From 337bfa6695bb5c3df83904311c0350499a2f3751 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Thu, 12 Nov 2020 04:09:57 -0600 Subject: [PATCH] Add: (tags-regexp, tags*) Predicate --- README.org | 3 +++ org-ql.el | 20 ++++++++++++++ org-ql.info | 64 ++++++++++++++++++++++++-------------------- tests/test-org-ql.el | 28 +++++++++++++++++++ 4 files changed, 86 insertions(+), 29 deletions(-) diff --git a/README.org b/README.org index 7863b92..6fcfc92 100644 --- a/README.org +++ b/README.org @@ -219,6 +219,8 @@ Arguments are listed next to predicate names, where applicable. - Aliases: ~local-tags~, ~tags-l~, ~ltags~. + =tags-all (tags)= :: Return non-nil if current heading includes all of ~TAGS~. Tests both inherited and local tags. - Aliases: ~tags&~. ++ =tags-regexp (&rest regexps)= :: Return non-nil if current heading has tags matching one or more of ~REGEXPS~. Tests both inherited and local tags. + - 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 @@ -457,6 +459,7 @@ Simple links may also be written manually in either sexp or non-sexp form, like: *Added* + View dispatcher using =transient.el= (like Magit), bound to =v= in search/view buffers. + Predicate =link=, which matches descriptions and targets in Org links. ++ Predicate ~tags-regexp~ (alias: ~tags*~), which matches regexps against entry tags (e.g, helpful when a tag might end in "s"). + Emacs bookmark support: Org QL View buffers can be bookmarked with, e.g. =C-x r m= and shown with, e.g. =C-x r b=. (This also enables view restoration with [[https://github.com/alphapapa/burly.el][Burly]].) + Dynamic block support. + Org link support (storing and opening links to Org QL View searches). diff --git a/org-ql.el b/org-ql.el index f6639c4..dc6ee24 100644 --- a/org-ql.el +++ b/org-ql.el @@ -672,6 +672,7 @@ Replaces bare strings with (regexp) selectors, and appropriate ;; Inherited and local predicate aliases. (`(,(or 'tags-i 'itags 'inherited-tags) . ,tags) `(tags-inherited ,@tags)) (`(,(or 'tags-l 'ltags 'local-tags) . ,tags) `(tags-local ,@tags)) + (`(,(or 'tags*) . ,regexps) `(tags-regexp ,@regexps)) ;; Timestamps (`(,(or 'ts-active 'ts-a) . ,rest) `(ts :type active ,@rest)) @@ -1153,6 +1154,25 @@ If TAGS is nil, return non-nil if heading has any local tags." (otherwise (when (tags-p local) (seq-intersection tags local))))))) +(org-ql--defpred (tags-regexp tags*) (&rest regexps) + "Return non-nil if current heading has tags matching one or more of REGEXPS. +Tests both inherited and local tags." + (cl-macrolet ((tags-p (tags) + `(and ,tags + (not (eq 'org-ql-nil ,tags))))) + (-let* (((inherited local) (org-ql--tags-at (point)))) + (cl-typecase regexps + (null (or (tags-p inherited) + (tags-p local))) + (otherwise (or (when (tags-p inherited) + (cl-loop for tag in inherited + thereis (cl-loop for regexp in regexps + thereis (string-match regexp tag)))) + (when (tags-p local) + (cl-loop for tag in local + thereis (cl-loop for regexp in regexps + thereis (string-match regexp tag)))))))))) + (org-ql--defpred level (level-or-comparator &optional level) "Return non-nil if current heading's outline level matches arguments. The following forms are accepted: diff --git a/org-ql.info b/org-ql.info index baf149e..3d86d66 100644 --- a/org-ql.info +++ b/org-ql.info @@ -455,6 +455,10 @@ Arguments are listed next to predicate names, where applicable. Return non-nil if current heading includes all of ‘TAGS’. Tests both inherited and local tags. • Aliases: ‘tags&’. +‘tags-regexp (&rest regexps)’ + Return non-nil if current heading has tags matching one or more of + ‘REGEXPS’. Tests both inherited and local tags. + • 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 @@ -830,6 +834,8 @@ File: README.info, Node: 05-pre, Next: 046, Up: Changelog search/view buffers. • Predicate link, which matches descriptions and targets in Org links. + • Predicate ‘tags-regexp’ (alias: ‘tags*’), which matches regexps + against entry tags (e.g, helpful when a tag might end in "s"). • Emacs bookmark support: Org QL View buffers can be bookmarked with, e.g. C-x r m and shown with, e.g. C-x r b. (This also enables view restoration with Burly @@ -1277,35 +1283,35 @@ Node: org-ql-sparse-tree7144 Node: Queries7944 Node: Non-sexp query syntax8852 Node: General predicates10559 -Node: Ancestor/descendant predicates15774 -Node: Date/time predicates16902 -Node: Functions / Macros19557 -Node: Agenda-like views19812 -Node: Listing / acting-on results21217 -Node: Dynamic block25819 -Node: Links27982 -Node: Tips28669 -Node: Changelog28987 -Node: 05-pre29626 -Node: 04630718 -Node: 04531121 -Node: 04431480 -Node: 04331837 -Node: 04232032 -Node: 04132191 -Node: 0432430 -Node: 03236361 -Node: 03136738 -Node: 0336935 -Node: 02339910 -Node: 02240138 -Node: 02140406 -Node: 0240605 -Node: 0144640 -Node: Notes44741 -Node: Comparison with Org Agenda searches44903 -Node: org-sidebar45775 -Node: License46054 +Node: Ancestor/descendant predicates15972 +Node: Date/time predicates17100 +Node: Functions / Macros19755 +Node: Agenda-like views20010 +Node: Listing / acting-on results21415 +Node: Dynamic block26017 +Node: Links28180 +Node: Tips28867 +Node: Changelog29185 +Node: 05-pre29824 +Node: 04631063 +Node: 04531466 +Node: 04431825 +Node: 04332182 +Node: 04232377 +Node: 04132536 +Node: 0432775 +Node: 03236706 +Node: 03137083 +Node: 0337280 +Node: 02340255 +Node: 02240483 +Node: 02140751 +Node: 0240950 +Node: 0144985 +Node: Notes45086 +Node: Comparison with Org Agenda searches45248 +Node: org-sidebar46120 +Node: License46399  End Tag Table diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index 63a02cf..d31a08f 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -962,6 +962,34 @@ RESULTS should be a list of strings as returned by '("Fruit" "Blueberry" "Strawberry") :buffer (org-ql-test-data-buffer "data2.org")))) + (describe "(tags-regexp), (tags*)" + + (org-ql-it "without arguments" + (org-ql-expect ((tags-regexp)) + '("Take over the 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" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Shop for groceries" "Rewrite Emacs in Common Lisp" "Write a symphony")) + (org-ql-expect ((not (tags*))) + '("Recurring" "Sunrise/sunset" "Ideas"))) + + (org-ql-it "with a tag regexp" + (org-ql-expect ((tags-regexp "Emac")) + '("/r/emacs" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((not (tags* "Emac"))) + '("Take over the 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" "Order a pizza" "Get haircut" "Internet" "Spaceship lease" "Fix flux capacitor" "Recurring" "Shop for groceries" "Sunrise/sunset" "Ideas" "Write a symphony"))) + + (org-ql-it "with 2 tag regexps" + (org-ql-expect ((tags-regexp "Emac" "spac")) + '("Visit Mars" "Visit the moon" "Spaceship lease" "Fix flux capacitor" "/r/emacs" "Rewrite Emacs in Common Lisp")) + (org-ql-expect ((not (tags* "Emac" "spac"))) + '("Take over the universe" "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" "Order a pizza" "Get haircut" "Internet" "Recurring" "Shop for groceries" "Sunrise/sunset" "Ideas" "Write a symphony"))) + + (org-ql-it "with regexp matching file tags" + (org-ql-expect ((tags-regexp "foo")) + '("Fruit" "Blueberry" "Strawberry" "Vegetable" "Broccoli" "Potato") + :buffer (org-ql-test-data-buffer "data2.org")) + (org-ql-expect ((tags* "frui")) + '("Fruit" "Blueberry" "Strawberry") + :buffer (org-ql-test-data-buffer "data2.org")))) + (describe "(ts)" (describe "active"