Add/Fix: Set case-fold for preambles
And use for (todo) preambles.
This commit is contained in:
Adam Porter
parent
6e4ce26f45
commit
8f2a02264f
3 changed files with 41 additions and 27 deletions
|
|
@ -490,6 +490,7 @@ Expands into a call to ~org-ql-select~ with the same arguments. For convenience
|
|||
|
||||
*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 =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
|
||||
|
||||
|
|
|
|||
37
org-ql.el
37
org-ql.el
|
|
@ -193,7 +193,7 @@ returns nil or non-nil."
|
|||
;; Ignore special/hidden buffers.
|
||||
(--remove (string-prefix-p " " (buffer-name it)))))
|
||||
(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))
|
||||
(action (pcase action
|
||||
;; NOTE: These two lambdas are backquoted to prevent "unused lexical
|
||||
|
|
@ -219,7 +219,7 @@ returns nil or non-nil."
|
|||
(--map (with-current-buffer it
|
||||
(unless (derived-mode-p 'org-mode)
|
||||
(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)))
|
||||
(-flatten-n 1))))
|
||||
;; Sort items
|
||||
|
|
@ -402,13 +402,14 @@ predicates."
|
|||
,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
|
||||
appropriate to use one (i.e. the clause is not in an `or'),
|
||||
replace the clause with a preamble."
|
||||
(pcase org-ql-use-preamble
|
||||
('nil (list query nil))
|
||||
(_ (let (org-ql-preamble)
|
||||
('nil (list :query query :preamble nil))
|
||||
(_ (let ((preamble-case-fold t)
|
||||
org-ql-preamble)
|
||||
(cl-labels ((rec (element)
|
||||
(or (when org-ql-preamble
|
||||
;; Only one preamble is allowed
|
||||
|
|
@ -431,14 +432,10 @@ replace the clause with a preamble."
|
|||
(setq org-ql-preamble (car regexps))
|
||||
element)
|
||||
(`(todo . ,(and todo-keywords (guard todo-keywords)))
|
||||
;; FIXME: With case-folding, a query like (todo "WAITING") can find a
|
||||
;; 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
|
||||
(setf org-ql-preamble
|
||||
(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.
|
||||
nil)
|
||||
(`(habit)
|
||||
|
|
@ -494,6 +491,7 @@ replace the clause with a preamble."
|
|||
nil)
|
||||
(`(priority ,letter)
|
||||
;; Specific priority without comparator.
|
||||
;; MAYBE: Disable case-folding.
|
||||
(setq org-ql-preamble (rx-to-string `(seq bol (1+ "*") (1+ blank)
|
||||
(optional (1+ upper) (1+ blank))
|
||||
"[#" ,letter "]") t))
|
||||
|
|
@ -517,6 +515,7 @@ replace the clause with a preamble."
|
|||
nil))
|
||||
|
||||
;; Properties.
|
||||
;; MAYBE: Should case folding be disabled for properties? What about values?
|
||||
(`(property ,property ,value)
|
||||
;; 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.
|
||||
|
|
@ -572,17 +571,17 @@ replace the clause with a preamble."
|
|||
`((or)))
|
||||
t)
|
||||
(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)
|
||||
"Return results for ARGS and current buffer using cache."
|
||||
;; 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.
|
||||
(-let* (((&plist :query :preamble-re :action :narrow) args)
|
||||
(-let* (((&plist :query :preamble :action :narrow :preamble-case-fold) args)
|
||||
(query-cache-key
|
||||
;; The key must include the preamble, because some queries are replaced by
|
||||
;; 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
|
||||
;; Use bounds of narrowed portion of buffer.
|
||||
(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)))
|
||||
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.
|
||||
If NARROW is non-nil, buffer will not be widened."
|
||||
;; 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)))
|
||||
nil)
|
||||
;; 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)
|
||||
when (funcall predicate)
|
||||
collect (funcall action)
|
||||
do (outline-next-heading)))
|
||||
do (outline-next-heading))))
|
||||
(t (cl-loop when (funcall predicate)
|
||||
collect (funcall action)
|
||||
while (outline-next-heading))))))))
|
||||
|
|
|
|||
|
|
@ -198,22 +198,34 @@ RESULTS should be a list of strings as returned by
|
|||
(describe "(level)"
|
||||
(it "with a number"
|
||||
(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"
|
||||
(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 "<"
|
||||
(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 "<="
|
||||
(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 ">"
|
||||
(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 ">="
|
||||
(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"
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue