diff options
Diffstat (limited to '.ai/scripts/todo-cleanup.el')
| -rw-r--r-- | .ai/scripts/todo-cleanup.el | 192 |
1 files changed, 189 insertions, 3 deletions
diff --git a/.ai/scripts/todo-cleanup.el b/.ai/scripts/todo-cleanup.el index 541d106..bd8166d 100644 --- a/.ai/scripts/todo-cleanup.el +++ b/.ai/scripts/todo-cleanup.el @@ -5,10 +5,12 @@ ;; 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 --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. @@ -52,6 +54,20 @@ ;; Archiving is consequential, so it's never run by default; it does *not* ;; also run the hygiene passes. ;; +;; * --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 ;; is lower (later in the alphabet — D is lower than A), bumps the child's @@ -73,11 +89,16 @@ (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.") @@ -89,10 +110,12 @@ 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-check-only nil) (defvar tc-archive-done nil) (defvar tc-sync-child-priority nil) +(defvar tc-convert-subtasks nil) (defvar tc-current-file nil) (defvar tc-current-dir nil) (defvar tc-archived-to-file 0) @@ -578,6 +601,138 @@ 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. + +(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--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 now-redundant CLOSED + ;; cookie from the entry (its date now lives in the header). Only + ;; the cookie goes: a planning line can also carry DEADLINE: or + ;; SCHEDULED: beside it, and those survive on their line. A line + ;; left blank by the removal is deleted whole. + (delete-region (line-beginning-position) (line-end-position)) + (insert new) + (let ((end (save-excursion + (or (outline-next-heading) (goto-char (point-max))) + (point)))) + (save-excursion + (when (re-search-forward "CLOSED:[ \t]*\\[[^]]*\\][ \t]*" end t) + (replace-match "") + (let ((bol (line-beginning-position)) + (eol (line-end-position))) + (if (string-match-p "\\`[ \t]*\\'" + (buffer-substring bol eol)) + (delete-region bol (min (1+ eol) (point-max))) + (goto-char bol) + (when (looking-at "[ \t]+") + (replace-match ""))))))) + (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) @@ -590,6 +745,8 @@ 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)) (t ;; Pass 1: auto-fix bogus state logs (or report under --check). (org-map-entries #'tc-fix-bogus-state-log-in-entry nil 'file) @@ -684,9 +841,34 @@ 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-report () (cond (tc-archive-done (tc--emit-archive-report)) (tc-sync-child-priority (tc--emit-sync-report)) + (tc-convert-subtasks (tc--emit-convert-report)) (t (tc--emit-hygiene-report)))) (defun tc-main () @@ -701,6 +883,9 @@ 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))) ;; --check-child-priority is the report-only alias for ;; `--sync-child-priority --check'. (when (member "--check-child-priority" command-line-args-left) @@ -708,7 +893,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 | --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) @@ -727,6 +912,7 @@ ert-run-tests-batch-and-exit'." (cl-every (lambda (a) (cond ((member a '("--check" "--archive-done" + "--convert-subtasks" "--sync-child-priority" "--check-child-priority")) t) |