Refiling Trees to Files

As I was explaining in Part 2 of this essay series, shuffling org entries (subtrees) from one file to another is common, but sometimes an entry grows and deserves its own file. Org can refile or archive a subtree to a new file, however, these functions simply creates a new file and copies that subtree. Personally, what I really want, is to have a subtree become a proper org file.

For instance, take a headline title like: 

* Foobar Bling

And convert it to a file’s title like: 

#+TITLE: Foobar Bling

And convert tags too: 

* Foobar Bling        :first:second:

To become: 

#+tags: first, second

Same with properties in a drawer. Other aspects of a subtree, like its priority, clock logs, and DONE state, doesn’t really have an equivalent at the file-level, and personally, I’m not sure if I really care to keep that information.

Do you need this too? Do you want this? For the last year, I’ve been simply archiving, and then editing the resulting file manually, and I’ll admit that the amount of times I need this feature, editing manually isn’t too bad. But I started writing some simple helper functions, which grew to cover more and more use (or edge) cases (the following sections show the resulting functions and hacking enjoyment).

Note, You could create a wrapper function that simply calls org-archive-subtree to move a subtree to a new file (ask me if you want the details)1.

Get Subtree Components

Org has the ability to parse a file, and return its parts. When looking at a subtree, we have two primary functions, org-entry-properties and org-element-context. The first of these gives a nice summary of values that is often what we want. However, the org-element-context gives a lot of details, including buffer positions, allowing us to walk through its sub-parts.

Calling this context function returns a tuple, with the first element a symbol of the element’s type, and the second is a plist of its attributes (see the Emacs Lisp manual for details). For instance, acquiring the context while the point is on a header returns headline as the type, and something like this list of attributes: 

(:raw-value "Best Header Ever" :begin 221 :end 522 :pre-blank 0
 :contents-begin 301 :contents-end 522 :level 2 :priority nil
 :tags "foo" :todo-keyword "DONE" :todo-type done :post-blank 0
 :footnote-section-p nil :archivedp nil :commentedp nil
 :closed ... :deadline ... :scheduled ... :title "Best Header Ever")

Why yes, the ellipses do show where I trimmed it for brevity. Keep in mind, attributes like :deadline return a timestamp element, and others, like the :todo-keyword return a string with font properties.

The following org-subtree-metadata function uses the results of calling this org-element-context function, and call some helper functions to return a plist of the parts that I need in order to create a new Org file from the subtree. 

(defun org-subtree-metadata ()
  "Return a list of key aspects of an org-subtree. Includes the
following: header text, body contents, list of tags, region list
of the start and end of the subtree."
  (save-excursion
    ;; Jump to the parent header if not already on a header
    (when (not (org-at-heading-p))
      (org-previous-visible-heading 1))

    (let* ((context (org-element-context))
           (attrs   (second context))
           (props   (org-entry-properties)))

      (list :region     (list (plist-get attrs :begin) (plist-get attrs :end))
            :header     (plist-get attrs :title)
            :tags       (org-get-subtree-tags props)
            :properties (org-get-subtree-properties attrs)
            :body       (org-get-subtree-content attrs)))))

Get the Tags

As mentioned above, a colon-separated list of tags at the end of a section’s headline, needs to become a space-separated list at the end of the #+tags: entry in a file. Question, do we want to copy the inherited tags? In other words, does the refiling the third headline in this example: 

* First Headline             :foo:
** Second Headline           :bar:
*** Third Headline           :baz:

In other words, do we get just the baz tag, or all three? Perhaps we need a customization variable to determine whether we retrieve ALLTAGS or just TAGS from a call to org-entry-properties. 

