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