comparison lisp/erc/erc-sound.el @ 68451:fc745b05e928

Revision: emacs@sv.gnu.org/emacs--devo--0--patch-22 Creator: Michael Olson <mwolson@gnu.org> Install ERC.
author Miles Bader <miles@gnu.org>
date Sun, 29 Jan 2006 13:08:58 +0000
parents
children 7010bb070445
comparison
equal deleted inserted replaced
68450:a3ba4ef5d590 68451:fc745b05e928
1 ;;; erc-sound.el --- CTCP SOUND support for ERC
2
3 ;; Copyright (C) 2002, 2003 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 2, or (at your option)
10 ;; 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; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 ;; Boston, MA 02110-1301, USA.
21
22 ;;; Commentary:
23
24 ;; This used to be in erc.el, I (Jorgen) just extracted it from there
25 ;; and put it in this file. Bugs and features are those of the
26 ;; original author.
27
28 ;;; Code:
29
30 (require 'erc)
31
32 ;;;###autoload (autoload 'erc-sound-mode "erc-sound")
33 (define-erc-module sound ctcp-sound
34 "In ERC sound mode, the client will respond to CTCP SOUND requests
35 and play sound files as requested."
36 ;; Enable:
37 ((define-key erc-mode-map "\C-c\C-s" 'erc-toggle-sound))
38 ;; Disable:
39 ((define-key erc-mode-map "\C-c\C-s" 'undefined)))
40
41 (erc-define-catalog-entry 'english 'CTCP-SOUND "%n (%u@%h) plays %s:%m")
42
43 (defgroup erc-sound nil
44 "Make ERC play bells and whistles while chatting with people."
45 :group 'erc)
46
47 (defcustom erc-play-sound t
48 "*Play sound on SOUND ctcp requests (used in ICQ chat)."
49 :group 'erc-sound
50 :type 'boolean)
51
52 (defcustom erc-sound-path nil
53 "List of directories that contain sound samples to play on SOUND events."
54 :group 'erc-sound
55 :type '(repeat directory))
56
57 (defcustom erc-default-sound nil
58 "Play this sound if the requested file was not found."
59 :group 'erc-sound
60 :type '(choice (const nil)
61 file))
62
63 (defcustom erc-play-command "play"
64 "Command for playing sound samples."
65 :group 'erc-sound
66 :type 'string)
67
68 (defun erc-cmd-SOUND (line &optional force)
69 "Play the sound given in LINE."
70 (cond
71 ((string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*\\)?$" line)
72 (let ((file (match-string 1 line))
73 (msg (match-string 2 line))
74 (tgt (erc-default-target)))
75 (if (null msg)
76 (setq msg "")
77 ;; remove the first white space
78 (setq msg (substring msg 1)))
79 (if tgt
80 (progn
81 (erc-send-ctcp-message tgt (format "SOUND %s %s" file msg) force)
82 (if erc-play-sound (erc-play-sound file)))
83 (erc-display-message nil 'error (current-buffer) 'no-target))
84 t))
85 (t nil)))
86
87 (defvar erc-ctcp-query-SOUND-hook '(erc-ctcp-query-SOUND))
88 (defun erc-ctcp-query-SOUND (proc nick login host to msg)
89 (when (string-match "^SOUND\\s-+\\(\\S-+\\)\\(\\(\\s-+.*\\)\\|\\(\\s-*\\)\\)$" msg)
90 (let ((sound (match-string 1 msg))
91 (comment (match-string 2 msg)))
92 (when erc-play-sound (erc-play-sound sound))
93 (erc-display-message
94 nil 'notice nil
95 'CTCP-SOUND ?n nick ?u login ?h host ?s sound ?m comment)))
96 nil)
97
98 (defun erc-play-sound (file)
99 "Plays a sound file located in one of the directories in `erc-sound-path'
100 with a command `erc-play-command'."
101 (let ((filepath (erc-find-file file erc-sound-path)))
102 (if (and (not filepath) erc-default-sound)
103 (setq filepath erc-default-sound))
104 (cond ((and filepath (file-exists-p filepath))
105 (if (and (fboundp 'device-sound-enabled-p)
106 (device-sound-enabled-p))
107 ; For XEmacs
108 (play-sound-file filepath)
109 ; (start-process "erc-sound" nil erc-play-command filepath)
110 (start-process "erc-sound" nil "/bin/tcsh" "-c"
111 (concat erc-play-command " " filepath))))
112 (t (beep)))
113 (erc-log (format "Playing sound file %S" filepath))))
114
115 ;(defun erc-play-sound (file)
116 ; "Plays a sound file located in one of the directories in `erc-sound-path'
117 ; with a command `erc-play-command'."
118 ; (let ((filepath nil)
119 ; (paths erc-sound-path))
120 ; (while (and paths
121 ; (progn (setq filepath (expand-file-name file (car paths)))
122 ; (not (file-exists-p filepath))))
123 ; (setq paths (cdr paths)))
124 ; (if (and (not (and filepath (file-exists-p filepath)))
125 ; erc-default-sound)
126 ; (setq filepath erc-default-sound))
127 ; (cond ((and filepath (file-exists-p filepath))
128 ;; (start-process "erc-sound" nil erc-play-command filepath)
129 ; (start-process "erc-sound" nil "/bin/tcsh" "-c"
130 ; (concat erc-play-command " " filepath))
131 ; )
132 ; (t (beep)))
133 ; (erc-log (format "Playing sound file %S" filepath))))
134
135 (defun erc-toggle-sound (&optional arg)
136 "Toggles playing sounds on and off. With positive argument,
137 turns them on. With any other argument turns sounds off."
138 (interactive "P")
139 (cond ((and (numberp arg) (> arg 0))
140 (setq erc-play-sound t))
141 (arg (setq erc-play-sound nil))
142 (t (setq erc-play-sound (not erc-play-sound))))
143 (message "ERC sound is %s" (if erc-play-sound "ON" "OFF")))
144
145
146 (provide 'erc-sound)
147
148 ;; arch-tag: 53657d1d-007f-4a20-91c1-588e71cf0cee
149 ;;; erc-sound.el ends here