org-agenda-shellHEADmaster

Initial version of org-agenda-shell. Alpha.

2 files changed, 216 insertions, 0 deletions

diff --git a/.emacs.d/rul-lisp/packages/org-agenda-shell.el b/.emacs.d/rul-lisp/packages/org-agenda-shell.el
new file mode 100644
index 0000000..4c4c493
--- /dev/null
+++ b/.emacs.d/rul-lisp/packages/org-agenda-shell.el
@@ -0,0 +1,214 @@
+;;; org-agenda-shell.el --- Export Org agenda state for shell integrations -*- lexical-binding: t; -*-
+
+(require 'cl-lib)
+(require 'json)
+(require 'org)
+(require 'org-clock)
+(require 'seq)
+
+(defgroup org-agenda-shell nil
+  "Export Org agenda data for desktop integrations."
+  :group 'org)
+
+(defcustom org-agenda-shell-snapshot-path "~/.cache/org-agenda-shell/today.json"
+  "Path to the JSON snapshot consumed by external shell integrations."
+  :type 'file)
+
+(defcustom org-agenda-shell-export-idle-delay 2
+  "Idle delay, in seconds, before exporting the agenda snapshot after changes."
+  :type 'number)
+
+(defvar org-agenda-shell--export-idle-timer nil
+  "Pending idle timer for agenda snapshot exports.")
+
+(defun org-agenda-shell--time-epoch (time)
+  "Return TIME as an integer Unix epoch."
+  (truncate (float-time time)))
+
+(defun org-agenda-shell--json-bool (value)
+  "Return VALUE encoded as a JSON boolean."
+  (if value t :json-false))
+
+(defun org-agenda-shell--today-days ()
+  "Return today's date as an absolute day count."
+  (time-to-days (current-time)))
+
+(defun org-agenda-shell--open-todo-p ()
+  "Return non-nil when the current heading is an open TODO item."
+  (let ((state (org-get-todo-state)))
+    (and state
+         (not (member state org-done-keywords)))))
+
+(defun org-agenda-shell--scheduled-clock-string (scheduled)
+  "Return the HH:MM component extracted from SCHEDULED, if present."
+  (when (and scheduled
+             (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" scheduled))
+    (match-string 1 scheduled)))
+
+(defun org-agenda-shell--task-record ()
+  "Return the current heading as an export task alist, or nil."
+  (let* ((scheduled (org-entry-get nil "SCHEDULED"))
+         (scheduled-time (and scheduled (org-time-string-to-time scheduled)))
+         (scheduled-days (and scheduled-time (time-to-days scheduled-time)))
+         (today-days (org-agenda-shell--today-days)))
+    (when (and scheduled
+               scheduled-time
+               scheduled-days
+               (<= scheduled-days today-days)
+               (org-agenda-shell--open-todo-p))
+      (let* ((file (buffer-file-name (buffer-base-buffer)))
+             (begin (point))
+             (task-id (or (org-entry-get nil "ID")
+                          (format "%s::%d" file begin)))
+             (scheduled-for (format-time-string "%F" scheduled-time))
+             (clock-time (org-agenda-shell--scheduled-clock-string scheduled))
+             (title (org-get-heading t t t t))
+             (state (org-get-todo-state)))
+        `((id . ,task-id)
+          (title . ,title)
+          (time . ,clock-time)
+          (state . ,state)
+          (category . ,(org-get-category))
+          (scheduled_for . ,scheduled-for)
+          (is_today . ,(org-agenda-shell--json-bool
+                        (= scheduled-days today-days)))
+          (is_overdue . ,(org-agenda-shell--json-bool
+                          (< scheduled-days today-days)))
+          (source_file . ,file)
+          (_sort_days . ,scheduled-days)
+          (_sort_time . ,(or clock-time "")))))))
+
+(defun org-agenda-shell--task< (left right)
+  "Return non-nil when LEFT should sort before RIGHT."
+  (let ((left-days (alist-get '_sort_days left))
+        (right-days (alist-get '_sort_days right))
+        (left-time (alist-get '_sort_time left))
+        (right-time (alist-get '_sort_time right))
+        (left-title (alist-get 'title left))
+        (right-title (alist-get 'title right)))
+    (or (< left-days right-days)
+        (and (= left-days right-days)
+             (or (string< left-time right-time)
+                 (and (string= left-time right-time)
+                      (string< left-title right-title)))))))
+
+(defun org-agenda-shell--public-task (task)
+  "Return TASK without exporter-only sort keys."
+  (seq-remove
+   (lambda (pair)
+     (memq (car pair) '(_sort_days _sort_time)))
+   task))
+
+(defun org-agenda-shell--collect-tasks ()
+  "Return agenda tasks scheduled for today and overdue scheduled items."
+  (let (tasks)
+    (dolist (file (org-agenda-files))
+      (when (file-readable-p file)
+        (let ((create-lockfiles nil))
+          (with-current-buffer (find-file-noselect file)
+            (org-with-wide-buffer
+              (org-map-entries
+               (lambda ()
+                 (let ((task (org-agenda-shell--task-record)))
+                   (when task
+                     (push task tasks))))
+               nil
+               'file))))))
+    (sort tasks #'org-agenda-shell--task<)))
+
+(defun org-agenda-shell--clocked-in-record ()
+  "Return the currently clocked-in Org task as an alist, or nil."
+  (when (and (org-clocking-p)
+             (marker-buffer org-clock-marker))
+    (org-with-point-at org-clock-marker
+      (let* ((file (buffer-file-name (buffer-base-buffer)))
+             (begin (point))
+             (started-at org-clock-start-time)
+             (task-id (or (org-entry-get nil "ID")
+                          (format "%s::%d" file begin))))
+        `((id . ,task-id)
+          (title . ,(or org-clock-current-task
+                        (org-get-heading t t t t)))
+          (state . ,(org-get-todo-state))
+          (category . ,(org-get-category))
+          (source_file . ,file)
+          (started_at . ,(format-time-string "%FT%T%z" started-at))
+          (started_epoch . ,(org-agenda-shell--time-epoch started-at)))))))
+
+;;;###autoload
+(defun org-agenda-shell-export ()
+  "Write the JSON snapshot consumed by shell integrations."
+  (interactive)
+  (let* ((now (current-time))
+         (json-encoding-pretty-print nil)
+         (tasks (mapcar #'org-agenda-shell--public-task
+                        (org-agenda-shell--collect-tasks)))
+         (clocked-in (org-agenda-shell--clocked-in-record))
+         (today-count (cl-count-if (lambda (task)
+                                     (eq t (alist-get 'is_today task)))
+                                   tasks))
+         (overdue-count (cl-count-if (lambda (task)
+                                       (eq t (alist-get 'is_overdue task)))
+                                     tasks))
+         (payload `((generated_at . ,(format-time-string "%FT%T%z" now))
+                    (generated_epoch . ,(org-agenda-shell--time-epoch now))
+                    (date . ,(format-time-string "%F" now))
+                    (task_count . ,(length tasks))
+                    (today_count . ,today-count)
+                    (overdue_count . ,overdue-count)
+                    (clocked_in . ,clocked-in)
+                    (today_tasks . ,(vconcat tasks))))
+         (target (expand-file-name org-agenda-shell-snapshot-path))
+         (target-dir (file-name-directory target)))
+    (make-directory target-dir t)
+    (with-temp-file target
+      (insert (json-encode payload))
+      (insert "\n"))))
+
+(defun org-agenda-shell-safe-export ()
+  "Export the agenda snapshot and log any errors."
+  (setq org-agenda-shell--export-idle-timer nil)
+  (condition-case err
+      (org-agenda-shell-export)
+    (error
+     (message "org-agenda-shell export failed: %s"
+              (error-message-string err)))))
+
+(defun org-agenda-shell-schedule-export ()
+  "Schedule an idle export of the agenda snapshot."
+  (when org-agenda-shell--export-idle-timer
+    (cancel-timer org-agenda-shell--export-idle-timer))
+  (setq org-agenda-shell--export-idle-timer
+        (run-with-idle-timer
+         org-agenda-shell-export-idle-delay
+         nil
+         #'org-agenda-shell-safe-export)))
+
+(defun org-agenda-shell--after-save-hook ()
+  "Refresh the agenda snapshot when an agenda file is saved."
+  (when (and buffer-file-name
+             (member (file-truename buffer-file-name)
+                     (mapcar #'file-truename (org-agenda-files))))
+    (org-agenda-shell-schedule-export)))
+
+;;;###autoload
+(define-minor-mode org-agenda-shell-mode
+  "Keep a JSON snapshot of the Org agenda up to date."
+  :global t
+  (if org-agenda-shell-mode
+      (progn
+        (add-hook 'after-save-hook #'org-agenda-shell--after-save-hook)
+        (add-hook 'org-clock-in-hook #'org-agenda-shell-schedule-export)
+        (add-hook 'org-clock-out-hook #'org-agenda-shell-schedule-export)
+        (add-hook 'org-clock-cancel-hook #'org-agenda-shell-schedule-export)
+        (org-agenda-shell-schedule-export))
+    (remove-hook 'after-save-hook #'org-agenda-shell--after-save-hook)
+    (remove-hook 'org-clock-in-hook #'org-agenda-shell-schedule-export)
+    (remove-hook 'org-clock-out-hook #'org-agenda-shell-schedule-export)
+    (remove-hook 'org-clock-cancel-hook #'org-agenda-shell-schedule-export)
+    (when org-agenda-shell--export-idle-timer
+      (cancel-timer org-agenda-shell--export-idle-timer)
+      (setq org-agenda-shell--export-idle-timer nil))))
+
+(provide 'org-agenda-shell)
+;;; org-agenda-shell.el ends here
diff --git a/.emacs.d/rul-lisp/packages/rul-org.el b/.emacs.d/rul-lisp/packages/rul-org.el
index 979fdab..f488ab0 100644
--- a/.emacs.d/rul-lisp/packages/rul-org.el
+++ b/.emacs.d/rul-lisp/packages/rul-org.el
@@ -5,6 +5,8 @@
 (require 'org-habit)
 
 (require 'rul-org-agenda)
+(require 'org-agenda-shell)
+(org-agenda-shell-mode 1)
 
 (setq org-attach-use-inheritance t)
 (setq org-cycle-separator-lines 0)