[elpa] externals/ement f792af5dd9 1/4: Change/Fix: Read receipts

[ELPA Syncer]

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

    Change/Fix: Read receipts
    
    Squashed commit of the following:
    
    commit ccc54b7910228495983d9ffc8e7b491baafead62
    Author: Adam Porter <adam@alphapapa.net>
    Date:   Thu Sep 15 16:21:31 2022 -0500
    
        Change/Fix: Read receipts
    
        Read receipts are now updated via a global idle timer that iterates
        over visible room buffers.  This avoids the nasty, inexplicable race
        condition that sometimes happened when using window-scroll-functions,
        which could cause the functions to be called infinitely, sometimes
        making Emacs unresponsive or even causing it to crash.
    
        Also, a room's read receipt is now set to the last completely visible
        event (i.e. if an event is only partially displayed, it's not
        considered read).
    
    commit 3569c1d2b5251061eb1415a7849039ff0f6f3c2a
    Author: Adam Porter <adam@alphapapa.net>
    Date:   Thu Sep 15 15:23:54 2022 -0500
    
        WIP: See comment
    
        Well, this reproduces the problem fairly reliably in my config in
        that, after connecting, it begins calling the
        ement-room-start-read-receipt-timer function infinitely.  Sometimes I
        can interrupt it by selecting one or another room window and scrolling
        it or moving point in it.  I have no explanation for why the function
        is called infinitely; the only entry point into it is in the room
        buffers' local values of window-scroll-functions.
    
        I'm going to try another approach, that of changing the global value
        of the variable and having the function iterate over visible windows.
---
 README.org    |   2 +
 ement-room.el | 152 +++++++++++++++++++++++++++++-----------------------------
 ement.el      |  20 +++++++-
 3 files changed, 97 insertions(+), 77 deletions(-)

diff --git a/README.org b/README.org
index d36135df12..9604bdec80 100644
--- a/README.org
+++ b/README.org
@@ -282,6 +282,8 @@ Note that, while ~matrix-client~ remains usable, and 
probably will for some time
 
 *Fixes*
 + Links to only rooms (as opposed to links to events in rooms) may be joined 
by activating them.
++ Read receipts are re-enabled.  (They're now implemented with a global idle 
timer rather than ~window-scroll-functions~, which sometimes caused a strange 
race condition that could cause Emacs to become unresponsive or crash.)
++ Read receipts mark the last completely visible event (rather than one that's 
only partially displayed).
 
 ** 0.1.4
 
diff --git a/ement-room.el b/ement-room.el
index e4d3087dfd..21ffadc016 100644
--- a/ement-room.el
+++ b/ement-room.el
@@ -98,6 +98,10 @@ Used by `ement-room-send-message'.")
 (defvar-local ement-room-replying-to-overlay nil
   "Used by `ement-room-send-reply'.")
 
