This commit is contained in:
Adam Porter 2018-05-10 15:38:44 -05:00
parent 9147c891a1
commit 146772af67
2 changed files with 45 additions and 21 deletions

View file

@ -9,7 +9,7 @@ Here's an example of generating a kind of agenda view for today (note that the g
(and (or (date :date '= (org-today))
(date :deadline '<= (+ org-deadline-warning-days (org-today)))
(date :scheduled '<= (org-today)))
(not (apply #'todo org-done-keywords-for-agenda))))
(not (done))))
#+END_SRC
[[screenshot.png]]
@ -37,7 +37,7 @@ Here are some other examples:
(and (or (date :date '= (org-today))
(date :deadline '<=)
(date :scheduled '<= (org-today)))
(not (apply #'todo org-done-keywords-for-agenda)))
(not (done)))
(and (todo "DONE" "CANCELLED")
(date :closed '= (org-today)))))
@ -46,7 +46,7 @@ Here are some other examples:
(and (or (date '= (org-today))
(deadline '<=)
(scheduled '<= (org-today)))
(not (apply #'todo org-done-keywords-for-agenda)))
(not (done)))
(and (todo "DONE" "CANCELLED")
(closed '= (org-today)))))
#+END_SRC
@ -59,17 +59,26 @@ Another way to look at it is like a "query language" for Org buffers. For examp
(org-ql org-agenda-files
(and (todo "SOMEDAY")
(tags "Emacs")
(priority >= "B")))
(priority >= "B"))) ;; => ((headline (:raw-value "org-board" :begin 1220270 :end 1220403 ...)) ...)
(org-ql "~/org/main.org"
(and (or (tags "Emacs")
(priority >= "B"))
(not (done))))
(not (done)))) ;; => (((headline (:raw-value "Now" :begin 3832 :end 3843 ...))) ...)
(org-ql "~/org/main.org"
(and (or (tags "Emacs")
(priority >= "B"))
(done)))
(done))
:action-fn (lambda (element)
(org-element-property :begin element))) ;; => (44154 46469 56008 63965 100008 ...)
(mapcar (lambda (element)
(org-element-property :begin element))
(org-ql "~/org/main.org"
(and (or (tags "Emacs")
(priority >= "B"))
(done)))) ;; => (44154 46469 56008 63965 100008 ...)
#+END_SRC
Instead of opening an agenda-like buffer with matching entries, =org-ql= could take a function as an argument that would be called at each matching entry to return a result, and finally it would return a list of the results. For example, you could return a list of positions within the buffer, or a list of headings, or headings with entry contents, etc.
Instead of opening an agenda-like buffer with matching entries, =org-ql= can take a function as an argument that is called at each matching entry to return a result, and finally it returns a list of the results. For example, you could return a list of positions within the buffer, or a list of headings, or headings with entry contents, etc. By default, the matching element is returned, which is the result of calling =org-element-headline-parser= at that entry.

View file

@ -47,20 +47,32 @@
(symbol-function ,target)))
,@body))
(cl-defmacro org-agenda-ng (files &rest pred-body)
(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 ,files
:pred (byte-compile (lambda ()
,@pred-body))))
`(org-agenda-ng--agenda ,files
(byte-compile (lambda ()
,pred-body))
#'org-agenda-ng--format-element))
(cl-defmacro org-ql (files pred-body &key (action-fn (lambda (element) (list element))))
"Find entries in 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
of calling `org-element-headline-parser' at each matching entry."
(declare (indent defun))
`(org-ql--query ,files
(byte-compile (lambda ()
,pred-body))
#',action-fn))
;; TODO: Return different kinds of results for org-ql? i.e. maybe it
;; shouldn't always open an agenda-like view; maybe it should return a
;; list of positions or propertized strings instead.
(defalias 'org-ql 'org-agenda-ng)
;;;; Commands
(cl-defun org-agenda-ng--agenda (&key files pred)
;; 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-ql--query (files pred action-fn)
(setq files (cl-typecase files
(null (list (buffer-file-name (current-buffer))))
(list files)
@ -68,11 +80,14 @@
(mapc 'find-file-noselect files)
(let* ((org-use-tag-inheritance t)
(org-scanner-tags nil)
(org-trust-scanner-tags t)
(entries (-flatten (--map (with-current-buffer (find-buffer-visiting it)
(mapcar #'org-agenda-ng--format-element
(org-trust-scanner-tags t))
(-flatten-n 1 (--map (with-current-buffer (find-buffer-visiting it)
(mapcar action-fn
(org-agenda-ng--filter-buffer :pred pred)))
files)))
files))))
(cl-defun org-agenda-ng--agenda (files pred action-fn)
(let* ((entries (org-ql--query files pred action-fn))
(result-string (org-agenda-finalize-entries entries 'agenda))
(target-buffer (get-buffer-create "test-agenda-ng")))
(with-current-buffer target-buffer