Change: Refactor, improve docstrings, argument handling, etc.
Move some code between functions and macros to make more sense and be more flexible.
This commit is contained in:
Adam Porter
parent
c605ccbaf3
commit
8bfb65d715
2 changed files with 84 additions and 40 deletions
|
|
@ -41,26 +41,66 @@
|
|||
|
||||
;; FIXME: DRY these two macros.
|
||||
|
||||
(cl-defmacro org-agenda-ng (files pred-body)
|
||||
"Display an agenda-like buffer of entries in FILES that match PRED-BODY."
|
||||
(declare (indent defun))
|
||||
(cl-defmacro org-agenda-ng (&rest args)
|
||||
"Display an agenda-like buffer of entries in FILES that match PRED.
|
||||
|
||||
FILES-OR-PRED is a sexp that is evaluated to get the list of
|
||||
files to scan.
|
||||
|
||||
PRED is a predicate sexp which is evaluated on each entry to test
|
||||
whether it matches. This should be a form used by `org-ql'.
|
||||
|
||||
The predicate may be passed as FILES-OR-PRED and PRED may be left
|
||||
nil, in which case the list of files will automatically be set to
|
||||
the value of calling `org-agenda-files'.
|
||||
|
||||
SORT is a list of sorting keys: `deadline', `scheduled',
|
||||
`date' (matching either `deadline' or `scheduled'), `priority',
|
||||
or `todo'.
|
||||
|
||||
NARROW, when non-nil, means to respect narrowing in buffers.
|
||||
When nil, buffers are widened before being searched."
|
||||
(declare (indent defun)
|
||||
(advertised-calling-convention '(files-or-pred &optional pred &key sort narrow) nil))
|
||||
(cl-macrolet ((set-keyword-args (args)
|
||||
`(setq sort (plist-get ,args :sort)
|
||||
narrow (plist-get ,args :narrow))))
|
||||
(let ((files '(org-agenda-files))
|
||||
pred sort narrow)
|
||||
;; Parse args manually (so we can leave FILES nil for a default argument).
|
||||
(pcase args
|
||||
(`(,arg-files ,arg-pred . ,(and rest (guard (keywordp (car rest)))))
|
||||
(setq files arg-files
|
||||
pred arg-pred)
|
||||
(set-keyword-args rest))
|
||||
(`(,arg-pred . ,(and rest (guard (keywordp (car rest)))))
|
||||
(setq pred arg-pred)
|
||||
(set-keyword-args rest)))
|
||||
;; Call --agenda
|
||||
`(org-agenda-ng--agenda ,files
|
||||
(byte-compile (lambda ()
|
||||
(cl-symbol-macrolet ((= #'=)
|
||||
(< #'<)
|
||||
(> #'>)
|
||||
(<= #'<=)
|
||||
(>= #'>=))
|
||||
,pred-body)))
|
||||
#'org-agenda-ng--format-element))
|
||||
(cl-symbol-macrolet ((= #'=) (< #'<) (> #'>) (<= #'<=) (>= #'>=))
|
||||
,pred)))
|
||||
:sort ',sort))))
|
||||
|
||||
;;;; Functions
|
||||
|
||||
;; TODO: Move the action-fn down into --filter-buffer, so users can avoid calling the
|
||||
;; headline-parser when they don't need it.
|
||||
|
||||
(cl-defun org-agenda-ng--agenda (files pred action-fn)
|
||||
(let* ((entries (org-ql--query files pred action-fn))
|
||||
(cl-defun org-agenda-ng--agenda (files pred &key action-fn sort)
|
||||
;; `org-ql--query' uses `org-element-headline-parser' by default, which we then map
|
||||
;; `org-agenda-ng--format-element' across to get formatted, propertized strings for the agenda.
|
||||
;; NOTE: `org-element-headline-parser' should remain the low-level action function, because the
|
||||
;; sorting functions work on Org elements (so e.g. if we put `org-agenda-ng--format-element' as
|
||||
;; the low-level action function, sorting would do nothing, because the sorting functions would
|
||||
;; not find any data to sort on). IOW we have to call `org-agenda-ng--format-element' here, not
|
||||
;; pass it to lower functions.
|
||||
(declare (indent defun))
|
||||
(let* ((entries (mapcar #'org-agenda-ng--format-element
|
||||
(org-ql--query files
|
||||
pred
|
||||
:sort sort)))
|
||||
(result-string (org-agenda-finalize-entries entries 'agenda))
|
||||
(target-buffer (get-buffer-create "test-agenda-ng")))
|
||||
(with-current-buffer target-buffer
|
||||
|
|
|
|||
28
org-ql.el
28
org-ql.el
|
|
@ -17,7 +17,7 @@
|
|||
|
||||
;;;; Macros
|
||||
|
||||
(cl-defmacro org-ql (buffers-or-files pred-body &key (action-fn (lambda (element) element)) sort narrow)
|
||||
(cl-defmacro org-ql (buffers-or-files pred-body &key (action-fn '#'identity) sort narrow)
|
||||
"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
|
||||
|
|
@ -30,7 +30,7 @@ one or more sorting methods, including: `date', `deadline',
|
|||
If NARROW is non-nil, query will run without widening the
|
||||
buffer (the default is to widen and search the entire buffer)."
|
||||
(declare (indent defun))
|
||||
`(let ((items (org-ql--query ,buffers-or-files
|
||||
`(org-ql--query ,buffers-or-files
|
||||
(byte-compile (lambda ()
|
||||
(cl-symbol-macrolet ((= #'=)
|
||||
(< #'<)
|
||||
|
|
@ -38,13 +38,11 @@ buffer (the default is to widen and search the entire buffer)."
|
|||
(<= #'<=)
|
||||
(>= #'>=))
|
||||
,pred-body)))
|
||||
,action-fn
|
||||
:narrow ,narrow)))
|
||||
(cl-typecase ',sort
|
||||
(list (org-ql--sort-by items ',sort))
|
||||
(function (funcall ,sort items))
|
||||
(null items)
|
||||
(t (user-error "SORT must be a function or a list of methods (see documentation)")))))
|
||||
:action-fn ,action-fn
|
||||
:narrow ,narrow
|
||||
:sort ,(pcase sort
|
||||
(`(function ,_) sort)
|
||||
(_ (list 'quote sort)))))
|
||||
|
||||
(defmacro org-ql--fmap (fns &rest body)
|
||||
(declare (indent defun) (debug (listp body)))
|
||||
|
|
@ -55,9 +53,10 @@ buffer (the default is to widen and search the entire buffer)."
|
|||
|
||||
;;;; Functions
|
||||
|
||||
(cl-defun org-ql--query (buffers-or-files pred action-fn &key narrow)
|
||||
(cl-defun org-ql--query (buffers-or-files pred &key (action-fn #'identity) narrow sort)
|
||||
"FIXME: Add docstring."
|
||||
;; MAYBE: Set :narrow t for buffers and nil for files.
|
||||
(declare (indent defun))
|
||||
(let* ((buffers-or-files (cl-typecase buffers-or-files
|
||||
(null (list (current-buffer)))
|
||||
(buffer (list buffers-or-files))
|
||||
|
|
@ -66,8 +65,8 @@ buffer (the default is to widen and search the entire buffer)."
|
|||
;; TODO: Figure out how to use or reimplement the org-scanner-tags feature.
|
||||
;; (org-use-tag-inheritance t)
|
||||
;; (org-trust-scanner-tags t)
|
||||
(org-ql--today (org-today)))
|
||||
(-flatten-n 1 (--map (with-current-buffer (cl-typecase it
|
||||
(org-ql--today (org-today))
|
||||
(items (-flatten-n 1 (--map (with-current-buffer (cl-typecase it
|
||||
(buffer it)
|
||||
(string (or (find-buffer-visiting it)
|
||||
(find-file-noselect it)
|
||||
|
|
@ -75,6 +74,11 @@ buffer (the default is to widen and search the entire buffer)."
|
|||
(mapcar action-fn
|
||||
(org-ql--filter-buffer :pred pred :narrow narrow)))
|
||||
buffers-or-files))))
|
||||
(cl-typecase sort
|
||||
(list (org-ql--sort-by items sort))
|
||||
(function (funcall sort items))
|
||||
(null items)
|
||||
(t (user-error "SORT must be a function or a list of methods (see documentation)")))))
|
||||
|
||||
(defun org-ql--sanity-check-form (form)
|
||||
"Signal an error if any of the forms in BODY do not have their preconditions met.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue