This library contains anything I may find specifically useful when working with Org Mode files, which I use constantly both in my regular workflow and as a literate programming tool.
This package tries as much as possible to play nicely with the dash.el package. Where possible, the last argument in a function is the input that is “operated on,” meaning it is, in the judgement of the author, the most likely argument to be passed in via a threading macro like ->>. This may clarify some choices.
For instance, function signatures that may otherwise naturally include keyword arguments must work around the cl-defun convention of putting keywords after positional arguments. Such functions may, therefore, include an argument containing keyword-like options in a plist in order to ensure that the last argument is positional (and likely to be passed in via a threading macro).
Where such an accomodation is more trouble than it’s worth, you may still see some work done to make the function work with composition operators like -partial and -flip.
;;; pg-org.el --- Customizations to org-mode
;; Copyright (C) 2022 Phil Groce
;; Author: Phil Groce <[email protected]>
;; Version: 0.4.8
;; Package-Requires: ((emacs "26.1") (org-ml "5.7") (dash "2.19") (s "1.12") (ts "0.3") (pg-ert "0.1"))
;; Keywords: productivity(eval-when-compile (require 'cl-macs))
(require 'org-ml)
(require 'org-clock)
(require 'dash)
(require 's)
(require 'ts)The ts time library has functions for parsing Org timestamp strings and elements. Building Org timestamp strings and elements from ts structures is also fairly easy, but functions for doing so are provided in Listing src/ts in order to further simplify the process.
(defun pg-org--ts-to-tuple (include-tod ts-elem)
(--> ts-elem
(if include-tod
(list (ts-year it) (ts-month it) (ts-day it))
(list
(ts-year it) (ts-month it) (ts-day it)
(ts-hour it) (ts-minute it)))))
(defun pg-org-build-timestamp-from-ts (options ts-elem)
"Create an Org timestamp element representing the same time as TS-ELEM.
OPTIONS is a plist of optional parameters. The keywords for
this plist can be :active, :repeater, and :warning. The
semantics of these options are identical to the active,
repeater, and warning arguments to
`org-ml-build-timestamp!'. Additionally, the option
:include-tod, if supplied, indicates to include the hours and
minutes from TS-ELEM in the output.
Note that nil is a valid, empty plist, and may be supplied if
none of these options are to be used."
(let ((ts-tuple (pg-org--ts-to-tuple (plist-get options :include-tod)
ts-elem)))
(org-ml-build-timestamp! ts-tuple
:active (plist-get options :active)
:repeater (plist-get options :repeater)
:warning (plist-get options :warning))))
(defun pg-org-build-timestamp-range-from-ts (options ts-elem-start ts-elem-end)
"Create an Org timestamp range from TS-ELEM-START and
TS-ELEM-END. For the semantics of OPTIONS, see
`pg-org-build-timestamp-from-ts'."
(let ((start (pg-org--ts-to-tuple (plist-get options :include-tod)
ts-elem-start))
(end (pg-org--ts-to-tuple (plist-get options :include-tod)
ts-elem-end)))
(org-ml-build-timestamp! start
:end end
:active (plist-get options :active)
:repeater (plist-get options :repeater)
:warning (plist-get options :warning))))
The tests for the timestamp functions above are in Listing t/ts.
<<src/ts>>
(ert-deftest pg-org/timestamp-from-ts ()
(cl-letf* (((symbol-function '>should)
(lambda (i o)
(should (string-equal (org-ml-to-trimmed-string i) o))))
(t-1 (ts-parse "2022-01-27 08:18:19 -0500"))
(t-0 (ts-adjust 'year -2 t-1)))
(>should (pg-org-build-timestamp-from-ts nil t-0)
"[2020-01-27 Mon 08:18]")
(>should (pg-org-build-timestamp-from-ts '(:active t) t-0)
"<2020-01-27 Mon 08:18>")
(>should (pg-org-build-timestamp-from-ts '(:warning (all 1 day)) t-0)
"[2020-01-27 Mon 08:18 -1d]")
(>should (pg-org-build-timestamp-range-from-ts '(:active t) t-0 t-1)
"<2020-01-27 Mon 08:18>--<2022-01-27 Thu 08:18>")))
(pg-ert-run-tests-string "pg-org/timestamp-from-ts")
Document keywords, such #+STARTUP and #+TITLE are somewhat cumbersome to access, relative to their utility. These functions streamline that access.
The document keywords are properties on the very first section node in the document. As such, these functions require that their argument be an org-data node.
(defun pg-org-get-all-keyword-nodes (org-data-node)
"Get all Org document keyword nodes that are children of ORG-DATA-NODE."
;; The keyword nodes live on the first section node in the org-data node.
(if (org-ml-is-type 'org-data org-data-node)
(->> org-data-node
(org-ml-get-children)
(first)
(org-ml-get-children)
(--filter (org-ml-is-type 'keyword it)))
(error "org-element node is not org-data type")))
(defun pg-org-get-keyword-nodes (key org-data-node)
"Returns a list of the keyword nodes with KEY as the :key
property, if any such nodes exists as a child of
ORG-DATA-NODE. KEY is case-insensitive."
(--filter
(and (org-ml-is-type 'keyword it)
(s-equals? (org-ml-get-property :key it) (upcase key)))
(pg-org-get-all-keyword-nodes org-data-node)))
(defun pg-org-get-keyword-node (key org-data-node)
"Get the first keyword node element in ORG-DATA-NODE with KEY as
key, for the common case where only one keyword definition is
expected/useful."
(first (pg-org-get-keyword-nodes key org-data-node)))
(defun pg-org-get-keyword-values (key org-data-node)
"Return the values (i.e., the values of the :value property) of
the keyword nodes with KEY as the :key property, if any such
nodes exists as a child of ORG-DATA-NODE. KEY is
case-insensitive."
(--map (org-ml-get-property :value it)
(pg-org-get-keyword-nodes key org-data-node)))
(defun pg-org-get-keyword-value (key org-data-node)
"Get the value of the first keyword node element in ORG-DATA-NODE
with KEY as key, for the common case where only one keyword
definition is expected/useful."
(->> (pg-org-get-keyword-values key org-data-node)
(first)))
(defun pg-org-get-keyword-keys (org-data-node)
"Get all the strings used as keys in document keyword nodes in ORG-DATA-NODE."
(--map (org-ml-get-property :key it)
(pg-org-get-all-keyword-nodes org-data-node)))
(defun pg-org-get-keywords-alist (org-data-node)
"Get the keywords associated with the Org document in
ORG-DATA-NODE as an alist. Note that, as is the case with Org
keywords, alists can have multiple entries for a single key."
(--map (cons (org-ml-get-property :key it) (org-ml-get-property :value it))
(pg-org-get-all-keyword-nodes org-data-node)))
;; TODO: Broken
;; (defun pg-org-set-keyword (key value org-data-node)
;; "Return ORG-DATA-NODE with keyword KEY updated to have value
;; VALUE. If a keyword for KEY exists, its value is updated. If it
;; does not exist, a new keyword for KEY is added as the first child
;; of ORG-DATA-NODE, with VALUE as its value.
;; This function should not be used if a keyword has or should have
;; multiple values."
;; ;; TODO: The keyword should probably be added in an appropriate
;; ;; place in the list of children, not at the end.
;; (let ((new-kw (org-ml-build-keyword key value))
;; (old-kw (pg-org-get-keyword key org-data-node)))
;; (if old-kw
;; ;; Update keyword in place
;; (org-ml-map-children*
;; (--map (if (and (org-ml-is-type 'keyword it)
;; (s-equals? key (org-ml-get-property :key it)))
;; new-kw
;; it)
;; it)
;; org-data-node)
;; ;; Add new keyword
;; (let ((new-children (cons new-kw (org-ml-get-children org-data-node))))
;; (org-ml-set-children new-children org-data-node)))))
Being able to easily operate on blocks comes up during testing, and also in workflows where the Org file is being treated like an executable notebook. (See also: Jupyter Notebook)
It should be easy to generalize this to all Org blocks, or even all named elements. I’m not inclined to do that right now, but the names of all the org elements types are in org-element-all-elements in org-element.el. (Not all of those can be named, however.)
(defmacro pg-org-with-src (block-name &rest body)
"Put the text in the source block BLOCK-NAME in a temp buffer,
then execute BODY in that buffer."
(declare (indent 1))
(let ((-src (make-symbol "-src")))
`(cl-flet ((-assert (msg arg) (if (eq nil arg) (error msg) arg)))
(let ((,-src
(->> (org-ml-parse-this-buffer)
(org-ml-match
'(:any * (:and
src-block
(:name ,(symbol-name block-name)))))
(-assert (format "No src block %s" ,(symbol-name block-name)))
(car)
(org-ml-get-property :value))))
;; Put the source block in a separate buffer and run the code in body
(with-temp-buffer
(insert ,-src)
,@body)))))
(defmacro pg-org-with-src-doc (block-name &rest body)
"Parse the text in the org-mode source block BLOCK-NAME into an
org-element tree and run BODY. Code in BODY can refer to the
org-element tree via the symbol `doc'."
(declare (indent 1))
`(lexical-let ((doc (pg-org-with-src ,block-name
(org-unescape-code-in-region (point-min) (point-max))
(org-do-remove-indentation)
(org-mode)
(org-ml-parse-this-buffer))))
,@body))(TODO: TEST!!!)
Speaking of testing, here’s a convenience macro for using ert-deftest with pg-org-with-src-doc.
(defmacro pg-org-deftest (test-name block-name &rest body)
"Use `pg-org-with-src-doc' to parse BLOCK-NAME into an
org-element tree, then define an ERT test named TEST-NAME (using
`ert-deftest') whose body is BODY."
(declare (indent 2))
`(pg-org-with-src-doc ,block-name
(ert-deftest ,test-name () ,@body)))Source blocks, like all Org blocks, have a lot of meta-info. Within an Org document, this information can be obtained programmatically by running org-babel-get-src-block-info. When editing the code in a source block, the same data is available from the local variable org-src--babel-info. (This value is populated once when the buffer is created and never updated, so changes to either the header or body of the block will not be reflected.)
The data structure itself is a list with the following elements. The names of these elements are my invention, as none of this seems to be documented anywhere else; I am reverse-documenting from the definition of org-babel-get-src-block-info.
lang- The language of the source block
body- The body of the source block as a (big) string.
properties- A plist [fn::I think? It’s often accessed in code with
assq] containing all the properties of the source block. Keys are:results,:exports,:tangle,:hlines,:noweb,:cache, and:session. If a property is not defined, this list contains the default/inherited value. switches- The string containing the switches associated with this source block. According to the documentation, ” \[s]witches provide finer control of the code execution, export, and format”. Use of switches is demonstrated in Literal Examples. If no switches are defined, this value is the empty string.
name- If the block is named (e.g., with
#+NAME:), this is the name. If no name is supplied, this is(?) the empty string. beg- The buffer position beginning this element, as from the
:post-affiliatedproperty of the Org Element API. ref- The “\[f]ormat string used to write labels in current block,” i.e., the value of the
:label-refproperty if supplied, or the default/inherited value otherwise.
There seems to be no official API access to this data via Org mode. The following function pg-org-src-info-get provides such an access method, but until Org mode makes this part of the public API it could break without notice.
(defun pg-org-src-info-get (item &optional src-block)
"Access ITEM in the org-src-block either at point (if in an Org
file) or associated with the buffer (for the edit buffer of an
org-src block). If SRC-BLOCK is supplied, it is used instead."
(let ((info (or src-block
(if (org-src-edit-buffer-p)
org-src--babel-info
(org-babel-get-src-block-info)))))
(cl-case item
(:lang (nth 0 info))
(:body (nth 1 info))
(:properties (nth 2 info))
(:switches (nth 3 info))
(:name (nth 4 info))
(:begin (nth 5 info))
(:label-ref (nth 6 info)))))It’s also helpful sometimes to be able to access an edit buffer’s “parent” buffer. This is also not supported directly, but it is possible. The local variables org-src--beg-marker and org-src--end-marker (both ostensibly private, of course) are markers referring to the beginning and end of the source block in the parent buffer. One can therefore use marker-buffer to get the buffer.
(defun pg-org-src-parent-buffer ()
"If in an Org Src edit buffer, return a reference to the parent
buffer. If not, emit an error."
(if (org-src-edit-buffer-p)
(marker-buffer org-src--beg-marker)
(error "Cannot get parent buffer: Not in Org Src edit buffer")))org-ml has a regular convention for its constructors; for each element type t, a corresponding org-ml object can be created using org-ml-t. Since lisp code is data, and since there are Org-ml builders for every org element type, this means we use these constructors as a kind of simplified DSL for specifying Org documents or, more powerfully, templates.
As an example, consider Listing ex/org-ml-build/1/code, which is code for building a very simple document with one headline. If name is “Phil”, this will generate the Org document in ex/org-ml-build/1/results.
(defun hello-org (name)
(list (org-ml-build-section
(org-ml-build-headline
:title (format "Hello %s!" name)
(org-ml-build-section
(org-ml-build-paragraph! "Hi there!"))))))* Hello Phil
Hi there!
There is a lot of duplication in the nested calls to org-ml-build-* functions; it would be nice to remove that. But beyond that, imagine treating that set of build calls as a template, as in Listing ex/org-ml-build/2/code.
(let ((hello-org-template
'(org-ml-build-section
(org-ml-build-headline :title name)))
(name "Phil"))
(eval hello-org-template))Lisp is beautiful. Perhaps, however, it can be made moreso. There’s a lot of duplication in hello-org-template, ideally it could be written as it is in Listing ex/org-ml-build/3/code.
(let ((hello-org-template
'(section (headline :title name)))
(name "Phil"))
(eval hello-org-template))We can’t, of course, pass hello-org-template to eval as we have done here. But if we precede that evaluation with a transformation of hello-org-template to restore the org-ml-build- prefix, we certainly can. This is the purpose of pg-org-build.
(defun pg-org--ml-build-spec (spec)
"Build the input to `org-ml-build' from `spec'."
(pg-util-tree-transform-2
spec
:transformer
(lambda (node)
(let ((head (car node)))
(cond
;; Return list un-transformed. The elements of this list will
;; still be transformed.
((listp head)
`(:node (list ,@node)))
((not (symbolp head))
(error "Unexpected non-symbol %s" head))
((eq head 'quote)
`(:node ,node :stop t))
(t
(let* ((new-name (format "org-ml-build-%s" (symbol-name head)))
(new-sym (intern-soft new-name)))
(if (not new-sym)
(error "Void function: %s" new-name)
`(:node ,(cons new-sym (cdr node)))))))))))
(defun pg-org-ml-build (spec)
"Transform SPEC into an org-element tree using constructors for
elements in `org-ml'.
All that is done to transform SPEC is that the first element of
every list is prepended with \"org-ml-build-\" if it is a
symbol. SPEC's format, then, is that of a tree of lists whose
first elements are symbols representing element types; the rest
of the elements are the arguments used to construct an element
type using org-ml's corresponding \"org-ml-build-*\"
corresponding to that symbol. A SPEC for a headline element, for
instance, might be:
'(headline :title (secondary-string! \"foo\")
(section (paragraph! \"paragraph text\")))
This function will convert that specification into the result of
calling:
(org-ml-build-headline
:title (org-ml-build-secondary-string! \"foo\")
(org-ml-build-section
(org-ml-build-paragraph! \"paragraph text\")))
Literal org-element nodes can be spliced into SPEC by wrapping
them in a quote, like so:
;; paragraph contains a literal org-element of a paragraph
`(headline :title (secondary-string! \"foo\")
(section ,(quote paragraph)))
"
(eval (pg-org--ml-build-spec spec)))
(defalias 'org-ml-build 'pg-org-ml-build)
The code in Listing ex/org-ml-build/4 demonstrates the usage of pg-org-ml-build.
<<src/org-ml-build>>
(pg-org-ml-build '(timestamp! '(2019 1 1 0 0)))Many children of headlines can be useful to work with from the headline itself. This is especially true in org-ml-match, where it is often convenient to select a headline based on features of its children.
Headline node properties–meaning the key-value pairs stored in the PROPERTIES drawer of the headline–are simply lists of keys and their associated values. Unlike a dictionary or hashtable structure, keys can be stored multiple times, both with and without different capitalization. Consider Example ex/node-properties/pathological, for example. The headline titled Buffalo? has seven properties named with the word “buffalo.” Some are capitalized differently, some are not. Some are exact duplicates, others are not.
* Buffalo?
:PROPERTIES:
:BUFFALO: BUFFALO
:BUFFALO: BUFFALO
:buffalo: buffalo
:Buffalo: Buffalo
:BuffalO: BuffalO
:Buffalo: Buffalo
:BuffalO: Buffal0
:END:
Bison.
The org-ml-headline-get-node-proeprty and org-ml-headline-set-node-property work simply and well for the common case where there is a single entry for a property. They do not account for multiple properties with the same key, and they work only in a case-sensitive way. If multiple values are set for a property, the getter will get the first property in order from the top, and the setter will update the same property, or insert a new property if none exist. They also do not indicate when multiple values exist. So these functions work, and are very easy to use, but do not give the user a good sense of the state of the property list except that the property being retrieved or set is, in some sense, now one of the properties.
At the price of simplicity, the pg-org-headline-get-node-property and pg-org-headline-set-node-property functions provide more complete guarantees about the state of the property list, by treating it as a multi-valued dictionary. Updating operations can be done with or without respect to case, at the user’s option.
The order of items in the property drawers is sorted lexicographically by key when the properties are modified. This may unnecessarily move some properties around, but it ensures that the list is returned in a predictable state, even if values for a given key are in various parts of the list.
#+name src/node-properties
(defun pg-org-headline-get-node-property (case-sensitive? key headline)
"Return a list of all values of property with KEY in HEADLINE, or nil if not found.
If CASE-SENSITIVE? is nil, test for key equality with KEY
irrespective of case.
Contrast with `org-ml-headline-get-node-property', which returns
only the first value found and is case sensitive."
(let ((props (org-ml-headline-get-node-properties headline)))
(->> props
(--filter (let ((k (org-ml-get-property :key it)))
(if case-sensitive?
(string-equal k key)
(string-equal (downcase k) (downcase key)))))
(--map (org-ml-get-property :value it)))))
(defun pg-org-headline-set-node-property (case-sensitive? action key values headline)
"Set node properties for KEY to VALUES in HEADLINE.
If CASE-SENSITIVE? is nil, test for key equality with KEY irrespective of case.
If ACTION is the symbol replace, any preexisting properties on
HEADLINE with KEY will be removed. (I.e., the set of values in
VALUES will replace the ones currently in HEADLINE.) For other
values of ACTION, preexisting values will be left alone. Note
that CASE-SENSITIVE? will affect how key equality is determined,
and thus which keys will be replaced.
The returned headline will have all properties returned in
lexicographically sorted order."
(cl-letf* ((orig-key key)
(key (if case-sensitive? key (downcase key)))
;; Function to use for comparing properties for key
;; equality
((symbol-function 'key-equal)
(lambda (prop)
(let ((other-key (org-ml-get-property :key prop)))
(if case-sensitive?
(string-equal key other-key)
(string-equal key (downcase other-key))))))
;; Function to use for comparing keys for sorting.
;;
;; n.b.: When we're sorting the list of properties, we
;; DON'T want to observe case-sensitive?; that's just for
;; setting the values.
((symbol-function 'key-lessp)
(lambda (this that)
(string-lessp (org-ml-get-property :key this)
(org-ml-get-property :key that))))
;; New properties to add to headline
;; n.b.: Build value props with original-case key
(added-props (--map (org-ml-build-node-property orig-key it) values))
;; Properties to retain from headline
(existing-props
(--> (org-ml-headline-get-node-properties headline)
(if (eq action 'replace)
(-remove #'key-equal it)
it)))
;; Properties in their final form
(new-props (sort
(-flatten-n 1 (list added-props existing-props))
#'key-lessp)))
(org-ml-headline-set-node-properties new-props headline)))
Several Org-ML functions related to headlines require the user to supply a logging configuration, specifying which drawer is the logbook drawer and whether to put clocks in the drawer. There are lots of good reasons for that. Perhaps the best is that the rules for determining a headline’s logging configuration depend on context like a node’s inherited properties; for a function operating on fragments of Org trees in isolation, there is no way to conclude what those are with any certainty. Passing the configuration also removes a source of side-effects, making the functions more generally useful.
All that said, these configurations seldom change for most people. An interface that hides the configuration information is clearer and, for most uses, quite adequate. For those who with to trade some possible inaccuracy and purity for simplicity, this package provides a set of complementary functions to those in Org-ML for handling headline contents and logbooks that don’t require the user to pass configuration information. Instead, custom variable holds this information; proxy functions use this variable for configuration information. No other changes are made, both because they aren’t required, and to facilitate switching over to the more fundamental functions if necessary.
Org-ML defines one more function in this category, org-ml-headline-logbook-convert-config, which doesn’t make sense to proxy here for obvious reasons.
(defun pg-org--build-logging-config ()
`(:log-into-drawer ,(org-log-into-drawer)
:clock-into-drawer ,(org-clock-into-drawer)))
;; Supercontents
(defun pg-org-headline-get-supercontents (headline)
"Use `org-ml-headline-get-supercontents' to return the
supercontents of HEADLINE."
(org-ml-headline-get-supercontents
(pg-org--build-logging-config) headline))
(defun pg-org-headline-set-supercontents (supercontents headline)
"Use `org-ml-headline-set-supercontents' to set the
supercontents of HEADLINE."
(org-ml-headline-set-supercontents
(pg-org--build-logging-config) supercontents headline))
(defun pg-org-headline-map-supercontents (fun headline)
"Use `org-ml-headline-map-supercontents' to map the
supercontents of HEADLINE."
(org-ml-headline-map-supercontents
(pg-org--build-logging-config) fun headline))
;; Logbook items
(defun pg-org-headline-get-logbook-items (headline)
"Use `org-ml-headline-get-logbook-items' to pull logbook items
off HEADLINE."
(org-ml-headline-get-logbook-items
(pg-org--build-logging-config)
headline))
(defun pg-org-headline-set-logbook-items (items headline)
"Use `org-ml-headline-set-logbook-items' to set logbook items
for HEADLINE."
(org-ml-headline-set-logbook-items
(pg-org--build-logging-config)
items
headline))
(defun pg-org-headline-map-logbook-items (fun headline)
"Use `org-ml-headline-map-logbook-items' to set logbook items
for HEADLINE."
(org-ml-headline-map-logbook-items
(pg-org--build-logging-config)
fun
headline))
;; Logbook clocks
(defun pg-org-headline-get-logbook-clocks (headline)
"Use `org-ml-headline-get-logbook-clocks' to pull logbook clocks
off HEADLINE."
(org-ml-headline-get-logbook-clocks
(pg-org--build-logging-config)
headline))
(defun pg-org-headline-set-logbook-clocks (clocks headline)
"Use `org-ml-headline-set-logbook-clocks' to set logbook clocks
for HEADLINE."
(org-ml-headline-set-logbook-clocks
(pg-org--build-logging-config)
clocks
headline))
(defun pg-org-headline-map-logbook-clocks (fun headline)
"Use `org-ml-headline-map-logbook-clocks' to set logbook clocks
for HEADLINE."
(org-ml-headline-map-logbook-clocks
(pg-org--build-logging-config)
fun
headline))
;; Contents
(defun pg-org-headline-get-contents (headline)
"Use `org-ml-headline-get-contents' to return the contents of
HEADLINE."
(org-ml-headline-get-contents
(pg-org--build-logging-config) headline))
(defun pg-org-headline-set-contents (contents headline)
"Use `org-ml-headline-set-contents' to set the contents of
HEADLINE."
(org-ml-headline-set-contents
(pg-org--build-logging-config) contents headline))
(defun pg-org-headline-map-contents (fun headline)
"Use `org-ml-headline-map-contents' to map the contents of
HEADLINE."
(org-ml-headline-map-contents
(pg-org--build-logging-config) fun headline))
;; Other logbook
(defun pg-org-headline-logbook-append-item (item headline)
"Use `org-ml-headline-append-item' to return the contents
of HEADLINE."
(org-ml-headline-logbook-append-item
(pg-org--build-logging-config) item headline))
(defun pg-org-headline-logbook-append-open-clock (unixtime note headline)
"Use `org-ml-headline-logbook-append-open-clock' to add an open
clock into the logbook of HEADLINE."
(org-ml-headline-logbook-append-open-clock
(pg-org--build-logging-config) unixtime headline))
(defun pg-org-headline-logbook-close-open-clock (unixtime note headline)
"Use `org-ml-headline-logbook-close-open-clock' to close an
open clock in the logbook of HEADLINE."
(org-ml-headline-logbook-close-open-clock
(pg-org--build-logging-config) unixtime note headline))
Syntactically, a logbook is just a drawer containing an itemized list of entries, and that’s the only interface Org-ML provides to it, with some limited exceptions Semantically, it’s an event log. The following code provides an interface for working with logbooks that considers it at that level.
A logbook has the structure shown in Listing ex/logbook-structure: A drawer containing a plain-list and a set of items. The items are frequently formatted specially as well.
#+name ex/logbook-structure
(drawer
(plain-list
(item (paragraph))
(item (paragraph))
(item (paragraph))))(defun pg-org-logbook (&optional post-blank)
"Create a new, empty logbook drawer as an Org element. If
POST-BLANK is non-nil, the drawer will be created with a
`post-blank' value of 1."
(if post-blank
(org-ml-build-drawer (org-log-into-drawer) :post-blank 1)
(org-ml-build-drawer (org-log-into-drawer))))
;; Constructors
(defun pg-org-logbook-from-plain-list (plain-list)
"Create a logbook using `pg-org-logbook', whose child is
PLAIN-LIST."
(->> (pg-org-logbook)
(org-ml-set-children (list plain-list))))
(defun pg-org-logbook-from-items (items)
"Create a logbook using `pg-org-logbook-from-plain-list',
containing ITEMS in its enclosed list."
(let ((plain-list (->> (org-ml-build-plain-list)
(org-ml-set-children items))))
(pg-org-logbook-from-plain-list plain-list)))
(defun pg-org-logbook-from-paragraphs (paragraphs)
"Create a logbook using `pg-org-logbook-from-items', with each
paragraph in PARAGRAPH enclosed in an item."
(->> (--map (org-ml-build-item it) paragraphs)
(pg-org-logbook-from-items)))
(defun pg-org-logbook-from-strings (strings)
"Create a logbook using `pg-org-logbook-from-paragraphs', with
each string in STRINGS enclosed in a paragraph element."
(->> (--map (org-ml-build-paragraph! it) strings)
(pg-org-logbook-from-paragraphs)))
;; Accessors
(defun pg-org-logbook-get-plain-list (logbook)
"Get the contents of LOGBOOK as a plain-list Org element."
(->> (org-ml-get-children logbook)
(nth 0)))
(defun pg-org-logbook-get-items (logbook)
"Get the contents of LOGBOOK as a list of item elements."
(->> (pg-org-logbook-get-plain-list logbook)
(org-ml-get-children)))
(defun pg-org-logbook-get-paragraphs (logbook)
"Get the contents of LOGBOOK as a list of paragraph elements."
(--map (->> (org-ml-get-children it)
(nth 0))
(pg-org-logbook-get-items logbook)))
(defun pg-org-logbook-get-strings (logbook)
"Get the contents of LOGBOOK as a list of strings."
(->> (pg-org-logbook-get-paragraphs logbook)
(-map #'org-ml-to-trimmed-string)))
;; Mutators
(defun pg-org-logbook-prepend-item (item logbook)
"Return new logbook based on LOGBOOK with ITEM prepended to the
beginning (top) of the list of items."
(->> (pg-org-logbook-get-items logbook)
(cons item)
(pg-org-logbook-from-items)))
(defun pg-org-logbook-prepend-paragraph (paragraph logbook)
"Return new logbook with PARAGRAPH wrapped in an item element
and prepended to the plain-list in LOGBOOK using
`pg-org-logbook-prepend-item'."
(pg-org-logbook-prepend-item (org-ml-build-item! paragraph) logbook))
(defun pg-org-logbook-prepend-string (s logbook)
"Return new logbook with S wrapped in a paragraph element and
prepended to LOGBOOK using
`pg-org-logbook-prepend-paragraph'. S is enclosed in a
paragraph using `org-ml-build-paragraph!', so formatting can be
used in the string."
(pg-org-logbook-prepend-paragraph (org-ml-build-paragraph! s) logbook))
(defun pg-org-logbook-prepend-secondary-string (ss logbook)
"Return new logbook with SS wrapped in a paragraph element and
item and prepended to LOGBOOK using
`pg-org-logbook-prepend-item'."
(->> (org-ml-build-item)
(org-ml-item-set-paragraph ss)
(funcall (-flip #'pg-org-logbook-prepend-item) logbook)))
The logbook functions are tested in Listing t/logbook.
<<src/logbook>>
(ert-deftest pg-org/logbook ()
(let* ((item-1-str "I *1*")
(item-2-str "I 2")
(strings (list item-1-str item-2-str))
(paragraphs (-map #'org-ml-build-paragraph! strings))
(items (-map #'org-ml-build-item paragraphs))
(item-3-str "I =3=")
(item-3-sec-str (org-ml-build-secondary-string! item-3-str))
(item-3-paragraph (org-ml-build-paragraph! item-3-str))
(item-3-item (org-ml-build-item item-3-paragraph))
(expected-logbook (pg-org-ml-build
`(drawer
"LOGBOOK"
(plain-list
(item (paragraph! ,item-1-str))
(item (paragraph! ,item-2-str))))))
(expected-logbook-prepended (pg-org-ml-build
`(drawer
"LOGBOOK"
(plain-list
(item (paragraph! ,item-3-str))
(item (paragraph! ,item-1-str))
(item (paragraph! ,item-2-str)))))))
;; Builders
(should (equal (org-ml-build-drawer "LOGBOOK") (pg-org-logbook)))
(should (equal expected-logbook
(pg-org-logbook-from-strings strings)))
(should (equal expected-logbook
(pg-org-logbook-from-items items)))
(should (equal expected-logbook
(pg-org-logbook-from-paragraphs paragraphs)))
;; Accessors
(should (equal strings
(pg-org-logbook-get-strings expected-logbook)))
(should (equal items
(pg-org-logbook-get-items expected-logbook)))
(should (equal paragraphs
(pg-org-logbook-get-paragraphs expected-logbook)))
;; Mutators
(should (equal expected-logbook-prepended
(pg-org-logbook-prepend-string
item-3-str
expected-logbook)))
(should (equal expected-logbook-prepended
(pg-org-logbook-prepend-paragraph
item-3-paragraph
expected-logbook)))
(should (equal expected-logbook-prepended
(pg-org-logbook-prepend-item
item-3-item
expected-logbook)))
(should (equal expected-logbook-prepended
(pg-org-logbook-prepend-secondary-string
item-3-sec-str
expected-logbook)))))
(pg-ert-run-tests-string "pg-org/logbook")Org-ML provides two ways to get logbook items from a headline. The official way is via org-ml-headline-get-logbook-items, which takes the user’s logging configuration into account. A proxy for this function that doesn’t burden the caller with supplying configuration information is in Listing src/logging-configuration.
It is also straightforward to get logbook entries using the org-ml-match interface. The pg-org-headline-logbook-entries function in Listing src/headline-logbook-entries uses this method to return a headline’s logbook entries. Despite not requiring the configuration info plist, it honors the :log-into-drawer value set in pg-org-headline-logging-config.
The other major change in this function is that it returns the paragraph element associated with each logbook item, not the item element. This is often more convenient when the user merely wants to read the logbook. The functions defined in Listing src/headline-logbook-entries are more suitable to general-purpose use of the logbook, including manipulation or synthesis of lists of logbook items.
(defun pg-org-headline-logbook-entries (headline)
"Given a headline org element, return its logbook entries as a
list of paragraph elements. If the headline doesn't contain any
logbook entries, return `nil'."
(let ((drawer-name (org-log-into-drawer)))
(->> headline
(org-ml-match
'(section
(:and drawer (:drawer-name drawer-name))
plain-list
item
paragraph)))))The pg-org-headline-logbook-entries function is tested using the sample Org input in Listing input/logbook-simple. Listing t/headline-logbook-entries shows how the function can be used to rapidly consume the entries in the logbook.
#+seq_todo: TODO DOING(@) BLOCKED(@) | DONE(@)
* DOING Rewire the security system
:PROPERTIES:
:ASSIGNEE: Bart Starr
:END:
:LOGBOOK:
- Top entry
- Middle entry
- Very first entry
:END:
<<src/headline-logbook-entries>>
(require 's)
(pg-org-deftest pg-org/headline-logbook-entries input/logbook-simple
(let* ((entries (->> doc
(org-ml-match '(headline))
(car)
(pg-org-headline-logbook-entries)))
(entry-strings (-map #'org-ml-to-trimmed-string entries)))
(should (s-equals-p (nth 0 entry-strings) "Top entry"))
(should (s-equals-p (nth 1 entry-strings) "Middle entry"))
(should (s-equals-p (nth 2 entry-strings) "Very first entry"))
(should (eq (nth 0 (nth 0 entries)) 'paragraph))
(should (eq (nth 0 (nth 1 entries)) 'paragraph))
(should (eq (nth 0 (nth 2 entries)) 'paragraph))))
(pg-ert-run-tests-string "pg-org/headline-logbook-entries")
When configured to do so, Org will log changes between to-do keywords into the logbook. These logbook entries have a specific text format, but to Org it’s still a single secondary string. This code parses that string and recovers the juicy data inside.
(defcustom pg-org--rx-logbook-status-change
(rx "State"
(+ whitespace)
"\"" (group (+ (not "\""))) "\""
(+ whitespace)
"from"
(+ whitespace)
"\"" (group (+ (not "\""))) "\"")
"Regex matching log entries of to-do state transitions, per the
default state format string in
`org-log-note-headings'. Capturing accomplishments will break
if that entry in `org-log-note-headings' is changed. (As will
large chunks of org-agenda.) In that case, it will be necessary
to customize this regex to correspond."
:type 'regexp
:group 'pg-org)A previous version of this function lived in pm.org and took item elements instead of paragraph elements. This function works better with the output of the new and improved pg-org-headline-logbook-entries, however.
(defun pg-org-paragraph-parse-status-change (para)
"If PARA is a logbook entry that looks like it was generated
when a to-do item's status changed, parse it and return a list of
the state it was changed to (as a string), the state it was
changed from (as a string), the timestamp, and an org paragraph
element representing any additional notes provided by the
user. Otherwise, return nil."
(-when-let* [((_ _ s ts . the-rest) para)
;; parse out the to and from states
((_ from to) (->> (org-ml-to-trimmed-string s)
(s-match pg-org--rx-logbook-status-change)))
;; if notes exist, create as new paragraph
(notes (->> (if (org-ml-is-type 'line-break (nth 0 the-rest))
;; trick to inline (cdr the-rest) as args
(let ((para-objs (-map (lambda (x) `(quote ,x)) (cdr the-rest))))
(eval `(org-ml-build-paragraph ,@para-objs)))
;; no additional notes == empty paragraph
(org-ml-build-paragraph))
(org-ml-remove-parents)))]
(list to from (org-ml-remove-parents ts) notes)))The pg-org-paragraph-parse-status-change function is tested in Listing t/paragraph-parse-status-change, using input from Listing input/logbook-status-changes.
#+seq_todo: TODO DOING(@) BLOCKED(@) | DONE(@)
* DOING Rewire the security system
:PROPERTIES:
:ASSIGNEE: Bart Starr
:END:
:LOGBOOK:
- State "DOING" from "BLOCKED" [2021-12-11 Sat 20:06] \\
Back on the case
- State "BLOCKED" from "DOING" [2021-12-11 Sat 20:05] \\
Waiting on parts from the supplier
- State "DOING" from "TODO" [2021-12-11 Sat 20:04] \\
In process, it's harder than it looks
- Not a status update
:END:
Note that pg-org-paragraph-parse-status-change returns nil if the parse fails, so the spurious additional item in the input is ignored.
(TODO: I think this test is broken? Look at it more later.)
<<src/paragraph-parse-status-change>>
(require 'ts)
(pg-org-deftest pg-org/paragraph-parse-status-change
input/logbook-status-changes
(let ((entries (->> doc
(org-ml-match '(headline))
(car)
(pg-org-headline-logbook-entries)
(-keep #'pg-org-paragraph-parse-status-change))))
(pg-ert-shouldmap
entries
'(("BLOCKED" "DOING" "[2021-12-11 Sat 20:06]"
"Back on the case")
("DOING" "BLOCKED" "[2021-12-11 Sat 20:05]"
"Waiting on parts from the supplier")
("TODO" "DOING" "[2021-12-11 Sat 20:046]"
"In process, it's harder than it looks"))
(-let (((act-to act-from act-ts act-notes) act)
((exp-to exp-from exp-ts exp-notes) exp))
(equal act-to exp-to)
(equal act-from exp-from)
(ts= (ts-parse-org-element act-ts) (ts-parse-org exp-ts))
(string-equal (org-ml-to-trimmed-string act-notes) exp-notes)))))
(pg-ert-run-tests-string "pg-org/paragraph-parse-status-change")
The org-ml-match function is very powerful, including a generalized :pred function that can match on a user-supplied predicate. Match predicates take a single argument representing the node currently being evaluated, and return t if the node should match, for whatever definition the predicate uses.
One limitation of org-ml-match predicates is a lack of a “lookahead” capability: There’s no natural way to select a node based on the properties of the nodes it contains. One can build predicates that, themselves, call org-ml-match on a node to find matching child nodes, but this is inconvenient for ad-hoc matching.
The following is a way around that limitation. pg-org-match-lookahead takes a set of org-ml-match criteria κ and returns a predicate that applies those criteria to the node under consideration–meaning, it’s a predicate that asserts that there exists one or more child nodes beneath the current node that match κ.
* Foo
** Tasks
* Bar
** Tasks
* Baz
** Tasks
* Additional notes
For example, consider the task of matching only the headlines in Listing ex/lookahead/1 that contain subheadings for tasks. As can be seen in Listing ex/lookahead/1.1 the match criteria (headline (:and headline (:raw-value "Tasks"))) will match the subheads, but not the tasks. (It is sometimes possible to backtrack to an ancestor from a child node, but not always and not reliably.)
(pg-org-with-src-doc ex/lookahead/1
(->> doc
(org-ml-match '(headline (:and headline (:raw-value "Tasks"))))
(-map #'org-ml-remove-parents)))Using a lookahead predicate, however, it is possible to get the result we want, as in Listing ex/lookahead/1.2.
(defun my-task-predicate (node)
(org-ml-match '((:and headline (:raw-value "Tasks"))) node))
(pg-org-with-src-doc ex/lookahead/1
(->> doc
(org-ml-match '((:and headline (:pred my-task-predicate))))
(-map #'org-ml-remove-parents)))The tradeoff here is obviously recursion, but the maximum recursion should be the maximum depth of the document tree, absent chicanery in the predicate like searching on a node’s parent.
<<sct-gp-lookahead>>
Listing src/lookahead shows a generalized function for returning a lookahead-style match predicate. It’s a simple partial application of org-ml-match.
(defun pg-org-lookahead (match-criteria)
"Return a function that takes an org-element node and runs
`org-ml-match' on it using MATCH-CRITERIA as the match
criteria. Returns a true value if the match returns results,
else `nil'."
(-partial #'org-ml-match match-criteria))This function is not as useful as we might wish, because the value of :pred must be a symbol, not an actual function. So the code in Listing ex/lookahead/2.1, for example doesn’t work.
;; This doesn't work....
(pg-org-with-src-doc ex/lookahead/1
(->> doc
(org-ml-match `((:and headline
(:pred ,(pg-org-lookahead
'(:and headline (:raw-value "Tasks")))))))
(-map #'org-ml-remove-parents)))It can, however, be used somewhat awkwardly with cl-letf, as shown by the test in Listing t/lookahead.
<<src/lookahead>>
(pg-org-deftest pg-org/lookahead
ex/lookahead/1
(cl-letf* (((symbol-function 'has-tasks)
(lambda (el)
(pg-org-lookahead
'((:and headline (:raw-value "Tasks"))))))
(results (org-ml-match '((:and headline (:pred has-tasks))) doc)))
(pg-ert-shouldmap results '("Foo" "Bar" "Baz")
(string-equal (org-ml-get-property :raw-value act) exp))))
(pg-ert-run-tests-string "pg-org/lookahead")This construct adds considerably to the complexity of an org-match call, but enables a powerful way of searching and selecting nodes in a document. The pg-org-match function presents this power while hiding ythe complexity.
Using the cl-letf trick described in Section sct-gp-lookahead, we can write a macro that extends org-ml-match with some new functionality.
First, we can implement a :lookahead selector that takes match criteria and applies it to the node using pg-org-lookahead using the cl-letf trick. That will simplify the org-ml-match call in Listing test-lookahead
to the code in Listing ex/match/lookahead.
(pg-org-match '((:and headline
(:lookahead
((:and headline
(:raw-value "Tasks"))))))
node)We can also extend the match syntax in a very powerful way, with anaphoric predicates. This would permit a user to specify a predicate as arbitrary code in the match criterion itself. Consider, for instance, a selector for all timestamps after a certain time. Currently, candidate timestamp elements would be selected with org-ml-match, then filtered. With an anaphoric predicate, this could be declared in a single match structure, as in Listing ex/match/anaphoric-pred/1.
;; Only timestamps from the last 7 days
(pg-org-match '((:and timestamp
(:-pred ((ts> (ts-parse-org-element el)
(ts-adjust 'day -7 (ts-now)))))))
node)Some of this logic could still be encapsulated in a function, as shown in Listing ex/match/anaphoric-pred/2. This increases readability and code reuse, as functions like timestamp-within-last could be used in many places.
;; Only timestamps from the last 7 days
(defun timestamp-within-last (num unit el)
(ts> (ts-parse-org-element el)
(ts-adjust unit num (ts-now))))
(pg-org-match '((:and timestamp (:-pred (timestamp-within-last 7 'day el))))
node)This would translate to the code in Listing ex/match/anaphoric-pred/3.
;; Only timestamps from the last 7 days
(defun timestamp-within-last (num unit el)
(ts> (ts-parse-org-element el)
(ts-adjust unit num (ts-now))))
(cl-letf* (((symbol-function 'a-predicate)
(lambda (el)
(timestamp-within-last 7 'day el))))
(pg-org-match '((:and timestamp (:pred a-predicate))) node))The main work of the pg-org-match macro is done in pg-org--match-build-pattern, which recursively traverses a match pattern, making some transformations as necessary to add our new functionality. The code for this function is in src/-match-build-pattern.
The input to pg-org--match-build-pattern is an org-ml-match pattern, augmented with the extensions implemented in pg-org-match. The output is a double (clauses pattern), which pattern is the original pattern transformed as necessary to enable our additional functionality, and clauses is a set of (symbol function) pairs. Using cl-letf and the org-ml-match :pred functionality, we can implement :lookahead and :-pred using only these additional functions and transformations.
One thing to note in pg-org-match-build-pattern is that :lookahead is implemented with pg-org-match itself, allowing the user to implement lookahead matches with :-pred and (though the utility seems questionable) :lookahead.
(defun pg-org--match-build-pattern (pattern)
;; Make this (-let (...) (case ...)) into a (pcase ...)?
(-let (((tok . rest) pattern))
(cl-case tok
;; The patterns we transform:
;; - :lookahead
(:lookahead
(progn
(-let* ((sym (gensym "lookahead-"))
(clause
`((symbol-function (quote ,sym))
(lambda (el) (pg-org-match (quote ,(car rest)) el))))
(new-pattern `(:pred ,sym)))
(list (list clause) new-pattern))))
;; - :-pred
(:-pred
(progn
(-let* ((sym (gensym "pred-"))
(clause
`((symbol-function (quote ,sym))
(lambda (el) ,(car rest))))
(new-pattern `(:pred ,sym)))
(list (list clause) new-pattern))))
;; unary prefixes; leave them unchanged and consume rest of the list
((:first :last :and :or :not)
(progn
(-let (((clauses rest-pattern) (pg-org--match-build-pattern rest)))
(list clauses (cons tok rest-pattern)))))
;; 2-ary prefixes
(:nth
(progn
(-let* (((x . rest) rest)
((clauses rest-pattern) (pg-org--match-build-pattern rest)))
(list clauses (-concat `(,tok ,x) rest-pattern)))))
;; 3-ary prefixes
(:sub
(progn
(-let* (((x y . rest) rest)
((clauses rest-pattern) (pg-org--match-build-pattern rest)))
(list clauses (-concat `(,tok ,x ,y) rest-pattern)))))
;; general case – if it's a list, modify it and consume the rest
;; of the list. If it's a symbol we don't need to modify, yield
;; it unchanged and consume the rest of the list.
(t
(cond
((listp tok)
;; Subpattern; get the clauses and new pattern associated
;; with it, and combine with the rest of the "horizontal"
;; pattern
(progn
(cond
;; base case
((eq nil tok)
'(nil nil))
;; descend into list
(t
(-let* (((cl1 p1) (pg-org--match-build-pattern tok))
((cl2 p2) (pg-org--match-build-pattern rest))
(new-clauses (-concat cl1 cl2))
(new-pattern (cons p1 p2)))
(list new-clauses new-pattern))))))
((symbolp tok)
(cond
;; Property name (or any other special form org-ml-match
;; handles)
((s-starts-with? ":" (symbol-name tok))
(progn
(message "[symbol] TOK: %s" tok)
(message "[symbol] REST: %s" rest)
(list nil `(,tok ,@rest))))
;; Element name
(t
(progn
(-let (((clauses pattern) (pg-org--match-build-pattern rest)))
(list clauses (cons tok pattern)))))))))
)))The pg-org--match-build-pattern function makes a lot of decisions. Listing t/-match-build-pattern/1 shows a unit test for basic functionality, demonstrating that the function can traverse the match structure non-destructively in the cases where it is just proxying org-ml-match.
<<src/-match-build-pattern>>
(ert-deftest pg-org/-match-build-pattern/1 ()
(cl-macrolet ((-? (test-form expected-value)
`(should (equal (pg-org--match-build-pattern ,test-form)
,expected-value))))
(-? '()
'(nil nil))
;; In case you're wondering, org-ml-match does this too
(should-error (pg-org--match-build-pattern 'headline))
(-? '(headline)
'(nil (headline)))
(-? '(:nth 2 headline)
'(nil (:nth 2 headline)))
(-? '(:sub 1 2 headline)
'(nil (:sub 1 2 headline)))
(-? '(:drawer-name "LOGBOOK")
'(nil (:drawer-name "LOGBOOK")))
(-? '(headline section paragraph)
'(nil (headline section paragraph)))
(-? '(:and (:nth 2 section) headline)
'(nil (:and (:nth 2 section) headline)))
(-? '(:and (:sub 1 2 section) headline)
'(nil (:and (:sub 1 2 section) headline)))
(-? '(:and headline (:drawer-name "LOGBOOK"))
'(nil (:and headline (:drawer-name "LOGBOOK"))))))
(pg-ert-run-tests-string "pg-org/-match-build-pattern/1")Testing our added functionality is more challenging, as it introduces code containing unique symbols created with gensym. We can still make assertions about the structure of the output, however, as shown in t/-match-build-pattern/2 and t/-match-build-pattern/3.
<<src/-match-build-pattern>>
(ert-deftest pg-org/-match-build-pattern/2 ()
(let ((output (pg-org--match-build-pattern '((:lookahead (headline))))))
(let* ((sym (eval (cadr (caaar output))))
(fn (cadaar output))
(expected-fn '(lambda (el) (pg-org-match '(headline) el)))
(expected `((((symbol-function (quote ,sym)) ,expected-fn)) ((:pred ,sym)))))
(should (symbolp sym)) ;; sym is quoted, so one more unboxing
(should (functionp fn))
(should (equal fn expected-fn))
(should (equal output expected)))))
(pg-ert-run-tests-string "pg-org/-match-build-pattern/2")<<src/-match-build-pattern>>
(ert-deftest pg-org/-match-build-pattern/3 ()
(let ((output (pg-org--match-build-pattern '((:-pred (equal (foo el) 1))))))
(let* ((sym (cadr (caaar output)))
(fn (cadaar output))
(expected-fn '(lambda (el) (equal (foo el) 1)))
(expected `((((symbol-function ,sym) ,expected-fn)) ((:pred ,sym)))))
(should (symbolp sym))
(should (functionp fn))
(should (equal fn expected-fn))
(should (equal output expected)))))
(pg-ert-run-tests-string "pg-org/-match-build-pattern/3")Listing src/match shows the very simple pg-org-match function. Clearly, all the heavy lifting is done in pg-org--match-build-pattern. This is the public entry point, however, so the function is well-documented.
(defmacro pg-org-match (pattern node)
"Match PATTERN against NODE, in the form of `org-ml-match', but with a more powerful extended syntax.
`pg-org-match' supports the following additional match patterns:
`(:lookahead SUBPATTERN)' runs a second `org-ml-match' on the
children of the current node, returning a true value if
SUBPATTERN matches any of the node's children. In other words, it
matches nodes based on the properties of the nodes' children. In
this way, one can, say, match headlines with a LOGBOOK drawer
with the following pattern:
(:and headline
(:lookahead (section (:and drawer
(:drawer-name \"LOGBOOK\")))))
`(:-pred CODE)' implements an anaphoric predicate. CODE is
interpreted as the body of a lambda expression, which is called
on a node using `(:pred ...)'. CODE may refer to the variable
`el', which is the element currently being considered. Thus, the
following code block:
(cl-letf ((fn (lambda (el)
(org-ml-headline-has-tag \"work\" el))))
(org-ml-match '((:pred fn)) node))
Is equivalent to this call to `pg-org-match':
(pg-org-match '((:-pred (org-ml-headline-has-tag \"work\" el))) node)
In all other respects, this function is equivalent to a call to
`org-ml-match'.
"
(-let (((clauses new-pattern) (pg-org--match-build-pattern pattern)))
`(cl-letf ,clauses
(org-ml-match ,new-pattern ,node))))In Listing t/match/1, we do one last white-box test of the macro to ensure that it generates the kind of code we expect.
<<src/-match-build-pattern>>
<<src/match>>
(ert-deftest pg-org/match/1 ()
(let* ((output (macroexpand-1
'(pg-org-match
((:-pred (org-ml-headline-has-tag "work" el))) node)))
(sym (cadr (caaadr output)))
(expected `(cl-letf
(((symbol-function ,sym) (lambda (el)
(org-ml-headline-has-tag "work" el))))
(org-ml-match ((:pred ,sym)) node))))
(should (symbolp sym))
(should (equal output expected))))
(pg-ert-run-tests-string "pg-org/match/1")
But will it blend? Let’s find out. Our input for these tests is in Listing input-pg-org-match/t.
#+seq_todo: TODO DOING(@) BLOCKED(@) | DONE(@)
* DOING Rewire the security system
:PROPERTIES:
:ASSIGNEE: Bart Starr
:END:
:LOGBOOK:
- State "DOING" from "BLOCKED" [2021-12-11 Sat 20:06] \\
Back on the case
- State "BLOCKED" from "DOING" [2021-12-11 Sat 20:05] \\
Waiting on parts from the supplier
- State "DOING" from "TODO" [2021-12-11 Sat 20:04] \\
In process, it's harder than it looks
- Not a status update
:END:
* TODO Something else to do
:PROPERTIES:
:ASSIGNEE: Johnny Unitas
:END:
The code in Listing t/match/2 demonstrates the usage of pg-org-match with the :lookahead matcher. The match is done at the headline level, but only the headline for “Rewire the security system” is selected because it contains a logbook.
<<src/-match-build-pattern>>
<<src/match>>
(pg-org-deftest pg-org/match/2
input/match
(let ((results (pg-org-match
'((:and headline
(:lookahead
(section
(:and drawer
(:drawer-name "LOGBOOK"))))))
(org-ml-remove-parents doc)
)))
(should (= (length results) 1))
(let ((result (car results)))
(should (equal (org-ml-get-type result) 'headline))
(should (equal (org-ml-get-property :raw-value result)
"Rewire the security system")))))
(pg-ert-run-tests-string "pg-org/match/2")The code in Listing t/match/3 exercises the :-pred matcher to search for a headline using a regular expression. The possibilities for :-pred are vast; (:lookahead) is simple to implement as (:-pred (pg-org-match pattern el)), for instance.
<<src/-match-build-pattern>>
<<src/match>>
(require 's)
(pg-org-deftest pg-org/match/2
input/match
(let ((results
(pg-org-match '((:and headline
(:-pred
(s-matches-p
"else"
(org-ml-get-property :raw-value el)))))
(org-ml-remove-parents doc))))
(should (= (length results) 1))
(let ((result (car results)))
(should (equal (org-ml-get-type result) 'headline))
(should (equal (org-ml-get-property :raw-value result)
"Something else to do")))))
(pg-ert-run-tests-string "pg-org/match/2")(provide 'pg-org)
;;; pg-org.el ends here