-
Notifications
You must be signed in to change notification settings - Fork 44
/
ement-notifications.el
301 lines (259 loc) · 13.5 KB
/
ement-notifications.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
;;; ement-notifications.el --- Notifications support -*- lexical-binding: t; -*-
;; Copyright (C) 2023 Free Software Foundation, Inc.
;; Author: Adam Porter <adam@alphapapa.net>
;; Maintainer: Adam Porter <adam@alphapapa.net>
;; 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 support for Matrix notifications. It differs from
;; `ement-notify', which implements a kind of bespoke notification system for events
;; received via sync requests rather than Matrix's own notifications endpoint. These two
;; libraries currently integrate somewhat, as newly arriving events are handled and
;; notified about by `ement-notify', and old notifications are fetched and listed by
;; `ement-notifications' in the same "*Ement Notifications*" buffer.
;; In the future, these libraries will likely be consolidated and enhanced to more closely
;; follow the Matrix API's and Element client's examples.
;;; Code:
;;;; Requirements
(require 'cl-lib)
(require 'map)
(require 'ement-lib)
(require 'ement-room)
(require 'ement-notify)
;;;; Structs
(cl-defstruct ement-notification
"Represents a Matrix notification."
room-id event readp)
(defun ement-notifications--make (notification)
"Return an `ement-notification' struct for NOTIFICATION.
NOTIFICATION is an alist representing a notification returned
from the \"/notifications\" endpoint. The notification's event
is passed through `ement--make-event'."
(declare (function ement--make-event "ement"))
(pcase-let (((map room_id _actions _ts event read) notification))
(make-ement-notification :room-id room_id :readp read
:event (ement--make-event event))))
;;;; Variables
(declare-function ement-room-list "ement-room-list")
(defvar ement-notifications-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "<return>") #'ement-notifications-jump)
(define-key map [mouse-1] #'ement-notifications-jump-mouse)
(define-key map [mouse-2] #'ement-notifications-jump-mouse)
(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)
(define-key map [remap scroll-down-command] #'ement-notifications-scroll-down-command)
(define-key map [remap mwheel-scroll] #'ement-notifications-mwheel-scroll)
(make-composed-keymap (list map) 'view-mode-map))
"Map for Ement notification buffers.")
(cl-defun ement-notifications-jump (&optional (pos (point)))
"Jump to Matrix event at POS."
(interactive)
(let ((session (get-text-property pos 'session))
(room (get-text-property pos 'room))
(event (get-text-property pos 'event)))
(ement-view-room room session)
(ement-room-goto-event event)))
(defun ement-notifications-jump-mouse (event)
"Jump to Matrix event at EVENT."
(interactive "e")
(let ((pos (posn-point (event-start event))))
(if (button-at pos)
(push-button pos)
(ement-notifications-jump pos))))
(defvar ement-notifications-hook '(ement-notifications-log-to-buffer)
"Functions called for `ement-notifications' notifications.
Each function is called with two arguments, the session and the
`ement-notification' struct.")
(defvar-local ement-notifications-retro-loading nil
"Non-nil when earlier messages are being loaded.
Used to avoid overlapping requests.")
(defvar-local ement-notifications-metadata nil
"Metadata for `ement-notifications' buffers.")
;; Variables from other files.
(defvar ement-ewoc)
(defvar ement-session)
(defvar ement-notify-prism-background)
(defvar ement-room-message-format-spec)
(defvar ement-room-sender-in-left-margin)
;;;; Commands
;;;###autoload
(cl-defun ement-notifications
(session &key from limit only
(then (apply-partially #'ement-notifications-callback session)) else)
"Show the notifications buffer for SESSION.
FROM may be a \"next_token\" token from a previous request.
LIMIT may be a maximum number of events to return. ONLY may be
the string \"highlight\" to only return notifications that have
the highlight tweak set. THEN and ELSE may be callbacks passed
to `ement-api', which see."
(interactive (list (ement-complete-session)
:only (when current-prefix-arg
"highlight")))
(if-let ((buffer (get-buffer "*Ement Notifications*")))
(switch-to-buffer buffer)
(let ((endpoint "notifications")
(params (remq nil
(list (when from
(list "from" from))
(when limit
(list "limit" (number-to-string limit)))
(when only
(list "only" only))))))
(ement-api session endpoint :params params :then then :else else)
(ement-message "Fetching notifications for <%s>..." (ement-user-id (ement-session-user session))))))
(cl-defun ement-notifications-callback (session data &key (buffer (ement-notifications--log-buffer)))
"Callback for `ement-notifications' on SESSION which receives DATA."
(pcase-let (((map notifications next_token) data))
(with-current-buffer buffer
(setf (map-elt ement-notifications-metadata :next-token) next_token)
(cl-loop for notification across notifications
do (run-hook-with-args 'ement-notifications-hook
session (ement-notifications--make notification)))
;; TODO: Pass start/end nodes to `ement-room--insert-ts-headers' if possible.
(ement-room--insert-ts-headers)
(switch-to-buffer (current-buffer)))))
(defun ement-notifications-scroll-down-command ()
"Scroll down, and load NUMBER earlier messages when at top."
(interactive)
(condition-case _err
(scroll-down nil)
(beginning-of-buffer
(call-interactively #'ement-notifications-retro))))
(defun ement-notifications-mwheel-scroll (event)
"Scroll according to EVENT, loading earlier messages when at top."
(interactive "e")
(with-selected-window (posn-window (event-start event))
(mwheel-scroll event)
(when (= (point-min) (window-start))
(call-interactively #'ement-notifications-retro))))
(cl-defun ement-notifications-retro (session number)
;; FIXME: Naming things is hard.
"Retrieve NUMBER older notifications on SESSION."
;; FIXME: Support multiple sessions.
(interactive (list (ement-complete-session)
(cl-typecase current-prefix-arg
(null 100)
(list (read-number "Number of messages: "))
(number current-prefix-arg))))
(cl-assert (eq 'ement-notifications-mode major-mode))
(cl-assert (map-elt ement-notifications-metadata :next-token) nil
"No more notifications for %s" (ement-user-id (ement-session-user ement-session)))
(let ((buffer (current-buffer)))
(unless ement-notifications-retro-loading
(ement-notifications
session :limit number
:from (map-elt ement-notifications-metadata :next-token)
;; TODO: Use a :finally for resetting `ement-notifications-retro-loading'?
:then (lambda (data)
(unwind-protect
(ement-notifications-callback session data :buffer buffer)
(setf (buffer-local-value 'ement-notifications-retro-loading buffer) nil)))
:else (lambda (plz-error)
(setf (buffer-local-value 'ement-notifications-retro-loading buffer) nil)
(ement-api-error plz-error)))
(ement-message "Loading %s earlier messages..." number)
(setf ement-notifications-retro-loading t))))
;;;; Functions
(cl-defun ement-notifications-log-to-buffer (session notification &key (buffer-name "*Ement Notifications*"))
"Log EVENT in ROOM on SESSION to \"*Ement NOTIFICATIONS*\" buffer."
(with-demoted-errors "ement-notifications-log-to-buffer: %S"
(with-current-buffer (ement-notifications--log-buffer :name buffer-name)
(save-window-excursion
(when-let ((buffer-window (get-buffer-window (current-buffer))))
;; Select the buffer's window to avoid EWOC bug. (See #191.)
(select-window buffer-window))
;; TODO: Use the :readp slot to mark unread events.
(save-mark-and-excursion
(pcase-let* (((cl-struct ement-notification room-id event) notification)
(ement-session session)
(ement-room (or (cl-find room-id (ement-session-rooms session)
:key #'ement-room-id :test #'equal)
(error "ement-notifications-log-to-buffer: Can't find room <%s>; discarding notification" room-id)))
(ement-room-sender-in-left-margin nil)
(ement-room-message-format-spec "%o%O »%W %S> %B%R%t")
(new-node (ement-room--insert-event event))
(inhibit-read-only t)
(start) (end))
(ewoc-goto-node ement-ewoc new-node)
;; Apply the button properties only to the room and sender names,
;; allowing buttons in the rest of the message to remain separate.
(setf start (point)
end (save-excursion
(re-search-forward (rx "> "))))
(add-text-properties start end '( button (t)
category default-button
action ement-notify-button-action))
;; Apply the session, room, and event properties to the whole event.
(setf end (save-excursion
(if-let ((next-node (ewoc-next ement-ewoc new-node)))
(ewoc-location next-node)
(point-max))))
(add-text-properties start end
(list 'session session
'room ement-room
'event event))
;; Remove button face property from the whole event.
(alter-text-property start end 'face
(lambda (face)
(pcase face
('button nil)
((pred listp) (remq 'button face))
(_ face))))
(when ement-notify-prism-background
(add-face-text-property start end (list :background (ement-notifications--room-background-color ement-room)
:extend t)))))))))
(defun ement-notifications--room-background-color (room)
"Return a background color on which to display ROOM's messages."
(or (alist-get 'notify-background-color (ement-room-local room))
(setf (alist-get 'notify-background-color (ement-room-local room))
(let ((color (color-desaturate-name
(ement--prism-color (ement-room-id room) :contrast-with (face-foreground 'default))
50)))
(if (ement--color-dark-p (color-name-to-rgb (face-background 'default)))
(color-darken-name color 25)
(color-lighten-name color 25))))))
(cl-defun ement-notifications--log-buffer (&key (name "*Ement Notifications*"))
"Return an Ement notifications buffer named NAME."
(or (get-buffer name)
(with-current-buffer (get-buffer-create name)
(ement-notifications-mode)
(current-buffer))))
;;;; Mode
(define-derived-mode ement-notifications-mode ement-room-mode "Ement Notifications"
(setf ement-room-sender-in-left-margin nil
left-margin-width 0
right-margin-width 8)
(setq-local ement-room-message-format-spec "[%o%O] %S> %B%R%t"
bookmark-make-record-function #'ement-notifications-bookmark-make-record))
;;;; Bookmark support
(require 'bookmark)
(defun ement-notifications-bookmark-make-record ()
"Return a bookmark record for the current `ement-notifications' buffer."
(list (buffer-name)
;; It seems silly to have to record the buffer name twice, but the
;; `bookmark-make-record' function seems to override the bookmark name sometimes,
;; which makes the result useless unless we save the buffer name separately.
(cons 'buffer-name (buffer-name))
(cons 'handler #'ement-notifications-bookmark-handler)))
(defun ement-notifications-bookmark-handler (_bookmark)
"Show `ement-notifications' buffer for BOOKMARK."
;; FIXME: Handle multiple sessions.
;; FIXME: This doesn't work quite correctly when the buffer isn't already open, because
;; the command is asynchronous in that case, so the buffer can be displayed in the wrong
;; window. Fixing this would be hacky and awkward, but a partial solution is probably
;; possible.
(ement-notifications (ement-complete-session)))
;;; Footer
(provide 'ement-notifications)
;;; ement-notifications.el ends here