Files
memex/projects/org-gtd-archive-roam-daily/org-gtd-archive-roam-daily.el

75 lines
3.1 KiB
EmacsLisp

;;; org-gtd-archive-roam-daily.el --- Archive Org headings to Org-roam dailies
;;; Commentary:
;; This file provides an Elisp function to archive an Org-mode heading
;; at point to an Org-roam daily file based on its :CREATED: property.
;;; Code:
(require 'org-roam-dailies)
(require 'org-element)
(require 'org-time)
(defun amero-get-org-heading-created-property ()
"Extract the :CREATED: property from the current Org heading.
Returns a time string or nil if not found."
(interactive)
(save-excursion
(org-back-to-heading t)
(org-entry-get (point) "CREATED")))
(defun amero-parse-created-timestamp (timestamp-string)
"Parse an Org-mode timestamp string like '[2026-03-16 Mon 14:05]'
into an Emacs internal time object.
Returns nil if parsing fails."
(ignore-errors
(org-time-string-to-time timestamp-string)))
(defun amero-get-daily-note-file (time-object)
"Get the Org-roam daily note file for a given Emacs TIME-OBJECT.
Creates the file if it doesn't exist. Returns the file path."
(let* ((date-string (format-time-string org-roam-dailies-capture-templates-date-format time-object))
(file-path (expand-file-name (concat date-string ".org")
(expand-file-name org-roam-dailies-directory org-roam-directory))))
;; Ensure the directory exists
(unless (file-exists-p (file-name-directory file-path))
(make-directory (file-name-directory file-path) t))
;; Create file if it doesn't exist (org-roam-dailies-goto-date handles this,
;; but we need to ensure it's created and accessible for append)
(unless (file-exists-p file-path)
(with-temp-buffer
(insert (format "#+title: %s\n" date-string))
(write-file file-path)))
file-path))
(defun org-gtd-archive-roam-daily ()
"Archive the current Org heading to an Org-roam daily file
based on its :CREATED: property.
Signals an error if :CREATED: property is missing."
(interactive)
(unless (org-before-first-heading-p (point))
(user-error "Point is not on an Org heading or within an Org file."))
(let* ((created-timestamp-string (amero-get-org-heading-created-property))
(created-time-object (and created-timestamp-string
(amero-parse-created-timestamp created-timestamp-string)))
(heading-start (save-excursion (org-back-to-heading t) (point)))
(heading-end (save-excursion (org-end-of-subtree t) (point)))
(heading-content (buffer-substring-no-properties heading-start heading-end))
daily-file-path)
(unless created-time-object
(user-error "No date error: Heading is missing a valid :CREATED: property."))
(setq daily-file-path (amero-get-daily-note-file created-time-object))
(with-current-buffer (find-file-noselect daily-file-path)
(goto-char (point-max))
(insert "\n\n" heading-content)
(save-buffer))
;; Remove the original heading
(delete-region heading-start heading-end)
(message "Archived heading to %s" daily-file-path)))
(provide 'org-gtd-archive-roam-daily)
;;; org-gtd-archive-roam-daily.el ends here