]> crepu.dev Git - config.git/blame - djavu-asus/elpa/jabber-20230715.456/jabber-alert.el
Configuracion en desarrollo PC pega
[config.git] / djavu-asus / elpa / jabber-20230715.456 / jabber-alert.el
CommitLineData
53e6db90
DC
1;; jabber-alert.el - alert hooks -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2003, 2004, 2005, 2007, 2008 - Magnus Henoch - mange@freemail.hu
4;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
5
6;; This file is a part of jabber.el.
7
8;; This program is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation; either version 2 of the License, or
11;; (at your option) any later version.
12
13;; This program is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with this program; if not, write to the Free Software
20;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21
22(require 'jabber-util)
23
24(require 'cl-lib)
25
26(defgroup jabber-alerts nil "auditory and visual alerts for jabber events"
27 :group 'jabber)
28
29(defcustom jabber-alert-message-hooks '(jabber-message-echo
30 jabber-message-scroll)
31 "Hooks run when a new message arrives.
32
33Arguments are FROM, BUFFER, TEXT and TITLE. FROM is the JID of
34the sender, BUFFER is the the buffer where the message can be
35read, and TEXT is the text of the message. TITLE is the string
36returned by `jabber-alert-message-function' for these arguments,
37so that hooks do not have to call it themselves.
38
39This hook is meant for user customization of message alerts. For
40other uses, see `jabber-message-hooks'."
41 :type 'hook
42 :options '(jabber-message-beep
43 jabber-message-wave
44 jabber-message-echo
45 jabber-message-switch
46 jabber-message-display
47 jabber-message-scroll)
48 :group 'jabber-alerts)
49
50(defvar jabber-message-hooks nil
51 "Internal hooks run when a new message arrives.
52
53This hook works just like `jabber-alert-message-hooks', except that
54it's not meant to be customized by the user.")
55
56(defcustom jabber-alert-message-function
57 'jabber-message-default-message
58 "Function for constructing short message alert messages.
59
60Arguments are FROM, BUFFER, and TEXT. This function should return a
61string containing an appropriate text message, or nil if no message
62should be displayed.
63
64The provided hooks displaying a text message get it from this function,
65and show no message if it returns nil. Other hooks do what they do
66every time."
67 :type 'function
68 :group 'jabber-alerts)
69
70(defcustom jabber-alert-muc-hooks '(jabber-muc-echo jabber-muc-scroll)
71 "Hooks run when a new MUC message arrives.
72
73Arguments are NICK, GROUP, BUFFER, TEXT and TITLE. NICK is the
74nickname of the sender. GROUP is the JID of the group. BUFFER
75is the the buffer where the message can be read, and TEXT is the
76text of the message. TITLE is the string returned by
77`jabber-alert-muc-function' for these arguments, so that hooks do
78not have to call it themselves."
79 :type 'hook
80 :options '(jabber-muc-beep
81 jabber-muc-wave
82 jabber-muc-echo
83 jabber-muc-switch
84 jabber-muc-display
85 jabber-muc-scroll)
86 :group 'jabber-alerts)
87
88(defvar jabber-muc-hooks '()
89 "Internal hooks run when a new MUC message arrives.
90
91This hook works just like `jabber-alert-muc-hooks', except that
92it's not meant to be customized by the user.")
93
94(defcustom jabber-alert-muc-function
95 'jabber-muc-default-message
96 "Function for constructing short message alert messages.
97
98Arguments are NICK, GROUP, BUFFER, and TEXT. This function
99should return a string containing an appropriate text message, or
100nil if no message should be displayed.
101
102The provided hooks displaying a text message get it from this function,
103and show no message if it returns nil. Other hooks do what they do
104every time."
105 :type 'function
106 :group 'jabber-alerts)
107
108(defcustom jabber-alert-presence-hooks
109 '(jabber-presence-echo)
110 "Hooks run when a user's presence changes.
111
112Arguments are WHO, OLDSTATUS, NEWSTATUS, STATUSTEXT and
113PROPOSED-ALERT. WHO is a symbol whose text is the JID of the contact,
114and which has various interesting properties. OLDSTATUS is the old
115presence or nil if disconnected. NEWSTATUS is the new presence, or
116one of \"subscribe\", \"unsubscribe\", \"subscribed\" and
117\"unsubscribed\". TITLE is the string returned by
118`jabber-alert-presence-message-function' for these arguments."
119 :type 'hook
120 :options '(jabber-presence-beep
121 jabber-presence-wave
122 jabber-presence-switch
123 jabber-presence-display
124 jabber-presence-echo)
125 :group 'jabber-alerts)
126
127(defvar jabber-presence-hooks '(jabber-presence-watch)
128 "Internal hooks run when a user's presence changes.
129
130This hook works just like `jabber-alert-presence-hooks', except that
131it's not meant to be customized by the user.")
132
133(defcustom jabber-alert-presence-message-function
134 'jabber-presence-default-message
135 "Function for constructing title of presence alert messages.
136
137Arguments are WHO, OLDSTATUS, NEWSTATUS and STATUSTEXT. See
138`jabber-alert-presence-hooks' for documentation. This function
139should return a string containing an appropriate text message, or nil
140if no message should be displayed.
141
142The provided hooks displaying a text message get it from this function.
143All hooks refrain from action if this function returns nil."
144 :type 'function
145 :group 'jabber-alerts)
146
147(defcustom jabber-alert-info-message-hooks '(jabber-info-display jabber-info-echo)
148 "Hooks run when an info request is completed.
149
150First argument is WHAT, a symbol telling the kind of info request completed.
151That might be 'roster, for requested roster updates, and 'browse, for
152browse requests. Second argument in BUFFER, a buffer containing the result.
153Third argument is PROPOSED-ALERT, containing the string returned by
154`jabber-alert-info-message-function' for these arguments."
155 :type 'hook
156 :options '(jabber-info-beep
157 jabber-info-wave
158 jabber-info-echo
159 jabber-info-switch
160 jabber-info-display)
161 :group 'jabber-alerts)
162
163(defvar jabber-info-message-hooks '()
164 "Internal hooks run when an info request is completed.
165
166This hook works just like `jabber-alert-info-message-hooks',
167except that it's not meant to be customized by the user.")
168
169(defcustom jabber-alert-info-message-function
170 'jabber-info-default-message
171 "Function for constructing info alert messages.
172
173Arguments are WHAT, a symbol telling the kind of info request completed,
174and BUFFER, a buffer containing the result."
175 :type 'function
176 :group 'jabber-alerts)
177
178(defcustom jabber-info-message-alist
179 '((roster . "Roster display updated")
180 (browse . "Browse request completed"))
181 "Alist for info alert messages, used by `jabber-info-default-message'."
182 :type '(alist :key-type symbol :value-type string
183 :options (roster browse))
184 :group 'jabber-alerts)
185
186(defcustom jabber-alert-message-wave ""
187 "A sound file to play when a message arrived.
188See `jabber-alert-message-wave-alist' if you want other sounds
189for specific contacts."
190 :type 'file
191 :group 'jabber-alerts)
192
193(defcustom jabber-alert-message-wave-alist nil
194 "Specific sound files for messages from specific contacts.
195The keys are regexps matching the JID, and the values are sound
196files."
197 :type '(alist :key-type regexp :value-type file)
198 :group 'jabber-alerts)
199
200(defcustom jabber-alert-muc-wave ""
201 "A sound file to play when a MUC message arrived."
202 :type 'file
203 :group 'jabber-alerts)
204
205(defcustom jabber-alert-presence-wave ""
206 "A sound file to play when a presence arrived."
207 :type 'file
208 :group 'jabber-alerts)
209
210(defcustom jabber-alert-presence-wave-alist nil
211 "Specific sound files for presence from specific contacts.
212The keys are regexps matching the JID, and the values are sound
213files."
214 :type '(alist :key-type regexp :value-type file)
215 :group 'jabber-alerts)
216
217(defcustom jabber-alert-info-wave ""
218 "A sound file to play when an info query result arrived."
219 :type 'file
220 :group 'jabber-alerts)
221
222(defcustom jabber-play-sound-file 'play-sound-file
223 "A function to call to play alert sound files."
224 :type 'function
225 :group 'jabber-alerts)
226
227(defmacro define-jabber-alert (name docstring function)
228 "Define a new family of external alert hooks.
229Use this macro when your hooks do nothing except displaying a string
230in some new innovative way. You write a string display function, and
231this macro does all the boring and repetitive work.
232
233NAME is the name of the alert family. The resulting hooks will be
234called jabber-{message,muc,presence,info}-NAME.
235DOCSTRING is the docstring to use for those hooks.
236FUNCTION is a function that takes one argument, a string,
237and displays it in some meaningful way. It can be either a
238lambda form or a quoted function name.
239The created functions are inserted as options in Customize.
240
241Examples:
242\(define-jabber-alert foo \"Send foo alert\" 'foo-message)
243\(define-jabber-alert bar \"Send bar alert\"
244 (lambda (msg) (bar msg 42)))"
245 (let ((sn (symbol-name name)))
246 (let ((msg (intern (format "jabber-message-%s" sn)))
247 (muc (intern (format "jabber-muc-%s" sn)))
248 (pres (intern (format "jabber-presence-%s" sn)))
249 (info (intern (format "jabber-info-%s" sn))))
250 `(progn
251 (defun ,msg (from buffer text title)
252 ,docstring
253 (when title
254 (funcall ,function text title)))
255 (cl-pushnew (quote ,msg) (get 'jabber-alert-message-hooks 'custom-options))
256 (defun ,muc (nick group buffer text title)
257 ,docstring
258 (when title
259 (funcall ,function text title)))
260 (cl-pushnew (quote ,muc) (get 'jabber-alert-muc-hooks 'custom-options))
261 (defun ,pres (who oldstatus newstatus statustext title)
262 ,docstring
263 (when title
264 (funcall ,function statustext title)))
265 (cl-pushnew (quote ,pres) (get 'jabber-alert-presence-hooks 'custom-options))
266 (defun ,info (infotype buffer text)
267 ,docstring
268 (when text
269 (funcall ,function text)))
270 (cl-pushnew (quote ,info) (get 'jabber-alert-info-message-hooks 'custom-options))))))
271
272;; Alert hooks
273(define-jabber-alert echo "Show a message in the echo area"
274 (lambda (text &optional title) (message "%s" (or title text))))
275(define-jabber-alert beep "Beep on event"
276 (lambda (&rest _ignore) (beep)))
277
278;; Message alert hooks
279(defun jabber-message-default-message (from buffer text)
280 (when (or jabber-message-alert-same-buffer
281 (not (memq (selected-window) (get-buffer-window-list buffer))))
282 (if (jabber-muc-sender-p from)
283 (format "Private message from %s in %s"
284 (jabber-jid-resource from)
285 (jabber-jid-displayname (jabber-jid-user from)))
286 (format "Message from %s" (jabber-jid-displayname from)))))
287
288(defcustom jabber-message-alert-same-buffer t
289 "If nil, don't display message alerts for the current buffer."
290 :type 'boolean
291 :group 'jabber-alerts)
292
293(defcustom jabber-muc-alert-self nil
294 "If nil, don't display MUC alerts for your own messages."
295 :type 'boolean
296 :group 'jabber-alerts)
297
298(defun jabber-message-wave (from buffer text title)
299 "Play the wave file specified in `jabber-alert-message-wave'."
300 (when title
301 (let* ((case-fold-search t)
302 (bare-jid (jabber-jid-user from))
303 (sound-file (or (cl-dolist (entry jabber-alert-message-wave-alist)
304 (when (string-match (car entry) bare-jid)
305 (cl-return (cdr entry))))
306 jabber-alert-message-wave)))
307 (unless (equal sound-file "")
308 (funcall jabber-play-sound-file sound-file)))))
309
310(defun jabber-message-display (from buffer text title)
311 "Display the buffer where a new message has arrived."
312 (when title
313 (display-buffer buffer)))
314
315(defun jabber-message-switch (from buffer text title)
316 "Switch to the buffer where a new message has arrived."
317 (when title
318 (switch-to-buffer buffer)))
319
320(defun jabber-message-scroll (from buffer text title)
321 "Scroll all nonselected windows where the chat buffer is displayed."
322 ;; jabber-chat-buffer-display will DTRT with point in the buffer.
323 ;; But this change will not take effect in nonselected windows.
324 ;; Therefore we do that manually here.
325 ;;
326 ;; There are three cases:
327 ;; 1. The user started typing a message in this window. Point is
328 ;; greater than jabber-point-insert. In that case, we don't
329 ;; want to move point.
330 ;; 2. Point was at the end of the buffer, but no message was being
331 ;; typed. After displaying the message, point is now close to
332 ;; the end of the buffer. We advance it to the end.
333 ;; 3. The user was perusing history in this window. There is no
334 ;; simple way to distinguish this from 2, so the user loses.
335 (let ((windows (get-buffer-window-list buffer nil t))
336 (new-point-max (with-current-buffer buffer (point-max))))
337 (dolist (w windows)
338 (unless (eq w (selected-window))
339 (set-window-point w new-point-max)))))
340
341;; MUC alert hooks
342(defun jabber-muc-default-message (nick group buffer text)
343 (when (or jabber-message-alert-same-buffer
344 (not (memq (selected-window) (get-buffer-window-list buffer))))
345 (if nick
346 (when (or jabber-muc-alert-self
347 (not (string= nick (cdr (assoc group *jabber-active-groupchats*)))))
348 (format "Message from %s in %s" nick (jabber-jid-displayname
349 group)))
350 (format "Message in %s" (jabber-jid-displayname group)))))
351
352(defun jabber-muc-wave (nick group buffer text title)
353 "Play the wave file specified in `jabber-alert-muc-wave'."
354 (when title
355 (funcall jabber-play-sound-file jabber-alert-muc-wave)))
356
357(defun jabber-muc-display (nick group buffer text title)
358 "Display the buffer where a new message has arrived."
359 (when title
360 (display-buffer buffer)))
361
362(defun jabber-muc-switch (nick group buffer text title)
363 "Switch to the buffer where a new message has arrived."
364 (when title
365 (switch-to-buffer buffer)))
366
367(defun jabber-muc-scroll (nick group buffer text title)
368 "Scroll buffer even if it is in an unselected window."
369 (jabber-message-scroll nil buffer nil nil))
370
371;; Presence alert hooks
372(defun jabber-presence-default-message (who oldstatus newstatus statustext)
373 "Return a string with the status change if OLDSTATUS and NEWSTATUS differs.
374
375Return nil if OLDSTATUS and NEWSTATUS are equal, and in other
376cases a string of the form \"'name' (jid) is now NEWSTATUS (STATUSTEXT)\".
377
378This function is not called directly, but is the default for
379`jabber-alert-presence-message-function'."
380 (cond
381 ((equal oldstatus newstatus)
382 nil)
383 (t
384 (let ((formattedname
385 (if (> (length (get who 'name)) 0)
386 (get who 'name)
387 (symbol-name who)))
388 (formattedstatus
389 (or
390 (cdr (assoc newstatus
391 '(("subscribe" . " requests subscription to your presence")
392 ("subscribed" . " has granted presence subscription to you")
393 ("unsubscribe" . " no longer subscribes to your presence")
394 ("unsubscribed" . " cancels your presence subscription"))))
395 (concat " is now "
396 (or
397 (cdr (assoc newstatus jabber-presence-strings))
398 newstatus)))))
399 (concat formattedname formattedstatus)))))
400
401(defun jabber-presence-only-chat-open-message (who oldstatus newstatus statustext)
402 "Same as `jabber-presence-default-message' but managing the presence messages.
403
404Return the same as `jabber-presence-default-message' but only
405if there is a chat buffer open for WHO, keeping the amount of presence messages
406at a more manageable level when there are lots of users.
407
408This function is not called directly, but can be used as the value for
409`jabber-alert-presence-message-function'."
410 (when (get-buffer (jabber-chat-get-buffer (jabber-xml-get-attribute xml-data 'from)))
411 (jabber-presence-default-message who oldstatus newstatus statustext)))
412
413(defun jabber-presence-wave (who oldstatus newstatus statustext proposed-alert)
414 "Play the wave file specified in `jabber-alert-presence-wave'."
415 (when proposed-alert
416 (let* ((case-fold-search t)
417 (bare-jid (symbol-name who))
418 (sound-file (or (cl-dolist (entry jabber-alert-presence-wave-alist)
419 (when (string-match (car entry) bare-jid)
420 (cl-return (cdr entry))))
421 jabber-alert-presence-wave)))
422 (unless (equal sound-file "")
423 (funcall jabber-play-sound-file sound-file)))))
424
425;; This is now defined in jabber-roster.el.
426;; (defun jabber-presence-update-roster (who oldstatus newstatus statustext proposed-alert)
427;; "Update the roster display by calling `jabber-display-roster'"
428;; (jabber-display-roster))
429
430(defun jabber-presence-display (who oldstatus newstatus statustext proposed-alert)
431 "Display the roster buffer."
432 (when proposed-alert
433 (display-buffer jabber-roster-buffer)))
434
435(defun jabber-presence-switch (who oldstatus newstatus statustext proposed-alert)
436 "Switch to the roster buffer."
437 (when proposed-alert
438 (switch-to-buffer jabber-roster-buffer)))
439
440;;; Info alert hooks
441
442(defun jabber-info-default-message (infotype buffer)
443 "Function for constructing info alert messages.
444
445The argument is INFOTYPE, a symbol telling the kind of info request completed.
446This function uses `jabber-info-message-alist' to find a message."
447 (concat (cdr (assq infotype jabber-info-message-alist))
448 " (buffer "(buffer-name buffer) ")"))
449
450(defun jabber-info-wave (infotype buffer proposed-alert)
451 "Play the wave file specified in `jabber-alert-info-wave'."
452 (if proposed-alert
453 (funcall jabber-play-sound-file jabber-alert-info-wave)))
454
455(defun jabber-info-display (infotype buffer proposed-alert)
456 "Display buffer of completed request."
457 (when proposed-alert
458 (display-buffer buffer)))
459
460(defun jabber-info-switch (infotype buffer proposed-alert)
461 "Switch to buffer of completed request."
462 (when proposed-alert
463 (switch-to-buffer buffer)))
464
465;;; Personal alert hooks
466(defmacro define-personal-jabber-alert (name)
467 "From ALERT function, make ALERT-personal function.
468
469This makes sense only for MUC.
470
471NAME: the name of the sender."
472 (let ((sn (symbol-name name)))
473 (let ((func (intern (format "%s-personal" sn))))
474 `(progn
475 (defun ,func (nick group buffer text title)
476 (if (jabber-muc-looks-like-personal-p text group)
477 (,name nick group buffer text title)))
478 (cl-pushnew (quote ,func) (get 'jabber-alert-muc-hooks 'custom-options))))))
479
480(define-personal-jabber-alert jabber-muc-beep)
481(define-personal-jabber-alert jabber-muc-wave)
482(define-personal-jabber-alert jabber-muc-echo)
483(define-personal-jabber-alert jabber-muc-switch)
484(define-personal-jabber-alert jabber-muc-display)
485
486(defcustom jabber-autoanswer-alist nil
487 "Specific phrases to autoanswer on specific message.
488The keys are regexps matching the incoming message text, and the values are
489autoanswer phrase."
490 :type '(alist :key-type regexp :value-type string)
491 :group 'jabber-alerts)
492
493(defun jabber-autoanswer-answer (from buffer text proposed-alert)
494 "Answer automaticaly when incoming text is in `jabber-autoanswer-alist'.
495Answer automaticaly when incoming text match the first element of
496`jabber-autoanswer-alist'"
497 (when (and from buffer text proposed-alert jabber-autoanswer-alist)
498 (let ((message
499 (cl-dolist (entry jabber-autoanswer-alist)
500 (when (string-match (car entry) text)
501 (cl-return (cdr entry))))))
502 (if message
503 (jabber-chat-send jabber-buffer-connection message)))))
504(cl-pushnew 'jabber-autoanswer-answer (get 'jabber-alert-message-hooks 'custom-options))
505
506(defun jabber-autoanswer-answer-muc (nick group buffer text proposed-alert)
507 "Answer automaticaly when incoming text is in `jabber-autoanswer-alist'.
508Answer automaticaly when incoming text match first element
509of `jabber-autoanswer-alist'."
510 (when (and nick group buffer text proposed-alert jabber-autoanswer-alist)
511 (let ((message
512 (cl-dolist (entry jabber-autoanswer-alist)
513 (when (string-match (car entry) text)
514 (cl-return (cdr entry))))))
515 (if message
516 (jabber-chat-send jabber-buffer-connection message)))))
517(cl-pushnew 'jabber-autoanswer-answer-muc (get 'jabber-alert-muc-hooks 'custom-options))
518(provide 'jabber-alert)
519
520;;; arch-tag: 725bd73e-c613-4fdc-a11d-3392a7598d4f