apodsf8u

1 files changed, 36 insertions, 0 deletions

@@ -730,6 +730,42 @@ When called with a prefix ARG, will still unconditionally call
                                 (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
 
 (el-patch-defun org-format-outline-path (path &optional width prefix separator)