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

WIP: (org-ql-select) Tidy, etc.

Browse source
This commit is contained in:
Adam Porter 2023-12-24 00:59:39 -06:00
parent e57d50b81c
commit 9237f0d93b
1 changed files with 34 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

43
org-ql.el
View file

@ -375,26 +375,24 @@ would appear first. In contrast, `(date reverse priority)' would
also present items with the highest priority first, but within also present items with the highest priority first, but within
each priority the newest items would appear first." each priority the newest items would appear first."
(declare (indent defun)) (declare (indent defun))
(-let* ((in (->> (cl-typecase in (-let* ((sources (->> (cl-typecase in
(null (list (current-buffer))) (null (list (current-buffer)))
(function (funcall in))
(list in) (list in)
(otherwise (list in))) (otherwise (list in)))
(--map (pcase-exhaustive it (--map (pcase-exhaustive it
;; NOTE: This exhaustive pcase is essential to opening links safely, ;; NOTE: This exhaustive pcase is essential to opening links
;; as it rejects, e.g. lambdas in the buffers-files argument. ;; safely, as it rejects, e.g. lambdas in the IN argument.
((cl-type buffer) it) ((cl-type buffer) it)
((and (cl-type string) ((and (cl-type string)
(pred file-readable-p)) (pred file-readable-p))
(or (find-buffer-visiting it) (or (find-buffer-visiting it)
(when (file-readable-p it) (when (file-readable-p it)
;; It feels unintuitive that `find-file-noselect' returns
;; a buffer if the filename doesn't exist.
(find-file-noselect it)) (find-file-noselect it))
(display-warning 'org-ql-select (format "Can't open file: %s" it) :error))) (display-warning 'org-ql-select (format "Can't open file: %s" it) :error)))
((cl-type string) ((cl-type string)
;; Assumed to be an Org ID string (without the "id:" prefix). (org-id-find it 'marker))
it))) ((cl-type function)
(funcall it))))
;; Ignore special/hidden buffers. ;; Ignore special/hidden buffers.
(--remove (and (bufferp it) (string-prefix-p " " (buffer-name it)))))) (--remove (and (bufferp it) (string-prefix-p " " (buffer-name it))))))
(query (org-ql--normalize-query query)) (query (org-ql--normalize-query query))
@ -420,6 +418,18 @@ each priority the newest items would appear first."
,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))
(select-in (lambda (it)
(let* ((marker)
(buffer (cl-etypecase it
(buffer it)
(marker (marker-buffer (setf marker it))))))
(with-current-buffer buffer
(unless (derived-mode-p 'org-mode)
(display-warning 'org-ql-select (format "Not an Org buffer: %s" (buffer-name)) :error))
(org-ql--select-cached :query query :preamble preamble
:preamble-case-fold preamble-case-fold
:predicate predicate :action action
:narrow (or marker narrow))))))
(items (let (orig-fns) (items (let (orig-fns)
(unwind-protect (unwind-protect
(progn (progn
@ -430,21 +440,8 @@ each priority the newest items would appear first."
(push (list :name name :fn (symbol-function name)) orig-fns) (push (list :name name :fn (symbol-function name)) orig-fns)
;; Temporarily set new function definition. ;; Temporarily set new function definition.
(fset name fn))) (fset name fn)))
;; Run query on buffers. ;; Collect results.
(->> in (-flatten-n 1 (mapcar select-in sources)))
(--map (let* ((marker)
(buffer (cl-etypecase it
(buffer it)
(string (marker-buffer
(setf marker (org-id-find it 'as-marker)))))))
(with-current-buffer buffer
(unless (derived-mode-p 'org-mode)
(display-warning 'org-ql-select (format "Not an Org buffer: %s" (buffer-name)) :error))
(org-ql--select-cached :query query :preamble preamble :preamble-case-fold preamble-case-fold
:predicate predicate :action action
;; FIXME: Is it okay to use a marker here, or do we need to use the ID and get a new position each time?
:narrow (or marker narrow)))))
(-flatten-n 1)))
(--each orig-fns (--each orig-fns
;; Restore original function mappings. ;; Restore original function mappings.
(-let (((&plist :name :fn) it)) (-let (((&plist :name :fn) it))