Change: Bind predicates per-query instead of per-buffer

This commit is contained in:
Adam Porter 2020-12-12 06:09:49 -06:00
parent 2dfd378d5f
commit ec2e624dc2

View file

@ -252,13 +252,28 @@ returns nil or non-nil."
,action))) ,action)))
(_ (user-error "Invalid action form: %s" action)))) (_ (user-error "Invalid action form: %s" action))))
(org-ql--today (ts-now)) (org-ql--today (ts-now))
(items (->> buffers (items (let (orig-fns)
(unwind-protect
(progn
(--each org-ql-predicates
;; Set predicate functions.
(-let (((&plist :name :fn) (cdr it)))
;; Save original function.
(push (list :name name :fn (symbol-function name)) orig-fns)
;; Temporarily set new function definition.
(fset name fn)))
;; Run query on buffers.
(->> buffers
(--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 preamble :preamble-case-fold preamble-case-fold (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)))
(--each orig-fns
;; Restore original function mappings.
(-let (((&plist :name :fn) it))
(fset name fn)))))))
;; Sort items ;; Sort items
(pcase sort (pcase sort
(`nil items) (`nil items)
@ -347,21 +362,6 @@ If NARROW is non-nil, buffer will not be widened."
;; can't be used, so we do it manually (this is same as the equivalent `flet' expansion). ;; can't be used, so we do it manually (this is same as the equivalent `flet' expansion).
;; Mappings are stored in the variable because it allows predicates to be defined with a ;; Mappings are stored in the variable because it allows predicates to be defined with a
;; macro, which allows documentation to be easily generated for them. ;; macro, which allows documentation to be easily generated for them.
;; MAYBE: Lift the `flet'-equivalent out of this function so it isn't done for each buffer.
(let (orig-fns)
(--each org-ql-predicates
;; Save original function mappings.
(let* ((it (cdr it))
(name (plist-get it :name)))
(push (list :name name :fn (symbol-function name)) orig-fns)))
(unwind-protect
(progn
(--each org-ql-predicates
;; Set predicate functions.
(let ((it (cdr it)))
(fset (plist-get it :name) (plist-get it :fn))))
;; Run query.
(save-excursion (save-excursion
(save-restriction (save-restriction
(unless narrow (unless narrow
@ -388,9 +388,6 @@ If NARROW is non-nil, buffer will not be widened."
(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))))))))
(--each orig-fns
;; Restore original function mappings.
(fset (plist-get it :name) (plist-get it :fn))))))
;;;;; Helpers ;;;;; Helpers