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