jiri/org-ql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source
This commit is contained in:
Adam Porter 2019-10-07 12:41:23 -05:00
parent 8d680a8e79
commit c06e5518eb
3 changed files with 96 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

70
org-ql.el
View file

@ -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'