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