Merge pull request 'Tame MUC presence notifications.' (legoscia#10) f…

…rom hdasch/emacs-jabber:tame-muc-presence into production Enable MUC presence announcement customization. No objections raised on xmpp:[email protected]. Seems ready. Reviewed-on: https://codeberg.org/emacs-jabber/emacs-jabber/pulls/10
emacsmirror · Jun 25, 2023 · 090dbf5 · 090dbf5
2 parents bf4f0de + 2bd1333
commit 090dbf5
Show file tree

Hide file tree

Showing 4 changed files with 109 additions and 32 deletions.
diff --git a/CHANGELOG.org b/CHANGELOG.org
@@ -13,6 +13,14 @@ The format is based on [[https://keepachangelog.com/en/1.0.0/][Keep a Changelog]
 :END:
 Use "machine example.com login username password s3cret port xmpp".
 
+** Provide MUC presence announcement formatting
+:PROPERTIES:
+:CUSTOM_ID: provide-muc-presence-announcement-formatting
+:END:
+Provide customization to limit, highlight, or deemphasize MUC presence
+announcements.  See the manual for details (info "(jabber) Presence
+announcements").
+
 ** Support for roster's groups roll state saving
 :PROPERTIES:
 :CUSTOM_ID: support-rosters-groups-roll-state-saving

diff --git a/README.org b/README.org
@@ -87,6 +87,8 @@ To activate logging of all chats, set =jabber-history-enabled= to =t=.  By defau
 
 By default, jabber.el will send a confirmation when messages sent to you are delivered and displayed, and also send "contact is typing" notifications.  To change this, type =M-x customize-group RET jabber-events=, and set the three =jabber-events-confirm-*= variables to nil.
 
+By default, jabber.el logs all MUC presence announcements to the chat buffer.  With the advent of mobile clients that frequently lose and regain network connectivity, the user left/joined messages can flood the chat.  Customize =jabber-muc-decorate-presence-patterns= to hide or deemphasize presence announcements.  See the manual for details [[info:jabber#Presence announcements][(info "(jabber) Presence announcements")]].
+
 ** File transfer
 :PROPERTIES:
 :CUSTOM_ID: file-transfer
@@ -343,6 +345,8 @@ To install the Info documentation, copy =jabber.info= to =/usr/local/info= and r
   - tmux support
 + Case Duckworth (acdw)
   - [[https://codeberg.org/emacs-jabber/emacs-jabber/pulls/2][PR #2]]
++ Hugh Daschbach (hdasch)
+  - MUC presence announcements
 
 ** Maintainers
 :PROPERTIES:

diff --git a/jabber.texi b/jabber.texi
@@ -481,6 +481,14 @@ you (@code{jabber-muc-looks-personaling-symbols})---see ``jabber-chat''
 customization group. Defaults are sane, so it is unlikely that you would
 want to change this, but... it is Emacs!
 
+By default presence updates are logged in the groupchat buffer.
+Presence updates include announcements when a member joins or leaves a
+room, as well as moderator actions, like kicks or bans.  These
+announcements can clutter up the group discussion, especially when
+other participants using mobile clients experiencing frequent network
+disconnect and reconnects.  Which of these announcements and how they
+are rendered can be configured (@xref{Presence announcements}).
+
 @cindex Topic, MUC
 @findex jabber-muc-set-topic
 To change the topic of a groupchat, type @kbd{M-x jabber-muc-set-topic}.
@@ -504,6 +512,7 @@ jabber-muc-names}.  This gives a list of nicknames,
 
 @menu
 * Configuration::
+* Presence announcements::
 * Invitations::
 * Private messages::
 * MUC Administration::
@@ -546,6 +555,31 @@ accounts---if you connect several accounts, both will try to connect to
 the same chat rooms, or use the same nickname.  This will lead to
 confusion.
 
+@node Presence announcements
+@section Presence announcements
+
+@vindex jabber-muc-decorate-presence-patterns
+
+To limit, highlight, or deemphasize presences announcement messages,
+customize the variable @code{jabber-muc-decorate-presence-patterns}.
+
+@code{jabber-muc-decorate-presence-patterns} is a list of pairs
+consisting of a regular expression and a face.  When a presence
+announcement matches a regular expression pattern, it will be
+displayed with the associated face.  If the face is @code{nil}, the
+announcement will not be added to the groupchat.  For example, the
+customization:
+
+@example
+'(jabber-muc-decorate-presence-patterns
+  '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$")
+    ("." . jabber-muc-presence-dim)))
+@end example
+
+This suppresses display of membership changes (join and leave events)
+and deemphasizes moderator action to set them off from surrounding
+chat messages.
+
 @node Invitations, Private messages, Configuration, Groupchat
 @section Invitations
 

diff --git a/lisp/jabber-muc.el b/lisp/jabber-muc.el
@@ -1045,6 +1045,42 @@ JC is the Jabber connection."
 				    (funcall jabber-alert-muc-function
 					     nick group (current-buffer) body-text))))))))))
 
