Add: Predicates outline-path, outline-path-segment

README.org

@@ -178,6 +178,10 @@ Arguments are listed next to predicate names, where applicable.
 +  ~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).
 +  ~level (level-or-comparator &optional level)~ :: Return non-nil if current heading's outline level matches arguments.  The following forms are accepted: ~(level NUMBER)~: Matches if heading level is ~NUMBER~.  ~(level NUMBER NUMBER)~: Matches if heading level is equal to or between NUMBERs.  ~(level COMPARATOR NUMBER)~: Matches if heading level compares to ~NUMBER~ with ~COMPARATOR~.  ~COMPARATOR~ may be ~<~, ~<=~, ~>~, or ~>=~.
++  =outline-path (&rest strings)= :: Return non-nil if current node's outline path matches all of =STRINGS=.  Each string may appear as a substring in any part of the node's outline path.  For example, the path =Food/Fruits/Grapes= would match ~(olp "Fruit" "Grape")~.
+     -  Aliases: =olp=.
++  =outline-path-segment (&rest strings)= :: Return non-nil if current node's outline path matches =STRINGS=.  Matches =STRINGS= as a contiguous segment of the outline path.  Each string is compared as a substring.  For example the path =Food/Fruits/Grapes= would match ~(olps "Fruit" "Grape")~ but not ~(olps "Food" "Grape")~.
+     -  Aliases: =olps=.
 +  =path (&rest regexps)= :: Return non-nil if current heading's buffer's filename path matches any of =REGEXPS= (regexp strings).  Without arguments, return non-nil if buffer is file-backed.
 +  ~priority (&optional comparator-or-priority priority)~ :: Return non-nil if current heading has a certain priority.  ~COMPARATOR-OR-PRIORITY~ should be either a comparator function, like ~<=~, or a priority string, like "A" (in which case (~=~ will be the comparator).  If ~COMPARATOR-OR-PRIORITY~ is a comparator, ~PRIORITY~ should be a priority string.  If both arguments are nil, return non-nil if heading has any defined priority.
 +  ~property (property &optional value)~ :: Return non-nil if current entry has ~PROPERTY~ (a string), and optionally ~VALUE~ (a string).  Note that property inheritance is currently /not/ enabled for this predicate.  If you need to test with inheritance, you could use a custom predicate form, like ~(org-entry-get (point) "PROPERTY" 'inherit)~.
@@ -365,6 +369,9 @@ Expands into a call to ~org-ql-select~ with the same arguments.  For convenience
 
 ** 0.4-pre
 
+*Added*
++  Predicates =outline-path= (alias =olp=) and =outline-path-segment= (alias =olps=).
+
 *Internal*
 +  Added generic node data cache to speed up recursive, tree-based queries.
 

org-ql.el

@@ -426,6 +426,18 @@ Returns cons (INHERITED-TAGS . LOCAL-TAGS)."
                  org-ql-tags-cache))
       (puthash position all-tags tags-cache))))
 
+(defun org-ql--outline-path ()
+  "Return outline path for heading at point."
+  (save-excursion
+    (let ((heading (nth 4 (org-heading-components))))
+      (if (org-up-heading-safe)
+          ;; MAYBE: It seems wrong to call the cache function from
+          ;; inside this function, like a violation of separation of
+          ;; concern.  Can this be rewritten to not work that way?
+          (append (org-ql--value-at (point) #'org-ql--outline-path)
+                  (list heading))
+        (list heading)))))
+
 ;; TODO: Use --value-at for tags cache.
 
 (defun org-ql--value-at (position fn)
@@ -556,6 +568,14 @@ Replaces bare strings with (regexp) selectors, and appropriate
                                      (ts-apply :hour 23 :minute 59 :second 59))))
                         `(,pred :to ,to)))
 
+                     ;; Outline paths.
+                     (`(,(or 'outline-path 'olp) . ,strings)
+                      ;; Regexp quote headings.
+                      `(outline-path ,@(mapcar #'regexp-quote strings)))
+                     (`(,(or 'outline-path-segment 'olps) . ,strings)
+                      ;; Regexp quote headings.
+                      `(outline-path-segment ,@(mapcar #'regexp-quote strings)))
+
                      ;; Priorities
                      (`(priority ,(and (or '= '< '> '<= '>=) comparator) ,letter)
                       ;; Quote comparator.
@@ -922,6 +942,44 @@ Tests both inherited and local tags."
                        (when (tags-p local)
                          (seq-intersection tags local))))))))
 