(defun org-get-subtree-tags (&optional props)
  "Given the properties, PROPS, from a call to
`org-entry-properties', return a list of tags."
  (unless props
     (setq props (org-entry-properties)))
  (let ((tag-label (if org-get-subtree-tags-inherited "ALLTAGS" "TAGS")))
    (-some->> props
         (assoc tag-label)
         cdr
         substring-no-properties
         (s-split ":")
         (--filter (not (equalp "" it))))))

(defvar org-get-subtree-tags-inherited t
  "Returns a subtree's tags, and all tags inherited (from tags
  specified in parents headlines or on the file itself). Defaults
  to true.")

Let me mention that weird function, -some->> which, like the more familiar threading macro, ->>, will take the value of props and put it as the last value in the call to assoc, and then take the results of that expression, and pass it as the last value to cdr, etc. As soon as one of the values is nil, however, this function stops and returns nil, saving us from throwing an exception if no tag exists for the subtree.

Get the Properties from the Drawer

Look at a subtree’s list of properties in the property drawer, e.g. 

* Some Headline
:PROPERTIES:
:hello:    world
:DESCRIPTION: This could be pretty good
:END:

The function, org-element-context returns these properties when called on a headline, but spread out with all the other properties, for instance: 

( ... :todo-type done :DESCRIPTION "This could be pretty good" :HELLO "world" :title "Best Header Ever")

Note that properties we add in a drawer are uppercase, while standard properties are not. Let’s write a function to iterate over the context attributes, looking for uppercase properties, and gather them into a more useful list of lists: 

(defun org-get-subtree-properties (attributes)
  "Return a list of tuples of a subtrees properties where the keys are strings."

  (defun symbol-upcase? (sym)
    (let ((case-fold-search nil))
      (string-match-p "^:[A-Z]+$" (symbol-name sym))))

  (defun convert-tuple (tup)
    (let ((key (first tup))
          (val (second tup)))
      (list (substring (symbol-name key) 1) val)))

  (->> attributes
       (-partition 2)                         ; Convert plist to list of tuples
       (--filter (symbol-upcase? (first it))) ; Remove lowercase tuples
       (-map 'convert-tuple)))

Get the Subtree Contents

Org offers functions for getting key aspects of your file (like org-heading-components), however, it does not offer a function for acquiring the contents of a subtree (without gathering the property drawer and whatnot). The following function returns what I consider a subtree’s contents by walking through a parsed version of the Org elements.

When given the headline attributes, we jump to what it considers the beginning of its contents (which I expect is just the next line). Next, we call org-element-context to walk down the org elements until we get to the real content.

But as we see each component element, how do we decide what element belongs to a subtree’s header (obviously headline is) as opposed to the body (for instance, paragraph or list-item)? The org-element-all-elements variables lists everything, and here I place header-specific elements in a list, header-components, and use the member function to see determine if I need to skip over it (by jumping to that element’s :end location).

After skipping over all header elements, I’m left at the beginning of the subtree’s contents, and use buffer-substring to return those contents: 

(defun org-get-subtree-content (attributes)
  "Return the contents of the current subtree as a string."
  (let ((header-components '(clock diary-sexp drawer headline inlinetask
                             node-property planning property-drawer section)))

      (goto-char (plist-get attributes :contents-begin))

      ;; Walk down past the properties, etc.
      (while
          (let* ((cntx (org-element-context))
                 (elem (first cntx))
                 (props (second cntx)))
            (when (member elem header-components)
              (goto-char (plist-get props :end)))))

      ;; At this point, we are at the beginning of what we consider
      ;; the contents of the subtree, so we can return part of the buffer:
      (buffer-substring-no-properties (point) (org-end-of-subtree))))

Create the Destination File

The function org-refile-subtree-to-file takes a directory destination and moves the subtree section to a new file there. 

(defun org-refile-subtree-to-file (dir)
  "Archive the org-mode subtree and create an entry in the
directory folder specified by DIR. It attempts to move as many of
the subtree's properties and other features to the new file."
  (interactive "DDestination: ")
  (let* ((props      (org-subtree-metadata))
         (head       (plist-get props :header))
         (body       (plist-get props :body))
         (tags       (plist-get props :tags))
         (properties (plist-get props :properties))
         (area       (plist-get props :region))
         (filename   (org-filename-from-title head))
         (filepath   (format "%s/%s.org" dir filename)))
    (apply #'delete-region area)
    (org-create-org-file filepath head body tags properties)))

However, the heavy lifting of the previous function is actually done by org-create-org-file, which given all the information it needs, creates a new org file. Note: This doesn’t get rid of auto-insert, so while the file is new, we still need to update the file. 

(defun org-create-org-file (filepath header body tags properties)
  "Create a new Org file by FILEPATH. The contents of the file is
pre-populated with the HEADER, BODY and any associated TAGS."
  (find-file-other-window filepath)
  (org-set-file-property "TITLE" header t)
  (when tags
    (org-set-file-property "tags" (s-join " " tags)))

  ;; Insert any drawer properties as #+PROPERTY entries:
  (when properties
    (goto-char (point-min))
    (or (re-search-forward "^\s*$" nil t) (point-max))
    (--map (insert (format "#+PROPERTY: %s %s" (first it) (second it))) properties))

  ;; My auto-insert often adds an initial headline for a subtree, and in this
  ;; case, I don't want that... Yeah, this isn't really globally applicable,
  ;; but it shouldn't cause a problem for others.
  (when (re-search-forward "^\\* [0-9]$" nil t)
    (replace-match ""))

  (delete-blank-lines)
  (goto-char (point-max))
  (insert "\n")
  (insert body))

File Name from Title

I need to programmatically choose a good filename to place the contents. Sure, I would like to take the section’s header, however, what should I do with something like, Let's go Shopping! … in this case, I’ll convert all the non-alphanumeric characters to dashes and lowercase everything: 

(defun org-filename-from-title (title)
  "Creates a useful filename based on a header string, TITLE.
For instance, given the string:    What's all this then?
     This function will return:    whats-all-this-then"
  (let* ((no-letters (rx (one-or-more (not alphanumeric))))
         (init-try (->> title
                        downcase
                        (replace-regexp-in-string "'" "")
                        (replace-regexp-in-string no-letters "-"))))
    (string-trim init-try "-+" "-+")))

Set Properties

Using auto-insert to pre-populate a file is great, so I need a way to make sure certain lines are set correctly, and if not, insert them: 

(defun org-set-file-property (key value &optional spot)
  "Make sure file contains a top-level, file-wide property.
KEY is something like `TITLE' or `tags'. This function makes
sure that the property contains the contents of VALUE, and if the
file doesn't have the property, it is inserted at either SPOT, or
if nil,the top of the file."
  (save-excursion
    (goto-char (point-min))
    (let ((case-fold-search t))
      (if (re-search-forward (format "^#\\+%s:\s*\\(.*\\)" key) nil t)
          (replace-match value nil nil nil 1)

        (cond
         ;; if SPOT is a number, go to it:
         ((numberp spot) (goto-char spot))
         ;; If SPOT is not given, jump to first blank line:
         ((null spot) (progn (goto-char (point-min))
                             (re-search-forward "^\s*$" nil t)))
         (t (goto-char (point-min))))

        (insert (format "#+%s: %s\n" (upcase key) value))))))

