如果所有 TODO 完成，组织模式归档整个文件

Question

虽然我看到了很多关于归档子树的 SO 问题，但我每天使用 org-journal 使用模板（例如 2018-09-14.org）创建一个每日文件，然后我记录下来预模板结构中的待办事项，用于个人、工作或你经历过各种状态，直到它们完成 DONE 或取消 KILL（我发现这种方法对我有用，因为它也允许我直观地在议程视图中查看任务自开始以来已挂起多长时间）。

我正在尝试编写一个交互式函数：

处理我所有 .org 议程文件的列表，并且
如果它在文件中检测到所有 TODO 和 DONE 或 KILL（或者存在 none），
提示我 y, n, skip 将整个文件移动到其 whatever.org_archive

（使用 org-mode 5 个月后开始发现议程构建速度变慢）。

我假设其他人已经在使用类似的方法（因为 emacs），但想知道是否有人可以向我指出有助于解决这个问题的类似功能或方法。到目前为止，在 elisp 上进行谷歌搜索和反复研究都没有结果。

=== 一个月后=== 嗯，自学一些 lisp 有帮助，但现在我有 3 个独立的函数在工作，但由于某种原因我在调用最终函数时出错。

但是，在调用 rename-file-buffer-to-org-archive 时，我在第 28 行遇到了一个函数无效的错误：如果有人能看到问题出在哪里，这就解决了我的用例（也可能是其他人的用例，这就是我将其粘贴回此处的原因。）。

(defun archive-done-org-journal-files ()
"Cycles all org files through checking function."
(interactive) 
(save-excursion
(mapc 'check-org-file-finito (directory-files "~/Desktop/test_archives/" t ".org$"))
))

(defun check-org-file-finito (f)
"Checks TODO keyword items are DONE then archives."
(interactive)
(find-file f)
;; Shows open Todo items whether agenda or todo
(let (
  (kwd-re
    (cond (org-not-done-regexp)
      (
       (let ((kwd
          (completing-read "Keyword (or KWD1|KWD2|...): "
                 (mapcar #'list org-todo-keywords-1))))
       (concat "\("
           (mapconcat 'identity (org-split-string kwd "|") "\|")
           "\)\>")))
    ((<= (prefix-numeric-value) (length org-todo-keywords-1))
     (regexp-quote (nth (1- (prefix-numeric-value))
                org-todo-keywords-1)))
    (t (user-error "Invalid prefix argument: %s")))))
 (if (= (org-occur (concat "^" org-outline-regexp " *" kwd-re )) 0)
 ((rename-file-buffer-to-org-archive)
  (kill-buffer (current-buffer)))
   (kill-buffer (current-buffer))
   )))

(defun rename-file-buffer-to-org-archive ()
"Renames current buffer and file it's visiting."
(interactive)
(let ((name (buffer-name))
    (filename (buffer-file-name))
)
(if (not (and filename (file-exists-p filename)))
    (error "Buffer '%s' is not visiting a file!" name)
  (let ((new-name (concat (file-name-sans-extension filename) ".org_archive")))
    (if (get-buffer new-name)
        (error "A buffer named '%s' already exists!" new-name)
      (rename-file filename new-name 1)
      (rename-buffer new-name)
      (set-visited-file-name new-name)
      (set-buffer-modified-p nil)
      (message "File '%s' successfully archived as '%s'."
               name (file-name-nondirectory new-name)))))))

Answer 1

所以，最后，我就是这样解决的。我确定这里需要进行优化和重构，但这绝对有效，并且如果您需要弄明白的话，它是合理的模块化。只需在 archive-done-org-journal-files 中为您的组织文件更改您使用的目录（我的在 Dropbox 中），这应该适合您。我强烈建议根据实际功能在 ~/Desktop/test_archives/ 目录下的测试存档中对此进行测试，这样您就可以确保它像宣传的那样工作。 YMMV。希望对大家有帮助！

(defun archive-done-org-journal-files ()
"Cycles all org files through checking function."
(interactive) 
(save-excursion
(mapc 'check-org-file-finito (directory-files "~/Desktop/test_archives/" t ".org$"))
))

(defun check-org-file-finito (f)
"Checks TODO keyword items are DONE then archives."
(interactive)
(find-file f)
;; Shows open Todo items whether agenda or todo
(let (
(kwd-re
  (cond (org-not-done-regexp)
    (
     (let ((kwd
        (completing-read "Keyword (or KWD1|KWD2|...): "
                 (mapcar #'list org-todo-keywords-1))))
       (concat "\("
           (mapconcat 'identity (org-split-string kwd "|") "\|")
           "\)\>")))
    ((<= (prefix-numeric-value) (length org-todo-keywords-1))
     (regexp-quote (nth (1- (prefix-numeric-value))
                org-todo-keywords-1)))
    (t (user-error "Invalid prefix argument: %s")))))
 (if (= (org-occur (concat "^" org-outline-regexp " *" kwd-re )) 0)
 (rename-file-buffer-to-org-archive)
     (kill-buffer (current-buffer))
   )))

(defun rename-file-buffer-to-org-archive ()
"Renames current buffer and file it's visiting."
(interactive)
(let ((name (buffer-name))
    (filename (buffer-file-name))
)
(if (not (and filename (file-exists-p filename)))
    (error "Buffer '%s' is not visiting a file!" name)
  (let ((new-name (concat (file-name-sans-extension filename) ".org_archive")))
    (if (get-buffer new-name)
        (error "A buffer named '%s' already exists!" new-name)
      (rename-file filename new-name 1)
      (rename-buffer new-name)
      (set-visited-file-name new-name)
      (set-buffer-modified-p nil)
  (kill-buffer (current-buffer))
  (message "File '%s' successfully archived as '%s'."
               name (file-name-nondirectory new-name)))))))

如果所有 TODO 完成，组织模式归档整个文件

Org-mode archive entire file if all TODOs DONE

emacs

org-mode