From 65fb37c30d6c0764a5f9f2b17b7062439804740e Mon Sep 17 00:00:00 2001 From: Josh Moller-Mara Date: Wed, 18 Dec 2019 01:01:47 +0800 Subject: [PATCH] Add: parent and ancestors predicates These predicates are analogs to the existing "children" and "descendents" predicates. They may be useful for testing parents for specific todo states, or if they have non-inherited tags (i.e. tags from "org-tags-exclude-from-inheritance"). --- README.org | 3 +++ org-ql.el | 73 ++++++++++++++++++++++++++++++++---------------------- 2 files changed, 47 insertions(+), 29 deletions(-) diff --git a/README.org b/README.org index 4922e12..23f672f 100644 --- a/README.org +++ b/README.org @@ -181,7 +181,9 @@ 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. ++ =parent (&optional query)= :: Return non-nil if current heading has a direct parent heading. If ~QUERY~, test it against the parent heading. This selector may be nested, e.g. to match grandparent 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!). ++ =ancestors (&optional query)= :: Return non-nil if current heading has ancestor headings (which is true if it has a parent heading). With ~QUERY~, return non-nil if some ancestor heading matches it. This selector may also be nested. + =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). @@ -395,6 +397,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=. - Alias =h= for =heading= predicate. - Alias =r= for =regexp= predicate. (Thanks to [[https://github.com/tumashu][Feng Shu]].) + Info manual. diff --git a/org-ql.el b/org-ql.el index effa411..e643ca5 100644 --- a/org-ql.el +++ b/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 ,(org-ql--query-predicate (rec '(lambda () t))))) + (`(ancestors ,query) `(ancestors ,(org-ql--query-predicate (rec query)))) + (`(ancestors) `(ancestors ,(org-ql--query-predicate (rec '(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 @@ -931,38 +935,49 @@ Arguments STRING, POS, FILL, and LEVEL are according to (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-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 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)))) (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-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))))))) + +(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 category (&rest categories) "Return non-nil if current heading is in one or more of CATEGORIES (a list of strings)."