Keeping the context when archiving in Emacs org-mode
;; org-archive-subtree-hierarchical.el
;; modified from https://lists.gnu.org/archive/html/emacs-orgmode/2014-08/msg00109.html
;; 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
(require 'org-archive)
(defun org-archive-subtree-hierarchical--line-content-as-string ()
"Returns the content of the current line as a string"
(save-excursion
(beginning-of-line)
(buffer-substring-no-properties
(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. "
(interactive)
(save-excursion
;; 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)
(org-goto-first-child))
(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)))
child-list)))
(defun org-archive-subtree-hierarchical--org-struct-subtree ()
"This function returns the tree structure in which a subtree
belongs as a list."
(interactive)
(let ((archive-tree nil))
(save-excursion
(while (org-up-heading-safe)
(let ((heading
(buffer-substring-no-properties
(line-beginning-position) (line-end-position))))
(if (eq archive-tree nil)
(setq archive-tree (list heading))
(setq archive-tree (cons heading archive-tree))))))
archive-tree))
(defun org-archive-subtree-hierarchical ()
"This function archives a subtree hierarchical"
(interactive)
(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")))))
(save-excursion
(setq location (org-get-local-archive-location)
afile (org-extract-archive-file 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))
(org-cut-subtree)
(set-buffer buffer)
(org-mode)
(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)
(progn
(search-forward (car org-tree) nil t)
(setq org-tree (cdr org-tree)))
(progn
(goto-char (point-max))
(newline)
(org-insert-struct org-tree)
(setq org-tree nil)))))
(newline)
(org-yank)
(when (not (eq this-buffer buffer))
(save-buffer))
(message "Subtree archived %s"
(concat "in file: " (abbreviate-file-name afile))))))
(defun org-insert-struct (struct)
"TODO"
(interactive)
(when struct
(insert (car struct))
(newline)
(org-insert-struct (cdr struct))))
(defun org-archive-subtree ()
(org-archive-subtree-hierarchical)
)
This hack just act like refile to your archive file with whole same parent struct，no archive :PROPERTIES: here.
Also as a gist here: https://gist.github.com/CodeFalling/87b116291aa87fde72cb
I don't think org-mode has support for directly mirroring the current context inside your archive file.
There is a relevant variable, org-archive-location which can be used to specify a single heading to place your archived item, but multiple levels inside the tree is not supported. On this page there are two advices for org-archive-subtree that may be good enough. I am replicating the first one here in case the site goes away:
(defadvice org-archive-subtree (around my-org-archive-subtree activate)
(let ((org-archive-location
(if (save-excursion (org-back-to-heading)
(> (org-outline-level) 1))
(concat (car (split-string org-archive-location "::"))
"::* "
(car (org-get-outline-path)))
org-archive-location)))
ad-do-it))
The second, and more complicated one also preserves tags found on the top level headings.
On last thing that may come in handy is the custom variable org-archive-save-context-info. If this list contains the symbol 'olpath, the archived entry will contain :ARCHIVE_OLPATH: property, which is set to the outline path of the archived entry (e.g. Projects/Misc. Maybe you can do some post processing on the org-archive-subtree and relocate the archived entry to its original outline path using this.
You likely want to set the :ARCHIVE: property on the parent headlines.
It allows you for headline specific org-archive-location settings. (See the manual)
For example if your archive file is set as %s_archive you would want your original file to look like this
* Misc.
:PROPERTIES:
:ARCHIVE: %s_archive::* Misc
:END:
** TODO Task 1
** TODO Task 2
* Project 1
:PROPERTIES:
:ARCHIVE: %s_archive::* Project 1
:END:
** TODO Task 1
** TODO Task 2
This would sent any subtrees in * Misc to a * Misc headline in the archive file, and would do the equivalent for the subtrees in Project 1 (unless you archive the whole tree in one shot). Archiving the parent tree after the subtrees appears to add it as an additional subheading under the destination. It does not support multiple levels, so you'd have to set up your archive file headlines ahead of time to ensure it outputs the way you desire if you need a complex setup of that sort.
You can also use this property to archive specific trees to separate files (for export/publication/sharing purposes).