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 int 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 TO_EXTERNAL_FORMAT (LISP_STRING, file,
124 C_STRING_ALLOCA, fileext,
126 /* #### NAS code should allow specification of a device. */
127 if (nas_play_sound_file (fileext, vol))
130 #endif /* HAVE_NAS_SOUND */
132 #ifdef HAVE_ESD_SOUND
133 if (DEVICE_CONNECTED_TO_ESD_P (d))
138 TO_EXTERNAL_FORMAT (LISP_STRING, file,
139 C_STRING_ALLOCA, fileext,
142 /* #### ESD uses alarm(). But why should we also stop SIGIO? */
144 result = esd_play_sound_file (fileext, vol);
149 #endif /* HAVE_ESD_SOUND */
151 #ifdef HAVE_NATIVE_SOUND
152 if (NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
156 TO_EXTERNAL_FORMAT (LISP_STRING, file,
157 C_STRING_ALLOCA, fileext,
159 /* The sound code doesn't like getting SIGIO interrupts.
162 play_sound_file ((char *) fileext, vol);
166 #endif /* HAVE_NATIVE_SOUND */
172 parse_sound_alist_elt (Lisp_Object elt,
175 Lisp_Object *duration,
185 /* The things we do for backward compatibility...
186 I wish I had just forced this to be a plist to begin with.
189 if (SYMBOLP (elt) || STRINGP (elt)) /* ( name . <sound> ) */
193 else if (!CONSP (elt))
197 else if (NILP (XCDR (elt)) && /* ( name <sound> ) */
198 (SYMBOLP (XCAR (elt)) ||
199 STRINGP (XCAR (elt))))
203 else if (INT_OR_FLOATP (XCAR (elt)) && /* ( name <vol> . <sound> ) */
204 (SYMBOLP (XCDR (elt)) ||
205 STRINGP (XCDR (elt))))
207 *volume = XCAR (elt);
210 else if (INT_OR_FLOATP (XCAR (elt)) && /* ( name <vol> <sound> ) */
211 CONSP (XCDR (elt)) &&
212 NILP (XCDR (XCDR (elt))) &&
213 (SYMBOLP (XCAR (XCDR (elt))) ||
214 STRINGP (XCAR (XCDR (elt)))))
216 *volume = XCAR (elt);
217 *sound = XCAR (XCDR (elt));
219 else if ((SYMBOLP (XCAR (elt)) || /* ( name <sound> . <vol> ) */
220 STRINGP (XCAR (elt))) &&
221 INT_OR_FLOATP (XCDR (elt)))
224 *volume = XCDR (elt);
226 #if 0 /* this one is ambiguous with the plist form */
227 else if ((SYMBOLP (XCAR (elt)) || /* ( name <sound> <vol> ) */
228 STRINGP (XCAR (elt))) &&
229 CONSP (XCDR (elt)) &&
230 NILP (XCDR (XCDR (elt))) &&
231 INT_OR_FLOATP (XCAR (XCDR (elt))))
234 *volume = XCAR (XCDR (elt));
237 else /* ( name [ keyword <value> ]* ) */
241 Lisp_Object key, val;
248 if (EQ (key, Q_volume))
250 if (INT_OR_FLOATP (val)) *volume = val;
252 else if (EQ (key, Q_pitch))
254 if (INT_OR_FLOATP (val)) *pitch = val;
255 if (NILP (*sound)) *sound = Qt;
257 else if (EQ (key, Q_duration))
259 if (INT_OR_FLOATP (val)) *duration = val;
260 if (NILP (*sound)) *sound = Qt;
262 else if (EQ (key, Q_sound))
264 if (SYMBOLP (val) || STRINGP (val)) *sound = val;
270 DEFUN ("play-sound", Fplay_sound, 1, 3, 0, /*
271 Play a sound of the provided type.
272 See the variable `sound-alist'.
274 (sound, volume, device))
276 int looking_for_default = 0;
277 /* variable `sound' is anything that can be a cdr in sound-alist */
278 Lisp_Object new_volume, pitch, duration, data;
281 struct device *d = decode_device (device);
283 /* NOTE! You'd better not signal an error in here. */
290 sound = Fcdr (Fassq (sound, Vsound_alist));
291 parse_sound_alist_elt (sound, &new_volume, &pitch, &duration, &data);
293 if (NILP (volume)) volume = new_volume;
294 if (EQ (sound, Qt) || EQ (sound, Qnil) || STRINGP (sound))
296 if (loop_count++ > 500) /* much bogosity has occurred */
300 if (NILP (sound) && !looking_for_default)
302 looking_for_default = 1;
309 vol = (INT_OR_FLOATP (volume) ? (int) XFLOATINT (volume) : bell_volume);
310 pit = (INT_OR_FLOATP (pitch) ? (int) XFLOATINT (pitch) : -1);
311 dur = (INT_OR_FLOATP (duration) ? (int) XFLOATINT (duration) : -1);
313 /* If the sound is a string, and we're connected to Nas, do that.
314 Else if the sound is a string, and we're on console, play it natively.
317 #ifdef HAVE_NAS_SOUND
318 if (DEVICE_CONNECTED_TO_NAS_P (d) && STRINGP (sound))
320 const Extbyte *soundext;
321 Extcount soundextlen;
323 TO_EXTERNAL_FORMAT (LISP_STRING, sound,
324 ALLOCA, (soundext, soundextlen),
326 if (nas_play_sound_data ((unsigned char*)soundext, soundextlen, vol))
329 #endif /* HAVE_NAS_SOUND */
331 #ifdef HAVE_ESD_SOUND
332 if (DEVICE_CONNECTED_TO_ESD_P (d) && STRINGP (sound))
335 Extcount soundextlen;
338 TO_EXTERNAL_FORMAT (LISP_STRING, sound, ALLOCA, (soundext, soundextlen),
341 /* #### ESD uses alarm(). But why should we also stop SIGIO? */
343 succes = esd_play_sound_data (soundext, soundextlen, vol);
349 #endif /* HAVE_ESD_SOUND */
351 #ifdef HAVE_NATIVE_SOUND
352 if ((NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
355 const Extbyte *soundext;
356 Extcount soundextlen;
359 TO_EXTERNAL_FORMAT (LISP_STRING, sound,
360 ALLOCA, (soundext, soundextlen),
362 /* The sound code doesn't like getting SIGIO interrupts. Unix sucks! */
364 succes = play_sound_data ((unsigned char*)soundext, soundextlen, vol);
370 #endif /* HAVE_NATIVE_SOUND */
372 DEVMETH (d, ring_bell, (d, vol, pit, dur));
376 DEFUN ("device-sound-enabled-p", Fdevice_sound_enabled_p, 0, 1, 0, /*
377 Return t if DEVICE is able to play sound. Defaults to selected device.
381 #ifdef HAVE_NAS_SOUND
382 if (DEVICE_CONNECTED_TO_NAS_P (decode_device (device)))
385 #ifdef HAVE_NATIVE_SOUND
386 if (DEVICE_ON_CONSOLE_P (decode_device (device)))
392 DEFUN ("ding", Fding, 0, 3, 0, /*
393 Beep, or flash the frame.
394 Also, unless an argument is given,
395 terminate any keyboard macro currently executing.
396 When called from lisp, the second argument is what sound to make, and
397 the third argument is the device to make it in (defaults to the selected
400 (arg, sound, device))
402 static time_t last_bell_time;
403 static struct device *last_bell_device;
405 struct device *d = decode_device (device);
407 XSETDEVICE (device, d);
410 if (NILP (arg) && !NILP (Vexecuting_macro))
411 /* Stop executing a keyboard macro. */
412 error ("Keyboard macro terminated by a command ringing the bell");
414 if (d == last_bell_device && now-last_bell_time < bell_inhibit_time)
416 else if (!NILP (Vvisible_bell) && DEVMETH (d, flash, (d)))
419 Fplay_sound (sound, Qnil, device);
421 last_bell_time = now;
422 last_bell_device = d;
426 DEFUN ("wait-for-sounds", Fwait_for_sounds, 0, 1, 0, /*
427 Wait for all sounds to finish playing on DEVICE.
432 #ifdef HAVE_NAS_SOUND
433 struct device *d = decode_device (device);
434 if (DEVICE_CONNECTED_TO_NAS_P (d))
436 /* #### somebody fix this to be device-dependent. */
437 nas_wait_for_sounds ();
443 DEFUN ("connected-to-nas-p", Fconnected_to_nas_p, 0, 1, 0, /*
444 Return t if connected to NAS server for sounds on DEVICE.
448 #ifdef HAVE_NAS_SOUND
449 return DEVICE_CONNECTED_TO_NAS_P (decode_device (device)) ? Qt : Qnil;
454 #ifdef HAVE_NAS_SOUND
457 init_nas_sound (struct device *d)
459 #ifdef HAVE_X_WINDOWS
462 char *err_message = nas_init_play (DEVICE_X_DISPLAY (d));
463 DEVICE_CONNECTED_TO_NAS_P (d) = !err_message;
464 /* Print out the message? */
466 #endif /* HAVE_X_WINDOWS */
469 #endif /* HAVE_NAS_SOUND */
471 #ifdef HAVE_NATIVE_SOUND
474 init_native_sound (struct device *d)
476 if (DEVICE_TTY_P (d) || DEVICE_STREAM_P (d) || DEVICE_MSWINDOWS_P(d))
477 DEVICE_ON_CONSOLE_P (d) = 1;
478 #ifdef HAVE_X_WINDOWS
481 /* When running on a machine with native sound support, we cannot use
482 digitized sounds as beeps unless emacs is running on the same machine
483 that $DISPLAY points to, and $DISPLAY points to frame 0 of that
487 Display *display = DEVICE_X_DISPLAY (d);
488 char *dpy = DisplayString (display);
489 char *tail = (char *) strchr (dpy, ':');
491 strncmp (tail, ":0", 2))
492 DEVICE_ON_CONSOLE_P (d) = 0;
495 char dpyname[255], localname[255];
497 /* some systems can't handle SIGIO or SIGALARM in gethostbyname. */
499 strncpy (dpyname, dpy, tail-dpy);
500 dpyname [tail-dpy] = 0;
502 !strcmp (dpyname, "unix") ||
503 !strcmp (dpyname, "localhost"))
504 DEVICE_ON_CONSOLE_P (d) = 1;
505 else if (gethostname (localname, sizeof (localname)))
506 DEVICE_ON_CONSOLE_P (d) = 0; /* can't find hostname? */
509 /* We have to call gethostbyname() on the result of gethostname()
510 because the two aren't guaranteed to be the same name for the
511 same host: on some losing systems, one is a FQDN and the other
512 is not. Here in the wide wonderful world of Unix it's rocket
513 science to obtain the local hostname in a portable fashion.
515 And don't forget, gethostbyname() reuses the structure it
516 returns, so we have to copy the fucker before calling it
519 Thank you master, may I have another.
521 struct hostent *h = gethostbyname (dpyname);
523 DEVICE_ON_CONSOLE_P (d) = 0;
528 strcpy (hn, h->h_name);
529 l = gethostbyname (localname);
530 DEVICE_ON_CONSOLE_P (d) = (l && !(strcmp (l->h_name, hn)));
536 #endif /* HAVE_X_WINDOWS */
539 #endif /* HAVE_NATIVE_SOUND */
542 init_device_sound (struct device *d)
544 #ifdef HAVE_NAS_SOUND
548 #ifdef HAVE_NATIVE_SOUND
549 init_native_sound (d);
556 defkeyword (&Q_volume, ":volume");
557 defkeyword (&Q_pitch, ":pitch");
558 defkeyword (&Q_duration, ":duration");
559 defkeyword (&Q_sound, ":sound");
561 #ifdef HAVE_NAS_SOUND
562 defsymbol (&Qnas, "nas");
565 DEFSUBR (Fplay_sound_file);
566 DEFSUBR (Fplay_sound);
568 DEFSUBR (Fwait_for_sounds);
569 DEFSUBR (Fconnected_to_nas_p);
570 DEFSUBR (Fdevice_sound_enabled_p);
577 #ifdef HAVE_NATIVE_SOUND
578 Fprovide (intern ("native-sound"));
580 #ifdef HAVE_NAS_SOUND
581 Fprovide (intern ("nas-sound"));
583 #ifdef HAVE_ESD_SOUND
584 Fprovide (intern ("esd-sound"));
587 DEFVAR_INT ("bell-volume", &bell_volume /*
588 *How loud to be, from 0 to 100.
592 DEFVAR_INT ("bell-inhibit-time", &bell_inhibit_time /*
593 *Don't ring the bell on the same device more than once within this many seconds.
595 bell_inhibit_time = 0;
597 DEFVAR_LISP ("sound-alist", &Vsound_alist /*
598 An alist associating names with sounds.
599 When `beep' or `ding' is called with one of the name symbols, the associated
600 sound will be generated instead of the standard beep.
602 Each element of `sound-alist' is a list describing a sound.
603 The first element of the list is the name of the sound being defined.
604 Subsequent elements of the list are alternating keyword/value pairs:
608 sound A string of raw sound data, or the name of another sound to
609 play. The symbol `t' here means use the default X beep.
610 volume An integer from 0-100, defaulting to `bell-volume'
611 pitch If using the default X beep, the pitch (Hz) to generate.
612 duration If using the default X beep, the duration (milliseconds).
614 For compatibility, elements of `sound-alist' may also be:
616 ( sound-name . <sound> )
617 ( sound-name <volume> <sound> )
619 You should probably add things to this list by calling the function
623 - XEmacs must be built with sound support for your system. Not all
624 systems support sound.
626 - The pitch, duration, and volume options are available everywhere, but
627 many X servers ignore the `pitch' option.
629 The following beep-types are used by emacs itself:
631 auto-save-error when an auto-save does not succeed
632 command-error when the emacs command loop catches an error
633 undefined-key when you type a key that is undefined
634 undefined-click when you use an undefined mouse-click combination
635 no-completion during completing-read
636 y-or-n-p when you type something other than 'y' or 'n'
637 yes-or-no-p when you type something other than 'yes' or 'no'
638 default used when nothing else is appropriate.
640 Other lisp packages may use other beep types, but these are the ones that
641 the C kernel of Emacs uses.
645 DEFVAR_LISP ("synchronous-sounds", &Vsynchronous_sounds /*
646 Play sounds synchronously, if non-nil.
647 Only applies if NAS is used and supports asynchronous playing
648 of sounds. Otherwise, sounds are always played synchronously.
650 Vsynchronous_sounds = Qnil;
652 DEFVAR_LISP ("native-sound-only-on-console", &Vnative_sound_only_on_console /*
653 Non-nil value means play sounds only if XEmacs is running
654 on the system console.
655 Nil means always always play sounds, even if running on a non-console tty
656 or a secondary X display.
658 This variable only applies to native sound support.
660 Vnative_sound_only_on_console = Qt;
662 #if defined (HAVE_NATIVE_SOUND) && defined (hp9000s800)
664 void vars_of_hpplay (void);