Skip to content

Instantly share code, notes, and snippets.

Last active March 10, 2024 13:24
Show Gist options
  • Save kepi/2f4acc3cc93403c75fbba5684c5d852d to your computer and use it in GitHub Desktop.
Save kepi/2f4acc3cc93403c75fbba5684c5d852d to your computer and use it in GitHub Desktop.
Hierarchical archiving for Org-mode
;; org-archive-subtree-hierarchical.el
;; version 0.2
;; modified from
;; modified from
;; In orgmode
;; * A
;; ** AA
;; *** AAA
;; ** AB
;; *** ABA
;; Archiving AA will remove the subtree from the original file and create
;; it like that in archive target:
;; * AA
;; ** AAA
;; And this give you
;; * A
;; ** AA
;; *** AAA
;; Install file to your include path and include in your init file with:
;; (require 'org-archive-subtree-hierarchical)
;; (setq org-archive-default-command 'org-archive-subtree-hierarchical)
(provide 'org-archive-subtree-hierarchical)
(require 'org-archive)
(defun org-archive-subtree-hierarchical--line-content-as-string ()
"Returns the content of the current line as a string"
(line-beginning-position) (line-end-position))))
(defun org-archive-subtree-hierarchical--org-child-list ()
"This function returns all children of a heading as a list. "
;; this only works with org-version > 8.0, since in previous
;; org-mode versions the function (org-outline-level) returns
;; gargabe when the point is not on a heading.
(if (= (org-outline-level) 0)
(outline-next-visible-heading 1)
(let ((child-list (list (org-archive-subtree-hierarchical--line-content-as-string))))
(while (org-goto-sibling)
(setq child-list (cons (org-archive-subtree-hierarchical--line-content-as-string) child-list)))
(defun org-archive-subtree-hierarchical--org-struct-subtree ()
"This function returns the tree structure in which a subtree
belongs as a list."
(let ((archive-tree nil))
(while (org-up-heading-safe)
(let ((heading
(line-beginning-position) (line-end-position))))
(if (eq archive-tree nil)
(setq archive-tree (list heading))
(setq archive-tree (cons heading archive-tree))))))
(defun org-archive-subtree-hierarchical ()
"This function archives a subtree hierarchical"
(let ((org-tree (org-archive-subtree-hierarchical--org-struct-subtree))
(this-buffer (current-buffer))
(file (abbreviate-file-name
(or (buffer-file-name (buffer-base-buffer))
(error "No file associated to buffer")))))
(setq location org-archive-location
afile (car (org-archive--compute-location
(or (org-entry-get nil "ARCHIVE" 'inherit) location)))
;; heading (org-extract-archive-heading location)
infile-p (equal file (abbreviate-file-name (or afile ""))))
(unless afile
(error "Invalid `org-archive-location'"))
(if (> (length afile) 0)
(setq newfile-p (not (file-exists-p afile))
visiting (find-buffer-visiting afile)
buffer (or visiting (find-file-noselect afile)))
(setq buffer (current-buffer)))
(unless buffer
(error "Cannot access file \"%s\"" afile))
(set-buffer buffer)
(goto-char (point-min))
(while (not (equal org-tree nil))
(let ((child-list (org-archive-subtree-hierarchical--org-child-list)))
(if (member (car org-tree) child-list)
(search-forward (car org-tree) nil t)
(setq org-tree (cdr org-tree)))
(goto-char (point-max))
(org-insert-struct org-tree)
(setq org-tree nil)))))
(when (not (eq this-buffer buffer))
(message "Subtree archived %s"
(concat "in file: " (abbreviate-file-name afile))))))
(defun org-insert-struct (struct)
(when struct
(insert (car struct))
(org-insert-struct (cdr struct))))
(defun org-archive-subtree ()
Copy link

Ypot commented Aug 26, 2019

When I try to archive using C-c C-x C-a, it says (Windows OS):
"Wrong type argument: commandp, org-archive-subtree"

Copy link

kepi commented Aug 26, 2019

What is value of your org-archive-default-command variable? And were your C-c C-x C-a binding leads? Here is my binding:

, s A runs the command org-archive-subtree-default, which is an autoloaded
interactive Lisp closure in ‘org-archive.el’.

It is bound to M-RET s A, M-m m s A, C-c C-x C-a, and many ordinary text


Archive the current subtree with the default command.
This command is set with the variable ‘org-archive-default-command’.

and variable:

org-archive-default-command is a variable defined in ‘org-archive.el’.
Its value is ‘org-archive-subtree-hierarchical
Original value was org-archive-subtree

Maybe you didn't include it correctly in your init file? Try something like

(require 'org-archive-subtree-hierarchical)
(setq org-archive-default-command 'org-archive-subtree-hierarchical)

Copy link

Ypot commented Aug 26, 2019

I am quite newbie, so I've tried adding those lines:

(require 'org-archive-subtree-hierarchical)
(setq org-archive-default-command 'org-archive-subtree-hierarchical)

I didn't modify any variable, just loaded your script, so I was using C-c C-x C-a because it is the default binding to "archive", it works if I don't try to improve it with your work.

After just adding your 2 lines I get this message:
"Symbol's function definition is void: org-archive--compute-location"

Copy link

kepi commented Aug 26, 2019

Is it possible you installed only org package without contrib part? Try to install package org-plus-contrib which contains org-archive.el and that should include your missing function. I'm not sure if it would help but its best fast guess.

I would definitely not call this "my work", to be hones, I barely understand the code, I just really depends on its functionality and need to fix it when it broke with new org :)

Copy link

Ypot commented Aug 27, 2019

Hi. Thanks.
I'm sure the cause is what you are saying, but... it seems I am too newbie to solve it: I have installed ELPA, listed its packages, but I can't find "org-archive.el", nor "org-archive-subtree-hierarchical.el". Is that the way?

Copy link

kepi commented Aug 27, 2019

org-archive.el is included in package org-plus-contrib, so just try to list packages and check if it is installed. Second .el is this file (one from this gist) which need to be placed to location where your emacs will find it.

Copy link

Ypot commented Aug 27, 2019


Copy link

4t0m commented Aug 29, 2019

Hmm, when I use this to archive a heading with several sub-headings, if I do it for each of the subheadings individually, then I get a bunch of added newlines in the archive. Each heading gains a newline that can be collapsed

I tried commenting out the (newline) on line 119, but then it reproduces the sub-structure each time rather than adding to the existing one.

Does this reproduce for you?

I've added the following in my config so that things are archived in an archive directory rather than in the current directory.
~/org/file1 is archived to ~/org/archive/file1_archive
~/org/notes/file2 is archived to ~org/archive/notes/file2_archive

(defun org-archive-subtree-hierarchical-archive-dir ()
     (let* ((org-archive-location (concat "~/org/archive/"
                                          (file-relative-name buffer-file-name "~/org/")

The newlines appear regardless of whether I include that code.

Copy link

kepi commented Jun 9, 2020

Oh, I finally found time to check your comment after almost a year... To be honest, I currently don't mind multiple newlines as I'm not working with archive too much. I'm archiving a lot, but almost never searching it for anything. Not sure on first glance where that new line is comming from but looks like I have redundant new lines too.

As for archive location, I have them in archive subfolder too, but if I remember correctly, it is coming from archive location in my case:

    (setq org-archive-location "~/org/archive/%s_archive::* Archived Tasks")

Subtrees are inserted in archive file automatically in exact place were they should be (the Archived Tasks heading is not added).

Copy link

GCamp6 commented Jun 24, 2020

Hi kepi, thanks for sharing this script, I was looking exactly for something like that and, considering my newbiness to emacs orgmode, this was perfect!

I have a similar configuration to your example above but in my case is:

(setq org-archive-location "~/org/archive/* From %s")

I was wandering if it would be possible to insert subtrees including the From %s heading?
In this way I can have one single archive file with the list of archived items grouped by original file name

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment