Archive subtrees under the same hierarchy as original in the archive files.

org-archive-subtree.el

(defadvice org-archive-subtree (around fix-hierarchy activate)
  (let* ((fix-archive-p (and (not current-prefix-arg)
                             (not (use-region-p))))
         (afile (org-extract-archive-file (org-get-local-archive-location)))
         (buffer (or (find-buffer-visiting afile) (find-file-noselect afile))))
    ad-do-it
    (when fix-archive-p
      (with-current-buffer buffer
        (goto-char (point-max))
        (while (org-up-heading-safe))
        (let* ((olpath (org-entry-get (point) "ARCHIVE_OLPATH"))
               (path (and olpath (split-string olpath "/")))
               (level 1)
               tree-text)
          (when olpath
            (org-mark-subtree)
            (setq tree-text (buffer-substring (region-beginning) (region-end)))
            (let (this-command) (org-cut-subtree))
            (goto-char (point-min))
            (save-restriction
              (widen)
              (-each path
                (lambda (heading)
                  (if (re-search-forward
                       (rx-to-string
                        `(: bol (repeat ,level "*") (1+ " ") ,heading)) nil t)
                      (org-narrow-to-subtree)
                    (goto-char (point-max))
                    (unless (looking-at "^")
                      (insert "\n"))
                    (insert (make-string level ?*)
                            " "
                            heading
                            "\n"))
                  (cl-incf level)))
              (widen)
              (org-end-of-subtree t t)
              (org-paste-subtree level tree-text))))))))

I guess it's about time to turn this into a package, seems like enough people are interested.

I'll take both feedbacks into consideration.

Some more input if you want to look deeper into this @Fuco1 (or someone else for that matter)

@daviderestivo has some more changes in his version:
https://github.com/daviderestivo/galactic-emacs/blob/master/lisp/org-archive-subtree.el .

I have put up a version using another approach here: https://gitlab.com/andersjohansson/org-archive-hierarchically (based on some other code from https://stackoverflow.com/a/35475878 and https://gist.github.com/kepi/2f4acc3cc93403c75fbba5684c5d852d). But that solution duplicates much more code from the standard archiving functions (and it’s definitely not perfect, statistics cookies causes problems for example). I think your approach of using a single function/advice for fixing it up after it has been moved to the archive file is a simpler idea.

I don’t think there’s a need for making it an advice though. The variable `org-archive-default-command´ allows for customization so we can just do something like:

(setq org-archive-default-command #'org-archive-subtree-hierarchically)

(defun org-archive-subtree-hierarchically (&optional prefix)
  (interactive "P")
  (let* ((fix-archive-p (and (not prefix)
                             (not (use-region-p))))
         (afile  (car (org-archive--compute-location
                       (or (org-entry-get nil "ARCHIVE" 'inherit) org-archive-location))))
         (buffer (or (find-buffer-visiting afile) (find-file-noselect afile))))
    (org-archive-subtree prefix)
    (when fix-archive-p
      (with-current-buffer buffer
        (goto-char (point-max))
        (while (org-up-heading-safe))
        (let* ((olpath (org-entry-get (point) "ARCHIVE_OLPATH"))
               (path (and olpath (split-string olpath "/")))
               (level 1)
               tree-text)
          (when olpath
            (org-mark-subtree)
            (setq tree-text (buffer-substring (region-beginning) (region-end)))
            (let (this-command (inhibit-message t)) (org-cut-subtree)) ; we don’t want to see "Cut subtree" messages
            (goto-char (point-min))
            (save-restriction
              (widen)
              (-each path
                (lambda (heading)
                  (if (re-search-forward
                       (rx-to-string
                        `(: bol (repeat ,level "*") (1+ " ") ,heading)) nil t)
                      (org-narrow-to-subtree)
                    (goto-char (point-max))
                    (unless (looking-at "^")
                      (insert "\n"))
                    (insert (make-string level ?*)
                            " "
                            heading
                            "\n"))
                  (cl-incf level)))
              (widen)
              (org-end-of-subtree t t)
              (org-paste-subtree level tree-text))))))))

HI all, any advice on which function/advice :) to use to accomplish hierarchical archiving? I got somewhat lost amongst all the comments. Is there a current version of this function that is working as expected? Thank you"

@Gahamelas: I'm using this one: https://github.com/daviderestivo/galactic-emacs/blob/master/lisp/org-archive-subtree.el since some years successfully :)

Thanks @daviderestivo! If my archive format is datetree, and I mark as DONE the following tasks on different days

* Heading 1
* * task 1 (DONE on 2020-01-01)
* * task 2
* * * task 3 (DONE on 2020-01-02)

What can I expect to get in my datetree?

* 2020
**   2020-01 January
***     2020-01-01 Saturday
{what to expect here}
***     2020-01-02 Sunday
{what to expect here}

Thanks!

Unfortunately this advice does nothing related to date trees. It will recreate the parents the same way as they exist in the original file. If you mark task 3 as done it will be placed under Heading1 > task2 > task3.

To make it archive in a date tree you would need to write a new function (as andersjohansson points out it doesn't need to be an advice).

@Fuco1: Thanks for having answered 👍

Thanks for the quick response, @Fuco1, as I don't know Elisp, I will have to continue as I am :) Thanks anyway!

The advice still works however it adds the archived subtree to the kill ring.
It also only works if the org archive locations isn't under another subtree.

I put in the advice in a small emacs package that has a function to enable and disable the advice:
https://gitlab.com/Thaodan/emacs.d-lisp/-/blob/master/org-archive-subtree-hierarchy.el