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

71
org-ql.el
View file

@ -375,28 +375,26 @@ 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
;; NOTE: This exhaustive pcase is essential to opening links safely, ;; safely, as it rejects, e.g. lambdas in the IN argument.
;; as it rejects, e.g. lambdas in the buffers-files 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) (find-file-noselect it))
;; It feels unintuitive that `find-file-noselect' returns (display-warning 'org-ql-select (format "Can't open file: %s" it) :error)))
;; a buffer if the filename doesn't exist. ((cl-type string)
(find-file-noselect it)) (org-id-find it 'marker))
(display-warning 'org-ql-select (format "Can't open file: %s" it) :error))) ((cl-type function)
((cl-type string) (funcall it))))
;; Assumed to be an Org ID string (without the "id:" prefix). ;; Ignore special/hidden buffers.
it))) (--remove (and (bufferp it) (string-prefix-p " " (buffer-name it))))))
;; Ignore special/hidden buffers.
(--remove (and (bufferp it) (string-prefix-p " " (buffer-name it))))))
(query (org-ql--normalize-query query)) (query (org-ql--normalize-query query))
((&plist :query :preamble :preamble-case-fold) (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))
@ -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))