(parse_modifiers_uncached): Delete the code for
[bpt/emacs.git] / src / keyboard.c
CommitLineData
284f4730 1/* Keyboard and mouse input; editor command loop.
0d882d52 2 Copyright (C) 1985,86,87,88,89,93,94,95 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
18160b98 23#include <config.h>
284f4730 24#include <stdio.h>
284f4730
JB
25#include "termchar.h"
26#include "termopts.h"
27#include "lisp.h"
28#include "termhooks.h"
29#include "macros.h"
ff11dfa1 30#include "frame.h"
284f4730
JB
31#include "window.h"
32#include "commands.h"
33#include "buffer.h"
34#include "disptab.h"
f4255cd1 35#include "dispextern.h"
284f4730 36#include "keyboard.h"
497ba7a1 37#include "intervals.h"
9ac0d9e0 38#include "blockinput.h"
284f4730
JB
39#include <setjmp.h>
40#include <errno.h>
41
80e4aa30
RS
42#ifdef MSDOS
43#include "msdos.h"
44#include <time.h>
45#else /* not MSDOS */
284f4730
JB
46#ifndef VMS
47#include <sys/ioctl.h>
284f4730 48#endif
80e4aa30 49#endif /* not MSDOS */
284f4730 50
52baf19e 51#include "syssignal.h"
6ef5b54f 52#include "systty.h"
52baf19e 53
c5e3b6c5
RS
54/* This is to get the definitions of the XK_ symbols. */
55#ifdef HAVE_X_WINDOWS
56#include "xterm.h"
57#endif
58
0c2611c5
RS
59/* Include systime.h after xterm.h to avoid double inclusion of time.h. */
60#include "systime.h"
61
52baf19e
JB
62extern int errno;
63
9ac0d9e0
JB
64/* Variables for blockinput.h: */
65
66/* Non-zero if interrupt input is blocked right now. */
63927c41 67int interrupt_input_blocked;
9ac0d9e0
JB
68
69/* Nonzero means an input interrupt has arrived
70 during the current critical section. */
63927c41 71int interrupt_input_pending;
9ac0d9e0
JB
72
73
437f6112
RS
74/* File descriptor to use for input. */
75extern int input_fd;
284f4730 76
bcce3e02 77#ifdef HAVE_X_WINDOWS
284f4730
JB
78/* Make all keyboard buffers much bigger when using X windows. */
79#define KBD_BUFFER_SIZE 4096
80#else /* No X-windows, character input */
81#define KBD_BUFFER_SIZE 256
82#endif /* No X-windows */
83
84/* Following definition copied from eval.c */
85
86struct backtrace
87 {
88 struct backtrace *next;
89 Lisp_Object *function;
90 Lisp_Object *args; /* Points to vector of args. */
91 int nargs; /* length of vector. If nargs is UNEVALLED,
92 args points to slot holding list of
93 unevalled args */
94 char evalargs;
95 };
96
6c6083a9
KH
97#ifdef MULTI_PERDISPLAY
98PERDISPLAY *current_perdisplay;
a2b20856 99PERDISPLAY *all_perdisplays;
bded54dd 100int display_locked;
6c6083a9 101#else
ba72822c 102PERDISPLAY the_only_perdisplay;
6c6083a9 103#endif
612b78ef 104
284f4730
JB
105/* Non-nil disable property on a command means
106 do not execute it; call disabled-command-hook's value instead. */
2e894dab 107Lisp_Object Qdisabled, Qdisabled_command_hook;
284f4730
JB
108
109#define NUM_RECENT_KEYS (100)
110int recent_keys_index; /* Index for storing next element into recent_keys */
111int total_keys; /* Total number of elements stored into recent_keys */
5160df46 112Lisp_Object recent_keys; /* A vector, holding the last 100 keystrokes */
284f4730 113
6569cc8d
JB
114/* Vector holding the key sequence that invoked the current command.
115 It is reused for each command, and it may be longer than the current
116 sequence; this_command_key_count indicates how many elements
117 actually mean something.
118 It's easier to staticpro a single Lisp_Object than an array. */
119Lisp_Object this_command_keys;
120int this_command_key_count;
284f4730
JB
121
122extern int minbuf_level;
123
124extern struct backtrace *backtrace_list;
125
126/* Nonzero means do menu prompting. */
127static int menu_prompting;
128
129/* Character to see next line of menu prompt. */
130static Lisp_Object menu_prompt_more_char;
131
132/* For longjmp to where kbd input is being done. */
133static jmp_buf getcjmp;
134
135/* True while doing kbd input. */
136int waiting_for_input;
137
138/* True while displaying for echoing. Delays C-g throwing. */
139static int echoing;
140
03361bcc
RS
141/* Nonzero means disregard local maps for the menu bar. */
142static int inhibit_local_menu_bar_menus;
143
80e4aa30 144/* Nonzero means C-g should cause immediate error-signal. */
284f4730
JB
145int immediate_quit;
146
147/* Character to recognize as the help char. */
7e85b935 148Lisp_Object Vhelp_char;
284f4730
JB
149
150/* Form to execute when help char is typed. */
151Lisp_Object Vhelp_form;
152
7e85b935
RS
153/* Command to run when the help character follows a prefix key. */
154Lisp_Object Vprefix_help_command;
155
9f9c0e27
RS
156/* List of items that should move to the end of the menu bar. */
157Lisp_Object Vmenu_bar_final_items;
a73c5e29 158
284f4730
JB
159/* Character that causes a quit. Normally C-g.
160
161 If we are running on an ordinary terminal, this must be an ordinary
162 ASCII char, since we want to make it our interrupt character.
163
164 If we are not running on an ordinary terminal, it still needs to be
165 an ordinary ASCII char. This character needs to be recognized in
166 the input interrupt handler. At this point, the keystroke is
167 represented as a struct input_event, while the desired quit
168 character is specified as a lispy event. The mapping from struct
169 input_events to lispy events cannot run in an interrupt handler,
170 and the reverse mapping is difficult for anything but ASCII
171 keystrokes.
172
173 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
174 ASCII character. */
175int quit_char;
176
177extern Lisp_Object current_global_map;
178extern int minibuf_level;
179
9dd3131c
RS
180/* If non-nil, this is a map that overrides all other local maps. */
181Lisp_Object Voverriding_local_map;
182
d0a49716
RS
183/* If non-nil, Voverriding_local_map applies to the menu bar. */
184Lisp_Object Voverriding_local_map_menu_flag;
185
284f4730
JB
186/* Current depth in recursive edits. */
187int command_loop_level;
188
189/* Total number of times command_loop has read a key sequence. */
190int num_input_keys;
191
192/* Last input character read as a command. */
193Lisp_Object last_command_char;
194
7d6de002
RS
195/* Last input character read as a command, not counting menus
196 reached by the mouse. */
197Lisp_Object last_nonmenu_event;
198
284f4730
JB
199/* Last input character read for any purpose. */
200Lisp_Object last_input_char;
201
dbc4e1c1 202/* If not Qnil, a list of objects to be read as subsequent command input. */
24597608 203Lisp_Object Vunread_command_events;
284f4730 204
86e5706b
RS
205/* If not -1, an event to be read as subsequent command input. */
206int unread_command_char;
207
cd21b839
JB
208/* If not Qnil, this is a switch-frame event which we decided to put
209 off until the end of a key sequence. This should be read as the
dbc4e1c1 210 next command input, after any unread_command_events.
8f805655
JB
211
212 read_key_sequence uses this to delay switch-frame events until the
213 end of the key sequence; Fread_char uses it to put off switch-frame
214 events until a non-ASCII event is acceptable as input. */
215Lisp_Object unread_switch_frame;
cd21b839 216
9fa4395d
RS
217/* A mask of extra modifier bits to put into every keyboard char. */
218int extra_keyboard_modifiers;
219
284f4730
JB
220/* Char to use as prefix when a meta character is typed in.
221 This is bound on entry to minibuffer in case ESC is changed there. */
222
223Lisp_Object meta_prefix_char;
224
225/* Last size recorded for a current buffer which is not a minibuffer. */
226static int last_non_minibuf_size;
227
06ef7355 228/* Number of idle seconds before an auto-save and garbage collection. */
284f4730
JB
229static Lisp_Object Vauto_save_timeout;
230
231/* Total number of times read_char has returned. */
232int num_input_chars;
233
51172b6d
RS
234/* Total number of times read_char has returned, outside of macros. */
235int num_nonmacro_input_chars;
236
284f4730
JB
237/* Auto-save automatically when this many characters have been typed
238 since the last time. */
239
240static int auto_save_interval;
241
51172b6d 242/* Value of num_nonmacro_input_chars as of last auto save. */
284f4730
JB
243
244int last_auto_save;
245
246/* Last command executed by the editor command loop, not counting
247 commands that set the prefix argument. */
248
249Lisp_Object last_command;
250
251/* The command being executed by the command loop.
252 Commands may set this, and the value set will be copied into last_command
253 instead of the actual command. */
254Lisp_Object this_command;
255
b453f72e
KH
256/* The value of point when the last command was executed. */
257int last_point_position;
258
047688cb
RS
259/* The buffer that was current when the last command was started. */
260Lisp_Object last_point_position_buffer;
261
4c52b668
KH
262#ifdef MULTI_FRAME
263/* The frame in which the last input event occurred, or Qmacro if the
264 last event came from a macro. We use this to determine when to
265 generate switch-frame events. This may be cleared by functions
266 like Fselect_frame, to make sure that a switch-frame event is
267 generated by the next character. */
268Lisp_Object internal_last_event_frame;
269#endif
270
271/* A user-visible version of the above, intended to allow users to
272 figure out where the last event came from, if the event doesn't
273 carry that information itself (i.e. if it was a character). */
274Lisp_Object Vlast_event_frame;
275
1113d9db
JB
276/* The timestamp of the last input event we received from the X server.
277 X Windows wants this for selection ownership. */
284f4730
JB
278unsigned long last_event_timestamp;
279
280Lisp_Object Qself_insert_command;
281Lisp_Object Qforward_char;
282Lisp_Object Qbackward_char;
e58aa385 283Lisp_Object Qundefined;
5169b66d 284Lisp_Object Qdigit_argument, Qnegative_argument;
284f4730
JB
285
286/* read_key_sequence stores here the command definition of the
287 key sequence that it reads. */
288Lisp_Object read_key_sequence_cmd;
289
290/* Form to evaluate (if non-nil) when Emacs is started. */
291Lisp_Object Vtop_level;
292
293/* User-supplied string to translate input characters through. */
294Lisp_Object Vkeyboard_translate_table;
295
296/* Keymap mapping ASCII function key sequences onto their preferred forms. */
297extern Lisp_Object Vfunction_key_map;
298
a612e298
RS
299/* Keymap mapping ASCII function key sequences onto their preferred forms. */
300Lisp_Object Vkey_translation_map;
301
86e5706b
RS
302/* Non-nil means deactivate the mark at end of this command. */
303Lisp_Object Vdeactivate_mark;
304
48e416d4
RS
305/* Menu bar specified in Lucid Emacs fashion. */
306
307Lisp_Object Vlucid_menu_bar_dirty_flag;
308Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
309
86e5706b
RS
310/* Hooks to run before and after each command. */
311Lisp_Object Qpre_command_hook, Qpost_command_hook;
312Lisp_Object Vpre_command_hook, Vpost_command_hook;
40932d1a 313Lisp_Object Qcommand_hook_internal, Vcommand_hook_internal;
86e5706b 314
8a792f3a
RS
315/* List of deferred actions to be performed at a later time.
316 The precise format isn't relevant here; we just check whether it is nil. */
317Lisp_Object Vdeferred_action_list;
318
319/* Function to call to handle deferred actions, when there are any. */
320Lisp_Object Vdeferred_action_function;
3ef14e46 321Lisp_Object Qdeferred_action_function;
8a792f3a 322
284f4730
JB
323/* File in which we write all commands we read. */
324FILE *dribble;
325
326/* Nonzero if input is available. */
327int input_pending;
328
b04904fb
RS
329/* 1 if should obey 0200 bit in input chars as "Meta", 2 if should
330 keep 0200 bit in input chars. 0 to ignore the 0200 bit. */
331
284f4730
JB
332int meta_key;
333
334extern char *pending_malloc_warning;
335
beecf6a1
KH
336/* Circular buffer for pre-read keyboard input. */
337static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
338
339/* Vector to GCPRO the frames and windows mentioned in kbd_buffer.
340
341 The interrupt-level event handlers will never enqueue an event on a
342 frame which is not in Vframe_list, and once an event is dequeued,
343 internal_last_event_frame or the event itself points to the frame.
344 So that's all fine.
345
346 But while the event is sitting in the queue, it's completely
347 unprotected. Suppose the user types one command which will run for
348 a while and then delete a frame, and then types another event at
349 the frame that will be deleted, before the command gets around to
350 it. Suppose there are no references to this frame elsewhere in
351 Emacs, and a GC occurs before the second event is dequeued. Now we
352 have an event referring to a freed frame, which will crash Emacs
353 when it is dequeued.
354
355 Similar things happen when an event on a scroll bar is enqueued; the
356 window may be deleted while the event is in the queue.
357
358 So, we use this vector to protect the frame_or_window field in the
359 event queue. That way, they'll be dequeued as dead frames or
360 windows, but still valid lisp objects.
361
362 If kbd_buffer[i].kind != no_event, then
363 (XVECTOR (kbd_buffer_frame_or_window)->contents[i]
364 == kbd_buffer[i].frame_or_window. */
365static Lisp_Object kbd_buffer_frame_or_window;
366
367/* Pointer to next available character in kbd_buffer.
368 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
369 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the the
370 next available char is in kbd_buffer[0]. */
371static struct input_event *kbd_fetch_ptr;
372
373/* Pointer to next place to store character in kbd_buffer. This
374 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
375 character should go in kbd_buffer[0]. */
376static volatile struct input_event *kbd_store_ptr;
377
378/* The above pair of variables forms a "queue empty" flag. When we
379 enqueue a non-hook event, we increment kbd_store_ptr. When we
380 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
381 there is input available iff the two pointers are not equal.
382
383 Why not just have a flag set and cleared by the enqueuing and
384 dequeuing functions? Such a flag could be screwed up by interrupts
385 at inopportune times. */
386
2eb6bfbe 387#ifdef HAVE_MOUSE
a9d77f1f
RS
388/* If this flag is a frame, we check mouse_moved to see when the
389 mouse moves, and motion events will appear in the input stream.
390 Otherwise, mouse motion is ignored. */
391static Lisp_Object do_mouse_tracking;
284f4730
JB
392
393/* The window system handling code should set this if the mouse has
394 moved since the last call to the mouse_position_hook. Calling that
395 hook should clear this. Code assumes that if this is set, it can
396 call mouse_position_hook to get the promised position, so don't set
397 it unless you're prepared to substantiate the claim! */
398int mouse_moved;
2eb6bfbe 399#endif /* HAVE_MOUSE. */
284f4730
JB
400
401/* Symbols to head events. */
402Lisp_Object Qmouse_movement;
3c370943 403Lisp_Object Qscroll_bar_movement;
cd21b839 404Lisp_Object Qswitch_frame;
bbdc2092 405Lisp_Object Qdelete_frame;
af17bd2b
KH
406Lisp_Object Qiconify_frame;
407Lisp_Object Qmake_frame_visible;
cd21b839 408
284f4730
JB
409/* Symbols to denote kinds of events. */
410Lisp_Object Qfunction_key;
411Lisp_Object Qmouse_click;
412/* Lisp_Object Qmouse_movement; - also an event header */
284f4730
JB
413
414/* Properties of event headers. */
415Lisp_Object Qevent_kind;
88cb0656 416Lisp_Object Qevent_symbol_elements;
284f4730 417
598a9fa7
JB
418Lisp_Object Qmenu_enable;
419
0a7f1fc0
JB
420/* An event header symbol HEAD may have a property named
421 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
422 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
423 mask of modifiers applied to it. If present, this is used to help
424 speed up parse_modifiers. */
425Lisp_Object Qevent_symbol_element_mask;
426
427/* An unmodified event header BASE may have a property named
428 Qmodifier_cache, which is an alist mapping modifier masks onto
429 modified versions of BASE. If present, this helps speed up
430 apply_modifiers. */
431Lisp_Object Qmodifier_cache;
432
5ec75a55 433/* Symbols to use for parts of windows. */
284f4730 434Lisp_Object Qmode_line;
e5d77022 435Lisp_Object Qvertical_line;
3c370943 436Lisp_Object Qvertical_scroll_bar;
5ec75a55
RS
437Lisp_Object Qmenu_bar;
438
439extern Lisp_Object Qmenu_enable;
284f4730 440
f4255cd1
JB
441Lisp_Object recursive_edit_unwind (), command_loop ();
442Lisp_Object Fthis_command_keys ();
03b4122a 443Lisp_Object Qextended_command_history;
284f4730 444
f4eef8b4
RS
445Lisp_Object Qpolling_period;
446
a9f16aa9
KH
447extern Lisp_Object Vprint_level, Vprint_length;
448
ffd56f97
JB
449/* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
450 happens. */
451EMACS_TIME *input_available_clear_time;
284f4730
JB
452
453/* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
454 Default is 1 if INTERRUPT_INPUT is defined. */
455int interrupt_input;
456
457/* Nonzero while interrupts are temporarily deferred during redisplay. */
458int interrupts_deferred;
459
460/* nonzero means use ^S/^Q for flow control. */
461int flow_control;
462
284f4730
JB
463/* Allow m- file to inhibit use of FIONREAD. */
464#ifdef BROKEN_FIONREAD
465#undef FIONREAD
466#endif
467
468/* We are unable to use interrupts if FIONREAD is not available,
469 so flush SIGIO so we won't try. */
470#ifndef FIONREAD
471#ifdef SIGIO
472#undef SIGIO
473#endif
474#endif
475
34f04431
RS
476/* If we support X Windows, turn on the code to poll periodically
477 to detect C-g. It isn't actually used when doing interrupt input. */
284f4730 478#ifdef HAVE_X_WINDOWS
284f4730
JB
479#define POLL_FOR_INPUT
480#endif
284f4730
JB
481\f
482/* Global variable declarations. */
483
484/* Function for init_keyboard to call with no args (if nonzero). */
485void (*keyboard_init_hook) ();
486
487static int read_avail_input ();
488static void get_input_pending ();
9fd7d808 489static int readable_events ();
8150596a
RS
490static Lisp_Object read_char_x_menu_prompt ();
491static Lisp_Object read_char_minibuf_menu_prompt ();
a612e298
RS
492static Lisp_Object make_lispy_event ();
493static Lisp_Object make_lispy_movement ();
494static Lisp_Object modify_event_symbol ();
495static Lisp_Object make_lispy_switch_frame ();
3d31316f 496static int parse_solitary_modifier ();
284f4730
JB
497
498/* > 0 if we are to echo keystrokes. */
499static int echo_keystrokes;
500
8026024c
KH
501/* Nonzero means don't try to suspend even if the operating system seems
502 to support it. */
503static int cannot_suspend;
504
284f4730
JB
505#define min(a,b) ((a)<(b)?(a):(b))
506#define max(a,b) ((a)>(b)?(a):(b))
507
508/* Install the string STR as the beginning of the string of echoing,
509 so that it serves as a prompt for the next character.
510 Also start echoing. */
511
512echo_prompt (str)
513 char *str;
514{
515 int len = strlen (str);
7a80a6f6 516
ba72822c
KH
517 if (len > ECHOBUFSIZE - 4)
518 len = ECHOBUFSIZE - 4;
6c6083a9
KH
519 bcopy (str, current_perdisplay->echobuf, len);
520 current_perdisplay->echoptr = current_perdisplay->echobuf + len;
521 *current_perdisplay->echoptr = '\0';
284f4730 522
6c6083a9 523 current_perdisplay->echo_after_prompt = len;
7a80a6f6 524
284f4730
JB
525 echo ();
526}
527
528/* Add C to the echo string, if echoing is going on.
529 C can be a character, which is printed prettily ("M-C-x" and all that
530 jazz), or a symbol, whose name is printed. */
531
532echo_char (c)
533 Lisp_Object c;
534{
535 extern char *push_key_description ();
536
6c6083a9 537 if (current_perdisplay->immediate_echo)
284f4730 538 {
6c6083a9 539 char *ptr = current_perdisplay->echoptr;
284f4730 540
6c6083a9 541 if (ptr != current_perdisplay->echobuf)
284f4730
JB
542 *ptr++ = ' ';
543
544 /* If someone has passed us a composite event, use its head symbol. */
88cb0656 545 c = EVENT_HEAD (c);
284f4730 546
8c18cbfb 547 if (INTEGERP (c))
284f4730 548 {
6c6083a9 549 if (ptr - current_perdisplay->echobuf > ECHOBUFSIZE - 6)
284f4730
JB
550 return;
551
cb5df6ae 552 ptr = push_key_description (XINT (c), ptr);
284f4730 553 }
8c18cbfb 554 else if (SYMBOLP (c))
284f4730
JB
555 {
556 struct Lisp_String *name = XSYMBOL (c)->name;
6c6083a9
KH
557 if (((ptr - current_perdisplay->echobuf) + name->size + 4)
558 > ECHOBUFSIZE)
284f4730
JB
559 return;
560 bcopy (name->data, ptr, name->size);
561 ptr += name->size;
562 }
563
6c6083a9
KH
564 if (current_perdisplay->echoptr == current_perdisplay->echobuf
565 && EQ (c, Vhelp_char))
284f4730
JB
566 {
567 strcpy (ptr, " (Type ? for further options)");
568 ptr += strlen (ptr);
569 }
570
571 *ptr = 0;
6c6083a9 572 current_perdisplay->echoptr = ptr;
284f4730
JB
573
574 echo ();
575 }
576}
577
578/* Temporarily add a dash to the end of the echo string if it's not
579 empty, so that it serves as a mini-prompt for the very next character. */
580
581echo_dash ()
582{
6c6083a9
KH
583 if (!current_perdisplay->immediate_echo
584 && current_perdisplay->echoptr == current_perdisplay->echobuf)
284f4730 585 return;
7a80a6f6 586 /* Do nothing if we just printed a prompt. */
6c6083a9
KH
587 if (current_perdisplay->echo_after_prompt
588 == current_perdisplay->echoptr - current_perdisplay->echobuf)
7a80a6f6 589 return;
4bafa972 590 /* Do nothing if not echoing at all. */
6c6083a9 591 if (current_perdisplay->echoptr == 0)
4bafa972 592 return;
284f4730
JB
593
594 /* Put a dash at the end of the buffer temporarily,
595 but make it go away when the next character is added. */
6c6083a9
KH
596 current_perdisplay->echoptr[0] = '-';
597 current_perdisplay->echoptr[1] = 0;
284f4730
JB
598
599 echo ();
600}
601
602/* Display the current echo string, and begin echoing if not already
603 doing so. */
604
605echo ()
606{
6c6083a9 607 if (!current_perdisplay->immediate_echo)
284f4730
JB
608 {
609 int i;
6c6083a9 610 current_perdisplay->immediate_echo = 1;
284f4730
JB
611
612 for (i = 0; i < this_command_key_count; i++)
d0a57728
RS
613 {
614 Lisp_Object c;
615 c = XVECTOR (this_command_keys)->contents[i];
616 if (! (EVENT_HAS_PARAMETERS (c)
617 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
618 echo_char (c);
619 }
284f4730
JB
620 echo_dash ();
621 }
622
623 echoing = 1;
6c6083a9 624 message1_nolog (current_perdisplay->echobuf);
284f4730
JB
625 echoing = 0;
626
627 if (waiting_for_input && !NILP (Vquit_flag))
628 quit_throw_to_read_char ();
629}
630
631/* Turn off echoing, for the start of a new command. */
632
633cancel_echoing ()
634{
6c6083a9
KH
635 current_perdisplay->immediate_echo = 0;
636 current_perdisplay->echoptr = current_perdisplay->echobuf;
637 current_perdisplay->echo_after_prompt = -1;
284f4730
JB
638}
639
640/* Return the length of the current echo string. */
641
642static int
643echo_length ()
644{
6c6083a9 645 return current_perdisplay->echoptr - current_perdisplay->echobuf;
284f4730
JB
646}
647
648/* Truncate the current echo message to its first LEN chars.
649 This and echo_char get used by read_key_sequence when the user
ff11dfa1 650 switches frames while entering a key sequence. */
284f4730
JB
651
652static void
653echo_truncate (len)
654 int len;
655{
6c6083a9
KH
656 current_perdisplay->echobuf[len] = '\0';
657 current_perdisplay->echoptr = current_perdisplay->echobuf + len;
40932d1a 658 truncate_echo_area (len);
284f4730
JB
659}
660
661\f
662/* Functions for manipulating this_command_keys. */
663static void
664add_command_key (key)
665 Lisp_Object key;
666{
6569cc8d
JB
667 int size = XVECTOR (this_command_keys)->size;
668
669 if (this_command_key_count >= size)
284f4730 670 {
9b8eb840 671 Lisp_Object new_keys;
6569cc8d 672
9b8eb840 673 new_keys = Fmake_vector (make_number (size * 2), Qnil);
6569cc8d
JB
674 bcopy (XVECTOR (this_command_keys)->contents,
675 XVECTOR (new_keys)->contents,
8f805655 676 size * sizeof (Lisp_Object));
6569cc8d
JB
677
678 this_command_keys = new_keys;
284f4730 679 }
6569cc8d
JB
680
681 XVECTOR (this_command_keys)->contents[this_command_key_count++] = key;
284f4730
JB
682}
683\f
684Lisp_Object
685recursive_edit_1 ()
686{
687 int count = specpdl_ptr - specpdl;
688 Lisp_Object val;
689
690 if (command_loop_level > 0)
691 {
692 specbind (Qstandard_output, Qt);
693 specbind (Qstandard_input, Qt);
694 }
695
696 val = command_loop ();
697 if (EQ (val, Qt))
698 Fsignal (Qquit, Qnil);
699
cb5df6ae 700 return unbind_to (count, Qnil);
284f4730
JB
701}
702
703/* When an auto-save happens, record the "time", and don't do again soon. */
5846638c 704
284f4730
JB
705record_auto_save ()
706{
51172b6d 707 last_auto_save = num_nonmacro_input_chars;
284f4730 708}
5846638c
RS
709
710/* Make an auto save happen as soon as possible at command level. */
711
712force_auto_save_soon ()
713{
714 last_auto_save = - auto_save_interval - 1;
241ceaf7
RS
715
716 record_asynch_buffer_change ();
5846638c 717}
284f4730 718\f
284f4730
JB
719DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
720 "Invoke the editor command loop recursively.\n\
721To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
722that tells this function to return.\n\
723Alternately, `(throw 'exit t)' makes this function signal an error.\n\
724This function is called by the editor initialization to begin editing.")
725 ()
726{
727 int count = specpdl_ptr - specpdl;
728 Lisp_Object val;
729
730 command_loop_level++;
731 update_mode_lines = 1;
732
733 record_unwind_protect (recursive_edit_unwind,
734 (command_loop_level
735 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
736 ? Fcurrent_buffer ()
737 : Qnil);
738 recursive_edit_1 ();
739 return unbind_to (count, Qnil);
740}
741
742Lisp_Object
743recursive_edit_unwind (buffer)
744 Lisp_Object buffer;
745{
746 if (!NILP (buffer))
747 Fset_buffer (buffer);
748
749 command_loop_level--;
750 update_mode_lines = 1;
751 return Qnil;
752}
753\f
604ccd1d
KH
754#ifdef MULTI_PERDISPLAY
755static void
756unlock_display ()
757{
758 if (CONSP (Vunread_command_events))
4524b161
KH
759 {
760 current_perdisplay->kbd_queue
761 = nconc2 (Vunread_command_events, current_perdisplay->kbd_queue);
762 current_perdisplay->kbd_queue_has_data = 1;
763 }
604ccd1d
KH
764 Vunread_command_events = Qnil;
765 current_perdisplay = 0;
766 display_locked = 0;
767}
768#endif
769
284f4730
JB
770Lisp_Object
771cmd_error (data)
772 Lisp_Object data;
a1341f75 773{
a9f16aa9
KH
774 Lisp_Object old_level, old_length;
775
a1341f75
RS
776 Vstandard_output = Qt;
777 Vstandard_input = Qt;
778 Vexecuting_macro = Qnil;
217e16c1
KH
779 if (current_perdisplay)
780 {
781 clear_prefix_arg ();
782 cancel_echoing ();
783 }
a9f16aa9
KH
784
785 /* Avoid unquittable loop if data contains a circular list. */
786 old_level = Vprint_level;
787 old_length = Vprint_length;
788 XSETFASTINT(Vprint_level, 10);
789 XSETFASTINT(Vprint_length, 10);
a1341f75 790 cmd_error_internal (data, 0);
a9f16aa9
KH
791 Vprint_level = old_level;
792 Vprint_length = old_length;
a1341f75
RS
793
794 Vquit_flag = Qnil;
795
796 Vinhibit_quit = Qnil;
ff4b06d3 797#ifdef MULTI_PERDISPLAY
217e16c1
KH
798 if (current_perdisplay)
799 unlock_display ();
ff4b06d3 800#endif
a1341f75
RS
801
802 return make_number (0);
803}
804
805cmd_error_internal (data, context)
806 Lisp_Object data;
807 char *context;
284f4730
JB
808{
809 Lisp_Object errmsg, tail, errname, file_error;
810 Lisp_Object stream;
811 struct gcpro gcpro1;
812 int i;
813
814 Vquit_flag = Qnil;
815 Vinhibit_quit = Qt;
284f4730
JB
816 echo_area_glyphs = 0;
817
ff11dfa1 818 /* If the window system or terminal frame hasn't been initialized
284f4730
JB
819 yet, or we're not interactive, it's best to dump this message out
820 to stderr and exit. */
ff11dfa1 821 if (! FRAME_MESSAGE_BUF (selected_frame)
284f4730
JB
822 || noninteractive)
823 stream = Qexternal_debugging_output;
824 else
825 {
826 Fdiscard_input ();
827 bitch_at_user ();
828 stream = Qt;
829 }
830
a1341f75
RS
831 if (context != 0)
832 write_string_1 (context, -1, stream);
833
284f4730
JB
834 errname = Fcar (data);
835
836 if (EQ (errname, Qerror))
837 {
838 data = Fcdr (data);
839 if (!CONSP (data)) data = Qnil;
840 errmsg = Fcar (data);
841 file_error = Qnil;
842 }
843 else
844 {
845 errmsg = Fget (errname, Qerror_message);
846 file_error = Fmemq (Qfile_error,
847 Fget (errname, Qerror_conditions));
848 }
849
850 /* Print an error message including the data items.
851 This is done by printing it into a scratch buffer
852 and then making a copy of the text in the buffer. */
853
854 if (!CONSP (data)) data = Qnil;
855 tail = Fcdr (data);
856 GCPRO1 (tail);
857
858 /* For file-error, make error message by concatenating
859 all the data items. They are all strings. */
860 if (!NILP (file_error) && !NILP (tail))
861 errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr;
862
8c18cbfb 863 if (STRINGP (errmsg))
284f4730
JB
864 Fprinc (errmsg, stream);
865 else
866 write_string_1 ("peculiar error", -1, stream);
867
868 for (i = 0; CONSP (tail); tail = Fcdr (tail), i++)
869 {
870 write_string_1 (i ? ", " : ": ", 2, stream);
871 if (!NILP (file_error))
872 Fprinc (Fcar (tail), stream);
873 else
874 Fprin1 (Fcar (tail), stream);
875 }
876 UNGCPRO;
877
ff11dfa1 878 /* If the window system or terminal frame hasn't been initialized
284f4730 879 yet, or we're in -batch mode, this error should cause Emacs to exit. */
ff11dfa1 880 if (! FRAME_MESSAGE_BUF (selected_frame)
284f4730
JB
881 || noninteractive)
882 {
883 Fterpri (stream);
884 Fkill_emacs (make_number (-1));
885 }
284f4730
JB
886}
887\f
888Lisp_Object command_loop_1 ();
889Lisp_Object command_loop_2 ();
890Lisp_Object top_level_1 ();
891
892/* Entry to editor-command-loop.
893 This level has the catches for exiting/returning to editor command loop.
894 It returns nil to exit recursive edit, t to abort it. */
895
896Lisp_Object
897command_loop ()
898{
899 if (command_loop_level > 0 || minibuf_level > 0)
900 {
901 return internal_catch (Qexit, command_loop_2, Qnil);
902 }
903 else
904 while (1)
905 {
906 internal_catch (Qtop_level, top_level_1, Qnil);
907 internal_catch (Qtop_level, command_loop_2, Qnil);
908
909 /* End of file in -batch run causes exit here. */
910 if (noninteractive)
911 Fkill_emacs (Qt);
912 }
913}
914
915/* Here we catch errors in execution of commands within the
916 editing loop, and reenter the editing loop.
917 When there is an error, cmd_error runs and returns a non-nil
918 value to us. A value of nil means that cmd_loop_1 itself
919 returned due to end of file (or end of kbd macro). */
920
921Lisp_Object
922command_loop_2 ()
923{
924 register Lisp_Object val;
925
926 do
927 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
928 while (!NILP (val));
929
930 return Qnil;
931}
932
933Lisp_Object
934top_level_2 ()
935{
936 return Feval (Vtop_level);
937}
938
939Lisp_Object
940top_level_1 ()
941{
942 /* On entry to the outer level, run the startup file */
943 if (!NILP (Vtop_level))
944 internal_condition_case (top_level_2, Qerror, cmd_error);
945 else if (!NILP (Vpurify_flag))
946 message ("Bare impure Emacs (standard Lisp code not loaded)");
947 else
948 message ("Bare Emacs (standard Lisp code not loaded)");
949 return Qnil;
950}
951
952DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
953 "Exit all recursive editing levels.")
954 ()
955{
956 Fthrow (Qtop_level, Qnil);
957}
958
959DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
960 "Exit from the innermost recursive edit or minibuffer.")
961 ()
962{
963 if (command_loop_level > 0 || minibuf_level > 0)
964 Fthrow (Qexit, Qnil);
965
966 error ("No recursive edit is in progress");
967}
968
969DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
970 "Abort the command that requested this recursive edit or minibuffer input.")
971 ()
972{
973 if (command_loop_level > 0 || minibuf_level > 0)
974 Fthrow (Qexit, Qt);
975
976 error ("No recursive edit is in progress");
977}
978\f
979/* This is the actual command reading loop,
980 sans error-handling encapsulation. */
981
982Lisp_Object Fcommand_execute ();
983static int read_key_sequence ();
1c9784c9 984static void safe_run_hooks ();
284f4730
JB
985
986Lisp_Object
987command_loop_1 ()
988{
48e416d4 989 Lisp_Object cmd, tem;
284f4730
JB
990 int lose;
991 int nonundocount;
992 Lisp_Object keybuf[30];
993 int i;
994 int no_redisplay;
995 int no_direct;
86e5706b
RS
996 int prev_modiff;
997 struct buffer *prev_buffer;
bded54dd 998#ifdef MULTI_PERDISPLAY
604ccd1d 999 int was_locked = display_locked;
bded54dd 1000#endif
284f4730 1001
86e5706b 1002 Vdeactivate_mark = Qnil;
284f4730 1003 waiting_for_input = 0;
267de7a1
KH
1004 if (current_perdisplay)
1005 cancel_echoing ();
284f4730 1006
284f4730
JB
1007 nonundocount = 0;
1008 no_redisplay = 0;
1009 this_command_key_count = 0;
1010
a612e298
RS
1011 /* Make sure this hook runs after commands that get errors and
1012 throw to top level. */
a98ea3f9
RS
1013 /* Note that the value cell will never directly contain nil
1014 if the symbol is a local variable. */
1015 if (!NILP (XSYMBOL (Qpost_command_hook)->value) && !NILP (Vrun_hooks))
1016 safe_run_hooks (Qpost_command_hook);
a612e298 1017
8a792f3a
RS
1018 if (!NILP (Vdeferred_action_list))
1019 call0 (Vdeferred_action_function);
1020
51d5a2c9
RS
1021 /* Do this after running Vpost_command_hook, for consistency. */
1022 last_command = this_command;
1023
284f4730
JB
1024 while (1)
1025 {
284f4730
JB
1026 /* Make sure the current window's buffer is selected. */
1027 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1028 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1029
1030 /* Display any malloc warning that just came out. Use while because
1031 displaying one warning can cause another. */
1032
1033 while (pending_malloc_warning)
1034 display_malloc_warning ();
1035
1036 no_direct = 0;
1037
86e5706b
RS
1038 Vdeactivate_mark = Qnil;
1039
284f4730 1040 /* If minibuffer on and echo area in use,
eb8c3be9 1041 wait 2 sec and redraw minibuffer. */
284f4730
JB
1042
1043 if (minibuf_level && echo_area_glyphs)
1044 {
f1bed6d8
RS
1045 /* Bind inhibit-quit to t so that C-g gets read in
1046 rather than quitting back to the minibuffer. */
1047 int count = specpdl_ptr - specpdl;
1048 specbind (Qinhibit_quit, Qt);
284f4730 1049 Fsit_for (make_number (2), Qnil, Qnil);
cb5df6ae 1050 unbind_to (count, Qnil);
f1bed6d8 1051
284f4730
JB
1052 echo_area_glyphs = 0;
1053 no_direct = 1;
1054 if (!NILP (Vquit_flag))
1055 {
1056 Vquit_flag = Qnil;
24597608 1057 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
284f4730
JB
1058 }
1059 }
1060
1061#ifdef C_ALLOCA
ff4b06d3 1062 alloca (0); /* Cause a garbage collection now */
284f4730
JB
1063 /* Since we can free the most stuff here. */
1064#endif /* C_ALLOCA */
1065
8f805655 1066#if 0
ff11dfa1 1067#ifdef MULTI_FRAME
8f805655
JB
1068 /* Select the frame that the last event came from. Usually,
1069 switch-frame events will take care of this, but if some lisp
1070 code swallows a switch-frame event, we'll fix things up here.
1071 Is this a good idea? */
8c18cbfb 1072 if (FRAMEP (internal_last_event_frame)
3c370943
JB
1073 && XFRAME (internal_last_event_frame) != selected_frame)
1074 Fselect_frame (internal_last_event_frame, Qnil);
cd21b839 1075#endif
284f4730 1076#endif
48e416d4
RS
1077 /* If it has changed current-menubar from previous value,
1078 really recompute the menubar from the value. */
a646e520
RS
1079 if (! NILP (Vlucid_menu_bar_dirty_flag)
1080 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
48e416d4
RS
1081 call0 (Qrecompute_lucid_menubar);
1082
8f805655 1083 /* Read next key sequence; i gets its length. */
ce98e608
KH
1084 i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
1085 Qnil, 0, 1);
8f805655
JB
1086
1087 ++num_input_keys;
1088
284f4730
JB
1089 /* Now we have read a key sequence of length I,
1090 or else I is 0 and we found end of file. */
1091
1092 if (i == 0) /* End of file -- happens only in */
1093 return Qnil; /* a kbd macro, at the end. */
dcc408a0
RS
1094 /* -1 means read_key_sequence got a menu that was rejected.
1095 Just loop around and read another command. */
1096 if (i == -1)
1097 {
1098 cancel_echoing ();
1099 this_command_key_count = 0;
ff4b06d3 1100 goto finalize;
dcc408a0 1101 }
284f4730 1102
284f4730
JB
1103 last_command_char = keybuf[i - 1];
1104
75c0b143
RS
1105 /* If the previous command tried to force a specific window-start,
1106 forget about that, in case this command moves point far away
1107 from that position. */
1108 XWINDOW (selected_window)->force_start = Qnil;
1109
284f4730
JB
1110 cmd = read_key_sequence_cmd;
1111 if (!NILP (Vexecuting_macro))
1112 {
1113 if (!NILP (Vquit_flag))
1114 {
1115 Vexecuting_macro = Qt;
1116 QUIT; /* Make some noise. */
1117 /* Will return since macro now empty. */
1118 }
1119 }
1120
1121 /* Do redisplay processing after this command except in special
40932d1a
RS
1122 cases identified below that set no_redisplay to 1.
1123 (actually, there's currently no way to prevent the redisplay,
1124 and no_redisplay is ignored.
beecf6a1 1125 Perhaps someday we will really implement it.) */
284f4730
JB
1126 no_redisplay = 0;
1127
86e5706b
RS
1128 prev_buffer = current_buffer;
1129 prev_modiff = MODIFF;
8746da95 1130 last_point_position = PT;
18cd2eeb 1131 XSETBUFFER (last_point_position_buffer, prev_buffer);
86e5706b 1132
4c52b668
KH
1133 /* If we're building a prefix argument, override minus and digits. */
1134 if (current_perdisplay->prefix_partial && i == 1 && NATNUMP (keybuf[0]))
1135 {
1136 if (XFASTINT (keybuf[0]) == '-'
1137 && NILP (current_perdisplay->prefix_value))
1138 cmd = Qnegative_argument;
1139 else if (XFASTINT (keybuf[0]) >= '0' && XFASTINT (keybuf[0]) <= '9')
1140 cmd = Qdigit_argument;
1141 }
1142
284f4730
JB
1143 /* Execute the command. */
1144
86e5706b 1145 this_command = cmd;
a98ea3f9
RS
1146 /* Note that the value cell will never directly contain nil
1147 if the symbol is a local variable. */
1148 if (!NILP (XSYMBOL (Qpre_command_hook)->value) && !NILP (Vrun_hooks))
1149 safe_run_hooks (Qpre_command_hook);
86e5706b 1150
258bf746 1151 if (NILP (this_command))
284f4730
JB
1152 {
1153 /* nil means key is undefined. */
1154 bitch_at_user ();
8066f1a1 1155 current_perdisplay->defining_kbd_macro = Qnil;
284f4730 1156 update_mode_lines = 1;
4c52b668 1157 clear_prefix_arg ();
284f4730
JB
1158 }
1159 else
1160 {
5169b66d 1161 current_prefix_partial = current_perdisplay->prefix_partial;
4c52b668
KH
1162 if (current_perdisplay->prefix_partial)
1163 finalize_prefix_arg ();
1164
1165 if (NILP (Vprefix_arg) && ! no_direct)
284f4730
JB
1166 {
1167 /* Recognize some common commands in common situations and
1168 do them directly. */
8001d352 1169 if (EQ (this_command, Qforward_char) && PT < ZV)
284f4730
JB
1170 {
1171 struct Lisp_Vector *dp
1172 = window_display_table (XWINDOW (selected_window));
8001d352
KH
1173 lose = FETCH_CHAR (PT);
1174 SET_PT (PT + 1);
0f7a8fee 1175 if ((dp
82ba47d7 1176 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
9a5540db
RS
1177 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1178 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1179 && (lose >= 0x20 && lose < 0x7f)))
0f7a8fee 1180 : (lose >= 0x20 && lose < 0x7f))
284f4730
JB
1181 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1182 >= MODIFF)
1183 && (XFASTINT (XWINDOW (selected_window)->last_point)
8001d352 1184 == PT - 1)
284f4730
JB
1185 && !windows_or_buffers_changed
1186 && EQ (current_buffer->selective_display, Qnil)
1187 && !detect_input_pending ()
1188 && NILP (Vexecuting_macro))
1189 no_redisplay = direct_output_forward_char (1);
1190 goto directly_done;
1191 }
8001d352 1192 else if (EQ (this_command, Qbackward_char) && PT > BEGV)
284f4730
JB
1193 {
1194 struct Lisp_Vector *dp
1195 = window_display_table (XWINDOW (selected_window));
8001d352
KH
1196 SET_PT (PT - 1);
1197 lose = FETCH_CHAR (PT);
0f7a8fee 1198 if ((dp
ca873d73 1199 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
9a5540db
RS
1200 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1201 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1202 && (lose >= 0x20 && lose < 0x7f)))
0f7a8fee 1203 : (lose >= 0x20 && lose < 0x7f))
284f4730
JB
1204 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1205 >= MODIFF)
1206 && (XFASTINT (XWINDOW (selected_window)->last_point)
8001d352 1207 == PT + 1)
284f4730
JB
1208 && !windows_or_buffers_changed
1209 && EQ (current_buffer->selective_display, Qnil)
1210 && !detect_input_pending ()
1211 && NILP (Vexecuting_macro))
1212 no_redisplay = direct_output_forward_char (-1);
1213 goto directly_done;
1214 }
258bf746 1215 else if (EQ (this_command, Qself_insert_command)
284f4730 1216 /* Try this optimization only on ascii keystrokes. */
8c18cbfb 1217 && INTEGERP (last_command_char))
284f4730
JB
1218 {
1219 unsigned char c = XINT (last_command_char);
fc9cce4e 1220 int value;
284f4730 1221
fc9cce4e
RS
1222 if (NILP (Vexecuting_macro)
1223 && !EQ (minibuf_window, selected_window))
284f4730
JB
1224 {
1225 if (!nonundocount || nonundocount >= 20)
1226 {
1227 Fundo_boundary ();
1228 nonundocount = 0;
1229 }
1230 nonundocount++;
1231 }
fc9cce4e
RS
1232 lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
1233 < MODIFF)
1234 || (XFASTINT (XWINDOW (selected_window)->last_point)
1235 != PT)
4c61f38e 1236 || MODIFF <= SAVE_MODIFF
fc9cce4e
RS
1237 || windows_or_buffers_changed
1238 || !EQ (current_buffer->selective_display, Qnil)
1239 || detect_input_pending ()
1240 || !NILP (Vexecuting_macro));
1241 value = internal_self_insert (c, 0);
1242 if (value)
1243 lose = 1;
1244 if (value == 2)
1245 nonundocount = 0;
1246
1247 if (!lose
1248 && (PT == ZV || FETCH_CHAR (PT) == '\n'))
284f4730
JB
1249 {
1250 struct Lisp_Vector *dp
1251 = window_display_table (XWINDOW (selected_window));
b8d9050d 1252 int lose = c;
284f4730 1253
0f7a8fee
JB
1254 if (dp)
1255 {
9b8eb840 1256 Lisp_Object obj;
0f7a8fee 1257
9b8eb840 1258 obj = DISP_CHAR_VECTOR (dp, lose);
054c8675 1259 if (NILP (obj))
8e91f441
RS
1260 {
1261 /* Do it only for char codes
1262 that by default display as themselves. */
1263 if (lose >= 0x20 && lose <= 0x7e)
1264 no_redisplay = direct_output_for_insert (lose);
1265 }
8c18cbfb 1266 else if (VECTORP (obj)
054c8675 1267 && XVECTOR (obj)->size == 1
8c18cbfb
KH
1268 && (obj = XVECTOR (obj)->contents[0],
1269 INTEGERP (obj))
054c8675
RS
1270 /* Insist face not specified in glyph. */
1271 && (XINT (obj) & ((-1) << 8)) == 0)
bd48a052
RS
1272 no_redisplay
1273 = direct_output_for_insert (XINT (obj));
0f7a8fee
JB
1274 }
1275 else
1276 {
1277 if (lose >= 0x20 && lose <= 0x7e)
1278 no_redisplay = direct_output_for_insert (lose);
1279 }
284f4730
JB
1280 }
1281 goto directly_done;
1282 }
1283 }
1284
1285 /* Here for a command that isn't executed directly */
1286
1287 nonundocount = 0;
4c52b668 1288 if (NILP (Vprefix_arg))
284f4730 1289 Fundo_boundary ();
258bf746 1290 Fcommand_execute (this_command, Qnil);
284f4730 1291
284f4730 1292 }
a764a753 1293 directly_done: ;
284f4730 1294
a98ea3f9
RS
1295 /* Note that the value cell will never directly contain nil
1296 if the symbol is a local variable. */
1297 if (!NILP (XSYMBOL (Qpost_command_hook)->value) && !NILP (Vrun_hooks))
1298 safe_run_hooks (Qpost_command_hook);
86e5706b 1299
8a792f3a 1300 if (!NILP (Vdeferred_action_list))
3ef14e46 1301 safe_run_hooks (Qdeferred_action_function);
8a792f3a 1302
284f4730
JB
1303 /* If there is a prefix argument,
1304 1) We don't want last_command to be ``universal-argument''
1305 (that would be dumb), so don't set last_command,
1306 2) we want to leave echoing on so that the prefix will be
1307 echoed as part of this key sequence, so don't call
1308 cancel_echoing, and
1309 3) we want to leave this_command_key_count non-zero, so that
1310 read_char will realize that it is re-reading a character, and
1311 not echo it a second time. */
c4288b3a 1312 if (NILP (Vprefix_arg) && !current_perdisplay->prefix_partial)
284f4730
JB
1313 {
1314 last_command = this_command;
1315 cancel_echoing ();
1316 this_command_key_count = 0;
1317 }
86e5706b 1318
88ce066e 1319 if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks))
86e5706b
RS
1320 {
1321 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
1322 {
1323 current_buffer->mark_active = Qnil;
1324 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
1325 }
1326 else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1327 call1 (Vrun_hooks, intern ("activate-mark-hook"));
1328 }
ff4b06d3
KH
1329
1330 finalize:
1331 /* Install chars successfully executed in kbd macro. */
1332
c4288b3a
KH
1333 if (!NILP (current_perdisplay->defining_kbd_macro) && NILP (Vprefix_arg)
1334 && !current_perdisplay->prefix_partial)
ff4b06d3
KH
1335 finalize_kbd_macro_chars ();
1336
1337#ifdef MULTI_PERDISPLAY
604ccd1d
KH
1338 if (!was_locked)
1339 unlock_display ();
ff4b06d3 1340#endif
284f4730
JB
1341 }
1342}
1c9784c9
KH
1343
1344/* If we get an error while running the hook, cause the hook variable
1345 to be nil. Also inhibit quits, so that C-g won't cause the hook
1346 to mysteriously evaporate. */
1347static void
1348safe_run_hooks (hook)
a98ea3f9 1349 Lisp_Object hook;
1c9784c9 1350{
68553292 1351 Lisp_Object value;
1c9784c9
KH
1352 int count = specpdl_ptr - specpdl;
1353 specbind (Qinhibit_quit, Qt);
1354
a98ea3f9
RS
1355 /* We read and set the variable with functions,
1356 in case it's buffer-local. */
68553292 1357 value = Vcommand_hook_internal = Fsymbol_value (hook);
a98ea3f9 1358 Fset (hook, Qnil);
1c9784c9 1359 call1 (Vrun_hooks, Qcommand_hook_internal);
68553292 1360 Fset (hook, value);
1c9784c9
KH
1361
1362 unbind_to (count, Qnil);
1363}
284f4730
JB
1364\f
1365/* Number of seconds between polling for input. */
1366int polling_period;
1367
eb8c3be9 1368/* Nonzero means polling for input is temporarily suppressed. */
284f4730
JB
1369int poll_suppress_count;
1370
36922b18 1371/* Nonzero if polling_for_input is actually being used. */
284f4730
JB
1372int polling_for_input;
1373
36922b18
RS
1374#ifdef POLL_FOR_INPUT
1375
284f4730
JB
1376/* Handle an alarm once each second and read pending input
1377 so as to handle a C-g if it comces in. */
1378
1379SIGTYPE
91c049d4
RS
1380input_poll_signal (signalnum) /* If we don't have an argument, */
1381 int signalnum; /* some compilers complain in signal calls. */
284f4730 1382{
9ac0d9e0
JB
1383 if (interrupt_input_blocked == 0
1384 && !waiting_for_input)
1385 read_avail_input (0);
284f4730
JB
1386 signal (SIGALRM, input_poll_signal);
1387 alarm (polling_period);
1388}
1389
1390#endif
1391
1392/* Begin signals to poll for input, if they are appropriate.
1393 This function is called unconditionally from various places. */
1394
1395start_polling ()
1396{
1397#ifdef POLL_FOR_INPUT
34f04431 1398 if (read_socket_hook && !interrupt_input)
284f4730
JB
1399 {
1400 poll_suppress_count--;
1401 if (poll_suppress_count == 0)
1402 {
1403 signal (SIGALRM, input_poll_signal);
1404 polling_for_input = 1;
1405 alarm (polling_period);
1406 }
1407 }
1408#endif
1409}
1410
1d3195db
RS
1411/* Nonzero if we are using polling to handle input asynchronously. */
1412
1413int
1414input_polling_used ()
1415{
1416#ifdef POLL_FOR_INPUT
1417 return read_socket_hook && !interrupt_input;
1418#else
1419 return 0;
1420#endif
1421}
1422
284f4730
JB
1423/* Turn off polling. */
1424
1425stop_polling ()
1426{
1427#ifdef POLL_FOR_INPUT
34f04431 1428 if (read_socket_hook && !interrupt_input)
284f4730
JB
1429 {
1430 if (poll_suppress_count == 0)
1431 {
1432 polling_for_input = 0;
1433 alarm (0);
1434 }
1435 poll_suppress_count++;
1436 }
1437#endif
1438}
fe8aeef3
RS
1439
1440/* Set the value of poll_suppress_count to COUNT
1441 and start or stop polling accordingly. */
1442
1443void
1444set_poll_suppress_count (count)
1445 int count;
1446{
1447#ifdef POLL_FOR_INPUT
1448 if (count == 0 && poll_suppress_count != 0)
1449 {
1450 poll_suppress_count = 1;
1451 start_polling ();
1452 }
1453 else if (count != 0 && poll_suppress_count == 0)
1454 {
1455 stop_polling ();
1456 }
1457 poll_suppress_count = count;
1458#endif
1459}
f4eef8b4 1460
d0a57728
RS
1461/* Bind polling_period to a value at least N.
1462 But don't decrease it. */
1463
f4eef8b4
RS
1464bind_polling_period (n)
1465 int n;
1466{
1467#ifdef POLL_FOR_INPUT
d0a57728
RS
1468 int new = polling_period;
1469
1470 if (n > new)
1471 new = n;
1472
f4eef8b4 1473 stop_polling ();
d0a57728
RS
1474 specbind (Qpolling_period, make_number (new));
1475 /* Start a new alarm with the new period. */
f4eef8b4
RS
1476 start_polling ();
1477#endif
1478}
284f4730 1479\f
6da3dd3a
RS
1480/* Apply the control modifier to CHARACTER. */
1481
faf5e407
JB
1482int
1483make_ctrl_char (c)
1484 int c;
1485{
d205953b
JB
1486 /* Save the upper bits here. */
1487 int upper = c & ~0177;
1488
1489 c &= 0177;
1490
1491 /* Everything in the columns containing the upper-case letters
1492 denotes a control character. */
1493 if (c >= 0100 && c < 0140)
1494 {
1495 int oc = c;
1496 c &= ~0140;
1497 /* Set the shift modifier for a control char
1498 made from a shifted letter. But only for letters! */
1499 if (oc >= 'A' && oc <= 'Z')
1500 c |= shift_modifier;
1501 }
1502
1503 /* The lower-case letters denote control characters too. */
1504 else if (c >= 'a' && c <= 'z')
1505 c &= ~0140;
1506
1507 /* Include the bits for control and shift
1508 only if the basic ASCII code can't indicate them. */
1509 else if (c >= ' ')
1510 c |= ctrl_modifier;
1511
1512 /* Replace the high bits. */
1513 c |= (upper & ~ctrl_modifier);
faf5e407
JB
1514
1515 return c;
1516}
1517
1518
1519\f
284f4730
JB
1520/* Input of single characters from keyboard */
1521
1522Lisp_Object print_help ();
1523static Lisp_Object kbd_buffer_get_event ();
e4fe371d 1524static void record_char ();
284f4730 1525
bded54dd 1526#ifdef MULTI_PERDISPLAY
beecf6a1 1527static jmp_buf wrong_display_jmpbuf;
bded54dd 1528#endif
beecf6a1 1529
284f4730
JB
1530/* read a character from the keyboard; call the redisplay if needed */
1531/* commandflag 0 means do not do auto-saving, but do do redisplay.
1532 -1 means do not do redisplay, but do do autosaving.
1533 1 means do both. */
1534
7d6de002
RS
1535/* The arguments MAPS and NMAPS are for menu prompting.
1536 MAPS is an array of keymaps; NMAPS is the length of MAPS.
1537
1538 PREV_EVENT is the previous input event, or nil if we are reading
1539 the first event of a key sequence.
1540
6569cc8d
JB
1541 If USED_MOUSE_MENU is non-zero, then we set *USED_MOUSE_MENU to 1
1542 if we used a mouse menu to read the input, or zero otherwise. If
dcc408a0
RS
1543 USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone.
1544
1545 Value is t if we showed a menu and the user rejected it. */
7d6de002 1546
284f4730 1547Lisp_Object
7d6de002 1548read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
284f4730 1549 int commandflag;
7d6de002
RS
1550 int nmaps;
1551 Lisp_Object *maps;
1552 Lisp_Object prev_event;
1553 int *used_mouse_menu;
284f4730
JB
1554{
1555 register Lisp_Object c;
1556 int count;
1557 jmp_buf save_jump;
a1341f75 1558 int key_already_recorded = 0;
e4fe371d
RS
1559 Lisp_Object also_record;
1560 also_record = Qnil;
284f4730 1561
24597608 1562 if (CONSP (Vunread_command_events))
284f4730 1563 {
24597608
RS
1564 c = XCONS (Vunread_command_events)->car;
1565 Vunread_command_events = XCONS (Vunread_command_events)->cdr;
284f4730 1566
284f4730
JB
1567 if (this_command_key_count == 0)
1568 goto reread_first;
1569 else
1570 goto reread;
1571 }
1572
86e5706b
RS
1573 if (unread_command_char != -1)
1574 {
18cd2eeb 1575 XSETINT (c, unread_command_char);
86e5706b
RS
1576 unread_command_char = -1;
1577
1578 if (this_command_key_count == 0)
1579 goto reread_first;
1580 else
1581 goto reread;
1582 }
1583
284f4730
JB
1584 if (!NILP (Vexecuting_macro))
1585 {
07d2b8de 1586#ifdef MULTI_FRAME
fce33686
JB
1587 /* We set this to Qmacro; since that's not a frame, nobody will
1588 try to switch frames on us, and the selected window will
1589 remain unchanged.
1590
1591 Since this event came from a macro, it would be misleading to
eb8c3be9 1592 leave internal_last_event_frame set to wherever the last
3c370943
JB
1593 real event came from. Normally, a switch-frame event selects
1594 internal_last_event_frame after each command is read, but
1595 events read from a macro should never cause a new frame to be
1596 selected. */
4c52b668 1597 Vlast_event_frame = internal_last_event_frame = Qmacro;
07d2b8de 1598#endif
fce33686 1599
663258f2
JB
1600 /* Exit the macro if we are at the end.
1601 Also, some things replace the macro with t
1602 to force an early exit. */
1603 if (EQ (Vexecuting_macro, Qt)
1604 || executing_macro_index >= XFASTINT (Flength (Vexecuting_macro)))
284f4730 1605 {
18cd2eeb 1606 XSETINT (c, -1);
284f4730
JB
1607 return c;
1608 }
1609
1610 c = Faref (Vexecuting_macro, make_number (executing_macro_index));
8c18cbfb 1611 if (STRINGP (Vexecuting_macro)
86e5706b 1612 && (XINT (c) & 0x80))
bb9e9bed 1613 XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
86e5706b 1614
284f4730
JB
1615 executing_macro_index++;
1616
1617 goto from_macro;
1618 }
1619
cd21b839
JB
1620 if (!NILP (unread_switch_frame))
1621 {
1622 c = unread_switch_frame;
1623 unread_switch_frame = Qnil;
1624
1625 /* This event should make it into this_command_keys, and get echoed
f4255cd1
JB
1626 again, so we go to reread_first, rather than reread. */
1627 goto reread_first;
cd21b839
JB
1628 }
1629
3f9929bf
RS
1630 /* Don't bother updating menu bars while doing mouse tracking.
1631 We get events very rapidly then, and the menu bar won't be changing.
1632 We do update the menu bar once on entry to Ftrack_mouse. */
b8556aee 1633 if (commandflag > 0 && !input_pending && !detect_input_pending ())
e9bf89a0
RS
1634 prepare_menu_bars ();
1635
284f4730 1636 /* Save outer setjmp data, in case called recursively. */
f76475ad 1637 save_getcjmp (save_jump);
284f4730
JB
1638
1639 stop_polling ();
1640
1641 if (commandflag >= 0 && !input_pending && !detect_input_pending ())
1642 redisplay ();
1643
1644 if (_setjmp (getcjmp))
1645 {
18cd2eeb 1646 XSETINT (c, quit_char);
07d2b8de 1647#ifdef MULTI_FRAME
4c52b668
KH
1648 XSETFRAME (internal_last_event_frame, selected_frame);
1649 Vlast_event_frame = internal_last_event_frame;
07d2b8de 1650#endif
04904c29
RS
1651 /* If we report the quit char as an event,
1652 don't do so more than once. */
1653 if (!NILP (Vinhibit_quit))
1654 Vquit_flag = Qnil;
284f4730 1655
284f4730
JB
1656 goto non_reread;
1657 }
1658
604ccd1d
KH
1659 if (current_perdisplay)
1660 {
1661 /* Message turns off echoing unless more keystrokes turn it on again. */
1662 if (echo_area_glyphs && *echo_area_glyphs
1663 && echo_area_glyphs != current_perdisplay->echobuf)
1664 cancel_echoing ();
1665 else
1666 /* If already echoing, continue. */
1667 echo_dash ();
1668 }
284f4730 1669
8150596a
RS
1670 /* Try reading a character via menu prompting in the minibuf.
1671 Try this before the sit-for, because the sit-for
1672 would do the wrong thing if we are supposed to do
1673 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
1674 after a mouse event so don't try a minibuf menu. */
1675 c = Qnil;
24597608
RS
1676 if (nmaps > 0 && INTERACTIVE
1677 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
1678 /* Don't bring up a menu if we already have another event. */
1679 && NILP (Vunread_command_events)
1680 && unread_command_char < 0
b8556aee 1681 && !detect_input_pending ())
8150596a
RS
1682 {
1683 c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
24597608 1684 if (! NILP (c))
a1341f75
RS
1685 {
1686 key_already_recorded = 1;
1687 goto non_reread;
1688 }
8150596a
RS
1689 }
1690
284f4730
JB
1691 /* If in middle of key sequence and minibuffer not active,
1692 start echoing if enough time elapses. */
604ccd1d
KH
1693 if (current_perdisplay
1694 && minibuf_level == 0
1695 && !current_perdisplay->immediate_echo
6c6083a9 1696 && this_command_key_count > 0
27203ead 1697 && ! noninteractive
284f4730
JB
1698 && echo_keystrokes > 0
1699 && (echo_area_glyphs == 0 || *echo_area_glyphs == 0))
1700 {
1701 Lisp_Object tem0;
1702
7d6de002
RS
1703 /* After a mouse event, start echoing right away.
1704 This is because we are probably about to display a menu,
1705 and we don't want to delay before doing so. */
dbc4e1c1 1706 if (EVENT_HAS_PARAMETERS (prev_event))
284f4730 1707 echo ();
7d6de002
RS
1708 else
1709 {
1710 tem0 = sit_for (echo_keystrokes, 0, 1, 1);
1711 if (EQ (tem0, Qt))
1712 echo ();
1713 }
284f4730
JB
1714 }
1715
1716 /* Maybe auto save due to number of keystrokes or idle time. */
1717
1718 if (commandflag != 0
1719 && auto_save_interval > 0
51172b6d 1720 && num_nonmacro_input_chars - last_auto_save > max (auto_save_interval, 20)
284f4730
JB
1721 && !detect_input_pending ())
1722 {
1723 jmp_buf temp;
1724 save_getcjmp (temp);
1725 Fdo_auto_save (Qnil, Qnil);
ef8fd672
RS
1726 /* Hooks can actually change some buffers in auto save. */
1727 redisplay ();
284f4730
JB
1728 restore_getcjmp (temp);
1729 }
1730
8150596a 1731 /* Try reading using an X menu.
24597608
RS
1732 This is never confused with reading using the minibuf
1733 because the recursive call of read_char in read_char_minibuf_menu_prompt
1734 does not pass on any keymaps. */
1735 if (nmaps > 0 && INTERACTIVE
1736 && !NILP (prev_event) && EVENT_HAS_PARAMETERS (prev_event)
1737 /* Don't bring up a menu if we already have another event. */
1738 && NILP (Vunread_command_events)
b8556aee 1739 && unread_command_char < 0)
8150596a 1740 c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
7d6de002 1741
284f4730
JB
1742 /* Slow down auto saves logarithmically in size of current buffer,
1743 and garbage collect while we're at it. */
26c1639e 1744 if (INTERACTIVE && NILP (c))
7d6de002
RS
1745 {
1746 int delay_level, buffer_size;
1747
1748 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
1749 last_non_minibuf_size = Z - BEG;
1750 buffer_size = (last_non_minibuf_size >> 8) + 1;
1751 delay_level = 0;
1752 while (buffer_size > 64)
1753 delay_level++, buffer_size -= buffer_size >> 2;
1754 if (delay_level < 4) delay_level = 4;
1755 /* delay_level is 4 for files under around 50k, 7 at 100k,
1756 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
1757
1758 /* Auto save if enough time goes by without input. */
1759 if (commandflag != 0
51172b6d 1760 && num_nonmacro_input_chars > last_auto_save
8c18cbfb 1761 && INTEGERP (Vauto_save_timeout)
7d6de002
RS
1762 && XINT (Vauto_save_timeout) > 0)
1763 {
1764 Lisp_Object tem0;
1765 int delay = delay_level * XFASTINT (Vauto_save_timeout) / 4;
1766 tem0 = sit_for (delay, 0, 1, 1);
1767 if (EQ (tem0, Qt))
1768 {
1769 jmp_buf temp;
1770 save_getcjmp (temp);
1771 Fdo_auto_save (Qnil, Qnil);
1772 restore_getcjmp (temp);
1773
1774 /* If we have auto-saved and there is still no input
1775 available, garbage collect if there has been enough
1776 consing going on to make it worthwhile. */
1777 if (!detect_input_pending ()
1778 && consing_since_gc > gc_cons_threshold / 2)
ef8fd672
RS
1779 Fgarbage_collect ();
1780 /* prepare_menu_bars isn't safe here, but it should
1781 also be unnecessary. */
1782 redisplay ();
7d6de002
RS
1783 }
1784 }
1785 }
284f4730 1786
beecf6a1 1787 if (NILP (c))
1e12dd87 1788 {
beecf6a1 1789 PERDISPLAY *perd;
bded54dd
KH
1790 /* Check for something on one of the side queues. Give priority to
1791 the current display, but if we're not locked, then check the other
1792 displays as well. */
4524b161 1793 if (current_perdisplay && current_perdisplay->kbd_queue_has_data)
bded54dd
KH
1794 perd = current_perdisplay;
1795 else if (!display_locked)
beecf6a1
KH
1796 {
1797 for (perd = all_perdisplays; perd; perd = perd->next_perdisplay)
4524b161 1798 if (perd->kbd_queue_has_data)
beecf6a1 1799 break;
cd72760c 1800 }
bded54dd
KH
1801 else
1802 perd = 0;
284f4730 1803
beecf6a1
KH
1804 /* If we found something on a side queue, use that.
1805 Otherwise, read from the main queue, and if that gives us
1806 something we can't use yet, put it on the side queue and
1807 try again. */
1808 if (perd)
1809 {
4524b161
KH
1810 if (!CONSP (perd->kbd_queue))
1811 abort ();
beecf6a1
KH
1812 c = XCONS (perd->kbd_queue)->car;
1813 perd->kbd_queue = XCONS (perd->kbd_queue)->cdr;
4524b161
KH
1814 if (NILP (perd->kbd_queue))
1815 perd->kbd_queue_has_data = 0;
4c52b668
KH
1816 input_pending = readable_events ();
1817#ifdef MULTI_FRAME
1818 if (EVENT_HAS_PARAMETERS (c)
1819 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
1820 internal_last_event_frame = XCONS (XCONS (c)->cdr)->car;
1821 Vlast_event_frame = internal_last_event_frame;
1822#endif
beecf6a1
KH
1823 }
1824 else
1825 {
1826 wrong_display:
1827 /* Actually read a character, waiting if necessary. */
1828 while (c = kbd_buffer_get_event (&perd), NILP (c))
1829 {
1830 if (commandflag >= 0
1831 && !input_pending && !detect_input_pending ())
1832 {
1833 prepare_menu_bars ();
1834 redisplay ();
1835 }
1836 }
bded54dd 1837 if (display_locked && perd != current_perdisplay)
beecf6a1
KH
1838 {
1839 Lisp_Object *tailp = &perd->kbd_queue;
1840 while (CONSP (*tailp))
1841 tailp = &XCONS (*tailp)->cdr;
1842 if (!NILP (*tailp))
1843 abort ();
1844 *tailp = Fcons (c, Qnil);
4524b161 1845 perd->kbd_queue_has_data = 1;
beecf6a1
KH
1846 goto wrong_display;
1847 }
1848 }
bded54dd 1849#ifdef MULTI_PERDISPLAY
bded54dd 1850 if (perd != current_perdisplay)
beecf6a1
KH
1851 {
1852 /* We shouldn't get here if we were locked onto one display! */
bded54dd 1853 if (display_locked)
beecf6a1
KH
1854 abort ();
1855 perd->kbd_queue = Fcons (c, perd->kbd_queue);
4524b161 1856 perd->kbd_queue_has_data = 1;
bded54dd 1857 current_perdisplay = perd;
beecf6a1
KH
1858 longjmp (wrong_display_jmpbuf, 1);
1859 }
bded54dd 1860#endif
beecf6a1 1861 }
284f4730 1862 /* Terminate Emacs in batch mode if at eof. */
8c18cbfb 1863 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
284f4730
JB
1864 Fkill_emacs (make_number (1));
1865
8c18cbfb 1866 if (INTEGERP (c))
80645119
JB
1867 {
1868 /* Add in any extra modifiers, where appropriate. */
1869 if ((extra_keyboard_modifiers & CHAR_CTL)
1870 || ((extra_keyboard_modifiers & 0177) < ' '
1871 && (extra_keyboard_modifiers & 0177) != 0))
faf5e407 1872 XSETINT (c, make_ctrl_char (XINT (c)));
80645119
JB
1873
1874 /* Transfer any other modifier bits directly from
1875 extra_keyboard_modifiers to c. Ignore the actual character code
1876 in the low 16 bits of extra_keyboard_modifiers. */
b8d9050d 1877 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
80645119 1878 }
9fa4395d 1879
284f4730
JB
1880 non_reread:
1881
f76475ad 1882 restore_getcjmp (save_jump);
284f4730
JB
1883
1884 start_polling ();
1885
dfd11da7
RS
1886 /* Buffer switch events are only for internal wakeups
1887 so don't show them to the user. */
8c18cbfb 1888 if (BUFFERP (c))
dfd11da7
RS
1889 return c;
1890
a1341f75
RS
1891 if (key_already_recorded)
1892 return c;
1893
dfd11da7
RS
1894 /* Wipe the echo area. */
1895 echo_area_glyphs = 0;
284f4730
JB
1896
1897 /* Handle things that only apply to characters. */
8c18cbfb 1898 if (INTEGERP (c))
284f4730
JB
1899 {
1900 /* If kbd_buffer_get_event gave us an EOF, return that. */
86e5706b 1901 if (XINT (c) == -1)
284f4730
JB
1902 return c;
1903
8c18cbfb 1904 if (STRINGP (Vkeyboard_translate_table)
f4255cd1
JB
1905 && XSTRING (Vkeyboard_translate_table)->size > XFASTINT (c))
1906 XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[XFASTINT (c)]);
284f4730
JB
1907 }
1908
e4fe371d
RS
1909 /* If this event is a mouse click in the menu bar,
1910 return just menu-bar for now. Modify the mouse click event
1911 so we won't do this twice, then queue it up. */
1912 if (EVENT_HAS_PARAMETERS (c)
1913 && CONSP (XCONS (c)->cdr)
1914 && CONSP (EVENT_START (c))
1915 && CONSP (XCONS (EVENT_START (c))->cdr))
284f4730 1916 {
e4fe371d 1917 Lisp_Object posn;
284f4730 1918
e4fe371d
RS
1919 posn = POSN_BUFFER_POSN (EVENT_START (c));
1920 /* Handle menu-bar events:
1921 insert the dummy prefix event `menu-bar'. */
1922 if (EQ (posn, Qmenu_bar))
1923 {
1924 /* Change menu-bar to (menu-bar) as the event "position". */
1925 POSN_BUFFER_POSN (EVENT_START (c)) = Fcons (posn, Qnil);
284f4730 1926
e4fe371d
RS
1927 also_record = c;
1928 Vunread_command_events = Fcons (c, Vunread_command_events);
1929 c = posn;
284f4730 1930 }
284f4730
JB
1931 }
1932
e4fe371d
RS
1933 record_char (c);
1934 if (! NILP (also_record))
1935 record_char (also_record);
51172b6d 1936
284f4730
JB
1937 from_macro:
1938 reread_first:
284f4730 1939
b8556aee 1940 /* Don't echo mouse motion events. */
8ea231fc
RS
1941 if (echo_keystrokes
1942 && ! (EVENT_HAS_PARAMETERS (c)
1943 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
e4fe371d
RS
1944 {
1945 echo_char (c);
1946 if (! NILP (also_record))
1947 echo_char (also_record);
1948 }
b8556aee 1949
db8c1663 1950 /* Record this character as part of the current key. */
b8556aee 1951 add_command_key (c);
e4fe371d
RS
1952 if (! NILP (also_record))
1953 add_command_key (also_record);
284f4730
JB
1954
1955 /* Re-reading in the middle of a command */
1956 reread:
1957 last_input_char = c;
1958 num_input_chars++;
1959
1960 /* Process the help character specially if enabled */
7e85b935 1961 if (EQ (c, Vhelp_char) && !NILP (Vhelp_form))
284f4730
JB
1962 {
1963 Lisp_Object tem0;
1964 count = specpdl_ptr - specpdl;
1965
1966 record_unwind_protect (Fset_window_configuration,
1967 Fcurrent_window_configuration (Qnil));
1968
1969 tem0 = Feval (Vhelp_form);
8c18cbfb 1970 if (STRINGP (tem0))
284f4730
JB
1971 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
1972
1973 cancel_echoing ();
3cb81011
KH
1974 do
1975 c = read_char (0, 0, 0, Qnil, 0);
8c18cbfb 1976 while (BUFFERP (c));
ff11dfa1 1977 /* Remove the help from the frame */
284f4730 1978 unbind_to (count, Qnil);
e9bf89a0 1979 prepare_menu_bars ();
284f4730
JB
1980 redisplay ();
1981 if (EQ (c, make_number (040)))
1982 {
1983 cancel_echoing ();
3cb81011
KH
1984 do
1985 c = read_char (0, 0, 0, Qnil, 0);
8c18cbfb 1986 while (BUFFERP (c));
284f4730
JB
1987 }
1988 }
1989
1990 return c;
1991}
1992
e4fe371d
RS
1993/* Record the input event C in various ways. */
1994
1995static void
1996record_char (c)
1997 Lisp_Object c;
1998{
1999 total_keys++;
2000 XVECTOR (recent_keys)->contents[recent_keys_index] = c;
2001 if (++recent_keys_index >= NUM_RECENT_KEYS)
2002 recent_keys_index = 0;
2003
2004 /* Write c to the dribble file. If c is a lispy event, write
2005 the event's symbol to the dribble file, in <brackets>. Bleaugh.
2006 If you, dear reader, have a better idea, you've got the source. :-) */
2007 if (dribble)
2008 {
2009 if (INTEGERP (c))
2010 {
2011 if (XUINT (c) < 0x100)
2012 putc (XINT (c), dribble);
2013 else
2014 fprintf (dribble, " 0x%x", XUINT (c));
2015 }
2016 else
2017 {
2018 Lisp_Object dribblee;
2019
2020 /* If it's a structured event, take the event header. */
2021 dribblee = EVENT_HEAD (c);
2022
2023 if (SYMBOLP (dribblee))
2024 {
2025 putc ('<', dribble);
2026 fwrite (XSYMBOL (dribblee)->name->data, sizeof (char),
2027 XSYMBOL (dribblee)->name->size,
2028 dribble);
2029 putc ('>', dribble);
2030 }
2031 }
2032
2033 fflush (dribble);
2034 }
2035
2036 store_kbd_macro_char (c);
2037
2038 num_nonmacro_input_chars++;
2039}
2040
284f4730
JB
2041Lisp_Object
2042print_help (object)
2043 Lisp_Object object;
2044{
622de3e9 2045 struct buffer *old = current_buffer;
284f4730 2046 Fprinc (object, Qnil);
622de3e9
KH
2047 set_buffer_internal (XBUFFER (Vstandard_output));
2048 call0 (intern ("help-mode"));
2049 set_buffer_internal (old);
284f4730
JB
2050 return Qnil;
2051}
2052
2053/* Copy out or in the info on where C-g should throw to.
2054 This is used when running Lisp code from within get_char,
2055 in case get_char is called recursively.
2056 See read_process_output. */
2057
2058save_getcjmp (temp)
2059 jmp_buf temp;
2060{
2061 bcopy (getcjmp, temp, sizeof getcjmp);
2062}
2063
2064restore_getcjmp (temp)
2065 jmp_buf temp;
2066{
2067 bcopy (temp, getcjmp, sizeof getcjmp);
2068}
2069
2070\f
2eb6bfbe
RM
2071#ifdef HAVE_MOUSE
2072
284f4730
JB
2073/* Restore mouse tracking enablement. See Ftrack_mouse for the only use
2074 of this function. */
a9d77f1f 2075
284f4730
JB
2076static Lisp_Object
2077tracking_off (old_value)
2078 Lisp_Object old_value;
2079{
71edead1
RS
2080 do_mouse_tracking = old_value;
2081 if (NILP (old_value))
284f4730 2082 {
284f4730
JB
2083 /* Redisplay may have been preempted because there was input
2084 available, and it assumes it will be called again after the
2085 input has been processed. If the only input available was
2086 the sort that we have just disabled, then we need to call
2087 redisplay. */
2088 if (!readable_events ())
2089 {
e9bf89a0 2090 prepare_menu_bars ();
284f4730
JB
2091 redisplay_preserve_echo_area ();
2092 get_input_pending (&input_pending);
2093 }
2094 }
2095}
2096
2097DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
4bb994d1
JB
2098 "Evaluate BODY with mouse movement events enabled.\n\
2099Within a `track-mouse' form, mouse motion generates input events that\n\
2100you can read with `read-event'.\n\
2101Normally, mouse motion is ignored.")
284f4730
JB
2102 (args)
2103 Lisp_Object args;
2104{
2105 int count = specpdl_ptr - specpdl;
2106 Lisp_Object val;
2107
a9d77f1f 2108 record_unwind_protect (tracking_off, do_mouse_tracking);
284f4730 2109
3f9929bf
RS
2110 if (!input_pending && !detect_input_pending ())
2111 prepare_menu_bars ();
2112
a9d77f1f 2113 XSETFRAME (do_mouse_tracking, selected_frame);
284f4730
JB
2114
2115 val = Fprogn (args);
2116 return unbind_to (count, val);
2117}
2eb6bfbe
RM
2118
2119#endif /* HAVE_MOUSE */
a612e298
RS
2120\f
2121/* Low level keyboard/mouse input.
2122 kbd_buffer_store_event places events in kbd_buffer, and
2123 kbd_buffer_get_event retrieves them.
2124 mouse_moved indicates when the mouse has moved again, and
2125 *mouse_position_hook provides the mouse position. */
2126
2127/* Return true iff there are any events in the queue that read-char
2128 would return. If this returns false, a read-char would block. */
2129static int
2130readable_events ()
2131{
beecf6a1
KH
2132 if (kbd_fetch_ptr != kbd_store_ptr)
2133 return 1;
2134#ifdef HAVE_MOUSE
2135 if (FRAMEP (do_mouse_tracking) && mouse_moved)
2136 return 1;
2137#endif
4c52b668
KH
2138 if (display_locked)
2139 {
4524b161 2140 if (current_perdisplay->kbd_queue_has_data)
4c52b668
KH
2141 return 1;
2142 }
2143 else
2144 {
2145 PERDISPLAY *perd;
2146 for (perd = all_perdisplays; perd; perd = perd->next_perdisplay)
4524b161 2147 if (perd->kbd_queue_has_data)
4c52b668
KH
2148 return 1;
2149 }
beecf6a1 2150 return 0;
a612e298
RS
2151}
2152
2153/* Set this for debugging, to have a way to get out */
2154int stop_character;
284f4730
JB
2155
2156/* Store an event obtained at interrupt level into kbd_buffer, fifo */
2157
2158void
2159kbd_buffer_store_event (event)
2160 register struct input_event *event;
2161{
2162 if (event->kind == no_event)
2163 abort ();
2164
2165 if (event->kind == ascii_keystroke)
2166 {
e9bf89a0 2167 register int c = event->code & 0377;
284f4730 2168
faf5e407
JB
2169 if (event->modifiers & ctrl_modifier)
2170 c = make_ctrl_char (c);
2171
9fd7d808
RS
2172 c |= (event->modifiers
2173 & (meta_modifier | alt_modifier
2174 | hyper_modifier | super_modifier));
2175
86e5706b 2176 if (c == quit_char)
284f4730 2177 {
3e51c7b7
JB
2178 extern SIGTYPE interrupt_signal ();
2179
07d2b8de 2180#ifdef MULTI_FRAME
284f4730 2181 /* If this results in a quit_char being returned to Emacs as
3c370943 2182 input, set Vlast_event_frame properly. If this doesn't
284f4730 2183 get returned to Emacs as an event, the next event read
ff11dfa1 2184 will set Vlast_event_frame again, so this is safe to do. */
4bb994d1 2185 {
9b8eb840 2186 Lisp_Object focus;
4bb994d1 2187
9b8eb840 2188 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
4bb994d1 2189 if (NILP (focus))
beecf6a1 2190 focus = event->frame_or_window;
4c52b668
KH
2191 internal_last_event_frame = focus;
2192 Vlast_event_frame = focus;
4bb994d1 2193 }
07d2b8de 2194#endif
3e51c7b7 2195
ffd56f97 2196 last_event_timestamp = event->timestamp;
284f4730
JB
2197 interrupt_signal ();
2198 return;
2199 }
2200
2201 if (c && c == stop_character)
2202 {
2203 sys_suspend ();
2204 return;
2205 }
284f4730
JB
2206 }
2207
beecf6a1
KH
2208 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
2209 kbd_store_ptr = kbd_buffer;
284f4730
JB
2210
2211 /* Don't let the very last slot in the buffer become full,
2212 since that would make the two pointers equal,
2213 and that is indistinguishable from an empty buffer.
2214 Discard the event if it would fill the last slot. */
beecf6a1 2215 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
284f4730 2216 {
beecf6a1 2217 volatile struct input_event *sp = kbd_store_ptr;
612b78ef 2218 sp->kind = event->kind;
27203ead
RS
2219 if (event->kind == selection_request_event)
2220 {
2221 /* We must not use the ordinary copying code for this case,
2222 since `part' is an enum and copying it might not copy enough
2223 in this case. */
612b78ef 2224 bcopy (event, (char *) sp, sizeof (*event));
27203ead
RS
2225 }
2226 else
2227 {
612b78ef
KH
2228 sp->code = event->code;
2229 sp->part = event->part;
2230 sp->frame_or_window = event->frame_or_window;
2231 sp->modifiers = event->modifiers;
2232 sp->x = event->x;
2233 sp->y = event->y;
2234 sp->timestamp = event->timestamp;
27203ead 2235 }
beecf6a1
KH
2236 (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_store_ptr
2237 - kbd_buffer]
7b4aedb9 2238 = event->frame_or_window);
284f4730 2239
beecf6a1 2240 kbd_store_ptr++;
284f4730
JB
2241 }
2242}
a612e298
RS
2243\f
2244/* Read one event from the event buffer, waiting if necessary.
2245 The value is a Lisp object representing the event.
2246 The value is nil for an event that should be ignored,
2247 or that was handled here.
2248 We always read and discard one event. */
284f4730
JB
2249
2250static Lisp_Object
beecf6a1 2251kbd_buffer_get_event (PERDISPLAY **perdp)
284f4730
JB
2252{
2253 register int c;
2254 Lisp_Object obj;
2255
2256 if (noninteractive)
2257 {
2258 c = getchar ();
18cd2eeb 2259 XSETINT (obj, c);
beecf6a1 2260 *perdp = all_perdisplays; /* There'd better be exactly one! */
284f4730
JB
2261 return obj;
2262 }
2263
2264 /* Wait until there is input available. */
2265 for (;;)
2266 {
beecf6a1
KH
2267 if (kbd_fetch_ptr != kbd_store_ptr)
2268 break;
2269#ifdef HAVE_MOUSE
2270 if (FRAMEP (do_mouse_tracking) && mouse_moved)
284f4730 2271 break;
beecf6a1 2272#endif
284f4730
JB
2273
2274 /* If the quit flag is set, then read_char will return
2275 quit_char, so that counts as "available input." */
2276 if (!NILP (Vquit_flag))
2277 quit_throw_to_read_char ();
2278
2279 /* One way or another, wait until input is available; then, if
2280 interrupt handlers have not read it, read it now. */
2281
2282#ifdef OLDVMS
2283 wait_for_kbd_input ();
2284#else
2285/* Note SIGIO has been undef'd if FIONREAD is missing. */
2286#ifdef SIGIO
2287 gobble_input (0);
2288#endif /* SIGIO */
beecf6a1
KH
2289 if (kbd_fetch_ptr != kbd_store_ptr)
2290 break;
2291#ifdef HAVE_MOUSE
2292 if (FRAMEP (do_mouse_tracking) && mouse_moved)
2293 break;
2294#endif
2295 {
2296 Lisp_Object minus_one;
f76475ad 2297
beecf6a1
KH
2298 XSETINT (minus_one, -1);
2299 wait_reading_process_input (0, 0, minus_one, 1);
284f4730 2300
beecf6a1
KH
2301 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
2302 /* Pass 1 for EXPECT since we just waited to have input. */
2303 read_avail_input (1);
2304 }
284f4730
JB
2305#endif /* not VMS */
2306 }
2307
2308 /* At this point, we know that there is a readable event available
2309 somewhere. If the event queue is empty, then there must be a
2310 mouse movement enabled and available. */
beecf6a1 2311 if (kbd_fetch_ptr != kbd_store_ptr)
284f4730 2312 {
cd21b839 2313 struct input_event *event;
3e51c7b7 2314
beecf6a1
KH
2315 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
2316 ? kbd_fetch_ptr
2317 : kbd_buffer);
3e51c7b7 2318
cd21b839 2319 last_event_timestamp = event->timestamp;
cd21b839 2320
beecf6a1
KH
2321 {
2322 Lisp_Object frame;
2323 frame = event->frame_or_window;
2324 if (CONSP (frame))
2325 frame = XCONS (frame)->car;
2326 else if (WINDOWP (frame))
2327 frame = WINDOW_FRAME (XWINDOW (frame));
4c52b668
KH
2328 /* There are still some events that don't set this field.
2329 For now, just ignore the problem. */
beecf6a1 2330 if (!FRAMEP (frame))
4c52b668
KH
2331 *perdp = all_perdisplays;
2332 else
2333 *perdp = get_perdisplay (XFRAME (frame));
beecf6a1
KH
2334 }
2335
4bb994d1
JB
2336 obj = Qnil;
2337
48e416d4 2338 /* These two kinds of events get special handling
a612e298
RS
2339 and don't actually appear to the command loop.
2340 We return nil for them. */
48e416d4
RS
2341 if (event->kind == selection_request_event)
2342 {
598a9fa7 2343#ifdef HAVE_X11
4581e928
RS
2344 struct input_event copy = *event;
2345 /* Remove it from the buffer before processing it,
2346 since otherwise swallow_events will see it
2347 and process it again. */
beecf6a1 2348 kbd_fetch_ptr = event + 1;
4581e928 2349 x_handle_selection_request (&copy);
598a9fa7
JB
2350#else
2351 /* We're getting selection request events, but we don't have
2352 a window system. */
2353 abort ();
2354#endif
48e416d4
RS
2355 }
2356
1e12dd87 2357 else if (event->kind == selection_clear_event)
48e416d4 2358 {
598a9fa7 2359#ifdef HAVE_X11
48e416d4 2360 x_handle_selection_clear (event);
beecf6a1 2361 kbd_fetch_ptr = event + 1;
598a9fa7
JB
2362#else
2363 /* We're getting selection request events, but we don't have
2364 a window system. */
2365 abort ();
2366#endif
48e416d4 2367 }
990acea3
RS
2368#ifdef HAVE_X11
2369 else if (event->kind == delete_window_event)
2370 {
bbdc2092
RS
2371 /* Make an event (delete-frame (FRAME)). */
2372 obj = Fcons (event->frame_or_window, Qnil);
af17bd2b 2373 obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
beecf6a1 2374 kbd_fetch_ptr = event + 1;
af17bd2b
KH
2375 }
2376 else if (event->kind == iconify_event)
2377 {
2378 /* Make an event (iconify-frame (FRAME)). */
2379 obj = Fcons (event->frame_or_window, Qnil);
2380 obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
beecf6a1 2381 kbd_fetch_ptr = event + 1;
af17bd2b
KH
2382 }
2383 else if (event->kind == deiconify_event)
2384 {
2385 /* Make an event (make-frame-visible (FRAME)). */
2386 obj = Fcons (event->frame_or_window, Qnil);
2387 obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
beecf6a1 2388 kbd_fetch_ptr = event + 1;
990acea3
RS
2389 }
2390#endif
f5e09c8b
RS
2391 else if (event->kind == menu_bar_event)
2392 {
beecf6a1
KH
2393 /* The event value is in the cdr of the frame_or_window slot. */
2394 if (!CONSP (event->frame_or_window))
2395 abort ();
2396 obj = XCONS (event->frame_or_window)->cdr;
2397 kbd_fetch_ptr = event + 1;
f5e09c8b 2398 }
a8015ab5
KH
2399 else if (event->kind == buffer_switch_event)
2400 {
2401 /* The value doesn't matter here; only the type is tested. */
18cd2eeb 2402 XSETBUFFER (obj, current_buffer);
beecf6a1 2403 kbd_fetch_ptr = event + 1;
a8015ab5 2404 }
a612e298
RS
2405 /* Just discard these, by returning nil.
2406 (They shouldn't be found in the buffer,
2407 but on some machines it appears they do show up.) */
2408 else if (event->kind == no_event)
beecf6a1 2409 kbd_fetch_ptr = event + 1;
48e416d4 2410
4bb994d1
JB
2411 /* If this event is on a different frame, return a switch-frame this
2412 time, and leave the event in the queue for next time. */
1e12dd87
RS
2413 else
2414 {
a6d53864 2415#ifdef MULTI_FRAME
9b8eb840 2416 Lisp_Object frame;
1e12dd87 2417 Lisp_Object focus;
7b4aedb9 2418
9b8eb840 2419 frame = event->frame_or_window;
8c18cbfb 2420 if (WINDOWP (frame))
1e12dd87 2421 frame = WINDOW_FRAME (XWINDOW (frame));
4bb994d1 2422
1e12dd87
RS
2423 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
2424 if (! NILP (focus))
2425 frame = focus;
07d2b8de 2426
4c52b668 2427 if (! EQ (frame, internal_last_event_frame)
1e12dd87
RS
2428 && XFRAME (frame) != selected_frame)
2429 obj = make_lispy_switch_frame (frame);
4c52b668 2430 internal_last_event_frame = frame;
a6d53864 2431#endif /* MULTI_FRAME */
4bb994d1 2432
1e12dd87
RS
2433 /* If we didn't decide to make a switch-frame event, go ahead
2434 and build a real event from the queue entry. */
cd21b839 2435
1e12dd87
RS
2436 if (NILP (obj))
2437 {
2438 obj = make_lispy_event (event);
2439
2440 /* Wipe out this event, to catch bugs. */
2441 event->kind = no_event;
beecf6a1 2442 XVECTOR (kbd_buffer_frame_or_window)->contents[event - kbd_buffer] = Qnil;
1e12dd87 2443
beecf6a1 2444 kbd_fetch_ptr = event + 1;
1e12dd87 2445 }
4bb994d1 2446 }
284f4730 2447 }
2eb6bfbe 2448#ifdef HAVE_MOUSE
a612e298 2449 /* Try generating a mouse motion event. */
a9d77f1f 2450 else if (FRAMEP (do_mouse_tracking) && mouse_moved)
284f4730 2451 {
a9d77f1f 2452 FRAME_PTR f = XFRAME (do_mouse_tracking);
7b4aedb9 2453 Lisp_Object bar_window;
3c370943 2454 enum scroll_bar_part part;
e5d77022
JB
2455 Lisp_Object x, y;
2456 unsigned long time;
284f4730 2457
beecf6a1
KH
2458 if (!current_perdisplay)
2459 abort ();
2460
2461 *perdp = current_perdisplay;
e177ac3a
RS
2462 /* Note that this uses F to determine which display to look at.
2463 If there is no valid info, it does not store anything
2464 so x remains nil. */
2465 x = Qnil;
7b4aedb9 2466 (*mouse_position_hook) (&f, &bar_window, &part, &x, &y, &time);
4bb994d1
JB
2467
2468 obj = Qnil;
284f4730 2469
07d2b8de 2470#ifdef MULTI_FRAME
4bb994d1
JB
2471 /* Decide if we should generate a switch-frame event. Don't
2472 generate switch-frame events for motion outside of all Emacs
2473 frames. */
e177ac3a 2474 if (!NILP (x) && f)
cd21b839 2475 {
9b8eb840 2476 Lisp_Object frame;
4bb994d1 2477
9b8eb840 2478 frame = FRAME_FOCUS_FRAME (f);
4bb994d1 2479 if (NILP (frame))
18cd2eeb 2480 XSETFRAME (frame, f);
4bb994d1 2481
4c52b668 2482 if (! EQ (frame, internal_last_event_frame)
80645119 2483 && XFRAME (frame) != selected_frame)
764cb3f9 2484 obj = make_lispy_switch_frame (frame);
4c52b668 2485 internal_last_event_frame = frame;
cd21b839 2486 }
68553292 2487#endif
4bb994d1
JB
2488
2489 /* If we didn't decide to make a switch-frame event, go ahead and
2490 return a mouse-motion event. */
e177ac3a 2491 if (!NILP (x) && NILP (obj))
7b4aedb9 2492 obj = make_lispy_movement (f, bar_window, part, x, y, time);
6cbff1cb 2493 }
2eb6bfbe 2494#endif /* HAVE_MOUSE */
284f4730
JB
2495 else
2496 /* We were promised by the above while loop that there was
2497 something for us to read! */
2498 abort ();
2499
2500 input_pending = readable_events ();
2501
3c370943 2502#ifdef MULTI_FRAME
4c52b668 2503 Vlast_event_frame = internal_last_event_frame;
3c370943
JB
2504#endif
2505
284f4730
JB
2506 return (obj);
2507}
a612e298
RS
2508\f
2509/* Process any events that are not user-visible,
2510 then return, without reading any user-visible events. */
3a3b9632
RS
2511
2512void
2513swallow_events ()
2514{
beecf6a1 2515 while (kbd_fetch_ptr != kbd_store_ptr)
3a3b9632
RS
2516 {
2517 struct input_event *event;
2518
beecf6a1
KH
2519 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
2520 ? kbd_fetch_ptr
2521 : kbd_buffer);
3a3b9632
RS
2522
2523 last_event_timestamp = event->timestamp;
2524
2525 /* These two kinds of events get special handling
2526 and don't actually appear to the command loop. */
2527 if (event->kind == selection_request_event)
2528 {
2529#ifdef HAVE_X11
4581e928
RS
2530 struct input_event copy;
2531 copy = *event;
beecf6a1 2532 kbd_fetch_ptr = event + 1;
4581e928 2533 x_handle_selection_request (&copy);
3a3b9632
RS
2534#else
2535 /* We're getting selection request events, but we don't have
2536 a window system. */
2537 abort ();
2538#endif
2539 }
2540
2541 else if (event->kind == selection_clear_event)
2542 {
2543#ifdef HAVE_X11
2544 x_handle_selection_clear (event);
beecf6a1 2545 kbd_fetch_ptr = event + 1;
3a3b9632
RS
2546#else
2547 /* We're getting selection request events, but we don't have
2548 a window system. */
2549 abort ();
2550#endif
2551 }
2552 else
2553 break;
2554 }
2555
2556 get_input_pending (&input_pending);
2557}
a612e298 2558\f
284f4730 2559/* Caches for modify_event_symbol. */
e9bf89a0 2560static Lisp_Object accent_key_syms;
270a208f 2561static Lisp_Object system_key_syms;
284f4730
JB
2562static Lisp_Object func_key_syms;
2563static Lisp_Object mouse_syms;
2564
270a208f 2565Lisp_Object Vsystem_key_alist;
80e4aa30 2566
e9bf89a0
RS
2567/* This is a list of keysym codes for special "accent" characters.
2568 It parallels lispy_accent_keys. */
2569
2570static int lispy_accent_codes[] =
2571{
79a7046c 2572#ifdef XK_dead_circumflex
e9bf89a0 2573 XK_dead_circumflex,
79a7046c
RS
2574#else
2575 0,
2576#endif
2577#ifdef XK_dead_grave
e9bf89a0 2578 XK_dead_grave,
79a7046c
RS
2579#else
2580 0,
2581#endif
2582#ifdef XK_dead_tilde
e9bf89a0 2583 XK_dead_tilde,
79a7046c
RS
2584#else
2585 0,
2586#endif
2587#ifdef XK_dead_diaeresis
e9bf89a0 2588 XK_dead_diaeresis,
79a7046c
RS
2589#else
2590 0,
2591#endif
2592#ifdef XK_dead_macron
e9bf89a0 2593 XK_dead_macron,
79a7046c
RS
2594#else
2595 0,
2596#endif
2597#ifdef XK_dead_degree
e9bf89a0 2598 XK_dead_degree,
79a7046c
RS
2599#else
2600 0,
2601#endif
2602#ifdef XK_dead_acute
e9bf89a0 2603 XK_dead_acute,
79a7046c
RS
2604#else
2605 0,
2606#endif
2607#ifdef XK_dead_cedilla
e9bf89a0 2608 XK_dead_cedilla,
79a7046c
RS
2609#else
2610 0,
2611#endif
2612#ifdef XK_dead_breve
e9bf89a0 2613 XK_dead_breve,
79a7046c
RS
2614#else
2615 0,
2616#endif
2617#ifdef XK_dead_ogonek
e9bf89a0 2618 XK_dead_ogonek,
79a7046c
RS
2619#else
2620 0,
2621#endif
2622#ifdef XK_dead_caron
e9bf89a0 2623 XK_dead_caron,
79a7046c
RS
2624#else
2625 0,
2626#endif
2627#ifdef XK_dead_doubleacute
e9bf89a0 2628 XK_dead_doubleacute,
79a7046c
RS
2629#else
2630 0,
2631#endif
2632#ifdef XK_dead_abovedot
e9bf89a0 2633 XK_dead_abovedot,
79a7046c
RS
2634#else
2635 0,
2636#endif
e9bf89a0
RS
2637};
2638
2639/* This is a list of Lisp names for special "accent" characters.
2640 It parallels lispy_accent_codes. */
2641
2642static char *lispy_accent_keys[] =
2643{
2644 "dead-circumflex",
2645 "dead-grave",
2646 "dead-tilde",
2647 "dead-diaeresis",
2648 "dead-macron",
2649 "dead-degree",
2650 "dead-acute",
2651 "dead-cedilla",
2652 "dead-breve",
2653 "dead-ogonek",
2654 "dead-caron",
2655 "dead-doubleacute",
2656 "dead-abovedot",
2657};
2658
284f4730
JB
2659/* You'll notice that this table is arranged to be conveniently
2660 indexed by X Windows keysym values. */
2661static char *lispy_function_keys[] =
2662 {
2663 /* X Keysym value */
2664
80e4aa30 2665 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00 */
86e5706b
RS
2666 "backspace",
2667 "tab",
2668 "linefeed",
2669 "clear",
2670 0,
2671 "return",
2672 0, 0,
2673 0, 0, 0, /* 0xff10 */
2674 "pause",
2675 0, 0, 0, 0, 0, 0, 0,
2676 "escape",
2677 0, 0, 0, 0,
2678 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff20...2f */
2679 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff30...3f */
2680 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
2681
284f4730
JB
2682 "home", /* 0xff50 */ /* IsCursorKey */
2683 "left",
2684 "up",
2685 "right",
2686 "down",
2687 "prior",
2688 "next",
2689 "end",
2690 "begin",
2691 0, /* 0xff59 */
2692 0, 0, 0, 0, 0, 0,
2693 "select", /* 0xff60 */ /* IsMiscFunctionKey */
2694 "print",
2695 "execute",
2696 "insert",
2697 0, /* 0xff64 */
2698 "undo",
2699 "redo",
2700 "menu",
2701 "find",
2702 "cancel",
2703 "help",
2704 "break", /* 0xff6b */
2705
9fdbfdf8 2706 0, 0, 0, 0, 0, 0, 0, 0, "backtab", 0,
284f4730 2707 0, /* 0xff76 */
36ae397e 2708 0, 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff7f */
284f4730
JB
2709 "kp-space", /* 0xff80 */ /* IsKeypadKey */
2710 0, 0, 0, 0, 0, 0, 0, 0,
2711 "kp-tab", /* 0xff89 */
2712 0, 0, 0,
2713 "kp-enter", /* 0xff8d */
2714 0, 0, 0,
2715 "kp-f1", /* 0xff91 */
2716 "kp-f2",
2717 "kp-f3",
2718 "kp-f4",
872157e7
RS
2719 "kp-home", /* 0xff95 */
2720 "kp-left",
2721 "kp-up",
2722 "kp-right",
2723 "kp-down",
2724 "kp-prior", /* kp-page-up */
2725 "kp-next", /* kp-page-down */
2726 "kp-end",
2727 "kp-begin",
2728 "kp-insert",
2729 "kp-delete",
2730 0, /* 0xffa0 */
2731 0, 0, 0, 0, 0, 0, 0, 0, 0,
284f4730
JB
2732 "kp-multiply", /* 0xffaa */
2733 "kp-add",
2734 "kp-separator",
2735 "kp-subtract",
2736 "kp-decimal",
2737 "kp-divide", /* 0xffaf */
2738 "kp-0", /* 0xffb0 */
2739 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
2740 0, /* 0xffba */
2741 0, 0,
2742 "kp-equal", /* 0xffbd */
2743 "f1", /* 0xffbe */ /* IsFunctionKey */
86e5706b
RS
2744 "f2",
2745 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
2746 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
2747 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
2748 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
2749 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
2750 0, 0, 0, 0, 0, 0, 0, 0,
2751 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
2752 0, 0, 0, 0, 0, 0, 0, "delete"
284f4730
JB
2753 };
2754
2755static char *lispy_mouse_names[] =
2756{
2757 "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5"
2758};
2759
3c370943 2760/* Scroll bar parts. */
4bb994d1
JB
2761Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
2762
3c370943
JB
2763/* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
2764Lisp_Object *scroll_bar_parts[] = {
4bb994d1
JB
2765 &Qabove_handle, &Qhandle, &Qbelow_handle
2766};
2767
2768
7b4aedb9 2769/* A vector, indexed by button number, giving the down-going location
3c370943 2770 of currently depressed buttons, both scroll bar and non-scroll bar.
7b4aedb9
JB
2771
2772 The elements have the form
2773 (BUTTON-NUMBER MODIFIER-MASK . REST)
2774 where REST is the cdr of a position as it would be reported in the event.
2775
2776 The make_lispy_event function stores positions here to tell the
2777 difference between click and drag events, and to store the starting
2778 location to be included in drag events. */
2779
2780static Lisp_Object button_down_location;
88cb0656 2781
fbcd35bd
JB
2782/* Information about the most recent up-going button event: Which
2783 button, what location, and what time. */
2784
559f9d04
RS
2785static int last_mouse_button;
2786static int last_mouse_x;
2787static int last_mouse_y;
2788static unsigned long button_down_time;
fbcd35bd 2789
564dc952
JB
2790/* The maximum time between clicks to make a double-click,
2791 or Qnil to disable double-click detection,
2792 or Qt for no time limit. */
2793Lisp_Object Vdouble_click_time;
fbcd35bd
JB
2794
2795/* The number of clicks in this multiple-click. */
2796
2797int double_click_count;
2798
bb936752
FP
2799#ifdef USE_X_TOOLKIT
2800extern Lisp_Object map_event_to_object ();
2801#endif /* USE_X_TOOLKIT */
2802
284f4730
JB
2803/* Given a struct input_event, build the lisp event which represents
2804 it. If EVENT is 0, build a mouse movement event from the mouse
88cb0656
JB
2805 movement buffer, which should have a movement event in it.
2806
2807 Note that events must be passed to this function in the order they
2808 are received; this function stores the location of button presses
2809 in order to build drag events when the button is released. */
284f4730
JB
2810
2811static Lisp_Object
2812make_lispy_event (event)
2813 struct input_event *event;
2814{
79a7046c
RS
2815 int i;
2816
0220c518 2817 switch (SWITCH_ENUM_CAST (event->kind))
284f4730 2818 {
284f4730
JB
2819 /* A simple keystroke. */
2820 case ascii_keystroke:
86e5706b 2821 {
9343ab07 2822 Lisp_Object lispy_c;
e9bf89a0 2823 int c = event->code & 0377;
5a1c6df8
JB
2824 /* Turn ASCII characters into control characters
2825 when proper. */
2826 if (event->modifiers & ctrl_modifier)
d205953b
JB
2827 c = make_ctrl_char (c);
2828
2829 /* Add in the other modifier bits. We took care of ctrl_modifier
2830 just above, and the shift key was taken care of by the X code,
2831 and applied to control characters by make_ctrl_char. */
86e5706b
RS
2832 c |= (event->modifiers
2833 & (meta_modifier | alt_modifier
2834 | hyper_modifier | super_modifier));
559f9d04 2835 button_down_time = 0;
bb9e9bed 2836 XSETFASTINT (lispy_c, c);
9343ab07 2837 return lispy_c;
86e5706b 2838 }
284f4730
JB
2839
2840 /* A function key. The symbol may need to have modifier prefixes
2841 tacked onto it. */
2842 case non_ascii_keystroke:
559f9d04 2843 button_down_time = 0;
e9bf89a0
RS
2844
2845 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
2846 if (event->code == lispy_accent_codes[i])
2847 return modify_event_symbol (i,
2848 event->modifiers,
80e4aa30 2849 Qfunction_key, Qnil,
e9bf89a0
RS
2850 lispy_accent_keys, &accent_key_syms,
2851 (sizeof (lispy_accent_keys)
2852 / sizeof (lispy_accent_keys[0])));
2853
270a208f 2854 /* Handle system-specific keysyms. */
80e4aa30
RS
2855 if (event->code & (1 << 28))
2856 {
2857 /* We need to use an alist rather than a vector as the cache
2858 since we can't make a vector long enuf. */
270a208f
RS
2859 if (NILP (system_key_syms))
2860 system_key_syms = Fcons (Qnil, Qnil);
80e4aa30
RS
2861 return modify_event_symbol (event->code & 0xffffff,
2862 event->modifiers,
270a208f
RS
2863 Qfunction_key, Vsystem_key_alist,
2864 0, &system_key_syms, 0xffffff);
80e4aa30
RS
2865 }
2866
e9bf89a0
RS
2867 return modify_event_symbol (event->code - 0xff00,
2868 event->modifiers,
80e4aa30 2869 Qfunction_key, Qnil,
284f4730
JB
2870 lispy_function_keys, &func_key_syms,
2871 (sizeof (lispy_function_keys)
2872 / sizeof (lispy_function_keys[0])));
2873 break;
2874
87485d6f 2875#if defined (MULTI_FRAME) || defined (HAVE_MOUSE)
88cb0656
JB
2876 /* A mouse click. Figure out where it is, decide whether it's
2877 a press, click or drag, and build the appropriate structure. */
284f4730 2878 case mouse_click:
3c370943 2879 case scroll_bar_click:
284f4730 2880 {
e9bf89a0 2881 int button = event->code;
559f9d04 2882 int is_double;
7b4aedb9 2883 Lisp_Object position;
dbc4e1c1
JB
2884 Lisp_Object *start_pos_ptr;
2885 Lisp_Object start_pos;
284f4730 2886
7b4aedb9 2887 if (button < 0 || button >= NUM_MOUSE_BUTTONS)
88cb0656
JB
2888 abort ();
2889
7b4aedb9
JB
2890 /* Build the position as appropriate for this mouse click. */
2891 if (event->kind == mouse_click)
284f4730 2892 {
7b4aedb9 2893 int part;
598a9fa7 2894 FRAME_PTR f = XFRAME (event->frame_or_window);
0aafc975 2895 Lisp_Object window;
7b4aedb9 2896 Lisp_Object posn;
9e20143a
RS
2897 int row, column;
2898
5da3133a
RS
2899 /* Ignore mouse events that were made on frame that
2900 have been deleted. */
2901 if (! FRAME_LIVE_P (f))
2902 return Qnil;
2903
9e20143a 2904 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
eef045bf 2905 &column, &row, 0, 1);
7b4aedb9 2906
eef045bf
RS
2907#ifndef USE_X_TOOLKIT
2908 /* In the non-toolkit version, clicks on the menu bar
2909 are ordinary button events in the event buffer.
2910 Distinguish them, and invoke the menu.
2911
2912 (In the toolkit version, the toolkit handles the menu bar
2913 and Emacs doesn't know about it until after the user
2914 makes a selection.) */
2915 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f))
bb936752 2916 {
b7c49376 2917 Lisp_Object items, item;
0a0e8fe6
RS
2918 int hpos;
2919 int i;
2920
2921 /* Activate the menu bar on the down event. If the
2922 up event comes in before the menu code can deal with it,
2923 just ignore it. */
2924 if (! (event->modifiers & down_modifier))
2925 return Qnil;
0aafc975 2926
f2ae6b3f 2927 item = Qnil;
5ec75a55 2928 items = FRAME_MENU_BAR_ITEMS (f);
b7c49376 2929 for (i = 0; i < XVECTOR (items)->size; i += 3)
5ec75a55
RS
2930 {
2931 Lisp_Object pos, string;
b7c49376
RS
2932 string = XVECTOR (items)->contents[i + 1];
2933 pos = XVECTOR (items)->contents[i + 2];
2934 if (NILP (string))
2935 break;
9e20143a
RS
2936 if (column >= XINT (pos)
2937 && column < XINT (pos) + XSTRING (string)->size)
b7c49376
RS
2938 {
2939 item = XVECTOR (items)->contents[i];
2940 break;
2941 }
5ec75a55 2942 }
9e20143a 2943
5ec75a55
RS
2944 position
2945 = Fcons (event->frame_or_window,
2946 Fcons (Qmenu_bar,
2947 Fcons (Fcons (event->x, event->y),
2948 Fcons (make_number (event->timestamp),
2949 Qnil))));
2950
b7c49376 2951 return Fcons (item, Fcons (position, Qnil));
5ec75a55 2952 }
eef045bf 2953#endif /* not USE_X_TOOLKIT */
0aafc975 2954
9e20143a 2955 window = window_from_coordinates (f, column, row, &part);
0aafc975 2956
8c18cbfb 2957 if (!WINDOWP (window))
78ced549
RS
2958 {
2959 window = event->frame_or_window;
2960 posn = Qnil;
2961 }
284f4730 2962 else
7b4aedb9 2963 {
9e20143a
RS
2964 int pixcolumn, pixrow;
2965 column -= XINT (XWINDOW (window)->left);
2966 row -= XINT (XWINDOW (window)->top);
2967 glyph_to_pixel_coords (f, column, row, &pixcolumn, &pixrow);
2968 XSETINT (event->x, pixcolumn);
2969 XSETINT (event->y, pixrow);
dbc4e1c1 2970
7b4aedb9
JB
2971 if (part == 1)
2972 posn = Qmode_line;
2973 else if (part == 2)
2974 posn = Qvertical_line;
2975 else
18cd2eeb
KH
2976 XSETINT (posn,
2977 buffer_posn_from_coords (XWINDOW (window),
2978 column, row));
7b4aedb9
JB
2979 }
2980
5ec75a55
RS
2981 position
2982 = Fcons (window,
2983 Fcons (posn,
2984 Fcons (Fcons (event->x, event->y),
2985 Fcons (make_number (event->timestamp),
2986 Qnil))));
284f4730 2987 }
7b4aedb9 2988 else
88cb0656 2989 {
9e20143a
RS
2990 Lisp_Object window;
2991 Lisp_Object portion_whole;
2992 Lisp_Object part;
2993
2994 window = event->frame_or_window;
2995 portion_whole = Fcons (event->x, event->y);
2996 part = *scroll_bar_parts[(int) event->part];
7b4aedb9
JB
2997
2998 position =
2999 Fcons (window,
3c370943 3000 Fcons (Qvertical_scroll_bar,
7b4aedb9
JB
3001 Fcons (portion_whole,
3002 Fcons (make_number (event->timestamp),
9e20143a 3003 Fcons (part, Qnil)))));
88cb0656
JB
3004 }
3005
dbc4e1c1
JB
3006 start_pos_ptr = &XVECTOR (button_down_location)->contents[button];
3007
3008 start_pos = *start_pos_ptr;
3009 *start_pos_ptr = Qnil;
7b4aedb9 3010
559f9d04
RS
3011 is_double = (button == last_mouse_button
3012 && XINT (event->x) == last_mouse_x
3013 && XINT (event->y) == last_mouse_y
3014 && button_down_time != 0
3015 && (EQ (Vdouble_click_time, Qt)
3016 || (INTEGERP (Vdouble_click_time)
3017 && ((int)(event->timestamp - button_down_time)
3018 < XINT (Vdouble_click_time)))));
3019 last_mouse_button = button;
3020 last_mouse_x = XINT (event->x);
3021 last_mouse_y = XINT (event->y);
3022
7b4aedb9
JB
3023 /* If this is a button press, squirrel away the location, so
3024 we can decide later whether it was a click or a drag. */
3025 if (event->modifiers & down_modifier)
559f9d04
RS
3026 {
3027 if (is_double)
3028 {
3029 double_click_count++;
3030 event->modifiers |= ((double_click_count > 2)
3031 ? triple_modifier
3032 : double_modifier);
3033 }
3034 else
3035 double_click_count = 1;
3036 button_down_time = event->timestamp;
3037 *start_pos_ptr = Fcopy_alist (position);
3038 }
7b4aedb9 3039
88cb0656 3040 /* Now we're releasing a button - check the co-ordinates to
7b4aedb9 3041 see if this was a click or a drag. */
88cb0656
JB
3042 else if (event->modifiers & up_modifier)
3043 {
48e416d4
RS
3044 /* If we did not see a down before this up,
3045 ignore the up. Probably this happened because
3046 the down event chose a menu item.
3047 It would be an annoyance to treat the release
3048 of the button that chose the menu item
3049 as a separate event. */
3050
8c18cbfb 3051 if (!CONSP (start_pos))
48e416d4
RS
3052 return Qnil;
3053
88cb0656 3054 event->modifiers &= ~up_modifier;
48e416d4 3055#if 0 /* Formerly we treated an up with no down as a click event. */
8c18cbfb 3056 if (!CONSP (start_pos))
dbc4e1c1
JB
3057 event->modifiers |= click_modifier;
3058 else
48e416d4 3059#endif
dbc4e1c1
JB
3060 {
3061 /* The third element of every position should be the (x,y)
3062 pair. */
9b8eb840 3063 Lisp_Object down;
dbc4e1c1 3064
9b8eb840 3065 down = Fnth (make_number (2), start_pos);
fbcd35bd
JB
3066 if (EQ (event->x, XCONS (down)->car)
3067 && EQ (event->y, XCONS (down)->cdr))
3068 {
bc536d84 3069 event->modifiers |= click_modifier;
fbcd35bd
JB
3070 }
3071 else
3072 {
559f9d04 3073 button_down_time = 0;
fbcd35bd
JB
3074 event->modifiers |= drag_modifier;
3075 }
bc536d84
RS
3076 /* Don't check is_double; treat this as multiple
3077 if the down-event was multiple. */
3078 if (double_click_count > 1)
3079 event->modifiers |= ((double_click_count > 2)
3080 ? triple_modifier
3081 : double_modifier);
dbc4e1c1 3082 }
88cb0656
JB
3083 }
3084 else
3085 /* Every mouse event should either have the down_modifier or
7b4aedb9 3086 the up_modifier set. */
88cb0656
JB
3087 abort ();
3088
88cb0656 3089 {
7b4aedb9 3090 /* Get the symbol we should use for the mouse click. */
9b8eb840
KH
3091 Lisp_Object head;
3092
3093 head = modify_event_symbol (button,
3094 event->modifiers,
3095 Qmouse_click, Qnil,
3096 lispy_mouse_names, &mouse_syms,
3097 (sizeof (lispy_mouse_names)
3098 / sizeof (lispy_mouse_names[0])));
88cb0656 3099 if (event->modifiers & drag_modifier)
dbc4e1c1
JB
3100 return Fcons (head,
3101 Fcons (start_pos,
3102 Fcons (position,
3103 Qnil)));
fbcd35bd
JB
3104 else if (event->modifiers & (double_modifier | triple_modifier))
3105 return Fcons (head,
3106 Fcons (position,
3107 Fcons (make_number (double_click_count),
3108 Qnil)));
88cb0656
JB
3109 else
3110 return Fcons (head,
7b4aedb9 3111 Fcons (position,
88cb0656
JB
3112 Qnil));
3113 }
284f4730 3114 }
5846638c 3115#endif /* MULTI_FRAME or HAVE_MOUSE */
284f4730 3116
284f4730
JB
3117 /* The 'kind' field of the event is something we don't recognize. */
3118 default:
48e416d4 3119 abort ();
284f4730
JB
3120 }
3121}
3122
87485d6f 3123#if defined (MULTI_FRAME) || defined (HAVE_MOUSE)
6cbff1cb 3124
284f4730 3125static Lisp_Object
7b4aedb9 3126make_lispy_movement (frame, bar_window, part, x, y, time)
ff11dfa1 3127 FRAME_PTR frame;
7b4aedb9 3128 Lisp_Object bar_window;
3c370943 3129 enum scroll_bar_part part;
284f4730 3130 Lisp_Object x, y;
e5d77022 3131 unsigned long time;
284f4730 3132{
68553292 3133#ifdef MULTI_FRAME
3c370943 3134 /* Is it a scroll bar movement? */
7b4aedb9 3135 if (frame && ! NILP (bar_window))
4bb994d1 3136 {
9b8eb840 3137 Lisp_Object part_sym;
4bb994d1 3138
9b8eb840 3139 part_sym = *scroll_bar_parts[(int) part];
3c370943 3140 return Fcons (Qscroll_bar_movement,
7b4aedb9 3141 (Fcons (Fcons (bar_window,
3c370943 3142 Fcons (Qvertical_scroll_bar,
4bb994d1
JB
3143 Fcons (Fcons (x, y),
3144 Fcons (make_number (time),
cb5df6ae 3145 Fcons (part_sym,
4bb994d1
JB
3146 Qnil))))),
3147 Qnil)));
3148 }
3149
3150 /* Or is it an ordinary mouse movement? */
284f4730 3151 else
68553292 3152#endif /* MULTI_FRAME */
284f4730 3153 {
4bb994d1 3154 int area;
9e20143a 3155 Lisp_Object window;
4bb994d1 3156 Lisp_Object posn;
9e20143a
RS
3157 int column, row;
3158
68553292 3159#ifdef MULTI_FRAME
9e20143a 3160 if (frame)
68553292
RS
3161#else
3162 if (1)
3163#endif
047688cb
RS
3164 {
3165 /* It's in a frame; which window on that frame? */
3166 pixel_to_glyph_coords (frame, XINT (x), XINT (y), &column, &row, 0, 1);
3167 window = window_from_coordinates (frame, column, row, &area);
3168 }
9e20143a
RS
3169 else
3170 window = Qnil;
4bb994d1 3171
8c18cbfb 3172 if (WINDOWP (window))
4bb994d1 3173 {
9e20143a
RS
3174 int pixcolumn, pixrow;
3175 column -= XINT (XWINDOW (window)->left);
3176 row -= XINT (XWINDOW (window)->top);
3177 glyph_to_pixel_coords (frame, column, row, &pixcolumn, &pixrow);
3178 XSETINT (x, pixcolumn);
3179 XSETINT (y, pixrow);
4bb994d1
JB
3180
3181 if (area == 1)
3182 posn = Qmode_line;
3183 else if (area == 2)
3184 posn = Qvertical_line;
3185 else
18cd2eeb
KH
3186 XSETINT (posn,
3187 buffer_posn_from_coords (XWINDOW (window), column, row));
4bb994d1 3188 }
68553292 3189#ifdef MULTI_FRAME
e9bf89a0
RS
3190 else if (frame != 0)
3191 {
18cd2eeb 3192 XSETFRAME (window, frame);
e9bf89a0
RS
3193 posn = Qnil;
3194 }
68553292 3195#endif
284f4730 3196 else
4bb994d1
JB
3197 {
3198 window = Qnil;
3199 posn = Qnil;
bb9e9bed
KH
3200 XSETFASTINT (x, 0);
3201 XSETFASTINT (y, 0);
4bb994d1 3202 }
284f4730 3203
4bb994d1
JB
3204 return Fcons (Qmouse_movement,
3205 Fcons (Fcons (window,
3206 Fcons (posn,
3207 Fcons (Fcons (x, y),
3208 Fcons (make_number (time),
3209 Qnil)))),
3210 Qnil));
3211 }
284f4730
JB
3212}
3213
68553292 3214#endif /* neither MULTI_FRAME nor HAVE_MOUSE */
6cbff1cb 3215
cd21b839
JB
3216/* Construct a switch frame event. */
3217static Lisp_Object
3218make_lispy_switch_frame (frame)
3219 Lisp_Object frame;
3220{
3221 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
3222}
0a7f1fc0
JB
3223\f
3224/* Manipulating modifiers. */
284f4730 3225
0a7f1fc0 3226/* Parse the name of SYMBOL, and return the set of modifiers it contains.
284f4730 3227
0a7f1fc0
JB
3228 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
3229 SYMBOL's name of the end of the modifiers; the string from this
3230 position is the unmodified symbol name.
284f4730 3231
0a7f1fc0 3232 This doesn't use any caches. */
6da3dd3a 3233
0a7f1fc0
JB
3234static int
3235parse_modifiers_uncached (symbol, modifier_end)
284f4730 3236 Lisp_Object symbol;
0a7f1fc0 3237 int *modifier_end;
284f4730
JB
3238{
3239 struct Lisp_String *name;
3240 int i;
3241 int modifiers;
284f4730
JB
3242
3243 CHECK_SYMBOL (symbol, 1);
3244
3245 modifiers = 0;
3246 name = XSYMBOL (symbol)->name;
3247
0a7f1fc0 3248 for (i = 0; i+2 <= name->size; )
6da3dd3a
RS
3249 {
3250 int this_mod_end = 0;
3251 int this_mod = 0;
284f4730 3252
6da3dd3a
RS
3253 /* See if the name continues with a modifier word.
3254 Check that the word appears, but don't check what follows it.
3255 Set this_mod and this_mod_end to record what we find. */
fce33686 3256
6da3dd3a
RS
3257 switch (name->data[i])
3258 {
3259#define SINGLE_LETTER_MOD(BIT) \
3260 (this_mod_end = i + 1, this_mod = BIT)
3261
6da3dd3a
RS
3262 case 'A':
3263 SINGLE_LETTER_MOD (alt_modifier);
3264 break;
284f4730 3265
6da3dd3a
RS
3266 case 'C':
3267 SINGLE_LETTER_MOD (ctrl_modifier);
3268 break;
284f4730 3269
6da3dd3a
RS
3270 case 'H':
3271 SINGLE_LETTER_MOD (hyper_modifier);
3272 break;
3273
6da3dd3a
RS
3274 case 'M':
3275 SINGLE_LETTER_MOD (meta_modifier);
3276 break;
3277
6da3dd3a
RS
3278 case 'S':
3279 SINGLE_LETTER_MOD (shift_modifier);
3280 break;
3281
3282 case 's':
6da3dd3a
RS
3283 SINGLE_LETTER_MOD (super_modifier);
3284 break;
3285
0a7f1fc0 3286#undef SINGLE_LETTER_MOD
6da3dd3a
RS
3287 }
3288
3289 /* If we found no modifier, stop looking for them. */
3290 if (this_mod_end == 0)
3291 break;
3292
3293 /* Check there is a dash after the modifier, so that it
3294 really is a modifier. */
3295 if (this_mod_end >= name->size || name->data[this_mod_end] != '-')
3296 break;
3297
3298 /* This modifier is real; look for another. */
3299 modifiers |= this_mod;
3300 i = this_mod_end + 1;
3301 }
284f4730 3302
0a7f1fc0 3303 /* Should we include the `click' modifier? */
fbcd35bd
JB
3304 if (! (modifiers & (down_modifier | drag_modifier
3305 | double_modifier | triple_modifier))
0a7f1fc0 3306 && i + 7 == name->size
4bb994d1 3307 && strncmp (name->data + i, "mouse-", 6) == 0
6569cc8d 3308 && ('0' <= name->data[i + 6] && name->data[i + 6] <= '9'))
0a7f1fc0
JB
3309 modifiers |= click_modifier;
3310
3311 if (modifier_end)
3312 *modifier_end = i;
3313
3314 return modifiers;
3315}
3316
0a7f1fc0
JB
3317/* Return a symbol whose name is the modifier prefixes for MODIFIERS
3318 prepended to the string BASE[0..BASE_LEN-1].
3319 This doesn't use any caches. */
3320static Lisp_Object
3321apply_modifiers_uncached (modifiers, base, base_len)
3322 int modifiers;
3323 char *base;
3324 int base_len;
3325{
3326 /* Since BASE could contain nulls, we can't use intern here; we have
3327 to use Fintern, which expects a genuine Lisp_String, and keeps a
3328 reference to it. */
3329 char *new_mods =
fbcd35bd 3330 (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
0a7f1fc0 3331 int mod_len;
284f4730 3332
284f4730 3333 {
0a7f1fc0
JB
3334 char *p = new_mods;
3335
3336 /* Only the event queue may use the `up' modifier; it should always
3337 be turned into a click or drag event before presented to lisp code. */
3338 if (modifiers & up_modifier)
3339 abort ();
3340
3341 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
3342 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
3343 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
3344 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
3345 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
86e5706b 3346 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
fbcd35bd
JB
3347 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
3348 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
559f9d04
RS
3349 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
3350 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
0a7f1fc0
JB
3351 /* The click modifier is denoted by the absence of other modifiers. */
3352
3353 *p = '\0';
3354
3355 mod_len = p - new_mods;
3356 }
284f4730 3357
0a7f1fc0 3358 {
9b8eb840 3359 Lisp_Object new_name;
0a7f1fc0 3360
9b8eb840 3361 new_name = make_uninit_string (mod_len + base_len);
0a7f1fc0
JB
3362 bcopy (new_mods, XSTRING (new_name)->data, mod_len);
3363 bcopy (base, XSTRING (new_name)->data + mod_len, base_len);
284f4730
JB
3364
3365 return Fintern (new_name, Qnil);
3366 }
3367}
3368
3369
0a7f1fc0
JB
3370static char *modifier_names[] =
3371{
fbcd35bd 3372 "up", "down", "drag", "click", "double", "triple", 0, 0,
1dfdf9e2 3373 0, 0, 0, 0, 0, 0, 0, 0,
86e5706b 3374 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
0a7f1fc0 3375};
80645119 3376#define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
0a7f1fc0
JB
3377
3378static Lisp_Object modifier_symbols;
3379
3380/* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
3381static Lisp_Object
3382lispy_modifier_list (modifiers)
3383 int modifiers;
3384{
3385 Lisp_Object modifier_list;
3386 int i;
3387
3388 modifier_list = Qnil;
80645119 3389 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
0a7f1fc0 3390 if (modifiers & (1<<i))
80645119
JB
3391 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
3392 modifier_list);
0a7f1fc0
JB
3393
3394 return modifier_list;
3395}
3396
3397
3398/* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
3399 where UNMODIFIED is the unmodified form of SYMBOL,
3400 MASK is the set of modifiers present in SYMBOL's name.
3401 This is similar to parse_modifiers_uncached, but uses the cache in
3402 SYMBOL's Qevent_symbol_element_mask property, and maintains the
3403 Qevent_symbol_elements property. */
3d31316f 3404
0a7f1fc0
JB
3405static Lisp_Object
3406parse_modifiers (symbol)
3407 Lisp_Object symbol;
3408{
9b8eb840 3409 Lisp_Object elements;
0a7f1fc0 3410
9b8eb840 3411 elements = Fget (symbol, Qevent_symbol_element_mask);
0a7f1fc0
JB
3412 if (CONSP (elements))
3413 return elements;
3414 else
3415 {
3416 int end;
3417 int modifiers = parse_modifiers_uncached (symbol, &end);
9b8eb840 3418 Lisp_Object unmodified;
0a7f1fc0
JB
3419 Lisp_Object mask;
3420
9b8eb840
KH
3421 unmodified = Fintern (make_string (XSYMBOL (symbol)->name->data + end,
3422 XSYMBOL (symbol)->name->size - end),
3423 Qnil);
3424
734fef94
JB
3425 if (modifiers & ~((1<<VALBITS) - 1))
3426 abort ();
bb9e9bed 3427 XSETFASTINT (mask, modifiers);
0a7f1fc0
JB
3428 elements = Fcons (unmodified, Fcons (mask, Qnil));
3429
3430 /* Cache the parsing results on SYMBOL. */
3431 Fput (symbol, Qevent_symbol_element_mask,
3432 elements);
3433 Fput (symbol, Qevent_symbol_elements,
3434 Fcons (unmodified, lispy_modifier_list (modifiers)));
3435
3436 /* Since we know that SYMBOL is modifiers applied to unmodified,
3437 it would be nice to put that in unmodified's cache.
3438 But we can't, since we're not sure that parse_modifiers is
3439 canonical. */
3440
3441 return elements;
3442 }
3443}
3444
3445/* Apply the modifiers MODIFIERS to the symbol BASE.
3446 BASE must be unmodified.
3447
3448 This is like apply_modifiers_uncached, but uses BASE's
3449 Qmodifier_cache property, if present. It also builds
cd21b839
JB
3450 Qevent_symbol_elements properties, since it has that info anyway.
3451
3452 apply_modifiers copies the value of BASE's Qevent_kind property to
3453 the modified symbol. */
0a7f1fc0
JB
3454static Lisp_Object
3455apply_modifiers (modifiers, base)
3456 int modifiers;
3457 Lisp_Object base;
3458{
7b4aedb9 3459 Lisp_Object cache, index, entry, new_symbol;
0a7f1fc0 3460
80645119
JB
3461 /* Mask out upper bits. We don't know where this value's been. */
3462 modifiers &= (1<<VALBITS) - 1;
3463
0a7f1fc0 3464 /* The click modifier never figures into cache indices. */
0a7f1fc0 3465 cache = Fget (base, Qmodifier_cache);
bb9e9bed 3466 XSETFASTINT (index, (modifiers & ~click_modifier));
697e4895 3467 entry = assq_no_quit (index, cache);
0a7f1fc0
JB
3468
3469 if (CONSP (entry))
7b4aedb9
JB
3470 new_symbol = XCONS (entry)->cdr;
3471 else
3472 {
3473 /* We have to create the symbol ourselves. */
3474 new_symbol = apply_modifiers_uncached (modifiers,
3475 XSYMBOL (base)->name->data,
3476 XSYMBOL (base)->name->size);
3477
3478 /* Add the new symbol to the base's cache. */
3479 entry = Fcons (index, new_symbol);
3480 Fput (base, Qmodifier_cache, Fcons (entry, cache));
3481
3482 /* We have the parsing info now for free, so add it to the caches. */
bb9e9bed 3483 XSETFASTINT (index, modifiers);
7b4aedb9
JB
3484 Fput (new_symbol, Qevent_symbol_element_mask,
3485 Fcons (base, Fcons (index, Qnil)));
3486 Fput (new_symbol, Qevent_symbol_elements,
3487 Fcons (base, lispy_modifier_list (modifiers)));
3488 }
0a7f1fc0 3489
7b4aedb9
JB
3490 /* Make sure this symbol is of the same kind as BASE.
3491
3492 You'd think we could just set this once and for all when we
3493 intern the symbol above, but reorder_modifiers may call us when
3494 BASE's property isn't set right; we can't assume that just
80645119
JB
3495 because it has a Qmodifier_cache property it must have its
3496 Qevent_kind set right as well. */
7b4aedb9
JB
3497 if (NILP (Fget (new_symbol, Qevent_kind)))
3498 {
9b8eb840 3499 Lisp_Object kind;
7b4aedb9 3500
9b8eb840 3501 kind = Fget (base, Qevent_kind);
7b4aedb9
JB
3502 if (! NILP (kind))
3503 Fput (new_symbol, Qevent_kind, kind);
3504 }
3505
3506 return new_symbol;
0a7f1fc0
JB
3507}
3508
3509
3510/* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
3511 return a symbol with the modifiers placed in the canonical order.
3512 Canonical order is alphabetical, except for down and drag, which
3513 always come last. The 'click' modifier is never written out.
3514
3515 Fdefine_key calls this to make sure that (for example) C-M-foo
3516 and M-C-foo end up being equivalent in the keymap. */
3517
3518Lisp_Object
3519reorder_modifiers (symbol)
3520 Lisp_Object symbol;
3521{
3522 /* It's hopefully okay to write the code this way, since everything
3523 will soon be in caches, and no consing will be done at all. */
9b8eb840 3524 Lisp_Object parsed;
0a7f1fc0 3525
9b8eb840 3526 parsed = parse_modifiers (symbol);
0a7f1fc0
JB
3527 return apply_modifiers (XCONS (XCONS (parsed)->cdr)->car,
3528 XCONS (parsed)->car);
3529}
3530
3531
284f4730
JB
3532/* For handling events, we often want to produce a symbol whose name
3533 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
3534 to some base, like the name of a function key or mouse button.
3535 modify_event_symbol produces symbols of this sort.
3536
3537 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
3538 is the name of the i'th symbol. TABLE_SIZE is the number of elements
3539 in the table.
3540
80e4aa30
RS
3541 Alternatively, NAME_ALIST is an alist mapping codes into symbol names.
3542 NAME_ALIST is used if it is non-nil; otherwise NAME_TABLE is used.
3543
284f4730
JB
3544 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
3545 persist between calls to modify_event_symbol that it can use to
3546 store a cache of the symbols it's generated for this NAME_TABLE
80e4aa30 3547 before. The object stored there may be a vector or an alist.
284f4730
JB
3548
3549 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
3550
3551 MODIFIERS is a set of modifier bits (as given in struct input_events)
3552 whose prefixes should be applied to the symbol name.
3553
3554 SYMBOL_KIND is the value to be placed in the event_kind property of
88cb0656
JB
3555 the returned symbol.
3556
3557 The symbols we create are supposed to have an
eb8c3be9 3558 `event-symbol-elements' property, which lists the modifiers present
88cb0656
JB
3559 in the symbol's name. */
3560
284f4730 3561static Lisp_Object
80e4aa30
RS
3562modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist,
3563 name_table, symbol_table, table_size)
284f4730
JB
3564 int symbol_num;
3565 unsigned modifiers;
3566 Lisp_Object symbol_kind;
80e4aa30 3567 Lisp_Object name_alist;
284f4730
JB
3568 char **name_table;
3569 Lisp_Object *symbol_table;
3570 int table_size;
3571{
80e4aa30
RS
3572 Lisp_Object value;
3573 Lisp_Object symbol_int;
3574
18cd2eeb 3575 XSETINT (symbol_int, symbol_num);
284f4730
JB
3576
3577 /* Is this a request for a valid symbol? */
88cb0656 3578 if (symbol_num < 0 || symbol_num >= table_size)
0c2611c5 3579 return Qnil;
284f4730 3580
80e4aa30
RS
3581 if (CONSP (*symbol_table))
3582 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
3583
0a7f1fc0 3584 /* If *symbol_table doesn't seem to be initialized properly, fix that.
88cb0656 3585 *symbol_table should be a lisp vector TABLE_SIZE elements long,
4bb994d1
JB
3586 where the Nth element is the symbol for NAME_TABLE[N], or nil if
3587 we've never used that symbol before. */
80e4aa30 3588 else
88cb0656 3589 {
80e4aa30
RS
3590 if (! VECTORP (*symbol_table)
3591 || XVECTOR (*symbol_table)->size != table_size)
3592 {
3593 Lisp_Object size;
0a7f1fc0 3594
bb9e9bed 3595 XSETFASTINT (size, table_size);
80e4aa30
RS
3596 *symbol_table = Fmake_vector (size, Qnil);
3597 }
284f4730 3598
80e4aa30
RS
3599 value = XVECTOR (*symbol_table)->contents[symbol_num];
3600 }
284f4730 3601
0a7f1fc0 3602 /* Have we already used this symbol before? */
80e4aa30 3603 if (NILP (value))
284f4730 3604 {
0a7f1fc0 3605 /* No; let's create it. */
80e4aa30 3606 if (!NILP (name_alist))
b64b4075 3607 value = Fcdr_safe (Fassq (symbol_int, name_alist));
80e4aa30
RS
3608 else if (name_table[symbol_num])
3609 value = intern (name_table[symbol_num]);
b64b4075
RS
3610
3611 if (NILP (value))
d1f50460
RS
3612 {
3613 char buf[20];
3614 sprintf (buf, "key-%d", symbol_num);
80e4aa30 3615 value = intern (buf);
d1f50460 3616 }
0a7f1fc0 3617
80e4aa30
RS
3618 if (CONSP (*symbol_table))
3619 *symbol_table = Fcons (value, *symbol_table);
3620 else
3621 XVECTOR (*symbol_table)->contents[symbol_num] = value;
3622
0a7f1fc0
JB
3623 /* Fill in the cache entries for this symbol; this also
3624 builds the Qevent_symbol_elements property, which the user
3625 cares about. */
80e4aa30
RS
3626 apply_modifiers (modifiers & click_modifier, value);
3627 Fput (value, Qevent_kind, symbol_kind);
284f4730 3628 }
88cb0656 3629
0a7f1fc0 3630 /* Apply modifiers to that symbol. */
80e4aa30 3631 return apply_modifiers (modifiers, value);
284f4730 3632}
6da3dd3a
RS
3633\f
3634/* Convert a list that represents an event type,
3635 such as (ctrl meta backspace), into the usual representation of that
3636 event type as a number or a symbol. */
3637
3638Lisp_Object
3639convert_event_type_list (event)
3640 Lisp_Object event;
3641{
3642 Lisp_Object base;
3643 int modifiers = 0;
3644 Lisp_Object rest;
3645
3646 base = Qnil;
3647 rest = event;
3648 while (CONSP (rest))
3649 {
3650 Lisp_Object elt;
3651 int this = 0;
3652
3653 elt = XCONS (rest)->car;
3654
3d31316f 3655 /* Given a symbol, see if it is a modifier name. */
6da3dd3a 3656 if (SYMBOLP (elt))
3d31316f 3657 this = parse_solitary_modifier (elt);
6da3dd3a
RS
3658
3659 if (this != 0)
3660 modifiers |= this;
3661 else if (!NILP (base))
3662 error ("Two bases given in one event");
3663 else
3664 base = elt;
3665
3666 rest = XCONS (rest)->cdr;
3667 }
3668
3d31316f
RS
3669 /* Let the symbol A refer to the character A. */
3670 if (SYMBOLP (base) && XSYMBOL (base)->name->size == 1)
3671 XSETINT (base, XSYMBOL (base)->name->data[0]);
3672
6da3dd3a
RS
3673 if (INTEGERP (base))
3674 {
3d31316f
RS
3675 /* Turn (shift a) into A. */
3676 if ((modifiers & shift_modifier) != 0
3677 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
3678 {
3679 XSETINT (base, XINT (base) - ('a' - 'A'));
3680 modifiers &= ~shift_modifier;
3681 }
3682
3683 /* Turn (control a) into C-a. */
6da3dd3a 3684 if (modifiers & ctrl_modifier)
3d31316f 3685 return make_number ((modifiers & ~ctrl_modifier)
6da3dd3a
RS
3686 | make_ctrl_char (XINT (base)));
3687 else
3688 return make_number (modifiers | XINT (base));
3689 }
3690 else if (SYMBOLP (base))
3691 return apply_modifiers (modifiers, base);
3692 else
3693 error ("Invalid base event");
3694}
3695
3d31316f
RS
3696/* Try to recognize SYMBOL as a modifier name.
3697 Return the modifier flag bit, or 0 if not recognized. */
3698
3699static int
3700parse_solitary_modifier (symbol)
3701 Lisp_Object symbol;
3702{
3703 struct Lisp_String *name = XSYMBOL (symbol)->name;
3704
3705 switch (name->data[0])
3706 {
3707#define SINGLE_LETTER_MOD(BIT) \
3708 if (name->size == 1) \
3709 return BIT;
3710
3711#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
3712 if (LEN == name->size \
3713 && ! strncmp (name->data, NAME, LEN)) \
3714 return BIT;
3715
3716 case 'A':
3717 SINGLE_LETTER_MOD (alt_modifier);
3718 break;
3719
3720 case 'a':
3721 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
3722 break;
3723
3724 case 'C':
3725 SINGLE_LETTER_MOD (ctrl_modifier);
3726 break;
3727
3728 case 'c':
3729 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
3730 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
3731 break;
3732
3733 case 'H':
3734 SINGLE_LETTER_MOD (hyper_modifier);
3735 break;
3736
3737 case 'h':
3738 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
3739 break;
3740
3741 case 'M':
3742 SINGLE_LETTER_MOD (meta_modifier);
3743 break;
3744
3745 case 'm':
3746 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
3747 break;
3748
3749 case 'S':
3750 SINGLE_LETTER_MOD (shift_modifier);
3751 break;
3752
3753 case 's':
3754 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
3755 MULTI_LETTER_MOD (super_modifier, "super", 5);
3756 SINGLE_LETTER_MOD (super_modifier);
3757 break;
3758
3759 case 'd':
3760 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
3761 MULTI_LETTER_MOD (down_modifier, "down", 4);
3762 MULTI_LETTER_MOD (double_modifier, "double", 6);
3763 break;
3764
3765 case 't':
3766 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
3767 break;
3768
3769#undef SINGLE_LETTER_MOD
3770#undef MULTI_LETTER_MOD
3771 }
3772
3773 return 0;
3774}
3775
6da3dd3a
RS
3776/* Return 1 if EVENT is a list whose elements are all integers or symbols.
3777 Such a list is not valid as an event,
3778 but it can be a Lucid-style event type list. */
3779
3780int
3781lucid_event_type_list_p (object)
3782 Lisp_Object object;
3783{
3784 Lisp_Object tail;
3785
3786 if (! CONSP (object))
3787 return 0;
3788
3789 for (tail = object; CONSP (tail); tail = XCONS (tail)->cdr)
3790 {
3791 Lisp_Object elt;
3792 elt = XCONS (tail)->car;
3793 if (! (INTEGERP (elt) || SYMBOLP (elt)))
3794 return 0;
3795 }
3796
3797 return NILP (tail);
3798}
284f4730 3799\f
284f4730
JB
3800/* Store into *addr a value nonzero if terminal input chars are available.
3801 Serves the purpose of ioctl (0, FIONREAD, addr)
3802 but works even if FIONREAD does not exist.
3803 (In fact, this may actually read some input.) */
3804
3805static void
3806get_input_pending (addr)
3807 int *addr;
3808{
3809 /* First of all, have we already counted some input? */
3810 *addr = !NILP (Vquit_flag) || readable_events ();
3811
3812 /* If input is being read as it arrives, and we have none, there is none. */
3813 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
3814 return;
3815
3816 /* Try to read some input and see how much we get. */
3817 gobble_input (0);
3818 *addr = !NILP (Vquit_flag) || readable_events ();
3819}
3820
81931ba1 3821/* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
284f4730
JB
3822
3823int
3824gobble_input (expected)
3825 int expected;
3826{
3827#ifndef VMS
3828#ifdef SIGIO
3829 if (interrupt_input)
3830 {
32676c08 3831 SIGMASKTYPE mask;
e065a56e 3832 mask = sigblockx (SIGIO);
284f4730 3833 read_avail_input (expected);
e065a56e 3834 sigsetmask (mask);
284f4730
JB
3835 }
3836 else
81931ba1
RS
3837#ifdef POLL_FOR_INPUT
3838 if (read_socket_hook && !interrupt_input && poll_suppress_count == 0)
3839 {
3840 SIGMASKTYPE mask;
3841 mask = sigblockx (SIGALRM);
3842 read_avail_input (expected);
3843 sigsetmask (mask);
3844 }
3845 else
87485d6f 3846#endif
284f4730
JB
3847#endif
3848 read_avail_input (expected);
3849#endif
3850}
a8015ab5 3851
241ceaf7
RS
3852/* Put a buffer_switch_event in the buffer
3853 so that read_key_sequence will notice the new current buffer. */
3854
a8015ab5
KH
3855record_asynch_buffer_change ()
3856{
3857 struct input_event event;
a30f0615
RS
3858 Lisp_Object tem;
3859
a8015ab5
KH
3860 event.kind = buffer_switch_event;
3861 event.frame_or_window = Qnil;
241ceaf7 3862
f65e6f7d 3863#ifdef subprocesses
a30f0615
RS
3864 /* We don't need a buffer-switch event unless Emacs is waiting for input.
3865 The purpose of the event is to make read_key_sequence look up the
3866 keymaps again. If we aren't in read_key_sequence, we don't need one,
3867 and the event could cause trouble by messing up (input-pending-p). */
3868 tem = Fwaiting_for_user_input_p ();
3869 if (NILP (tem))
3870 return;
f65e6f7d
RS
3871#else
3872 /* We never need these events if we have no asynchronous subprocesses. */
3873 return;
3874#endif
a30f0615 3875
241ceaf7
RS
3876 /* Make sure no interrupt happens while storing the event. */
3877#ifdef SIGIO
3878 if (interrupt_input)
3879 {
3880 SIGMASKTYPE mask;
3881 mask = sigblockx (SIGIO);
3882 kbd_buffer_store_event (&event);
3883 sigsetmask (mask);
3884 }
3885 else
3886#endif
3887 {
3888 stop_polling ();
3889 kbd_buffer_store_event (&event);
3890 start_polling ();
3891 }
a8015ab5 3892}
284f4730
JB
3893\f
3894#ifndef VMS
3895
3896/* Read any terminal input already buffered up by the system
3897 into the kbd_buffer, but do not wait.
3898
3899 EXPECTED should be nonzero if the caller knows there is some input.
3900
3901 Except on VMS, all input is read by this function.
3902 If interrupt_input is nonzero, this function MUST be called
3903 only when SIGIO is blocked.
3904
3905 Returns the number of keyboard chars read, or -1 meaning
3906 this is a bad time to try to read input. */
3907
3908static int
3909read_avail_input (expected)
3910 int expected;
3911{
3912 struct input_event buf[KBD_BUFFER_SIZE];
3913 register int i;
3914 int nread;
3915
3916 if (read_socket_hook)
3917 /* No need for FIONREAD or fcntl; just say don't wait. */
437f6112
RS
3918 nread = (*read_socket_hook) (input_fd, buf, KBD_BUFFER_SIZE,
3919 expected, expected);
284f4730
JB
3920 else
3921 {
17270835
RS
3922 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
3923 the kbd_buffer can really hold. That may prevent loss
3924 of characters on some systems when input is stuffed at us. */
3925 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
58788063 3926 int n_to_read;
284f4730 3927
58788063 3928 /* Determine how many characters we should *try* to read. */
bc536d84
RS
3929#ifdef WINDOWSNT
3930 return 0;
3931#else /* not WINDOWSNT */
80e4aa30 3932#ifdef MSDOS
58788063
RS
3933 n_to_read = dos_keysns ();
3934 if (n_to_read == 0)
3935 return 0;
c3a2738c 3936#else /* not MSDOS */
284f4730
JB
3937#ifdef FIONREAD
3938 /* Find out how much input is available. */
437f6112 3939 if (ioctl (input_fd, FIONREAD, &n_to_read) < 0)
284f4730
JB
3940 /* Formerly simply reported no input, but that sometimes led to
3941 a failure of Emacs to terminate.
3942 SIGHUP seems appropriate if we can't reach the terminal. */
e4535288
RS
3943 /* ??? Is it really right to send the signal just to this process
3944 rather than to the whole process group?
3945 Perhaps on systems with FIONREAD Emacs is alone in its group. */
284f4730 3946 kill (getpid (), SIGHUP);
58788063 3947 if (n_to_read == 0)
284f4730 3948 return 0;
58788063
RS
3949 if (n_to_read > sizeof cbuf)
3950 n_to_read = sizeof cbuf;
284f4730 3951#else /* no FIONREAD */
482952ef 3952#if defined(USG) || defined(DGUX)
284f4730 3953 /* Read some input if available, but don't wait. */
58788063 3954 n_to_read = sizeof cbuf;
437f6112 3955 fcntl (input_fd, F_SETFL, O_NDELAY);
284f4730
JB
3956#else
3957 you lose;
3958#endif
3959#endif
80e4aa30 3960#endif /* not MSDOS */
bc536d84 3961#endif /* not WINDOWSNT */
284f4730 3962
58788063
RS
3963 /* Now read; for one reason or another, this will not block.
3964 NREAD is set to the number of chars read. */
9134775b 3965 do
284f4730 3966 {
80e4aa30
RS
3967#ifdef MSDOS
3968 cbuf[0] = dos_keyread();
3969 nread = 1;
3970#else
437f6112 3971 nread = read (input_fd, cbuf, n_to_read);
80e4aa30 3972#endif
762f2b92 3973#if defined (AIX) && (! defined (aix386) && defined (_BSD))
284f4730
JB
3974 /* The kernel sometimes fails to deliver SIGHUP for ptys.
3975 This looks incorrect, but it isn't, because _BSD causes
3976 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
3977 and that causes a value other than 0 when there is no input. */
854f3a54 3978 if (nread == 0)
80e4aa30 3979 kill (0, SIGHUP);
284f4730 3980#endif
9134775b 3981 }
791587ee
KH
3982 while (
3983 /* We used to retry the read if it was interrupted.
3984 But this does the wrong thing when O_NDELAY causes
3985 an EAGAIN error. Does anybody know of a situation
3986 where a retry is actually needed? */
3987#if 0
3988 nread < 0 && (errno == EAGAIN
6aec06f5 3989#ifdef EFAULT
9134775b 3990 || errno == EFAULT
80e4aa30 3991#endif
284f4730 3992#ifdef EBADSLT
9134775b 3993 || errno == EBADSLT
284f4730 3994#endif
791587ee
KH
3995 )
3996#else
3997 0
3998#endif
3999 );
284f4730
JB
4000
4001#ifndef FIONREAD
02c2c53f 4002#if defined (USG) || defined (DGUX)
437f6112 4003 fcntl (input_fd, F_SETFL, 0);
02c2c53f 4004#endif /* USG or DGUX */
284f4730
JB
4005#endif /* no FIONREAD */
4006 for (i = 0; i < nread; i++)
4007 {
4008 buf[i].kind = ascii_keystroke;
86e5706b 4009 buf[i].modifiers = 0;
b04904fb 4010 if (meta_key == 1 && (cbuf[i] & 0x80))
86e5706b 4011 buf[i].modifiers = meta_modifier;
b04904fb
RS
4012 if (meta_key != 2)
4013 cbuf[i] &= ~0x80;
f3e59d5e
KH
4014
4015 buf[i].code = cbuf[i];
7b4aedb9 4016#ifdef MULTI_FRAME
18cd2eeb 4017 XSETFRAME (buf[i].frame_or_window, selected_frame);
7b4aedb9
JB
4018#else
4019 buf[i].frame_or_window = Qnil;
4020#endif
284f4730
JB
4021 }
4022 }
4023
4024 /* Scan the chars for C-g and store them in kbd_buffer. */
4025 for (i = 0; i < nread; i++)
4026 {
4027 kbd_buffer_store_event (&buf[i]);
4028 /* Don't look at input that follows a C-g too closely.
4029 This reduces lossage due to autorepeat on C-g. */
4030 if (buf[i].kind == ascii_keystroke
9343ab07 4031 && buf[i].code == quit_char)
284f4730
JB
4032 break;
4033 }
4034
4035 return nread;
4036}
4037#endif /* not VMS */
4038\f
4039#ifdef SIGIO /* for entire page */
4040/* Note SIGIO has been undef'd if FIONREAD is missing. */
4041
2ce30ea2 4042SIGTYPE
284f4730
JB
4043input_available_signal (signo)
4044 int signo;
4045{
4046 /* Must preserve main program's value of errno. */
4047 int old_errno = errno;
4048#ifdef BSD4_1
4049 extern int select_alarmed;
4050#endif
4051
4052#ifdef USG
4053 /* USG systems forget handlers when they are used;
4054 must reestablish each time */
4055 signal (signo, input_available_signal);
4056#endif /* USG */
4057
4058#ifdef BSD4_1
4059 sigisheld (SIGIO);
4060#endif
4061
ffd56f97
JB
4062 if (input_available_clear_time)
4063 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
284f4730
JB
4064
4065 while (1)
4066 {
4067 int nread;
4068 nread = read_avail_input (1);
4069 /* -1 means it's not ok to read the input now.
4070 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
4071 0 means there was no keyboard input available. */
4072 if (nread <= 0)
4073 break;
4074
4075#ifdef BSD4_1
4076 select_alarmed = 1; /* Force the select emulator back to life */
4077#endif
4078 }
4079
4080#ifdef BSD4_1
4081 sigfree ();
4082#endif
4083 errno = old_errno;
4084}
4085#endif /* SIGIO */
ad163903
JB
4086
4087/* Send ourselves a SIGIO.
4088
4089 This function exists so that the UNBLOCK_INPUT macro in
4090 blockinput.h can have some way to take care of input we put off
4091 dealing with, without assuming that every file which uses
4092 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
4093void
4094reinvoke_input_signal ()
4095{
4096#ifdef SIGIO
4097 kill (0, SIGIO);
4098#endif
4099}
4100
4101
284f4730
JB
4102\f
4103/* Return the prompt-string of a sparse keymap.
4104 This is the first element which is a string.
4105 Return nil if there is none. */
4106
4107Lisp_Object
4108map_prompt (map)
4109 Lisp_Object map;
4110{
4111 while (CONSP (map))
4112 {
4113 register Lisp_Object tem;
4114 tem = Fcar (map);
8c18cbfb 4115 if (STRINGP (tem))
284f4730
JB
4116 return tem;
4117 map = Fcdr (map);
4118 }
4119 return Qnil;
4120}
4121
b7c49376
RS
4122static void menu_bar_item ();
4123static void menu_bar_one_keymap ();
4124
4125/* These variables hold the vector under construction within
4126 menu_bar_items and its subroutines, and the current index
4127 for storing into that vector. */
4128static Lisp_Object menu_bar_items_vector;
9343ab07 4129static int menu_bar_items_index;
5ec75a55 4130
b7c49376
RS
4131/* Return a vector of menu items for a menu bar, appropriate
4132 to the current buffer. Each item has three elements in the vector:
f5e09c8b 4133 KEY STRING MAPLIST.
b7c49376
RS
4134
4135 OLD is an old vector we can optionally reuse, or nil. */
5ec75a55
RS
4136
4137Lisp_Object
b7c49376
RS
4138menu_bar_items (old)
4139 Lisp_Object old;
5ec75a55
RS
4140{
4141 /* The number of keymaps we're scanning right now, and the number of
4142 keymaps we have allocated space for. */
4143 int nmaps;
4144
4145 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
4146 in the current keymaps, or nil where it is not a prefix. */
4147 Lisp_Object *maps;
4148
9f9c0e27 4149 Lisp_Object def, tem, tail;
5ec75a55
RS
4150
4151 Lisp_Object result;
4152
4153 int mapno;
47d319aa 4154 Lisp_Object oquit;
5ec75a55 4155
b7c49376
RS
4156 int i;
4157
4158 struct gcpro gcpro1;
4159
db60d856
JB
4160 /* In order to build the menus, we need to call the keymap
4161 accessors. They all call QUIT. But this function is called
4162 during redisplay, during which a quit is fatal. So inhibit
47d319aa
RS
4163 quitting while building the menus.
4164 We do this instead of specbind because (1) errors will clear it anyway
4165 and (2) this avoids risk of specpdl overflow. */
4166 oquit = Vinhibit_quit;
4167 Vinhibit_quit = Qt;
db60d856 4168
b7c49376
RS
4169 if (!NILP (old))
4170 menu_bar_items_vector = old;
4171 else
4172 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
4173 menu_bar_items_index = 0;
4174
4175 GCPRO1 (menu_bar_items_vector);
4176
5ec75a55
RS
4177 /* Build our list of keymaps.
4178 If we recognize a function key and replace its escape sequence in
4179 keybuf with its symbol, or if the sequence starts with a mouse
4180 click and we need to switch buffers, we jump back here to rebuild
4181 the initial keymaps from the current buffer. */
4182 {
4183 Lisp_Object *tmaps;
4184
d0a49716
RS
4185 /* Should overriding-local-map apply, here? */
4186 if (!NILP (Voverriding_local_map_menu_flag))
9dd3131c 4187 {
d0a49716
RS
4188 if (NILP (Voverriding_local_map))
4189 {
4190 /* Yes, and it is nil. Use just global map. */
4191 nmaps = 1;
4192 maps = (Lisp_Object *) alloca (nmaps * sizeof (maps[0]));
4193 }
4194 else
4195 {
4196 /* Yes, and it is non-nil. Use it and the global map. */
4197 nmaps = 2;
4198 maps = (Lisp_Object *) alloca (nmaps * sizeof (maps[0]));
4199 maps[0] = Voverriding_local_map;
4200 }
9dd3131c
RS
4201 }
4202 else
4203 {
d0a49716 4204 /* No, so use major and minor mode keymaps. */
9dd3131c
RS
4205 nmaps = current_minor_maps (0, &tmaps) + 2;
4206 maps = (Lisp_Object *) alloca (nmaps * sizeof (maps[0]));
4207 bcopy (tmaps, maps, (nmaps - 2) * sizeof (maps[0]));
5ec75a55 4208#ifdef USE_TEXT_PROPERTIES
9dd3131c 4209 maps[nmaps-2] = get_local_map (PT, current_buffer);
5ec75a55 4210#else
9dd3131c 4211 maps[nmaps-2] = current_buffer->keymap;
5ec75a55 4212#endif
9dd3131c 4213 }
7e6992e0 4214 maps[nmaps-1] = current_global_map;
5ec75a55
RS
4215 }
4216
4217 /* Look up in each map the dummy prefix key `menu-bar'. */
4218
4219 result = Qnil;
4220
e58aa385 4221 for (mapno = nmaps - 1; mapno >= 0; mapno--)
5ec75a55
RS
4222 {
4223 if (! NILP (maps[mapno]))
e74fbc70 4224 def = get_keyelt (access_keymap (maps[mapno], Qmenu_bar, 1, 0));
5ec75a55
RS
4225 else
4226 def = Qnil;
4227
4228 tem = Fkeymapp (def);
4229 if (!NILP (tem))
b7c49376 4230 menu_bar_one_keymap (def);
5ec75a55
RS
4231 }
4232
b7c49376
RS
4233 /* Move to the end those items that should be at the end. */
4234
9f9c0e27
RS
4235 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCONS (tail)->cdr)
4236 {
b7c49376
RS
4237 int i;
4238 int end = menu_bar_items_index;
4239
4240 for (i = 0; i < end; i += 3)
4241 if (EQ (XCONS (tail)->car, XVECTOR (menu_bar_items_vector)->contents[i]))
4242 {
0301268e
RS
4243 Lisp_Object tem0, tem1, tem2;
4244 /* Move the item at index I to the end,
4245 shifting all the others forward. */
4246 tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
4247 tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
4248 tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
4249 if (end > i + 3)
4250 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 3],
4251 &XVECTOR (menu_bar_items_vector)->contents[i],
4252 (end - i - 3) * sizeof (Lisp_Object));
4253 XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem0;
4254 XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem1;
4255 XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem2;
4256 break;
b7c49376
RS
4257 }
4258 }
9f9c0e27 4259
b7c49376
RS
4260 /* Add nil, nil, nil at the end. */
4261 i = menu_bar_items_index;
4262 if (i + 3 > XVECTOR (menu_bar_items_vector)->size)
4263 {
4264 Lisp_Object tem;
4265 int newsize = 2 * i;
4266 tem = Fmake_vector (make_number (2 * i), Qnil);
4267 bcopy (XVECTOR (menu_bar_items_vector)->contents,
4268 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
4269 menu_bar_items_vector = tem;
9f9c0e27 4270 }
b7c49376
RS
4271 /* Add this item. */
4272 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
4273 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
4274 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
4275 menu_bar_items_index = i;
a73c5e29 4276
47d319aa 4277 Vinhibit_quit = oquit;
b7c49376
RS
4278 UNGCPRO;
4279 return menu_bar_items_vector;
5ec75a55
RS
4280}
4281\f
4282/* Scan one map KEYMAP, accumulating any menu items it defines
f5e09c8b 4283 in menu_bar_items_vector. */
5ec75a55 4284
b7c49376
RS
4285static void
4286menu_bar_one_keymap (keymap)
4287 Lisp_Object keymap;
5ec75a55
RS
4288{
4289 Lisp_Object tail, item, key, binding, item_string, table;
4290
4291 /* Loop over all keymap entries that have menu strings. */
8c18cbfb 4292 for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr)
5ec75a55
RS
4293 {
4294 item = XCONS (tail)->car;
8c18cbfb 4295 if (CONSP (item))
5ec75a55
RS
4296 {
4297 key = XCONS (item)->car;
4298 binding = XCONS (item)->cdr;
8c18cbfb 4299 if (CONSP (binding))
5ec75a55
RS
4300 {
4301 item_string = XCONS (binding)->car;
8c18cbfb 4302 if (STRINGP (item_string))
b7c49376 4303 menu_bar_item (key, item_string, Fcdr (binding));
5ec75a55 4304 }
e58aa385 4305 else if (EQ (binding, Qundefined))
8aa034e1 4306 menu_bar_item (key, Qnil, binding);
5ec75a55 4307 }
8c18cbfb 4308 else if (VECTORP (item))
5ec75a55
RS
4309 {
4310 /* Loop over the char values represented in the vector. */
4311 int len = XVECTOR (item)->size;
4312 int c;
4313 for (c = 0; c < len; c++)
4314 {
4315 Lisp_Object character;
bb9e9bed 4316 XSETFASTINT (character, c);
5ec75a55 4317 binding = XVECTOR (item)->contents[c];
8c18cbfb 4318 if (CONSP (binding))
5ec75a55
RS
4319 {
4320 item_string = XCONS (binding)->car;
8c18cbfb 4321 if (STRINGP (item_string))
b7c49376 4322 menu_bar_item (key, item_string, Fcdr (binding));
5ec75a55 4323 }
e58aa385 4324 else if (EQ (binding, Qundefined))
8aa034e1 4325 menu_bar_item (key, Qnil, binding);
5ec75a55
RS
4326 }
4327 }
4328 }
5ec75a55
RS
4329}
4330
047a8ea7
RS
4331/* This is used as the handler when calling internal_condition_case_1. */
4332
4333static Lisp_Object
4334menu_bar_item_1 (arg)
4335 Lisp_Object arg;
4336{
4337 return Qnil;
4338}
4339
f5e09c8b
RS
4340/* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
4341 If there's already an item for KEY, add this DEF to it. */
4342
b7c49376
RS
4343static void
4344menu_bar_item (key, item_string, def)
4345 Lisp_Object key, item_string, def;
5ec75a55 4346{
e58aa385 4347 Lisp_Object tem;
5ec75a55 4348 Lisp_Object enabled;
b7c49376 4349 int i;
5ec75a55 4350
e58aa385
RS
4351 if (EQ (def, Qundefined))
4352 {
f5e09c8b 4353 /* If a map has an explicit `undefined' as definition,
e58aa385 4354 discard any previously made menu bar item. */
b7c49376
RS
4355
4356 for (i = 0; i < menu_bar_items_index; i += 3)
4357 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
4358 {
4359 if (menu_bar_items_index > i + 3)
4360 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 3],
4361 &XVECTOR (menu_bar_items_vector)->contents[i],
4362 (menu_bar_items_index - i - 3) * sizeof (Lisp_Object));
4363 menu_bar_items_index -= 3;
4364 return;
4365 }
8aa034e1
RS
4366
4367 /* If there's no definition for this key yet,
4368 just ignore `undefined'. */
4369 return;
e58aa385
RS
4370 }
4371
5ec75a55
RS
4372 /* See if this entry is enabled. */
4373 enabled = Qt;
4374
8c18cbfb 4375 if (SYMBOLP (def))
5ec75a55
RS
4376 {
4377 /* No property, or nil, means enable.
4378 Otherwise, enable if value is not nil. */
4379 tem = Fget (def, Qmenu_enable);
4380 if (!NILP (tem))
047a8ea7
RS
4381 /* (condition-case nil (eval tem)
4382 (error nil)) */
4383 enabled = internal_condition_case_1 (Feval, tem, Qerror,
4384 menu_bar_item_1);
5ec75a55
RS
4385 }
4386
b7c49376
RS
4387 /* Ignore this item if it's not enabled. */
4388 if (NILP (enabled))
4389 return;
5ec75a55 4390
f5e09c8b 4391 /* Find any existing item for this KEY. */
b7c49376
RS
4392 for (i = 0; i < menu_bar_items_index; i += 3)
4393 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
4394 break;
4395
f5e09c8b 4396 /* If we did not find this KEY, add it at the end. */
b7c49376
RS
4397 if (i == menu_bar_items_index)
4398 {
4399 /* If vector is too small, get a bigger one. */
4400 if (i + 3 > XVECTOR (menu_bar_items_vector)->size)
4401 {
4402 Lisp_Object tem;
4403 int newsize = 2 * i;
4404 tem = Fmake_vector (make_number (2 * i), Qnil);
4405 bcopy (XVECTOR (menu_bar_items_vector)->contents,
4406 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
4407 menu_bar_items_vector = tem;
4408 }
4409 /* Add this item. */
4410 XVECTOR (menu_bar_items_vector)->contents[i++] = key;
4411 XVECTOR (menu_bar_items_vector)->contents[i++] = item_string;
f5e09c8b 4412 XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (def, Qnil);
b7c49376
RS
4413 menu_bar_items_index = i;
4414 }
f5e09c8b
RS
4415 /* We did find an item for this KEY. Add DEF to its list of maps. */
4416 else
4417 {
4418 Lisp_Object old;
4419 old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
4420 XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (def, old);
4421 }
5ec75a55
RS
4422}
4423\f
dcc408a0
RS
4424/* Read a character using menus based on maps in the array MAPS.
4425 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
4426 Return t if we displayed a menu but the user rejected it.
7d6de002
RS
4427
4428 PREV_EVENT is the previous input event, or nil if we are reading
4429 the first event of a key sequence.
4430
6569cc8d
JB
4431 If USED_MOUSE_MENU is non-zero, then we set *USED_MOUSE_MENU to 1
4432 if we used a mouse menu to read the input, or zero otherwise. If
4433 USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone.
284f4730
JB
4434
4435 The prompting is done based on the prompt-string of the map
8150596a
RS
4436 and the strings associated with various map elements.
4437
4438 This can be done with X menus or with menus put in the minibuf.
4439 These are done in different ways, depending on how the input will be read.
4440 Menus using X are done after auto-saving in read-char, getting the input
4441 event from Fx_popup_menu; menus using the minibuf use read_char recursively
4442 and do auto-saving in the inner call of read_char. */
284f4730 4443
7617111f 4444static Lisp_Object
8150596a 4445read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
7d6de002
RS
4446 int nmaps;
4447 Lisp_Object *maps;
4448 Lisp_Object prev_event;
4449 int *used_mouse_menu;
284f4730 4450{
7d6de002
RS
4451 int mapno;
4452 register Lisp_Object name;
7d6de002
RS
4453 Lisp_Object rest, vector;
4454
6569cc8d
JB
4455 if (used_mouse_menu)
4456 *used_mouse_menu = 0;
284f4730
JB
4457
4458 /* Use local over global Menu maps */
4459
7d6de002
RS
4460 if (! menu_prompting)
4461 return Qnil;
4462
03361bcc
RS
4463 /* Optionally disregard all but the global map. */
4464 if (inhibit_local_menu_bar_menus)
4465 {
4466 maps += (nmaps - 1);
4467 nmaps = 1;
4468 }
4469
7d6de002
RS
4470 /* Get the menu name from the first map that has one (a prompt string). */
4471 for (mapno = 0; mapno < nmaps; mapno++)
4472 {
4473 name = map_prompt (maps[mapno]);
4474 if (!NILP (name))
4475 break;
4476 }
284f4730 4477
7d6de002 4478 /* If we don't have any menus, just read a character normally. */
dbc4e1c1 4479 if (mapno >= nmaps)
7d6de002
RS
4480 return Qnil;
4481
87485d6f 4482#if (defined (HAVE_X_WINDOWS) && defined (HAVE_X_MENU)) || defined (MSDOS)
7d6de002
RS
4483 /* If we got to this point via a mouse click,
4484 use a real menu for mouse selection. */
dbc4e1c1 4485 if (EVENT_HAS_PARAMETERS (prev_event))
7d6de002
RS
4486 {
4487 /* Display the menu and get the selection. */
4488 Lisp_Object *realmaps
4489 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
4490 Lisp_Object value;
4491 int nmaps1 = 0;
4492
4493 /* Use the maps that are not nil. */
4494 for (mapno = 0; mapno < nmaps; mapno++)
4495 if (!NILP (maps[mapno]))
4496 realmaps[nmaps1++] = maps[mapno];
4497
4498 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
663258f2
JB
4499 if (CONSP (value))
4500 {
4501 /* If we got more than one event, put all but the first
4502 onto this list to be read later.
4503 Return just the first event now. */
24597608
RS
4504 Vunread_command_events
4505 = nconc2 (XCONS (value)->cdr, Vunread_command_events);
663258f2
JB
4506 value = XCONS (value)->car;
4507 }
1c90c381 4508 else if (NILP (value))
dcc408a0 4509 value = Qt;
6569cc8d
JB
4510 if (used_mouse_menu)
4511 *used_mouse_menu = 1;
7d6de002
RS
4512 return value;
4513 }
87485d6f 4514#endif /* (HAVE_X_WINDOWS && HAVE_X_MENU) || MSDOS */
8150596a
RS
4515 return Qnil ;
4516}
4517
4518static Lisp_Object
24597608 4519read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
8150596a
RS
4520 int commandflag ;
4521 int nmaps;
4522 Lisp_Object *maps;
4523{
4524 int mapno;
4525 register Lisp_Object name;
4526 int nlength;
4527 int width = FRAME_WIDTH (selected_frame) - 4;
4528 char *menu = (char *) alloca (width + 4);
4529 int idx = -1;
9fdbfdf8 4530 int nobindings = 1;
8150596a
RS
4531 Lisp_Object rest, vector;
4532
4533 if (! menu_prompting)
4534 return Qnil;
4535
4536 /* Get the menu name from the first map that has one (a prompt string). */
4537 for (mapno = 0; mapno < nmaps; mapno++)
4538 {
4539 name = map_prompt (maps[mapno]);
4540 if (!NILP (name))
4541 break;
4542 }
4543
4544 /* If we don't have any menus, just read a character normally. */
4545 if (mapno >= nmaps)
4546 return Qnil;
284f4730
JB
4547
4548 /* Prompt string always starts with map's prompt, and a space. */
4549 strcpy (menu, XSTRING (name)->data);
4550 nlength = XSTRING (name)->size;
7d6de002 4551 menu[nlength++] = ':';
284f4730
JB
4552 menu[nlength++] = ' ';
4553 menu[nlength] = 0;
4554
7d6de002
RS
4555 /* Start prompting at start of first map. */
4556 mapno = 0;
4557 rest = maps[mapno];
284f4730
JB
4558
4559 /* Present the documented bindings, a line at a time. */
4560 while (1)
4561 {
4562 int notfirst = 0;
4563 int i = nlength;
4564 Lisp_Object obj;
4565 int ch;
8066f1a1 4566 Lisp_Object orig_defn_macro;
284f4730 4567
284f4730 4568 /* Loop over elements of map. */
7d6de002 4569 while (i < width)
284f4730 4570 {
7d6de002 4571 Lisp_Object s, elt;
284f4730 4572
7d6de002
RS
4573 /* If reached end of map, start at beginning of next map. */
4574 if (NILP (rest))
4575 {
4576 mapno++;
4577 /* At end of last map, wrap around to first map if just starting,
4578 or end this line if already have something on it. */
4579 if (mapno == nmaps)
284f4730 4580 {
8150596a 4581 mapno = 0;
40932d1a 4582 if (notfirst || nobindings) break;
284f4730 4583 }
7d6de002 4584 rest = maps[mapno];
284f4730 4585 }
7d6de002
RS
4586
4587 /* Look at the next element of the map. */
4588 if (idx >= 0)
4589 elt = XVECTOR (vector)->contents[idx];
284f4730 4590 else
7d6de002
RS
4591 elt = Fcar_safe (rest);
4592
8c18cbfb 4593 if (idx < 0 && VECTORP (elt))
284f4730 4594 {
7d6de002
RS
4595 /* If we found a dense table in the keymap,
4596 advanced past it, but start scanning its contents. */
4597 rest = Fcdr_safe (rest);
4598 vector = elt;
4599 idx = 0;
284f4730 4600 }
7d6de002
RS
4601 else
4602 {
4603 /* An ordinary element. */
8150596a
RS
4604 if ( idx < 0 )
4605 s = Fcar_safe (Fcdr_safe (elt)); /* alist */
4606 else
4607 s = Fcar_safe(elt); /* vector */
8c18cbfb 4608 if (!STRINGP (s))
7d6de002
RS
4609 /* Ignore the element if it has no prompt string. */
4610 ;
4611 /* If we have room for the prompt string, add it to this line.
4612 If this is the first on the line, always add it. */
8150596a 4613 else if (XSTRING (s)->size + i + 2 < width
7d6de002
RS
4614 || !notfirst)
4615 {
4616 int thiswidth;
284f4730 4617
7d6de002
RS
4618 /* Punctuate between strings. */
4619 if (notfirst)
4620 {
4621 strcpy (menu + i, ", ");
4622 i += 2;
4623 }
4624 notfirst = 1;
8150596a 4625 nobindings = 0 ;
7d6de002
RS
4626
4627 /* Add as much of string as fits. */
4628 thiswidth = XSTRING (s)->size;
4629 if (thiswidth + i > width)
4630 thiswidth = width - i;
4631 bcopy (XSTRING (s)->data, menu + i, thiswidth);
4632 i += thiswidth;
8150596a 4633 menu[i] = 0;
7d6de002
RS
4634 }
4635 else
4636 {
4637 /* If this element does not fit, end the line now,
4638 and save the element for the next line. */
4639 strcpy (menu + i, "...");
4640 break;
4641 }
4642
4643 /* Move past this element. */
8150596a 4644 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
7d6de002
RS
4645 /* Handle reaching end of dense table. */
4646 idx = -1;
4647 if (idx >= 0)
4648 idx++;
4649 else
4650 rest = Fcdr_safe (rest);
4651 }
284f4730
JB
4652 }
4653
4654 /* Prompt with that and read response. */
4655 message1 (menu);
8150596a
RS
4656
4657 /* Make believe its not a keyboard macro in case the help char
4658 is pressed. Help characters are not recorded because menu prompting
4659 is not used on replay.
4660 */
8066f1a1
KH
4661 orig_defn_macro = current_perdisplay->defining_kbd_macro;
4662 current_perdisplay->defining_kbd_macro = Qnil;
3cb81011
KH
4663 do
4664 obj = read_char (commandflag, 0, 0, Qnil, 0);
8c18cbfb 4665 while (BUFFERP (obj));
8066f1a1 4666 current_perdisplay->defining_kbd_macro = orig_defn_macro;
284f4730 4667
8c18cbfb 4668 if (!INTEGERP (obj))
284f4730
JB
4669 return obj;
4670 else
4671 ch = XINT (obj);
4672
f4255cd1 4673 if (! EQ (obj, menu_prompt_more_char)
8c18cbfb 4674 && (!INTEGERP (menu_prompt_more_char)
f4255cd1 4675 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
8150596a 4676 {
8066f1a1
KH
4677 if (!NILP (current_perdisplay->defining_kbd_macro))
4678 store_kbd_macro_char (obj);
8150596a
RS
4679 return obj;
4680 }
4681 /* Help char - go round again */
284f4730
JB
4682 }
4683}
284f4730
JB
4684\f
4685/* Reading key sequences. */
4686
4687/* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
4688 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
4689 keymap, or nil otherwise. Return the index of the first keymap in
4690 which KEY has any binding, or NMAPS if no map has a binding.
4691
4692 If KEY is a meta ASCII character, treat it like meta-prefix-char
4693 followed by the corresponding non-meta character. Keymaps in
4694 CURRENT with non-prefix bindings for meta-prefix-char become nil in
4695 NEXT.
4696
88cb0656
JB
4697 If KEY has no bindings in any of the CURRENT maps, NEXT is left
4698 unmodified.
4699
284f4730
JB
4700 NEXT may == CURRENT. */
4701
4702static int
4e50f26a 4703follow_key (key, nmaps, current, defs, next)
284f4730
JB
4704 Lisp_Object key;
4705 Lisp_Object *current, *defs, *next;
4706 int nmaps;
4707{
4708 int i, first_binding;
4709
4710 /* If KEY is a meta ASCII character, treat it like meta-prefix-char
4711 followed by the corresponding non-meta character. */
8c18cbfb 4712 if (INTEGERP (key) && (XINT (key) & CHAR_META))
284f4730
JB
4713 {
4714 for (i = 0; i < nmaps; i++)
4715 if (! NILP (current[i]))
4716 {
cd21b839 4717 next[i] =
e74fbc70 4718 get_keyelt (access_keymap (current[i], meta_prefix_char, 1, 0));
284f4730
JB
4719
4720 /* Note that since we pass the resulting bindings through
4721 get_keymap_1, non-prefix bindings for meta-prefix-char
4722 disappear. */
f4255cd1 4723 next[i] = get_keymap_1 (next[i], 0, 1);
284f4730
JB
4724 }
4725 else
4726 next[i] = Qnil;
4727
4728 current = next;
18cd2eeb 4729 XSETINT (key, XFASTINT (key) & ~CHAR_META);
284f4730
JB
4730 }
4731
4732 first_binding = nmaps;
4733 for (i = nmaps - 1; i >= 0; i--)
4734 {
4735 if (! NILP (current[i]))
4736 {
e74fbc70 4737 defs[i] = get_keyelt (access_keymap (current[i], key, 1, 0));
284f4730
JB
4738 if (! NILP (defs[i]))
4739 first_binding = i;
4740 }
4741 else
4742 defs[i] = Qnil;
4743 }
4744
284f4730 4745 /* Given the set of bindings we've found, produce the next set of maps. */
0a7f1fc0
JB
4746 if (first_binding < nmaps)
4747 for (i = 0; i < nmaps; i++)
f4255cd1 4748 next[i] = NILP (defs[i]) ? Qnil : get_keymap_1 (defs[i], 0, 1);
284f4730
JB
4749
4750 return first_binding;
4751}
4752
f4255cd1
JB
4753/* Read a sequence of keys that ends with a non prefix character,
4754 storing it in KEYBUF, a buffer of size BUFSIZE.
4755 Prompt with PROMPT.
284f4730 4756 Return the length of the key sequence stored.
dcc408a0 4757 Return -1 if the user rejected a command menu.
284f4730 4758
f4255cd1
JB
4759 Echo starting immediately unless `prompt' is 0.
4760
4761 Where a key sequence ends depends on the currently active keymaps.
4762 These include any minor mode keymaps active in the current buffer,
4763 the current buffer's local map, and the global map.
4764
4765 If a key sequence has no other bindings, we check Vfunction_key_map
4766 to see if some trailing subsequence might be the beginning of a
4767 function key's sequence. If so, we try to read the whole function
4768 key, and substitute its symbolic name into the key sequence.
4769
fbcd35bd
JB
4770 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
4771 `double-' events into similar click events, if that would make them
4772 bound. We try to turn `triple-' events first into `double-' events,
4773 then into clicks.
f4255cd1
JB
4774
4775 If we get a mouse click in a mode line, vertical divider, or other
4776 non-text area, we treat the click as if it were prefixed by the
4777 symbol denoting that area - `mode-line', `vertical-line', or
4778 whatever.
4779
4780 If the sequence starts with a mouse click, we read the key sequence
4781 with respect to the buffer clicked on, not the current buffer.
284f4730 4782
f4255cd1
JB
4783 If the user switches frames in the midst of a key sequence, we put
4784 off the switch-frame event until later; the next call to
4785 read_char will return it. */
48e416d4 4786
284f4730 4787static int
ce98e608
KH
4788read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
4789 can_return_switch_frame)
284f4730
JB
4790 Lisp_Object *keybuf;
4791 int bufsize;
84d91fda 4792 Lisp_Object prompt;
309b0fc8 4793 int dont_downcase_last;
ce98e608 4794 int can_return_switch_frame;
284f4730 4795{
f4255cd1
JB
4796 int count = specpdl_ptr - specpdl;
4797
284f4730
JB
4798 /* How many keys there are in the current key sequence. */
4799 int t;
4800
284f4730
JB
4801 /* The length of the echo buffer when we started reading, and
4802 the length of this_command_keys when we started reading. */
4803 int echo_start;
f4255cd1 4804 int keys_start;
284f4730
JB
4805
4806 /* The number of keymaps we're scanning right now, and the number of
4807 keymaps we have allocated space for. */
4808 int nmaps;
4809 int nmaps_allocated = 0;
4810
284f4730
JB
4811 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
4812 the current keymaps. */
4813 Lisp_Object *defs;
4814
f4255cd1
JB
4815 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
4816 in the current keymaps, or nil where it is not a prefix. */
4817 Lisp_Object *submaps;
4818
e0dff5f6
RS
4819 /* The local map to start out with at start of key sequence. */
4820 Lisp_Object orig_local_map;
4821
4822 /* 1 if we have already considered switching to the local-map property
4823 of the place where a mouse click occurred. */
4824 int localized_local_map = 0;
4825
f4255cd1
JB
4826 /* The index in defs[] of the first keymap that has a binding for
4827 this key sequence. In other words, the lowest i such that
4828 defs[i] is non-nil. */
284f4730
JB
4829 int first_binding;
4830
f4255cd1 4831 /* If t < mock_input, then KEYBUF[t] should be read as the next
253598e4
JB
4832 input key.
4833
4834 We use this to recover after recognizing a function key. Once we
4835 realize that a suffix of the current key sequence is actually a
4836 function key's escape sequence, we replace the suffix with the
4837 function key's binding from Vfunction_key_map. Now keybuf
f4255cd1
JB
4838 contains a new and different key sequence, so the echo area,
4839 this_command_keys, and the submaps and defs arrays are wrong. In
4840 this situation, we set mock_input to t, set t to 0, and jump to
4841 restart_sequence; the loop will read keys from keybuf up until
4842 mock_input, thus rebuilding the state; and then it will resume
4843 reading characters from the keyboard. */
284f4730
JB
4844 int mock_input = 0;
4845
253598e4 4846 /* If the sequence is unbound in submaps[], then
f4255cd1
JB
4847 keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map,
4848 and fkey_map is its binding.
253598e4 4849
f4255cd1
JB
4850 These might be > t, indicating that all function key scanning
4851 should hold off until t reaches them. We do this when we've just
4852 recognized a function key, to avoid searching for the function
4853 key's again in Vfunction_key_map. */
284f4730 4854 int fkey_start = 0, fkey_end = 0;
4efda7dd 4855 Lisp_Object fkey_map;
284f4730 4856
a612e298
RS
4857 /* Likewise, for key_translation_map. */
4858 int keytran_start = 0, keytran_end = 0;
4859 Lisp_Object keytran_map;
4860
cd21b839
JB
4861 /* If we receive a ``switch-frame'' event in the middle of a key sequence,
4862 we put it off for later. While we're reading, we keep the event here. */
4efda7dd 4863 Lisp_Object delayed_switch_frame;
cd21b839 4864
51763820
BF
4865 /* See the comment below... */
4866#if defined (GOBBLE_FIRST_EVENT)
4efda7dd 4867 Lisp_Object first_event;
51763820 4868#endif
4efda7dd 4869
309b0fc8
RS
4870 Lisp_Object original_uppercase;
4871 int original_uppercase_position = -1;
4872
bc536d84 4873 /* Gets around Microsoft compiler limitations. */
309b0fc8 4874 int dummyflag = 0;
bc536d84 4875
3b9189f8
RS
4876 struct buffer *starting_buffer;
4877
e9bf89a0
RS
4878 /* Nonzero if we seem to have got the beginning of a binding
4879 in function_key_map. */
4880 int function_key_possible = 0;
00a78037 4881 int key_translation_possible = 0;
e9bf89a0 4882
4efda7dd
RS
4883 int junk;
4884
4885 last_nonmenu_event = Qnil;
4886
4887 delayed_switch_frame = Qnil;
4888 fkey_map = Vfunction_key_map;
a612e298 4889 keytran_map = Vkey_translation_map;
f4255cd1 4890
a612e298 4891 /* If there is no function-key-map, turn off function key scanning. */
f4255cd1
JB
4892 if (NILP (Fkeymapp (Vfunction_key_map)))
4893 fkey_start = fkey_end = bufsize + 1;
4894
a612e298
RS
4895 /* If there is no key-translation-map, turn off scanning. */
4896 if (NILP (Fkeymapp (Vkey_translation_map)))
4897 keytran_start = keytran_end = bufsize + 1;
4898
284f4730
JB
4899 if (INTERACTIVE)
4900 {
84d91fda
RS
4901 if (!NILP (prompt))
4902 echo_prompt (XSTRING (prompt)->data);
a98ea3f9 4903 else if (cursor_in_echo_area && echo_keystrokes)
284f4730
JB
4904 /* This doesn't put in a dash if the echo buffer is empty, so
4905 you don't always see a dash hanging out in the minibuffer. */
4906 echo_dash ();
284f4730
JB
4907 }
4908
f4255cd1
JB
4909 /* Record the initial state of the echo area and this_command_keys;
4910 we will need to restore them if we replay a key sequence. */
0a7f1fc0 4911 if (INTERACTIVE)
4c52b668 4912 echo_start = (current_perdisplay ? echo_length () : 0);
f4255cd1 4913 keys_start = this_command_key_count;
0a7f1fc0 4914
51763820
BF
4915#if defined (GOBBLE_FIRST_EVENT)
4916 /* This doesn't quite work, because some of the things that read_char
4917 does cannot safely be bypassed. It seems too risky to try to make
4918 this work right. */
4919
4efda7dd
RS
4920 /* Read the first char of the sequence specially, before setting
4921 up any keymaps, in case a filter runs and switches buffers on us. */
84d91fda 4922 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
4efda7dd 4923 &junk);
51763820 4924#endif /* GOBBLE_FIRST_EVENT */
4efda7dd 4925
e0dff5f6
RS
4926 orig_local_map = get_local_map (PT, current_buffer);
4927
7b4aedb9
JB
4928 /* We jump here when the key sequence has been thoroughly changed, and
4929 we need to rescan it starting from the beginning. When we jump here,
4930 keybuf[0..mock_input] holds the sequence we should reread. */
07d2b8de 4931 replay_sequence:
7b4aedb9 4932
3b9189f8 4933 starting_buffer = current_buffer;
e9bf89a0 4934 function_key_possible = 0;
00a78037 4935 key_translation_possible = 0;
3b9189f8 4936
f4255cd1 4937 /* Build our list of keymaps.
07d2b8de
JB
4938 If we recognize a function key and replace its escape sequence in
4939 keybuf with its symbol, or if the sequence starts with a mouse
4940 click and we need to switch buffers, we jump back here to rebuild
4941 the initial keymaps from the current buffer. */
284f4730
JB
4942 {
4943 Lisp_Object *maps;
4944
9dd3131c 4945 if (!NILP (Voverriding_local_map))
284f4730 4946 {
9dd3131c
RS
4947 nmaps = 2;
4948 if (nmaps > nmaps_allocated)
4949 {
4950 submaps = (Lisp_Object *) alloca (nmaps * sizeof (submaps[0]));
4951 defs = (Lisp_Object *) alloca (nmaps * sizeof (defs[0]));
4952 nmaps_allocated = nmaps;
4953 }
4954 submaps[0] = Voverriding_local_map;
284f4730 4955 }
9dd3131c
RS
4956 else
4957 {
4958 nmaps = current_minor_maps (0, &maps) + 2;
4959 if (nmaps > nmaps_allocated)
4960 {
4961 submaps = (Lisp_Object *) alloca (nmaps * sizeof (submaps[0]));
4962 defs = (Lisp_Object *) alloca (nmaps * sizeof (defs[0]));
4963 nmaps_allocated = nmaps;
4964 }
4965 bcopy (maps, submaps, (nmaps - 2) * sizeof (submaps[0]));
497ba7a1 4966#ifdef USE_TEXT_PROPERTIES
e0dff5f6 4967 submaps[nmaps-2] = orig_local_map;
497ba7a1 4968#else
9dd3131c 4969 submaps[nmaps-2] = current_buffer->keymap;
497ba7a1 4970#endif
9dd3131c 4971 }
7e6992e0 4972 submaps[nmaps-1] = current_global_map;
284f4730
JB
4973 }
4974
4975 /* Find an accurate initial value for first_binding. */
4976 for (first_binding = 0; first_binding < nmaps; first_binding++)
253598e4 4977 if (! NILP (submaps[first_binding]))
284f4730
JB
4978 break;
4979
3b9189f8 4980 /* Start from the beginning in keybuf. */
f4255cd1
JB
4981 t = 0;
4982
4983 /* These are no-ops the first time through, but if we restart, they
4984 revert the echo area and this_command_keys to their original state. */
4985 this_command_key_count = keys_start;
4c52b668 4986 if (INTERACTIVE && t < mock_input && current_perdisplay)
f4255cd1
JB
4987 echo_truncate (echo_start);
4988
cca310da
JB
4989 /* If the best binding for the current key sequence is a keymap, or
4990 we may be looking at a function key's escape sequence, keep on
4991 reading. */
253598e4 4992 while ((first_binding < nmaps && ! NILP (submaps[first_binding]))
cca310da
JB
4993 || (first_binding >= nmaps
4994 && fkey_start < t
4995 /* mock input is never part of a function key's sequence. */
a612e298 4996 && mock_input <= fkey_start)
0d882d52
KH
4997 || (first_binding >= nmaps
4998 && keytran_start < t && key_translation_possible)
e9bf89a0
RS
4999 /* Don't return in the middle of a possible function key sequence,
5000 if the only bindings we found were via case conversion.
5001 Thus, if ESC O a has a function-key-map translation
5002 and ESC o has a binding, don't return after ESC O,
5003 so that we can translate ESC O plus the next character. */
4e50f26a 5004 )
284f4730
JB
5005 {
5006 Lisp_Object key;
7d6de002 5007 int used_mouse_menu = 0;
284f4730 5008
7b4aedb9
JB
5009 /* Where the last real key started. If we need to throw away a
5010 key that has expanded into more than one element of keybuf
5011 (say, a mouse click on the mode line which is being treated
5012 as [mode-line (mouse-...)], then we backtrack to this point
5013 of keybuf. */
5014 int last_real_key_start;
5015
0a7f1fc0
JB
5016 /* These variables are analogous to echo_start and keys_start;
5017 while those allow us to restart the entire key sequence,
5018 echo_local_start and keys_local_start allow us to throw away
5019 just one key. */
f4255cd1
JB
5020 int echo_local_start, keys_local_start, local_first_binding;
5021
284f4730
JB
5022 if (t >= bufsize)
5023 error ("key sequence too long");
5024
f4255cd1
JB
5025 if (INTERACTIVE)
5026 echo_local_start = echo_length ();
5027 keys_local_start = this_command_key_count;
5028 local_first_binding = first_binding;
5029
5030 replay_key:
0a7f1fc0 5031 /* These are no-ops, unless we throw away a keystroke below and
f4255cd1
JB
5032 jumped back up to replay_key; in that case, these restore the
5033 variables to their original state, allowing us to replay the
0a7f1fc0 5034 loop. */
40932d1a 5035 if (INTERACTIVE && t < mock_input)
f4255cd1 5036 echo_truncate (echo_local_start);
0a7f1fc0
JB
5037 this_command_key_count = keys_local_start;
5038 first_binding = local_first_binding;
5039
7e85b935
RS
5040 /* By default, assume each event is "real". */
5041 last_real_key_start = t;
5042
f4255cd1 5043 /* Does mock_input indicate that we are re-reading a key sequence? */
284f4730
JB
5044 if (t < mock_input)
5045 {
5046 key = keybuf[t];
5047 add_command_key (key);
a98ea3f9
RS
5048 if (echo_keystrokes)
5049 echo_char (key);
284f4730 5050 }
253598e4
JB
5051
5052 /* If not, we should actually read a character. */
284f4730
JB
5053 else
5054 {
a6d53864
RS
5055 struct buffer *buf = current_buffer;
5056
beecf6a1 5057 {
bded54dd
KH
5058#ifdef MULTI_PERDISPLAY
5059 PERDISPLAY *interrupted_perdisplay = current_perdisplay;
beecf6a1
KH
5060 if (setjmp (wrong_display_jmpbuf))
5061 {
5062 while (t > 0)
5063 interrupted_perdisplay->kbd_queue
5064 = Fcons (keybuf[--t], interrupted_perdisplay->kbd_queue);
5065 mock_input = 0;
a6e0153c 5066 orig_local_map = get_local_map (PT, current_buffer);
beecf6a1
KH
5067 goto replay_sequence;
5068 }
bded54dd 5069#endif
beecf6a1
KH
5070 key = read_char (NILP (prompt), nmaps, submaps, last_nonmenu_event,
5071 &used_mouse_menu);
5072 }
284f4730 5073
dcc408a0
RS
5074 /* read_char returns t when it shows a menu and the user rejects it.
5075 Just return -1. */
5076 if (EQ (key, Qt))
5077 return -1;
5078
f4255cd1 5079 /* read_char returns -1 at the end of a macro.
284f4730
JB
5080 Emacs 18 handles this by returning immediately with a
5081 zero, so that's what we'll do. */
8c18cbfb 5082 if (INTEGERP (key) && XINT (key) == -1)
cd21b839 5083 {
f4255cd1 5084 t = 0;
bc536d84
RS
5085 /* The Microsoft C compiler can't handle the goto that
5086 would go here. */
309b0fc8 5087 dummyflag = 1;
bc536d84 5088 break;
cd21b839 5089 }
284f4730 5090
3cb81011
KH
5091 /* If the current buffer has been changed from under us, the
5092 keymap may have changed, so replay the sequence. */
8c18cbfb 5093 if (BUFFERP (key))
3cb81011
KH
5094 {
5095 mock_input = t;
a6e0153c 5096 orig_local_map = get_local_map (PT, current_buffer);
3cb81011
KH
5097 goto replay_sequence;
5098 }
5099
3b9189f8
RS
5100 /* If we have a quit that was typed in another frame, and
5101 quit_throw_to_read_char switched buffers,
5102 replay to get the right keymap. */
9343ab07 5103 if (XINT (key) == quit_char && current_buffer != starting_buffer)
3b9189f8
RS
5104 {
5105 keybuf[t++] = key;
5106 mock_input = t;
5107 Vquit_flag = Qnil;
a6e0153c 5108 orig_local_map = get_local_map (PT, current_buffer);
3b9189f8
RS
5109 goto replay_sequence;
5110 }
3cb81011 5111
284f4730 5112 Vquit_flag = Qnil;
7e85b935 5113 }
284f4730 5114
7e85b935
RS
5115 /* Clicks in non-text areas get prefixed by the symbol
5116 in their CHAR-ADDRESS field. For example, a click on
5117 the mode line is prefixed by the symbol `mode-line'.
5118
5119 Furthermore, key sequences beginning with mouse clicks
5120 are read using the keymaps of the buffer clicked on, not
5121 the current buffer. So we may have to switch the buffer
5122 here.
5123
5124 When we turn one event into two events, we must make sure
5125 that neither of the two looks like the original--so that,
5126 if we replay the events, they won't be expanded again.
5127 If not for this, such reexpansion could happen either here
5128 or when user programs play with this-command-keys. */
5129 if (EVENT_HAS_PARAMETERS (key))
5130 {
9b8eb840 5131 Lisp_Object kind;
cca310da 5132
9b8eb840 5133 kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
7e85b935 5134 if (EQ (kind, Qmouse_click))
0a7f1fc0 5135 {
9b8eb840 5136 Lisp_Object window, posn;
f4255cd1 5137
9b8eb840
KH
5138 window = POSN_WINDOW (EVENT_START (key));
5139 posn = POSN_BUFFER_POSN (EVENT_START (key));
8c18cbfb 5140 if (CONSP (posn))
0a7f1fc0 5141 {
7e85b935
RS
5142 /* We're looking at the second event of a
5143 sequence which we expanded before. Set
5144 last_real_key_start appropriately. */
5145 if (t > 0)
5146 last_real_key_start = t - 1;
cd21b839 5147 }
7e85b935
RS
5148
5149 /* Key sequences beginning with mouse clicks are
5150 read using the keymaps in the buffer clicked on,
5151 not the current buffer. If we're at the
5152 beginning of a key sequence, switch buffers. */
5153 if (last_real_key_start == 0
8c18cbfb
KH
5154 && WINDOWP (window)
5155 && BUFFERP (XWINDOW (window)->buffer)
7e85b935 5156 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
cd21b839 5157 {
7e85b935
RS
5158 keybuf[t] = key;
5159 mock_input = t + 1;
5160
5161 /* Arrange to go back to the original buffer once we're
5162 done reading the key sequence. Note that we can't
5163 use save_excursion_{save,restore} here, because they
5164 save point as well as the current buffer; we don't
5165 want to save point, because redisplay may change it,
5166 to accommodate a Fset_window_start or something. We
5167 don't want to do this at the top of the function,
5168 because we may get input from a subprocess which
5169 wants to change the selected window and stuff (say,
5170 emacsclient). */
5171 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
5172
5173 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
e0dff5f6 5174 orig_local_map = get_local_map (PT, current_buffer);
7e85b935 5175 goto replay_sequence;
0a7f1fc0 5176 }
e0dff5f6
RS
5177 /* For a mouse click, get the local text-property keymap
5178 of the place clicked on, rather than point. */
5179 if (last_real_key_start == 0 && CONSP (XCONS (key)->cdr)
5180 && ! localized_local_map)
5ec75a55 5181 {
e0dff5f6
RS
5182 Lisp_Object map_here, start, pos;
5183
5184 localized_local_map = 1;
5185 start = EVENT_START (key);
5186 if (CONSP (start) && CONSP (XCONS (start)->cdr))
5187 {
5188 pos = POSN_BUFFER_POSN (start);
5189 if (INTEGERP (pos))
5190 {
5191 map_here = get_local_map (XINT (pos), current_buffer);
5192 if (!EQ (map_here, orig_local_map))
5193 {
5194 orig_local_map = map_here;
5195 keybuf[t] = key;
5196 mock_input = t + 1;
5ec75a55 5197
e0dff5f6
RS
5198 goto replay_sequence;
5199 }
5200 }
5201 }
5202 }
5203
5204 /* Expand mode-line and scroll-bar events into two events:
5205 use posn as a fake prefix key. */
5206 if (SYMBOLP (posn))
5207 {
7e85b935
RS
5208 if (t + 1 >= bufsize)
5209 error ("key sequence too long");
5210 keybuf[t] = posn;
5211 keybuf[t+1] = key;
5212 mock_input = t + 2;
5213
5214 /* Zap the position in key, so we know that we've
5215 expanded it, and don't try to do so again. */
5216 POSN_BUFFER_POSN (EVENT_START (key))
5217 = Fcons (posn, Qnil);
5218 goto replay_key;
5ec75a55 5219 }
0a7f1fc0 5220 }
7e85b935 5221 else if (EQ (kind, Qswitch_frame))
a6d53864 5222 {
ce98e608
KH
5223 /* If we're at the beginning of a key sequence, and the caller
5224 says it's okay, go ahead and return this event. If we're
5225 in the midst of a key sequence, delay it until the end. */
5226 if (t > 0 || !can_return_switch_frame)
7e85b935
RS
5227 {
5228 delayed_switch_frame = key;
5229 goto replay_key;
5230 }
5231 }
7a80a6f6
RS
5232 else if (CONSP (XCONS (key)->cdr)
5233 && CONSP (EVENT_START (key))
5234 && CONSP (XCONS (EVENT_START (key))->cdr))
7e85b935 5235 {
9b8eb840 5236 Lisp_Object posn;
7e85b935 5237
9b8eb840 5238 posn = POSN_BUFFER_POSN (EVENT_START (key));
7e85b935
RS
5239 /* Handle menu-bar events:
5240 insert the dummy prefix event `menu-bar'. */
5241 if (EQ (posn, Qmenu_bar))
5242 {
5243 if (t + 1 >= bufsize)
5244 error ("key sequence too long");
5245 /* Run the Lucid hook. */
88ce066e
RS
5246 if (!NILP (Vrun_hooks))
5247 call1 (Vrun_hooks, Qactivate_menubar_hook);
7e85b935
RS
5248 /* If it has changed current-menubar from previous value,
5249 really recompute the menubar from the value. */
5250 if (! NILP (Vlucid_menu_bar_dirty_flag))
5251 call0 (Qrecompute_lucid_menubar);
5252 keybuf[t] = posn;
5253 keybuf[t+1] = key;
5254
5255 /* Zap the position in key, so we know that we've
5256 expanded it, and don't try to do so again. */
5257 POSN_BUFFER_POSN (EVENT_START (key))
5258 = Fcons (posn, Qnil);
5259
5260 mock_input = t + 2;
5261 goto replay_sequence;
5262 }
8c18cbfb 5263 else if (CONSP (posn))
7e85b935
RS
5264 {
5265 /* We're looking at the second event of a
5266 sequence which we expanded before. Set
5267 last_real_key_start appropriately. */
5268 if (last_real_key_start == t && t > 0)
5269 last_real_key_start = t - 1;
5270 }
a6d53864 5271 }
284f4730 5272 }
f4255cd1
JB
5273
5274 /* We have finally decided that KEY is something we might want
5275 to look up. */
284f4730
JB
5276 first_binding = (follow_key (key,
5277 nmaps - first_binding,
253598e4 5278 submaps + first_binding,
284f4730 5279 defs + first_binding,
4e50f26a 5280 submaps + first_binding)
284f4730 5281 + first_binding);
0a7f1fc0 5282
f4255cd1 5283 /* If KEY wasn't bound, we'll try some fallbacks. */
0a7f1fc0
JB
5284 if (first_binding >= nmaps)
5285 {
9b8eb840 5286 Lisp_Object head;
0a7f1fc0 5287
9b8eb840 5288 head = EVENT_HEAD (key);
7e85b935
RS
5289 if (EQ (head, Vhelp_char))
5290 {
5291 read_key_sequence_cmd = Vprefix_help_command;
5292 keybuf[t++] = key;
5293 last_nonmenu_event = key;
bc536d84
RS
5294 /* The Microsoft C compiler can't handle the goto that
5295 would go here. */
309b0fc8 5296 dummyflag = 1;
0d882d52 5297 break;
7e85b935
RS
5298 }
5299
8c18cbfb 5300 if (SYMBOLP (head))
0a7f1fc0 5301 {
9b8eb840
KH
5302 Lisp_Object breakdown;
5303 int modifiers;
0a7f1fc0 5304
9b8eb840
KH
5305 breakdown = parse_modifiers (head);
5306 modifiers = XINT (XCONS (XCONS (breakdown)->cdr)->car);
559f9d04
RS
5307 /* Attempt to reduce an unbound mouse event to a simpler
5308 event that is bound:
5309 Drags reduce to clicks.
5310 Double-clicks reduce to clicks.
5311 Triple-clicks reduce to double-clicks, then to clicks.
5312 Down-clicks are eliminated.
5313 Double-downs reduce to downs, then are eliminated.
5314 Triple-downs reduce to double-downs, then to downs,
5315 then are eliminated. */
5316 if (modifiers & (down_modifier | drag_modifier
5317 | double_modifier | triple_modifier))
0a7f1fc0 5318 {
559f9d04
RS
5319 while (modifiers & (down_modifier | drag_modifier
5320 | double_modifier | triple_modifier))
fbcd35bd
JB
5321 {
5322 Lisp_Object new_head, new_click;
5323 if (modifiers & triple_modifier)
5324 modifiers ^= (double_modifier | triple_modifier);
bc536d84
RS
5325 else if (modifiers & double_modifier)
5326 modifiers &= ~double_modifier;
5327 else if (modifiers & drag_modifier)
5328 modifiers &= ~drag_modifier;
559f9d04
RS
5329 else
5330 {
5331 /* Dispose of this `down' event by simply jumping
5332 back to replay_key, to get another event.
5333
5334 Note that if this event came from mock input,
5335 then just jumping back to replay_key will just
5336 hand it to us again. So we have to wipe out any
5337 mock input.
5338
5339 We could delete keybuf[t] and shift everything
5340 after that to the left by one spot, but we'd also
5341 have to fix up any variable that points into
5342 keybuf, and shifting isn't really necessary
5343 anyway.
5344
5345 Adding prefixes for non-textual mouse clicks
5346 creates two characters of mock input, and both
5347 must be thrown away. If we're only looking at
5348 the prefix now, we can just jump back to
5349 replay_key. On the other hand, if we've already
5350 processed the prefix, and now the actual click
5351 itself is giving us trouble, then we've lost the
5352 state of the keymaps we want to backtrack to, and
5353 we need to replay the whole sequence to rebuild
5354 it.
5355
5356 Beyond that, only function key expansion could
5357 create more than two keys, but that should never
5358 generate mouse events, so it's okay to zero
5359 mock_input in that case too.
5360
5361 Isn't this just the most wonderful code ever? */
5362 if (t == last_real_key_start)
5363 {
5364 mock_input = 0;
5365 goto replay_key;
5366 }
5367 else
5368 {
5369 mock_input = last_real_key_start;
5370 goto replay_sequence;
5371 }
5372 }
5373
27203ead
RS
5374 new_head
5375 = apply_modifiers (modifiers, XCONS (breakdown)->car);
5376 new_click
5377 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
fbcd35bd
JB
5378
5379 /* Look for a binding for this new key. follow_key
5380 promises that it didn't munge submaps the
5381 last time we called it, since key was unbound. */
27203ead
RS
5382 first_binding
5383 = (follow_key (new_click,
5384 nmaps - local_first_binding,
5385 submaps + local_first_binding,
5386 defs + local_first_binding,
4e50f26a 5387 submaps + local_first_binding)
27203ead 5388 + local_first_binding);
fbcd35bd
JB
5389
5390 /* If that click is bound, go for it. */
5391 if (first_binding < nmaps)
5392 {
5393 key = new_click;
5394 break;
5395 }
5396 /* Otherwise, we'll leave key set to the drag event. */
5397 }
0a7f1fc0
JB
5398 }
5399 }
5400 }
5401
284f4730 5402 keybuf[t++] = key;
7d6de002
RS
5403 /* Normally, last_nonmenu_event gets the previous key we read.
5404 But when a mouse popup menu is being used,
5405 we don't update last_nonmenu_event; it continues to hold the mouse
5406 event that preceded the first level of menu. */
5407 if (!used_mouse_menu)
5408 last_nonmenu_event = key;
284f4730
JB
5409
5410 /* If the sequence is unbound, see if we can hang a function key
253598e4
JB
5411 off the end of it. We only want to scan real keyboard input
5412 for function key sequences, so if mock_input says that we're
f4255cd1 5413 re-reading old events, don't examine it. */
4e50f26a 5414 if (first_binding >= nmaps
253598e4 5415 && t >= mock_input)
284f4730
JB
5416 {
5417 Lisp_Object fkey_next;
5418
e9bf89a0
RS
5419 /* Continue scan from fkey_end until we find a bound suffix.
5420 If we fail, increment fkey_start
5421 and start fkey_end from there. */
284f4730
JB
5422 while (fkey_end < t)
5423 {
f4255cd1
JB
5424 Lisp_Object key;
5425
5426 key = keybuf[fkey_end++];
067ffa38
JB
5427 /* Look up meta-characters by prefixing them
5428 with meta_prefix_char. I hate this. */
8c18cbfb 5429 if (INTEGERP (key) && XINT (key) & meta_modifier)
f4255cd1 5430 {
e74fbc70
RS
5431 fkey_next
5432 = get_keymap_1
f4255cd1 5433 (get_keyelt
e74fbc70 5434 (access_keymap (fkey_map, meta_prefix_char, 1, 0)),
f4255cd1 5435 0, 1);
bb9e9bed 5436 XSETFASTINT (key, XFASTINT (key) & ~meta_modifier);
f4255cd1 5437 }
067ffa38
JB
5438 else
5439 fkey_next = fkey_map;
5440
e74fbc70
RS
5441 fkey_next
5442 = get_keyelt (access_keymap (fkey_next, key, 1, 0));
067ffa38 5443
7a80a6f6
RS
5444#if 0 /* I didn't turn this on, because it might cause trouble
5445 for the mapping of return into C-m and tab into C-i. */
5446 /* Optionally don't map function keys into other things.
5447 This enables the user to redefine kp- keys easily. */
5448 if (SYMBOLP (key) && !NILP (Vinhibit_function_key_mapping))
5449 fkey_next = Qnil;
5450#endif
5451
1abe6abe
RS
5452 /* If the function key map gives a function, not an
5453 array, then call the function with no args and use
5454 its value instead. */
5455 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
5456 && fkey_end == t)
5457 {
5458 struct gcpro gcpro1, gcpro2, gcpro3;
5459 Lisp_Object tem;
5460 tem = fkey_next;
5461
5462 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
84d91fda 5463 fkey_next = call1 (fkey_next, prompt);
1abe6abe
RS
5464 UNGCPRO;
5465 /* If the function returned something invalid,
5466 barf--don't ignore it.
5467 (To ignore it safely, we would need to gcpro a bunch of
5468 other variables.) */
5469 if (! (VECTORP (fkey_next) || STRINGP (fkey_next)))
5470 error ("Function in function-key-map returns invalid key sequence");
5471 }
5472
e9bf89a0
RS
5473 function_key_possible = ! NILP (fkey_next);
5474
85bc5181 5475 /* If keybuf[fkey_start..fkey_end] is bound in the
a764a753 5476 function key map and it's a suffix of the current
85bc5181 5477 sequence (i.e. fkey_end == t), replace it with
a764a753 5478 the binding and restart with fkey_start at the end. */
f5ea6163 5479 if ((VECTORP (fkey_next) || STRINGP (fkey_next))
284f4730
JB
5480 && fkey_end == t)
5481 {
2e864a76 5482 int len = XFASTINT (Flength (fkey_next));
f5ea6163
JB
5483
5484 t = fkey_start + len;
284f4730
JB
5485 if (t >= bufsize)
5486 error ("key sequence too long");
5487
f5ea6163
JB
5488 if (VECTORP (fkey_next))
5489 bcopy (XVECTOR (fkey_next)->contents,
5490 keybuf + fkey_start,
5491 (t - fkey_start) * sizeof (keybuf[0]));
5492 else if (STRINGP (fkey_next))
5493 {
5494 int i;
5495
5496 for (i = 0; i < len; i++)
bb9e9bed
KH
5497 XSETFASTINT (keybuf[fkey_start + i],
5498 XSTRING (fkey_next)->data[i]);
f5ea6163 5499 }
284f4730
JB
5500
5501 mock_input = t;
5502 fkey_start = fkey_end = t;
32e6d806 5503 fkey_map = Vfunction_key_map;
284f4730 5504
00a78037
RS
5505 /* Do pass the results through key-translation-map. */
5506 keytran_start = keytran_end = 0;
5507 keytran_map = Vkey_translation_map;
5508
f4255cd1 5509 goto replay_sequence;
284f4730
JB
5510 }
5511
f4255cd1 5512 fkey_map = get_keymap_1 (fkey_next, 0, 1);
284f4730 5513
a764a753
JB
5514 /* If we no longer have a bound suffix, try a new positions for
5515 fkey_start. */
284f4730
JB
5516 if (NILP (fkey_map))
5517 {
5518 fkey_end = ++fkey_start;
5519 fkey_map = Vfunction_key_map;
e9bf89a0 5520 function_key_possible = 0;
284f4730
JB
5521 }
5522 }
5523 }
a612e298
RS
5524
5525 /* Look for this sequence in key-translation-map. */
5526 {
5527 Lisp_Object keytran_next;
5528
5529 /* Scan from keytran_end until we find a bound suffix. */
5530 while (keytran_end < t)
5531 {
5532 Lisp_Object key;
5533
5534 key = keybuf[keytran_end++];
5535 /* Look up meta-characters by prefixing them
5536 with meta_prefix_char. I hate this. */
8c18cbfb 5537 if (INTEGERP (key) && XINT (key) & meta_modifier)
a612e298
RS
5538 {
5539 keytran_next
5540 = get_keymap_1
5541 (get_keyelt
5542 (access_keymap (keytran_map, meta_prefix_char, 1, 0)),
5543 0, 1);
bb9e9bed 5544 XSETFASTINT (key, XFASTINT (key) & ~meta_modifier);
a612e298
RS
5545 }
5546 else
5547 keytran_next = keytran_map;
5548
5549 keytran_next
5550 = get_keyelt (access_keymap (keytran_next, key, 1, 0));
5551
1abe6abe
RS
5552 /* If the key translation map gives a function, not an
5553 array, then call the function with no args and use
5554 its value instead. */
5555 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
5556 && keytran_end == t)
5557 {
5558 struct gcpro gcpro1, gcpro2, gcpro3;
5559 Lisp_Object tem;
5560 tem = keytran_next;
5561
40932d1a 5562 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
84d91fda 5563 keytran_next = call1 (keytran_next, prompt);
1abe6abe
RS
5564 UNGCPRO;
5565 /* If the function returned something invalid,
5566 barf--don't ignore it.
5567 (To ignore it safely, we would need to gcpro a bunch of
5568 other variables.) */
5569 if (! (VECTORP (keytran_next) || STRINGP (keytran_next)))
40932d1a 5570 error ("Function in key-translation-map returns invalid key sequence");
1abe6abe
RS
5571 }
5572
00a78037
RS
5573 key_translation_possible = ! NILP (keytran_next);
5574
a612e298 5575 /* If keybuf[keytran_start..keytran_end] is bound in the
1abe6abe 5576 key translation map and it's a suffix of the current
a612e298
RS
5577 sequence (i.e. keytran_end == t), replace it with
5578 the binding and restart with keytran_start at the end. */
5579 if ((VECTORP (keytran_next) || STRINGP (keytran_next))
5580 && keytran_end == t)
5581 {
2e864a76 5582 int len = XFASTINT (Flength (keytran_next));
a612e298
RS
5583
5584 t = keytran_start + len;
5585 if (t >= bufsize)
5586 error ("key sequence too long");
5587
5588 if (VECTORP (keytran_next))
5589 bcopy (XVECTOR (keytran_next)->contents,
5590 keybuf + keytran_start,
5591 (t - keytran_start) * sizeof (keybuf[0]));
5592 else if (STRINGP (keytran_next))
5593 {
5594 int i;
5595
5596 for (i = 0; i < len; i++)
bb9e9bed
KH
5597 XSETFASTINT (keybuf[keytran_start + i],
5598 XSTRING (keytran_next)->data[i]);
a612e298
RS
5599 }
5600
5601 mock_input = t;
5602 keytran_start = keytran_end = t;
5603 keytran_map = Vkey_translation_map;
5604
00a78037
RS
5605 /* Don't pass the results of key-translation-map
5606 through function-key-map. */
5607 fkey_start = fkey_end = t;
5608 fkey_map = Vkey_translation_map;
5609
a612e298
RS
5610 goto replay_sequence;
5611 }
5612
5613 keytran_map = get_keymap_1 (keytran_next, 0, 1);
5614
5615 /* If we no longer have a bound suffix, try a new positions for
5616 keytran_start. */
5617 if (NILP (keytran_map))
5618 {
5619 keytran_end = ++keytran_start;
5620 keytran_map = Vkey_translation_map;
00a78037 5621 key_translation_possible = 0;
a612e298
RS
5622 }
5623 }
5624 }
4e50f26a
RS
5625
5626 /* If KEY is not defined in any of the keymaps,
5627 and cannot be part of a function key or translation,
5628 and is an upper case letter
5629 use the corresponding lower-case letter instead. */
5630 if (first_binding == nmaps && ! function_key_possible
00a78037 5631 && ! key_translation_possible
8c18cbfb 5632 && INTEGERP (key)
4e50f26a
RS
5633 && ((((XINT (key) & 0x3ffff)
5634 < XSTRING (current_buffer->downcase_table)->size)
5635 && UPPERCASEP (XINT (key) & 0x3ffff))
5636 || (XINT (key) & shift_modifier)))
5637 {
309b0fc8
RS
5638 original_uppercase = key;
5639 original_uppercase_position = t - 1;
5640
4e50f26a
RS
5641 if (XINT (key) & shift_modifier)
5642 XSETINT (key, XINT (key) & ~shift_modifier);
5643 else
5644 XSETINT (key, (DOWNCASE (XINT (key) & 0x3ffff)
5645 | (XINT (key) & ~0x3ffff)));
5646
5647 keybuf[t - 1] = key;
5648 mock_input = t;
5649 goto replay_sequence;
5650 }
ef8fd672
RS
5651 /* If KEY is not defined in any of the keymaps,
5652 and cannot be part of a function key or translation,
5653 and is a shifted function key,
5654 use the corresponding unshifted function key instead. */
5655 if (first_binding == nmaps && ! function_key_possible
5656 && ! key_translation_possible
5657 && SYMBOLP (key))
5658 {
5659 Lisp_Object breakdown;
5660 int modifiers;
5661
309b0fc8
RS
5662 original_uppercase = key;
5663 original_uppercase_position = t - 1;
5664
ef8fd672
RS
5665 breakdown = parse_modifiers (key);
5666 modifiers = XINT (XCONS (XCONS (breakdown)->cdr)->car);
5667 if (modifiers & shift_modifier)
5668 {
5669 modifiers &= ~shift_modifier;
5670 key = apply_modifiers (make_number (modifiers),
5671 XCONS (breakdown)->car);
5672
5673 keybuf[t - 1] = key;
5674 mock_input = t;
5675 goto replay_sequence;
5676 }
5677 }
284f4730
JB
5678 }
5679
309b0fc8 5680 if (!dummyflag)
bc536d84
RS
5681 read_key_sequence_cmd = (first_binding < nmaps
5682 ? defs[first_binding]
5683 : Qnil);
284f4730 5684
cd21b839 5685 unread_switch_frame = delayed_switch_frame;
f4255cd1 5686 unbind_to (count, Qnil);
07f76a14 5687
309b0fc8
RS
5688 if (dont_downcase_last && t - 1 == original_uppercase_position)
5689 keybuf[t - 1] = original_uppercase;
5690
07f76a14
JB
5691 /* Occasionally we fabricate events, perhaps by expanding something
5692 according to function-key-map, or by adding a prefix symbol to a
5693 mouse click in the scroll bar or modeline. In this cases, return
5694 the entire generated key sequence, even if we hit an unbound
5695 prefix or a definition before the end. This means that you will
5696 be able to push back the event properly, and also means that
5697 read-key-sequence will always return a logical unit.
5698
5699 Better ideas? */
cca310da
JB
5700 for (; t < mock_input; t++)
5701 {
a98ea3f9
RS
5702 if (echo_keystrokes)
5703 echo_char (keybuf[t]);
cca310da
JB
5704 add_command_key (keybuf[t]);
5705 }
07f76a14 5706
284f4730
JB
5707 return t;
5708}
5709
a612e298
RS
5710#if 0 /* This doc string is too long for some compilers.
5711 This commented-out definition serves for DOC. */
ce98e608 5712DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0,
284f4730
JB
5713 "Read a sequence of keystrokes and return as a string or vector.\n\
5714The sequence is sufficient to specify a non-prefix command in the\n\
5715current local and global maps.\n\
5716\n\
c0a58692
RS
5717First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
5718Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\
5719as a continuation of the previous key.\n\
284f4730 5720\n\
309b0fc8
RS
5721The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not\n\
5722convert the last event to lower case. (Normally any upper case event\n\
5723is converted to lower case if the original event is undefined and the lower\n\
5724case equivalent is defined.) A non-nil value is appropriate for reading\n\
5725a key sequence to be defined.\n\
5726\n\
cb5df6ae
JB
5727A C-g typed while in this function is treated like any other character,\n\
5728and `quit-flag' is not set.\n\
5729\n\
5730If the key sequence starts with a mouse click, then the sequence is read\n\
5731using the keymaps of the buffer of the window clicked in, not the buffer\n\
5732of the selected window as normal.\n\
ede41463 5733""\n\
cb5df6ae
JB
5734`read-key-sequence' drops unbound button-down events, since you normally\n\
5735only care about the click or drag events which follow them. If a drag\n\
fbcd35bd
JB
5736or multi-click event is unbound, but the corresponding click event would\n\
5737be bound, `read-key-sequence' turns the event into a click event at the\n\
cb5df6ae 5738drag's starting position. This means that you don't have to distinguish\n\
fbcd35bd 5739between click and drag, double, or triple events unless you want to.\n\
cb5df6ae
JB
5740\n\
5741`read-key-sequence' prefixes mouse events on mode lines, the vertical\n\
3c370943
JB
5742lines separating windows, and scroll bars with imaginary keys\n\
5743`mode-line', `vertical-line', and `vertical-scroll-bar'.\n\
cb5df6ae 5744\n\
ce98e608
KH
5745Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this\n\
5746function will process a switch-frame event if the user switches frames\n\
5747before typing anything. If the user switches frames in the middle of a\n\
5748key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME\n\
5749is nil, then the event will be put off until after the current key sequence.\n\
cb5df6ae
JB
5750\n\
5751`read-key-sequence' checks `function-key-map' for function key\n\
5752sequences, where they wouldn't conflict with ordinary bindings. See\n\
4bb994d1 5753`function-key-map' for more details.")
a612e298
RS
5754 (prompt, continue_echo)
5755#endif
5756
ce98e608 5757DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0,
a612e298 5758 0)
ce98e608 5759 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame)
309b0fc8 5760 Lisp_Object prompt, continue_echo, dont_downcase_last;
ce98e608 5761 Lisp_Object can_return_switch_frame;
284f4730
JB
5762{
5763 Lisp_Object keybuf[30];
5764 register int i;
5765 struct gcpro gcpro1, gcpro2;
5766
5767 if (!NILP (prompt))
5768 CHECK_STRING (prompt, 0);
5769 QUIT;
5770
5771 bzero (keybuf, sizeof keybuf);
5772 GCPRO1 (keybuf[0]);
5773 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
5774
daa37602 5775 if (NILP (continue_echo))
c0a58692
RS
5776 this_command_key_count = 0;
5777
309b0fc8 5778 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
ce98e608
KH
5779 prompt, ! NILP (dont_downcase_last),
5780 ! NILP (can_return_switch_frame));
284f4730 5781
dcc408a0
RS
5782 if (i == -1)
5783 {
5784 Vquit_flag = Qt;
5785 QUIT;
5786 }
284f4730 5787 UNGCPRO;
86e5706b 5788 return make_event_array (i, keybuf);
284f4730
JB
5789}
5790\f
5791DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 2, 0,
5792 "Execute CMD as an editor command.\n\
5793CMD must be a symbol that satisfies the `commandp' predicate.\n\
5794Optional second arg RECORD-FLAG non-nil\n\
5795means unconditionally put this command in `command-history'.\n\
5796Otherwise, that is done only if an arg is read using the minibuffer.")
5797 (cmd, record)
5798 Lisp_Object cmd, record;
5799{
5800 register Lisp_Object final;
5801 register Lisp_Object tem;
5802 Lisp_Object prefixarg;
5803 struct backtrace backtrace;
5804 extern int debug_on_next_call;
5805
4c52b668
KH
5806 prefixarg = Vprefix_arg;
5807 clear_prefix_arg ();
5808 Vcurrent_prefix_arg = prefixarg;
284f4730
JB
5809 debug_on_next_call = 0;
5810
8c18cbfb 5811 if (SYMBOLP (cmd))
284f4730
JB
5812 {
5813 tem = Fget (cmd, Qdisabled);
88ce066e 5814 if (!NILP (tem) && !NILP (Vrun_hooks))
2e894dab 5815 return call1 (Vrun_hooks, Qdisabled_command_hook);
284f4730
JB
5816 }
5817
5818 while (1)
5819 {
ffd56f97 5820 final = Findirect_function (cmd);
284f4730
JB
5821
5822 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
5823 do_autoload (final, cmd);
5824 else
5825 break;
5826 }
5827
8c18cbfb 5828 if (STRINGP (final) || VECTORP (final))
284f4730
JB
5829 {
5830 /* If requested, place the macro in the command history. For
5831 other sorts of commands, call-interactively takes care of
5832 this. */
5833 if (!NILP (record))
5834 Vcommand_history
5835 = Fcons (Fcons (Qexecute_kbd_macro,
5836 Fcons (final, Fcons (prefixarg, Qnil))),
5837 Vcommand_history);
5838
5839 return Fexecute_kbd_macro (final, prefixarg);
5840 }
8c18cbfb 5841 if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
284f4730
JB
5842 {
5843 backtrace.next = backtrace_list;
5844 backtrace_list = &backtrace;
5845 backtrace.function = &Qcall_interactively;
5846 backtrace.args = &cmd;
5847 backtrace.nargs = 1;
5848 backtrace.evalargs = 0;
5849
5850 tem = Fcall_interactively (cmd, record);
5851
5852 backtrace_list = backtrace.next;
5853 return tem;
5854 }
5855 return Qnil;
5856}
5857\f
284f4730
JB
5858DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
5859 1, 1, "P",
5860 "Read function name, then read its arguments and call it.")
5861 (prefixarg)
5862 Lisp_Object prefixarg;
5863{
5864 Lisp_Object function;
5865 char buf[40];
5866 Lisp_Object saved_keys;
5867 struct gcpro gcpro1;
5868
b0f2a7bf
KH
5869 saved_keys = Fvector (this_command_key_count,
5870 XVECTOR (this_command_keys)->contents);
284f4730
JB
5871 buf[0] = 0;
5872 GCPRO1 (saved_keys);
5873
5874 if (EQ (prefixarg, Qminus))
5875 strcpy (buf, "- ");
5876 else if (CONSP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4)
5877 strcpy (buf, "C-u ");
8c18cbfb 5878 else if (CONSP (prefixarg) && INTEGERP (XCONS (prefixarg)->car))
284f4730 5879 sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car));
8c18cbfb 5880 else if (INTEGERP (prefixarg))
284f4730
JB
5881 sprintf (buf, "%d ", XINT (prefixarg));
5882
5883 /* This isn't strictly correct if execute-extended-command
5884 is bound to anything else. Perhaps it should use
5885 this_command_keys? */
5886 strcat (buf, "M-x ");
5887
5888 /* Prompt with buf, and then read a string, completing from and
5889 restricting to the set of all defined commands. Don't provide
51763820 5890 any initial input. Save the command read on the extended-command
03b4122a 5891 history list. */
284f4730
JB
5892 function = Fcompleting_read (build_string (buf),
5893 Vobarray, Qcommandp,
03b4122a 5894 Qt, Qnil, Qextended_command_history);
284f4730 5895
1113d9db
JB
5896 /* Set this_command_keys to the concatenation of saved_keys and
5897 function, followed by a RET. */
284f4730 5898 {
1113d9db 5899 struct Lisp_String *str;
b0f2a7bf 5900 Lisp_Object *keys;
284f4730
JB
5901 int i;
5902 Lisp_Object tem;
5903
1113d9db
JB
5904 this_command_key_count = 0;
5905
b0f2a7bf
KH
5906 keys = XVECTOR (saved_keys)->contents;
5907 for (i = 0; i < XVECTOR (saved_keys)->size; i++)
5908 add_command_key (keys[i]);
1113d9db
JB
5909
5910 str = XSTRING (function);
5911 for (i = 0; i < str->size; i++)
5912 {
bb9e9bed 5913 XSETFASTINT (tem, str->data[i]);
1113d9db
JB
5914 add_command_key (tem);
5915 }
5916
bb9e9bed 5917 XSETFASTINT (tem, '\015');
1113d9db 5918 add_command_key (tem);
284f4730
JB
5919 }
5920
5921 UNGCPRO;
5922
0a7f1fc0 5923 function = Fintern (function, Qnil);
4c52b668 5924 Vprefix_arg = prefixarg;
284f4730
JB
5925 this_command = function;
5926
5927 return Fcommand_execute (function, Qt);
5928}
5929\f
5930
5931detect_input_pending ()
5932{
5933 if (!input_pending)
5934 get_input_pending (&input_pending);
5935
5936 return input_pending;
5937}
5938
ffd56f97
JB
5939/* This is called in some cases before a possible quit.
5940 It cases the next call to detect_input_pending to recompute input_pending.
5941 So calling this function unnecessarily can't do any harm. */
5942clear_input_pending ()
5943{
5944 input_pending = 0;
5945}
5946
284f4730
JB
5947DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
5948 "T if command input is currently available with no waiting.\n\
5949Actually, the value is nil only if we can be sure that no input is available.")
5950 ()
5951{
24597608 5952 if (!NILP (Vunread_command_events) || unread_command_char != -1)
284f4730
JB
5953 return (Qt);
5954
5955 return detect_input_pending () ? Qt : Qnil;
5956}
5957
5958DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
22d7cb89 5959 "Return vector of last 100 events, not counting those from keyboard macros.")
284f4730
JB
5960 ()
5961{
5160df46 5962 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
284f4730
JB
5963 Lisp_Object val;
5964
5965 if (total_keys < NUM_RECENT_KEYS)
5160df46 5966 return Fvector (total_keys, keys);
284f4730
JB
5967 else
5968 {
5160df46
JB
5969 val = Fvector (NUM_RECENT_KEYS, keys);
5970 bcopy (keys + recent_keys_index,
284f4730
JB
5971 XVECTOR (val)->contents,
5972 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
5160df46 5973 bcopy (keys,
284f4730
JB
5974 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
5975 recent_keys_index * sizeof (Lisp_Object));
5976 return val;
5977 }
5978}
5979
5980DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
e5f920d7
RS
5981 "Return the key sequence that invoked this command.\n\
5982The value is a string or a vector.")
284f4730
JB
5983 ()
5984{
86e5706b
RS
5985 return make_event_array (this_command_key_count,
5986 XVECTOR (this_command_keys)->contents);
284f4730
JB
5987}
5988
5989DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
5990 "Return the current depth in recursive edits.")
5991 ()
5992{
5993 Lisp_Object temp;
bb9e9bed 5994 XSETFASTINT (temp, command_loop_level + minibuf_level);
284f4730
JB
5995 return temp;
5996}
5997
5998DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
5999 "FOpen dribble file: ",
9b2471df
RS
6000 "Start writing all keyboard characters to a dribble file called FILE.\n\
6001If FILE is nil, close any open dribble file.")
284f4730
JB
6002 (file)
6003 Lisp_Object file;
6004{
6005 if (NILP (file))
6006 {
d0011c11
RS
6007 if (dribble)
6008 {
6009 fclose (dribble);
6010 dribble = 0;
6011 }
284f4730
JB
6012 }
6013 else
6014 {
6015 file = Fexpand_file_name (file, Qnil);
6016 dribble = fopen (XSTRING (file)->data, "w");
6017 }
6018 return Qnil;
6019}
6020
6021DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
6022 "Discard the contents of the terminal input buffer.\n\
6023Also cancel any kbd macro being defined.")
6024 ()
6025{
8066f1a1 6026 current_perdisplay->defining_kbd_macro = Qnil;
284f4730
JB
6027 update_mode_lines++;
6028
24597608 6029 Vunread_command_events = Qnil;
86e5706b 6030 unread_command_char = -1;
284f4730
JB
6031
6032 discard_tty_input ();
6033
ff0b5f4c
JB
6034 /* Without the cast, GCC complains that this assignment loses the
6035 volatile qualifier of kbd_store_ptr. Is there anything wrong
6036 with that? */
beecf6a1
KH
6037 kbd_fetch_ptr = (struct input_event *) kbd_store_ptr;
6038 Ffillarray (kbd_buffer_frame_or_window, Qnil);
284f4730
JB
6039 input_pending = 0;
6040
6041 return Qnil;
6042}
6043\f
6044DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
6045 "Stop Emacs and return to superior process. You can resume later.\n\
8026024c
KH
6046If `cannot-suspend' is non-nil, or if the system doesn't support job\n\
6047control, run a subshell instead.\n\n\
284f4730 6048If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
b7d2ebbf
RS
6049to be read as terminal input by Emacs's parent, after suspension.\n\
6050\n\
bbdc2092
RS
6051Before suspending, run the normal hook `suspend-hook'.\n\
6052After resumption run the normal hook `suspend-resume-hook'.\n\
284f4730
JB
6053\n\
6054Some operating systems cannot stop the Emacs process and resume it later.\n\
b7d2ebbf 6055On such systems, Emacs starts a subshell instead of suspending.")
284f4730
JB
6056 (stuffstring)
6057 Lisp_Object stuffstring;
6058{
3a69360c 6059 Lisp_Object tem;
284f4730
JB
6060 int count = specpdl_ptr - specpdl;
6061 int old_height, old_width;
6062 int width, height;
b7d2ebbf 6063 struct gcpro gcpro1, gcpro2;
284f4730
JB
6064 extern init_sys_modes ();
6065
6066 if (!NILP (stuffstring))
6067 CHECK_STRING (stuffstring, 0);
284f4730 6068
1e95ed28
JB
6069 /* Run the functions in suspend-hook. */
6070 if (!NILP (Vrun_hooks))
6071 call1 (Vrun_hooks, intern ("suspend-hook"));
284f4730 6072
b7d2ebbf 6073 GCPRO1 (stuffstring);
ff11dfa1 6074 get_frame_size (&old_width, &old_height);
284f4730
JB
6075 reset_sys_modes ();
6076 /* sys_suspend can get an error if it tries to fork a subshell
6077 and the system resources aren't available for that. */
6078 record_unwind_protect (init_sys_modes, 0);
6079 stuff_buffered_input (stuffstring);
8026024c
KH
6080 if (cannot_suspend)
6081 sys_subshell ();
6082 else
6083 sys_suspend ();
284f4730
JB
6084 unbind_to (count, Qnil);
6085
6086 /* Check if terminal/window size has changed.
6087 Note that this is not useful when we are running directly
6088 with a window system; but suspend should be disabled in that case. */
ff11dfa1 6089 get_frame_size (&width, &height);
284f4730 6090 if (width != old_width || height != old_height)
f5ea6163 6091 change_frame_size (selected_frame, height, width, 0, 0);
284f4730 6092
1e95ed28 6093 /* Run suspend-resume-hook. */
284f4730
JB
6094 if (!NILP (Vrun_hooks))
6095 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
6096
6097 UNGCPRO;
6098 return Qnil;
6099}
6100
6101/* If STUFFSTRING is a string, stuff its contents as pending terminal input.
eb8c3be9 6102 Then in any case stuff anything Emacs has read ahead and not used. */
284f4730
JB
6103
6104stuff_buffered_input (stuffstring)
6105 Lisp_Object stuffstring;
6106{
284f4730
JB
6107/* stuff_char works only in BSD, versions 4.2 and up. */
6108#ifdef BSD
6109#ifndef BSD4_1
612b78ef 6110 register unsigned char *p;
612b78ef 6111
8c18cbfb 6112 if (STRINGP (stuffstring))
284f4730
JB
6113 {
6114 register int count;
6115
6116 p = XSTRING (stuffstring)->data;
6117 count = XSTRING (stuffstring)->size;
6118 while (count-- > 0)
6119 stuff_char (*p++);
6120 stuff_char ('\n');
6121 }
6122 /* Anything we have read ahead, put back for the shell to read. */
beecf6a1
KH
6123 /* ?? What should this do when we have multiple keyboards??
6124 Should we ignore anything that was typed in at the "wrong" display? */
6125 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
284f4730 6126 {
beecf6a1
KH
6127 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
6128 kbd_fetch_ptr = kbd_buffer;
6129 if (kbd_fetch_ptr->kind == ascii_keystroke)
6130 stuff_char (kbd_fetch_ptr->code);
6131 kbd_fetch_ptr->kind = no_event;
6132 (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_fetch_ptr
6133 - kbd_buffer]
7b4aedb9 6134 = Qnil);
284f4730
JB
6135 }
6136 input_pending = 0;
6137#endif
6138#endif /* BSD and not BSD4_1 */
6139}
6140\f
ffd56f97
JB
6141set_waiting_for_input (time_to_clear)
6142 EMACS_TIME *time_to_clear;
284f4730 6143{
ffd56f97 6144 input_available_clear_time = time_to_clear;
284f4730
JB
6145
6146 /* Tell interrupt_signal to throw back to read_char, */
6147 waiting_for_input = 1;
6148
6149 /* If interrupt_signal was called before and buffered a C-g,
6150 make it run again now, to avoid timing error. */
6151 if (!NILP (Vquit_flag))
6152 quit_throw_to_read_char ();
284f4730
JB
6153}
6154
6155clear_waiting_for_input ()
6156{
6157 /* Tell interrupt_signal not to throw back to read_char, */
6158 waiting_for_input = 0;
ffd56f97 6159 input_available_clear_time = 0;
284f4730
JB
6160}
6161
6162/* This routine is called at interrupt level in response to C-G.
6163 If interrupt_input, this is the handler for SIGINT.
6164 Otherwise, it is called from kbd_buffer_store_event,
6165 in handling SIGIO or SIGTINT.
6166
6167 If `waiting_for_input' is non zero, then unless `echoing' is nonzero,
6168 immediately throw back to read_char.
6169
6170 Otherwise it sets the Lisp variable quit-flag not-nil.
6171 This causes eval to throw, when it gets a chance.
6172 If quit-flag is already non-nil, it stops the job right away. */
6173
6174SIGTYPE
91c049d4
RS
6175interrupt_signal (signalnum) /* If we don't have an argument, */
6176 int signalnum; /* some compilers complain in signal calls. */
284f4730
JB
6177{
6178 char c;
6179 /* Must preserve main program's value of errno. */
6180 int old_errno = errno;
284f4730
JB
6181
6182#ifdef USG
7a80a6f6
RS
6183 if (!read_socket_hook && NILP (Vwindow_system))
6184 {
6185 /* USG systems forget handlers when they are used;
6186 must reestablish each time */
6187 signal (SIGINT, interrupt_signal);
6188 signal (SIGQUIT, interrupt_signal);
6189 }
284f4730
JB
6190#endif /* USG */
6191
6192 cancel_echoing ();
6193
d5045cf9 6194 if (!NILP (Vquit_flag) && FRAME_TERMCAP_P (selected_frame))
284f4730
JB
6195 {
6196 fflush (stdout);
6197 reset_sys_modes ();
6198 sigfree ();
6199#ifdef SIGTSTP /* Support possible in later USG versions */
6200/*
6201 * On systems which can suspend the current process and return to the original
6202 * shell, this command causes the user to end up back at the shell.
6203 * The "Auto-save" and "Abort" questions are not asked until
6204 * the user elects to return to emacs, at which point he can save the current
6205 * job and either dump core or continue.
6206 */
6207 sys_suspend ();
6208#else
6209#ifdef VMS
6210 if (sys_suspend () == -1)
6211 {
6212 printf ("Not running as a subprocess;\n");
6213 printf ("you can continue or abort.\n");
6214 }
6215#else /* not VMS */
6216 /* Perhaps should really fork an inferior shell?
6217 But that would not provide any way to get back
6218 to the original shell, ever. */
6219 printf ("No support for stopping a process on this operating system;\n");
6220 printf ("you can continue or abort.\n");
6221#endif /* not VMS */
6222#endif /* not SIGTSTP */
80e4aa30
RS
6223#ifdef MSDOS
6224 /* We must remain inside the screen area when the internal terminal
6225 is used. Note that [Enter] is not echoed by dos. */
6226 cursor_to (0, 0);
6227#endif
284f4730
JB
6228 printf ("Auto-save? (y or n) ");
6229 fflush (stdout);
6230 if (((c = getchar ()) & ~040) == 'Y')
9fd7d808
RS
6231 {
6232 Fdo_auto_save (Qt, Qnil);
80e4aa30
RS
6233#ifdef MSDOS
6234 printf ("\r\nAuto-save done");
6235#else /* not MSDOS */
9fd7d808 6236 printf ("Auto-save done\n");
80e4aa30 6237#endif /* not MSDOS */
9fd7d808 6238 }
284f4730 6239 while (c != '\n') c = getchar ();
80e4aa30
RS
6240#ifdef MSDOS
6241 printf ("\r\nAbort? (y or n) ");
6242#else /* not MSDOS */
284f4730
JB
6243#ifdef VMS
6244 printf ("Abort (and enter debugger)? (y or n) ");
6245#else /* not VMS */
6246 printf ("Abort (and dump core)? (y or n) ");
6247#endif /* not VMS */
80e4aa30 6248#endif /* not MSDOS */
284f4730
JB
6249 fflush (stdout);
6250 if (((c = getchar ()) & ~040) == 'Y')
6251 abort ();
6252 while (c != '\n') c = getchar ();
80e4aa30
RS
6253#ifdef MSDOS
6254 printf ("\r\nContinuing...\r\n");
6255#else /* not MSDOS */
284f4730 6256 printf ("Continuing...\n");
80e4aa30 6257#endif /* not MSDOS */
284f4730
JB
6258 fflush (stdout);
6259 init_sys_modes ();
6260 }
6261 else
6262 {
6263 /* If executing a function that wants to be interrupted out of
6264 and the user has not deferred quitting by binding `inhibit-quit'
6265 then quit right away. */
6266 if (immediate_quit && NILP (Vinhibit_quit))
6267 {
6268 immediate_quit = 0;
6269 sigfree ();
6270 Fsignal (Qquit, Qnil);
6271 }
6272 else
6273 /* Else request quit when it's safe */
6274 Vquit_flag = Qt;
6275 }
6276
6277 if (waiting_for_input && !echoing)
6278 quit_throw_to_read_char ();
6279
6280 errno = old_errno;
6281}
6282
6283/* Handle a C-g by making read_char return C-g. */
6284
6285quit_throw_to_read_char ()
6286{
6287 quit_error_check ();
6288 sigfree ();
6289 /* Prevent another signal from doing this before we finish. */
f76475ad 6290 clear_waiting_for_input ();
284f4730
JB
6291 input_pending = 0;
6292
24597608 6293 Vunread_command_events = Qnil;
86e5706b 6294 unread_command_char = -1;
284f4730 6295
e6b01c14
JB
6296#ifdef POLL_FOR_INPUT
6297 /* May be > 1 if in recursive minibuffer. */
6298 if (poll_suppress_count == 0)
6299 abort ();
6300#endif
0dfcc832 6301#ifdef MULTI_FRAME
4c52b668
KH
6302 if (FRAMEP (internal_last_event_frame)
6303 && XFRAME (internal_last_event_frame) != selected_frame)
6304 Fhandle_switch_frame (make_lispy_switch_frame (internal_last_event_frame));
0dfcc832 6305#endif
e6b01c14 6306
284f4730
JB
6307 _longjmp (getcjmp, 1);
6308}
6309\f
6310DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
6311 "Set mode of reading keyboard input.\n\
464f8898
RS
6312First arg INTERRUPT non-nil means use input interrupts;\n\
6313 nil means use CBREAK mode.\n\
6314Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
284f4730 6315 (no effect except in CBREAK mode).\n\
b04904fb
RS
6316Third arg META t means accept 8-bit input (for a Meta key).\n\
6317 META nil means ignore the top bit, on the assumption it is parity.\n\
6318 Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\
a8ee7ef9
RS
6319Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\
6320See also `current-input-mode'.")
284f4730
JB
6321 (interrupt, flow, meta, quit)
6322 Lisp_Object interrupt, flow, meta, quit;
6323{
6324 if (!NILP (quit)
8c18cbfb 6325 && (!INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400))
34f04431
RS
6326 error ("set-input-mode: QUIT must be an ASCII character");
6327
6328#ifdef POLL_FOR_INPUT
6329 stop_polling ();
6330#endif
284f4730
JB
6331
6332 reset_sys_modes ();
6333#ifdef SIGIO
6334/* Note SIGIO has been undef'd if FIONREAD is missing. */
6335#ifdef NO_SOCK_SIGIO
6336 if (read_socket_hook)
6337 interrupt_input = 0; /* No interrupts if reading from a socket. */
6338 else
6339#endif /* NO_SOCK_SIGIO */
6340 interrupt_input = !NILP (interrupt);
6341#else /* not SIGIO */
6342 interrupt_input = 0;
6343#endif /* not SIGIO */
6344/* Our VMS input only works by interrupts, as of now. */
6345#ifdef VMS
6346 interrupt_input = 1;
6347#endif
6348 flow_control = !NILP (flow);
b04904fb
RS
6349 if (NILP (meta))
6350 meta_key = 0;
6351 else if (EQ (meta, Qt))
6352 meta_key = 1;
6353 else
6354 meta_key = 2;
284f4730
JB
6355 if (!NILP (quit))
6356 /* Don't let this value be out of range. */
6357 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
6358
6359 init_sys_modes ();
34f04431
RS
6360
6361#ifdef POLL_FOR_INPUT
6362 poll_suppress_count = 1;
6363 start_polling ();
6364#endif
284f4730
JB
6365 return Qnil;
6366}
80645119
JB
6367
6368DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
6369 "Return information about the way Emacs currently reads keyboard input.\n\
6370The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\
6371 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\
6372 nil, Emacs is using CBREAK mode.\n\
6373 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\
6374 terminal; this does not apply if Emacs uses interrupt-driven input.\n\
a8ee7ef9
RS
6375 META is t if accepting 8-bit input with 8th bit as Meta flag.\n\
6376 META nil means ignoring the top bit, on the assumption it is parity.\n\
6377 META is neither t nor nil if accepting 8-bit input and using\n\
6378 all 8 bits as the character code.\n\
80645119
JB
6379 QUIT is the character Emacs currently uses to quit.\n\
6380The elements of this list correspond to the arguments of\n\
a8ee7ef9 6381`set-input-mode'.")
80645119
JB
6382 ()
6383{
6384 Lisp_Object val[4];
6385
6386 val[0] = interrupt_input ? Qt : Qnil;
6387 val[1] = flow_control ? Qt : Qnil;
a8ee7ef9 6388 val[2] = meta_key == 2 ? make_number (0) : meta_key == 1 ? Qt : Qnil;
bb9e9bed 6389 XSETFASTINT (val[3], quit_char);
80645119 6390
bf673a7a 6391 return Flist (sizeof (val) / sizeof (val[0]), val);
80645119
JB
6392}
6393
284f4730 6394\f
6c6083a9
KH
6395/*
6396 * Set up a perdisplay object with reasonable initial values.
6397 */
6398void
6399init_perdisplay (perd)
6400 PERDISPLAY *perd;
6401{
4c52b668
KH
6402 perd->prefix_factor = Qnil;
6403 perd->prefix_value = Qnil;
6404 perd->prefix_sign = 1;
6405 perd->prefix_partial = 0;
beecf6a1 6406 perd->kbd_queue = Qnil;
4524b161 6407 perd->kbd_queue_has_data = 0;
267de7a1
KH
6408 perd->immediate_echo = 0;
6409 perd->echoptr = perd->echobuf;
6410 perd->echo_after_prompt = -1;
8066f1a1
KH
6411 perd->kbd_macro_buffer = 0;
6412 perd->kbd_macro_bufsize = 0;
6413 perd->defining_kbd_macro = Qnil;
b2ca5e69 6414 perd->Vlast_kbd_macro = Qnil;
6c6083a9
KH
6415}
6416
6417/*
6418 * Destroy the contents of a perdisplay object, but not the object itself.
6419 * We use this just before deleteing it, or if we're going to initialize
6420 * it a second time.
6421 */
6422void
6423wipe_perdisplay (perd)
6424 PERDISPLAY *perd;
6425{
8066f1a1
KH
6426 if (perd->kbd_macro_buffer)
6427 xfree (perd->kbd_macro_buffer);
6c6083a9
KH
6428}
6429
284f4730
JB
6430init_keyboard ()
6431{
284f4730
JB
6432 /* This is correct before outermost invocation of the editor loop */
6433 command_loop_level = -1;
6434 immediate_quit = 0;
6435 quit_char = Ctl ('g');
24597608 6436 Vunread_command_events = Qnil;
86e5706b 6437 unread_command_char = -1;
284f4730 6438 total_keys = 0;
9deb415a 6439 recent_keys_index = 0;
beecf6a1
KH
6440 kbd_fetch_ptr = kbd_buffer;
6441 kbd_store_ptr = kbd_buffer;
6442 kbd_buffer_frame_or_window
6443 = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil);
2eb6bfbe 6444#ifdef HAVE_MOUSE
a9d77f1f 6445 do_mouse_tracking = Qnil;
2eb6bfbe 6446#endif
284f4730
JB
6447 input_pending = 0;
6448
4c52b668
KH
6449#ifdef MULTI_FRAME
6450 /* This means that command_loop_1 won't try to select anything the first
6451 time through. */
6452 internal_last_event_frame = Qnil;
6453 Vlast_event_frame = internal_last_event_frame;
6454#endif
6455
6c6083a9 6456#ifndef MULTI_PERDISPLAY
4bb994d1 6457 if (initialized)
6c6083a9
KH
6458 wipe_perdisplay (&the_only_perdisplay);
6459 init_perdisplay (&the_only_perdisplay);
6460#endif
07d2b8de 6461
beecf6a1
KH
6462 if (initialized)
6463 Ffillarray (kbd_buffer_frame_or_window, Qnil);
6464
6465 kbd_buffer_frame_or_window
6466 = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil);
7a80a6f6 6467 if (!noninteractive && !read_socket_hook && NILP (Vwindow_system))
284f4730
JB
6468 {
6469 signal (SIGINT, interrupt_signal);
cb5df6ae 6470#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
284f4730
JB
6471 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
6472 SIGQUIT and we can't tell which one it will give us. */
6473 signal (SIGQUIT, interrupt_signal);
6474#endif /* HAVE_TERMIO */
7a80a6f6 6475 }
284f4730
JB
6476/* Note SIGIO has been undef'd if FIONREAD is missing. */
6477#ifdef SIGIO
7a80a6f6
RS
6478 if (!noninteractive)
6479 signal (SIGIO, input_available_signal);
8ea0a720 6480#endif /* SIGIO */
284f4730
JB
6481
6482/* Use interrupt input by default, if it works and noninterrupt input
6483 has deficiencies. */
6484
6485#ifdef INTERRUPT_INPUT
6486 interrupt_input = 1;
6487#else
6488 interrupt_input = 0;
6489#endif
6490
6491/* Our VMS input only works by interrupts, as of now. */
6492#ifdef VMS
6493 interrupt_input = 1;
6494#endif
6495
6496 sigfree ();
6497 dribble = 0;
6498
6499 if (keyboard_init_hook)
6500 (*keyboard_init_hook) ();
6501
6502#ifdef POLL_FOR_INPUT
6503 poll_suppress_count = 1;
6504 start_polling ();
6505#endif
6506}
6507
6508/* This type's only use is in syms_of_keyboard, to initialize the
6509 event header symbols and put properties on them. */
6510struct event_head {
6511 Lisp_Object *var;
6512 char *name;
6513 Lisp_Object *kind;
6514};
6515
6516struct event_head head_table[] = {
7b4aedb9 6517 &Qmouse_movement, "mouse-movement", &Qmouse_movement,
3c370943 6518 &Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement,
7b4aedb9 6519 &Qswitch_frame, "switch-frame", &Qswitch_frame,
bbdc2092 6520 &Qdelete_frame, "delete-frame", &Qdelete_frame,
af17bd2b
KH
6521 &Qiconify_frame, "iconify-frame", &Qiconify_frame,
6522 &Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible,
284f4730
JB
6523};
6524
6525syms_of_keyboard ()
6526{
2e894dab
RS
6527 Qdisabled_command_hook = intern ("disabled-command-hook");
6528 staticpro (&Qdisabled_command_hook);
6529
284f4730
JB
6530 Qself_insert_command = intern ("self-insert-command");
6531 staticpro (&Qself_insert_command);
6532
6533 Qforward_char = intern ("forward-char");
6534 staticpro (&Qforward_char);
6535
6536 Qbackward_char = intern ("backward-char");
6537 staticpro (&Qbackward_char);
6538
6539 Qdisabled = intern ("disabled");
6540 staticpro (&Qdisabled);
6541
e58aa385
RS
6542 Qundefined = intern ("undefined");
6543 staticpro (&Qundefined);
6544
4c52b668
KH
6545 Qdigit_argument = intern ("digit-argument");
6546 staticpro (&Qdigit_argument);
6547
6548 Qnegative_argument = intern ("negative-argument");
6549 staticpro (&Qnegative_argument);
6550
86e5706b
RS
6551 Qpre_command_hook = intern ("pre-command-hook");
6552 staticpro (&Qpre_command_hook);
6553
6554 Qpost_command_hook = intern ("post-command-hook");
6555 staticpro (&Qpost_command_hook);
6556
3ef14e46
RS
6557 Qdeferred_action_function = intern ("deferred-action-function");
6558 staticpro (&Qdeferred_action_function);
6559
40932d1a
RS
6560 Qcommand_hook_internal = intern ("command-hook-internal");
6561 staticpro (&Qcommand_hook_internal);
6562
284f4730
JB
6563 Qfunction_key = intern ("function-key");
6564 staticpro (&Qfunction_key);
13b5e56c 6565 Qmouse_click = intern ("mouse-click");
284f4730 6566 staticpro (&Qmouse_click);
284f4730 6567
598a9fa7
JB
6568 Qmenu_enable = intern ("menu-enable");
6569 staticpro (&Qmenu_enable);
6570
284f4730
JB
6571 Qmode_line = intern ("mode-line");
6572 staticpro (&Qmode_line);
e5d77022
JB
6573 Qvertical_line = intern ("vertical-line");
6574 staticpro (&Qvertical_line);
3c370943
JB
6575 Qvertical_scroll_bar = intern ("vertical-scroll-bar");
6576 staticpro (&Qvertical_scroll_bar);
5ec75a55
RS
6577 Qmenu_bar = intern ("menu-bar");
6578 staticpro (&Qmenu_bar);
4bb994d1
JB
6579
6580 Qabove_handle = intern ("above-handle");
6581 staticpro (&Qabove_handle);
6582 Qhandle = intern ("handle");
6583 staticpro (&Qhandle);
6584 Qbelow_handle = intern ("below-handle");
6585 staticpro (&Qbelow_handle);
284f4730 6586
cd21b839 6587 Qevent_kind = intern ("event-kind");
284f4730 6588 staticpro (&Qevent_kind);
88cb0656
JB
6589 Qevent_symbol_elements = intern ("event-symbol-elements");
6590 staticpro (&Qevent_symbol_elements);
0a7f1fc0
JB
6591 Qevent_symbol_element_mask = intern ("event-symbol-element-mask");
6592 staticpro (&Qevent_symbol_element_mask);
6593 Qmodifier_cache = intern ("modifier-cache");
6594 staticpro (&Qmodifier_cache);
284f4730 6595
48e416d4
RS
6596 Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar");
6597 staticpro (&Qrecompute_lucid_menubar);
6598 Qactivate_menubar_hook = intern ("activate-menubar-hook");
6599 staticpro (&Qactivate_menubar_hook);
6600
f4eef8b4
RS
6601 Qpolling_period = intern ("polling-period");
6602 staticpro (&Qpolling_period);
6603
284f4730
JB
6604 {
6605 struct event_head *p;
6606
6607 for (p = head_table;
6608 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
6609 p++)
6610 {
6611 *p->var = intern (p->name);
6612 staticpro (p->var);
6613 Fput (*p->var, Qevent_kind, *p->kind);
88cb0656 6614 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
284f4730
JB
6615 }
6616 }
6617
7b4aedb9
JB
6618 button_down_location = Fmake_vector (make_number (NUM_MOUSE_BUTTONS), Qnil);
6619 staticpro (&button_down_location);
88cb0656
JB
6620
6621 {
6622 int i;
6623 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
6624
6625 modifier_symbols = Fmake_vector (make_number (len), Qnil);
6626 for (i = 0; i < len; i++)
86e5706b
RS
6627 if (modifier_names[i])
6628 XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]);
88cb0656
JB
6629 staticpro (&modifier_symbols);
6630 }
6631
9deb415a
JB
6632 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
6633 staticpro (&recent_keys);
6634
6569cc8d 6635 this_command_keys = Fmake_vector (make_number (40), Qnil);
715d9345 6636 staticpro (&this_command_keys);
6569cc8d 6637
03b4122a
BF
6638 Qextended_command_history = intern ("extended-command-history");
6639 Fset (Qextended_command_history, Qnil);
6640 staticpro (&Qextended_command_history);
6641
beecf6a1
KH
6642 kbd_buffer_frame_or_window
6643 = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil);
6644 staticpro (&kbd_buffer_frame_or_window);
6645
24597608
RS
6646 accent_key_syms = Qnil;
6647 staticpro (&accent_key_syms);
6648
284f4730
JB
6649 func_key_syms = Qnil;
6650 staticpro (&func_key_syms);
6651
4e0e7d8e
RS
6652 system_key_syms = Qnil;
6653 staticpro (&system_key_syms);
6654
284f4730
JB
6655 mouse_syms = Qnil;
6656 staticpro (&mouse_syms);
6657
cd21b839
JB
6658 unread_switch_frame = Qnil;
6659 staticpro (&unread_switch_frame);
6660
284f4730
JB
6661 defsubr (&Sread_key_sequence);
6662 defsubr (&Srecursive_edit);
2eb6bfbe 6663#ifdef HAVE_MOUSE
284f4730 6664 defsubr (&Strack_mouse);
2eb6bfbe 6665#endif
284f4730
JB
6666 defsubr (&Sinput_pending_p);
6667 defsubr (&Scommand_execute);
6668 defsubr (&Srecent_keys);
6669 defsubr (&Sthis_command_keys);
6670 defsubr (&Ssuspend_emacs);
6671 defsubr (&Sabort_recursive_edit);
6672 defsubr (&Sexit_recursive_edit);
6673 defsubr (&Srecursion_depth);
6674 defsubr (&Stop_level);
6675 defsubr (&Sdiscard_input);
6676 defsubr (&Sopen_dribble_file);
6677 defsubr (&Sset_input_mode);
80645119 6678 defsubr (&Scurrent_input_mode);
284f4730
JB
6679 defsubr (&Sexecute_extended_command);
6680
284f4730 6681 DEFVAR_LISP ("last-command-char", &last_command_char,
86e5706b
RS
6682 "Last input event that was part of a command.");
6683
186cf719 6684 DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char,
86e5706b 6685 "Last input event that was part of a command.");
284f4730 6686
7d6de002 6687 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
86e5706b 6688 "Last input event in a command, except for mouse menu events.\n\
7d6de002
RS
6689Mouse menus give back keys that don't look like mouse events;\n\
6690this variable holds the actual mouse event that led to the menu,\n\
6691so that you can determine whether the command was run by mouse or not.");
6692
284f4730 6693 DEFVAR_LISP ("last-input-char", &last_input_char,
86e5706b
RS
6694 "Last input event.");
6695
186cf719 6696 DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char,
86e5706b 6697 "Last input event.");
284f4730 6698
24597608 6699 DEFVAR_LISP ("unread-command-events", &Vunread_command_events,
1c07d0a6 6700 "List of objects to be read as next command input events.");
284f4730 6701
86e5706b
RS
6702 DEFVAR_INT ("unread-command-char", &unread_command_char,
6703 "If not -1, an object to be read as next command input event.");
6704
284f4730
JB
6705 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
6706 "Meta-prefix character code. Meta-foo as command input\n\
6707turns into this character followed by foo.");
18cd2eeb 6708 XSETINT (meta_prefix_char, 033);
284f4730
JB
6709
6710 DEFVAR_LISP ("last-command", &last_command,
6711 "The last command executed. Normally a symbol with a function definition,\n\
6712but can be whatever was found in the keymap, or whatever the variable\n\
18f29056
RS
6713`this-command' was set to by that command.\n\
6714\n\
6715The value `mode-exit' is special; it means that the previous command\n\
6716read an event that told it to exit, and it did so and unread that event.\n\
6717In other words, the present command is the event that made the previous\n\
6718command exit.\n\
6719\n\
6720The value `kill-region' is special; it means that the previous command\n\
6721was a kill command.");
284f4730
JB
6722 last_command = Qnil;
6723
6724 DEFVAR_LISP ("this-command", &this_command,
6725 "The command now being executed.\n\
6726The command can set this variable; whatever is put here\n\
6727will be in `last-command' during the following command.");
6728 this_command = Qnil;
6729
6730 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
6731 "*Number of keyboard input characters between auto-saves.\n\
6732Zero means disable autosaving due to number of characters typed.");
6733 auto_save_interval = 300;
6734
6735 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
6736 "*Number of seconds idle time before auto-save.\n\
06ef7355
RS
6737Zero or nil means disable auto-saving due to idleness.\n\
6738After auto-saving due to this many seconds of idle time,\n\
84447c71 6739Emacs also does a garbage collection if that seems to be warranted.");
bb9e9bed 6740 XSETFASTINT (Vauto_save_timeout, 30);
284f4730
JB
6741
6742 DEFVAR_INT ("echo-keystrokes", &echo_keystrokes,
6743 "*Nonzero means echo unfinished commands after this many seconds of pause.");
6744 echo_keystrokes = 1;
6745
6746 DEFVAR_INT ("polling-period", &polling_period,
6747 "*Interval between polling for input during Lisp execution.\n\
6748The reason for polling is to make C-g work to stop a running program.\n\
6749Polling is needed only when using X windows and SIGIO does not work.\n\
6750Polling is automatically disabled in all other cases.");
6751 polling_period = 2;
6752
564dc952 6753 DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
fbcd35bd 6754 "*Maximum time between mouse clicks to make a double-click.\n\
564dc952
JB
6755Measured in milliseconds. nil means disable double-click recognition;\n\
6756t means double-clicks have no time limit and are detected\n\
fbcd35bd 6757by position only.");
aab06933 6758 Vdouble_click_time = make_number (500);
fbcd35bd 6759
03361bcc
RS
6760 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
6761 "*Non-nil means inhibit local map menu bar menus.");
6762 inhibit_local_menu_bar_menus = 0;
6763
284f4730 6764 DEFVAR_INT ("num-input-keys", &num_input_keys,
e0dff5f6 6765 "Number of complete keys read from the keyboard so far.");
284f4730
JB
6766 num_input_keys = 0;
6767
4c52b668
KH
6768 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
6769 "The frame in which the most recently read event occurred.\n\
6770If the last event came from a keyboard macro, this is set to `macro'.");
6771 Vlast_event_frame = Qnil;
6772
7e85b935 6773 DEFVAR_LISP ("help-char", &Vhelp_char,
284f4730
JB
6774 "Character to recognize as meaning Help.\n\
6775When it is read, do `(eval help-form)', and display result if it's a string.\n\
6776If the value of `help-form' is nil, this char can be read normally.");
18cd2eeb 6777 XSETINT (Vhelp_char, Ctl ('H'));
284f4730
JB
6778
6779 DEFVAR_LISP ("help-form", &Vhelp_form,
7e85b935 6780 "Form to execute when character `help-char' is read.\n\
284f4730
JB
6781If the form returns a string, that string is displayed.\n\
6782If `help-form' is nil, the help char is not recognized.");
6783 Vhelp_form = Qnil;
6784
7e85b935
RS
6785 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
6786 "Command to run when `help-char' character follows a prefix key.\n\
6787This command is used only when there is no actual binding\n\
6788for that character after that prefix key.");
6789 Vprefix_help_command = Qnil;
6790
284f4730
JB
6791 DEFVAR_LISP ("top-level", &Vtop_level,
6792 "Form to evaluate when Emacs starts up.\n\
6793Useful to set before you dump a modified Emacs.");
6794 Vtop_level = Qnil;
6795
6796 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
6797 "String used as translate table for keyboard input, or nil.\n\
6798Each character is looked up in this string and the contents used instead.\n\
6799If string is of length N, character codes N and up are untranslated.");
6800 Vkeyboard_translate_table = Qnil;
6801
a612e298
RS
6802 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
6803 "Keymap of key translations that can override keymaps.\n\
6804This keymap works like `function-key-map', but comes after that,\n\
6805and applies even for keys that have ordinary bindings.");
6806 Vkey_translation_map = Qnil;
6807
8026024c
KH
6808 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
6809 "Non-nil means to always spawn a subshell instead of suspending,\n\
6810even if the operating system has support for stopping a process.");
6811 cannot_suspend = 0;
6812
284f4730 6813 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
7d6de002 6814 "Non-nil means prompt with menus when appropriate.\n\
284f4730 6815This is done when reading from a keymap that has a prompt string,\n\
7d6de002
RS
6816for elements that have prompt strings.\n\
6817The menu is displayed on the screen\n\
6818if X menus were enabled at configuration\n\
6819time and the previous event was a mouse click prefix key.\n\
6820Otherwise, menu prompting uses the echo area.");
284f4730
JB
6821 menu_prompting = 1;
6822
6823 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
6824 "Character to see next line of menu prompt.\n\
6825Type this character while in a menu prompt to rotate around the lines of it.");
18cd2eeb 6826 XSETINT (menu_prompt_more_char, ' ');
9fa4395d
RS
6827
6828 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
6829 "A mask of additional modifier keys to use with every keyboard character.\n\
ad163903
JB
6830Emacs applies the modifiers of the character stored here to each keyboard\n\
6831character it reads. For example, after evaluating the expression\n\
9d9f56dd 6832 (setq extra-keyboard-modifiers ?\\C-x)\n\
80645119
JB
6833all input characters will have the control modifier applied to them.\n\
6834\n\
9d9f56dd 6835Note that the character ?\\C-@, equivalent to the integer zero, does\n\
80645119 6836not count as a control character; rather, it counts as a character\n\
27203ead 6837with no modifiers; thus, setting `extra-keyboard-modifiers' to zero\n\
80645119 6838cancels any modification.");
9fa4395d 6839 extra_keyboard_modifiers = 0;
86e5706b
RS
6840
6841 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
6842 "If an editing command sets this to t, deactivate the mark afterward.\n\
6843The command loop sets this to nil before each command,\n\
6844and tests the value when the command returns.\n\
6845Buffer modification stores t in this variable.");
6846 Vdeactivate_mark = Qnil;
6847
b0f2a7bf
KH
6848 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal,
6849 "Temporary storage of pre-command-hook or post-command-hook.");
6850 Vcommand_hook_internal = Qnil;
6851
86e5706b 6852 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
a1fd42c0
RS
6853 "Normal hook run before each command is executed.\n\
6854While the hook is run, its value is temporarily set to nil\n\
6855to avoid an unbreakable infinite loop if a hook function gets an error.\n\
6856As a result, a hook function cannot straightforwardly alter the value of\n\
6857`pre-command-hook'. See the Emacs Lisp manual for a way of\n\
6858implementing hook functions that alter the set of hook functions.");
86e5706b
RS
6859 Vpre_command_hook = Qnil;
6860
6861 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
a1fd42c0
RS
6862 "Normal hook run after each command is executed.\n\
6863While the hook is run, its value is temporarily set to nil\n\
6864to avoid an unbreakable infinite loop if a hook function gets an error.\n\
6865As a result, a hook function cannot straightforwardly alter the value of\n\
6866`post-command-hook'. See the Emacs Lisp manual for a way of\n\
6867implementing hook functions that alter the set of hook functions.");
86e5706b 6868 Vpost_command_hook = Qnil;
48e416d4
RS
6869
6870 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
6871 "t means menu bar, specified Lucid style, needs to be recomputed.");
6872 Vlucid_menu_bar_dirty_flag = Qnil;
a73c5e29 6873
9f9c0e27
RS
6874 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
6875 "List of menu bar items to move to the end of the menu bar.\n\
a612e298 6876The elements of the list are event types that may have menu bar bindings.");
9f9c0e27 6877 Vmenu_bar_final_items = Qnil;
e9bf89a0 6878
9dd3131c
RS
6879 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map,
6880 "Keymap that overrides all other local keymaps.\n\
6881If this variable is non-nil, it is used as a keymap instead of the\n\
6882buffer's local map, and the minor mode keymaps and text property keymaps.");
6883 Voverriding_local_map = Qnil;
6884
d0a49716
RS
6885 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag,
6886 "Non-nil means `overriding-local-map' applies to the menu bar.\n\
6887Otherwise, the menu bar continues to reflect the buffer's local map\n\
6888and the minor mode maps regardless of `overriding-local-map'.");
6889 Voverriding_local_map_menu_flag = Qnil;
6890
2eb6bfbe 6891#ifdef HAVE_MOUSE
71edead1 6892 DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
e9bf89a0 6893 "*Non-nil means generate motion events for mouse motion.");
2eb6bfbe 6894#endif
80e4aa30 6895
270a208f
RS
6896 DEFVAR_LISP ("system-key-alist", &Vsystem_key_alist,
6897 "Alist of system-specific X windows key symbols.\n\
80e4aa30 6898Each element should have the form (N . SYMBOL) where N is the\n\
270a208f 6899numeric keysym code (sans the \"system-specific\" bit 1<<28)\n\
80e4aa30 6900and SYMBOL is its name.");
a69a8ca2 6901 Vsystem_key_alist = Qnil;
8a792f3a
RS
6902
6903 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list,
6904 "List of deferred actions to be performed at a later time.\n\
6905The precise format isn't relevant here; we just check whether it is nil.");
6906 Vdeferred_action_list = Qnil;
6907
6908 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function,
6909 "Function to call to handle deferred actions, after each command.\n\
6910This function is called with no arguments after each command\n\
6911whenever `deferred-action-list' is non-nil.");
6912 Vdeferred_action_function = Qnil;
284f4730
JB
6913}
6914
6915keys_of_keyboard ()
6916{
6917 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
6918 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
6919 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
6920 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
6921 initial_define_key (meta_map, 'x', "execute-extended-command");
6922}