+;; MAYBE: Preambles for outline-path predicates.  Not sure if possible without complicated logic.
+
+(org-ql--defpred (outline-path olp) (&rest regexps)
+  "Return non-nil if current node's outline path matches all of REGEXPS.
+Each string is compared as a regexp to each element of the node's
+outline path with `string-match'.  For example, if an entry's
+outline path were \"Food/Fruits/Grapes\", it would match any of
+the following queries:
+
+  (olp \"Food\")
+  (olp \"Fruits\")
+  (olp \"Food\" \"Fruits\")
+  (olp \"Fruits\" \"Grapes\")
+  (olp \"Food\" \"Grapes\")"
+  (let ((entry-olp (org-ql--value-at (point) #'org-ql--outline-path)))
+    (cl-loop for h in regexps
+             always (cl-member h entry-olp :test #'string-match))))
+
+(org-ql--defpred (outline-path-segment olps) (&rest regexps)
+  "Return non-nil if current node's outline path matches segment REGEXPS.
+Matches REGEXPS as a contiguous segment of the outline path.
+Each regexp is compared to each element of the node's outline
+path with `string-match'.  For example, if an entry's outline
+path were \"Food/Fruits/Grapes\", it would match any of the
+following queries:
+
+  (olp \"Food\")
+  (olp \"Fruit\")
+  (olp \"Food\" \"Fruit\")
+  (olp \"Fruit\" \"Grape\")
+
+But it would not match the following, because they do not match a
+contiguous segment of the outline path:
+
+  (olp \"Food\" \"Grape\")"
+  ;; MAYBE: Allow anchored matching.
+  (org-ql--infix-p regexps (org-ql--value-at (point) #'org-ql--outline-path)))
+
 (org-ql--defpred (tags-inherited tags-i itags) (&rest tags)
   "Return non-nil if current heading's inherited tags include one or more of TAGS (a list of strings).
 If TAGS is nil, return non-nil if heading has any inherited tags."
@@ -1302,6 +1360,18 @@ A and B are Org headline elements."
             (a-priority t)
             (b-priority nil)))))
 
+(defun org-ql--infix-p (infix list)
+  "Return non-nil if INFIX is an infix of LIST.
+Each element of INFIX is compared using `string-match', so each
+element should be a regexp string."
+  (cl-loop with infix-length = (length infix)
+           while (and list
+                      (>= (length list) infix-length))
+           thereis (cl-loop for i in infix
+                            for l in list
+                            always (string-match i l))
+           do (pop list)))
+
 ;;;;; Plain query parsing
 
 ;; This section implements parsing of "plain," non-Lisp queries using the `peg'

tests/test-org-ql.el

@@ -479,6 +479,25 @@ RESULTS should be a list of strings as returned by
         (org-ql-expect ((heading "Take over" "world"))
           '("Take over the world"))))
 
+    (describe "(outline-path)"
+      (org-ql-it "with one argument"
+        (org-ql-expect ((outline-path "symphony"))
+          '("Write a symphony")))
+      (org-ql-it "with two arguments"
+        (org-ql-expect ((outline-path "idea" "symphony"))
+          '("Write a symphony"))))
+
+    (describe "(outline-path-segment)"
+      (org-ql-it "with one argument"
+        (org-ql-expect ((outline-path-segment "symphony"))
+          '("Write a symphony")))
+      (org-ql-it "with a contiguous segment"
+        (org-ql-expect ((outline-path-segment "idea" "symphony"))
+          '("Write a symphony")))
+      (org-ql-it "with a non-contiguous segment"
+        (org-ql-expect ((outline-path-segment "data" "symphony"))
+          nil)))
+
     (describe "(path)"
       (org-ql-it "without arguments"
         (org-ql-expect ((path))