blob: c4231f4023b98af21ccb75c17cc59e96e1c75f4a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
;;; todo-cleanup.el --- Auto-fix and audit for todo.org hygiene
;;
;; Usage:
;; emacs --batch -q -l todo-cleanup.el todo.org # apply fixes in place
;; emacs --batch -q -l todo-cleanup.el --check todo.org # report-only
;;
;; What it does:
;;
;; 1. Auto-deletes "bogus state-log" lines of the form
;; - State "X" from "X" [date]
;; where the state didn't actually change. Org sometimes logs these when
;; `org-log-into-drawer' is unset and a state-change toggle lands on the
;; same state. They carry no information and they break org's planning-line
;; parser by sitting between the heading and DEADLINE/SCHEDULED.
;;
;; 2. Detects "orphan planning lines" — entries whose body contains
;; `^DEADLINE:' or `^SCHEDULED:' that org-entry-get can't read because the
;; line isn't in canonical position. Reports these for manual fix; doesn't
;; auto-rewrite (preserving real state-log history is judgement work).
;;
;; Designed for the wrap-it-up workflow: cheap (~0.4s on a 3700-line todo.org),
;; idempotent, and safe to run every session. Any fixes show up in the
;; wrap-up commit's diff for review.
(require 'org)
(require 'cl-lib)
(setq org-todo-keywords
'((sequence "TODO" "DOING" "WAITING" "NEXT" "|" "DONE" "CANCELLED")))
(defvar tc-fixes 0)
(defvar tc-issues nil)
(defvar tc-check-only nil)
(defvar tc-current-file nil)
(defun tc-fix-bogus-state-log-in-entry ()
"Delete bogus state-log lines within the entry at point.
A bogus log line matches `- State \"X\" from \"X\" [date]' where the two
states are identical."
(save-excursion
(let ((end (save-excursion
(or (outline-next-heading) (goto-char (point-max)))
(point))))
(while (re-search-forward
"^[[:space:]]*- State \"\\([^\"]+\\)\"[[:space:]]+from \"\\1\"[[:space:]]+\\[[^]]+\\][[:space:]]*\n"
end t)
(let ((line (line-number-at-pos (match-beginning 0))))
(if tc-check-only
(push (list :kind 'bogus-log
:file tc-current-file
:line line
:detail (string-trim (match-string 0)))
tc-issues)
(delete-region (match-beginning 0) (match-end 0))
(cl-incf tc-fixes)
(push (list :kind 'bogus-log-fixed
:file tc-current-file
:line line
:detail (string-trim (match-string 0)))
tc-issues)))))))
(defun tc-detect-orphan-planning-in-entry ()
"Flag entries where DEADLINE/SCHEDULED is in the body but org-entry-get returns nil.
This means the planning line isn't in canonical position, so org-mode's
agenda + scheduling machinery won't see it."
(let* ((line (line-number-at-pos))
(heading (org-get-heading t t t t))
(dl-canonical (org-entry-get (point) "DEADLINE"))
(sc-canonical (org-entry-get (point) "SCHEDULED"))
(start (save-excursion (org-end-of-meta-data t) (point)))
(end (save-excursion
(or (outline-next-heading) (goto-char (point-max)))
(point)))
(body (buffer-substring-no-properties start end)))
(when (and (not dl-canonical)
(string-match "^[[:space:]]*DEADLINE:[[:space:]]*\\(<[^>]+>\\)" body))
(push (list :kind 'orphan-deadline
:file tc-current-file
:line line
:heading heading
:detail (match-string 1 body))
tc-issues))
(when (and (not sc-canonical)
(string-match "^[[:space:]]*SCHEDULED:[[:space:]]*\\(<[^>]+>\\)" body))
(push (list :kind 'orphan-scheduled
:file tc-current-file
:line line
:heading heading
:detail (match-string 1 body))
tc-issues))))
(defun tc-process-file (file)
(setq tc-current-file (file-name-nondirectory file))
(with-current-buffer (find-file-noselect file)
(org-mode)
;; Pass 1: auto-fix bogus state logs (or report under --check).
(org-map-entries #'tc-fix-bogus-state-log-in-entry nil 'file)
;; Pass 2: detect orphan planning lines (always report-only).
(org-map-entries #'tc-detect-orphan-planning-in-entry nil 'file)
(when (and (not tc-check-only) (buffer-modified-p))
(save-buffer))))
(defun tc-emit-report ()
(princ (format "todo-cleanup: %d fix(es) applied%s\n"
tc-fixes
(if tc-check-only " — CHECK MODE (no writes)" "")))
(let ((orphans (cl-remove-if-not (lambda (i) (memq (plist-get i :kind)
'(orphan-deadline
orphan-scheduled)))
tc-issues))
(logs (cl-remove-if-not (lambda (i) (memq (plist-get i :kind)
'(bogus-log
bogus-log-fixed)))
tc-issues)))
(when logs
(princ (format " Bogus state-log lines (%s):\n"
(if tc-check-only "would delete" "deleted")))
(dolist (i (nreverse logs))
(princ (format " %s:%d: %s\n"
(plist-get i :file)
(plist-get i :line)
(plist-get i :detail)))))
(when orphans
(princ (format " Orphan planning lines needing manual fix (%d):\n" (length orphans)))
(dolist (i (nreverse orphans))
(princ (format " %s:%d: %s — %s in body\n"
(plist-get i :file)
(plist-get i :line)
(plist-get i :heading)
(plist-get i :detail)))))))
(when noninteractive
;; Mutate `command-line-args-left' so emacs's own arg parser doesn't see
;; --check after our script returns.
(when (member "--check" command-line-args-left)
(setq tc-check-only t)
(setq command-line-args-left (delete "--check" command-line-args-left)))
(if (null command-line-args-left)
(progn (princ "Usage: emacs --batch -q -l todo-cleanup.el [--check] FILE...\n")
(kill-emacs 1))
(let ((files command-line-args-left))
(setq command-line-args-left nil)
(dolist (file files)
(when (file-readable-p file)
(tc-process-file file)))
(tc-emit-report))))
(provide 'todo-cleanup)
;;; todo-cleanup.el ends here
|
