Merge: parent-ancestors-predicates

Closes #77.  Thanks to Josh Moller-Mara (@mm--).

README.org

@@ -60,9 +60,16 @@ Installing with [[https://framagit.org/steckerhalter/quelpa][Quelpa]] is easy:
 #+END_SRC
 
 * Usage
+:PROPERTIES:
+:TOC:      :include descendants :depth 1
+:END:
 :CONTENTS:
 - [[#commands][Commands]]
 - [[#queries][Queries]]
+  - [[#non-sexp-query-syntax][Non-sexp query syntax]]
+  - [[#general-predicates][General predicates]]
+  - [[#ancestordescendant-predicates][Ancestor/descendant predicates]]
+  - [[#datetime-predicates][Date/time predicates]]
 - [[#functions--macros][Functions / Macros]]
 :END:
 
@@ -143,9 +150,13 @@ Show a sparse tree for ~QUERY~ in ~BUFFER~ and return number of results.  The tr
 ~QUERY~ is an ~org-ql~ query sexp (quoted, since this is a function).  ~BUFFER~ defaults to the current buffer.  When ~KEEP-PREVIOUS~ is non-nil (interactively, with prefix), the outline is not reset to the overview state before finding matches, which allows stacking calls to this command.  Runs ~org-occur-hook~ after making the sparse tree.
 
 ** Queries
+:PROPERTIES:
+:TOC:      :include descendants :depth 1
+:END:
 :CONTENTS:
 - [[#non-sexp-query-syntax][Non-sexp query syntax]]
--  [[#predicates][Predicates]]
+- [[#general-predicates][General predicates]]
+- [[#ancestordescendant-predicates][Ancestor/descendant predicates]]
 - [[#datetime-predicates][Date/time predicates]]
 :END:
 
@@ -175,13 +186,11 @@ The command =org-ql-search= also accepts, and the command =helm-org-ql= only acc
 
 Note that the =priority= predicate does not support comparators in the non-sexp syntax, so multiple priorities should be passed instead, as seen in the last example.
 
-*** Predicates
+*** General predicates
 
 Arguments are listed next to predicate names, where applicable.
 
 +  =category (&optional categories)= :: Return non-nil if current heading is in one or more of ~CATEGORIES~ (a list of strings).
-+  =children (&optional query)= :: Return non-nil if current heading has direct child headings.  If ~QUERY~, test it against child headings.  This selector may be nested, e.g. to match grandchild headings.
-+  =descendants (&optional query)= :: Return non-nil if current heading has descendant headings.  If ~QUERY~, test it against descendant headings.  This selector may be nested (if you can grok the nesting!).
 +  =done= :: Return non-nil if entry's ~TODO~ keyword is in ~org-done-keywords~.
 +  =habit= :: Return non-nil if entry is a habit.
 +  =heading (&rest regexps)= :: Return non-nil if current entry's heading matches all ~REGEXPS~ (regexp strings).
@@ -206,6 +215,13 @@ Arguments are listed next to predicate names, where applicable.
      -  Aliases: ~tags&~.
 +  =todo (&optional keywords)= :: Return non-nil if current heading is a ~TODO~ item.  With ~KEYWORDS~, return non-nil if its keyword is one of ~KEYWORDS~ (a list of strings).  When called without arguments, only matches non-done tasks (i.e. does not match keywords in ~org-done-keywords~).
 
+*** Ancestor/descendant predicates
+
++  =ancestors (&optional query)= :: Return non-nil if current heading has ancestor headings.  If ~QUERY~, return non-nil if an ancestor heading matches it.  This selector may be nested.
++  =children (&optional query)= :: Return non-nil if current heading has direct child headings.  If ~QUERY~, return non-nil if a child heading matches it.  This selector may be nested, e.g. to match grandchild headings.
++  =descendants (&optional query)= :: Return non-nil if current heading has descendant headings.  If ~QUERY~, return non-nil if a descendant heading matches it.  This selector may be nested (if you can grok the nesting!).
++  =parent (&optional query)= :: Return non-nil if current heading has a direct parent heading.  If ~QUERY~, return non-nil if the parent heading matches it.  This selector may be nested, e.g. to match grandparent headings.
+
 *** Date/time predicates
 
 All of these predicates take optional keyword arguments ~:from~, ~:to:~, and ~:on~:
@@ -395,6 +411,7 @@ Expands into a call to ~org-ql-select~ with the same arguments.  For convenience
      -  Negation of terms in plain queries using ~!~.  For example, ~tags:space !moon~ to exclude entries which contain ~moon~.
      -  Predicates =outline-path= (alias =olp=) and =outline-path-segment= (alias =olps=).
      -  Predicate ~src~, which matches Org Babel source blocks.
+     -  Predicates =parent= and =ancestors=.  (Thanks to [[https://github.com/mm--][Josh Moller-Mara]].)
      -  Alias =h= for =heading= predicate.
      -  Alias =r= for =regexp= predicate.  (Thanks to [[https://github.com/tumashu][Feng Shu]].)
 +  Info manual.
@@ -403,6 +420,7 @@ Expands into a call to ~org-ql-select~ with the same arguments.  For convenience
 +  Respect Org Agenda restriction in =org-ql-block=.  (Thanks to [[https://github.com/yantar92][Ihor Radchenko]] for reporting.)
 +  Option =org-ql-view-sidebar-sort-views=.
 +  Mouseover =help-echo= text for =org-ql-views= default view names.
++  "Dangling tasks" default view in =org-ql-views=.  (Users who have modified =org-ql-views= from the default will not see the new view unless they copy it into their config.)
 
 *Changed*
 +  Some default =org-ql-view= views (users who have modified =org-ql-views= from the default will not see the new views unless they copy them into their config):

examples.org

@@ -2,8 +2,9 @@
 
 * Contents
 :PROPERTIES:
-:TOC:      this
+:TOC:      :include siblings :ignore this
 :END:
+:CONTENTS:
 - [[#agenda-like-view][Agenda-like view]]
 - [[#entries-from-the-past-week][Entries from the past week]]
 - [[#find-entries-matching-a-certain-custom_id][Find entries matching a certain CUSTOM_ID]]
@@ -13,6 +14,8 @@
 - [[#set-tags-on-certain-entries][Set tags on certain entries]]
 - [[#show-entries-with-recent-timestamps][Show entries with recent timestamps]]
 - [[#stuck-projects-block-agenda][Stuck projects block agenda]]
+- [[#subproject-and-subtask-queries][Subproject and subtask queries]]
+:END:
 
 * Agenda-like view
 
@@ -173,9 +176,67 @@ With this =org-ql-block= agenda view, like:
                           ((org-ql-block-header "Stuck Projects")))))))
 #+END_SRC
 
+* Subproject and subtask queries
+
+#+BEGIN_SRC elisp
+  ;; Search for subprojects.
+  (org-ql-search (org-agenda-files)
+    '(and (todo "PROJECT")
+          (ancestors (todo "PROJECT"))))
+
+  ;; Search for all subtasks of projects, grouped by parent heading.
+  (org-ql-search (org-agenda-files)
+    '(and (todo)
+          (ancestors (todo "PROJECT")))
+    :super-groups '((:auto-parent t)))
+
+  ;; Search for direct top-level tasks of projects.
+  (org-ql-search (org-agenda-files)
+    '(and (todo)
+          (parent (todo "PROJECT")))
+    :super-groups '((:auto-parent t)))
+#+END_SRC
+
+Of course, all of those presume using a =PROJECT= keyword to define projects. If one defines a project as any task which has an ancestor task, one could use queries like:
+
+#+BEGIN_SRC elisp
+  ;; Search for all subtasks of top-level projects, grouped by parent heading.
+  (org-ql-search (org-agenda-files)
+    '(and (todo)
+          (ancestors
+           (and (todo)
+                (not (parent)))))
+    :super-groups '((:auto-parent t)))
+
+  ;; Search for all subtasks of all projects, including subprojects, grouped by project.
+  (org-ql-search (org-agenda-files)
+    '(and (todo)
+          (ancestors (todo)))
+    :super-groups '((:auto-parent t)))
+#+END_SRC
+
+Other interesting queries:
+
+#+BEGIN_SRC elisp
+  ;; Subtasks of upcoming deadline items.
+  (org-ql-search (org-agenda-files)
+    '(and (todo)
+          (ancestors
+           (and (not (done))
+                (deadline auto))))
+    :super-groups '((:auto-parent t)))
+
+  ;; TODO items whose ancestor is already DONE, and should therefore be
+  ;; either marked DONE or CANCELLED.
+  (org-ql-search (org-agenda-files)
+    '(and (todo)
+          (ancestors (done)))
+    :super-groups '((:auto-parent t)))
+#+END_SRC
+
 * COMMENT Code                                                     :noexport:
 :PROPERTIES:
-:TOC:      ignore
+:TOC:      :ignore (this descendants)
 :END:
 
 ** File-local variables

org-ql-view.el

@@ -177,6 +177,15 @@ See info node `(elisp)Cyclic Window Ordering'."
                     :super-groups 'org-super-agenda-groups
                     :sort '(priority)))))
         (cons "Review: Recently timestamped" #'org-ql-view-recent-items)
+        (cons (propertize "Review: Dangling tasks"
+                          'help-echo "Tasks whose ancestor is done")
+              (list :buffers-files #'org-agenda-files
+                    :query '(and (todo)
+                                 (ancestors (done)))
+                    :title (propertize "Review: Dangling tasks"
+                                       'help-echo "Tasks whose ancestor is done")
+                    :sort '(date priority todo)
+                    :super-groups '((:auto-parent t))))
         (cons (propertize "Review: Stale tasks"
                           'help-echo "Tasks without a timestamp in the past 2 weeks")
               (list :buffers-files #'org-agenda-files

org-ql.el

@@ -548,6 +548,10 @@ Replaces bare strings with (regexp) selectors, and appropriate
                      (`(children) '(children (lambda () t)))
                      (`(descendants ,query) `(descendants ',query))
                      (`(descendants) '(descendants (lambda () t)))
+                     (`(parent ,query) `(parent ,(org-ql--query-predicate (rec query))))
+                     (`(parent) '(parent (lambda () t)))
+                     (`(ancestors ,query) `(ancestors ,(org-ql--query-predicate (rec query))))
+                     (`(ancestors) '(ancestors (lambda () t)))
                      ;; Timestamp-based predicates.  I think this is the way that makes the most sense:
                      ;; set the limit to N days in the future, adjusted to 23:59:59 (since Org doesn't
                      ;; support timestamps down to the second, anyway, there should be no need to adjust
@@ -929,41 +933,6 @@ Arguments STRING, POS, FILL, and LEVEL are according to
 
 ;;;;; Predicates
 
-(org-ql--defpred children (query)
-  "Return non-nil if current entry has children matching QUERY."
-  (save-excursion
-    (save-restriction
-      (org-narrow-to-subtree)
-      (when (org-goto-first-child)
-        ;; Lisp makes this easy and elegant: all we do is modify the query,
-        ;; nesting it inside an (and), and it doesn't descend into grandchildren.
-        (let* ((level (org-current-level))
-               (query (cl-typecase query
-                        (byte-code-function `(and (level ,level)
-                                                  (funcall ,query)))
-                        (t `(and (level ,level)
-                                 ,query)))))
-          (catch 'found
-            (org-ql-select (current-buffer)
-              query
-              :narrow t
-              :action (lambda ()
-                        (throw 'found t)))))))))
-
-(org-ql--defpred descendants (query)
-  "Return non-nil if current entry has descendants matching QUERY."
-  (save-excursion
-    (save-restriction
-      (org-narrow-to-subtree)
-      (when (org-goto-first-child)
-        (narrow-to-region (point) (point-max))
-        (catch 'found
-          (org-ql-select (current-buffer)
-            query
-            :narrow t
-            :action (lambda ()
-                      (throw 'found t))))))))
-
 (org-ql--defpred category (&rest categories)
   "Return non-nil if current heading is in one or more of CATEGORIES (a list of strings)."
   (when-let ((category (org-get-category (point))))
@@ -1193,6 +1162,78 @@ language."
             ;; No regexps to check: return non-nil.
             t))))))
 
+;;;;;; Ancestor/descendant
+
+;; These predicates search ancestor and descendant headings for sub-queries.
+
+;; Note that the implementations of the upward-searching, ancestor/parent predicates differ
+;; from that of the downward-searching, descendants/children predicates in that the former
+;; take a predicate function as their argument and test it on each heading (the predicate
+;; being created by the `--pre-process-query' function, which see), while the latter take an
+;; `org-ql' query form as their argument and execute another `org-ql-select' query inside of
+;; the currently running query.  This "split" implementation seems like the most generally
+;; efficient one, because searching descendants searches potentially many more headings than
+;; searching ancestors, so executing a full query in that case can be faster due to use of
+;; the "preambles" provided by running a full query.  However, see note below.
+
+;; NOTE: The ancestors and parent predicates' docstrings are developer-facing
+;; rather than user-facing, since their arguments are predicates provided
+;; automatically by `--pre-process-query'.
+
+(org-ql--defpred ancestors (predicate)
+  "Return non-nil if any of current entry's ancestors satisfy PREDICATE."
+  (org-with-wide-buffer
+   (cl-loop while (org-up-heading-safe)
+            thereis (org-ql--value-at (point) predicate))))
+
+(org-ql--defpred parent (predicate)
+  "Return non-nil if the current entry's parent satisfies PREDICATE."
+  (org-with-wide-buffer
+   (when (org-up-heading-safe)
+     (org-ql--value-at (point) predicate))))
+
+;; MAYBE: The `children' and `descendants' predicates could probably be rewritten like
+;; the `ancestors' predicate, which avoids calling `org-ql-select' recursively and its
+;; associated overhead.  However, that would preclude the use of preambles, so depending
+;; on the Org file being searched and the sub-query, performance could be better or
+;; worse.  It should be benchmarked extensively before so changing the implementation.
+
+(org-ql--defpred children (query)
+  "Return non-nil if current entry has children matching QUERY."
+  (org-with-wide-buffer
+   ;; Widening is needed if inside an "ancestors" query
+   (org-narrow-to-subtree)
+   (when (org-goto-first-child)
+     ;; Lisp makes this easy and elegant: all we do is modify the query,
+     ;; nesting it inside an (and), and it doesn't descend into grandchildren.
+     (let* ((level (org-current-level))
+            (query (cl-typecase query
+                     (byte-code-function `(and (level ,level)
+                                               (funcall ,query)))
+                     (t `(and (level ,level)
+                              ,query)))))
+       (catch 'found
+         (org-ql-select (current-buffer)
+           query
+           :narrow t
+           :action (lambda ()
+                     (throw 'found t))))))))
+
+(org-ql--defpred descendants (query)
+  "Return non-nil if current entry has descendants matching QUERY."
+  ;; TODO: This could probably be rewritten like the `ancestors' predicate,
+  ;; which avoids calling `org-ql-select' recursively and its associated overhead.
+  (org-with-wide-buffer
+   (org-narrow-to-subtree)
+   (when (org-goto-first-child)
+     (narrow-to-region (point) (point-max))
+     (catch 'found
+       (org-ql-select (current-buffer)
+         query
+         :narrow t
+         :action (lambda ()
+                   (throw 'found t)))))))
+
 ;;;;;; Timestamps
 
 ;; TODO: Remove the _on vars from these arg lists.  I think they're not

org-ql.info

@@ -50,7 +50,8 @@ Commands
 Queries
 
 * Non-sexp query syntax::
-* Predicates::
+* General predicates::
+* Ancestor/descendant predicates::
 * Date/time predicates::
 
 
@@ -146,7 +147,8 @@ File: README.info,  Node: Usage,  Next: Changelog,  Prev: Installation,  Up: Top
 4 Usage
 *******
 
-   • • • 
+   • • 
+        • • • • • 
    Feedback on these APIs is welcome.  Eventually, after being tested
 and polished, they will be considered stable.
 
@@ -294,7 +296,7 @@ File: README.info,  Node: Queries,  Next: Functions / Macros,  Prev: Commands,
 4.2 Queries
 ===========
 
-   • • • 
+   • • • • 
    An org-ql query is a lisp form which may contain arbitrary lisp
 forms, as well as certain built-in predicates.  It is byte-compiled into
 a predicate function which is tested with point on each heading in an
@@ -311,11 +313,12 @@ Org buffer; when it returns non-nil, the heading matches the query.
 * Menu:
 
 * Non-sexp query syntax::
-* Predicates::
+* General predicates::
+* Ancestor/descendant predicates::
 * Date/time predicates::
 
 
-File: README.info,  Node: Non-sexp query syntax,  Next: Predicates,  Up: Queries
+File: README.info,  Node: Non-sexp query syntax,  Next: General predicates,  Up: Queries
 
 4.2.1 Non-sexp query syntax
 ---------------------------
@@ -345,24 +348,16 @@ non-sexp syntax, so multiple priorities should be passed instead, as
 seen in the last example.
 
 
-File: README.info,  Node: Predicates,  Next: Date/time predicates,  Prev: Non-sexp query syntax,  Up: Queries
+File: README.info,  Node: General predicates,  Next: Ancestor/descendant predicates,  Prev: Non-sexp query syntax,  Up: Queries
 
-4.2.2 Predicates
+4.2.2 General predicates
-----------------
+------------------------
 
 Arguments are listed next to predicate names, where applicable.
 
 ‘category (&optional categories)’
      Return non-nil if current heading is in one or more of ‘CATEGORIES’
      (a list of strings).
-‘children (&optional query)’
-     Return non-nil if current heading has direct child headings.  If
-     ‘QUERY’, test it against child headings.  This selector may be
-     nested, e.g.  to match grandchild headings.
-‘descendants (&optional query)’
-     Return non-nil if current heading has descendant headings.  If
-     ‘QUERY’, test it against descendant headings.  This selector may be
-     nested (if you can grok the nesting!).
 ‘done’
      Return non-nil if entry’s ‘TODO’ keyword is in ‘org-done-keywords’.
 ‘habit’
@@ -444,9 +439,32 @@ Arguments are listed next to predicate names, where applicable.
      ‘org-done-keywords’).
 
 
-File: README.info,  Node: Date/time predicates,  Prev: Predicates,  Up: Queries
+File: README.info,  Node: Ancestor/descendant predicates,  Next: Date/time predicates,  Prev: General predicates,  Up: Queries
 
-4.2.3 Date/time predicates
+4.2.3 Ancestor/descendant predicates
+------------------------------------
+
+‘ancestors (&optional query)’
+     Return non-nil if current heading has ancestor headings.  If
+     ‘QUERY’, return non-nil if an ancestor heading matches it.  This
+     selector may be nested.
+‘children (&optional query)’
+     Return non-nil if current heading has direct child headings.  If
+     ‘QUERY’, return non-nil if a child heading matches it.  This
+     selector may be nested, e.g.  to match grandchild headings.
+‘descendants (&optional query)’
+     Return non-nil if current heading has descendant headings.  If
+     ‘QUERY’, return non-nil if a descendant heading matches it.  This
+     selector may be nested (if you can grok the nesting!).
+‘parent (&optional query)’
+     Return non-nil if current heading has a direct parent heading.  If
+     ‘QUERY’, return non-nil if the parent heading matches it.  This
+     selector may be nested, e.g.  to match grandparent headings.
+
+
+File: README.info,  Node: Date/time predicates,  Prev: Ancestor/descendant predicates,  Up: Queries
+
+4.2.4 Date/time predicates
 --------------------------
 
 All of these predicates take optional keyword arguments ‘:from’, ‘:to:’,
@@ -722,6 +740,8 @@ will be pushed to the master branch when ready.
         • Predicates outline-path (alias olp) and outline-path-segment
           (alias olps).
         • Predicate ‘src’, which matches Org Babel source blocks.
+        • Predicates parent and ancestors.  (Thanks to Josh Moller-Mara
+          (https://github.com/mm--).)
         • Alias h for heading predicate.
         • Alias r for regexp predicate.  (Thanks to Feng Shu
           (https://github.com/tumashu).)
@@ -735,6 +755,9 @@ will be pushed to the master branch when ready.
      Radchenko (https://github.com/yantar92) for reporting.)
    • Option org-ql-view-sidebar-sort-views.
    • Mouseover help-echo text for org-ql-views default view names.
+   • "Dangling tasks" default view in org-ql-views.  (Users who have
+     modified org-ql-views from the default will not see the new view
+     unless they copy it into their config.)
 
    *Changed*
    • Some default org-ql-view views (users who have modified
@@ -1037,39 +1060,40 @@ GPLv3
 
 Tag Table:
 Node: Top225
-Node: Contents1367
+Node: Contents1410
-Node: Screenshots1541
+Node: Screenshots1584
-Node: Installation1659
+Node: Installation1702
-Node: Quelpa2297
+Node: Quelpa2340
-Node: Usage2740
+Node: Usage2783
-Node: Commands3064
+Node: Commands3132
-Node: org-ql-search3537
+Node: org-ql-search3605
-Node: helm-org-ql5185
+Node: helm-org-ql5253
-Node: org-ql-view5597
+Node: org-ql-view5665
-Node: org-ql-view-sidebar5795
+Node: org-ql-view-sidebar5863
-Node: org-ql-view-recent-items6151
+Node: org-ql-view-recent-items6219
-Node: org-ql-sparse-tree6635
+Node: org-ql-sparse-tree6703
-Node: Queries7435
+Node: Queries7503
-Node: Non-sexp query syntax8296
+Node: Non-sexp query syntax8411
-Node: Predicates9995
+Node: General predicates10118
-Node: Date/time predicates15217
+Node: Ancestor/descendant predicates14925
-Node: Functions / Macros17852
+Node: Date/time predicates16053
-Node: Agenda-like views18085
+Node: Functions / Macros18708
-Node: Listing / acting-on results19490
+Node: Agenda-like views18941
-Node: Changelog24092
+Node: Listing / acting-on results20346
-Node: 04-pre24629
+Node: Changelog24948
-Node: 03228251
+Node: 04-pre25485
-Node: 03128632
+Node: 03229405
-Node: 0328827
+Node: 03129786
-Node: 02331800
+Node: 0329981
-Node: 02232026
+Node: 02332954
-Node: 02132292
+Node: 02233180
-Node: 0232489
+Node: 02133446
-Node: 0136522
+Node: 0233643
-Node: Notes36621
+Node: 0137676
-Node: Comparison with Org Agenda searches36783
+Node: Notes37775
-Node: org-sidebar37654
+Node: Comparison with Org Agenda searches37937
-Node: License37933
+Node: org-sidebar38808
+Node: License39087
 
 End Tag Table
 

tests/test-org-ql.el

@@ -347,6 +347,24 @@ RESULTS should be a list of strings as returned by
 
     ;; TODO: Other predicates.
 
+    (describe "(ancestors)"
+      (org-ql-it "without sub-query"
+        (org-ql-expect ((ancestors))
+          '("Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "/r/emacs" "Shop for groceries" "Sunrise/sunset" "Rewrite Emacs in Common Lisp" "Write a symphony")))
+
+      (org-ql-it "with sub-query"
+        (org-ql-expect ((ancestors (heading "universe")))
+          '("Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language"))))
+
+    (describe "(parent)"
+      (org-ql-it "without sub-query"
+        (org-ql-expect ((parent))
+          '("Take over the world" "Skype with president of Antarctica" "Take over Mars" "Visit Mars" "Take over the moon" "Visit the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language" "/r/emacs" "Shop for groceries" "Sunrise/sunset" "Rewrite Emacs in Common Lisp" "Write a symphony")))
+
+      (org-ql-it "with sub-query"
+        (org-ql-expect ((parent (and (todo) (priority "A"))))
+          '("Take over the world" "Skype with president of Antarctica" "Take over Mars" "Take over the moon" "Practice leaping tall buildings in a single bound" "Renew membership in supervillain club" "Learn universal sign language"))))
+
     (describe "(category)"
 
       (org-ql-it "without arguments"