I think I spent a bit too much time worry about text that can be easily manipulated afterwards. Well, now I can finish my workflow.

Projects

Good, big, chewy projects may start life as a single idea in incubate but when they outgrow that file, they need to be moved to their own org file in the projects directory. 

(defun org-refile-to-projects-dir ()
  "Move the current subtree to a file in the `projects' directory."
  (interactive)
  (org-refile-subtree-to-file org-default-projects-dir))

Completed projects need to be moved out of the projects directory. This could be:

  • technical : where complicated notes can help with ongoing maintenance
  • personal : need to remember personal information about the project
  • projects/trophies : seems like an apt name for a done directory

Sounds like a job for dired, eh?

Technical Folder

The technical folder contains any notes on non-work, non-personal information. The idea with this box is that I can share it publicly. 

(defun org-refile-to-technical-dir ()
  "Move the current subtree to a file in the `technical' directory."
  (interactive)
  (org-refile-subtree-to-file org-default-technical-dir))

Personal Folder

Any thing remembered or referenced goes into a file in the personal folder. Each of these files end with a .txt extension so that Dropbox can display it on my mobile device. However, I still want Emacs to render it as an org file, so my Yasnippet template for files in this directory looks like: 

--org--
#+TITLE:  $1
#+AUTHOR: Howard Abrams
#+EMAIL:  howard.abrams@gmail.com
#+tags:   personal $2

$0

We need an auto insert for anything in that directory to expand that snippet. 

(define-auto-insert "/personal/*\\.org" ["personal.org" ha/autoinsert-yas-expand])

Where ha/autoinsert-yas-expand deletes any existing file contents and then calls yas-expand-snippet: 

(defun ha/autoinsert-yas-expand()
  "Replace text in yasnippet template. This compensates for a
bug(?) in the `yas-expand-snippet' function where it doesn't
delete the current contents of the specified region (like the
entire buffer that was inserted)."
  (let ((template (buffer-string)))
    (delete-region (point-min) (point-max))
    (yas-expand-snippet template)))

Now, we just need a helper function for throwing subtrees into new files in that directory: 

(defun org-refile-to-personal-dir ()
  "Move the current subtree to a file in the `personal' directory."
  (interactive)
  (org-refile-subtree-to-file org-default-personal-dir))

Summary

Whew. Is automatically polishing the archiving/refiling of a subtree to its own file worth this amount of code? I think I will keep it as something extra and use it with: 

(require 'boxes-extras)

Footnotes:

1

Since you asked, here is the code that I used earlier, before refactoring to the code you see in this essay.

The trick is simply to define the destination by setting the value of the variable, org-archive-location, and then calling org-archive-subtree: 

(defun ha/org-refile-subtree-as-file (dir)
  "Archive the org-mode subtree and create an entry in the directory folder specified by DIR.
The formatting, since it is an archive, isn't quite what I want,but it gets it going."
  (let* ((header (substring-no-properties (org-get-heading)))
         (title (if (string-match ": \\(.*\\)" header)
                    (match-string 1 header)
                  header))
         (filename (replace-regexp-in-string "\s+" "-" (downcase title)))
         (filepath (format "%s/%s.org" dir filename))
         (org-archive-location (format "%s::" filepath)))
    (org-archive-subtree)
    (find-file-other-window filepath)))