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"
42 #ifdef HAVE_NATIVE_SOUND
44 # include "nativesound.h"
48 extern int esd_play_sound_file (char *file, int vol);
49 extern int esd_play_sound_data (unsigned char *data, size_t length, int vol);
50 # define DEVICE_CONNECTED_TO_ESD_P(x) 1 /* FIXME: better check */
54 Fixnum bell_inhibit_time;
55 Lisp_Object Vsound_alist;
56 Lisp_Object Vsynchronous_sounds;
57 Lisp_Object Vnative_sound_only_on_console;
58 Lisp_Object Q_volume, Q_pitch, Q_duration, Q_sound;
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 || defined (HAVE_ESD_SOUND)
84 struct device *d = decode_device (device);
100 file = Fexpand_file_name (file, Qnil);
101 if (!NILP(Ffile_readable_p (file)))
105 /* #### This is crockish. It might be a better idea to try
106 to open the file, and use report_file_error() if it
108 if (NILP (Ffile_exists_p (file)))
110 signal_simple_continuable_error ("File does not exist", file);
113 signal_simple_continuable_error ("File is unreadable", file);
118 #ifdef HAVE_NAS_SOUND
119 if (DEVICE_CONNECTED_TO_NAS_P (d))
123 LISP_STRING_TO_EXTERNAL (file, fileext, Qfile_name);
124 /* #### NAS code should allow specification of a device. */
125 if (nas_play_sound_file (fileext, vol))
128 #endif /* HAVE_NAS_SOUND */
130 #ifdef HAVE_ESD_SOUND
131 if (DEVICE_CONNECTED_TO_ESD_P (d))
136 LISP_STRING_TO_EXTERNAL (file, fileext, Qfile_name);
138 /* #### ESD uses alarm(). But why should we also stop SIGIO? */
140 result = esd_play_sound_file (fileext, vol);
145 #endif /* HAVE_ESD_SOUND */
147 #ifdef HAVE_NATIVE_SOUND
148 if (NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
152 LISP_STRING_TO_EXTERNAL (file, fileext, Qfile_name);
153 /* The sound code doesn't like getting SIGIO interrupts.
156 play_sound_file ((char *) fileext, vol);
160 #endif /* HAVE_NATIVE_SOUND */
166 parse_sound_alist_elt (Lisp_Object elt,
169 Lisp_Object *duration,
179 /* The things we do for backward compatibility...
180 I wish I had just forced this to be a plist to begin with.
183 if (SYMBOLP (elt) || STRINGP (elt)) /* ( name . <sound> ) */
187 else if (!CONSP (elt))
191 else if (NILP (XCDR (elt)) && /* ( name <sound> ) */
192 (SYMBOLP (XCAR (elt)) ||
193 STRINGP (XCAR (elt))))
197 else if (INT_OR_FLOATP (XCAR (elt)) && /* ( name <vol> . <sound> ) */
198 (SYMBOLP (XCDR (elt)) ||
199 STRINGP (XCDR (elt))))
201 *volume = XCAR (elt);
204 else if (INT_OR_FLOATP (XCAR (elt)) && /* ( name <vol> <sound> ) */
205 CONSP (XCDR (elt)) &&
206 NILP (XCDR (XCDR (elt))) &&
207 (SYMBOLP (XCAR (XCDR (elt))) ||
208 STRINGP (XCAR (XCDR (elt)))))
210 *volume = XCAR (elt);
211 *sound = XCAR (XCDR (elt));
213 else if ((SYMBOLP (XCAR (elt)) || /* ( name <sound> . <vol> ) */
214 STRINGP (XCAR (elt))) &&
215 INT_OR_FLOATP (XCDR (elt)))
218 *volume = XCDR (elt);
220 #if 0 /* this one is ambiguous with the plist form */
221 else if ((SYMBOLP (XCAR (elt)) || /* ( name <sound> <vol> ) */
222 STRINGP (XCAR (elt))) &&
223 CONSP (XCDR (elt)) &&
224 NILP (XCDR (XCDR (elt))) &&
225 INT_OR_FLOATP (XCAR (XCDR (elt))))
228 *volume = XCAR (XCDR (elt));
231 else /* ( name [ keyword <value> ]* ) */
235 Lisp_Object key, val;
242 if (EQ (key, Q_volume))
244 if (INT_OR_FLOATP (val)) *volume = val;
246 else if (EQ (key, Q_pitch))
248 if (INT_OR_FLOATP (val)) *pitch = val;
249 if (NILP (*sound)) *sound = Qt;
251 else if (EQ (key, Q_duration))
253 if (INT_OR_FLOATP (val)) *duration = val;
254 if (NILP (*sound)) *sound = Qt;
256 else if (EQ (key, Q_sound))
258 if (SYMBOLP (val) || STRINGP (val)) *sound = val;
264 DEFUN ("play-sound", Fplay_sound, 1, 3, 0, /*
265 Play a sound of the provided type.
266 See the variable `sound-alist'.
268 (sound, volume, device))
270 int looking_for_default = 0;
271 /* variable `sound' is anything that can be a cdr in sound-alist */
272 Lisp_Object new_volume, pitch, duration, data;
275 struct device *d = decode_device (device);
277 /* NOTE! You'd better not signal an error in here. */
284 sound = Fcdr (Fassq (sound, Vsound_alist));
285 parse_sound_alist_elt (sound, &new_volume, &pitch, &duration, &data);
287 if (NILP (volume)) volume = new_volume;
288 if (EQ (sound, Qt) || EQ (sound, Qnil) || STRINGP (sound))
290 if (loop_count++ > 500) /* much bogosity has occurred */
294 if (NILP (sound) && !looking_for_default)
296 looking_for_default = 1;
303 vol = (INT_OR_FLOATP (volume) ? (int) XFLOATINT (volume) : bell_volume);
304 pit = (INT_OR_FLOATP (pitch) ? (int) XFLOATINT (pitch) : -1);
305 dur = (INT_OR_FLOATP (duration) ? (int) XFLOATINT (duration) : -1);
307 /* If the sound is a string, and we're connected to Nas, do that.
308 Else if the sound is a string, and we're on console, play it natively.
311 #ifdef HAVE_NAS_SOUND
312 if (DEVICE_CONNECTED_TO_NAS_P (d) && STRINGP (sound))
314 const Extbyte *soundext;
315 Extcount soundextlen;
317 TO_EXTERNAL_FORMAT (LISP_STRING, sound,
318 ALLOCA, (soundext, soundextlen),
320 if (nas_play_sound_data ((unsigned char*)soundext, soundextlen, vol))
323 #endif /* HAVE_NAS_SOUND */
325 #ifdef HAVE_ESD_SOUND
326 if (DEVICE_CONNECTED_TO_ESD_P (d) && STRINGP (sound))
329 Extcount soundextlen;
332 TO_EXTERNAL_FORMAT (LISP_STRING, sound, ALLOCA, (soundext, soundextlen),
335 /* #### ESD uses alarm(). But why should we also stop SIGIO? */
337 succes = esd_play_sound_data ((unsigned char *) soundext, soundextlen, vol);
343 #endif /* HAVE_ESD_SOUND */
345 #ifdef HAVE_NATIVE_SOUND
346 if ((NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
349 const Extbyte *soundext;
350 Extcount soundextlen;
353 TO_EXTERNAL_FORMAT (LISP_STRING, sound,
354 ALLOCA, (soundext, soundextlen),
356 /* The sound code doesn't like getting SIGIO interrupts. Unix sucks! */
358 succes = play_sound_data ((unsigned char*)soundext, soundextlen, vol);
364 #endif /* HAVE_NATIVE_SOUND */
366 DEVMETH (d, ring_bell, (d, vol, pit, dur));
370 DEFUN ("device-sound-enabled-p", Fdevice_sound_enabled_p, 0, 1, 0, /*
371 Return t if DEVICE is able to play sound. Defaults to selected device.
375 #ifdef HAVE_NAS_SOUND
376 if (DEVICE_CONNECTED_TO_NAS_P (decode_device (device)))
379 #ifdef HAVE_NATIVE_SOUND
380 if (DEVICE_ON_CONSOLE_P (decode_device (device)))
386 DEFUN ("ding", Fding, 0, 3, 0, /*
387 Beep, or flash the frame.
388 Also, unless an argument is given,
389 terminate any keyboard macro currently executing.
390 When called from lisp, the second argument is what sound to make, and
391 the third argument is the device to make it in (defaults to the selected
394 (arg, sound, device))
396 static time_t last_bell_time;
397 static struct device *last_bell_device;
399 struct device *d = decode_device (device);
401 XSETDEVICE (device, d);
404 if (NILP (arg) && !NILP (Vexecuting_macro))
405 /* Stop executing a keyboard macro. */
406 error ("Keyboard macro terminated by a command ringing the bell");
408 if (d == last_bell_device && now-last_bell_time < bell_inhibit_time)
410 else if (!NILP (Vvisible_bell) && DEVMETH (d, flash, (d)))
413 Fplay_sound (sound, Qnil, device);
415 last_bell_time = now;
416 last_bell_device = d;
420 DEFUN ("wait-for-sounds", Fwait_for_sounds, 0, 1, 0, /*
421 Wait for all sounds to finish playing on DEVICE.
426 #ifdef HAVE_NAS_SOUND
427 struct device *d = decode_device (device);
428 if (DEVICE_CONNECTED_TO_NAS_P (d))
430 /* #### somebody fix this to be device-dependent. */
431 nas_wait_for_sounds ();
437 DEFUN ("connected-to-nas-p", Fconnected_to_nas_p, 0, 1, 0, /*
438 Return t if connected to NAS server for sounds on DEVICE.
442 #ifdef HAVE_NAS_SOUND
443 return DEVICE_CONNECTED_TO_NAS_P (decode_device (device)) ? Qt : Qnil;
448 #ifdef HAVE_NAS_SOUND
451 init_nas_sound (struct device *d)
453 #ifdef HAVE_X_WINDOWS
456 char *err_message = nas_init_play (DEVICE_X_DISPLAY (d));
457 DEVICE_CONNECTED_TO_NAS_P (d) = !err_message;
458 /* Print out the message? */
460 #endif /* HAVE_X_WINDOWS */
463 #endif /* HAVE_NAS_SOUND */
465 #ifdef HAVE_NATIVE_SOUND
468 init_native_sound (struct device *d)
470 if (!(DEVICE_X_P(d) || DEVICE_GTK_P(d)))
471 DEVICE_ON_CONSOLE_P (d) = 1;
472 #ifdef HAVE_X_WINDOWS
475 /* When running on a machine with native sound support, we cannot use
476 digitized sounds as beeps unless emacs is running on the same machine
477 that $DISPLAY points to, and $DISPLAY points to frame 0 of that
481 Display *display = DEVICE_X_DISPLAY (d);
482 char *dpy = DisplayString (display);
483 char *tail = (char *) strchr (dpy, ':');
485 strncmp (tail, ":0", 2))
486 DEVICE_ON_CONSOLE_P (d) = 0;
489 char dpyname[255], localname[255];
491 /* some systems can't handle SIGIO or SIGALARM in gethostbyname. */
493 strncpy (dpyname, dpy, tail-dpy);
494 dpyname [tail-dpy] = 0;
496 !strcmp (dpyname, "unix") ||
497 !strcmp (dpyname, "localhost"))
498 DEVICE_ON_CONSOLE_P (d) = 1;
499 else if (gethostname (localname, sizeof (localname)))
500 DEVICE_ON_CONSOLE_P (d) = 0; /* can't find hostname? */
503 /* We have to call gethostbyname() on the result of gethostname()
504 because the two aren't guaranteed to be the same name for the
505 same host: on some losing systems, one is a FQDN and the other
506 is not. Here in the wide wonderful world of Unix it's rocket
507 science to obtain the local hostname in a portable fashion.
509 And don't forget, gethostbyname() reuses the structure it
510 returns, so we have to copy the fucker before calling it
513 Thank you master, may I have another.
515 struct hostent *h = gethostbyname (dpyname);
517 DEVICE_ON_CONSOLE_P (d) = 0;
520 char *hn = alloca_array (char, strlen (h->h_name) + 1);
522 strcpy (hn, h->h_name);
523 l = gethostbyname (localname);
524 DEVICE_ON_CONSOLE_P (d) = (l && !(strcmp (l->h_name, hn)));
530 #endif /* HAVE_X_WINDOWS */
533 #endif /* HAVE_NATIVE_SOUND */
536 init_device_sound (struct device *d)
538 #ifdef HAVE_NAS_SOUND
542 #ifdef HAVE_NATIVE_SOUND
543 init_native_sound (d);
550 defkeyword (&Q_volume, ":volume");
551 defkeyword (&Q_pitch, ":pitch");
552 defkeyword (&Q_duration, ":duration");
553 defkeyword (&Q_sound, ":sound");
555 #ifdef HAVE_NAS_SOUND
556 defsymbol (&Qnas, "nas");
559 DEFSUBR (Fplay_sound_file);
560 DEFSUBR (Fplay_sound);
562 DEFSUBR (Fwait_for_sounds);
563 DEFSUBR (Fconnected_to_nas_p);
564 DEFSUBR (Fdevice_sound_enabled_p);
571 #ifdef HAVE_NATIVE_SOUND
572 Fprovide (intern ("native-sound"));
574 #ifdef HAVE_NAS_SOUND
575 Fprovide (intern ("nas-sound"));
577 #ifdef HAVE_ESD_SOUND
578 Fprovide (intern ("esd-sound"));
581 DEFVAR_INT ("bell-volume", &bell_volume /*
582 *How loud to be, from 0 to 100.
586 DEFVAR_INT ("bell-inhibit-time", &bell_inhibit_time /*
587 *Don't ring the bell on the same device more than once within this many seconds.
589 bell_inhibit_time = 0;
591 DEFVAR_LISP ("sound-alist", &Vsound_alist /*
592 An alist associating names with sounds.
593 When `beep' or `ding' is called with one of the name symbols, the associated
594 sound will be generated instead of the standard beep.
596 Each element of `sound-alist' is a list describing a sound.
597 The first element of the list is the name of the sound being defined.
598 Subsequent elements of the list are alternating keyword/value pairs:
602 sound A string of raw sound data, or the name of another sound to
603 play. The symbol `t' here means use the default X beep.
604 volume An integer from 0-100, defaulting to `bell-volume'
605 pitch If using the default X beep, the pitch (Hz) to generate.
606 duration If using the default X beep, the duration (milliseconds).
608 For compatibility, elements of `sound-alist' may also be:
610 ( sound-name . <sound> )
611 ( sound-name <volume> <sound> )
613 You should probably add things to this list by calling the function
617 - XEmacs must be built with sound support for your system. Not all
618 systems support sound.
620 - The pitch, duration, and volume options are available everywhere, but
621 many X servers ignore the `pitch' option.
623 The following beep-types are used by emacs itself:
625 auto-save-error when an auto-save does not succeed
626 command-error when the emacs command loop catches an error
627 undefined-key when you type a key that is undefined
628 undefined-click when you use an undefined mouse-click combination
629 no-completion during completing-read
630 y-or-n-p when you type something other than 'y' or 'n'
631 yes-or-no-p when you type something other than 'yes' or 'no'
632 default used when nothing else is appropriate.
634 Other lisp packages may use other beep types, but these are the ones that
635 the C kernel of Emacs uses.
639 DEFVAR_LISP ("synchronous-sounds", &Vsynchronous_sounds /*
640 Play sounds synchronously, if non-nil.
641 Only applies if NAS is used and supports asynchronous playing
642 of sounds. Otherwise, sounds are always played synchronously.
644 Vsynchronous_sounds = Qnil;
646 DEFVAR_LISP ("native-sound-only-on-console", &Vnative_sound_only_on_console /*
647 Non-nil value means play sounds only if XEmacs is running
648 on the system console.
649 Nil means always play sounds, even if running on a non-console tty
650 or a secondary X display.
652 This variable only applies to native sound support.
654 Vnative_sound_only_on_console = Qt;
656 #if defined (HAVE_NATIVE_SOUND) && defined (hp9000s800)
658 void vars_of_hpplay (void);