From 29a4eda586a9fc07b64d05bbdfee5f31674819b7 Mon Sep 17 00:00:00 2001 From: defanor Date: Tue, 7 Sep 2021 18:19:52 +0300 Subject: Improve xmpp.el presence and message notifications Now tracking-mode is used, and presence changes are printed in conversation buffers. --- emacs/xmpp.el | 86 ++++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 53 insertions(+), 33 deletions(-) diff --git a/emacs/xmpp.el b/emacs/xmpp.el index 2eaeb38..a0ee75b 100644 --- a/emacs/xmpp.el +++ b/emacs/xmpp.el @@ -36,7 +36,7 @@ (require 'xml) (require 'seq) -(require 'alert) +(require 'tracking) (defvar xmpp-command "rexmpp_xml_interface" "A command to run an XMPP client subprocess.") @@ -82,8 +82,8 @@ "The buffer size at which to truncate an XMPP-related buffer by approximately halving it.") -(defun xmpp-message-notify () - (alert (concat "A new message in " (buffer-name)) :category "xmpp")) +(defun xmpp-activity-notify () + (tracking-add-buffer (current-buffer))) (defun xmpp-jid-to-bare (jid) (let* ((jid-list (reverse (string-to-list jid))) @@ -139,7 +139,22 @@ (with-current-buffer xmpp-xml-buffer (xmpp-insert (format "\n" (current-time-string))) (xmpp-insert-xml (list xml)) - (xmpp-insert "\n"))) + (xmpp-insert "\n")) + (when (eq (xml-node-name xml) 'presence) + (let* ((presence-from (xml-get-attribute-or-nil xml 'from)) + (presence-type (or (xml-get-attribute-or-nil xml 'type) "available")) + (bare-jid (xmpp-jid-to-bare presence-from)) + (resourcepart (xmpp-jid-resource presence-from))) + (when (assoc bare-jid xmpp-query-buffers) + (with-current-buffer (cdr (assoc bare-jid xmpp-query-buffers)) + (xmpp-insert + (concat (format-time-string xmpp-timestamp-format) ", " + presence-from " is " presence-type "\n")))) + (when (assoc bare-jid xmpp-muc-buffers) + (with-current-buffer (cdr (assoc bare-jid xmpp-muc-buffers)) + (xmpp-insert + (concat (format-time-string xmpp-timestamp-format) ", " + resourcepart " is " presence-type "\n"))))))) (when (eq (xml-node-name xml) 'message) (xmpp-with-message-body proc xml @@ -156,7 +171,7 @@ (concat (format-time-string xmpp-timestamp-format) ", " message-from-name ": " (car (xml-node-children message-body)) "\n")) - (xmpp-message-notify)))) + (xmpp-activity-notify)))) ("groupchat" (when message-body (with-current-buffer (xmpp-muc-buffer message-from proc) @@ -164,7 +179,7 @@ (concat (format-time-string xmpp-timestamp-format) ", " (xmpp-jid-resource message-from) ": " (car (xml-node-children message-body)) "\n")) - (xmpp-message-notify)))))))))))) + (xmpp-activity-notify)))))))))))) (defun xmpp-set-from (proc xml) (let* ((name (xml-node-name xml)) @@ -400,19 +415,22 @@ (let ((process (or proc xmpp-proc)) (bare-jid (xmpp-jid-to-bare jid))) (with-current-buffer (process-buffer process) - (if (assoc bare-jid xmpp-query-buffers) - (cdr (assoc bare-jid xmpp-query-buffers)) - (let ((query-buf (generate-new-buffer (concat "*xmpp:" bare-jid "*")))) - (with-current-buffer query-buf - (xmpp-query-mode) - (setq-local xmpp-jid bare-jid) - (setq-local xmpp-proc process) - (setq-local kill-buffer-query-functions - (cons #'xmpp-query-buffer-on-close - kill-buffer-query-functions))) - (push (cons bare-jid query-buf) xmpp-query-buffers) - (display-buffer query-buf) - query-buf))))) + (let ((buf (if (assoc bare-jid xmpp-query-buffers) + (cdr (assoc bare-jid xmpp-query-buffers)) + (let ((query-buf (generate-new-buffer + (concat "*xmpp:" bare-jid "*")))) + (with-current-buffer query-buf + (xmpp-query-mode) + (setq-local xmpp-jid bare-jid) + (setq-local xmpp-proc process) + (setq-local kill-buffer-query-functions + (cons #'xmpp-query-buffer-on-close + kill-buffer-query-functions))) + (push (cons bare-jid query-buf) xmpp-query-buffers) + query-buf)))) + (when (interactive-p) + (display-buffer buf)) + buf)))) (defun xmpp-muc-join (jid &optional nick proc) (interactive "sConference JID: ") @@ -441,21 +459,23 @@ (defun xmpp-muc-buffer (jid &optional proc) (let* ((process (or proc xmpp-proc)) - (bare-jid (xmpp-jid-to-bare jid))) + (bare-jid (xmpp-jid-to-bare jid))) (with-current-buffer (process-buffer process) - (if (assoc bare-jid xmpp-muc-buffers) - (cdr (assoc bare-jid xmpp-muc-buffers)) - (let ((muc-buf (generate-new-buffer (concat "*xmpp:" bare-jid "*")))) - (with-current-buffer muc-buf - (xmpp-muc-mode) - (setq-local xmpp-jid bare-jid) - (setq-local xmpp-proc process) - (setq-local kill-buffer-query-functions - (cons #'xmpp-muc-buffer-on-close - kill-buffer-query-functions))) - (push (cons bare-jid muc-buf) xmpp-muc-buffers) - (display-buffer muc-buf) - muc-buf))))) + (let ((buf (if (assoc bare-jid xmpp-muc-buffers) + (cdr (assoc bare-jid xmpp-muc-buffers)) + (let ((muc-buf (generate-new-buffer (concat "*xmpp:" bare-jid "*")))) + (with-current-buffer muc-buf + (xmpp-muc-mode) + (setq-local xmpp-jid bare-jid) + (setq-local xmpp-proc process) + (setq-local kill-buffer-query-functions + (cons #'xmpp-muc-buffer-on-close + kill-buffer-query-functions))) + (push (cons bare-jid muc-buf) xmpp-muc-buffers) + muc-buf)))) + (when (interactive-p) + (display-buffer buf)) + buf)))) (provide 'xmpp) -- cgit v1.2.3