branch: elpa/jabber
commit 77e79c7e4fa12813b07a93547c39e3ae80fa7c48
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
chat: Jump to the original message with RET on a reply
---
CHANGELOG.org | 1 +
lisp/jabber-chat.el | 36 +++++++++++++++++++++++++++
lisp/jabber-chatbuffer.el | 6 +++--
tests/jabber-test-chat.el | 62 +++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 103 insertions(+), 2 deletions(-)
diff --git a/CHANGELOG.org b/CHANGELOG.org
index 361907c333..ad6b1acd8f 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -3,6 +3,7 @@
* [Unreleased]
** Added
+- RET on a reply jumps to the original message and highlights it; RET
elsewhere still sends
- Replies without an inline quote now show a snippet of the original message,
looked up from local history
- Reply context survives buffer reloads: reply metadata is now stored in the
message database
- Outgoing messages carry an XEP-0359 origin-id, so replies from other clients
reference a stable id
diff --git a/lisp/jabber-chat.el b/lisp/jabber-chat.el
index ee1e454ec1..5b56f69e82 100644
--- a/lisp/jabber-chat.el
+++ b/lisp/jabber-chat.el
@@ -1228,6 +1228,42 @@ snippet of it after the label."
(concat label "\n"))
'face 'shadow)))))
+(defun jabber-chat--reply-target-at-point ()
+ "Return the :reply-to-id of the rendered message at point, or nil.
+Only meaningful in the message area, above the input divider."
+ (and jabber-chat-ewoc
+ (markerp jabber-point-insert)
+ (< (point) jabber-point-insert)
+ (when-let* ((node (ewoc-locate jabber-chat-ewoc (point)))
+ (msg (cadr (ewoc-data node))))
+ (and (listp msg) (plist-get msg :reply-to-id)))))
+
+(defun jabber-chat-goto-reply-target ()
+ "Move point to the message the reply at point references."
+ (interactive)
+ (let ((target (jabber-chat--reply-target-at-point)))
+ (unless target
+ (user-error "No reply at point"))
+ (let ((node (jabber-chat-ewoc-find-by-id target)))
+ (unless node
+ (user-error "The original message is not in this buffer"))
+ (goto-char (ewoc-location node))
+ (require 'pulse)
+ (pulse-momentary-highlight-region
+ (ewoc-location node)
+ (or (and-let* ((next (ewoc-next jabber-chat-ewoc node)))
+ (ewoc-location next))
+ jabber-point-insert)))))
+
+(defun jabber-chat-goto-reply-target-or-send ()
+ "Jump to the replied-to message at point, or send the input.
+On a rendered reply, move point to the original message;
+anywhere else, behave like `jabber-chat-buffer-send'."
+ (interactive)
+ (if (jabber-chat--reply-target-at-point)
+ (jabber-chat-goto-reply-target)
+ (jabber-chat-buffer-send)))
+
(defun jabber-chat-pp--local (data)
"Render a locally sent message from DATA."
(let* ((msg (cadr data))
diff --git a/lisp/jabber-chatbuffer.el b/lisp/jabber-chatbuffer.el
index 47e1e61332..6fb3be98ca 100644
--- a/lisp/jabber-chatbuffer.el
+++ b/lisp/jabber-chatbuffer.el
@@ -131,6 +131,7 @@ previous sequence detect the mismatch and stop.")
(declare-function jabber-correct-last-message "jabber-message-correct" ())
(declare-function jabber-chat-cancel-reply "jabber-message-reply" ())
(declare-function jabber-reactions-react-at-point-or-insert "jabber-reactions"
())
+(declare-function jabber-chat-goto-reply-target-or-send "jabber-chat" ())
(declare-function jabber-chat-image-enlarge-or-self-insert "jabber-chat" (n))
(declare-function jabber-chat-image-shrink-or-self-insert "jabber-chat" (n))
(declare-function jabber-chat-image-reset-size-or-self-insert "jabber-chat"
(n))
@@ -458,7 +459,7 @@ MAM sync in this buffer. Set via the operations menu.")
(insert "\n"))
(defvar-keymap jabber-chat-mode-map
- "RET" #'jabber-chat-buffer-send
+ "RET" #'jabber-chat-goto-reply-target-or-send
"S-<return>" #'jabber-chat-newline
"TAB" #'completion-at-point
"<backtab>" #'backward-button
@@ -727,9 +728,10 @@ or nil if the message was a duplicate."
node))))
(defun jabber-chat-ewoc--msg-matches-id-p (msg stanza-id)
- "Return non-nil when MSG has STANZA-ID as :id or :server-id."
+ "Return non-nil when MSG has STANZA-ID as :id, :origin-id or :server-id."
(and (listp msg)
(or (equal stanza-id (plist-get msg :id))
+ (equal stanza-id (plist-get msg :origin-id))
(equal stanza-id (plist-get msg :server-id)))))
(defun jabber-chat-ewoc--find-by-id-scan (stanza-id)
diff --git a/tests/jabber-test-chat.el b/tests/jabber-test-chat.el
index eb36954285..cbdba749fe 100644
--- a/tests/jabber-test-chat.el
+++ b/tests/jabber-test-chat.el
@@ -261,6 +261,68 @@
(plist (jabber-chat--msg-plist-from-stanza stanza)))
(should-not (plist-get plist :fallback-range))))
+(defmacro jabber-test-chat--with-reply-ewoc (&rest body)
+ "Run BODY in a temp buffer with an original and a reply node.
+The original has id \"orig-1\"; the reply references it. Point
+starts on the reply node; `jabber-point-insert' marks the input
+area after both messages."
+ (declare (indent 0) (debug t))
+ `(with-temp-buffer
+ (let ((jabber-chat-ewoc (ewoc-create
+ (lambda (data)
+ (insert (plist-get (cadr data) :body) "\n"))
+ nil nil 'nosep))
+ (jabber-chat--msg-nodes (make-hash-table :test 'equal)))
+ (jabber-chat-ewoc-enter
+ (list :foreign (list :id "orig-1" :from "[email protected]"
+ :body "the original"
+ :timestamp (current-time))))
+ (let ((reply-node
+ (jabber-chat-ewoc-enter
+ (list :foreign (list :id "r-1" :from "[email protected]"
+ :body "the reply"
+ :reply-to-id "orig-1"
+ :timestamp (current-time))))))
+ (setq-local jabber-point-insert (point-max-marker))
+ (goto-char (ewoc-location reply-node))
+ ,@body))))
+
+(ert-deftest jabber-test-chat-reply-target-at-point ()
+ "The reply target is found on the reply node and nowhere else."
+ (jabber-test-chat--with-reply-ewoc
+ (should (equal "orig-1" (jabber-chat--reply-target-at-point)))
+ (goto-char (point-min))
+ (should-not (jabber-chat--reply-target-at-point))
+ (goto-char (point-max))
+ (should-not (jabber-chat--reply-target-at-point))))
+
+(ert-deftest jabber-test-chat-goto-reply-target-jumps ()
+ "RET on a reply moves point to the original message."
+ (jabber-test-chat--with-reply-ewoc
+ (cl-letf (((symbol-function 'pulse-momentary-highlight-region)
+ #'ignore))
+ (jabber-chat-goto-reply-target))
+ (should (= (point) (point-min)))
+ (should (looking-at "the original"))))
+
+(ert-deftest jabber-test-chat-goto-reply-target-or-send-dispatch ()
+ "RET sends from the input area and jumps from a reply."
+ (jabber-test-chat--with-reply-ewoc
+ (let ((sent nil))
+ (cl-letf (((symbol-function 'jabber-chat-buffer-send)
+ (lambda () (setq sent t)))
+ ((symbol-function 'pulse-momentary-highlight-region)
+ #'ignore))
+ (goto-char (point-max))
+ (jabber-chat-goto-reply-target-or-send)
+ (should sent)
+ (setq sent nil)
+ (goto-char (point-min))
+ (ewoc-goto-next jabber-chat-ewoc 1)
+ (jabber-chat-goto-reply-target-or-send)
+ (should-not sent)
+ (should (= (point) (point-min)))))))
+
(ert-deftest jabber-test-chat-reply-context-synthesizes-quote ()
"A fallback-less reply quotes the original body from the database."
(with-temp-buffer
