branch: elpa/jabber
commit c8ab7cd903282892f466576efa3464057b076b36
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
buffer: Separate chat registry
---
lisp/jabber-buffer-registry.el | 69 +++++++++++++++++++++++++++++++++++++++
lisp/jabber-chat.el | 5 +--
lisp/jabber-chatbuffer.el | 50 +++--------------------------
lisp/jabber-muc.el | 9 +++---
tests/jabber-test-chatbuffer.el | 71 ++++++++++++++++++++---------------------
5 files changed, 117 insertions(+), 87 deletions(-)
diff --git a/lisp/jabber-buffer-registry.el b/lisp/jabber-buffer-registry.el
new file mode 100644
index 0000000000..57c6e3c19e
--- /dev/null
+++ b/lisp/jabber-buffer-registry.el
@@ -0,0 +1,69 @@
+;;; jabber-buffer-registry.el --- Chat buffer lookup registry -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2026 Thanos Apollo
+
+;; Maintainer: Thanos Apollo <[email protected]>
+
+;; This file is a part of jabber.el.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+;;; Commentary:
+
+;; Provides lookup by chat kind without depending on chat rendering modules.
+
+;;; Code:
+
+(defvar jabber-buffer-registry--buffers (make-hash-table :test #'equal)
+ "Hash table mapping chat kinds and peer keys to live buffers.")
+
+(defvar-local jabber-buffer-registry--keys nil
+ "Registry keys owned by the current buffer.")
+
+(defun jabber-buffer-registry--key (kind peer)
+ "Return the registry key for chat KIND and PEER."
+ (cons kind peer))
+
+(defun jabber-buffer-registry--remove-current ()
+ "Remove registry entries owned by the current buffer."
+ (dolist (key jabber-buffer-registry--keys)
+ (when (eq (gethash key jabber-buffer-registry--buffers)
+ (current-buffer))
+ (remhash key jabber-buffer-registry--buffers)))
+ (setq jabber-buffer-registry--keys nil))
+
+(defun jabber-buffer-registry-register (kind peer &optional buffer)
+ "Register BUFFER under chat KIND and PEER.
+BUFFER defaults to the current buffer."
+ (with-current-buffer (or buffer (current-buffer))
+ (let ((key (jabber-buffer-registry--key kind peer)))
+ (puthash key (current-buffer) jabber-buffer-registry--buffers)
+ (unless (member key jabber-buffer-registry--keys)
+ (push key jabber-buffer-registry--keys))
+ (add-hook 'kill-buffer-hook
+ #'jabber-buffer-registry--remove-current nil t)
+ (current-buffer))))
+
+(defun jabber-buffer-registry-find (kind peer)
+ "Return the live buffer registered under chat KIND and PEER."
+ (let* ((key (jabber-buffer-registry--key kind peer))
+ (buffer (gethash key jabber-buffer-registry--buffers)))
+ (if (buffer-live-p buffer)
+ buffer
+ (remhash key jabber-buffer-registry--buffers)
+ nil)))
+
+(provide 'jabber-buffer-registry)
+;;; jabber-buffer-registry.el ends here
diff --git a/lisp/jabber-chat.el b/lisp/jabber-chat.el
index ea85a0cb46..d0df6c5742 100644
--- a/lisp/jabber-chat.el
+++ b/lisp/jabber-chat.el
@@ -28,6 +28,7 @@
(require 'jabber-core)
(require 'jabber-alert)
+(require 'jabber-buffer-registry)
(require 'jabber-chatbuffer)
(require 'jabber-db)
(require 'jabber-reactions)
@@ -363,7 +364,7 @@ or `get-buffer-create'."
(defun jabber-chat-find-buffer (chat-with)
"Find an existing 1:1 chat buffer for CHAT-WITH, or nil."
- (jabber-chatbuffer--registry-get 'chat (jabber-jid-user chat-with)))
+ (jabber-buffer-registry-find 'chat (jabber-jid-user chat-with)))
(defun jabber-chat-create-buffer (jc chat-with)
"Prepare a buffer for chatting with CHAT-WITH.
@@ -374,7 +375,7 @@ JC is the Jabber connection."
(jabber-chat-mode)
(setq-local jabber-chatting-with chat-with)
- (jabber-chatbuffer--registry-put 'chat (jabber-jid-user chat-with))
+ (jabber-buffer-registry-register 'chat (jabber-jid-user chat-with))
(jabber-chat-mode-setup jc #'jabber-chat-pp)
(setq jabber-send-function #'jabber-chat-send)
diff --git a/lisp/jabber-chatbuffer.el b/lisp/jabber-chatbuffer.el
index 7b4a0f9caa..081fa04abe 100644
--- a/lisp/jabber-chatbuffer.el
+++ b/lisp/jabber-chatbuffer.el
@@ -27,6 +27,7 @@
;;; Code:
(require 'jabber-util)
+(require 'jabber-buffer-registry)
(require 'jabber-input)
(require 'jabber-core)
(require 'jabber-db)
@@ -107,43 +108,6 @@ previous sequence detect the mismatch and stop.")
(defvar jabber-group) ; jabber-muc.el
(defvar jabber-muc-header-line-format) ; jabber-muc.el
-;;; Buffer lookup registry
-
-(defvar jabber-chatbuffer--registry (make-hash-table :test #'equal)
- "Hash table mapping (TYPE . KEY) to a live buffer.
-TYPE is `chat', `muc', or `muc-private'.
-KEY: bare JID for chat; group JID for muc; \"group/nick\" for muc-private.")
-
-(defun jabber-chatbuffer--registry-put (type key)
- "Register current buffer under TYPE and KEY."
- (puthash (cons type key) (current-buffer) jabber-chatbuffer--registry))
-
-(defun jabber-chatbuffer--registry-get (type key)
- "Return the live buffer registered under TYPE and KEY, or nil."
- (let* ((k (cons type key))
- (buf (gethash k jabber-chatbuffer--registry)))
- (if (buffer-live-p buf)
- buf
- (remhash k jabber-chatbuffer--registry)
- nil)))
-
-(defun jabber-chatbuffer--registry-remove ()
- "Remove current buffer from registry. Used as `kill-buffer-hook'."
- (cond
- ((and (local-variable-p 'jabber-group) jabber-group)
- (remhash (cons 'muc jabber-group) jabber-chatbuffer--registry))
- ((and (local-variable-p 'jabber-chatting-with) jabber-chatting-with)
- ;; MUC-private: jabber-chatting-with is "group/nick" (has resource).
- ;; 1:1 chat: jabber-chatting-with may be full JID or bare — always
- ;; normalise to bare JID to match the key stored at registration time.
- (if (jabber-jid-resource jabber-chatting-with)
- (remhash (cons 'muc-private jabber-chatting-with)
- jabber-chatbuffer--registry)
- (remhash (cons 'chat (jabber-jid-user jabber-chatting-with))
- jabber-chatbuffer--registry)))))
-
-(add-hook 'kill-buffer-hook #'jabber-chatbuffer--registry-remove)
-
(defcustom jabber-chat-default-encryption 'omemo
"Default encryption mode for new chat buffers."
:type '(choice (const :tag "OMEMO" omemo)
@@ -357,8 +321,6 @@ EWOC-PP is the pretty-printer function for the message
EWOC."
(setq jabber-chat-encryption 'plaintext))))
(jabber-chat-encryption--update-header))
-(declare-function jabber-chat-find-buffer "jabber-chat" (chat-with))
-(declare-function jabber-muc-find-buffer "jabber-muc" (group))
(declare-function jabber-chat-insert-backlog-entry "jabber-chat"
(msg-plist))
(declare-function jabber-chat--insert-backlog-chunked "jabber-chat"
@@ -676,9 +638,8 @@ reload, so a reader scrolled up in history is not yanked to
the top."
"Update syncing indicator for PEER's chat buffer.
TYPE is \"groupchat\" or \"chat\". SYNCING-P is non-nil when
sync starts, nil when it ends."
- (when-let* ((buffer (if (string= type "groupchat")
- (jabber-muc-find-buffer peer)
- (jabber-chat-find-buffer peer)))
+ (when-let* ((kind (if (string= type "groupchat") 'muc 'chat))
+ (buffer (jabber-buffer-registry-find kind peer))
((buffer-live-p buffer)))
(with-current-buffer buffer
(setq jabber-chat-mam-syncing syncing-p)
@@ -692,9 +653,8 @@ PEERS is a list of (PEER . TYPE) pairs."
(dolist (entry peers)
(let* ((peer (car entry))
(type (cdr entry))
- (buffer (if (string= type "groupchat")
- (jabber-muc-find-buffer peer)
- (jabber-chat-find-buffer peer))))
+ (kind (if (string= type "groupchat") 'muc 'chat))
+ (buffer (jabber-buffer-registry-find kind peer)))
(when (and buffer (buffer-live-p buffer))
(with-current-buffer buffer
(jabber-chat-buffer-refresh))))))
diff --git a/lisp/jabber-muc.el b/lisp/jabber-muc.el
index b032a58df2..7677ae8e86 100644
--- a/lisp/jabber-muc.el
+++ b/lisp/jabber-muc.el
@@ -31,6 +31,7 @@
(require 'cl-lib)
(require 'ewoc)
(require 'jabber-widget)
+(require 'jabber-buffer-registry)
(require 'jabber-disco)
(require 'jabber-muc-protocol)
(require 'jabber-muc-state)
@@ -280,7 +281,7 @@ or `get-buffer-create'."
(defun jabber-muc-find-buffer (group)
"Find an existing MUC buffer for GROUP, or nil."
- (jabber-chatbuffer--registry-get 'muc group))
+ (jabber-buffer-registry-find 'muc group))
(defun jabber-muc-create-buffer (jc group)
"Prepare a buffer for chatroom GROUP.
@@ -319,7 +320,7 @@ JC is the Jabber connection."
;; Make sure the connection variable is up to date.
(setq jabber-buffer-connection jc)
- (jabber-chatbuffer--registry-put 'muc group)
+ (jabber-buffer-registry-register 'muc group)
(current-buffer)))
@@ -339,7 +340,7 @@ or `get-buffer-create'."
(defun jabber-muc-private-find-buffer (group nickname)
"Find an existing MUC private buffer for GROUP/NICKNAME, or nil."
- (jabber-chatbuffer--registry-get 'muc-private (format "%s/%s" group
nickname)))
+ (jabber-buffer-registry-find 'muc-private (format "%s/%s" group nickname)))
(defun jabber-muc-private-create-buffer (jc group nickname)
"Prepare a buffer for chatting with NICKNAME in GROUP.
@@ -363,7 +364,7 @@ JC is the Jabber connection."
(jabber-chat-encryption--update-header)))
(setq-local jabber-chatting-with (concat group "/" nickname))
- (jabber-chatbuffer--registry-put 'muc-private (format "%s/%s" group
nickname))
+ (jabber-buffer-registry-register 'muc-private (format "%s/%s" group
nickname))
(setq jabber-send-function #'jabber-chat-send)
(setq header-line-format jabber-muc-private-header-line-format)
diff --git a/tests/jabber-test-chatbuffer.el b/tests/jabber-test-chatbuffer.el
index 6d60851173..0ace6e08fb 100644
--- a/tests/jabber-test-chatbuffer.el
+++ b/tests/jabber-test-chatbuffer.el
@@ -441,75 +441,74 @@
;;; Group 8: Buffer lookup registry
(ert-deftest jabber-test-chatbuffer-registry-chat-find ()
- "Register a temp buffer as a chat buffer; registry-get returns it."
- (let ((jabber-chatbuffer--registry (make-hash-table :test #'equal)))
+ "Register a temp buffer as a chat buffer and find it."
+ (let ((jabber-buffer-registry--buffers (make-hash-table :test #'equal)))
(with-temp-buffer
- (setq-local jabber-chatting-with "[email protected]")
- (jabber-chatbuffer--registry-put 'chat "[email protected]")
+ (jabber-buffer-registry-register 'chat "[email protected]")
(should (eq (current-buffer)
- (jabber-chatbuffer--registry-get 'chat
"[email protected]"))))))
+ (jabber-buffer-registry-find 'chat "[email protected]"))))))
(ert-deftest jabber-test-chatbuffer-registry-kill-removes-entry ()
"Killing the buffer removes its registry entry."
- (let ((jabber-chatbuffer--registry (make-hash-table :test #'equal)))
+ (let ((jabber-buffer-registry--buffers (make-hash-table :test #'equal)))
(let ((buf (generate-new-buffer " *test-chat-registry*")))
(with-current-buffer buf
- (setq-local jabber-chatting-with "[email protected]")
- (jabber-chatbuffer--registry-put 'chat "[email protected]"))
- (should (eq buf (jabber-chatbuffer--registry-get 'chat
"[email protected]")))
+ (jabber-buffer-registry-register 'chat "[email protected]"))
+ (should (eq buf (jabber-buffer-registry-find 'chat "[email protected]")))
(kill-buffer buf)
- ;; The kill-buffer-hook removed it; get now returns nil.
- (should-not (jabber-chatbuffer--registry-get 'chat
"[email protected]")))))
+ (should-not (jabber-buffer-registry-find 'chat "[email protected]")))))
(ert-deftest jabber-test-chatbuffer-registry-no-collision ()
"MUC and chat buffers with the same bare JID do not collide."
- (let ((jabber-chatbuffer--registry (make-hash-table :test #'equal)))
+ (let ((jabber-buffer-registry--buffers (make-hash-table :test #'equal)))
(let ((chat-buf (generate-new-buffer " *test-chat*"))
(muc-buf (generate-new-buffer " *test-muc*")))
(unwind-protect
(progn
(with-current-buffer chat-buf
- (setq-local jabber-chatting-with "[email protected]")
- (jabber-chatbuffer--registry-put 'chat "[email protected]"))
+ (jabber-buffer-registry-register 'chat "[email protected]"))
(with-current-buffer muc-buf
- (setq-local jabber-group "[email protected]")
- (jabber-chatbuffer--registry-put 'muc "[email protected]"))
+ (jabber-buffer-registry-register 'muc "[email protected]"))
(should (eq chat-buf
- (jabber-chatbuffer--registry-get 'chat
"[email protected]")))
+ (jabber-buffer-registry-find
+ 'chat "[email protected]")))
(should (eq muc-buf
- (jabber-chatbuffer--registry-get 'muc
"[email protected]"))))
+ (jabber-buffer-registry-find
+ 'muc "[email protected]"))))
(kill-buffer chat-buf)
(kill-buffer muc-buf)))))
(ert-deftest jabber-test-chatbuffer-registry-muc-private ()
"MUC-private lookup by group+nick returns correct buffer."
- (let ((jabber-chatbuffer--registry (make-hash-table :test #'equal)))
+ (let ((jabber-buffer-registry--buffers (make-hash-table :test #'equal)))
(let ((buf (generate-new-buffer " *test-muc-private*")))
(unwind-protect
(progn
(with-current-buffer buf
- (setq-local jabber-chatting-with "[email protected]/alice")
- (jabber-chatbuffer--registry-put
+ (jabber-buffer-registry-register
'muc-private "[email protected]/alice"))
(should (eq buf
- (jabber-chatbuffer--registry-get
+ (jabber-buffer-registry-find
'muc-private "[email protected]/alice"))))
(kill-buffer buf)))))
-(ert-deftest jabber-test-chatbuffer-registry-kill-full-jid-removes-bare-key ()
- "kill-buffer-hook cleans up bare-JID key when chatting-with is a full JID."
- (let ((jabber-chatbuffer--registry (make-hash-table :test #'equal)))
- (let ((buf (generate-new-buffer " *test-chat-full-jid*")))
- (with-current-buffer buf
- ;; Registered with bare JID (as jabber-chat-create-buffer does).
- (setq-local jabber-chatting-with "[email protected]/phone")
- (jabber-chatbuffer--registry-put 'chat "[email protected]"))
- ;; At this point the registry holds bare key.
- (should (eq buf (jabber-chatbuffer--registry-get 'chat
"[email protected]")))
- ;; jabber-chatting-with has a resource — kill-hook should still remove
- ;; the bare-JID key because it normalises via jabber-jid-user.
- (kill-buffer buf)
- (should-not (jabber-chatbuffer--registry-get 'chat
"[email protected]")))))
+(ert-deftest jabber-test-chatbuffer-registry-replacement-survives-old-kill ()
+ "Killing a replaced buffer does not remove the current registration."
+ (let ((jabber-buffer-registry--buffers (make-hash-table :test #'equal))
+ (old (generate-new-buffer " *test-chat-old*"))
+ (new (generate-new-buffer " *test-chat-new*")))
+ (unwind-protect
+ (progn
+ (jabber-buffer-registry-register 'chat "[email protected]" old)
+ (jabber-buffer-registry-register 'chat "[email protected]" new)
+ (kill-buffer old)
+ (should (eq new
+ (jabber-buffer-registry-find
+ 'chat "[email protected]"))))
+ (when (buffer-live-p old)
+ (kill-buffer old))
+ (when (buffer-live-p new)
+ (kill-buffer new)))))
;;; Group 9: OMEMO immediate display status transitions