+(defface jabber-muc-presence-dim
+  '((t (:foreground "dark grey" :weight light :slant italic)))
+  "face for diminished presence notifications.")
+
+(defcustom jabber-muc-decorate-presence-patterns nil
+  "List of regular expressions and face pairs.
+When a presence notification matches a pattern, display it with
+associated face.  Ignore notification if face is ‘nil’."
+  :type '(repeat
+          :tag "Patterns"
+          (cons :format "%v"
+           (regexp :tag "Regexp")
+           (choice
+            (const :tag "Ignore" nil)
+            (face :tag "Face" :value jabber-muc-presence-dim))))
+  :group 'jabber-alerts)
+
+(defun jabber-muc-maybe-decorate-presence (node)
+  "Filter presence notifications."
+  (cl-destructuring-bind (key msg &key time) node
+    (let* ((match (cl-find-if
+                   (lambda (pair)
+                     (string-match (car pair) msg))
+                   jabber-muc-decorate-presence-patterns))
+           (face (cdr-safe match)))
+      (if match
+          (when face
+            (jabber-maybe-print-rare-time
+             (ewoc-enter-last
+              jabber-chat-ewoc
+              (list key
+                    (propertize msg 'face face)
+                    :time time))))
+        (jabber-maybe-print-rare-time
+         (ewoc-enter-last jabber-chat-ewoc node))))))
+
 (defun jabber-muc-process-presence (jc presence)
   (let* ((from (jabber-xml-get-attribute presence 'from))
 	 (type (jabber-xml-get-attribute presence 'type))
@@ -1107,13 +1143,12 @@ JC is the Jabber connection."
 	    (let ((buffer (get-buffer (jabber-muc-get-buffer group))))
 	      (if buffer
 		  (with-current-buffer buffer
-		    (jabber-maybe-print-rare-time
-		     (ewoc-enter-last jabber-chat-ewoc
-				      (list (if (string= type "error")
-						:muc-error
-					      :muc-notice)
-					    message
-					    :time (current-time)))))
+                    (jabber-muc-maybe-decorate-presence
+                     (list (if (string= type "error")
+                               :muc-error
+                             :muc-notice)
+                           message
+                           :time (current-time))))
 		(message "%s: %s" (jabber-jid-displayname group) message))))
 	;; or someone else?
 	(let* ((plist (jabber-muc-participant-plist group nickname))
@@ -1125,25 +1160,23 @@ JC is the Jabber connection."
 				       ">")))))
 	  (jabber-muc-remove-participant group nickname)
 	  (with-current-buffer (jabber-muc-create-buffer jc group)
-	    (jabber-maybe-print-rare-time
-	     (ewoc-enter-last
-	      jabber-chat-ewoc
-	      (list :muc-notice
-		    (cond
-		     ((member "301" status-codes)
-		      (concat name " has been banned"
-			      (when actor (concat " by " actor))
-			      (when reason (concat " - '" reason "'"))))
-		     ((member "307" status-codes)
-		      (concat name " has been kicked"
-			      (when actor (concat " by " actor))
-			      (when reason (concat " - '" reason "'"))))
-		     ((member "303" status-codes)
-		      (concat name " changes nickname to "
-			      (jabber-xml-get-attribute item 'nick)))
-		     (t
-		      (concat name " has left the chatroom")))
-		    :time (current-time))))))))
+            (jabber-muc-maybe-decorate-presence
+             (list :muc-notice
+                   (cond
+                    ((member "301" status-codes)
+                     (concat name " has been banned"
+                             (when actor (concat " by " actor))
+                             (when reason (concat " - '" reason "'"))))
+                    ((member "307" status-codes)
+                     (concat name " has been kicked"
+                             (when actor (concat " by " actor))
+                             (when reason (concat " - '" reason "'"))))
+                    ((member "303" status-codes)
+                     (concat name " changes nickname to "
+                             (jabber-xml-get-attribute item 'nick)))
+                    (t
+                     (concat name " has left the chatroom")))
+                   :time (current-time)))))))
      (t
       ;; someone is entering
 
@@ -1177,12 +1210,10 @@ JC is the Jabber connection."
 					       reason actor)))
 	  (when report
 	    (with-current-buffer (jabber-muc-create-buffer jc group)
-	      (jabber-maybe-print-rare-time
-	       (ewoc-enter-last
-		jabber-chat-ewoc
-		(list :muc-notice report
-		      :time (current-time))))
-	      ;; Did the server change our nick?
+              (jabber-muc-maybe-decorate-presence
+               (list :muc-notice report
+                     :time (current-time)))
+             ;; Did the server change our nick?
 	      (when (member "210" status-codes)
 		(ewoc-enter-last
 		 jabber-chat-ewoc