From 8bfb65d715d72380d10086ef8f3cccdc331088a3 Mon Sep 17 00:00:00 2001 From: Adam Porter Date: Tue, 10 Jul 2018 08:27:54 -0500 Subject: [PATCH] Change: Refactor, improve docstrings, argument handling, etc. Move some code between functions and macros to make more sense and be more flexible. --- org-agenda-ng.el | 68 ++++++++++++++++++++++++++++++++++++++---------- org-ql.el | 56 +++++++++++++++++++++------------------ 2 files changed, 84 insertions(+), 40 deletions(-) diff --git a/org-agenda-ng.el b/org-agenda-ng.el index 4373e65..f0b6dff 100644 --- a/org-agenda-ng.el +++ b/org-agenda-ng.el @@ -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)) - `(org-agenda-ng--agenda ,files - (byte-compile (lambda () - (cl-symbol-macrolet ((= #'=) - (< #'<) - (> #'>) - (<= #'<=) - (>= #'>=)) - ,pred-body))) - #'org-agenda-ng--format-element)) +(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))) + :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 diff --git a/org-ql.el b/org-ql.el index cac8297..71bc772 100644 --- a/org-ql.el +++ b/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,21 +30,19 @@ 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 - (byte-compile (lambda () - (cl-symbol-macrolet ((= #'=) - (< #'<) - (> #'>) - (<= #'<=) - (>= #'>=)) - ,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)"))))) + `(org-ql--query ,buffers-or-files + (byte-compile (lambda () + (cl-symbol-macrolet ((= #'=) + (< #'<) + (> #'>) + (<= #'<=) + (>= #'>=)) + ,pred-body))) + :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,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. ;; (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 - (buffer it) - (string (or (find-buffer-visiting it) - (find-file-noselect it) - (user-error "Can't open file: %s" it)))) - (mapcar action-fn - (org-ql--filter-buffer :pred pred :narrow narrow))) - buffers-or-files)))) + (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) + (user-error "Can't open file: %s" it)))) + (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.