+(defvar-local ement-room-read-receipt-request nil
+  "Maps event ID to request updating read receipt to that event.
+An alist of one entry.")
+
 (defvar ement-room-compose-hook nil
   "Hook run in compose buffers when created.
 Used to, e.g. call `ement-room-compose-org'.")
@@ -1958,20 +1962,7 @@ and erases the buffer."
     (setq-local browse-url-handlers (cons (cons 
ement-room-matrix.to-url-regexp #'ement-room-browse-url)
                                           browse-url-handlers)))
   (setq-local completion-at-point-functions
-              '(ement-room--complete-members-at-point 
ement-room--complete-rooms-at-point))
-  ;; FIXME: Disabling this because of some weird behavior.  It seems like a 
race condition
-  ;; exists in which the window-scroll-functions are called, causing the read 
receipt to
-  ;; get sent, followed by the read-receipt being updated, causing the
-  ;; window-scroll-functions to be called again before the updated receipt is 
displayed in
-  ;; the buffer, which can cause an infinite loop, which can even exhaust the 
Lisp stack
-  ;; and cause Emacs to freeze (without 100% CPU usage).  At least, that's the 
best
-  ;; explanation I have so far--it's very weird.  Until it's solved, we'll 
have to do
-  ;; without sending read receipts.  Maybe window-scroll-functions isn't 
suitable for
-  ;; this, even though it seems ideal in theory.  Maybe instead we should use 
a simple
-  ;; idle timer that iterates over windows, or something like that.
-  
-  ;; (setq-local window-scroll-functions
-  ;;             (cons 'ement-room-start-read-receipt-timer 
window-scroll-functions))
+              '(ement-room--complete-members-at-point 
ement-room--complete-rooms-at-point))  
   (setq-local dnd-protocol-alist (append '(("^file:///" . 
ement-room-dnd-upload-file)
                                            ("^file:" . 
ement-room-dnd-upload-file))
                                          dnd-protocol-alist)))
@@ -2436,9 +2427,6 @@ function to `ement-room-event-fns', which see."
 (defvar-local ement-room-read-receipt-marker nil
   "EWOC node for the room's read-receipt marker.")
 
-(defvar-local ement-room-read-receipt-timer nil
-  "Timer that sets read receipt after scrolling.")
-
 (defvar-local ement-room-fully-read-marker nil
   "EWOC node for the room's fully-read marker.")
 
@@ -2457,60 +2445,63 @@ automatically."
   :type 'boolean
   :group 'ement-room)
 
-(defun ement-room-start-read-receipt-timer (window _pos)
-  "Start idle timer to set read-receipt to POS in WINDOW's room.
-Read receipt is sent if `ement-room-send-read-receipts' is
-non-nil, the read-receipt marker is between retrieved events, and
-WINDOW's end is beyond the marker.  For use in
-`window-scroll-functions'."
+(defun ement-room-read-receipt-idle-timer ()
+  "Update read receipts in visible Ement room buffers.
+To be called from timer stored in
+`ement-read-receipt-idle-timer'."
+  (when ement-room-send-read-receipts
+    (dolist (window (window-list))
+      (when (and (eq 'ement-room-mode (buffer-local-value 'major-mode 
(window-buffer window)))
+                 (buffer-local-value 'ement-room (window-buffer window)))
+        (ement-room-update-read-receipt window)))))
+
+(defun ement-room-update-read-receipt (window)
+  "Update read receipt for room displayed in WINDOW."
   (with-selected-window window
-    (when (timerp ement-room-read-receipt-timer)
-      (cancel-timer ement-room-read-receipt-timer))
-    (when ement-room-send-read-receipts
-      ;; This is highly suboptimal, because this function is called
-      ;; from `window-scroll-functions', whose docstring says that
-      ;; `window-end' is not valid when this function is called.  So
-      ;; we have to call `window-end' from the idle timer, and the
-      ;; window might not even be visible or on the same buffer by
-      ;; that time; if that's the case, the receipt is not sent.
-
-      ;; MAYBE: Reduce idle time so the receipt is less likely to not
-      ;; get updated if the user only views a room's buffer for a
-      ;; short time.
-      (let ((room-buffer (window-buffer window)))
-        (setf ement-room-read-receipt-timer
-              ;; FIXME: Temporarily disabling sending of read receipts due to 
a bug that
-              ;; can cause excessive read receipts to be sent in rapid 
succession.
-              nil
-              ;; (run-with-idle-timer
-              ;;  3 nil #'ement-room-read-receipt-timer window room-buffer)
-              )))))
-
-(defun ement-room-read-receipt-timer (window room-buffer)
-  "Send read receipt for WINDOW displaying ROOM-BUFFER.
-To be called by timer run by
-`ement-room-start-read-receipt-timer'."
-  (when (and (window-live-p window)
-             (eq (window-buffer window) room-buffer))
-    (with-selected-window window
-      (let ((read-receipt-node (ement-room--ewoc-last-matching ement-ewoc
-                                 (lambda (node-data)
-                                   (eq 'ement-room-read-receipt-marker 
node-data)))))
-        (when (or
-               ;; The window's end has been scrolled to or past the position 
of the
-               ;; receipt marker.
-               (and read-receipt-node
-                    (>= (window-end) (ewoc-location read-receipt-node)))
-               ;; The read receipt is outside of retrieved events.
-               (not read-receipt-node))
-          (when-let* ((window-end-node (or (ewoc-locate ement-ewoc 
(window-end))
-                                           (ewoc-nth ement-ewoc -1)))
-                      (event-node (cl-typecase (ewoc-data window-end-node)
-                                    (ement-event window-end-node)
-                                    (t (ement-room--ewoc-next-matching 
ement-ewoc window-end-node
-                                         #'ement-event-p #'ewoc-prev)))))
-            (ement-room-mark-read ement-room ement-session
-              :read-event (ewoc-data event-node))))))))
+    (let ((read-receipt-node (ement-room--ewoc-last-matching ement-ewoc
+                               (lambda (node-data)
+                                 (eq 'ement-room-read-receipt-marker 
node-data))))
+          (window-end-node (or (ewoc-locate ement-ewoc (window-end nil t))
+                               (ewoc-nth ement-ewoc -1))))
+      (when (or
+             ;; The window's end has been scrolled to or past the position of 
the
+             ;; receipt marker.
+             (and read-receipt-node
+                  (>= (window-end nil t) (ewoc-location read-receipt-node)))
+             ;; The read receipt is outside of retrieved events.
+             (not read-receipt-node))
+        (let* ((event-node (when window-end-node
+                             ;; It seems like `window-end-node' shouldn't ever 
be nil,
+                             ;; but just in case...
+                             (cl-typecase (ewoc-data window-end-node)
+                               (ement-event window-end-node)
+                               (t (ement-room--ewoc-next-matching ement-ewoc 
window-end-node
+                                    #'ement-event-p #'ewoc-prev)))))
+               (node-after-event (ewoc-next ement-ewoc event-node))
+               (event))
+          (when event-node
+            (unless (or (when node-after-event
+                          (<= (ewoc-location node-after-event) (window-end nil 
t)))
+                        (>= (window-end) (point-max)))
+              ;; The entire event is not visible: use the previous event.  
(NOTE: This
+              ;; isn't quite perfect, because apparently `window-end' 
considers a position
+              ;; visible if even one pixel of its line is visible.  This will 
have to be
+              ;; good enough for now.)
+              ;; FIXME: Workaround that an entire line's height need not be 
displayed for it to be considered so.
+              (setf event-node (ement-room--ewoc-next-matching ement-ewoc 
event-node
+                                 #'ement-event-p #'ewoc-prev)))
+            (setf event (ewoc-data event-node))
+            (unless (alist-get event ement-room-read-receipt-request)
+              ;; No existing request for this event: cancel any outstanding 
request and
+              ;; send a new one.
+              (when-let ((request-process (car (map-values 
ement-room-read-receipt-request))))
+                (when (process-live-p request-process)
+                  ;; FIXME: This will probably cause a spurious error message.
+                  (interrupt-process request-process)))
+              (setf ement-room-read-receipt-request nil)
+              (setf (alist-get event ement-room-read-receipt-request)
+                    (ement-room-mark-read ement-room ement-session
+                      :read-event event)))))))))
 
 (defun ement-room-goto-fully-read-marker ()
   "Move to the fully-read marker in the current room."
@@ -2538,7 +2529,7 @@ To be called by timer run by
 (cl-defun ement-room-mark-read (room session &key read-event fully-read-event)
   "Mark ROOM on SESSION as read on the server.
 Set \"m.read\" to READ-EVENT and \"m.fully_read\" to
-FULLY-READ-EVENT.
+FULLY-READ-EVENT.  Return the API request.
 
 Interactively, mark both types as read up to event at point."
   (declare (indent defun))
@@ -2573,10 +2564,21 @@ Interactively, mark both types as read up to event at 
point."
                  (data (ement-alist "m.fully_read" (ement-event-id 
fully-read-event))))
       (when read-event
         (push (cons "m.read" (ement-event-id read-event)) data))
-      (ement-api session endpoint :method 'post :data (json-encode data)
-        :then (lambda (_data)
-                (ement-room-move-read-markers room
-                  :read-event read-event :fully-read-event 
fully-read-event))))))
+      ;; NOTE: See similar code in `ement-room-update-read-receipt'.
+      (let ((request-process (ement-api session endpoint :method 'post :data 
(json-encode data)
+                               :then (lambda (_data)
+                                       (ement-room-move-read-markers room
+                                         :read-event read-event 
:fully-read-event fully-read-event)))))
+        (when-let ((room-buffer (alist-get 'buffer (ement-room-local room))))
+          ;; NOTE: Ideally we would do this before sending the new request, 
but to make
+          ;; the code much simpler, we do it afterward.
+          (with-current-buffer room-buffer
+            (when-let ((request-process (car (map-values 
ement-room-read-receipt-request))))
+              (when (process-live-p request-process)
+                ;; FIXME: This will probably cause a spurious error message.
+                (interrupt-process request-process)))
+            (setf ement-room-read-receipt-request nil
+                  (alist-get read-event ement-room-read-receipt-request) 
request-process)))))))
 
 (cl-defun ement-room-send-receipt (room session event &key (type "m.read"))
   "Send receipt of TYPE for EVENT to ROOM on SESSION."
diff --git a/ement.el b/ement.el
index cab91a1ee5..7e67648e62 100644
--- a/ement.el
+++ b/ement.el
@@ -103,6 +103,9 @@ by users; ones who do so should know what they're doing.")
 (defvar ement-images-queue (make-plz-queue :limit 5)
   "`plz' HTTP request queue for image requests.")
 
+(defvar ement-read-receipt-idle-timer nil
+  "Idle timer used to update read receipts.")
+
 ;; From other files.
 (defvar ement-room-avatar-max-width)
 (defvar ement-room-avatar-max-height)
@@ -133,7 +136,7 @@ Writes the session file when Emacs is killed."
   :type 'boolean)
 
 (defcustom ement-after-initial-sync-hook
-  '(ement-list-rooms ement-view-initial-rooms ement--link-children)
+  '(ement-list-rooms ement-view-initial-rooms ement--link-children 
ement--run-idle-timer)
   "Hook run after initial sync.
 Run with one argument, the session synced."
   :type 'hook)
@@ -151,7 +154,7 @@ Alist mapping user IDs to a list of room aliases/IDs to 
open buffers for."
   :type '(alist :key-type (string :tag "Local user ID")
                 :value-type (repeat (string :tag "Room alias/ID"))))
 
