branch: elpa/jabber
commit f36fbf5a8b905c7d2cd9ca7ffed85d028c82e597
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
chatstates: Preserve typing on reaction fallbacks
---
lisp/jabber-chatstates.el | 14 ++++++--
tests/jabber-test-chatstates.el | 75 +++++++++++++++++++++++++++++++++++++++++
2 files changed, 86 insertions(+), 3 deletions(-)
diff --git a/lisp/jabber-chatstates.el b/lisp/jabber-chatstates.el
index 8b1cc075d6..c631094fae 100644
--- a/lisp/jabber-chatstates.el
+++ b/lisp/jabber-chatstates.el
@@ -44,6 +44,7 @@
(declare-function jabber-muc-find-buffer "jabber-muc" (group))
(declare-function jabber-muc-nickname "jabber-muc" (group &optional jc))
+(declare-function jabber-reactions--reaction-only-p "jabber-reactions"
(xml-data))
(defgroup jabber-chatstates nil
"Chat state notifications."
@@ -287,6 +288,12 @@ Added to `kill-buffer-hook' in chat buffers."
;;; COMMON
+(defun jabber-chatstates--real-body-message-p (xml-data)
+ "Return non-nil when XML-DATA has a body that should clear chatstates."
+ (and (jabber-xml-get-children xml-data 'body)
+ (not (and (fboundp 'jabber-reactions--reaction-only-p)
+ (jabber-reactions--reaction-only-p xml-data)))))
+
(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))))
@@ -306,8 +313,9 @@ Added to `kill-buffer-hook' in chat buffers."
(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)))))))
+ (when (or state (jabber-chatstates--real-body-message-p xml-data))
+ (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."
@@ -315,7 +323,7 @@ Added to `kill-buffer-hook' in chat buffers."
(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)))
+ (or state (jabber-chatstates--real-body-message-p
xml-data)))
(jabber-chatstates--handle-muc-state jc from state)))
(jabber-chatstates--handle-direct-state jc xml-data from))))
diff --git a/tests/jabber-test-chatstates.el b/tests/jabber-test-chatstates.el
index 4146fe14a0..58b2c137d3 100644
--- a/tests/jabber-test-chatstates.el
+++ b/tests/jabber-test-chatstates.el
@@ -8,6 +8,7 @@
(require 'ert)
(require 'jabber-chatstates)
+(require 'jabber-reactions)
(defun jabber-test-chatstates--message (from type state)
"Return a message sexp from FROM with TYPE and chat STATE."
@@ -29,6 +30,18 @@
(id . "target-1"))
(reaction nil "š"))))
+(defun jabber-test-chatstates--reaction-fallback-message (from type)
+ "Return a reaction message from FROM with TYPE and fallback text."
+ `(message ((from . ,from)
+ (type . ,type))
+ (body nil "> quoted\nš")
+ (reactions ((xmlns . "urn:xmpp:reactions:0")
+ (id . "target-1"))
+ (reaction nil "š"))
+ (fallback ((xmlns . "urn:xmpp:fallback:0")
+ (for . "urn:xmpp:reactions:0"))
+ (body ((start . "0") (end . "10"))))))
+
(defun jabber-test-chatstates--ewoc-data ()
"Return the current EWOC data in display order."
(let (data)
@@ -438,6 +451,26 @@ nil after the first message, breaking subsequent composing
detection."
(should (equal (jabber-test-chatstates--ewoc-data)
'((:typing "alice is typing..."))))))))
+(ert-deftest
jabber-test-chatstates-groupchat-reaction-fallback-preserves-composing ()
+ "Incoming groupchat reaction fallback body 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-fallback-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)
@@ -515,6 +548,48 @@ nil after the first message, breaking subsequent composing
detection."
(should (eq jabber-chatstates-last-state 'composing))
(should (equal entered '(:typing "[email protected] is
typing..."))))))))
+(ert-deftest
jabber-test-chatstates-direct-reaction-fallback-preserves-composing ()
+ "Incoming direct reaction fallback body does not clear peer typing."
+ (with-temp-buffer
+ (rename-buffer " *jabber-direct-chatstates-reaction-fallback-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))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--reaction-fallback-message
+ "[email protected]/resource" "chat"))
+ (should (eq jabber-chatstates-last-state 'composing))
+ (should (equal (jabber-test-chatstates--ewoc-data)
+ '((:typing "[email protected] is typing..."))))))))
+
+(ert-deftest jabber-test-chatstates-direct-message-clears-composing ()
+ "Incoming direct message without chatstate clears peer typing."
+ (with-temp-buffer
+ (rename-buffer " *jabber-direct-chatstates-message-clears-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))
+ (jabber-handle-incoming-message-chatstates
+ 'fake-jc
+ (jabber-test-chatstates--plain-message
+ "[email protected]/resource" "chat"))
+ (should-not jabber-chatstates-last-state)
+ (should-not jabber-chatstates--ewoc-node)
+ (should-not (jabber-test-chatstates--ewoc-data))))))
+
(ert-deftest jabber-test-chatstates-direct-active-forgets-stale-node ()
"Incoming direct active clears a stale typing node without error."
(with-temp-buffer
