aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.ai/scripts/tests/test-todo-cleanup.el206
-rw-r--r--.ai/scripts/todo-cleanup.el237
-rw-r--r--claude-templates/.ai/scripts/tests/test-todo-cleanup.el206
-rw-r--r--claude-templates/.ai/scripts/todo-cleanup.el237
-rw-r--r--docs/design/2026-06-29-todo-cleanup-aging-proposal.org64
5 files changed, 922 insertions, 28 deletions
diff --git a/.ai/scripts/tests/test-todo-cleanup.el b/.ai/scripts/tests/test-todo-cleanup.el
index ad9260b..e569d9a 100644
--- a/.ai/scripts/tests/test-todo-cleanup.el
+++ b/.ai/scripts/tests/test-todo-cleanup.el
@@ -30,16 +30,20 @@
;;; Harness
(defun tc-test--reset (&optional check)
- (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-issues nil
+ (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-archived-to-file 0 tc-issues nil
tc-check-only (and check t)
tc-archive-done t tc-sync-child-priority nil
- tc-current-file nil))
+ tc-current-file nil
+ ;; Aging step OFF by default so the in-file-move tests are unaffected by
+ ;; the wall clock; the aging harness re-enables it with fixed params.
+ tc-archive-retain-days nil tc-archive-reference-date nil tc-archive-file nil))
(defun tc-test--reset-sync (&optional check)
- (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-issues nil
+ (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-archived-to-file 0 tc-issues nil
tc-check-only (and check t)
tc-archive-done nil tc-sync-child-priority t
- tc-current-file nil))
+ tc-current-file nil
+ tc-archive-retain-days nil tc-archive-reference-date nil tc-archive-file nil))
(defun tc-test--drop-buffer (file)
(let ((buf (find-buffer-visiting file)))
@@ -355,6 +359,200 @@ from the heading line through (not including) the next level-1 heading or EOF."
(should (tc-test--has (plist-get out :report) "skipped"))))
;;; ---------------------------------------------------------------------------
+;;; --archive-done file-aging: keep last week in-file, move older to task-archive
+
+(defun tc-test--age (content &optional opts)
+ "Run `--archive-done' with the file-aging step enabled.
+OPTS is a plist: :retain (days; default 7, may be nil to disable), :ref
+\(YEAR MONTH DAY reference date), :runs (default 1), :check. Writes CONTENT to a
+temp todo file and points `tc-archive-file' at a not-yet-existing temp archive.
+Returns a plist: :result (todo contents), :archive (archive-file contents or
+nil), :archived (in-file move count), :to-file (aged count), :issues — all from
+the last run."
+ (let* ((retain (if (plist-member opts :retain) (plist-get opts :retain) 7))
+ (ref (plist-get opts :ref))
+ (runs (or (plist-get opts :runs) 1))
+ (check (plist-get opts :check))
+ (todo (make-temp-file "tc-age-todo-" nil ".org"))
+ (adir (make-temp-file "tc-age-arch-" t))
+ (afile (expand-file-name "task-archive.org" adir))
+ last)
+ (unwind-protect
+ (progn
+ (with-temp-file todo (insert content))
+ (dotimes (_ runs)
+ (tc-test--reset check)
+ (setq tc-archive-retain-days retain
+ tc-archive-reference-date ref
+ tc-archive-file afile)
+ (tc-process-file todo)
+ (setq last (list :archived tc-archived :to-file tc-archived-to-file
+ :issues tc-issues))
+ (tc-test--drop-buffer todo))
+ (append
+ last
+ (list :result (with-temp-buffer (insert-file-contents todo) (buffer-string))
+ :archive (and (file-readable-p afile)
+ (with-temp-buffer (insert-file-contents afile)
+ (buffer-string))))))
+ (tc-test--drop-buffer todo)
+ (delete-file todo)
+ (delete-directory adir t))))
+
+;; Reference "today" for these fixtures is 2026-06-29; with retain 7 the cutoff
+;; is 2026-06-22, so a task closed on or after 2026-06-22 stays in-file.
+(defconst tc-test--age-resolved "\
+* Age Open Work
+** TODO [#A] still open
+* Age Resolved
+** DONE [#B] recent within window
+CLOSED: [2026-06-25 Thu]
+recent body
+** DONE [#C] old beyond window
+CLOSED: [2026-05-01 Fri]
+old body line
+** CANCELLED [#C] old cancelled too
+CLOSED: [2026-04-15 Wed]
+** DONE [#B] exactly at cutoff stays
+CLOSED: [2026-06-22 Sun]
+** DONE [#C] undated no-date archived
+no closed date in this body
+")
+
+(defconst tc-test--age-straggler "\
+* Age Open Work
+** TODO [#A] still open
+** DONE [#C] old straggler
+CLOSED: [2026-03-01 Sun]
+straggler body
+* Age Resolved
+** DONE [#B] recent stays
+CLOSED: [2026-06-26 Fri]
+")
+
+(ert-deftest tc-age-moves-old-and-undated-resolved ()
+ "Normal: closed-beyond-window AND undated subtrees leave the file; only those
+closed within the window (cutoff inclusive) stay."
+ (let* ((out (tc-test--age tc-test--age-resolved '(:ref (2026 6 29))))
+ (resolved (tc-test--section (plist-get out :result) "Age Resolved"))
+ (arch (plist-get out :archive)))
+ (should (= 3 (plist-get out :to-file)))
+ (should-not (tc-test--has resolved "old beyond window"))
+ (should-not (tc-test--has resolved "old cancelled too"))
+ (should-not (tc-test--has resolved "undated no-date archived"))
+ (should (tc-test--has resolved "recent within window"))
+ (should (tc-test--has resolved "exactly at cutoff stays"))
+ (should arch)
+ (should (tc-test--has arch "Resolved (archived)"))
+ (should (tc-test--has arch "old beyond window"))
+ (should (tc-test--has arch "old body line"))
+ (should (tc-test--has arch "old cancelled too"))
+ (should (tc-test--has arch "undated no-date archived"))
+ (should-not (tc-test--has arch "recent within window"))))
+
+(ert-deftest tc-age-disabled-when-retain-nil ()
+ "Boundary: nil retain disables the aging step entirely (legacy behavior)."
+ (let ((out (tc-test--age tc-test--age-resolved '(:retain nil :ref (2026 6 29)))))
+ (should (= 0 (plist-get out :to-file)))
+ (should (equal tc-test--age-resolved (plist-get out :result)))
+ (should-not (plist-get out :archive))))
+
+(ert-deftest tc-age-is-idempotent ()
+ "Boundary: a second run finds nothing new to age; the todo file is stable."
+ (let ((once (tc-test--age tc-test--age-resolved '(:ref (2026 6 29) :runs 1)))
+ (twice (tc-test--age tc-test--age-resolved '(:ref (2026 6 29) :runs 2))))
+ (should (equal (plist-get once :result) (plist-get twice :result)))
+ (should (= 0 (plist-get twice :to-file)))))
+
+(ert-deftest tc-age-check-mode-previews-without-writing ()
+ "Boundary: --check reports the aged count but writes neither file."
+ (let ((out (tc-test--age tc-test--age-resolved '(:ref (2026 6 29) :check t))))
+ (should (= 3 (plist-get out :to-file)))
+ (should (equal tc-test--age-resolved (plist-get out :result)))
+ (should-not (plist-get out :archive))))
+
+(ert-deftest tc-age-straggler-moves-through-to-archive ()
+ "Normal: an old-dated DONE in Open Work moves to Resolved then ages out in one run."
+ (let* ((out (tc-test--age tc-test--age-straggler '(:ref (2026 6 29))))
+ (open (tc-test--section (plist-get out :result) "Age Open Work"))
+ (resolved (tc-test--section (plist-get out :result) "Age Resolved"))
+ (arch (plist-get out :archive)))
+ (should-not (tc-test--has open "old straggler"))
+ (should-not (tc-test--has resolved "old straggler"))
+ (should (tc-test--has arch "old straggler"))
+ (should (tc-test--has arch "straggler body"))
+ (should (tc-test--has resolved "recent stays"))
+ (should (= 1 (plist-get out :archived)))
+ (should (= 1 (plist-get out :to-file)))))
+
+(ert-deftest tc-age-append-preserves-existing-archive ()
+ "Error/edge: appending to a populated archive keeps prior entries and one scaffold."
+ (let* ((adir (make-temp-file "tc-arch-" t))
+ (afile (expand-file-name "task-archive.org" adir)))
+ (unwind-protect
+ (progn
+ (tc--append-subtrees-to-archive-file afile (list "** DONE one\n"))
+ (tc--append-subtrees-to-archive-file afile (list "** DONE two\n"))
+ (let ((content (with-temp-buffer (insert-file-contents afile)
+ (buffer-string)))
+ (n 0) (start 0))
+ (should (tc-test--has content "** DONE one"))
+ (should (tc-test--has content "** DONE two"))
+ (should (tc-test--before-p content "** DONE one" "** DONE two"))
+ (while (string-match "\\* Resolved (archived)" content start)
+ (setq n (1+ n) start (match-end 0)))
+ (should (= 1 n))))
+ (delete-directory adir t))))
+
+;;; ---------------------------------------------------------------------------
+;;; --archive-done aging: the archive follows the todo file's gitignore status
+
+(defun tc-test--age-in-git-repo (gitignore-todo)
+ "Init a temp git repo, write todo.org with an old Resolved entry, optionally
+gitignore todo.org, then run `--archive-done' aging with the DEFAULT archive path
+(archive/task-archive.org beside the todo file). Return a plist: :gitignore (final
+.gitignore contents or nil), :archive-ignored (whether git ignores the archive),
+:archive-exists."
+ (let* ((root (make-temp-file "tc-git-" t))
+ (todo (expand-file-name "todo.org" root))
+ (archive (expand-file-name "archive/task-archive.org" root))
+ (gi (expand-file-name ".gitignore" root)))
+ (unwind-protect
+ (let ((default-directory root))
+ (call-process "git" nil nil nil "init" "-q")
+ (with-temp-file todo (insert tc-test--age-resolved))
+ (when gitignore-todo (with-temp-file gi (insert "/todo.org\n")))
+ (tc-test--reset nil)
+ (setq tc-archive-retain-days 7
+ tc-archive-reference-date '(2026 6 29)
+ tc-archive-file nil) ; default path, beside the todo file
+ (tc-process-file todo)
+ (tc-test--drop-buffer todo)
+ (list :gitignore (and (file-readable-p gi)
+ (with-temp-buffer (insert-file-contents gi)
+ (buffer-string)))
+ :archive-ignored
+ (eq 0 (call-process "git" nil nil nil "check-ignore" "-q" archive))
+ :archive-exists (file-readable-p archive)))
+ (delete-directory root t))))
+
+(ert-deftest tc-age-self-protect-gitignores-archive-when-todo-ignored ()
+ "When the todo file is gitignored, the aged-out archive is added to .gitignore
+so it inherits the same privacy."
+ (let ((out (tc-test--age-in-git-repo t)))
+ (should (plist-get out :archive-exists))
+ (should (string-match-p "task-archive" (or (plist-get out :gitignore) "")))
+ (should (plist-get out :archive-ignored))))
+
+(ert-deftest tc-age-self-protect-leaves-tracked-todo-archive-tracked ()
+ "When the todo file is tracked, the archive is not gitignored — no .gitignore
+entry is added for it."
+ (let ((out (tc-test--age-in-git-repo nil)))
+ (should (plist-get out :archive-exists))
+ (should-not (plist-get out :archive-ignored))
+ (should-not (string-match-p "task-archive" (or (plist-get out :gitignore) "")))))
+
+;;; ---------------------------------------------------------------------------
;;; Realistic synthetic sample (committed under fixtures/)
(defun tc-test--sample-file ()
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 ()
diff --git a/claude-templates/.ai/scripts/tests/test-todo-cleanup.el b/claude-templates/.ai/scripts/tests/test-todo-cleanup.el
index ad9260b..e569d9a 100644
--- a/claude-templates/.ai/scripts/tests/test-todo-cleanup.el
+++ b/claude-templates/.ai/scripts/tests/test-todo-cleanup.el
@@ -30,16 +30,20 @@
;;; Harness
(defun tc-test--reset (&optional check)
- (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-issues nil
+ (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-archived-to-file 0 tc-issues nil
tc-check-only (and check t)
tc-archive-done t tc-sync-child-priority nil
- tc-current-file nil))
+ tc-current-file nil
+ ;; Aging step OFF by default so the in-file-move tests are unaffected by
+ ;; the wall clock; the aging harness re-enables it with fixed params.
+ tc-archive-retain-days nil tc-archive-reference-date nil tc-archive-file nil))
(defun tc-test--reset-sync (&optional check)
- (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-issues nil
+ (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-archived-to-file 0 tc-issues nil
tc-check-only (and check t)
tc-archive-done nil tc-sync-child-priority t
- tc-current-file nil))
+ tc-current-file nil
+ tc-archive-retain-days nil tc-archive-reference-date nil tc-archive-file nil))
(defun tc-test--drop-buffer (file)
(let ((buf (find-buffer-visiting file)))
@@ -355,6 +359,200 @@ from the heading line through (not including) the next level-1 heading or EOF."
(should (tc-test--has (plist-get out :report) "skipped"))))
;;; ---------------------------------------------------------------------------
+;;; --archive-done file-aging: keep last week in-file, move older to task-archive
+
+(defun tc-test--age (content &optional opts)
+ "Run `--archive-done' with the file-aging step enabled.
+OPTS is a plist: :retain (days; default 7, may be nil to disable), :ref
+\(YEAR MONTH DAY reference date), :runs (default 1), :check. Writes CONTENT to a
+temp todo file and points `tc-archive-file' at a not-yet-existing temp archive.
+Returns a plist: :result (todo contents), :archive (archive-file contents or
+nil), :archived (in-file move count), :to-file (aged count), :issues — all from
+the last run."
+ (let* ((retain (if (plist-member opts :retain) (plist-get opts :retain) 7))
+ (ref (plist-get opts :ref))
+ (runs (or (plist-get opts :runs) 1))
+ (check (plist-get opts :check))
+ (todo (make-temp-file "tc-age-todo-" nil ".org"))
+ (adir (make-temp-file "tc-age-arch-" t))
+ (afile (expand-file-name "task-archive.org" adir))
+ last)
+ (unwind-protect
+ (progn
+ (with-temp-file todo (insert content))
+ (dotimes (_ runs)
+ (tc-test--reset check)
+ (setq tc-archive-retain-days retain
+ tc-archive-reference-date ref
+ tc-archive-file afile)
+ (tc-process-file todo)
+ (setq last (list :archived tc-archived :to-file tc-archived-to-file
+ :issues tc-issues))
+ (tc-test--drop-buffer todo))
+ (append
+ last
+ (list :result (with-temp-buffer (insert-file-contents todo) (buffer-string))
+ :archive (and (file-readable-p afile)
+ (with-temp-buffer (insert-file-contents afile)
+ (buffer-string))))))
+ (tc-test--drop-buffer todo)
+ (delete-file todo)
+ (delete-directory adir t))))
+
+;; Reference "today" for these fixtures is 2026-06-29; with retain 7 the cutoff
+;; is 2026-06-22, so a task closed on or after 2026-06-22 stays in-file.
+(defconst tc-test--age-resolved "\
+* Age Open Work
+** TODO [#A] still open
+* Age Resolved
+** DONE [#B] recent within window
+CLOSED: [2026-06-25 Thu]
+recent body
+** DONE [#C] old beyond window
+CLOSED: [2026-05-01 Fri]
+old body line
+** CANCELLED [#C] old cancelled too
+CLOSED: [2026-04-15 Wed]
+** DONE [#B] exactly at cutoff stays
+CLOSED: [2026-06-22 Sun]
+** DONE [#C] undated no-date archived
+no closed date in this body
+")
+
+(defconst tc-test--age-straggler "\
+* Age Open Work
+** TODO [#A] still open
+** DONE [#C] old straggler
+CLOSED: [2026-03-01 Sun]
+straggler body
+* Age Resolved
+** DONE [#B] recent stays
+CLOSED: [2026-06-26 Fri]
+")
+
+(ert-deftest tc-age-moves-old-and-undated-resolved ()
+ "Normal: closed-beyond-window AND undated subtrees leave the file; only those
+closed within the window (cutoff inclusive) stay."
+ (let* ((out (tc-test--age tc-test--age-resolved '(:ref (2026 6 29))))
+ (resolved (tc-test--section (plist-get out :result) "Age Resolved"))
+ (arch (plist-get out :archive)))
+ (should (= 3 (plist-get out :to-file)))
+ (should-not (tc-test--has resolved "old beyond window"))
+ (should-not (tc-test--has resolved "old cancelled too"))
+ (should-not (tc-test--has resolved "undated no-date archived"))
+ (should (tc-test--has resolved "recent within window"))
+ (should (tc-test--has resolved "exactly at cutoff stays"))
+ (should arch)
+ (should (tc-test--has arch "Resolved (archived)"))
+ (should (tc-test--has arch "old beyond window"))
+ (should (tc-test--has arch "old body line"))
+ (should (tc-test--has arch "old cancelled too"))
+ (should (tc-test--has arch "undated no-date archived"))
+ (should-not (tc-test--has arch "recent within window"))))
+
+(ert-deftest tc-age-disabled-when-retain-nil ()
+ "Boundary: nil retain disables the aging step entirely (legacy behavior)."
+ (let ((out (tc-test--age tc-test--age-resolved '(:retain nil :ref (2026 6 29)))))
+ (should (= 0 (plist-get out :to-file)))
+ (should (equal tc-test--age-resolved (plist-get out :result)))
+ (should-not (plist-get out :archive))))
+
+(ert-deftest tc-age-is-idempotent ()
+ "Boundary: a second run finds nothing new to age; the todo file is stable."
+ (let ((once (tc-test--age tc-test--age-resolved '(:ref (2026 6 29) :runs 1)))
+ (twice (tc-test--age tc-test--age-resolved '(:ref (2026 6 29) :runs 2))))
+ (should (equal (plist-get once :result) (plist-get twice :result)))
+ (should (= 0 (plist-get twice :to-file)))))
+
+(ert-deftest tc-age-check-mode-previews-without-writing ()
+ "Boundary: --check reports the aged count but writes neither file."
+ (let ((out (tc-test--age tc-test--age-resolved '(:ref (2026 6 29) :check t))))
+ (should (= 3 (plist-get out :to-file)))
+ (should (equal tc-test--age-resolved (plist-get out :result)))
+ (should-not (plist-get out :archive))))
+
+(ert-deftest tc-age-straggler-moves-through-to-archive ()
+ "Normal: an old-dated DONE in Open Work moves to Resolved then ages out in one run."
+ (let* ((out (tc-test--age tc-test--age-straggler '(:ref (2026 6 29))))
+ (open (tc-test--section (plist-get out :result) "Age Open Work"))
+ (resolved (tc-test--section (plist-get out :result) "Age Resolved"))
+ (arch (plist-get out :archive)))
+ (should-not (tc-test--has open "old straggler"))
+ (should-not (tc-test--has resolved "old straggler"))
+ (should (tc-test--has arch "old straggler"))
+ (should (tc-test--has arch "straggler body"))
+ (should (tc-test--has resolved "recent stays"))
+ (should (= 1 (plist-get out :archived)))
+ (should (= 1 (plist-get out :to-file)))))
+
+(ert-deftest tc-age-append-preserves-existing-archive ()
+ "Error/edge: appending to a populated archive keeps prior entries and one scaffold."
+ (let* ((adir (make-temp-file "tc-arch-" t))
+ (afile (expand-file-name "task-archive.org" adir)))
+ (unwind-protect
+ (progn
+ (tc--append-subtrees-to-archive-file afile (list "** DONE one\n"))
+ (tc--append-subtrees-to-archive-file afile (list "** DONE two\n"))
+ (let ((content (with-temp-buffer (insert-file-contents afile)
+ (buffer-string)))
+ (n 0) (start 0))
+ (should (tc-test--has content "** DONE one"))
+ (should (tc-test--has content "** DONE two"))
+ (should (tc-test--before-p content "** DONE one" "** DONE two"))
+ (while (string-match "\\* Resolved (archived)" content start)
+ (setq n (1+ n) start (match-end 0)))
+ (should (= 1 n))))
+ (delete-directory adir t))))
+
+;;; ---------------------------------------------------------------------------
+;;; --archive-done aging: the archive follows the todo file's gitignore status
+
+(defun tc-test--age-in-git-repo (gitignore-todo)
+ "Init a temp git repo, write todo.org with an old Resolved entry, optionally
+gitignore todo.org, then run `--archive-done' aging with the DEFAULT archive path
+(archive/task-archive.org beside the todo file). Return a plist: :gitignore (final
+.gitignore contents or nil), :archive-ignored (whether git ignores the archive),
+:archive-exists."
+ (let* ((root (make-temp-file "tc-git-" t))
+ (todo (expand-file-name "todo.org" root))
+ (archive (expand-file-name "archive/task-archive.org" root))
+ (gi (expand-file-name ".gitignore" root)))
+ (unwind-protect
+ (let ((default-directory root))
+ (call-process "git" nil nil nil "init" "-q")
+ (with-temp-file todo (insert tc-test--age-resolved))
+ (when gitignore-todo (with-temp-file gi (insert "/todo.org\n")))
+ (tc-test--reset nil)
+ (setq tc-archive-retain-days 7
+ tc-archive-reference-date '(2026 6 29)
+ tc-archive-file nil) ; default path, beside the todo file
+ (tc-process-file todo)
+ (tc-test--drop-buffer todo)
+ (list :gitignore (and (file-readable-p gi)
+ (with-temp-buffer (insert-file-contents gi)
+ (buffer-string)))
+ :archive-ignored
+ (eq 0 (call-process "git" nil nil nil "check-ignore" "-q" archive))
+ :archive-exists (file-readable-p archive)))
+ (delete-directory root t))))
+
+(ert-deftest tc-age-self-protect-gitignores-archive-when-todo-ignored ()
+ "When the todo file is gitignored, the aged-out archive is added to .gitignore
+so it inherits the same privacy."
+ (let ((out (tc-test--age-in-git-repo t)))
+ (should (plist-get out :archive-exists))
+ (should (string-match-p "task-archive" (or (plist-get out :gitignore) "")))
+ (should (plist-get out :archive-ignored))))
+
+(ert-deftest tc-age-self-protect-leaves-tracked-todo-archive-tracked ()
+ "When the todo file is tracked, the archive is not gitignored — no .gitignore
+entry is added for it."
+ (let ((out (tc-test--age-in-git-repo nil)))
+ (should (plist-get out :archive-exists))
+ (should-not (plist-get out :archive-ignored))
+ (should-not (string-match-p "task-archive" (or (plist-get out :gitignore) "")))))
+
+;;; ---------------------------------------------------------------------------
;;; Realistic synthetic sample (committed under fixtures/)
(defun tc-test--sample-file ()
diff --git a/claude-templates/.ai/scripts/todo-cleanup.el b/claude-templates/.ai/scripts/todo-cleanup.el
index 6b3081a..541d106 100644
--- a/claude-templates/.ai/scripts/todo-cleanup.el
+++ b/claude-templates/.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 ()
diff --git a/docs/design/2026-06-29-todo-cleanup-aging-proposal.org b/docs/design/2026-06-29-todo-cleanup-aging-proposal.org
new file mode 100644
index 0000000..5a18990
--- /dev/null
+++ b/docs/design/2026-06-29-todo-cleanup-aging-proposal.org
@@ -0,0 +1,64 @@
+#+TITLE: todo-cleanup.el — add Resolved-section file-aging to --archive-done
+
+* What changed (from .emacs.d, 2026-06-29)
+
+Extended =todo-cleanup.el='s =--archive-done= mode (the =make task-sorted=
+target) with a SECOND step, run after the existing Open Work -> Resolved move:
+
+- *Age the Resolved section.* Level-2 DONE/CANCELLED subtrees whose CLOSED date
+ is older than =tc-archive-retain-days= (default 7) — AND any with no parseable
+ CLOSED date — move out of the in-file Resolved section to =tc-archive-file=
+ (default =archive/task-archive.org= beside the todo file). Only tasks closed
+ within the last week stay in todo.org itself.
+
+Two files are attached (the edited canonical candidates):
+- =todo-cleanup.el=
+- =tests/test-todo-cleanup.el=
+
+* Why
+
+Craig's .emacs.d todo.org had grown to 768KB / 9616 lines, ~44% of it a
+243-task in-file "Resolved" section. The existing =--archive-done= only moved
+closures Open Work -> Resolved (same file), so the file grew without bound. The
+new step keeps only the last week of closed tasks in the file and sheds the rest
+to a git-tracked archive sibling. After this run: 207 aged out, todo.org
+9616 -> 5625 lines.
+
+* Design notes for the canonical
+
+- New defvars: =tc-archive-retain-days= (7; nil disables the step, preserving
+ legacy in-file-only behavior), =tc-archive-reference-date= ((YEAR MONTH DAY),
+ nil=real today — mockable for deterministic tests), =tc-archive-file= (nil =>
+ =archive/task-archive.org= beside the todo file).
+- Policy: KEEP iff CLOSED date present AND within the window (cutoff inclusive).
+ Older OR undated => archive. The undated->archive call is deliberate ("keep
+ the last week and that's it"); an earlier undated->keep version left 14 legacy
+ undated tasks behind and read as two weeks.
+- The aging step honors =--check= (previews + reports, writes nothing).
+- Report: an additive "N aged subtree(s) moved to task-archive.org" line, only
+ when N>0, so the existing real-mode-no-op silence tests are unaffected.
+- Archive file scaffold: =#+TITLE: Task Archive= / =#+FILETAGS: :archive:= /
+ =* Resolved (archived)=; aged subtrees append as level-2 children; created on
+ first use, appended to thereafter (one scaffold, never duplicated).
+- Tests: =tc-test--reset= now sets the aging knobs OFF (retain nil) so the
+ existing in-file-move + sync tests are untouched by the wall clock; a new
+ =tc-test--age= harness re-enables them with a fixed reference date and a temp
+ archive file. 6 new tests (old+undated move, cutoff-inclusive stay, disabled,
+ idempotent, check-no-write, straggler pipeline, append-preserves). 34/34 green.
+
+* Cross-project consideration for your value gate
+
+Default is ON (retain 7) for ALL consuming projects once this syncs. A project's
+first =task-sorted= after the sync will shed everything in its Resolved section
+older than a week to a new =archive/task-archive.org=. That's the intended
+feature, but flag it — projects with a large historical Resolved section will see
+a big first-run move (git-tracked, recoverable). Adjust the default or gate it if
+you'd rather it be opt-in per project.
+
+* Companion (project-local, NOT synced)
+
+.emacs.d's Makefile =task-sorted= target now also runs =lint-org.el todo.org=
+after the archive, as a structural-safety pass (org-lint catches links/drawers/
+blocks; we separately verified heading-level structure by hand). Makefiles aren't
+template-synced, so this is per-project — noting it in case the pattern is worth
+documenting alongside the tool.