home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / prim / sound.el < prev    next >
Encoding:
Text File  |  1992-07-07  |  2.8 KB  |  75 lines
  1. ;; Basic lisp subroutines for Emacs
  2. ;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 2, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (defun load-sound-file (filename sound-name &optional volume)
  21.   "Read in an audio-file and add it to the sound-alist.
  22.  
  23. You can only play sound files if you are running on display 0 of the console
  24. of a Sun SparcStation or an SGI machine.  The sound file must be in the
  25. Sun/NeXT U-LAW format."
  26.   (interactive "fSound file name: \n\
  27. SSymbol to name this sound: \n\
  28. nVolume (0 for default): ")
  29.   (or (symbolp sound-name) (error "sound-name not a symbol"))
  30.   (or (null volume) (integerp volume) (error "volume not an integer or nil"))
  31.   (let (buf data)
  32.     (unwind-protect
  33.     (save-excursion
  34.       (set-buffer (setq buf (get-buffer-create " *sound-tmp*")))
  35.       (erase-buffer)
  36.       (insert-file-contents filename)
  37.       (setq data (buffer-string))
  38.       (erase-buffer))
  39.       (and buf (kill-buffer buf)))
  40.     (let ((old (assq sound-name sound-alist)))
  41.       ;; some conses in sound-alist might have been dumped with emacs.
  42.       (if old (setq sound-alist (delq old (copy-sequence sound-alist)))))
  43.     (setq sound-alist (cons
  44.             (purecopy
  45.               (if (and volume (not (eq 0 volume)))
  46.                   (list sound-name volume data)
  47.                   (cons sound-name data)))
  48.                sound-alist)))
  49.   sound-name)
  50.  
  51. (defun load-default-sounds ()
  52.   "Load and install some sound files as beep-types.
  53. This only works if you're on display 0 of a Sun SparcStation or SGI machine."
  54.   (interactive)
  55.   (message "Loading sounds...")
  56.   (setq sound-alist nil)
  57.   (let ((default-directory exec-directory))
  58.     (load-sound-file "sounds/drum-beep.au"    'drum)
  59.     (load-sound-file "sounds/quiet-beep.au"    'quiet)
  60.     (load-sound-file "sounds/bass-snap.au"    'bass 80)
  61.     (load-sound-file "sounds/whip.au"        'whip 70))
  62.   (setq sound-alist (append '((default        bass)
  63.                   (undefined-key    drum)
  64.                   (undefined-click    drum)
  65.                   (command-error    bass)
  66.                   (no-completion    whip)
  67.                   (y-or-n-p        quiet)
  68.                   (yes-or-no-p    quiet)
  69.                   (isearch-failed    quiet)
  70.                   (isearch-quit    bass)
  71.                   (auto-save-error    whip 100))
  72.                 sound-alist))
  73.   (message "Loading sounds...done")
  74.   (beep nil 'quiet))
  75.