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

Change: Refactor, improve docstrings, argument handling, etc.

Browse source 
Move some code between functions and macros to make more sense and be
more flexible.
This commit is contained in:
Adam Porter 2018-07-10 08:27:54 -05:00
parent c605ccbaf3
commit 8bfb65d715
2 changed files with 84 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

68
org-agenda-ng.el
View file

@ -41,26 +41,66 @@
;; FIXME: DRY these two macros. ;; FIXME: DRY these two macros.
(cl-defmacro org-agenda-ng (files pred-body) (cl-defmacro org-agenda-ng (&rest args)
"Display an agenda-like buffer of entries in FILES that match PRED-BODY." "Display an agenda-like buffer of entries in FILES that match PRED.
(declare (indent defun))
`(org-agenda-ng--agenda ,files FILES-OR-PRED is a sexp that is evaluated to get the list of
(byte-compile (lambda () files to scan.
(cl-symbol-macrolet ((= #'=)
(< #'<) 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
,pred-body))) nil, in which case the list of files will automatically be set to
#'org-agenda-ng--format-element)) 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)))
:sort ',sort))))
;;;; Functions ;;;; Functions
;; TODO: Move the action-fn down into --filter-buffer, so users can avoid calling the ;; TODO: Move the action-fn down into --filter-buffer, so users can avoid calling the
;; headline-parser when they don't need it. ;; headline-parser when they don't need it.
(cl-defun org-agenda-ng--agenda (files pred action-fn) (cl-defun org-agenda-ng--agenda (files pred &key action-fn sort)
(let* ((entries (org-ql--query files pred action-fn)) ;; `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)) (result-string (org-agenda-finalize-entries entries 'agenda))
(target-buffer (get-buffer-create "test-agenda-ng"))) (target-buffer (get-buffer-create "test-agenda-ng")))
(with-current-buffer target-buffer (with-current-buffer target-buffer

56
org-ql.el
View file

@ -17,7 +17,7 @@
;;;; Macros ;;;; 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. "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
@ -30,21 +30,19 @@ 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 ,buffers-or-files `(org-ql--query ,buffers-or-files
(byte-compile (lambda () (byte-compile (lambda ()
(cl-symbol-macrolet ((= #'=) (cl-symbol-macrolet ((= #'=)
(< #'<) (< #'<)
(> #'>) (> #'>)
(<= #'<=) (<= #'<=)
(>= #'>=)) (>= #'>=))
,pred-body))) ,pred-body)))
,action-fn :action-fn ,action-fn
:narrow ,narrow))) :narrow ,narrow
(cl-typecase ',sort :sort ,(pcase sort
(list (org-ql--sort-by items ',sort)) (`(function ,_) sort)
(function (funcall ,sort items)) (_ (list 'quote sort)))))
(null items)
(t (user-error "SORT must be a function or a list of methods (see documentation)")))))
(defmacro org-ql--fmap (fns &rest body) (defmacro org-ql--fmap (fns &rest body)
(declare (indent defun) (debug (listp body))) (declare (indent defun) (debug (listp body)))
@ -55,9 +53,10 @@ buffer (the default is to widen and search the entire buffer)."
;;;; Functions ;;;; 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." "FIXME: Add docstring."
;; MAYBE: Set :narrow t for buffers and nil for files. ;; MAYBE: Set :narrow t for buffers and nil for files.
(declare (indent defun))
(let* ((buffers-or-files (cl-typecase buffers-or-files (let* ((buffers-or-files (cl-typecase buffers-or-files
(null (list (current-buffer))) (null (list (current-buffer)))
(buffer (list buffers-or-files)) (buffer (list buffers-or-files))
@ -66,15 +65,20 @@ buffer (the default is to widen and search the entire buffer)."
;; TODO: Figure out how to use or reimplement the org-scanner-tags feature. ;; TODO: Figure out how to use or reimplement the org-scanner-tags feature.
;; (org-use-tag-inheritance t) ;; (org-use-tag-inheritance t)
;; (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 (cl-typecase it (items (-flatten-n 1 (--map (with-current-buffer (cl-typecase it
(buffer it) (buffer it)
(string (or (find-buffer-visiting it) (string (or (find-buffer-visiting it)
(find-file-noselect it) (find-file-noselect it)
(user-error "Can't open file: %s" it)))) (user-error "Can't open file: %s" it))))
(mapcar action-fn (mapcar action-fn
(org-ql--filter-buffer :pred pred :narrow narrow))) (org-ql--filter-buffer :pred pred :narrow narrow)))
buffers-or-files)))) 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) (defun org-ql--sanity-check-form (form)
"Signal an error if any of the forms in BODY do not have their preconditions met. "Signal an error if any of the forms in BODY do not have their preconditions met.