From c06e5518eb830b2cc079bc61fc9ba32549710103 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Mon, 7 Oct 2019 12:41:23 -0500 Subject: [PATCH] Add: Predicates outline-path, outline-path-segment --- README.org | 7 +++++ org-ql.el | 70 ++++++++++++++++++++++++++++++++++++++++++++ tests/test-org-ql.el | 19 ++++++++++++ 3 files changed, 96 insertions(+) diff --git a/README.org b/README.org index f72bb43..574e056 100644 --- a/README.org +++ b/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. diff --git a/org-ql.el b/org-ql.el index dfc48db..65f1ff9 100644 --- a/org-ql.el +++ b/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' diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index c7b95bc..66c3053 100644 --- a/tests/test-org-ql.el +++ b/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))