lisp/gnus/gnus-audio.el

   1 ;;; gnus-audio.el --- Sound effects for Gnus
   2
   3 ;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: Steven L. Baur <steve@miranova.com>
   7 ;; Keywords: news, mail, multimedia
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 3, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This file provides access to sound effects in Gnus.
  29 ;; This file is partially stripped to support earcons.el.
  30
  31 ;;; Code:
  32
  33 (require 'nnheader)
  34
  35 (defgroup gnus-audio nil
  36   "Playing sound in Gnus."
  37   :version "21.1"
  38   :group 'gnus-visual
  39   :group 'multimedia)
  40
  41 (defvar gnus-audio-inline-sound
  42   (or (if (fboundp 'device-sound-enabled-p)
  43           (device-sound-enabled-p))     ; XEmacs
  44       (fboundp 'play-sound))            ; Emacs 21
  45   "Non-nil means try to play sounds without using an external program.")
  46
  47 (defcustom gnus-audio-directory (nnheader-find-etc-directory "sounds")
  48   "The directory containing the Sound Files."
  49   :type '(choice directory (const nil))
  50   :group 'gnus-audio)
  51
  52 (defcustom gnus-audio-au-player (executable-find "play")
  53   "Executable program for playing sun AU format sound files."
  54   :group 'gnus-audio
  55   :type '(choice file (const nil)))
  56
  57 (defcustom gnus-audio-wav-player (executable-find "play")
  58   "Executable program for playing WAV files."
  59   :group 'gnus-audio
  60   :type '(choice file (const nil)))
  61
  62 ;;; The following isn't implemented yet.  Wait for Millennium Gnus.
  63 ;;(defvar gnus-audio-effects-enabled t
  64 ;;  "When t, Gnus will use sound effects.")
  65 ;;(defvar gnus-audio-enable-hooks nil
  66 ;;  "Functions run when enabling sound effects.")
  67 ;;(defvar gnus-audio-disable-hooks nil
  68 ;;  "Functions run when disabling sound effects.")
  69 ;;(defvar gnus-audio-theme-song nil
  70 ;;  "Theme song for Gnus.")
  71 ;;(defvar gnus-audio-enter-group nil
  72 ;;  "Sound effect played when selecting a group.")
  73 ;;(defvar gnus-audio-exit-group nil
  74 ;;  "Sound effect played when exiting a group.")
  75 ;;(defvar gnus-audio-score-group nil
  76 ;;  "Sound effect played when scoring a group.")
  77 ;;(defvar gnus-audio-busy-sound nil
  78 ;;  "Sound effect played when going into a ... sequence.")
  79
  80
  81 ;;;###autoload
  82 ;;(defun gnus-audio-enable-sound ()
  83 ;;  "Enable Sound Effects for Gnus."
  84 ;;  (interactive)
  85 ;;  (setq gnus-audio-effects-enabled t)
  86 ;;  (gnus-run-hooks gnus-audio-enable-hooks))
  87
  88 ;;;###autoload
  89                                         ;(defun gnus-audio-disable-sound ()
  90 ;;  "Disable Sound Effects for Gnus."
  91 ;;  (interactive)
  92 ;;  (setq gnus-audio-effects-enabled nil)
  93 ;;  (gnus-run-hooks gnus-audio-disable-hooks))
  94
  95 ;;;###autoload
  96 (defun gnus-audio-play (file)
  97   "Play a sound FILE through the speaker."
  98   (interactive "fSound file name: ")
  99   (let ((sound-file (if (file-exists-p file)
 100                         file
 101                       (expand-file-name file gnus-audio-directory))))
 102     (when (file-exists-p sound-file)
 103       (cond ((and gnus-audio-inline-sound
 104                  (condition-case nil
 105                      ;; Even if we have audio, we may fail with the
 106                      ;; wrong sort of sound file.
 107                      (progn (play-sound-file sound-file)
 108                             t)
 109                    (error nil))))
 110             ;; If we don't have built-in sound, or playing it failed,
 111             ;; try with external program.
 112             ((equal "wav" (file-name-extension sound-file))
 113              (call-process gnus-audio-wav-player
 114                            sound-file
 115                            0
 116                            nil
 117                            sound-file))
 118             ((equal "au" (file-name-extension sound-file))
 119              (call-process gnus-audio-au-player
 120                            sound-file
 121                            0
 122                            nil
 123                            sound-file))))))
 124
 125
 126 ;;; The following isn't implemented yet, wait for Red Gnus
 127 ;;(defun gnus-audio-startrek-sounds ()
 128 ;;  "Enable sounds from Star Trek the original series."
 129 ;;  (interactive)
 130 ;;  (setq gnus-audio-busy-sound "working.au")
 131 ;;  (setq gnus-audio-enter-group "bulkhead_door.au")
 132 ;;  (setq gnus-audio-exit-group "bulkhead_door.au")
 133 ;;  (setq gnus-audio-score-group "ST_laser.au")
 134 ;;  (setq gnus-audio-theme-song "startrek.au")
 135 ;;  (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group)
 136 ;;  (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group))
 137 ;;;***
 138
 139 (defvar gnus-startup-jingle "Tuxedomoon.Jingle4.au"
 140   "Name of the Gnus startup jingle file.")
 141
 142 (defun gnus-play-jingle ()
 143   "Play the Gnus startup jingle, unless that's inhibited."
 144   (interactive)
 145   (gnus-audio-play gnus-startup-jingle))
 146
 147 (provide 'gnus-audio)
 148
 149 (run-hooks 'gnus-audio-load-hook)
 150
 151 ;; arch-tag: 6f129e78-3416-4fc9-973f-6cf5ac8d654b
 152 ;;; gnus-audio.el ends here