From 1293e0d0710974e756470f3df107db592029880c Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 1 Feb 2022 15:05:25 -0600 Subject: Hide presence notifications ?? Not sure if this is working --- lisp/+jabber.el | 224 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 223 insertions(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/+jabber.el b/lisp/+jabber.el index a0fdea7..2382102 100644 --- a/lisp/+jabber.el +++ b/lisp/+jabber.el @@ -25,8 +25,230 @@ This does the same as `jabber-activity-show-p', but for the (when (funcall +jabber-tracking-show-p group) (tracking-add-buffer buffer 'jabber-activity-face))) -;;; TODO: Hiding presence messages: +;;; Hiding presence messages: ;; https://paste.sr.ht/~hdasch/f0ad09fbcd08e940a4fda71c2f40abc1c4efd45f +;; Tame MUC presence notifications. + +;; This patch hides or applies a face to MUC presence notifications in +;; the MUC chat buffer. To control its behavior, customize +;; ’jabber-muc-decorate-presence-patterns’. By default it does nothing. + +;; ’jabber-muc-decorate-presence-patterns’ is a list of pairs consisting +;; of a regular expression and a either a face or ‘nil’. If a the +;; regular expression matches a presence notification, then either: + +;; - the specified face is applied to the notification message +;; - or if the second value of the pair is nil, the notification is +;; discarded + +;; If no regular expression in the list of pairs matches the notification +;; message, the message is displayed unchanged. + +;; For example, the customization: + +;; '(jabber-muc-decorate-presence-patterns +;; '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") +;; ("." . jabber-muc-presence-dim))) + +;; hides participant enter/leave notifications. It also diminishes other +;; presence notification messages to make it easier to distinguish +;; between conversation and notifications. + +(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)) + (x-muc (cl-find-if + (lambda (x) (equal (jabber-xml-get-attribute x 'xmlns) + "http://jabber.org/protocol/muc#user")) + (jabber-xml-get-children presence 'x))) + (group (jabber-jid-user from)) + (nickname (jabber-jid-resource from)) + (symbol (jabber-jid-symbol from)) + (our-nickname (gethash symbol jabber-pending-groupchats)) + (item (car (jabber-xml-get-children x-muc 'item))) + (actor (jabber-xml-get-attribute (car (jabber-xml-get-children item 'actor)) 'jid)) + (reason (car (jabber-xml-node-children (car (jabber-xml-get-children item 'reason))))) + (error-node (car (jabber-xml-get-children presence 'error))) + (status-codes (if error-node + (list (jabber-xml-get-attribute error-node 'code)) + (mapcar + (lambda (status-element) + (jabber-xml-get-attribute status-element 'code)) + (jabber-xml-get-children x-muc 'status))))) + ;; handle leaving a room + (cond + ((or (string= type "unavailable") (string= type "error")) + ;; error from room itself? or are we leaving? + (if (or (null nickname) + (member "110" status-codes) + (string= nickname our-nickname)) + ;; Assume that an error means that we were thrown out of the + ;; room... + (let* ((leavingp t) + (message (cond + ((string= type "error") + (cond + ;; ...except for certain cases. + ((or (member "406" status-codes) + (member "409" status-codes)) + (setq leavingp nil) + (concat "Nickname change not allowed" + (when error-node + (concat ": " (jabber-parse-error error-node))))) + (t + (concat "Error entering room" + (when error-node + (concat ": " (jabber-parse-error error-node))))))) + ((member "301" status-codes) + (concat "You have been banned" + (when actor (concat " by " actor)) + (when reason (concat " - '" reason "'")))) + ((member "307" status-codes) + (concat "You have been kicked" + (when actor (concat " by " actor)) + (when reason (concat " - '" reason "'")))) + (t + "You have left the chatroom")))) + (when leavingp + (jabber-muc-remove-groupchat group)) + ;; If there is no buffer for this groupchat, don't bother + ;; creating one just to tell that user left the room. + (let ((buffer (get-buffer (jabber-muc-get-buffer group)))) + (if buffer + (with-current-buffer buffer + (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)) + (jid (plist-get plist 'jid)) + (name (concat nickname + (when jid + (concat " <" + (jabber-jid-user jid) + ">"))))) + (jabber-muc-remove-participant group nickname) + (with-current-buffer (jabber-muc-create-buffer jc group) + (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 + + (when (or (member "110" status-codes) (string= nickname our-nickname)) + ;; This is us. We just succeeded in entering the room. + ;; + ;; The MUC server is supposed to send a 110 code whenever this + ;; is our presence ("self-presence"), but at least one + ;; (ejabberd's mod_irc) doesn't, so check the nickname as well. + ;; + ;; This check might give incorrect results if the server + ;; changed our nickname to avoid collision with an existing + ;; participant, but even in this case the window where we have + ;; incorrect information should be very small, as we should be + ;; getting our own 110+210 presence shortly. + (let ((whichgroup (assoc group *jabber-active-groupchats*))) + (if whichgroup + (setcdr whichgroup nickname) + (add-to-list '*jabber-active-groupchats* (cons group nickname)))) + ;; The server may have changed our nick. Record the new one. + (puthash symbol nickname jabber-pending-groupchats)) + + ;; Whoever enters, we create a buffer (if it didn't already + ;; exist), and print a notice. This is where autojoined MUC + ;; rooms have buffers created for them. We also remember some + ;; metadata. + (let ((old-plist (jabber-muc-participant-plist group nickname)) + (new-plist (jabber-muc-parse-affiliation x-muc))) + (jabber-muc-modify-participant group nickname new-plist) + (let ((report (jabber-muc-report-delta nickname old-plist new-plist + reason actor))) + (when report + (with-current-buffer (jabber-muc-create-buffer jc group) + (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 + (list :muc-notice + (concat "Your nick was changed to " nickname " by the server") + :time (current-time)))) + ;; Was this room just created? If so, it's a locked + ;; room. Notify the user. + (when (member "201" status-codes) + (ewoc-enter-last + jabber-chat-ewoc + (list :muc-notice + (with-temp-buffer + (insert "This room was just created, and is locked to other participants.\n" + "To unlock it, ") + (insert-text-button + "configure the room" + 'action (apply-partially 'call-interactively 'jabber-muc-get-config)) + (insert " or ") + (insert-text-button + "accept the default configuration" + 'action (apply-partially 'call-interactively 'jabber-muc-instant-config)) + (insert ".") + (buffer-string)) + :time (current-time)))))))))))) + (provide '+jabber) ;;; +jabber.el ends here -- cgit 1.4.1-21-gabe81