fedora-csb-system-manager
1;;; batch-functions.el --- Org-mode batch operations -*- lexical-binding: t -*-
2
3;; Copyright (C) 2025 Vincent Demeester
4
5;; Author: Vincent Demeester <vincent@sbr.pm>
6;; Keywords: org, batch, automation
7;; Version: 1.0.0
8
9;;; Commentary:
10
11;; Elisp functions for batch-mode org-mode file manipulation.
12;; Provides read and write operations on org files without GUI.
13;; Used by org-manager CLI tool and Claude Code skills.
14
15;;; Code:
16
17(require 'org)
18(require 'org-element)
19(require 'json)
20
21;;; Configuration
22
23(setq org-todo-keywords
24 '((sequence "STRT(s)" "NEXT(n)" "TODO(t)" "WAIT(w)" "|" "DONE(d!)" "CANX(c@/!)")))
25
26(setq org-priority-highest ?1 ; Highest priority (character '1' = ASCII 49)
27 org-priority-lowest ?5 ; Lowest priority (character '5' = ASCII 53)
28 org-priority-default ?4) ; Default priority (character '4' = ASCII 52)
29
30;; Silence interactive prompts
31(setq org-use-fast-todo-selection nil
32 org-log-done nil ; Will be set per-operation as needed
33 org-agenda-inhibit-startup t)
34
35;;; Utility Functions
36
37(defun org-batch--format-timestamp (timestamp)
38 "Format TIMESTAMP element to string."
39 (when timestamp
40 (org-element-property :raw-value timestamp)))
41
42(defun org-batch--priority-to-number (priority-char)
43 "Convert PRIORITY-CHAR to number (1-5).
44Priority '1'=1, '2'=2, '3'=3, '4'=4, '5'=5."
45 (when priority-char
46 (- priority-char 48))) ; '1'(49) → 1, '2'(50) → 2, ..., '5'(53) → 5
47
48(defun org-batch--number-to-priority (num)
49 "Convert NUM (1-5) to priority character.
501='1', 2='2', 3='3', 4='4', 5='5'."
51 (when (and num (>= num 1) (<= num 5))
52 (+ num 48))) ; 1 → '1'(49), 2 → '2'(50), ..., 5 → '5'(53)
53
54(defun org-batch--element-to-alist (element)
55 "Convert org ELEMENT to JSON-friendly alist."
56 `((heading . ,(org-element-property :raw-value element))
57 (todo . ,(org-element-property :todo-keyword element))
58 (priority . ,(org-batch--priority-to-number
59 (org-element-property :priority element)))
60 (tags . ,(org-element-property :tags element))
61 (level . ,(org-element-property :level element))
62 (scheduled . ,(org-batch--format-timestamp
63 (org-element-property :scheduled element)))
64 (deadline . ,(org-batch--format-timestamp
65 (org-element-property :deadline element)))))
66
67;;; Read Operations
68
69(defun org-batch-list-todos (file &optional filter-state filter-priority filter-tags)
70 "List TODOs from FILE with optional filters.
71FILTER-STATE: String like \"NEXT\" or \"TODO\"
72FILTER-PRIORITY: Number 1-5 or list of numbers
73FILTER-Tags: List of tag strings (match any)"
74 (with-temp-buffer
75 (insert-file-contents file)
76 (org-mode)
77 (let ((todos '())
78 (priority-list (if (listp filter-priority)
79 filter-priority
80 (when filter-priority (list filter-priority)))))
81 (org-element-map (org-element-parse-buffer) 'headline
82 (lambda (hl)
83 (let ((todo (org-element-property :todo-keyword hl))
84 (priority (org-batch--priority-to-number
85 (org-element-property :priority hl)))
86 (tags (org-element-property :tags hl)))
87 (when (and todo
88 ;; State filter
89 (or (null filter-state)
90 (string= todo filter-state))
91 ;; Priority filter
92 (or (null priority-list)
93 (member priority priority-list))
94 ;; Tag filter (match any)
95 (or (null filter-tags)
96 (and tags (seq-intersection filter-tags tags))))
97 (push (org-batch--element-to-alist hl) todos)))))
98 (nreverse todos))))
99
100(defun org-batch-scheduled-today (file &optional date)
101 "Get items scheduled for DATE (default today) from FILE.
102DATE should be in format \"YYYY-MM-DD\" or \"today\"."
103 (let* ((target-date (if (or (null date) (string= date "today"))
104 (format-time-string "%Y-%m-%d")
105 date))
106 (items '()))
107 (with-temp-buffer
108 (insert-file-contents file)
109 (org-mode)
110 (org-element-map (org-element-parse-buffer) 'headline
111 (lambda (hl)
112 (let ((scheduled (org-element-property :scheduled hl)))
113 (when scheduled
114 (let ((sched-val (org-element-property :raw-value scheduled)))
115 (when (string-match target-date sched-val)
116 (push (org-batch--element-to-alist hl) items))))))))
117 (nreverse items)))
118
119(defun org-batch-by-section (file section-name)
120 "Get all TODOs under SECTION-NAME (level 1 heading) in FILE."
121 (with-temp-buffer
122 (insert-file-contents file)
123 (org-mode)
124 (let ((in-section nil)
125 (todos '()))
126 (org-element-map (org-element-parse-buffer) 'headline
127 (lambda (hl)
128 (let ((level (org-element-property :level hl))
129 (heading (org-element-property :raw-value hl))
130 (todo (org-element-property :todo-keyword hl)))
131 ;; Track which section we're in
132 (when (= level 1)
133 (setq in-section (string= heading section-name)))
134 ;; Collect TODOs in this section (level > 1)
135 (when (and in-section todo (> level 1))
136 (push (org-batch--element-to-alist hl) todos)))))
137 (nreverse todos))))
138
139(defun org-batch-count-by-state (file)
140 "Count TODOs in FILE by state.
141Returns alist with counts for each state."
142 (with-temp-buffer
143 (insert-file-contents file)
144 (org-mode)
145 (let ((counts '((total . 0) (TODO . 0) (NEXT . 0) (STRT . 0) (WAIT . 0) (DONE . 0) (CANX . 0))))
146 (org-element-map (org-element-parse-buffer) 'headline
147 (lambda (hl)
148 (let ((todo (org-element-property :todo-keyword hl)))
149 (when todo
150 (setcdr (assoc 'total counts) (1+ (cdr (assoc 'total counts))))
151 (let ((state-entry (assoc (intern todo) counts)))
152 (when state-entry
153 (setcdr state-entry (1+ (cdr state-entry)))))))))
154 counts)))
155
156(defun org-batch-search (file search-term)
157 "Search for SEARCH-TERM in FILE content.
158Returns list of matching headlines with context."
159 (with-temp-buffer
160 (insert-file-contents file)
161 (org-mode)
162 (let ((matches '())
163 (search-regexp (regexp-quote search-term)))
164 (org-element-map (org-element-parse-buffer) 'headline
165 (lambda (hl)
166 (let* ((begin (org-element-property :begin hl))
167 (end (org-element-property :end hl))
168 (content (buffer-substring-no-properties begin end)))
169 (when (string-match-p search-regexp content)
170 (push (cons (cons 'matched-in
171 (if (string-match-p search-regexp
172 (org-element-property :raw-value hl))
173 "heading"
174 "content"))
175 (org-batch--element-to-alist hl))
176 matches)))))
177 (nreverse matches))))
178
179(defun org-batch-get-sections (file)
180 "Get list of all level-1 sections in FILE."
181 (with-temp-buffer
182 (insert-file-contents file)
183 (org-mode)
184 (let ((sections '()))
185 (org-element-map (org-element-parse-buffer) 'headline
186 (lambda (hl)
187 (when (= 1 (org-element-property :level hl))
188 (push (org-element-property :raw-value hl) sections))))
189 (nreverse sections))))
190
191(defun org-batch-get-children (file heading-name)
192 "Get all direct children TODOs of HEADING-NAME in FILE.
193Returns only immediate children (level = parent + 1), not all descendants."
194 (with-temp-buffer
195 (insert-file-contents file)
196 (org-mode)
197 (let ((children '())
198 (parent-level nil)
199 (in-subtree nil))
200 (org-element-map (org-element-parse-buffer) 'headline
201 (lambda (hl)
202 (let ((heading (org-element-property :raw-value hl))
203 (level (org-element-property :level hl)))
204 (cond
205 ;; Found the parent heading
206 ((string= heading heading-name)
207 (setq parent-level level
208 in-subtree t))
209 ;; We're past the parent's subtree (same or lower level)
210 ((and in-subtree parent-level (<= level parent-level))
211 (setq in-subtree nil))
212 ;; We're in the subtree and this is a direct child
213 ((and in-subtree parent-level (= level (1+ parent-level)))
214 (push (org-batch--element-to-alist hl) children))))))
215 (nreverse children))))
216
217(defun org-batch-get-todo-content (file heading-name)
218 "Get full content of TODO with HEADING-NAME in FILE.
219Returns alist with metadata, properties, and body content.
220Returns nil if heading not found."
221 (with-temp-buffer
222 (insert-file-contents file)
223 (org-mode)
224 (let ((found nil)
225 (result nil))
226 (org-element-map (org-element-parse-buffer) 'headline
227 (lambda (hl)
228 (when (and (not found)
229 (string= (org-element-property :raw-value hl) heading-name))
230 (setq found t)
231 ;; Build result with metadata
232 (let* ((basic-data (org-batch--element-to-alist hl))
233 (properties (org-batch--extract-properties hl))
234 (content (org-batch--extract-content hl)))
235 (setq result (append basic-data
236 (list (cons 'properties properties)
237 (cons 'content content))))))))
238 result)))
239
240(defun org-batch--extract-properties (element)
241 "Extract properties drawer from ELEMENT as alist."
242 (let ((properties '())
243 (begin (org-element-property :begin element))
244 (end (org-element-property :contents-end element)))
245 (when (and begin end)
246 (save-excursion
247 (goto-char begin)
248 (forward-line 1) ; Skip heading line
249 ;; Look for :PROPERTIES: drawer
250 (when (re-search-forward "^[ \t]*:PROPERTIES:[ \t]*$" end t)
251 (let ((drawer-start (point)))
252 (when (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
253 (let ((drawer-end (match-beginning 0)))
254 (goto-char drawer-start)
255 ;; Extract each property
256 (while (re-search-forward "^[ \t]*:\\([^:\n]+\\):[ \t]*\\(.*\\)$" drawer-end t)
257 (let ((key (match-string 1))
258 (value (match-string 2)))
259 (push (cons key value) properties)))))))))
260 (nreverse properties)))
261
262(defun org-batch--extract-content (element)
263 "Extract body content from ELEMENT (excluding properties drawer).
264Returns the text content without the heading line or properties."
265 (let ((end (org-element-property :contents-end element))
266 (contents-begin (org-element-property :contents-begin element)))
267 (if (and contents-begin end)
268 (save-excursion
269 (let ((content-text (buffer-substring-no-properties contents-begin end)))
270 ;; Remove properties drawer if present
271 (with-temp-buffer
272 (insert content-text)
273 (goto-char (point-min))
274 ;; Remove SCHEDULED/DEADLINE lines (they're in metadata)
275 (while (re-search-forward "^[ \t]*\\(?:SCHEDULED\\|DEADLINE\\|CLOSED\\):.*$" nil t)
276 (replace-match ""))
277 ;; Remove properties drawer
278 (goto-char (point-min))
279 (when (re-search-forward "^[ \t]*:PROPERTIES:[ \t]*$" nil t)
280 (let ((drawer-start (match-beginning 0)))
281 (when (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)
282 (delete-region drawer-start (point))
283 ;; Remove trailing newline
284 (when (looking-at "\n")
285 (delete-char 1)))))
286 ;; Trim whitespace
287 (goto-char (point-min))
288 (while (re-search-forward "^[ \t]+$" nil t)
289 (replace-match ""))
290 (goto-char (point-min))
291 (skip-chars-forward "\n")
292 (delete-region (point-min) (point))
293 (goto-char (point-max))
294 (skip-chars-backward "\n")
295 (delete-region (point) (point-max))
296 (buffer-string))))
297 "")))
298
299;;; Write Operations
300
301(defun org-batch--adjust-heading-levels (content parent-level)
302 "Adjust heading levels in CONTENT to be relative to PARENT-LEVEL.
303Converts markdown headers (#, ##, ###) and org headers (*, **, ***)
304to the appropriate level relative to the parent heading.
305Parent level 2 (**) means # becomes ***, ## becomes ****, etc."
306 (with-temp-buffer
307 (insert content)
308 (goto-char (point-min))
309 ;; First, convert markdown headings to org format with adjusted levels
310 (while (re-search-forward "^\\(#+\\)\\( .*\\)$" nil t)
311 (let* ((markdown-level (length (match-string 1)))
312 (header-text (match-string 2))
313 ;; Subheading should be parent + markdown level
314 (new-level (+ parent-level markdown-level))
315 (org-stars (make-string new-level ?*)))
316 ;; Replace with a temporary marker to avoid re-processing
317 (replace-match (concat "ORG_HEADING_MARKER:" org-stars header-text))))
318 ;; Now process existing org headings (* Header) - adjust their level
319 (goto-char (point-min))
320 (while (re-search-forward "^\\(\\*+\\)\\( .*\\)$" nil t)
321 (let* ((org-level (length (match-string 1)))
322 (header-text (match-string 2))
323 ;; Subheading should be parent + org level
324 (new-level (+ parent-level org-level))
325 (org-stars (make-string new-level ?*)))
326 (replace-match (concat "ORG_HEADING_MARKER:" org-stars header-text))))
327 ;; Remove the temporary markers
328 (goto-char (point-min))
329 (while (re-search-forward "ORG_HEADING_MARKER:" nil t)
330 (replace-match ""))
331 (buffer-string)))
332
333(defun org-batch-append-content (file heading content)
334 "Append CONTENT to TODO with HEADING in FILE.
335Adds content at the end of the heading's body, before any subheadings.
336Automatically adjusts heading levels in content (# becomes ###, etc).
337Returns t on success, nil if heading not found."
338 (with-temp-buffer
339 (insert-file-contents file)
340 (org-mode)
341 (goto-char (point-min))
342 (let ((found nil)
343 (heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\|DONE\\|CANX\\)? ?\\(?:\\[#[1-5]\\] \\)?"
344 (regexp-quote heading))))
345 (when (re-search-forward heading-regexp nil t)
346 (org-back-to-heading)
347 ;; Get parent heading level for content adjustment
348 (let* ((parent-level (org-current-level))
349 (section-end (save-excursion
350 (org-end-of-subtree t t)
351 (point)))
352 ;; Adjust content heading levels
353 (adjusted-content (org-batch--adjust-heading-levels content parent-level)))
354 ;; Find the insertion point:
355 ;; - After properties drawer
356 ;; - After SCHEDULED/DEADLINE lines
357 ;; - Before any subheadings
358 ;; - At end of existing content
359 (forward-line 1)
360 ;; Skip properties drawer
361 (when (looking-at "^[ \t]*:PROPERTIES:")
362 (re-search-forward "^[ \t]*:END:" section-end t)
363 (forward-line 1))
364 ;; Skip SCHEDULED/DEADLINE/CLOSED lines
365 (while (looking-at "^[ \t]*\\(?:SCHEDULED\\|DEADLINE\\|CLOSED\\):")
366 (forward-line 1))
367 ;; Skip logbook drawer if present
368 (when (looking-at "^[ \t]*:LOGBOOK:")
369 (re-search-forward "^[ \t]*:END:" section-end t)
370 (forward-line 1))
371 ;; Find end of content (before any subheading)
372 (let ((content-end (save-excursion
373 (if (re-search-forward "^\\*" section-end t)
374 (match-beginning 0)
375 section-end))))
376 (goto-char content-end)
377 ;; Skip back over trailing blank lines
378 (skip-chars-backward "\n\t ")
379 (unless (bolp) (forward-line 1))
380 ;; Ensure we have a blank line before content if there's existing content
381 (unless (or (= (point) (save-excursion (org-back-to-heading) (forward-line 1) (point)))
382 (looking-back "\\`\\|^[ \t]*\n" nil))
383 (insert "\n"))
384 ;; Insert the adjusted content
385 (insert adjusted-content)
386 ;; Ensure content ends with newline
387 (unless (bolp) (insert "\n"))
388 ;; Add blank line after content if subheadings follow
389 (when (looking-at "^\\*")
390 (unless (looking-back "\n\n" nil)
391 (insert "\n")))
392 (write-region (point-min) (point-max) file)
393 (setq found t)))
394 found))))
395
396(defun org-batch-update-state (file heading new-state)
397 "Update TODO state for HEADING in FILE to NEW-STATE.
398Returns t on success, nil if heading not found."
399 (with-temp-buffer
400 (insert-file-contents file)
401 (org-mode)
402 (goto-char (point-min))
403 (let ((found nil)
404 (heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\|DONE\\|CANX\\) \\(?:\\[#[1-5]\\] \\)?"
405 (regexp-quote heading))))
406 (when (re-search-forward heading-regexp nil t)
407 (org-back-to-heading)
408 (let ((org-log-done (if (string= new-state "DONE") 'time nil)))
409 (org-todo new-state))
410 (write-region (point-min) (point-max) file)
411 (setq found t))
412 found)))
413
414(defun org-batch-add-todo (file section heading &optional scheduled priority tags)
415 "Add new TODO to FILE in SECTION with HEADING.
416SCHEDULED: Date string \"YYYY-MM-DD\"
417PRIORITY: Number 1-5
418TAGS: List of tag strings"
419 (with-temp-buffer
420 (insert-file-contents file)
421 (org-mode)
422 (goto-char (point-min))
423 (let ((section-regexp (concat "^\\* " (regexp-quote section) "$")))
424 (if (re-search-forward section-regexp nil t)
425 (progn
426 ;; Find end of section
427 (org-end-of-subtree t)
428 ;; Insert new TODO
429 (insert "\n** TODO ")
430 (when priority
431 (insert (format "[#%d] " priority)))
432 (insert heading)
433 (when tags
434 (insert " :" (string-join tags ":") ":"))
435 (insert "\n")
436 (when scheduled
437 (insert (format "SCHEDULED: <%s>\n" scheduled)))
438 (insert ":PROPERTIES:\n")
439 (insert (format ":CREATED: [%s]\n"
440 (format-time-string "%Y-%m-%d %a %H:%M")))
441 (insert ":END:\n")
442 (write-region (point-min) (point-max) file)
443 t)
444 ;; Section not found
445 nil))))
446
447(defun org-batch-schedule-task (file heading date)
448 "Schedule task with HEADING in FILE for DATE.
449DATE should be \"YYYY-MM-DD\" format.
450Returns t on success, nil if heading not found."
451 (with-temp-buffer
452 (insert-file-contents file)
453 (org-mode)
454 (goto-char (point-min))
455 (let ((found nil)
456 (heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\) \\(?:\\[#[1-5]\\] \\)?"
457 (regexp-quote heading))))
458 (when (re-search-forward heading-regexp nil t)
459 (org-back-to-heading)
460 (org-schedule nil date)
461 (write-region (point-min) (point-max) file)
462 (setq found t))
463 found)))
464
465(defun org-batch-set-deadline (file heading date)
466 "Set deadline for task with HEADING in FILE to DATE.
467DATE should be \"YYYY-MM-DD\" format.
468Returns t on success, nil if heading not found."
469 (with-temp-buffer
470 (insert-file-contents file)
471 (org-mode)
472 (goto-char (point-min))
473 (let ((found nil)
474 (heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\) \\(?:\\[#[1-5]\\] \\)?"
475 (regexp-quote heading))))
476 (when (re-search-forward heading-regexp nil t)
477 (org-back-to-heading)
478 (org-deadline nil date)
479 (write-region (point-min) (point-max) file)
480 (setq found t))
481 found)))
482
483(defun org-batch-set-priority (file heading priority)
484 "Set PRIORITY (1-5) for task with HEADING in FILE.
485Returns t on success, nil if heading not found."
486 (with-temp-buffer
487 (insert-file-contents file)
488 (org-mode)
489 (goto-char (point-min))
490 (let ((found nil)
491 (heading-regexp (concat "^\\(\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\)\\) \\(?:\\[#[1-5]\\] \\)?"
492 (regexp-quote heading)))
493 (priority-cookie (format " [#%d]" priority)))
494 (when (re-search-forward heading-regexp nil t)
495 (goto-char (match-end 1)) ; Move to end of TODO keyword
496 ;; Remove existing priority if present
497 (when (looking-at " \\[#[1-5]\\]")
498 (delete-region (point) (+ (point) 5)))
499 ;; Insert new priority (note: priority-cookie already has leading space)
500 (insert priority-cookie)
501 (write-region (point-min) (point-max) file)
502 (setq found t))
503 found)))
504
505(defun org-batch-add-tags (file heading new-tags)
506 "Add NEW-TAGS to task with HEADING in FILE.
507NEW-TAGS is a list of tag strings to add (existing tags are preserved).
508Returns t on success, nil if heading not found."
509 (with-temp-buffer
510 (insert-file-contents file)
511 (org-mode)
512 (goto-char (point-min))
513 (let ((found nil)
514 (heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\|DONE\\|CANX\\) \\(?:\\[#[1-5]\\] \\)?"
515 (regexp-quote heading))))
516 (when (re-search-forward heading-regexp nil t)
517 (org-back-to-heading)
518 (let* ((current-tags (org-get-tags))
519 (combined-tags (delete-dups (append current-tags new-tags))))
520 (org-set-tags combined-tags)
521 (write-region (point-min) (point-max) file)
522 (setq found t)))
523 found)))
524
525(defun org-batch-remove-tags (file heading tags-to-remove)
526 "Remove TAGS-TO-REMOVE from task with HEADING in FILE.
527TAGS-TO-REMOVE is a list of tag strings to remove.
528Returns t on success, nil if heading not found."
529 (with-temp-buffer
530 (insert-file-contents file)
531 (org-mode)
532 (goto-char (point-min))
533 (let ((found nil)
534 (heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\|DONE\\|CANX\\) \\(?:\\[#[1-5]\\] \\)?"
535 (regexp-quote heading))))
536 (when (re-search-forward heading-regexp nil t)
537 (org-back-to-heading)
538 (let* ((current-tags (org-get-tags))
539 (remaining-tags (seq-difference current-tags tags-to-remove)))
540 (org-set-tags remaining-tags)
541 (write-region (point-min) (point-max) file)
542 (setq found t)))
543 found)))
544
545(defun org-batch-replace-tags (file heading new-tags)
546 "Replace all tags on task with HEADING in FILE with NEW-TAGS.
547NEW-TAGS is a list of tag strings.
548Returns t on success, nil if heading not found."
549 (with-temp-buffer
550 (insert-file-contents file)
551 (org-mode)
552 (goto-char (point-min))
553 (let ((found nil)
554 (heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\|DONE\\|CANX\\) \\(?:\\[#[1-5]\\] \\)?"
555 (regexp-quote heading))))
556 (when (re-search-forward heading-regexp nil t)
557 (org-back-to-heading)
558 (org-set-tags new-tags)
559 (write-region (point-min) (point-max) file)
560 (setq found t))
561 found)))
562
563(defun org-batch-list-all-tags (file)
564 "List all unique tags used in FILE.
565Returns sorted list of tag strings."
566 (with-temp-buffer
567 (insert-file-contents file)
568 (org-mode)
569 (let ((all-tags '()))
570 (org-element-map (org-element-parse-buffer) 'headline
571 (lambda (hl)
572 (let ((tags (org-element-property :tags hl)))
573 (when tags
574 (setq all-tags (append all-tags tags))))))
575 (sort (delete-dups all-tags) #'string<))))
576
577(defun org-batch-get-overdue (file)
578 "Get all tasks with DEADLINE before today from FILE.
579Returns list of overdue tasks with their metadata."
580 (let ((today (format-time-string "%Y-%m-%d"))
581 (overdue-items '()))
582 (with-temp-buffer
583 (insert-file-contents file)
584 (org-mode)
585 (org-element-map (org-element-parse-buffer) 'headline
586 (lambda (hl)
587 (let ((todo (org-element-property :todo-keyword hl))
588 (deadline (org-element-property :deadline hl)))
589 ;; Only include active TODOs with deadlines
590 (when (and todo
591 (not (member todo '("DONE" "CANX")))
592 deadline)
593 (let ((deadline-date (org-element-property :raw-value deadline)))
594 ;; Extract YYYY-MM-DD from deadline
595 (when (string-match "\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)" deadline-date)
596 (let ((dl-str (match-string 0 deadline-date)))
597 ;; Compare dates (string comparison works for YYYY-MM-DD)
598 (when (string< dl-str today)
599 (push (org-batch--element-to-alist hl) overdue-items)))))))))
600 (nreverse overdue-items))))
601
602(defun org-batch-get-upcoming (file &optional days)
603 "Get tasks with DEADLINE or SCHEDULED in next DAYS from FILE.
604DAYS defaults to 7. Returns list of upcoming tasks."
605 (let* ((days-count (or days 7))
606 (today (current-time))
607 (future-date (time-add today (days-to-time days-count)))
608 (today-str (format-time-string "%Y-%m-%d" today))
609 (future-str (format-time-string "%Y-%m-%d" future-date))
610 (upcoming-items '()))
611 (with-temp-buffer
612 (insert-file-contents file)
613 (org-mode)
614 (org-element-map (org-element-parse-buffer) 'headline
615 (lambda (hl)
616 (let ((todo (org-element-property :todo-keyword hl))
617 (scheduled (org-element-property :scheduled hl))
618 (deadline (org-element-property :deadline hl)))
619 ;; Only include active TODOs
620 (when (and todo (not (member todo '("DONE" "CANX"))))
621 (let ((dates-to-check '()))
622 ;; Collect scheduled and deadline dates
623 (when scheduled
624 (push (org-element-property :raw-value scheduled) dates-to-check))
625 (when deadline
626 (push (org-element-property :raw-value deadline) dates-to-check))
627 ;; Check if any date is in range
628 (dolist (date-str dates-to-check)
629 (when (string-match "\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)" date-str)
630 (let ((task-date (match-string 0 date-str)))
631 ;; Date is upcoming if: today <= date <= future
632 (when (and (not (string< task-date today-str))
633 (not (string< future-str task-date)))
634 (push (org-batch--element-to-alist hl) upcoming-items)
635 ;; Stop checking other dates for this task
636 (setq dates-to-check nil))))))))))
637 ;; Remove duplicates and reverse
638 (delete-dups (nreverse upcoming-items)))))
639
640(defun org-batch-get-property (file heading property-name)
641 "Get value of PROPERTY-NAME for task with HEADING in FILE.
642Returns property value string or nil if not found."
643 (with-temp-buffer
644 (insert-file-contents file)
645 (org-mode)
646 (goto-char (point-min))
647 (let ((found nil)
648 (heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\|DONE\\|CANX\\)? ?\\(?:\\[#[1-5]\\] \\)?"
649 (regexp-quote heading))))
650 (when (re-search-forward heading-regexp nil t)
651 (org-back-to-heading)
652 (setq found (org-entry-get nil property-name)))
653 found)))
654
655(defun org-batch-set-property (file heading property-name value)
656 "Set PROPERTY-NAME to VALUE for task with HEADING in FILE.
657Returns t on success, nil if heading not found."
658 (with-temp-buffer
659 (insert-file-contents file)
660 (org-mode)
661 (goto-char (point-min))
662 (let ((found nil)
663 (heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\|DONE\\|CANX\\)? ?\\(?:\\[#[1-5]\\] \\)?"
664 (regexp-quote heading))))
665 (when (re-search-forward heading-regexp nil t)
666 (org-back-to-heading)
667 (org-set-property property-name value)
668 (write-region (point-min) (point-max) file)
669 (setq found t))
670 found)))
671
672(defun org-batch-list-properties (file heading)
673 "List all properties for task with HEADING in FILE.
674Returns alist of (property . value) pairs."
675 (with-temp-buffer
676 (insert-file-contents file)
677 (org-mode)
678 (goto-char (point-min))
679 (let ((properties '())
680 (heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\|DONE\\|CANX\\)? ?\\(?:\\[#[1-5]\\] \\)?"
681 (regexp-quote heading))))
682 (when (re-search-forward heading-regexp nil t)
683 (org-back-to-heading)
684 ;; Get all properties using org-entry-properties
685 (let ((props (org-entry-properties nil 'standard)))
686 (dolist (prop props)
687 (let ((key (car prop))
688 (val (cdr prop)))
689 ;; Filter out special properties we don't want to show
690 (unless (member key '("CATEGORY" "BLOCKED" "ALLTAGS" "FILE" "PRIORITY_COOKIE"
691 "TODO" "TAGS" "ITEM"))
692 (push (cons key val) properties))))))
693 (nreverse properties))))
694
695(defun org-batch-archive-done (file)
696 "Archive all DONE and CANX items in FILE.
697Returns count of archived items."
698 (let ((count 0)
699 (archive-location nil))
700 (with-temp-buffer
701 (insert-file-contents file)
702 (org-mode)
703 ;; Find and archive DONE items
704 (goto-char (point-min))
705 (while (re-search-forward "^\\*+ \\(DONE\\|CANX\\) " nil t)
706 (org-back-to-heading)
707 ;; Get archive location from properties if available
708 (let ((local-archive (org-entry-get nil "ARCHIVE")))
709 (when local-archive
710 (setq archive-location local-archive)))
711 (condition-case err
712 (progn
713 (when archive-location
714 (let ((org-archive-location archive-location))
715 (org-archive-subtree)))
716 (unless archive-location
717 (org-archive-subtree))
718 (setq count (1+ count)))
719 (error
720 (message "Failed to archive: %s" (error-message-string err)))))
721 ;; Save changes
722 (write-region (point-min) (point-max) file))
723 count))
724
725;;; Bulk Operations
726
727(defun org-batch-bulk-update-state (file filter-state new-state &optional filter-tags)
728 "Update all tasks matching FILTER-STATE in FILE to NEW-STATE.
729FILTER-TAGS: Optional list of tags to further filter tasks.
730Returns count of updated tasks."
731 (let ((count 0))
732 (with-temp-buffer
733 (insert-file-contents file)
734 (org-mode)
735 (goto-char (point-min))
736 (while (re-search-forward org-heading-regexp nil t)
737 (org-back-to-heading t)
738 (let ((todo (org-get-todo-state))
739 (tags (org-get-tags)))
740 (when (and todo
741 (string= todo filter-state)
742 ;; Tag filter (match any)
743 (or (null filter-tags)
744 (and tags (seq-intersection filter-tags tags))))
745 (let ((org-log-done (if (string= new-state "DONE") 'time nil)))
746 (org-todo new-state))
747 (setq count (1+ count))))
748 (forward-line 1))
749 (write-region (point-min) (point-max) file))
750 count))
751
752(defun org-batch-bulk-add-tags (file filter-state new-tags)
753 "Add NEW-TAGS to all tasks with FILTER-STATE in FILE.
754Returns count of updated tasks."
755 (let ((count 0))
756 (with-temp-buffer
757 (insert-file-contents file)
758 (org-mode)
759 (goto-char (point-min))
760 (while (re-search-forward org-heading-regexp nil t)
761 (org-back-to-heading t)
762 (let ((todo (org-get-todo-state)))
763 (when (and todo (string= todo filter-state))
764 (let* ((current-tags (org-get-tags))
765 (combined-tags (delete-dups (append current-tags new-tags))))
766 (org-set-tags combined-tags))
767 (setq count (1+ count))))
768 (forward-line 1))
769 (write-region (point-min) (point-max) file))
770 count))
771
772(defun org-batch-bulk-set-priority (file filter-state priority)
773 "Set PRIORITY for all tasks with FILTER-STATE in FILE.
774Returns count of updated tasks."
775 (let ((count 0)
776 (priority-cookie (format " [#%d]" priority)))
777 (with-temp-buffer
778 (insert-file-contents file)
779 (org-mode)
780 (goto-char (point-min))
781 (while (re-search-forward (concat "^\\(\\*+ " (regexp-quote filter-state) "\\) \\(?:\\[#[1-5]\\] \\)?") nil t)
782 (goto-char (match-end 1))
783 ;; Remove existing priority if present
784 (when (looking-at " \\[#[1-5]\\]")
785 (delete-region (point) (+ (point) 5)))
786 ;; Insert new priority
787 (insert priority-cookie)
788 (setq count (1+ count)))
789 (write-region (point-min) (point-max) file))
790 count))
791
792;;; Time Tracking
793
794(defun org-batch-clock-in (file heading)
795 "Clock in to task with HEADING in FILE.
796Returns t on success, nil if heading not found."
797 (with-temp-buffer
798 (insert-file-contents file)
799 (org-mode)
800 (goto-char (point-min))
801 (let ((found nil)
802 (heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\|DONE\\|CANX\\)? ?\\(?:\\[#[1-5]\\] \\)?"
803 (regexp-quote heading))))
804 (when (re-search-forward heading-regexp nil t)
805 (org-back-to-heading)
806 (org-clock-in)
807 (write-region (point-min) (point-max) file)
808 (setq found t))
809 found)))
810
811(defun org-batch-clock-out (file)
812 "Clock out of currently clocked task in FILE.
813Returns t on success, nil if no active clock found."
814 (with-temp-buffer
815 (insert-file-contents file)
816 (org-mode)
817 (goto-char (point-min))
818 (let ((found nil))
819 ;; Find active clock line (has start time but no end time)
820 (when (re-search-forward "^\\([ \t]*CLOCK: \\)\\(\\[.*?\\]\\)$" nil t)
821 (let ((indent (match-string 1))
822 (start-time (match-string 2))
823 (end-time (format-time-string "[%Y-%m-%d %a %H:%M]")))
824 ;; Calculate duration
825 (let* ((start-ts (org-parse-time-string start-time))
826 (start-encoded (apply #'encode-time start-ts))
827 (end-encoded (current-time))
828 (duration-seconds (float-time (time-subtract end-encoded start-encoded)))
829 (hours (floor (/ duration-seconds 3600)))
830 (minutes (floor (/ (mod duration-seconds 3600) 60))))
831 ;; Replace the line with closed clock entry
832 (replace-match (format "%s%s--%s => %2d:%02d" indent start-time end-time hours minutes))
833 (write-region (point-min) (point-max) file)
834 (setq found t))))
835 found)))
836
837(defun org-batch-get-active-clock (file)
838 "Get currently active clock in FILE.
839Returns alist with heading and clock-in time, or nil if no active clock."
840 (with-temp-buffer
841 (insert-file-contents file)
842 (org-mode)
843 (goto-char (point-min))
844 (let ((result nil))
845 ;; Find active clock line (no end time)
846 (when (re-search-forward "^[ \t]*CLOCK: \\(\\[.*?\\]\\)$" nil t)
847 (let ((clock-start (match-string 1)))
848 (org-back-to-heading)
849 (let ((heading (org-element-property :raw-value (org-element-at-point))))
850 (setq result `((heading . ,heading)
851 (clock_start . ,clock-start))))))
852 result)))
853
854(defun org-batch-get-clocked-time (file heading)
855 "Get total clocked time for HEADING in FILE.
856Returns minutes as integer."
857 (with-temp-buffer
858 (insert-file-contents file)
859 (org-mode)
860 (goto-char (point-min))
861 (let ((heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\|DONE\\|CANX\\)? ?\\(?:\\[#[1-5]\\] \\)?"
862 (regexp-quote heading)))
863 (total-minutes 0))
864 (when (re-search-forward heading-regexp nil t)
865 (org-back-to-heading)
866 (save-restriction
867 (org-narrow-to-subtree)
868 (org-clock-sum)
869 (setq total-minutes (get-text-property (point) :org-clock-minutes))))
870 (or total-minutes 0))))
871
872;;; Statistics & Analytics
873
874(defun org-batch-get-statistics (file)
875 "Get comprehensive statistics about TODOs in FILE.
876Returns alist with counts, priorities, tags, and time data."
877 (with-temp-buffer
878 (insert-file-contents file)
879 (org-mode)
880 (let ((total 0)
881 (by-state '())
882 (by-priority '())
883 (by-tag '())
884 (scheduled-count 0)
885 (deadline-count 0)
886 (overdue-count 0))
887 ;; Count all TODOs and gather stats
888 (org-element-map (org-element-parse-buffer) 'headline
889 (lambda (hl)
890 (let ((todo (org-element-property :todo-keyword hl))
891 (priority (org-batch--priority-to-number
892 (org-element-property :priority hl)))
893 (tags (org-element-property :tags hl))
894 (scheduled (org-element-property :scheduled hl))
895 (deadline (org-element-property :deadline hl)))
896 (when todo
897 (setq total (1+ total))
898 ;; Count by state
899 (let ((state-sym (intern todo)))
900 (if (assoc state-sym by-state)
901 (setcdr (assoc state-sym by-state)
902 (1+ (cdr (assoc state-sym by-state))))
903 (push (cons state-sym 1) by-state)))
904 ;; Count by priority
905 (when priority
906 (if (assoc priority by-priority)
907 (setcdr (assoc priority by-priority)
908 (1+ (cdr (assoc priority by-priority))))
909 (push (cons priority 1) by-priority)))
910 ;; Count by tag
911 (dolist (tag tags)
912 (if (assoc tag by-tag #'string=)
913 (setcdr (assoc tag by-tag #'string=)
914 (1+ (cdr (assoc tag by-tag #'string=))))
915 (push (cons tag 1) by-tag)))
916 ;; Count scheduled/deadline
917 (when scheduled (setq scheduled-count (1+ scheduled-count)))
918 (when deadline (setq deadline-count (1+ deadline-count)))
919 ;; Count overdue
920 (when (and deadline (not (member todo '("DONE" "CANX"))))
921 (let ((deadline-date (org-element-property :raw-value deadline))
922 (today (format-time-string "%Y-%m-%d")))
923 (when (string-match "\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)" deadline-date)
924 (let ((dl-str (match-string 0 deadline-date)))
925 (when (string< dl-str today)
926 (setq overdue-count (1+ overdue-count)))))))))))
927 ;; Return comprehensive stats
928 `((total . ,total)
929 (by_state . ,by-state)
930 (by_priority . ,by-priority)
931 (by_tag . ,by-tag)
932 (scheduled_count . ,scheduled-count)
933 (deadline_count . ,deadline-count)
934 (overdue_count . ,overdue-count)))))
935
936(defun org-batch-get-priority-distribution (file)
937 "Get distribution of tasks by priority in FILE.
938Returns alist mapping priority (1-5) to count."
939 (with-temp-buffer
940 (insert-file-contents file)
941 (org-mode)
942 (let ((distribution '((1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0))))
943 (org-element-map (org-element-parse-buffer) 'headline
944 (lambda (hl)
945 (let ((todo (org-element-property :todo-keyword hl))
946 (priority (org-batch--priority-to-number
947 (org-element-property :priority hl))))
948 (when (and todo priority)
949 (let ((entry (assoc priority distribution)))
950 (when entry
951 (setcdr entry (1+ (cdr entry)))))))))
952 distribution)))
953
954(defun org-batch-get-tag-statistics (file)
955 "Get statistics about tag usage in FILE.
956Returns sorted list of (tag . count) pairs."
957 (with-temp-buffer
958 (insert-file-contents file)
959 (org-mode)
960 (let ((tag-counts '()))
961 (org-element-map (org-element-parse-buffer) 'headline
962 (lambda (hl)
963 (let ((tags (org-element-property :tags hl)))
964 (dolist (tag tags)
965 (if (assoc tag tag-counts #'string=)
966 (setcdr (assoc tag tag-counts #'string=)
967 (1+ (cdr (assoc tag tag-counts #'string=))))
968 (push (cons tag 1) tag-counts))))))
969 ;; Sort by count descending
970 (sort tag-counts (lambda (a b) (> (cdr a) (cdr b)))))))
971
972;;; Export & Reporting
973
974(defun org-batch-export-csv (file output-file)
975 "Export TODOs from FILE to CSV format in OUTPUT-FILE.
976Returns t on success."
977 (let ((todos (org-batch-list-todos file)))
978 (with-temp-file output-file
979 ;; CSV header
980 (insert "heading,state,priority,tags,level,scheduled,deadline\n")
981 ;; CSV rows
982 (dolist (todo todos)
983 (insert (format "\"%s\",\"%s\",%s,\"%s\",%s,\"%s\",\"%s\"\n"
984 (or (alist-get 'heading todo) "")
985 (or (alist-get 'todo todo) "")
986 (or (alist-get 'priority todo) "")
987 (or (string-join (alist-get 'tags todo) ";") "")
988 (or (alist-get 'level todo) "")
989 (or (alist-get 'scheduled todo) "")
990 (or (alist-get 'deadline todo) "")))))
991 t))
992
993(defun org-batch-export-json (file output-file)
994 "Export TODOs from FILE to JSON format in OUTPUT-FILE.
995Returns t on success."
996 (let ((todos (org-batch-list-todos file)))
997 (with-temp-file output-file
998 (insert (json-encode todos)))
999 t))
1000
1001;;; Recurring Tasks
1002
1003(defun org-batch-set-repeater (file heading repeater-spec)
1004 "Set repeater REPEATER-SPEC for HEADING in FILE.
1005REPEATER-SPEC should be like '+1w' or '.+2d' for org-mode repeaters.
1006Returns t on success, nil if heading not found."
1007 (with-temp-buffer
1008 (insert-file-contents file)
1009 (org-mode)
1010 (goto-char (point-min))
1011 (let ((found nil)
1012 (heading-regexp (concat "^\\*+ \\(?:TODO\\|NEXT\\|STRT\\|WAIT\\)? ?\\(?:\\[#[1-5]\\] \\)?"
1013 (regexp-quote heading))))
1014 (when (re-search-forward heading-regexp nil t)
1015 (org-back-to-heading)
1016 ;; Look for existing SCHEDULED line
1017 (if (re-search-forward "^[ \t]*SCHEDULED:" (save-excursion (outline-next-heading) (point)) t)
1018 ;; Update existing scheduled with repeater
1019 (progn
1020 (beginning-of-line)
1021 (when (re-search-forward "<\\([^>]+\\)>" (line-end-position) t)
1022 (let ((timestamp (match-string 1)))
1023 ;; Remove existing repeater if any
1024 (setq timestamp (replace-regexp-in-string " [.+]?\\+[0-9]+[dwmy]" "" timestamp))
1025 ;; Add new repeater
1026 (replace-match (format "<%s %s>" timestamp repeater-spec)))))
1027 ;; No scheduled, add one with today's date + repeater
1028 (org-back-to-heading)
1029 (forward-line 1)
1030 (insert (format "SCHEDULED: <%s %s>\n"
1031 (format-time-string "%Y-%m-%d %a")
1032 repeater-spec)))
1033 (write-region (point-min) (point-max) file)
1034 (setq found t))
1035 found)))
1036
1037(defun org-batch-get-recurring-tasks (file)
1038 "Get all tasks with repeaters in FILE.
1039Returns list of tasks with their repeater specifications."
1040 (with-temp-buffer
1041 (insert-file-contents file)
1042 (org-mode)
1043 (let ((recurring '()))
1044 (org-element-map (org-element-parse-buffer) 'headline
1045 (lambda (hl)
1046 (let ((todo (org-element-property :todo-keyword hl))
1047 (scheduled (org-element-property :scheduled hl))
1048 (deadline (org-element-property :deadline hl)))
1049 (when todo
1050 (let ((repeater nil))
1051 ;; Check for repeater in scheduled
1052 (when scheduled
1053 (let ((sched-val (org-element-property :raw-value scheduled)))
1054 (when (string-match "[.+]?\\+[0-9]+[dwmy]" sched-val)
1055 (setq repeater (match-string 0 sched-val)))))
1056 ;; Check for repeater in deadline
1057 (when (and (not repeater) deadline)
1058 (let ((dead-val (org-element-property :raw-value deadline)))
1059 (when (string-match "[.+]?\\+[0-9]+[dwmy]" dead-val)
1060 (setq repeater (match-string 0 dead-val)))))
1061 (when repeater
1062 (push (cons (cons 'repeater repeater)
1063 (org-batch--element-to-alist hl))
1064 recurring)))))))
1065 (nreverse recurring))))
1066
1067;;; Dependencies & Relationships
1068
1069(defun org-batch-set-blocker (file heading blocker-heading)
1070 "Set BLOCKER-HEADING as a blocker for HEADING in FILE.
1071Creates or updates BLOCKER property.
1072Returns t on success, nil if heading not found."
1073 (org-batch-set-property file heading "BLOCKER" blocker-heading))
1074
1075(defun org-batch-get-blocker (file heading)
1076 "Get blocker for HEADING in FILE.
1077Returns blocker heading name or nil if no blocker set."
1078 (org-batch-get-property file heading "BLOCKER"))
1079
1080(defun org-batch-get-blocked-tasks (file)
1081 "Get all tasks that have blockers in FILE.
1082Returns list of tasks with their blocker information."
1083 (with-temp-buffer
1084 (insert-file-contents file)
1085 (org-mode)
1086 (let ((blocked '()))
1087 (org-element-map (org-element-parse-buffer) 'headline
1088 (lambda (hl)
1089 (let ((todo (org-element-property :todo-keyword hl)))
1090 (when todo
1091 (let ((blocker-prop nil))
1092 (save-excursion
1093 (goto-char (org-element-property :begin hl))
1094 (setq blocker-prop (org-entry-get nil "BLOCKER")))
1095 (when blocker-prop
1096 (push (cons (cons 'blocker blocker-prop)
1097 (org-batch--element-to-alist hl))
1098 blocked)))))))
1099 (nreverse blocked))))
1100
1101(defun org-batch-set-related (file heading related-heading relation-type)
1102 "Set relationship between HEADING and RELATED-HEADING in FILE.
1103RELATION-TYPE can be `child', `parent', `related', or `depends-on'.
1104Uses org properties to track relationships.
1105Returns t on success."
1106 (org-batch-set-property file heading
1107 (upcase (format "RELATED_%s" relation-type))
1108 related-heading))
1109
1110(defun org-batch-get-related (file heading)
1111 "Get all related tasks for HEADING in FILE.
1112Returns alist of relationship types and related task names."
1113 (let ((props (org-batch-list-properties file heading))
1114 (related '()))
1115 (dolist (prop props)
1116 (when (string-match "^RELATED_\\(.*\\)$" (car prop))
1117 (let ((rel-type (downcase (match-string 1 (car prop))))
1118 (rel-value (cdr prop)))
1119 (push (cons (intern rel-type) rel-value) related))))
1120 related))
1121
1122;;; Output Functions
1123
1124(defun org-batch-output-json (success data &optional error)
1125 "Output JSON response.
1126SUCCESS: boolean
1127DATA: data to include in response
1128ERROR: error message if any"
1129 (let ((response (if success
1130 `((success . ,success) (data . ,data))
1131 `((success . :json-false) (error . ,error)))))
1132 (princ (json-encode response))
1133 (terpri)))
1134
1135(defun org-batch-output-error (message)
1136 "Output error MESSAGE in JSON format."
1137 (org-batch-output-json nil nil message))
1138
1139(provide 'batch-functions)
1140;;; batch-functions.el ends here