-(defcustom ement-disconnect-hook '(ement-kill-buffers)
+(defcustom ement-disconnect-hook '(ement-kill-buffers ement--stop-idle-timer)
   "Functions called when disconnecting.
 That is, when calling command `ement-disconnect'.  Functions are
 called with no arguments."
@@ -305,6 +308,19 @@ Useful in, e.g. `ement-disconnect-hook', which see."
 
 ;;;; Functions
 
+(defun ement--run-idle-timer (&rest _ignore)
+  "Run idle timer that updates read receipts.
+To be called from `ement-after-initial-sync-hook'.  Timer is
+stored in `ement-read-receipt-idle-timer'."
+  (setf ement-read-receipt-idle-timer (run-with-idle-timer 3 t 
#'ement-room-read-receipt-idle-timer)))
+
+(defun ement--stop-idle-timer (&rest _ignore)
+  "Stop idle timer stored in `ement-read-receipt-idle-timer'.
+To be called from `ement-disconnect-hook'."
+  (when (timerp ement-read-receipt-idle-timer)
+    (cancel-timer ement-read-receipt-idle-timer)
+    (setf ement-read-receipt-idle-timer nil)))
+
 (defun ement-view-initial-rooms (session)
   "View rooms for SESSION configured in `ement-auto-view-rooms'."
   (when-let (rooms (alist-get (ement-user-id (ement-session-user session))