blob: 5d6e971cffe0f8b799d8c802c1d34490976d2bc3 (
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
|
;;; daily-prep-agenda.el --- Standalone batch agenda extractor for daily-prep
;;
;; Usage:
;; emacs --batch -q -l daily-prep-agenda.el todo.org [pcal.org ...]
;;
;; Filters entries to TODO/DOING/WAITING/NEXT with [#A]/[#B] priority OR
;; DEADLINE/SCHEDULED present. Bucketizes into Overdue, Today, This Week,
;; Priority A (no date), Priority B (no date). Emits heading + body for each.
(require 'org)
(require 'cl-lib)
;; Declare the TODO keywords used across Craig's org files so org-mode parses
;; "DOING", "WAITING", "NEXT", "CANCELLED" headings as TODO states. With `-q`,
;; org-mode defaults to just "TODO"/"DONE" and will treat the others as plain
;; heading text (state comes back as nil).
(setq org-todo-keywords
'((sequence "TODO" "DOING" "WAITING" "NEXT" "|" "DONE" "CANCELLED")))
(defvar dp-today (format-time-string "%Y-%m-%d"))
(defvar dp-week-end
(format-time-string "%Y-%m-%d" (time-add (current-time) (days-to-time 7))))
(defun dp-iso-date (org-ts)
"Extract YYYY-MM-DD from an org timestamp string like '<2026-04-25 Sat 16:00>'."
(when (and org-ts (string-match "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)" org-ts))
(match-string 1 org-ts)))
(defun dp-entry-info ()
"Return plist of metadata + body for org entry at point."
(let* ((state (org-get-todo-state))
(el (org-element-at-point))
(priority (org-element-property :priority el))
(deadline-raw (org-entry-get (point) "DEADLINE"))
(scheduled-raw (org-entry-get (point) "SCHEDULED"))
(deadline (dp-iso-date deadline-raw))
(scheduled (dp-iso-date scheduled-raw))
(heading (org-get-heading t t t t))
(line (line-number-at-pos))
(file (or (buffer-file-name) (buffer-name)))
(start (save-excursion (org-end-of-meta-data t) (point)))
(end (save-excursion
(or (outline-next-heading) (goto-char (point-max)))
(point)))
(body (and (< start end)
(string-trim (buffer-substring-no-properties start end)))))
(list :state state
:priority priority
:deadline deadline
:deadline-raw deadline-raw
:scheduled scheduled
:scheduled-raw scheduled-raw
:heading heading
:line line
:file file
:body body)))
(defun dp-active-candidate-p ()
"True if entry at point is an active state with [#A]/[#B] OR has DEADLINE/SCHEDULED."
(let* ((state (org-get-todo-state))
(el (org-element-at-point))
(pri (org-element-property :priority el))
(dl (org-entry-get (point) "DEADLINE"))
(sc (org-entry-get (point) "SCHEDULED")))
(and (member state '("TODO" "DOING" "WAITING" "NEXT"))
(or (memq pri '(?A ?B)) dl sc))))
(defun dp-collect (files)
"Walk FILES, return list of dp-entry-info plists for matching entries."
(let (entries)
(dolist (file files)
(when (file-readable-p file)
(with-current-buffer (find-file-noselect file)
(org-mode)
(org-map-entries
(lambda ()
(when (dp-active-candidate-p)
(push (dp-entry-info) entries)))
nil 'file))))
(nreverse entries)))
(defun dp-bucket (e)
"Return bucket name for entry plist E."
(let ((dl (plist-get e :deadline))
(sc (plist-get e :scheduled))
(pri (plist-get e :priority)))
(cond
((and dl (string< dl dp-today)) 'overdue)
((or (equal dl dp-today) (equal sc dp-today)) 'today)
((and sc (string< sc dp-today)) 'overdue)
((or (and dl (string< dl dp-week-end))
(and sc (string< sc dp-week-end))) 'this-week)
((eq pri ?A) 'pri-a)
((eq pri ?B) 'pri-b)
(t 'other))))
(defun dp-format-entry (e)
"Format entry plist E as org-mode text."
(concat
(format "** %s%s %s\n"
(or (plist-get e :state) "")
(if-let ((p (plist-get e :priority))) (format " [#%c]" p) "")
(plist-get e :heading))
(format " :LOC: %s:%d\n"
(file-name-nondirectory (plist-get e :file))
(plist-get e :line))
(when-let ((d (plist-get e :deadline-raw))) (format " DEADLINE: %s\n" d))
(when-let ((s (plist-get e :scheduled-raw))) (format " SCHEDULED: %s\n" s))
(let ((b (plist-get e :body)))
(if (and b (not (string-empty-p b)))
(concat (replace-regexp-in-string "^" " " b) "\n")
""))
"\n"))
(defun dp-emit-bucket (label entries)
(when entries
(princ (format "* %s (%d)\n\n" label (length entries)))
(dolist (e entries)
(princ (dp-format-entry e)))))
(defun dp--cli-invocation-p ()
"Non-nil when the trailing args look like a real invocation (readable files).
Keeps the batch entrypoint from firing when this file is loaded under ERT,
where the trailing args are ERT's own flags rather than org files."
(and command-line-args-left
(cl-every #'file-readable-p command-line-args-left)))
;; Main entrypoint
(when (and noninteractive (dp--cli-invocation-p))
(let* ((files command-line-args-left)
(entries (dp-collect files))
(groups (seq-group-by #'dp-bucket entries)))
(princ (format "# Daily-Prep Extract — %s\n# Files: %s\n# Total candidates: %d\n\n"
dp-today
(mapconcat #'file-name-nondirectory files ", ")
(length entries)))
(dolist (bucket '(overdue today this-week pri-a pri-b other))
(dp-emit-bucket
(pcase bucket
('overdue "Overdue")
('today "Today")
('this-week "This Week")
('pri-a "Priority A (undated)")
('pri-b "Priority B (undated)")
('other "Other"))
(alist-get bucket groups)))))
(provide 'daily-prep-agenda)
;;; daily-prep-agenda.el ends here
|
