branch: elpa/jabber
commit e091b0d20dcb5538baf6597d33ede90743ce8af8
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
presence: Separate effect handlers
---
lisp/jabber-muc.el | 3 ++
lisp/jabber-presence-events.el | 64 ++++++++++++++++++++++++++
lisp/jabber-presence.el | 82 ++++------------------------------
lisp/jabber-roster.el | 3 ++
lisp/jabber-subscription.el | 99 +++++++++++++++++++++++++++++++++++++++++
lisp/jabber.el | 1 +
tests/jabber-test-chatbuffer.el | 28 ++++++++++++
7 files changed, 206 insertions(+), 74 deletions(-)
diff --git a/lisp/jabber-muc.el b/lisp/jabber-muc.el
index 7677ae8e86..f74758a58f 100644
--- a/lisp/jabber-muc.el
+++ b/lisp/jabber-muc.el
@@ -35,6 +35,7 @@
(require 'jabber-disco)
(require 'jabber-muc-protocol)
(require 'jabber-muc-state)
+(require 'jabber-presence-events)
(require 'jabber-bookmarks)
(require 'jabber-chat)
(require 'jabber-db)
@@ -1906,5 +1907,7 @@ Accesses `jabber-pending-groupchats' to determine our
nickname."
x-muc actor reason our-nickname)))))
(jabber-disco-advertise-feature jabber-muc-xmlns-direct-invite)
+(add-hook 'jabber-presence-muc-functions #'jabber-muc-process-presence)
+
(provide 'jabber-muc)
;;; jabber-muc.el ends here.
diff --git a/lisp/jabber-presence-events.el b/lisp/jabber-presence-events.el
new file mode 100644
index 0000000000..ac0e09404f
--- /dev/null
+++ b/lisp/jabber-presence-events.el
@@ -0,0 +1,64 @@
+;;; jabber-presence-events.el --- Presence effect dispatch -*-
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:
+
+;; Keeps presence parsing independent from roster, chat, and MUC effects.
+
+;;; Code:
+
+(defvar jabber-presence-roster-update-functions nil
+ "Functions called with a parsed roster update.
+Arguments are connection, new items, changed items, and deleted items.")
+
+(defvar jabber-presence-muc-functions nil
+ "Functions called with a connection and an incoming MUC presence stanza.")
+
+(defvar jabber-presence-contact-functions nil
+ "Functions called with a connection and ordinary presence sender.")
+
+(defvar jabber-presence-subscription-request-functions nil
+ "Functions called with a connection, sender, and subscription status.")
+
+(defun jabber-presence-events-dispatch-roster-update
+ (jc new-items changed-items deleted-items)
+ "Dispatch a roster update for JC.
+NEW-ITEMS, CHANGED-ITEMS, and DELETED-ITEMS are JID symbol lists."
+ (run-hook-with-args 'jabber-presence-roster-update-functions
+ jc new-items changed-items deleted-items))
+
+(defun jabber-presence-events-dispatch-muc (jc presence)
+ "Dispatch an incoming MUC PRESENCE stanza on JC."
+ (run-hook-with-args 'jabber-presence-muc-functions jc presence))
+
+(defun jabber-presence-events-dispatch-contact (jc from)
+ "Dispatch ordinary presence from FROM on JC."
+ (run-hook-with-args 'jabber-presence-contact-functions jc from))
+
+(defun jabber-presence-events-dispatch-subscription-request
+ (jc from presence-status)
+ "Dispatch a subscription request from FROM on JC with PRESENCE-STATUS."
+ (run-hook-with-args 'jabber-presence-subscription-request-functions
+ jc from presence-status))
+
+(provide 'jabber-presence-events)
+;;; jabber-presence-events.el ends here
diff --git a/lisp/jabber-presence.el b/lisp/jabber-presence.el
index 58a3ed71ee..e122065e1b 100644
--- a/lisp/jabber-presence.el
+++ b/lisp/jabber-presence.el
@@ -34,7 +34,7 @@
(require 'jabber-util)
(require 'jabber-muc-protocol)
(require 'jabber-muc-state)
-(require 'ewoc)
+(require 'jabber-presence-events)
(defconst jabber-presence-show-alist
'(("Online" . "")
@@ -56,19 +56,6 @@ stanza.")
(defvar jabber-presence-sent-hooks nil
"List of functions called after presence messages are sent.")
-;; Global reference declarations
-
-(declare-function jabber-roster-update "jabber-roster.el"
- (jc new-items changed-items deleted-items))
-(declare-function jabber-chat-create-buffer "jabber-chat.el" (jc chat-with))
-(declare-function jabber-chat-ewoc-enter "jabber-chatbuffer.el" (data))
-(declare-function jabber-chat-ewoc-delete "jabber-chatbuffer" (node))
-(declare-function jabber-chat-get-buffer "jabber-chat.el" (chat-with &optional
jc))
-(declare-function jabber-muc-get-buffer "jabber-muc.el" (group &optional jc))
-(declare-function jabber-muc-process-presence "jabber-muc.el" (jc presence))
-(defvar jabber-chatting-with) ; jabber-chat.el
-(defvar jabber-buffer-connection) ; jabber-chatbuffer.el
-(defvar jabber-chat-ewoc) ; jabber-chatbuffer.el
(defvar jabber-current-show) ; jabber.el
(defvar jabber-current-status) ; jabber.el
(defvar jabber-current-priority) ; jabber.el
@@ -143,7 +130,8 @@ obtained from `xml-parse-region'."
(`(new . ,sym) (push sym new-items))
(`(changed . ,sym) (push sym changed-items))
(`(deleted . ,sym) (push sym deleted-items))))
- (jabber-roster-update jc new-items changed-items deleted-items)
+ (jabber-presence-events-dispatch-roster-update
+ jc new-items changed-items deleted-items)
(when (and id (string= type "set"))
(jabber-send-iq jc nil "result" nil nil nil nil nil id)))
(when initialp
@@ -262,22 +250,21 @@ Runs `jabber-presence-hooks' and
`jabber-alert-presence-hooks'."
JC is the Jabber connection.
XML-DATA is the parsed tree data from the stream (stanzas)
obtained from `xml-parse-region'."
- ;; XXX: use JC argument
(let* ((roster (plist-get (fsm-get-state-data jc) :roster))
(from (jabber-xml-get-attribute xml-data 'from))
(type (jabber-xml-get-attribute xml-data 'type))
(metadata (jabber-presence--extract-metadata xml-data)))
(cond
((string= type "subscribe")
- (run-with-idle-timer 0.01 nil #'jabber-process-subscription-request
- jc from (plist-get metadata :status)))
+ (run-with-idle-timer
+ 0.01 nil #'jabber-presence-events-dispatch-subscription-request
+ jc from (plist-get metadata :status)))
((jabber-muc-presence-p xml-data)
- (jabber-muc-process-presence jc xml-data))
+ (jabber-presence-events-dispatch-muc jc xml-data))
(t
- ;; Clean up any stale subscription request prompts for this JID.
- (jabber-subscription--remove-stale jc from)
+ (jabber-presence-events-dispatch-contact jc from)
;; XXX: Think about what to do about out-of-roster presences.
(let ((buddy (jabber-jid-symbol from)))
(when (memq buddy roster)
@@ -304,59 +291,6 @@ obtained from `xml-parse-region'."
buddy oldstatus newstatus
(plist-get resource-plist 'status)))))))))
-(defun jabber-process-subscription-request (jc from presence-status)
- "Process an incoming subscription request from FROM with PRESENCE-STATUS.
-JC is the Jabber connection."
- (with-current-buffer (jabber-chat-create-buffer jc from)
- (jabber-chat-ewoc-enter (list :subscription-request presence-status :time
(current-time)))
-
- (dolist (hook '(jabber-presence-hooks jabber-alert-presence-hooks))
- (run-hook-with-args hook (jabber-jid-symbol from) nil "subscribe"
presence-status (funcall jabber-alert-presence-message-function
(jabber-jid-symbol from) nil "subscribe" presence-status)))))
-
-(defun jabber-subscription-accept-mutual (&rest _ignored)
- "Accept the pending subscription request and request reciprocal
subscription."
- (message "Subscription accepted; reciprocal subscription request sent")
- (jabber-subscription-reply "subscribed" "subscribe"))
-
-(defun jabber-subscription-accept-one-way (&rest _ignored)
- "Accept the pending subscription request without reciprocating."
- (message "Subscription accepted")
- (jabber-subscription-reply "subscribed"))
-
-(defun jabber-subscription-decline (&rest _ignored)
- "Decline the pending subscription request."
- (message "Subscription declined")
- (jabber-subscription-reply "unsubscribed"))
-
-(defun jabber-subscription--remove-prompt ()
- "Remove the subscription request EWOC node at point."
- (when (bound-and-true-p jabber-chat-ewoc)
- (let ((node (ewoc-locate jabber-chat-ewoc)))
- (when (and node (eq :subscription-request (car (ewoc-data node))))
- (jabber-chat-ewoc-delete node)))))
-
-(defun jabber-subscription--remove-stale (jc from)
- "Remove all subscription request nodes from FROM's chat buffer.
-JC is the Jabber connection."
- (when-let* ((buf (get-buffer (jabber-chat-get-buffer from jc))))
- (with-current-buffer buf
- (when (bound-and-true-p jabber-chat-ewoc)
- (let ((node (ewoc-nth jabber-chat-ewoc 0))
- to-delete)
- (while node
- (when (eq :subscription-request (car (ewoc-data node)))
- (push node to-delete))
- (setq node (ewoc-next jabber-chat-ewoc node)))
- (dolist (n to-delete)
- (jabber-chat-ewoc-delete n)))))))
-
-(defun jabber-subscription-reply (&rest types)
- "Send one presence stanza per TYPES (e.g. \"subscribed\") to the current
peer."
- (let ((to (jabber-jid-user jabber-chatting-with)))
- (dolist (type types)
- (jabber-send-sexp jabber-buffer-connection `(presence ((to . ,to) (type
. ,type))))))
- (jabber-subscription--remove-prompt))
-
(defun jabber-prioritize-resources (buddy)
"Set connected, show and status properties for BUDDY.
Show status properties from highest-priority resource."
diff --git a/lisp/jabber-roster.el b/lisp/jabber-roster.el
index 92c29c8962..7306c5c548 100644
--- a/lisp/jabber-roster.el
+++ b/lisp/jabber-roster.el
@@ -29,6 +29,7 @@
;;; Code:
(require 'cl-lib)
+(require 'jabber-presence-events)
(require 'jabber-util)
(require 'jabber-private)
@@ -226,6 +227,8 @@ obtained from `xml-parse-region'."
'jabber-report-success "Roster groups saved"
'jabber-report-success "Failed to save roster
groups"))))
+(add-hook 'jabber-presence-roster-update-functions #'jabber-roster-update)
+
(provide 'jabber-roster)
;;; jabber-roster.el ends here
diff --git a/lisp/jabber-subscription.el b/lisp/jabber-subscription.el
new file mode 100644
index 0000000000..3f37e0dc79
--- /dev/null
+++ b/lisp/jabber-subscription.el
@@ -0,0 +1,99 @@
+;;; jabber-subscription.el --- Presence subscription UI -*- 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:
+
+;; Displays subscription requests in chat buffers and handles replies.
+
+;;; Code:
+
+(require 'ewoc)
+(require 'jabber-alert)
+(require 'jabber-buffer-registry)
+(require 'jabber-chat)
+(require 'jabber-chatbuffer)
+(require 'jabber-presence-events)
+(require 'jabber-util)
+
+(defun jabber-process-subscription-request (jc from presence-status)
+ "Display a subscription request from FROM on JC with PRESENCE-STATUS."
+ (with-current-buffer (jabber-chat-create-buffer jc from)
+ (jabber-chat-ewoc-enter
+ (list :subscription-request presence-status :time (current-time)))
+ (dolist (hook '(jabber-presence-hooks jabber-alert-presence-hooks))
+ (run-hook-with-args
+ hook (jabber-jid-symbol from) nil "subscribe" presence-status
+ (funcall jabber-alert-presence-message-function
+ (jabber-jid-symbol from) nil "subscribe" presence-status)))))
+
+(defun jabber-subscription-accept-mutual (&rest _ignored)
+ "Accept the pending request and request a reciprocal subscription."
+ (message "Subscription accepted; reciprocal subscription request sent")
+ (jabber-subscription-reply "subscribed" "subscribe"))
+
+(defun jabber-subscription-accept-one-way (&rest _ignored)
+ "Accept the pending subscription request without reciprocating."
+ (message "Subscription accepted")
+ (jabber-subscription-reply "subscribed"))
+
+(defun jabber-subscription-decline (&rest _ignored)
+ "Decline the pending subscription request."
+ (message "Subscription declined")
+ (jabber-subscription-reply "unsubscribed"))
+
+(defun jabber-subscription--remove-prompt ()
+ "Remove the subscription request EWOC node at point."
+ (when (bound-and-true-p jabber-chat-ewoc)
+ (let ((node (ewoc-locate jabber-chat-ewoc)))
+ (when (and node (eq :subscription-request (car (ewoc-data node))))
+ (jabber-chat-ewoc-delete node)))))
+
+(defun jabber-subscription--remove-stale (_jc from)
+ "Remove all subscription request nodes from FROM's chat buffer."
+ (when-let* ((buffer (jabber-buffer-registry-find
+ 'chat (jabber-jid-user from))))
+ (with-current-buffer buffer
+ (when (bound-and-true-p jabber-chat-ewoc)
+ (let ((node (ewoc-nth jabber-chat-ewoc 0))
+ to-delete)
+ (while node
+ (when (eq :subscription-request (car (ewoc-data node)))
+ (push node to-delete))
+ (setq node (ewoc-next jabber-chat-ewoc node)))
+ (mapc #'jabber-chat-ewoc-delete to-delete))))))
+
+(defun jabber-subscription-reply (&rest types)
+ "Send one presence stanza per TYPES to the current peer."
+ (let ((to (jabber-jid-user jabber-chatting-with)))
+ (dolist (type types)
+ (jabber-send-sexp
+ jabber-buffer-connection
+ `(presence ((to . ,to) (type . ,type))))))
+ (jabber-subscription--remove-prompt))
+
+(add-hook 'jabber-presence-contact-functions
+ #'jabber-subscription--remove-stale)
+(add-hook 'jabber-presence-subscription-request-functions
+ #'jabber-process-subscription-request)
+
+(provide 'jabber-subscription)
+;;; jabber-subscription.el ends here
diff --git a/lisp/jabber.el b/lisp/jabber.el
index 1d3bd05d64..b5c403d353 100644
--- a/lisp/jabber.el
+++ b/lisp/jabber.el
@@ -164,6 +164,7 @@ One disabled account with a non-standard port:
(require 'jabber-presence)
(require 'jabber-alert)
(require 'jabber-chat)
+(require 'jabber-subscription)
(require 'jabber-db)
(require 'jabber-disco)
(require 'jabber-iq)
diff --git a/tests/jabber-test-chatbuffer.el b/tests/jabber-test-chatbuffer.el
index 0ace6e08fb..111fe7263d 100644
--- a/tests/jabber-test-chatbuffer.el
+++ b/tests/jabber-test-chatbuffer.el
@@ -14,6 +14,7 @@
(require 'jabber-chat-commands)
(require 'jabber-db)
(require 'jabber-httpupload)
+(require 'jabber-subscription)
;; jabber-chat requires this via jabber-muc
(defvar jabber-muc-xmlns-user "http://jabber.org/protocol/muc#user";)
@@ -510,6 +511,33 @@
(when (buffer-live-p new)
(kill-buffer new)))))
+(ert-deftest jabber-test-subscription-removes-stale-prompts-from-chat ()
+ "Ordinary presence removes old subscription prompts for its sender."
+ (let ((jabber-buffer-registry--buffers (make-hash-table :test #'equal)))
+ (jabber-test-chatbuffer-with-ewoc
+ (jabber-buffer-registry-register 'chat "[email protected]")
+ (jabber-chat-ewoc-enter '(:subscription-request "hello"))
+ (jabber-chat-ewoc-enter '(:notice "keep me"))
+ (jabber-subscription--remove-stale nil "[email protected]/phone")
+ (should (equal (ewoc-collect jabber-chat-ewoc #'identity)
+ '((:notice "keep me")))))))
+
+(ert-deftest jabber-test-subscription-request-enters-chat-buffer ()
+ "A subscription request is rendered in the sender's chat buffer."
+ (with-temp-buffer
+ (let ((buffer (current-buffer))
+ entered)
+ (cl-letf (((symbol-function 'jabber-chat-create-buffer)
+ (lambda (_jc _from) buffer))
+ ((symbol-function 'jabber-chat-ewoc-enter)
+ (lambda (data) (setq entered data))))
+ (let ((jabber-presence-hooks nil)
+ (jabber-alert-presence-hooks nil))
+ (jabber-process-subscription-request
+ 'fake-jc "[email protected]" "please")))
+ (should (equal (plist-get entered :subscription-request) "please"))
+ (should (plist-get entered :time)))))
+
;;; Group 9: OMEMO immediate display status transitions
(defvar jabber-muc-printers)
