diff options
Diffstat (limited to '.ai/scripts/lint-org.el')
| -rw-r--r-- | .ai/scripts/lint-org.el | 388 |
1 files changed, 366 insertions, 22 deletions
diff --git a/.ai/scripts/lint-org.el b/.ai/scripts/lint-org.el index 8f55cc6..33dc52f 100644 --- a/.ai/scripts/lint-org.el +++ b/.ai/scripts/lint-org.el @@ -2,16 +2,19 @@ ;; ;; Usage: ;; emacs --batch -q -l lint-org.el FILE.org [FILE.org ...] +;; report only (the default) — categorize without modifying the file. +;; A linter reports, it doesn't write; mutation requires --fix. +;; --check is accepted as an explicit alias of this default. +;; +;; emacs --batch -q -l lint-org.el --fix FILE.org [FILE.org ...] ;; apply mechanical fixes in place, emit judgment items on stdout for the ;; command layer to walk ;; -;; emacs --batch -q -l lint-org.el --check FILE.org [FILE.org ...] -;; report only — categorize without modifying the file -;; -;; emacs --batch -q -l lint-org.el --followups-file=PATH FILE.org +;; emacs --batch -q -l lint-org.el --fix --followups-file=PATH FILE.org ;; apply mechanical fixes; if any judgment items remain, append them to ;; PATH as an org section dated today. Used by wrap-it-up to defer the ;; judgment walk to the next morning's review without blocking the wrap. +;; (--followups-file only writes in --fix mode.) ;; ;; Mechanical categories (auto-fixed): ;; item-number add [@N] directive to drifted bullets @@ -29,6 +32,15 @@ ;; link-to-local-file broken file: links ;; invalid-fuzzy-link broken *Heading refs ;; suspicious-language-in-src-block unknown source-block language +;; org-table-standard table wider than budget / missing rules +;; level-2-dated-header ** dated header instead of a keyword +;; indented-heading whitespace before stars (demoted to body) +;; empty-heading bare stars with no title +;; malformed-priority-cookie [#x]-shaped token org rejected +;; level2-done-without-closed completed level-2 task with no CLOSED +;; task-missing-last-reviewed open level-2 task with no :LAST_REVIEWED: +;; subtask-done-not-dated level-3+ done sub-task still a DONE keyword +;; dated-log-heading-active-timestamp dated-log heading with a live SCHEDULED/DEADLINE ;; (anything else) surfaced as judgment with checker name ;; ;; Output format on stdout: @@ -59,9 +71,23 @@ Each plist has :kind (mechanical-fixed | judgment), :line, :checker, :msg. Mechanical entries from --check mode also carry :preview t.") (defvar lo-check-only nil - "Non-nil means run in report-only mode — no buffer writes.") + "Non-nil means run in report-only mode — no buffer writes. +The CLI defaults this to t (a linter reports, it doesn't write); +`--fix' is what enables writes on a command-line run.") (defvar lo-current-file nil "Path of the file currently being processed.") + +(defun lo--spec-file-p () + "Non-nil when the current file lives under a docs/specs/ directory. +The four todo-format-family checkers encode todo.org completion conventions +and misfire on a spec: a spec's Decisions section legitimately carries a +level-2 DONE with no CLOSED cookie, and its review-history section carries +level-2 dated headings. docs/specs/ is the canonical spec home per the +docs-lifecycle rule, so a path segment match is the scope test. Link, +table, and structural checks still run on specs — only the todo-format +family is scoped out." + (and lo-current-file + (string-match-p "/docs/specs/" (expand-file-name lo-current-file)))) (defvar lo-followups-file nil "When non-nil, after a non-check run any judgment items are appended to this path as an org section dated today. The file is created if missing.") @@ -280,6 +306,52 @@ Craig-specific annotation marker rather than Babel src-block syntax." (lo--goto-line line) (looking-at-p "^[ \t]*#\\+begin_src[ \t]+cj:"))) +(defvar-local lo--matched-blocks-cache nil + "Cons of (TICK . REGIONS) memoizing `lo--matched-block-regions'. +TICK is the `buffer-chars-modified-tick' the regions were computed at, so a +fix applied mid-pass invalidates them.") + +(defun lo--matched-block-regions () + "Return ((BEGIN-LINE . END-LINE) ...) for every correctly paired block. +Scans lines directly rather than asking org, because org's own parser is what +mis-reads these blocks: a heading-shaped line inside a verbatim body reads as a +structural break and loses the open block. The scan applies org's real rule — +once a block is open, only its own `#+end_TYPE' closes it, so a nested +`#+begin_' or a foreign `#+end_' in the body is just text." + (let ((tick (buffer-chars-modified-tick))) + (if (eql (car lo--matched-blocks-cache) tick) + (cdr lo--matched-blocks-cache) + (let ((case-fold-search t) + (regions nil) (open-type nil) (open-line nil) (line 0)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (setq line (1+ line)) + (let ((text (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))) + (cond + (open-type + (when (string-match + (format "\\`[ \t]*#\\+end_%s[ \t]*\\'" + (regexp-quote open-type)) + text) + (push (cons open-line line) regions) + (setq open-type nil open-line nil))) + ((string-match "\\`[ \t]*#\\+begin_\\([^ \t\n]+\\)" text) + (setq open-type (match-string 1 text) + open-line line)))) + (forward-line 1))) + (setq lo--matched-blocks-cache (cons tick (nreverse regions))) + (cdr lo--matched-blocks-cache))))) + +(defun lo--in-matched-block-p (line) + "Non-nil when LINE sits within a correctly paired block, delimiters included. +org-lint reports `invalid-block' at the delimiter lines themselves, so the +range has to be inclusive for the suppression to reach them." + (cl-some (lambda (region) + (and (>= line (car region)) (<= line (cdr region)))) + (lo--matched-block-regions))) + (defun lo--handle-item (item) (let ((name (lo--checker-name item)) (line (lo--line item)) @@ -292,6 +364,13 @@ Craig-specific annotation marker rather than Babel src-block syntax." wrong-header-argument)) (lo--cj-comment-block-opener-p line)) nil) + ;; `invalid-block' on a block that is in fact correctly paired — the + ;; checker is org-lint's own, so this filters its output rather than + ;; fixing a local checker. A genuinely unterminated block isn't in any + ;; matched region, so it still reports. + ((and (eq name 'invalid-block) + (lo--in-matched-block-p line)) + nil) ((eq name 'item-number) (lo--apply-or-preview name line msg #'lo-fix-item-number)) ((eq name 'missing-language-in-src-block) @@ -348,24 +427,266 @@ logical row, matching wrap-org-table.el's grouping." (defun lo--check-tables () "Scan the current buffer for org tables violating the table standard. -Emits one judgment item per violating table." +Emits one judgment item per violating table. Pipe-led lines inside +#+begin_/#+end_ blocks are content (ASCII art, shell pipes), not tables, +and are skipped — the same block rule `wot-process-file' applies." (save-excursion (goto-char (point-min)) - (while (re-search-forward "^[ \t]*|" nil t) - (let ((start-line (line-number-at-pos)) - (lines nil)) - (beginning-of-line) - (while (and (not (eobp)) (looking-at "[ \t]*|")) - (push (buffer-substring-no-properties (line-beginning-position) - (line-end-position)) - lines) + (let ((in-block nil)) ; the open block's type, e.g. "example" — nil outside + (while (not (eobp)) + (cond + ;; Type-matched close only: literal #+end_src quoted inside an + ;; example block must not clear the flag (see wot-process-file). + ((and (not in-block) + (looking-at "^[ \t]*#\\+begin_\\([^ \t\n]+\\)")) + (setq in-block (downcase (match-string 1))) + (forward-line 1)) + ((and in-block + (looking-at-p (format "^[ \t]*#\\+end_%s\\([ \t]\\|$\\)" + (regexp-quote in-block)))) + (setq in-block nil) (forward-line 1)) - (let ((violations (lo--table-violations (nreverse lines)))) - (when violations - (lo--emit-judgment - 'org-table-standard start-line - (format "table violates the org-table standard: %s — wrap-org-table.el reflows it" - (string-join violations "; "))))))))) + ((and (not in-block) (looking-at-p "^[ \t]*|")) + (let ((start-line (line-number-at-pos)) + (lines nil)) + (while (and (not (eobp)) (looking-at "[ \t]*|")) + (push (buffer-substring-no-properties (line-beginning-position) + (line-end-position)) + lines) + (forward-line 1)) + (let ((violations (lo--table-violations (nreverse lines)))) + (when violations + (lo--emit-judgment + 'org-table-standard start-line + (format "table violates the org-table standard: %s — wrap-org-table.el reflows it" + (string-join violations "; "))))))) + (t (forward-line 1))))))) + +;;; --------------------------------------------------------------------------- +;;; level-2 dated-header check (claude-rules/todo-format.md) +;; +;; A completed task or resolved VERIFY at level 2 must carry a terminal +;; keyword (DONE/CANCELLED + CLOSED:), never a dated heading. A `** <date>' +;; header has no keyword, so todo-cleanup's --archive-done can never archive +;; it (it accumulates in Open Work forever) and task-review drops it from +;; selection. Judgment-only, never auto-fixed: the repair needs a +;; DONE-vs-CANCELLED call and the original heading text, which is a judgment +;; the sweep can't make. Targets todo/task files; a dated-log-format org +;; file using `** <date>' headings intentionally will false-positive here, in +;; which case the human dismisses the judgment item. + +(defun lo--check-level2-dated-headers () + "Flag level-2 headings whose text begins with a YYYY-MM-DD date. +Emits one judgment item per offending heading (checker +`level-2-dated-header')." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward + "^\\*\\* \\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)" nil t) + (lo--emit-judgment + 'level-2-dated-header (line-number-at-pos) + "level-2 dated header is a completion defect (todo-format.md): a ** task or VERIFY closes with DONE/CANCELLED + CLOSED:, not a dated heading — convert it so --archive-done can archive it")))) + +;;; --------------------------------------------------------------------------- +;;; structural heading checks (mistakes org-lint does not cover) +;; +;; org-lint validates links, drawers, blocks, and babel — but not heading +;; well-formedness. These four catch hand-edit defects it misses, all +;; judgment-only (each repair is a human call) and regex-based (no dependence on +;; which TODO keywords the batch Emacs happens to recognize): +;; +;; indented-heading leading whitespace before two-or-more stars; org +;; demotes it to body text, so the task vanishes from +;; the agenda and never archives. The worst case — an +;; invisible task — and silent. Single `*' is left +;; alone (a valid indented plain-list bullet). +;; empty-heading a line of bare stars with no title. +;; malformed-priority-cookie a `[#x]'-shaped token org rejected (lowercase, +;; multi-char, non-letter) sitting where a cookie +;; would be. +;; level2-done-without-closed a level-2 DONE/CANCELLED with no CLOSED line — +;; directly relevant to todo-cleanup's aging step, +;; which archives an undated completed task at once. + +(defconst lo-done-keywords '("DONE" "CANCELLED") + "Heading keywords treated as completed for `lo--check-level2-done-without-closed'.") + +(defun lo--check-indented-headings () + "Flag lines that are whitespace + two-or-more stars + space outside any block. +Org parses a heading only at column 0, so leading whitespace silently demotes a +would-be heading to body text. Two-or-more stars is required: an indented +single `*' is a valid plain-list bullet, not a lost heading, so flagging it +false-positives on legitimate lists; `**'+ is never a bullet, so an indented one +is unambiguously a demoted level-2+ heading turned invisible. Lines inside +`#+begin_/#+end_' blocks are skipped — indented asterisks there are legitimate +content." + (save-excursion + (goto-char (point-min)) + (let ((in-block nil)) + (while (not (eobp)) + (cond + ((looking-at-p "^[ \t]*#\\+begin_") (setq in-block t)) + ((looking-at-p "^[ \t]*#\\+end_") (setq in-block nil)) + ((and (not in-block) (looking-at-p "^[ \t]+\\*\\*+[ \t]")) + (lo--emit-judgment + 'indented-heading (line-number-at-pos) + "indented heading: leading whitespace before the stars demotes this to body text — org won't treat it as a heading (it vanishes from the agenda and never archives); dedent to column 0"))) + (forward-line 1))))) + +(defun lo--check-empty-headings () + "Flag headings that are bare stars with no title text. +A line of nothing but stars is an empty heading — a stray heading-star carrying +no content." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^\\*+[ \t]*$" nil t) + (lo--emit-judgment + 'empty-heading (line-number-at-pos) + "empty heading: a line of stars with no title — delete it or give it a title")))) + +(defun lo--check-malformed-priority-cookies () + "Flag a heading whose first cookie-shaped token is not a valid priority. +A valid cookie is a single uppercase letter in `[#A]' form. Verbatim-wrapped +cookies (`=[#D]=' quoted in a dated-log title) are skipped. Only the first +token on the line is checked, so a real cookie earlier on the line means a +later `[#x]' in the title is left alone." + (save-excursion + (goto-char (point-min)) + ;; Case-sensitive: a cookie is uppercase only, and case-fold-search defaults + ;; to t (which would accept [#a] as valid). + (let ((case-fold-search nil)) + (while (re-search-forward "^\\*+ " nil t) + (let ((eol (line-end-position)) (hline (line-number-at-pos))) + (when (re-search-forward "\\[#\\([^]]*\\)\\]" eol t) + (let ((inner (match-string 1)) + (before (char-before (match-beginning 0))) + (after (char-after (match-end 0)))) + (unless (or (eq before ?=) (eq after ?=) + (string-match-p "\\`[A-Z]\\'" inner)) + (lo--emit-judgment + 'malformed-priority-cookie hline + (format "malformed priority cookie [#%s] — a cookie is a single uppercase letter ([#A]) right after the keyword; fix or remove it" + inner))))) + (goto-char eol)))))) + +(defun lo--check-level2-done-without-closed () + "Flag a level-2 DONE/CANCELLED heading with no CLOSED line in its own entry. +todo-cleanup's `--archive-done' aging step archives a completed task with no +parseable CLOSED date immediately, so an undated completed task silently leaves +the live file on the next `task-sorted'." + (save-excursion + (goto-char (point-min)) + ;; Case-sensitive: DONE/CANCELLED are uppercase keywords, not the words + ;; "done"/"cancelled" in a heading title (case-fold-search defaults to t). + (let ((case-fold-search nil) + (re (format "^\\*\\* \\(%s\\) " + (mapconcat #'regexp-quote lo-done-keywords "\\|")))) + (while (re-search-forward re nil t) + (let ((hline (line-number-at-pos)) + (entry-end (save-excursion (outline-next-heading) (point)))) + (save-excursion + (forward-line 1) + (unless (re-search-forward "^[ \t]*CLOSED:[ \t]*\\[" entry-end t) + (lo--emit-judgment + 'level2-done-without-closed hline + "level-2 DONE/CANCELLED has no CLOSED date — add CLOSED: [YYYY-MM-DD Day]; task-sorted's aging step archives an undated completed task immediately")))))))) + +;;; --------------------------------------------------------------------------- +;;; task-missing-last-reviewed check (claude-rules/todo-format.md) +;; +;; A task is stamped `:LAST_REVIEWED:' when it is *created*, not a review cycle +;; later. An agent filing a task has just written its body and graded its +;; priority, which is a review by any honest reading — so a fresh task that +;; carries no stamp reads as "never reviewed" and lands at the top of the next +;; staleness batch, where re-reviewing it is pure ceremony. Every task filed +;; during the 2026-07-23 sweep hit exactly that, which is what prompted the rule. +;; +;; Judgment-only, deliberately. The stamp's whole value is that its date is +;; true, and nothing here can know when an unstamped task was actually last +;; looked at. Auto-stamping today's date would convert a "nobody has reviewed +;; this" signal into a false "reviewed today" one — worse than the gap it +;; closes. Flag it; a human or the filing workflow supplies the honest date. +;; +;; Scope matches `task-review-staleness.sh' exactly (level-2, open keyword, +;; priority cookie), so the checker and the staleness count never disagree +;; about which headings are in the review pool. + +(defun lo--check-task-missing-last-reviewed () + "Flag an open level-2 task with a priority cookie and no `:LAST_REVIEWED:'." + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search nil)) + (while (re-search-forward "^\\*\\* \\(TODO\\|DOING\\|VERIFY\\) \\[#[A-D]\\]" nil t) + (let ((hline (line-number-at-pos)) + (entry-end (save-excursion (outline-next-heading) (point)))) + (save-excursion + (forward-line 1) + (unless (re-search-forward "^[ \t]*:LAST_REVIEWED:[ \t]*[[0-9]" + entry-end t) + (lo--emit-judgment + 'task-missing-last-reviewed hline + "task has no :LAST_REVIEWED: — stamp it at creation with today's date (a task you just wrote and graded is reviewed); otherwise it enters the next staleness batch as never-reviewed")))))))) + +;;; --------------------------------------------------------------------------- +;;; level-3+ dated-header check (claude-rules/todo-format.md) +;; +;; The inverse of the level-2 check above. A completed sub-task — a heading at +;; level 3 or deeper, under a parent task — becomes a dated event-log entry, not +;; a DONE keyword, so the parent's subtree grows a chronological history instead +;; of a long tail of nested DONE lines. An interactive org close +;; (`org-log-done' → DONE + CLOSED) leaves the keyword in place, and +;; `--archive-done' only touches level 2, so these accumulate. Flag them for +;; conversion. Judgment-only and regex-based (independent of which TODO keywords +;; the batch Emacs recognizes); todo-cleanup.el --convert-subtasks does the fix. + +(defun lo--check-subtask-done-not-dated () + "Flag level-3+ headings carrying a done keyword (DONE/CANCELLED/FAILED). +Emits one judgment item per offending heading (checker +`subtask-done-not-dated')." + (save-excursion + (goto-char (point-min)) + ;; Case-sensitive: the keywords are uppercase, not the words in a title. + (let ((case-fold-search nil)) + (while (re-search-forward + "^\\*\\{3,\\} \\(DONE\\|CANCELLED\\|FAILED\\) " nil t) + (lo--emit-judgment + 'subtask-done-not-dated (line-number-at-pos) + "level-3+ done sub-task should be a dated event-log entry (todo-format.md): run todo-cleanup.el --convert-subtasks to rewrite it"))))) + +;;; --------------------------------------------------------------------------- +;;; dated-log heading with a stale active planning timestamp (todo-format.md) +;; +;; The mechanical backstop for the planning-line-strip rule. A dated event-log +;; heading (`<stars> YYYY-MM-DD Day @ ...', no TODO keyword) records completed +;; work — its date lives in the heading. An active `<...>' SCHEDULED or DEADLINE +;; left on it pins the entry to the agenda forever: org renders any headline with +;; an active planning timestamp, keyword or not, so a stale SCHEDULED shows as +;; weeks-overdue long after the work is done. Invisible to a keyword scan (no +;; TODO) and it survives --archive-done, so nothing else catches it. The +;; completion rewrite and todo-cleanup --convert-subtasks now strip the planning +;; line; this flags any that slipped through before that landed, the same way +;; subtask-done-not-dated backstops the depth rule. Judgment-only. + +(defun lo--check-dated-log-active-timestamp () + "Flag a dated event-log heading that still carries an active SCHEDULED/DEADLINE. +The heading matches `<stars> YYYY-MM-DD Day @ ...' with no TODO keyword; an +active `<...>' planning timestamp in its entry is the defect. An inactive +`[...]' timestamp is ignored (org doesn't render it on the agenda). Emits one +judgment item per offending heading (checker `dated-log-heading-active-timestamp')." + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search nil)) + (while (re-search-forward + "^\\*+ [0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [A-Za-z]+ @ " nil t) + (let ((hline (line-number-at-pos)) + (entry-end (save-excursion (outline-next-heading) (point)))) + (save-excursion + (forward-line 1) + (when (re-search-forward + "^[ \t]*\\(?:SCHEDULED\\|DEADLINE\\):[ \t]*<" entry-end t) + (lo--emit-judgment + 'dated-log-heading-active-timestamp hline + "dated-log heading carries an active SCHEDULED/DEADLINE — org renders any active planning timestamp (keyword or not), so it stays on the agenda as weeks-overdue; delete the planning line (todo-format.md)")))))))) ;;; --------------------------------------------------------------------------- ;;; File processing @@ -401,6 +722,22 @@ left unmodified and mechanical entries are recorded with :preview t." ;; After org-lint items: the custom table-standard scan. Runs on the ;; post-fix buffer; judgment-only, so order doesn't perturb fixes. (lo--check-tables) + ;; Structural heading defects org-lint doesn't cover. These run on + ;; every org file, specs included. + (lo--check-indented-headings) + (lo--check-empty-headings) + (lo--check-malformed-priority-cookies) + ;; The todo-format family encodes todo.org completion conventions and + ;; misfires on a spec (a Decisions section's undated DONE, a + ;; review-history dated heading, a phases task with no LAST_REVIEWED). + ;; Scope them out of docs/specs/; link, table, and structural checks + ;; above still run there. + (unless (lo--spec-file-p) + (lo--check-level2-dated-headers) + (lo--check-level2-done-without-closed) + (lo--check-task-missing-last-reviewed) + (lo--check-subtask-done-not-dated) + (lo--check-dated-log-active-timestamp)) (when (and (not lo-check-only) (buffer-modified-p)) (save-buffer))) (with-current-buffer buf (set-buffer-modified-p nil)) @@ -507,6 +844,13 @@ After printing, also append judgments to `lo-followups-file' when set." ;;; CLI (defun lo-main () + ;; Report-only is the CLI default; --fix is the only way a command-line run + ;; writes to disk. The old mutate-by-default reformatted five files in one + ;; pass before anyone confirmed anything (work project, 2026-07-09). + (setq lo-check-only t) + (when (member "--fix" command-line-args-left) + (setq lo-check-only nil) + (setq command-line-args-left (delete "--fix" command-line-args-left))) (when (member "--check" command-line-args-left) (setq lo-check-only t) (setq command-line-args-left (delete "--check" command-line-args-left))) @@ -518,7 +862,7 @@ After printing, also append judgments to `lo-followups-file' when set." (setq command-line-args-left (delete followups command-line-args-left)))) (if (null command-line-args-left) (progn - (princ "Usage: emacs --batch -q -l lint-org.el [--check] [--followups-file=PATH] FILE.org ...\n") + (princ "Usage: emacs --batch -q -l lint-org.el [--fix] [--check] [--followups-file=PATH] FILE.org ...\n") (kill-emacs 1)) (let ((files command-line-args-left)) (setq command-line-args-left nil) @@ -537,7 +881,7 @@ this file without firing the CLI dispatch — under `ert-run-tests-batch-and-exi the trailing args are things like `-f ert-run-tests-batch-and-exit'." (and command-line-args-left (cl-every (lambda (a) - (cond ((member a '("--check")) t) + (cond ((member a '("--check" "--fix")) t) ((string-prefix-p "--followups-file=" a) t) ((string-prefix-p "-" a) nil) (t (file-readable-p a)))) |