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

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

Browse source
This commit is contained in:
Adam Porter 2020-12-12 06:09:49 -06:00
parent 2dfd378d5f
commit ec2e624dc2
1 changed files with 48 additions and 51 deletions
Download patch file Download diff file Expand all files Collapse all files

99
org-ql.el
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)
(--map (with-current-buffer it (unwind-protect
(unless (derived-mode-p 'org-mode) (progn
(user-error "Not an Org buffer: %s" (buffer-name))) (--each org-ql-predicates
(org-ql--select-cached :query query :preamble preamble :preamble-case-fold preamble-case-fold ;; Set predicate functions.
:predicate predicate :action action :narrow narrow))) (-let (((&plist :name :fn) (cdr it)))
(-flatten-n 1)))) ;; 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
(unless (derived-mode-p 'org-mode)
(user-error "Not an Org buffer: %s" (buffer-name)))
(org-ql--select-cached :query query :preamble preamble :preamble-case-fold preamble-case-fold
:predicate predicate :action action :narrow narrow)))
(-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,50 +362,32 @@ 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.
(save-excursion
;; MAYBE: Lift the `flet'-equivalent out of this function so it isn't done for each buffer. (save-restriction
(let (orig-fns) (unless narrow
(--each org-ql-predicates (widen))
;; Save original function mappings. (goto-char (point-min))
(let* ((it (cdr it)) (when (org-before-first-heading-p)
(name (plist-get it :name))) (outline-next-heading))
(push (list :name name :fn (symbol-function name)) orig-fns))) (if (not (org-at-heading-p))
(unwind-protect (progn
(progn ;; No headings in buffer: return nil.
(--each org-ql-predicates (unless (string-prefix-p " " (buffer-name))
;; Set predicate functions. ;; Not a special, hidden buffer: show message, because if a user accidentally
(let ((it (cdr it))) ;; searches a buffer without headings, he might be confused.
(fset (plist-get it :name) (plist-get it :fn)))) (message "org-ql: No headings in buffer: %s" (current-buffer)))
;; Run query. nil)
(save-excursion ;; Find matching entries.
(save-restriction ;; TODO: Bind `case-fold-search' around the preamble loop.
(unless narrow (cond (preamble (cl-loop while (let ((case-fold-search preamble-case-fold))
(widen)) (re-search-forward preamble nil t))
(goto-char (point-min)) do (outline-back-to-heading 'invisible-ok)
(when (org-before-first-heading-p) when (funcall predicate)
(outline-next-heading)) collect (funcall action)
(if (not (org-at-heading-p)) do (outline-next-heading)))
(progn (t (cl-loop when (funcall predicate)
;; No headings in buffer: return nil. collect (funcall action)
(unless (string-prefix-p " " (buffer-name)) while (outline-next-heading))))))))
;; Not a special, hidden buffer: show message, because if a user accidentally
;; searches a buffer without headings, he might be confused.
(message "org-ql: No headings in buffer: %s" (current-buffer)))
nil)
;; Find matching entries.
;; TODO: Bind `case-fold-search' around the preamble loop.
(cond (preamble (cl-loop while (let ((case-fold-search preamble-case-fold))
(re-search-forward preamble nil t))
do (outline-back-to-heading 'invisible-ok)
when (funcall predicate)
collect (funcall action)
do (outline-next-heading)))
(t (cl-loop when (funcall predicate)
collect (funcall action)
while (outline-next-heading))))))))
(--each orig-fns
;; Restore original function mappings.
(fset (plist-get it :name) (plist-get it :fn))))))
;;;;; Helpers ;;;;; Helpers