cgit.sxemacs.org Git - sxemacs/blob - lisp/sound.el

   1 ;;; sound.el --- Loading sound files in SXEmacs
   2
   3 ;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
   5 ;; Copyright (C) 2006 Sebastian Freundt
   6
   7 ;; Maintainer: SXEmacs Development Team
   8 ;; Keywords: internal
   9
  10 ;; This file is part of SXEmacs.
  11
  12 ;; SXEmacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; SXEmacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Synched up with: Not in FSF.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30 (defgroup sound nil
  31   "Configure SXEmacs sounds and properties"
  32   :group 'environment)
  33
  34 (defcustom sound-default-alist
  35       '((default                :sound bass)
  36         (undefined-key  :sound drum)
  37         (undefined-click        :sound drum)
  38         ;; beginning-of-buffer or end-of-buffer errors.
  39         (buffer-bound   :sound drum)
  40         ;; buffer-read-only error
  41         (read-only              :sound drum)
  42         ;; non-interactive function or lambda called
  43         (command-error  :sound bass)
  44         (y-or-n-p               :sound quiet)
  45         (yes-or-no-p            :sound quiet)
  46         (auto-save-error        :sound whip :volume 100)
  47         (no-completion  :sound whip)
  48         (isearch-failed :sound quiet)
  49         (isearch-quit   :sound bass)
  50         ;; QUIT: sound generated by ^G and its variants.
  51         (quit           :sound quiet :volume 75)
  52         ;; READY: time-consuming task has completed...  compile,
  53         ;; cvs-update, etc.
  54         (ready          :sound cuckoo)
  55         ;; WARP: XEmacs has changed the selected-window or frame
  56         ;; asynchronously...  Especially when it's done by an
  57         ;; asynchronous process filter.  Perhaps by a debugger breakpoint
  58         ;; has been hit?
  59         (warp           :sound yeep :volume 75)
  60         ;; ALARM: used for reminders...
  61         (alarm          :sound cuckoo :volume 100)
  62         )
  63       "The alist of sounds and associated error symbols.
  64
  65  Used to set sound-alist in load-default-sounds."
  66       :group 'sound
  67       :type '(repeat
  68               (group (symbol :tag "Name")
  69                      (checklist :inline t
  70                                 :greedy t
  71                                 (group :inline t
  72                                        (const :format "" :value :sound)
  73                                        (symbol :tag "Sound"))
  74                                 (group :inline t
  75                                        (const :format "" :value :volume)
  76                                        (integer :tag "Volume"))
  77                                 (group :inline t
  78                                        (const :format "" :value :pitch)
  79                                        (integer :tag "Pitch"))
  80                                 (group :inline t
  81                                        (const :format "" :value :duration)
  82                                        (integer :tag "Duration"))))))
  83
  84 (defcustom sound-load-list
  85   '((load-sound-file "drum-beep"        'drum)
  86     (load-sound-file "quiet-beep"       'quiet)
  87     (load-sound-file "bass-snap"        'bass 80)
  88     (load-sound-file "whip"             'whip 70)
  89     (load-sound-file "cuckoo"           'cuckoo)
  90     (load-sound-file "yeep"             'yeep)
  91     (load-sound-file "hype"             'hype 100)
  92     )
  93   "A list of calls to load-sound-file to be processed by load-default-sounds.
  94
  95   Reference load-sound-file for more information."
  96
  97   :group 'sound
  98   :type '(repeat  (sexp :tag "Sound")
  99                   ))
 100
 101 (defcustom default-sound-directory (locate-data-directory "sounds")
 102   "Default directory to load a sound file from."
 103   :group 'sound
 104   :type 'directory
 105   )
 106
 107 ;; #### This should really be a list.  --hniksic
 108 ;; #### It is now :) -hroptatyr
 109 (defcustom sound-extension-list (cond ((eq system-type 'linux)
 110                                        '(".wav" ".au" ".mp3" ".mka" ".ogg"
 111                                          ".aac" ".ac3" ".mp4" ".flac"
 112                                          ".mpc" ".mpa"))
 113                                       (t
 114                                        '(".au")))
 115   "List of filename extensions to complete sound file name with."
 116   :group 'sound
 117   :type 'string)
 118
 119 (defcustom default-sound-directory-list (locate-data-directory-list "sounds")
 120   "List of directories which to search for sound files"
 121   :group 'sound
 122   :type '(repeat directory )
 123   )
 124
 125 (defvar default-media-stream-volume nil
 126   "*The default volume to assign to media streams
 127 when an explicit volume parameter is omitted.")
 128
 129 ;;;###autoload
 130 (or sound-alist
 131     ;; these should be silent until sounds are loaded
 132     (setq sound-alist '((ready nil) (warp nil))))
 133
 134 (eval-when-compile (defvar file))
 135
 136 (defun locate-sound-file (filename)
 137   "Search for FILENAME in `default-sound-directory-list'
 138 with respect to the extensions given by `sound-extension-list'."
 139   (let ((exts (cond ((listp sound-extension-list)
 140                      sound-extension-list)
 141                     ((stringp sound-extension-list)
 142                      (split-string sound-extension-list ":"))
 143                     (t nil))))
 144
 145     (cond ((file-exists-p filename)
 146            (expand-file-name filename))
 147           ((file-name-absolute-p filename)
 148            ;; For absolute file names, we don't have on choice on the
 149            ;; location, but sound extensions however can still be tried
 150            (setq file (locate-file filename
 151                                    (list (file-name-directory filename))
 152                                    exts)))
 153           (t
 154            (setq file (locate-file filename
 155                                    default-sound-directory-list
 156                                    exts))))))
 157
 158 (defun make-sound-alist-item (filename sound-name &optional volume)
 159   "Return an item suitable for `sound-alist'."
 160   (let* ((file (locate-sound-file filename))
 161          ;; let's create media-streams
 162          (stream (make-media-stream :file file))
 163          (data))
 164
 165     (unless file
 166       (error "Couldn't load sound file %s" filename))
 167
 168 ;; DEPRECATED as of merge of hrop-feat-MM series
 169 ;;     (unwind-protect
 170 ;;         (save-excursion
 171 ;;           (set-buffer (setq buf (get-buffer-create " *sound-tmp*")))
 172 ;;           (buffer-disable-undo (current-buffer))
 173 ;;           (erase-buffer)
 174 ;;           (let ((coding-system-for-read 'binary))
 175 ;;             (insert-file-contents  file))
 176 ;;           (setq data (buffer-string))
 177 ;;           (erase-buffer))
 178 ;;       (and buf (kill-buffer buf)))
 179
 180     (nconc (list sound-name)
 181            (if (and volume (not (eq 0 volume)))
 182                (list ':volume volume))
 183            (if data
 184                (list ':sound data))
 185            (list ':stream stream))))
 186
 187 ;;;###autoload
 188 (defun load-sound-file (filename sound-name &optional volume)
 189   "Read in an audio-file and add it to the sound-alist.
 190 The cached sound can be referenced later by SOUND-NAME.
 191
 192 FILENAME can either be absolute or relative, in which case the file will
 193 be searched in the directories given by `default-sound-directory-list'.
 194 When looking for the file, the extensions given by `sound-extension-list' are
 195 also tried in the given order."
 196   (interactive "fSound file name: \n\
 197 SSymbol to name this sound: \n\
 198 nVolume (0 for default): ")
 199   (unless (symbolp sound-name)
 200     (error "sound-name not a symbol"))
 201   (unless (or (null volume) (integerp volume))
 202     (error "volume not an integer or nil"))
 203
 204   (let ((item (make-sound-alist-item filename sound-name volume))
 205         (old (assq sound-name sound-alist)))
 206
 207       ;; some conses in sound-alist might have been dumped with emacs.
 208       (when old
 209         (setq sound-alist (delq old (copy-sequence sound-alist))))
 210
 211       (setq sound-alist (cons item sound-alist)))
 212   sound-name)
 213
 214 ;;;###autoload
 215 (defun load-default-sounds ()
 216   "Load and install some sound files as beep-types, using
 217 `load-sound-file'.  This only works if you specify `default-audio-device'."
 218   (interactive)
 219   ;; #### - this should do NOTHING if the sounds can't be played.
 220   (message "Loading sounds...")
 221   (setq sound-alist nil)
 222   ;; this is where the calls to load-sound-file get done
 223   (mapc 'eval sound-load-list)
 224   (setq sound-alist
 225         (append sound-default-alist
 226                 sound-alist))
 227   (message "Loading sounds...done")
 228   ;; (beep nil 'quiet)
 229   )
 230
 231 ;;;###autoload
 232 (defun play-media-stream (stream &optional device sentinel volume)
 233   "Play the media stream STREAM on an audio device.
 234 STREAM must be a valid media-stream object as created by
 235 `make-media-stream'.
 236 Return a media-thread object which can be used to interact with
 237 the worker thread which handles STREAM, which of course is only
 238 useful in asynchronous mode.
 239
 240 This function uses the value of `synchronous-sounds' to decide
 241 if a stream is played synchronously or asynchronously.
 242 See `play-media-stream-synchronously' and
 243 `play-media-stream&'.
 244
 245 Optional second argument DEVICE must be an audio device created
 246 by `make-audio-device'.
 247 If omitted DEVICE defaults to the value of `default-audio-device'.
 248
 249 Optional third argument SENTINEL specifies a lisp function to be
 250 called after the stream playback finishes.  The function should
 251 take one argument (STREAM) where STREAM is bound to the
 252 media stream which finished.  See `set-media-thread-sentinel'.
 253
 254 Optional fourth argument VOLUME specifies an initial value for
 255 the playback volume.
 256
 257
 258 Depending on the value of `synchronous-sounds' this function will
 259 decide whether to play either asynchronously or synchronously.
 260
 261 If `synchronous-sounds' is `nil' AND threads are supported,
 262 streams will be passed to the `play-media-stream&'
 263 function.
 264 In that case return a media-thread object which can be used to
 265 interact with the worker thread which handles STREAM.
 266
 267 If `synchronous-sounds' is non-`nil' OR threads are not supported,
 268 streams will be passed to the `play-media-stream-synchronously'
 269 function.
 270 In that case return non-`nil' if STREAM was played successfully,
 271 and `nil' otherwise.
 272
 273 See `play-media-stream-synchronously' and
 274 `play-media-stream&'."
 275   (let* ((vol (or volume default-media-stream-volume)))
 276     (if (and (fboundp #'play-media-stream&)
 277              (not synchronous-sounds))
 278         (play-media-stream& stream device sentinel vol)
 279       (play-media-stream-synchronously stream device sentinel vol))))
 280
 281 ;;;###autoload
 282 (defun play-sound (sound &optional volume device sentinel)
 283   "Play the sound SOUND from `sound-alist'.
 284
 285 The sound is played at the specified VOLUME \(0-100, default
 286 specified by the `bell-volume' variable\).
 287
 288 With no further media drivers, the sound file must be in the
 289 Sun/NeXT U-LAW format. Under Linux WAV files are also supported.
 290
 291 DEVICE can be any device created by `make-audio-device' and
 292 defaults to `default-audio-device', or, if that is `nil',
 293 to the selected device.
 294
 295 Optional argument SENTINEL specifies a lisp function to be
 296 called after the stream playback finishes.  The function should
 297 take two arguments (STREAM STATE) where STREAM is bound to the
 298 media stream which finished and STATE is a symbol \(currently the
 299 only valid symbol is 'finished\).  See `set-media-thread-sentinel'."
 300   (let ((data (cdr-safe (assq sound sound-alist))))
 301     (when (and data default-audio-device)
 302       (let ((ms (or (plist-get data :stream)
 303                     (let ((s (plist-get data :sound)))
 304                       (and (stringp s)
 305                            (make-media-stream :data s)))))
 306             (vol
 307              (plist-get data :volume
 308                         (or volume default-media-stream-volume bell-volume))))
 309         (when ms
 310           (play-media-stream ms device sentinel vol))))))
 311
 312 ;;; sound.el ends here.