feat(todo-cleanup): add --archive-done mode with ERT test suite

--archive-done moves every level-2 subtree whose TODO state is DONE or CANCELLED out of the "Open Work" section into the "Resolved" section of the same org file, subtree intact. Sections match on a unique level-1 heading containing "Open Work" (case-insensitive) and one containing "Resolved"; a missing or ambiguous section skips the file with a message rather than crashing. Only direct level-2 children move. A DONE entry nested under an open parent stays put. Opt-in, never run by default, doesn't also run the hygiene passes; --check previews without writing.

The CLI dispatch moved into tc-main behind a guard so the new ERT suite can require the file without firing it. Hygiene mode is unchanged.

13 ERT cases (the repo's first elisp tests) cover the move and the stay-put cases, EOF with no final newline, missing or ambiguous sections, lowercase headings, idempotency, and --check. tests/fixtures/todo-sample.org is the synthetic sample, and the Makefile test target now runs the ERT suites alongside pytest.

1 files changed, 210 insertions, 29 deletions

diff --git a/.ai/scripts/todo-cleanup.el b/.ai/scripts/todo-cleanup.el
index c4231f4..4988db0 100644
--- a/.ai/scripts/todo-cleanup.el
+++ b/.ai/scripts/todo-cleanup.el
@@ -1,26 +1,36 @@
-;;; todo-cleanup.el --- Auto-fix and audit for todo.org hygiene
+;;; todo-cleanup.el --- Auto-fix and audit for todo.org hygiene  -*- lexical-binding: t; -*-
 ;;
 ;; Usage:
-;;   emacs --batch -q -l todo-cleanup.el todo.org           # apply fixes in place
-;;   emacs --batch -q -l todo-cleanup.el --check todo.org   # report-only
+;;   emacs --batch -q -l todo-cleanup.el todo.org                    # apply hygiene fixes in place
+;;   emacs --batch -q -l todo-cleanup.el --check todo.org            # hygiene report only
+;;   emacs --batch -q -l todo-cleanup.el --archive-done todo.org     # archive completed subtrees
+;;   emacs --batch -q -l todo-cleanup.el --archive-done --check todo.org  # preview the archive
 ;;
-;; What it does:
+;; Two independent modes:
 ;;
-;; 1. Auto-deletes "bogus state-log" lines of the form
-;;      - State "X"       from "X"       [date]
-;;    where the state didn't actually change. Org sometimes logs these when
-;;    `org-log-into-drawer' is unset and a state-change toggle lands on the
-;;    same state. They carry no information and they break org's planning-line
-;;    parser by sitting between the heading and DEADLINE/SCHEDULED.
+;; * Default (hygiene). Designed for the wrap-it-up workflow: cheap, idempotent,
+;;   safe to run every session.
 ;;
-;; 2. Detects "orphan planning lines" — entries whose body contains
-;;    `^DEADLINE:' or `^SCHEDULED:' that org-entry-get can't read because the
-;;    line isn't in canonical position. Reports these for manual fix; doesn't
-;;    auto-rewrite (preserving real state-log history is judgement work).
+;;   1. Auto-deletes "bogus state-log" lines of the form
+;;        - State "X"       from "X"       [date]
+;;      where the state didn't actually change. Org sometimes logs these when
+;;      `org-log-into-drawer' is unset and a state-change toggle lands on the
+;;      same state. They carry no information and they break org's planning-line
+;;      parser by sitting between the heading and DEADLINE/SCHEDULED.
 ;;
-;; Designed for the wrap-it-up workflow: cheap (~0.4s on a 3700-line todo.org),
-;; idempotent, and safe to run every session. Any fixes show up in the
-;; wrap-up commit's diff for review.
+;;   2. Detects "orphan planning lines" — entries whose body contains
+;;      `^DEADLINE:' or `^SCHEDULED:' that org-entry-get can't read because the
+;;      line isn't in canonical position. Reports these for manual fix; doesn't
+;;      auto-rewrite (preserving real state-log history is judgement work).
+;;
+;; * --archive-done (opt-in). Moves every level-2 subtree whose TODO state is
+;;   DONE or CANCELLED out of the "Open Work" section and into the "Resolved"
+;;   section of the same file, subtree intact. The sections are matched by a
+;;   unique level-1 heading containing "Open Work" (case-insensitive) and one
+;;   containing "Resolved"; if either is missing or ambiguous, the file is
+;;   skipped with a message. Only direct level-2 children move — a DONE entry
+;;   nested under an open parent stays put. Archiving is consequential, so it's
+;;   never run by default; it does *not* also run the hygiene passes.
 
 (require 'org)
 (require 'cl-lib)
@@ -28,11 +38,19 @@
 (setq org-todo-keywords
       '((sequence "TODO" "DOING" "WAITING" "NEXT" "|" "DONE" "CANCELLED")))
 
+(defconst tc-done-states '("DONE" "CANCELLED")
+  "TODO keywords that mark an entry as completed for `--archive-done'.")
+
 (defvar tc-fixes 0)
+(defvar tc-archived 0)
 (defvar tc-issues nil)
 (defvar tc-check-only nil)
+(defvar tc-archive-done nil)
 (defvar tc-current-file nil)
 
+;;; ---------------------------------------------------------------------------
+;;; Hygiene mode
+
 (defun tc-fix-bogus-state-log-in-entry ()
   "Delete bogus state-log lines within the entry at point.
 A bogus log line matches `- State \"X\" from \"X\" [date]' where the two
@@ -60,8 +78,8 @@ states are identical."
                   tc-issues)))))))
 
 (defun tc-detect-orphan-planning-in-entry ()
-  "Flag entries where DEADLINE/SCHEDULED is in the body but org-entry-get returns nil.
-This means the planning line isn't in canonical position, so org-mode's
+  "Flag entries with a body DEADLINE/SCHEDULED that org-entry-get can't read.
+That means the planning line isn't in canonical position, so org-mode's
 agenda + scheduling machinery won't see it."
   (let* ((line (line-number-at-pos))
          (heading (org-get-heading t t t t))
@@ -89,18 +107,158 @@ agenda + scheduling machinery won't see it."
                   :detail (match-string 1 body))
             tc-issues))))
 
+;;; ---------------------------------------------------------------------------
+;;; --archive-done mode
+
+(defun tc--find-section (substring)
+  "Buffer position (beginning of line) of the unique level-1 heading whose
+stripped text contains SUBSTRING, case-insensitively.
+Return nil if there is no such heading, or the symbol `multiple' if there is
+more than one."
+  (let ((needle (regexp-quote (downcase substring)))
+        (matches nil))
+    (save-excursion
+      (goto-char (point-min))
+      (while (re-search-forward "^\\* " nil t)
+        (let* ((pos (match-beginning 0))
+               (text (downcase (or (save-excursion (goto-char pos)
+                                                   (org-get-heading t t t t))
+                                   ""))))
+          (when (string-match-p needle text)
+            (push pos matches)))))
+    (cond ((null matches) nil)
+          ((cdr matches) 'multiple)
+          (t (car matches)))))
+
+(defun tc--subtree-end (heading-bol level)
+  "Beginning of the first heading at level <= LEVEL after HEADING-BOL,
+or `point-max' if there is none."
+  (save-excursion
+    (goto-char heading-bol)
+    (forward-line 1)
+    (let (found)
+      (while (and (not found) (re-search-forward "^\\(\\*+\\)[ \t]" nil t))
+        (when (<= (length (match-string 1)) level)
+          (setq found (match-beginning 0))))
+      (or found (point-max)))))
+
+(defun tc--subtree-region ()
+  "Return (BEG . END) for the subtree whose heading the point is on.
+BEG is the beginning of the heading line; END is the beginning of the next
+heading at the same or a shallower level, or `point-max'."
+  (org-back-to-heading t)
+  (let ((beg (line-beginning-position))
+        (level (org-current-level)))
+    (cons beg (tc--subtree-end beg level))))
+
+(defun tc--done-level-2-children (section-bol)
+  "List of heading positions (beginning of line) for the direct level-2
+children of the level-1 section heading at SECTION-BOL whose TODO state is in
+`tc-done-states', in document order."
+  (save-excursion
+    (goto-char section-bol)
+    (forward-line 1)
+    (let ((positions nil)
+          (stop nil))
+      (while (and (not stop) (re-search-forward "^\\(\\*+\\)[ \t]" nil t))
+        (let ((lvl (length (match-string 1)))
+              (hpos (match-beginning 0)))
+          (cond
+           ((<= lvl 1) (setq stop t))   ; reached the next level-1 section
+           ((= lvl 2)
+            (when (member (save-excursion (goto-char hpos) (org-get-todo-state))
+                          tc-done-states)
+              (push hpos positions)))
+           ;; lvl > 2: a deeper descendant — leave it alone
+           )))
+      (nreverse positions))))
+
+(defun tc--archive-skip (detail)
+  (push (list :kind 'archive-skip :file tc-current-file :detail detail) tc-issues))
+
+(defun tc-archive-done-in-file ()
+  "Move level-2 DONE/CANCELLED subtrees from the \"Open Work\" section into the
+\"Resolved\" section of the current buffer.  Under `tc-check-only' the moves
+are reported but not performed."
+  (let ((open (tc--find-section "open work"))
+        (res (tc--find-section "resolved")))
+    (cond
+     ((null open) (tc--archive-skip "no level-1 heading containing \"Open Work\""))
+     ((eq open 'multiple) (tc--archive-skip "more than one level-1 heading contains \"Open Work\""))
+     ((null res) (tc--archive-skip "no level-1 heading containing \"Resolved\""))
+     ((eq res 'multiple) (tc--archive-skip "more than one level-1 heading contains \"Resolved\""))
+     ((= open res) (tc--archive-skip "the same heading matches both \"Open Work\" and \"Resolved\""))
+     (tc-check-only
+      (save-excursion
+        (dolist (pos (tc--done-level-2-children open))
+          (goto-char pos)
+          (push (list :kind 'archive-would :file tc-current-file
+                      :line (line-number-at-pos)
+                      :heading (org-get-heading t t t t))
+                tc-issues)
+          (cl-incf tc-archived))))
+     (t
+      (catch 'done
+        (while t
+          (let* ((open* (tc--find-section "open work"))
+                 (targets (and (integerp open*) (tc--done-level-2-children open*))))
+            (unless targets (throw 'done nil))
+            (goto-char (car targets))
+            (let* ((region (tc--subtree-region))
+                   (beg (car region))
+                   (end (cdr region))
+                   (heading (save-excursion (goto-char beg) (org-get-heading t t t t)))
+                   (line (line-number-at-pos beg))
+                   ;; Normalize the trailing separator to a single newline so
+                   ;; moved subtrees don't drag blank lines into "Resolved".
+                   (text (concat (string-trim-right (buffer-substring-no-properties beg end)
+                                                    "[ \t\n]+")
+                                 "\n")))
+              (delete-region beg end)
+              (let* ((res* (tc--find-section "resolved"))
+                     (ins (tc--subtree-end res* 1)))
+                (goto-char ins)
+                (unless (bolp) (insert "\n"))
+                (insert text)
+                (unless (bolp) (insert "\n")))
+              (cl-incf tc-archived)
+              (push (list :kind 'archive-moved :file tc-current-file
+                          :line line :heading heading)
+                    tc-issues)))))))))
+
+;;; ---------------------------------------------------------------------------
+;;; Driver + reporting
+
 (defun tc-process-file (file)
   (setq tc-current-file (file-name-nondirectory file))
   (with-current-buffer (find-file-noselect file)
     (org-mode)
-    ;; Pass 1: auto-fix bogus state logs (or report under --check).
-    (org-map-entries #'tc-fix-bogus-state-log-in-entry nil 'file)
-    ;; Pass 2: detect orphan planning lines (always report-only).
-    (org-map-entries #'tc-detect-orphan-planning-in-entry nil 'file)
+    (if tc-archive-done
+        (tc-archive-done-in-file)
+      ;; Pass 1: auto-fix bogus state logs (or report under --check).
+      (org-map-entries #'tc-fix-bogus-state-log-in-entry nil 'file)
+      ;; Pass 2: detect orphan planning lines (always report-only).
+      (org-map-entries #'tc-detect-orphan-planning-in-entry nil 'file))
     (when (and (not tc-check-only) (buffer-modified-p))
       (save-buffer))))
 
-(defun tc-emit-report ()
+(defun tc--emit-archive-report ()
+  (princ (format "todo-cleanup --archive-done: %d subtree(s) %s%s\n"
+                 tc-archived
+                 (if tc-check-only "would move" "moved")
+                 (if tc-check-only " — CHECK MODE (no writes)" "")))
+  (dolist (i (reverse tc-issues))
+    (pcase (plist-get i :kind)
+      ('archive-skip
+       (princ (format "  skipped %s: %s\n" (plist-get i :file) (plist-get i :detail))))
+      ((or 'archive-moved 'archive-would)
+       (princ (format "    %s:%d: %s %s\n"
+                      (plist-get i :file)
+                      (plist-get i :line)
+                      (if tc-check-only "would move" "moved")
+                      (plist-get i :heading)))))))
+
+(defun tc--emit-hygiene-report ()
   (princ (format "todo-cleanup: %d fix(es) applied%s\n"
                  tc-fixes
                  (if tc-check-only " — CHECK MODE (no writes)" "")))
@@ -129,15 +287,22 @@ agenda + scheduling machinery won't see it."
                        (plist-get i :heading)
                        (plist-get i :detail)))))))
 
-(when noninteractive
-  ;; Mutate `command-line-args-left' so emacs's own arg parser doesn't see
-  ;; --check after our script returns.
+(defun tc-emit-report ()
+  (if tc-archive-done (tc--emit-archive-report) (tc--emit-hygiene-report)))
+
+(defun tc-main ()
+  ;; Strip our flags from `command-line-args-left' so emacs's own arg parser
+  ;; doesn't see them after this returns.
   (when (member "--check" command-line-args-left)
     (setq tc-check-only t)
     (setq command-line-args-left (delete "--check" command-line-args-left)))
+  (when (member "--archive-done" command-line-args-left)
+    (setq tc-archive-done t)
+    (setq command-line-args-left (delete "--archive-done" command-line-args-left)))
   (if (null command-line-args-left)
-      (progn (princ "Usage: emacs --batch -q -l todo-cleanup.el [--check] FILE...\n")
-             (kill-emacs 1))
+      (progn
+        (princ "Usage: emacs --batch -q -l todo-cleanup.el [--check] [--archive-done] FILE...\n")
+        (kill-emacs 1))
     (let ((files command-line-args-left))
       (setq command-line-args-left nil)
       (dolist (file files)
@@ -145,5 +310,21 @@ agenda + scheduling machinery won't see it."
           (tc-process-file file)))
       (tc-emit-report))))
 
+(defun tc--cli-invocation-p ()
+  "Non-nil when the trailing command-line arguments look like a real
+todo-cleanup invocation: only recognized flags and/or readable file paths.
+Lets the ERT suite `require' this file without triggering the CLI dispatch —
+during a test run the trailing args are things like `-f
+ert-run-tests-batch-and-exit'."
+  (and command-line-args-left
+       (cl-every (lambda (a)
+                   (cond ((member a '("--check" "--archive-done")) t)
+                         ((string-prefix-p "-" a) nil)
+                         (t (file-readable-p a))))
+                 command-line-args-left)))
+
+(when (and noninteractive (tc--cli-invocation-p))
+  (tc-main))
+
 (provide 'todo-cleanup)
 ;;; todo-cleanup.el ends here