flake-update-20260201
1;;; org-ql-batch-functions.el --- Org-mode batch operations using org-ql -*- lexical-binding: t -*-
2
3;; Copyright (C) 2026 Vincent Demeester
4
5;; Author: Vincent Demeester <vincent@sbr.pm>
6;; Keywords: org, batch, automation, org-ql
7;; Version: 1.0.0
8;; Package-Requires: ((emacs "27.1") (org-ql "0.8"))
9
10;;; Commentary:
11
12;; Reimplementation of org-batch-functions.el using org-ql for queries.
13;; Benefits:
14;; - More powerful query language (30+ predicates)
15;; - Less code for complex queries
16;; - Composable queries with and/or/not
17;; - Built-in caching for performance
18;;
19;; This file provides drop-in replacements for read operations.
20;; Write operations are kept from the original (org-ql is read-only).
21
22;;; Code:
23
24(require 'org-ql)
25(require 'org-element)
26(require 'json)
27
28;;; Configuration (same as original)
29
30(setq org-priority-highest ?1
31 org-priority-lowest ?5
32 org-priority-default ?4)
33
34(setq org-todo-keywords
35 '((sequence "STRT(s)" "NEXT(n)" "TODO(t)" "WAIT(w)" "|" "DONE(d!)" "CANX(c@/!)")))
36
37;;; Utility Functions
38
39(defun org-ql-batch--element-to-alist ()
40 "Convert current heading to JSON-friendly alist.
41Must be called with point on a heading."
42 (let* ((element (org-element-at-point))
43 (priority-char (org-element-property :priority element))
44 (priority-num (when priority-char (- priority-char 48))))
45 `((heading . ,(org-get-heading t t t t))
46 (todo . ,(org-get-todo-state))
47 (priority . ,priority-num)
48 (tags . ,(org-get-tags nil t))
49 (level . ,(org-current-level))
50 (scheduled . ,(org-entry-get nil "SCHEDULED"))
51 (deadline . ,(org-entry-get nil "DEADLINE")))))
52
53(defun org-ql-batch--build-priority-regexp (priorities)
54 "Build regexp to match PRIORITIES (list of numbers 1-5)."
55 (when priorities
56 (format "\\[#[%s]\\]"
57 (mapconcat #'number-to-string priorities ""))))
58
59;;; Read Operations - Reimplemented with org-ql
60
61(defun org-ql-batch-list-todos (file &optional filter-state filter-priority filter-tags)
62 "List TODOs from FILE with optional filters using org-ql.
63FILTER-STATE: String like \"NEXT\" or \"TODO\", or list of states
64FILTER-PRIORITY: Number 1-5 or list of numbers
65FILTER-TAGS: List of tag strings (match any)
66
67This replaces `org-batch-list-todos' with ~50% less code."
68 (let* ((states (cond ((null filter-state) '("TODO" "NEXT" "STRT" "WAIT" "DONE" "CANX"))
69 ((listp filter-state) filter-state)
70 ((stringp filter-state)
71 (if (string-match-p "," filter-state)
72 (split-string filter-state ",")
73 (list filter-state)))
74 (t (list filter-state))))
75 (priority-list (cond ((null filter-priority) nil)
76 ((listp filter-priority) filter-priority)
77 (t (list filter-priority))))
78 (priority-regexp (org-ql-batch--build-priority-regexp priority-list))
79 ;; Build org-ql query dynamically
80 (query `(and (todo ,@states)
81 ,@(when priority-regexp
82 `((regexp ,priority-regexp)))
83 ,@(when filter-tags
84 `((tags-local ,@filter-tags))))))
85 (org-ql-select file query
86 :action #'org-ql-batch--element-to-alist)))
87
88(defun org-ql-batch-scheduled-today (file &optional date)
89 "Get items scheduled for DATE (default today) from FILE.
90DATE should be \"YYYY-MM-DD\" or \"today\".
91
92This replaces `org-batch-scheduled-today' - cleaner with org-ql predicates."
93 (let ((target-date (if (or (null date) (string= date "today"))
94 'today
95 (date-to-time date))))
96 (org-ql-select file
97 `(scheduled :on ,target-date)
98 :action #'org-ql-batch--element-to-alist)))
99
100(defun org-ql-batch-by-section (file section-name)
101 "Get all TODOs under SECTION-NAME (level 1 heading) in FILE.
102
103Uses org-ql's `ancestors' predicate - much cleaner than manual tracking!"
104 (org-ql-select file
105 `(and (todo)
106 (ancestors (and (level 1)
107 (heading ,section-name))))
108 :action #'org-ql-batch--element-to-alist))
109
110(defun org-ql-batch-search (file search-term)
111 "Search for SEARCH-TERM in FILE content.
112
113Uses org-ql's `regexp' predicate."
114 (org-ql-select file
115 `(and (todo)
116 (regexp ,(regexp-quote search-term)))
117 :action (lambda ()
118 (let ((alist (org-ql-batch--element-to-alist)))
119 (cons (cons 'matched-in
120 (if (string-match-p (regexp-quote search-term)
121 (alist-get 'heading alist))
122 "heading"
123 "content"))
124 alist)))))
125
126(defun org-ql-batch-get-sections (file)
127 "Get list of all level-1 sections in FILE."
128 (org-ql-select file
129 '(level 1)
130 :action (lambda () (org-get-heading t t t t))))
131
132(defun org-ql-batch-get-children (file heading-name)
133 "Get all direct children TODOs of HEADING-NAME in FILE.
134
135Uses org-ql's `parent' predicate - elegant solution!"
136 (org-ql-select file
137 `(and (todo)
138 (parent (heading ,heading-name)))
139 :action #'org-ql-batch--element-to-alist))
140
141(defun org-ql-batch-get-overdue (file)
142 "Get all tasks with DEADLINE before today from FILE.
143
144Uses org-ql's `deadline' predicate with :before modifier."
145 (org-ql-select file
146 '(and (todo "TODO" "NEXT" "STRT" "WAIT")
147 (deadline :before today))
148 :action #'org-ql-batch--element-to-alist))
149
150(defun org-ql-batch-get-upcoming (file &optional days)
151 "Get tasks scheduled or due in next DAYS from FILE.
152DAYS defaults to 7.
153
154Uses org-ql's date predicates - very clean!"
155 (let ((days-count (or days 7)))
156 (org-ql-select file
157 `(and (todo "TODO" "NEXT" "STRT" "WAIT")
158 (or (scheduled :to ,days-count)
159 (deadline :to ,days-count)))
160 :action #'org-ql-batch--element-to-alist)))
161
162(defun org-ql-batch-get-recurring-tasks (file)
163 "Get all tasks with repeaters in FILE.
164
165Uses regexp to match org repeater syntax."
166 (org-ql-select file
167 '(and (todo)
168 (regexp "[.+]?\\+[0-9]+[hdwmy]"))
169 :action (lambda ()
170 (let* ((alist (org-ql-batch--element-to-alist))
171 (scheduled (alist-get 'scheduled alist))
172 (deadline (alist-get 'deadline alist))
173 (repeater (or (and scheduled
174 (string-match "[.+]?\\+[0-9]+[hdwmy]" scheduled)
175 (match-string 0 scheduled))
176 (and deadline
177 (string-match "[.+]?\\+[0-9]+[hdwmy]" deadline)
178 (match-string 0 deadline)))))
179 (cons (cons 'repeater repeater) alist)))))
180
181(defun org-ql-batch-get-blocked-tasks (file)
182 "Get all tasks that have BLOCKER property in FILE.
183
184Uses org-ql's `property' predicate."
185 (org-ql-select file
186 '(and (todo)
187 (property "BLOCKER"))
188 :action (lambda ()
189 (let ((alist (org-ql-batch--element-to-alist))
190 (blocker (org-entry-get nil "BLOCKER")))
191 (cons (cons 'blocker blocker) alist)))))
192
193(defun org-ql-batch-count-by-state (file)
194 "Count TODOs in FILE by state.
195
196Uses org-ql with grouping."
197 (let ((counts '((total . 0) (TODO . 0) (NEXT . 0) (STRT . 0)
198 (WAIT . 0) (DONE . 0) (CANX . 0))))
199 (org-ql-select file '(todo)
200 :action (lambda ()
201 (let* ((state (org-get-todo-state))
202 (state-sym (intern state)))
203 (cl-incf (alist-get 'total counts))
204 (when (assoc state-sym counts)
205 (cl-incf (alist-get state-sym counts))))))
206 counts))
207
208;;; Advanced Queries - New capabilities with org-ql
209
210(defun org-ql-batch-clocked-today (file)
211 "Get tasks that were clocked today.
212
213NEW: Not available in original - org-ql makes this easy!"
214 (org-ql-select file
215 '(clocked :on today)
216 :action #'org-ql-batch--element-to-alist))
217
218(defun org-ql-batch-habits (file)
219 "Get all habits from FILE.
220
221NEW: Easy habit filtering with org-ql!"
222 (org-ql-select file
223 '(habit)
224 :action #'org-ql-batch--element-to-alist))
225
226(defun org-ql-batch-stale-tasks (file &optional days)
227 "Get TODO tasks not touched in DAYS (default 30).
228
229NEW: Find forgotten tasks!"
230 (let ((days-ago (or days 30)))
231 (org-ql-select file
232 `(and (todo "TODO")
233 (not (ts :from ,(- days-ago))))
234 :action #'org-ql-batch--element-to-alist)))
235
236(defun org-ql-batch-by-path (file path-pattern)
237 "Get TODOs matching outline PATH-PATTERN.
238
239NEW: Query by outline path like 'Projects/Work/Tekton'."
240 (org-ql-select file
241 `(and (todo)
242 (path ,path-pattern))
243 :action #'org-ql-batch--element-to-alist))
244
245(defun org-ql-batch-with-property (file property &optional value)
246 "Get TODOs with PROPERTY (optionally matching VALUE).
247
248NEW: Easy property-based queries!"
249 (org-ql-select file
250 (if value
251 `(and (todo) (property ,property ,value))
252 `(and (todo) (property ,property)))
253 :action #'org-ql-batch--element-to-alist))
254
255;;; Statistics - Simplified with org-ql
256
257(defun org-ql-batch-get-statistics (file)
258 "Get comprehensive statistics about TODOs in FILE.
259
260Combines multiple org-ql queries for efficiency."
261 (let ((by-state (org-ql-batch-count-by-state file))
262 (scheduled-count (length (org-ql-select file '(and (todo) (scheduled)))))
263 (deadline-count (length (org-ql-select file '(and (todo) (deadline)))))
264 (overdue-count (length (org-ql-batch-get-overdue file)))
265 (by-priority '())
266 (by-tag '()))
267 ;; Count by priority
268 (dolist (p '(1 2 3 4 5))
269 (let ((regexp (format "\\[#%d\\]" p)))
270 (push (cons p (length (org-ql-select file `(and (todo) (regexp ,regexp)))))
271 by-priority)))
272 ;; Count by tag (get all unique tags first, then count)
273 (let ((all-tags '()))
274 (org-ql-select file '(todo)
275 :action (lambda ()
276 (dolist (tag (org-get-tags nil t))
277 (if (assoc tag all-tags #'string=)
278 (cl-incf (cdr (assoc tag all-tags #'string=)))
279 (push (cons tag 1) all-tags)))))
280 (setq by-tag (sort all-tags (lambda (a b) (> (cdr a) (cdr b))))))
281 ;; Return stats
282 `((total . ,(alist-get 'total by-state))
283 (by_state . ,by-state)
284 (by_priority . ,(nreverse by-priority))
285 (by_tag . ,by-tag)
286 (scheduled_count . ,scheduled-count)
287 (deadline_count . ,deadline-count)
288 (overdue_count . ,overdue-count))))
289
290;;; Output Functions (same as original)
291
292(defun org-ql-batch-output-json (success data &optional error)
293 "Output JSON response.
294SUCCESS: boolean
295DATA: data to include in response
296ERROR: error message if any"
297 (let ((response (if success
298 `((success . ,success) (data . ,data))
299 `((success . :json-false) (error . ,error)))))
300 (princ (json-encode response))
301 (terpri)))
302
303(defun org-ql-batch-output-error (message)
304 "Output error MESSAGE in JSON format."
305 (org-ql-batch-output-json nil nil message))
306
307(provide 'org-ql-batch-functions)
308;;; org-ql-batch-functions.el ends here