-
Notifications
You must be signed in to change notification settings - Fork 0
/
osd.el
380 lines (319 loc) · 14.4 KB
/
osd.el
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
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
;;; osd.el --- Emacs notification daemon. -*- lexical-binding: t -*-
;; Copyright (c) 2022 0x0049
;; Author: 0x0049 <[email protected]>
;; URL: https://github.com/0x0049/osd
;; Keywords: notifications dbus
;; Version: 2.1.1
;; This file is NOT part of GNU Emacs.
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; See <http://www.gnu.org/licenses/> for a copy of the GNU General
;; Public License.
;;; Commentary:
;; Emacs must be compiled with dbus support. Start Emacs with something like:
;; `exec dbus-launch --exit-with-session <emacs invocation>'.
;; See https://specifications.freedesktop.org/notification-spec/notification-spec-latest.html
;; for the notification spec.
;;; Code:
(require 'dbus)
(defcustom osd-time-format "%Y-%m-%d %T"
"Format for the notification time column."
:type 'string
:group 'osd)
(defcustom osd-max-notifications 1000
"Maximum number of notifications to keep in memory."
:type 'integer
:group 'osd)
(defcustom osd-display-method 'echo
"How to display new notifications."
:type '(choice
(const :tag "Never" nil)
(const :tag "Notification buffer" buffer)
(const :tag "Echo area" echo))
:group 'osd)
(defcustom osd-notify-program nil
"The program to use to send notifications (like notify-send).
If nil trigger the dbus notify handler directly instead."
:type 'string
:group 'osd)
(cl-defstruct notification time app summary body actions)
(defvar osd--notification-ring nil "Notification list.")
;; Each notification gets an incrementing ID. Servers should never return zero
;; for an ID.
(defvar osd--id 0 "Last notification ID.")
(defun osd--dbus-close-notification (id)
"Handle the CloseNotification signal.
Close a notification identified by ID. If the notification no
longer exists, an empty D-BUS message is sent back.
The NotificationClosed signal is emitted by this method."
(osd--apply-dbus-fn
#'dbus-send-signal
`(("NotificationClosed" ,id ,osd--reason-closed))))
(defun osd--dbus-get-capabilities ()
"Handle the GetCapabilities signal."
'((;; "action-icons" ;; Icons for actions instead of text.
"actions" ;; Provide actions to the user.
"body" ;; Body text.
"body-hyperlinks" ;; Hyperlinks in the body.
;; "body-images" ;; Images in the body.
;; "body-markup" ;; Markup in the body.
;; "icon-multi" ;; Render an animation (gets multiple frames).
;; "icon-static" ;; Show one frame (mutually exclusive with icon-multi).
"persistence" ;; Notifications are retained until removed by user.
;; "sound" ;; Must support "sound-file" and "suppress-sound" hints.
)))
(defun osd--dbus-get-server-information ()
"Handle the GetServerInformation signal."
'("osd" ;; Name of the server.
"0x0049" ;; Vendor name.
"2.1.1" ;; Version of the server.
"1.2" ;; Version of the spec with which the server is compliant.
))
(defun osd--dbus-notify (app-name _replaces-id _app-icon summary body actions _hints _expire_timeout)
"Handle the Notify signal.
APP-NAME is the optional name of the application sending the
notification.
REPLACES-ID is the optional ID of a notification this
notification replaces. If this is zero, the return value is an
ID that represents the notification. Otherwise it's the same as
REPLACES-ID.
APP-ICON is the optional program icon of the calling application.
SUMMARY is a brief description of the notification while BODY is
the optional detailed body text.
ACTIONS are list of pairs. The even elements are the identifier
and the odd elements are the strings to display to the user.
HINTS are optional hints that can provide extra information to
the server like a PID.
EXPIRE-TIMEOUT is how long to display the notification before
automatically closing it. If -1 it depends on the server. If 0
it never expires."
(setq osd--id (+ 1 osd--id))
(osd--notify osd--id (make-notification
:actions actions
:app (or app-name "unknown")
:body body
:summary summary
:time (format-time-string osd-time-format)))
osd--id)
(defun osd--center-truncate (item len)
"Replace the center of ITEM with … to make it of length LEN (including …).
When the length is odd the right side will be one longer than the left."
(let ((item (if (stringp item) item (format "%s" item))))
(if (> (length item) len)
(let* ((len (- len 1))
(mid (/ len 2)))
(concat (substring item 0 mid)
(apply #'propertize "…" (text-properties-at (- mid 1) item))
(substring item (- mid len) nil)))
item)))
(defun osd--entries ()
"Return notification data for `tabulated-list-entries'."
(let ((vect nil)
(idx (- (or (and osd--notification-ring (ring-length osd--notification-ring)) 0) 1)))
(while (and (>= idx 0))
(let* ((entry (ring-ref osd--notification-ring idx))
(notification (cdr entry)))
(push
`(,(car entry) [,(cl-struct-slot-value 'notification 'time notification)
,(osd--center-truncate
(cl-struct-slot-value 'notification 'app notification)
10)
,(osd--center-truncate
(cl-struct-slot-value 'notification 'summary notification)
50)
;; TODO: This still isn't great, would prefer to have
;; the original newlines in addition to automatic
;; wrapping but have it all aligned somehow.
,(replace-regexp-in-string
"\n+" " "
(cl-struct-slot-value 'notification 'body notification))])
vect))
(setq idx (- idx 1)))
vect))
(defun osd--refresh ()
"Refresh the notification list."
(setq tabulated-list-entries (osd--entries)))
(defun osd--goto-notification (id)
"Goto to the notification identified by ID, staying on the same column.
If ID is not found, go to the beginning of the buffer."
(unless (derived-mode-p 'osd-mode)
(error "The current buffer is not in OSD mode"))
(let ((col (tablist-current-column)))
(goto-char (point-min))
(while (and (not (equal id (tabulated-list-get-id)))
(not (eq 1 (forward-line 1)))))
(unless (tabulated-list-get-id) (goto-char (point-min)))
(tablist-move-to-column
(or col (car (tablist-major-columns))))))
(defun osd--get-notification (id)
"Get a notification by ID."
(let ((idx (- (or (and osd--notification-ring (ring-length osd--notification-ring)) 0) 1)))
(while (and (>= idx 0)
(not (eq id (car (ring-ref osd--notification-ring idx)))))
(setq idx (- idx 1)))
(when (>= idx 0) (ring-ref osd--notification-ring idx))))
(defconst osd--reason-expired 1 "Notification expired.")
(defconst osd--reason-dismissed 2 "Closed by user.")
(defconst osd--reason-closed 3 "Closed by CloseNotification.")
(defconst osd--reason-undefined 4 "Undefined/reserved reason.")
(defun osd--find-notification (id)
"Return the index of the notification identified by ID."
(let ((idx (- (or (and osd--notification-ring (ring-length osd--notification-ring)) 0) 1)))
(while (and (>= idx 0)
(not (eq id (car (ring-ref osd--notification-ring idx)))))
(setq idx (- idx 1)))
(when (>= idx 0) idx)))
(defun osd--delete-notification (id)
"Delete a notification by ID."
(when-let ((idx (osd--find-notification id)))
(ring-remove osd--notification-ring idx)
(osd--apply-dbus-fn
#'dbus-send-signal
`(("NotificationClosed" ,id ,osd--reason-dismissed)))))
(defun osd--visit-notification (id)
"Trigger a notification's action by ID."
(when-let ((idx (osd--find-notification id))
(entry (cdr (ring-ref osd--notification-ring idx)))
(actions (cl-struct-slot-value 'notification 'actions entry)))
(osd--apply-dbus-fn
#'dbus-send-signal
`(("ActionInvoked" ,id ,(car actions))))))
(defun osd--notify (id notification)
"Store NOTIFICATION by ID then refresh notification list."
(if osd--notification-ring
(unless (eq osd-max-notifications (ring-size osd--notification-ring))
(ring-resize osd--notification-ring osd-max-notifications))
(setq osd--notification-ring (make-ring osd-max-notifications)))
(let ((existing (osd--get-notification id)))
(if existing (setcdr existing notification)
(ring-insert osd--notification-ring `(,id . ,notification))))
(let ((buffer (get-buffer-create "*Notifications*")))
(with-current-buffer buffer
(osd-mode)
(osd--refresh)
(tablist-revert)
(osd--goto-notification id))
;; TODO: Unread/unacknowledged count in modeline.
(cl-case osd-display-method
(echo (let ((app (cl-struct-slot-value 'notification 'app notification))
(body (replace-regexp-in-string "\n+" " " (cl-struct-slot-value 'notification 'body notification)))
(summary (cl-struct-slot-value 'notification 'summary notification)))
(message "%s" (if (< 0 (length body)) (concat "[" app "] " summary ": " body) summary))))
(buffer (display-buffer buffer)))))
(defun osd--apply-dbus-fn (dbus-fn args)
"Call DBUS-FN with ARGS which is a list of argument lists.
If dbus support is not enabled then do nothing."
(when (featurep 'dbusbind)
(dolist (a args)
(apply dbus-fn
:session "org.freedesktop.Notifications"
"/org/freedesktop/Notifications" "org.freedesktop.Notifications"
a))))
;;;###autoload
(defun osd-start ()
"Start listening."
(interactive)
(osd--apply-dbus-fn
#'dbus-register-method
'(("CloseNotification" osd--dbus-close-notification)
("GetCapabilities" osd--dbus-get-capabilities)
("GetServerInformation" osd--dbus-get-server-information)
("Notify" osd--dbus-notify))))
;;;###autoload
(defun osd-show-notifications ()
"Show notifications buffer."
(interactive)
(pop-to-buffer (get-buffer-create "*Notifications*"))
(osd-mode)
(osd--refresh)
(tablist-revert))
;;;###autoload
(defun osd-stop ()
"Stop listening."
(interactive)
(dbus-unregister-service :session "org.freedesktop.Notifications"))
;;;###autoload
(defun osd-notify (notification)
"Display NOTIFICATION, a list with a summary, body, and app name."
(if osd-notify-program
(set-process-sentinel
(start-process osd-notify-program nil osd-notify-program
"--app-name" (or (nth 2 notification) "unknown")
(nth 0 notification)
(nth 1 notification))
(lambda (_ event)
(message "%s: %s" osd-notify-program (string-trim event))))
(osd--dbus-notify (nth 2 notification) nil nil
(nth 0 notification)
(nth 1 notification) nil nil nil)))
(defun osd--tablist-operations (operation &rest arguments)
"Perform OPERATION with ARGUMENTS.
See `tablist-operations-function' for more information."
(cl-ecase operation
(delete (mapc #'osd--delete-notification (nth 0 arguments)))
(find-entry (osd--visit-notification (nth 0 arguments)))
(supported-operations '(delete find-entry))))
(define-derived-mode osd-mode tablist-mode "OSD"
"Mode for the notification center."
(setq tabulated-list-format [("Time" 20 t)("App" 10 t)("Summary" 50 t)("Body" 50 t)]
tabulated-list-padding 2
tablist-operations-function 'osd--tablist-operations)
(add-hook 'tabulated-list-revert-hook #'osd--refresh nil t)
(tabulated-list-init-header)
;; TODO: Does inheriting tablist-mode not automatically set this?
(tablist-minor-mode))
(defun osd--org-format-appt (remaining text)
"Format appointment described by TEXT due in REMAINING minutes.
The result is a list with the summary and body."
(let ((case-fold-search nil)
(remaining (if (string= "0" remaining)
"now"
(concat "in " remaining " min"
(unless (string= "1" remaining) "s")))))
(save-match-data
;; [START] [STATE? (3+ capitalized chars)] [SUMMARY] [START?] - [END?]
;; 10:00 TASK TEXT 10:00 - 11:00
(if (string-match "^\\([0-9]+:[0-9]+\\) \\(?:\\([A-Z]\\{3,\\}\\) \\)?\\(.+?\\)\\(?: ?\\([0-9]+:[0-9]+\\)\\)?\\(?:-\\([0-9]+:[0-9]+\\)\\)?$" text)
(let ((state (match-string 2 text))
(summary (match-string 3 text))
(start (or (match-string 4 text) (match-string 1 text)))
(end (match-string 5 text)))
`(,(concat summary " " remaining)
,(concat (when state (concat (capitalize state) " "))
"@ "
start (when end " to ") end
".")))
`(,(format "%s %s" text remaining) "")))))
(defun osd--org-agenda-format-item (fn &rest args)
"Append time to txt of the string returned by calling FN with ARGS.
The resulting string is returned.
This works in conjunction with `osd-org-appt-display' so it can
display the end time."
(let* ((string (apply fn args))
(time (org-find-text-property-in-string 'time string))
(txt (org-find-text-property-in-string 'txt string)))
(if (not (string-empty-p time))
(org-add-props string nil 'txt (concat (org-trim txt) " " time))
string)))
(advice-add 'org-agenda-format-item :around #'osd--org-agenda-format-item)
;;;###autoload
(defun osd-org-appt-display (remaining _current text)
"Display appointment described by TEXT due in REMAINING (a string) minutes.
CURRENT is a string giving the current date.
The arguments may also be lists, where each element is a separate
appointment."
(if (listp remaining)
(dotimes (i (length remaining))
(osd-notify (append (osd--org-format-appt (nth i remaining) (nth i text)) '("appt"))))
(osd-notify (append (osd--org-format-appt remaining text) '("appt")))))
(provide 'osd)
;;; osd.el ends here