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