Mercurial > hg > xemacs-beta

comparison src/sound.c @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 859a2309aef8
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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 "lisp.h"
29
30 #include "buffer.h"
31 #ifdef HAVE_X_WINDOWS
32 #include "console-x.h"
33 #endif
34
35 #ifdef HAVE_NEXTSTEP
36 #include "console-ns.h"
37 #endif
38
39 #include "commands.h"
40 #include "device.h"
41 #include "redisplay.h"
42 #include "sysdep.h"
43
44 #ifdef HAVE_NATIVE_SOUND
45 # include <netdb.h>
46 #endif
47
48 int bell_volume;
49 Lisp_Object Vsound_alist;
50 Lisp_Object Vsynchronous_sounds;
51 Lisp_Object Vnative_sound_only_on_console;
52 Lisp_Object Q_volume, Q_pitch, Q_duration, Q_sound;
53
54 /* These are defined in the appropriate file (sunplay.c, sgiplay.c,
55 or hpplay.c). */
56
57 extern void play_sound_file (char *name, int volume);
58 extern void play_sound_data (unsigned char *data, int length, int volume);
59
60 #ifdef HAVE_NAS_SOUND
61 extern int nas_play_sound_file (char *name, int volume);
62 extern int nas_play_sound_data (unsigned char *data, int length, int volume);
63 extern int nas_wait_for_sounds (void);
64 extern char *nas_init_play (Display *);
65
66 Lisp_Object Qnas;
67 #endif
68
69 DEFUN ("play-sound-file", Fplay_sound_file, Splay_sound_file,
70 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 The sound file must be in the Sun/NeXT U-LAW format except under Linux
74 where WAV files are also supported.
75 DEVICE defaults to the selected device.
76 */ )
77 (file, volume, device)
78 Lisp_Object file, volume, device;
79 {
80 /* This function can GC */
81 int vol;
82 #if defined (HAVE_NATIVE_SOUND) || defined (HAVE_NAS_SOUND)
83 struct device *d = decode_device (device);
84 #endif
85 CHECK_STRING (file);
86 if (NILP (volume))
87 vol = bell_volume;
88 else
89 {
90 CHECK_INT (volume);
91 vol = XINT (volume);
92 }
93
94 file = Fexpand_file_name (file, Qnil);
95 if (NILP (Ffile_readable_p (file)))
96 if (NILP (Ffile_exists_p (file)))
97 error ("file does not exist.");
98 else
99 error ("file is unreadable.");
100
101 #ifdef HAVE_NAS_SOUND
102 if (DEVICE_CONNECTED_TO_NAS_P (d))
103 {
104 char *fileext;
105
106 GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext);
107 /* #### NAS code should allow specification of a device. */
108 if (nas_play_sound_file (fileext, vol))
109 return Qnil;
110 }
111 #endif /* HAVE_NAS_SOUND */
112
113 #ifdef HAVE_NATIVE_SOUND
114 if (NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
115 {
116 CONST char *fileext;
117
118 GET_C_STRING_FILENAME_DATA_ALLOCA (file, fileext);
119 /* The sound code doesn't like getting SIGIO interrupts.
120 Unix sucks! */
121 stop_interrupts ();
122 play_sound_file ((char *) fileext, vol);
123 start_interrupts ();
124 QUIT;
125 }
126 #endif /* HAVE_NATIVE_SOUND */
127
128 return Qnil;
129 }
130
131 static void
132 parse_sound_alist_elt (Lisp_Object elt,
133 Lisp_Object *volume,
134 Lisp_Object *pitch,
135 Lisp_Object *duration,
136 Lisp_Object *sound)
137 {
138 *volume = Qnil;
139 *pitch = Qnil;
140 *duration = Qnil;
141 *sound = Qnil;
142 if (! CONSP (elt))
143 return;
144
145 /* The things we do for backward compatibility...
146 I wish I had just forced this to be a plist to begin with.
147 */
148
149 if (SYMBOLP (elt) || STRINGP (elt)) /* ( name . <sound> ) */
150 {
151 *sound = elt;
152 }
153 else if (!CONSP (elt))
154 {
155 return;
156 }
157 else if (NILP (XCDR (elt)) && /* ( name <sound> ) */
158 (SYMBOLP (XCAR (elt)) ||
159 STRINGP (XCAR (elt))))
160 {
161 *sound = XCAR (elt);
162 }
163 else if (INT_OR_FLOATP (XCAR (elt)) && /* ( name <vol> . <sound> ) */
164 (SYMBOLP (XCDR (elt)) ||
165 STRINGP (XCDR (elt))))
166 {
167 *volume = XCAR (elt);
168 *sound = XCDR (elt);
169 }
170 else if (INT_OR_FLOATP (XCAR (elt)) && /* ( name <vol> <sound> ) */
171 CONSP (XCDR (elt)) &&
172 NILP (XCDR (XCDR (elt))) &&
173 (SYMBOLP (XCAR (XCDR (elt))) ||
174 STRINGP (XCAR (XCDR (elt)))))
175 {
176 *volume = XCAR (elt);
177 *sound = XCAR (XCDR (elt));
178 }
179 else if ((SYMBOLP (XCAR (elt)) || /* ( name <sound> . <vol> ) */
180 STRINGP (XCAR (elt))) &&
181 INT_OR_FLOATP (XCDR (elt)))
182 {
183 *sound = XCAR (elt);
184 *volume = XCDR (elt);
185 }
186 #if 0 /* this one is ambiguous with the plist form */
187 else if ((SYMBOLP (XCAR (elt)) || /* ( name <sound> <vol> ) */
188 STRINGP (XCAR (elt))) &&
189 CONSP (XCDR (elt)) &&
190 NILP (XCDR (XCDR (elt))) &&
191 INT_OR_FLOATP (XCAR (XCDR (elt))))
192 {
193 *sound = XCAR (elt);
194 *volume = XCAR (XCDR (elt));
195 }
196 #endif /* 0 */
197 else /* ( name [ keyword <value> ]* ) */
198 {
199 while (CONSP (elt))
200 {
201 Lisp_Object key, val;
202 key = XCAR (elt);
203 val = XCDR (elt);
204 if (!CONSP (val))
205 return;
206 elt = XCDR (val);
207 val = XCAR (val);
208 if (EQ (key, Q_volume))
209 {
210 if (INT_OR_FLOATP (val)) *volume = val;
211 }
212 else if (EQ (key, Q_pitch))
213 {
214 if (INT_OR_FLOATP (val)) *pitch = val;
215 if (NILP (*sound)) *sound = Qt;
216 }
217 else if (EQ (key, Q_duration))
218 {
219 if (INT_OR_FLOATP (val)) *duration = val;
220 if (NILP (*sound)) *sound = Qt;
221 }
222 else if (EQ (key, Q_sound))
223 {
224 if (SYMBOLP (val) || STRINGP (val)) *sound = val;
225 }
226 }
227 }
228 }
229
230 DEFUN ("play-sound", Fplay_sound, Splay_sound, 1, 3, 0 /*
231 Play a sound of the provided type.
232 See the variable `sound-alist'.
233 */ )
234 (sound, volume, device)
235 Lisp_Object sound, volume, device;
236 {
237 int looking_for_default = 0;
238 /* variable `sound' is anything that can be a cdr in sound-alist */
239 Lisp_Object new_volume, pitch, duration, data;
240 int loop_count = 0;
241 int vol, pit, dur;
242 struct device *d = decode_device (device);
243
244 /* NOTE! You'd better not signal an error in here. */
245
246
247 try_it_again:
248 while (1)
249 {
250 if (SYMBOLP (sound))
251 sound = Fcdr (Fassq (sound, Vsound_alist));
252 parse_sound_alist_elt (sound, &new_volume, &pitch, &duration, &data);
253 sound = data;
254 if (NILP (volume)) volume = new_volume;
255 if (EQ (sound, Qt) || EQ (sound, Qnil) || STRINGP (sound))
256 break;
257 if (loop_count++ > 500) /* much bogosity has occurred */
258 break;
259 }
260
261 if (NILP (sound) && !looking_for_default)
262 {
263 looking_for_default = 1;
264 loop_count = 0;
265 sound = Qdefault;
266 goto try_it_again;
267 }
268
269
270 vol = (INT_OR_FLOATP (volume) ? XFLOATINT (volume) : bell_volume);
271 pit = (INT_OR_FLOATP (pitch) ? XFLOATINT (pitch) : -1);
272 dur = (INT_OR_FLOATP (duration) ? XFLOATINT (duration) : -1);
273
274 /* If the sound is a string, and we're connected to Nas, do that.
275 Else if the sound is a string, and we're on console, play it natively.
276 Else just beep.
277 */
278 #ifdef HAVE_NAS_SOUND
279 if (DEVICE_CONNECTED_TO_NAS_P (d) && STRINGP (sound))
280 {
281 Extbyte *soundext;
282 Extcount soundextlen;
283
284 GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen);
285 if (nas_play_sound_data (soundext, soundextlen, vol))
286 return Qnil;
287 }
288 #endif /* HAVE_NAS_SOUND */
289
290 #ifdef HAVE_NATIVE_SOUND
291 if ((NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
292 && STRINGP (sound))
293 {
294 Extbyte *soundext;
295 Extcount soundextlen;
296
297 GET_STRING_BINARY_DATA_ALLOCA (sound, soundext, soundextlen);
298 /* The sound code doesn't like getting SIGIO interrupts. Unix sucks! */
299 stop_interrupts ();
300 play_sound_data (soundext, soundextlen, vol);
301 start_interrupts ();
302 QUIT;
303 return Qnil;
304 }
305 #endif /* HAVE_NATIVE_SOUND */
306
307 DEVMETH (d, ring_bell, (d, vol, pit, dur));
308 return Qnil;
309 }
310
311 DEFUN ("device-sound-enabled-p", Fdevice_sound_enabled_p, Sdevice_sound_enabled_p, 0, 1, 0 /*
312 Return T iff DEVICE is able to play sound. Defaults to selected device.
313 */ )
314 (device)
315 Lisp_Object device;
316 {
317 struct device *d = decode_device(device);
318
319 #ifdef HAVE_NAS_SOUND
320 if ( DEVICE_CONNECTED_TO_NAS_P (d) )
321 return (Qt);
322 #endif
323 #ifdef HAVE_NATIVE_SOUND
324 if ( DEVICE_ON_CONSOLE_P (d) )
325 return (Qt);
326 #endif
327 return Qnil;
328 }
329
330 DEFUN ("ding", Fding, Sding, 0, 3, 0 /*
331 Beep, or flash the frame.
332 Also, unless an argument is given,
333 terminate any keyboard macro currently executing.
334 When called from lisp, the second argument is what sound to make, and
335 the third argument is the device to make it in (defaults to the selected
336 device).
337 */ )
338 (arg, sound, device)
339 Lisp_Object arg, sound, device;
340 {
341 struct device *d = decode_device (device);
342
343 XSETDEVICE (device, d);
344 if (NILP (arg) && !NILP (Vexecuting_macro))
345 /* Stop executing a keyboard macro. */
346 error ("Keyboard macro terminated by a command ringing the bell");
347 else if (visible_bell && DEVMETH (d, flash, (d)))
348 ;
349 else
350 Fplay_sound (sound, Qnil, device);
351
352 return Qnil;
353 }
354
355 DEFUN ("wait-for-sounds", Fwait_for_sounds, Swait_for_sounds,
356 0, 1, 0 /*
357 Wait for all sounds to finish playing on DEVICE.
358 */ )
359 (device)
360 Lisp_Object device;
361
362 {
363 #ifdef HAVE_NAS_SOUND
364 struct device *d = decode_device (device);
365 if (DEVICE_CONNECTED_TO_NAS_P (d))
366 {
367 /* #### somebody fix this to be device-dependent. */
368 nas_wait_for_sounds ();
369 }
370 #endif
371 return Qnil;
372 }
373
374 DEFUN ("connected-to-nas-p", Fconnected_to_nas_p, Sconnected_to_nas_p,
375 0, 1, 0 /*
376 t if connected to NAS server for sounds on DEVICE.
377 */ )
378 (device)
379 Lisp_Object device;
380 {
381 #ifdef HAVE_NAS_SOUND
382 struct device *d = decode_device (device);
383 if (DEVICE_CONNECTED_TO_NAS_P (d))
384 return Qt;
385 else
386 return Qnil;
387 #else
388 return Qnil;
389 #endif
390 }
391 #ifdef HAVE_NAS_SOUND
392
393 static void
394 init_nas_sound (struct device *d)
395 {
396 char *error;
397
398 #ifdef HAVE_X_WINDOWS
399 if (DEVICE_X_P (d))
400 {
401 error = nas_init_play (DEVICE_X_DISPLAY (d));
402 DEVICE_CONNECTED_TO_NAS_P (d) = !error;
403 /* Print out the message? */
404 }
405 #endif /* HAVE_X_WINDOWS */
406 }
407
408 #endif /* HAVE_NAS_SOUND */
409
410 #ifdef HAVE_NATIVE_SOUND
411
412 static void
413 init_native_sound (struct device *d)
414 {
415 if (DEVICE_TTY_P (d) || DEVICE_STREAM_P (d))
416 DEVICE_ON_CONSOLE_P (d) = 1;
417 #ifdef HAVE_X_WINDOWS
418 else
419 {
420 /* When running on a machine with native sound support, we cannot use
421 digitized sounds as beeps unless emacs is running on the same machine
422 that $DISPLAY points to, and $DISPLAY points to frame 0 of that
423 machine.
424 */
425
426 Display *display = DEVICE_X_DISPLAY (d);
427 char *dpy = DisplayString (display);
428 char *tail = (char *) strchr (dpy, ':');
429 if (! tail ||
430 strncmp (tail, ":0", 2))
431 DEVICE_ON_CONSOLE_P (d) = 0;
432 else
433 {
434 char dpyname[255], localname[255];
435
436 /* some systems can't handle SIGIO or SIGALARM in gethostbyname. */
437 stop_interrupts ();
438 strncpy (dpyname, dpy, tail-dpy);
439 dpyname [tail-dpy] = 0;
440 if (!*dpyname ||
441 !strcmp (dpyname, "unix") ||
442 !strcmp (dpyname, "localhost"))
443 DEVICE_ON_CONSOLE_P (d) = 1;
444 else if (gethostname (localname, sizeof (localname)))
445 DEVICE_ON_CONSOLE_P (d) = 0; /* can't find hostname? */
446 else
447 {
448 /* We have to call gethostbyname() on the result of gethostname()
449 because the two aren't guarenteed to be the same name for the
450 same host: on some losing systems, one is a FQDN and the other
451 is not. Here in the wide wonderful world of Unix it's rocket
452 science to obtain the local hostname in a portable fashion.
453
454 And don't forget, gethostbyname() reuses the structure it
455 returns, so we have to copy the fucker before calling it
456 again.
457
458 Thank you master, may I have another.
459 */
460 struct hostent *h = gethostbyname (dpyname);
461 if (!h)
462 DEVICE_ON_CONSOLE_P (d) = 0;
463 else
464 {
465 char hn [255];
466 struct hostent *l;
467 strcpy (hn, h->h_name);
468 l = gethostbyname (localname);
469 DEVICE_ON_CONSOLE_P (d) = (l && !(strcmp (l->h_name, hn)));
470 }
471 }
472 start_interrupts ();
473 }
474 }
475 #endif /* HAVE_X_WINDOWS */
476 }
477
478 #endif /* HAVE_NATIVE_SOUND */
479
480 void
481 init_device_sound (struct device *d)
482 {
483 #ifdef HAVE_NAS_SOUND
484 init_nas_sound (d);
485 #endif
486
487 #ifdef HAVE_NATIVE_SOUND
488 init_native_sound (d);
489 #endif
490 }
491
492 void
493 syms_of_sound (void)
494 {
495 defkeyword (&Q_volume, ":volume");
496 defkeyword (&Q_pitch, ":pitch");
497 defkeyword (&Q_duration, ":duration");
498 defkeyword (&Q_sound, ":sound");
499
500 #ifdef HAVE_NAS_SOUND
501 defsymbol (&Qnas, "nas");
502 #endif
503
504 defsubr (&Splay_sound_file);
505 defsubr (&Splay_sound);
506 defsubr (&Sding);
507 defsubr (&Swait_for_sounds);
508 defsubr (&Sconnected_to_nas_p);
509 defsubr (&Sdevice_sound_enabled_p);
510 }
511
512
513 void
514 vars_of_sound (void)
515 {
516 #ifdef HAVE_NATIVE_SOUND
517 Fprovide (intern ("native-sound"));
518 #endif
519 #ifdef HAVE_NAS_SOUND
520 Fprovide (intern ("nas-sound"));
521 #endif
522
523 DEFVAR_INT ("bell-volume", &bell_volume /*
524 *How loud to be, from 0 to 100.
525 */ );
526 bell_volume = 50;
527
528 DEFVAR_LISP ("sound-alist", &Vsound_alist /*
529 An alist associating names with sounds.
530 When `beep' or `ding' is called with one of the name symbols, the associated
531 sound will be generated instead of the standard beep.
532
533 Each element of `sound-alist' is a list describing a sound.
534 The first element of the list is the name of the sound being defined.
535 Subsequent elements of the list are alternating keyword/value pairs:
536
537 Keyword: Value:
538 ------- -----
539 sound A string of raw sound data, or the name of another sound to
540 play. The symbol `t' here means use the default X beep.
541 volume An integer from 0-100, defaulting to `bell-volume'
542 pitch If using the default X beep, the pitch (Hz) to generate.
543 duration If using the default X beep, the duration (milliseconds).
544
545 For compatibility, elements of `sound-alist' may also be:
546
547 ( sound-name . <sound> )
548 ( sound-name <volume> <sound> )
549
550 You should probably add things to this list by calling the function
551 load-sound-file.
552
553 Caveats:
554 - You can only play audio data if running on the console screen of a
555 Sun SparcStation, SGI, or HP9000s700.
556
557 - The pitch, duration, and volume options are available everywhere, but
558 many X servers ignore the `pitch' option.
559
560 The following beep-types are used by emacs itself:
561
562 auto-save-error when an auto-save does not succeed
563 command-error when the emacs command loop catches an error
564 undefined-key when you type a key that is undefined
565 undefined-click when you use an undefined mouse-click combination
566 no-completion during completing-read
567 y-or-n-p when you type something other than 'y' or 'n'
568 yes-or-no-p when you type something other than 'yes' or 'no'
569 default used when nothing else is appropriate.
570
571 Other lisp packages may use other beep types, but these are the ones that
572 the C kernel of Emacs uses.
573 */ );
574 Vsound_alist = Qnil;
575
576 DEFVAR_LISP ("synchronous-sounds", &Vsynchronous_sounds /*
577 Play sounds synchronously, if non-nil.
578 Only applies if NAS is used and supports asynchronous playing
579 of sounds. Otherwise, sounds are always played synchronously.
580 */ );
581 Vsynchronous_sounds = Qnil;
582
583 DEFVAR_LISP ("native-sound-only-on-console", &Vnative_sound_only_on_console /*
584 Non-nil value means play sounds only if XEmacs is running
585 on the system console.
586 Nil means always always play sounds, even if running on a non-console tty
587 or a secondary X display.
588
589 This variable only applies to native sound support.
590 */ );
591 Vnative_sound_only_on_console = Qt;
592
593 #if defined (HAVE_NATIVE_SOUND) && defined (hp9000s800)
594 vars_of_hpplay ();
595 #endif
596 }