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 extern int esd_play_sound_file (char *file, int vol);
50 extern int esd_play_sound_data (unsigned char *data, size_t length, int vol);
51 # define DEVICE_CONNECTED_TO_ESD_P(x) 1 /* FIXME: better check */
55 int bell_inhibit_time;
56 Lisp_Object Vsound_alist;
57 Lisp_Object Vsynchronous_sounds;
58 Lisp_Object Vnative_sound_only_on_console;
59 Lisp_Object Q_volume, Q_pitch, Q_duration, Q_sound;
61 /* These are defined in the appropriate file (sunplay.c, sgiplay.c,
64 extern void play_sound_file (char *name, int volume);
65 extern void play_sound_data (unsigned char *data, int length, int volume);
68 extern int nas_play_sound_file (char *name, int volume);
69 extern int nas_play_sound_data (unsigned char *data, int length, int volume);
70 extern int nas_wait_for_sounds (void);
71 extern char *nas_init_play (Display *);
76 DEFUN ("play-sound-file", Fplay_sound_file, 1, 3, "fSound file name: ", /*
77 Play the named sound file on DEVICE's speaker at the specified volume
78 \(0-100, default specified by the `bell-volume' variable).
79 On Unix machines the sound file must be in the Sun/NeXT U-LAW format
80 except under Linux where WAV files are also supported. On Microsoft
81 Windows the sound file must be in WAV format.
82 DEVICE defaults to the selected device.
84 (file, volume, device))
86 /* This function can call lisp */
88 #if defined (HAVE_NATIVE_SOUND) || defined (HAVE_NAS_SOUND) \
89 || defined (HAVE_ESD_SOUND)
90 struct device *d = decode_device (device);
106 file = Fexpand_file_name (file, Qnil);
107 if (!NILP(Ffile_readable_p (file)))
111 /* #### This is crockish. It might be a better idea to try
112 to open the file, and use report_file_error() if it
114 if (NILP (Ffile_exists_p (file)))
116 signal_simple_continuable_error ("File does not exist", file);
119 signal_simple_continuable_error ("File is unreadable", file);
124 #ifdef HAVE_NAS_SOUND
125 if (DEVICE_CONNECTED_TO_NAS_P (d))
129 GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext);
130 /* #### NAS code should allow specification of a device. */
131 if (nas_play_sound_file (fileext, vol))
134 #endif /* HAVE_NAS_SOUND */
136 #ifdef HAVE_ESD_SOUND
137 if (DEVICE_CONNECTED_TO_ESD_P (d))
141 GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext);
142 if (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 GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext);
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 GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen);
318 if (nas_play_sound_data ((unsigned char*)soundext, soundextlen, vol))
321 #endif /* HAVE_NAS_SOUND */
323 #ifdef HAVE_ESD_SOUND
324 if (DEVICE_CONNECTED_TO_ESD_P (d) && STRINGP (sound))
327 Extcount soundextlen;
329 GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen);
330 if (esd_play_sound_data (soundext, soundextlen, vol))
333 #endif /* HAVE_ESD_SOUND */
335 #ifdef HAVE_NATIVE_SOUND
336 if ((NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
339 CONST Extbyte *soundext;
340 Extcount soundextlen;
342 GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen);
343 /* The sound code doesn't like getting SIGIO interrupts. Unix sucks! */
345 play_sound_data ((unsigned char*)soundext, soundextlen, vol);
350 #endif /* HAVE_NATIVE_SOUND */
352 DEVMETH (d, ring_bell, (d, vol, pit, dur));
356 DEFUN ("device-sound-enabled-p", Fdevice_sound_enabled_p, 0, 1, 0, /*
357 Return t if DEVICE is able to play sound. Defaults to selected device.
361 #ifdef HAVE_NAS_SOUND
362 if (DEVICE_CONNECTED_TO_NAS_P (decode_device (device)))
365 #ifdef HAVE_NATIVE_SOUND
366 if (DEVICE_ON_CONSOLE_P (decode_device (device)))
372 DEFUN ("ding", Fding, 0, 3, 0, /*
373 Beep, or flash the frame.
374 Also, unless an argument is given,
375 terminate any keyboard macro currently executing.
376 When called from lisp, the second argument is what sound to make, and
377 the third argument is the device to make it in (defaults to the selected
380 (arg, sound, device))
382 static time_t last_bell_time;
383 static struct device *last_bell_device;
385 struct device *d = decode_device (device);
387 XSETDEVICE (device, d);
390 if (NILP (arg) && !NILP (Vexecuting_macro))
391 /* Stop executing a keyboard macro. */
392 error ("Keyboard macro terminated by a command ringing the bell");
394 if (d == last_bell_device && now-last_bell_time < bell_inhibit_time)
396 else if (visible_bell && DEVMETH (d, flash, (d)))
399 Fplay_sound (sound, Qnil, device);
401 last_bell_time = now;
402 last_bell_device = d;
406 DEFUN ("wait-for-sounds", Fwait_for_sounds, 0, 1, 0, /*
407 Wait for all sounds to finish playing on DEVICE.
412 #ifdef HAVE_NAS_SOUND
413 struct device *d = decode_device (device);
414 if (DEVICE_CONNECTED_TO_NAS_P (d))
416 /* #### somebody fix this to be device-dependent. */
417 nas_wait_for_sounds ();
423 DEFUN ("connected-to-nas-p", Fconnected_to_nas_p, 0, 1, 0, /*
424 Return t if connected to NAS server for sounds on DEVICE.
428 #ifdef HAVE_NAS_SOUND
429 return DEVICE_CONNECTED_TO_NAS_P (decode_device (device)) ? Qt : Qnil;
434 #ifdef HAVE_NAS_SOUND
437 init_nas_sound (struct device *d)
441 #ifdef HAVE_X_WINDOWS
444 error = nas_init_play (DEVICE_X_DISPLAY (d));
445 DEVICE_CONNECTED_TO_NAS_P (d) = !error;
446 /* Print out the message? */
448 #endif /* HAVE_X_WINDOWS */
451 #endif /* HAVE_NAS_SOUND */
453 #ifdef HAVE_NATIVE_SOUND
456 init_native_sound (struct device *d)
458 if (DEVICE_TTY_P (d) || DEVICE_STREAM_P (d) || DEVICE_MSWINDOWS_P(d))
459 DEVICE_ON_CONSOLE_P (d) = 1;
460 #ifdef HAVE_X_WINDOWS
463 /* When running on a machine with native sound support, we cannot use
464 digitized sounds as beeps unless emacs is running on the same machine
465 that $DISPLAY points to, and $DISPLAY points to frame 0 of that
469 Display *display = DEVICE_X_DISPLAY (d);
470 char *dpy = DisplayString (display);
471 char *tail = (char *) strchr (dpy, ':');
473 strncmp (tail, ":0", 2))
474 DEVICE_ON_CONSOLE_P (d) = 0;
477 char dpyname[255], localname[255];
479 /* some systems can't handle SIGIO or SIGALARM in gethostbyname. */
481 strncpy (dpyname, dpy, tail-dpy);
482 dpyname [tail-dpy] = 0;
484 !strcmp (dpyname, "unix") ||
485 !strcmp (dpyname, "localhost"))
486 DEVICE_ON_CONSOLE_P (d) = 1;
487 else if (gethostname (localname, sizeof (localname)))
488 DEVICE_ON_CONSOLE_P (d) = 0; /* can't find hostname? */
491 /* We have to call gethostbyname() on the result of gethostname()
492 because the two aren't guaranteed to be the same name for the
493 same host: on some losing systems, one is a FQDN and the other
494 is not. Here in the wide wonderful world of Unix it's rocket
495 science to obtain the local hostname in a portable fashion.
497 And don't forget, gethostbyname() reuses the structure it
498 returns, so we have to copy the fucker before calling it
501 Thank you master, may I have another.
503 struct hostent *h = gethostbyname (dpyname);
505 DEVICE_ON_CONSOLE_P (d) = 0;
510 strcpy (hn, h->h_name);
511 l = gethostbyname (localname);
512 DEVICE_ON_CONSOLE_P (d) = (l && !(strcmp (l->h_name, hn)));
518 #endif /* HAVE_X_WINDOWS */
521 #endif /* HAVE_NATIVE_SOUND */
524 init_device_sound (struct device *d)
526 #ifdef HAVE_NAS_SOUND
530 #ifdef HAVE_NATIVE_SOUND
531 init_native_sound (d);
538 defkeyword (&Q_volume, ":volume");
539 defkeyword (&Q_pitch, ":pitch");
540 defkeyword (&Q_duration, ":duration");
541 defkeyword (&Q_sound, ":sound");
543 #ifdef HAVE_NAS_SOUND
544 defsymbol (&Qnas, "nas");
547 DEFSUBR (Fplay_sound_file);
548 DEFSUBR (Fplay_sound);
550 DEFSUBR (Fwait_for_sounds);
551 DEFSUBR (Fconnected_to_nas_p);
552 DEFSUBR (Fdevice_sound_enabled_p);
559 #ifdef HAVE_NATIVE_SOUND
560 Fprovide (intern ("native-sound"));
562 #ifdef HAVE_NAS_SOUND
563 Fprovide (intern ("nas-sound"));
565 #ifdef HAVE_ESD_SOUND
566 Fprovide (intern ("esd-sound"));
569 DEFVAR_INT ("bell-volume", &bell_volume /*
570 *How loud to be, from 0 to 100.
574 DEFVAR_INT ("bell-inhibit-time", &bell_inhibit_time /*
575 *Don't ring the bell on the same device more than once within this many seconds.
577 bell_inhibit_time = 0;
579 DEFVAR_LISP ("sound-alist", &Vsound_alist /*
580 An alist associating names with sounds.
581 When `beep' or `ding' is called with one of the name symbols, the associated
582 sound will be generated instead of the standard beep.
584 Each element of `sound-alist' is a list describing a sound.
585 The first element of the list is the name of the sound being defined.
586 Subsequent elements of the list are alternating keyword/value pairs:
590 sound A string of raw sound data, or the name of another sound to
591 play. The symbol `t' here means use the default X beep.
592 volume An integer from 0-100, defaulting to `bell-volume'
593 pitch If using the default X beep, the pitch (Hz) to generate.
594 duration If using the default X beep, the duration (milliseconds).
596 For compatibility, elements of `sound-alist' may also be:
598 ( sound-name . <sound> )
599 ( sound-name <volume> <sound> )
601 You should probably add things to this list by calling the function
605 - XEmacs must be built with sound support for your system. Not all
606 systems support sound.
608 - The pitch, duration, and volume options are available everywhere, but
609 many X servers ignore the `pitch' option.
611 The following beep-types are used by emacs itself:
613 auto-save-error when an auto-save does not succeed
614 command-error when the emacs command loop catches an error
615 undefined-key when you type a key that is undefined
616 undefined-click when you use an undefined mouse-click combination
617 no-completion during completing-read
618 y-or-n-p when you type something other than 'y' or 'n'
619 yes-or-no-p when you type something other than 'yes' or 'no'
620 default used when nothing else is appropriate.
622 Other lisp packages may use other beep types, but these are the ones that
623 the C kernel of Emacs uses.
627 DEFVAR_LISP ("synchronous-sounds", &Vsynchronous_sounds /*
628 Play sounds synchronously, if non-nil.
629 Only applies if NAS is used and supports asynchronous playing
630 of sounds. Otherwise, sounds are always played synchronously.
632 Vsynchronous_sounds = Qnil;
634 DEFVAR_LISP ("native-sound-only-on-console", &Vnative_sound_only_on_console /*
635 Non-nil value means play sounds only if XEmacs is running
636 on the system console.
637 Nil means always always play sounds, even if running on a non-console tty
638 or a secondary X display.
640 This variable only applies to native sound support.
642 Vnative_sound_only_on_console = Qt;
644 #if defined (HAVE_NATIVE_SOUND) && defined (hp9000s800)
646 void vars_of_hpplay (void);