From 58e163e03be262dd2ac7c8239e638cf880a38e09 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Wed, 6 Jul 2022 16:47:51 -0500
Subject: apodsf8u

---
 lisp/+org.el | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

(limited to 'lisp')

diff --git a/lisp/+org.el b/lisp/+org.el
index 6b956ae..2557671 100644
--- a/lisp/+org.el
+++ b/lisp/+org.el
@@ -729,6 +729,42 @@ When called with a prefix ARG, will still unconditionally call
                                 ((org-at-table-p) #'org-table-wrap-region)
                                 (t #'org-return)))))
 
+
+;;; move org archives to a dedicated file
+(defun +org-archive-monthwise (archive-file)
+  (if (file-exists-p archive-file)
+      (with-current-buffer (find-file-noselect archive-file)
+        (let ((dir (file-name-directory (file-truename archive-file)))
+              (prog (make-progress-reporter (format "Archiving from %s..." archive-file)))
+              (keep-going t))
+          (goto-char (point-min))
+          (while keep-going
+            (when-let* ((time (or (org-entry-get (point) "ARCHIVE_TIME")
+                                  (org-get-deadline-time (point))))
+                        (parsed-time (and time
+                                          (org-parse-time-string time)))
+                        (refile-target (format "%s%02d-%02d.org"
+                                               dir
+                                               (decoded-time-year parsed-time)
+                                               (decoded-time-month parsed-time)))
+                        (title-str (format "#+title: Archive for %02d-%02d (%s)\n\n"
+                                           (decoded-time-year parsed-time)
+                                           (decoded-time-month parsed-time)
+                                           (file-truename archive-file))))
+              (unless (file-exists-p refile-target)
+                (with-current-buffer (find-file-noselect refile-target)
+                  (insert title-str)
+                  (save-buffer)))
+              (org-refile nil nil (list ""
+                                        refile-target
+                                        nil
+                                        0)))
+            (progress-reporter-update prog)
+            (org-next-visible-heading 1)
+            (when (>= (point) (point-max))
+              (setq keep-going nil)))))
+    (message "Archive file %s does not exist!" archive-file)))
+
 
 ;;; el-patch
 
-- 
cgit 1.4.1-21-gabe81