Commit 12e455adca63
Changed files (3)
dots
.config
dots/.config/emacs/site-lisp/org-batch-functions-test.el
@@ -0,0 +1,320 @@
+;;; org-batch-functions-test.el --- Tests for org-batch-functions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2026 Vincent Demeester
+
+;;; Commentary:
+
+;; Comprehensive tests for org-batch-functions.el v2.0 (org-ql based)
+;; Run with: emacs --batch -l org-batch-functions-test.el -f org-batch-run-all-tests
+
+;;; Code:
+
+(require 'org-batch-functions)
+(require 'ert)
+
+(defvar org-batch-test-file "/home/vincent/desktop/org/todos.org"
+ "File to use for testing.")
+
+(defvar org-batch-test-results '()
+ "Accumulator for test results.")
+
+(defun org-batch-test-report (name passed &optional message)
+ "Report test NAME result (PASSED t/nil) with optional MESSAGE."
+ (push (list name passed message) org-batch-test-results)
+ (princ (format "%s %s%s\n"
+ (if passed "✓" "✗")
+ name
+ (if message (format " - %s" message) ""))))
+
+(defun org-batch-test-assert (name condition &optional message)
+ "Assert CONDITION is true for test NAME."
+ (org-batch-test-report name condition message))
+
+;;; Read Operations Tests
+
+(defun org-batch-test-list-todos ()
+ "Test org-batch-list-todos function."
+ (let ((results (org-batch-list-todos org-batch-test-file)))
+ (org-batch-test-assert
+ "list-todos: returns list"
+ (listp results)
+ (format "got %d items" (length results)))
+ (org-batch-test-assert
+ "list-todos: items have heading"
+ (and (car results) (alist-get 'heading (car results)))
+ (format "first: %s" (alist-get 'heading (car results))))))
+
+(defun org-batch-test-list-todos-filter-state ()
+ "Test state filtering."
+ (let ((next-items (org-batch-list-todos org-batch-test-file "NEXT"))
+ (todo-items (org-batch-list-todos org-batch-test-file "TODO")))
+ (org-batch-test-assert
+ "list-todos-filter-state: NEXT filter works"
+ (and (listp next-items)
+ (or (null next-items)
+ (string= "NEXT" (alist-get 'todo (car next-items)))))
+ (format "%d NEXT items" (length next-items)))
+ (org-batch-test-assert
+ "list-todos-filter-state: TODO filter works"
+ (and (listp todo-items)
+ (or (null todo-items)
+ (string= "TODO" (alist-get 'todo (car todo-items)))))
+ (format "%d TODO items" (length todo-items)))))
+
+(defun org-batch-test-list-todos-comma-separated ()
+ "Test comma-separated state filtering."
+ (let ((results (org-batch-list-todos org-batch-test-file "NEXT,STRT")))
+ (org-batch-test-assert
+ "list-todos-comma-separated: works"
+ (and (listp results)
+ (or (null results)
+ (member (alist-get 'todo (car results)) '("NEXT" "STRT"))))
+ (format "%d items" (length results)))))
+
+(defun org-batch-test-scheduled-today ()
+ "Test org-batch-scheduled-today function."
+ (let ((results (org-batch-scheduled-today org-batch-test-file)))
+ (org-batch-test-assert
+ "scheduled-today: returns list"
+ (listp results)
+ (format "%d scheduled today" (length results)))))
+
+(defun org-batch-test-by-section ()
+ "Test org-batch-by-section function."
+ (let ((results (org-batch-by-section org-batch-test-file "Systems")))
+ (org-batch-test-assert
+ "by-section: finds Systems section"
+ (and (listp results) (> (length results) 0))
+ (format "%d items in Systems" (length results)))))
+
+(defun org-batch-test-count-by-state ()
+ "Test org-batch-count-by-state function."
+ (let ((counts (org-batch-count-by-state org-batch-test-file)))
+ (org-batch-test-assert
+ "count-by-state: returns alist"
+ (and (listp counts) (assoc 'total counts))
+ (format "total: %d" (alist-get 'total counts)))
+ (org-batch-test-assert
+ "count-by-state: has TODO count"
+ (assoc 'TODO counts)
+ (format "TODO: %d" (alist-get 'TODO counts)))))
+
+(defun org-batch-test-search ()
+ "Test org-batch-search function."
+ (let ((results (org-batch-search org-batch-test-file "tekton")))
+ (org-batch-test-assert
+ "search: finds tekton"
+ (and (listp results) (> (length results) 0))
+ (format "%d matches for 'tekton'" (length results)))))
+
+(defun org-batch-test-get-sections ()
+ "Test org-batch-get-sections function."
+ (let ((sections (org-batch-get-sections org-batch-test-file)))
+ (org-batch-test-assert
+ "get-sections: returns list"
+ (and (listp sections) (> (length sections) 0))
+ (format "sections: %s" (string-join (seq-take sections 3) ", ")))))
+
+(defun org-batch-test-get-overdue ()
+ "Test org-batch-get-overdue function."
+ (let ((results (org-batch-get-overdue org-batch-test-file)))
+ (org-batch-test-assert
+ "get-overdue: returns list"
+ (listp results)
+ (format "%d overdue items" (length results)))))
+
+(defun org-batch-test-get-upcoming ()
+ "Test org-batch-get-upcoming function."
+ (let ((results (org-batch-get-upcoming org-batch-test-file 7)))
+ (org-batch-test-assert
+ "get-upcoming: returns list"
+ (listp results)
+ (format "%d items in next 7 days" (length results)))))
+
+(defun org-batch-test-get-recurring-tasks ()
+ "Test org-batch-get-recurring-tasks function."
+ (let ((results (org-batch-get-recurring-tasks org-batch-test-file)))
+ (org-batch-test-assert
+ "get-recurring-tasks: returns list"
+ (listp results)
+ (format "%d recurring tasks" (length results)))
+ (org-batch-test-assert
+ "get-recurring-tasks: has repeater field"
+ (or (null results) (assoc 'repeater (car results)))
+ "repeater field present")))
+
+(defun org-batch-test-get-blocked-tasks ()
+ "Test org-batch-get-blocked-tasks function."
+ (let ((results (org-batch-get-blocked-tasks org-batch-test-file)))
+ (org-batch-test-assert
+ "get-blocked-tasks: returns list"
+ (listp results)
+ (format "%d blocked tasks" (length results)))))
+
+;;; New org-ql Capabilities Tests
+
+(defun org-batch-test-clocked-today ()
+ "Test org-batch-clocked-today function (NEW)."
+ (let ((results (org-batch-clocked-today org-batch-test-file)))
+ (org-batch-test-assert
+ "clocked-today (NEW): returns list"
+ (listp results)
+ (format "%d clocked today" (length results)))))
+
+(defun org-batch-test-habits ()
+ "Test org-batch-habits function (NEW)."
+ (let ((results (org-batch-habits org-batch-test-file)))
+ (org-batch-test-assert
+ "habits (NEW): returns list"
+ (listp results)
+ (format "%d habits" (length results)))))
+
+(defun org-batch-test-priority-items ()
+ "Test org-batch-priority-items function (NEW)."
+ (let ((results (org-batch-priority-items org-batch-test-file 1 2)))
+ (org-batch-test-assert
+ "priority-items (NEW): returns list"
+ (listp results)
+ (format "%d priority 1-2 items" (length results)))))
+
+(defun org-batch-test-with-property ()
+ "Test org-batch-with-property function (NEW)."
+ (let ((results (org-batch-with-property org-batch-test-file "CREATED")))
+ (org-batch-test-assert
+ "with-property (NEW): returns list"
+ (listp results)
+ (format "%d items with CREATED property" (length results)))))
+
+;;; Statistics Tests
+
+(defun org-batch-test-get-statistics ()
+ "Test org-batch-get-statistics function."
+ (let ((stats (org-batch-get-statistics org-batch-test-file)))
+ (org-batch-test-assert
+ "get-statistics: returns alist"
+ (and (listp stats) (assoc 'total stats))
+ (format "total: %d" (alist-get 'total stats)))
+ (org-batch-test-assert
+ "get-statistics: has by_state"
+ (assoc 'by_state stats)
+ "by_state present")
+ (org-batch-test-assert
+ "get-statistics: has overdue_count"
+ (assoc 'overdue_count stats)
+ (format "overdue: %d" (alist-get 'overdue_count stats)))))
+
+(defun org-batch-test-get-priority-distribution ()
+ "Test org-batch-get-priority-distribution function."
+ (let ((dist (org-batch-get-priority-distribution org-batch-test-file)))
+ (org-batch-test-assert
+ "get-priority-distribution: returns alist"
+ (and (listp dist) (= 5 (length dist)))
+ (format "priorities 1-5 present"))))
+
+(defun org-batch-test-get-tag-statistics ()
+ "Test org-batch-get-tag-statistics function."
+ (let ((stats (org-batch-get-tag-statistics org-batch-test-file)))
+ (org-batch-test-assert
+ "get-tag-statistics: returns list"
+ (listp stats)
+ (format "%d unique tags" (length stats)))))
+
+(defun org-batch-test-list-all-tags ()
+ "Test org-batch-list-all-tags function."
+ (let ((tags (org-batch-list-all-tags org-batch-test-file)))
+ (org-batch-test-assert
+ "list-all-tags: returns sorted list"
+ (and (listp tags)
+ (or (null tags)
+ (null (cdr tags)) ; Only 1 tag - nothing to compare
+ (string< (car tags) (cadr tags))))
+ (format "%d tags" (length tags)))))
+
+;;; Output Format Tests
+
+(defun org-batch-test-json-output ()
+ "Test JSON output functions."
+ (let ((json-output (with-output-to-string
+ (org-batch-output-json t '((test . "value"))))))
+ (org-batch-test-assert
+ "json-output: valid JSON"
+ (string-match-p "success" json-output)
+ "contains success field")))
+
+;;; Integration Tests
+
+(defun org-batch-test-children ()
+ "Test org-batch-get-children with real heading."
+ ;; First find a heading with children
+ (let* ((sections (org-batch-get-sections org-batch-test-file))
+ (results (when sections
+ (org-batch-get-children org-batch-test-file (car sections)))))
+ (org-batch-test-assert
+ "get-children: works with real data"
+ (listp results)
+ (format "%d children of '%s'" (length results) (car sections)))))
+
+(defun org-batch-test-get-todo-content ()
+ "Test org-batch-get-todo-content with real heading."
+ (let* ((todos (org-batch-list-todos org-batch-test-file "NEXT"))
+ (heading (when todos (alist-get 'heading (car todos))))
+ (content (when heading (org-batch-get-todo-content org-batch-test-file heading))))
+ (org-batch-test-assert
+ "get-todo-content: returns content"
+ (or (null heading) (listp content))
+ (if content "got content" "no NEXT items to test"))))
+
+;;; Run All Tests
+
+(defun org-batch-run-all-tests ()
+ "Run all tests and print summary."
+ (setq org-batch-test-results '())
+
+ (princ "\n=== org-batch-functions.el v2.0 Test Suite ===\n\n")
+ (princ "--- Read Operations ---\n")
+ (org-batch-test-list-todos)
+ (org-batch-test-list-todos-filter-state)
+ (org-batch-test-list-todos-comma-separated)
+ (org-batch-test-scheduled-today)
+ (org-batch-test-by-section)
+ (org-batch-test-count-by-state)
+ (org-batch-test-search)
+ (org-batch-test-get-sections)
+ (org-batch-test-get-overdue)
+ (org-batch-test-get-upcoming)
+ (org-batch-test-get-recurring-tasks)
+ (org-batch-test-get-blocked-tasks)
+
+ (princ "\n--- New org-ql Capabilities ---\n")
+ (org-batch-test-clocked-today)
+ (org-batch-test-habits)
+ (org-batch-test-priority-items)
+ (org-batch-test-with-property)
+
+ (princ "\n--- Statistics ---\n")
+ (org-batch-test-get-statistics)
+ (org-batch-test-get-priority-distribution)
+ (org-batch-test-get-tag-statistics)
+ (org-batch-test-list-all-tags)
+
+ (princ "\n--- Output Format ---\n")
+ (org-batch-test-json-output)
+
+ (princ "\n--- Integration ---\n")
+ (org-batch-test-children)
+ (org-batch-test-get-todo-content)
+
+ ;; Summary
+ (let* ((total (length org-batch-test-results))
+ (passed (length (seq-filter #'cadr org-batch-test-results)))
+ (failed (- total passed)))
+ (princ (format "\n=== Summary: %d/%d passed" passed total))
+ (when (> failed 0)
+ (princ (format ", %d failed" failed)))
+ (princ " ===\n")
+
+ ;; Return exit code
+ (kill-emacs (if (= failed 0) 0 1))))
+
+(provide 'org-batch-functions-test)
+;;; org-batch-functions-test.el ends here
dots/.config/emacs/site-lisp/org-batch-functions.el
@@ -1,22 +1,30 @@
-;;; batch-functions.el --- Org-mode batch operations -*- lexical-binding: t -*-
+;;; org-batch-functions.el --- Org-mode batch operations -*- lexical-binding: t -*-
-;; Copyright (C) 2025 Vincent Demeester
+;; Copyright (C) 2025-2026 Vincent Demeester
;; Author: Vincent Demeester <vincent@sbr.pm>
-;; Keywords: org, batch, automation
-;; Version: 1.0.0
+;; Keywords: org, batch, automation, org-ql
+;; Version: 2.0.0
+;; Package-Requires: ((emacs "27.1") (org-ql "0.8"))
;;; Commentary:
;; Elisp functions for batch-mode org-mode file manipulation.
;; Provides read and write operations on org files without GUI.
;; Used by org-manager CLI tool and Claude Code skills.
+;;
+;; v2.0: Read operations now use org-ql for:
+;; - More powerful queries (30+ predicates)
+;; - Cleaner, more maintainable code
+;; - Built-in caching for performance
+;; - New capabilities (clocked-today, habits, stale-tasks, by-path)
;;; Code:
(require 'org)
(require 'org-element)
(require 'json)
+(require 'org-ql)
;;; Configuration
@@ -51,227 +59,154 @@ Priority '1'=1, '2'=2, '3'=3, '4'=4, '5'=5."
(when (and num (>= num 1) (<= num 5))
(+ num 48))) ; 1 → '1'(49), 2 → '2'(50), ..., 5 → '5'(53)
-(defun org-batch--element-to-alist (element)
- "Convert org ELEMENT to JSON-friendly alist."
- `((heading . ,(org-element-property :raw-value element))
- (todo . ,(org-element-property :todo-keyword element))
- (priority . ,(org-batch--priority-to-number
- (org-element-property :priority element)))
- (tags . ,(org-element-property :tags element))
- (level . ,(org-element-property :level element))
- (scheduled . ,(org-batch--format-timestamp
- (org-element-property :scheduled element)))
- (deadline . ,(org-batch--format-timestamp
- (org-element-property :deadline element)))))
+(defun org-batch--element-to-alist-at-point ()
+ "Convert current heading to JSON-friendly alist.
+Must be called with point on a heading. Used by org-ql actions."
+ (let* ((element (org-element-at-point))
+ (priority-char (org-element-property :priority element))
+ (priority-num (when priority-char (- priority-char 48))))
+ `((heading . ,(org-get-heading t t t t))
+ (todo . ,(org-get-todo-state))
+ (priority . ,priority-num)
+ (tags . ,(org-get-tags nil t))
+ (level . ,(org-current-level))
+ (scheduled . ,(org-entry-get nil "SCHEDULED"))
+ (deadline . ,(org-entry-get nil "DEADLINE")))))
-;;; Read Operations
+(defun org-batch--build-priority-regexp (priorities)
+ "Build regexp to match PRIORITIES (list of numbers 1-5)."
+ (when priorities
+ (format "\\[#[%s]\\]"
+ (mapconcat #'number-to-string priorities ""))))
+
+;;; Read Operations - Using org-ql
(defun org-batch-list-todos (file &optional filter-state filter-priority filter-tags)
- "List TODOs from FILE with optional filters.
-FILTER-STATE: String like \"NEXT\" or \"TODO\"
+ "List TODOs from FILE with optional filters using org-ql.
+FILTER-STATE: String like \"NEXT\" or \"TODO\", or comma-separated list
FILTER-PRIORITY: Number 1-5 or list of numbers
-FILTER-Tags: List of tag strings (match any)"
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((todos '())
- (priority-list (if (listp filter-priority)
- filter-priority
- (when filter-priority (list filter-priority)))))
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((todo (org-element-property :todo-keyword hl))
- (priority (org-batch--priority-to-number
- (org-element-property :priority hl)))
- (tags (org-element-property :tags hl)))
- (when (and todo
- ;; State filter
- (or (null filter-state)
- (string= todo filter-state))
- ;; Priority filter
- (or (null priority-list)
- (member priority priority-list))
- ;; Tag filter (match any)
- (or (null filter-tags)
- (and tags (seq-intersection filter-tags tags))))
- (push (org-batch--element-to-alist hl) todos)))))
- (nreverse todos))))
+FILTER-TAGS: List of tag strings (match any)"
+ (let* ((states (cond ((null filter-state) '("TODO" "NEXT" "STRT" "WAIT" "DONE" "CANX"))
+ ((listp filter-state) filter-state)
+ ((stringp filter-state)
+ (if (string-match-p "," filter-state)
+ (split-string filter-state ",")
+ (list filter-state)))
+ (t (list filter-state))))
+ (priority-list (cond ((null filter-priority) nil)
+ ((listp filter-priority) filter-priority)
+ (t (list filter-priority))))
+ (priority-regexp (org-batch--build-priority-regexp priority-list))
+ ;; Build org-ql query dynamically
+ (query `(and (todo ,@states)
+ ,@(when priority-regexp
+ `((regexp ,priority-regexp)))
+ ,@(when filter-tags
+ `((tags-local ,@filter-tags))))))
+ (org-ql-select file query
+ :action #'org-batch--element-to-alist-at-point)))
(defun org-batch-scheduled-today (file &optional date)
"Get items scheduled for DATE (default today) from FILE.
-DATE should be in format \"YYYY-MM-DD\" or \"today\"."
- (let* ((target-date (if (or (null date) (string= date "today"))
- (format-time-string "%Y-%m-%d")
- date))
- (items '()))
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((scheduled (org-element-property :scheduled hl)))
- (when scheduled
- (let ((sched-val (org-element-property :raw-value scheduled)))
- (when (string-match target-date sched-val)
- (push (org-batch--element-to-alist hl) items))))))))
- (nreverse items)))
+DATE should be \"YYYY-MM-DD\" or \"today\"."
+ (let ((target-date (if (or (null date) (string= date "today"))
+ 'today
+ (date-to-time date))))
+ (org-ql-select file
+ `(scheduled :on ,target-date)
+ :action #'org-batch--element-to-alist-at-point)))
(defun org-batch-by-section (file section-name)
- "Get all TODOs under SECTION-NAME (level 1 heading) in FILE."
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((in-section nil)
- (todos '()))
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((level (org-element-property :level hl))
- (heading (org-element-property :raw-value hl))
- (todo (org-element-property :todo-keyword hl)))
- ;; Track which section we're in
- (when (= level 1)
- (setq in-section (string= heading section-name)))
- ;; Collect TODOs in this section (level > 1)
- (when (and in-section todo (> level 1))
- (push (org-batch--element-to-alist hl) todos)))))
- (nreverse todos))))
+ "Get all TODOs under SECTION-NAME (level 1 heading) in FILE.
+Uses org-ql's `ancestors' predicate for clean hierarchical queries."
+ (org-ql-select file
+ `(and (todo)
+ (ancestors (and (level 1)
+ (heading ,section-name))))
+ :action #'org-batch--element-to-alist-at-point))
(defun org-batch-count-by-state (file)
"Count TODOs in FILE by state.
Returns alist with counts for each state."
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((counts '((total . 0) (TODO . 0) (NEXT . 0) (STRT . 0) (WAIT . 0) (DONE . 0) (CANX . 0))))
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((todo (org-element-property :todo-keyword hl)))
- (when todo
- (setcdr (assoc 'total counts) (1+ (cdr (assoc 'total counts))))
- (let ((state-entry (assoc (intern todo) counts)))
- (when state-entry
- (setcdr state-entry (1+ (cdr state-entry)))))))))
- counts)))
+ (let ((counts '((total . 0) (TODO . 0) (NEXT . 0) (STRT . 0)
+ (WAIT . 0) (DONE . 0) (CANX . 0))))
+ (org-ql-select file '(todo)
+ :action (lambda ()
+ (let* ((state (org-get-todo-state))
+ (state-sym (intern state)))
+ (cl-incf (alist-get 'total counts))
+ (when (assoc state-sym counts)
+ (cl-incf (alist-get state-sym counts))))))
+ counts))
(defun org-batch-search (file search-term)
"Search for SEARCH-TERM in FILE content.
Returns list of matching headlines with context."
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((matches '())
- (search-regexp (regexp-quote search-term)))
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let* ((begin (org-element-property :begin hl))
- (end (org-element-property :end hl))
- (content (buffer-substring-no-properties begin end)))
- (when (string-match-p search-regexp content)
- (push (cons (cons 'matched-in
- (if (string-match-p search-regexp
- (org-element-property :raw-value hl))
- "heading"
- "content"))
- (org-batch--element-to-alist hl))
- matches)))))
- (nreverse matches))))
+ (org-ql-select file
+ `(and (todo)
+ (regexp ,(regexp-quote search-term)))
+ :action (lambda ()
+ (let ((alist (org-batch--element-to-alist-at-point)))
+ (cons (cons 'matched-in
+ (if (string-match-p (regexp-quote search-term)
+ (alist-get 'heading alist))
+ "heading"
+ "content"))
+ alist)))))
(defun org-batch-get-sections (file)
"Get list of all level-1 sections in FILE."
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((sections '()))
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (when (= 1 (org-element-property :level hl))
- (push (org-element-property :raw-value hl) sections))))
- (nreverse sections))))
+ (org-ql-select file
+ '(level 1)
+ :action (lambda () (org-get-heading t t t t))))
(defun org-batch-get-children (file heading-name)
"Get all direct children TODOs of HEADING-NAME in FILE.
-Returns only immediate children (level = parent + 1), not all descendants."
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((children '())
- (parent-level nil)
- (in-subtree nil))
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((heading (org-element-property :raw-value hl))
- (level (org-element-property :level hl)))
- (cond
- ;; Found the parent heading
- ((string= heading heading-name)
- (setq parent-level level
- in-subtree t))
- ;; We're past the parent's subtree (same or lower level)
- ((and in-subtree parent-level (<= level parent-level))
- (setq in-subtree nil))
- ;; We're in the subtree and this is a direct child
- ((and in-subtree parent-level (= level (1+ parent-level)))
- (push (org-batch--element-to-alist hl) children))))))
- (nreverse children))))
+Uses org-ql's `parent' predicate."
+ (org-ql-select file
+ `(and (todo)
+ (parent (heading ,heading-name)))
+ :action #'org-batch--element-to-alist-at-point))
(defun org-batch-get-todo-content (file heading-name)
"Get full content of TODO with HEADING-NAME in FILE.
Returns alist with metadata, properties, and body content.
Returns nil if heading not found."
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((found nil)
- (result nil))
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (when (and (not found)
- (string= (org-element-property :raw-value hl) heading-name))
- (setq found t)
- ;; Build result with metadata
- (let* ((basic-data (org-batch--element-to-alist hl))
- (properties (org-batch--extract-properties hl))
- (content (org-batch--extract-content hl)))
- (setq result (append basic-data
- (list (cons 'properties properties)
- (cons 'content content))))))))
- result)))
+ (let ((results (org-ql-select file
+ `(heading ,heading-name)
+ :action (lambda ()
+ (let* ((element (org-element-at-point))
+ (basic-data (org-batch--element-to-alist-at-point))
+ (properties (org-batch--extract-properties-at-point))
+ (content (org-batch--extract-content-at-point element)))
+ (append basic-data
+ (list (cons 'properties properties)
+ (cons 'content content))))))))
+ (car results))) ; Return first match or nil
-(defun org-batch--extract-properties (element)
- "Extract properties drawer from ELEMENT as alist."
- (let ((properties '())
- (begin (org-element-property :begin element))
- (end (org-element-property :contents-end element)))
- (when (and begin end)
- (save-excursion
- (goto-char begin)
- (forward-line 1) ; Skip heading line
- ;; Look for :PROPERTIES: drawer
- (when (re-search-forward "^[ \t]*:PROPERTIES:[ \t]*$" end t)
- (let ((drawer-start (point)))
- (when (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
- (let ((drawer-end (match-beginning 0)))
- (goto-char drawer-start)
- ;; Extract each property
- (while (re-search-forward "^[ \t]*:\\([^:\n]+\\):[ \t]*\\(.*\\)$" drawer-end t)
- (let ((key (match-string 1))
- (value (match-string 2)))
- (push (cons key value) properties)))))))))
+(defun org-batch--extract-properties-at-point ()
+ "Extract properties drawer at point as alist."
+ (let ((props (org-entry-properties nil 'standard))
+ (properties '()))
+ (dolist (prop props)
+ (let ((key (car prop))
+ (val (cdr prop)))
+ (unless (member key '("CATEGORY" "BLOCKED" "ALLTAGS" "FILE" "PRIORITY_COOKIE"
+ "TODO" "TAGS" "ITEM"))
+ (push (cons key val) properties))))
(nreverse properties)))
-(defun org-batch--extract-content (element)
- "Extract body content from ELEMENT (excluding properties drawer).
-Returns the text content without the heading line or properties."
+(defun org-batch--extract-content-at-point (element)
+ "Extract body content from ELEMENT (excluding properties drawer)."
(let ((end (org-element-property :contents-end element))
(contents-begin (org-element-property :contents-begin element)))
(if (and contents-begin end)
(save-excursion
(let ((content-text (buffer-substring-no-properties contents-begin end)))
- ;; Remove properties drawer if present
(with-temp-buffer
(insert content-text)
(goto-char (point-min))
- ;; Remove SCHEDULED/DEADLINE lines (they're in metadata)
+ ;; Remove SCHEDULED/DEADLINE lines
(while (re-search-forward "^[ \t]*\\(?:SCHEDULED\\|DEADLINE\\|CLOSED\\):.*$" nil t)
(replace-match ""))
;; Remove properties drawer
@@ -280,7 +215,6 @@ Returns the text content without the heading line or properties."
(let ((drawer-start (match-beginning 0)))
(when (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)
(delete-region drawer-start (point))
- ;; Remove trailing newline
(when (looking-at "\n")
(delete-char 1)))))
;; Trim whitespace
@@ -296,35 +230,129 @@ Returns the text content without the heading line or properties."
(buffer-string))))
"")))
-;;; Write Operations
+(defun org-batch-get-overdue (file)
+ "Get all tasks with DEADLINE before today from FILE.
+Uses org-ql's `deadline' predicate."
+ (org-ql-select file
+ '(and (todo "TODO" "NEXT" "STRT" "WAIT")
+ (deadline :before today))
+ :action #'org-batch--element-to-alist-at-point))
+
+(defun org-batch-get-upcoming (file &optional days)
+ "Get tasks scheduled or due in next DAYS from FILE.
+DAYS defaults to 7."
+ (let ((days-count (or days 7)))
+ (org-ql-select file
+ `(and (todo "TODO" "NEXT" "STRT" "WAIT")
+ (or (scheduled :to ,days-count)
+ (deadline :to ,days-count)))
+ :action #'org-batch--element-to-alist-at-point)))
+
+(defun org-batch-get-recurring-tasks (file)
+ "Get all tasks with repeaters in FILE."
+ (org-ql-select file
+ '(and (todo)
+ (regexp "[.+]?\\+[0-9]+[hdwmy]"))
+ :action (lambda ()
+ (let* ((alist (org-batch--element-to-alist-at-point))
+ (scheduled (alist-get 'scheduled alist))
+ (deadline (alist-get 'deadline alist))
+ (repeater (or (and scheduled
+ (string-match "[.+]?\\+[0-9]+[hdwmy]" scheduled)
+ (match-string 0 scheduled))
+ (and deadline
+ (string-match "[.+]?\\+[0-9]+[hdwmy]" deadline)
+ (match-string 0 deadline)))))
+ (cons (cons 'repeater repeater) alist)))))
+
+(defun org-batch-get-blocked-tasks (file)
+ "Get all tasks that have BLOCKER property in FILE."
+ (org-ql-select file
+ '(and (todo)
+ (property "BLOCKER"))
+ :action (lambda ()
+ (let ((alist (org-batch--element-to-alist-at-point))
+ (blocker (org-entry-get nil "BLOCKER")))
+ (cons (cons 'blocker blocker) alist)))))
+
+;;; NEW: Advanced Queries (org-ql only)
+
+(defun org-batch-clocked-today (file)
+ "Get tasks that were clocked today.
+NEW in v2.0: Not possible without org-ql."
+ (org-ql-select file
+ '(clocked :on today)
+ :action #'org-batch--element-to-alist-at-point))
+
+(defun org-batch-habits (file)
+ "Get all habits from FILE.
+NEW in v2.0."
+ (org-ql-select file
+ '(habit)
+ :action #'org-batch--element-to-alist-at-point))
+
+(defun org-batch-stale-tasks (file &optional days)
+ "Get TODO tasks not touched in DAYS (default 30).
+NEW in v2.0: Find forgotten tasks."
+ (let ((days-ago (or days 30)))
+ (org-ql-select file
+ `(and (todo "TODO")
+ (not (ts :from ,(- days-ago))))
+ :action #'org-batch--element-to-alist-at-point)))
+
+(defun org-batch-by-path (file path-pattern)
+ "Get TODOs matching outline PATH-PATTERN.
+NEW in v2.0: Query by outline path like \"Projects\"."
+ (org-ql-select file
+ `(and (todo)
+ (path ,path-pattern))
+ :action #'org-batch--element-to-alist-at-point))
+
+(defun org-batch-with-property (file property &optional value)
+ "Get TODOs with PROPERTY (optionally matching VALUE).
+NEW in v2.0."
+ (org-ql-select file
+ (if value
+ `(and (todo) (property ,property ,value))
+ `(and (todo) (property ,property)))
+ :action #'org-batch--element-to-alist-at-point))
+
+(defun org-batch-priority-items (file min-priority &optional max-priority)
+ "Get TODOs with priority between MIN-PRIORITY and MAX-PRIORITY (1-5).
+NEW in v2.0."
+ (let* ((max-p (or max-priority min-priority))
+ (priorities (number-sequence min-priority max-p))
+ (regexp (org-batch--build-priority-regexp priorities)))
+ (org-ql-select file
+ `(and (todo "TODO" "NEXT" "STRT" "WAIT")
+ (regexp ,regexp))
+ :action #'org-batch--element-to-alist-at-point)))
+
+;;; Write Operations (unchanged - org-ql is read-only)
(defun org-batch--adjust-heading-levels (content parent-level)
"Adjust heading levels in CONTENT to be relative to PARENT-LEVEL.
Converts markdown headers (#, ##, ###) and org headers (*, **, ***)
-to the appropriate level relative to the parent heading.
-Parent level 2 (**) means # becomes ***, ## becomes ****, etc."
+to the appropriate level relative to the parent heading."
(with-temp-buffer
(insert content)
(goto-char (point-min))
- ;; First, convert markdown headings to org format with adjusted levels
+ ;; Convert markdown headings to org format with adjusted levels
(while (re-search-forward "^\\(#+\\)\\( .*\\)$" nil t)
(let* ((markdown-level (length (match-string 1)))
(header-text (match-string 2))
- ;; Subheading should be parent + markdown level
(new-level (+ parent-level markdown-level))
(org-stars (make-string new-level ?*)))
- ;; Replace with a temporary marker to avoid re-processing
(replace-match (concat "ORG_HEADING_MARKER:" org-stars header-text))))
- ;; Now process existing org headings (* Header) - adjust their level
+ ;; Process existing org headings
(goto-char (point-min))
(while (re-search-forward "^\\(\\*+\\)\\( .*\\)$" nil t)
(let* ((org-level (length (match-string 1)))
(header-text (match-string 2))
- ;; Subheading should be parent + org level
(new-level (+ parent-level org-level))
(org-stars (make-string new-level ?*)))
(replace-match (concat "ORG_HEADING_MARKER:" org-stars header-text))))
- ;; Remove the temporary markers
+ ;; Remove markers
(goto-char (point-min))
(while (re-search-forward "ORG_HEADING_MARKER:" nil t)
(replace-match ""))
@@ -333,7 +361,6 @@ Parent level 2 (**) means # becomes ***, ## becomes ****, etc."
(defun org-batch-append-content (file heading content)
"Append CONTENT to TODO with HEADING in FILE.
Adds content at the end of the heading's body, before any subheadings.
-Automatically adjusts heading levels in content (# becomes ###, etc).
Returns t on success, nil if heading not found."
(with-temp-buffer
(insert-file-contents file)
@@ -344,18 +371,11 @@ Returns t on success, nil if heading not found."
(regexp-quote heading))))
(when (re-search-forward heading-regexp nil t)
(org-back-to-heading)
- ;; Get parent heading level for content adjustment
(let* ((parent-level (org-current-level))
(section-end (save-excursion
- (org-end-of-subtree t t)
- (point)))
- ;; Adjust content heading levels
+ (org-end-of-subtree t t)
+ (point)))
(adjusted-content (org-batch--adjust-heading-levels content parent-level)))
- ;; Find the insertion point:
- ;; - After properties drawer
- ;; - After SCHEDULED/DEADLINE lines
- ;; - Before any subheadings
- ;; - At end of existing content
(forward-line 1)
;; Skip properties drawer
(when (looking-at "^[ \t]*:PROPERTIES:")
@@ -364,28 +384,23 @@ Returns t on success, nil if heading not found."
;; Skip SCHEDULED/DEADLINE/CLOSED lines
(while (looking-at "^[ \t]*\\(?:SCHEDULED\\|DEADLINE\\|CLOSED\\):")
(forward-line 1))
- ;; Skip logbook drawer if present
+ ;; Skip logbook drawer
(when (looking-at "^[ \t]*:LOGBOOK:")
(re-search-forward "^[ \t]*:END:" section-end t)
(forward-line 1))
- ;; Find end of content (before any subheading)
+ ;; Find end of content
(let ((content-end (save-excursion
- (if (re-search-forward "^\\*" section-end t)
- (match-beginning 0)
- section-end))))
+ (if (re-search-forward "^\\*" section-end t)
+ (match-beginning 0)
+ section-end))))
(goto-char content-end)
- ;; Skip back over trailing blank lines
(skip-chars-backward "\n\t ")
(unless (bolp) (forward-line 1))
- ;; Ensure we have a blank line before content if there's existing content
(unless (or (= (point) (save-excursion (org-back-to-heading) (forward-line 1) (point)))
- (looking-back "\\`\\|^[ \t]*\n" nil))
+ (looking-back "\\`\\|^[ \t]*\n" nil))
(insert "\n"))
- ;; Insert the adjusted content
(insert adjusted-content)
- ;; Ensure content ends with newline
(unless (bolp) (insert "\n"))
- ;; Add blank line after content if subheadings follow
(when (looking-at "^\\*")
(unless (looking-back "\n\n" nil)
(insert "\n")))
@@ -423,9 +438,7 @@ TAGS: List of tag strings"
(let ((section-regexp (concat "^\\* " (regexp-quote section) "$")))
(if (re-search-forward section-regexp nil t)
(progn
- ;; Find end of section
(org-end-of-subtree t)
- ;; Insert new TODO
(insert "\n** TODO ")
(when priority
(insert (format "[#%d] " priority)))
@@ -441,13 +454,11 @@ TAGS: List of tag strings"
(insert ":END:\n")
(write-region (point-min) (point-max) file)
t)
- ;; Section not found
nil))))
(defun org-batch-schedule-task (file heading date)
"Schedule task with HEADING in FILE for DATE.
-DATE should be \"YYYY-MM-DD\" format.
-Returns t on success, nil if heading not found."
+DATE should be \"YYYY-MM-DD\" format."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
@@ -464,8 +475,7 @@ Returns t on success, nil if heading not found."
(defun org-batch-set-deadline (file heading date)
"Set deadline for task with HEADING in FILE to DATE.
-DATE should be \"YYYY-MM-DD\" format.
-Returns t on success, nil if heading not found."
+DATE should be \"YYYY-MM-DD\" format."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
@@ -481,8 +491,7 @@ Returns t on success, nil if heading not found."
found)))
(defun org-batch-set-priority (file heading priority)
- "Set PRIORITY (1-5) for task with HEADING in FILE.
-Returns t on success, nil if heading not found."
+ "Set PRIORITY (1-5) for task with HEADING in FILE."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
@@ -492,11 +501,9 @@ Returns t on success, nil if heading not found."
(regexp-quote heading)))
(priority-cookie (format " [#%d]" priority)))
(when (re-search-forward heading-regexp nil t)
- (goto-char (match-end 1)) ; Move to end of TODO keyword
- ;; Remove existing priority if present
+ (goto-char (match-end 1))
(when (looking-at " \\[#[1-5]\\]")
(delete-region (point) (+ (point) 5)))
- ;; Insert new priority (note: priority-cookie already has leading space)
(insert priority-cookie)
(write-region (point-min) (point-max) file)
(setq found t))
@@ -504,8 +511,7 @@ Returns t on success, nil if heading not found."
(defun org-batch-add-tags (file heading new-tags)
"Add NEW-TAGS to task with HEADING in FILE.
-NEW-TAGS is a list of tag strings to add (existing tags are preserved).
-Returns t on success, nil if heading not found."
+NEW-TAGS is a list of tag strings to add."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
@@ -523,9 +529,7 @@ Returns t on success, nil if heading not found."
found)))
(defun org-batch-remove-tags (file heading tags-to-remove)
- "Remove TAGS-TO-REMOVE from task with HEADING in FILE.
-TAGS-TO-REMOVE is a list of tag strings to remove.
-Returns t on success, nil if heading not found."
+ "Remove TAGS-TO-REMOVE from task with HEADING in FILE."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
@@ -543,9 +547,7 @@ Returns t on success, nil if heading not found."
found)))
(defun org-batch-replace-tags (file heading new-tags)
- "Replace all tags on task with HEADING in FILE with NEW-TAGS.
-NEW-TAGS is a list of tag strings.
-Returns t on success, nil if heading not found."
+ "Replace all tags on task with HEADING in FILE with NEW-TAGS."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
@@ -561,85 +563,16 @@ Returns t on success, nil if heading not found."
found)))
(defun org-batch-list-all-tags (file)
- "List all unique tags used in FILE.
-Returns sorted list of tag strings."
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((all-tags '()))
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((tags (org-element-property :tags hl)))
- (when tags
- (setq all-tags (append all-tags tags))))))
- (sort (delete-dups all-tags) #'string<))))
-
-(defun org-batch-get-overdue (file)
- "Get all tasks with DEADLINE before today from FILE.
-Returns list of overdue tasks with their metadata."
- (let ((today (format-time-string "%Y-%m-%d"))
- (overdue-items '()))
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((todo (org-element-property :todo-keyword hl))
- (deadline (org-element-property :deadline hl)))
- ;; Only include active TODOs with deadlines
- (when (and todo
- (not (member todo '("DONE" "CANX")))
- deadline)
- (let ((deadline-date (org-element-property :raw-value deadline)))
- ;; Extract YYYY-MM-DD from deadline
- (when (string-match "\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)" deadline-date)
- (let ((dl-str (match-string 0 deadline-date)))
- ;; Compare dates (string comparison works for YYYY-MM-DD)
- (when (string< dl-str today)
- (push (org-batch--element-to-alist hl) overdue-items)))))))))
- (nreverse overdue-items))))
-
-(defun org-batch-get-upcoming (file &optional days)
- "Get tasks with DEADLINE or SCHEDULED in next DAYS from FILE.
-DAYS defaults to 7. Returns list of upcoming tasks."
- (let* ((days-count (or days 7))
- (today (current-time))
- (future-date (time-add today (days-to-time days-count)))
- (today-str (format-time-string "%Y-%m-%d" today))
- (future-str (format-time-string "%Y-%m-%d" future-date))
- (upcoming-items '()))
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((todo (org-element-property :todo-keyword hl))
- (scheduled (org-element-property :scheduled hl))
- (deadline (org-element-property :deadline hl)))
- ;; Only include active TODOs
- (when (and todo (not (member todo '("DONE" "CANX"))))
- (let ((dates-to-check '()))
- ;; Collect scheduled and deadline dates
- (when scheduled
- (push (org-element-property :raw-value scheduled) dates-to-check))
- (when deadline
- (push (org-element-property :raw-value deadline) dates-to-check))
- ;; Check if any date is in range
- (dolist (date-str dates-to-check)
- (when (string-match "\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)" date-str)
- (let ((task-date (match-string 0 date-str)))
- ;; Date is upcoming if: today <= date <= future
- (when (and (not (string< task-date today-str))
- (not (string< future-str task-date)))
- (push (org-batch--element-to-alist hl) upcoming-items)
- ;; Stop checking other dates for this task
- (setq dates-to-check nil))))))))))
- ;; Remove duplicates and reverse
- (delete-dups (nreverse upcoming-items)))))
+ "List all unique tags used in FILE."
+ (let ((all-tags '()))
+ (org-ql-select file '(todo)
+ :action (lambda ()
+ (dolist (tag (org-get-tags nil t))
+ (cl-pushnew tag all-tags :test #'string=))))
+ (sort all-tags #'string<)))
(defun org-batch-get-property (file heading property-name)
- "Get value of PROPERTY-NAME for task with HEADING in FILE.
-Returns property value string or nil if not found."
+ "Get value of PROPERTY-NAME for task with HEADING in FILE."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
@@ -653,8 +586,7 @@ Returns property value string or nil if not found."
found)))
(defun org-batch-set-property (file heading property-name value)
- "Set PROPERTY-NAME to VALUE for task with HEADING in FILE.
-Returns t on success, nil if heading not found."
+ "Set PROPERTY-NAME to VALUE for task with HEADING in FILE."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
@@ -670,8 +602,7 @@ Returns t on success, nil if heading not found."
found)))
(defun org-batch-list-properties (file heading)
- "List all properties for task with HEADING in FILE.
-Returns alist of (property . value) pairs."
+ "List all properties for task with HEADING in FILE."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
@@ -681,14 +612,12 @@ Returns alist of (property . value) pairs."
(regexp-quote heading))))
(when (re-search-forward heading-regexp nil t)
(org-back-to-heading)
- ;; Get all properties using org-entry-properties
(let ((props (org-entry-properties nil 'standard)))
(dolist (prop props)
(let ((key (car prop))
(val (cdr prop)))
- ;; Filter out special properties we don't want to show
(unless (member key '("CATEGORY" "BLOCKED" "ALLTAGS" "FILE" "PRIORITY_COOKIE"
- "TODO" "TAGS" "ITEM"))
+ "TODO" "TAGS" "ITEM"))
(push (cons key val) properties))))))
(nreverse properties))))
@@ -700,25 +629,20 @@ Returns count of archived items."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
- ;; Find and archive DONE items
(goto-char (point-min))
(while (re-search-forward "^\\*+ \\(DONE\\|CANX\\) " nil t)
(org-back-to-heading)
- ;; Get archive location from properties if available
(let ((local-archive (org-entry-get nil "ARCHIVE")))
(when local-archive
(setq archive-location local-archive)))
- (condition-case err
+ (condition-case nil
(progn
- (when archive-location
- (let ((org-archive-location archive-location))
- (org-archive-subtree)))
- (unless archive-location
+ (if archive-location
+ (let ((org-archive-location archive-location))
+ (org-archive-subtree))
(org-archive-subtree))
(setq count (1+ count)))
- (error
- (message "Failed to archive: %s" (error-message-string err)))))
- ;; Save changes
+ (error nil)))
(write-region (point-min) (point-max) file))
count))
@@ -726,7 +650,6 @@ Returns count of archived items."
(defun org-batch-bulk-update-state (file filter-state new-state &optional filter-tags)
"Update all tasks matching FILTER-STATE in FILE to NEW-STATE.
-FILTER-TAGS: Optional list of tags to further filter tasks.
Returns count of updated tasks."
(let ((count 0))
(with-temp-buffer
@@ -739,7 +662,6 @@ Returns count of updated tasks."
(tags (org-get-tags)))
(when (and todo
(string= todo filter-state)
- ;; Tag filter (match any)
(or (null filter-tags)
(and tags (seq-intersection filter-tags tags))))
(let ((org-log-done (if (string= new-state "DONE") 'time nil)))
@@ -780,10 +702,8 @@ Returns count of updated tasks."
(goto-char (point-min))
(while (re-search-forward (concat "^\\(\\*+ " (regexp-quote filter-state) "\\) \\(?:\\[#[1-5]\\] \\)?") nil t)
(goto-char (match-end 1))
- ;; Remove existing priority if present
(when (looking-at " \\[#[1-5]\\]")
(delete-region (point) (+ (point) 5)))
- ;; Insert new priority
(insert priority-cookie)
(setq count (1+ count)))
(write-region (point-min) (point-max) file))
@@ -792,8 +712,7 @@ Returns count of updated tasks."
;;; Time Tracking
(defun org-batch-clock-in (file heading)
- "Clock in to task with HEADING in FILE.
-Returns t on success, nil if heading not found."
+ "Clock in to task with HEADING in FILE."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
@@ -809,46 +728,40 @@ Returns t on success, nil if heading not found."
found)))
(defun org-batch-clock-out (file)
- "Clock out of currently clocked task in FILE.
-Returns t on success, nil if no active clock found."
+ "Clock out of currently clocked task in FILE."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
(goto-char (point-min))
(let ((found nil))
- ;; Find active clock line (has start time but no end time)
(when (re-search-forward "^\\([ \t]*CLOCK: \\)\\(\\[.*?\\]\\)$" nil t)
(let ((indent (match-string 1))
(start-time (match-string 2))
(end-time (format-time-string "[%Y-%m-%d %a %H:%M]")))
- ;; Calculate duration
(let* ((start-ts (org-parse-time-string start-time))
(start-encoded (apply #'encode-time start-ts))
(end-encoded (current-time))
(duration-seconds (float-time (time-subtract end-encoded start-encoded)))
(hours (floor (/ duration-seconds 3600)))
(minutes (floor (/ (mod duration-seconds 3600) 60))))
- ;; Replace the line with closed clock entry
(replace-match (format "%s%s--%s => %2d:%02d" indent start-time end-time hours minutes))
(write-region (point-min) (point-max) file)
(setq found t))))
found)))
(defun org-batch-get-active-clock (file)
- "Get currently active clock in FILE.
-Returns alist with heading and clock-in time, or nil if no active clock."
+ "Get currently active clock in FILE."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
(goto-char (point-min))
(let ((result nil))
- ;; Find active clock line (no end time)
(when (re-search-forward "^[ \t]*CLOCK: \\(\\[.*?\\]\\)$" nil t)
(let ((clock-start (match-string 1)))
(org-back-to-heading)
(let ((heading (org-element-property :raw-value (org-element-at-point))))
(setq result `((heading . ,heading)
- (clock_start . ,clock-start))))))
+ (clock_start . ,clock-start))))))
result)))
(defun org-batch-get-clocked-time (file heading)
@@ -872,127 +785,75 @@ Returns minutes as integer."
;;; Statistics & Analytics
(defun org-batch-get-statistics (file)
- "Get comprehensive statistics about TODOs in FILE.
-Returns alist with counts, priorities, tags, and time data."
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((total 0)
- (by-state '())
- (by-priority '())
- (by-tag '())
- (scheduled-count 0)
- (deadline-count 0)
- (overdue-count 0))
- ;; Count all TODOs and gather stats
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((todo (org-element-property :todo-keyword hl))
- (priority (org-batch--priority-to-number
- (org-element-property :priority hl)))
- (tags (org-element-property :tags hl))
- (scheduled (org-element-property :scheduled hl))
- (deadline (org-element-property :deadline hl)))
- (when todo
- (setq total (1+ total))
- ;; Count by state
- (let ((state-sym (intern todo)))
- (if (assoc state-sym by-state)
- (setcdr (assoc state-sym by-state)
- (1+ (cdr (assoc state-sym by-state))))
- (push (cons state-sym 1) by-state)))
- ;; Count by priority
- (when priority
- (if (assoc priority by-priority)
- (setcdr (assoc priority by-priority)
- (1+ (cdr (assoc priority by-priority))))
- (push (cons priority 1) by-priority)))
- ;; Count by tag
- (dolist (tag tags)
- (if (assoc tag by-tag #'string=)
- (setcdr (assoc tag by-tag #'string=)
- (1+ (cdr (assoc tag by-tag #'string=))))
- (push (cons tag 1) by-tag)))
- ;; Count scheduled/deadline
- (when scheduled (setq scheduled-count (1+ scheduled-count)))
- (when deadline (setq deadline-count (1+ deadline-count)))
- ;; Count overdue
- (when (and deadline (not (member todo '("DONE" "CANX"))))
- (let ((deadline-date (org-element-property :raw-value deadline))
- (today (format-time-string "%Y-%m-%d")))
- (when (string-match "\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)" deadline-date)
- (let ((dl-str (match-string 0 deadline-date)))
- (when (string< dl-str today)
- (setq overdue-count (1+ overdue-count)))))))))))
- ;; Return comprehensive stats
- `((total . ,total)
- (by_state . ,by-state)
- (by_priority . ,by-priority)
- (by_tag . ,by-tag)
- (scheduled_count . ,scheduled-count)
- (deadline_count . ,deadline-count)
- (overdue_count . ,overdue-count)))))
+ "Get comprehensive statistics about TODOs in FILE."
+ (let ((by-state (org-batch-count-by-state file))
+ (scheduled-count (length (org-ql-select file '(and (todo) (scheduled)))))
+ (deadline-count (length (org-ql-select file '(and (todo) (deadline)))))
+ (overdue-count (length (org-batch-get-overdue file)))
+ (by-priority '())
+ (by-tag '()))
+ ;; Count by priority
+ (dolist (p '(1 2 3 4 5))
+ (let ((regexp (format "\\[#%d\\]" p)))
+ (push (cons p (length (org-ql-select file `(and (todo) (regexp ,regexp)))))
+ by-priority)))
+ ;; Count by tag
+ (let ((all-tags '()))
+ (org-ql-select file '(todo)
+ :action (lambda ()
+ (dolist (tag (org-get-tags nil t))
+ (if (assoc tag all-tags #'string=)
+ (cl-incf (cdr (assoc tag all-tags #'string=)))
+ (push (cons tag 1) all-tags)))))
+ (setq by-tag (sort all-tags (lambda (a b) (> (cdr a) (cdr b))))))
+ `((total . ,(alist-get 'total by-state))
+ (by_state . ,by-state)
+ (by_priority . ,(nreverse by-priority))
+ (by_tag . ,by-tag)
+ (scheduled_count . ,scheduled-count)
+ (deadline_count . ,deadline-count)
+ (overdue_count . ,overdue-count))))
(defun org-batch-get-priority-distribution (file)
- "Get distribution of tasks by priority in FILE.
-Returns alist mapping priority (1-5) to count."
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((distribution '((1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0))))
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((todo (org-element-property :todo-keyword hl))
- (priority (org-batch--priority-to-number
- (org-element-property :priority hl))))
- (when (and todo priority)
- (let ((entry (assoc priority distribution)))
- (when entry
- (setcdr entry (1+ (cdr entry)))))))))
- distribution)))
+ "Get distribution of tasks by priority in FILE."
+ (let ((distribution '((1 . 0) (2 . 0) (3 . 0) (4 . 0) (5 . 0))))
+ (dolist (p '(1 2 3 4 5))
+ (let ((regexp (format "\\[#%d\\]" p)))
+ (setcdr (assoc p distribution)
+ (length (org-ql-select file `(and (todo) (regexp ,regexp)))))))
+ distribution))
(defun org-batch-get-tag-statistics (file)
- "Get statistics about tag usage in FILE.
-Returns sorted list of (tag . count) pairs."
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((tag-counts '()))
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((tags (org-element-property :tags hl)))
- (dolist (tag tags)
- (if (assoc tag tag-counts #'string=)
- (setcdr (assoc tag tag-counts #'string=)
- (1+ (cdr (assoc tag tag-counts #'string=))))
- (push (cons tag 1) tag-counts))))))
- ;; Sort by count descending
- (sort tag-counts (lambda (a b) (> (cdr a) (cdr b)))))))
+ "Get statistics about tag usage in FILE."
+ (let ((tag-counts '()))
+ (org-ql-select file '(todo)
+ :action (lambda ()
+ (dolist (tag (org-get-tags nil t))
+ (if (assoc tag tag-counts #'string=)
+ (cl-incf (cdr (assoc tag tag-counts #'string=)))
+ (push (cons tag 1) tag-counts)))))
+ (sort tag-counts (lambda (a b) (> (cdr a) (cdr b))))))
;;; Export & Reporting
(defun org-batch-export-csv (file output-file)
- "Export TODOs from FILE to CSV format in OUTPUT-FILE.
-Returns t on success."
+ "Export TODOs from FILE to CSV format in OUTPUT-FILE."
(let ((todos (org-batch-list-todos file)))
(with-temp-file output-file
- ;; CSV header
(insert "heading,state,priority,tags,level,scheduled,deadline\n")
- ;; CSV rows
(dolist (todo todos)
(insert (format "\"%s\",\"%s\",%s,\"%s\",%s,\"%s\",\"%s\"\n"
- (or (alist-get 'heading todo) "")
- (or (alist-get 'todo todo) "")
- (or (alist-get 'priority todo) "")
- (or (string-join (alist-get 'tags todo) ";") "")
- (or (alist-get 'level todo) "")
- (or (alist-get 'scheduled todo) "")
- (or (alist-get 'deadline todo) "")))))
+ (or (alist-get 'heading todo) "")
+ (or (alist-get 'todo todo) "")
+ (or (alist-get 'priority todo) "")
+ (or (string-join (alist-get 'tags todo) ";") "")
+ (or (alist-get 'level todo) "")
+ (or (alist-get 'scheduled todo) "")
+ (or (alist-get 'deadline todo) "")))))
t))
(defun org-batch-export-json (file output-file)
- "Export TODOs from FILE to JSON format in OUTPUT-FILE.
-Returns t on success."
+ "Export TODOs from FILE to JSON format in OUTPUT-FILE."
(let ((todos (org-batch-list-todos file)))
(with-temp-file output-file
(insert (json-encode todos)))
@@ -1001,9 +862,7 @@ Returns t on success."
;;; Recurring Tasks
(defun org-batch-set-repeater (file heading repeater-spec)
- "Set repeater REPEATER-SPEC for HEADING in FILE.
-REPEATER-SPEC should be like '+1w' or '.+2d' for org-mode repeaters.
-Returns t on success, nil if heading not found."
+ "Set repeater REPEATER-SPEC for HEADING in FILE."
(with-temp-buffer
(insert-file-contents file)
(org-mode)
@@ -1013,103 +872,41 @@ Returns t on success, nil if heading not found."
(regexp-quote heading))))
(when (re-search-forward heading-regexp nil t)
(org-back-to-heading)
- ;; Look for existing SCHEDULED line
(if (re-search-forward "^[ \t]*SCHEDULED:" (save-excursion (outline-next-heading) (point)) t)
- ;; Update existing scheduled with repeater
(progn
(beginning-of-line)
(when (re-search-forward "<\\([^>]+\\)>" (line-end-position) t)
(let ((timestamp (match-string 1)))
- ;; Remove existing repeater if any
(setq timestamp (replace-regexp-in-string " [.+]?\\+[0-9]+[dwmy]" "" timestamp))
- ;; Add new repeater
(replace-match (format "<%s %s>" timestamp repeater-spec)))))
- ;; No scheduled, add one with today's date + repeater
(org-back-to-heading)
(forward-line 1)
(insert (format "SCHEDULED: <%s %s>\n"
- (format-time-string "%Y-%m-%d %a")
- repeater-spec)))
+ (format-time-string "%Y-%m-%d %a")
+ repeater-spec)))
(write-region (point-min) (point-max) file)
(setq found t))
found)))
-(defun org-batch-get-recurring-tasks (file)
- "Get all tasks with repeaters in FILE.
-Returns list of tasks with their repeater specifications."
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((recurring '()))
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((todo (org-element-property :todo-keyword hl))
- (scheduled (org-element-property :scheduled hl))
- (deadline (org-element-property :deadline hl)))
- (when todo
- (let ((repeater nil))
- ;; Check for repeater in scheduled
- (when scheduled
- (let ((sched-val (org-element-property :raw-value scheduled)))
- (when (string-match "[.+]?\\+[0-9]+[dwmy]" sched-val)
- (setq repeater (match-string 0 sched-val)))))
- ;; Check for repeater in deadline
- (when (and (not repeater) deadline)
- (let ((dead-val (org-element-property :raw-value deadline)))
- (when (string-match "[.+]?\\+[0-9]+[dwmy]" dead-val)
- (setq repeater (match-string 0 dead-val)))))
- (when repeater
- (push (cons (cons 'repeater repeater)
- (org-batch--element-to-alist hl))
- recurring)))))))
- (nreverse recurring))))
-
;;; Dependencies & Relationships
(defun org-batch-set-blocker (file heading blocker-heading)
- "Set BLOCKER-HEADING as a blocker for HEADING in FILE.
-Creates or updates BLOCKER property.
-Returns t on success, nil if heading not found."
+ "Set BLOCKER-HEADING as a blocker for HEADING in FILE."
(org-batch-set-property file heading "BLOCKER" blocker-heading))
(defun org-batch-get-blocker (file heading)
- "Get blocker for HEADING in FILE.
-Returns blocker heading name or nil if no blocker set."
+ "Get blocker for HEADING in FILE."
(org-batch-get-property file heading "BLOCKER"))
-(defun org-batch-get-blocked-tasks (file)
- "Get all tasks that have blockers in FILE.
-Returns list of tasks with their blocker information."
- (with-temp-buffer
- (insert-file-contents file)
- (org-mode)
- (let ((blocked '()))
- (org-element-map (org-element-parse-buffer) 'headline
- (lambda (hl)
- (let ((todo (org-element-property :todo-keyword hl)))
- (when todo
- (let ((blocker-prop nil))
- (save-excursion
- (goto-char (org-element-property :begin hl))
- (setq blocker-prop (org-entry-get nil "BLOCKER")))
- (when blocker-prop
- (push (cons (cons 'blocker blocker-prop)
- (org-batch--element-to-alist hl))
- blocked)))))))
- (nreverse blocked))))
-
(defun org-batch-set-related (file heading related-heading relation-type)
"Set relationship between HEADING and RELATED-HEADING in FILE.
-RELATION-TYPE can be `child', `parent', `related', or `depends-on'.
-Uses org properties to track relationships.
-Returns t on success."
+RELATION-TYPE can be `child', `parent', `related', or `depends-on'."
(org-batch-set-property file heading
- (upcase (format "RELATED_%s" relation-type))
- related-heading))
+ (upcase (format "RELATED_%s" relation-type))
+ related-heading))
(defun org-batch-get-related (file heading)
- "Get all related tasks for HEADING in FILE.
-Returns alist of relationship types and related task names."
+ "Get all related tasks for HEADING in FILE."
(let ((props (org-batch-list-properties file heading))
(related '()))
(dolist (prop props)
@@ -1119,6 +916,113 @@ Returns alist of relationship types and related task names."
(push (cons (intern rel-type) rel-value) related))))
related))
+;;; Denote Operations
+
+(defun org-batch-denote-create (title tags &optional signature category directory content-file)
+ "Create a denote note with TITLE, TAGS, and optional metadata.
+SIGNATURE: Short identifier (e.g., 'pkai')
+CATEGORY: Category for the note
+DIRECTORY: Where to create the note
+CONTENT-FILE: File with initial content"
+ (let* ((dir (or directory (expand-file-name "~/desktop/org/notes")))
+ (date-str (format-time-string "%Y%m%dT%H%M%S"))
+ (slug (replace-regexp-in-string "[^a-zA-Z0-9-]" "-" (downcase title)))
+ (tags-str (if (listp tags) (mapconcat #'identity tags "_") tags))
+ (filename (format "%s--%s__%s.org" date-str slug tags-str))
+ (filepath (expand-file-name filename dir)))
+ ;; Create directory if needed
+ (unless (file-directory-p dir)
+ (make-directory dir t))
+ ;; Write the file
+ (with-temp-file filepath
+ (insert "#+title: " title "\n")
+ (insert "#+date: [" (format-time-string "%Y-%m-%d %a %H:%M") "]\n")
+ (insert "#+filetags: :" (if (listp tags) (mapconcat #'identity tags ":") tags) ":\n")
+ (when signature
+ (insert "#+identifier: " signature "\n"))
+ (when category
+ (insert "#+category: " category "\n"))
+ (insert "\n")
+ (when content-file
+ (when (file-exists-p content-file)
+ (insert-file-contents content-file))))
+ (princ (json-encode `((success . t) (filepath . ,filepath))))
+ (terpri)
+ filepath))
+
+(defun org-batch-denote-append (filepath content-file)
+ "Append content from CONTENT-FILE to denote note at FILEPATH."
+ (when (and (file-exists-p filepath) (file-exists-p content-file))
+ (with-temp-buffer
+ (insert-file-contents filepath)
+ (goto-char (point-max))
+ (insert "\n")
+ (insert-file-contents content-file)
+ (write-region (point-min) (point-max) filepath))
+ (princ (json-encode `((success . t) (appended . t))))
+ (terpri)
+ t))
+
+(defun org-batch-denote-metadata (filepath)
+ "Read metadata from denote note at FILEPATH."
+ (when (file-exists-p filepath)
+ (with-temp-buffer
+ (insert-file-contents filepath)
+ (let ((title nil) (date nil) (tags nil) (category nil) (identifier nil))
+ (goto-char (point-min))
+ (when (re-search-forward "^#\\+title: \\(.*\\)$" nil t)
+ (setq title (match-string 1)))
+ (goto-char (point-min))
+ (when (re-search-forward "^#\\+date: \\(.*\\)$" nil t)
+ (setq date (match-string 1)))
+ (goto-char (point-min))
+ (when (re-search-forward "^#\\+filetags: :\\(.*\\):$" nil t)
+ (setq tags (split-string (match-string 1) ":")))
+ (goto-char (point-min))
+ (when (re-search-forward "^#\\+category: \\(.*\\)$" nil t)
+ (setq category (match-string 1)))
+ (goto-char (point-min))
+ (when (re-search-forward "^#\\+identifier: \\(.*\\)$" nil t)
+ (setq identifier (match-string 1)))
+ (let ((result `((title . ,title)
+ (date . ,date)
+ (tags . ,tags)
+ (category . ,category)
+ (identifier . ,identifier)
+ (filepath . ,filepath))))
+ (princ (json-encode `((success . t) (data . ,result))))
+ (terpri)
+ result)))))
+
+(defun org-batch-denote-update (filepath &optional new-title new-tags new-category)
+ "Update metadata in denote note at FILEPATH."
+ (when (file-exists-p filepath)
+ (with-temp-buffer
+ (insert-file-contents filepath)
+ (when new-title
+ (goto-char (point-min))
+ (when (re-search-forward "^#\\+title: .*$" nil t)
+ (replace-match (concat "#+title: " new-title))))
+ (when new-tags
+ (goto-char (point-min))
+ (let ((tags-str (if (listp new-tags) (mapconcat #'identity new-tags ":") new-tags)))
+ (if (re-search-forward "^#\\+filetags: .*$" nil t)
+ (replace-match (concat "#+filetags: :" tags-str ":"))
+ (goto-char (point-min))
+ (forward-line 2)
+ (insert "#+filetags: :" tags-str ":\n"))))
+ (when new-category
+ (goto-char (point-min))
+ (if (re-search-forward "^#\\+category: .*$" nil t)
+ (replace-match (concat "#+category: " new-category))
+ (goto-char (point-min))
+ (forward-line 3)
+ (insert "#+category: " new-category "\n")))
+ (write-region (point-min) (point-max) filepath))
+ (princ (json-encode `((success . t) (updated . t))))
+ (terpri)
+ t))
+
;;; Output Functions
(defun org-batch-output-json (success data &optional error)
@@ -1136,5 +1040,5 @@ ERROR: error message if any"
"Output error MESSAGE in JSON format."
(org-batch-output-json nil nil message))
-(provide 'batch-functions)
-;;; batch-functions.el ends here
+(provide 'org-batch-functions)
+;;; org-batch-functions.el ends here
dots/.config/emacs/site-lisp/org-ql-batch-functions.el
@@ -0,0 +1,308 @@
+;;; org-ql-batch-functions.el --- Org-mode batch operations using org-ql -*- lexical-binding: t -*-
+
+;; Copyright (C) 2026 Vincent Demeester
+
+;; Author: Vincent Demeester <vincent@sbr.pm>
+;; Keywords: org, batch, automation, org-ql
+;; Version: 1.0.0
+;; Package-Requires: ((emacs "27.1") (org-ql "0.8"))
+
+;;; Commentary:
+
+;; Reimplementation of org-batch-functions.el using org-ql for queries.
+;; Benefits:
+;; - More powerful query language (30+ predicates)
+;; - Less code for complex queries
+;; - Composable queries with and/or/not
+;; - Built-in caching for performance
+;;
+;; This file provides drop-in replacements for read operations.
+;; Write operations are kept from the original (org-ql is read-only).
+
+;;; Code:
+
+(require 'org-ql)
+(require 'org-element)
+(require 'json)
+
+;;; Configuration (same as original)
+
+(setq org-priority-highest ?1
+ org-priority-lowest ?5
+ org-priority-default ?4)
+
+(setq org-todo-keywords
+ '((sequence "STRT(s)" "NEXT(n)" "TODO(t)" "WAIT(w)" "|" "DONE(d!)" "CANX(c@/!)")))
+
+;;; Utility Functions
+
+(defun org-ql-batch--element-to-alist ()
+ "Convert current heading to JSON-friendly alist.
+Must be called with point on a heading."
+ (let* ((element (org-element-at-point))
+ (priority-char (org-element-property :priority element))
+ (priority-num (when priority-char (- priority-char 48))))
+ `((heading . ,(org-get-heading t t t t))
+ (todo . ,(org-get-todo-state))
+ (priority . ,priority-num)
+ (tags . ,(org-get-tags nil t))
+ (level . ,(org-current-level))
+ (scheduled . ,(org-entry-get nil "SCHEDULED"))
+ (deadline . ,(org-entry-get nil "DEADLINE")))))
+
+(defun org-ql-batch--build-priority-regexp (priorities)
+ "Build regexp to match PRIORITIES (list of numbers 1-5)."
+ (when priorities
+ (format "\\[#[%s]\\]"
+ (mapconcat #'number-to-string priorities ""))))
+
+;;; Read Operations - Reimplemented with org-ql
+
+(defun org-ql-batch-list-todos (file &optional filter-state filter-priority filter-tags)
+ "List TODOs from FILE with optional filters using org-ql.
+FILTER-STATE: String like \"NEXT\" or \"TODO\", or list of states
+FILTER-PRIORITY: Number 1-5 or list of numbers
+FILTER-TAGS: List of tag strings (match any)
+
+This replaces `org-batch-list-todos' with ~50% less code."
+ (let* ((states (cond ((null filter-state) '("TODO" "NEXT" "STRT" "WAIT" "DONE" "CANX"))
+ ((listp filter-state) filter-state)
+ ((stringp filter-state)
+ (if (string-match-p "," filter-state)
+ (split-string filter-state ",")
+ (list filter-state)))
+ (t (list filter-state))))
+ (priority-list (cond ((null filter-priority) nil)
+ ((listp filter-priority) filter-priority)
+ (t (list filter-priority))))
+ (priority-regexp (org-ql-batch--build-priority-regexp priority-list))
+ ;; Build org-ql query dynamically
+ (query `(and (todo ,@states)
+ ,@(when priority-regexp
+ `((regexp ,priority-regexp)))
+ ,@(when filter-tags
+ `((tags-local ,@filter-tags))))))
+ (org-ql-select file query
+ :action #'org-ql-batch--element-to-alist)))
+
+(defun org-ql-batch-scheduled-today (file &optional date)
+ "Get items scheduled for DATE (default today) from FILE.
+DATE should be \"YYYY-MM-DD\" or \"today\".
+
+This replaces `org-batch-scheduled-today' - cleaner with org-ql predicates."
+ (let ((target-date (if (or (null date) (string= date "today"))
+ 'today
+ (date-to-time date))))
+ (org-ql-select file
+ `(scheduled :on ,target-date)
+ :action #'org-ql-batch--element-to-alist)))
+
+(defun org-ql-batch-by-section (file section-name)
+ "Get all TODOs under SECTION-NAME (level 1 heading) in FILE.
+
+Uses org-ql's `ancestors' predicate - much cleaner than manual tracking!"
+ (org-ql-select file
+ `(and (todo)
+ (ancestors (and (level 1)
+ (heading ,section-name))))
+ :action #'org-ql-batch--element-to-alist))
+
+(defun org-ql-batch-search (file search-term)
+ "Search for SEARCH-TERM in FILE content.
+
+Uses org-ql's `regexp' predicate."
+ (org-ql-select file
+ `(and (todo)
+ (regexp ,(regexp-quote search-term)))
+ :action (lambda ()
+ (let ((alist (org-ql-batch--element-to-alist)))
+ (cons (cons 'matched-in
+ (if (string-match-p (regexp-quote search-term)
+ (alist-get 'heading alist))
+ "heading"
+ "content"))
+ alist)))))
+
+(defun org-ql-batch-get-sections (file)
+ "Get list of all level-1 sections in FILE."
+ (org-ql-select file
+ '(level 1)
+ :action (lambda () (org-get-heading t t t t))))
+
+(defun org-ql-batch-get-children (file heading-name)
+ "Get all direct children TODOs of HEADING-NAME in FILE.
+
+Uses org-ql's `parent' predicate - elegant solution!"
+ (org-ql-select file
+ `(and (todo)
+ (parent (heading ,heading-name)))
+ :action #'org-ql-batch--element-to-alist))
+
+(defun org-ql-batch-get-overdue (file)
+ "Get all tasks with DEADLINE before today from FILE.
+
+Uses org-ql's `deadline' predicate with :before modifier."
+ (org-ql-select file
+ '(and (todo "TODO" "NEXT" "STRT" "WAIT")
+ (deadline :before today))
+ :action #'org-ql-batch--element-to-alist))
+
+(defun org-ql-batch-get-upcoming (file &optional days)
+ "Get tasks scheduled or due in next DAYS from FILE.
+DAYS defaults to 7.
+
+Uses org-ql's date predicates - very clean!"
+ (let ((days-count (or days 7)))
+ (org-ql-select file
+ `(and (todo "TODO" "NEXT" "STRT" "WAIT")
+ (or (scheduled :to ,days-count)
+ (deadline :to ,days-count)))
+ :action #'org-ql-batch--element-to-alist)))
+
+(defun org-ql-batch-get-recurring-tasks (file)
+ "Get all tasks with repeaters in FILE.
+
+Uses regexp to match org repeater syntax."
+ (org-ql-select file
+ '(and (todo)
+ (regexp "[.+]?\\+[0-9]+[hdwmy]"))
+ :action (lambda ()
+ (let* ((alist (org-ql-batch--element-to-alist))
+ (scheduled (alist-get 'scheduled alist))
+ (deadline (alist-get 'deadline alist))
+ (repeater (or (and scheduled
+ (string-match "[.+]?\\+[0-9]+[hdwmy]" scheduled)
+ (match-string 0 scheduled))
+ (and deadline
+ (string-match "[.+]?\\+[0-9]+[hdwmy]" deadline)
+ (match-string 0 deadline)))))
+ (cons (cons 'repeater repeater) alist)))))
+
+(defun org-ql-batch-get-blocked-tasks (file)
+ "Get all tasks that have BLOCKER property in FILE.
+
+Uses org-ql's `property' predicate."
+ (org-ql-select file
+ '(and (todo)
+ (property "BLOCKER"))
+ :action (lambda ()
+ (let ((alist (org-ql-batch--element-to-alist))
+ (blocker (org-entry-get nil "BLOCKER")))
+ (cons (cons 'blocker blocker) alist)))))
+
+(defun org-ql-batch-count-by-state (file)
+ "Count TODOs in FILE by state.
+
+Uses org-ql with grouping."
+ (let ((counts '((total . 0) (TODO . 0) (NEXT . 0) (STRT . 0)
+ (WAIT . 0) (DONE . 0) (CANX . 0))))
+ (org-ql-select file '(todo)
+ :action (lambda ()
+ (let* ((state (org-get-todo-state))
+ (state-sym (intern state)))
+ (cl-incf (alist-get 'total counts))
+ (when (assoc state-sym counts)
+ (cl-incf (alist-get state-sym counts))))))
+ counts))
+
+;;; Advanced Queries - New capabilities with org-ql
+
+(defun org-ql-batch-clocked-today (file)
+ "Get tasks that were clocked today.
+
+NEW: Not available in original - org-ql makes this easy!"
+ (org-ql-select file
+ '(clocked :on today)
+ :action #'org-ql-batch--element-to-alist))
+
+(defun org-ql-batch-habits (file)
+ "Get all habits from FILE.
+
+NEW: Easy habit filtering with org-ql!"
+ (org-ql-select file
+ '(habit)
+ :action #'org-ql-batch--element-to-alist))
+
+(defun org-ql-batch-stale-tasks (file &optional days)
+ "Get TODO tasks not touched in DAYS (default 30).
+
+NEW: Find forgotten tasks!"
+ (let ((days-ago (or days 30)))
+ (org-ql-select file
+ `(and (todo "TODO")
+ (not (ts :from ,(- days-ago))))
+ :action #'org-ql-batch--element-to-alist)))
+
+(defun org-ql-batch-by-path (file path-pattern)
+ "Get TODOs matching outline PATH-PATTERN.
+
+NEW: Query by outline path like 'Projects/Work/Tekton'."
+ (org-ql-select file
+ `(and (todo)
+ (path ,path-pattern))
+ :action #'org-ql-batch--element-to-alist))
+
+(defun org-ql-batch-with-property (file property &optional value)
+ "Get TODOs with PROPERTY (optionally matching VALUE).
+
+NEW: Easy property-based queries!"
+ (org-ql-select file
+ (if value
+ `(and (todo) (property ,property ,value))
+ `(and (todo) (property ,property)))
+ :action #'org-ql-batch--element-to-alist))
+
+;;; Statistics - Simplified with org-ql
+
+(defun org-ql-batch-get-statistics (file)
+ "Get comprehensive statistics about TODOs in FILE.
+
+Combines multiple org-ql queries for efficiency."
+ (let ((by-state (org-ql-batch-count-by-state file))
+ (scheduled-count (length (org-ql-select file '(and (todo) (scheduled)))))
+ (deadline-count (length (org-ql-select file '(and (todo) (deadline)))))
+ (overdue-count (length (org-ql-batch-get-overdue file)))
+ (by-priority '())
+ (by-tag '()))
+ ;; Count by priority
+ (dolist (p '(1 2 3 4 5))
+ (let ((regexp (format "\\[#%d\\]" p)))
+ (push (cons p (length (org-ql-select file `(and (todo) (regexp ,regexp)))))
+ by-priority)))
+ ;; Count by tag (get all unique tags first, then count)
+ (let ((all-tags '()))
+ (org-ql-select file '(todo)
+ :action (lambda ()
+ (dolist (tag (org-get-tags nil t))
+ (if (assoc tag all-tags #'string=)
+ (cl-incf (cdr (assoc tag all-tags #'string=)))
+ (push (cons tag 1) all-tags)))))
+ (setq by-tag (sort all-tags (lambda (a b) (> (cdr a) (cdr b))))))
+ ;; Return stats
+ `((total . ,(alist-get 'total by-state))
+ (by_state . ,by-state)
+ (by_priority . ,(nreverse by-priority))
+ (by_tag . ,by-tag)
+ (scheduled_count . ,scheduled-count)
+ (deadline_count . ,deadline-count)
+ (overdue_count . ,overdue-count))))
+
+;;; Output Functions (same as original)
+
+(defun org-ql-batch-output-json (success data &optional error)
+ "Output JSON response.
+SUCCESS: boolean
+DATA: data to include in response
+ERROR: error message if any"
+ (let ((response (if success
+ `((success . ,success) (data . ,data))
+ `((success . :json-false) (error . ,error)))))
+ (princ (json-encode response))
+ (terpri)))
+
+(defun org-ql-batch-output-error (message)
+ "Output error MESSAGE in JSON format."
+ (org-ql-batch-output-json nil nil message))
+
+(provide 'org-ql-batch-functions)
+;;; org-ql-batch-functions.el ends here