feat(todo-cleanup): age the Resolved section out to a tracked archive

A project's in-file Resolved section grew without bound: --archive-done only moved closures from Open Work into Resolved, same file. .emacs.d's todo.org reached 768KB that way. So --archive-done now has a second step: a Resolved subtree closed longer ago than tc-archive-retain-days (default 7), or with no parseable CLOSED date, moves out to archive/task-archive.org beside the todo file. Only the last week of closures stays in the file. The step honors --check, and tc-archive-retain-days nil disables it.

I added a guard the proposal lacked: the archive inherits the todo file's gitignore status. gitignore-mode projects gitignore todo.org, so without this the aging step would shed previously-private task history into a tracked archive, a leak on any public repo. When the todo file is gitignored and the archive isn't, the script adds the archive path to .gitignore before the first write. Track-mode projects leave both tracked. Covered by two tests in a temp git repo, one per branch.

1 files changed, 227 insertions, 10 deletions

diff --git a/.ai/scripts/todo-cleanup.el b/.ai/scripts/todo-cleanup.el
index 6b3081a..541d106 100644
--- a/.ai/scripts/todo-cleanup.el
+++ b/.ai/scripts/todo-cleanup.el
@@ -25,14 +25,32 @@
 ;;      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.
+;; * --archive-done (opt-in). Two steps, in order:
+;;
+;;   1. 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.
+;;
+;;   2. Ages the "Resolved" section: a level-2 DONE/CANCELLED subtree whose
+;;      CLOSED date is older than `tc-archive-retain-days' (default 7) is moved
+;;      out to `tc-archive-file' (default `archive/task-archive.org' beside the
+;;      todo file), keeping only the last week of closed tasks in the file
+;;      itself. Only subtrees closed within the window stay; older ones, and
+;;      those with no parseable CLOSED date, are moved out. Set
+;;      `tc-archive-retain-days' to nil to disable this step (legacy in-file-only
+;;      behavior). The aging date is `tc-archive-reference-date' when set
+;;      (tests), otherwise the real current date. The archive inherits the todo
+;;      file's gitignore status: when the todo file is gitignored, the archive
+;;      path is added to .gitignore before the first write, so private task
+;;      history never lands in a tracked path (see
+;;      `tc--ensure-archive-gitignored').
+;;
+;;   Archiving is consequential, so it's never run by default; it does *not*
+;;   also run the hygiene passes.
 ;;
 ;; * --sync-child-priority (opt-in). Walks every heading with a priority cookie
 ;;   ([#A]-[#D]) and, for each of its direct child headings whose own priority
@@ -52,6 +70,7 @@
 
 (require 'org)
 (require 'cl-lib)
+(require 'calendar)
 
 (setq org-todo-keywords
       '((sequence "TODO" "DOING" "WAITING" "NEXT" "|" "DONE" "CANCELLED")))
@@ -75,6 +94,23 @@ every heading below it.")
 (defvar tc-archive-done nil)
 (defvar tc-sync-child-priority nil)
 (defvar tc-current-file nil)
+(defvar tc-current-dir nil)
+(defvar tc-archived-to-file 0)
+
+(defvar tc-archive-retain-days 7
+  "Retention window for the `--archive-done' file-aging step. A closed Resolved
+subtree whose CLOSED date is within this many days of the reference date stays
+in the in-file Resolved section; an older one is moved out to `tc-archive-file'.
+A subtree with no parseable CLOSED date stays. nil disables the aging step
+entirely, leaving the legacy in-file-only behavior.")
+
+(defvar tc-archive-reference-date nil
+  "(YEAR MONTH DAY) treated as \"today\" when aging Resolved subtrees out to a
+file; nil means the real current date. Set in tests for determinism.")
+
+(defvar tc-archive-file nil
+  "Destination file for aged-out Resolved subtrees; nil means
+`archive/task-archive.org' beside the todo file being processed.")
 
 ;;; ---------------------------------------------------------------------------
 ;;; Hygiene mode
@@ -224,7 +260,8 @@ are reported but not performed."
                       :line (line-number-at-pos)
                       :heading (org-get-heading t t t t))
                 tc-issues)
