2 Copyright (C) 1992, 1993, 1994 Lucid Inc.
3 Copyright (C) 1994, 1995 Free Software Foundation, Inc.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Not in FSF. */
24 /* Originally written by Jamie Zawinski.
25 Hacked on quite a bit by various others. */
33 #include "console-x.h"
37 #include "redisplay.h"
44 #ifdef HAVE_NATIVE_SOUND
49 int bell_inhibit_time;
50 Lisp_Object Vsound_alist;
51 Lisp_Object Vsynchronous_sounds;
52 Lisp_Object Vnative_sound_only_on_console;
53 Lisp_Object Q_volume, Q_pitch, Q_duration, Q_sound;
55 /* These are defined in the appropriate file (sunplay.c, sgiplay.c,
58 extern void play_sound_file (char *name, int volume);
59 extern void play_sound_data (unsigned char *data, int length, int volume);
62 extern int nas_play_sound_file (char *name, int volume);
63 extern int nas_play_sound_data (unsigned char *data, int length, int volume);
64 extern int nas_wait_for_sounds (void);
65 extern char *nas_init_play (Display *);
70 DEFUN ("play-sound-file", Fplay_sound_file, 1, 3, "fSound file name: ", /*
71 Play the named sound file on DEVICE's speaker at the specified volume
72 \(0-100, default specified by the `bell-volume' variable).
73 On Unix machines the sound file must be in the Sun/NeXT U-LAW format
74 except under Linux where WAV files are also supported. On Microsoft
75 Windows the sound file must be in WAV format.
76 DEVICE defaults to the selected device.
78 (file, volume, device))
80 /* This function can call lisp */
82 #if defined (HAVE_NATIVE_SOUND) || defined (HAVE_NAS_SOUND)
83 struct device *d = decode_device (device);
99 file = Fexpand_file_name (file, Qnil);
100 if (!NILP(Ffile_readable_p (file)))
104 /* #### This is crockish. It might be a better idea to try
105 to open the file, and use report_file_error() if it
107 if (NILP (Ffile_exists_p (file)))
109 signal_simple_continuable_error ("File does not exist", file);
112 signal_simple_continuable_error ("File is unreadable", file);
117 #ifdef HAVE_NAS_SOUND
118 if (DEVICE_CONNECTED_TO_NAS_P (d))
122 GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext);
123 /* #### NAS code should allow specification of a device. */
124 if (nas_play_sound_file (fileext, vol))
127 #endif /* HAVE_NAS_SOUND */
129 #ifdef HAVE_NATIVE_SOUND
130 if (NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
134 GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext);
135 /* The sound code doesn't like getting SIGIO interrupts.
138 play_sound_file ((char *) fileext, vol);
142 #endif /* HAVE_NATIVE_SOUND */
148 parse_sound_alist_elt (Lisp_Object elt,
151 Lisp_Object *duration,
161 /* The things we do for backward compatibility...
162 I wish I had just forced this to be a plist to begin with.
165 if (SYMBOLP (elt) || STRINGP (elt)) /* ( name . <sound> ) */
169 else if (!CONSP (elt))
173 else if (NILP (XCDR (elt)) && /* ( name <sound> ) */
174 (SYMBOLP (XCAR (elt)) ||
175 STRINGP (XCAR (elt))))
179 else if (INT_OR_FLOATP (XCAR (elt)) && /* ( name <vol> . <sound> ) */
180 (SYMBOLP (XCDR (elt)) ||
181 STRINGP (XCDR (elt))))
183 *volume = XCAR (elt);
186 else if (INT_OR_FLOATP (XCAR (elt)) && /* ( name <vol> <sound> ) */
187 CONSP (XCDR (elt)) &&
188 NILP (XCDR (XCDR (elt))) &&
189 (SYMBOLP (XCAR (XCDR (elt))) ||
190 STRINGP (XCAR (XCDR (elt)))))
192 *volume = XCAR (elt);
193 *sound = XCAR (XCDR (elt));
195 else if ((SYMBOLP (XCAR (elt)) || /* ( name <sound> . <vol> ) */
196 STRINGP (XCAR (elt))) &&
197 INT_OR_FLOATP (XCDR (elt)))
200 *volume = XCDR (elt);
202 #if 0 /* this one is ambiguous with the plist form */
203 else if ((SYMBOLP (XCAR (elt)) || /* ( name <sound> <vol> ) */
204 STRINGP (XCAR (elt))) &&
205 CONSP (XCDR (elt)) &&
206 NILP (XCDR (XCDR (elt))) &&
207 INT_OR_FLOATP (XCAR (XCDR (elt))))
210 *volume = XCAR (XCDR (elt));
213 else /* ( name [ keyword <value> ]* ) */
217 Lisp_Object key, val;
224 if (EQ (key, Q_volume))
226 if (INT_OR_FLOATP (val)) *volume = val;
228 else if (EQ (key, Q_pitch))
230 if (INT_OR_FLOATP (val)) *pitch = val;
231 if (NILP (*sound)) *sound = Qt;
233 else if (EQ (key, Q_duration))
235 if (INT_OR_FLOATP (val)) *duration = val;
236 if (NILP (*sound)) *sound = Qt;
238 else if (EQ (key, Q_sound))
240 if (SYMBOLP (val) || STRINGP (val)) *sound = val;
246 DEFUN ("play-sound", Fplay_sound, 1, 3, 0, /*
247 Play a sound of the provided type.
248 See the variable `sound-alist'.
250 (sound, volume, device))
252 int looking_for_default = 0;
253 /* variable `sound' is anything that can be a cdr in sound-alist */
254 Lisp_Object new_volume, pitch, duration, data;
257 struct device *d = decode_device (device);
259 /* NOTE! You'd better not signal an error in here. */
266 sound = Fcdr (Fassq (sound, Vsound_alist));
267 parse_sound_alist_elt (sound, &new_volume, &pitch, &duration, &data);
269 if (NILP (volume)) volume = new_volume;
270 if (EQ (sound, Qt) || EQ (sound, Qnil) || STRINGP (sound))
272 if (loop_count++ > 500) /* much bogosity has occurred */
276 if (NILP (sound) && !looking_for_default)
278 looking_for_default = 1;
285 vol = (INT_OR_FLOATP (volume) ? (int) XFLOATINT (volume) : bell_volume);
286 pit = (INT_OR_FLOATP (pitch) ? (int) XFLOATINT (pitch) : -1);
287 dur = (INT_OR_FLOATP (duration) ? (int) XFLOATINT (duration) : -1);
289 /* If the sound is a string, and we're connected to Nas, do that.
290 Else if the sound is a string, and we're on console, play it natively.
293 #ifdef HAVE_NAS_SOUND
294 if (DEVICE_CONNECTED_TO_NAS_P (d) && STRINGP (sound))
296 CONST Extbyte *soundext;
297 Extcount soundextlen;
299 GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen);
300 if (nas_play_sound_data ((unsigned char*)soundext, soundextlen, vol))
303 #endif /* HAVE_NAS_SOUND */
305 #ifdef HAVE_NATIVE_SOUND
306 if ((NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
309 CONST Extbyte *soundext;
310 Extcount soundextlen;
312 GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen);
313 /* The sound code doesn't like getting SIGIO interrupts. Unix sucks! */
315 play_sound_data ((unsigned char*)soundext, soundextlen, vol);
320 #endif /* HAVE_NATIVE_SOUND */
322 DEVMETH (d, ring_bell, (d, vol, pit, dur));
326 DEFUN ("device-sound-enabled-p", Fdevice_sound_enabled_p, 0, 1, 0, /*
327 Return t if DEVICE is able to play sound. Defaults to selected device.
331 #ifdef HAVE_NAS_SOUND
332 if (DEVICE_CONNECTED_TO_NAS_P (decode_device (device)))
335 #ifdef HAVE_NATIVE_SOUND
336 if (DEVICE_ON_CONSOLE_P (decode_device (device)))
342 DEFUN ("ding", Fding, 0, 3, 0, /*
343 Beep, or flash the frame.
344 Also, unless an argument is given,
345 terminate any keyboard macro currently executing.
346 When called from lisp, the second argument is what sound to make, and
347 the third argument is the device to make it in (defaults to the selected
350 (arg, sound, device))
352 static time_t last_bell_time = (time_t) 0;
353 static struct device *last_bell_device = (struct device*) 0;
355 struct device *d = decode_device (device);
357 XSETDEVICE (device, d);
360 if (NILP (arg) && !NILP (Vexecuting_macro))
361 /* Stop executing a keyboard macro. */
362 error ("Keyboard macro terminated by a command ringing the bell");
364 if (d == last_bell_device && now-last_bell_time < bell_inhibit_time)
366 else if (visible_bell && DEVMETH (d, flash, (d)))
369 Fplay_sound (sound, Qnil, device);
371 last_bell_time = now;
372 last_bell_device = d;
376 DEFUN ("wait-for-sounds", Fwait_for_sounds, 0, 1, 0, /*
377 Wait for all sounds to finish playing on DEVICE.
382 #ifdef HAVE_NAS_SOUND
383 struct device *d = decode_device (device);
384 if (DEVICE_CONNECTED_TO_NAS_P (d))
386 /* #### somebody fix this to be device-dependent. */
387 nas_wait_for_sounds ();
393 DEFUN ("connected-to-nas-p", Fconnected_to_nas_p, 0, 1, 0, /*
394 Return t if connected to NAS server for sounds on DEVICE.
398 #ifdef HAVE_NAS_SOUND
399 return DEVICE_CONNECTED_TO_NAS_P (decode_device (device)) ? Qt : Qnil;
404 #ifdef HAVE_NAS_SOUND
407 init_nas_sound (struct device *d)
411 #ifdef HAVE_X_WINDOWS
414 error = nas_init_play (DEVICE_X_DISPLAY (d));
415 DEVICE_CONNECTED_TO_NAS_P (d) = !error;
416 /* Print out the message? */
418 #endif /* HAVE_X_WINDOWS */
421 #endif /* HAVE_NAS_SOUND */
423 #ifdef HAVE_NATIVE_SOUND
426 init_native_sound (struct device *d)
428 if (DEVICE_TTY_P (d) || DEVICE_STREAM_P (d) || DEVICE_MSWINDOWS_P(d))
429 DEVICE_ON_CONSOLE_P (d) = 1;
430 #ifdef HAVE_X_WINDOWS
433 /* When running on a machine with native sound support, we cannot use
434 digitized sounds as beeps unless emacs is running on the same machine
435 that $DISPLAY points to, and $DISPLAY points to frame 0 of that
439 Display *display = DEVICE_X_DISPLAY (d);
440 char *dpy = DisplayString (display);
441 char *tail = (char *) strchr (dpy, ':');
443 strncmp (tail, ":0", 2))
444 DEVICE_ON_CONSOLE_P (d) = 0;
447 char dpyname[255], localname[255];
449 /* some systems can't handle SIGIO or SIGALARM in gethostbyname. */
451 strncpy (dpyname, dpy, tail-dpy);
452 dpyname [tail-dpy] = 0;
454 !strcmp (dpyname, "unix") ||
455 !strcmp (dpyname, "localhost"))
456 DEVICE_ON_CONSOLE_P (d) = 1;
457 else if (gethostname (localname, sizeof (localname)))
458 DEVICE_ON_CONSOLE_P (d) = 0; /* can't find hostname? */
461 /* We have to call gethostbyname() on the result of gethostname()
462 because the two aren't guaranteed to be the same name for the
463 same host: on some losing systems, one is a FQDN and the other
464 is not. Here in the wide wonderful world of Unix it's rocket
465 science to obtain the local hostname in a portable fashion.
467 And don't forget, gethostbyname() reuses the structure it
468 returns, so we have to copy the fucker before calling it
471 Thank you master, may I have another.
473 struct hostent *h = gethostbyname (dpyname);
475 DEVICE_ON_CONSOLE_P (d) = 0;
480 strcpy (hn, h->h_name);
481 l = gethostbyname (localname);
482 DEVICE_ON_CONSOLE_P (d) = (l && !(strcmp (l->h_name, hn)));
488 #endif /* HAVE_X_WINDOWS */
491 #endif /* HAVE_NATIVE_SOUND */
494 init_device_sound (struct device *d)
496 #ifdef HAVE_NAS_SOUND
500 #ifdef HAVE_NATIVE_SOUND
501 init_native_sound (d);
508 defkeyword (&Q_volume, ":volume");
509 defkeyword (&Q_pitch, ":pitch");
510 defkeyword (&Q_duration, ":duration");
511 defkeyword (&Q_sound, ":sound");
513 #ifdef HAVE_NAS_SOUND
514 defsymbol (&Qnas, "nas");
517 DEFSUBR (Fplay_sound_file);
518 DEFSUBR (Fplay_sound);
520 DEFSUBR (Fwait_for_sounds);
521 DEFSUBR (Fconnected_to_nas_p);
522 DEFSUBR (Fdevice_sound_enabled_p);
529 #ifdef HAVE_NATIVE_SOUND
530 Fprovide (intern ("native-sound"));
532 #ifdef HAVE_NAS_SOUND
533 Fprovide (intern ("nas-sound"));
536 DEFVAR_INT ("bell-volume", &bell_volume /*
537 *How loud to be, from 0 to 100.
541 DEFVAR_INT ("bell-inhibit-time", &bell_inhibit_time /*
542 *Don't ring the bell on the same device more than once within this many seconds.
544 bell_inhibit_time = 0;
546 DEFVAR_LISP ("sound-alist", &Vsound_alist /*
547 An alist associating names with sounds.
548 When `beep' or `ding' is called with one of the name symbols, the associated
549 sound will be generated instead of the standard beep.
551 Each element of `sound-alist' is a list describing a sound.
552 The first element of the list is the name of the sound being defined.
553 Subsequent elements of the list are alternating keyword/value pairs:
557 sound A string of raw sound data, or the name of another sound to
558 play. The symbol `t' here means use the default X beep.
559 volume An integer from 0-100, defaulting to `bell-volume'
560 pitch If using the default X beep, the pitch (Hz) to generate.
561 duration If using the default X beep, the duration (milliseconds).
563 For compatibility, elements of `sound-alist' may also be:
565 ( sound-name . <sound> )
566 ( sound-name <volume> <sound> )
568 You should probably add things to this list by calling the function
572 - XEmacs must be built with sound support for your system. Not all
573 systems support sound.
575 - The pitch, duration, and volume options are available everywhere, but
576 many X servers ignore the `pitch' option.
578 The following beep-types are used by emacs itself:
580 auto-save-error when an auto-save does not succeed
581 command-error when the emacs command loop catches an error
582 undefined-key when you type a key that is undefined
583 undefined-click when you use an undefined mouse-click combination
584 no-completion during completing-read
585 y-or-n-p when you type something other than 'y' or 'n'
586 yes-or-no-p when you type something other than 'yes' or 'no'
587 default used when nothing else is appropriate.
589 Other lisp packages may use other beep types, but these are the ones that
590 the C kernel of Emacs uses.
594 DEFVAR_LISP ("synchronous-sounds", &Vsynchronous_sounds /*
595 Play sounds synchronously, if non-nil.
596 Only applies if NAS is used and supports asynchronous playing
597 of sounds. Otherwise, sounds are always played synchronously.
599 Vsynchronous_sounds = Qnil;
601 DEFVAR_LISP ("native-sound-only-on-console", &Vnative_sound_only_on_console /*
602 Non-nil value means play sounds only if XEmacs is running
603 on the system console.
604 Nil means always always play sounds, even if running on a non-console tty
605 or a secondary X display.
607 This variable only applies to native sound support.
609 Vnative_sound_only_on_console = Qt;
611 #if defined (HAVE_NATIVE_SOUND) && defined (hp9000s800)
613 void vars_of_hpplay (void);