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. */
32 #include "console-x.h"
36 #include "redisplay.h"
43 #ifdef HAVE_NATIVE_SOUND
48 Lisp_Object Vsound_alist;
49 Lisp_Object Vsynchronous_sounds;
50 Lisp_Object Vnative_sound_only_on_console;
51 Lisp_Object Q_volume, Q_pitch, Q_duration, Q_sound;
53 /* These are defined in the appropriate file (sunplay.c, sgiplay.c,
56 extern void play_sound_file (char *name, int volume);
57 extern void play_sound_data (unsigned char *data, int length, int volume);
60 extern int nas_play_sound_file (char *name, int volume);
61 extern int nas_play_sound_data (unsigned char *data, int length, int volume);
62 extern int nas_wait_for_sounds (void);
63 extern char *nas_init_play (Display *);
68 DEFUN ("play-sound-file", Fplay_sound_file, 1, 3, "fSound file name: ", /*
69 Play the named sound file on DEVICE's speaker at the specified volume
70 \(0-100, default specified by the `bell-volume' variable).
71 On Unix machines the sound file must be in the Sun/NeXT U-LAW format
72 except under Linux where WAV files are also supported. On Microsoft
73 Windows the sound file must be in WAV format.
74 DEVICE defaults to the selected device.
76 (file, volume, device))
78 /* This function can call lisp */
80 #if defined (HAVE_NATIVE_SOUND) || defined (HAVE_NAS_SOUND)
81 struct device *d = decode_device (device);
97 file = Fexpand_file_name (file, Qnil);
98 if (!NILP(Ffile_readable_p (file)))
102 /* #### This is crockish. It might be a better idea to try
103 to open the file, and use report_file_error() if it
105 if (NILP (Ffile_exists_p (file)))
107 signal_simple_continuable_error ("File does not exist", file);
110 signal_simple_continuable_error ("File is unreadable", file);
115 #ifdef HAVE_NAS_SOUND
116 if (DEVICE_CONNECTED_TO_NAS_P (d))
120 GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext);
121 /* #### NAS code should allow specification of a device. */
122 if (nas_play_sound_file (fileext, vol))
125 #endif /* HAVE_NAS_SOUND */
127 #ifdef HAVE_NATIVE_SOUND
128 if (NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
132 GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext);
133 /* The sound code doesn't like getting SIGIO interrupts.
136 play_sound_file ((char *) fileext, vol);
140 #endif /* HAVE_NATIVE_SOUND */
146 parse_sound_alist_elt (Lisp_Object elt,
149 Lisp_Object *duration,
159 /* The things we do for backward compatibility...
160 I wish I had just forced this to be a plist to begin with.
163 if (SYMBOLP (elt) || STRINGP (elt)) /* ( name . <sound> ) */
167 else if (!CONSP (elt))
171 else if (NILP (XCDR (elt)) && /* ( name <sound> ) */
172 (SYMBOLP (XCAR (elt)) ||
173 STRINGP (XCAR (elt))))
177 else if (INT_OR_FLOATP (XCAR (elt)) && /* ( name <vol> . <sound> ) */
178 (SYMBOLP (XCDR (elt)) ||
179 STRINGP (XCDR (elt))))
181 *volume = XCAR (elt);
184 else if (INT_OR_FLOATP (XCAR (elt)) && /* ( name <vol> <sound> ) */
185 CONSP (XCDR (elt)) &&
186 NILP (XCDR (XCDR (elt))) &&
187 (SYMBOLP (XCAR (XCDR (elt))) ||
188 STRINGP (XCAR (XCDR (elt)))))
190 *volume = XCAR (elt);
191 *sound = XCAR (XCDR (elt));
193 else if ((SYMBOLP (XCAR (elt)) || /* ( name <sound> . <vol> ) */
194 STRINGP (XCAR (elt))) &&
195 INT_OR_FLOATP (XCDR (elt)))
198 *volume = XCDR (elt);
200 #if 0 /* this one is ambiguous with the plist form */
201 else if ((SYMBOLP (XCAR (elt)) || /* ( name <sound> <vol> ) */
202 STRINGP (XCAR (elt))) &&
203 CONSP (XCDR (elt)) &&
204 NILP (XCDR (XCDR (elt))) &&
205 INT_OR_FLOATP (XCAR (XCDR (elt))))
208 *volume = XCAR (XCDR (elt));
211 else /* ( name [ keyword <value> ]* ) */
215 Lisp_Object key, val;
222 if (EQ (key, Q_volume))
224 if (INT_OR_FLOATP (val)) *volume = val;
226 else if (EQ (key, Q_pitch))
228 if (INT_OR_FLOATP (val)) *pitch = val;
229 if (NILP (*sound)) *sound = Qt;
231 else if (EQ (key, Q_duration))
233 if (INT_OR_FLOATP (val)) *duration = val;
234 if (NILP (*sound)) *sound = Qt;
236 else if (EQ (key, Q_sound))
238 if (SYMBOLP (val) || STRINGP (val)) *sound = val;
244 DEFUN ("play-sound", Fplay_sound, 1, 3, 0, /*
245 Play a sound of the provided type.
246 See the variable `sound-alist'.
248 (sound, volume, device))
250 int looking_for_default = 0;
251 /* variable `sound' is anything that can be a cdr in sound-alist */
252 Lisp_Object new_volume, pitch, duration, data;
255 struct device *d = decode_device (device);
257 /* NOTE! You'd better not signal an error in here. */
264 sound = Fcdr (Fassq (sound, Vsound_alist));
265 parse_sound_alist_elt (sound, &new_volume, &pitch, &duration, &data);
267 if (NILP (volume)) volume = new_volume;
268 if (EQ (sound, Qt) || EQ (sound, Qnil) || STRINGP (sound))
270 if (loop_count++ > 500) /* much bogosity has occurred */
274 if (NILP (sound) && !looking_for_default)
276 looking_for_default = 1;
283 vol = (INT_OR_FLOATP (volume) ? (int) XFLOATINT (volume) : bell_volume);
284 pit = (INT_OR_FLOATP (pitch) ? (int) XFLOATINT (pitch) : -1);
285 dur = (INT_OR_FLOATP (duration) ? (int) XFLOATINT (duration) : -1);
287 /* If the sound is a string, and we're connected to Nas, do that.
288 Else if the sound is a string, and we're on console, play it natively.
291 #ifdef HAVE_NAS_SOUND
292 if (DEVICE_CONNECTED_TO_NAS_P (d) && STRINGP (sound))
294 CONST Extbyte *soundext;
295 Extcount soundextlen;
297 GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen);
298 if (nas_play_sound_data ((unsigned char*)soundext, soundextlen, vol))
301 #endif /* HAVE_NAS_SOUND */
303 #ifdef HAVE_NATIVE_SOUND
304 if ((NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
307 CONST Extbyte *soundext;
308 Extcount soundextlen;
310 GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen);
311 /* The sound code doesn't like getting SIGIO interrupts. Unix sucks! */
313 play_sound_data ((unsigned char*)soundext, soundextlen, vol);
318 #endif /* HAVE_NATIVE_SOUND */
320 DEVMETH (d, ring_bell, (d, vol, pit, dur));
324 DEFUN ("device-sound-enabled-p", Fdevice_sound_enabled_p, 0, 1, 0, /*
325 Return t if DEVICE is able to play sound. Defaults to selected device.
329 struct device *d = decode_device(device);
331 #ifdef HAVE_NAS_SOUND
332 if (DEVICE_CONNECTED_TO_NAS_P (d))
335 #ifdef HAVE_NATIVE_SOUND
336 if (DEVICE_ON_CONSOLE_P (d))
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 struct device *d = decode_device (device);
354 XSETDEVICE (device, d);
356 /* #### This is utterly disgusting, and is probably a remnant from
357 legacy code that used `ding'+`message' to signal error instead
358 calling `error'. As a result, there is no way to beep from Lisp
359 directly, without also invoking this aspect. Maybe we should
360 define a `ring-bell' function that simply beeps on the console,
361 which `ding' should invoke? --hniksic */
362 if (NILP (arg) && !NILP (Vexecuting_macro))
363 /* Stop executing a keyboard macro. */
364 error ("Keyboard macro terminated by a command ringing the bell");
365 else if (visible_bell && DEVMETH (d, flash, (d)))
368 Fplay_sound (sound, Qnil, device);
373 DEFUN ("wait-for-sounds", Fwait_for_sounds, 0, 1, 0, /*
374 Wait for all sounds to finish playing on DEVICE.
379 #ifdef HAVE_NAS_SOUND
380 struct device *d = decode_device (device);
381 if (DEVICE_CONNECTED_TO_NAS_P (d))
383 /* #### somebody fix this to be device-dependent. */
384 nas_wait_for_sounds ();
390 DEFUN ("connected-to-nas-p", Fconnected_to_nas_p, 0, 1, 0, /*
391 Return t if connected to NAS server for sounds on DEVICE.
395 #ifdef HAVE_NAS_SOUND
396 return DEVICE_CONNECTED_TO_NAS_P (decode_device (device)) ? Qt : Qnil;
401 #ifdef HAVE_NAS_SOUND
404 init_nas_sound (struct device *d)
408 #ifdef HAVE_X_WINDOWS
411 error = nas_init_play (DEVICE_X_DISPLAY (d));
412 DEVICE_CONNECTED_TO_NAS_P (d) = !error;
413 /* Print out the message? */
415 #endif /* HAVE_X_WINDOWS */
418 #endif /* HAVE_NAS_SOUND */
420 #ifdef HAVE_NATIVE_SOUND
423 init_native_sound (struct device *d)
425 if (DEVICE_TTY_P (d) || DEVICE_STREAM_P (d) || DEVICE_MSWINDOWS_P(d))
426 DEVICE_ON_CONSOLE_P (d) = 1;
427 #ifdef HAVE_X_WINDOWS
430 /* When running on a machine with native sound support, we cannot use
431 digitized sounds as beeps unless emacs is running on the same machine
432 that $DISPLAY points to, and $DISPLAY points to frame 0 of that
436 Display *display = DEVICE_X_DISPLAY (d);
437 char *dpy = DisplayString (display);
438 char *tail = (char *) strchr (dpy, ':');
440 strncmp (tail, ":0", 2))
441 DEVICE_ON_CONSOLE_P (d) = 0;
444 char dpyname[255], localname[255];
446 /* some systems can't handle SIGIO or SIGALARM in gethostbyname. */
448 strncpy (dpyname, dpy, tail-dpy);
449 dpyname [tail-dpy] = 0;
451 !strcmp (dpyname, "unix") ||
452 !strcmp (dpyname, "localhost"))
453 DEVICE_ON_CONSOLE_P (d) = 1;
454 else if (gethostname (localname, sizeof (localname)))
455 DEVICE_ON_CONSOLE_P (d) = 0; /* can't find hostname? */
458 /* We have to call gethostbyname() on the result of gethostname()
459 because the two aren't guaranteed to be the same name for the
460 same host: on some losing systems, one is a FQDN and the other
461 is not. Here in the wide wonderful world of Unix it's rocket
462 science to obtain the local hostname in a portable fashion.
464 And don't forget, gethostbyname() reuses the structure it
465 returns, so we have to copy the fucker before calling it
468 Thank you master, may I have another.
470 struct hostent *h = gethostbyname (dpyname);
472 DEVICE_ON_CONSOLE_P (d) = 0;
477 strcpy (hn, h->h_name);
478 l = gethostbyname (localname);
479 DEVICE_ON_CONSOLE_P (d) = (l && !(strcmp (l->h_name, hn)));
485 #endif /* HAVE_X_WINDOWS */
488 #endif /* HAVE_NATIVE_SOUND */
491 init_device_sound (struct device *d)
493 #ifdef HAVE_NAS_SOUND
497 #ifdef HAVE_NATIVE_SOUND
498 init_native_sound (d);
505 defkeyword (&Q_volume, ":volume");
506 defkeyword (&Q_pitch, ":pitch");
507 defkeyword (&Q_duration, ":duration");
508 defkeyword (&Q_sound, ":sound");
510 #ifdef HAVE_NAS_SOUND
511 defsymbol (&Qnas, "nas");
514 DEFSUBR (Fplay_sound_file);
515 DEFSUBR (Fplay_sound);
517 DEFSUBR (Fwait_for_sounds);
518 DEFSUBR (Fconnected_to_nas_p);
519 DEFSUBR (Fdevice_sound_enabled_p);
526 #ifdef HAVE_NATIVE_SOUND
527 Fprovide (intern ("native-sound"));
529 #ifdef HAVE_NAS_SOUND
530 Fprovide (intern ("nas-sound"));
533 DEFVAR_INT ("bell-volume", &bell_volume /*
534 *How loud to be, from 0 to 100.
538 DEFVAR_LISP ("sound-alist", &Vsound_alist /*
539 An alist associating names with sounds.
540 When `beep' or `ding' is called with one of the name symbols, the associated
541 sound will be generated instead of the standard beep.
543 Each element of `sound-alist' is a list describing a sound.
544 The first element of the list is the name of the sound being defined.
545 Subsequent elements of the list are alternating keyword/value pairs:
549 sound A string of raw sound data, or the name of another sound to
550 play. The symbol `t' here means use the default X beep.
551 volume An integer from 0-100, defaulting to `bell-volume'
552 pitch If using the default X beep, the pitch (Hz) to generate.
553 duration If using the default X beep, the duration (milliseconds).
555 For compatibility, elements of `sound-alist' may also be:
557 ( sound-name . <sound> )
558 ( sound-name <volume> <sound> )
560 You should probably add things to this list by calling the function
564 - You can only play audio data if running on the console screen of a
565 Sun SparcStation, SGI, or HP9000s700.
567 - The pitch, duration, and volume options are available everywhere, but
568 many X servers ignore the `pitch' option.
570 The following beep-types are used by emacs itself:
572 auto-save-error when an auto-save does not succeed
573 command-error when the emacs command loop catches an error
574 undefined-key when you type a key that is undefined
575 undefined-click when you use an undefined mouse-click combination
576 no-completion during completing-read
577 y-or-n-p when you type something other than 'y' or 'n'
578 yes-or-no-p when you type something other than 'yes' or 'no'
579 default used when nothing else is appropriate.
581 Other lisp packages may use other beep types, but these are the ones that
582 the C kernel of Emacs uses.
586 DEFVAR_LISP ("synchronous-sounds", &Vsynchronous_sounds /*
587 Play sounds synchronously, if non-nil.
588 Only applies if NAS is used and supports asynchronous playing
589 of sounds. Otherwise, sounds are always played synchronously.
591 Vsynchronous_sounds = Qnil;
593 DEFVAR_LISP ("native-sound-only-on-console", &Vnative_sound_only_on_console /*
594 Non-nil value means play sounds only if XEmacs is running
595 on the system console.
596 Nil means always always play sounds, even if running on a non-console tty
597 or a secondary X display.
599 This variable only applies to native sound support.
601 Vnative_sound_only_on_console = Qt;
603 #if defined (HAVE_NATIVE_SOUND) && defined (hp9000s800)
605 void vars_of_hpplay (void);