diff options
author | Case Duckworth | 2022-02-01 15:05:25 -0600 |
---|---|---|
committer | Case Duckworth | 2022-02-01 15:05:25 -0600 |
commit | 1293e0d0710974e756470f3df107db592029880c (patch) | |
tree | cbb019ca85cd2a007f213e38b1db77af79a4aeca /lisp | |
parent | meh (diff) | |
download | emacs-1293e0d0710974e756470f3df107db592029880c.tar.gz emacs-1293e0d0710974e756470f3df107db592029880c.zip |
Hide presence notifications ??
Not sure if this is working
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/+jabber.el | 224 |
1 files changed, 223 insertions, 1 deletions
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 | |||
25 | (when (funcall +jabber-tracking-show-p group) | 25 | (when (funcall +jabber-tracking-show-p group) |
26 | (tracking-add-buffer buffer 'jabber-activity-face))) | 26 | (tracking-add-buffer buffer 'jabber-activity-face))) |
27 | 27 | ||
28 | ;;; TODO: Hiding presence messages: | 28 | ;;; Hiding presence messages: |
29 | ;; https://paste.sr.ht/~hdasch/f0ad09fbcd08e940a4fda71c2f40abc1c4efd45f | 29 | ;; https://paste.sr.ht/~hdasch/f0ad09fbcd08e940a4fda71c2f40abc1c4efd45f |
30 | 30 | ||
31 | ;; Tame MUC presence notifications. | ||
32 | |||
33 | ;; This patch hides or applies a face to MUC presence notifications in | ||
34 | ;; the MUC chat buffer. To control its behavior, customize | ||
35 | ;; ’jabber-muc-decorate-presence-patterns’. By default it does nothing. | ||
36 | |||
37 | ;; ’jabber-muc-decorate-presence-patterns’ is a list of pairs consisting | ||
38 | ;; of a regular expression and a either a face or ‘nil’. If a the | ||
39 | ;; regular expression matches a presence notification, then either: | ||
40 | |||
41 | ;; - the specified face is applied to the notification message | ||
42 | ;; - or if the second value of the pair is nil, the notification is | ||
43 | ;; discarded | ||
44 | |||
45 | ;; If no regular expression in the list of pairs matches the notification | ||
46 | ;; message, the message is displayed unchanged. | ||
47 | |||
48 | ;; For example, the customization: | ||
49 | |||
50 | ;; '(jabber-muc-decorate-presence-patterns | ||
51 | ;; '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") | ||
52 | ;; ("." . jabber-muc-presence-dim))) | ||
53 | |||
54 | ;; hides participant enter/leave notifications. It also diminishes other | ||
55 | ;; presence notification messages to make it easier to distinguish | ||
56 | ;; between conversation and notifications. | ||
57 | |||
58 | (defface jabber-muc-presence-dim | ||
59 | '((t (:foreground "dark grey" :weight light :slant italic))) | ||
60 | "face for diminished presence notifications.") | ||
61 | |||
62 | (defcustom jabber-muc-decorate-presence-patterns nil | ||
63 | "List of regular expressions and face pairs. | ||
64 | When a presence notification matches a pattern, display it with | ||
65 | associated face. Ignore notification if face is ‘nil’." | ||
66 | :type '(repeat | ||
67 | :tag "Patterns" | ||
68 | (cons :format "%v" | ||
69 | (regexp :tag "Regexp") | ||
70 | (choice | ||
71 | (const :tag "Ignore" nil) | ||
72 | (face :tag "Face" :value jabber-muc-presence-dim)))) | ||
73 | :group 'jabber-alerts) | ||
74 | |||
75 | (defun jabber-muc-maybe-decorate-presence (node) | ||
76 | "Filter presence notifications." | ||
77 | (cl-destructuring-bind (key msg &key time) node | ||
78 | (let* ((match (cl-find-if | ||
79 | (lambda (pair) | ||
80 | (string-match (car pair) msg)) | ||
81 | jabber-muc-decorate-presence-patterns)) | ||
82 | (face (cdr-safe match))) | ||
83 | (if match | ||
84 | (when face | ||
85 | (jabber-maybe-print-rare-time | ||
86 | (ewoc-enter-last | ||
87 | jabber-chat-ewoc | ||
88 | (list key | ||
89 | (propertize msg 'face face) | ||
90 | :time time)))) | ||
91 | (jabber-maybe-print-rare-time | ||
92 | (ewoc-enter-last jabber-chat-ewoc node)))))) | ||
93 | |||
94 | (defun jabber-muc-process-presence (jc presence) | ||
95 | (let* ((from (jabber-xml-get-attribute presence 'from)) | ||
96 | (type (jabber-xml-get-attribute presence 'type)) | ||
97 | (x-muc (cl-find-if | ||
98 | (lambda (x) (equal (jabber-xml-get-attribute x 'xmlns) | ||
99 | "http://jabber.org/protocol/muc#user")) | ||
100 | (jabber-xml-get-children presence 'x))) | ||
101 | (group (jabber-jid-user from)) | ||
102 | (nickname (jabber-jid-resource from)) | ||
103 | (symbol (jabber-jid-symbol from)) | ||
104 | (our-nickname (gethash symbol jabber-pending-groupchats)) | ||
105 | (item (car (jabber-xml-get-children x-muc 'item))) | ||
106 | (actor (jabber-xml-get-attribute (car (jabber-xml-get-children item 'actor)) 'jid)) | ||
107 | (reason (car (jabber-xml-node-children (car (jabber-xml-get-children item 'reason))))) | ||
108 | (error-node (car (jabber-xml-get-children presence 'error))) | ||
109 | (status-codes (if error-node | ||
110 | (list (jabber-xml-get-attribute error-node 'code)) | ||
111 | (mapcar | ||
112 | (lambda (status-element) | ||
113 | (jabber-xml-get-attribute status-element 'code)) | ||
114 | (jabber-xml-get-children x-muc 'status))))) | ||
115 | ;; handle leaving a room | ||
116 | (cond | ||
117 | ((or (string= type "unavailable") (string= type "error")) | ||
118 | ;; error from room itself? or are we leaving? | ||
119 | (if (or (null nickname) | ||
120 | (member "110" status-codes) | ||
121 | (string= nickname our-nickname)) | ||
122 | ;; Assume that an error means that we were thrown out of the | ||
123 | ;; room... | ||
124 | (let* ((leavingp t) | ||
125 | (message (cond | ||
126 | ((string= type "error") | ||
127 | (cond | ||
128 | ;; ...except for certain cases. | ||
129 | ((or (member "406" status-codes) | ||
130 | (member "409" status-codes)) | ||
131 | (setq leavingp nil) | ||
132 | (concat "Nickname change not allowed" | ||
133 | (when error-node | ||
134 | (concat ": " (jabber-parse-error error-node))))) | ||
135 | (t | ||
136 | (concat "Error entering room" | ||
137 | (when error-node | ||
138 | (concat ": " (jabber-parse-error error-node))))))) | ||
139 | ((member "301" status-codes) | ||
140 | (concat "You have been banned" | ||
141 | (when actor (concat " by " actor)) | ||
142 | (when reason (concat " - '" reason "'")))) | ||
143 | ((member "307" status-codes) | ||
144 | (concat "You have been kicked" | ||
145 | (when actor (concat " by " actor)) | ||
146 | (when reason (concat " - '" reason "'")))) | ||
147 | (t | ||
148 | "You have left the chatroom")))) | ||
149 | (when leavingp | ||
150 | (jabber-muc-remove-groupchat group)) | ||
151 | ;; If there is no buffer for this groupchat, don't bother | ||
152 | ;; creating one just to tell that user left the room. | ||
153 | (let ((buffer (get-buffer (jabber-muc-get-buffer group)))) | ||
154 | (if buffer | ||
155 | (with-current-buffer buffer | ||
156 | (jabber-muc-maybe-decorate-presence | ||
157 | (list (if (string= type "error") | ||
158 | :muc-error | ||
159 | :muc-notice) | ||
160 | message | ||
161 | :time (current-time))))) | ||
162 | (message "%s: %s" (jabber-jid-displayname group) message)))) | ||
163 | ;; or someone else? | ||
164 | (let* ((plist (jabber-muc-participant-plist group nickname)) | ||
165 | (jid (plist-get plist 'jid)) | ||
166 | (name (concat nickname | ||
167 | (when jid | ||
168 | (concat " <" | ||
169 | (jabber-jid-user jid) | ||
170 | ">"))))) | ||
171 | (jabber-muc-remove-participant group nickname) | ||
172 | (with-current-buffer (jabber-muc-create-buffer jc group) | ||
173 | (jabber-muc-maybe-decorate-presence | ||
174 | (list :muc-notice | ||
175 | (cond | ||
176 | ((member "301" status-codes) | ||
177 | (concat name " has been banned" | ||
178 | (when actor (concat " by " actor)) | ||
179 | (when reason (concat " - '" reason "'")))) | ||
180 | ((member "307" status-codes) | ||
181 | (concat name " has been kicked" | ||
182 | (when actor (concat " by " actor)) | ||
183 | (when reason (concat " - '" reason "'")))) | ||
184 | ((member "303" status-codes) | ||
185 | (concat name " changes nickname to " | ||
186 | (jabber-xml-get-attribute item 'nick))) | ||
187 | (t | ||
188 | (concat name " has left the chatroom"))) | ||
189 | :time (current-time)))))) | ||
190 | (t | ||
191 | ;; someone is entering | ||
192 | |||
193 | (when (or (member "110" status-codes) (string= nickname our-nickname)) | ||
194 | ;; This is us. We just succeeded in entering the room. | ||
195 | ;; | ||
196 | ;; The MUC server is supposed to send a 110 code whenever this | ||
197 | ;; is our presence ("self-presence"), but at least one | ||
198 | ;; (ejabberd's mod_irc) doesn't, so check the nickname as well. | ||
199 | ;; | ||
200 | ;; This check might give incorrect results if the server | ||
201 | ;; changed our nickname to avoid collision with an existing | ||
202 | ;; participant, but even in this case the window where we have | ||
203 | ;; incorrect information should be very small, as we should be | ||
204 | ;; getting our own 110+210 presence shortly. | ||
205 | (let ((whichgroup (assoc group *jabber-active-groupchats*))) | ||
206 | (if whichgroup | ||
207 | (setcdr whichgroup nickname) | ||
208 | (add-to-list '*jabber-active-groupchats* (cons group nickname)))) | ||
209 | ;; The server may have changed our nick. Record the new one. | ||
210 | (puthash symbol nickname jabber-pending-groupchats)) | ||
211 | |||
212 | ;; Whoever enters, we create a buffer (if it didn't already | ||
213 | ;; exist), and print a notice. This is where autojoined MUC | ||
214 | ;; rooms have buffers created for them. We also remember some | ||
215 | ;; metadata. | ||
216 | (let ((old-plist (jabber-muc-participant-plist group nickname)) | ||
217 | (new-plist (jabber-muc-parse-affiliation x-muc))) | ||
218 | (jabber-muc-modify-participant group nickname new-plist) | ||
219 | (let ((report (jabber-muc-report-delta nickname old-plist new-plist | ||
220 | reason actor))) | ||
221 | (when report | ||
222 | (with-current-buffer (jabber-muc-create-buffer jc group) | ||
223 | (jabber-muc-maybe-decorate-presence | ||
224 | (list :muc-notice report | ||
225 | :time (current-time))) | ||
226 | ;; Did the server change our nick? | ||
227 | (when (member "210" status-codes) | ||
228 | (ewoc-enter-last | ||
229 | jabber-chat-ewoc | ||
230 | (list :muc-notice | ||
231 | (concat "Your nick was changed to " nickname " by the server") | ||
232 | :time (current-time)))) | ||
233 | ;; Was this room just created? If so, it's a locked | ||
234 | ;; room. Notify the user. | ||
235 | (when (member "201" status-codes) | ||
236 | (ewoc-enter-last | ||
237 | jabber-chat-ewoc | ||
238 | (list :muc-notice | ||
239 | (with-temp-buffer | ||
240 | (insert "This room was just created, and is locked to other participants.\n" | ||
241 | "To unlock it, ") | ||
242 | (insert-text-button | ||
243 | "configure the room" | ||
244 | 'action (apply-partially 'call-interactively 'jabber-muc-get-config)) | ||
245 | (insert " or ") | ||
246 | (insert-text-button | ||
247 | "accept the default configuration" | ||
248 | 'action (apply-partially 'call-interactively 'jabber-muc-instant-config)) | ||
249 | (insert ".") | ||
250 | (buffer-string)) | ||
251 | :time (current-time)))))))))))) | ||
252 | |||
31 | (provide '+jabber) | 253 | (provide '+jabber) |
32 | ;;; +jabber.el ends here | 254 | ;;; +jabber.el ends here |