(U+5E22): Apply new conventions for glyph granularity.
[chise/xemacs-chise.git] / lisp / sound.el
1 ;;; sound.el --- Loading sound files in XEmacs
2
3 ;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
5
6 ;; Maintainer: XEmacs Development Team
7 ;; Keywords: internal
8
9 ;; This file is part of XEmacs.
10
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19 ;; General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING.  If not, write to the
23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
25
26 ;;; Synched up with: Not in FSF.
27
28 ;;; Commentary:
29
30 ;;; Code:
31 (defgroup sound nil
32   "Configure XEmacs sounds and properties"
33   :group 'environment)
34
35 (defcustom sound-default-alist
36       '((default                :sound bass)
37         (undefined-key  :sound drum)
38         (undefined-click        :sound drum)
39         ;; beginning-of-buffer or end-of-buffer errors.
40         (buffer-bound   :sound drum)
41         ;; buffer-read-only error
42         (read-only              :sound drum)
43         ;; non-interactive function or lambda called
44         (command-error  :sound bass)
45         (y-or-n-p               :sound quiet)
46         (yes-or-no-p            :sound quiet)
47         (auto-save-error        :sound whip :volume 100)
48         (no-completion  :sound whip)
49         (isearch-failed :sound quiet)
50         (isearch-quit   :sound bass)
51         ;; QUIT: sound generated by ^G and its variants.
52         (quit           :sound quiet :volume 75)
53         ;; READY: time-consuming task has completed...  compile,
54         ;; cvs-update, etc.
55         (ready          :sound cuckoo)
56         ;; WARP: XEmacs has changed the selected-window or frame
57         ;; asynchronously...  Especially when it's done by an
58         ;; asynchronous process filter.  Perhaps by a debugger breakpoint
59         ;; has been hit?
60         (warp           :sound yeep :volume 75)
61         ;; ALARM: used for reminders...
62         (alarm          :sound cuckoo :volume 100)
63         )
64       "The alist of sounds and associated error symbols.
65
66  Used to set sound-alist in load-default-sounds."
67       :group 'sound
68       :type '(repeat
69               (group (symbol :tag "Name")
70                      (checklist :inline t
71                                 :greedy t
72                                 (group :inline t
73                                        (const :format "" :value :sound)
74                                        (symbol :tag "Sound"))
75                                 (group :inline t
76                                        (const :format "" :value :volume)
77                                        (integer :tag "Volume"))
78                                 (group :inline t
79                                        (const :format "" :value :pitch)
80                                        (integer :tag "Pitch"))
81                                 (group :inline t
82                                        (const :format "" :value :duration)
83                                        (integer :tag "Duration"))))))
84
85 (defcustom sound-load-list
86   '((load-sound-file "drum-beep"        'drum)
87     (load-sound-file "quiet-beep"       'quiet)
88     (load-sound-file "bass-snap"        'bass 80)
89     (load-sound-file "whip"             'whip 70)
90     (load-sound-file "cuckoo"           'cuckoo)
91     (load-sound-file "yeep"             'yeep)
92     (load-sound-file "hype"             'hype 100)
93     )
94   "A list of calls to load-sound-file to be processed by load-default-sounds.
95
96   Reference load-sound-file for more information."
97
98   :group 'sound
99   :type '(repeat  (sexp :tag "Sound")
100                   ))
101
102 (defcustom default-sound-directory (locate-data-directory "sounds")
103   "Default directory to load a sound file from."
104   :group 'sound
105   :type 'directory
106   )
107
108 ;; #### This should really be a list.  --hniksic
109 (defcustom sound-extension-list (cond ((or (eq system-type 'cygwin32)
110                                            (eq system-type 'windows-nt))
111                                        ".wav:")
112                                       ((eq system-type 'linux)
113                                        ".wav:.au:")
114                                       (t
115                                        ".au:"))
116   "Filename extensions to complete sound file name with. If more than one
117    extension is used, they should be separated by \":\". "
118   :group 'sound
119   :type 'string)
120
121 (defcustom default-sound-directory-list (locate-data-directory-list "sounds")
122   "List of directories which to search for sound files"
123   :group 'sound
124   :type '(repeat directory )
125   )
126
127 ;;;###autoload
128 (or sound-alist
129     ;; these should be silent until sounds are loaded
130     (setq sound-alist '((ready nil) (warp nil))))
131
132 ;;;###autoload
133 (defun load-sound-file (filename sound-name &optional volume)
134   "Read in an audio-file and add it to the sound-alist.
135
136 FILENAME can either be absolute or relative, in which case the file will
137 be searched in the directories given by `default-sound-directory-list'.
138 When looking for the file, the extensions given by `sound-extension-list' are
139 also tried in the given order.
140
141 You can only play sound files if you are running on display 0 of the
142 console of a machine with native sound support or running a NetAudio
143 server and XEmacs has the necessary sound support compiled in.
144
145 The sound file must be in the Sun/NeXT U-LAW format, except on Linux,
146 where .wav files are also supported by the sound card drivers."
147   (interactive "fSound file name: \n\
148 SSymbol to name this sound: \n\
149 nVolume (0 for default): ")
150   (unless (symbolp sound-name)
151     (error "sound-name not a symbol"))
152   (unless (or (null volume) (integerp volume))
153     (error "volume not an integer or nil"))
154   (let ((file (if (file-name-absolute-p filename)
155                   ;; For absolute file names, we don't have on choice on the
156                   ;; location, but sound extensions however can still be tried
157                   (setq file (locate-file filename
158                                           (list (file-name-directory filename))
159                                           (split-string sound-extension-list
160                                                         ":")))
161                 (setq file (locate-file filename
162                                         default-sound-directory-list
163                                         (split-string sound-extension-list
164                                                       ":")))))
165         buf data)
166     (unless file
167       (error "Couldn't load sound file %s" filename))
168     (unwind-protect
169         (save-excursion
170           (set-buffer (setq buf (get-buffer-create " *sound-tmp*")))
171           (buffer-disable-undo (current-buffer))
172           (erase-buffer)
173           (let ((coding-system-for-read 'binary))
174             (insert-file-contents  file))
175           (setq data (buffer-string))
176           (erase-buffer))
177       (and buf (kill-buffer buf)))
178     (let ((old (assq sound-name sound-alist)))
179       ;; some conses in sound-alist might have been dumped with emacs.
180       (if old (setq sound-alist (delq old (copy-sequence sound-alist)))))
181     (setq sound-alist (cons
182                        (nconc (list sound-name)
183                               (if (and volume (not (eq 0 volume)))
184                                   (list ':volume volume))
185                               (list ':sound data))
186                        sound-alist)))
187   sound-name)
188
189 ;;;###autoload
190 (defun load-default-sounds ()
191   "Load and install some sound files as beep-types, using
192 `load-sound-file'.  This only works if you're on display 0 of the
193 console of a machine with native sound support or running a NetAudio
194 server and XEmacs has the necessary sound support compiled in."
195   (interactive)
196   ;; #### - this should do NOTHING if the sounds can't be played.
197   (message "Loading sounds...")
198   (setq sound-alist nil)
199   ;; this is where the calls to load-sound-file get done
200   (mapc 'eval sound-load-list)
201   (setq sound-alist
202         (append sound-default-alist
203                 sound-alist))
204   (message "Loading sounds...done")
205   ;; (beep nil 'quiet)
206   )
207
208 ;;; sound.el ends here.