code.delx.au - gnu-emacs/blob - lisp/erc/erc-sound.el

   1 ;;; erc-sound.el --- CTCP SOUND support for ERC
   2
   3 ;; Copyright (C) 2002-2003, 2006-2011 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is free software: you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 ;; Play sounds when users send you CTCP SOUND messages.
  23
  24 ;; This file also defines the command /sound so that you can send
  25 ;; sound requests to other users.
  26
  27 ;;; Usage:
  28
  29 ;; Add the following to your .emacs if you want to play sounds.
  30 ;;
  31 ;; (require 'erc-sound)
  32 ;; (erc-sound-enable)
  33 ;;
  34 ;; To send requests to other users from within query buffers, type the
  35 ;; following:
  36 ;;
  37 ;; /sound filename optional-message-text
  38 ;;
  39 ;; You can also type the following:
  40 ;;
  41 ;; /ctcp nickname sound filename optional-message
  42
  43 ;;; Code:
  44
  45 (require 'erc)
  46
  47 ;;;###autoload (autoload 'erc-sound-mode "erc-sound")
  48 (define-erc-module sound ctcp-sound
  49   "In ERC sound mode, the client will respond to CTCP SOUND requests
  50 and play sound files as requested."
  51   ;; Enable:
  52   ((add-hook 'erc-ctcp-query-SOUND-hook 'erc-ctcp-query-SOUND)
  53    (define-key erc-mode-map "\C-c\C-s" 'erc-toggle-sound))
  54   ;; Disable:
  55   ((remove-hook 'erc-ctcp-query-SOUND-hook 'erc-ctcp-query-SOUND)
  56    (define-key erc-mode-map "\C-c\C-s" 'undefined)))
  57
  58 (erc-define-catalog-entry 'english 'CTCP-SOUND "%n (%u@%h) plays %s:%m")
  59
  60 (defgroup erc-sound nil
  61   "Make ERC play bells and whistles while chatting with people."
  62   :group 'erc)
  63
  64 (defcustom erc-play-sound t
  65   "*Play sounds when you receive CTCP SOUND requests."
  66   :group 'erc-sound
  67   :type 'boolean)
  68
  69 (defcustom erc-sound-path nil
  70   "List of directories that contain sound samples to play on SOUND events."
  71   :group 'erc-sound
  72   :type '(repeat directory))
  73
  74 (defcustom erc-default-sound nil
  75   "Play this sound if the requested file was not found.
  76 If this is set to nil or the file doesn't exist a beep will sound."
  77   :group 'erc-sound
  78   :type '(choice (const nil)
  79                  file))
  80
  81 (defvar erc-ctcp-query-SOUND-hook nil
  82   "Hook to run after receiving a CTCP SOUND request.")
  83
  84 (defun erc-cmd-SOUND (line &optional force)
  85   "Send a CTCP SOUND message to the default target.
  86 If `erc-play-sound' is non-nil, play the sound as well.
  87
  88 /sound filename optional-message-text
  89
  90 LINE is the text entered, including the command."
  91   (cond
  92    ((string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*\\)?$" line)
  93     (let ((file (match-string 1 line))
  94           (msg (match-string 2 line))
  95           (tgt (erc-default-target)))
  96       (if (null msg)
  97           (setq msg "")
  98         ;; remove the first white space
  99         (setq msg (substring msg 1)))
 100       (if tgt
 101           (progn
 102             (erc-send-ctcp-message tgt (format "SOUND %s %s" file msg) force)
 103             (if erc-play-sound (erc-play-sound file)))
 104         (erc-display-message nil 'error (current-buffer) 'no-target))
 105       t))
 106    (t nil)))
 107
 108 (defun erc-ctcp-query-SOUND (proc nick login host to msg)
 109   "Display a CTCP SOUND message and play sound if `erc-play-sound' is non-nil."
 110   (when (string-match "^SOUND\\s-+\\(\\S-+\\)\\(\\(\\s-+.*\\)\\|\\(\\s-*\\)\\)$" msg)
 111     (let ((sound (match-string 1 msg))
 112           (comment (match-string 2 msg)))
 113       (when erc-play-sound (erc-play-sound sound))
 114       (erc-display-message
 115        nil 'notice nil
 116        'CTCP-SOUND ?n nick ?u login ?h host ?s sound ?m comment)))
 117   nil)
 118
 119 (defun erc-play-sound (file)
 120   "Play a sound file located in one of the directories in `erc-sound-path'.
 121 See also `play-sound-file'."
 122   (let ((filepath (erc-find-file file erc-sound-path)))
 123     (if (and (not filepath) erc-default-sound)
 124         (setq filepath erc-default-sound))
 125     (cond ((and filepath (file-exists-p filepath))
 126            (play-sound-file filepath))
 127           (t (beep)))
 128     (erc-log (format "Playing sound file %S" filepath))))
 129
 130 (defun erc-toggle-sound (&optional arg)
 131   "Toggles playing sounds on and off.  With positive argument,
 132   turns them on.  With any other argument turns sounds off."
 133   (interactive "P")
 134   (cond ((and (numberp arg) (> arg 0))
 135          (setq erc-play-sound t))
 136         (arg (setq erc-play-sound nil))
 137         (t (setq erc-play-sound (not erc-play-sound))))
 138   (message "ERC sound is %s" (if erc-play-sound "ON" "OFF")))
 139
 140
 141 (provide 'erc-sound)
 142
 143 ;;; erc-sound.el ends here
 144 ;;
 145 ;; Local Variables:
 146 ;; indent-tabs-mode: t
 147 ;; tab-width: 8
 148 ;; End:
 149