Mercurial > hg > xemacs-beta

comparison src/sound.c @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children a5df635868b2
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 /* Sound functions.
2 Copyright (C) 1992, 1993, 1994 Lucid Inc.
3 Copyright (C) 1994, 1995 Free Software Foundation, Inc.
4
5 This file is part of XEmacs.
6
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
10 later version.
11
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
15 for more details.
16
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. */
21
22 /* Synched up with: Not in FSF. */
23
24 /* Originally written by Jamie Zawinski.
25 Hacked on quite a bit by various others. */
26
27 #include <config.h>
28 #include <time.h>
29 #include "lisp.h"
30
31 #include "buffer.h"
32 #ifdef HAVE_X_WINDOWS
33 #include "console-x.h"
34 #endif
35
36 #include "device.h"
37 #include "redisplay.h"
38 #include "sysdep.h"
39
40 #ifdef HAVE_UNISTD_H
41 #include <unistd.h>
42 #endif
43
44 #ifdef HAVE_NATIVE_SOUND
45 # include <netdb.h>
46 #endif
47
48 #ifdef HAVE_ESD_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 */
52 #endif
53
54 int bell_volume;
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;
60
61 /* These are defined in the appropriate file (sunplay.c, sgiplay.c,
62 or hpplay.c). */
63
64 extern void play_sound_file (char *name, int volume);
65 extern void play_sound_data (unsigned char *data, int length, int volume);
66
67 #ifdef HAVE_NAS_SOUND
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 *);
72
73 Lisp_Object Qnas;
74 #endif
75
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.
83 */
84 (file, volume, device))
85 {
86 /* This function can call lisp */
87 int vol;
88 #if defined (HAVE_NATIVE_SOUND) || defined (HAVE_NAS_SOUND) \
89 || defined (HAVE_ESD_SOUND)
90 struct device *d = decode_device (device);
91 #endif
92 struct gcpro gcpro1;
93
94 CHECK_STRING (file);
95 if (NILP (volume))
96 vol = bell_volume;
97 else
98 {
99 CHECK_INT (volume);
100 vol = XINT (volume);
101 }
102
103 GCPRO1 (file);
104 while (1)
105 {
106 file = Fexpand_file_name (file, Qnil);
107 if (!NILP(Ffile_readable_p (file)))
108 break;
109 else
110 {
111 /* #### This is crockish. It might be a better idea to try
112 to open the file, and use report_file_error() if it
113 fails. --hniksic */
114 if (NILP (Ffile_exists_p (file)))
115 file =
116 signal_simple_continuable_error ("File does not exist", file);
117 else
118 file =
119 signal_simple_continuable_error ("File is unreadable", file);
120 }
121 }
122 UNGCPRO;
123
124 #ifdef HAVE_NAS_SOUND
125 if (DEVICE_CONNECTED_TO_NAS_P (d))
126 {
127 char *fileext;
128
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))
132 return Qnil;
133 }
134 #endif /* HAVE_NAS_SOUND */
135
136 #ifdef HAVE_ESD_SOUND
137 if (DEVICE_CONNECTED_TO_ESD_P (d))
138 {
139 char *fileext;
140
141 GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext);
142 if (esd_play_sound_file (fileext, vol))
143 return Qnil;
144 }
145 #endif /* HAVE_ESD_SOUND */
146
147 #ifdef HAVE_NATIVE_SOUND
148 if (NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
149 {
150 CONST char *fileext;
151
152 GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext);
153 /* The sound code doesn't like getting SIGIO interrupts.
154 Unix sucks! */
155 stop_interrupts ();
156 play_sound_file ((char *) fileext, vol);
157 start_interrupts ();
158 QUIT;
159 }
160 #endif /* HAVE_NATIVE_SOUND */
161
162 return Qnil;
163 }
164
165 static void
166 parse_sound_alist_elt (Lisp_Object elt,
167 Lisp_Object *volume,
168 Lisp_Object *pitch,
169 Lisp_Object *duration,
170 Lisp_Object *sound)
171 {
172 *volume = Qnil;
173 *pitch = Qnil;
174 *duration = Qnil;
175 *sound = Qnil;
176 if (! CONSP (elt))
177 return;
178
179 /* The things we do for backward compatibility...
180 I wish I had just forced this to be a plist to begin with.
181 */
182
183 if (SYMBOLP (elt) || STRINGP (elt)) /* ( name . <sound> ) */
184 {
185 *sound = elt;
186 }
187 else if (!CONSP (elt))
188 {
189 return;
190 }
191 else if (NILP (XCDR (elt)) && /* ( name <sound> ) */
192 (SYMBOLP (XCAR (elt)) ||
193 STRINGP (XCAR (elt))))
194 {
195 *sound = XCAR (elt);
196 }
197 else if (INT_OR_FLOATP (XCAR (elt)) && /* ( name <vol> . <sound> ) */
198 (SYMBOLP (XCDR (elt)) ||
199 STRINGP (XCDR (elt))))
200 {
201 *volume = XCAR (elt);
202 *sound = XCDR (elt);
203 }
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)))))
209 {
210 *volume = XCAR (elt);
211 *sound = XCAR (XCDR (elt));
212 }
213 else if ((SYMBOLP (XCAR (elt)) || /* ( name <sound> . <vol> ) */
214 STRINGP (XCAR (elt))) &&
215 INT_OR_FLOATP (XCDR (elt)))
216 {
217 *sound = XCAR (elt);
218 *volume = XCDR (elt);
219 }
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))))
226 {
227 *sound = XCAR (elt);
228 *volume = XCAR (XCDR (elt));
229 }
230 #endif /* 0 */
231 else /* ( name [ keyword <value> ]* ) */
232 {
233 while (CONSP (elt))
234 {
235 Lisp_Object key, val;
236 key = XCAR (elt);
237 val = XCDR (elt);
238 if (!CONSP (val))
239 return;
240 elt = XCDR (val);
241 val = XCAR (val);
242 if (EQ (key, Q_volume))
243 {
244 if (INT_OR_FLOATP (val)) *volume = val;
245 }
246 else if (EQ (key, Q_pitch))
247 {
248 if (INT_OR_FLOATP (val)) *pitch = val;
249 if (NILP (*sound)) *sound = Qt;
250 }
251 else if (EQ (key, Q_duration))
252 {
253 if (INT_OR_FLOATP (val)) *duration = val;
254 if (NILP (*sound)) *sound = Qt;
255 }
256 else if (EQ (key, Q_sound))
257 {
258 if (SYMBOLP (val) || STRINGP (val)) *sound = val;
259 }
260 }
261 }
262 }
263
264 DEFUN ("play-sound", Fplay_sound, 1, 3, 0, /*
265 Play a sound of the provided type.
266 See the variable `sound-alist'.
267 */
268 (sound, volume, device))
269 {
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;
273 int loop_count = 0;
274 int vol, pit, dur;
275 struct device *d = decode_device (device);
276
277 /* NOTE! You'd better not signal an error in here. */
278
279
280 try_it_again:
281 while (1)
282 {
283 if (SYMBOLP (sound))
284 sound = Fcdr (Fassq (sound, Vsound_alist));
285 parse_sound_alist_elt (sound, &new_volume, &pitch, &duration, &data);
286 sound = data;
287 if (NILP (volume)) volume = new_volume;
288 if (EQ (sound, Qt) || EQ (sound, Qnil) || STRINGP (sound))
289 break;
290 if (loop_count++ > 500) /* much bogosity has occurred */
291 break;
292 }
293
294 if (NILP (sound) && !looking_for_default)
295 {
296 looking_for_default = 1;
297 loop_count = 0;
298 sound = Qdefault;
299 goto try_it_again;
300 }
301
302
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);
306
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.
309 Else just beep.
310 */
311 #ifdef HAVE_NAS_SOUND
312 if (DEVICE_CONNECTED_TO_NAS_P (d) && STRINGP (sound))
313 {
314 CONST Extbyte *soundext;
315 Extcount soundextlen;
316
317 GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen);
318 if (nas_play_sound_data ((unsigned char*)soundext, soundextlen, vol))
319 return Qnil;
320 }
321 #endif /* HAVE_NAS_SOUND */
322
323 #ifdef HAVE_ESD_SOUND
324 if (DEVICE_CONNECTED_TO_ESD_P (d) && STRINGP (sound))
325 {
326 Extbyte *soundext;
327 Extcount soundextlen;
328
329 GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen);
330 if (esd_play_sound_data (soundext, soundextlen, vol))
331 return Qnil;
332 }
333 #endif /* HAVE_ESD_SOUND */
334
335 #ifdef HAVE_NATIVE_SOUND
336 if ((NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
337 && STRINGP (sound))
338 {
339 CONST Extbyte *soundext;
340 Extcount soundextlen;
341
342 GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen);
343 /* The sound code doesn't like getting SIGIO interrupts. Unix sucks! */
344 stop_interrupts ();
345 play_sound_data ((unsigned char*)soundext, soundextlen, vol);
346 start_interrupts ();
347 QUIT;
348 return Qnil;
349 }
350 #endif /* HAVE_NATIVE_SOUND */
351
352 DEVMETH (d, ring_bell, (d, vol, pit, dur));
353 return Qnil;
354 }
355
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.
358 */
359 (device))
360 {
361 #ifdef HAVE_NAS_SOUND
362 if (DEVICE_CONNECTED_TO_NAS_P (decode_device (device)))
363 return Qt;
364 #endif
365 #ifdef HAVE_NATIVE_SOUND
366 if (DEVICE_ON_CONSOLE_P (decode_device (device)))
367 return Qt;
368 #endif
369 return Qnil;
370 }
371
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
378 device).
379 */
380 (arg, sound, device))
381 {
382 static time_t last_bell_time = (time_t) 0;
383 static struct device *last_bell_device = (struct device*) 0;
384 time_t now;
385 struct device *d = decode_device (device);
386
387 XSETDEVICE (device, d);
388 now = time (0);
389
390 if (NILP (arg) && !NILP (Vexecuting_macro))
391 /* Stop executing a keyboard macro. */
392 error ("Keyboard macro terminated by a command ringing the bell");
393
394 if (d == last_bell_device && now-last_bell_time < bell_inhibit_time)
395 return Qnil;
396 else if (visible_bell && DEVMETH (d, flash, (d)))
397 ;
398 else
399 Fplay_sound (sound, Qnil, device);
400
401 last_bell_time = now;
402 last_bell_device = d;
403 return Qnil;
404 }
405
406 DEFUN ("wait-for-sounds", Fwait_for_sounds, 0, 1, 0, /*
407 Wait for all sounds to finish playing on DEVICE.
408 */
409 (device))
410
411 {
412 #ifdef HAVE_NAS_SOUND
413 struct device *d = decode_device (device);
414 if (DEVICE_CONNECTED_TO_NAS_P (d))
415 {
416 /* #### somebody fix this to be device-dependent. */
417 nas_wait_for_sounds ();
418 }
419 #endif
420 return Qnil;
421 }
422
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.
425 */
426 (device))
427 {
428 #ifdef HAVE_NAS_SOUND
429 return DEVICE_CONNECTED_TO_NAS_P (decode_device (device)) ? Qt : Qnil;
430 #else
431 return Qnil;
432 #endif
433 }
434 #ifdef HAVE_NAS_SOUND
435
436 static void
437 init_nas_sound (struct device *d)
438 {
439 char *error;
440
441 #ifdef HAVE_X_WINDOWS
442 if (DEVICE_X_P (d))
443 {
444 error = nas_init_play (DEVICE_X_DISPLAY (d));
445 DEVICE_CONNECTED_TO_NAS_P (d) = !error;
446 /* Print out the message? */
447 }
448 #endif /* HAVE_X_WINDOWS */
449 }
450
451 #endif /* HAVE_NAS_SOUND */
452
453 #ifdef HAVE_NATIVE_SOUND
454
455 static void
456 init_native_sound (struct device *d)
457 {
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
461 else
462 {
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
466 machine.
467 */
468
469 Display *display = DEVICE_X_DISPLAY (d);
470 char *dpy = DisplayString (display);
471 char *tail = (char *) strchr (dpy, ':');
472 if (! tail ||
473 strncmp (tail, ":0", 2))
474 DEVICE_ON_CONSOLE_P (d) = 0;
475 else
476 {
477 char dpyname[255], localname[255];
478
479 /* some systems can't handle SIGIO or SIGALARM in gethostbyname. */
480 stop_interrupts ();
481 strncpy (dpyname, dpy, tail-dpy);
482 dpyname [tail-dpy] = 0;
483 if (!*dpyname ||
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? */
489 else
490 {
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.
496
497 And don't forget, gethostbyname() reuses the structure it
498 returns, so we have to copy the fucker before calling it
499 again.
500
501 Thank you master, may I have another.
502 */
503 struct hostent *h = gethostbyname (dpyname);
504 if (!h)
505 DEVICE_ON_CONSOLE_P (d) = 0;
506 else
507 {
508 char hn [255];
509 struct hostent *l;
510 strcpy (hn, h->h_name);
511 l = gethostbyname (localname);
512 DEVICE_ON_CONSOLE_P (d) = (l && !(strcmp (l->h_name, hn)));
513 }
514 }
515 start_interrupts ();
516 }
517 }
518 #endif /* HAVE_X_WINDOWS */
519 }
520
521 #endif /* HAVE_NATIVE_SOUND */
522
523 void
524 init_device_sound (struct device *d)
525 {
526 #ifdef HAVE_NAS_SOUND
527 init_nas_sound (d);
528 #endif
529
530 #ifdef HAVE_NATIVE_SOUND
531 init_native_sound (d);
532 #endif
533 }
534
535 void
536 syms_of_sound (void)
537 {
538 defkeyword (&Q_volume, ":volume");
539 defkeyword (&Q_pitch, ":pitch");
540 defkeyword (&Q_duration, ":duration");
541 defkeyword (&Q_sound, ":sound");
542
543 #ifdef HAVE_NAS_SOUND
544 defsymbol (&Qnas, "nas");
545 #endif
546
547 DEFSUBR (Fplay_sound_file);
548 DEFSUBR (Fplay_sound);
549 DEFSUBR (Fding);
550 DEFSUBR (Fwait_for_sounds);
551 DEFSUBR (Fconnected_to_nas_p);
552 DEFSUBR (Fdevice_sound_enabled_p);
553 }
554
555
556 void
557 vars_of_sound (void)
558 {
559 #ifdef HAVE_NATIVE_SOUND
560 Fprovide (intern ("native-sound"));
561 #endif
562 #ifdef HAVE_NAS_SOUND
563 Fprovide (intern ("nas-sound"));
564 #endif
565
566 DEFVAR_INT ("bell-volume", &bell_volume /*
567 *How loud to be, from 0 to 100.
568 */ );
569 bell_volume = 50;
570
571 DEFVAR_INT ("bell-inhibit-time", &bell_inhibit_time /*
572 *Don't ring the bell on the same device more than once within this many seconds.
573 */ );
574 bell_inhibit_time = 0;
575
576 DEFVAR_LISP ("sound-alist", &Vsound_alist /*
577 An alist associating names with sounds.
578 When `beep' or `ding' is called with one of the name symbols, the associated
579 sound will be generated instead of the standard beep.
580
581 Each element of `sound-alist' is a list describing a sound.
582 The first element of the list is the name of the sound being defined.
583 Subsequent elements of the list are alternating keyword/value pairs:
584
585 Keyword: Value:
586 ------- -----
587 sound A string of raw sound data, or the name of another sound to
588 play. The symbol `t' here means use the default X beep.
589 volume An integer from 0-100, defaulting to `bell-volume'
590 pitch If using the default X beep, the pitch (Hz) to generate.
591 duration If using the default X beep, the duration (milliseconds).
592
593 For compatibility, elements of `sound-alist' may also be:
594
595 ( sound-name . <sound> )
596 ( sound-name <volume> <sound> )
597
598 You should probably add things to this list by calling the function
599 load-sound-file.
600
601 Caveats:
602 - XEmacs must be built with sound support for your system. Not all
603 systems support sound.
604
605 - The pitch, duration, and volume options are available everywhere, but
606 many X servers ignore the `pitch' option.
607
608 The following beep-types are used by emacs itself:
609
610 auto-save-error when an auto-save does not succeed
611 command-error when the emacs command loop catches an error
612 undefined-key when you type a key that is undefined
613 undefined-click when you use an undefined mouse-click combination
614 no-completion during completing-read
615 y-or-n-p when you type something other than 'y' or 'n'
616 yes-or-no-p when you type something other than 'yes' or 'no'
617 default used when nothing else is appropriate.
618
619 Other lisp packages may use other beep types, but these are the ones that
620 the C kernel of Emacs uses.
621 */ );
622 Vsound_alist = Qnil;
623
624 DEFVAR_LISP ("synchronous-sounds", &Vsynchronous_sounds /*
625 Play sounds synchronously, if non-nil.
626 Only applies if NAS is used and supports asynchronous playing
627 of sounds. Otherwise, sounds are always played synchronously.
628 */ );
629 Vsynchronous_sounds = Qnil;
630
631 DEFVAR_LISP ("native-sound-only-on-console", &Vnative_sound_only_on_console /*
632 Non-nil value means play sounds only if XEmacs is running
633 on the system console.
634 Nil means always always play sounds, even if running on a non-console tty
635 or a secondary X display.
636
637 This variable only applies to native sound support.
638 */ );
639 Vnative_sound_only_on_console = Qt;
640
641 #if defined (HAVE_NATIVE_SOUND) && defined (hp9000s800)
642 {
643 void vars_of_hpplay (void);
644 vars_of_hpplay ();
645 }
646 #endif
647 }