*** empty log message ***
[bpt/emacs.git] / src / keyboard.c
1 /* Keyboard and mouse input; editor command loop.
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1992 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20 /* Allow config.h to undefine symbols found here. */
21 #include <signal.h>
22
23 #include "config.h"
24 #include <stdio.h>
25 #undef NULL
26 #include "termchar.h"
27 #include "termopts.h"
28 #include "lisp.h"
29 #include "termhooks.h"
30 #include "macros.h"
31 #include "screen.h"
32 #include "window.h"
33 #include "commands.h"
34 #include "buffer.h"
35 #include "disptab.h"
36 #include "keyboard.h"
37 #include <setjmp.h>
38 #include <errno.h>
39
40 #ifndef VMS
41 #include <sys/ioctl.h>
42 #endif
43
44 #include "syssignal.h"
45 #include "systerm.h"
46 #include "systime.h"
47
48 extern int errno;
49
50 #ifdef HAVE_X_WINDOWS
51 extern Lisp_Object Vmouse_grabbed;
52
53 /* Make all keyboard buffers much bigger when using X windows. */
54 #define KBD_BUFFER_SIZE 4096
55 #else /* No X-windows, character input */
56 #define KBD_BUFFER_SIZE 256
57 #endif /* No X-windows */
58
59 /* Following definition copied from eval.c */
60
61 struct backtrace
62 {
63 struct backtrace *next;
64 Lisp_Object *function;
65 Lisp_Object *args; /* Points to vector of args. */
66 int nargs; /* length of vector. If nargs is UNEVALLED,
67 args points to slot holding list of
68 unevalled args */
69 char evalargs;
70 };
71
72 /* Non-nil disable property on a command means
73 do not execute it; call disabled-command-hook's value instead. */
74 Lisp_Object Qdisabled, Vdisabled_command_hook;
75
76 #define NUM_RECENT_KEYS (100)
77 int recent_keys_index; /* Index for storing next element into recent_keys */
78 int total_keys; /* Total number of elements stored into recent_keys */
79 Lisp_Object recent_keys[NUM_RECENT_KEYS]; /* Holds last 100 keystrokes */
80
81 /* Buffer holding the key that invoked the current command. */
82 Lisp_Object *this_command_keys;
83 int this_command_key_count; /* Size in use. */
84 int this_command_keys_size; /* Size allocated. */
85
86 extern int minbuf_level;
87
88 extern struct backtrace *backtrace_list;
89
90 /* Nonzero means do menu prompting. */
91 static int menu_prompting;
92
93 /* Character to see next line of menu prompt. */
94 static Lisp_Object menu_prompt_more_char;
95
96 /* For longjmp to where kbd input is being done. */
97 static jmp_buf getcjmp;
98
99 /* True while doing kbd input. */
100 int waiting_for_input;
101
102 /* True while displaying for echoing. Delays C-g throwing. */
103 static int echoing;
104
105 /* Nonzero means C-G should cause immediate error-signal. */
106 int immediate_quit;
107
108 /* Character to recognize as the help char. */
109 Lisp_Object help_char;
110
111 /* Form to execute when help char is typed. */
112 Lisp_Object Vhelp_form;
113
114 /* Character that causes a quit. Normally C-g.
115
116 If we are running on an ordinary terminal, this must be an ordinary
117 ASCII char, since we want to make it our interrupt character.
118
119 If we are not running on an ordinary terminal, it still needs to be
120 an ordinary ASCII char. This character needs to be recognized in
121 the input interrupt handler. At this point, the keystroke is
122 represented as a struct input_event, while the desired quit
123 character is specified as a lispy event. The mapping from struct
124 input_events to lispy events cannot run in an interrupt handler,
125 and the reverse mapping is difficult for anything but ASCII
126 keystrokes.
127
128 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
129 ASCII character. */
130 int quit_char;
131
132 extern Lisp_Object current_global_map;
133 extern int minibuf_level;
134
135 /* Current depth in recursive edits. */
136 int command_loop_level;
137
138 /* Total number of times command_loop has read a key sequence. */
139 int num_input_keys;
140
141 /* Last input character read as a command. */
142 Lisp_Object last_command_char;
143
144 /* Last input character read for any purpose. */
145 Lisp_Object last_input_char;
146
147 /* If not Qnil, an object to be read as the next command input. */
148 Lisp_Object unread_command_char;
149
150 /* Char to use as prefix when a meta character is typed in.
151 This is bound on entry to minibuffer in case ESC is changed there. */
152
153 Lisp_Object meta_prefix_char;
154
155 /* Last size recorded for a current buffer which is not a minibuffer. */
156 static int last_non_minibuf_size;
157
158 /* Number of idle seconds before an auto-save and garbage collection. */
159 static Lisp_Object Vauto_save_timeout;
160
161 /* Total number of times read_char has returned. */
162 int num_input_chars;
163
164 /* Auto-save automatically when this many characters have been typed
165 since the last time. */
166
167 static int auto_save_interval;
168
169 /* Value of num_input_chars as of last auto save. */
170
171 int last_auto_save;
172
173 /* Last command executed by the editor command loop, not counting
174 commands that set the prefix argument. */
175
176 Lisp_Object last_command;
177
178 /* The command being executed by the command loop.
179 Commands may set this, and the value set will be copied into last_command
180 instead of the actual command. */
181 Lisp_Object this_command;
182
183 #ifndef HAVE_X11
184 /* Window of last mouse click. */
185 extern Lisp_Object Vmouse_window;
186
187 /* List containing details of last mouse click. */
188 extern Lisp_Object Vmouse_event;
189 #endif /* defined HAVE_X11 */
190
191 /* Hook to call on each mouse event after running its definition. */
192 Lisp_Object Vmouse_event_function;
193
194 /* Hook to call when mouse leaves screen. */
195 Lisp_Object Vmouse_left_hook;
196
197 /* Hook to call when a screen is mapped. */
198 Lisp_Object Vmap_screen_hook;
199
200 /* Hook to call when a screen is unmapped. */
201 Lisp_Object Vunmap_screen_hook;
202
203 /* Handler for non-grabbed (no keys depressed) mouse motion. */
204 Lisp_Object Vmouse_motion_handler;
205
206 /* The screen in which the last input event occurred.
207 command_loop_1 will select this screen before running the
208 command bound to an event sequence, and read_key_sequence will
209 toss the existing prefix if the user starts typing at a
210 new screen. */
211 Lisp_Object Vlast_event_screen;
212
213 /* The timestamp of the last input event we received from the X server.
214 X Windows wants this for selection ownership. */
215 unsigned long last_event_timestamp;
216
217 Lisp_Object Qself_insert_command;
218 Lisp_Object Qforward_char;
219 Lisp_Object Qbackward_char;
220
221 /* read_key_sequence stores here the command definition of the
222 key sequence that it reads. */
223 Lisp_Object read_key_sequence_cmd;
224
225 /* Form to evaluate (if non-nil) when Emacs is started. */
226 Lisp_Object Vtop_level;
227
228 /* User-supplied string to translate input characters through. */
229 Lisp_Object Vkeyboard_translate_table;
230
231 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
232 extern Lisp_Object Vfunction_key_map;
233
234 /* File in which we write all commands we read. */
235 FILE *dribble;
236
237 /* Nonzero if input is available. */
238 int input_pending;
239
240 /* Nonzero if should obey 0200 bit in input chars as "Meta". */
241 int meta_key;
242
243 extern char *pending_malloc_warning;
244
245 /* Circular buffer for pre-read keyboard input. */
246 static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
247
248 /* Pointer to next available character in kbd_buffer.
249 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
250 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the the
251 next available char is in kbd_buffer[0]. */
252 static struct input_event *kbd_fetch_ptr;
253
254 /* Pointer to next place to store character in kbd_buffer. This
255 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
256 character should go in kbd_buffer[0]. */
257 static struct input_event *kbd_store_ptr;
258
259 /* The above pair of variables forms a "queue empty" flag. When we
260 enqueue a non-hook event, we increment kbd_write_count. When we
261 dequeue a non-hook event, we increment kbd_read_count. We say that
262 there is input available iff the two counters are equal.
263
264 Why not just have a flag set and cleared by the enqueuing and
265 dequeuing functions? Such a flag could be screwed up by interrupts
266 at inopportune times. */
267
268 /* If this flag is non-zero, mouse movement events will appear in the
269 input stream. If is zero, mouse movement will be ignored. */
270 int do_mouse_tracking;
271
272 /* The window system handling code should set this if the mouse has
273 moved since the last call to the mouse_position_hook. Calling that
274 hook should clear this. Code assumes that if this is set, it can
275 call mouse_position_hook to get the promised position, so don't set
276 it unless you're prepared to substantiate the claim! */
277 int mouse_moved;
278
279 /* True iff there is an event in kbd_buffer, or if mouse tracking is
280 enabled and there is a new mouse position in the mouse movement
281 buffer. Note that if this is false, that doesn't mean that there
282 is readable input; all the events in the queue might be button-up
283 events, and do_mouse_tracking might be off. */
284 #define EVENT_QUEUES_EMPTY \
285 ((kbd_fetch_ptr == kbd_store_ptr) && (!do_mouse_tracking || !mouse_moved))
286
287
288 /* Symbols to head events. */
289 Lisp_Object Qmouse_movement;
290
291 Lisp_Object Qvscrollbar_part;
292 Lisp_Object Qvslider_part;
293 Lisp_Object Qvthumbup_part;
294 Lisp_Object Qvthumbdown_part;
295
296 Lisp_Object Qhscrollbar_part;
297 Lisp_Object Qhslider_part;
298 Lisp_Object Qhthumbleft_part;
299 Lisp_Object Qhthumbright_part;
300
301 /* Symbols to denote kinds of events. */
302 Lisp_Object Qfunction_key;
303 Lisp_Object Qmouse_click;
304 /* Lisp_Object Qmouse_movement; - also an event header */
305 Lisp_Object Qscrollbar_click;
306
307 /* Properties of event headers. */
308 Lisp_Object Qevent_kind;
309 Lisp_Object Qevent_unmodified;
310
311 /* Symbols to use for non-text mouse positions. */
312 Lisp_Object Qmode_line;
313 Lisp_Object Qvertical_split;
314
315
316 /* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
317 happens. */
318 EMACS_TIME *input_available_clear_time;
319
320 /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
321 Default is 1 if INTERRUPT_INPUT is defined. */
322 int interrupt_input;
323
324 /* Nonzero while interrupts are temporarily deferred during redisplay. */
325 int interrupts_deferred;
326
327 /* nonzero means use ^S/^Q for flow control. */
328 int flow_control;
329
330 /* Allow m- file to inhibit use of FIONREAD. */
331 #ifdef BROKEN_FIONREAD
332 #undef FIONREAD
333 #endif
334
335 /* We are unable to use interrupts if FIONREAD is not available,
336 so flush SIGIO so we won't try. */
337 #ifndef FIONREAD
338 #ifdef SIGIO
339 #undef SIGIO
340 #endif
341 #endif
342
343 /* If we support X Windows, and won't get an interrupt when input
344 arrives from the server, poll periodically so we can detect C-g. */
345 #ifdef HAVE_X_WINDOWS
346 #ifndef SIGIO
347 #define POLL_FOR_INPUT
348 #endif
349 #endif
350 \f
351 /* Global variable declarations. */
352
353 /* Function for init_keyboard to call with no args (if nonzero). */
354 void (*keyboard_init_hook) ();
355
356 static int read_avail_input ();
357 static void get_input_pending ();
358
359 /* > 0 if we are to echo keystrokes. */
360 static int echo_keystrokes;
361
362 /* Nonzero means echo each character as typed. */
363 static int immediate_echo;
364
365 /* The text we're echoing in the modeline - partial key sequences,
366 usually. '\0'-terminated. */
367 static char echobuf[100];
368
369 /* Where to append more text to echobuf if we want to. */
370 static char *echoptr;
371
372 #define min(a,b) ((a)<(b)?(a):(b))
373 #define max(a,b) ((a)>(b)?(a):(b))
374
375 /* Install the string STR as the beginning of the string of echoing,
376 so that it serves as a prompt for the next character.
377 Also start echoing. */
378
379 echo_prompt (str)
380 char *str;
381 {
382 int len = strlen (str);
383 if (len > sizeof echobuf - 4)
384 len = sizeof echobuf - 4;
385 bcopy (str, echobuf, len + 1);
386 echoptr = echobuf + len;
387
388 echo ();
389 }
390
391 /* Add C to the echo string, if echoing is going on.
392 C can be a character, which is printed prettily ("M-C-x" and all that
393 jazz), or a symbol, whose name is printed. */
394
395 echo_char (c)
396 Lisp_Object c;
397 {
398 extern char *push_key_description ();
399
400 if (immediate_echo)
401 {
402 char *ptr = echoptr;
403
404 if (ptr != echobuf)
405 *ptr++ = ' ';
406
407 /* If someone has passed us a composite event, use its head symbol. */
408 if (EVENT_HAS_PARAMETERS (c))
409 c = EVENT_HEAD (c);
410
411 if (XTYPE (c) == Lisp_Int)
412 {
413 if (ptr - echobuf > sizeof echobuf - 6)
414 return;
415
416 ptr = push_key_description (c, ptr);
417 }
418 else if (XTYPE (c) == Lisp_Symbol)
419 {
420 struct Lisp_String *name = XSYMBOL (c)->name;
421 if (((ptr - echobuf) + name->size + 4) > sizeof echobuf)
422 return;
423 bcopy (name->data, ptr, name->size);
424 ptr += name->size;
425 }
426
427 if (echoptr == echobuf && c == help_char)
428 {
429 strcpy (ptr, " (Type ? for further options)");
430 ptr += strlen (ptr);
431 }
432
433 *ptr = 0;
434 echoptr = ptr;
435
436 echo ();
437 }
438 }
439
440 /* Temporarily add a dash to the end of the echo string if it's not
441 empty, so that it serves as a mini-prompt for the very next character. */
442
443 echo_dash ()
444 {
445 if (!immediate_echo && echoptr == echobuf)
446 return;
447
448 /* Put a dash at the end of the buffer temporarily,
449 but make it go away when the next character is added. */
450 echoptr[0] = '-';
451 echoptr[1] = 0;
452
453 echo ();
454 }
455
456 /* Display the current echo string, and begin echoing if not already
457 doing so. */
458
459 echo ()
460 {
461 if (!immediate_echo)
462 {
463 int i;
464 immediate_echo = 1;
465
466 for (i = 0; i < this_command_key_count; i++)
467 echo_char (this_command_keys[i]);
468 echo_dash ();
469 }
470
471 echoing = 1;
472 message1 (echobuf);
473 echoing = 0;
474
475 if (waiting_for_input && !NILP (Vquit_flag))
476 quit_throw_to_read_char ();
477 }
478
479 /* Turn off echoing, for the start of a new command. */
480
481 cancel_echoing ()
482 {
483 immediate_echo = 0;
484 echoptr = echobuf;
485 }
486
487 /* Return the length of the current echo string. */
488
489 static int
490 echo_length ()
491 {
492 return echoptr - echobuf;
493 }
494
495 /* Truncate the current echo message to its first LEN chars.
496 This and echo_char get used by read_key_sequence when the user
497 switches screens while entering a key sequence. */
498
499 static void
500 echo_truncate (len)
501 int len;
502 {
503 echobuf[len] = '\0';
504 echoptr = echobuf + strlen (echobuf);
505 }
506
507 \f
508 /* Functions for manipulating this_command_keys. */
509 static void
510 add_command_key (key)
511 Lisp_Object key;
512 {
513 if (this_command_key_count == this_command_keys_size)
514 {
515 this_command_keys_size *= 2;
516 this_command_keys
517 = (Lisp_Object *) xrealloc (this_command_keys,
518 (this_command_keys_size
519 * sizeof (Lisp_Object)));
520 }
521 this_command_keys[this_command_key_count++] = key;
522 }
523 \f
524 Lisp_Object
525 recursive_edit_1 ()
526 {
527 int count = specpdl_ptr - specpdl;
528 Lisp_Object val;
529
530 if (command_loop_level > 0)
531 {
532 specbind (Qstandard_output, Qt);
533 specbind (Qstandard_input, Qt);
534 }
535
536 val = command_loop ();
537 if (EQ (val, Qt))
538 Fsignal (Qquit, Qnil);
539
540 unbind_to (count);
541 return Qnil;
542 }
543
544 /* When an auto-save happens, record the "time", and don't do again soon. */
545 record_auto_save ()
546 {
547 last_auto_save = num_input_chars;
548 }
549 \f
550 Lisp_Object recursive_edit_unwind (), command_loop ();
551
552 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
553 "Invoke the editor command loop recursively.\n\
554 To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
555 that tells this function to return.\n\
556 Alternately, `(throw 'exit t)' makes this function signal an error.\n\
557 This function is called by the editor initialization to begin editing.")
558 ()
559 {
560 int count = specpdl_ptr - specpdl;
561 Lisp_Object val;
562
563 command_loop_level++;
564 update_mode_lines = 1;
565
566 record_unwind_protect (recursive_edit_unwind,
567 (command_loop_level
568 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
569 ? Fcurrent_buffer ()
570 : Qnil);
571 recursive_edit_1 ();
572 return unbind_to (count, Qnil);
573 }
574
575 Lisp_Object
576 recursive_edit_unwind (buffer)
577 Lisp_Object buffer;
578 {
579 if (!NILP (buffer))
580 Fset_buffer (buffer);
581
582 command_loop_level--;
583 update_mode_lines = 1;
584 return Qnil;
585 }
586 \f
587 Lisp_Object
588 cmd_error (data)
589 Lisp_Object data;
590 {
591 Lisp_Object errmsg, tail, errname, file_error;
592 Lisp_Object stream;
593 struct gcpro gcpro1;
594 int i;
595
596 Vquit_flag = Qnil;
597 Vinhibit_quit = Qt;
598 Vstandard_output = Qt;
599 Vstandard_input = Qt;
600 Vexecuting_macro = Qnil;
601 echo_area_glyphs = 0;
602
603 /* If the window system or terminal screen hasn't been initialized
604 yet, or we're not interactive, it's best to dump this message out
605 to stderr and exit. */
606 if (! SCREEN_MESSAGE_BUF (selected_screen)
607 || noninteractive)
608 stream = Qexternal_debugging_output;
609 else
610 {
611 Fdiscard_input ();
612 bitch_at_user ();
613 stream = Qt;
614 }
615
616 errname = Fcar (data);
617
618 if (EQ (errname, Qerror))
619 {
620 data = Fcdr (data);
621 if (!CONSP (data)) data = Qnil;
622 errmsg = Fcar (data);
623 file_error = Qnil;
624 }
625 else
626 {
627 errmsg = Fget (errname, Qerror_message);
628 file_error = Fmemq (Qfile_error,
629 Fget (errname, Qerror_conditions));
630 }
631
632 /* Print an error message including the data items.
633 This is done by printing it into a scratch buffer
634 and then making a copy of the text in the buffer. */
635
636 if (!CONSP (data)) data = Qnil;
637 tail = Fcdr (data);
638 GCPRO1 (tail);
639
640 /* For file-error, make error message by concatenating
641 all the data items. They are all strings. */
642 if (!NILP (file_error) && !NILP (tail))
643 errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr;
644
645 if (XTYPE (errmsg) == Lisp_String)
646 Fprinc (errmsg, stream);
647 else
648 write_string_1 ("peculiar error", -1, stream);
649
650 for (i = 0; CONSP (tail); tail = Fcdr (tail), i++)
651 {
652 write_string_1 (i ? ", " : ": ", 2, stream);
653 if (!NILP (file_error))
654 Fprinc (Fcar (tail), stream);
655 else
656 Fprin1 (Fcar (tail), stream);
657 }
658 UNGCPRO;
659
660 /* If the window system or terminal screen hasn't been initialized
661 yet, or we're in -batch mode, this error should cause Emacs to exit. */
662 if (! SCREEN_MESSAGE_BUF (selected_screen)
663 || noninteractive)
664 {
665 Fterpri (stream);
666 Fkill_emacs (make_number (-1));
667 }
668
669 Vquit_flag = Qnil;
670
671 Vinhibit_quit = Qnil;
672 return make_number (0);
673 }
674 \f
675 Lisp_Object command_loop_1 ();
676 Lisp_Object command_loop_2 ();
677 Lisp_Object top_level_1 ();
678
679 /* Entry to editor-command-loop.
680 This level has the catches for exiting/returning to editor command loop.
681 It returns nil to exit recursive edit, t to abort it. */
682
683 Lisp_Object
684 command_loop ()
685 {
686 if (command_loop_level > 0 || minibuf_level > 0)
687 {
688 return internal_catch (Qexit, command_loop_2, Qnil);
689 }
690 else
691 while (1)
692 {
693 internal_catch (Qtop_level, top_level_1, Qnil);
694 internal_catch (Qtop_level, command_loop_2, Qnil);
695
696 /* End of file in -batch run causes exit here. */
697 if (noninteractive)
698 Fkill_emacs (Qt);
699 }
700 }
701
702 /* Here we catch errors in execution of commands within the
703 editing loop, and reenter the editing loop.
704 When there is an error, cmd_error runs and returns a non-nil
705 value to us. A value of nil means that cmd_loop_1 itself
706 returned due to end of file (or end of kbd macro). */
707
708 Lisp_Object
709 command_loop_2 ()
710 {
711 register Lisp_Object val;
712
713 do
714 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
715 while (!NILP (val));
716
717 return Qnil;
718 }
719
720 Lisp_Object
721 top_level_2 ()
722 {
723 return Feval (Vtop_level);
724 }
725
726 Lisp_Object
727 top_level_1 ()
728 {
729 /* On entry to the outer level, run the startup file */
730 if (!NILP (Vtop_level))
731 internal_condition_case (top_level_2, Qerror, cmd_error);
732 else if (!NILP (Vpurify_flag))
733 message ("Bare impure Emacs (standard Lisp code not loaded)");
734 else
735 message ("Bare Emacs (standard Lisp code not loaded)");
736 return Qnil;
737 }
738
739 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
740 "Exit all recursive editing levels.")
741 ()
742 {
743 Fthrow (Qtop_level, Qnil);
744 }
745
746 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
747 "Exit from the innermost recursive edit or minibuffer.")
748 ()
749 {
750 if (command_loop_level > 0 || minibuf_level > 0)
751 Fthrow (Qexit, Qnil);
752
753 error ("No recursive edit is in progress");
754 }
755
756 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
757 "Abort the command that requested this recursive edit or minibuffer input.")
758 ()
759 {
760 if (command_loop_level > 0 || minibuf_level > 0)
761 Fthrow (Qexit, Qt);
762
763 error ("No recursive edit is in progress");
764 }
765 \f
766 /* This is the actual command reading loop,
767 sans error-handling encapsulation. */
768
769 Lisp_Object Fcommand_execute ();
770 static int read_key_sequence ();
771
772 Lisp_Object
773 command_loop_1 ()
774 {
775 Lisp_Object cmd;
776 int lose;
777 int nonundocount;
778 Lisp_Object keybuf[30];
779 int i;
780 int no_redisplay;
781 int no_direct;
782
783 Vprefix_arg = Qnil;
784 waiting_for_input = 0;
785 cancel_echoing ();
786
787 /* Don't clear out last_command at the beginning of a macro. */
788 if (XTYPE (Vexecuting_macro) != Lisp_String)
789 last_command = Qt;
790
791 nonundocount = 0;
792 no_redisplay = 0;
793 this_command_key_count = 0;
794
795 while (1)
796 {
797 /* Install chars successfully executed in kbd macro. */
798
799 if (defining_kbd_macro && NILP (Vprefix_arg))
800 finalize_kbd_macro_chars ();
801
802 /* Make sure the current window's buffer is selected. */
803 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
804 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
805
806 /* Display any malloc warning that just came out. Use while because
807 displaying one warning can cause another. */
808
809 while (pending_malloc_warning)
810 display_malloc_warning ();
811
812 no_direct = 0;
813
814 /* If minibuffer on and echo area in use,
815 wait 2 sec and redraw minibufer. */
816
817 if (minibuf_level && echo_area_glyphs)
818 {
819 Fsit_for (make_number (2), Qnil, Qnil);
820 echo_area_glyphs = 0;
821 no_direct = 1;
822 if (!NILP (Vquit_flag))
823 {
824 Vquit_flag = Qnil;
825 unread_command_char = make_number (quit_char);
826 }
827 }
828
829 #ifdef C_ALLOCA
830 alloca (0); /* Cause a garbage collection now */
831 /* Since we can free the most stuff here. */
832 #endif /* C_ALLOCA */
833
834 /* Read next key sequence; i gets its length. */
835 i = read_key_sequence (keybuf, (sizeof keybuf / sizeof (keybuf[0])), 0);
836
837 ++num_input_keys;
838
839 #ifdef MULTI_SCREEN
840 /* Select the screen that the key sequence came from. */
841 if (XTYPE (Vlast_event_screen) == Lisp_Screen
842 && XSCREEN (Vlast_event_screen) != selected_screen)
843 Fselect_screen (Vlast_event_screen, Qnil);
844 #endif
845
846 /* Now we have read a key sequence of length I,
847 or else I is 0 and we found end of file. */
848
849 if (i == 0) /* End of file -- happens only in */
850 return Qnil; /* a kbd macro, at the end. */
851
852 #if 0
853 #ifdef HAVE_X_WINDOWS
854 if (SCREEN_IS_X (selected_screen))
855 {
856 if (i == -1) /* Mouse event */
857 {
858 nonundocount = 0;
859 if (NILP (Vprefix_arg) && NILP (Vexecuting_macro) &&
860 !EQ (minibuf_window, selected_window))
861 Fundo_boundary ();
862
863 if (defining_kbd_macro)
864 {
865 /* Be nice if this worked... */
866 }
867 Fexecute_mouse_event (read_key_sequence_cmd);
868 no_redisplay = 0;
869 goto directly_done;
870 }
871
872 if (i == -2) /* Lisp Symbol */
873 {
874 nonundocount = 0;
875 if (NILP (Vprefix_arg) && NILP (Vexecuting_macro) &&
876 !EQ (minibuf_window, selected_window))
877 Fundo_boundary ();
878
879 goto directly_done;
880 }
881 }
882 #endif /* HAVE_X_WINDOWS */
883 #endif
884
885 last_command_char = keybuf[i - 1];
886
887 cmd = read_key_sequence_cmd;
888 if (!NILP (Vexecuting_macro))
889 {
890 if (!NILP (Vquit_flag))
891 {
892 Vexecuting_macro = Qt;
893 QUIT; /* Make some noise. */
894 /* Will return since macro now empty. */
895 }
896 }
897
898 /* Do redisplay processing after this command except in special
899 cases identified below that set no_redisplay to 1. */
900 no_redisplay = 0;
901
902 /* Execute the command. */
903
904 if (NILP (cmd))
905 {
906 /* nil means key is undefined. */
907 bitch_at_user ();
908 defining_kbd_macro = 0;
909 update_mode_lines = 1;
910 Vprefix_arg = Qnil;
911 }
912 else
913 {
914 this_command = cmd;
915 if (NILP (Vprefix_arg) && ! no_direct)
916 {
917 /* Recognize some common commands in common situations and
918 do them directly. */
919 if (EQ (cmd, Qforward_char) && point < ZV)
920 {
921 struct Lisp_Vector *dp
922 = window_display_table (XWINDOW (selected_window));
923 lose = FETCH_CHAR (point);
924 SET_PT (point + 1);
925 if (((dp == 0 && lose >= 040 && lose < 0177)
926 ||
927 (dp && (XTYPE (dp->contents[lose]) != Lisp_String
928 || XSTRING (dp->contents[lose])->size == sizeof (GLYPH))))
929 && (XFASTINT (XWINDOW (selected_window)->last_modified)
930 >= MODIFF)
931 && (XFASTINT (XWINDOW (selected_window)->last_point)
932 == point - 1)
933 && !windows_or_buffers_changed
934 && EQ (current_buffer->selective_display, Qnil)
935 && !detect_input_pending ()
936 && NILP (Vexecuting_macro))
937 no_redisplay = direct_output_forward_char (1);
938 goto directly_done;
939 }
940 else if (EQ (cmd, Qbackward_char) && point > BEGV)
941 {
942 struct Lisp_Vector *dp
943 = window_display_table (XWINDOW (selected_window));
944 SET_PT (point - 1);
945 lose = FETCH_CHAR (point);
946 if (((dp == 0 && lose >= 040 && lose < 0177)
947 ||
948 (dp && (XTYPE (dp->contents[lose]) != Lisp_String
949 || XSTRING (dp->contents[lose])->size == sizeof (GLYPH))))
950 && (XFASTINT (XWINDOW (selected_window)->last_modified)
951 >= MODIFF)
952 && (XFASTINT (XWINDOW (selected_window)->last_point)
953 == point + 1)
954 && !windows_or_buffers_changed
955 && EQ (current_buffer->selective_display, Qnil)
956 && !detect_input_pending ()
957 && NILP (Vexecuting_macro))
958 no_redisplay = direct_output_forward_char (-1);
959 goto directly_done;
960 }
961 else if (EQ (cmd, Qself_insert_command)
962 /* Try this optimization only on ascii keystrokes. */
963 && XTYPE (last_command_char) == Lisp_Int)
964 {
965 unsigned char c = XINT (last_command_char);
966
967 if (NILP (Vexecuting_macro) &&
968 !EQ (minibuf_window, selected_window))
969 {
970 if (!nonundocount || nonundocount >= 20)
971 {
972 Fundo_boundary ();
973 nonundocount = 0;
974 }
975 nonundocount++;
976 }
977 lose = (XFASTINT (XWINDOW (selected_window)->last_modified)
978 < MODIFF)
979 || (XFASTINT (XWINDOW (selected_window)->last_point)
980 != point)
981 || MODIFF <= current_buffer->save_modified
982 || windows_or_buffers_changed
983 || !EQ (current_buffer->selective_display, Qnil)
984 || detect_input_pending ()
985 || !NILP (Vexecuting_macro);
986 if (internal_self_insert (c, 0))
987 {
988 lose = 1;
989 nonundocount = 0;
990 }
991 if (!lose &&
992 (point == ZV || FETCH_CHAR (point) == '\n'))
993 {
994 struct Lisp_Vector *dp
995 = window_display_table (XWINDOW (selected_window));
996
997 if (dp == 0 || XTYPE (dp->contents[c]) != Lisp_String)
998 no_redisplay = direct_output_for_insert (c);
999 else if (XSTRING (dp->contents[c])->size
1000 == sizeof (GLYPH))
1001 no_redisplay =
1002 direct_output_for_insert (*(GLYPH *)XSTRING (dp->contents[c])->data);
1003 }
1004 goto directly_done;
1005 }
1006 }
1007
1008 /* Here for a command that isn't executed directly */
1009
1010 nonundocount = 0;
1011 if (NILP (Vprefix_arg))
1012 Fundo_boundary ();
1013 Fcommand_execute (cmd, Qnil);
1014
1015 }
1016 directly_done: ;
1017
1018 /* If there is a prefix argument,
1019 1) We don't want last_command to be ``universal-argument''
1020 (that would be dumb), so don't set last_command,
1021 2) we want to leave echoing on so that the prefix will be
1022 echoed as part of this key sequence, so don't call
1023 cancel_echoing, and
1024 3) we want to leave this_command_key_count non-zero, so that
1025 read_char will realize that it is re-reading a character, and
1026 not echo it a second time. */
1027 if (NILP (Vprefix_arg))
1028 {
1029 last_command = this_command;
1030 cancel_echoing ();
1031 this_command_key_count = 0;
1032 }
1033 }
1034 }
1035 \f
1036 /* Number of seconds between polling for input. */
1037 int polling_period;
1038
1039 /* Nonzero means polling for input is temporarily suppresed. */
1040 int poll_suppress_count;
1041
1042 #ifdef POLL_FOR_INPUT
1043 int polling_for_input;
1044
1045 /* Handle an alarm once each second and read pending input
1046 so as to handle a C-g if it comces in. */
1047
1048 SIGTYPE
1049 input_poll_signal ()
1050 {
1051 #ifdef HAVE_X_WINDOWS
1052 extern int x_input_blocked;
1053 if (x_input_blocked == 0)
1054 #endif
1055 if (!waiting_for_input)
1056 read_avail_input (0);
1057 signal (SIGALRM, input_poll_signal);
1058 alarm (polling_period);
1059 }
1060
1061 #endif
1062
1063 /* Begin signals to poll for input, if they are appropriate.
1064 This function is called unconditionally from various places. */
1065
1066 start_polling ()
1067 {
1068 #ifdef POLL_FOR_INPUT
1069 if (read_socket_hook)
1070 {
1071 poll_suppress_count--;
1072 if (poll_suppress_count == 0)
1073 {
1074 signal (SIGALRM, input_poll_signal);
1075 polling_for_input = 1;
1076 alarm (polling_period);
1077 }
1078 }
1079 #endif
1080 }
1081
1082 /* Turn off polling. */
1083
1084 stop_polling ()
1085 {
1086 #ifdef POLL_FOR_INPUT
1087 if (read_socket_hook)
1088 {
1089 if (poll_suppress_count == 0)
1090 {
1091 polling_for_input = 0;
1092 alarm (0);
1093 }
1094 poll_suppress_count++;
1095 }
1096 #endif
1097 }
1098 \f
1099 /* Input of single characters from keyboard */
1100
1101 Lisp_Object print_help ();
1102 static Lisp_Object kbd_buffer_get_event ();
1103
1104 /* read a character from the keyboard; call the redisplay if needed */
1105 /* commandflag 0 means do not do auto-saving, but do do redisplay.
1106 -1 means do not do redisplay, but do do autosaving.
1107 1 means do both. */
1108
1109 Lisp_Object
1110 read_char (commandflag)
1111 int commandflag;
1112 {
1113 register Lisp_Object c;
1114 int count;
1115 jmp_buf save_jump;
1116
1117 if (!NILP (unread_command_char))
1118 {
1119 c = unread_command_char;
1120 unread_command_char = Qnil;
1121
1122 #if 0 /* We're not handling mouse keys specially anymore. */
1123 if (!EQ (XTYPE (obj), Lisp_Int)) /* Mouse thing */
1124 {
1125 num_input_chars++;
1126 last_input_char = 0;
1127 return obj;
1128 }
1129 #endif
1130
1131 if (this_command_key_count == 0)
1132 goto reread_first;
1133 else
1134 goto reread;
1135 }
1136
1137 if (!NILP (Vexecuting_macro))
1138 {
1139 if (executing_macro_index >= Flength (Vexecuting_macro))
1140 {
1141 XSET (c, Lisp_Int, -1);
1142 return c;
1143 }
1144
1145 c = Faref (Vexecuting_macro, make_number (executing_macro_index));
1146 executing_macro_index++;
1147
1148 goto from_macro;
1149 }
1150
1151 /* Save outer setjmp data, in case called recursively. */
1152 save_getcjmp (save_jump);
1153
1154 stop_polling ();
1155
1156 if (commandflag >= 0 && !input_pending && !detect_input_pending ())
1157 redisplay ();
1158
1159 if (_setjmp (getcjmp))
1160 {
1161 XSET (c, Lisp_Int, quit_char);
1162 #ifdef MULTI_SCREEN
1163 XSET (Vlast_event_screen, Lisp_Screen, selected_screen);
1164 #endif
1165
1166 goto non_reread;
1167 }
1168
1169 /* Message turns off echoing unless more keystrokes turn it on again. */
1170 if (echo_area_glyphs && *echo_area_glyphs && echo_area_glyphs != echobuf)
1171 cancel_echoing ();
1172 else
1173 /* If already echoing, continue. */
1174 echo_dash ();
1175
1176 /* If in middle of key sequence and minibuffer not active,
1177 start echoing if enough time elapses. */
1178 if (minibuf_level == 0 && !immediate_echo && this_command_key_count > 0
1179 && echo_keystrokes > 0
1180 && (echo_area_glyphs == 0 || *echo_area_glyphs == 0))
1181 {
1182 Lisp_Object tem0;
1183
1184 tem0 = sit_for (echo_keystrokes, 0, 1, 1);
1185 if (EQ (tem0, Qt))
1186 echo ();
1187 }
1188
1189 /* Maybe auto save due to number of keystrokes or idle time. */
1190
1191 if (commandflag != 0
1192 && auto_save_interval > 0
1193 && num_input_chars - last_auto_save > max (auto_save_interval, 20)
1194 && !detect_input_pending ())
1195 {
1196 jmp_buf temp;
1197 save_getcjmp (temp);
1198 Fdo_auto_save (Qnil, Qnil);
1199 restore_getcjmp (temp);
1200 }
1201
1202 /* Slow down auto saves logarithmically in size of current buffer,
1203 and garbage collect while we're at it. */
1204 {
1205 int delay_level, buffer_size;
1206
1207 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
1208 last_non_minibuf_size = Z - BEG;
1209 buffer_size = (last_non_minibuf_size >> 8) + 1;
1210 delay_level = 0;
1211 while (buffer_size > 64)
1212 delay_level++, buffer_size -= buffer_size >> 2;
1213 if (delay_level < 4) delay_level = 4;
1214 /* delay_level is 4 for files under around 50k, 7 at 100k,
1215 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
1216
1217 /* Auto save if enough time goes by without input. */
1218 if (commandflag != 0
1219 && num_input_chars > last_auto_save
1220 && XTYPE (Vauto_save_timeout) == Lisp_Int
1221 && XINT (Vauto_save_timeout) > 0)
1222 {
1223 Lisp_Object tem0;
1224 int delay = delay_level * XFASTINT (Vauto_save_timeout) / 4;
1225 tem0 = sit_for (delay, 0, 1, 1);
1226 if (EQ (tem0, Qt))
1227 {
1228 jmp_buf temp;
1229 save_getcjmp (temp);
1230 Fdo_auto_save (Qnil, Qnil);
1231 restore_getcjmp (temp);
1232
1233 /* If we have auto-saved and there is still no input
1234 available, garbage collect if there has been enough
1235 consing going on to make it worthwhile. */
1236 if (!detect_input_pending ()
1237 && consing_since_gc > gc_cons_threshold / 2)
1238 Fgarbage_collect ();
1239 }
1240 }
1241 }
1242
1243 /* Actually read a character, waiting if necessary. */
1244 c = kbd_buffer_get_event ();
1245
1246 if (NILP (c))
1247 abort (); /* Don't think this can happen. */
1248
1249 #if 0 /* I think that all the different kinds of events should be
1250 handled together now... */
1251 if (XTYPE (c) != Lisp_Int)
1252 {
1253 start_polling ();
1254 return c;
1255 }
1256 c = XINT (obj);
1257 #endif
1258
1259 /* Terminate Emacs in batch mode if at eof. */
1260 if (noninteractive && c < 0)
1261 Fkill_emacs (make_number (1));
1262
1263 non_reread:
1264
1265 restore_getcjmp (save_jump);
1266
1267 start_polling ();
1268
1269 echo_area_glyphs = 0;
1270
1271 /* Handle things that only apply to characters. */
1272 if (XTYPE (c) == Lisp_Int)
1273 {
1274 /* If kbd_buffer_get_event gave us an EOF, return that. */
1275 if (XINT (c) < 0)
1276 return c;
1277
1278 /* Strip the high bits, and maybe the meta bit too. */
1279 XSETINT (c, c & (meta_key ? 0377 : 0177));
1280
1281 if (XTYPE (Vkeyboard_translate_table) == Lisp_String
1282 && XSTRING (Vkeyboard_translate_table)->size > XINT (c))
1283 XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[c]);
1284 }
1285
1286 total_keys++;
1287 recent_keys[recent_keys_index] = c;
1288 if (++recent_keys_index >= (sizeof (recent_keys)/sizeof(recent_keys[0])))
1289 recent_keys_index = 0;
1290
1291 /* Write c to the dribble file. If c is a lispy event, write
1292 the event's symbol to the dribble file, in <brackets>. Bleaugh.
1293 If you, dear reader, have a better idea, you've got the source. :-) */
1294 if (dribble)
1295 {
1296 if (XTYPE (c) == Lisp_Int)
1297 putc (c, dribble);
1298 else
1299 {
1300 Lisp_Object dribblee = c;
1301
1302 /* If it's a structured event, take the event header. */
1303 if (EVENT_HAS_PARAMETERS (dribblee))
1304 dribblee = EVENT_HEAD (dribblee);
1305
1306 if (XTYPE (c) == Lisp_Symbol)
1307 {
1308 putc ('<', dribble);
1309 fwrite (XSYMBOL (c)->name->data, sizeof (char),
1310 XSYMBOL (c)->name->size,
1311 dribble);
1312 putc ('>', dribble);
1313 }
1314 }
1315
1316 fflush (dribble);
1317 }
1318
1319 store_kbd_macro_char (c);
1320
1321 from_macro:
1322 reread_first:
1323 echo_char (c);
1324
1325 /* Record this character as part of the current key. */
1326 add_command_key (c);
1327
1328 /* Re-reading in the middle of a command */
1329 reread:
1330 last_input_char = c;
1331 num_input_chars++;
1332
1333 /* Process the help character specially if enabled */
1334 if (EQ (c, help_char) && !NILP (Vhelp_form))
1335 {
1336 Lisp_Object tem0;
1337 count = specpdl_ptr - specpdl;
1338
1339 record_unwind_protect (Fset_window_configuration,
1340 Fcurrent_window_configuration (Qnil));
1341
1342 tem0 = Feval (Vhelp_form);
1343 if (XTYPE (tem0) == Lisp_String)
1344 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
1345
1346 cancel_echoing ();
1347 c = read_char (0);
1348 /* Remove the help from the screen */
1349 unbind_to (count, Qnil);
1350 redisplay ();
1351 if (EQ (c, make_number (040)))
1352 {
1353 cancel_echoing ();
1354 c = read_char (0);
1355 }
1356 }
1357
1358 return c;
1359 }
1360
1361 Lisp_Object
1362 print_help (object)
1363 Lisp_Object object;
1364 {
1365 Fprinc (object, Qnil);
1366 return Qnil;
1367 }
1368
1369 /* Copy out or in the info on where C-g should throw to.
1370 This is used when running Lisp code from within get_char,
1371 in case get_char is called recursively.
1372 See read_process_output. */
1373
1374 save_getcjmp (temp)
1375 jmp_buf temp;
1376 {
1377 bcopy (getcjmp, temp, sizeof getcjmp);
1378 }
1379
1380 restore_getcjmp (temp)
1381 jmp_buf temp;
1382 {
1383 bcopy (temp, getcjmp, sizeof getcjmp);
1384 }
1385
1386 \f
1387 /* Low level keyboard/mouse input.
1388 kbd_buffer_store_event places events in kbd_buffer, and
1389 kbd_buffer_get_event retrieves them.
1390 mouse_moved indicates when the mouse has moved again, and
1391 *mouse_position_hook provides the mouse position. */
1392
1393 /* Set this for debugging, to have a way to get out */
1394 int stop_character;
1395
1396 extern int screen_garbaged;
1397
1398 /* Return true iff there are any events in the queue that read-char
1399 would return. If this returns false, a read-char would block. */
1400 static int
1401 readable_events ()
1402 {
1403 struct input_event *ep;
1404
1405 if (EVENT_QUEUES_EMPTY)
1406 return 0;
1407
1408 if (do_mouse_tracking)
1409 return 1;
1410
1411 /* Mouse tracking is disabled, so we need to actually scan the
1412 input queue to see if any events are currently readable. */
1413 for (ep = kbd_fetch_ptr; ep != kbd_store_ptr; ep++)
1414 {
1415 if (ep == kbd_buffer + KBD_BUFFER_SIZE)
1416 ep = kbd_buffer;
1417
1418 /* Skip button-up events. */
1419 if ((ep->kind == mouse_click || ep->kind == scrollbar_click)
1420 && (ep->modifiers & up_modifier))
1421 continue;
1422
1423 return 1;
1424 }
1425
1426 return 0;
1427 }
1428
1429
1430 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
1431 of this function. */
1432 static Lisp_Object
1433 tracking_off (old_value)
1434 Lisp_Object old_value;
1435 {
1436 if (! XFASTINT (old_value))
1437 {
1438 do_mouse_tracking = 0;
1439
1440 /* Redisplay may have been preempted because there was input
1441 available, and it assumes it will be called again after the
1442 input has been processed. If the only input available was
1443 the sort that we have just disabled, then we need to call
1444 redisplay. */
1445 if (!readable_events ())
1446 {
1447 redisplay_preserve_echo_area ();
1448 get_input_pending (&input_pending);
1449 }
1450 }
1451 }
1452
1453 DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
1454 "Evaluate BODY with mouse movement and button release events enabled.\n\
1455 Within a `track-mouse', mouse motion and button releases generate input\n\
1456 events that you can read with `read-event'.\n\
1457 Normally, these occurrences don't generate events.")
1458 (args)
1459 Lisp_Object args;
1460 {
1461 int count = specpdl_ptr - specpdl;
1462 Lisp_Object val;
1463
1464 XSET (val, Lisp_Int, do_mouse_tracking);
1465 record_unwind_protect (tracking_off, val);
1466
1467 do_mouse_tracking = 1;
1468
1469 val = Fprogn (args);
1470 return unbind_to (count, val);
1471 }
1472
1473 /* Store an event obtained at interrupt level into kbd_buffer, fifo */
1474
1475 void
1476 kbd_buffer_store_event (event)
1477 register struct input_event *event;
1478 {
1479 if (event->kind == no_event)
1480 abort ();
1481
1482 if (event->kind == ascii_keystroke)
1483 {
1484 register int c = XFASTINT (event->code) & 0377;
1485
1486 if (c == quit_char
1487 || ((c == (0200 | quit_char)) && !meta_key))
1488 {
1489 /* If this results in a quit_char being returned to Emacs as
1490 input, set last-event-screen properly. If this doesn't
1491 get returned to Emacs as an event, the next event read
1492 will set Vlast_event_screen again, so this is safe to do. */
1493 extern SIGTYPE interrupt_signal ();
1494 Vlast_event_screen = SCREEN_FOCUS_SCREEN (event->screen);
1495 last_event_timestamp = event->timestamp;
1496 interrupt_signal ();
1497 return;
1498 }
1499
1500 if (c && c == stop_character)
1501 {
1502 sys_suspend ();
1503 return;
1504 }
1505
1506 XSET (event->code, Lisp_Int, c);
1507 }
1508
1509 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
1510 kbd_store_ptr = kbd_buffer;
1511
1512 /* Don't let the very last slot in the buffer become full,
1513 since that would make the two pointers equal,
1514 and that is indistinguishable from an empty buffer.
1515 Discard the event if it would fill the last slot. */
1516 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
1517 {
1518 kbd_store_ptr->kind = event->kind;
1519 kbd_store_ptr->code = event->code;
1520 kbd_store_ptr->part = event->part;
1521 kbd_store_ptr->screen = event->screen;
1522 kbd_store_ptr->modifiers = event->modifiers;
1523 kbd_store_ptr->x = event->x;
1524 kbd_store_ptr->y = event->y;
1525 kbd_store_ptr->timestamp = event->timestamp;
1526
1527 kbd_store_ptr++;
1528 }
1529 }
1530
1531 static Lisp_Object make_lispy_event ();
1532 static Lisp_Object make_lispy_movement ();
1533 static Lisp_Object modify_event_symbol ();
1534
1535 static Lisp_Object
1536 kbd_buffer_get_event ()
1537 {
1538 register int c;
1539 Lisp_Object obj;
1540
1541 if (noninteractive)
1542 {
1543 c = getchar ();
1544 XSET (obj, Lisp_Int, c);
1545 return obj;
1546 }
1547
1548 /* Wait until there is input available. */
1549 for (;;)
1550 {
1551
1552 /* Process or toss any events that we don't want to return as
1553 input. The fact that we remove undesirable events here
1554 allows us to use EVENT_QUEUES_EMPTY in the rest of this loop. */
1555 if (! do_mouse_tracking)
1556 while (kbd_fetch_ptr != kbd_store_ptr)
1557 {
1558 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
1559 kbd_fetch_ptr = kbd_buffer;
1560
1561 if (kbd_fetch_ptr->kind == mouse_click
1562 || kbd_fetch_ptr->kind == scrollbar_click)
1563 {
1564 if ((kbd_fetch_ptr->modifiers & up_modifier) == 0)
1565 break;
1566 }
1567 else
1568 break;
1569
1570 kbd_fetch_ptr++;
1571 }
1572
1573 if (!EVENT_QUEUES_EMPTY)
1574 break;
1575
1576 /* If the quit flag is set, then read_char will return
1577 quit_char, so that counts as "available input." */
1578 if (!NILP (Vquit_flag))
1579 quit_throw_to_read_char ();
1580
1581 /* One way or another, wait until input is available; then, if
1582 interrupt handlers have not read it, read it now. */
1583
1584 #ifdef OLDVMS
1585 wait_for_kbd_input ();
1586 #else
1587 /* Note SIGIO has been undef'd if FIONREAD is missing. */
1588 #ifdef SIGIO
1589 gobble_input (0);
1590 #endif /* SIGIO */
1591 if (EVENT_QUEUES_EMPTY)
1592 {
1593 Lisp_Object minus_one;
1594
1595 XSET (minus_one, Lisp_Int, -1);
1596 wait_reading_process_input (0, 0, minus_one, 1);
1597
1598 if (!interrupt_input && EVENT_QUEUES_EMPTY)
1599 {
1600 read_avail_input (0);
1601 }
1602 }
1603 #endif /* not VMS */
1604 }
1605
1606 /* At this point, we know that there is a readable event available
1607 somewhere. If the event queue is empty, then there must be a
1608 mouse movement enabled and available. */
1609 if (kbd_fetch_ptr != kbd_store_ptr)
1610 {
1611 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
1612 kbd_fetch_ptr = kbd_buffer;
1613 /* Do the redirection specified by the focus_screen
1614 member now, before we return this event. */
1615 kbd_fetch_ptr->screen =
1616 XSCREEN (SCREEN_FOCUS_SCREEN (kbd_fetch_ptr->screen));
1617 XSET (Vlast_event_screen, Lisp_Screen, kbd_fetch_ptr->screen);
1618 last_event_timestamp = kbd_fetch_ptr->timestamp;
1619 obj = make_lispy_event (kbd_fetch_ptr);
1620 kbd_fetch_ptr->kind = no_event;
1621 kbd_fetch_ptr++;
1622 if (XTYPE (obj) == Lisp_Int)
1623 XSET (obj, Lisp_Int, XINT (obj) & (meta_key ? 0377 : 0177));
1624 }
1625 else if (do_mouse_tracking && mouse_moved)
1626 {
1627 SCREEN_PTR screen;
1628 Lisp_Object x, y, time;
1629
1630 (*mouse_position_hook) (&screen, &x, &y, &time);
1631 XSET (Vlast_event_screen, Lisp_Screen, screen);
1632
1633 obj = make_lispy_movement (screen, x, y, time);
1634 }
1635 else
1636 /* We were promised by the above while loop that there was
1637 something for us to read! */
1638 abort ();
1639
1640 input_pending = readable_events ();
1641
1642 return (obj);
1643 }
1644
1645 /* Caches for modify_event_symbol. */
1646 static Lisp_Object func_key_syms;
1647 static Lisp_Object mouse_syms;
1648
1649 /* You'll notice that this table is arranged to be conveniently
1650 indexed by X Windows keysym values. */
1651 static char *lispy_function_keys[] =
1652 {
1653 /* X Keysym value */
1654
1655 "home", /* 0xff50 */ /* IsCursorKey */
1656 "left",
1657 "up",
1658 "right",
1659 "down",
1660 "prior",
1661 "next",
1662 "end",
1663 "begin",
1664 0, /* 0xff59 */
1665 0, 0, 0, 0, 0, 0,
1666 "select", /* 0xff60 */ /* IsMiscFunctionKey */
1667 "print",
1668 "execute",
1669 "insert",
1670 0, /* 0xff64 */
1671 "undo",
1672 "redo",
1673 "menu",
1674 "find",
1675 "cancel",
1676 "help",
1677 "break", /* 0xff6b */
1678
1679 /* Here are some keys found mostly on HP keyboards. The X event
1680 handling code will strip bit 29, which flags vendor-specific
1681 keysyms. */
1682 "reset", /* 0x1000ff6c */
1683 "system",
1684 "user",
1685 "clearline",
1686 "insertline",
1687 "deleteline",
1688 "insertchar",
1689 "deletechar",
1690 "backtab",
1691 "kp_backtab", /* 0x1000ff75 */
1692 0, /* 0xff76 */
1693 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff7f */
1694 "kp-space", /* 0xff80 */ /* IsKeypadKey */
1695 0, 0, 0, 0, 0, 0, 0, 0,
1696 "kp-tab", /* 0xff89 */
1697 0, 0, 0,
1698 "kp-enter", /* 0xff8d */
1699 0, 0, 0,
1700 "kp-f1", /* 0xff91 */
1701 "kp-f2",
1702 "kp-f3",
1703 "kp-f4",
1704 0, /* 0xff95 */
1705 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
1706 "kp-multiply", /* 0xffaa */
1707 "kp-add",
1708 "kp-separator",
1709 "kp-subtract",
1710 "kp-decimal",
1711 "kp-divide", /* 0xffaf */
1712 "kp-0", /* 0xffb0 */
1713 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
1714 0, /* 0xffba */
1715 0, 0,
1716 "kp-equal", /* 0xffbd */
1717 "f1", /* 0xffbe */ /* IsFunctionKey */
1718 "f2", "f3", "f4",
1719 "f5", "f6", "f7", "f8", "f9", "f10", "f11", "f12",
1720 "f13", "f14", "f15", "f16", "f17", "f18", "f19", "f20",
1721 "f21", "f22", "f23", "f24", "f25", "f26", "f27", "f28",
1722 "f29", "f30", "f31", "f32", "f33", "f34", "f35" /* 0xffe0 */
1723 };
1724
1725 static char *lispy_mouse_names[] =
1726 {
1727 "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5"
1728 };
1729
1730 /* Given a struct input_event, build the lisp event which represents
1731 it. If EVENT is 0, build a mouse movement event from the mouse
1732 movement buffer, which should have a movement event in it. */
1733
1734 static Lisp_Object
1735 make_lispy_event (event)
1736 struct input_event *event;
1737 {
1738 #ifdef SWITCH_ENUM_BUG
1739 switch ((int) event->kind)
1740 #else
1741 switch (event->kind)
1742 #endif
1743 {
1744
1745 /* A simple keystroke. */
1746 case ascii_keystroke:
1747 return event->code;
1748 break;
1749
1750 /* A function key. The symbol may need to have modifier prefixes
1751 tacked onto it. */
1752 case non_ascii_keystroke:
1753 return modify_event_symbol (XFASTINT (event->code), event->modifiers,
1754 Qfunction_key,
1755 lispy_function_keys, &func_key_syms,
1756 (sizeof (lispy_function_keys)
1757 / sizeof (lispy_function_keys[0])));
1758 break;
1759
1760 /* A mouse click - build a list of the relevant information. */
1761 case mouse_click:
1762 {
1763 int part;
1764 Lisp_Object window =
1765 window_from_coordinates (event->screen,
1766 XINT (event->x), XINT (event->y),
1767 &part);
1768 Lisp_Object posn;
1769
1770 if (XTYPE (window) != Lisp_Window)
1771 posn = Qnil;
1772 else
1773 {
1774 XSETINT (event->x, (XINT (event->x)
1775 - XINT (XWINDOW (window)->left)));
1776 XSETINT (event->y, (XINT (event->y)
1777 - XINT (XWINDOW (window)->top)));
1778
1779 if (part == 1)
1780 posn = Qmode_line;
1781 else if (part == 2)
1782 posn = Qvertical_split;
1783 else
1784 XSET (posn, Lisp_Int,
1785 buffer_posn_from_coords (XWINDOW (window),
1786 XINT (event->x),
1787 XINT (event->y)));
1788 }
1789
1790 return Fcons (modify_event_symbol (XFASTINT (event->code) - 1,
1791 event->modifiers,
1792 Qmouse_click,
1793 lispy_mouse_names, &mouse_syms,
1794 (sizeof (lispy_mouse_names)
1795 / sizeof (lispy_mouse_names[0]))),
1796 Fcons (window,
1797 Fcons (posn,
1798 Fcons (Fcons (event->x, event->y),
1799 Fcons (make_number
1800 (event->timestamp),
1801 Qnil)))));
1802 }
1803
1804 /* A scrollbar click. Build a list containing the relevant
1805 information. */
1806 case scrollbar_click:
1807 {
1808 Lisp_Object button
1809 = modify_event_symbol (XFASTINT (event->code) - 1,
1810 event->modifiers,
1811 Qmouse_click,
1812 lispy_mouse_names, &mouse_syms,
1813 (sizeof (lispy_mouse_names)
1814 / sizeof (lispy_mouse_names[0])));
1815 return Fcons (event->part,
1816 Fcons (SCREEN_SELECTED_WINDOW (event->screen),
1817 Fcons (button,
1818 Fcons (Fcons (event->x, event->y),
1819 Fcons (make_number
1820 (event->timestamp),
1821 Qnil)))));
1822 }
1823
1824 /* The 'kind' field of the event is something we don't recognize. */
1825 default:
1826 abort();
1827 }
1828 }
1829
1830 static Lisp_Object
1831 make_lispy_movement (screen, x, y, time)
1832 SCREEN_PTR screen;
1833 Lisp_Object x, y;
1834 Lisp_Object time;
1835 {
1836 Lisp_Object window;
1837 int ix, iy;
1838 Lisp_Object posn;
1839 int part;
1840
1841 ix = XINT (x);
1842 iy = XINT (y);
1843 window = (screen
1844 ? window_from_coordinates (screen, ix, iy, &part)
1845 : Qnil);
1846 if (XTYPE (window) != Lisp_Window)
1847 posn = Qnil;
1848 else
1849 {
1850 ix -= XINT (XWINDOW (window)->left);
1851 iy -= XINT (XWINDOW (window)->top);
1852 if (part == 1)
1853 posn = Qmode_line;
1854 else if (part == 2)
1855 posn = Qvertical_split;
1856 else
1857 XSET (posn, Lisp_Int, buffer_posn_from_coords (XWINDOW (window),
1858 ix, iy));
1859 }
1860
1861 XSETINT (x, ix);
1862 XSETINT (y, iy);
1863 return Fcons (Qmouse_movement,
1864 Fcons (window,
1865 Fcons (posn,
1866 Fcons (Fcons (x, y),
1867 Fcons (time, Qnil)))));
1868 }
1869
1870
1871
1872 /* Place the written representation of MODIFIERS in BUF, '\0'-terminated,
1873 and return its length. */
1874
1875 static int
1876 format_modifiers (modifiers, buf)
1877 int modifiers;
1878 char *buf;
1879 {
1880 char *p = buf;
1881
1882 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
1883 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
1884 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
1885 if (modifiers & up_modifier) { *p++ = 'U'; *p++ = '-'; }
1886 *p = '\0';
1887
1888 return p - buf;
1889 }
1890
1891
1892 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
1893 return a symbol with the modifiers placed in the canonical order.
1894
1895 Fdefine_key calls this to make sure that (for example) C-M-foo
1896 and M-C-foo end up being equivalent in the keymap. */
1897
1898 Lisp_Object
1899 reorder_modifiers (symbol)
1900 Lisp_Object symbol;
1901 {
1902 struct Lisp_String *name;
1903 int i;
1904 int modifiers;
1905 int not_canonical;
1906
1907 CHECK_SYMBOL (symbol, 1);
1908
1909 modifiers = 0;
1910 name = XSYMBOL (symbol)->name;
1911
1912 /* Special case for things with only one modifier, which is
1913 (hopefully) the vast majority of cases. */
1914 if (! (name->size >= 4 && name->data[1] == '-' && name->data[3] == '-'))
1915 return symbol;
1916
1917 for (i = 0; i + 1 < name->size && name->data[i + 1] == '-'; i += 2)
1918 switch (name->data[i])
1919 {
1920 case 'M':
1921 not_canonical |= (modifiers & (meta_modifier|ctrl_modifier
1922 |shift_modifier|up_modifier));
1923 modifiers |= meta_modifier;
1924 break;
1925
1926 case 'C':
1927 not_canonical |= (modifiers &
1928 (ctrl_modifier|shift_modifier|up_modifier));
1929 modifiers |= ctrl_modifier;
1930 break;
1931
1932 case 'S':
1933 not_canonical |= (modifiers & (shift_modifier|up_modifier));
1934 modifiers |= shift_modifier;
1935 break;
1936
1937 case 'U':
1938 not_canonical |= (modifiers & (up_modifier));
1939 modifiers |= up_modifier;
1940 break;
1941
1942 default:
1943 goto no_more_modifiers;
1944 }
1945 no_more_modifiers:
1946
1947 if (!not_canonical)
1948 return symbol;
1949
1950 /* The modifiers were out of order, so find a new symbol with the
1951 mods in order. Since the symbol name could contain nulls, we can't
1952 use intern here; we have to use Fintern, which expects a genuine
1953 Lisp_String, and keeps a reference to it. */
1954 {
1955 char *new_mods = (char *) alloca (sizeof ("C-M-S-U-"));
1956 int len = format_modifiers (modifiers, new_mods);
1957 Lisp_Object new_name = make_uninit_string (len + name->size - i);
1958
1959 bcopy (new_mods, XSTRING (new_name)->data, len);
1960 bcopy (name->data + i, XSTRING (new_name)->data + len, name->size - i);
1961
1962 return Fintern (new_name, Qnil);
1963 }
1964 }
1965
1966
1967 /* For handling events, we often want to produce a symbol whose name
1968 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
1969 to some base, like the name of a function key or mouse button.
1970 modify_event_symbol produces symbols of this sort.
1971
1972 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
1973 is the name of the i'th symbol. TABLE_SIZE is the number of elements
1974 in the table.
1975
1976 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
1977 persist between calls to modify_event_symbol that it can use to
1978 store a cache of the symbols it's generated for this NAME_TABLE
1979 before.
1980
1981 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
1982
1983 MODIFIERS is a set of modifier bits (as given in struct input_events)
1984 whose prefixes should be applied to the symbol name.
1985
1986 SYMBOL_KIND is the value to be placed in the event_kind property of
1987 the returned symbol. */
1988
1989 static Lisp_Object
1990 modify_event_symbol (symbol_num, modifiers, symbol_kind, name_table,
1991 symbol_table, table_size)
1992 int symbol_num;
1993 unsigned modifiers;
1994 Lisp_Object symbol_kind;
1995 char **name_table;
1996 Lisp_Object *symbol_table;
1997 int table_size;
1998 {
1999 Lisp_Object *slot, *unmodified_slot;
2000
2001 /* Is this a request for a valid symbol? */
2002 if (symbol_num < 0 || symbol_num >= table_size
2003 || modifiers >= NUM_MODIFIER_COMBOS)
2004 abort ();
2005
2006 /* If *symbol_table is not a vector of the appropriate size,
2007 set it to one. */
2008 if (XTYPE (*symbol_table) != Lisp_Vector
2009 || XVECTOR (*symbol_table)->size != table_size)
2010 *symbol_table = Fmake_vector (make_number (table_size), Qnil);
2011
2012 unmodified_slot = slot = & XVECTOR (*symbol_table)->contents[symbol_num];
2013
2014 /* If there are modifier keys, there had better be a vector in
2015 this symbol's position of the symbol_table. */
2016 if (modifiers != 0)
2017 {
2018 Lisp_Object slot_contents = *slot;
2019
2020 /* If there isn't the right sort of vector there, put one in. */
2021 if (XTYPE (slot_contents) != Lisp_Vector
2022 || XVECTOR (slot_contents)->size != NUM_MODIFIER_COMBOS)
2023 {
2024 *slot = Fmake_vector (make_number (NUM_MODIFIER_COMBOS), Qnil);
2025
2026 /* Make sure that the vector has an entry for the unmodified
2027 symbol, so we can put it on the event_unmodified property. */
2028 if (! NILP (slot_contents))
2029 XVECTOR (*slot)->contents[0] = slot_contents;
2030 else
2031 XVECTOR (*slot)->contents[0] = intern (name_table [symbol_num]);
2032 }
2033 }
2034
2035 /* If this entry has been filled in with a modified symbol vector,
2036 point to the appropriate slot within that. */
2037 if (XTYPE (*slot) == Lisp_Vector)
2038 {
2039 unmodified_slot = & XVECTOR (*slot)->contents[0];
2040 slot = & XVECTOR (*slot)->contents[modifiers];
2041 }
2042
2043 /* Make sure we have an unmodified version of the symbol in its
2044 proper place? */
2045 if (NILP (*unmodified_slot))
2046 {
2047 *unmodified_slot = intern (name_table [symbol_num]);
2048 Fput (*unmodified_slot, Qevent_kind, symbol_kind);
2049 Fput (*unmodified_slot, Qevent_unmodified, *unmodified_slot);
2050 }
2051
2052 /* Have we already created a symbol for this combination of modifiers? */
2053 if (NILP (*slot))
2054 {
2055 /* No, let's create one. */
2056 char *modified_name
2057 = (char *) alloca (sizeof ("C-M-S-U-")
2058 + strlen (name_table [symbol_num]));
2059
2060 strcpy (modified_name + format_modifiers (modifiers, modified_name),
2061 name_table [symbol_num]);
2062
2063 *slot = intern (modified_name);
2064 Fput (*slot, Qevent_kind, symbol_kind);
2065 Fput (*slot, Qevent_unmodified, *unmodified_slot);
2066 }
2067
2068 return *slot;
2069 }
2070 \f
2071 DEFUN ("mouse-click-p", Fmouse_click_p, Smouse_click_p, 1, 1, 0,
2072 "Return non-nil iff OBJECT is a representation of a mouse event.\n\
2073 A mouse event is a list of five elements whose car is a symbol of the\n\
2074 form <MODIFIERS>mouse-<DIGIT>. I hope this is a temporary hack.")
2075 (object)
2076 Lisp_Object object;
2077 {
2078 if (EVENT_HAS_PARAMETERS (object)
2079 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (object)),
2080 Qmouse_click))
2081 return Qt;
2082 else
2083 return Qnil;
2084 }
2085 \f
2086 /* Store into *addr a value nonzero if terminal input chars are available.
2087 Serves the purpose of ioctl (0, FIONREAD, addr)
2088 but works even if FIONREAD does not exist.
2089 (In fact, this may actually read some input.) */
2090
2091 static void
2092 get_input_pending (addr)
2093 int *addr;
2094 {
2095 /* First of all, have we already counted some input? */
2096 *addr = !NILP (Vquit_flag) || readable_events ();
2097
2098 /* If input is being read as it arrives, and we have none, there is none. */
2099 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
2100 return;
2101
2102 /* Try to read some input and see how much we get. */
2103 gobble_input (0);
2104 *addr = !NILP (Vquit_flag) || readable_events ();
2105 }
2106
2107 /* Interface to read_avail_input, blocking SIGIO if necessary. */
2108
2109 int
2110 gobble_input (expected)
2111 int expected;
2112 {
2113 #ifndef VMS
2114 #ifdef SIGIO
2115 if (interrupt_input)
2116 {
2117 SIGMASKTYPE mask;
2118 mask = sigblockx (SIGIO);
2119 read_avail_input (expected);
2120 sigsetmask (mask);
2121 }
2122 else
2123 #endif
2124 read_avail_input (expected);
2125 #endif
2126 }
2127 \f
2128 #ifndef VMS
2129
2130 /* Read any terminal input already buffered up by the system
2131 into the kbd_buffer, but do not wait.
2132
2133 EXPECTED should be nonzero if the caller knows there is some input.
2134
2135 Except on VMS, all input is read by this function.
2136 If interrupt_input is nonzero, this function MUST be called
2137 only when SIGIO is blocked.
2138
2139 Returns the number of keyboard chars read, or -1 meaning
2140 this is a bad time to try to read input. */
2141
2142 static int
2143 read_avail_input (expected)
2144 int expected;
2145 {
2146 struct input_event buf[KBD_BUFFER_SIZE];
2147 register int i;
2148 int nread;
2149
2150 if (read_socket_hook)
2151 /* No need for FIONREAD or fcntl; just say don't wait. */
2152 nread = (*read_socket_hook) (0, buf, KBD_BUFFER_SIZE, expected, expected);
2153 else
2154 {
2155 unsigned char cbuf[KBD_BUFFER_SIZE];
2156
2157 #ifdef FIONREAD
2158 /* Find out how much input is available. */
2159 if (ioctl (0, FIONREAD, &nread) < 0)
2160 /* Formerly simply reported no input, but that sometimes led to
2161 a failure of Emacs to terminate.
2162 SIGHUP seems appropriate if we can't reach the terminal. */
2163 kill (getpid (), SIGHUP);
2164 if (nread == 0)
2165 return 0;
2166 if (nread > sizeof cbuf)
2167 nread = sizeof cbuf;
2168 #else /* no FIONREAD */
2169 #ifdef USG
2170 /* Read some input if available, but don't wait. */
2171 nread = sizeof cbuf;
2172 fcntl (fileno (stdin), F_SETFL, O_NDELAY);
2173 #else
2174 you lose;
2175 #endif
2176 #endif
2177
2178 /* Now read; for one reason or another, this will not block. */
2179 while (1)
2180 {
2181 nread = read (fileno (stdin), cbuf, nread);
2182 #ifdef AIX
2183 /* The kernel sometimes fails to deliver SIGHUP for ptys.
2184 This looks incorrect, but it isn't, because _BSD causes
2185 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
2186 and that causes a value other than 0 when there is no input. */
2187 if (nread == 0)
2188 kill (SIGHUP, 0);
2189 #endif
2190 /* Retry the read if it is interrupted. */
2191 if (nread >= 0
2192 || ! (errno == EAGAIN || errno == EFAULT
2193 #ifdef EBADSLT
2194 || errno == EBADSLT
2195 #endif
2196 ))
2197 break;
2198 }
2199
2200 #ifndef FIONREAD
2201 #ifdef USG
2202 fcntl (fileno (stdin), F_SETFL, 0);
2203 #endif /* USG */
2204 #endif /* no FIONREAD */
2205 for (i = 0; i < nread; i++)
2206 {
2207 buf[i].kind = ascii_keystroke;
2208 XSET (buf[i].code, Lisp_Int, cbuf[i]);
2209 buf[i].screen = selected_screen;
2210 }
2211 }
2212
2213 /* Scan the chars for C-g and store them in kbd_buffer. */
2214 for (i = 0; i < nread; i++)
2215 {
2216 kbd_buffer_store_event (&buf[i]);
2217 /* Don't look at input that follows a C-g too closely.
2218 This reduces lossage due to autorepeat on C-g. */
2219 if (buf[i].kind == ascii_keystroke
2220 && XINT(buf[i].code) == quit_char)
2221 break;
2222 }
2223
2224 return nread;
2225 }
2226 #endif /* not VMS */
2227 \f
2228 #ifdef SIGIO /* for entire page */
2229 /* Note SIGIO has been undef'd if FIONREAD is missing. */
2230
2231 input_available_signal (signo)
2232 int signo;
2233 {
2234 /* Must preserve main program's value of errno. */
2235 int old_errno = errno;
2236 #ifdef BSD4_1
2237 extern int select_alarmed;
2238 #endif
2239
2240 #ifdef USG
2241 /* USG systems forget handlers when they are used;
2242 must reestablish each time */
2243 signal (signo, input_available_signal);
2244 #endif /* USG */
2245
2246 #ifdef BSD4_1
2247 sigisheld (SIGIO);
2248 #endif
2249
2250 if (input_available_clear_time)
2251 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
2252
2253 while (1)
2254 {
2255 int nread;
2256 nread = read_avail_input (1);
2257 /* -1 means it's not ok to read the input now.
2258 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
2259 0 means there was no keyboard input available. */
2260 if (nread <= 0)
2261 break;
2262
2263 #ifdef BSD4_1
2264 select_alarmed = 1; /* Force the select emulator back to life */
2265 #endif
2266 }
2267
2268 #ifdef BSD4_1
2269 sigfree ();
2270 #endif
2271 errno = old_errno;
2272 }
2273 #endif /* SIGIO */
2274 \f
2275 /* Return the prompt-string of a sparse keymap.
2276 This is the first element which is a string.
2277 Return nil if there is none. */
2278
2279 Lisp_Object
2280 map_prompt (map)
2281 Lisp_Object map;
2282 {
2283 while (CONSP (map))
2284 {
2285 register Lisp_Object tem;
2286 tem = Fcar (map);
2287 if (XTYPE (tem) == Lisp_String)
2288 return tem;
2289 map = Fcdr (map);
2290 }
2291 return Qnil;
2292 }
2293
2294 static int echo_flag;
2295 static int echo_now;
2296
2297 /* Read a character like read_char but optionally prompt based on maps
2298 LOCAL and GLOBAL.
2299
2300 The prompting is done based on the prompt-string of the map
2301 and the strings associated with various map elements. */
2302
2303 Lisp_Object
2304 read_char_menu_prompt (prompt, local, global)
2305 int prompt;
2306 Lisp_Object local, global;
2307 {
2308 register Lisp_Object rest, name;
2309 Lisp_Object hmap;
2310 int nlength;
2311 int width = SCREEN_WIDTH (selected_screen) - 4;
2312 char *menu = (char *) alloca (width);
2313
2314 /* Use local over global Menu maps */
2315
2316 if (menu_prompting)
2317 return read_char (!prompt);
2318
2319 /* We can't get prompt strings from dense keymaps. */
2320 if (CONSP (local)
2321 && EQ (Fcar (local), Qkeymap)
2322 && !(CONSP (XCONS (local)->cdr)
2323 && XTYPE (XCONS (XCONS (local)->cdr)->car) == Lisp_Vector))
2324 hmap = local;
2325 else if (CONSP (global)
2326 && EQ (Fcar (global), Qkeymap)
2327 && !(CONSP (XCONS (global)->cdr)
2328 && XTYPE (XCONS (XCONS (global)->cdr)->car) == Lisp_Vector))
2329 hmap = global;
2330 else
2331 return read_char (!prompt);
2332
2333 /* Get the map's prompt string. */
2334 name = map_prompt (hmap);
2335 if (NILP (name))
2336 return read_char (!prompt);
2337
2338 /* Prompt string always starts with map's prompt, and a space. */
2339 strcpy (menu, XSTRING (name)->data);
2340 nlength = XSTRING (name)->size;
2341 menu[nlength++] = ' ';
2342 menu[nlength] = 0;
2343
2344 /* Start prompting at start of map. */
2345 rest = hmap; /* Current menu item */
2346
2347 /* Present the documented bindings, a line at a time. */
2348 while (1)
2349 {
2350 int notfirst = 0;
2351 int i = nlength;
2352 Lisp_Object obj;
2353 int ch;
2354
2355 /* If reached end of map, start at beginning. */
2356 if (NILP (Fcdr (rest))) rest = hmap;
2357
2358 /* Loop over elements of map. */
2359 while (!NILP (rest) && i < width)
2360 {
2361 Lisp_Object s;
2362
2363 /* Look for conses whose cadrs are strings. */
2364 s = Fcar_safe (Fcdr_safe (Fcar_safe (rest)));
2365 if (XTYPE (s) != Lisp_String)
2366 /* Ignore all other elements. */
2367 ;
2368 /* If first such element, or enough room, add string to prompt. */
2369 else if (XSTRING (s)->size + i < width
2370 || !notfirst)
2371 {
2372 int thiswidth;
2373
2374 /* Punctuate between strings. */
2375 if (notfirst)
2376 {
2377 strcpy (menu + i, ", ");
2378 i += 2;
2379 }
2380 notfirst = 1;
2381
2382 /* Add as much of string as fits. */
2383 thiswidth = XSTRING (s)->size;
2384 if (thiswidth + i > width)
2385 thiswidth = width - i;
2386 bcopy (XSTRING (s)->data, menu + i, thiswidth);
2387 i += thiswidth;
2388 }
2389 else
2390 {
2391 /* If some elts don't fit, show there are more. */
2392 strcpy (menu + i, "...");
2393 break;
2394 }
2395
2396 /* Move past this element. */
2397 rest = Fcdr_safe (rest);
2398 }
2399
2400 /* Prompt with that and read response. */
2401 message1 (menu);
2402 obj = read_char (1);
2403
2404 if (XTYPE (obj) != Lisp_Int)
2405 return obj;
2406 else
2407 ch = XINT (obj);
2408
2409 if (obj != menu_prompt_more_char
2410 && (XTYPE (menu_prompt_more_char) != Lisp_Int
2411 || obj != make_number (Ctl (XINT (menu_prompt_more_char)))))
2412 return obj;
2413 }
2414 }
2415
2416 \f
2417 /* Reading key sequences. */
2418
2419 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
2420 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
2421 keymap, or nil otherwise. Return the index of the first keymap in
2422 which KEY has any binding, or NMAPS if no map has a binding.
2423
2424 If KEY is a meta ASCII character, treat it like meta-prefix-char
2425 followed by the corresponding non-meta character. Keymaps in
2426 CURRENT with non-prefix bindings for meta-prefix-char become nil in
2427 NEXT.
2428
2429 When KEY is not defined in any of the keymaps, if it is an upper
2430 case letter and there are bindings for the corresponding lower-case
2431 letter, return the bindings for the lower-case letter.
2432
2433 NEXT may == CURRENT. */
2434
2435 static int
2436 follow_key (key, nmaps, current, defs, next)
2437 Lisp_Object key;
2438 Lisp_Object *current, *defs, *next;
2439 int nmaps;
2440 {
2441 int i, first_binding;
2442
2443 /* If KEY is a meta ASCII character, treat it like meta-prefix-char
2444 followed by the corresponding non-meta character. */
2445 if (XTYPE (key) == Lisp_Int
2446 && XINT (key) >= 0200)
2447 {
2448 for (i = 0; i < nmaps; i++)
2449 if (! NILP (current[i]))
2450 {
2451 next[i] = get_keyelt (access_keymap (current[i],
2452 meta_prefix_char));
2453
2454 /* Note that since we pass the resulting bindings through
2455 get_keymap_1, non-prefix bindings for meta-prefix-char
2456 disappear. */
2457 next[i] = get_keymap_1 (next[i], 0);
2458 }
2459 else
2460 next[i] = Qnil;
2461
2462 current = next;
2463 XSET (key, Lisp_Int, XFASTINT (key) & 0177);
2464 }
2465
2466 first_binding = nmaps;
2467 for (i = nmaps - 1; i >= 0; i--)
2468 {
2469 if (! NILP (current[i]))
2470 {
2471 defs[i] = get_keyelt (access_keymap (current[i], key));
2472 if (! NILP (defs[i]))
2473 first_binding = i;
2474 }
2475 else
2476 defs[i] = Qnil;
2477 }
2478
2479 /* When KEY is not defined in any of the keymaps, if it is an upper
2480 case letter and there are bindings for the corresponding
2481 lower-case letter, return the bindings for the lower-case letter. */
2482 if (first_binding == nmaps
2483 && XTYPE (key) == Lisp_Int
2484 && UPPERCASEP (XINT (key)))
2485 {
2486 XSETINT (key, DOWNCASE (XINT (key)));
2487
2488 first_binding = nmaps;
2489 for (i = nmaps - 1; i >= 0; i--)
2490 {
2491 if (! NILP (current[i]))
2492 {
2493 defs[i] = get_keyelt (access_keymap (current[i], key));
2494 if (! NILP (defs[i]))
2495 first_binding = i;
2496 }
2497 else
2498 defs[i] = Qnil;
2499 }
2500 }
2501
2502 /* Given the set of bindings we've found, produce the next set of maps. */
2503 for (i = 0; i < nmaps; i++)
2504 next[i] = NILP (defs[i]) ? Qnil : get_keymap_1 (defs[i], 0);
2505
2506 return first_binding;
2507 }
2508
2509 /* Read a sequence of keys that ends with a non prefix character
2510 according to the keymaps in KEYMAPS[0..nmaps-1]. Keymaps appearing
2511 earlier in KEYMAPS take precidence over those appearing later.
2512
2513 Store the sequence in KEYBUF, a buffer of size BUFSIZE. Prompt
2514 with PROMPT. Echo starting immediately unless `prompt' is 0.
2515 Return the length of the key sequence stored.
2516
2517 If the user switches screens in the midst of a key sequence, we
2518 throw away any prefix we have read so far, and start afresh. For
2519 mouse clicks, we look up the click in the keymap of the buffer
2520 clicked on, throwing away any prefix if it is not the same buffer
2521 we used to be reading from. */
2522
2523 static int
2524 read_key_sequence (keybuf, bufsize, prompt)
2525 Lisp_Object *keybuf;
2526 int bufsize;
2527 Lisp_Object prompt;
2528 {
2529 /* How many keys there are in the current key sequence. */
2530 int t;
2531
2532 /* The buffer that the most recently read event was typed at. This
2533 helps us read mouse clicks according to the buffer clicked in,
2534 and notice when the mouse has moved from one screen to another. */
2535 struct buffer *last_event_buffer = current_buffer;
2536
2537 /* The length of the echo buffer when we started reading, and
2538 the length of this_command_keys when we started reading. */
2539 int echo_start;
2540 int keys_start = this_command_key_count;
2541
2542 /* The number of keymaps we're scanning right now, and the number of
2543 keymaps we have allocated space for. */
2544 int nmaps;
2545 int nmaps_allocated = 0;
2546
2547 /* current[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
2548 in the current keymaps, or nil where it is not a prefix. */
2549 Lisp_Object *current;
2550
2551 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
2552 the current keymaps. */
2553 Lisp_Object *defs;
2554
2555 /* The lowest i such that defs[i] is non-nil. */
2556 int first_binding;
2557
2558 /* If mock_input > t, then KEYBUF[t] should be read as the next
2559 input key. */
2560 int mock_input = 0;
2561
2562 /* If the sequence is unbound in current[], keymap[fkey_start..fkey_end-1]
2563 is a prefix in Vfunction_key_map, and fkey_map is its binding.
2564 These might be > t, indicating that all function key scanning should
2565 hold off until t reaches them. */
2566 int fkey_start = 0, fkey_end = 0;
2567 Lisp_Object fkey_map = Vfunction_key_map;
2568
2569 if (INTERACTIVE)
2570 {
2571 if (prompt)
2572 echo_prompt (prompt);
2573 else if (cursor_in_echo_area)
2574 /* This doesn't put in a dash if the echo buffer is empty, so
2575 you don't always see a dash hanging out in the minibuffer. */
2576 echo_dash ();
2577 echo_start = echo_length ();
2578 }
2579
2580 /* If there is no function key map, turn of function key scanning. */
2581 if (NILP (Fkeymapp (Vfunction_key_map)))
2582 fkey_start = fkey_end = bufsize + 1;
2583
2584 restart:
2585 t = 0;
2586 this_command_key_count = keys_start;
2587
2588 {
2589 Lisp_Object *maps;
2590
2591 nmaps = current_minor_maps (0, &maps) + 2;
2592 if (nmaps > nmaps_allocated)
2593 {
2594 current = (Lisp_Object *) alloca (nmaps * sizeof (current[0]));
2595 defs = (Lisp_Object *) alloca (nmaps * sizeof (defs[0]));
2596 nmaps_allocated = nmaps;
2597 }
2598 bcopy (maps, current, (nmaps - 2) * sizeof (current[0]));
2599 current[nmaps-2] = last_event_buffer->keymap;
2600 current[nmaps-1] = global_map;
2601 }
2602
2603 /* Find an accurate initial value for first_binding. */
2604 for (first_binding = 0; first_binding < nmaps; first_binding++)
2605 if (! NILP (current[first_binding]))
2606 break;
2607
2608 while ((first_binding < nmaps && ! NILP (current[first_binding]))
2609 || (first_binding >= nmaps && fkey_start < t))
2610 {
2611 Lisp_Object key;
2612
2613 if (t >= bufsize)
2614 error ("key sequence too long");
2615
2616 /* Are we reading keys stuffed into keybuf? */
2617 if (t < mock_input)
2618 {
2619 key = keybuf[t];
2620 add_command_key (key);
2621 echo_char (key);
2622 }
2623 /* Otherwise, we should actually read a character. */
2624 else
2625 {
2626 struct buffer *buf;
2627
2628 if (!prompt && INTERACTIVE)
2629 key = read_char_menu_prompt (prompt, Qnil, Qnil);
2630 else
2631 key = read_char (!prompt);
2632
2633 /* The above routines return -1 at the end of a macro.
2634 Emacs 18 handles this by returning immediately with a
2635 zero, so that's what we'll do. */
2636 if (XTYPE (key) == Lisp_Int && XINT (key) < 0)
2637 return 0;
2638
2639 Vquit_flag = Qnil;
2640
2641 /* What buffer was this event typed/moused at? */
2642 if (XTYPE (key) == Lisp_Int || XTYPE (key) == Lisp_Symbol)
2643 buf = (XBUFFER
2644 (XWINDOW
2645 (SCREEN_SELECTED_WINDOW
2646 (XSCREEN (Vlast_event_screen)))->buffer));
2647 else if (EVENT_HAS_PARAMETERS (key))
2648 {
2649 Lisp_Object window = EVENT_WINDOW (key);
2650
2651 if (NILP (window))
2652 abort ();
2653
2654 buf = XBUFFER (XWINDOW (window)->buffer);
2655 }
2656 else
2657 abort ();
2658
2659 /* If this event came to a different buffer than the one
2660 we're currently in, switch buffers and start a new key
2661 sequence, starting with key. */
2662 if (buf != last_event_buffer)
2663 {
2664 last_event_buffer = buf;
2665 Fselect_screen (Vlast_event_screen, Qnil);
2666
2667 /* Arrange to read key as the next event. */
2668 keybuf[0] = key;
2669 mock_input = 1;
2670
2671 /* Truncate the key sequence in the echo area. */
2672 if (INTERACTIVE)
2673 echo_truncate (echo_start);
2674
2675 goto restart;
2676 }
2677 }
2678
2679 first_binding = (follow_key (key,
2680 nmaps - first_binding,
2681 current + first_binding,
2682 defs + first_binding,
2683 current + first_binding)
2684 + first_binding);
2685 keybuf[t++] = key;
2686
2687 /* If the sequence is unbound, see if we can hang a function key
2688 off the end of it. Don't reread the expansion of a function key. */
2689 if (first_binding >= nmaps
2690 && t > mock_input)
2691 {
2692 Lisp_Object fkey_next;
2693
2694 /* Scan from fkey_end until we find a bound suffix. */
2695 while (fkey_end < t)
2696 {
2697 fkey_next =
2698 get_keyelt (access_keymap (fkey_map, keybuf[fkey_end++]));
2699 /* If keybuf[fkey_start..fkey_next] is bound in the
2700 function key map and it's a suffix of the current
2701 sequence (i.e. fkey_next == t), replace it with
2702 the binding and restart with fkey_start at the end. */
2703 if (XTYPE (fkey_next) == Lisp_Vector
2704 && fkey_end == t)
2705 {
2706 t = fkey_start + XVECTOR (fkey_next)->size;
2707 if (t >= bufsize)
2708 error ("key sequence too long");
2709
2710 bcopy (XVECTOR (fkey_next)->contents,
2711 keybuf + fkey_start,
2712 (t - fkey_start) * sizeof (keybuf[0]));
2713
2714 mock_input = t;
2715 fkey_start = fkey_end = t;
2716
2717 /* Truncate the key sequence in the echo area. */
2718 if (INTERACTIVE)
2719 echo_truncate (echo_start);
2720
2721 goto restart;
2722 }
2723
2724 fkey_map = get_keymap_1 (fkey_next, 0);
2725
2726 /* If we no longer have a bound suffix, try a new positions for
2727 fkey_start. */
2728 if (NILP (fkey_map))
2729 {
2730 fkey_end = ++fkey_start;
2731 fkey_map = Vfunction_key_map;
2732 }
2733 }
2734 }
2735 }
2736
2737 read_key_sequence_cmd = (first_binding < nmaps
2738 ? defs[first_binding]
2739 : Qnil);
2740
2741 return t;
2742 }
2743
2744 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 2, 0,
2745 "Read a sequence of keystrokes and return as a string or vector.\n\
2746 The sequence is sufficient to specify a non-prefix command in the\n\
2747 current local and global maps.\n\
2748 \n\
2749 First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
2750 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\
2751 as a continuation of the previous key.\n\
2752 \n\
2753 If Emacs is running on multiple screens, switching between screens in\n\
2754 the midst of a keystroke will toss any prefix typed so far. A C-g\n\
2755 typed while in this function is treated like any other character, and\n\
2756 `quit-flag' is not set.")
2757 (prompt, continue_echo)
2758 Lisp_Object prompt, continue_echo;
2759 {
2760 Lisp_Object keybuf[30];
2761 register int i;
2762 struct gcpro gcpro1, gcpro2;
2763
2764 if (!NILP (prompt))
2765 CHECK_STRING (prompt, 0);
2766 QUIT;
2767
2768 bzero (keybuf, sizeof keybuf);
2769 GCPRO1 (keybuf[0]);
2770 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
2771
2772 if (NILP (continue_echo))
2773 this_command_key_count = 0;
2774
2775 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
2776 NILP (prompt) ? 0 : XSTRING (prompt)->data);
2777
2778 UNGCPRO;
2779 return make_array (i, keybuf);
2780 }
2781 \f
2782 DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 2, 0,
2783 "Execute CMD as an editor command.\n\
2784 CMD must be a symbol that satisfies the `commandp' predicate.\n\
2785 Optional second arg RECORD-FLAG non-nil\n\
2786 means unconditionally put this command in `command-history'.\n\
2787 Otherwise, that is done only if an arg is read using the minibuffer.")
2788 (cmd, record)
2789 Lisp_Object cmd, record;
2790 {
2791 register Lisp_Object final;
2792 register Lisp_Object tem;
2793 Lisp_Object prefixarg;
2794 struct backtrace backtrace;
2795 extern int debug_on_next_call;
2796
2797 prefixarg = Vprefix_arg, Vprefix_arg = Qnil;
2798 Vcurrent_prefix_arg = prefixarg;
2799 debug_on_next_call = 0;
2800
2801 if (XTYPE (cmd) == Lisp_Symbol)
2802 {
2803 tem = Fget (cmd, Qdisabled);
2804 if (!NILP (tem))
2805 return call1 (Vrun_hooks, Vdisabled_command_hook);
2806 }
2807
2808 while (1)
2809 {
2810 final = Findirect_function (cmd);
2811
2812 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
2813 do_autoload (final, cmd);
2814 else
2815 break;
2816 }
2817
2818 if (XTYPE (final) == Lisp_String
2819 || XTYPE (final) == Lisp_Vector)
2820 {
2821 /* If requested, place the macro in the command history. For
2822 other sorts of commands, call-interactively takes care of
2823 this. */
2824 if (!NILP (record))
2825 Vcommand_history
2826 = Fcons (Fcons (Qexecute_kbd_macro,
2827 Fcons (final, Fcons (prefixarg, Qnil))),
2828 Vcommand_history);
2829
2830 return Fexecute_kbd_macro (final, prefixarg);
2831 }
2832 if (CONSP (final) || XTYPE (final) == Lisp_Subr
2833 || XTYPE (final) == Lisp_Compiled)
2834 {
2835 backtrace.next = backtrace_list;
2836 backtrace_list = &backtrace;
2837 backtrace.function = &Qcall_interactively;
2838 backtrace.args = &cmd;
2839 backtrace.nargs = 1;
2840 backtrace.evalargs = 0;
2841
2842 tem = Fcall_interactively (cmd, record);
2843
2844 backtrace_list = backtrace.next;
2845 return tem;
2846 }
2847 return Qnil;
2848 }
2849 \f
2850 #if 0
2851 DEFUN ("execute-mouse-event", Fexecute_mouse_event, Sexecute_mouse_event,
2852 1, 1, 0,
2853 "Execute the definition of the mouse-click event EVENT.\n\
2854 The handler function is found by looking the event's key sequence up\n\
2855 in the buffer's local mouse map and in `global-mouse-map'.\n\
2856 \n\
2857 After running the handler, call the value of `mouse-event-function'\n\
2858 with EVENT as arg.")
2859 (event)
2860 Lisp_Object event;
2861 {
2862 Lisp_Object tem;
2863 Lisp_Object mouse_cmd;
2864 Lisp_Object keyseq, window, screen_part, pos, time;
2865
2866 #ifndef HAVE_X11
2867 Vmouse_event = event;
2868 #endif
2869
2870 if (EQ (event, Qnil))
2871 {
2872 bitch_at_user ();
2873 return Qnil;
2874 }
2875
2876 CHECK_CONS (event, 0);
2877 pos = Fcar (event);
2878 window = Fcar (Fcdr (event));
2879 screen_part = Fcar (Fcdr (Fcdr (event)));
2880 keyseq = Fcar (Fcdr (Fcdr (Fcdr (event))));
2881 time = Fcar (Fcdr (Fcdr (Fcdr (Fcdr (event)))));
2882 CHECK_STRING (keyseq, 0);
2883 CHECK_WINDOW (window, 0);
2884
2885 /* Look up KEYSEQ in the buffer's local mouse map, then in global one. */
2886
2887 mouse_cmd = Qnil;
2888
2889 if (!NILP (XWINDOW (window)->buffer))
2890 {
2891 Lisp_Object local_map;
2892
2893 local_map = XBUFFER (XWINDOW (window)->buffer)->mouse_map;
2894 tem = Fkeymapp (local_map);
2895 if (!NILP (tem))
2896 mouse_cmd = Flookup_key (local_map, keyseq);
2897 /* A number as value means the key is too long; treat as undefined. */
2898 if (XTYPE (mouse_cmd) == Lisp_Int)
2899 mouse_cmd = Qnil;
2900 }
2901
2902 tem = Fkeymapp (Vglobal_mouse_map);
2903 if (NILP (mouse_cmd) && !NILP (tem))
2904 mouse_cmd = Flookup_key (Vglobal_mouse_map, keyseq);
2905 if (XTYPE (mouse_cmd) == Lisp_Int)
2906 mouse_cmd = Qnil;
2907
2908 if (NILP (mouse_cmd))
2909 {
2910 /* This button/shift combination is not defined.
2911 If it is a button-down event, ring the bell. */
2912 #ifdef HAVE_X11
2913 if (XSTRING (keyseq)->data[XSTRING (keyseq)->size - 1] & 0x18 == 0)
2914 #else
2915 if (XSTRING (keyseq)->data[XSTRING (keyseq)->size - 1] & 4 == 0)
2916 #endif
2917 bitch_at_user ();
2918 }
2919 else
2920 {
2921 SCREEN_PTR s = XSCREEN (WINDOW_SCREEN (XWINDOW (window)));
2922
2923 #ifndef HAVE_X11
2924 Vmouse_window = s->selected_window;
2925 #endif /* HAVE_X11 */
2926 /* It's defined; call the definition. */
2927 Vprefix_arg = Qnil;
2928 if (!NILP (screen_part))
2929 {
2930 /* For a scroll-bar click, set the prefix arg
2931 to the number of lines down from the top the click was.
2932 Many scroll commands want to scroll by this many lines. */
2933 Lisp_Object position;
2934 Lisp_Object length;
2935 Lisp_Object offset;
2936
2937 position = Fcar (pos);
2938 length = Fcar (Fcdr (pos));
2939 offset = Fcar (Fcdr (Fcdr (pos)));
2940
2941 if (XINT (length) != 0)
2942 XSET (Vprefix_arg, Lisp_Int,
2943 (SCREEN_HEIGHT (s) * (XINT (position) + XINT (offset))
2944 / (XINT (length) + 2 * XINT (offset))));
2945 }
2946 Fcommand_execute (mouse_cmd, Qnil);
2947 }
2948
2949 if (!NILP (Vmouse_event_function)) /* Not `event' so no need for GCPRO */
2950 call1 (Vmouse_event_function, Vmouse_event);
2951 return Qnil;
2952 }
2953 #endif
2954 \f
2955 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
2956 1, 1, "P",
2957 "Read function name, then read its arguments and call it.")
2958 (prefixarg)
2959 Lisp_Object prefixarg;
2960 {
2961 Lisp_Object function;
2962 char buf[40];
2963 Lisp_Object saved_keys;
2964 struct gcpro gcpro1;
2965
2966 saved_keys = Fthis_command_keys ();
2967 buf[0] = 0;
2968 GCPRO1 (saved_keys);
2969
2970 if (EQ (prefixarg, Qminus))
2971 strcpy (buf, "- ");
2972 else if (CONSP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4)
2973 strcpy (buf, "C-u ");
2974 else if (CONSP (prefixarg) && XTYPE (XCONS (prefixarg)->car) == Lisp_Int)
2975 sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car));
2976 else if (XTYPE (prefixarg) == Lisp_Int)
2977 sprintf (buf, "%d ", XINT (prefixarg));
2978
2979 /* This isn't strictly correct if execute-extended-command
2980 is bound to anything else. Perhaps it should use
2981 this_command_keys? */
2982 strcat (buf, "M-x ");
2983
2984 /* Prompt with buf, and then read a string, completing from and
2985 restricting to the set of all defined commands. Don't provide
2986 any initial input. The last Qnil says not to perform a
2987 peculiar hack on the initial input. */
2988 function = Fcompleting_read (build_string (buf),
2989 Vobarray, Qcommandp,
2990 Qt, Qnil, Qnil);
2991
2992 /* Set this_command_keys to the concatenation of saved_keys and
2993 function, followed by a RET. */
2994 {
2995 struct Lisp_String *str;
2996 int i;
2997 Lisp_Object tem;
2998
2999 this_command_key_count = 0;
3000
3001 str = XSTRING (saved_keys);
3002 for (i = 0; i < str->size; i++)
3003 {
3004 XFASTINT (tem) = str->data[i];
3005 add_command_key (tem);
3006 }
3007
3008 str = XSTRING (function);
3009 for (i = 0; i < str->size; i++)
3010 {
3011 XFASTINT (tem) = str->data[i];
3012 add_command_key (tem);
3013 }
3014
3015 XFASTINT (tem) = '\015';
3016 add_command_key (tem);
3017 }
3018
3019 UNGCPRO;
3020
3021 function = Fintern (function, Vobarray);
3022 Vprefix_arg = prefixarg;
3023 this_command = function;
3024
3025 return Fcommand_execute (function, Qt);
3026 }
3027 \f
3028
3029 detect_input_pending ()
3030 {
3031 if (!input_pending)
3032 get_input_pending (&input_pending);
3033
3034 return input_pending;
3035 }
3036
3037 /* This is called in some cases before a possible quit.
3038 It cases the next call to detect_input_pending to recompute input_pending.
3039 So calling this function unnecessarily can't do any harm. */
3040 clear_input_pending ()
3041 {
3042 input_pending = 0;
3043 }
3044
3045 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
3046 "T if command input is currently available with no waiting.\n\
3047 Actually, the value is nil only if we can be sure that no input is available.")
3048 ()
3049 {
3050 if (!NILP (unread_command_char))
3051 return (Qt);
3052
3053 return detect_input_pending () ? Qt : Qnil;
3054 }
3055
3056 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
3057 "Return vector of last 100 chars read from terminal.")
3058 ()
3059 {
3060 Lisp_Object val;
3061
3062 if (total_keys < NUM_RECENT_KEYS)
3063 return Fvector (total_keys, recent_keys);
3064 else
3065 {
3066 val = Fvector (NUM_RECENT_KEYS, recent_keys);
3067 bcopy (recent_keys + recent_keys_index,
3068 XVECTOR (val)->contents,
3069 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
3070 bcopy (recent_keys,
3071 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
3072 recent_keys_index * sizeof (Lisp_Object));
3073 return val;
3074 }
3075 }
3076
3077 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
3078 "Return string of the keystrokes that invoked this command.")
3079 ()
3080 {
3081 return make_array (this_command_key_count, this_command_keys);
3082 }
3083
3084 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
3085 "Return the current depth in recursive edits.")
3086 ()
3087 {
3088 Lisp_Object temp;
3089 XFASTINT (temp) = command_loop_level + minibuf_level;
3090 return temp;
3091 }
3092
3093 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
3094 "FOpen dribble file: ",
3095 "Start writing all keyboard characters to FILE.")
3096 (file)
3097 Lisp_Object file;
3098 {
3099 if (NILP (file))
3100 {
3101 fclose (dribble);
3102 dribble = 0;
3103 }
3104 else
3105 {
3106 file = Fexpand_file_name (file, Qnil);
3107 dribble = fopen (XSTRING (file)->data, "w");
3108 }
3109 return Qnil;
3110 }
3111
3112 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
3113 "Discard the contents of the terminal input buffer.\n\
3114 Also cancel any kbd macro being defined.")
3115 ()
3116 {
3117 defining_kbd_macro = 0;
3118 update_mode_lines++;
3119
3120 #if 0
3121 unread_command_char = make_number (-1);
3122 #endif
3123 unread_command_char = Qnil;
3124
3125 discard_tty_input ();
3126
3127 kbd_fetch_ptr = kbd_store_ptr;
3128 input_pending = 0;
3129
3130 return Qnil;
3131 }
3132 \f
3133 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
3134 "Stop Emacs and return to superior process. You can resume later.\n\
3135 On systems that don't have job control, run a subshell instead.\n\n\
3136 If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
3137 to be read as terminal input by Emacs's superior shell.\n\
3138 Before suspending, if `suspend-hook' is bound and value is non-nil\n\
3139 call the value as a function of no args. Don't suspend if it returns non-nil.\n\
3140 Otherwise, suspend normally and after resumption call\n\
3141 `suspend-resume-hook' if that is bound and non-nil.\n\
3142 \n\
3143 Some operating systems cannot stop the Emacs process and resume it later.\n\
3144 On such systems, Emacs will start a subshell and wait for it to exit.")
3145 (stuffstring)
3146 Lisp_Object stuffstring;
3147 {
3148 register Lisp_Object tem;
3149 int count = specpdl_ptr - specpdl;
3150 int old_height, old_width;
3151 int width, height;
3152 struct gcpro gcpro1;
3153 extern init_sys_modes ();
3154
3155 if (!NILP (stuffstring))
3156 CHECK_STRING (stuffstring, 0);
3157 GCPRO1 (stuffstring);
3158
3159 /* Call value of suspend-hook
3160 if it is bound and value is non-nil. */
3161 if (!NILP (Vrun_hooks))
3162 {
3163 tem = call1 (Vrun_hooks, intern ("suspend-hook"));
3164 if (!EQ (tem, Qnil)) return Qnil;
3165 }
3166
3167 get_screen_size (&old_width, &old_height);
3168 reset_sys_modes ();
3169 /* sys_suspend can get an error if it tries to fork a subshell
3170 and the system resources aren't available for that. */
3171 record_unwind_protect (init_sys_modes, 0);
3172 stuff_buffered_input (stuffstring);
3173 sys_suspend ();
3174 unbind_to (count, Qnil);
3175
3176 /* Check if terminal/window size has changed.
3177 Note that this is not useful when we are running directly
3178 with a window system; but suspend should be disabled in that case. */
3179 get_screen_size (&width, &height);
3180 if (width != old_width || height != old_height)
3181 change_screen_size (height, width, 0);
3182
3183 /* Call value of suspend-resume-hook
3184 if it is bound and value is non-nil. */
3185 if (!NILP (Vrun_hooks))
3186 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
3187
3188 UNGCPRO;
3189 return Qnil;
3190 }
3191
3192 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
3193 Then in any case stuff anthing Emacs has read ahead and not used. */
3194
3195 stuff_buffered_input (stuffstring)
3196 Lisp_Object stuffstring;
3197 {
3198 register unsigned char *p;
3199
3200 /* stuff_char works only in BSD, versions 4.2 and up. */
3201 #ifdef BSD
3202 #ifndef BSD4_1
3203 if (XTYPE (stuffstring) == Lisp_String)
3204 {
3205 register int count;
3206
3207 p = XSTRING (stuffstring)->data;
3208 count = XSTRING (stuffstring)->size;
3209 while (count-- > 0)
3210 stuff_char (*p++);
3211 stuff_char ('\n');
3212 }
3213 /* Anything we have read ahead, put back for the shell to read. */
3214 while (kbd_fetch_ptr != kbd_store_ptr)
3215 {
3216 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
3217 kbd_fetch_ptr = kbd_buffer;
3218 if (kbd_fetch_ptr->kind == ascii_keystroke)
3219 stuff_char (XINT (kbd_fetch_ptr->code));
3220 kbd_fetch_ptr++;
3221 }
3222 input_pending = 0;
3223 #endif
3224 #endif /* BSD and not BSD4_1 */
3225 }
3226 \f
3227 set_waiting_for_input (time_to_clear)
3228 EMACS_TIME *time_to_clear;
3229 {
3230 input_available_clear_time = time_to_clear;
3231
3232 /* Tell interrupt_signal to throw back to read_char, */
3233 waiting_for_input = 1;
3234
3235 /* If interrupt_signal was called before and buffered a C-g,
3236 make it run again now, to avoid timing error. */
3237 if (!NILP (Vquit_flag))
3238 quit_throw_to_read_char ();
3239
3240 /* If alarm has gone off already, echo now. */
3241 if (echo_flag)
3242 {
3243 echo ();
3244 echo_flag = 0;
3245 }
3246 }
3247
3248 clear_waiting_for_input ()
3249 {
3250 /* Tell interrupt_signal not to throw back to read_char, */
3251 waiting_for_input = 0;
3252 input_available_clear_time = 0;
3253 }
3254
3255 /* This routine is called at interrupt level in response to C-G.
3256 If interrupt_input, this is the handler for SIGINT.
3257 Otherwise, it is called from kbd_buffer_store_event,
3258 in handling SIGIO or SIGTINT.
3259
3260 If `waiting_for_input' is non zero, then unless `echoing' is nonzero,
3261 immediately throw back to read_char.
3262
3263 Otherwise it sets the Lisp variable quit-flag not-nil.
3264 This causes eval to throw, when it gets a chance.
3265 If quit-flag is already non-nil, it stops the job right away. */
3266
3267 SIGTYPE
3268 interrupt_signal ()
3269 {
3270 char c;
3271 /* Must preserve main program's value of errno. */
3272 int old_errno = errno;
3273 extern Lisp_Object Vwindow_system;
3274
3275 #ifdef USG
3276 /* USG systems forget handlers when they are used;
3277 must reestablish each time */
3278 signal (SIGINT, interrupt_signal);
3279 signal (SIGQUIT, interrupt_signal);
3280 #endif /* USG */
3281
3282 cancel_echoing ();
3283
3284 if (!NILP (Vquit_flag) && SCREEN_IS_TERMCAP (selected_screen))
3285 {
3286 fflush (stdout);
3287 reset_sys_modes ();
3288 sigfree ();
3289 #ifdef SIGTSTP /* Support possible in later USG versions */
3290 /*
3291 * On systems which can suspend the current process and return to the original
3292 * shell, this command causes the user to end up back at the shell.
3293 * The "Auto-save" and "Abort" questions are not asked until
3294 * the user elects to return to emacs, at which point he can save the current
3295 * job and either dump core or continue.
3296 */
3297 sys_suspend ();
3298 #else
3299 #ifdef VMS
3300 if (sys_suspend () == -1)
3301 {
3302 printf ("Not running as a subprocess;\n");
3303 printf ("you can continue or abort.\n");
3304 }
3305 #else /* not VMS */
3306 /* Perhaps should really fork an inferior shell?
3307 But that would not provide any way to get back
3308 to the original shell, ever. */
3309 printf ("No support for stopping a process on this operating system;\n");
3310 printf ("you can continue or abort.\n");
3311 #endif /* not VMS */
3312 #endif /* not SIGTSTP */
3313 printf ("Auto-save? (y or n) ");
3314 fflush (stdout);
3315 if (((c = getchar ()) & ~040) == 'Y')
3316 Fdo_auto_save (Qnil, Qnil);
3317 while (c != '\n') c = getchar ();
3318 #ifdef VMS
3319 printf ("Abort (and enter debugger)? (y or n) ");
3320 #else /* not VMS */
3321 printf ("Abort (and dump core)? (y or n) ");
3322 #endif /* not VMS */
3323 fflush (stdout);
3324 if (((c = getchar ()) & ~040) == 'Y')
3325 abort ();
3326 while (c != '\n') c = getchar ();
3327 printf ("Continuing...\n");
3328 fflush (stdout);
3329 init_sys_modes ();
3330 }
3331 else
3332 {
3333 /* If executing a function that wants to be interrupted out of
3334 and the user has not deferred quitting by binding `inhibit-quit'
3335 then quit right away. */
3336 if (immediate_quit && NILP (Vinhibit_quit))
3337 {
3338 immediate_quit = 0;
3339 sigfree ();
3340 Fsignal (Qquit, Qnil);
3341 }
3342 else
3343 /* Else request quit when it's safe */
3344 Vquit_flag = Qt;
3345 }
3346
3347 if (waiting_for_input && !echoing)
3348 quit_throw_to_read_char ();
3349
3350 errno = old_errno;
3351 }
3352
3353 /* Handle a C-g by making read_char return C-g. */
3354
3355 quit_throw_to_read_char ()
3356 {
3357 quit_error_check ();
3358 sigfree ();
3359 /* Prevent another signal from doing this before we finish. */
3360 clear_waiting_for_input ();
3361 input_pending = 0;
3362
3363 #if 0
3364 unread_command_char = make_number (-1);
3365 #endif
3366 unread_command_char = Qnil;
3367
3368 _longjmp (getcjmp, 1);
3369 }
3370 \f
3371 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
3372 "Set mode of reading keyboard input.\n\
3373 First arg INTERRUPT non-nil means use input interrupts;\n\
3374 nil means use CBREAK mode.\n\
3375 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
3376 (no effect except in CBREAK mode).\n\
3377 Third arg META non-nil means accept 8-bit input (for a Meta key).\n\
3378 Otherwise, the top bit is ignored, on the assumption it is parity.\n\
3379 Optional fourth arg QUIT if non-nil specifies character to use for quitting.")
3380 (interrupt, flow, meta, quit)
3381 Lisp_Object interrupt, flow, meta, quit;
3382 {
3383 if (!NILP (quit)
3384 && (XTYPE (quit) != Lisp_Int
3385 || XINT (quit) < 0 || XINT (quit) > 0400))
3386 error ("set-input-mode: QUIT must be an ASCII character.");
3387
3388 reset_sys_modes ();
3389 #ifdef SIGIO
3390 /* Note SIGIO has been undef'd if FIONREAD is missing. */
3391 #ifdef NO_SOCK_SIGIO
3392 if (read_socket_hook)
3393 interrupt_input = 0; /* No interrupts if reading from a socket. */
3394 else
3395 #endif /* NO_SOCK_SIGIO */
3396 interrupt_input = !NILP (interrupt);
3397 #else /* not SIGIO */
3398 interrupt_input = 0;
3399 #endif /* not SIGIO */
3400 /* Our VMS input only works by interrupts, as of now. */
3401 #ifdef VMS
3402 interrupt_input = 1;
3403 #endif
3404 flow_control = !NILP (flow);
3405 meta_key = !NILP (meta);
3406 if (!NILP (quit))
3407 /* Don't let this value be out of range. */
3408 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
3409
3410 init_sys_modes ();
3411 return Qnil;
3412 }
3413 \f
3414 init_keyboard ()
3415 {
3416 this_command_keys_size = 40;
3417 this_command_keys =
3418 (Lisp_Object *) xmalloc (this_command_keys_size * sizeof (Lisp_Object));
3419
3420 /* This is correct before outermost invocation of the editor loop */
3421 command_loop_level = -1;
3422 immediate_quit = 0;
3423 quit_char = Ctl ('g');
3424 unread_command_char = Qnil;
3425 recent_keys_index = 0;
3426 total_keys = 0;
3427 kbd_fetch_ptr = kbd_buffer;
3428 kbd_store_ptr = kbd_buffer;
3429 do_mouse_tracking = 0;
3430 input_pending = 0;
3431
3432 if (!noninteractive)
3433 {
3434 signal (SIGINT, interrupt_signal);
3435 #ifdef HAVE_TERMIO
3436 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
3437 SIGQUIT and we can't tell which one it will give us. */
3438 signal (SIGQUIT, interrupt_signal);
3439 #endif /* HAVE_TERMIO */
3440 /* Note SIGIO has been undef'd if FIONREAD is missing. */
3441 #ifdef SIGIO
3442 signal (SIGIO, input_available_signal);
3443 #endif SIGIO
3444 }
3445
3446 /* Use interrupt input by default, if it works and noninterrupt input
3447 has deficiencies. */
3448
3449 #ifdef INTERRUPT_INPUT
3450 interrupt_input = 1;
3451 #else
3452 interrupt_input = 0;
3453 #endif
3454
3455 /* Our VMS input only works by interrupts, as of now. */
3456 #ifdef VMS
3457 interrupt_input = 1;
3458 #endif
3459
3460 sigfree ();
3461 dribble = 0;
3462
3463 if (keyboard_init_hook)
3464 (*keyboard_init_hook) ();
3465
3466 #ifdef POLL_FOR_INPUT
3467 poll_suppress_count = 1;
3468 start_polling ();
3469 #endif
3470 }
3471
3472 /* This type's only use is in syms_of_keyboard, to initialize the
3473 event header symbols and put properties on them. */
3474 struct event_head {
3475 Lisp_Object *var;
3476 char *name;
3477 Lisp_Object *kind;
3478 };
3479
3480 struct event_head head_table[] = {
3481 &Qmouse_movement, "mouse-movement", &Qmouse_movement,
3482 &Qvscrollbar_part, "vscrollbar-part", &Qscrollbar_click,
3483 &Qvslider_part, "vslider-part", &Qscrollbar_click,
3484 &Qvthumbup_part, "vthumbup-part", &Qscrollbar_click,
3485 &Qvthumbdown_part, "vthumbdown-part", &Qscrollbar_click,
3486 &Qhscrollbar_part, "hscrollbar-part", &Qscrollbar_click,
3487 &Qhslider_part, "hslider-part", &Qscrollbar_click,
3488 &Qhthumbleft_part, "hthumbleft-part", &Qscrollbar_click,
3489 &Qhthumbright_part,"hthumbright-part", &Qscrollbar_click
3490 };
3491
3492 syms_of_keyboard ()
3493 {
3494 Qself_insert_command = intern ("self-insert-command");
3495 staticpro (&Qself_insert_command);
3496
3497 Qforward_char = intern ("forward-char");
3498 staticpro (&Qforward_char);
3499
3500 Qbackward_char = intern ("backward-char");
3501 staticpro (&Qbackward_char);
3502
3503 Qdisabled = intern ("disabled");
3504 staticpro (&Qdisabled);
3505
3506 Qfunction_key = intern ("function-key");
3507 staticpro (&Qfunction_key);
3508 Qmouse_movement = intern ("mouse-click");
3509 staticpro (&Qmouse_click);
3510 Qmouse_movement = intern ("scrollbar-click");
3511 staticpro (&Qmouse_movement);
3512
3513 Qmode_line = intern ("mode-line");
3514 staticpro (&Qmode_line);
3515 Qvertical_split = intern ("vertical-split");
3516 staticpro (&Qvertical_split);
3517
3518 Qevent_kind = intern ("event-type");
3519 staticpro (&Qevent_kind);
3520 Qevent_unmodified = intern ("event-unmodified");
3521 staticpro (&Qevent_unmodified);
3522
3523 {
3524 struct event_head *p;
3525
3526 for (p = head_table;
3527 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
3528 p++)
3529 {
3530 *p->var = intern (p->name);
3531 staticpro (p->var);
3532 Fput (*p->var, Qevent_kind, *p->kind);
3533 Fput (*p->var, Qevent_unmodified, *p->var);
3534 }
3535 }
3536
3537 func_key_syms = Qnil;
3538 staticpro (&func_key_syms);
3539
3540 mouse_syms = Qnil;
3541 staticpro (&mouse_syms);
3542
3543 defsubr (&Sread_key_sequence);
3544 defsubr (&Srecursive_edit);
3545 defsubr (&Strack_mouse);
3546 defsubr (&Smouse_click_p);
3547 defsubr (&Sinput_pending_p);
3548 defsubr (&Scommand_execute);
3549 defsubr (&Srecent_keys);
3550 defsubr (&Sthis_command_keys);
3551 defsubr (&Ssuspend_emacs);
3552 defsubr (&Sabort_recursive_edit);
3553 defsubr (&Sexit_recursive_edit);
3554 defsubr (&Srecursion_depth);
3555 defsubr (&Stop_level);
3556 defsubr (&Sdiscard_input);
3557 defsubr (&Sopen_dribble_file);
3558 defsubr (&Sset_input_mode);
3559 defsubr (&Sexecute_extended_command);
3560
3561 DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook,
3562 "Value is called instead of any command that is disabled\n\
3563 (has a non-nil `disabled' property).");
3564
3565 DEFVAR_LISP ("last-command-char", &last_command_char,
3566 "Last terminal input key that was part of a command.");
3567
3568 DEFVAR_LISP ("last-input-char", &last_input_char,
3569 "Last terminal input key.");
3570
3571 DEFVAR_LISP ("unread-command-char", &unread_command_char,
3572 "Object to be read as next input from input stream, or nil if none.");
3573
3574 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
3575 "Meta-prefix character code. Meta-foo as command input\n\
3576 turns into this character followed by foo.");
3577 XSET (meta_prefix_char, Lisp_Int, 033);
3578
3579 DEFVAR_LISP ("last-command", &last_command,
3580 "The last command executed. Normally a symbol with a function definition,\n\
3581 but can be whatever was found in the keymap, or whatever the variable\n\
3582 `this-command' was set to by that command.");
3583 last_command = Qnil;
3584
3585 DEFVAR_LISP ("this-command", &this_command,
3586 "The command now being executed.\n\
3587 The command can set this variable; whatever is put here\n\
3588 will be in `last-command' during the following command.");
3589 this_command = Qnil;
3590
3591 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
3592 "*Number of keyboard input characters between auto-saves.\n\
3593 Zero means disable autosaving due to number of characters typed.");
3594 auto_save_interval = 300;
3595
3596 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
3597 "*Number of seconds idle time before auto-save.\n\
3598 Zero or nil means disable auto-saving due to idleness.\n\
3599 After auto-saving due to this many seconds of idle time,\n\
3600 Emacs also does a garbage collection if that seems to be warranted.");
3601 XFASTINT (Vauto_save_timeout) = 30;
3602
3603 DEFVAR_INT ("echo-keystrokes", &echo_keystrokes,
3604 "*Nonzero means echo unfinished commands after this many seconds of pause.");
3605 echo_keystrokes = 1;
3606
3607 DEFVAR_INT ("polling-period", &polling_period,
3608 "*Interval between polling for input during Lisp execution.\n\
3609 The reason for polling is to make C-g work to stop a running program.\n\
3610 Polling is needed only when using X windows and SIGIO does not work.\n\
3611 Polling is automatically disabled in all other cases.");
3612 polling_period = 2;
3613
3614 DEFVAR_INT ("num-input-keys", &num_input_keys,
3615 "*Number of complete keys read from the keyboard so far.");
3616 num_input_keys = 0;
3617
3618 DEFVAR_LISP ("last-event-screen", &Vlast_event_screen,
3619 "*The screen in which the most recently read event occurred.");
3620 Vlast_event_screen = Qnil;
3621
3622 DEFVAR_LISP ("help-char", &help_char,
3623 "Character to recognize as meaning Help.\n\
3624 When it is read, do `(eval help-form)', and display result if it's a string.\n\
3625 If the value of `help-form' is nil, this char can be read normally.");
3626 XSET (help_char, Lisp_Int, Ctl ('H'));
3627
3628 DEFVAR_LISP ("help-form", &Vhelp_form,
3629 "Form to execute when character help-char is read.\n\
3630 If the form returns a string, that string is displayed.\n\
3631 If `help-form' is nil, the help char is not recognized.");
3632 Vhelp_form = Qnil;
3633
3634 DEFVAR_LISP ("top-level", &Vtop_level,
3635 "Form to evaluate when Emacs starts up.\n\
3636 Useful to set before you dump a modified Emacs.");
3637 Vtop_level = Qnil;
3638
3639 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
3640 "String used as translate table for keyboard input, or nil.\n\
3641 Each character is looked up in this string and the contents used instead.\n\
3642 If string is of length N, character codes N and up are untranslated.");
3643 Vkeyboard_translate_table = Qnil;
3644
3645 #ifdef HAVE_X_WINDOWS
3646 DEFVAR_LISP ("mouse-event-function", &Vmouse_event_function,
3647 "Function to call for each mouse event, after the event's definition.\n\
3648 Called, if non-nil, with one argument, which is the event-list.\n\
3649 See the variable `mouse-event' for the format of this list.");
3650 Vmouse_event_function = Qnil;
3651
3652 DEFVAR_LISP ("mouse-left-hook", &Vmouse_left_hook,
3653 "Function to call when mouse leaves window. No arguments.");
3654 Vmouse_left_hook = Qnil;
3655
3656 DEFVAR_LISP ("map-screen-hook", &Vmap_screen_hook,
3657 "Function to call when screen is mapped. No arguments.");
3658 Vmap_screen_hook = Qnil;
3659
3660 DEFVAR_LISP ("unmap-screen-hook", &Vunmap_screen_hook,
3661 "Function to call when screen is unmapped. No arguments.");
3662 Vunmap_screen_hook = Qnil;
3663
3664 DEFVAR_LISP ("mouse-motion-handler", &Vmouse_motion_handler,
3665 "Handler for motion events. No arguments.");
3666 Vmouse_motion_handler = Qnil;
3667 #endif
3668
3669 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
3670 "Non-nil means prompt with menus in echo area when appropriate.\n\
3671 This is done when reading from a keymap that has a prompt string,\n\
3672 for elements that have prompt strings.");
3673 menu_prompting = 1;
3674
3675 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
3676 "Character to see next line of menu prompt.\n\
3677 Type this character while in a menu prompt to rotate around the lines of it.");
3678 XSET (menu_prompt_more_char, Lisp_Int, ' ');
3679 }
3680
3681 keys_of_keyboard ()
3682 {
3683 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
3684 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
3685 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
3686 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
3687 initial_define_key (meta_map, 'x', "execute-extended-command");
3688 }