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

Add/Fix: Set case-fold for preambles

Browse source 
And use for (todo) preambles.
This commit is contained in:
Adam Porter 2019-09-18 01:21:07 -05:00
parent 6e4ce26f45
commit 8f2a02264f
3 changed files with 41 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

1
README.org
View file

@ -490,6 +490,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience
*Fixed* *Fixed*
+ Predicate =heading= now matches only against heading text, i.e. not including tags at the end of the line, to-do keyword, etc. + Predicate =heading= now matches only against heading text, i.e. not including tags at the end of the line, to-do keyword, etc.
+ Predicate =todo= now matches case-sensitively, avoiding non-todo-keyword matches (e.g. a heading which begins =Waiting on= will no longer match for a todo keyword =WAITING=).
** 0.2.1 ** 0.2.1

37
org-ql.el
View file

@ -193,7 +193,7 @@ returns nil or non-nil."
;; Ignore special/hidden buffers. ;; Ignore special/hidden buffers.
(--remove (string-prefix-p " " (buffer-name it))))) (--remove (string-prefix-p " " (buffer-name it)))))
(query (org-ql--pre-process-query query)) (query (org-ql--pre-process-query query))
((query preamble-re) (org-ql--query-preamble query)) ((&plist :query :preamble :preamble-case-fold) (org-ql--query-preamble query))
(predicate (org-ql--query-predicate query)) (predicate (org-ql--query-predicate query))
(action (pcase action (action (pcase action
;; NOTE: These two lambdas are backquoted to prevent "unused lexical ;; NOTE: These two lambdas are backquoted to prevent "unused lexical
@ -219,7 +219,7 @@ returns nil or non-nil."
(--map (with-current-buffer it (--map (with-current-buffer it
(unless (derived-mode-p 'org-mode) (unless (derived-mode-p 'org-mode)
(user-error "Not an Org buffer: %s" (buffer-name))) (user-error "Not an Org buffer: %s" (buffer-name)))
(org-ql--select-cached :query query :preamble-re preamble-re (org-ql--select-cached :query query :preamble preamble :preamble-case-fold preamble-case-fold
:predicate predicate :action action :narrow narrow))) :predicate predicate :action action :narrow narrow)))
(-flatten-n 1)))) (-flatten-n 1))))
;; Sort items ;; Sort items
@ -402,13 +402,14 @@ predicates."
,query)))) ,query))))
(defun org-ql--query-preamble (query) (defun org-ql--query-preamble (query)
"Return (QUERY PREAMBLE) for QUERY. "Return plist (QUERY PREAMBLE PREAMBLE-CASE-FOLD) for QUERY.
When QUERY has a clause with a corresponding preamble, and it's When QUERY has a clause with a corresponding preamble, and it's
appropriate to use one (i.e. the clause is not in an `or'), appropriate to use one (i.e. the clause is not in an `or'),
replace the clause with a preamble." replace the clause with a preamble."
(pcase org-ql-use-preamble (pcase org-ql-use-preamble
('nil (list query nil)) ('nil (list :query query :preamble nil))
(_ (let (org-ql-preamble) (_ (let ((preamble-case-fold t)
org-ql-preamble)
(cl-labels ((rec (element) (cl-labels ((rec (element)
(or (when org-ql-preamble (or (when org-ql-preamble
;; Only one preamble is allowed ;; Only one preamble is allowed
@ -431,14 +432,10 @@ replace the clause with a preamble."
(setq org-ql-preamble (car regexps)) (setq org-ql-preamble (car regexps))
element) element)
(`(todo . ,(and todo-keywords (guard todo-keywords))) (`(todo . ,(and todo-keywords (guard todo-keywords)))
;; FIXME: With case-folding, a query like (todo "WAITING") can find a (setf org-ql-preamble
;; non-todo heading named "Waiting". For correctness, we could test the
;; predicate anyway, but that would negate some of the speed, and in
;; most cases it probably won't matter, so I'm leaving it this way for
;; now. Maybe we should use a special variable to control case-folding.
(setq org-ql-preamble
(rx-to-string `(seq bol (1+ "*") (1+ space) (or ,@todo-keywords) (or " " eol)) (rx-to-string `(seq bol (1+ "*") (1+ space) (or ,@todo-keywords) (or " " eol))
t)) t)
preamble-case-fold nil)
;; Return nil, don't test the predicate. ;; Return nil, don't test the predicate.
nil) nil)
(`(habit) (`(habit)
@ -494,6 +491,7 @@ replace the clause with a preamble."
nil) nil)
(`(priority ,letter) (`(priority ,letter)
;; Specific priority without comparator. ;; Specific priority without comparator.
;; MAYBE: Disable case-folding.
(setq org-ql-preamble (rx-to-string `(seq bol (1+ "*") (1+ blank) (setq org-ql-preamble (rx-to-string `(seq bol (1+ "*") (1+ blank)
(optional (1+ upper) (1+ blank)) (optional (1+ upper) (1+ blank))
"[#" ,letter "]") t)) "[#" ,letter "]") t))
@ -517,6 +515,7 @@ replace the clause with a preamble."
nil)) nil))
;; Properties. ;; Properties.
;; MAYBE: Should case folding be disabled for properties? What about values?
(`(property ,property ,value) (`(property ,property ,value)
;; We do NOT return nil, because the predicate still needs to be tested, ;; We do NOT return nil, because the predicate still needs to be tested,
;; because the regexp could match a string not inside a property drawer. ;; because the regexp could match a string not inside a property drawer.
@ -572,17 +571,17 @@ replace the clause with a preamble."
`((or))) `((or)))
t) t)
(query (-flatten-n 1 query)))) (query (-flatten-n 1 query))))
(list query org-ql-preamble)))))) (list :query query :preamble org-ql-preamble :preamble-case-fold preamble-case-fold))))))
(defun org-ql--select-cached (&rest args) (defun org-ql--select-cached (&rest args)
"Return results for ARGS and current buffer using cache." "Return results for ARGS and current buffer using cache."
;; MAYBE: Timeout cached queries. Probably not necessarily since they will be removed when a ;; MAYBE: Timeout cached queries. Probably not necessarily since they will be removed when a
;; buffer is closed, or when a query is run after modifying a buffer. ;; buffer is closed, or when a query is run after modifying a buffer.
(-let* (((&plist :query :preamble-re :action :narrow) args) (-let* (((&plist :query :preamble :action :narrow :preamble-case-fold) args)
(query-cache-key (query-cache-key
;; The key must include the preamble, because some queries are replaced by ;; The key must include the preamble, because some queries are replaced by
;; the preamble, leaving a nil query, which would make the key ambiguous. ;; the preamble, leaving a nil query, which would make the key ambiguous.
(list :query query :preamble-re preamble-re :action action (list :query query :preamble preamble :action action :preamble-case-fold preamble-case-fold
(if narrow (if narrow
;; Use bounds of narrowed portion of buffer. ;; Use bounds of narrowed portion of buffer.
(cons (point-min) (point-max)) (cons (point-min) (point-max))
@ -607,7 +606,8 @@ replace the clause with a preamble."
(t (puthash query-cache-key (or new-result 'org-ql-nil) query-cache))) (t (puthash query-cache-key (or new-result 'org-ql-nil) query-cache)))
new-result)))) new-result))))
(cl-defun org-ql--select (&key preamble-re predicate action narrow &allow-other-keys) (cl-defun org-ql--select (&key preamble preamble-case-fold predicate action narrow
&allow-other-keys)
"Return results of mapping function ACTION across entries in current buffer matching function PREDICATE. "Return results of mapping function ACTION across entries in current buffer matching function PREDICATE.
If NARROW is non-nil, buffer will not be widened." If NARROW is non-nil, buffer will not be widened."
;; Since the mappings are stored in the variable `org-ql-predicates', macros like `flet' ;; Since the mappings are stored in the variable `org-ql-predicates', macros like `flet'
@ -643,11 +643,12 @@ If NARROW is non-nil, buffer will not be widened."
(message "org-ql: No headings in buffer: %s" (current-buffer))) (message "org-ql: No headings in buffer: %s" (current-buffer)))
nil) nil)
;; Find matching entries. ;; Find matching entries.
(cond (preamble-re (cl-loop while (re-search-forward preamble-re nil t) (cond (preamble (let ((case-fold-search preamble-case-fold))
(cl-loop while (re-search-forward preamble nil t)
do (outline-back-to-heading 'invisible-ok) do (outline-back-to-heading 'invisible-ok)
when (funcall predicate) when (funcall predicate)
collect (funcall action) collect (funcall action)
do (outline-next-heading))) do (outline-next-heading))))
(t (cl-loop when (funcall predicate) (t (cl-loop when (funcall predicate)
collect (funcall action) collect (funcall action)
while (outline-next-heading)))))))) while (outline-next-heading))))))))

24
tests/test-org-ql.el
View file

@ -198,22 +198,34 @@ RESULTS should be a list of strings as returned by
(describe "(level)" (describe "(level)"
(it "with a number" (it "with a number"
(expect (org-ql--query-preamble '(level 2)) (expect (org-ql--query-preamble '(level 2))
:to-equal `(t ,(rx bol (repeat 2 "*") " ")))) :to-equal (list :query t
:preamble (rx bol (repeat 2 "*") " ")
:preamble-case-fold t)))
(it "with two numbers" (it "with two numbers"
(expect (org-ql--query-preamble '(level 2 4)) (expect (org-ql--query-preamble '(level 2 4))
:to-equal `(t ,(rx bol (repeat 2 4 "*") " ")))) :to-equal (list :query t
:preamble (rx bol (repeat 2 4 "*") " ")
:preamble-case-fold t)))
(it "<" (it "<"
(expect (org-ql--query-preamble '(level < 3)) (expect (org-ql--query-preamble '(level < 3))
:to-equal `(t ,(rx bol (repeat 1 2 "*") " ")))) :to-equal (list :query t
:preamble (rx bol (repeat 1 2 "*") " ")
:preamble-case-fold t)))
(it "<=" (it "<="
(expect (org-ql--query-preamble '(level <= 2)) (expect (org-ql--query-preamble '(level <= 2))
:to-equal `(t ,(rx bol (repeat 1 2 "*") " ")))) :to-equal (list :query t
:preamble (rx bol (repeat 1 2 "*") " ")
:preamble-case-fold t)))
(it ">" (it ">"
(expect (org-ql--query-preamble '(level > 2)) (expect (org-ql--query-preamble '(level > 2))
:to-equal `(t ,(rx bol (>= 3 "*") " ")))) :to-equal (list :query t
:preamble (rx bol (>= 3 "*") " ")
:preamble-case-fold t)))
(it ">=" (it ">="
(expect (org-ql--query-preamble '(level >= 2)) (expect (org-ql--query-preamble '(level >= 2))
:to-equal `(t ,(rx bol (>= 2 "*") " ")))))) :to-equal (list :query t
:preamble (rx bol (>= 2 "*") " ")
:preamble-case-fold t)))))
(describe "Query results" (describe "Query results"