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