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