301 lines
14 KiB
EmacsLisp
301 lines
14 KiB
EmacsLisp
;;; 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
|