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