diff options
Diffstat (limited to '.ai/scripts/todo-cleanup.el')
| -rw-r--r-- | .ai/scripts/todo-cleanup.el | 46 |
1 files changed, 34 insertions, 12 deletions
diff --git a/.ai/scripts/todo-cleanup.el b/.ai/scripts/todo-cleanup.el index 11851b2..569e7c7 100644 --- a/.ai/scripts/todo-cleanup.el +++ b/.ai/scripts/todo-cleanup.el @@ -41,7 +41,10 @@ ;; match a child. Children with no priority cookie at all are left alone, as ;; are parents with no priority cookie. A child can opt out of being bumped ;; by carrying the `:no-sync:' tag — useful for `Follow-up:'/`Spike:' children -;; that are deliberately deprioritized. Because the walk visits parents +;; that are deliberately deprioritized. The opt-out inherits down the tree: +;; if any ancestor heading carries `:no-sync:', every descendant under it is +;; skipped, so tagging a top-level PROJECT once is enough to keep its whole +;; subtree from cascading. Because the walk visits parents ;; before their descendants in document order, a multi-level chain ;; ([#A] → [#B] → [#D]) collapses to the top priority in a single pass. ;; --check-child-priority is the report-only alias for --sync-child-priority @@ -60,7 +63,9 @@ "Regexp matching an org priority cookie. Match group 1 is the letter.") (defconst tc-no-sync-tag "no-sync" - "Org tag a child heading carries to opt out of `--sync-child-priority'.") + "Org tag that opts a heading and all its descendants out of +`--sync-child-priority'. Inherits down: a tag on an ancestor counts for +every heading below it.") (defvar tc-fixes 0) (defvar tc-archived 0) @@ -271,20 +276,36 @@ the alphabet, since A is highest in org's default priority scheme." (and child parent (> child parent))) (defun tc--heading-has-no-sync-tag-p () - "Non-nil when the heading line at point carries `:no-sync:' as a trailing -tag-style marker. Uses a literal regex match rather than `org-get-tags' -because org's default tag character class (`org-tag-re') excludes hyphens — + "Non-nil when the heading line at point carries the literal substring +`:no-sync:'. Uses a literal regex match rather than `org-get-tags' because +org's default tag character class (`org-tag-re') excludes hyphens — `no-sync' isn't recognized as a real org tag in batch mode unless the user has extended that regex. The literal `:no-sync:' is what wrap-up sessions -actually type, so match it directly: any `:no-sync:' preceded by whitespace -on the heading line counts." +actually type, so match it directly anywhere on the heading line; the +heading line is scoped narrowly enough that a false-positive match in title +text is unlikely, and the cost would only be skipping a bump." (save-excursion (org-back-to-heading t) (let ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) - (string-match-p (format "[ \t]:%s:" (regexp-quote tc-no-sync-tag)) + (string-match-p (format ":%s:" (regexp-quote tc-no-sync-tag)) line)))) +(defun tc--ancestor-or-self-has-no-sync-tag-p () + "Non-nil when the heading at point, or any strict ancestor, carries the +literal `:no-sync:' tag on its own heading line. Walks up the outline +chain via `org-up-heading-safe', which returns nil at the top level +instead of erroring." + (save-excursion + (org-back-to-heading t) + (catch 'found + (when (tc--heading-has-no-sync-tag-p) + (throw 'found t)) + (while (org-up-heading-safe) + (when (tc--heading-has-no-sync-tag-p) + (throw 'found t))) + nil))) + (defun tc--set-heading-priority (letter) "Rewrite the priority cookie on the heading at point to LETTER (a character)." (save-excursion @@ -313,9 +334,10 @@ level deeper than the parent." (defun tc-sync-child-priority-at-heading () "If the heading at point carries a priority cookie, bump any direct child -heading whose own priority is lower, skipping children tagged -`tc-no-sync-tag'. A priority-less parent is a no-op; priority-less children -are left untouched (down-only does not invent priorities)." +heading whose own priority is lower, skipping children whose own heading +or any ancestor carries `tc-no-sync-tag'. A priority-less parent is a +no-op; priority-less children are left untouched (down-only does not +invent priorities)." (let ((parent (tc--heading-priority-letter))) (when parent (let ((parent-heading (org-get-heading t t t t))) @@ -325,7 +347,7 @@ are left untouched (down-only does not invent priorities)." (let ((child (tc--heading-priority-letter))) (when (and child (tc--priority-lower-p child parent) - (not (tc--heading-has-no-sync-tag-p))) + (not (tc--ancestor-or-self-has-no-sync-tag-p))) (let ((child-heading (org-get-heading t t t t)) (child-line (line-number-at-pos))) (cl-incf tc-bumped) |