git.chise.org Git - chise/xemacs-chise.git.1/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-alist
  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 (defcustom sound-ext (if (or (eq system-type 'cygwin32)
 109                              (eq system-type 'windows-nt))
 110                          ".wav:" ".au:")
 111   "Filename extensions to complete sound file name with. If more than one
 112    extension is used, they should be separated by \":\". "
 113   :group 'sound
 114   :type 'string)
 115
 116 (defcustom default-sound-directory-list ( list default-sound-directory )
 117
 118   "List of directories which to search for sound files"
 119   :group 'sound
 120   :type '(repeat directory )
 121   )
 122
 123 ;;;###autoload
 124 (or sound-alist
 125     ;; these should be silent until sounds are loaded
 126     (setq sound-alist '((ready nil) (warp nil))))
 127
 128 ;;;###autoload
 129 (defun load-sound-file (filename sound-name &optional volume)
 130   "Read in an audio-file and add it to the sound-alist.
 131
 132 You can only play sound files if you are running on display 0 of the
 133 console of a machine with native sound support or running a NetAudio
 134 server and XEmacs has the necessary sound support compiled in.
 135
 136 The sound file must be in the Sun/NeXT U-LAW format, except on Linux,
 137 where .wav files are also supported by the sound card drivers."
 138   (interactive "fSound file name: \n\
 139 SSymbol to name this sound: \n\
 140 nVolume (0 for default): ")
 141   (unless (symbolp sound-name)
 142     (error "sound-name not a symbol"))
 143   (unless (or (null volume) (integerp volume))
 144     (error "volume not an integer or nil"))
 145   (let (buf
 146         data
 147         (file (locate-file filename  default-sound-directory-list  sound-ext)))
 148     (unless file
 149       (error "Couldn't load sound file %s" filename))
 150     (unwind-protect
 151         (save-excursion
 152           (set-buffer (setq buf (get-buffer-create " *sound-tmp*")))
 153           (buffer-disable-undo (current-buffer))
 154           (erase-buffer)
 155           (let ((coding-system-for-read 'binary))
 156             (insert-file-contents  file))
 157           (setq data (buffer-string))
 158           (erase-buffer))
 159       (and buf (kill-buffer buf)))
 160     (let ((old (assq sound-name sound-alist)))
 161       ;; some conses in sound-alist might have been dumped with emacs.
 162       (if old (setq sound-alist (delq old (copy-sequence sound-alist)))))
 163     (setq sound-alist (cons
 164                         (purecopy
 165                          (nconc (list sound-name)
 166                                 (if (and volume (not (eq 0 volume)))
 167                                     (list ':volume volume))
 168                                (list ':sound data)))
 169                         sound-alist)))
 170   sound-name)
 171
 172 ;;;###autoload
 173 (defun load-default-sounds ()
 174   "Load and install some sound files as beep-types, using
 175 `load-sound-file'.  This only works if you're on display 0 of the
 176 console of a machine with native sound support or running a NetAudio
 177 server and XEmacs has the necessary sound support compiled in."
 178   (interactive)
 179   ;; #### - this should do NOTHING if the sounds can't be played.
 180   (message "Loading sounds...")
 181   (setq sound-alist nil)
 182   ;; this is where the calls to load-sound-file get done
 183   (mapc 'eval sound-load-alist)
 184   (setq sound-alist
 185         (append sound-default-alist
 186                 sound-alist))
 187   (message "Loading sounds...done")
 188   ;; (beep nil 'quiet)
 189   )
 190
 191 ;;; sound.el ends here.