cgit.sxemacs.org Git - packages/blob - xemacs-packages/xwem/lisp/xwem-sound.el

   1 ;;; xwem-sound.el --- Sound support.
   2
   3 ;; Copyright (C) 2004,2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Wed Jan 28 22:25:44 MSK 2004
   7 ;; Keywords: xwem
   8 ;; X-CVS: $Id: xwem-sound.el,v 1.8 2005-04-04 19:54:15 lg Exp $
   9
  10 ;; This file is part of XWEM.
  11
  12 ;; XWEM is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF
  28
  29 ;;; Commentary:
  30
  31 ;; XWEM support sounds. Wooouuhha xwem is multimedia awared WM :).
  32
  33 ;; Set `xwem-visible-bell' to non-nil if you dislike beeping.
  34
  35 ;;; Code:
  36 \f
  37 (require 'xwem-load)
  38
  39 ;;; Customisation
  40 (defgroup xwem-sound nil
  41   "Group to customize XWEM sounds."
  42   :prefix "xwem-sound-"
  43   :prefix "xwem-"
  44   :group 'xwem)
  45
  46 (defcustom xwem-sound-default-alist
  47   '((default :sound bass)
  48     (undefined-key :sound drum)
  49     (command-fail :sound bass)
  50     (quit :sound quiet :volume 75)
  51     (ready :sound cuckoo)
  52     (alarm :sound cuckoo :volume 100)
  53     (warning :sound clink :volume 70)
  54     (error :sound bong :volume 100))
  55   "The alist of sounds and associated error symbols.
  56 Used to set `xwem-sound-alist' in `xwem-sound-load-default'."
  57   :group 'xwem-sound
  58   :type '(repeat
  59           (group (symbol :tag "Name")
  60                  (checklist :inline t
  61                             :greedy t
  62                             (group :inline t
  63                                    (const :format "" :value :sound)
  64                                    (symbol :tag "Sound"))
  65                             (group :inline t
  66                                    (const :format "" :value :volume)
  67                                    (integer :tag "Volume"))
  68                             (group :inline t
  69                                    (const :format "" :value :pitch)
  70                                    (integer :tag "Pitch"))
  71                             (group :inline t
  72                                    (const :format "" :value :duration)
  73                                    (integer :tag "Duration"))))))
  74
  75 (defcustom xwem-sound-beeping-alist
  76   '((default :sound t :pitch 70 :duration 15 :volume 100)
  77     (undefined-key :sound t :pitch 100 :duration 10 :volume 100)
  78     (command-fail :sound t :pitch 1000 :duration 40 :volume 100)
  79     ;; H-g
  80     (quit :sound t :pitch 70 :duration 5 :volume 100)
  81     ;; Ready: time cunsuming task has beed done .. compile, cvs,
  82     ;; etc.
  83     (ready :sound t :pitch 800 :duration 50 :volume 100)
  84     ;; alarm: used by reminders
  85     (alarm :sound t :pitch 2000 :duration 150 :volume 100)
  86
  87     (warning :sound t :pitch 50 :duration 10 :volume 100)
  88     (error :sound t :pitch 3000 :duration 50 :volume 100)
  89     )
  90   "X Bell oriented candidate for `xwem-sound-alist'.
  91 Format is identical as for `xwem-sound-default-alist'."
  92   :group 'xwem-sound
  93   :type '(repeat
  94           (group (symbol :tag "Name")
  95                  (checklist :inline t
  96                             :greedy t
  97                             (group :inline t
  98                                    (const :format "" :value :sound)
  99                                    (symbol :tag "Sound"))
 100                             (group :inline t
 101                                    (const :format "" :value :volume)
 102                                    (integer :tag "Volume"))
 103                             (group :inline t
 104                                    (const :format "" :value :pitch)
 105                                    (integer :tag "Pitch"))
 106                             (group :inline t
 107                                    (const :format "" :value :duration)
 108                                    (integer :tag "Duration"))))))
 109
 110 (defcustom xwem-sound-directory (locate-data-directory "sounds")
 111   "Default directory to load sound files."
 112   :type 'directory
 113   :group 'sound)
 114
 115 (defcustom xwem-sound-directory-list (locate-data-directory-list "sounds")
 116   "List of directories, which to search for sound files."
 117   :type '(repeat directory)
 118   :group 'xwem-sound)
 119
 120 (defcustom xwem-sound-extension-list ".au:"
 121   "Filename extensions to complete sound file name with. If more than one
 122    extension is used, they should be separated by \":\". "
 123   :type 'string
 124   :group 'xwem-sound)
 125
 126 ;;;###autoload
 127 (defcustom xwem-sound-list
 128   '((xwem-sound-file-load "bass-snap" 'bass 100)
 129     (xwem-sound-file-load "drum-beep" 'drum 100)
 130     (xwem-sound-file-load "quiet-beep" 'quiet 100)
 131     (xwem-sound-file-load "cuckoo" 'cuckoo 100)
 132     (xwem-sound-file-load "clink" 'clink 100)
 133     (xwem-sound-file-load "bong" 'bong 100)
 134     (xwem-sound-file-load "say-beep" 'say-beep 100)
 135     )
 136   "A list of calls to `xwem-sound-file-load' to be processed by `xwem-sound-load-default'.
 137 Reference `xwem-sound-file-load' for detailed information."
 138   :type '(repeat (sexp :tag "Sound"))
 139   :group 'xwem-sound)
 140
 141 (defcustom xwem-visible-bell nil
 142   "*If non-nil mean try to flash selected frame to represent a bell."
 143   :type 'boolean
 144   :group 'xwem-sound)
 145
 146 ;;; Internal variables
 147
 148 ;;;###autoload
 149 (defvar xwem-sound-alist nil
 150   "Sound alist for use by XWEM.
 151 Format is identical as for `sound-alist'.
 152 Error symbols are:
 153   default -- When nothing else matches.
 154   quit -- After \\<xwem-global-map>\\[xwem-kbd-quit]
 155   undefined-key -- Keybinding undefined.
 156   command-fail -- When execution of command failed.
 157   warning -- Some one warnings you.
 158   error -- Some one reports you an error.
 159   ready -- Time consumed task has been done.
 160   alarm -- Used by reminders.")
 161
 162 (defun xwem-sound-file-load (filename sound-name &optional volume)
 163   "Read an audio FILE and return a valid node for use in `xwem-sound-alist'."
 164   (unless (symbolp sound-name)
 165     (error 'xwem-error "SOUND-NAME not a symbol"))
 166   (unless (or (null volume) (integerp volume))
 167     (error 'xwem-error "VOLUME not an integer or nil"))
 168
 169   (let ((file (locate-file filename xwem-sound-directory-list
 170                            xwem-sound-extension-list))
 171         buf data)
 172     (unless file
 173       (error 'xwem-error "Couldn't locate sound file %s" filename))
 174
 175     (unwind-protect
 176         (save-excursion
 177           (set-buffer (setq buf (get-buffer-create " *sound-tmp*")))
 178           (buffer-disable-undo (current-buffer))
 179           (erase-buffer)
 180           (let ((coding-system-for-read 'binary))
 181             (setq coding-system-for-read coding-system-for-read) ; shut up compiler
 182             (insert-file-contents file))
 183           (setq data (buffer-string))
 184           (erase-buffer))
 185       (and buf (kill-buffer buf)))
 186
 187     (nconc (list sound-name) (when volume (list :volume volume))
 188            (list :sound data))))
 189
 190 (defun xwem-sound-do-visible-bell ()
 191   "Visible bell."
 192   (let* ((gc-cons-threshold most-positive-fixnum) ; inhibit gcing
 193          (xdpy (xwem-dpy))
 194          (frame (xwem-frame-selected))
 195          (gc (XCreateGC xdpy (xwem-frame-xwin frame)
 196                         (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
 197                                    :function X-GXInvert
 198                                    :subwindow-mode X-IncludeInferiors))))
 199     (XGrabServer xdpy)
 200     (xwem-unwind-protect
 201         (progn
 202           (XFillRectangle xdpy (xwem-frame-xwin frame)
 203                           gc 0 0 (xwem-frame-width frame)
 204                           (xwem-frame-height frame))
 205
 206           ;; XXX we need sleeping, so flashing will be visible
 207           (sleep-for 0.1)
 208
 209           (XFillRectangle xdpy (xwem-frame-xwin frame)
 210                           gc 0 0 (xwem-frame-width frame)
 211                           (xwem-frame-height frame)))
 212       (XUngrabServer xdpy)
 213       (XFreeGC xdpy gc))))
 214
 215 ;;;###autoload
 216 (defun xwem-play-sound (sound &optional volume)
 217   "Play a sound of provided SOUND type.
 218 If VOLUME is specified, it overrides the value specified in
 219 `xwem-sound-alist'."
 220   (if xwem-visible-bell
 221       (xwem-sound-do-visible-bell)
 222
 223     (let ((sound-alist xwem-sound-alist))
 224       (play-sound sound volume))))
 225
 226 ;;;###autoload
 227 (defun xwem-sound-load-default (&optional x-beep)
 228   "Loads and install `xwem-sound-default-alist'.
 229 If X-BEEP is non-nil, `xwem-sound-beeping-alist' will be loaded."
 230   (xwem-message 'info "Loading sounds ...")
 231   (if x-beep
 232       (setq xwem-sound-alist (append xwem-sound-beeping-alist
 233                                      xwem-sound-alist))
 234
 235     ;; Load sound files
 236     (setq xwem-sound-alist (append xwem-sound-default-alist
 237                                    xwem-sound-alist
 238                                    (mapcar 'eval xwem-sound-list))))
 239   (xwem-message 'info "Loading sounds ... done"))
 240
 241 \f
 242 (provide 'xwem-sound)
 243
 244 ;;; xwem-sound.el ends here