git.chise.org Git - chise/xemacs-chise.git-/blob - 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.