[O] macro for iterating over headings and "doing things" with them

[Eric Abrahamsen]

Hi all,

Recently, with the help of emacs.help, I wrote a small macro called
`org-iter-headings' (essentially a thin wrapper around
`org-element-map') for iterating over the child headings in a subtree,
and "doing something" with them. It's meant to be a quick-and-dirty,
*scratch*-buffer convenience function, for when you have some regular
data in a series of sibling headings, and want to use that data in a
one-off way. So anything from mail merges, to quick collections of
property values, to launching more complex per-heading processes.

You call the macro on a subtree's parent, and the body of the macro is
executed once for each child heading. In the macro body, the dynamic
variables `head', `item', `todo', `tags', `log-items' and `body-pars'
are bound appropriately (see the docstring below).

For example, I occasionally evaluate a batch of manuscripts for a
publishing house. Each child heading is a manuscript: the heading text
is the title, the todo either "ACCEPT" or "REJECT", with my reasons in
the todo state log. I might this information to the publishing house by
calling the following on the parent heading:

(let ((buf (get-buffer-create "*temp output*")))
  (with-current-buffer buf
    (erase-buffer))
  (org-iter-headings
    (with-current-buffer buf
      (insert
       (format
        "Title: %s\nMy recommendation: %s, reasons as follows:\n\n%s\n\n\n"
                
        item (capitalize (cdr todo))
        ;; Get the most recent state log, and insert all its paragraphs
        ;; but the first one.
        (mapconcat #'identity (cdar log-items) "\n")))))
  (compose-mail "address@hidden" 
                "Manuscript evaluation" )
  (message-goto-body)
  (insert-buffer-substring buf))


For things you do regularly, you might as well write a proper function
using `org-element-map'. But for one-offs, this can be a lot easier to
manage.

I guess I might stick this on Worg, depending on how useful people think
it might be.

Enjoy,
Eric


(defmacro org-iter-headings (&rest body)
  "Run BODY forms on each child heading of the heading at point.

This is a thin wrapper around `org-element-map'. Note that the former
will map over the heading under point as well as its children; this
function skips the heading under point, and *only* applies to the
children. At present it ignores further nested headline. If you have a
strong opinion on how to customize handling of nested children, please
contact the author.

Within the body of this macro, dynamic variables are bound to
various parts of the heading being processed:

head: The full parsed heading, as an Org element. Get your
property values here.

item: The text (ie :raw-value) of the heading.

todo: The heading's todo information, as a cons of the todo
type (one of the symbols 'todo or 'done) and the todo keyword as
a string.

tags: The heading's tags, as a list of strings.

log-items: If org-log-into-drawer is true, and the drawer is
present, then this variable will hold all the list items from the
log drawer. Specifically, each member of `log-items' is a further
list of strings, containing the text of that item's paragraphs.
Not the paragraphs as parsed org structures, just their text. If
org-log-into-drawer is false, any state logs or notes will be
found in body-pars.

body-pars: A list of all the paragraphs in the heading's body text;
\"paragraphs\" are understood however `org-element-map'
understands them.

tree: This holds the entire parsed tree for the subtree being
operated on.


This macro returns a list of whatever value the final form of
BODY returns."
  `(call-org-iter-headings
    (lambda (tree head item todo tags log-items body-pars) ,@body)))

(defun call-org-iter-headings (thunk)
  (save-restriction
    (org-narrow-to-subtree)
    (let ((tree (org-element-parse-buffer))
          (log-spec org-log-into-drawer)
          (first t)
          returns)
      (setq
       returns
       (org-element-map tree 'headline
         (lambda (head)
           ;; Skip the first headline, only operate on children. Is
           ;; there a less stupid way of doing this?
           (if first
               (setq first nil)
             (let ((item (org-element-property :raw-value head))
                   (todo (cons
                          (org-element-property :todo-type head)
                          (org-element-property :todo-keyword head)))
                   (tags (org-element-property :tags head))
                   (log-items
                    (org-element-map
                        (org-element-map head 'drawer
                          ;; Find the first drawer called
                          ;; \"LOGBOOK\", or whatever.
                          (lambda (d)
                            (when (string=
                                   (if (stringp log-spec)
                                       log-spec "LOGBOOK")
                                   (org-element-property :drawer-name d))
                              d))
                          nil t)
                        ;; Map over the items in the logbook
                        ;; list.
                        'item
                      (lambda (i)
                        ;; Map over the paragraphs in each
                        ;; item, and collect the text.
                        (org-element-map i 'paragraph
                          (lambda (p)
                            (substring-no-properties
                             (org-element-interpret-data
                              (org-element-contents p))))))))
                   (body-pars (org-element-map head 'paragraph
                                (lambda (p)
                                  (substring-no-properties
                                   (org-element-interpret-data
                                    (org-element-contents p))))
                                nil nil '(headline drawer))))
               ;; Break the log item headings into their own
               ;; paragraph.
               (setq log-items
                     (mapcar
                      (lambda (ls)
                        (if (string-match-p "\\\\\\\\" (car ls))
                            (append (split-string (car ls) "\\\\\\\\\n")
                                    (cdr ls))))
                      log-items))
               (funcall thunk tree head item todo tags log-items body-pars))))))
      (delq nil returns))))