forked from alphapapa/ement.el
-
Notifications
You must be signed in to change notification settings - Fork 1
/
ement-notify.el
340 lines (296 loc) · 16.3 KB
/
ement-notify.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
;;; ement-notify.el --- Notifications for Ement events -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Adam Porter
;; Author: Adam Porter <[email protected]>
;; Keywords: comm
;; 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.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library implements notifications for Ement events.
;;; Code:
;;;; Requirements
(require 'cl-lib)
(require 'map)
(require 'notifications)
(require 'ement-room)
(eval-when-compile
(require 'ement-structs))
;;;; Variables
(declare-function ement-room-list "ement-room-list")
(defvar ement-notify-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "S-<return>") #'ement-notify-reply)
(define-key map (kbd "M-g M-l") #'ement-room-list)
(define-key map (kbd "M-g M-m") #'ement-notify-switch-to-mentions-buffer)
(define-key map (kbd "M-g M-n") #'ement-notify-switch-to-notifications-buffer)
(make-composed-keymap (list map button-buffer-map) 'view-mode-map))
"Map for Ement notification buffers.")
;;;; Customization
(defgroup ement-notify nil
"Notification options."
:group 'ement)
(defcustom ement-notify-ignore-predicates
'(ement-notify--event-not-message-p)
"Display notification if none of these return non-nil for an event.
Each predicate is called with three arguments: the event, the
room, and the session (each the respective struct)."
:type '(repeat (choice (function-item ement-notify--event-not-message-p)
(function :tag "Custom predicate"))))
(defcustom ement-notify-functions
'(ement-notify--notify-if-mention ement-notify--log-if-mention ement-notify--log-if-buffer)
"Call these functions to send notifications for events.
These functions are called when the `ement-notify-predicates'
have already indicated that a notification should be sent. Each
function is called with three arguments: the event, the room, and
the session (each the respective struct)."
:type 'hook
:options '(ement-notify--notify-if-mention ement-notify--log-if-mention ement-notify--log-if-buffer))
(defcustom ement-notify-sound nil
"Sound to play for notifications."
:type '(choice (file :tag "Sound file")
(string :tag "XDG sound name")
(const :tag "Default XDG message sound" "message-new-instant")
(const :tag "Don't play a sound" nil)))
(defcustom ement-notify-limit-room-name-width 14
"Limit the width of room display names in mentions and notifications buffers.
This prevents the margin from being made excessively wide."
:type '(choice (integer :tag "Maximum width")
(const :tag "Unlimited width" nil)))
(defcustom ement-notify-prism-background nil
"Add distinct background color by room to messages in notification buffers.
The color is specific to each room, generated automatically, and
can help distinguish messages by room."
:type 'boolean)
(defcustom ement-notify-room-avatars t
"Show room avatars in the notifications buffers.
This shows room avatars at the left of the window margin in
notification buffers. It's not customizeable beyond that due to
limitations and complexities of displaying strings and images in
margins in Emacs. But it's useful, anyway."
:type 'boolean)
;;;; Commands
(declare-function ement-view-room "ement")
(declare-function ement-room-goto-event "ement-room")
(defun ement-notify-button-action (button)
"Show BUTTON's event in its room buffer."
;; TODO: Is `interactive' necessary here?
(interactive)
(let* ((session (button-get button 'session))
(room (button-get button 'room))
(event (button-get button 'event)))
(ement-view-room room session)
(ement-room-goto-event event)))
(defun ement-notify-reply ()
"Send a reply to event at point."
(interactive)
(save-window-excursion
;; Not sure why `call-interactively' doesn't work for `push-button' but oh well.
(push-button)
(call-interactively #'ement-room-send-reply)))
(defun ement-notify-switch-to-notifications-buffer ()
"Switch to \"*Ement Notifications*\" buffer."
(interactive)
(switch-to-buffer (ement-notify--log-buffer "*Ement Notifications*")))
(defun ement-notify-switch-to-mentions-buffer ()
"Switch to \"*Ement Mentions*\" buffer."
(interactive)
(switch-to-buffer (ement-notify--log-buffer "*Ement Mentions*")))
;;;; Functions
(defun ement-notify (event room session)
"Send notifications for EVENT in ROOM on SESSION.
Calls functions in `ement-notify-functions' if all of
`ement-notify-ignore-predicates' return nil. Does not do
anything if session hasn't finished initial sync."
(when (and (ement-session-has-synced-p session)
(cl-loop for pred in ement-notify-ignore-predicates
never (funcall pred event room session)))
(run-hook-with-args 'ement-notify-functions event room session)))
(defun ement-notify--notify-if-mention (event room session)
"Send desktop notification if EVENT in ROOM mention's SESSION's user.
Calls `ement-notify--notifications-notify'."
(when (ement-notify--event-mentions-session-user-p event room session)
(ement-notify--notifications-notify event room session)))
(defun ement-notify--notifications-notify (event room _session)
"Call `notifications-notify' for EVENT in ROOM on SESSION."
(pcase-let* (((cl-struct ement-event sender content) event)
((map body) content)
(room-name (ement-room-display-name room))
(sender-name (ement-room--user-display-name sender room))
(title (format "%s in %s" sender-name room-name))
;; TODO: Encode HTML entities.
(body (if (stringp body)
(truncate-string-to-width body 60)
(progn
(display-warning 'ement-notify--notifications-notify
(format "Event has no body. Please report this bug. ID:%S ROOM:%S TYPE:%S"
(ement-event-id room)
room-name (ement-event-type event)))
""))))
(notifications-notify :title title :body body
:app-name "Ement.el"
:category "im.received"
:timeout 5000
;; FIXME: Using :sound-file seems to do nothing, ever. Maybe a bug in notifications-notify?
:sound-file (when (and ement-notify-sound
(file-name-absolute-p ement-notify-sound))
ement-notify-sound)
:sound-name (when (and ement-notify-sound
(not (file-name-absolute-p ement-notify-sound)))
ement-notify-sound)
;; TODO: Show when action used.
;; :actions '("default" "Show")
;; :on-action #'ement-notify-show
)))
(defun ement-notify--log-if-mention (event room session)
"Log EVENT in ROOM to \"*Ement Mentions*\" buffer if it mentions SESSION's user."
(when (ement-notify--event-mentions-session-user-p event room session)
(ement-notify--log-to-buffer event room session :buffer-name "*Ement Mentions*")))
(defun ement-notify--log-if-buffer (event room session)
"Log EVENT in ROOM on SESSION to \"*Ement Notifications*\" buffer if ROOM has a buffer."
(when (ement-notify--room-buffer-live-p event room session)
(ement-notify--log-to-buffer event room session)))
(cl-defun ement-notify--log-to-buffer (event room session &key (buffer-name "*Ement Notifications*"))
"Log EVENT in ROOM to \"*Ement Notifications*\" buffer."
;; HACK: We only log "m.room.message" events for now. This shouldn't be necessary since we
;; have `ement-notify--event-message-p' in `ement-notify-predicates', but just to be safe...
(when (equal "m.room.message" (ement-event-type event))
;; HACK: For now, we call `ement-room--format-message' in a buffer that pretends to be
;; the room's buffer. We have to do this, because the room might not have a buffer yet.
(with-temp-buffer
;; Set these buffer-local variables, which `ement-room--format-message' uses.
(setf ement-session session
ement-room room)
(let* (;; Bind this to nil to prevent `ement-room--format-message' from padding sender name.
(ement-room-sender-in-headers t)
;; NOTE: We hard-code the room and sender name to be in the left
;; margin. It works well. See also `room-avatar-string' below.
(ement-room-message-format-spec "%O %S%L%B%R%t")
(message (ement-room--format-event event room session))
(buffer (ement-notify--log-buffer buffer-name))
(avatar-width (if ement-notify-room-avatars 2 0))
(room-name-width (if ement-notify-limit-room-name-width
(min (+ avatar-width (string-width (ement-room-display-name room)))
ement-notify-limit-room-name-width)
(+ avatar-width (string-width (ement-room-display-name room)))))
(sender-name-width (string-width (ement-room--user-display-name (ement-event-sender event) room)))
(new-left-margin-width
(max (buffer-local-value 'left-margin-width buffer)
(+ room-name-width sender-name-width 2)))
(inhibit-read-only t)
(room-avatar-string
;; HACK: This is awkward, but displaying images in the margin along with other non-image text
;; requires some hackery due to manipulating and combining the display property. The root problem is
;; that recursive display specs are not supported by Emacs, so if a string in a display spec has its
;; own display spec that is an image, the image isn't displayed. So we have to do things like this.
(or (when-let* (ement-notify-room-avatars
(room-list-avatar (alist-get 'room-list-avatar (ement-room-local room)))
(avatar-image (get-text-property 0 'display room-list-avatar)))
(propertize " " 'display `((margin left-margin) ,avatar-image)))
"")))
(when ement-notify-prism-background
(add-face-text-property 0 (length message) (list :background (ement-notify--room-background-color room))
nil message))
(with-current-buffer buffer
(save-excursion
(goto-char (point-max))
;; We make the button manually to avoid overriding the message faces.
;; TODO: Define our own button type? Maybe integrating the hack below...
(save-excursion
(insert room-avatar-string
(propertize message
'button '(t)
'category 'default-button
'action #'ement-notify-button-action
'session session
'room room
'event event)
"\n"))
;; HACK: Try to remove `button' face property from new text. (It works!)
;; TODO: Use new `ement--remove-face-property' function.
(cl-loop for next-face-change-pos = (next-single-property-change (point) 'face)
for face-at = (get-text-property (point) 'face)
when (pcase face-at
('button t)
((pred listp) (member 'button face-at)))
do (put-text-property (point) (or next-face-change-pos (point-max))
'face (pcase face-at
('button nil)
((pred listp) (delete 'button face-at))))
while next-face-change-pos
do (goto-char next-face-change-pos)))
(setf left-margin-width new-left-margin-width)
(when-let (window (get-buffer-window buffer))
(set-window-margins window new-left-margin-width right-margin-width)))))))
(defun ement-notify--log-buffer (name)
"Return an Ement notifications buffer named NAME."
(or (get-buffer name)
(with-current-buffer (get-buffer-create name)
(view-mode)
(visual-line-mode)
(use-local-map ement-notify-map)
(setf left-margin-width ement-room-left-margin-width
right-margin-width 8)
(current-buffer))))
(defun ement-notify--room-background-color (room)
"Return a background color on which to display ROOM's messages."
;; Based on `ement-room--user-color', hacked up a bit (adjusting
;; some of the numbers feels a little like magic).
(cl-labels ((relative-luminance
;; Copy of `modus-themes-wcag-formula', an elegant
;; implementation by Protesilaos Stavrou. Also see
;; <https://en.wikipedia.org/wiki/Relative_luminance> and
;; <https://www.w3.org/TR/WCAG20/#relativeluminancedef>.
(rgb) (cl-loop for k in '(0.2126 0.7152 0.0722)
for x in rgb
sum (* k (if (<= x 0.03928)
(/ x 12.92)
(expt (/ (+ x 0.055) 1.055) 2.4)))))
(contrast-ratio
;; Copy of `modus-themes-contrast'; see above.
(a b) (let ((ct (/ (+ (relative-luminance a) 0.05)
(+ (relative-luminance b) 0.05))))
(max ct (/ ct)))))
(let* ((id (ement-room-display-name room))
(id-hash (float (abs (sxhash id))))
(ratio (/ id-hash (float (expt 2 24))))
(color-num (round (* (* 255 255 255) ratio)))
(color-rgb (list (/ (float (logand color-num 255)) 255)
(/ (float (lsh (logand color-num 65280) -8)) 255)
(/ (float (lsh (logand color-num 16711680) -16)) 255)))
(background-rgb (color-name-to-rgb (face-background 'default))))
(if (> (contrast-ratio color-rgb background-rgb) 2)
(progn
;; Contrast ratio too high: I don't know the best way to fix this, but we
;; use a color from a gradient between the computed color and the default
;; background color, which seems to blend decently with the background.
(apply #'color-rgb-to-hex
(append (nth 3 (color-gradient background-rgb color-rgb 20))
(list 2))))
(apply #'color-rgb-to-hex (append color-rgb (list 2)))))))
;;;;; Predicates
(defun ement-notify--event-mentions-session-user-p (event room session)
"Return non-nil if EVENT in ROOM mentions SESSION's user.
If EVENT's sender is SESSION's user, returns nil."
(pcase-let* (((cl-struct ement-session user) session)
((cl-struct ement-event sender) event))
(unless (equal (ement-user-id user) (ement-user-id sender))
(ement-room--event-mentions-user-p event user room))))
(defun ement-notify--room-buffer-live-p (_event room _session)
"Return non-nil if ROOM has a live buffer."
(buffer-live-p (alist-get 'buffer (ement-room-local room))))
(defun ement-notify--event-message-p (event _room _session)
"Return non-nil if EVENT is an \"m.room.message\" event."
(equal "m.room.message" (ement-event-type event)))
(defun ement-notify--event-not-message-p (event _room _session)
"Return non-nil if EVENT is not an \"m.room.message\" event."
(not (equal "m.room.message" (ement-event-type event))))
;;;; Footer
(provide 'ement-notify)
;;; ement-notify.el ends here