Mercurial > hg > xemacs-beta
view lisp/sound.el @ 1346:01c57eb70ae9
[xemacs-hg @ 2003-03-09 02:27:27 by ben]
To: xemacs-patches@xemacs.org
i.c: Sleep between calls to check for I/O, since these calls are non-blocking.
behavior.el: Allow other keywords for forward compatibility.
cl-macs.el: Rewrite to eliminate byte-compiler warning when `return' is used
without `finally'.
cmdloop.el: Avoid truncated error messages for `end-of-file' and the like.
cmdloop.el: Avoid char-int error after syncing.
files.el: Eliminate byte-compile warnings.
printer.el: Fix line-width calculations.
#### This used to work. Someone's changes (perhaps by
Michael Sperber?) seem to have messed something up.
simple.el: Use new clear-left-side functions to avoid messages ending up on
the same line as other output.
xemacs.mak: Add override for info/ as well when separate source/build dirs.
xemacs.mak: Order sections in main build process and add comments. Add
additional dependencies to try and prevent later steps from
happening when failures in earlier steps have occurred.
Makefile.in.in: Order sections in main build process and add comments. Add
additional dependencies to try and prevent later steps from
happening when failures in earlier steps have occurred.
alloc.c: Don't arbitrarily clear Vconfigure_info_directory since it
messes up separate build/source dirs.
console.c, console.h, device-msw.c, device.c: Add accidentally omitted msprinter console and data descriptions.
print.c, console-msw.c: Add clear-left-side functionality to help keep stdio/stderr
output from separate sources on separate lines. Generalize
the different kinds of debugging output. Add dpa().
profile.c: Add better docs on Unix/Windows differences.
regex.c: Fix problems with rel-alloc compilation caused by previous patch.
emacs.c: Seg fault rather than abort on Cygwin, since gdb doesn't trap
aborts properly.
console-gtk-impl.h, console-gtk.h, console-msw.h, console-x-impl.h, console-x.h, dialog-gtk.c, dialog-x.c, event-msw.c, frame-gtk.c, frame-x.c, frameslots.h, glyphs-gtk.c, glyphs-x.c, gui-gtk.c, gui-x.c, inline.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, scrollbar-gtk.c, scrollbar-x.c, ui-gtk.c: Delete popup-data object. Delete menubar_data field from frames,
since its usage is frame-specific. Delete menubar-msw.h,
gui-x.h, gui-gtk.h. Clean up handling of lwlib callback data
GCPRO'ing and add missing GCPRO recomputation in widget code.
| author | ben |
|---|---|
| date | Sun, 09 Mar 2003 02:27:46 +0000 |
| parents | e38acbeb1cae |
| children | 2a54dfbe434f 308d34e9f07d |
line wrap: on
line source
;;; 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. ;; Copyright (C) 2002 Ben Wing. ;; 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) ;; any error other than those handled by undefined-key, ;; undefined-click, buffer-bound, read-only (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 (cond ((or (eq system-type 'cygwin32) (eq system-type 'windows-nt)) ".wav:") ((eq system-type 'linux) ".wav:.au:") (t ".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. FILENAME can either be absolute or relative, in which case the file will be searched in the directories given by `default-sound-directory-list'. When looking for the file, the extensions given by `sound-extension-list' are also tried in the given order. 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 or ESD 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 and MS Windows, 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 ((file ;; For absolute file names, we don't have on choice on the ;; location, but sound extensions however can still be tried (locate-file filename (if (file-name-absolute-p filename) (list (file-name-directory filename)) default-sound-directory-list) (split-string sound-extension-list ":"))) buf data) (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 (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.
