djavu-asus/emacs/elpa/jabber-20230715.456/jabber-alert.el

   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
  33 Arguments are FROM, BUFFER, TEXT and TITLE.  FROM is the JID of
  34 the sender, BUFFER is the the buffer where the message can be
  35 read, and TEXT is the text of the message.  TITLE is the string
  36 returned by `jabber-alert-message-function' for these arguments,
  37 so that hooks do not have to call it themselves.
  38
  39 This hook is meant for user customization of message alerts.  For
  40 other 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
  53 This hook works just like `jabber-alert-message-hooks', except that
  54 it'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
  60 Arguments are FROM, BUFFER, and TEXT.  This function should return a
  61 string containing an appropriate text message, or nil if no message
  62 should be displayed.
  63
  64 The provided hooks displaying a text message get it from this function,
  65 and show no message if it returns nil.  Other hooks do what they do
  66 every 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
  73 Arguments are NICK, GROUP, BUFFER, TEXT and TITLE.  NICK is the
  74 nickname of the sender.  GROUP is the JID of the group.  BUFFER
  75 is the the buffer where the message can be read, and TEXT is the
  76 text of the message.  TITLE is the string returned by
  77 `jabber-alert-muc-function' for these arguments, so that hooks do
  78 not 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
  91 This hook works just like `jabber-alert-muc-hooks', except that
  92 it'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
  98 Arguments are NICK, GROUP, BUFFER, and TEXT.  This function
  99 should return a string containing an appropriate text message, or
 100 nil if no message should be displayed.
 101
 102 The provided hooks displaying a text message get it from this function,
 103 and show no message if it returns nil.  Other hooks do what they do
 104 every 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
 112 Arguments are WHO, OLDSTATUS, NEWSTATUS, STATUSTEXT and
 113 PROPOSED-ALERT.  WHO is a symbol whose text is the JID of the contact,
 114 and which has various interesting properties.  OLDSTATUS is the old
 115 presence or nil if disconnected.  NEWSTATUS is the new presence, or
 116 one 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
 130 This hook works just like `jabber-alert-presence-hooks', except that
 131 it'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
 137 Arguments are WHO, OLDSTATUS, NEWSTATUS and STATUSTEXT.  See
 138 `jabber-alert-presence-hooks' for documentation.  This function
 139 should return a string containing an appropriate text message, or nil
 140 if no message should be displayed.
 141
 142 The provided hooks displaying a text message get it from this function.
 143 All 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
 150 First argument is WHAT, a symbol telling the kind of info request completed.
 151 That might be 'roster, for requested roster updates, and 'browse, for
 152 browse requests.  Second argument in BUFFER, a buffer containing the result.
 153 Third 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
 166 This hook works just like `jabber-alert-info-message-hooks',
 167 except 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
 173 Arguments are WHAT, a symbol telling the kind of info request completed,
 174 and 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.
 188 See `jabber-alert-message-wave-alist' if you want other sounds
 189 for 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.
 195 The keys are regexps matching the JID, and the values are sound
 196 files."
 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.
 212 The keys are regexps matching the JID, and the values are sound
 213 files."
 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.
 229 Use this macro when your hooks do nothing except displaying a string
 230 in some new innovative way.  You write a string display function, and
 231 this macro does all the boring and repetitive work.
 232
 233 NAME is the name of the alert family.  The resulting hooks will be
 234 called jabber-{message,muc,presence,info}-NAME.
 235 DOCSTRING is the docstring to use for those hooks.
 236 FUNCTION is a function that takes one argument, a string,
 237 and displays it in some meaningful way.  It can be either a
 238 lambda form or a quoted function name.
 239 The created functions are inserted as options in Customize.
 240
 241 Examples:
 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
 375 Return nil if OLDSTATUS and NEWSTATUS are equal, and in other
 376 cases a string of the form \"'name' (jid) is now NEWSTATUS (STATUSTEXT)\".
 377
 378 This 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
 404 Return the same as `jabber-presence-default-message' but only
 405 if there is a chat buffer open for WHO, keeping the amount of presence messages
 406 at a more manageable level when there are lots of users.
 407
 408 This 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
 445 The argument is INFOTYPE, a symbol telling the kind of info request completed.
 446 This 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
 469 This makes sense only for MUC.
 470
 471 NAME: 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.
 488 The keys are regexps matching the incoming message text, and the values are
 489 autoanswer 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'.
 495 Answer 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'.
 508 Answer automaticaly when incoming text match first element
 509 of `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