diff options
Diffstat (limited to '.emacs.d/rul-lisp')
| -rw-r--r-- | .emacs.d/rul-lisp/packages/org-agenda-shell.el | 214 | ||||
| -rw-r--r-- | .emacs.d/rul-lisp/packages/rul-org.el | 2 |
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) |