[elpa] externals/ement 46afa1f5a1 02/13: Change: Integrate ement-notify and ement-notifications, and retro-load

[ELPA Syncer]

branch: externals/ement
commit 46afa1f5a10f088ed636126d6be9fd440f1ac57b
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    Change: Integrate ement-notify and ement-notifications, and retro-load
---
 ement-notifications.el | 110 +++++++++++++++++++++++++++++++++++++++++--------
 ement-notify.el        |  78 +++++------------------------------
 2 files changed, 103 insertions(+), 85 deletions(-)

diff --git a/ement-notifications.el b/ement-notifications.el
index 7a1f27439e..7e04dcb1d2 100644
--- a/ement-notifications.el
+++ b/ement-notifications.el
@@ -50,23 +50,41 @@ is passed through `ement--make-event'."
 
 ;;;; Variables
 
+(defvar ement-notifications-mode-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)
+    (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 button-buffer-map) 'view-mode-map))
+  "Map for Ement notification buffers.")
+
 (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.")
 
 ;;;; Commands
 
 ;;;###autoload
-(cl-defun ement-notifications (session &key from limit only)
+(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."
+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")))
@@ -78,22 +96,68 @@ the highlight tweak set."
                               (list "limit" (number-to-string limit)))
                             (when only
                               (list "only" only))))))
-    (ement-api session endpoint :params params
-      :then (lambda (data)
-              (pcase-let (((map notifications next_token) data))
-                (with-current-buffer (ement-notifications--log-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)))
-                  (ement-room--insert-ts-headers)
-                  (pop-to-buffer (current-buffer))))))))
+    (ement-api session endpoint :params params :then then :else else)))
+
+(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)))
+      (ement-room--insert-ts-headers)
+      (pop-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)))
+      (message "Loading %s earlier messages..." number)
+      (setf ement-notifications-retro-loading t))))
 
 ;;;; Functions
 
 ;; FIXME: The buffer name is the same as used in 
`ement-notify--log-to-buffer', except capitalized.
 
-(cl-defun ement-notifications-log-to-buffer (session notification &key 
(buffer-name "*Ement NOTIFICATIONS*"))
+(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)
@@ -104,8 +168,9 @@ the highlight tweak set."
         ;; TODO: Use the :readp slot to mark unread events.
         (pcase-let* (((cl-struct ement-notification room-id event) 
notification)
                      (ement-session session)
-                     (ement-room (cl-find room-id (ement-session-rooms session)
-                                          :key #'ement-room-id :test #'equal))
+                     (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))
@@ -132,10 +197,21 @@ the highlight tweak set."
                                    ((pred listp) (remq 'button face))
                                    (_ face))))
           (when ement-notify-prism-background
-            (add-face-text-property start end (list :background 
(ement-notify--room-background-color ement-room)
+            (add-face-text-property start end (list :background 
(ement-notifications--room-background-color ement-room)
                                                     :extend t))))))))
 
-(cl-defun ement-notifications--log-buffer (&key (name "*Ement NOTIFICATIONS*"))
+(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)
diff --git a/ement-notify.el b/ement-notify.el
index c2e71ea392..918955d962 100644
--- a/ement-notify.el
+++ b/ement-notify.el
@@ -169,13 +169,15 @@ margins in Emacs.  But it's useful, anyway."
 
 (defun ement-notify-switch-to-notifications-buffer ()
   "Switch to \"*Ement Notifications*\" buffer."
+  (declare (function ement-notifications--log-buffer "ement-notifications"))
   (interactive)
-  (switch-to-buffer (ement-notify--log-buffer "*Ement Notifications*")))
+  (switch-to-buffer (ement-notifications--log-buffer :name "*Ement 
Notifications*")))
 
 (defun ement-notify-switch-to-mentions-buffer ()
   "Switch to \"*Ement Mentions*\" buffer."
+  (declare (function ement-notifications--log-buffer "ement-notifications"))
   (interactive)
-  (switch-to-buffer (ement-notify--log-buffer "*Ement Mentions*")))
+  (switch-to-buffer (ement-notifications--log-buffer :name "*Ement 
Mentions*")))
 
 ;;;; Functions
 
@@ -272,73 +274,13 @@ If ROOM has no existing buffer, do nothing."
                                (delete-file filename)))
     filename))
 
-(define-derived-mode ement-notify-mode ement-room-mode "Ement Notify"
-  (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-notify-bookmark-make-record))
-
 (cl-defun ement-notify--log-to-buffer (event room session &key (buffer-name 
"*Ement Notifications*"))
   "Log EVENT in ROOM on SESSION to \"*Ement Notifications*\" buffer."
-  (with-demoted-errors "ement-notify--log-to-buffer: %S"
-    ;; 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))
-      (with-current-buffer (ement-notify--log-buffer 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))
-          (let* ((ement-session session)
-                 (ement-room room)
-                 (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)
-            (setf start (point))
-            (if-let (next-node (ewoc-next ement-ewoc new-node))
-                (ewoc-goto-node ement-ewoc next-node)
-              (goto-char (point-max)))
-            (setf end (- (point) 2))
-            (add-text-properties start end
-                                 (list 'button '(t)
-                                       'category 'default-button
-                                       'action #'ement-notify-button-action
-                                       'session session
-                                       'room room
-                                       'event event))
-            ;; Remove button face property.
-            (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-notify--room-background-color room)
-                                                      :extend t)))))))))
-
-(defun ement-notify--log-buffer (name)
-  "Return an Ement notifications buffer named NAME."
-  (or (get-buffer name)
-      (with-current-buffer (get-buffer-create name)
-        (ement-notify-mode)
-        (current-buffer))))
-
-(defun ement-notify--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))))))
+  (declare (function ement-notifications-log-to-buffer "ement-notifications")
+           (function make-ement-notification "ement-notifications"))
+  (pcase-let* (((cl-struct ement-room (id room-id)) room)
+               (notification (make-ement-notification :room-id room-id :event 
event)))
+    (ement-notifications-log-to-buffer session notification :buffer-name 
buffer-name)))
 
 ;;;;; Predicates
 
@@ -395,7 +337,7 @@ According to the room's notification configuration on the 
server."
 (defun ement-notify-bookmark-handler (bookmark)
   "Show Ement notifications buffer for BOOKMARK."
   (pcase-let ((`(,_bookmark-name . ,(map buffer-name)) bookmark))
-    (switch-to-buffer (ement-notify--log-buffer buffer-name))))
+    (switch-to-buffer (ement-notifications--log-buffer buffer-name))))
 
 ;;;; Footer