;;; ement-notifications.el --- Notifications support -*- lexical-binding: t; -*- ;; Copyright (C) 2023 Free Software Foundation, Inc. ;; Author: Adam Porter ;; Maintainer: Adam Porter ;; 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 . ;;; 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 "") #'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-") #'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