branch: elpa/jabber
commit a5b4b920e4a81a74c7d3c2f6cc3dbe6ecc7b3469
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
chatstates: Add MUC typing indicators
---
lisp/jabber-chatbuffer.el | 7 +-
lisp/jabber-chatstates.el | 169 +++++++++++++---
lisp/jabber-muc.el | 12 +-
tests/jabber-test-chatbuffer.el | 68 +++++++
tests/jabber-test-chatstates.el | 435 ++++++++++++++++++++++++++++++++++++++++
5 files changed, 657 insertions(+), 34 deletions(-)
diff --git a/lisp/jabber-chatbuffer.el b/lisp/jabber-chatbuffer.el
index e722d93c05..5983335200 100644
--- a/lisp/jabber-chatbuffer.el
+++ b/lisp/jabber-chatbuffer.el
@@ -544,6 +544,11 @@ EWOC-PP is the pretty-printer function for the message
EWOC."
(buffer entries callback &optional generation))
(declare-function jabber-chat-display-buffer-images "jabber-chat" ())
+(defun jabber-chat-buffer--refresh-complete ()
+ "Finish a chat buffer refresh after backlog insertion completes."
+ (jabber-chat-display-buffer-images)
+ (jabber-chat-buffer-recenter-input))
+
(defun jabber-chat-buffer-refresh ()
"Refresh the current chat buffer from the database without killing it.
Clears the ewoc and reloads backlog entries in place. Cancels any
@@ -581,7 +586,7 @@ Uses `jabber-chat-buffer-msg-count' for the number of
messages."
(float-time (plist-get (car (last entries)) :timestamp)))
(jabber-chat--insert-backlog-chunked
(current-buffer) entries
- #'jabber-chat-display-buffer-images
+ #'jabber-chat-buffer--refresh-complete
generation)))))
(defun jabber-chat-buffer-send ()
diff --git a/lisp/jabber-chatstates.el b/lisp/jabber-chatstates.el
index 348d43c351..8b1cc075d6 100644
--- a/lisp/jabber-chatstates.el
+++ b/lisp/jabber-chatstates.el
@@ -29,6 +29,7 @@
;;; Code:
(require 'cl-lib)
+(require 'subr-x)
(require 'jabber-util)
(require 'ewoc)
(require 'jabber-core)
@@ -41,6 +42,9 @@
(defvar jabber-chat-ewoc) ; jabber-chatbuffer.el
(defvar jabber-chatting-with) ; jabber-chat.el
+(declare-function jabber-muc-find-buffer "jabber-muc" (group))
+(declare-function jabber-muc-nickname "jabber-muc" (group &optional jc))
+
(defgroup jabber-chatstates nil
"Chat state notifications."
:group 'jabber)
@@ -65,6 +69,9 @@ Non-nil means send states, nil means don't.")
(defvar-local jabber-chatstates--ewoc-node nil
"Ewoc node for the typing indicator, or nil.")
+(defvar-local jabber-chatstates--muc-composers nil
+ "Ordered list of MUC occupants currently composing in this buffer.")
+
(defvar-local jabber-chatstates-composing-sent nil
"Has composing notification been sent?
It can be sent and cancelled several times.")
@@ -85,26 +92,120 @@ It can be sent and cancelled several times.")
"Show or remove the typing indicator ewoc node for STATE."
(let ((inhibit-read-only t))
(if (eq state 'composing)
- (unless jabber-chatstates--ewoc-node
- (setq jabber-chatstates--ewoc-node
- (jabber-chat-ewoc-enter
- (list :typing
- (format "%s is typing..."
- (jabber-jid-displayname
jabber-chatting-with))))))
- (when jabber-chatstates--ewoc-node
- (jabber-chat-ewoc-delete jabber-chatstates--ewoc-node)
- (setq jabber-chatstates--ewoc-node nil)))))
+ (progn
+ (when (and jabber-chatstates--ewoc-node
+ (not (jabber-chatstates--live-ewoc-node-p
+ jabber-chatstates--ewoc-node)))
+ (setq jabber-chatstates--ewoc-node nil))
+ (unless jabber-chatstates--ewoc-node
+ (setq jabber-chatstates--ewoc-node
+ (jabber-chat-ewoc-enter
+ (list :typing
+ (format "%s is typing..."
+ (jabber-jid-displayname
jabber-chatting-with)))))))
+ (jabber-chatstates--delete-typing-node))))
+
+(defun jabber-chatstates--composing-state-p (state)
+ "Return non-nil when STATE is the XEP-0085 composing state."
+ (eq state 'composing))
+
+(defun jabber-chatstates--muc-add-composer (composers nick)
+ "Return COMPOSERS with NICK appended once, preserving order."
+ (if (member nick composers)
+ composers
+ (append composers (list nick))))
+
+(defun jabber-chatstates--muc-remove-composer (composers nick)
+ "Return COMPOSERS without NICK, preserving order."
+ (remove nick composers))
+
+(defun jabber-chatstates--muc-composers-for-state (composers nick state)
+ "Return COMPOSERS updated for NICK's chat STATE."
+ (if (jabber-chatstates--composing-state-p state)
+ (jabber-chatstates--muc-add-composer composers nick)
+ (jabber-chatstates--muc-remove-composer composers nick)))
+
+(defun jabber-chatstates--format-muc-composers (composers)
+ "Return typing text for COMPOSERS, or nil when no one is composing."
+ (pcase composers
+ ('nil nil)
+ (`(,nick) (format "%s is typing..." nick))
+ (_ (format "%s are typing..." (string-join composers ", ")))))
+
+(defun jabber-chatstates--live-ewoc-node-p (node)
+ "Return non-nil when NODE still has a live EWOC marker."
+ (and-let* ((marker (ignore-errors (ewoc-location node))))
+ (marker-buffer marker)))
+
+(defun jabber-chatstates--delete-typing-node ()
+ "Remove the current typing indicator node without changing state."
+ (when jabber-chatstates--ewoc-node
+ (when (jabber-chatstates--live-ewoc-node-p jabber-chatstates--ewoc-node)
+ (jabber-chat-ewoc-delete jabber-chatstates--ewoc-node))
+ (setq jabber-chatstates--ewoc-node nil)))
+
+(defun jabber-chatstates--muc-reinsert-typing ()
+ "Reinsert the current buffer's MUC typing indicator at the bottom."
+ (jabber-chatstates--delete-typing-node)
+ (when-let* ((message (jabber-chatstates--format-muc-composers
+ jabber-chatstates--muc-composers)))
+ (setq jabber-chatstates--ewoc-node
+ (jabber-chat-ewoc-enter (list :typing message)))))
+
+(defun jabber-chatstates--update-muc-ewoc ()
+ "Refresh the current buffer's MUC typing indicator at the bottom."
+ (let ((inhibit-read-only t))
+ (jabber-chatstates--muc-reinsert-typing)))
+
+(defun jabber-chatstates--muc-remove-nick (nick)
+ "Remove MUC NICK from the current buffer's composer state."
+ (setq jabber-chatstates--muc-composers
+ (jabber-chatstates--muc-remove-composer
+ jabber-chatstates--muc-composers nick)))
+
+(defun jabber-chatstates--muc-clear-nick (nick)
+ "Remove MUC NICK from the current buffer's typing indicator."
+ (jabber-chatstates--muc-remove-nick nick)
+ (jabber-chatstates--update-muc-ewoc))
(defun jabber-chatstates--clear-typing ()
"Remove the typing indicator ewoc node if present."
- (when jabber-chatstates--ewoc-node
- (jabber-chat-ewoc-delete jabber-chatstates--ewoc-node)
- (setq jabber-chatstates--ewoc-node nil)))
+ (jabber-chatstates--delete-typing-node))
+
+(defun jabber-chatstates--clear-send-typing ()
+ "Remove direct-chat typing state while preserving active MUC composers."
+ (unless jabber-chatstates--muc-composers
+ (jabber-chatstates--clear-typing)))
+
+(defun jabber-chatstates--message-state (xml-data)
+ "Return the chat state symbol from XML-DATA, or nil."
+ (jabber-xml-node-name
+ (cl-find jabber-chatstates-xmlns
+ (jabber-xml-node-children xml-data)
+ :key (lambda (x) (jabber-xml-get-attribute x 'xmlns))
+ :test #'string=)))
+
+(defun jabber-chatstates--muc-self-nick-p (group nick jc)
+ "Return non-nil when NICK is our nickname in GROUP on JC."
+ (and-let* ((self-nick (jabber-muc-nickname group jc)))
+ (string= nick self-nick)))
+
+(defun jabber-chatstates--handle-muc-state (jc from state)
+ "Apply incoming MUC chat STATE from FROM on JC."
+ (when-let* ((group (jabber-jid-user from))
+ (nick (jabber-jid-resource from))
+ (buffer (jabber-muc-find-buffer group)))
+ (with-current-buffer buffer
+ (unless (jabber-chatstates--muc-self-nick-p group nick jc)
+ (setq jabber-chatstates--muc-composers
+ (jabber-chatstates--muc-composers-for-state
+ jabber-chatstates--muc-composers nick state)))
+ (jabber-chatstates--update-muc-ewoc))))
(add-hook 'jabber-chat-send-hooks #'jabber-chatstates-when-sending)
(defun jabber-chatstates-when-sending (_text _id)
"Chat-send hook: cancel state timers and attach an `active' element."
- (jabber-chatstates--clear-typing)
+ (jabber-chatstates--clear-send-typing)
(jabber-chatstates-stop-timer)
(when jabber-chatstates-confirm
(setq jabber-chatstates-composing-sent nil)
@@ -186,10 +287,9 @@ Added to `kill-buffer-hook' in chat buffers."
;;; COMMON
-(defun jabber-handle-incoming-message-chatstates (jc xml-data)
- "Update the chat buffer's typing indicator from XML-DATA on JC."
- (when-let* ((from (jabber-xml-get-attribute xml-data 'from))
- (buffer (get-buffer (jabber-chat-get-buffer from jc))))
+(defun jabber-chatstates--handle-direct-state (jc xml-data from)
+ "Update the direct chat buffer from XML-DATA sent by FROM on JC."
+ (when-let* ((buffer (get-buffer (jabber-chat-get-buffer from jc))))
(with-current-buffer buffer
(cond
;; If we get an error message, we shouldn't report any
@@ -199,20 +299,25 @@ Added to `kill-buffer-hook' in chat buffers."
(setq jabber-chatstates-requested nil))
(t
- (let ((state
- (jabber-xml-node-name
- (cl-find jabber-chatstates-xmlns
- (jabber-xml-node-children xml-data)
- :key (lambda (x) (jabber-xml-get-attribute x 'xmlns))
- :test #'string=))))
- ;; Set up hooks for composition notification
- (when (and jabber-chatstates-confirm state)
- (setq jabber-chatstates-requested t)
- (add-hook 'post-command-hook #'jabber-chatstates-after-change nil t)
- (add-hook 'kill-buffer-hook #'jabber-chatstates-send-gone nil t))
-
- (setq jabber-chatstates-last-state state)
- (jabber-chatstates--update-ewoc state)))))))
+ (let ((state (jabber-chatstates--message-state xml-data)))
+ ;; Set up hooks for composition notification
+ (when (and jabber-chatstates-confirm state)
+ (setq jabber-chatstates-requested t)
+ (add-hook 'post-command-hook #'jabber-chatstates-after-change nil
t)
+ (add-hook 'kill-buffer-hook #'jabber-chatstates-send-gone nil t))
+
+ (setq jabber-chatstates-last-state state)
+ (jabber-chatstates--update-ewoc state)))))))
+
+(defun jabber-handle-incoming-message-chatstates (jc xml-data)
+ "Update the chat buffer's typing indicator from XML-DATA on JC."
+ (when-let* ((from (jabber-xml-get-attribute xml-data 'from)))
+ (if (string= (jabber-xml-get-attribute xml-data 'type) "groupchat")
+ (let ((state (jabber-chatstates--message-state xml-data)))
+ (when (and (not (string= (jabber-xml-get-attribute xml-data 'type)
"error"))
+ (or state (jabber-xml-get-children xml-data 'body)))
+ (jabber-chatstates--handle-muc-state jc from state)))
+ (jabber-chatstates--handle-direct-state jc xml-data from))))
(jabber-chain-add 'jabber-message-chain
#'jabber-handle-incoming-message-chatstates 50)
@@ -220,4 +325,4 @@ Added to `kill-buffer-hook' in chat buffers."
(provide 'jabber-chatstates)
-;;; jabber-chatstates.el ends here
\ No newline at end of file
+;;; jabber-chatstates.el ends here
diff --git a/lisp/jabber-muc.el b/lisp/jabber-muc.el
index 005ce86cc0..7db2d2b91b 100644
--- a/lisp/jabber-muc.el
+++ b/lisp/jabber-muc.el
@@ -333,6 +333,10 @@ The format is that of `mode-line-format' and
`header-line-format'."
(replace-id new-body new-from muc-p buffer))
(declare-function jabber-reactions--reaction-only-p "jabber-reactions"
(xml-data))
+(declare-function jabber-chatstates--delete-typing-node "jabber-chatstates" ())
+(declare-function jabber-chatstates--muc-reinsert-typing "jabber-chatstates"
())
+(declare-function jabber-chatstates--muc-remove-nick "jabber-chatstates"
+ (nick))
(defvar jabber-silent-mode) ; jabber.el
(defvar jabber-alert-muc-function) ; jabber-alert.el
(defvar jabber-body-printers) ; jabber-chat.el
@@ -1809,6 +1813,10 @@ come from the stanza."
(jabber-muc-remove-participant group nickname)
(when-let* ((buffer (jabber-muc-find-buffer group)))
(with-current-buffer buffer
+ (when (and (fboundp 'jabber-chatstates--muc-remove-nick)
+ (fboundp 'jabber-chatstates--delete-typing-node))
+ (jabber-chatstates--muc-remove-nick nickname)
+ (jabber-chatstates--delete-typing-node))
(jabber-maybe-print-rare-time
(jabber-chat-ewoc-enter
(list :muc-notice
@@ -1824,7 +1832,9 @@ come from the stanza."
(jabber-xml-get-attribute item 'nick)))
(t
(concat name " has left the chatroom")))
- :time (current-time))))))))
+ :time (current-time))))
+ (when (fboundp 'jabber-chatstates--muc-reinsert-typing)
+ (jabber-chatstates--muc-reinsert-typing))))))
(defun jabber-muc--room-created-message ()
"Return a string with buttons for configuring a newly created room."
diff --git a/tests/jabber-test-chatbuffer.el b/tests/jabber-test-chatbuffer.el
index 76783da4d4..4e8ab6fb31 100644
--- a/tests/jabber-test-chatbuffer.el
+++ b/tests/jabber-test-chatbuffer.el
@@ -14,6 +14,7 @@
;; jabber-chat requires this via jabber-muc
(defvar jabber-muc-xmlns-user "http://jabber.org/protocol/muc#user";)
+(defvar jabber-group nil)
(defvar jabber-muc-participants nil)
;;; Test helpers
@@ -480,6 +481,73 @@ again, and the ewoc created on the first call must
survive."
(jabber-chat-mode-setup 'jc-new #'ignore)
(should (eq 'jc-new jabber-buffer-connection))))))
+;;; Group 11: Refresh completion
+
+(ert-deftest jabber-test-chatbuffer-refresh-recenters-after-chunked-insert ()
+ "Refresh recenters only from the chunked insertion completion callback."
+ (jabber-test-chatbuffer-with-ewoc
+ (let ((events nil)
+ (callback nil)
+ (insert-generation nil)
+ (jabber-buffer-connection 'fake-jc)
+ (jabber-chatting-with "[email protected]")
+ (jabber-group nil)
+ (jabber-chat-buffer-msg-count nil)
+ (jabber-backlog-number 10)
+ (jabber-chat-earliest-backlog nil)
+ (entries (list (list :timestamp (current-time) :body "hello"))))
+ (cl-letf (((symbol-function 'jabber-connection-bare-jid)
+ (lambda (_jc) "[email protected]"))
+ ((symbol-function 'jabber-db-backlog)
+ (lambda (&rest _) entries))
+ ((symbol-function 'jabber-muc-sender-p)
+ (lambda (&rest _) nil))
+ ((symbol-function 'jabber-chat--insert-backlog-chunked)
+ (lambda (_buffer _entries cb &optional generation)
+ (setq events (append events '(insert-start))
+ callback cb
+ insert-generation generation)))
+ ((symbol-function 'jabber-chat-display-buffer-images)
+ (lambda ()
+ (setq events (append events '(images)))))
+ ((symbol-function 'jabber-chat-buffer-recenter-input)
+ (lambda ()
+ (setq events (append events '(recenter))))))
+ (jabber-chat-buffer-refresh)
+ (should (equal '(insert-start) events))
+ (should callback)
+ (should (= insert-generation jabber-chat--backlog-generation))
+ (funcall callback)
+ (should (equal '(insert-start images recenter) events))))))
+
+(ert-deftest jabber-test-chatbuffer-refresh-empty-skips-completion-callbacks ()
+ "Empty refresh preserves behavior by skipping insert completion callbacks."
+ (jabber-test-chatbuffer-with-ewoc
+ (let ((events nil)
+ (jabber-buffer-connection 'fake-jc)
+ (jabber-chatting-with "[email protected]")
+ (jabber-group nil)
+ (jabber-chat-buffer-msg-count nil)
+ (jabber-backlog-number 10)
+ (jabber-chat-earliest-backlog nil))
+ (cl-letf (((symbol-function 'jabber-connection-bare-jid)
+ (lambda (_jc) "[email protected]"))
+ ((symbol-function 'jabber-db-backlog)
+ (lambda (&rest _) nil))
+ ((symbol-function 'jabber-muc-sender-p)
+ (lambda (&rest _) nil))
+ ((symbol-function 'jabber-chat--insert-backlog-chunked)
+ (lambda (&rest _)
+ (setq events (append events '(insert-start)))))
+ ((symbol-function 'jabber-chat-display-buffer-images)
+ (lambda ()
+ (setq events (append events '(images)))))
+ ((symbol-function 'jabber-chat-buffer-recenter-input)
+ (lambda ()
+ (setq events (append events '(recenter))))))
+ (jabber-chat-buffer-refresh)
+ (should-not events)))))
+
(provide 'jabber-test-chatbuffer)
;;; jabber-test-chatbuffer.el ends here
diff --git a/tests/jabber-test-chatstates.el b/tests/jabber-test-chatstates.el
index 027d2f6e22..4146fe14a0 100644
--- a/tests/jabber-test-chatstates.el
+++ b/tests/jabber-test-chatstates.el
@@ -9,6 +9,32 @@
(require 'ert)
(require 'jabber-chatstates)
+(defun jabber-test-chatstates--message (from type state)
+ "Return a message sexp from FROM with TYPE and chat STATE."
+ `(message ((from . ,from)
+ (type . ,type))
+ (,state ((xmlns . ,jabber-chatstates-xmlns)))))
+
+(defun jabber-test-chatstates--plain-message (from type)
+ "Return a message sexp from FROM with TYPE, body, and no chat state."
+ `(message ((from . ,from)
+ (type . ,type))
+ (body nil "hello")))
+
+(defun jabber-test-chatstates--reaction-message (from type)
+ "Return a bodyless reaction message sexp from FROM with TYPE."
+ `(message ((from . ,from)
+ (type . ,type))
+ (reactions ((xmlns . "urn:xmpp:reactions:0")
+ (id . "target-1"))
+ (reaction nil "👍"))))
+
+(defun jabber-test-chatstates--ewoc-data ()
+ "Return the current EWOC data in display order."
+ (let (data)
+ (ewoc-map (lambda (item) (push item data)) jabber-chat-ewoc)
+ (nreverse data)))
+
;;; Group 1: Composing notification fix
(ert-deftest jabber-test-chatstates-composing-after-first-send ()
@@ -143,6 +169,415 @@ nil after the first message, breaking subsequent
composing detection."
(jabber-chatstates-after-change)
(should-not (memq jabber-chatstates-inactive-timer timer-list)))))
+;;; Group 3: MUC typing helpers
+
+(ert-deftest jabber-test-chatstates-format-no-muc-composers ()
+ (should-not (jabber-chatstates--format-muc-composers nil)))
+
+(ert-deftest jabber-test-chatstates-format-one-muc-composer ()
+ (should (string= (jabber-chatstates--format-muc-composers '("alice"))
+ "alice is typing...")))
+
+(ert-deftest jabber-test-chatstates-format-multiple-muc-composers ()
+ (should (string= (jabber-chatstates--format-muc-composers '("alice" "bob"))
+ "alice, bob are typing...")))
+
+(ert-deftest jabber-test-chatstates-muc-composers-adds-on-composing ()
+ (should (equal (jabber-chatstates--muc-composers-for-state
+ '("alice") "bob" 'composing)
+ '("alice" "bob"))))
+
+(ert-deftest jabber-test-chatstates-muc-composers-does-not-duplicate ()
+ (should (equal (jabber-chatstates--muc-composers-for-state
+ '("alice" "bob") "alice" 'composing)
+ '("alice" "bob"))))
+
+(ert-deftest jabber-test-chatstates-muc-composers-removes-on-non-composing ()
+ (should (equal (jabber-chatstates--muc-composers-for-state
+ '("alice" "bob" "carol") "bob" 'paused)
+ '("alice" "carol"))))
+
+(ert-deftest jabber-test-chatstates-muc-composers-removal-is-idempotent ()
+ (should (equal (jabber-chatstates--muc-composers-for-state
+ '("alice" "bob") "carol" 'active)
+ '("alice" "bob"))))
+
+(ert-deftest jabber-test-chatstates-direct-send-clears-typing-node ()
+ "Local direct-chat send clears the peer typing node."
+ (with-temp-buffer
+ (let* ((jabber-chat-ewoc (ewoc-create #'ignore))
+ (node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "alice is typing..."))))
+ (setq-local jabber-chatstates-confirm t)
+ (setq-local jabber-chatstates--ewoc-node node)
+ (jabber-chatstates-when-sending "hello" "id-1")
+ (should-not jabber-chatstates--ewoc-node)
+ (should-not (jabber-test-chatstates--ewoc-data)))))
+
+(ert-deftest jabber-test-chatstates-muc-send-preserves-remote-composers ()
+ "Local MUC send preserves remote composers and their typing node."
+ (let ((deleted nil))
+ (with-temp-buffer
+ (setq-local jabber-chatstates-confirm t)
+ (setq-local jabber-chatstates--muc-composers '("alice"))
+ (setq-local jabber-chatstates--ewoc-node 'node)
+ (cl-letf (((symbol-function 'jabber-chat-ewoc-delete)
+ (lambda (node) (setq deleted node))))
+ (jabber-chatstates-when-sending "hello" "id-1")
+ (should-not deleted)
+ (should (equal jabber-chatstates--muc-composers '("alice")))
+ (should (eq jabber-chatstates--ewoc-node 'node))))))
+
+(ert-deftest jabber-test-chatstates-clear-typing-forgets-stale-node ()
+ "Clearing a stale typing node forgets it without deleting again."
+ (with-temp-buffer
+ (let* ((jabber-chat-ewoc (ewoc-create #'ignore))
+ (node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "alice is typing..."))))
+ (ewoc-delete jabber-chat-ewoc node)
+ (setq-local jabber-chatstates--ewoc-node node)
+ (should-not (jabber-chatstates--live-ewoc-node-p node))
+ (jabber-chatstates--clear-typing)
+ (should-not jabber-chatstates--ewoc-node))))
+
+(ert-deftest jabber-test-chatstates-direct-send-forgets-stale-typing-node ()
+ "Local direct-chat send ignores stale typing nodes."
+ (with-temp-buffer
+ (let* ((jabber-chat-ewoc (ewoc-create #'ignore))
+ (node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "alice is typing..."))))
+ (ewoc-delete jabber-chat-ewoc node)
+ (setq-local jabber-chatstates-confirm t)
+ (setq-local jabber-chatstates--ewoc-node node)
+ (jabber-chatstates-when-sending "hello" "id-1")
+ (should-not jabber-chatstates--ewoc-node))))
+
+(ert-deftest jabber-test-chatstates-muc-reinsert-after-stale-node ()
+ "A stale MUC typing node does not block bottom reinsertion."
+ (with-temp-buffer
+ (let* ((jabber-chat-ewoc (ewoc-create #'ignore))
+ (node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "alice is typing..."))))
+ (ewoc-delete jabber-chat-ewoc node)
+ (ewoc-enter-last jabber-chat-ewoc '(:muc-message "alice: hello"))
+ (setq-local jabber-chatstates--muc-composers '("bob"))
+ (setq-local jabber-chatstates--ewoc-node node)
+ (jabber-chatstates--update-muc-ewoc)
+ (should (equal (jabber-test-chatstates--ewoc-data)
+ '((:muc-message "alice: hello")
+ (:typing "bob is typing..."))))
+ (should-not (eq jabber-chatstates--ewoc-node node)))))
+
+(ert-deftest jabber-test-chatstates-muc-ewoc-update-reinserts-node ()
+ "Updating existing MUC typing text reinserts the node at bottom."
+ (with-temp-buffer
+ (let* ((jabber-chat-ewoc (ewoc-create #'ignore))
+ (first (ewoc-enter-last jabber-chat-ewoc '(:muc-notice "joined")))
+ (old-node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "alice is typing..."))))
+ (setq-local jabber-chatstates--muc-composers '("alice" "bob"))
+ (setq-local jabber-chatstates--ewoc-node old-node)
+ (jabber-chatstates--update-muc-ewoc)
+ (should (equal (ewoc-data first) '(:muc-notice "joined")))
+ (should-not (eq jabber-chatstates--ewoc-node old-node))
+ (should (equal (jabber-test-chatstates--ewoc-data)
+ '((:muc-notice "joined")
+ (:typing "alice, bob are typing...")))))))
+
+(ert-deftest jabber-test-chatstates-muc-clear-nick-deletes-typing-node ()
+ "Clearing the last MUC composer deletes the typing node."
+ (with-temp-buffer
+ (let* ((jabber-chat-ewoc (ewoc-create #'ignore))
+ (node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "alice is typing..."))))
+ (setq-local jabber-chatstates--muc-composers '("alice"))
+ (setq-local jabber-chatstates--ewoc-node node)
+ (jabber-chatstates--muc-clear-nick "alice")
+ (should-not jabber-chatstates--muc-composers)
+ (should-not jabber-chatstates--ewoc-node)
+ (should-not (jabber-test-chatstates--ewoc-data)))))
+
+(ert-deftest jabber-test-chatstates-muc-clear-nick-reinserts-typing-node ()
+ "Clearing one MUC composer reinserts the node for remaining composers."
+ (with-temp-buffer
+ (let* ((jabber-chat-ewoc (ewoc-create #'ignore))
+ (old-node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "alice, bob are typing..."))))
+ (setq-local jabber-chatstates--muc-composers '("alice" "bob"))
+ (setq-local jabber-chatstates--ewoc-node old-node)
+ (jabber-chatstates--muc-clear-nick "alice")
+ (should (equal jabber-chatstates--muc-composers '("bob")))
+ (should-not (eq jabber-chatstates--ewoc-node old-node))
+ (should (equal (jabber-test-chatstates--ewoc-data)
+ '((:typing "bob is typing...")))))))
+
+(ert-deftest jabber-test-chatstates-groupchat-message-keeps-typing-at-bottom ()
+ "Plain groupchat message cleanup moves remaining typing below the message."
+ (with-temp-buffer
+ (let* ((jabber-chat-ewoc (ewoc-create #'ignore))
+ (old-node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "alice, bob are typing..."))))
+ (setq-local jabber-chatstates--muc-composers '("alice" "bob"))
+ (setq-local jabber-chatstates--ewoc-node old-node)
+ (ewoc-enter-last jabber-chat-ewoc '(:muc-message "alice: hello"))
+ (let ((muc-buffer (current-buffer)))
+ (cl-letf (((symbol-function 'jabber-muc-find-buffer)
+ (lambda (_group) muc-buffer))
+ ((symbol-function 'jabber-muc-nickname) #'ignore))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--plain-message
+ "[email protected]/alice" "groupchat"))))
+ (should (equal jabber-chatstates--muc-composers '("bob")))
+ (should (equal (jabber-test-chatstates--ewoc-data)
+ '((:muc-message "alice: hello")
+ (:typing "bob is typing...")))))))
+
+(ert-deftest jabber-test-chatstates-muc-leave-cleanup-keeps-typing-at-bottom ()
+ "Leave cleanup can remove, print notice, and reinsert typing at bottom."
+ (with-temp-buffer
+ (let* ((jabber-chat-ewoc (ewoc-create #'ignore))
+ (old-node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "alice, bob are typing..."))))
+ (setq-local jabber-chatstates--muc-composers '("alice" "bob"))
+ (setq-local jabber-chatstates--ewoc-node old-node)
+ (jabber-chatstates--muc-remove-nick "alice")
+ (jabber-chatstates--delete-typing-node)
+ (ewoc-enter-last jabber-chat-ewoc '(:muc-notice "alice has left"))
+ (jabber-chatstates--muc-reinsert-typing)
+ (should (equal jabber-chatstates--muc-composers '("bob")))
+ (should (equal (jabber-test-chatstates--ewoc-data)
+ '((:muc-notice "alice has left")
+ (:typing "bob is typing...")))))))
+
+;;; Group 4: Incoming MUC routing
+
+(ert-deftest jabber-test-chatstates-groupchat-composing-routes-to-muc-buffer ()
+ "Incoming groupchat composing updates the room buffer by bare JID."
+ (let ((entered nil)
+ (seen-group nil))
+ (with-temp-buffer
+ (let ((muc-buffer (current-buffer)))
+ (cl-letf (((symbol-function 'jabber-muc-find-buffer)
+ (lambda (group)
+ (setq seen-group group)
+ muc-buffer))
+ ((symbol-function 'jabber-muc-nickname) #'ignore)
+ ((symbol-function 'jabber-chat-ewoc-enter)
+ (lambda (data)
+ (setq entered data)
+ 'node)))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--message
+ "[email protected]/alice" "groupchat" 'composing))
+ (should (string= seen-group "[email protected]"))
+ (should (equal jabber-chatstates--muc-composers '("alice")))
+ (should (equal entered '(:typing "alice is typing..."))))))))
+
+(ert-deftest jabber-test-chatstates-groupchat-active-removes-from-muc-buffer ()
+ "Incoming groupchat active removes the occupant from the room buffer."
+ (with-temp-buffer
+ (let* ((jabber-chat-ewoc (ewoc-create #'ignore))
+ (node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "alice is typing..."))))
+ (setq-local jabber-chatstates--muc-composers '("alice"))
+ (setq-local jabber-chatstates--ewoc-node node)
+ (let ((muc-buffer (current-buffer)))
+ (cl-letf (((symbol-function 'jabber-muc-find-buffer)
+ (lambda (_group) muc-buffer))
+ ((symbol-function 'jabber-muc-nickname) #'ignore))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--message
+ "[email protected]/alice" "groupchat" 'active))
+ (should-not jabber-chatstates--muc-composers)
+ (should-not jabber-chatstates--ewoc-node)
+ (should-not (jabber-test-chatstates--ewoc-data)))))))
+
+(ert-deftest jabber-test-chatstates-groupchat-message-clears-composing ()
+ "Incoming groupchat message without chatstate clears occupant typing."
+ (with-temp-buffer
+ (let ((muc-buffer (current-buffer))
+ (jabber-chat-ewoc (ewoc-create #'ignore)))
+ (cl-letf (((symbol-function 'jabber-muc-find-buffer)
+ (lambda (_group) muc-buffer))
+ ((symbol-function 'jabber-muc-nickname) #'ignore))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--message
+ "[email protected]/alice" "groupchat" 'composing))
+ (should (equal jabber-chatstates--muc-composers '("alice")))
+ (should (equal (jabber-test-chatstates--ewoc-data)
+ '((:typing "alice is typing..."))))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--plain-message
+ "[email protected]/alice" "groupchat"))
+ (should-not jabber-chatstates--muc-composers)
+ (should-not jabber-chatstates--ewoc-node)
+ (should-not (jabber-test-chatstates--ewoc-data))))))
+
+(ert-deftest jabber-test-chatstates-groupchat-reaction-preserves-composing ()
+ "Incoming groupchat reaction-only stanza does not clear occupant typing."
+ (with-temp-buffer
+ (let ((muc-buffer (current-buffer))
+ (jabber-chat-ewoc (ewoc-create #'ignore)))
+ (cl-letf (((symbol-function 'jabber-muc-find-buffer)
+ (lambda (_group) muc-buffer))
+ ((symbol-function 'jabber-muc-nickname) #'ignore))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--message
+ "[email protected]/alice" "groupchat" 'composing))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--reaction-message
+ "[email protected]/alice" "groupchat"))
+ (should (equal jabber-chatstates--muc-composers '("alice")))
+ (should (equal (jabber-test-chatstates--ewoc-data)
+ '((:typing "alice is typing..."))))))))
+
+(ert-deftest jabber-test-chatstates-groupchat-self-nick-is-ignored ()
+ "Incoming groupchat state from our nick refreshes without mutating
composers."
+ (let ((find-called nil)
+ (entered nil))
+ (with-temp-buffer
+ (cl-letf (((symbol-function 'jabber-muc-find-buffer)
+ (lambda (_group)
+ (setq find-called t)
+ (current-buffer)))
+ ((symbol-function 'jabber-muc-nickname)
+ (lambda (_group _jc) "alice"))
+ ((symbol-function 'jabber-chat-ewoc-enter)
+ (lambda (data)
+ (setq entered data)
+ 'node)))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--message
+ "[email protected]/alice" "groupchat" 'composing))
+ (should find-called)
+ (should-not jabber-chatstates--muc-composers)
+ (should-not entered)))))
+
+(ert-deftest
jabber-test-chatstates-self-groupchat-message-keeps-typing-at-bottom ()
+ "Self groupchat echo refreshes remote typing below the echoed message."
+ (with-temp-buffer
+ (let* ((jabber-chat-ewoc (ewoc-create #'ignore))
+ (old-node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "bob is typing..."))))
+ (setq-local jabber-chatstates--muc-composers '("bob"))
+ (setq-local jabber-chatstates--ewoc-node old-node)
+ (ewoc-enter-last jabber-chat-ewoc '(:muc-message "alice: hello"))
+ (let ((muc-buffer (current-buffer)))
+ (cl-letf (((symbol-function 'jabber-muc-find-buffer)
+ (lambda (_group) muc-buffer))
+ ((symbol-function 'jabber-muc-nickname)
+ (lambda (_group _jc) "alice")))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--plain-message
+ "[email protected]/alice" "groupchat"))))
+ (should (equal jabber-chatstates--muc-composers '("bob")))
+ (should-not (eq jabber-chatstates--ewoc-node old-node))
+ (should (equal (jabber-test-chatstates--ewoc-data)
+ '((:muc-message "alice: hello")
+ (:typing "bob is typing...")))))))
+
+(ert-deftest jabber-test-chatstates-direct-chat-keeps-direct-routing ()
+ "Incoming direct chat states keep using the direct chat buffer lookup."
+ (let ((direct-called nil)
+ (muc-called nil)
+ (entered nil))
+ (with-temp-buffer
+ (rename-buffer " *jabber-direct-chatstates-test*" t)
+ (setq-local jabber-chatting-with "[email protected]/resource")
+ (let ((chat-buffer (current-buffer)))
+ (cl-letf (((symbol-function 'jabber-chat-get-buffer)
+ (lambda (from jc)
+ (setq direct-called (list from jc))
+ (buffer-name chat-buffer)))
+ ((symbol-function 'jabber-muc-find-buffer)
+ (lambda (_group)
+ (setq muc-called t)
+ nil))
+ ((symbol-function 'jabber-chat-ewoc-enter)
+ (lambda (data)
+ (setq entered data)
+ 'node)))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--message
+ "[email protected]/resource" "chat" 'composing))
+ (should (equal direct-called '("[email protected]/resource"
fake-jc)))
+ (should-not muc-called)
+ (should (eq jabber-chatstates-last-state 'composing))
+ (should (equal entered '(:typing "[email protected] is
typing..."))))))))
+
+(ert-deftest jabber-test-chatstates-direct-active-forgets-stale-node ()
+ "Incoming direct active clears a stale typing node without error."
+ (with-temp-buffer
+ (rename-buffer " *jabber-direct-chatstates-active-stale-test*" t)
+ (let* ((chat-buffer (current-buffer))
+ (jabber-chat-ewoc (ewoc-create #'ignore))
+ (node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "alice is typing..."))))
+ (ewoc-delete jabber-chat-ewoc node)
+ (setq-local jabber-chatstates--ewoc-node node)
+ (cl-letf (((symbol-function 'jabber-chat-get-buffer)
+ (lambda (_from _jc) (buffer-name chat-buffer))))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--message
+ "[email protected]/resource" "chat" 'active))
+ (should-not jabber-chatstates--ewoc-node)
+ (should-not (jabber-test-chatstates--ewoc-data))))))
+
+(ert-deftest jabber-test-chatstates-direct-composing-replaces-stale-node ()
+ "Incoming direct composing inserts a fresh node after stale node cleanup."
+ (with-temp-buffer
+ (rename-buffer " *jabber-direct-chatstates-composing-stale-test*" t)
+ (let* ((chat-buffer (current-buffer))
+ (jabber-chat-ewoc (ewoc-create #'ignore))
+ (node (ewoc-enter-last jabber-chat-ewoc
+ '(:typing "alice is typing..."))))
+ (ewoc-delete jabber-chat-ewoc node)
+ (setq-local jabber-chatting-with "[email protected]/resource")
+ (setq-local jabber-chatstates--ewoc-node node)
+ (cl-letf (((symbol-function 'jabber-chat-get-buffer)
+ (lambda (_from _jc) (buffer-name chat-buffer))))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--message
+ "[email protected]/resource" "chat" 'composing))
+ (should jabber-chatstates--ewoc-node)
+ (should-not (eq jabber-chatstates--ewoc-node node))
+ (should (equal (jabber-test-chatstates--ewoc-data)
+ '((:typing "[email protected] is typing..."))))))))
+
+(ert-deftest jabber-test-chatstates-direct-composing-keeps-live-node ()
+ "Repeated incoming direct composing preserves the live typing node."
+ (with-temp-buffer
+ (rename-buffer " *jabber-direct-chatstates-composing-live-test*" t)
+ (let ((chat-buffer (current-buffer))
+ (jabber-chat-ewoc (ewoc-create #'ignore)))
+ (setq-local jabber-chatting-with "[email protected]/resource")
+ (cl-letf (((symbol-function 'jabber-chat-get-buffer)
+ (lambda (_from _jc) (buffer-name chat-buffer))))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--message
+ "[email protected]/resource" "chat" 'composing))
+ (let ((node jabber-chatstates--ewoc-node))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--message
+ "[email protected]/resource" "chat" 'composing))
+ (should (eq jabber-chatstates--ewoc-node node))
+ (should (equal (jabber-test-chatstates--ewoc-data)
+ '((:typing "[email protected] is typing...")))))))))
+
(provide 'jabber-test-chatstates)
;;; jabber-test-chatstates.el ends here