-          (cl-incf tc-archived))))
+          (cl-incf tc-archived)))
+      (tc-archive-old-resolved-to-file))
      (t
       (catch 'done
         (while t
@@ -252,7 +289,171 @@ are reported but not performed."
               (cl-incf tc-archived)
               (push (list :kind 'archive-moved :file tc-current-file
                           :line line :heading heading)
-                    tc-issues)))))))))
+                    tc-issues)))))
+      (tc-archive-old-resolved-to-file)))))
+
+;;; ---------------------------------------------------------------------------
+;;; --archive-done: age old Resolved subtrees out to a file
+
+(defconst tc-archive-file-scaffold
+  "#+TITLE: Task Archive\n#+FILETAGS: :archive:\n\n* Resolved (archived)\n"
+  "Initial content written to a fresh `tc-archive-file'. Aged subtrees are
+appended as level-2 children under the level-1 heading.")
+
+(defun tc--reference-absolute ()
+  "Absolute (Gregorian serial) day number of the aging reference date —
+`tc-archive-reference-date' when set, otherwise the real current date."
+  (if tc-archive-reference-date
+      (pcase-let ((`(,y ,m ,d) tc-archive-reference-date))
+        (calendar-absolute-from-gregorian (list m d y)))
+    (pcase-let ((`(,m ,d ,y) (calendar-current-date)))
+      (calendar-absolute-from-gregorian (list m d y)))))
+
+(defun tc--closed-absolute-in-region (beg end)
+  "Absolute day number of the first CLOSED: [YYYY-MM-DD ...] line in BEG..END,
+or nil when the region carries no parseable CLOSED date. The task's own CLOSED
+line sits in canonical position directly under the heading, so the first match
+in the subtree is the task's close."
+  (save-excursion
+    (goto-char beg)
+    (when (re-search-forward
+           "CLOSED:[ \t]*\\[\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\)"
+           end t)
+      (calendar-absolute-from-gregorian
+       (list (string-to-number (match-string 2))
+             (string-to-number (match-string 3))
+             (string-to-number (match-string 1)))))))
+
+(defun tc--archive-file-path ()
+  "Resolve the destination file for aged-out subtrees: `tc-archive-file' if set,
+else `archive/task-archive.org' beside the todo file being processed."
+  (or tc-archive-file
+      (and tc-current-dir
+           (expand-file-name "archive/task-archive.org" tc-current-dir))))
+
+(defun tc--git-ignored-p (path)
+  "Non-nil when PATH is gitignored (git check-ignore exits 0). nil on any git
+error or when git is unavailable."
+  (let ((default-directory (or tc-current-dir default-directory)))
+    (eq 0 (ignore-errors
+            (call-process "git" nil nil nil "check-ignore" "-q"
+                          (expand-file-name path))))))
+
+(defun tc--ensure-archive-gitignored (archive-path)
+  "Keep the aged-out archive as private as the todo file it derives from. When the
+todo file being processed is gitignored but ARCHIVE-PATH is not, append a
+root-relative ignore entry for ARCHIVE-PATH to the project's .gitignore. No-op
+when the todo file is tracked, the archive is already ignored, or there is no git
+work tree — so track-mode projects (todo file tracked) leave the archive tracked
+too. This is what makes the aging step safe to ship to gitignore-mode projects,
+where todo.org is private: the archive inherits that privacy instead of leaking
+previously-ignored task history into a tracked path."
+  (when (and tc-current-file tc-current-dir)
+    (let* ((todo (expand-file-name tc-current-file tc-current-dir))
+           (default-directory tc-current-dir)
+           (root (with-temp-buffer
+                   (when (eq 0 (ignore-errors
+                                 (call-process "git" nil (current-buffer) nil
+                                               "rev-parse" "--show-toplevel")))
+                     (string-trim (buffer-string))))))
+      (when (and root (> (length root) 0) (file-directory-p root)
+                 (tc--git-ignored-p todo)
+                 (not (tc--git-ignored-p archive-path)))
+        (let ((entry (concat "/" (file-relative-name
+                                  (expand-file-name archive-path) root)))
+              (gi (expand-file-name ".gitignore" root)))
+          (with-temp-buffer
+            (when (file-readable-p gi) (insert-file-contents gi))
+            (unless (save-excursion
+                      (goto-char (point-min))
+                      (re-search-forward (concat "^" (regexp-quote entry) "$") nil t))
+              (goto-char (point-max))
+              (unless (bolp) (insert "\n"))
+              (insert "\n# Claude Code: task archive (follows todo file privacy)\n"
+                      entry "\n")
+              (write-region (point-min) (point-max) gi nil 'silent))))))))
+
+(defun tc--append-subtrees-to-archive-file (path texts)
+  "Append TEXTS (subtree strings) under the level-1 heading in PATH, creating the
+file with `tc-archive-file-scaffold' and the parent directory when absent.
+Ensures the archive inherits the todo file's gitignore status first."
+  (when (and path texts)
+    (tc--ensure-archive-gitignored path)
+    (let ((dir (file-name-directory path)))
+      (when (and dir (not (file-directory-p dir)))
+        (make-directory dir t)))
+    (with-temp-buffer
+      (when (file-readable-p path)
+        (insert-file-contents path))
+      (when (= (point-min) (point-max))
+        (insert tc-archive-file-scaffold))
+      ;; Guarantee a level-1 heading to append under (older files might lack one).
+      (goto-char (point-min))
+      (unless (re-search-forward "^\\* " nil t)
+        (goto-char (point-max))
+        (unless (bolp) (insert "\n"))
+        (insert "* Resolved (archived)\n"))
+      (goto-char (point-max))
+      (unless (bolp) (insert "\n"))
+      (dolist (text texts)
+        (insert text)
+        (unless (bolp) (insert "\n")))
+      (write-region (point-min) (point-max) path nil 'silent))))
+
+(defun tc-archive-old-resolved-to-file ()
+  "Move level-2 DONE/CANCELLED subtrees in the \"Resolved\" section whose CLOSED
+date predates the `tc-archive-retain-days' window out to `tc--archive-file-path'.
+Only subtrees closed within the window stay; older ones, and those with no
+parseable CLOSED date, are moved out. A nil `tc-archive-retain-days' disables the
+step. Honors `tc-check-only' (report only)."
+  (when tc-archive-retain-days
+    (let ((res (tc--find-section "resolved")))
+      (when (integerp res)
+        (let* ((cutoff (- (tc--reference-absolute) tc-archive-retain-days))
+               (moves nil))
+          (dolist (pos (tc--done-level-2-children res))
+            (save-excursion
+              (goto-char pos)
+              (let* ((region (tc--subtree-region))
+                     (beg (car region))
+                     (end (cdr region))
+                     (closed (tc--closed-absolute-in-region beg end)))
+                ;; Archive anything not provably within the window: closed
+                ;; before the cutoff, or with no parseable CLOSED date at all.
+                (when (or (null closed) (< closed cutoff))
+                  (push (list :beg beg :end end
+                              :heading (org-get-heading t t t t)
+                              :line (line-number-at-pos beg))
+                        moves)))))
+          (setq moves (nreverse moves))   ; document order
+          (cond
+           ((null moves) nil)
+           (tc-check-only
+            (dolist (m moves)
+              (cl-incf tc-archived-to-file)
+              (push (list :kind 'archive-file-would :file tc-current-file
+                          :line (plist-get m :line) :heading (plist-get m :heading))
+                    tc-issues)))
+           (t
+            ;; Capture text before any deletion (positions are still valid), then
+            ;; delete bottom-up so earlier subtree positions stay correct.
+            (let ((texts (mapcar
+                          (lambda (m)
+                            (concat (string-trim-right
+                                     (buffer-substring-no-properties
+                                      (plist-get m :beg) (plist-get m :end))
+                                     "[ \t\n]+")
+                                    "\n"))
+                          moves)))
+              (dolist (m (sort (copy-sequence moves)
+                               (lambda (a b) (> (plist-get a :beg) (plist-get b :beg)))))
+                (delete-region (plist-get m :beg) (plist-get m :end)))
+              (tc--append-subtrees-to-archive-file (tc--archive-file-path) texts)
+              (dolist (m moves)
+                (cl-incf tc-archived-to-file)
+                (push (list :kind 'archive-file-moved :file tc-current-file
+                            :line (plist-get m :line) :heading (plist-get m :heading))
+                      tc-issues))))))))))
 
 ;;; ---------------------------------------------------------------------------
 ;;; --sync-child-priority mode
@@ -381,6 +582,7 @@ before their descendants — a [#A] → [#B] → [#D] chain collapses in one pas
 
 (defun tc-process-file (file)
   (setq tc-current-file (file-name-nondirectory file))
+  (setq tc-current-dir (file-name-directory (expand-file-name file)))
   (with-current-buffer (find-file-noselect file)
     (org-mode)
     (cond
@@ -420,6 +622,21 @@ before their descendants — a [#A] → [#B] → [#D] chain collapses in one pas
                           (plist-get i :file)
                           (plist-get i :line)
                           (if tc-check-only "would move" "moved")
+                          (plist-get i :heading)))))))
+    ;; Aged-out subtrees: only reported when some moved (or would). Additive to
+    ;; the in-file report above, and absent when the aging step is disabled.
+    (when (> tc-archived-to-file 0)
+      (princ (format "todo-cleanup --archive-done: %d aged subtree(s) %s task-archive.org%s\n"
+                     tc-archived-to-file
+                     (if tc-check-only "would move to" "moved to")
+                     (if tc-check-only " — CHECK MODE (no writes)" "")))
+      (dolist (i (reverse tc-issues))
+        (pcase (plist-get i :kind)
+          ((or 'archive-file-moved 'archive-file-would)
+           (princ (format "    %s:%d: %s %s\n"
+                          (plist-get i :file)
+                          (plist-get i :line)
+                          (if tc-check-only "would archive" "archived")
                           (plist-get i :heading)))))))))
 
 (defun tc--emit-hygiene-report ()