--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/sound.el	Mon Aug 13 11:28:15 2007 +0200
@@ -0,0 +1,193 @@
+;;; sound.el --- Loading sound files in XEmacs
+
+;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
+
+;; Maintainer: XEmacs Development Team
+;; Keywords: internal
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Commentary:
+
+;;; Code:
+(defgroup sound nil
+  "Configure XEmacs sounds and properties"
+  :group 'environment)
+
+(defcustom sound-default-alist
+      '((default		:sound bass)
+	(undefined-key	:sound drum)
+	(undefined-click	:sound drum)
+	;; beginning-of-buffer or end-of-buffer errors.
+	(buffer-bound	:sound drum)
+	;; buffer-read-only error
+	(read-only	        :sound drum)
+	;; non-interactive function or lambda called
+	(command-error	:sound bass)
+	(y-or-n-p		:sound quiet)
+	(yes-or-no-p		:sound quiet)
+	(auto-save-error	:sound whip :volume 100)
+	(no-completion	:sound whip)
+	(isearch-failed	:sound quiet)
+	(isearch-quit	:sound bass)
+	;; QUIT: sound generated by ^G and its variants.
+	(quit		:sound quiet :volume 75)
+	;; READY: time-consuming task has completed...  compile,
+	;; cvs-update, etc.
+	(ready		:sound cuckoo)
+	;; WARP: XEmacs has changed the selected-window or frame
+	;; asynchronously...  Especially when it's done by an
+	;; asynchronous process filter.  Perhaps by a debugger breakpoint
+	;; has been hit?
+	(warp		:sound yeep :volume 75)
+	;; ALARM: used for reminders...
+	(alarm		:sound cuckoo :volume 100)
+	)
+      "The alist of sounds and associated error symbols.
+
+ Used to set sound-alist in load-default-sounds."
+      :group 'sound
+      :type '(repeat
+	      (group (symbol :tag "Name")
+		     (checklist :inline t
+				:greedy t
+				(group :inline t
+				       (const :format "" :value :sound)
+				       (symbol :tag "Sound"))
+				(group :inline t
+				       (const :format "" :value :volume)
+				       (integer :tag "Volume"))
+				(group :inline t
+				       (const :format "" :value :pitch)
+				       (integer :tag "Pitch"))
+				(group :inline t
+				       (const :format "" :value :duration)
+				       (integer :tag "Duration"))))))
+
+(defcustom sound-load-list
+  '((load-sound-file "drum-beep"	'drum)
+    (load-sound-file "quiet-beep"	'quiet)
+    (load-sound-file "bass-snap"	'bass 80)
+    (load-sound-file "whip"		'whip 70)
+    (load-sound-file "cuckoo"		'cuckoo)
+    (load-sound-file "yeep"		'yeep)
+    (load-sound-file "hype"		'hype 100)
+    )
+  "A list of calls to load-sound-file to be processed by load-default-sounds.
+
+  Reference load-sound-file for more information."
+
+  :group 'sound
+  :type '(repeat  (sexp :tag "Sound")
+		  ))
+
+(defcustom default-sound-directory (locate-data-directory "sounds")
+  "Default directory to load a sound file from."
+  :group 'sound
+  :type 'directory
+  )
+
+;; #### This should really be a list.  --hniksic
+(defcustom sound-extension-list (if (or (eq system-type 'cygwin32)
+					(eq system-type 'windows-nt))
+				    ".wav:" ".au:")
+  "Filename extensions to complete sound file name with. If more than one
+   extension is used, they should be separated by \":\". "
+  :group 'sound
+  :type 'string)
+
+(defcustom default-sound-directory-list (locate-data-directory-list "sounds")
+
+  "List of directories which to search for sound files"
+  :group 'sound
+  :type '(repeat directory )
+  )
+
+;;;###autoload
+(or sound-alist
+    ;; these should be silent until sounds are loaded
+    (setq sound-alist '((ready nil) (warp nil))))
+
+;;;###autoload
+(defun load-sound-file (filename sound-name &optional volume)
+  "Read in an audio-file and add it to the sound-alist.
+
+You can only play sound files if you are running on display 0 of the
+console of a machine with native sound support or running a NetAudio
+server and XEmacs has the necessary sound support compiled in.
+
+The sound file must be in the Sun/NeXT U-LAW format, except on Linux,
+where .wav files are also supported by the sound card drivers."
+  (interactive "fSound file name: \n\
+SSymbol to name this sound: \n\
+nVolume (0 for default): ")
+  (unless (symbolp sound-name)
+    (error "sound-name not a symbol"))
+  (unless (or (null volume) (integerp volume))
+    (error "volume not an integer or nil"))
+  (let (buf
+	data
+	(file (locate-file filename default-sound-directory-list
+			   sound-extension-list)))
+    (unless file
+      (error "Couldn't load sound file %s" filename))
+    (unwind-protect
+	(save-excursion
+	  (set-buffer (setq buf (get-buffer-create " *sound-tmp*")))
+	  (buffer-disable-undo (current-buffer))
+	  (erase-buffer)
+	  (let ((coding-system-for-read 'binary))
+	    (insert-file-contents  file))
+	  (setq data (buffer-string))
+	  (erase-buffer))
+      (and buf (kill-buffer buf)))
+    (let ((old (assq sound-name sound-alist)))
+      ;; some conses in sound-alist might have been dumped with emacs.
+      (if old (setq sound-alist (delq old (copy-sequence sound-alist)))))
+    (setq sound-alist (cons
+			(purecopy
+			 (nconc (list sound-name)
+				(if (and volume (not (eq 0 volume)))
+				    (list ':volume volume))
+			       (list ':sound data)))
+			sound-alist)))
+  sound-name)
+
+;;;###autoload
+(defun load-default-sounds ()
+  "Load and install some sound files as beep-types, using
+`load-sound-file'.  This only works if you're on display 0 of the
+console of a machine with native sound support or running a NetAudio
+server and XEmacs has the necessary sound support compiled in."
+  (interactive)
+  ;; #### - this should do NOTHING if the sounds can't be played.
+  (message "Loading sounds...")
+  (setq sound-alist nil)
+  ;; this is where the calls to load-sound-file get done
+  (mapc 'eval sound-load-list)
+  (setq sound-alist
+	(append sound-default-alist
+		sound-alist))
+  (message "Loading sounds...done")
+  ;; (beep nil 'quiet)
+  )
+
+;;; sound.el ends here.