diff options
Diffstat (limited to '.ai/scripts/todo-cleanup.el')
| -rw-r--r-- | .ai/scripts/todo-cleanup.el | 548 |
1 files changed, 535 insertions, 13 deletions
diff --git a/.ai/scripts/todo-cleanup.el b/.ai/scripts/todo-cleanup.el index 6b3081a..c4a87de 100644 --- a/.ai/scripts/todo-cleanup.el +++ b/.ai/scripts/todo-cleanup.el @@ -5,10 +5,14 @@ ;; 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 +;; emacs --batch -q -l todo-cleanup.el --seal todo.org # seal the working archive to resolved-YYYY-MM-DD.org +;; emacs --batch -q -l todo-cleanup.el --seal --check todo.org # preview the seal +;; emacs --batch -q -l todo-cleanup.el --convert-subtasks todo.org # dated-rewrite done level-3+ sub-tasks +;; emacs --batch -q -l todo-cleanup.el --convert-subtasks --check todo.org # preview the conversion ;; emacs --batch -q -l todo-cleanup.el --sync-child-priority todo.org # bump children whose priority drifted below the parent's ;; emacs --batch -q -l todo-cleanup.el --check-child-priority todo.org # preview the sync (same as --sync-child-priority --check) ;; -;; Three independent modes: +;; Four independent modes: ;; ;; * Default (hygiene). Designed for the wrap-it-up workflow: cheap, idempotent, ;; safe to run every session. @@ -25,14 +29,60 @@ ;; 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 is moved +;; out to `tc-archive-file' (default `archive/task-archive.org' beside the +;; todo file) when its CLOSED date is older than `tc-archive-retain-days' +;; (default 31 — one month) OR its CLOSED date can't be parsed. The last +;; month of closed tasks stays browsable in the file itself; older ones age +;; out. The unparseable-CLOSED case archives too, deliberately: a +;; keyword-complete task with no readable close date is cruft, not live +;; work. 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. +;; +;; * --seal (opt-in). Renames the working archive file (`tc-archive-file', +;; default `archive/task-archive.org') to `resolved-YYYY-MM-DD.org' beside it, +;; dated by the seal run, and leaves the next `--archive-done' to recreate a +;; fresh working file. The dated file means "everything sealed as of that +;; date" — not a calendar quarter — so a task closed late in a quarter and +;; archived after the boundary is never mislabeled; cadence (e.g. quarterly) +;; becomes independent of correctness and any slip is harmless. The sealed +;; file inherits the todo file's gitignore status the same way the working +;; archive does. A no-op (reported) when there's no working archive to seal; +;; refuses to clobber an existing `resolved-<today>.org'. Honors `--check'. +;; The seal date is `tc-archive-reference-date' when set (tests), otherwise the +;; real current date. +;; +;; * --convert-subtasks (opt-in). Rewrites every level-3-and-deeper heading whose +;; TODO state is DONE/CANCELLED/FAILED into a dated event-log entry +;; (`<stars> YYYY-MM-DD Day @ HH:MM:SS -ZZZZ <text>'), dropping the keyword, +;; priority cookie, and tags, and removing the now-redundant CLOSED line. The +;; date and time come from that entry's own CLOSED cookie; a date-only close +;; yields 00:00:00, and the UTC offset is computed DST-aware for that date. +;; This enforces the todo-format depth rule that interactive closes +;; (`org-log-done' → DONE + CLOSED) and `--archive-done' (level-2 only) leave +;; unapplied. The heading text is preserved verbatim — a batch tool can't +;; past-tense an imperative title reliably. Idempotent (an already-dated +;; heading has no done keyword); a done sub-task with no parseable CLOSED date +;; is flagged and left alone, never stamped with a fabricated date. Like +;; --archive-done 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,16 +102,33 @@ (require 'org) (require 'cl-lib) +(require 'calendar) (setq org-todo-keywords - '((sequence "TODO" "DOING" "WAITING" "NEXT" "|" "DONE" "CANCELLED"))) + '((sequence "TODO" "DOING" "WAITING" "NEXT" "|" "DONE" "CANCELLED" "FAILED"))) (defconst tc-done-states '("DONE" "CANCELLED") "TODO keywords that mark an entry as completed for `--archive-done'.") +(defconst tc--convert-done-states '("DONE" "CANCELLED" "FAILED") + "TODO keywords whose level-3-and-deeper entries `--convert-subtasks' rewrites +to dated event-log entries. Broader than `tc-done-states' because a FAILED +sub-task is terminal too and belongs in the parent's dated history.") + (defconst tc--priority-cookie-regexp "\\[#\\([A-Z]\\)\\]" "Regexp matching an org priority cookie. Match group 1 is the letter.") +(defconst tc--planning-cookie-regexp + "\\(?:CLOSED\\|DEADLINE\\|SCHEDULED\\):[ \t]*[[<][^]>\n]*[]>]" + "One org planning cookie: a CLOSED/DEADLINE/SCHEDULED keyword followed by a +bracketed (inactive) or angled (active) timestamp.") + +(defconst tc--planning-line-regexp + (concat "\\`[ \t]*\\(?:" tc--planning-cookie-regexp "[ \t]*\\)+\\'") + "A whole org planning line: nothing but planning cookies and whitespace. +Anchored to a single line's contents so a line mixing a cookie with real body +text is never matched.") + (defconst tc-no-sync-tag "no-sync" "Org tag that opts a heading and all its descendants out of `--sync-child-priority'. Inherits down: a tag on an ancestor counts for @@ -70,11 +137,40 @@ every heading below it.") (defvar tc-fixes 0) (defvar tc-archived 0) (defvar tc-bumped 0) +(defvar tc-converted 0) (defvar tc-issues nil) +(defvar tc-sealed 0) (defvar tc-check-only nil) (defvar tc-archive-done nil) (defvar tc-sync-child-priority nil) +(defvar tc-convert-subtasks nil) +(defvar tc-seal nil) (defvar tc-current-file nil) +(defvar tc-current-dir nil) +(defvar tc-archived-to-file 0) + +(defconst tc-archive-retain-days-default 31 + "Default retention window (days) for the `--archive-done' file-aging step — +one month. A closed Resolved subtree stays in-file for this long before it ages +out to `tc-archive-file'; the last month of resolved work stays browsable in the +todo file itself. Named so the \"one month\" contract is explicit and testable.") + +(defvar tc-archive-retain-days tc-archive-retain-days-default + "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 is aged out too (a keyword-complete task +with no readable close date is cruft, not live work). nil disables the aging +step entirely, leaving the legacy in-file-only behavior. Defaults to +`tc-archive-retain-days-default' (one month).") + +(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 +320,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 +349,216 @@ 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)))))))))) + +;;; --------------------------------------------------------------------------- +;;; --seal mode: rename the working archive to a dated resolved-YYYY-MM-DD.org + +(defun tc--seal-date-string () + "YYYY-MM-DD for the seal — `tc-archive-reference-date' when set (tests), +otherwise the real current date." + (if tc-archive-reference-date + (pcase-let ((`(,y ,m ,d) tc-archive-reference-date)) + (format "%04d-%02d-%02d" y m d)) + (format-time-string "%Y-%m-%d"))) + +(defun tc-seal-archive-file () + "Rename the working archive file to `resolved-YYYY-MM-DD.org' beside it. +The next `--archive-done' run recreates a fresh working file. No-op (reported) +when there is no working archive to seal; refuses to clobber an existing +`resolved-<today>.org'. Ensures the sealed file inherits the todo file's +gitignore status. Honors `tc-check-only'." + (let ((path (tc--archive-file-path))) + (cond + ((or (null path) (not (file-readable-p path))) + (push (list :kind 'seal-nothing :file tc-current-file) tc-issues)) + (t + (let* ((dir (file-name-directory path)) + (sealed (expand-file-name + (format "resolved-%s.org" (tc--seal-date-string)) dir))) + (cond + ((file-exists-p sealed) + (push (list :kind 'seal-collision :file tc-current-file + :detail (file-name-nondirectory sealed)) + tc-issues)) + (tc-check-only + (cl-incf tc-sealed) + (push (list :kind 'seal-would :file tc-current-file + :detail (file-name-nondirectory sealed)) + tc-issues)) + (t + ;; Ignore the sealed name before the rename so its history stays as + ;; private as the working archive it derives from. + (tc--ensure-archive-gitignored sealed) + (rename-file path sealed) + (cl-incf tc-sealed) + (push (list :kind 'seal-done :file tc-current-file + :detail (file-name-nondirectory sealed)) + tc-issues)))))))) ;;; --------------------------------------------------------------------------- ;;; --sync-child-priority mode @@ -377,10 +683,158 @@ before their descendants — a [#A] → [#B] → [#D] chain collapses in one pas (org-map-entries #'tc-sync-child-priority-at-heading nil 'file)) ;;; --------------------------------------------------------------------------- +;;; --convert-subtasks mode +;; +;; A sub-task (a heading at level 3 or deeper, i.e. under a parent task) that is +;; marked DONE/CANCELLED/FAILED should become a dated event-log entry per the +;; todo-format depth rule: drop the keyword, priority cookie, and tags, and +;; rewrite the heading to `<stars> YYYY-MM-DD Day @ HH:MM:SS -ZZZZ <text>' so the +;; parent's subtree grows a chronological history instead of a long tail of +;; nested DONE lines. Nothing enforced this before: `org-log-done' just flips an +;; interactive close to DONE + CLOSED, and `--archive-done' only touches level 2. +;; So level-3+ closes piled up as DONE keywords. This mode converts them +;; mechanically, pulling the timestamp from each entry's own CLOSED cookie. The +;; heading text is kept verbatim (a batch tool can't reliably past-tense an +;; imperative title, and guessing prose in the task file is worse than leaving it +;; as written). Idempotent: an already-dated heading has no done keyword, so it +;; is skipped. A done sub-task with no parseable CLOSED cookie can't be dated, so +;; it is flagged and left alone rather than stamped with a fabricated date. +;; +;; The planning line goes entirely. A dated-log entry carries its date in the +;; heading, so CLOSED is redundant and an active DEADLINE/SCHEDULED is wrong: org +;; renders any headline with an active planning timestamp — keyword or not — so a +;; SCHEDULED left on a dated-log heading pins it to the agenda as weeks-overdue +;; long after the work is done. The conversion deletes the whole planning line, +;; not just the CLOSED cookie (todo-format.md; lint checker +;; `dated-log-heading-active-timestamp' backstops any that slip through). + +(defun tc--closed-parts-in-entry () + "Return a plist (:year :month :day :dow :hour :minute) from the CLOSED cookie +of the entry at point, or nil when the entry has no parseable CLOSED line. +:hour and :minute are nil when the cookie carries only a date. The CLOSED line +sits in canonical position directly under the heading, so the first match within +the entry is the task's own close." + (save-excursion + (org-back-to-heading t) + (let ((end (save-excursion + (or (outline-next-heading) (goto-char (point-max))) + (point)))) + (when (re-search-forward + (concat "CLOSED:[ \t]*\\[\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)" + "[ \t]+\\([A-Za-z]+\\)" + "\\(?:[ \t]+\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\]") + end t) + (list :year (match-string 1) :month (match-string 2) :day (match-string 3) + :dow (match-string 4) + :hour (match-string 5) :minute (match-string 6)))))) + +(defun tc--tz-offset-string (year month day hour minute) + "Return the local UTC offset (e.g. \"-0500\") for the given wall-clock instant. +DST-aware: `encode-time' with an unknown-DST field lets the system pick the +correct offset for that date, so a summer close reads -0400 and a winter one +-0500 without hardcoding either." + (format-time-string + "%z" (encode-time (list 0 minute hour day month year nil -1 nil)))) + +(defun tc--dated-header-line (level parts title) + "Build the dated event-log heading string from LEVEL, CLOSED PARTS, and TITLE. +Missing time in PARTS defaults to 00:00:00 (the close logged only a date)." + (let* ((year (plist-get parts :year)) + (month (plist-get parts :month)) + (day (plist-get parts :day)) + (dow (plist-get parts :dow)) + (hh (or (plist-get parts :hour) "00")) + (mm (or (plist-get parts :minute) "00")) + (tz (tc--tz-offset-string (string-to-number year) + (string-to-number month) + (string-to-number day) + (string-to-number hh) + (string-to-number mm)))) + (format "%s %s-%s-%s %s @ %s:%s:00 %s %s" + (make-string level ?*) year month day dow hh mm tz title))) + +(defun tc--convert-collect-targets () + "Markers at every heading at level >= 3 whose TODO state is a done state. +Collected up front so the rewrite loop can edit the buffer without disturbing an +in-progress `org-map-entries' walk; markers track their headings across edits." + (let (targets) + (org-map-entries + (lambda () + (when (and (>= (org-current-level) 3) + (member (org-get-todo-state) tc--convert-done-states)) + (push (copy-marker (point)) targets))) + nil 'file) + (nreverse targets))) + +(defun tc--strip-planning-lines-in-entry () + "Delete the canonical planning line(s) directly under the heading at point. +A planning line is one composed solely of CLOSED/DEADLINE/SCHEDULED cookies and +whitespace. Walks the lines immediately after the heading and stops at the first +non-planning line, so a planning-shaped line deeper in the body (e.g. in a code +block) is never touched. Returns the count of lines removed." + (save-excursion + (org-back-to-heading t) + (forward-line 1) + (let ((removed 0) (continue t)) + (while (and continue (not (eobp))) + (let ((line (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))) + (if (string-match-p tc--planning-line-regexp line) + (progn + (delete-region (line-beginning-position) + (min (1+ (line-end-position)) (point-max))) + (cl-incf removed)) + (setq continue nil)))) + removed))) + +(defun tc--convert-one-subtask (marker) + "Convert the done sub-task heading at MARKER to a dated event-log entry. +Under `tc-check-only' the conversion is reported but not performed." + (goto-char marker) + (org-back-to-heading t) + (let* ((level (org-current-level)) + (title (org-get-heading t t t t)) + (line (line-number-at-pos)) + (parts (tc--closed-parts-in-entry))) + (cond + ((null parts) + (push (list :kind 'convert-skip :file tc-current-file + :line line :heading title + :detail "no CLOSED date to derive the timestamp") + tc-issues)) + (t + (let ((new (tc--dated-header-line level parts title))) + (cl-incf tc-converted) + (if tc-check-only + (push (list :kind 'convert-would :file tc-current-file + :line line :heading title :new new) + tc-issues) + ;; Replace the heading line, then drop the whole planning line. The + ;; date now lives in the header, so CLOSED is redundant and an active + ;; DEADLINE/SCHEDULED would wrongly pin this completed entry to the + ;; agenda (todo-format.md). Both go, not just the CLOSED cookie. + (delete-region (line-beginning-position) (line-end-position)) + (insert new) + (tc--strip-planning-lines-in-entry) + (push (list :kind 'convert-done :file tc-current-file + :line line :heading title :new new) + tc-issues))))))) + +(defun tc-convert-subtasks-in-file () + "Rewrite every level-3-and-deeper DONE/CANCELLED/FAILED heading to a dated +event-log entry, pulling the timestamp from its CLOSED cookie. Honors +`tc-check-only'." + (let ((targets (tc--convert-collect-targets))) + (dolist (m targets) + (tc--convert-one-subtask m) + (set-marker m nil)))) + +;;; --------------------------------------------------------------------------- ;;; Driver + reporting (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 @@ -388,6 +842,10 @@ before their descendants — a [#A] → [#B] → [#D] chain collapses in one pas (tc-archive-done-in-file)) (tc-sync-child-priority (tc-sync-child-priority-in-file)) + (tc-convert-subtasks + (tc-convert-subtasks-in-file)) + (tc-seal + (tc-seal-archive-file)) (t ;; Pass 1: auto-fix bogus state logs (or report under --check). (org-map-entries #'tc-fix-bogus-state-log-in-entry nil 'file) @@ -420,6 +878,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 () @@ -467,9 +940,50 @@ before their descendants — a [#A] → [#B] → [#D] chain collapses in one pas (plist-get i :child-heading) (plist-get i :parent-heading))))))) +(defun tc--emit-convert-report () + ;; Silent on a real-mode no-op (nothing to convert and nothing skipped), for + ;; the same reason as the archive report: the wrap runs cleanup passes more + ;; than once, and a vocal \"0 converted\" reads as noise. Check mode always + ;; reports (the preview is what the caller asked for), and a skip always + ;; reports (a done sub-task with no CLOSED date is a real condition to see). + (let ((has-skip (cl-some (lambda (i) (eq (plist-get i :kind) 'convert-skip)) + tc-issues))) + (when (or tc-check-only (> tc-converted 0) has-skip) + (princ (format "todo-cleanup --convert-subtasks: %d sub-task(s) %s%s\n" + tc-converted + (if tc-check-only "would convert" "converted") + (if tc-check-only " — CHECK MODE (no writes)" ""))) + (dolist (i (reverse tc-issues)) + (pcase (plist-get i :kind) + ((or 'convert-done 'convert-would) + (princ (format " %s:%d: %s\n → %s\n" + (plist-get i :file) (plist-get i :line) + (plist-get i :heading) (plist-get i :new)))) + ('convert-skip + (princ (format " skipped %s:%d: %s — %s\n" + (plist-get i :file) (plist-get i :line) + (plist-get i :heading) (plist-get i :detail))))))))) + +(defun tc--emit-seal-report () + (dolist (i (reverse tc-issues)) + (pcase (plist-get i :kind) + ('seal-done + (princ (format "todo-cleanup --seal: sealed task-archive.org → %s\n" + (plist-get i :detail)))) + ('seal-would + (princ (format "todo-cleanup --seal: would seal task-archive.org → %s — CHECK MODE (no writes)\n" + (plist-get i :detail)))) + ('seal-collision + (princ (format "todo-cleanup --seal: %s already exists — not sealing (already sealed today?)\n" + (plist-get i :detail)))) + ('seal-nothing + (princ "todo-cleanup --seal: no working archive to seal\n"))))) + (defun tc-emit-report () (cond (tc-archive-done (tc--emit-archive-report)) (tc-sync-child-priority (tc--emit-sync-report)) + (tc-convert-subtasks (tc--emit-convert-report)) + (tc-seal (tc--emit-seal-report)) (t (tc--emit-hygiene-report)))) (defun tc-main () @@ -484,6 +998,12 @@ before their descendants — a [#A] → [#B] → [#D] chain collapses in one pas (when (member "--sync-child-priority" command-line-args-left) (setq tc-sync-child-priority t) (setq command-line-args-left (delete "--sync-child-priority" command-line-args-left))) + (when (member "--convert-subtasks" command-line-args-left) + (setq tc-convert-subtasks t) + (setq command-line-args-left (delete "--convert-subtasks" command-line-args-left))) + (when (member "--seal" command-line-args-left) + (setq tc-seal t) + (setq command-line-args-left (delete "--seal" command-line-args-left))) ;; --check-child-priority is the report-only alias for ;; `--sync-child-priority --check'. (when (member "--check-child-priority" command-line-args-left) @@ -491,7 +1011,7 @@ before their descendants — a [#A] → [#B] → [#D] chain collapses in one pas (setq command-line-args-left (delete "--check-child-priority" command-line-args-left))) (if (null command-line-args-left) (progn - (princ "Usage: emacs --batch -q -l todo-cleanup.el [--check] [--archive-done | --sync-child-priority | --check-child-priority] FILE...\n") + (princ "Usage: emacs --batch -q -l todo-cleanup.el [--check] [--archive-done | --seal | --convert-subtasks | --sync-child-priority | --check-child-priority] FILE...\n") (kill-emacs 1)) (let ((files command-line-args-left)) (setq command-line-args-left nil) @@ -510,6 +1030,8 @@ ert-run-tests-batch-and-exit'." (cl-every (lambda (a) (cond ((member a '("--check" "--archive-done" + "--seal" + "--convert-subtasks" "--sync-child-priority" "--check-child-priority")) t) |