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