Archive org tasks to org-roam dailies
The snippets in the following article won’t work with tasks that require taking a note after being set: you’ll be left with a note where the task was.
I recently stumbled upon this article from systemcrafters, and quite liked the idea of being able to store DONE tasks into org-roam dailies. However, I already had a working system using org archives which held metadata about the task and kept hierarchy, and I wanted to avoid scrapping that (I also think it makes more sense to archive DONE tasks than to refile them) so I adapted the snippet from systemcrafters’ article to fit my needs.
First, let’s see how we archive the subtree under the same hierarchy as the original source file. I did not write this, but found it here and here.
(require 'dash)
(require 'org-archive)
(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)))
;; we don’t want to see "Cut subtree" messages
(let (this-command (inhibit-message t)) (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))))))))
So now we can adapt the snippet to our needs (I also archive CANCELLED and READ tasks):
;; Set archive location just before archiving
(defun tyx/archive-to-location (location)
(interactive)
(setq org-archive-location location)
(setq org-archive-subtree-add-inherited-tags t)
(org-archive-subtree-hierarchically))
(defun tyx/org-roam-archive-todo-to-today ()
(interactive)
(let ((org-roam-dailies-capture-templates
'(("t" "tasks" entry "%?"
:if-new (file+head+olp
"%<%Y-%m-%d>.org.gpg" "#+title: %<%Y-%m-%d>\n"
("Tasks done")))))
(org-archive-hook #'save-buffer)
today-file
pos)
(save-window-excursion
(org-roam-dailies--capture (current-time) t)
(setq today-file (buffer-file-name))
(setq pos (point)))
;; Only archive if the target file is different than the current file
(unless (equal (file-truename today-file)
(file-truename (buffer-file-name)))
(tyx/archive-to-location (concat today-file "::* Tasks done")))))
(add-to-list 'org-after-todo-state-change-hook
(lambda ()
(when (member org-state '("DONE" "CANCELLED" "READ"))
(my/org-roam-archive-todo-to-today))))
Previously, I was archiving tasks by week, under the archives subdirectory using the following functions, regularly called manually (inspired from here):
(defun tyx/archive-on-closed-time ()
(interactive)
(let ((timestamp (date-to-time (cdr (assoc "CLOSED" (org-entry-properties))))))
(setq org-archive-location (concat "~/org/archives/" ;
(format-time-string "%Y" timestamp)
"/"
(format-time-string "%m" timestamp)
"/"
(format-time-string "W%V" timestamp)
".org::"))
(org-archive-subtree-hierarchically)))
(defun tyx/org-archive-done-tasks ()
(interactive)
(org-map-entries 'tyx/archive-on-closed-time "/DONE" 'file))
(defun tyx/org-archive-cancelled-tasks ()
(interactive)
(org-map-entries 'tyx/archive-on-closed-time "/CANCELLED" 'file))