[O] Conditionally archiving to subtree or archive file (depending on parent ARCHIVE property)

[Christopher Allan Webber]

Hi all,

I've written a snippet of elisp which I'm finding very helpful.  I've
replaced the archive keybinding with it.  Basically, I found that when I
had something like this:

#+BEGIN_SRC org
  * Task tree
    :PROPERTIES:
    :ARCHIVE: %s_archive::* Task tree
    :END:

  ** TODO Some task
  *** TODO Some subtask
  *** DONE Another subtask
  
  ** DONE This is done
#+END_SRC

... on something like "This is done", I'd want that whole tree moved to
the archive file.  On something like "some task", if I eventually
finished the whole tree, I wanted it moved to the archive file, but if I
had subtasks within that subtree, I might want to move them out of the
way, but not have them disappear from the bigger subtask... that would
be confusing!  So I wanted them to move to the archive subtree so I
could clean up that bigger TODO structure, like so:


#+BEGIN_SRC org
  * Task tree
    :PROPERTIES:
    :ARCHIVE: %s_archive::* Task tree
    :END:

  ** TODO Some task
  *** TODO Some subtask
  *** Archive               :ARCHIVE:
  **** DONE Another subtask
#+END_SRC


But I wanted this logic to happen automatically.  So I wrote some
trivial elisp to do this.  Maybe someone else will find it helpful?

#+BEGIN_SRC emacs-lisp
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

(defun org-archive-subtree-depending-on-property ()
  "Conditionally archive the subtree to a file or archive sibling
If the parent subtree has an ARCHIVE property, archive to a file.
Otherwise, archive to an archive sibling.
"
  (interactive)
  (let* ((current-level (org-current-level))
         (parent-archive-property
          (if current-level
              (save-excursion
                (org-up-heading-safe)
                (org-entry-get (point) "ARCHIVE")))))
    (cond
     ; If there is no current level, do nothing
     ((not current-level) nil)
     ; If we're at the first level, subtree archive it
     ((or (eq current-level 1)
          (not parent-archive-property))
      (let ((org-archive-default-command 'org-archive-to-archive-sibling))
        (org-archive-subtree-default-with-confirmation)))
     ; Otherwise, archive to a file
     (t
       (let ((org-archive-default-command 'org-archive-subtree))
         (org-archive-subtree-default-with-confirmation))))))
#+END_SRC