branch: elpa/jabber
commit 0487687c4d60376088f0d37d2d28a36f3c0175e9
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
chat: Quote the original message in fallback-less replies
---
CHANGELOG.org | 1 +
lisp/jabber-chat.el | 32 ++++++++++++++++++++++++++++++--
lisp/jabber-db.el | 14 ++++++++++++++
tests/jabber-test-chat.el | 34 ++++++++++++++++++++++++++++++++++
tests/jabber-test-db.el | 31 +++++++++++++++++++++++++++++++
5 files changed, 110 insertions(+), 2 deletions(-)
diff --git a/CHANGELOG.org b/CHANGELOG.org
index 6d86808dd8..361907c333 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -3,6 +3,7 @@
* [Unreleased]
** Added
+- 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
- OMEMO signed pre-keys now rotate automatically on connect
(~jabber-omemo-signed-pre-key-rotation-period~, 7 days default)
diff --git a/lisp/jabber-chat.el b/lisp/jabber-chat.el
index e0cd72c429..ee1e454ec1 100644
--- a/lisp/jabber-chat.el
+++ b/lisp/jabber-chat.el
@@ -289,6 +289,8 @@ holding state for the next composed message stay inert."
&optional resource stanza-id
server-id occupant-id oob-entries
encrypted reply))
+(declare-function jabber-db-reply-target-body "jabber-db.el"
+ (account peer reply-id muc-p))
(declare-function jabber-db--extract-occupant-id "jabber-db.el" (xml-data))
(declare-function jabber-message-correct--replace-id "jabber-message-correct"
(xml-data))
@@ -1195,10 +1197,36 @@ is in the body the reply context is already visible
inline."
(format "reply to %s" who)
"reply"))))
+(defun jabber-chat--first-line-snippet (text limit)
+ "Return the first line of TEXT, truncated to LIMIT characters."
+ (let ((line (car (split-string text "\n"))))
+ (if (> (length line) limit)
+ (concat (substring line 0 limit) "…")
+ line)))
+
+(defun jabber-chat--reply-context-snippet (msg)
+ "Return a snippet of the original body MSG replies to, or nil.
+Looks the referenced message up in the local database."
+ (and-let* ((reply-id (plist-get msg :reply-to-id))
+ (jabber-buffer-connection)
+ (peer (or (bound-and-true-p jabber-group)
+ jabber-chatting-with))
+ (body (jabber-db-reply-target-body
+ (jabber-connection-bare-jid jabber-buffer-connection)
+ (jabber-jid-user peer) reply-id
+ (and (bound-and-true-p jabber-group) t))))
+ (jabber-chat--first-line-snippet body 80)))
+
(defun jabber-chat--insert-reply-context (msg)
- "Insert reply context line for MSG when it needs one."
+ "Insert reply context line for MSG when it needs one.
+When the referenced message is in the local database, quote a
+snippet of it after the label."
(when-let* ((label (jabber-chat--reply-context-label msg)))
- (insert (propertize (concat label "\n") 'face 'shadow))))
+ (let ((snippet (jabber-chat--reply-context-snippet msg)))
+ (insert (propertize
+ (if snippet (format "%s: %s\n" label snippet)
+ (concat label "\n"))
+ 'face 'shadow)))))
(defun jabber-chat-pp--local (data)
"Render a locally sent message from DATA."
diff --git a/lisp/jabber-db.el b/lisp/jabber-db.el
index cb8cb2c9b7..79b71436f7 100644
--- a/lisp/jabber-db.el
+++ b/lisp/jabber-db.el
@@ -805,6 +805,20 @@ FROM message WHERE stanza_id = ? LIMIT 1"
(if resource (concat peer "/" resource) peer)
account)))))
+(defun jabber-db-reply-target-body (account peer reply-id muc-p)
+ "Return the body of the message REPLY-ID references, or nil.
+In a MUC (MUC-P non-nil) REPLY-ID is the room-assigned stanza-id
+\(XEP-0461), so match on server_id; in 1:1 chat it is the sender's
+origin id, so match on stanza_id. ACCOUNT and PEER scope the lookup."
+ (when-let* ((db (jabber-db-ensure-open)))
+ (caar (sqlite-select
+ db
+ (format "SELECT body FROM message \
+WHERE account = ? AND peer = ? AND %s = ? AND retracted_by IS NULL \
+LIMIT 1"
+ (if muc-p "server_id" "stanza_id"))
+ (list account peer reply-id)))))
+
;;; Reactions
(defun jabber-db--reaction-id-column (type)
diff --git a/tests/jabber-test-chat.el b/tests/jabber-test-chat.el
index a824448ee7..eb36954285 100644
--- a/tests/jabber-test-chat.el
+++ b/tests/jabber-test-chat.el
@@ -261,6 +261,40 @@
(plist (jabber-chat--msg-plist-from-stanza stanza)))
(should-not (plist-get plist :fallback-range))))
+(ert-deftest jabber-test-chat-reply-context-synthesizes-quote ()
+ "A fallback-less reply quotes the original body from the database."
+ (with-temp-buffer
+ (setq-local jabber-chatting-with "[email protected]")
+ (setq-local jabber-buffer-connection 'fake-jc)
+ (cl-letf (((symbol-function 'jabber-connection-bare-jid)
+ (lambda (_jc) "[email protected]"))
+ ((symbol-function 'jabber-muc-sender-p)
+ (lambda (_jid) nil))
+ ((symbol-function 'jabber-db-reply-target-body)
+ (lambda (_account _peer reply-id _muc-p)
+ (and (equal reply-id "orig-1")
+ "original text\nsecond line"))))
+ (jabber-chat--insert-reply-context
+ '(:reply-to-id "orig-1" :reply-to-jid "[email protected]"))
+ (should (string-match-p "reply to [email protected]: original text"
+ (buffer-string)))
+ (should-not (string-match-p "second line" (buffer-string))))))
+
+(ert-deftest jabber-test-chat-reply-context-label-without-db-hit ()
+ "A fallback-less reply falls back to the bare label when unresolved."
+ (with-temp-buffer
+ (setq-local jabber-chatting-with "[email protected]")
+ (setq-local jabber-buffer-connection 'fake-jc)
+ (cl-letf (((symbol-function 'jabber-connection-bare-jid)
+ (lambda (_jc) "[email protected]"))
+ ((symbol-function 'jabber-muc-sender-p)
+ (lambda (_jid) nil))
+ ((symbol-function 'jabber-db-reply-target-body)
+ (lambda (&rest _) nil)))
+ (jabber-chat--insert-reply-context
+ '(:reply-to-id "orig-2" :reply-to-jid "[email protected]"))
+ (should (equal "reply to [email protected]\n" (buffer-string))))))
+
(ert-deftest jabber-test-chat-outgoing-handler-stores-reply-metadata ()
"The DB outgoing handler reads reply elements off the final stanza."
(require 'jabber-db)
diff --git a/tests/jabber-test-db.el b/tests/jabber-test-db.el
index a4b191cefe..f5550b9208 100644
--- a/tests/jabber-test-db.el
+++ b/tests/jabber-test-db.el
@@ -1765,6 +1765,37 @@ CREATE TABLE omemo_store (
(should (equal "orig-4" (plist-get msg :reply-to-id)))
(should (eq 'all (plist-get msg :fallback-range)))))))
+(ert-deftest jabber-test-db-reply-target-body-lookup ()
+ "Reply target lookup matches server_id in MUC, stanza_id in 1:1."
+ (jabber-test-db-with-db
+ (let ((ts (floor (float-time))))
+ (jabber-db-store-message
+ "[email protected]" "[email protected]" "in" "groupchat" "the original" ts
+ "alice" "short-1" "room-uuid-1")
+ (jabber-db-store-message
+ "[email protected]" "[email protected]" "in" "chat" "direct original" ts
+ "phone" "origin-7"))
+ (should (equal "the original"
+ (jabber-db-reply-target-body
+ "[email protected]" "[email protected]" "room-uuid-1" t)))
+ (should-not (jabber-db-reply-target-body
+ "[email protected]" "[email protected]" "short-1" t))
+ (should (equal "direct original"
+ (jabber-db-reply-target-body
+ "[email protected]" "[email protected]" "origin-7" nil)))
+ (should-not (jabber-db-reply-target-body
+ "[email protected]" "[email protected]" "missing" nil))))
+
+(ert-deftest jabber-test-db-reply-target-body-skips-retracted ()
+ "A retracted reply target is not quoted."
+ (jabber-test-db-with-db
+ (jabber-db-store-message
+ "[email protected]" "[email protected]" "in" "chat" "soon gone"
+ (floor (float-time)) "phone" "orig-8" "srv-8")
+ (jabber-db-retract-message "srv-8" "[email protected]/phone" nil)
+ (should-not (jabber-db-reply-target-body
+ "[email protected]" "[email protected]" "orig-8" nil))))
+
(ert-deftest jabber-test-db-extract-reply-fields ()
"Reply extraction matches the chat-side parser's shape."
(let ((stanza '(message ((from . "[email protected]") (type . "chat"))
