Change: Refactor and tidy

Move add-markers function into org-ql, which should help avoid
cross-dependency, and should be generally useful.
This commit is contained in:
Adam Porter 2018-08-20 07:34:30 -05:00
parent 4822f1406f
commit f6db1097dc
2 changed files with 67 additions and 46 deletions

View file

@ -86,9 +86,7 @@ When nil, buffers are widened before being searched."
;; Call --agenda ;; Call --agenda
`(org-agenda-ng--agenda ,files `(org-agenda-ng--agenda ,files
;; TODO: Probably better to just use eval on org-ql rather than reimplementing parts of it here. ;; TODO: Probably better to just use eval on org-ql rather than reimplementing parts of it here.
(byte-compile (lambda () ',pred
(cl-symbol-macrolet ((= #'=) (< #'<) (> #'>) (<= #'<=) (>= #'>=))
,pred)))
:sort ',sort)))) :sort ',sort))))
;;;; Functions ;;;; Functions
@ -96,7 +94,7 @@ When nil, buffers are widened before being searched."
;; 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 &key action-fn sort) (cl-defun org-agenda-ng--agenda (files pred &key sort)
;; `org-ql--query' uses `org-element-headline-parser' by default, which we then map ;; `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. ;; `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 ;; NOTE: `org-element-headline-parser' should remain the low-level action function, because the
@ -105,18 +103,18 @@ When nil, buffers are widened before being searched."
;; not find any data to sort on). IOW we have to call `org-agenda-ng--format-element' here, not ;; not find any data to sort on). IOW we have to call `org-agenda-ng--format-element' here, not
;; pass it to lower functions. ;; pass it to lower functions.
(declare (indent defun)) (declare (indent defun))
(let* ((entries (mapcar #'org-agenda-ng--format-element ;; I think it's reasonable to use `eval' here.
(org-ql--query files (let* ((entries (->> (eval `(org-ql ',files
pred ,pred
:sort sort :sort ,sort
:action-fn #'org-agenda-ng--add-markers))) :markers t))
(result-string (s-join "\n" entries)) (mapcar #'org-agenda-ng--format-element)
(target-buffer (get-buffer-create "test-agenda-ng"))) (s-join "\n")))
(target-buffer (get-buffer-create "test-agenda-ng"))
(inhibit-read-only t))
(with-current-buffer target-buffer (with-current-buffer target-buffer
(read-only-mode -1)
(erase-buffer) (erase-buffer)
(insert result-string) (insert entries)
(read-only-mode 1)
(pop-to-buffer (current-buffer)) (pop-to-buffer (current-buffer))
(org-agenda-finalize)))) (org-agenda-finalize))))

View file

@ -43,7 +43,7 @@ buffer. In this case, ACTION should return an Org element."
;; headline element, which --add-markers works with. On the other hand, ;; headline element, which --add-markers works with. On the other hand,
;; maybe this should be on the agenda-ng side. ;; maybe this should be on the agenda-ng side.
(->> ,action (->> ,action
org-agenda-ng--add-markers))) org-ql--add-agenda-markers)))
('nil `(lambda () ('nil `(lambda ()
,action)))) ,action))))
`(org-ql--query ,buffers-or-files `(org-ql--query ,buffers-or-files
@ -61,9 +61,24 @@ buffer. In this case, ACTION should return an Org element."
;;;; Functions ;;;; Functions
(cl-defun org-ql--query (buffers-or-files pred-body &key action narrow sort) (cl-defun org-ql--query (buffers-or-files query &key action narrow sort)
"FIXME: Add docstring." "Return items matching QUERY in BUFFERS-OR-FILES.
;; MAYBE: Set :narrow t for buffers and nil for files.
QUERY is an `org-ql' query sexp.
ACTION is a function which is called on each matching entry, with
point at the beginning of its heading. For example,
`org-element-headline-parser' may be used to parse an entry into
an Org element (note that it must be called with a limit
argument, so a lambda must be used to do so). Also see
`org-ql--add-agenda-markers', which may be used to add markers
compatible with Org Agenda code.
If NARROW is non-nil, buffers are not widened.
SORT is either nil, in which case items are not sorted; or one or
a list of defined `org-ql' sorting methods: `date', `deadline',
`scheduled', `todo', and `priority'."
(declare (indent defun)) (declare (indent defun))
(let* ((sources (pcase buffers-or-files (let* ((sources (pcase buffers-or-files
(`nil (list (current-buffer))) (`nil (list (current-buffer)))
@ -77,7 +92,7 @@ buffer. In this case, ACTION should return an Org element."
(> #'>) (> #'>)
(<= #'<=) (<= #'<=)
(>= #'>=)) (>= #'>=))
,pred-body)))) ,query))))
(action (byte-compile action)) (action (byte-compile action))
;; 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)
@ -101,41 +116,17 @@ buffer. In this case, ACTION should return an Org element."
;; Sort items ;; Sort items
(pcase sort (pcase sort
(`nil items) (`nil items)
(`(function ,_)
;; Custom sort function
(funcall sort items))
((guard (and sort ((guard (and sort
(setq sort (-list sort)) (setq sort (-list sort))
(cl-loop for elem in sort (cl-loop for elem in sort
always (memq elem '(date deadline scheduled todo priority))))) always (memq elem '(date deadline scheduled todo priority)))))
;; Default sorting functions ;; Default sorting functions
(org-ql--sort-by items sort)) (org-ql--sort-by items sort))
(_ (user-error "SORT must be either a function, or one or a list of the defined sorting methods (see documentation)"))))) (_ (user-error "SORT must be either nil, or one or a list of the defined sorting 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.
Or, when possible, fix the problem."
(cl-flet ((check (symbol)
(cl-case symbol
('done (unless org-done-keywords
;; NOTE: This check needs to be done from within the Org buffer being checked.
(error "Variable `org-done-keywords' is nil. Are you running this from an Org buffer?")))
('habit (unless (featurep 'org-habit)
(require 'org-habit))))))
(cl-loop for elem in form
if (consp elem)
do (progn
(check (car elem))
(org-ql--sanity-check-form (cdr elem)))
else do (check elem))))
(cl-defun org-ql--select (&key predicate action narrow) (cl-defun org-ql--select (&key predicate action narrow)
;; FIXME: Docstring "Return results of mapping function ACTION across entries in current buffer matching function PREDICATE.
"Return positions of entries in current buffer matching PREDICATE. If NARROW is non-nil, buffer will not be widened."
Headings should return non-nil for any ANY-PREDS and nil for all
NONE-PREDS. If NARROW is non-nil, buffer will not be widened
first."
;; Cache `org-today' so we don't have to run it repeatedly.
(org-ql--fmap ((category #'org-ql--category-p) (org-ql--fmap ((category #'org-ql--category-p)
(date #'org-ql--date-plain-p) (date #'org-ql--date-plain-p)
(deadline #'org-ql--deadline-p) (deadline #'org-ql--deadline-p)
@ -161,6 +152,38 @@ first."
collect (funcall action) collect (funcall action)
while (outline-next-heading)))))) while (outline-next-heading))))))
;;;;; Helpers
(defun org-ql--add-agenda-markers (element)
"Return ELEMENT with Org Agenda marker text properties added.
ELEMENT should be an Org element like that returned by
`org-element-headline-parser'. This function should be called
from within ELEMENT's buffer. It calls `org-agenda-new-marker',
which see."
(let* ((marker (org-agenda-new-marker (org-element-property :begin element)))
(properties (--> (cadr element)
(plist-put it :org-marker marker)
(plist-put it :org-hd-marker marker))))
(setf (cadr element) properties)
element))
(defun org-ql--sanity-check-form (form)
"Signal an error if any of the forms in BODY do not have their preconditions met.
Or, when possible, fix the problem."
(cl-flet ((check (symbol)
(cl-case symbol
('done (unless org-done-keywords
;; NOTE: This check needs to be done from within the Org buffer being checked.
(error "Variable `org-done-keywords' is nil. Are you running this from an Org buffer?")))
('habit (unless (featurep 'org-habit)
(require 'org-habit))))))
(cl-loop for elem in form
if (consp elem)
do (progn
(check (car elem))
(org-ql--sanity-check-form (cdr elem)))
else do (check elem))))
;;;;; Predicates ;;;;; Predicates
(defun org-ql--category-p (&rest categories) (defun org-ql--category-p (&rest categories)