lisp/erc/erc-sound.el

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