Change: Read files or buffers

This commit is contained in:
Adam Porter 2018-05-23 09:35:35 -05:00
parent a3cb114f71
commit 6624837aa2

View file

@ -14,8 +14,8 @@
;;;; Macros ;;;; Macros
(cl-defmacro org-ql (files pred-body &key (action-fn (lambda (element) element)) sort narrow) (cl-defmacro org-ql (buffers-or-files pred-body &key (action-fn (lambda (element) element)) sort narrow)
"Find entries in FILES that match PRED-BODY, and return the results of running ACTION-FN on each matching entry. "Find entries in BUFFERS-OR-FILES that match PRED-BODY, and return the results of running ACTION-FN on each matching entry.
ACTION-FN should take a single argument, which will be the result ACTION-FN should take a single argument, which will be the result
of calling `org-element-headline-parser' at each matching entry. of calling `org-element-headline-parser' at each matching entry.
@ -27,7 +27,7 @@ one or more sorting methods, including: `date', `deadline',
If NARROW is non-nil, query will run without widening the If NARROW is non-nil, query will run without widening the
buffer (the default is to widen and search the entire buffer)." buffer (the default is to widen and search the entire buffer)."
(declare (indent defun)) (declare (indent defun))
`(let ((items (org-ql--query ,files `(let ((items (org-ql--query ,buffers-or-files
(byte-compile (lambda () (byte-compile (lambda ()
(cl-symbol-macrolet ((= #'=) (cl-symbol-macrolet ((= #'=)
(< #'<) (< #'<)
@ -52,21 +52,25 @@ buffer (the default is to widen and search the entire buffer)."
;;;; Functions ;;;; Functions
(cl-defun org-ql--query (files pred action-fn &key narrow) (cl-defun org-ql--query (buffers-or-files pred action-fn &key narrow)
"FIXME: Add docstring." "FIXME: Add docstring."
(setq files (cl-typecase files ;; MAYBE: Set :narrow t for buffers and nil for files.
(null (list (buffer-file-name (current-buffer)))) (setq buffers-or-files (cl-typecase buffers-or-files
(list files) (null (list (current-buffer)))
(string (list files)))) (buffer (list buffers-or-files))
(mapc 'find-file-noselect files) (list buffers-or-files)
(string (list buffers-or-files))))
(let* ((org-use-tag-inheritance t) (let* ((org-use-tag-inheritance t)
(org-scanner-tags nil) (org-scanner-tags nil)
(org-trust-scanner-tags t) (org-trust-scanner-tags t)
(org-ql--today (org-today))) (org-ql--today (org-today)))
(-flatten-n 1 (--map (with-current-buffer (find-buffer-visiting it) (-flatten-n 1 (--map (with-current-buffer (cl-typecase it
(buffer it)
(string (or (find-buffer-visiting it)
(find-file-noselect it))))
(mapcar action-fn (mapcar action-fn
(org-ql--filter-buffer :pred pred :narrow narrow))) (org-ql--filter-buffer :pred pred :narrow narrow)))
files)))) buffers-or-files))))
(cl-defun org-ql--filter-buffer (&key pred narrow) (cl-defun org-ql--filter-buffer (&key pred narrow)
"Return positions of matching headings in current buffer. "Return positions of matching headings in current buffer.