Add: (tags-regexp, tags*) Predicate
This commit is contained in:
parent
cbd4ea89f4
commit
337bfa6695
4 changed files with 86 additions and 29 deletions
20
org-ql.el
20
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:
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue