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

Change: (olp, olps) Optimize multiple args with heading query

Browse source
This commit is contained in:
Adam Porter 2020-12-03 12:27:32 -06:00
parent 73209cf48e
commit 2d07cb0822
3 changed files with 49 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

28
org-ql.el
View file

@ -1170,9 +1170,17 @@ the following queries:
(olp \"Food\" \"Fruits\")
(olp \"Fruits\" \"Grapes\")
(olp \"Food\" \"Grapes\")"
:normalizers ((`(,predicate-names . ,strings)
;; Regexp quote headings.
`(outline-path ,@(mapcar #'regexp-quote strings))))
;; FIXME: Stop regexp quoting when the (heading) predicate is changed to take a non-regexp string.
:normalizers ((`(,predicate-names ,string)
;; Equivalent to (heading string), which is much faster.
`(heading ,(regexp-quote string)))
(`(,predicate-names . ,strings)
;; Rewrite query to use (heading) with the last string
;; and (olp) for the rest, which is much faster.
(let ((last (car (last strings)))
(rest (butlast strings)))
`(and (heading ,(regexp-quote last))
(outline-path ,@(mapcar #'regexp-quote rest))))))
:body (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))))
@ -1195,9 +1203,17 @@ contiguous segment of the outline path:
(olp \"Food\" \"Grape\")"
;; MAYBE: Allow anchored matching.
:normalizers ((`(,(or 'outline-path-segment 'olps) . ,strings)
;; Regexp quote headings.
`(outline-path-segment ,@(mapcar #'regexp-quote strings))))
;; FIXME: Stop regexp quoting when the (heading) predicate is changed to take a non-regexp string.
:normalizers ((`(,predicate-names ,string)
;; Equivalent to (heading string), which is much faster.
`(heading ,(regexp-quote string)))
(`(,predicate-names . ,strings)
;; Rewrite query to use (heading) with the last string
;; and (olp) for the rest, which is much faster.
(let ((last (car (last strings)))
(rest (butlast strings)))
`(and (heading ,(regexp-quote last))
(outline-path-segment ,@(mapcar #'regexp-quote rest))))))
:body (org-ql--infix-p regexps (org-ql--value-at (point) #'org-ql--outline-path)))
(org-ql-defpred path (&rest regexps)