aboutsummaryrefslogtreecommitdiff
path: root/.emacs.d/rul-lisp/packages/org-agenda-shell.el
blob: 4c4c49360827aed3a21dd2ab93311ccdec10db1c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
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
nihil fit ex nihilo