Protect keyboard-translate-table from GC.
[bpt/emacs.git] / src / keyboard.c
CommitLineData
284f4730 1/* Keyboard and mouse input; editor command loop.
0b5538bd
TTN
2 Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
3 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005 Free Software Foundation, Inc.
284f4730
JB
5
6This file is part of GNU Emacs.
7
8GNU Emacs is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
7b4aedb9 10the Free Software Foundation; either version 2, or (at your option)
284f4730
JB
11any later version.
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with GNU Emacs; see the file COPYING. If not, write to
4fc5845f
LK
20the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21Boston, MA 02110-1301, USA. */
284f4730 22
18160b98 23#include <config.h>
68c45bf0 24#include <signal.h>
284f4730 25#include <stdio.h>
9628b887 26#include "lisp.h"
284f4730
JB
27#include "termchar.h"
28#include "termopts.h"
428a555e 29#include "frame.h"
284f4730
JB
30#include "termhooks.h"
31#include "macros.h"
02639609 32#include "keyboard.h"
284f4730
JB
33#include "window.h"
34#include "commands.h"
35#include "buffer.h"
37cd9f30 36#include "charset.h"
284f4730 37#include "disptab.h"
f4255cd1 38#include "dispextern.h"
e39da3d7 39#include "syntax.h"
497ba7a1 40#include "intervals.h"
bdb7aa47 41#include "keymap.h"
9ac0d9e0 42#include "blockinput.h"
e8886a1d 43#include "puresize.h"
8a9f5d3c
GM
44#include "systime.h"
45#include "atimer.h"
284f4730
JB
46#include <setjmp.h>
47#include <errno.h>
48
aa477689
JD
49#ifdef HAVE_GTK_AND_PTHREAD
50#include <pthread.h>
51#endif
80e4aa30
RS
52#ifdef MSDOS
53#include "msdos.h"
54#include <time.h>
55#else /* not MSDOS */
284f4730
JB
56#ifndef VMS
57#include <sys/ioctl.h>
284f4730 58#endif
80e4aa30 59#endif /* not MSDOS */
284f4730 60
52baf19e 61#include "syssignal.h"
52baf19e 62
03cee6ae
GM
63#include <sys/types.h>
64#ifdef HAVE_UNISTD_H
65#include <unistd.h>
66#endif
67
e31d908f
DN
68#ifdef HAVE_FCNTL_H
69#include <fcntl.h>
70#endif
71
c5e3b6c5
RS
72/* This is to get the definitions of the XK_ symbols. */
73#ifdef HAVE_X_WINDOWS
74#include "xterm.h"
75#endif
76
e98a93eb
GV
77#ifdef HAVE_NTGUI
78#include "w32term.h"
79#endif /* HAVE_NTGUI */
80
e0f712ba 81#ifdef MAC_OS
1a578e9b
AC
82#include "macterm.h"
83#endif
84
02639609 85#ifndef USE_CRT_DLL
52baf19e 86extern int errno;
02639609 87#endif
52baf19e 88
9ac0d9e0
JB
89/* Variables for blockinput.h: */
90
91/* Non-zero if interrupt input is blocked right now. */
63927c41 92int interrupt_input_blocked;
9ac0d9e0
JB
93
94/* Nonzero means an input interrupt has arrived
95 during the current critical section. */
63927c41 96int interrupt_input_pending;
9ac0d9e0
JB
97
98
e98a93eb 99#ifdef HAVE_WINDOW_SYSTEM
284f4730 100/* Make all keyboard buffers much bigger when using X windows. */
e0f712ba
AC
101#ifdef MAC_OS8
102/* But not too big (local data > 32K error) if on Mac OS Classic. */
f019cded
RS
103#define KBD_BUFFER_SIZE 512
104#else
284f4730 105#define KBD_BUFFER_SIZE 4096
f019cded 106#endif
284f4730 107#else /* No X-windows, character input */
de11c1ea 108#define KBD_BUFFER_SIZE 4096
284f4730
JB
109#endif /* No X-windows */
110
222d557c
GM
111#define abs(x) ((x) >= 0 ? (x) : -(x))
112
284f4730
JB
113/* Following definition copied from eval.c */
114
115struct backtrace
116 {
117 struct backtrace *next;
118 Lisp_Object *function;
119 Lisp_Object *args; /* Points to vector of args. */
120 int nargs; /* length of vector. If nargs is UNEVALLED,
121 args points to slot holding list of
122 unevalled args */
123 char evalargs;
080e18b1
KS
124 /* Nonzero means call value of debugger when done with this operation. */
125 char debug_on_exit;
284f4730
JB
126 };
127
c5fdd383
KH
128#ifdef MULTI_KBOARD
129KBOARD *initial_kboard;
130KBOARD *current_kboard;
131KBOARD *all_kboards;
1e8bd3da 132int single_kboard;
6c6083a9 133#else
c5fdd383 134KBOARD the_only_kboard;
6c6083a9 135#endif
612b78ef 136
284f4730 137/* Non-nil disable property on a command means
971e4c98
LT
138 do not execute it; call disabled-command-function's value instead. */
139Lisp_Object Qdisabled, Qdisabled_command_function;
284f4730
JB
140
141#define NUM_RECENT_KEYS (100)
142int recent_keys_index; /* Index for storing next element into recent_keys */
143int total_keys; /* Total number of elements stored into recent_keys */
5160df46 144Lisp_Object recent_keys; /* A vector, holding the last 100 keystrokes */
284f4730 145
6569cc8d
JB
146/* Vector holding the key sequence that invoked the current command.
147 It is reused for each command, and it may be longer than the current
148 sequence; this_command_key_count indicates how many elements
149 actually mean something.
150 It's easier to staticpro a single Lisp_Object than an array. */
151Lisp_Object this_command_keys;
152int this_command_key_count;
284f4730 153
63020c46
RS
154/* 1 after calling Freset_this_command_lengths.
155 Usually it is 0. */
156int this_command_key_count_reset;
157
7d18f9ae
RS
158/* This vector is used as a buffer to record the events that were actually read
159 by read_key_sequence. */
160Lisp_Object raw_keybuf;
161int raw_keybuf_count;
162
163#define GROW_RAW_KEYBUF \
7189cad8 164 if (raw_keybuf_count == XVECTOR (raw_keybuf)->size) \
7d18f9ae
RS
165 { \
166 int newsize = 2 * XVECTOR (raw_keybuf)->size; \
167 Lisp_Object new; \
168 new = Fmake_vector (make_number (newsize), Qnil); \
169 bcopy (XVECTOR (raw_keybuf)->contents, XVECTOR (new)->contents, \
170 raw_keybuf_count * sizeof (Lisp_Object)); \
171 raw_keybuf = new; \
172 }
173
6321824f
RS
174/* Number of elements of this_command_keys
175 that precede this key sequence. */
176int this_single_command_key_start;
177
71918b75
RS
178/* Record values of this_command_key_count and echo_length ()
179 before this command was read. */
180static int before_command_key_count;
181static int before_command_echo_length;
71918b75 182
284f4730
JB
183extern int minbuf_level;
184
a59b172a
RS
185extern int message_enable_multibyte;
186
284f4730
JB
187extern struct backtrace *backtrace_list;
188
7ee32cda
GM
189/* If non-nil, the function that implements the display of help.
190 It's called with one argument, the help string to display. */
191
192Lisp_Object Vshow_help_function;
193
f0c1cc56
GM
194/* If a string, the message displayed before displaying a help-echo
195 in the echo area. */
196
197Lisp_Object Vpre_help_message;
198
284f4730 199/* Nonzero means do menu prompting. */
f0c1cc56 200
284f4730
JB
201static int menu_prompting;
202
203/* Character to see next line of menu prompt. */
f0c1cc56 204
284f4730
JB
205static Lisp_Object menu_prompt_more_char;
206
207/* For longjmp to where kbd input is being done. */
f0c1cc56 208
284f4730
JB
209static jmp_buf getcjmp;
210
211/* True while doing kbd input. */
212int waiting_for_input;
213
214/* True while displaying for echoing. Delays C-g throwing. */
985f9f66 215
c843d6c6 216int echoing;
284f4730 217
985f9f66
GM
218/* Non-null means we can start echoing at the next input pause even
219 though there is something in the echo area. */
220
221static struct kboard *ok_to_echo_at_next_pause;
222
59a84f8e
GM
223/* The kboard last echoing, or null for none. Reset to 0 in
224 cancel_echoing. If non-null, and a current echo area message
225 exists, and echo_message_buffer is eq to the current message
226 buffer, we know that the message comes from echo_kboard. */
985f9f66 227
f49aedfd 228struct kboard *echo_kboard;
1fc93d49 229
59a84f8e
GM
230/* The buffer used for echoing. Set in echo_now, reset in
231 cancel_echoing. */
232
c843d6c6 233Lisp_Object echo_message_buffer;
59a84f8e 234
03361bcc
RS
235/* Nonzero means disregard local maps for the menu bar. */
236static int inhibit_local_menu_bar_menus;
237
80e4aa30 238/* Nonzero means C-g should cause immediate error-signal. */
284f4730
JB
239int immediate_quit;
240
fa90970d
RS
241/* The user's ERASE setting. */
242Lisp_Object Vtty_erase_char;
243
284f4730 244/* Character to recognize as the help char. */
7e85b935 245Lisp_Object Vhelp_char;
284f4730 246
ecb7cb34
KH
247/* List of other event types to recognize as meaning "help". */
248Lisp_Object Vhelp_event_list;
249
284f4730
JB
250/* Form to execute when help char is typed. */
251Lisp_Object Vhelp_form;
252
7e85b935
RS
253/* Command to run when the help character follows a prefix key. */
254Lisp_Object Vprefix_help_command;
255
9f9c0e27
RS
256/* List of items that should move to the end of the menu bar. */
257Lisp_Object Vmenu_bar_final_items;
a73c5e29 258
6526ab49
RS
259/* Non-nil means show the equivalent key-binding for
260 any M-x command that has one.
261 The value can be a length of time to show the message for.
262 If the value is non-nil and not a number, we wait 2 seconds. */
263Lisp_Object Vsuggest_key_bindings;
264
00392ce6
MB
265/* How long to display an echo-area message when the minibuffer is active.
266 If the value is not a number, such messages don't time out. */
267Lisp_Object Vminibuffer_message_timeout;
268
284f4730
JB
269/* Character that causes a quit. Normally C-g.
270
271 If we are running on an ordinary terminal, this must be an ordinary
272 ASCII char, since we want to make it our interrupt character.
273
274 If we are not running on an ordinary terminal, it still needs to be
275 an ordinary ASCII char. This character needs to be recognized in
276 the input interrupt handler. At this point, the keystroke is
277 represented as a struct input_event, while the desired quit
278 character is specified as a lispy event. The mapping from struct
279 input_events to lispy events cannot run in an interrupt handler,
280 and the reverse mapping is difficult for anything but ASCII
281 keystrokes.
282
283 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
284 ASCII character. */
285int quit_char;
286
287extern Lisp_Object current_global_map;
288extern int minibuf_level;
289
9dd3131c
RS
290/* If non-nil, this is a map that overrides all other local maps. */
291Lisp_Object Voverriding_local_map;
292
d0a49716
RS
293/* If non-nil, Voverriding_local_map applies to the menu bar. */
294Lisp_Object Voverriding_local_map_menu_flag;
295
7f07d5ca
RS
296/* Keymap that defines special misc events that should
297 be processed immediately at a low level. */
298Lisp_Object Vspecial_event_map;
299
284f4730
JB
300/* Current depth in recursive edits. */
301int command_loop_level;
302
303/* Total number of times command_loop has read a key sequence. */
31ade731 304EMACS_INT num_input_keys;
284f4730
JB
305
306/* Last input character read as a command. */
307Lisp_Object last_command_char;
308
7d6de002
RS
309/* Last input character read as a command, not counting menus
310 reached by the mouse. */
311Lisp_Object last_nonmenu_event;
312
284f4730
JB
313/* Last input character read for any purpose. */
314Lisp_Object last_input_char;
315
dbc4e1c1 316/* If not Qnil, a list of objects to be read as subsequent command input. */
24597608 317Lisp_Object Vunread_command_events;
284f4730 318
7d18f9ae
RS
319/* If not Qnil, a list of objects to be read as subsequent command input
320 including input method processing. */
321Lisp_Object Vunread_input_method_events;
322
323/* If not Qnil, a list of objects to be read as subsequent command input
324 but NOT including input method processing. */
325Lisp_Object Vunread_post_input_method_events;
326
86e5706b 327/* If not -1, an event to be read as subsequent command input. */
31ade731 328EMACS_INT unread_command_char;
86e5706b 329
cd21b839
JB
330/* If not Qnil, this is a switch-frame event which we decided to put
331 off until the end of a key sequence. This should be read as the
dbc4e1c1 332 next command input, after any unread_command_events.
8f805655
JB
333
334 read_key_sequence uses this to delay switch-frame events until the
335 end of the key sequence; Fread_char uses it to put off switch-frame
336 events until a non-ASCII event is acceptable as input. */
337Lisp_Object unread_switch_frame;
cd21b839 338
9fa4395d 339/* A mask of extra modifier bits to put into every keyboard char. */
31ade731 340EMACS_INT extra_keyboard_modifiers;
9fa4395d 341
284f4730
JB
342/* Char to use as prefix when a meta character is typed in.
343 This is bound on entry to minibuffer in case ESC is changed there. */
344
345Lisp_Object meta_prefix_char;
346
347/* Last size recorded for a current buffer which is not a minibuffer. */
348static int last_non_minibuf_size;
349
06ef7355 350/* Number of idle seconds before an auto-save and garbage collection. */
284f4730
JB
351static Lisp_Object Vauto_save_timeout;
352
353/* Total number of times read_char has returned. */
4abfba1f 354int num_input_events;
284f4730 355
51172b6d 356/* Total number of times read_char has returned, outside of macros. */
31ade731 357EMACS_INT num_nonmacro_input_events;
51172b6d 358
284f4730
JB
359/* Auto-save automatically when this many characters have been typed
360 since the last time. */
361
31ade731 362static EMACS_INT auto_save_interval;
284f4730 363
c43b1734 364/* Value of num_nonmacro_input_events as of last auto save. */
284f4730
JB
365
366int last_auto_save;
367
284f4730 368/* The command being executed by the command loop.
6c7178b9
KH
369 Commands may set this, and the value set will be copied into
370 current_kboard->Vlast_command instead of the actual command. */
d5eecefb
RS
371Lisp_Object Vthis_command;
372
373/* This is like Vthis_command, except that commands never set it. */
374Lisp_Object real_this_command;
284f4730 375
8b9940e6
KS
376/* If the lookup of the command returns a binding, the original
377 command is stored in this-original-command. It is nil otherwise. */
378Lisp_Object Vthis_original_command;
379
b453f72e
KH
380/* The value of point when the last command was executed. */
381int last_point_position;
382
047688cb
RS
383/* The buffer that was current when the last command was started. */
384Lisp_Object last_point_position_buffer;
385
4c52b668
KH
386/* The frame in which the last input event occurred, or Qmacro if the
387 last event came from a macro. We use this to determine when to
388 generate switch-frame events. This may be cleared by functions
389 like Fselect_frame, to make sure that a switch-frame event is
390 generated by the next character. */
391Lisp_Object internal_last_event_frame;
4c52b668
KH
392
393/* A user-visible version of the above, intended to allow users to
394 figure out where the last event came from, if the event doesn't
395 carry that information itself (i.e. if it was a character). */
396Lisp_Object Vlast_event_frame;
397
1113d9db
JB
398/* The timestamp of the last input event we received from the X server.
399 X Windows wants this for selection ownership. */
284f4730
JB
400unsigned long last_event_timestamp;
401
402Lisp_Object Qself_insert_command;
403Lisp_Object Qforward_char;
404Lisp_Object Qbackward_char;
e58aa385 405Lisp_Object Qundefined;
d925fb39 406Lisp_Object Qtimer_event_handler;
284f4730
JB
407
408/* read_key_sequence stores here the command definition of the
409 key sequence that it reads. */
410Lisp_Object read_key_sequence_cmd;
411
39aab679
DL
412/* Echo unfinished commands after this many seconds of pause. */
413Lisp_Object Vecho_keystrokes;
414
284f4730
JB
415/* Form to evaluate (if non-nil) when Emacs is started. */
416Lisp_Object Vtop_level;
417
7d18f9ae
RS
418/* If non-nil, this implements the current input method. */
419Lisp_Object Vinput_method_function;
420Lisp_Object Qinput_method_function;
421
d5eecefb
RS
422/* When we call Vinput_method_function,
423 this holds the echo area message that was just erased. */
424Lisp_Object Vinput_method_previous_message;
425
86e5706b
RS
426/* Non-nil means deactivate the mark at end of this command. */
427Lisp_Object Vdeactivate_mark;
428
48e416d4
RS
429/* Menu bar specified in Lucid Emacs fashion. */
430
431Lisp_Object Vlucid_menu_bar_dirty_flag;
432Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
433
cf24f894 434Lisp_Object Qecho_area_clear_hook;
cdb9d665 435
86e5706b 436/* Hooks to run before and after each command. */
59aadc81
RS
437Lisp_Object Qpre_command_hook, Vpre_command_hook;
438Lisp_Object Qpost_command_hook, Vpost_command_hook;
40932d1a 439Lisp_Object Qcommand_hook_internal, Vcommand_hook_internal;
86e5706b 440
ac09dc1e
KL
441/* Parent keymap of terminal-local function-key-map instances. */
442Lisp_Object Vfunction_key_map;
443
4ea81208 444/* Parent keymap of terminal-local key-translation-map instances. */
ac09dc1e 445Lisp_Object Vkey_translation_map;
4ea81208 446
8a792f3a
RS
447/* List of deferred actions to be performed at a later time.
448 The precise format isn't relevant here; we just check whether it is nil. */
449Lisp_Object Vdeferred_action_list;
450
451/* Function to call to handle deferred actions, when there are any. */
452Lisp_Object Vdeferred_action_function;
3ef14e46 453Lisp_Object Qdeferred_action_function;
8a792f3a 454
d5eecefb
RS
455Lisp_Object Qinput_method_exit_on_first_char;
456Lisp_Object Qinput_method_use_echo_area;
457
284f4730
JB
458/* File in which we write all commands we read. */
459FILE *dribble;
460
461/* Nonzero if input is available. */
462int input_pending;
463
284f4730
JB
464extern char *pending_malloc_warning;
465
beecf6a1 466/* Circular buffer for pre-read keyboard input. */
da8f7368 467
beecf6a1
KH
468static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
469
beecf6a1
KH
470/* Pointer to next available character in kbd_buffer.
471 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
5cb6905d 472 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the
beecf6a1
KH
473 next available char is in kbd_buffer[0]. */
474static struct input_event *kbd_fetch_ptr;
475
476/* Pointer to next place to store character in kbd_buffer. This
477 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
478 character should go in kbd_buffer[0]. */
7ee32cda 479static struct input_event * volatile kbd_store_ptr;
beecf6a1
KH
480
481/* The above pair of variables forms a "queue empty" flag. When we
482 enqueue a non-hook event, we increment kbd_store_ptr. When we
483 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
484 there is input available iff the two pointers are not equal.
485
486 Why not just have a flag set and cleared by the enqueuing and
487 dequeuing functions? Such a flag could be screwed up by interrupts
488 at inopportune times. */
489
f3253854 490/* If this flag is non-nil, we check mouse_moved to see when the
a9d77f1f
RS
491 mouse moves, and motion events will appear in the input stream.
492 Otherwise, mouse motion is ignored. */
e10da507 493Lisp_Object do_mouse_tracking;
284f4730 494
284f4730
JB
495/* Symbols to head events. */
496Lisp_Object Qmouse_movement;
3c370943 497Lisp_Object Qscroll_bar_movement;
cd21b839 498Lisp_Object Qswitch_frame;
bbdc2092 499Lisp_Object Qdelete_frame;
af17bd2b
KH
500Lisp_Object Qiconify_frame;
501Lisp_Object Qmake_frame_visible;
a697f886 502Lisp_Object Qselect_window;
7ee32cda 503Lisp_Object Qhelp_echo;
cd21b839 504
c22237f7
KS
505#ifdef HAVE_MOUSE
506Lisp_Object Qmouse_fixup_help_message;
507#endif
508
284f4730
JB
509/* Symbols to denote kinds of events. */
510Lisp_Object Qfunction_key;
511Lisp_Object Qmouse_click;
c16dab62 512#if defined (WINDOWSNT) || defined (MAC_OS)
1161d367 513Lisp_Object Qlanguage_change;
07de30b9 514#endif
a24dc617 515Lisp_Object Qdrag_n_drop;
4ebc27a5
JD
516Lisp_Object Qsave_session;
517
284f4730 518/* Lisp_Object Qmouse_movement; - also an event header */
284f4730
JB
519
520/* Properties of event headers. */
521Lisp_Object Qevent_kind;
88cb0656 522Lisp_Object Qevent_symbol_elements;
284f4730 523
e8886a1d
RS
524/* menu item parts */
525Lisp_Object Qmenu_alias;
598a9fa7 526Lisp_Object Qmenu_enable;
74c1de23
RS
527Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCkeys, QCkey_sequence;
528Lisp_Object QCbutton, QCtoggle, QCradio;
e8886a1d
RS
529extern Lisp_Object Vdefine_key_rebound_commands;
530extern Lisp_Object Qmenu_item;
598a9fa7 531
0a7f1fc0
JB
532/* An event header symbol HEAD may have a property named
533 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
534 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
535 mask of modifiers applied to it. If present, this is used to help
536 speed up parse_modifiers. */
537Lisp_Object Qevent_symbol_element_mask;
538
539/* An unmodified event header BASE may have a property named
540 Qmodifier_cache, which is an alist mapping modifier masks onto
541 modified versions of BASE. If present, this helps speed up
542 apply_modifiers. */
543Lisp_Object Qmodifier_cache;
544
5ec75a55 545/* Symbols to use for parts of windows. */
284f4730 546Lisp_Object Qmode_line;
e5d77022 547Lisp_Object Qvertical_line;
3c370943 548Lisp_Object Qvertical_scroll_bar;
5ec75a55 549Lisp_Object Qmenu_bar;
7d60ad8a 550extern Lisp_Object Qleft_margin, Qright_margin;
3d566707 551extern Lisp_Object Qleft_fringe, Qright_fringe;
2e3f0f61 552extern Lisp_Object QCmap;
5ec75a55 553
f4255cd1
JB
554Lisp_Object recursive_edit_unwind (), command_loop ();
555Lisp_Object Fthis_command_keys ();
03b4122a 556Lisp_Object Qextended_command_history;
c04cbc3b 557EMACS_TIME timer_check ();
284f4730 558
a0acc6c7 559extern Lisp_Object Vhistory_length, Vtranslation_table_for_input;
f4385381 560
2c834fb3
KH
561extern char *x_get_keysym_name ();
562
8eb4d8ef 563static void record_menu_key ();
22b94eeb 564static int echo_length ();
8eb4d8ef 565
f4eef8b4
RS
566Lisp_Object Qpolling_period;
567
d9d4c147 568/* List of absolute timers. Appears in order of next scheduled event. */
c04cbc3b
RS
569Lisp_Object Vtimer_list;
570
d9d4c147
KH
571/* List of idle time timers. Appears in order of next scheduled event. */
572Lisp_Object Vtimer_idle_list;
573
87dd9b9b
RS
574/* Incremented whenever a timer is run. */
575int timers_run;
576
a9f16aa9
KH
577extern Lisp_Object Vprint_level, Vprint_length;
578
ffd56f97
JB
579/* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
580 happens. */
581EMACS_TIME *input_available_clear_time;
284f4730
JB
582
583/* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
584 Default is 1 if INTERRUPT_INPUT is defined. */
585int interrupt_input;
586
587/* Nonzero while interrupts are temporarily deferred during redisplay. */
588int interrupts_deferred;
589
284f4730
JB
590/* Allow m- file to inhibit use of FIONREAD. */
591#ifdef BROKEN_FIONREAD
592#undef FIONREAD
593#endif
594
595/* We are unable to use interrupts if FIONREAD is not available,
596 so flush SIGIO so we won't try. */
fc7a70cc 597#if !defined (FIONREAD)
284f4730
JB
598#ifdef SIGIO
599#undef SIGIO
600#endif
601#endif
602
e98a93eb 603/* If we support a window system, turn on the code to poll periodically
34f04431 604 to detect C-g. It isn't actually used when doing interrupt input. */
742fbed7 605#if defined(HAVE_WINDOW_SYSTEM) && !defined(USE_ASYNC_EVENTS)
284f4730
JB
606#define POLL_FOR_INPUT
607#endif
adf5cb9c
KH
608
609/* After a command is executed, if point is moved into a region that
610 has specific properties (e.g. composition, display), we adjust
611 point to the boundary of the region. But, if a command sets this
27fd22dc 612 variable to non-nil, we suppress this point adjustment. This
adf5cb9c 613 variable is set to nil before reading a command. */
da8f7368 614
adf5cb9c
KH
615Lisp_Object Vdisable_point_adjustment;
616
617/* If non-nil, always disable point adjustment. */
da8f7368 618
adf5cb9c
KH
619Lisp_Object Vglobal_disable_point_adjustment;
620
fdbb67fe
GM
621/* The time when Emacs started being idle. */
622
623static EMACS_TIME timer_idleness_start_time;
624
3021d3a9
RS
625/* After Emacs stops being idle, this saves the last value
626 of timer_idleness_start_time from when it was idle. */
627
628static EMACS_TIME timer_last_idleness_start_time;
629
284f4730
JB
630\f
631/* Global variable declarations. */
632
a2d5fca0
JD
633/* Flags for readable_events. */
634#define READABLE_EVENTS_DO_TIMERS_NOW (1 << 0)
635#define READABLE_EVENTS_FILTER_EVENTS (1 << 1)
636#define READABLE_EVENTS_IGNORE_SQUEEZABLES (1 << 2)
637
284f4730
JB
638/* Function for init_keyboard to call with no args (if nonzero). */
639void (*keyboard_init_hook) ();
640
0bbfdc25
GM
641static int read_avail_input P_ ((int));
642static void get_input_pending P_ ((int *, int));
643static int readable_events P_ ((int));
644static Lisp_Object read_char_x_menu_prompt P_ ((int, Lisp_Object *,
645 Lisp_Object, int *));
8150596a 646static Lisp_Object read_char_x_menu_prompt ();
0bbfdc25
GM
647static Lisp_Object read_char_minibuf_menu_prompt P_ ((int, int,
648 Lisp_Object *));
649static Lisp_Object make_lispy_event P_ ((struct input_event *));
514354e9 650#ifdef HAVE_MOUSE
0bbfdc25
GM
651static Lisp_Object make_lispy_movement P_ ((struct frame *, Lisp_Object,
652 enum scroll_bar_part,
653 Lisp_Object, Lisp_Object,
654 unsigned long));
514354e9 655#endif
0bbfdc25
GM
656static Lisp_Object modify_event_symbol P_ ((int, unsigned, Lisp_Object,
657 Lisp_Object, char **,
658 Lisp_Object *, unsigned));
659static Lisp_Object make_lispy_switch_frame P_ ((Lisp_Object));
660static int parse_solitary_modifier P_ ((Lisp_Object));
3d31316f 661static int parse_solitary_modifier ();
0bbfdc25 662static void save_getcjmp P_ ((jmp_buf));
dfcf069d 663static void save_getcjmp ();
0bbfdc25 664static void restore_getcjmp P_ ((jmp_buf));
7ee32cda 665static Lisp_Object apply_modifiers P_ ((int, Lisp_Object));
0bbfdc25 666static void clear_event P_ ((struct input_event *));
9ce50b1e 667static void any_kboard_state P_ ((void));
9148bda2 668static Lisp_Object restore_kboard_configuration P_ ((Lisp_Object));
5598c32e 669static SIGTYPE interrupt_signal P_ ((int signalnum));
114a8b8c 670static void handle_interrupt P_ ((void));
5c12e63f
KS
671static void timer_start_idle P_ ((void));
672static void timer_stop_idle P_ ((void));
673static void timer_resume_idle P_ ((void));
284f4730 674
8026024c
KH
675/* Nonzero means don't try to suspend even if the operating system seems
676 to support it. */
677static int cannot_suspend;
678
29204e13
RS
679extern Lisp_Object Qidentity, Qonly;
680\f
284f4730
JB
681/* Install the string STR as the beginning of the string of echoing,
682 so that it serves as a prompt for the next character.
683 Also start echoing. */
684
dfcf069d 685void
284f4730 686echo_prompt (str)
a4ef85ee 687 Lisp_Object str;
284f4730 688{
678e9d18 689 current_kboard->echo_string = str;
0d121f7c 690 current_kboard->echo_after_prompt = SCHARS (str);
3dbd9ee4 691 echo_now ();
284f4730
JB
692}
693
df0f2ba1 694/* Add C to the echo string, if echoing is going on.
284f4730
JB
695 C can be a character, which is printed prettily ("M-C-x" and all that
696 jazz), or a symbol, whose name is printed. */
697
dfcf069d 698void
284f4730
JB
699echo_char (c)
700 Lisp_Object c;
701{
c5fdd383 702 if (current_kboard->immediate_echo)
284f4730 703 {
678e9d18
GM
704 int size = KEY_DESCRIPTION_SIZE + 100;
705 char *buffer = (char *) alloca (size);
706 char *ptr = buffer;
707 Lisp_Object echo_string;
284f4730 708
0d121f7c 709 echo_string = current_kboard->echo_string;
c60ee5e7 710
284f4730 711 /* If someone has passed us a composite event, use its head symbol. */
88cb0656 712 c = EVENT_HEAD (c);
284f4730 713
8c18cbfb 714 if (INTEGERP (c))
284f4730 715 {
678e9d18 716 ptr = push_key_description (XINT (c), ptr, 1);
284f4730 717 }
8c18cbfb 718 else if (SYMBOLP (c))
284f4730 719 {
1b049b51
KR
720 Lisp_Object name = SYMBOL_NAME (c);
721 int nbytes = SBYTES (name);
c60ee5e7 722
0d121f7c 723 if (size - (ptr - buffer) < nbytes)
678e9d18
GM
724 {
725 int offset = ptr - buffer;
0d121f7c 726 size = max (2 * size, size + nbytes);
678e9d18
GM
727 buffer = (char *) alloca (size);
728 ptr = buffer + offset;
729 }
730
1b049b51
KR
731 ptr += copy_text (SDATA (name), ptr, nbytes,
732 STRING_MULTIBYTE (name), 1);
284f4730
JB
733 }
734
0d121f7c 735 if ((NILP (echo_string) || SCHARS (echo_string) == 0)
ecb7cb34 736 && help_char_p (c))
284f4730 737 {
678e9d18
GM
738 const char *text = " (Type ? for further options)";
739 int len = strlen (text);
c60ee5e7 740
678e9d18
GM
741 if (size - (ptr - buffer) < len)
742 {
743 int offset = ptr - buffer;
744 size += len;
745 buffer = (char *) alloca (size);
746 ptr = buffer + offset;
747 }
748
749 bcopy (text, ptr, len);
750 ptr += len;
284f4730
JB
751 }
752
0d121f7c
GM
753 /* Replace a dash from echo_dash with a space, otherwise
754 add a space at the end as a separator between keys. */
678e9d18 755 if (STRINGP (echo_string)
2ff4d3d9 756 && SCHARS (echo_string) > 1)
0d121f7c 757 {
2ff4d3d9
RS
758 Lisp_Object last_char, prev_char, idx;
759
760 idx = make_number (SCHARS (echo_string) - 2);
761 prev_char = Faref (echo_string, idx);
0d121f7c
GM
762
763 idx = make_number (SCHARS (echo_string) - 1);
764 last_char = Faref (echo_string, idx);
765
2ff4d3d9
RS
766 /* We test PREV_CHAR to make sure this isn't the echoing
767 of a minus-sign. */
768 if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
0d121f7c
GM
769 Faset (echo_string, idx, make_number (' '));
770 else
771 echo_string = concat2 (echo_string, build_string (" "));
772 }
678e9d18
GM
773
774 current_kboard->echo_string
775 = concat2 (echo_string, make_string (buffer, ptr - buffer));
284f4730 776
3dbd9ee4 777 echo_now ();
284f4730
JB
778 }
779}
780
781/* Temporarily add a dash to the end of the echo string if it's not
782 empty, so that it serves as a mini-prompt for the very next character. */
783
dfcf069d 784void
284f4730
JB
785echo_dash ()
786{
678e9d18
GM
787 /* Do nothing if not echoing at all. */
788 if (NILP (current_kboard->echo_string))
789 return;
790
c5fdd383 791 if (!current_kboard->immediate_echo
0d121f7c 792 && SCHARS (current_kboard->echo_string) == 0)
284f4730 793 return;
c60ee5e7 794
7a80a6f6 795 /* Do nothing if we just printed a prompt. */
c5fdd383 796 if (current_kboard->echo_after_prompt
0d121f7c 797 == SCHARS (current_kboard->echo_string))
4bafa972 798 return;
c60ee5e7 799
366511da
MB
800 /* Do nothing if we have already put a dash at the end. */
801 if (SCHARS (current_kboard->echo_string) > 1)
802 {
803 Lisp_Object last_char, prev_char, idx;
804
805 idx = make_number (SCHARS (current_kboard->echo_string) - 2);
806 prev_char = Faref (current_kboard->echo_string, idx);
807
808 idx = make_number (SCHARS (current_kboard->echo_string) - 1);
809 last_char = Faref (current_kboard->echo_string, idx);
810
811 if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
812 return;
813 }
814
284f4730
JB
815 /* Put a dash at the end of the buffer temporarily,
816 but make it go away when the next character is added. */
678e9d18
GM
817 current_kboard->echo_string = concat2 (current_kboard->echo_string,
818 build_string ("-"));
3dbd9ee4 819 echo_now ();
284f4730
JB
820}
821
822/* Display the current echo string, and begin echoing if not already
823 doing so. */
824
07a59269 825void
3dbd9ee4 826echo_now ()
284f4730 827{
c5fdd383 828 if (!current_kboard->immediate_echo)
284f4730
JB
829 {
830 int i;
c5fdd383 831 current_kboard->immediate_echo = 1;
284f4730
JB
832
833 for (i = 0; i < this_command_key_count; i++)
d0a57728
RS
834 {
835 Lisp_Object c;
22b94eeb
RS
836
837 /* Set before_command_echo_length to the value that would
838 have been saved before the start of this subcommand in
839 command_loop_1, if we had already been echoing then. */
840 if (i == this_single_command_key_start)
841 before_command_echo_length = echo_length ();
842
d0a57728
RS
843 c = XVECTOR (this_command_keys)->contents[i];
844 if (! (EVENT_HAS_PARAMETERS (c)
845 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
846 echo_char (c);
847 }
22b94eeb
RS
848
849 /* Set before_command_echo_length to the value that would
850 have been saved before the start of this subcommand in
851 command_loop_1, if we had already been echoing then. */
852 if (this_command_key_count == this_single_command_key_start)
853 before_command_echo_length = echo_length ();
854
855 /* Put a dash at the end to invite the user to type more. */
284f4730
JB
856 echo_dash ();
857 }
858
859 echoing = 1;
678e9d18 860 message3_nolog (current_kboard->echo_string,
0d121f7c 861 SBYTES (current_kboard->echo_string),
d5db4077 862 STRING_MULTIBYTE (current_kboard->echo_string));
284f4730
JB
863 echoing = 0;
864
59a84f8e
GM
865 /* Record in what buffer we echoed, and from which kboard. */
866 echo_message_buffer = echo_area_buffer[0];
867 echo_kboard = current_kboard;
868
284f4730
JB
869 if (waiting_for_input && !NILP (Vquit_flag))
870 quit_throw_to_read_char ();
871}
872
873/* Turn off echoing, for the start of a new command. */
874
dfcf069d 875void
284f4730
JB
876cancel_echoing ()
877{
c5fdd383 878 current_kboard->immediate_echo = 0;
c5fdd383 879 current_kboard->echo_after_prompt = -1;
678e9d18 880 current_kboard->echo_string = Qnil;
59a84f8e
GM
881 ok_to_echo_at_next_pause = NULL;
882 echo_kboard = NULL;
883 echo_message_buffer = Qnil;
284f4730
JB
884}
885
886/* Return the length of the current echo string. */
887
888static int
889echo_length ()
890{
678e9d18 891 return (STRINGP (current_kboard->echo_string)
0d121f7c 892 ? SCHARS (current_kboard->echo_string)
678e9d18 893 : 0);
284f4730
JB
894}
895
896/* Truncate the current echo message to its first LEN chars.
897 This and echo_char get used by read_key_sequence when the user
ff11dfa1 898 switches frames while entering a key sequence. */
284f4730
JB
899
900static void
678e9d18
GM
901echo_truncate (nchars)
902 int nchars;
903{
904 if (STRINGP (current_kboard->echo_string))
905 current_kboard->echo_string
906 = Fsubstring (current_kboard->echo_string,
907 make_number (0), make_number (nchars));
908 truncate_echo_area (nchars);
284f4730
JB
909}
910
911\f
912/* Functions for manipulating this_command_keys. */
913static void
914add_command_key (key)
915 Lisp_Object key;
916{
22b94eeb
RS
917#if 0 /* Not needed after we made Freset_this_command_lengths
918 do the job immediately. */
71918b75
RS
919 /* If reset-this-command-length was called recently, obey it now.
920 See the doc string of that function for an explanation of why. */
921 if (before_command_restore_flag)
922 {
923 this_command_key_count = before_command_key_count_1;
6321824f
RS
924 if (this_command_key_count < this_single_command_key_start)
925 this_single_command_key_start = this_command_key_count;
71918b75
RS
926 echo_truncate (before_command_echo_length_1);
927 before_command_restore_flag = 0;
928 }
22b94eeb 929#endif
71918b75 930
f4e05d97
GM
931 if (this_command_key_count >= ASIZE (this_command_keys))
932 this_command_keys = larger_vector (this_command_keys,
933 2 * ASIZE (this_command_keys),
934 Qnil);
6569cc8d 935
f4e05d97
GM
936 AREF (this_command_keys, this_command_key_count) = key;
937 ++this_command_key_count;
284f4730 938}
f4e05d97 939
284f4730
JB
940\f
941Lisp_Object
942recursive_edit_1 ()
943{
aed13378 944 int count = SPECPDL_INDEX ();
284f4730
JB
945 Lisp_Object val;
946
947 if (command_loop_level > 0)
948 {
949 specbind (Qstandard_output, Qt);
950 specbind (Qstandard_input, Qt);
951 }
952
84265027 953#ifdef HAVE_X_WINDOWS
526a058f 954 /* The command loop has started an hourglass timer, so we have to
84265027 955 cancel it here, otherwise it will fire because the recursive edit
d8e2d5ba
PJ
956 can take some time. Do not check for display_hourglass_p here,
957 because it could already be nil. */
526a058f 958 cancel_hourglass ();
84265027
GM
959#endif
960
980a2d69
GM
961 /* This function may have been called from a debugger called from
962 within redisplay, for instance by Edebugging a function called
963 from fontification-functions. We want to allow redisplay in
964 the debugging session.
965
966 The recursive edit is left with a `(throw exit ...)'. The `exit'
967 tag is not caught anywhere in redisplay, i.e. when we leave the
968 recursive edit, the original redisplay leading to the recursive
969 edit will be unwound. The outcome should therefore be safe. */
970 specbind (Qinhibit_redisplay, Qnil);
971 redisplaying_p = 0;
972
284f4730
JB
973 val = command_loop ();
974 if (EQ (val, Qt))
975 Fsignal (Qquit, Qnil);
cb252880
RS
976 /* Handle throw from read_minibuf when using minibuffer
977 while it's active but we're in another window. */
978 if (STRINGP (val))
979 Fsignal (Qerror, Fcons (val, Qnil));
284f4730 980
cb5df6ae 981 return unbind_to (count, Qnil);
284f4730
JB
982}
983
984/* When an auto-save happens, record the "time", and don't do again soon. */
5846638c 985
07a59269 986void
284f4730
JB
987record_auto_save ()
988{
c43b1734 989 last_auto_save = num_nonmacro_input_events;
284f4730 990}
5846638c
RS
991
992/* Make an auto save happen as soon as possible at command level. */
993
dfcf069d 994void
5846638c
RS
995force_auto_save_soon ()
996{
997 last_auto_save = - auto_save_interval - 1;
241ceaf7
RS
998
999 record_asynch_buffer_change ();
5846638c 1000}
284f4730 1001\f
284f4730 1002DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
4707d2d0
PJ
1003 doc: /* Invoke the editor command loop recursively.
1004To get out of the recursive edit, a command can do `(throw 'exit nil)';
1005that tells this function to return.
6e604a9b 1006Alternatively, `(throw 'exit t)' makes this function signal an error.
4707d2d0
PJ
1007This function is called by the editor initialization to begin editing. */)
1008 ()
284f4730 1009{
aed13378 1010 int count = SPECPDL_INDEX ();
9ce50b1e 1011 Lisp_Object buffer;
284f4730 1012
96edd5d4
KS
1013 /* If we enter while input is blocked, don't lock up here.
1014 This may happen through the debugger during redisplay. */
1015 if (INPUT_BLOCKED_P)
1016 return Qnil;
1017
284f4730
JB
1018 command_loop_level++;
1019 update_mode_lines = 1;
1020
9ce50b1e
GM
1021 if (command_loop_level
1022 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
1023 buffer = Fcurrent_buffer ();
1024 else
1025 buffer = Qnil;
1026
1027 /* If we leave recursive_edit_1 below with a `throw' for instance,
1028 like it is done in the splash screen display, we have to
1029 make sure that we restore single_kboard as command_loop_1
1030 would have done if it were left normally. */
256c9c3a
KL
1031 temporarily_switch_to_single_kboard (FRAME_KBOARD (SELECTED_FRAME ()));
1032 record_unwind_protect (recursive_edit_unwind, buffer);
9ce50b1e 1033
284f4730
JB
1034 recursive_edit_1 ();
1035 return unbind_to (count, Qnil);
1036}
1037
1038Lisp_Object
256c9c3a
KL
1039recursive_edit_unwind (buffer)
1040 Lisp_Object buffer;
284f4730 1041{
256c9c3a
KL
1042 if (BUFFERP (buffer))
1043 Fset_buffer (buffer);
c60ee5e7 1044
284f4730
JB
1045 command_loop_level--;
1046 update_mode_lines = 1;
1047 return Qnil;
1048}
9ce50b1e 1049
284f4730 1050\f
604ccd1d 1051static void
1e8bd3da 1052any_kboard_state ()
604ccd1d 1053{
1e8bd3da
RS
1054#ifdef MULTI_KBOARD
1055#if 0 /* Theory: if there's anything in Vunread_command_events,
1056 it will right away be read by read_key_sequence,
1057 and then if we do switch KBOARDS, it will go into the side
1058 queue then. So we don't need to do anything special here -- rms. */
604ccd1d 1059 if (CONSP (Vunread_command_events))
4524b161 1060 {
c5fdd383
KH
1061 current_kboard->kbd_queue
1062 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
1063 current_kboard->kbd_queue_has_data = 1;
4524b161 1064 }
604ccd1d 1065 Vunread_command_events = Qnil;
1e8bd3da
RS
1066#endif
1067 single_kboard = 0;
1068#endif
604ccd1d 1069}
1e8bd3da
RS
1070
1071/* Switch to the single-kboard state, making current_kboard
1072 the only KBOARD from which further input is accepted. */
1073
1074void
1075single_kboard_state ()
1076{
1077#ifdef MULTI_KBOARD
1078 single_kboard = 1;
604ccd1d 1079#endif
1e8bd3da
RS
1080}
1081
0c1c1b93
RS
1082/* If we're in single_kboard state for kboard KBOARD,
1083 get out of it. */
1084
1085void
1086not_single_kboard_state (kboard)
1087 KBOARD *kboard;
1088{
26503ad2 1089#ifdef MULTI_KBOARD
0c1c1b93
RS
1090 if (kboard == current_kboard)
1091 single_kboard = 0;
26503ad2 1092#endif
0c1c1b93
RS
1093}
1094
1e8bd3da
RS
1095/* Maintain a stack of kboards, so other parts of Emacs
1096 can switch temporarily to the kboard of a given frame
1097 and then revert to the previous status. */
1098
1099struct kboard_stack
1100{
1101 KBOARD *kboard;
1102 struct kboard_stack *next;
1103};
1104
1105static struct kboard_stack *kboard_stack;
1106
e589efa5 1107void
256c9c3a
KL
1108push_kboard (k)
1109 struct kboard *k;
e589efa5
KL
1110{
1111#ifdef MULTI_KBOARD
1112 struct kboard_stack *p
1113 = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
1114
1115 p->next = kboard_stack;
1116 p->kboard = current_kboard;
1117 kboard_stack = p;
1118
256c9c3a 1119 current_kboard = k;
e589efa5
KL
1120#endif
1121}
1122
1e8bd3da
RS
1123void
1124push_frame_kboard (f)
1125 FRAME_PTR f;
1126{
256c9c3a 1127 push_kboard (f->device->kboard);
1e8bd3da
RS
1128}
1129
1130void
256c9c3a 1131pop_kboard ()
1e8bd3da 1132{
ab48365b 1133#ifdef MULTI_KBOARD
3fb8e5d7 1134 struct device *d;
1e8bd3da 1135 struct kboard_stack *p = kboard_stack;
3fb8e5d7
KL
1136 int ok = 0;
1137 current_kboard = NULL;
1138 for (d = device_list; d; d = d->next_device)
1139 {
1140 if (d->kboard == p->kboard)
1141 {
1142 current_kboard = p->kboard;
1143 break;
1144 }
1145 }
1146 if (current_kboard == NULL)
1147 {
1148 /* The display we remembered has been deleted. */
1149 current_kboard = FRAME_KBOARD (SELECTED_FRAME ());
1150 }
1e8bd3da
RS
1151 kboard_stack = p->next;
1152 xfree (p);
ab48365b 1153#endif
1e8bd3da 1154}
256c9c3a
KL
1155
1156/* Switch to single_kboard mode. If K is non-nil, set it as the
1157 current keyboard. Use record_unwind_protect to return to the
1158 previous state later. */
1159
1160void
1161temporarily_switch_to_single_kboard (k)
1162 struct kboard *k;
1163{
1164#ifdef MULTI_KBOARD
1165 int was_locked = single_kboard;
1166 if (k != NULL)
1167 push_kboard (k);
1168 else
1169 push_kboard (current_kboard);
1170 single_kboard_state ();
1171 record_unwind_protect (restore_kboard_configuration,
1172 (was_locked ? Qt : Qnil));
1173#endif
1174}
1175
1176void
1177record_single_kboard_state ()
1178{
1179 push_kboard (current_kboard);
1180 record_unwind_protect (restore_kboard_configuration,
1181 (single_kboard ? Qt : Qnil));
1182}
1183
1184static Lisp_Object
1185restore_kboard_configuration (was_locked)
1186 Lisp_Object was_locked;
1187{
256c9c3a
KL
1188 if (NILP (was_locked))
1189 any_kboard_state ();
1190 else
1191 single_kboard_state ();
3fb8e5d7 1192 pop_kboard ();
256c9c3a
KL
1193 return Qnil;
1194}
1e8bd3da
RS
1195\f
1196/* Handle errors that are not handled at inner levels
1197 by printing an error message and returning to the editor command loop. */
604ccd1d 1198
284f4730
JB
1199Lisp_Object
1200cmd_error (data)
1201 Lisp_Object data;
a1341f75 1202{
a9f16aa9 1203 Lisp_Object old_level, old_length;
e881d8b2
RS
1204 char macroerror[50];
1205
160552c5
RS
1206#ifdef HAVE_X_WINDOWS
1207 if (display_hourglass_p)
1208 cancel_hourglass ();
1209#endif
1210
649d952d 1211 if (!NILP (executing_kbd_macro))
e881d8b2 1212 {
649d952d 1213 if (executing_kbd_macro_iterations == 1)
e881d8b2
RS
1214 sprintf (macroerror, "After 1 kbd macro iteration: ");
1215 else
1216 sprintf (macroerror, "After %d kbd macro iterations: ",
649d952d 1217 executing_kbd_macro_iterations);
e881d8b2
RS
1218 }
1219 else
1220 *macroerror = 0;
a9f16aa9 1221
a1341f75
RS
1222 Vstandard_output = Qt;
1223 Vstandard_input = Qt;
ce0d2858 1224 Vexecuting_kbd_macro = Qnil;
649d952d 1225 executing_kbd_macro = Qnil;
d8bcf58e 1226 current_kboard->Vprefix_arg = Qnil;
75045dcb 1227 current_kboard->Vlast_prefix_arg = Qnil;
df0f2ba1 1228 cancel_echoing ();
a9f16aa9
KH
1229
1230 /* Avoid unquittable loop if data contains a circular list. */
1231 old_level = Vprint_level;
1232 old_length = Vprint_length;
0c04a67e
RS
1233 XSETFASTINT (Vprint_level, 10);
1234 XSETFASTINT (Vprint_length, 10);
e881d8b2 1235 cmd_error_internal (data, macroerror);
a9f16aa9
KH
1236 Vprint_level = old_level;
1237 Vprint_length = old_length;
a1341f75
RS
1238
1239 Vquit_flag = Qnil;
1240
1241 Vinhibit_quit = Qnil;
c5fdd383 1242#ifdef MULTI_KBOARD
e3ee34f0
RS
1243 if (command_loop_level == 0 && minibuf_level == 0)
1244 any_kboard_state ();
ff4b06d3 1245#endif
a1341f75
RS
1246
1247 return make_number (0);
1248}
1249
301738ed
RS
1250/* Take actions on handling an error. DATA is the data that describes
1251 the error.
1252
1253 CONTEXT is a C-string containing ASCII characters only which
1254 describes the context in which the error happened. If we need to
1255 generalize CONTEXT to allow multibyte characters, make it a Lisp
1256 string. */
1257
07a59269 1258void
a1341f75
RS
1259cmd_error_internal (data, context)
1260 Lisp_Object data;
1261 char *context;
284f4730 1262{
284f4730 1263 Lisp_Object stream;
7ee32cda 1264 int kill_emacs_p = 0;
788f89eb 1265 struct frame *sf = SELECTED_FRAME ();
284f4730
JB
1266
1267 Vquit_flag = Qnil;
1268 Vinhibit_quit = Qt;
985f9f66 1269 clear_message (1, 0);
284f4730 1270
ff11dfa1 1271 /* If the window system or terminal frame hasn't been initialized
284f4730
JB
1272 yet, or we're not interactive, it's best to dump this message out
1273 to stderr and exit. */
788f89eb 1274 if (!sf->glyphs_initialized_p
114a8b8c 1275 || FRAME_INITIAL_P (sf)
284f4730 1276 || noninteractive)
7ee32cda
GM
1277 {
1278 stream = Qexternal_debugging_output;
1279 kill_emacs_p = 1;
1280 }
284f4730
JB
1281 else
1282 {
1283 Fdiscard_input ();
dc4854ce 1284 message_log_maybe_newline ();
284f4730
JB
1285 bitch_at_user ();
1286 stream = Qt;
1287 }
1288
dc4854ce
RS
1289 /* The immediate context is not interesting for Quits,
1290 since they are asyncronous. */
1291 if (EQ (XCAR (data), Qquit))
1292 Vsignaling_function = Qnil;
c60ee5e7 1293
dc4854ce 1294 print_error_message (data, stream, context, Vsignaling_function);
a1341f75 1295
dc4854ce 1296 Vsignaling_function = Qnil;
284f4730 1297
ff11dfa1 1298 /* If the window system or terminal frame hasn't been initialized
284f4730 1299 yet, or we're in -batch mode, this error should cause Emacs to exit. */
7ee32cda 1300 if (kill_emacs_p)
284f4730
JB
1301 {
1302 Fterpri (stream);
1303 Fkill_emacs (make_number (-1));
1304 }
284f4730
JB
1305}
1306\f
1307Lisp_Object command_loop_1 ();
1308Lisp_Object command_loop_2 ();
1309Lisp_Object top_level_1 ();
1310
1311/* Entry to editor-command-loop.
1312 This level has the catches for exiting/returning to editor command loop.
1313 It returns nil to exit recursive edit, t to abort it. */
1314
1315Lisp_Object
1316command_loop ()
1317{
1318 if (command_loop_level > 0 || minibuf_level > 0)
1319 {
07ba902e
RS
1320 Lisp_Object val;
1321 val = internal_catch (Qexit, command_loop_2, Qnil);
649d952d 1322 executing_kbd_macro = Qnil;
68c46464 1323 return val;
284f4730
JB
1324 }
1325 else
1326 while (1)
1327 {
1328 internal_catch (Qtop_level, top_level_1, Qnil);
c98e2d50
KL
1329 /* Reset single_kboard in case top-level set it while
1330 evaluating an -f option, or we are stuck there for some
1331 other reason. */
1332 any_kboard_state ();
284f4730 1333 internal_catch (Qtop_level, command_loop_2, Qnil);
649d952d 1334 executing_kbd_macro = Qnil;
df0f2ba1 1335
284f4730
JB
1336 /* End of file in -batch run causes exit here. */
1337 if (noninteractive)
1338 Fkill_emacs (Qt);
1339 }
1340}
1341
1342/* Here we catch errors in execution of commands within the
1343 editing loop, and reenter the editing loop.
1344 When there is an error, cmd_error runs and returns a non-nil
27fd22dc 1345 value to us. A value of nil means that command_loop_1 itself
284f4730
JB
1346 returned due to end of file (or end of kbd macro). */
1347
1348Lisp_Object
1349command_loop_2 ()
1350{
1351 register Lisp_Object val;
1352
1353 do
1354 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1355 while (!NILP (val));
1356
1357 return Qnil;
1358}
1359
1360Lisp_Object
1361top_level_2 ()
1362{
1363 return Feval (Vtop_level);
1364}
1365
1366Lisp_Object
1367top_level_1 ()
1368{
1369 /* On entry to the outer level, run the startup file */
1370 if (!NILP (Vtop_level))
1371 internal_condition_case (top_level_2, Qerror, cmd_error);
1372 else if (!NILP (Vpurify_flag))
1373 message ("Bare impure Emacs (standard Lisp code not loaded)");
1374 else
1375 message ("Bare Emacs (standard Lisp code not loaded)");
1376 return Qnil;
1377}
1378
1379DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
4707d2d0
PJ
1380 doc: /* Exit all recursive editing levels. */)
1381 ()
284f4730 1382{
2c9cf2c8 1383#ifdef HAVE_X_WINDOWS
526a058f
GM
1384 if (display_hourglass_p)
1385 cancel_hourglass ();
2c9cf2c8 1386#endif
96edd5d4 1387
a25e44b2
JD
1388 /* Unblock input if we enter with input blocked. This may happen if
1389 redisplay traps e.g. during tool-bar update with input blocked. */
1390 while (INPUT_BLOCKED_P)
1391 UNBLOCK_INPUT;
1392
8c907a56 1393 return Fthrow (Qtop_level, Qnil);
284f4730
JB
1394}
1395
1396DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
4707d2d0
PJ
1397 doc: /* Exit from the innermost recursive edit or minibuffer. */)
1398 ()
284f4730
JB
1399{
1400 if (command_loop_level > 0 || minibuf_level > 0)
1401 Fthrow (Qexit, Qnil);
1402
1403 error ("No recursive edit is in progress");
8c907a56 1404 return Qnil;
284f4730
JB
1405}
1406
1407DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
4707d2d0
PJ
1408 doc: /* Abort the command that requested this recursive edit or minibuffer input. */)
1409 ()
284f4730
JB
1410{
1411 if (command_loop_level > 0 || minibuf_level > 0)
1412 Fthrow (Qexit, Qt);
1413
1414 error ("No recursive edit is in progress");
8c907a56 1415 return Qnil;
284f4730
JB
1416}
1417\f
1418/* This is the actual command reading loop,
1419 sans error-handling encapsulation. */
1420
a7b772c1
GM
1421static int read_key_sequence P_ ((Lisp_Object *, int, Lisp_Object,
1422 int, int, int));
1423void safe_run_hooks P_ ((Lisp_Object));
2a026b04 1424static void adjust_point_for_property P_ ((int, int));
284f4730 1425
0af912f0
JD
1426/* Cancel hourglass from protect_unwind.
1427 ARG is not used. */
bb8db7e1 1428#ifdef HAVE_X_WINDOWS
0af912f0
JD
1429static Lisp_Object
1430cancel_hourglass_unwind (arg)
1431 Lisp_Object arg;
1432{
1433 cancel_hourglass ();
e581a466 1434 return Qnil;
0af912f0 1435}
bb8db7e1 1436#endif
0af912f0 1437
284f4730
JB
1438Lisp_Object
1439command_loop_1 ()
1440{
03cee6ae
GM
1441 Lisp_Object cmd;
1442 int lose;
284f4730
JB
1443 int nonundocount;
1444 Lisp_Object keybuf[30];
1445 int i;
284f4730 1446 int no_direct;
80d4c824 1447 int prev_modiff = 0;
8c907a56 1448 struct buffer *prev_buffer = NULL;
c5fdd383 1449#ifdef MULTI_KBOARD
1e8bd3da 1450 int was_locked = single_kboard;
bded54dd 1451#endif
80d4c824 1452 int already_adjusted = 0;
284f4730 1453
d9b641bb 1454 current_kboard->Vprefix_arg = Qnil;
75045dcb 1455 current_kboard->Vlast_prefix_arg = Qnil;
86e5706b 1456 Vdeactivate_mark = Qnil;
284f4730 1457 waiting_for_input = 0;
df0f2ba1 1458 cancel_echoing ();
284f4730 1459
284f4730 1460 nonundocount = 0;
284f4730 1461 this_command_key_count = 0;
63020c46 1462 this_command_key_count_reset = 0;
6321824f 1463 this_single_command_key_start = 0;
284f4730 1464
325309f5 1465 if (NILP (Vmemory_full))
59aadc81 1466 {
10ffcb64
RS
1467 /* Make sure this hook runs after commands that get errors and
1468 throw to top level. */
1469 /* Note that the value cell will never directly contain nil
1470 if the symbol is a local variable. */
1471 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1472 safe_run_hooks (Qpost_command_hook);
1473
1474 /* If displaying a message, resize the echo area window to fit
1475 that message's size exactly. */
1476 if (!NILP (echo_area_buffer[0]))
1477 resize_echo_area_exactly ();
1478
1479 if (!NILP (Vdeferred_action_list))
0b5d283f 1480 safe_run_hooks (Qdeferred_action_function);
59aadc81
RS
1481 }
1482
10ffcb64
RS
1483 Vmemory_full = Qnil;
1484
51d5a2c9 1485 /* Do this after running Vpost_command_hook, for consistency. */
d5eecefb
RS
1486 current_kboard->Vlast_command = Vthis_command;
1487 current_kboard->Vreal_last_command = real_this_command;
51d5a2c9 1488
284f4730
JB
1489 while (1)
1490 {
788f89eb 1491 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
a94a4335
KH
1492 Fkill_emacs (Qnil);
1493
284f4730
JB
1494 /* Make sure the current window's buffer is selected. */
1495 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1496 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1497
1498 /* Display any malloc warning that just came out. Use while because
1499 displaying one warning can cause another. */
1500
1501 while (pending_malloc_warning)
1502 display_malloc_warning ();
1503
1504 no_direct = 0;
1505
86e5706b
RS
1506 Vdeactivate_mark = Qnil;
1507
284f4730 1508 /* If minibuffer on and echo area in use,
00392ce6 1509 wait a short time and redraw minibuffer. */
284f4730 1510
7ee32cda 1511 if (minibuf_level
985f9f66 1512 && !NILP (echo_area_buffer[0])
00392ce6
MB
1513 && EQ (minibuf_window, echo_area_window)
1514 && NUMBERP (Vminibuffer_message_timeout))
284f4730 1515 {
f1bed6d8
RS
1516 /* Bind inhibit-quit to t so that C-g gets read in
1517 rather than quitting back to the minibuffer. */
aed13378 1518 int count = SPECPDL_INDEX ();
f1bed6d8 1519 specbind (Qinhibit_quit, Qt);
f1bed6d8 1520
00392ce6 1521 Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil);
e6aa7813 1522 /* Clear the echo area. */
301738ed 1523 message2 (0, 0, 0);
cdb9d665 1524 safe_run_hooks (Qecho_area_clear_hook);
e6aa7813 1525
db08707d
RS
1526 unbind_to (count, Qnil);
1527
e6aa7813 1528 /* If a C-g came in before, treat it as input now. */
284f4730
JB
1529 if (!NILP (Vquit_flag))
1530 {
1531 Vquit_flag = Qnil;
24597608 1532 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
284f4730
JB
1533 }
1534 }
1535
1536#ifdef C_ALLOCA
ff4b06d3 1537 alloca (0); /* Cause a garbage collection now */
284f4730
JB
1538 /* Since we can free the most stuff here. */
1539#endif /* C_ALLOCA */
1540
8f805655 1541#if 0
8f805655
JB
1542 /* Select the frame that the last event came from. Usually,
1543 switch-frame events will take care of this, but if some lisp
1544 code swallows a switch-frame event, we'll fix things up here.
1545 Is this a good idea? */
8c18cbfb 1546 if (FRAMEP (internal_last_event_frame)
788f89eb 1547 && !EQ (internal_last_event_frame, selected_frame))
f840fb39 1548 Fselect_frame (internal_last_event_frame);
284f4730 1549#endif
48e416d4
RS
1550 /* If it has changed current-menubar from previous value,
1551 really recompute the menubar from the value. */
a646e520
RS
1552 if (! NILP (Vlucid_menu_bar_dirty_flag)
1553 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
48e416d4
RS
1554 call0 (Qrecompute_lucid_menubar);
1555
71918b75
RS
1556 before_command_key_count = this_command_key_count;
1557 before_command_echo_length = echo_length ();
1558
d5eecefb
RS
1559 Vthis_command = Qnil;
1560 real_this_command = Qnil;
9d138659 1561 Vthis_original_command = Qnil;
d7437ef6 1562
8f805655 1563 /* Read next key sequence; i gets its length. */
ce98e608 1564 i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
f571ae0d 1565 Qnil, 0, 1, 1);
8f805655 1566
6fac1409 1567 /* A filter may have run while we were reading the input. */
788f89eb 1568 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
a94a4335 1569 Fkill_emacs (Qnil);
6fac1409
RS
1570 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1571 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1572
8f805655
JB
1573 ++num_input_keys;
1574
284f4730
JB
1575 /* Now we have read a key sequence of length I,
1576 or else I is 0 and we found end of file. */
1577
1578 if (i == 0) /* End of file -- happens only in */
1579 return Qnil; /* a kbd macro, at the end. */
dcc408a0
RS
1580 /* -1 means read_key_sequence got a menu that was rejected.
1581 Just loop around and read another command. */
1582 if (i == -1)
1583 {
1584 cancel_echoing ();
1585 this_command_key_count = 0;
63020c46 1586 this_command_key_count_reset = 0;
6321824f 1587 this_single_command_key_start = 0;
ff4b06d3 1588 goto finalize;
dcc408a0 1589 }
284f4730 1590
284f4730
JB
1591 last_command_char = keybuf[i - 1];
1592
75c0b143
RS
1593 /* If the previous command tried to force a specific window-start,
1594 forget about that, in case this command moves point far away
c422836d
KH
1595 from that position. But also throw away beg_unchanged and
1596 end_unchanged information in that case, so that redisplay will
1597 update the whole window properly. */
1598 if (!NILP (XWINDOW (selected_window)->force_start))
1599 {
9351ebd0 1600 struct buffer *b;
c422836d 1601 XWINDOW (selected_window)->force_start = Qnil;
9351ebd0
GM
1602 b = XBUFFER (XWINDOW (selected_window)->buffer);
1603 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
c422836d 1604 }
75c0b143 1605
284f4730 1606 cmd = read_key_sequence_cmd;
ce0d2858 1607 if (!NILP (Vexecuting_kbd_macro))
284f4730
JB
1608 {
1609 if (!NILP (Vquit_flag))
1610 {
ce0d2858 1611 Vexecuting_kbd_macro = Qt;
284f4730
JB
1612 QUIT; /* Make some noise. */
1613 /* Will return since macro now empty. */
1614 }
1615 }
1616
1617 /* Do redisplay processing after this command except in special
e35b6123 1618 cases identified below. */
86e5706b
RS
1619 prev_buffer = current_buffer;
1620 prev_modiff = MODIFF;
8746da95 1621 last_point_position = PT;
18cd2eeb 1622 XSETBUFFER (last_point_position_buffer, prev_buffer);
86e5706b 1623
adf5cb9c
KH
1624 /* By default, we adjust point to a boundary of a region that
1625 has such a property that should be treated intangible
1626 (e.g. composition, display). But, some commands will set
1627 this variable differently. */
1628 Vdisable_point_adjustment = Qnil;
a7b772c1 1629
be2488ca
GM
1630 /* Process filters and timers may have messed with deactivate-mark.
1631 reset it before we execute the command. */
1632 Vdeactivate_mark = Qnil;
1633
8b9940e6
KS
1634 /* Remap command through active keymaps */
1635 Vthis_original_command = cmd;
a34cb674 1636 if (SYMBOLP (cmd))
8b9940e6
KS
1637 {
1638 Lisp_Object cmd1;
023b93f6 1639 if (cmd1 = Fcommand_remapping (cmd), !NILP (cmd1))
8b9940e6
KS
1640 cmd = cmd1;
1641 }
1642
284f4730
JB
1643 /* Execute the command. */
1644
d5eecefb
RS
1645 Vthis_command = cmd;
1646 real_this_command = cmd;
a98ea3f9
RS
1647 /* Note that the value cell will never directly contain nil
1648 if the symbol is a local variable. */
e98a93eb 1649 if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks))
a98ea3f9 1650 safe_run_hooks (Qpre_command_hook);
c60ee5e7 1651
2764bebd
RS
1652 already_adjusted = 0;
1653
d5eecefb 1654 if (NILP (Vthis_command))
284f4730
JB
1655 {
1656 /* nil means key is undefined. */
1bf0e604
SM
1657 Lisp_Object keys = Fvector (i, keybuf);
1658 keys = Fkey_description (keys, Qnil);
284f4730 1659 bitch_at_user ();
1bf0e604 1660 message_with_string ("%s is undefined", keys, 0);
c5fdd383 1661 current_kboard->defining_kbd_macro = Qnil;
284f4730 1662 update_mode_lines = 1;
d8bcf58e 1663 current_kboard->Vprefix_arg = Qnil;
284f4730
JB
1664 }
1665 else
1666 {
d8bcf58e 1667 if (NILP (current_kboard->Vprefix_arg) && ! no_direct)
284f4730 1668 {
75045dcb
RS
1669 /* In case we jump to directly_done. */
1670 Vcurrent_prefix_arg = current_kboard->Vprefix_arg;
1671
284f4730
JB
1672 /* Recognize some common commands in common situations and
1673 do them directly. */
d5eecefb 1674 if (EQ (Vthis_command, Qforward_char) && PT < ZV)
284f4730 1675 {
51ad8a68 1676 struct Lisp_Char_Table *dp
284f4730 1677 = window_display_table (XWINDOW (selected_window));
aaf35234 1678 lose = FETCH_CHAR (PT_BYTE);
8458ede6 1679 SET_PT (PT + 1);
d86ba5c5
RS
1680 if (! NILP (Vpost_command_hook))
1681 /* Put this before calling adjust_point_for_property
1682 so it will only get called once in any case. */
1683 goto directly_done;
22b94eeb
RS
1684 if (current_buffer == prev_buffer
1685 && last_point_position != PT
1686 && NILP (Vdisable_point_adjustment)
1687 && NILP (Vglobal_disable_point_adjustment))
1688 adjust_point_for_property (last_point_position, 0);
2764bebd
RS
1689 already_adjusted = 1;
1690 if (PT == last_point_position + 1
1691 && (dp
1692 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1693 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1694 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1695 && (lose >= 0x20 && lose < 0x7f)))
1696 : (lose >= 0x20 && lose < 0x7f))
37cd9f30
KH
1697 /* To extract the case of continuation on
1698 wide-column characters. */
8458ede6 1699 && (WIDTH_BY_CHAR_HEAD (FETCH_BYTE (PT_BYTE)) == 1)
284f4730
JB
1700 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1701 >= MODIFF)
598ba4c7
RS
1702 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1703 >= OVERLAY_MODIFF)
284f4730 1704 && (XFASTINT (XWINDOW (selected_window)->last_point)
8001d352 1705 == PT - 1)
284f4730
JB
1706 && !windows_or_buffers_changed
1707 && EQ (current_buffer->selective_display, Qnil)
1708 && !detect_input_pending ()
962ae636 1709 && NILP (XWINDOW (selected_window)->column_number_displayed)
ce0d2858 1710 && NILP (Vexecuting_kbd_macro))
e35b6123 1711 direct_output_forward_char (1);
284f4730
JB
1712 goto directly_done;
1713 }
d5eecefb 1714 else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV)
284f4730 1715 {
51ad8a68 1716 struct Lisp_Char_Table *dp
284f4730 1717 = window_display_table (XWINDOW (selected_window));
8458ede6 1718 SET_PT (PT - 1);
aaf35234 1719 lose = FETCH_CHAR (PT_BYTE);
d86ba5c5
RS
1720 if (! NILP (Vpost_command_hook))
1721 goto directly_done;
22b94eeb
RS
1722 if (current_buffer == prev_buffer
1723 && last_point_position != PT
1724 && NILP (Vdisable_point_adjustment)
1725 && NILP (Vglobal_disable_point_adjustment))
1726 adjust_point_for_property (last_point_position, 0);
2764bebd
RS
1727 already_adjusted = 1;
1728 if (PT == last_point_position - 1
1729 && (dp
1730 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1731 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1732 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1733 && (lose >= 0x20 && lose < 0x7f)))
1734 : (lose >= 0x20 && lose < 0x7f))
284f4730
JB
1735 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1736 >= MODIFF)
598ba4c7
RS
1737 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1738 >= OVERLAY_MODIFF)
284f4730 1739 && (XFASTINT (XWINDOW (selected_window)->last_point)
8001d352 1740 == PT + 1)
284f4730
JB
1741 && !windows_or_buffers_changed
1742 && EQ (current_buffer->selective_display, Qnil)
1743 && !detect_input_pending ()
962ae636 1744 && NILP (XWINDOW (selected_window)->column_number_displayed)
ce0d2858 1745 && NILP (Vexecuting_kbd_macro))
e35b6123 1746 direct_output_forward_char (-1);
284f4730
JB
1747 goto directly_done;
1748 }
d5eecefb 1749 else if (EQ (Vthis_command, Qself_insert_command)
14e40288
SM
1750 /* Try this optimization only on char keystrokes. */
1751 && NATNUMP (last_command_char)
1752 && CHAR_VALID_P (XFASTINT (last_command_char), 0))
284f4730 1753 {
d86ba5c5
RS
1754 unsigned int c
1755 = translate_char (Vtranslation_table_for_input,
1756 XFASTINT (last_command_char), 0, 0, 0);
fc9cce4e 1757 int value;
ce0d2858 1758 if (NILP (Vexecuting_kbd_macro)
fc9cce4e 1759 && !EQ (minibuf_window, selected_window))
284f4730
JB
1760 {
1761 if (!nonundocount || nonundocount >= 20)
1762 {
1763 Fundo_boundary ();
1764 nonundocount = 0;
1765 }
1766 nonundocount++;
1767 }
c60ee5e7 1768
fc9cce4e
RS
1769 lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
1770 < MODIFF)
598ba4c7
RS
1771 || (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1772 < OVERLAY_MODIFF)
fc9cce4e
RS
1773 || (XFASTINT (XWINDOW (selected_window)->last_point)
1774 != PT)
4c61f38e 1775 || MODIFF <= SAVE_MODIFF
fc9cce4e
RS
1776 || windows_or_buffers_changed
1777 || !EQ (current_buffer->selective_display, Qnil)
1778 || detect_input_pending ()
962ae636 1779 || !NILP (XWINDOW (selected_window)->column_number_displayed)
ce0d2858 1780 || !NILP (Vexecuting_kbd_macro));
c60ee5e7 1781
fc9cce4e 1782 value = internal_self_insert (c, 0);
7ee32cda 1783
fc9cce4e
RS
1784 if (value == 2)
1785 nonundocount = 0;
1786
294d643a
RS
1787 if (! NILP (Vpost_command_hook))
1788 /* Put this before calling adjust_point_for_property
1789 so it will only get called once in any case. */
1790 goto directly_done;
1791
7ee32cda
GM
1792 /* VALUE == 1 when AFTER-CHANGE functions are
1793 installed which is the case most of the time
1794 because FONT-LOCK installs one. */
1795 if (!lose && !value)
e35b6123 1796 direct_output_for_insert (c);
284f4730
JB
1797 goto directly_done;
1798 }
1799 }
1800
1801 /* Here for a command that isn't executed directly */
1802
0af912f0 1803 {
7ee32cda 1804#ifdef HAVE_X_WINDOWS
0af912f0
JD
1805 int scount = SPECPDL_INDEX ();
1806
1807 if (display_hourglass_p
ce0d2858 1808 && NILP (Vexecuting_kbd_macro))
0af912f0
JD
1809 {
1810 record_unwind_protect (cancel_hourglass_unwind, Qnil);
1811 start_hourglass ();
1812 }
7ee32cda
GM
1813#endif
1814
0af912f0
JD
1815 nonundocount = 0;
1816 if (NILP (current_kboard->Vprefix_arg))
1817 Fundo_boundary ();
1818 Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
d0c48478
GM
1819
1820#ifdef HAVE_X_WINDOWS
4fbcc9b1
PJ
1821 /* Do not check display_hourglass_p here, because
1822 Fcommand_execute could change it, but we should cancel
e1204d39
RS
1823 hourglass cursor anyway.
1824 But don't cancel the hourglass within a macro
1825 just because a command in the macro finishes. */
ce0d2858 1826 if (NILP (Vexecuting_kbd_macro))
0af912f0 1827 unbind_to (scount, Qnil);
d0c48478 1828#endif
0af912f0 1829 }
284f4730 1830 }
a764a753 1831 directly_done: ;
75045dcb 1832 current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg;
284f4730 1833
84ee6048
RS
1834 /* Note that the value cell will never directly contain nil
1835 if the symbol is a local variable. */
1836 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1837 safe_run_hooks (Qpost_command_hook);
1838
8f12e41d
GM
1839 /* If displaying a message, resize the echo area window to fit
1840 that message's size exactly. */
1841 if (!NILP (echo_area_buffer[0]))
f09c15ed 1842 resize_echo_area_exactly ();
8f12e41d 1843
84ee6048
RS
1844 if (!NILP (Vdeferred_action_list))
1845 safe_run_hooks (Qdeferred_action_function);
1846
284f4730 1847 /* If there is a prefix argument,
6c7178b9
KH
1848 1) We don't want Vlast_command to be ``universal-argument''
1849 (that would be dumb), so don't set Vlast_command,
284f4730
JB
1850 2) we want to leave echoing on so that the prefix will be
1851 echoed as part of this key sequence, so don't call
1852 cancel_echoing, and
1853 3) we want to leave this_command_key_count non-zero, so that
1854 read_char will realize that it is re-reading a character, and
217258d5
KH
1855 not echo it a second time.
1856
1857 If the command didn't actually create a prefix arg,
1858 but is merely a frame event that is transparent to prefix args,
1859 then the above doesn't apply. */
1860 if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_char))
284f4730 1861 {
d5eecefb
RS
1862 current_kboard->Vlast_command = Vthis_command;
1863 current_kboard->Vreal_last_command = real_this_command;
284f4730
JB
1864 cancel_echoing ();
1865 this_command_key_count = 0;
63020c46 1866 this_command_key_count_reset = 0;
6321824f 1867 this_single_command_key_start = 0;
284f4730 1868 }
86e5706b 1869
88ce066e 1870 if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks))
86e5706b 1871 {
f28c1bd9
RS
1872 /* Setting transient-mark-mode to `only' is a way of
1873 turning it on for just one command. */
1874
1875 if (EQ (Vtransient_mark_mode, Qidentity))
1876 Vtransient_mark_mode = Qnil;
1877 if (EQ (Vtransient_mark_mode, Qonly))
1878 Vtransient_mark_mode = Qidentity;
1879
86e5706b
RS
1880 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
1881 {
2e1a49ad
SM
1882 /* We could also call `deactivate'mark'. */
1883 if (EQ (Vtransient_mark_mode, Qlambda))
1884 Vtransient_mark_mode = Qnil;
1885 else
1886 {
1887 current_buffer->mark_active = Qnil;
1888 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
1889 }
86e5706b
RS
1890 }
1891 else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1892 call1 (Vrun_hooks, intern ("activate-mark-hook"));
1893 }
ff4b06d3
KH
1894
1895 finalize:
adf5cb9c
KH
1896
1897 if (current_buffer == prev_buffer
1898 && last_point_position != PT
1899 && NILP (Vdisable_point_adjustment)
2764bebd
RS
1900 && NILP (Vglobal_disable_point_adjustment)
1901 && !already_adjusted)
2a026b04 1902 adjust_point_for_property (last_point_position, MODIFF != prev_modiff);
adf5cb9c 1903
ff4b06d3
KH
1904 /* Install chars successfully executed in kbd macro. */
1905
d8bcf58e
KH
1906 if (!NILP (current_kboard->defining_kbd_macro)
1907 && NILP (current_kboard->Vprefix_arg))
ff4b06d3
KH
1908 finalize_kbd_macro_chars ();
1909
c5fdd383 1910#ifdef MULTI_KBOARD
604ccd1d 1911 if (!was_locked)
1e8bd3da 1912 any_kboard_state ();
ff4b06d3 1913#endif
284f4730
JB
1914 }
1915}
1c9784c9 1916
adf5cb9c
KH
1917extern Lisp_Object Qcomposition, Qdisplay;
1918
1919/* Adjust point to a boundary of a region that has such a property
1920 that should be treated intangible. For the moment, we check
7e16ef60
SM
1921 `composition', `display' and `invisible' properties.
1922 LAST_PT is the last position of point. */
adf5cb9c 1923
14e40288
SM
1924extern Lisp_Object Qafter_string, Qbefore_string;
1925extern Lisp_Object get_pos_property P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
1926
adf5cb9c 1927static void
2a026b04 1928adjust_point_for_property (last_pt, modified)
adf5cb9c 1929 int last_pt;
2a026b04 1930 int modified;
adf5cb9c 1931{
7e16ef60
SM
1932 int beg, end;
1933 Lisp_Object val, overlay, tmp;
1934 int check_composition = 1, check_display = 1, check_invisible = 1;
0bbdffbd 1935 int orig_pt = PT;
adf5cb9c 1936
0bbdffbd
SM
1937 /* FIXME: cycling is probably not necessary because these properties
1938 can't be usefully combined anyway. */
7e16ef60 1939 while (check_composition || check_display || check_invisible)
adf5cb9c
KH
1940 {
1941 if (check_composition
1942 && PT > BEGV && PT < ZV
7e16ef60
SM
1943 && get_property_and_range (PT, Qcomposition, &val, &beg, &end, Qnil)
1944 && COMPOSITION_VALID_P (beg, end, val)
1945 && beg < PT /* && end > PT <- It's always the case. */
1946 && (last_pt <= beg || last_pt >= end))
adf5cb9c 1947 {
14e40288 1948 xassert (end > PT);
7e16ef60 1949 SET_PT (PT < last_pt ? beg : end);
14e40288 1950 check_display = check_invisible = 1;
adf5cb9c
KH
1951 }
1952 check_composition = 0;
1953 if (check_display
1954 && PT > BEGV && PT < ZV
7e16ef60
SM
1955 && !NILP (val = get_char_property_and_overlay
1956 (make_number (PT), Qdisplay, Qnil, &overlay))
3e9ac4b7 1957 && display_prop_intangible_p (val)
7e16ef60
SM
1958 && (!OVERLAYP (overlay)
1959 ? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil)
1960 : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)),
1961 end = OVERLAY_POSITION (OVERLAY_END (overlay))))
4ca39724
KS
1962 && (beg < PT /* && end > PT <- It's always the case. */
1963 || (beg <= PT && STRINGP (val) && SCHARS (val) == 0)))
adf5cb9c 1964 {
14e40288 1965 xassert (end > PT);
4ca39724
KS
1966 SET_PT (PT < last_pt
1967 ? (STRINGP (val) && SCHARS (val) == 0 ? beg - 1 : beg)
1968 : end);
14e40288 1969 check_composition = check_invisible = 1;
adf5cb9c
KH
1970 }
1971 check_display = 0;
14e40288 1972 if (check_invisible && PT > BEGV && PT < ZV)
7e16ef60 1973 {
14e40288
SM
1974 int inv, ellipsis = 0;
1975 beg = end = PT;
1976
1977 /* Find boundaries `beg' and `end' of the invisible area, if any. */
1978 while (end < ZV
1979 && !NILP (val = get_char_property_and_overlay
1980 (make_number (end), Qinvisible, Qnil, &overlay))
1981 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1982 {
1983 ellipsis = ellipsis || inv > 1
1984 || (OVERLAYP (overlay)
1985 && (!NILP (Foverlay_get (overlay, Qafter_string))
1986 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1987 tmp = Fnext_single_char_property_change
1988 (make_number (end), Qinvisible, Qnil, Qnil);
1989 end = NATNUMP (tmp) ? XFASTINT (tmp) : ZV;
1990 }
1991 while (beg > BEGV
1992 && !NILP (val = get_char_property_and_overlay
1993 (make_number (beg - 1), Qinvisible, Qnil, &overlay))
1994 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1995 {
1996 ellipsis = ellipsis || inv > 1
1997 || (OVERLAYP (overlay)
1998 && (!NILP (Foverlay_get (overlay, Qafter_string))
1999 || !NILP (Foverlay_get (overlay, Qbefore_string))));
2000 tmp = Fprevious_single_char_property_change
2001 (make_number (beg), Qinvisible, Qnil, Qnil);
2002 beg = NATNUMP (tmp) ? XFASTINT (tmp) : BEGV;
2003 }
c60ee5e7 2004
14e40288
SM
2005 /* Move away from the inside area. */
2006 if (beg < PT && end > PT)
2007 {
0bbdffbd
SM
2008 SET_PT ((orig_pt == PT && (last_pt < beg || last_pt > end))
2009 /* We haven't moved yet (so we don't need to fear
2010 infinite-looping) and we were outside the range
2011 before (so either end of the range still corresponds
2012 to a move in the right direction): pretend we moved
2013 less than we actually did, so that we still have
2014 more freedom below in choosing which end of the range
2015 to go to. */
9465a86c 2016 ? (orig_pt = -1, PT < last_pt ? end : beg)
0bbdffbd
SM
2017 /* We either have moved already or the last point
2018 was already in the range: we don't get to choose
2019 which end of the range we have to go to. */
2020 : (PT < last_pt ? beg : end));
14e40288
SM
2021 check_composition = check_display = 1;
2022 }
a874691c
MB
2023#if 0 /* This assertion isn't correct, because SET_PT may end up setting
2024 the point to something other than its argument, due to
2025 point-motion hooks, intangibility, etc. */
14e40288 2026 xassert (PT == beg || PT == end);
a874691c
MB
2027#endif
2028
2a026b04
KH
2029 /* Pretend the area doesn't exist if the buffer is not
2030 modified. */
2031 if (!modified && !ellipsis && beg < end)
14e40288
SM
2032 {
2033 if (last_pt == beg && PT == end && end < ZV)
2034 (check_composition = check_display = 1, SET_PT (end + 1));
2035 else if (last_pt == end && PT == beg && beg > BEGV)
2036 (check_composition = check_display = 1, SET_PT (beg - 1));
2037 else if (PT == ((PT < last_pt) ? beg : end))
2038 /* We've already moved as far as we can. Trying to go
2039 to the other end would mean moving backwards and thus
2040 could lead to an infinite loop. */
2041 ;
2042 else if (val = get_pos_property (make_number (PT),
2043 Qinvisible, Qnil),
2044 TEXT_PROP_MEANS_INVISIBLE (val)
2045 && (val = get_pos_property
2046 (make_number (PT == beg ? end : beg),
2047 Qinvisible, Qnil),
2048 !TEXT_PROP_MEANS_INVISIBLE (val)))
2049 (check_composition = check_display = 1,
2050 SET_PT (PT == beg ? end : beg));
2051 }
7e16ef60
SM
2052 }
2053 check_invisible = 0;
adf5cb9c
KH
2054 }
2055}
2056
0bc3db2b
RS
2057/* Subroutine for safe_run_hooks: run the hook HOOK. */
2058
2059static Lisp_Object
2060safe_run_hooks_1 (hook)
2061 Lisp_Object hook;
2062{
2063 return call1 (Vrun_hooks, Vinhibit_quit);
2064}
2065
2066/* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */
2067
2068static Lisp_Object
2069safe_run_hooks_error (data)
2070 Lisp_Object data;
2071{
adec392e
SM
2072 Lisp_Object args[3];
2073 args[0] = build_string ("Error in %s: %s");
2074 args[1] = Vinhibit_quit;
2075 args[2] = data;
2076 Fmessage (3, args);
30690496 2077 return Fset (Vinhibit_quit, Qnil);
0bc3db2b
RS
2078}
2079
1c9784c9
KH
2080/* If we get an error while running the hook, cause the hook variable
2081 to be nil. Also inhibit quits, so that C-g won't cause the hook
2082 to mysteriously evaporate. */
0bc3db2b 2083
68f297c5 2084void
1c9784c9 2085safe_run_hooks (hook)
a98ea3f9 2086 Lisp_Object hook;
1c9784c9 2087{
aed13378 2088 int count = SPECPDL_INDEX ();
0bc3db2b
RS
2089 specbind (Qinhibit_quit, hook);
2090
e702932d 2091 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
1c9784c9
KH
2092
2093 unbind_to (count, Qnil);
2094}
8a9f5d3c 2095
284f4730 2096\f
8a9f5d3c
GM
2097/* Number of seconds between polling for input. This is a Lisp
2098 variable that can be bound. */
2099
31ade731 2100EMACS_INT polling_period;
284f4730 2101
eb8c3be9 2102/* Nonzero means polling for input is temporarily suppressed. */
8a9f5d3c 2103
284f4730
JB
2104int poll_suppress_count;
2105
8a9f5d3c
GM
2106/* Asynchronous timer for polling. */
2107
2108struct atimer *poll_timer;
2109
284f4730 2110
36922b18
RS
2111#ifdef POLL_FOR_INPUT
2112
8a9f5d3c
GM
2113/* Poll for input, so what we catch a C-g if it comes in. This
2114 function is called from x_make_frame_visible, see comment
2115 there. */
284f4730 2116
8a9f5d3c
GM
2117void
2118poll_for_input_1 ()
284f4730 2119{
9ac0d9e0
JB
2120 if (interrupt_input_blocked == 0
2121 && !waiting_for_input)
2122 read_avail_input (0);
284f4730
JB
2123}
2124
8a9f5d3c
GM
2125/* Timer callback function for poll_timer. TIMER is equal to
2126 poll_timer. */
2127
2128void
2129poll_for_input (timer)
2130 struct atimer *timer;
2131{
2132 if (poll_suppress_count == 0)
a42bf890
YM
2133#ifdef SYNC_INPUT
2134 interrupt_input_pending = 1;
2135#else
8a9f5d3c 2136 poll_for_input_1 ();
a42bf890 2137#endif
8a9f5d3c
GM
2138}
2139
2140#endif /* POLL_FOR_INPUT */
284f4730
JB
2141
2142/* Begin signals to poll for input, if they are appropriate.
2143 This function is called unconditionally from various places. */
2144
07a59269 2145void
284f4730
JB
2146start_polling ()
2147{
2148#ifdef POLL_FOR_INPUT
428a555e
KL
2149 /* XXX This condition was (read_socket_hook && !interrupt_input),
2150 but read_socket_hook is not global anymore. Let's pretend that
2151 it's always set. */
2152 if (!interrupt_input)
284f4730 2153 {
8a9f5d3c
GM
2154 /* Turn alarm handling on unconditionally. It might have
2155 been turned off in process.c. */
2156 turn_on_atimers (1);
c60ee5e7 2157
8a9f5d3c
GM
2158 /* If poll timer doesn't exist, are we need one with
2159 a different interval, start a new one. */
2160 if (poll_timer == NULL
2161 || EMACS_SECS (poll_timer->interval) != polling_period)
284f4730 2162 {
8a9f5d3c
GM
2163 EMACS_TIME interval;
2164
2165 if (poll_timer)
2166 cancel_atimer (poll_timer);
c60ee5e7 2167
8a9f5d3c
GM
2168 EMACS_SET_SECS_USECS (interval, polling_period, 0);
2169 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
2170 poll_for_input, NULL);
284f4730 2171 }
8a9f5d3c
GM
2172
2173 /* Let the timer's callback function poll for input
2174 if this becomes zero. */
2175 --poll_suppress_count;
284f4730
JB
2176 }
2177#endif
2178}
2179
1d3195db
RS
2180/* Nonzero if we are using polling to handle input asynchronously. */
2181
2182int
2183input_polling_used ()
2184{
2185#ifdef POLL_FOR_INPUT
428a555e
KL
2186 /* XXX This condition was (read_socket_hook && !interrupt_input),
2187 but read_socket_hook is not global anymore. Let's pretend that
2188 it's always set. */
2189 return !interrupt_input;
1d3195db
RS
2190#else
2191 return 0;
2192#endif
2193}
2194
284f4730
JB
2195/* Turn off polling. */
2196
07a59269 2197void
284f4730
JB
2198stop_polling ()
2199{
2200#ifdef POLL_FOR_INPUT
428a555e
KL
2201 /* XXX This condition was (read_socket_hook && !interrupt_input),
2202 but read_socket_hook is not global anymore. Let's pretend that
2203 it's always set. */
2204 if (!interrupt_input)
8a9f5d3c 2205 ++poll_suppress_count;
284f4730
JB
2206#endif
2207}
fe8aeef3
RS
2208
2209/* Set the value of poll_suppress_count to COUNT
2210 and start or stop polling accordingly. */
2211
2212void
2213set_poll_suppress_count (count)
2214 int count;
2215{
2216#ifdef POLL_FOR_INPUT
2217 if (count == 0 && poll_suppress_count != 0)
2218 {
2219 poll_suppress_count = 1;
2220 start_polling ();
2221 }
2222 else if (count != 0 && poll_suppress_count == 0)
2223 {
2224 stop_polling ();
2225 }
2226 poll_suppress_count = count;
2227#endif
2228}
f4eef8b4 2229
d0a57728
RS
2230/* Bind polling_period to a value at least N.
2231 But don't decrease it. */
2232
07a59269 2233void
f4eef8b4
RS
2234bind_polling_period (n)
2235 int n;
2236{
2237#ifdef POLL_FOR_INPUT
d0a57728
RS
2238 int new = polling_period;
2239
2240 if (n > new)
2241 new = n;
2242
6fe007f7 2243 stop_other_atimers (poll_timer);
f4eef8b4 2244 stop_polling ();
d0a57728
RS
2245 specbind (Qpolling_period, make_number (new));
2246 /* Start a new alarm with the new period. */
f4eef8b4
RS
2247 start_polling ();
2248#endif
2249}
284f4730 2250\f
6da3dd3a
RS
2251/* Apply the control modifier to CHARACTER. */
2252
faf5e407
JB
2253int
2254make_ctrl_char (c)
2255 int c;
2256{
d205953b
JB
2257 /* Save the upper bits here. */
2258 int upper = c & ~0177;
2259
2260 c &= 0177;
2261
2262 /* Everything in the columns containing the upper-case letters
2263 denotes a control character. */
2264 if (c >= 0100 && c < 0140)
2265 {
2266 int oc = c;
2267 c &= ~0140;
2268 /* Set the shift modifier for a control char
2269 made from a shifted letter. But only for letters! */
2270 if (oc >= 'A' && oc <= 'Z')
2271 c |= shift_modifier;
2272 }
2273
2274 /* The lower-case letters denote control characters too. */
2275 else if (c >= 'a' && c <= 'z')
2276 c &= ~0140;
2277
2278 /* Include the bits for control and shift
2279 only if the basic ASCII code can't indicate them. */
2280 else if (c >= ' ')
2281 c |= ctrl_modifier;
2282
2283 /* Replace the high bits. */
2284 c |= (upper & ~ctrl_modifier);
faf5e407
JB
2285
2286 return c;
2287}
2288
bb8c4865
RS
2289/* Display the help-echo property of the character after the mouse pointer.
2290 Either show it in the echo area, or call show-help-function to display
2291 it by other means (maybe in a tooltip).
d4e68eea 2292
bb8c4865
RS
2293 If HELP is nil, that means clear the previous help echo.
2294
2295 If HELP is a string, display that string. If HELP is a function,
2296 call it with OBJECT and POS as arguments; the function should
2297 return a help string or nil for none. For all other types of HELP,
2298 evaluate it to obtain a string.
8dfd92c9 2299
2190735a
GM
2300 WINDOW is the window in which the help was generated, if any.
2301 It is nil if not in a window.
2302
5b2ec2d0
GM
2303 If OBJECT is a buffer, POS is the position in the buffer where the
2304 `help-echo' text property was found.
2305
2306 If OBJECT is an overlay, that overlay has a `help-echo' property,
2307 and POS is the position in the overlay's buffer under the mouse.
2308
2309 If OBJECT is a string (an overlay string or a string displayed with
2310 the `display' property). POS is the position in that string under
2311 the mouse.
d4e68eea 2312
27fd22dc 2313 OK_TO_OVERWRITE_KEYSTROKE_ECHO non-zero means it's okay if the help
d4e68eea
GM
2314 echo overwrites a keystroke echo currently displayed in the echo
2315 area.
2316
8dfd92c9
GM
2317 Note: this function may only be called with HELP nil or a string
2318 from X code running asynchronously. */
d4e68eea 2319
31f84d03 2320void
2190735a
GM
2321show_help_echo (help, window, object, pos, ok_to_overwrite_keystroke_echo)
2322 Lisp_Object help, window, object, pos;
adc84f48 2323 int ok_to_overwrite_keystroke_echo;
31f84d03 2324{
8dfd92c9 2325 if (!NILP (help) && !STRINGP (help))
d4e68eea 2326 {
8dfd92c9
GM
2327 if (FUNCTIONP (help))
2328 {
2190735a 2329 Lisp_Object args[4];
8dfd92c9 2330 args[0] = help;
2190735a
GM
2331 args[1] = window;
2332 args[2] = object;
2333 args[3] = pos;
1db0076e 2334 help = safe_call (4, args);
8dfd92c9
GM
2335 }
2336 else
1db0076e 2337 help = safe_eval (help);
c60ee5e7 2338
8dfd92c9 2339 if (!STRINGP (help))
d4e68eea 2340 return;
31f84d03
SM
2341 }
2342
c22237f7
KS
2343#ifdef HAVE_MOUSE
2344 if (!noninteractive && STRINGP (help))
2345 help = call1 (Qmouse_fixup_help_message, help);
2346#endif
2347
8dfd92c9 2348 if (STRINGP (help) || NILP (help))
d4e68eea
GM
2349 {
2350 if (!NILP (Vshow_help_function))
8dfd92c9 2351 call1 (Vshow_help_function, help);
d4e68eea
GM
2352 else if (/* Don't overwrite minibuffer contents. */
2353 !MINI_WINDOW_P (XWINDOW (selected_window))
2354 /* Don't overwrite a keystroke echo. */
8dfd92c9
GM
2355 && (NILP (echo_message_buffer)
2356 || ok_to_overwrite_keystroke_echo)
d4e68eea
GM
2357 /* Don't overwrite a prompt. */
2358 && !cursor_in_echo_area)
2359 {
8dfd92c9 2360 if (STRINGP (help))
d4e68eea 2361 {
331379bf 2362 int count = SPECPDL_INDEX ();
f0c1cc56
GM
2363
2364 if (!help_echo_showing_p)
2365 Vpre_help_message = current_message ();
c60ee5e7 2366
d4e68eea 2367 specbind (Qmessage_truncate_lines, Qt);
d5db4077 2368 message3_nolog (help, SBYTES (help),
8dfd92c9 2369 STRING_MULTIBYTE (help));
d4e68eea
GM
2370 unbind_to (count, Qnil);
2371 }
f0c1cc56
GM
2372 else if (STRINGP (Vpre_help_message))
2373 {
2374 message3_nolog (Vpre_help_message,
d5db4077 2375 SBYTES (Vpre_help_message),
f0c1cc56
GM
2376 STRING_MULTIBYTE (Vpre_help_message));
2377 Vpre_help_message = Qnil;
2378 }
d4e68eea 2379 else
f0c1cc56 2380 message (0);
d4e68eea 2381 }
c60ee5e7 2382
5295a500 2383 help_echo_showing_p = STRINGP (help);
d4e68eea 2384 }
31f84d03
SM
2385}
2386
faf5e407
JB
2387
2388\f
284f4730
JB
2389/* Input of single characters from keyboard */
2390
2391Lisp_Object print_help ();
2392static Lisp_Object kbd_buffer_get_event ();
e4fe371d 2393static void record_char ();
284f4730 2394
c5fdd383
KH
2395#ifdef MULTI_KBOARD
2396static jmp_buf wrong_kboard_jmpbuf;
bded54dd 2397#endif
beecf6a1 2398
184c3d81
RS
2399#define STOP_POLLING \
2400do { if (! polling_stopped_here) stop_polling (); \
2401 polling_stopped_here = 1; } while (0)
2402
2403#define RESUME_POLLING \
2404do { if (polling_stopped_here) start_polling (); \
2405 polling_stopped_here = 0; } while (0)
2406
284f4730
JB
2407/* read a character from the keyboard; call the redisplay if needed */
2408/* commandflag 0 means do not do auto-saving, but do do redisplay.
2409 -1 means do not do redisplay, but do do autosaving.
2410 1 means do both. */
2411
7d6de002
RS
2412/* The arguments MAPS and NMAPS are for menu prompting.
2413 MAPS is an array of keymaps; NMAPS is the length of MAPS.
2414
2415 PREV_EVENT is the previous input event, or nil if we are reading
b638f328
RS
2416 the first event of a key sequence (or not reading a key sequence).
2417 If PREV_EVENT is t, that is a "magic" value that says
2418 not to run input methods, but in other respects to act as if
2419 not reading a key sequence.
7d6de002 2420
83d68044 2421 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
6569cc8d 2422 if we used a mouse menu to read the input, or zero otherwise. If
83d68044 2423 USED_MOUSE_MENU is null, we don't dereference it.
dcc408a0
RS
2424
2425 Value is t if we showed a menu and the user rejected it. */
7d6de002 2426
284f4730 2427Lisp_Object
7d6de002 2428read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
284f4730 2429 int commandflag;
7d6de002
RS
2430 int nmaps;
2431 Lisp_Object *maps;
2432 Lisp_Object prev_event;
2433 int *used_mouse_menu;
284f4730 2434{
8c907a56 2435 volatile Lisp_Object c;
284f4730 2436 int count;
410d4de9 2437 jmp_buf local_getcjmp;
284f4730 2438 jmp_buf save_jump;
8c907a56 2439 volatile int key_already_recorded = 0;
017c7cb6 2440 Lisp_Object tem, save;
8c907a56
GM
2441 volatile Lisp_Object previous_echo_area_message;
2442 volatile Lisp_Object also_record;
2443 volatile int reread;
d5eecefb 2444 struct gcpro gcpro1, gcpro2;
184c3d81 2445 int polling_stopped_here = 0;
7c3bc944 2446
e4fe371d 2447 also_record = Qnil;
284f4730 2448
22b94eeb 2449#if 0 /* This was commented out as part of fixing echo for C-u left. */
71918b75
RS
2450 before_command_key_count = this_command_key_count;
2451 before_command_echo_length = echo_length ();
22b94eeb 2452#endif
ef6661f7 2453 c = Qnil;
7ee32cda 2454 previous_echo_area_message = Qnil;
71918b75 2455
7ee32cda 2456 GCPRO2 (c, previous_echo_area_message);
7c3bc944 2457
7f07d5ca
RS
2458 retry:
2459
7d18f9ae
RS
2460 reread = 0;
2461 if (CONSP (Vunread_post_input_method_events))
284f4730 2462 {
7539e11f 2463 c = XCAR (Vunread_post_input_method_events);
7d18f9ae 2464 Vunread_post_input_method_events
7539e11f 2465 = XCDR (Vunread_post_input_method_events);
284f4730 2466
2479e91e
RS
2467 /* Undo what read_char_x_menu_prompt did when it unread
2468 additional keys returned by Fx_popup_menu. */
2469 if (CONSP (c)
7539e11f
KR
2470 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2471 && NILP (XCDR (c)))
2472 c = XCAR (c);
2479e91e 2473
7d18f9ae
RS
2474 reread = 1;
2475 goto reread_first;
284f4730
JB
2476 }
2477
86e5706b
RS
2478 if (unread_command_char != -1)
2479 {
18cd2eeb 2480 XSETINT (c, unread_command_char);
86e5706b
RS
2481 unread_command_char = -1;
2482
7d18f9ae
RS
2483 reread = 1;
2484 goto reread_first;
2485 }
2486
2487 if (CONSP (Vunread_command_events))
2488 {
7539e11f
KR
2489 c = XCAR (Vunread_command_events);
2490 Vunread_command_events = XCDR (Vunread_command_events);
7d18f9ae
RS
2491
2492 /* Undo what read_char_x_menu_prompt did when it unread
2493 additional keys returned by Fx_popup_menu. */
2494 if (CONSP (c)
f4e05d97
GM
2495 && EQ (XCDR (c), Qdisabled)
2496 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))))
7539e11f 2497 c = XCAR (c);
c60ee5e7 2498
d17e49a8
GM
2499 /* If the queued event is something that used the mouse,
2500 set used_mouse_menu accordingly. */
2501 if (used_mouse_menu
2502 && (EQ (c, Qtool_bar) || EQ (c, Qmenu_bar)))
2503 *used_mouse_menu = 1;
c60ee5e7 2504
7d18f9ae
RS
2505 reread = 1;
2506 goto reread_for_input_method;
2507 }
2508
2509 if (CONSP (Vunread_input_method_events))
2510 {
7539e11f
KR
2511 c = XCAR (Vunread_input_method_events);
2512 Vunread_input_method_events = XCDR (Vunread_input_method_events);
7d18f9ae
RS
2513
2514 /* Undo what read_char_x_menu_prompt did when it unread
2515 additional keys returned by Fx_popup_menu. */
2516 if (CONSP (c)
7539e11f
KR
2517 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2518 && NILP (XCDR (c)))
2519 c = XCAR (c);
7d18f9ae
RS
2520 reread = 1;
2521 goto reread_for_input_method;
86e5706b
RS
2522 }
2523
63020c46
RS
2524 this_command_key_count_reset = 0;
2525
ce0d2858 2526 if (!NILP (Vexecuting_kbd_macro))
284f4730 2527 {
fce33686
JB
2528 /* We set this to Qmacro; since that's not a frame, nobody will
2529 try to switch frames on us, and the selected window will
2530 remain unchanged.
2531
2532 Since this event came from a macro, it would be misleading to
eb8c3be9 2533 leave internal_last_event_frame set to wherever the last
3c370943
JB
2534 real event came from. Normally, a switch-frame event selects
2535 internal_last_event_frame after each command is read, but
2536 events read from a macro should never cause a new frame to be
2537 selected. */
4c52b668 2538 Vlast_event_frame = internal_last_event_frame = Qmacro;
fce33686 2539
663258f2
JB
2540 /* Exit the macro if we are at the end.
2541 Also, some things replace the macro with t
2542 to force an early exit. */
ce0d2858 2543 if (EQ (Vexecuting_kbd_macro, Qt)
649d952d 2544 || executing_kbd_macro_index >= XFASTINT (Flength (Vexecuting_kbd_macro)))
284f4730 2545 {
18cd2eeb 2546 XSETINT (c, -1);
184c3d81 2547 goto exit;
284f4730 2548 }
df0f2ba1 2549
649d952d 2550 c = Faref (Vexecuting_kbd_macro, make_number (executing_kbd_macro_index));
ce0d2858 2551 if (STRINGP (Vexecuting_kbd_macro)
d5161e8c 2552 && (XINT (c) & 0x80) && (XUINT (c) <= 0xff))
bb9e9bed 2553 XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
86e5706b 2554
649d952d 2555 executing_kbd_macro_index++;
284f4730
JB
2556
2557 goto from_macro;
2558 }
2559
cd21b839
JB
2560 if (!NILP (unread_switch_frame))
2561 {
2562 c = unread_switch_frame;
2563 unread_switch_frame = Qnil;
2564
2565 /* This event should make it into this_command_keys, and get echoed
7d18f9ae 2566 again, so we do not set `reread'. */
f4255cd1 2567 goto reread_first;
cd21b839
JB
2568 }
2569
adc1d5c8 2570 /* if redisplay was requested */
6e4e64a8
RS
2571 if (commandflag >= 0)
2572 {
adc1d5c8
RS
2573 /* If there is pending input, process any events which are not
2574 user-visible, such as X selection_request events. */
6e4e64a8
RS
2575 if (input_pending
2576 || detect_input_pending_run_timers (0))
adc1d5c8 2577 swallow_events (0); /* may clear input_pending */
6e4e64a8 2578
adc1d5c8
RS
2579 /* Redisplay if no pending input. */
2580 while (!input_pending)
2581 {
5295a500 2582 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
3007ebfb 2583 redisplay_preserve_echo_area (5);
5295a500
GM
2584 else
2585 redisplay ();
adc1d5c8
RS
2586
2587 if (!input_pending)
2588 /* Normal case: no input arrived during redisplay. */
2589 break;
2590
2591 /* Input arrived and pre-empted redisplay.
2592 Process any events which are not user-visible. */
2593 swallow_events (0);
2594 /* If that cleared input_pending, try again to redisplay. */
2595 }
6e4e64a8 2596 }
e9bf89a0 2597
59a84f8e 2598 /* Message turns off echoing unless more keystrokes turn it on again.
c60ee5e7 2599
59a84f8e
GM
2600 The code in 20.x for the condition was
2601
2602 1. echo_area_glyphs && *echo_area_glyphs
2603 2. && echo_area_glyphs != current_kboard->echobuf
2604 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2605
2606 (1) means there's a current message displayed
c60ee5e7 2607
59a84f8e
GM
2608 (2) means it's not the message from echoing from the current
2609 kboard.
c60ee5e7 2610
59a84f8e
GM
2611 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2612 is set to a non-null value. This is done in read_char and it is
2613 set to echo_area_glyphs after a call to echo_char. That means
2614 ok_to_echo_at_next_pause is either null or
2615 current_kboard->echobuf with the appropriate current_kboard at
2616 that time.
2617
2618 So, condition (3) means in clear text ok_to_echo_at_next_pause
2619 must be either null, or the current message isn't from echoing at
2620 all, or it's from echoing from a different kboard than the
2621 current one. */
c60ee5e7 2622
27fd22dc 2623 if (/* There currently is something in the echo area. */
985f9f66 2624 !NILP (echo_area_buffer[0])
59a84f8e
GM
2625 && (/* And it's either not from echoing. */
2626 !EQ (echo_area_buffer[0], echo_message_buffer)
2627 /* Or it's an echo from a different kboard. */
2628 || echo_kboard != current_kboard
2629 /* Or we explicitly allow overwriting whatever there is. */
2630 || ok_to_echo_at_next_pause == NULL))
7ee32cda 2631 cancel_echoing ();
410d4de9 2632 else
410d4de9 2633 echo_dash ();
c60ee5e7 2634
410d4de9
RS
2635 /* Try reading a character via menu prompting in the minibuf.
2636 Try this before the sit-for, because the sit-for
2637 would do the wrong thing if we are supposed to do
2638 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2639 after a mouse event so don't try a minibuf menu. */
2640 c = Qnil;
2641 if (nmaps > 0 && INTERACTIVE
2642 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2643 /* Don't bring up a menu if we already have another event. */
2644 && NILP (Vunread_command_events)
2645 && unread_command_char < 0
4ec4ed6a 2646 && !detect_input_pending_run_timers (0))
410d4de9
RS
2647 {
2648 c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
2649 if (! NILP (c))
2650 {
2651 key_already_recorded = 1;
2652 goto non_reread_1;
2653 }
2654 }
284f4730 2655
410d4de9
RS
2656 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2657 We will do that below, temporarily for short sections of code,
2658 when appropriate. local_getcjmp must be in effect
2659 around any call to sit_for or kbd_buffer_get_event;
2660 it *must not* be in effect when we call redisplay. */
284f4730 2661
410d4de9 2662 if (_setjmp (local_getcjmp))
284f4730 2663 {
dfbfad25
RS
2664 /* We must have saved the outer value of getcjmp here,
2665 so restore it now. */
2666 restore_getcjmp (save_jump);
18cd2eeb 2667 XSETINT (c, quit_char);
788f89eb 2668 internal_last_event_frame = selected_frame;
4c52b668 2669 Vlast_event_frame = internal_last_event_frame;
04904c29
RS
2670 /* If we report the quit char as an event,
2671 don't do so more than once. */
2672 if (!NILP (Vinhibit_quit))
2673 Vquit_flag = Qnil;
284f4730 2674
c5fdd383 2675#ifdef MULTI_KBOARD
df0f2ba1 2676 {
788f89eb 2677 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
c5fdd383 2678 if (kb != current_kboard)
df0f2ba1 2679 {
f3fbd155 2680 Lisp_Object link = kb->kbd_queue;
1e8bd3da
RS
2681 /* We shouldn't get here if we were in single-kboard mode! */
2682 if (single_kboard)
df0f2ba1 2683 abort ();
f3fbd155
KR
2684 if (CONSP (link))
2685 {
2686 while (CONSP (XCDR (link)))
2687 link = XCDR (link);
2688 if (!NILP (XCDR (link)))
2689 abort ();
2690 }
2691 if (!CONSP (link))
2692 kb->kbd_queue = Fcons (c, Qnil);
2693 else
2694 XSETCDR (link, Fcons (c, Qnil));
c5fdd383
KH
2695 kb->kbd_queue_has_data = 1;
2696 current_kboard = kb;
ef6661f7
RS
2697 /* This is going to exit from read_char
2698 so we had better get rid of this frame's stuff. */
2699 UNGCPRO;
c5fdd383 2700 longjmp (wrong_kboard_jmpbuf, 1);
df0f2ba1
KH
2701 }
2702 }
2703#endif
284f4730
JB
2704 goto non_reread;
2705 }
2706
d9d4c147
KH
2707 timer_start_idle ();
2708
284f4730
JB
2709 /* If in middle of key sequence and minibuffer not active,
2710 start echoing if enough time elapses. */
410d4de9 2711
c60ee5e7 2712 if (minibuf_level == 0
7ee32cda 2713 && !current_kboard->immediate_echo
6c6083a9 2714 && this_command_key_count > 0
27203ead 2715 && ! noninteractive
f2647d04
DL
2716 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2717 && NILP (Fzerop (Vecho_keystrokes))
985f9f66
GM
2718 && (/* No message. */
2719 NILP (echo_area_buffer[0])
2720 /* Or empty message. */
2721 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2722 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2723 /* Or already echoing from same kboard. */
2724 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2725 /* Or not echoing before and echoing allowed. */
2726 || (!echo_kboard && ok_to_echo_at_next_pause)))
284f4730
JB
2727 {
2728 Lisp_Object tem0;
c60ee5e7 2729
7d6de002
RS
2730 /* After a mouse event, start echoing right away.
2731 This is because we are probably about to display a menu,
2732 and we don't want to delay before doing so. */
dbc4e1c1 2733 if (EVENT_HAS_PARAMETERS (prev_event))
3dbd9ee4 2734 echo_now ();
7d6de002
RS
2735 else
2736 {
39aab679
DL
2737 int sec, usec;
2738 double duration = extract_float (Vecho_keystrokes);
2739 sec = (int) duration;
15fa88ab 2740 usec = (duration - sec) * 1000000;
410d4de9
RS
2741 save_getcjmp (save_jump);
2742 restore_getcjmp (local_getcjmp);
39aab679 2743 tem0 = sit_for (sec, usec, 1, 1, 0);
410d4de9 2744 restore_getcjmp (save_jump);
303b5b3f
RS
2745 if (EQ (tem0, Qt)
2746 && ! CONSP (Vunread_command_events))
3dbd9ee4 2747 echo_now ();
7d6de002 2748 }
284f4730
JB
2749 }
2750
410d4de9 2751 /* Maybe auto save due to number of keystrokes. */
284f4730
JB
2752
2753 if (commandflag != 0
2754 && auto_save_interval > 0
c43b1734 2755 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
4ec4ed6a 2756 && !detect_input_pending_run_timers (0))
284f4730 2757 {
284f4730 2758 Fdo_auto_save (Qnil, Qnil);
ef8fd672
RS
2759 /* Hooks can actually change some buffers in auto save. */
2760 redisplay ();
284f4730
JB
2761 }
2762
8150596a 2763 /* Try reading using an X menu.
24597608
RS
2764 This is never confused with reading using the minibuf
2765 because the recursive call of read_char in read_char_minibuf_menu_prompt
2766 does not pass on any keymaps. */
410d4de9 2767
24597608 2768 if (nmaps > 0 && INTERACTIVE
5a8d99e0
KH
2769 && !NILP (prev_event)
2770 && EVENT_HAS_PARAMETERS (prev_event)
7539e11f
KR
2771 && !EQ (XCAR (prev_event), Qmenu_bar)
2772 && !EQ (XCAR (prev_event), Qtool_bar)
24597608
RS
2773 /* Don't bring up a menu if we already have another event. */
2774 && NILP (Vunread_command_events)
b8556aee 2775 && unread_command_char < 0)
8eb4d8ef
RS
2776 {
2777 c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
2778
2779 /* Now that we have read an event, Emacs is not idle. */
2780 timer_stop_idle ();
2781
184c3d81 2782 goto exit;
8eb4d8ef 2783 }
7d6de002 2784
410d4de9
RS
2785 /* Maybe autosave and/or garbage collect due to idleness. */
2786
26c1639e 2787 if (INTERACTIVE && NILP (c))
7d6de002
RS
2788 {
2789 int delay_level, buffer_size;
2790
410d4de9
RS
2791 /* Slow down auto saves logarithmically in size of current buffer,
2792 and garbage collect while we're at it. */
7d6de002
RS
2793 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2794 last_non_minibuf_size = Z - BEG;
2795 buffer_size = (last_non_minibuf_size >> 8) + 1;
2796 delay_level = 0;
2797 while (buffer_size > 64)
2798 delay_level++, buffer_size -= buffer_size >> 2;
2799 if (delay_level < 4) delay_level = 4;
2800 /* delay_level is 4 for files under around 50k, 7 at 100k,
2801 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2802
2803 /* Auto save if enough time goes by without input. */
2804 if (commandflag != 0
c43b1734 2805 && num_nonmacro_input_events > last_auto_save
8c18cbfb 2806 && INTEGERP (Vauto_save_timeout)
7d6de002
RS
2807 && XINT (Vauto_save_timeout) > 0)
2808 {
2809 Lisp_Object tem0;
410d4de9
RS
2810
2811 save_getcjmp (save_jump);
2812 restore_getcjmp (local_getcjmp);
d9d4c147 2813 tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4,
41365083 2814 0, 1, 1, 0);
410d4de9
RS
2815 restore_getcjmp (save_jump);
2816
303b5b3f
RS
2817 if (EQ (tem0, Qt)
2818 && ! CONSP (Vunread_command_events))
7d6de002 2819 {
7d6de002 2820 Fdo_auto_save (Qnil, Qnil);
7d6de002
RS
2821
2822 /* If we have auto-saved and there is still no input
2823 available, garbage collect if there has been enough
2824 consing going on to make it worthwhile. */
4ec4ed6a 2825 if (!detect_input_pending_run_timers (0)
7d6de002 2826 && consing_since_gc > gc_cons_threshold / 2)
ef8fd672 2827 Fgarbage_collect ();
410d4de9 2828
ef8fd672 2829 redisplay ();
7d6de002
RS
2830 }
2831 }
2832 }
284f4730 2833
303b5b3f
RS
2834 /* If this has become non-nil here, it has been set by a timer
2835 or sentinel or filter. */
2836 if (CONSP (Vunread_command_events))
2837 {
7539e11f
KR
2838 c = XCAR (Vunread_command_events);
2839 Vunread_command_events = XCDR (Vunread_command_events);
303b5b3f
RS
2840 }
2841
410d4de9
RS
2842 /* Read something from current KBOARD's side queue, if possible. */
2843
beecf6a1 2844 if (NILP (c))
1e12dd87 2845 {
c5fdd383 2846 if (current_kboard->kbd_queue_has_data)
beecf6a1 2847 {
c5fdd383 2848 if (!CONSP (current_kboard->kbd_queue))
4524b161 2849 abort ();
7539e11f 2850 c = XCAR (current_kboard->kbd_queue);
c5fdd383 2851 current_kboard->kbd_queue
7539e11f 2852 = XCDR (current_kboard->kbd_queue);
c5fdd383
KH
2853 if (NILP (current_kboard->kbd_queue))
2854 current_kboard->kbd_queue_has_data = 0;
d9d4c147 2855 input_pending = readable_events (0);
4c52b668
KH
2856 if (EVENT_HAS_PARAMETERS (c)
2857 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
7539e11f 2858 internal_last_event_frame = XCAR (XCDR (c));
4c52b668 2859 Vlast_event_frame = internal_last_event_frame;
beecf6a1 2860 }
1e8bd3da
RS
2861 }
2862
c5fdd383 2863#ifdef MULTI_KBOARD
1e8bd3da
RS
2864 /* If current_kboard's side queue is empty check the other kboards.
2865 If one of them has data that we have not yet seen here,
2866 switch to it and process the data waiting for it.
2867
2868 Note: if the events queued up for another kboard
2869 have already been seen here, and therefore are not a complete command,
2870 the kbd_queue_has_data field is 0, so we skip that kboard here.
2871 That's to avoid an infinite loop switching between kboards here. */
2872 if (NILP (c) && !single_kboard)
2873 {
2874 KBOARD *kb;
2875 for (kb = all_kboards; kb; kb = kb->next_kboard)
2876 if (kb->kbd_queue_has_data)
2877 {
2878 current_kboard = kb;
ef6661f7
RS
2879 /* This is going to exit from read_char
2880 so we had better get rid of this frame's stuff. */
2881 UNGCPRO;
1e8bd3da
RS
2882 longjmp (wrong_kboard_jmpbuf, 1);
2883 }
2884 }
df0f2ba1
KH
2885#endif
2886
410d4de9
RS
2887 wrong_kboard:
2888
184c3d81 2889 STOP_POLLING;
410d4de9 2890
1e8bd3da
RS
2891 /* Finally, we read from the main queue,
2892 and if that gives us something we can't use yet, we put it on the
2893 appropriate side queue and try again. */
410d4de9 2894
1e8bd3da
RS
2895 if (NILP (c))
2896 {
2897 KBOARD *kb;
2898
1e8bd3da 2899 /* Actually read a character, waiting if necessary. */
410d4de9
RS
2900 save_getcjmp (save_jump);
2901 restore_getcjmp (local_getcjmp);
5b7bc0da 2902 timer_start_idle ();
83d68044 2903 c = kbd_buffer_get_event (&kb, used_mouse_menu);
410d4de9
RS
2904 restore_getcjmp (save_jump);
2905
c5fdd383 2906#ifdef MULTI_KBOARD
410d4de9 2907 if (! NILP (c) && (kb != current_kboard))
1e8bd3da 2908 {
f3fbd155
KR
2909 Lisp_Object link = kb->kbd_queue;
2910 if (CONSP (link))
2911 {
2912 while (CONSP (XCDR (link)))
2913 link = XCDR (link);
2914 if (!NILP (XCDR (link)))
2915 abort ();
2916 }
2917 if (!CONSP (link))
2918 kb->kbd_queue = Fcons (c, Qnil);
2919 else
2920 XSETCDR (link, Fcons (c, Qnil));
1e8bd3da 2921 kb->kbd_queue_has_data = 1;
46b84797 2922 c = Qnil;
1e8bd3da
RS
2923 if (single_kboard)
2924 goto wrong_kboard;
2925 current_kboard = kb;
ef6661f7
RS
2926 /* This is going to exit from read_char
2927 so we had better get rid of this frame's stuff. */
2928 UNGCPRO;
1e8bd3da 2929 longjmp (wrong_kboard_jmpbuf, 1);
df0f2ba1 2930 }
1e8bd3da 2931#endif
beecf6a1 2932 }
1e8bd3da 2933
284f4730 2934 /* Terminate Emacs in batch mode if at eof. */
8c18cbfb 2935 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
284f4730
JB
2936 Fkill_emacs (make_number (1));
2937
8c18cbfb 2938 if (INTEGERP (c))
80645119
JB
2939 {
2940 /* Add in any extra modifiers, where appropriate. */
2941 if ((extra_keyboard_modifiers & CHAR_CTL)
2942 || ((extra_keyboard_modifiers & 0177) < ' '
2943 && (extra_keyboard_modifiers & 0177) != 0))
faf5e407 2944 XSETINT (c, make_ctrl_char (XINT (c)));
80645119
JB
2945
2946 /* Transfer any other modifier bits directly from
2947 extra_keyboard_modifiers to c. Ignore the actual character code
2948 in the low 16 bits of extra_keyboard_modifiers. */
b8d9050d 2949 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
80645119 2950 }
9fa4395d 2951
284f4730
JB
2952 non_reread:
2953
2fb9049e 2954 timer_stop_idle ();
184c3d81 2955 RESUME_POLLING;
284f4730 2956
410d4de9
RS
2957 if (NILP (c))
2958 {
2959 if (commandflag >= 0
4ec4ed6a 2960 && !input_pending && !detect_input_pending_run_timers (0))
410d4de9
RS
2961 redisplay ();
2962
2963 goto wrong_kboard;
2964 }
2965
2966 non_reread_1:
2967
dfd11da7 2968 /* Buffer switch events are only for internal wakeups
7c3bc944
RS
2969 so don't show them to the user.
2970 Also, don't record a key if we already did. */
2971 if (BUFFERP (c) || key_already_recorded)
184c3d81 2972 goto exit;
a1341f75 2973
7f07d5ca
RS
2974 /* Process special events within read_char
2975 and loop around to read another event. */
017c7cb6
RS
2976 save = Vquit_flag;
2977 Vquit_flag = Qnil;
02067692 2978 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
017c7cb6 2979 Vquit_flag = save;
7f07d5ca
RS
2980
2981 if (!NILP (tem))
2982 {
ba8dfba8
RS
2983 int was_locked = single_kboard;
2984
7f07d5ca 2985 last_input_char = c;
158f7532 2986 Fcommand_execute (tem, Qnil, Fvector (1, &last_input_char), Qt);
ba8dfba8 2987
5d12f14d
EZ
2988 if (CONSP (c) && EQ (XCAR (c), Qselect_window))
2989 /* We stopped being idle for this event; undo that. This
2990 prevents automatic window selection (under
0b9a1d3d 2991 mouse_autoselect_window from acting as a real input event, for
5d12f14d 2992 example banishing the mouse under mouse-avoidance-mode. */
5c12e63f 2993 timer_resume_idle ();
5d12f14d 2994
ba8dfba8
RS
2995 /* Resume allowing input from any kboard, if that was true before. */
2996 if (!was_locked)
2997 any_kboard_state ();
2998
7f07d5ca
RS
2999 goto retry;
3000 }
3001
284f4730 3002 /* Handle things that only apply to characters. */
8c18cbfb 3003 if (INTEGERP (c))
284f4730
JB
3004 {
3005 /* If kbd_buffer_get_event gave us an EOF, return that. */
86e5706b 3006 if (XINT (c) == -1)
184c3d81 3007 goto exit;
284f4730 3008
2e478293
KL
3009 if ((STRINGP (current_kboard->Vkeyboard_translate_table)
3010 && SCHARS (current_kboard->Vkeyboard_translate_table) > (unsigned) XFASTINT (c))
3011 || (VECTORP (current_kboard->Vkeyboard_translate_table)
3012 && XVECTOR (current_kboard->Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
3013 || (CHAR_TABLE_P (current_kboard->Vkeyboard_translate_table)
5e3cb80d 3014 && CHAR_VALID_P (XINT (c), 0)))
f9414d62
RS
3015 {
3016 Lisp_Object d;
2e478293 3017 d = Faref (current_kboard->Vkeyboard_translate_table, c);
f9414d62
RS
3018 /* nil in keyboard-translate-table means no translation. */
3019 if (!NILP (d))
3020 c = d;
3021 }
284f4730
JB
3022 }
3023
e4fe371d
RS
3024 /* If this event is a mouse click in the menu bar,
3025 return just menu-bar for now. Modify the mouse click event
3026 so we won't do this twice, then queue it up. */
3027 if (EVENT_HAS_PARAMETERS (c)
7539e11f 3028 && CONSP (XCDR (c))
e4fe371d 3029 && CONSP (EVENT_START (c))
7539e11f 3030 && CONSP (XCDR (EVENT_START (c))))
284f4730 3031 {
e4fe371d 3032 Lisp_Object posn;
284f4730 3033
eee5863b 3034 posn = POSN_POSN (EVENT_START (c));
e4fe371d
RS
3035 /* Handle menu-bar events:
3036 insert the dummy prefix event `menu-bar'. */
9ea173e8 3037 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
e4fe371d
RS
3038 {
3039 /* Change menu-bar to (menu-bar) as the event "position". */
eee5863b 3040 POSN_SET_POSN (EVENT_START (c), Fcons (posn, Qnil));
284f4730 3041
e4fe371d
RS
3042 also_record = c;
3043 Vunread_command_events = Fcons (c, Vunread_command_events);
3044 c = posn;
284f4730 3045 }
284f4730
JB
3046 }
3047
7d18f9ae
RS
3048 /* Store these characters into recent_keys, the dribble file if any,
3049 and the keyboard macro being defined, if any. */
e4fe371d
RS
3050 record_char (c);
3051 if (! NILP (also_record))
3052 record_char (also_record);
51172b6d 3053
d5eecefb
RS
3054 /* Wipe the echo area.
3055 But first, if we are about to use an input method,
3056 save the echo area contents for it to refer to. */
3057 if (INTEGERP (c)
3058 && ! NILP (Vinput_method_function)
3059 && (unsigned) XINT (c) >= ' '
8d769115
KH
3060 && (unsigned) XINT (c) != 127
3061 && (unsigned) XINT (c) < 256)
7ee32cda
GM
3062 {
3063 previous_echo_area_message = Fcurrent_message ();
3064 Vinput_method_previous_message = previous_echo_area_message;
3065 }
d5eecefb 3066
1172eb8d
GM
3067 /* Now wipe the echo area, except for help events which do their
3068 own stuff with the echo area. */
4d2e9f95
GM
3069 if (!CONSP (c)
3070 || (!(EQ (Qhelp_echo, XCAR (c)))
3071 && !(EQ (Qswitch_frame, XCAR (c)))))
1172eb8d
GM
3072 {
3073 if (!NILP (echo_area_buffer[0]))
3074 safe_run_hooks (Qecho_area_clear_hook);
3075 clear_message (1, 0);
3076 }
d5eecefb 3077
7d18f9ae 3078 reread_for_input_method:
284f4730 3079 from_macro:
7d18f9ae 3080 /* Pass this to the input method, if appropriate. */
d5eecefb
RS
3081 if (INTEGERP (c)
3082 && ! NILP (Vinput_method_function)
b638f328
RS
3083 /* Don't run the input method within a key sequence,
3084 after the first event of the key sequence. */
3085 && NILP (prev_event)
d5eecefb 3086 && (unsigned) XINT (c) >= ' '
8d769115
KH
3087 && (unsigned) XINT (c) != 127
3088 && (unsigned) XINT (c) < 256)
d5eecefb 3089 {
c60ee5e7 3090 Lisp_Object keys;
63020c46 3091 int key_count, key_count_reset;
d5eecefb 3092 struct gcpro gcpro1;
aed13378 3093 int count = SPECPDL_INDEX ();
d5eecefb 3094
6e5742a0
RS
3095 /* Save the echo status. */
3096 int saved_immediate_echo = current_kboard->immediate_echo;
985f9f66 3097 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
dc29116a 3098 Lisp_Object saved_echo_string = current_kboard->echo_string;
6e5742a0
RS
3099 int saved_echo_after_prompt = current_kboard->echo_after_prompt;
3100
22b94eeb 3101#if 0
6e5742a0
RS
3102 if (before_command_restore_flag)
3103 {
3104 this_command_key_count = before_command_key_count_1;
3105 if (this_command_key_count < this_single_command_key_start)
3106 this_single_command_key_start = this_command_key_count;
3107 echo_truncate (before_command_echo_length_1);
3108 before_command_restore_flag = 0;
3109 }
22b94eeb 3110#endif
6e5742a0
RS
3111
3112 /* Save the this_command_keys status. */
3113 key_count = this_command_key_count;
63020c46 3114 key_count_reset = this_command_key_count_reset;
6e5742a0
RS
3115
3116 if (key_count > 0)
3117 keys = Fcopy_sequence (this_command_keys);
3118 else
3119 keys = Qnil;
d5eecefb 3120 GCPRO1 (keys);
6e5742a0
RS
3121
3122 /* Clear out this_command_keys. */
3123 this_command_key_count = 0;
63020c46 3124 this_command_key_count_reset = 0;
6e5742a0
RS
3125
3126 /* Now wipe the echo area. */
985f9f66 3127 if (!NILP (echo_area_buffer[0]))
6e5742a0 3128 safe_run_hooks (Qecho_area_clear_hook);
985f9f66 3129 clear_message (1, 0);
6e5742a0
RS
3130 echo_truncate (0);
3131
b638f328
RS
3132 /* If we are not reading a key sequence,
3133 never use the echo area. */
3134 if (maps == 0)
3135 {
b638f328
RS
3136 specbind (Qinput_method_use_echo_area, Qt);
3137 }
3138
6e5742a0 3139 /* Call the input method. */
d5eecefb 3140 tem = call1 (Vinput_method_function, c);
b638f328
RS
3141
3142 tem = unbind_to (count, tem);
3143
6e5742a0
RS
3144 /* Restore the saved echoing state
3145 and this_command_keys state. */
3146 this_command_key_count = key_count;
63020c46 3147 this_command_key_count_reset = key_count_reset;
6e5742a0
RS
3148 if (key_count > 0)
3149 this_command_keys = keys;
3150
3151 cancel_echoing ();
3152 ok_to_echo_at_next_pause = saved_ok_to_echo;
dc29116a 3153 current_kboard->echo_string = saved_echo_string;
6e5742a0
RS
3154 current_kboard->echo_after_prompt = saved_echo_after_prompt;
3155 if (saved_immediate_echo)
3156 echo_now ();
3157
d5eecefb 3158 UNGCPRO;
6e5742a0 3159
d5eecefb
RS
3160 /* The input method can return no events. */
3161 if (! CONSP (tem))
7d18f9ae 3162 {
d5eecefb 3163 /* Bring back the previous message, if any. */
7ee32cda
GM
3164 if (! NILP (previous_echo_area_message))
3165 message_with_string ("%s", previous_echo_area_message, 0);
d5eecefb 3166 goto retry;
7d18f9ae 3167 }
d5eecefb 3168 /* It returned one event or more. */
7539e11f 3169 c = XCAR (tem);
d5eecefb 3170 Vunread_post_input_method_events
7539e11f 3171 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
7d18f9ae 3172 }
7c3bc944 3173
7d18f9ae 3174 reread_first:
284f4730 3175
7ee32cda 3176 /* Display help if not echoing. */
1172eb8d 3177 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
7ee32cda 3178 {
2190735a 3179 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
d31053f9
RS
3180 Lisp_Object help, object, position, window, tem;
3181
3182 tem = Fcdr (XCDR (c));
3183 help = Fcar (tem);
3184 tem = Fcdr (tem);
3185 window = Fcar (tem);
3186 tem = Fcdr (tem);
3187 object = Fcar (tem);
3188 tem = Fcdr (tem);
3189 position = Fcar (tem);
3190
2190735a 3191 show_help_echo (help, window, object, position, 0);
fdbb67fe
GM
3192
3193 /* We stopped being idle for this event; undo that. */
5c12e63f 3194 timer_resume_idle ();
7ee32cda
GM
3195 goto retry;
3196 }
c60ee5e7 3197
63020c46
RS
3198 if (! reread || this_command_key_count == 0
3199 || this_command_key_count_reset)
e4fe371d 3200 {
7d18f9ae
RS
3201
3202 /* Don't echo mouse motion events. */
f2647d04
DL
3203 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
3204 && NILP (Fzerop (Vecho_keystrokes))
7d18f9ae
RS
3205 && ! (EVENT_HAS_PARAMETERS (c)
3206 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
3207 {
3208 echo_char (c);
3209 if (! NILP (also_record))
3210 echo_char (also_record);
3211 /* Once we reread a character, echoing can happen
3212 the next time we pause to read a new one. */
985f9f66 3213 ok_to_echo_at_next_pause = current_kboard;
7d18f9ae
RS
3214 }
3215
3216 /* Record this character as part of the current key. */
3217 add_command_key (c);
e4fe371d 3218 if (! NILP (also_record))
7d18f9ae 3219 add_command_key (also_record);
e4fe371d 3220 }
b8556aee 3221
284f4730 3222 last_input_char = c;
c43b1734 3223 num_input_events++;
284f4730
JB
3224
3225 /* Process the help character specially if enabled */
ecb7cb34 3226 if (!NILP (Vhelp_form) && help_char_p (c))
284f4730
JB
3227 {
3228 Lisp_Object tem0;
aed13378 3229 count = SPECPDL_INDEX ();
284f4730
JB
3230
3231 record_unwind_protect (Fset_window_configuration,
3232 Fcurrent_window_configuration (Qnil));
3233
3234 tem0 = Feval (Vhelp_form);
8c18cbfb 3235 if (STRINGP (tem0))
284f4730
JB
3236 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
3237
3238 cancel_echoing ();
3cb81011
KH
3239 do
3240 c = read_char (0, 0, 0, Qnil, 0);
8c18cbfb 3241 while (BUFFERP (c));
ff11dfa1 3242 /* Remove the help from the frame */
284f4730 3243 unbind_to (count, Qnil);
410d4de9 3244
284f4730
JB
3245 redisplay ();
3246 if (EQ (c, make_number (040)))
3247 {
3248 cancel_echoing ();
3cb81011
KH
3249 do
3250 c = read_char (0, 0, 0, Qnil, 0);
8c18cbfb 3251 while (BUFFERP (c));
284f4730
JB
3252 }
3253 }
3254
184c3d81
RS
3255 exit:
3256 RESUME_POLLING;
7c3bc944 3257 RETURN_UNGCPRO (c);
284f4730
JB
3258}
3259
8eb4d8ef
RS
3260/* Record a key that came from a mouse menu.
3261 Record it for echoing, for this-command-keys, and so on. */
3262
3263static void
3264record_menu_key (c)
3265 Lisp_Object c;
3266{
3267 /* Wipe the echo area. */
985f9f66 3268 clear_message (1, 0);
8eb4d8ef
RS
3269
3270 record_char (c);
3271
22b94eeb 3272#if 0
8eb4d8ef
RS
3273 before_command_key_count = this_command_key_count;
3274 before_command_echo_length = echo_length ();
22b94eeb 3275#endif
8eb4d8ef
RS
3276
3277 /* Don't echo mouse motion events. */
f2647d04
DL
3278 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
3279 && NILP (Fzerop (Vecho_keystrokes)))
8eb4d8ef
RS
3280 {
3281 echo_char (c);
3282
3283 /* Once we reread a character, echoing can happen
3284 the next time we pause to read a new one. */
3285 ok_to_echo_at_next_pause = 0;
3286 }
3287
3288 /* Record this character as part of the current key. */
3289 add_command_key (c);
3290
3291 /* Re-reading in the middle of a command */
3292 last_input_char = c;
c43b1734 3293 num_input_events++;
8eb4d8ef
RS
3294}
3295
ecb7cb34
KH
3296/* Return 1 if should recognize C as "the help character". */
3297
3298int
3299help_char_p (c)
3300 Lisp_Object c;
3301{
3302 Lisp_Object tail;
3303
3304 if (EQ (c, Vhelp_char))
3305 return 1;
7539e11f
KR
3306 for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
3307 if (EQ (c, XCAR (tail)))
ecb7cb34
KH
3308 return 1;
3309 return 0;
3310}
3311
e4fe371d
RS
3312/* Record the input event C in various ways. */
3313
3314static void
3315record_char (c)
3316 Lisp_Object c;
3317{
090c68b9 3318 int recorded = 0;
52be17cc 3319
090c68b9
KS
3320 if (CONSP (c) && (EQ (XCAR (c), Qhelp_echo) || EQ (XCAR (c), Qmouse_movement)))
3321 {
3322 /* To avoid filling recent_keys with help-echo and mouse-movement
3323 events, we filter out repeated help-echo events, only store the
3324 first and last in a series of mouse-movement events, and don't
3325 store repeated help-echo events which are only separated by
3326 mouse-movement events. */
3327
3328 Lisp_Object ev1, ev2, ev3;
3329 int ix1, ix2, ix3;
c60ee5e7 3330
090c68b9
KS
3331 if ((ix1 = recent_keys_index - 1) < 0)
3332 ix1 = NUM_RECENT_KEYS - 1;
3333 ev1 = AREF (recent_keys, ix1);
c60ee5e7 3334
090c68b9
KS
3335 if ((ix2 = ix1 - 1) < 0)
3336 ix2 = NUM_RECENT_KEYS - 1;
3337 ev2 = AREF (recent_keys, ix2);
c60ee5e7 3338
090c68b9
KS
3339 if ((ix3 = ix2 - 1) < 0)
3340 ix3 = NUM_RECENT_KEYS - 1;
3341 ev3 = AREF (recent_keys, ix3);
c60ee5e7 3342
090c68b9
KS
3343 if (EQ (XCAR (c), Qhelp_echo))
3344 {
3345 /* Don't record `help-echo' in recent_keys unless it shows some help
a978004d 3346 message, and a different help than the previously recorded
090c68b9
KS
3347 event. */
3348 Lisp_Object help, last_help;
3349
3350 help = Fcar_safe (Fcdr_safe (XCDR (c)));
3351 if (!STRINGP (help))
3352 recorded = 1;
3353 else if (CONSP (ev1) && EQ (XCAR (ev1), Qhelp_echo)
3354 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev1))), EQ (last_help, help)))
3355 recorded = 1;
3356 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3357 && CONSP (ev2) && EQ (XCAR (ev2), Qhelp_echo)
3358 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev2))), EQ (last_help, help)))
3359 recorded = -1;
3360 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3361 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3362 && CONSP (ev3) && EQ (XCAR (ev3), Qhelp_echo)
3363 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev3))), EQ (last_help, help)))
3364 recorded = -2;
3365 }
3366 else if (EQ (XCAR (c), Qmouse_movement))
52be17cc 3367 {
090c68b9
KS
3368 /* Only record one pair of `mouse-movement' on a window in recent_keys.
3369 So additional mouse movement events replace the last element. */
3370 Lisp_Object last_window, window;
3371
3372 window = Fcar_safe (Fcar_safe (XCDR (c)));
3373 if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3374 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev1))), EQ (last_window, window))
3375 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3376 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev2))), EQ (last_window, window)))
52be17cc 3377 {
090c68b9
KS
3378 ASET (recent_keys, ix1, c);
3379 recorded = 1;
52be17cc
GM
3380 }
3381 }
3382 }
3383 else
090c68b9
KS
3384 store_kbd_macro_char (c);
3385
3386 if (!recorded)
e8a50785
GM
3387 {
3388 total_keys++;
3389 ASET (recent_keys, recent_keys_index, c);
3390 if (++recent_keys_index >= NUM_RECENT_KEYS)
3391 recent_keys_index = 0;
3392 }
090c68b9
KS
3393 else if (recorded < 0)
3394 {
3395 /* We need to remove one or two events from recent_keys.
3396 To do this, we simply put nil at those events and move the
3397 recent_keys_index backwards over those events. Usually,
3398 users will never see those nil events, as they will be
3399 overwritten by the command keys entered to see recent_keys
3400 (e.g. C-h l). */
3401
3402 while (recorded++ < 0 && total_keys > 0)
3403 {
3404 if (total_keys < NUM_RECENT_KEYS)
3405 total_keys--;
3406 if (--recent_keys_index < 0)
3407 recent_keys_index = NUM_RECENT_KEYS - 1;
3408 ASET (recent_keys, recent_keys_index, Qnil);
3409 }
3410 }
3411
3412 num_nonmacro_input_events++;
c60ee5e7 3413
e4fe371d
RS
3414 /* Write c to the dribble file. If c is a lispy event, write
3415 the event's symbol to the dribble file, in <brackets>. Bleaugh.
3416 If you, dear reader, have a better idea, you've got the source. :-) */
3417 if (dribble)
3418 {
3419 if (INTEGERP (c))
3420 {
3421 if (XUINT (c) < 0x100)
3422 putc (XINT (c), dribble);
3423 else
6de34814 3424 fprintf (dribble, " 0x%x", (int) XUINT (c));
e4fe371d
RS
3425 }
3426 else
3427 {
3428 Lisp_Object dribblee;
3429
3430 /* If it's a structured event, take the event header. */
3431 dribblee = EVENT_HEAD (c);
3432
3433 if (SYMBOLP (dribblee))
3434 {
3435 putc ('<', dribble);
d5db4077
KR
3436 fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
3437 SBYTES (SYMBOL_NAME (dribblee)),
e4fe371d
RS
3438 dribble);
3439 putc ('>', dribble);
3440 }
3441 }
3442
3443 fflush (dribble);
3444 }
e4fe371d
RS
3445}
3446
284f4730
JB
3447Lisp_Object
3448print_help (object)
3449 Lisp_Object object;
3450{
622de3e9 3451 struct buffer *old = current_buffer;
284f4730 3452 Fprinc (object, Qnil);
622de3e9
KH
3453 set_buffer_internal (XBUFFER (Vstandard_output));
3454 call0 (intern ("help-mode"));
3455 set_buffer_internal (old);
284f4730
JB
3456 return Qnil;
3457}
3458
3459/* Copy out or in the info on where C-g should throw to.
3460 This is used when running Lisp code from within get_char,
3461 in case get_char is called recursively.
3462 See read_process_output. */
3463
dfcf069d 3464static void
284f4730
JB
3465save_getcjmp (temp)
3466 jmp_buf temp;
3467{
3468 bcopy (getcjmp, temp, sizeof getcjmp);
3469}
3470
dfcf069d 3471static void
284f4730
JB
3472restore_getcjmp (temp)
3473 jmp_buf temp;
3474{
3475 bcopy (temp, getcjmp, sizeof getcjmp);
3476}
284f4730 3477\f
2eb6bfbe
RM
3478#ifdef HAVE_MOUSE
3479
284f4730
JB
3480/* Restore mouse tracking enablement. See Ftrack_mouse for the only use
3481 of this function. */
a9d77f1f 3482
284f4730
JB
3483static Lisp_Object
3484tracking_off (old_value)
3485 Lisp_Object old_value;
3486{
71edead1
RS
3487 do_mouse_tracking = old_value;
3488 if (NILP (old_value))
284f4730 3489 {
284f4730
JB
3490 /* Redisplay may have been preempted because there was input
3491 available, and it assumes it will be called again after the
3492 input has been processed. If the only input available was
3493 the sort that we have just disabled, then we need to call
3494 redisplay. */
a2d5fca0 3495 if (!readable_events (READABLE_EVENTS_DO_TIMERS_NOW))
284f4730 3496 {
3007ebfb 3497 redisplay_preserve_echo_area (6);
a2d5fca0
JD
3498 get_input_pending (&input_pending,
3499 READABLE_EVENTS_DO_TIMERS_NOW);
284f4730
JB
3500 }
3501 }
30690496 3502 return Qnil;
284f4730
JB
3503}
3504
3505DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
4707d2d0
PJ
3506 doc: /* Evaluate BODY with mouse movement events enabled.
3507Within a `track-mouse' form, mouse motion generates input events that
3508you can read with `read-event'.
3509Normally, mouse motion is ignored.
3510usage: (track-mouse BODY ...) */)
3511 (args)
284f4730
JB
3512 Lisp_Object args;
3513{
aed13378 3514 int count = SPECPDL_INDEX ();
284f4730
JB
3515 Lisp_Object val;
3516
a9d77f1f 3517 record_unwind_protect (tracking_off, do_mouse_tracking);
284f4730 3518
f3253854 3519 do_mouse_tracking = Qt;
df0f2ba1 3520
284f4730
JB
3521 val = Fprogn (args);
3522 return unbind_to (count, val);
3523}
2eb6bfbe 3524
f3253854
KH
3525/* If mouse has moved on some frame, return one of those frames.
3526 Return 0 otherwise. */
3527
3528static FRAME_PTR
3529some_mouse_moved ()
3530{
3531 Lisp_Object tail, frame;
3532
3533 FOR_EACH_FRAME (tail, frame)
3534 {
3535 if (XFRAME (frame)->mouse_moved)
3536 return XFRAME (frame);
3537 }
3538
3539 return 0;
3540}
3541
2eb6bfbe 3542#endif /* HAVE_MOUSE */
a612e298
RS
3543\f
3544/* Low level keyboard/mouse input.
3545 kbd_buffer_store_event places events in kbd_buffer, and
0646c0dd 3546 kbd_buffer_get_event retrieves them. */
a612e298
RS
3547
3548/* Return true iff there are any events in the queue that read-char
3549 would return. If this returns false, a read-char would block. */
3550static int
a2d5fca0
JD
3551readable_events (flags)
3552 int flags;
a612e298 3553{
a2d5fca0
JD
3554 if (flags & READABLE_EVENTS_DO_TIMERS_NOW)
3555 timer_check (1);
4ec4ed6a 3556
a2d5fca0
JD
3557 /* If the buffer contains only FOCUS_IN_EVENT events, and
3558 READABLE_EVENTS_FILTER_EVENTS is set, report it as empty. */
beecf6a1 3559 if (kbd_fetch_ptr != kbd_store_ptr)
a0ba8995 3560 {
354344a2
YM
3561 if (flags & (READABLE_EVENTS_FILTER_EVENTS
3562#ifdef USE_TOOLKIT_SCROLL_BARS
3563 | READABLE_EVENTS_IGNORE_SQUEEZABLES
3564#endif
3565 ))
20057d52
JD
3566 {
3567 struct input_event *event;
3568
3569 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3570 ? kbd_fetch_ptr
3571 : kbd_buffer);
3572
354344a2
YM
3573 do
3574 {
3575 if (!(
3576#ifdef USE_TOOLKIT_SCROLL_BARS
3577 (flags & READABLE_EVENTS_FILTER_EVENTS) &&
3578#endif
3579 event->kind == FOCUS_IN_EVENT)
3580#ifdef USE_TOOLKIT_SCROLL_BARS
3581 && !((flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3582 && event->kind == SCROLL_BAR_CLICK_EVENT
3583 && event->part == scroll_bar_handle
3584 && event->modifiers == 0)
3585#endif
3586 )
3587 return 1;
3588 event++;
20057d52
JD
3589 if (event == kbd_buffer + KBD_BUFFER_SIZE)
3590 event = kbd_buffer;
354344a2
YM
3591 }
3592 while (event != kbd_store_ptr);
20057d52 3593 }
354344a2
YM
3594 else
3595 return 1;
a0ba8995
RS
3596 }
3597
beecf6a1 3598#ifdef HAVE_MOUSE
a2d5fca0
JD
3599 if (!(flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3600 && !NILP (do_mouse_tracking) && some_mouse_moved ())
beecf6a1
KH
3601 return 1;
3602#endif
1e8bd3da 3603 if (single_kboard)
4c52b668 3604 {
c5fdd383 3605 if (current_kboard->kbd_queue_has_data)
4c52b668
KH
3606 return 1;
3607 }
3608 else
3609 {
c5fdd383
KH
3610 KBOARD *kb;
3611 for (kb = all_kboards; kb; kb = kb->next_kboard)
3612 if (kb->kbd_queue_has_data)
4c52b668
KH
3613 return 1;
3614 }
beecf6a1 3615 return 0;
a612e298
RS
3616}
3617
3618/* Set this for debugging, to have a way to get out */
3619int stop_character;
284f4730 3620
c5fdd383
KH
3621#ifdef MULTI_KBOARD
3622static KBOARD *
3623event_to_kboard (event)
5798cf15
KH
3624 struct input_event *event;
3625{
3626 Lisp_Object frame;
3627 frame = event->frame_or_window;
3628 if (CONSP (frame))
7539e11f 3629 frame = XCAR (frame);
5798cf15
KH
3630 else if (WINDOWP (frame))
3631 frame = WINDOW_FRAME (XWINDOW (frame));
3632
3633 /* There are still some events that don't set this field.
f5b56972
KH
3634 For now, just ignore the problem.
3635 Also ignore dead frames here. */
3636 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
5798cf15
KH
3637 return 0;
3638 else
c5fdd383 3639 return FRAME_KBOARD (XFRAME (frame));
5798cf15
KH
3640}
3641#endif
3642
2a84c6da
KS
3643
3644Lisp_Object Vthrow_on_input;
3645
284f4730
JB
3646/* Store an event obtained at interrupt level into kbd_buffer, fifo */
3647
3648void
3649kbd_buffer_store_event (event)
3650 register struct input_event *event;
0fc0bac9
KS
3651{
3652 kbd_buffer_store_event_hold (event, 0);
3653}
3654
3655/* Store EVENT obtained at interrupt level into kbd_buffer, fifo.
3656
3657 If HOLD_QUIT is 0, just stuff EVENT into the fifo.
3658 Else, if HOLD_QUIT.kind != NO_EVENT, discard EVENT.
3659 Else, if EVENT is a quit event, store the quit event
3660 in HOLD_QUIT, and return (thus ignoring further events).
3661
3662 This is used in read_avail_input to postpone the processing
3663 of the quit event until all subsequent input events have been
3664 parsed (and discarded).
3665 */
3666
3667void
3668kbd_buffer_store_event_hold (event, hold_quit)
3669 register struct input_event *event;
3670 struct input_event *hold_quit;
284f4730 3671{
3b8f9651 3672 if (event->kind == NO_EVENT)
284f4730
JB
3673 abort ();
3674
0fc0bac9
KS
3675 if (hold_quit && hold_quit->kind != NO_EVENT)
3676 return;
3677
3b8f9651 3678 if (event->kind == ASCII_KEYSTROKE_EVENT)
284f4730 3679 {
e9bf89a0 3680 register int c = event->code & 0377;
284f4730 3681
faf5e407
JB
3682 if (event->modifiers & ctrl_modifier)
3683 c = make_ctrl_char (c);
3684
9fd7d808
RS
3685 c |= (event->modifiers
3686 & (meta_modifier | alt_modifier
3687 | hyper_modifier | super_modifier));
3688
86e5706b 3689 if (c == quit_char)
284f4730 3690 {
c5fdd383
KH
3691#ifdef MULTI_KBOARD
3692 KBOARD *kb;
5798cf15
KH
3693 struct input_event *sp;
3694
1e8bd3da 3695 if (single_kboard
c5fdd383
KH
3696 && (kb = FRAME_KBOARD (XFRAME (event->frame_or_window)),
3697 kb != current_kboard))
5798cf15 3698 {
c5fdd383 3699 kb->kbd_queue
5798cf15
KH
3700 = Fcons (make_lispy_switch_frame (event->frame_or_window),
3701 Fcons (make_number (c), Qnil));
c5fdd383 3702 kb->kbd_queue_has_data = 1;
5798cf15
KH
3703 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3704 {
3705 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3706 sp = kbd_buffer;
3707
c5fdd383 3708 if (event_to_kboard (sp) == kb)
5798cf15 3709 {
3b8f9651 3710 sp->kind = NO_EVENT;
5798cf15 3711 sp->frame_or_window = Qnil;
da8f7368 3712 sp->arg = Qnil;
5798cf15
KH
3713 }
3714 }
3715 return;
3716 }
3717#endif
3e51c7b7 3718
0fc0bac9
KS
3719 if (hold_quit)
3720 {
3721 bcopy (event, (char *) hold_quit, sizeof (*event));
3722 return;
3723 }
3724
284f4730 3725 /* If this results in a quit_char being returned to Emacs as
3c370943 3726 input, set Vlast_event_frame properly. If this doesn't
284f4730 3727 get returned to Emacs as an event, the next event read
ff11dfa1 3728 will set Vlast_event_frame again, so this is safe to do. */
4bb994d1 3729 {
9b8eb840 3730 Lisp_Object focus;
4bb994d1 3731
9b8eb840 3732 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
4bb994d1 3733 if (NILP (focus))
beecf6a1 3734 focus = event->frame_or_window;
4c52b668
KH
3735 internal_last_event_frame = focus;
3736 Vlast_event_frame = focus;
4bb994d1 3737 }
3e51c7b7 3738
ffd56f97 3739 last_event_timestamp = event->timestamp;
114a8b8c 3740 handle_interrupt ();
284f4730
JB
3741 return;
3742 }
3743
3744 if (c && c == stop_character)
3745 {
3746 sys_suspend ();
3747 return;
3748 }
284f4730 3749 }
3b8f9651 3750 /* Don't insert two BUFFER_SWITCH_EVENT's in a row.
3fe8e9a2 3751 Just ignore the second one. */
3b8f9651 3752 else if (event->kind == BUFFER_SWITCH_EVENT
3fe8e9a2 3753 && kbd_fetch_ptr != kbd_store_ptr
0fc0bac9
KS
3754 && ((kbd_store_ptr == kbd_buffer
3755 ? kbd_buffer + KBD_BUFFER_SIZE - 1
3756 : kbd_store_ptr - 1)->kind) == BUFFER_SWITCH_EVENT)
3fe8e9a2 3757 return;
284f4730 3758
beecf6a1
KH
3759 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
3760 kbd_store_ptr = kbd_buffer;
284f4730
JB
3761
3762 /* Don't let the very last slot in the buffer become full,
3763 since that would make the two pointers equal,
3764 and that is indistinguishable from an empty buffer.
3765 Discard the event if it would fill the last slot. */
beecf6a1 3766 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
284f4730 3767 {
e3f6e7c7
KS
3768 *kbd_store_ptr = *event;
3769 ++kbd_store_ptr;
3770 }
2a84c6da 3771
85e7f477
RS
3772 /* If we're inside while-no-input, and this event qualifies
3773 as input, set quit-flag to cause an interrupt. */
2a84c6da
KS
3774 if (!NILP (Vthrow_on_input)
3775 && event->kind != FOCUS_IN_EVENT
3776 && event->kind != HELP_EVENT
3777 && event->kind != DEICONIFY_EVENT)
85e7f477
RS
3778 {
3779 Vquit_flag = Vthrow_on_input;
3780 /* If we're inside a function that wants immediate quits,
3781 do it now. */
3782 if (immediate_quit && NILP (Vinhibit_quit))
3783 {
3784 immediate_quit = 0;
3785 sigfree ();
3786 QUIT;
3787 }
3788 }
e3f6e7c7 3789}
c60ee5e7 3790
da8f7368 3791
e3f6e7c7 3792/* Put an input event back in the head of the event queue. */
284f4730 3793
e3f6e7c7
KS
3794void
3795kbd_buffer_unget_event (event)
3796 register struct input_event *event;
3797{
3798 if (kbd_fetch_ptr == kbd_buffer)
3799 kbd_fetch_ptr = kbd_buffer + KBD_BUFFER_SIZE;
3800
3801 /* Don't let the very last slot in the buffer become full, */
3802 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3803 {
3804 --kbd_fetch_ptr;
3805 *kbd_fetch_ptr = *event;
284f4730
JB
3806 }
3807}
8dfd92c9
GM
3808
3809
f139e559 3810/* Generate HELP_EVENT input_events in BUFP which has room for
0bbfdc25
GM
3811 SIZE events. If there's not enough room in BUFP, ignore this
3812 event.
8dfd92c9
GM
3813
3814 HELP is the help form.
3815
3816 FRAME is the frame on which the help is generated. OBJECT is the
5b2ec2d0
GM
3817 Lisp object where the help was found (a buffer, a string, an
3818 overlay, or nil if neither from a string nor from a buffer. POS is
3819 the position within OBJECT where the help was found.
8dfd92c9
GM
3820
3821 Value is the number of input_events generated. */
3822
0fc0bac9
KS
3823void
3824gen_help_event (help, frame, window, object, pos)
2190735a 3825 Lisp_Object help, frame, object, window;
8dfd92c9
GM
3826 int pos;
3827{
0fc0bac9
KS
3828 struct input_event event;
3829
3830 EVENT_INIT (event);
3831
3832 event.kind = HELP_EVENT;
3833 event.frame_or_window = frame;
3834 event.arg = object;
3835 event.x = WINDOWP (window) ? window : frame;
3836 event.y = help;
3837 event.code = pos;
3838 kbd_buffer_store_event (&event);
8dfd92c9
GM
3839}
3840
3841
3842/* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3843
3844void
3845kbd_buffer_store_help_event (frame, help)
3846 Lisp_Object frame, help;
3847{
3848 struct input_event event;
3849
3850 event.kind = HELP_EVENT;
3851 event.frame_or_window = frame;
3852 event.arg = Qnil;
2e1a49ad
SM
3853 event.x = Qnil;
3854 event.y = help;
8dfd92c9
GM
3855 event.code = 0;
3856 kbd_buffer_store_event (&event);
8dfd92c9
GM
3857}
3858
a612e298 3859\f
07de30b9 3860/* Discard any mouse events in the event buffer by setting them to
3b8f9651 3861 NO_EVENT. */
07de30b9
GV
3862void
3863discard_mouse_events ()
3864{
3865 struct input_event *sp;
3866 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3867 {
3868 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3869 sp = kbd_buffer;
3870
3b8f9651 3871 if (sp->kind == MOUSE_CLICK_EVENT
8006e4bb 3872 || sp->kind == WHEEL_EVENT
07de30b9 3873#ifdef WINDOWSNT
3b8f9651 3874 || sp->kind == W32_SCROLL_BAR_CLICK_EVENT
07de30b9 3875#endif
3b8f9651 3876 || sp->kind == SCROLL_BAR_CLICK_EVENT)
07de30b9 3877 {
3b8f9651 3878 sp->kind = NO_EVENT;
07de30b9
GV
3879 }
3880 }
3881}
eeabfe76 3882
0bbfdc25
GM
3883
3884/* Return non-zero if there are any real events waiting in the event
3b8f9651 3885 buffer, not counting `NO_EVENT's.
0bbfdc25 3886
3b8f9651 3887 If DISCARD is non-zero, discard NO_EVENT events at the front of
0bbfdc25
GM
3888 the input queue, possibly leaving the input queue empty if there
3889 are no real input events. */
3890
eeabfe76
EZ
3891int
3892kbd_buffer_events_waiting (discard)
3893 int discard;
3894{
3895 struct input_event *sp;
c60ee5e7 3896
0bbfdc25 3897 for (sp = kbd_fetch_ptr;
3b8f9651 3898 sp != kbd_store_ptr && sp->kind == NO_EVENT;
0bbfdc25 3899 ++sp)
eeabfe76
EZ
3900 {
3901 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3902 sp = kbd_buffer;
eeabfe76 3903 }
0bbfdc25 3904
eeabfe76
EZ
3905 if (discard)
3906 kbd_fetch_ptr = sp;
0bbfdc25 3907
3b8f9651 3908 return sp != kbd_store_ptr && sp->kind != NO_EVENT;
eeabfe76 3909}
0bbfdc25 3910
07de30b9 3911\f
0bbfdc25
GM
3912/* Clear input event EVENT. */
3913
3914static INLINE void
3915clear_event (event)
3916 struct input_event *event;
3917{
3b8f9651 3918 event->kind = NO_EVENT;
0bbfdc25
GM
3919}
3920
3921
a612e298
RS
3922/* Read one event from the event buffer, waiting if necessary.
3923 The value is a Lisp object representing the event.
3924 The value is nil for an event that should be ignored,
3925 or that was handled here.
3926 We always read and discard one event. */
284f4730
JB
3927
3928static Lisp_Object
83d68044 3929kbd_buffer_get_event (kbp, used_mouse_menu)
410d4de9 3930 KBOARD **kbp;
83d68044 3931 int *used_mouse_menu;
284f4730
JB
3932{
3933 register int c;
3934 Lisp_Object obj;
3935
3936 if (noninteractive)
3937 {
3938 c = getchar ();
18cd2eeb 3939 XSETINT (obj, c);
f5b56972 3940 *kbp = current_kboard;
284f4730
JB
3941 return obj;
3942 }
3943
3944 /* Wait until there is input available. */
3945 for (;;)
3946 {
beecf6a1
KH
3947 if (kbd_fetch_ptr != kbd_store_ptr)
3948 break;
3949#ifdef HAVE_MOUSE
f3253854 3950 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
284f4730 3951 break;
beecf6a1 3952#endif
284f4730
JB
3953
3954 /* If the quit flag is set, then read_char will return
3955 quit_char, so that counts as "available input." */
3956 if (!NILP (Vquit_flag))
3957 quit_throw_to_read_char ();
3958
3959 /* One way or another, wait until input is available; then, if
3960 interrupt handlers have not read it, read it now. */
3961
3962#ifdef OLDVMS
3963 wait_for_kbd_input ();
3964#else
3965/* Note SIGIO has been undef'd if FIONREAD is missing. */
3966#ifdef SIGIO
3967 gobble_input (0);
3968#endif /* SIGIO */
beecf6a1
KH
3969 if (kbd_fetch_ptr != kbd_store_ptr)
3970 break;
3971#ifdef HAVE_MOUSE
f3253854 3972 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
beecf6a1
KH
3973 break;
3974#endif
3975 {
d64b707c 3976 wait_reading_process_output (0, 0, -1, 1, Qnil, NULL, 0);
284f4730 3977
beecf6a1
KH
3978 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
3979 /* Pass 1 for EXPECT since we just waited to have input. */
3980 read_avail_input (1);
3981 }
284f4730
JB
3982#endif /* not VMS */
3983 }
3984
303b5b3f
RS
3985 if (CONSP (Vunread_command_events))
3986 {
3987 Lisp_Object first;
7539e11f
KR
3988 first = XCAR (Vunread_command_events);
3989 Vunread_command_events = XCDR (Vunread_command_events);
303b5b3f
RS
3990 *kbp = current_kboard;
3991 return first;
3992 }
3993
284f4730
JB
3994 /* At this point, we know that there is a readable event available
3995 somewhere. If the event queue is empty, then there must be a
3996 mouse movement enabled and available. */
beecf6a1 3997 if (kbd_fetch_ptr != kbd_store_ptr)
284f4730 3998 {
cd21b839 3999 struct input_event *event;
3e51c7b7 4000
beecf6a1
KH
4001 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
4002 ? kbd_fetch_ptr
4003 : kbd_buffer);
3e51c7b7 4004
cd21b839 4005 last_event_timestamp = event->timestamp;
cd21b839 4006
c5fdd383
KH
4007#ifdef MULTI_KBOARD
4008 *kbp = event_to_kboard (event);
4009 if (*kbp == 0)
4010 *kbp = current_kboard; /* Better than returning null ptr? */
5798cf15 4011#else
c5fdd383 4012 *kbp = &the_only_kboard;
5798cf15 4013#endif
beecf6a1 4014
4bb994d1
JB
4015 obj = Qnil;
4016
48e416d4 4017 /* These two kinds of events get special handling
a612e298
RS
4018 and don't actually appear to the command loop.
4019 We return nil for them. */
e3f6e7c7
KS
4020 if (event->kind == SELECTION_REQUEST_EVENT
4021 || event->kind == SELECTION_CLEAR_EVENT)
48e416d4 4022 {
598a9fa7 4023#ifdef HAVE_X11
1e8bd3da
RS
4024 struct input_event copy;
4025
4581e928
RS
4026 /* Remove it from the buffer before processing it,
4027 since otherwise swallow_events will see it
4028 and process it again. */
1e8bd3da 4029 copy = *event;
beecf6a1 4030 kbd_fetch_ptr = event + 1;
d9d4c147 4031 input_pending = readable_events (0);
e3f6e7c7 4032 x_handle_selection_event (&copy);
598a9fa7
JB
4033#else
4034 /* We're getting selection request events, but we don't have
4035 a window system. */
4036 abort ();
4037#endif
48e416d4
RS
4038 }
4039
e0f712ba 4040#if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (MAC_OS)
3b8f9651 4041 else if (event->kind == DELETE_WINDOW_EVENT)
990acea3 4042 {
bbdc2092
RS
4043 /* Make an event (delete-frame (FRAME)). */
4044 obj = Fcons (event->frame_or_window, Qnil);
af17bd2b 4045 obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
beecf6a1 4046 kbd_fetch_ptr = event + 1;
af17bd2b 4047 }
1a578e9b 4048#endif
fca32d15 4049#if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (MAC_OS)
3b8f9651 4050 else if (event->kind == ICONIFY_EVENT)
af17bd2b
KH
4051 {
4052 /* Make an event (iconify-frame (FRAME)). */
4053 obj = Fcons (event->frame_or_window, Qnil);
4054 obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
beecf6a1 4055 kbd_fetch_ptr = event + 1;
af17bd2b 4056 }
3b8f9651 4057 else if (event->kind == DEICONIFY_EVENT)
af17bd2b
KH
4058 {
4059 /* Make an event (make-frame-visible (FRAME)). */
4060 obj = Fcons (event->frame_or_window, Qnil);
4061 obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
beecf6a1 4062 kbd_fetch_ptr = event + 1;
990acea3
RS
4063 }
4064#endif
3b8f9651 4065 else if (event->kind == BUFFER_SWITCH_EVENT)
a8015ab5
KH
4066 {
4067 /* The value doesn't matter here; only the type is tested. */
18cd2eeb 4068 XSETBUFFER (obj, current_buffer);
beecf6a1 4069 kbd_fetch_ptr = event + 1;
a8015ab5 4070 }
488dd4c4
JD
4071#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
4072 || defined (USE_GTK)
3b8f9651 4073 else if (event->kind == MENU_BAR_ACTIVATE_EVENT)
099787c1
RS
4074 {
4075 kbd_fetch_ptr = event + 1;
d9d4c147 4076 input_pending = readable_events (0);
e649d076
RS
4077 if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
4078 x_activate_menubar (XFRAME (event->frame_or_window));
099787c1 4079 }
1161d367 4080#endif
c16dab62 4081#if defined (WINDOWSNT) || defined (MAC_OS)
3b8f9651 4082 else if (event->kind == LANGUAGE_CHANGE_EVENT)
1161d367 4083 {
c16dab62
YM
4084#ifdef MAC_OS
4085 /* Make an event (language-change (KEY_SCRIPT)). */
4086 obj = Fcons (make_number (event->code), Qnil);
4087#else
1161d367 4088 /* Make an event (language-change (FRAME CHARSET LCID)). */
d352abdf 4089 obj = Fcons (event->frame_or_window, Qnil);
c16dab62 4090#endif
1161d367
GV
4091 obj = Fcons (Qlanguage_change, Fcons (obj, Qnil));
4092 kbd_fetch_ptr = event + 1;
4093 }
099787c1 4094#endif
3b8f9651 4095 else if (event->kind == SAVE_SESSION_EVENT)
4ebc27a5
JD
4096 {
4097 obj = Fcons (Qsave_session, Qnil);
4098 kbd_fetch_ptr = event + 1;
4099 }
a612e298 4100 /* Just discard these, by returning nil.
c5fdd383 4101 With MULTI_KBOARD, these events are used as placeholders
5798cf15
KH
4102 when we need to randomly delete events from the queue.
4103 (They shouldn't otherwise be found in the buffer,
4104 but on some machines it appears they do show up
c5fdd383 4105 even without MULTI_KBOARD.) */
3b8f9651 4106 /* On Windows NT/9X, NO_EVENT is used to delete extraneous
07de30b9 4107 mouse events during a popup-menu call. */
3b8f9651 4108 else if (event->kind == NO_EVENT)
beecf6a1 4109 kbd_fetch_ptr = event + 1;
7ee32cda
GM
4110 else if (event->kind == HELP_EVENT)
4111 {
2190735a 4112 Lisp_Object object, position, help, frame, window;
e4457b09 4113
8dfd92c9
GM
4114 frame = event->frame_or_window;
4115 object = event->arg;
2e1a49ad
SM
4116 position = make_number (event->code);
4117 window = event->x;
4118 help = event->y;
0bbfdc25 4119 clear_event (event);
e4457b09
GM
4120
4121 kbd_fetch_ptr = event + 1;
2190735a
GM
4122 if (!WINDOWP (window))
4123 window = Qnil;
4124 obj = Fcons (Qhelp_echo,
4125 list5 (frame, help, window, object, position));
7ee32cda 4126 }
c51c7093
GM
4127 else if (event->kind == FOCUS_IN_EVENT)
4128 {
4129 /* Notification of a FocusIn event. The frame receiving the
4130 focus is in event->frame_or_window. Generate a
4131 switch-frame event if necessary. */
4132 Lisp_Object frame, focus;
4133
4134 frame = event->frame_or_window;
4135 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4136 if (FRAMEP (focus))
4137 frame = focus;
4138
4139 if (!EQ (frame, internal_last_event_frame)
4140 && !EQ (frame, selected_frame))
4141 obj = make_lispy_switch_frame (frame);
4142 internal_last_event_frame = frame;
4143 kbd_fetch_ptr = event + 1;
4144 }
1e12dd87
RS
4145 else
4146 {
c51c7093
GM
4147 /* If this event is on a different frame, return a switch-frame this
4148 time, and leave the event in the queue for next time. */
9b8eb840 4149 Lisp_Object frame;
1e12dd87 4150 Lisp_Object focus;
7b4aedb9 4151
9b8eb840 4152 frame = event->frame_or_window;
2470a66f 4153 if (CONSP (frame))
7539e11f 4154 frame = XCAR (frame);
2470a66f 4155 else if (WINDOWP (frame))
1e12dd87 4156 frame = WINDOW_FRAME (XWINDOW (frame));
4bb994d1 4157
1e12dd87
RS
4158 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4159 if (! NILP (focus))
4160 frame = focus;
07d2b8de 4161
4c52b668 4162 if (! EQ (frame, internal_last_event_frame)
788f89eb 4163 && !EQ (frame, selected_frame))
1e12dd87 4164 obj = make_lispy_switch_frame (frame);
4c52b668 4165 internal_last_event_frame = frame;
4bb994d1 4166
1e12dd87
RS
4167 /* If we didn't decide to make a switch-frame event, go ahead
4168 and build a real event from the queue entry. */
cd21b839 4169
1e12dd87
RS
4170 if (NILP (obj))
4171 {
4172 obj = make_lispy_event (event);
c60ee5e7 4173
488dd4c4
JD
4174#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined(MAC_OS) \
4175 || defined (USE_GTK)
83d68044
KH
4176 /* If this was a menu selection, then set the flag to inhibit
4177 writing to last_nonmenu_event. Don't do this if the event
4178 we're returning is (menu-bar), though; that indicates the
4179 beginning of the menu sequence, and we might as well leave
4180 that as the `event with parameters' for this selection. */
da8f7368
GM
4181 if (used_mouse_menu
4182 && !EQ (event->frame_or_window, event->arg)
4183 && (event->kind == MENU_BAR_EVENT
4184 || event->kind == TOOL_BAR_EVENT))
83d68044
KH
4185 *used_mouse_menu = 1;
4186#endif
1e12dd87
RS
4187
4188 /* Wipe out this event, to catch bugs. */
0bbfdc25 4189 clear_event (event);
beecf6a1 4190 kbd_fetch_ptr = event + 1;
1e12dd87 4191 }
4bb994d1 4192 }
284f4730 4193 }
2eb6bfbe 4194#ifdef HAVE_MOUSE
a612e298 4195 /* Try generating a mouse motion event. */
f3253854 4196 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
284f4730 4197 {
f3253854 4198 FRAME_PTR f = some_mouse_moved ();
7b4aedb9 4199 Lisp_Object bar_window;
3c370943 4200 enum scroll_bar_part part;
e5d77022
JB
4201 Lisp_Object x, y;
4202 unsigned long time;
284f4730 4203
c5fdd383 4204 *kbp = current_kboard;
e177ac3a
RS
4205 /* Note that this uses F to determine which display to look at.
4206 If there is no valid info, it does not store anything
4207 so x remains nil. */
4208 x = Qnil;
3b7fbceb 4209
c3b4957f 4210 /* XXX Can f or mouse_position_hook be NULL here? */
7e59217d
KL
4211 if (f && FRAME_DEVICE (f)->mouse_position_hook)
4212 (*FRAME_DEVICE (f)->mouse_position_hook) (&f, 0, &bar_window,
4213 &part, &x, &y, &time);
4bb994d1
JB
4214
4215 obj = Qnil;
284f4730 4216
4bb994d1
JB
4217 /* Decide if we should generate a switch-frame event. Don't
4218 generate switch-frame events for motion outside of all Emacs
4219 frames. */
e177ac3a 4220 if (!NILP (x) && f)
cd21b839 4221 {
9b8eb840 4222 Lisp_Object frame;
4bb994d1 4223
9b8eb840 4224 frame = FRAME_FOCUS_FRAME (f);
4bb994d1 4225 if (NILP (frame))
18cd2eeb 4226 XSETFRAME (frame, f);
4bb994d1 4227
4c52b668 4228 if (! EQ (frame, internal_last_event_frame)
788f89eb 4229 && !EQ (frame, selected_frame))
764cb3f9 4230 obj = make_lispy_switch_frame (frame);
4c52b668 4231 internal_last_event_frame = frame;
cd21b839 4232 }
4bb994d1 4233
df0f2ba1 4234 /* If we didn't decide to make a switch-frame event, go ahead and
4bb994d1 4235 return a mouse-motion event. */
e177ac3a 4236 if (!NILP (x) && NILP (obj))
7b4aedb9 4237 obj = make_lispy_movement (f, bar_window, part, x, y, time);
6cbff1cb 4238 }
2eb6bfbe 4239#endif /* HAVE_MOUSE */
284f4730
JB
4240 else
4241 /* We were promised by the above while loop that there was
4242 something for us to read! */
4243 abort ();
4244
d9d4c147 4245 input_pending = readable_events (0);
284f4730 4246
4c52b668 4247 Vlast_event_frame = internal_last_event_frame;
3c370943 4248
284f4730
JB
4249 return (obj);
4250}
a612e298
RS
4251\f
4252/* Process any events that are not user-visible,
4253 then return, without reading any user-visible events. */
3a3b9632
RS
4254
4255void
d9d4c147
KH
4256swallow_events (do_display)
4257 int do_display;
3a3b9632 4258{
87dd9b9b
RS
4259 int old_timers_run;
4260
beecf6a1 4261 while (kbd_fetch_ptr != kbd_store_ptr)
3a3b9632
RS
4262 {
4263 struct input_event *event;
4264
beecf6a1
KH
4265 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
4266 ? kbd_fetch_ptr
4267 : kbd_buffer);
3a3b9632
RS
4268
4269 last_event_timestamp = event->timestamp;
4270
4271 /* These two kinds of events get special handling
4272 and don't actually appear to the command loop. */
e3f6e7c7
KS
4273 if (event->kind == SELECTION_REQUEST_EVENT
4274 || event->kind == SELECTION_CLEAR_EVENT)
3a3b9632
RS
4275 {
4276#ifdef HAVE_X11
4581e928 4277 struct input_event copy;
e0301c07
RS
4278
4279 /* Remove it from the buffer before processing it,
4280 since otherwise swallow_events called recursively could see it
4281 and process it again. */
4581e928 4282 copy = *event;
beecf6a1 4283 kbd_fetch_ptr = event + 1;
d9d4c147 4284 input_pending = readable_events (0);
e3f6e7c7 4285 x_handle_selection_event (&copy);
3a3b9632
RS
4286#else
4287 /* We're getting selection request events, but we don't have
4288 a window system. */
4289 abort ();
4290#endif
4291 }
4292 else
4293 break;
4294 }
4295
87dd9b9b 4296 old_timers_run = timers_run;
a2d5fca0 4297 get_input_pending (&input_pending, READABLE_EVENTS_DO_TIMERS_NOW);
87dd9b9b
RS
4298
4299 if (timers_run != old_timers_run && do_display)
3007ebfb 4300 redisplay_preserve_echo_area (7);
3a3b9632 4301}
a612e298 4302\f
d9d4c147
KH
4303/* Record the start of when Emacs is idle,
4304 for the sake of running idle-time timers. */
4305
5c12e63f 4306static void
d9d4c147
KH
4307timer_start_idle ()
4308{
4309 Lisp_Object timers;
4310
4311 /* If we are already in the idle state, do nothing. */
4312 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4313 return;
4314
4315 EMACS_GET_TIME (timer_idleness_start_time);
4316
3021d3a9
RS
4317 timer_last_idleness_start_time = timer_idleness_start_time;
4318
d9d4c147 4319 /* Mark all idle-time timers as once again candidates for running. */
7539e11f 4320 for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers))
d9d4c147
KH
4321 {
4322 Lisp_Object timer;
4323
7539e11f 4324 timer = XCAR (timers);
d9d4c147
KH
4325
4326 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4327 continue;
4328 XVECTOR (timer)->contents[0] = Qnil;
4329 }
4330}
4331
4332/* Record that Emacs is no longer idle, so stop running idle-time timers. */
4333
5c12e63f 4334static void
d9d4c147
KH
4335timer_stop_idle ()
4336{
4337 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
4338}
4339
5c12e63f
KS
4340/* Resume idle timer from last idle start time. */
4341
4342static void
4343timer_resume_idle ()
4344{
4345 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4346 return;
4347
4348 timer_idleness_start_time = timer_last_idleness_start_time;
4349}
4350
e044e87c
RS
4351/* This is only for debugging. */
4352struct input_event last_timer_event;
4353
c04cbc3b
RS
4354/* Check whether a timer has fired. To prevent larger problems we simply
4355 disregard elements that are not proper timers. Do not make a circular
4356 timer list for the time being.
4357
4358 Returns the number of seconds to wait until the next timer fires. If a
4359 timer is triggering now, return zero seconds.
4360 If no timer is active, return -1 seconds.
4361
4ec4ed6a
RS
4362 If a timer is ripe, we run it, with quitting turned off.
4363
4364 DO_IT_NOW is now ignored. It used to mean that we should
4365 run the timer directly instead of queueing a timer-event.
4366 Now we always run timers directly. */
c04cbc3b
RS
4367
4368EMACS_TIME
4369timer_check (do_it_now)
4370 int do_it_now;
4371{
4372 EMACS_TIME nexttime;
9291c072
RS
4373 EMACS_TIME now, idleness_now;
4374 Lisp_Object timers, idle_timers, chosen_timer;
9291c072 4375 struct gcpro gcpro1, gcpro2, gcpro3;
c04cbc3b 4376
c04cbc3b
RS
4377 EMACS_SET_SECS (nexttime, -1);
4378 EMACS_SET_USECS (nexttime, -1);
4379
9291c072 4380 /* Always consider the ordinary timers. */
7ea13e12 4381 timers = Vtimer_list;
9291c072
RS
4382 /* Consider the idle timers only if Emacs is idle. */
4383 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4384 idle_timers = Vtimer_idle_list;
4385 else
4386 idle_timers = Qnil;
4387 chosen_timer = Qnil;
4388 GCPRO3 (timers, idle_timers, chosen_timer);
7ea13e12 4389
9291c072 4390 if (CONSP (timers) || CONSP (idle_timers))
c04cbc3b 4391 {
9291c072
RS
4392 EMACS_GET_TIME (now);
4393 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4394 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
4395 }
c04cbc3b 4396
9291c072
RS
4397 while (CONSP (timers) || CONSP (idle_timers))
4398 {
9291c072 4399 Lisp_Object *vector;
8c907a56 4400 Lisp_Object timer = Qnil, idle_timer = Qnil;
9291c072
RS
4401 EMACS_TIME timer_time, idle_timer_time;
4402 EMACS_TIME difference, timer_difference, idle_timer_difference;
4403
4404 /* Skip past invalid timers and timers already handled. */
4405 if (!NILP (timers))
c04cbc3b 4406 {
7539e11f 4407 timer = XCAR (timers);
9291c072
RS
4408 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4409 {
7539e11f 4410 timers = XCDR (timers);
9291c072
RS
4411 continue;
4412 }
4413 vector = XVECTOR (timer)->contents;
d9d4c147 4414
9291c072
RS
4415 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
4416 || !INTEGERP (vector[3])
4417 || ! NILP (vector[0]))
4418 {
7539e11f 4419 timers = XCDR (timers);
9291c072
RS
4420 continue;
4421 }
4422 }
4423 if (!NILP (idle_timers))
4424 {
7539e11f 4425 timer = XCAR (idle_timers);
d9d4c147 4426 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
9291c072 4427 {
7539e11f 4428 idle_timers = XCDR (idle_timers);
9291c072
RS
4429 continue;
4430 }
d9d4c147
KH
4431 vector = XVECTOR (timer)->contents;
4432
4433 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
9291c072
RS
4434 || !INTEGERP (vector[3])
4435 || ! NILP (vector[0]))
4436 {
7539e11f 4437 idle_timers = XCDR (idle_timers);
9291c072
RS
4438 continue;
4439 }
4440 }
d9d4c147 4441
9291c072
RS
4442 /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
4443 based on the next ordinary timer.
4444 TIMER_DIFFERENCE is the distance in time from NOW to when
4445 this timer becomes ripe (negative if it's already ripe). */
4446 if (!NILP (timers))
4447 {
7539e11f 4448 timer = XCAR (timers);
9291c072 4449 vector = XVECTOR (timer)->contents;
d9d4c147
KH
4450 EMACS_SET_SECS (timer_time,
4451 (XINT (vector[1]) << 16) | (XINT (vector[2])));
4452 EMACS_SET_USECS (timer_time, XINT (vector[3]));
9291c072
RS
4453 EMACS_SUB_TIME (timer_difference, timer_time, now);
4454 }
ba8dfba8 4455
9291c072
RS
4456 /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
4457 based on the next idle timer. */
4458 if (!NILP (idle_timers))
4459 {
7539e11f 4460 idle_timer = XCAR (idle_timers);
9291c072
RS
4461 vector = XVECTOR (idle_timer)->contents;
4462 EMACS_SET_SECS (idle_timer_time,
4463 (XINT (vector[1]) << 16) | (XINT (vector[2])));
4464 EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
4465 EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
4466 }
ba8dfba8 4467
9291c072
RS
4468 /* Decide which timer is the next timer,
4469 and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
4470 Also step down the list where we found that timer. */
d9d4c147 4471
9291c072
RS
4472 if (! NILP (timers) && ! NILP (idle_timers))
4473 {
4474 EMACS_TIME temp;
4475 EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
4476 if (EMACS_TIME_NEG_P (temp))
4477 {
4478 chosen_timer = timer;
7539e11f 4479 timers = XCDR (timers);
9291c072 4480 difference = timer_difference;
c04cbc3b 4481 }
d9d4c147 4482 else
d9d4c147 4483 {
9291c072 4484 chosen_timer = idle_timer;
7539e11f 4485 idle_timers = XCDR (idle_timers);
9291c072 4486 difference = idle_timer_difference;
d9d4c147 4487 }
7ea13e12 4488 }
9291c072
RS
4489 else if (! NILP (timers))
4490 {
4491 chosen_timer = timer;
7539e11f 4492 timers = XCDR (timers);
9291c072
RS
4493 difference = timer_difference;
4494 }
4495 else
4496 {
4497 chosen_timer = idle_timer;
7539e11f 4498 idle_timers = XCDR (idle_timers);
9291c072
RS
4499 difference = idle_timer_difference;
4500 }
4501 vector = XVECTOR (chosen_timer)->contents;
c60ee5e7 4502
bd55b860 4503 /* If timer is ripe, run it if it hasn't been run. */
9291c072
RS
4504 if (EMACS_TIME_NEG_P (difference)
4505 || (EMACS_SECS (difference) == 0
4506 && EMACS_USECS (difference) == 0))
4507 {
4508 if (NILP (vector[0]))
4509 {
331379bf 4510 int count = SPECPDL_INDEX ();
d0bbfc99 4511 Lisp_Object old_deactivate_mark = Vdeactivate_mark;
d925fb39 4512
256c9c3a
KL
4513 /* On unbind_to, resume allowing input from any kboard, if that
4514 was true before. */
4515 record_single_kboard_state ();
4516
9291c072
RS
4517 /* Mark the timer as triggered to prevent problems if the lisp
4518 code fails to reschedule it right. */
4519 vector[0] = Qt;
4520
d925fb39 4521 specbind (Qinhibit_quit, Qt);
c60ee5e7 4522
d925fb39 4523 call1 (Qtimer_event_handler, chosen_timer);
d0bbfc99 4524 Vdeactivate_mark = old_deactivate_mark;
d925fb39 4525 timers_run++;
d925fb39 4526 unbind_to (count, Qnil);
4ec4ed6a 4527
d925fb39
RS
4528 /* Since we have handled the event,
4529 we don't need to tell the caller to wake up and do it. */
9291c072
RS
4530 }
4531 }
4532 else
4533 /* When we encounter a timer that is still waiting,
4534 return the amount of time to wait before it is ripe. */
4535 {
4536 UNGCPRO;
9291c072
RS
4537 return difference;
4538 }
c04cbc3b 4539 }
9291c072 4540
7ea13e12
RS
4541 /* No timers are pending in the future. */
4542 /* Return 0 if we generated an event, and -1 if not. */
4543 UNGCPRO;
c04cbc3b
RS
4544 return nexttime;
4545}
4546\f
284f4730 4547/* Caches for modify_event_symbol. */
e9bf89a0 4548static Lisp_Object accent_key_syms;
284f4730
JB
4549static Lisp_Object func_key_syms;
4550static Lisp_Object mouse_syms;
8006e4bb 4551static Lisp_Object wheel_syms;
a24dc617 4552static Lisp_Object drag_n_drop_syms;
284f4730 4553
e9bf89a0
RS
4554/* This is a list of keysym codes for special "accent" characters.
4555 It parallels lispy_accent_keys. */
4556
4557static int lispy_accent_codes[] =
4558{
79a7046c 4559#ifdef XK_dead_circumflex
e9bf89a0 4560 XK_dead_circumflex,
79a7046c
RS
4561#else
4562 0,
4563#endif
4564#ifdef XK_dead_grave
e9bf89a0 4565 XK_dead_grave,
79a7046c
RS
4566#else
4567 0,
4568#endif
4569#ifdef XK_dead_tilde
e9bf89a0 4570 XK_dead_tilde,
79a7046c
RS
4571#else
4572 0,
4573#endif
4574#ifdef XK_dead_diaeresis
e9bf89a0 4575 XK_dead_diaeresis,
79a7046c
RS
4576#else
4577 0,
4578#endif
4579#ifdef XK_dead_macron
e9bf89a0 4580 XK_dead_macron,
79a7046c
RS
4581#else
4582 0,
4583#endif
4584#ifdef XK_dead_degree
e9bf89a0 4585 XK_dead_degree,
79a7046c
RS
4586#else
4587 0,
4588#endif
4589#ifdef XK_dead_acute
e9bf89a0 4590 XK_dead_acute,
79a7046c
RS
4591#else
4592 0,
4593#endif
4594#ifdef XK_dead_cedilla
e9bf89a0 4595 XK_dead_cedilla,
79a7046c
RS
4596#else
4597 0,
4598#endif
4599#ifdef XK_dead_breve
e9bf89a0 4600 XK_dead_breve,
79a7046c
RS
4601#else
4602 0,
4603#endif
4604#ifdef XK_dead_ogonek
e9bf89a0 4605 XK_dead_ogonek,
79a7046c
RS
4606#else
4607 0,
4608#endif
4609#ifdef XK_dead_caron
e9bf89a0 4610 XK_dead_caron,
79a7046c
RS
4611#else
4612 0,
4613#endif
4614#ifdef XK_dead_doubleacute
e9bf89a0 4615 XK_dead_doubleacute,
79a7046c
RS
4616#else
4617 0,
4618#endif
4619#ifdef XK_dead_abovedot
e9bf89a0 4620 XK_dead_abovedot,
79a7046c
RS
4621#else
4622 0,
4623#endif
ed3230db
DL
4624#ifdef XK_dead_abovering
4625 XK_dead_abovering,
4626#else
4627 0,
4628#endif
4629#ifdef XK_dead_iota
4630 XK_dead_iota,
4631#else
4632 0,
4633#endif
4634#ifdef XK_dead_belowdot
4635 XK_dead_belowdot,
4636#else
4637 0,
4638#endif
4639#ifdef XK_dead_voiced_sound
4640 XK_dead_voiced_sound,
4641#else
4642 0,
4643#endif
4644#ifdef XK_dead_semivoiced_sound
4645 XK_dead_semivoiced_sound,
4646#else
4647 0,
4648#endif
4649#ifdef XK_dead_hook
4650 XK_dead_hook,
4651#else
4652 0,
4653#endif
4654#ifdef XK_dead_horn
4655 XK_dead_horn,
4656#else
4657 0,
4658#endif
e9bf89a0
RS
4659};
4660
4661/* This is a list of Lisp names for special "accent" characters.
4662 It parallels lispy_accent_codes. */
4663
4664static char *lispy_accent_keys[] =
4665{
4666 "dead-circumflex",
4667 "dead-grave",
4668 "dead-tilde",
4669 "dead-diaeresis",
4670 "dead-macron",
4671 "dead-degree",
4672 "dead-acute",
4673 "dead-cedilla",
4674 "dead-breve",
4675 "dead-ogonek",
4676 "dead-caron",
4677 "dead-doubleacute",
4678 "dead-abovedot",
ed3230db
DL
4679 "dead-abovering",
4680 "dead-iota",
4681 "dead-belowdot",
4682 "dead-voiced-sound",
4683 "dead-semivoiced-sound",
4684 "dead-hook",
4685 "dead-horn",
e9bf89a0
RS
4686};
4687
e98a93eb
GV
4688#ifdef HAVE_NTGUI
4689#define FUNCTION_KEY_OFFSET 0x0
4690
4691char *lispy_function_keys[] =
4692 {
4693 0, /* 0 */
c60ee5e7 4694
e98a93eb
GV
4695 0, /* VK_LBUTTON 0x01 */
4696 0, /* VK_RBUTTON 0x02 */
4697 "cancel", /* VK_CANCEL 0x03 */
4698 0, /* VK_MBUTTON 0x04 */
c60ee5e7 4699
e98a93eb 4700 0, 0, 0, /* 0x05 .. 0x07 */
c60ee5e7 4701
e98a93eb
GV
4702 "backspace", /* VK_BACK 0x08 */
4703 "tab", /* VK_TAB 0x09 */
c60ee5e7 4704
e98a93eb 4705 0, 0, /* 0x0A .. 0x0B */
c60ee5e7 4706
e98a93eb
GV
4707 "clear", /* VK_CLEAR 0x0C */
4708 "return", /* VK_RETURN 0x0D */
c60ee5e7 4709
e98a93eb 4710 0, 0, /* 0x0E .. 0x0F */
c60ee5e7 4711
1161d367
GV
4712 0, /* VK_SHIFT 0x10 */
4713 0, /* VK_CONTROL 0x11 */
4714 0, /* VK_MENU 0x12 */
e98a93eb 4715 "pause", /* VK_PAUSE 0x13 */
1161d367 4716 "capslock", /* VK_CAPITAL 0x14 */
c60ee5e7 4717
e98a93eb 4718 0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */
c60ee5e7 4719
1161d367 4720 "escape", /* VK_ESCAPE 0x1B */
c60ee5e7 4721
e98a93eb 4722 0, 0, 0, 0, /* 0x1C .. 0x1F */
c60ee5e7 4723
e98a93eb
GV
4724 0, /* VK_SPACE 0x20 */
4725 "prior", /* VK_PRIOR 0x21 */
4726 "next", /* VK_NEXT 0x22 */
4727 "end", /* VK_END 0x23 */
4728 "home", /* VK_HOME 0x24 */
4729 "left", /* VK_LEFT 0x25 */
4730 "up", /* VK_UP 0x26 */
4731 "right", /* VK_RIGHT 0x27 */
4732 "down", /* VK_DOWN 0x28 */
4733 "select", /* VK_SELECT 0x29 */
4734 "print", /* VK_PRINT 0x2A */
4735 "execute", /* VK_EXECUTE 0x2B */
4736 "snapshot", /* VK_SNAPSHOT 0x2C */
4737 "insert", /* VK_INSERT 0x2D */
4738 "delete", /* VK_DELETE 0x2E */
4739 "help", /* VK_HELP 0x2F */
c60ee5e7 4740
e98a93eb 4741 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
c60ee5e7 4742
e98a93eb 4743 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
c60ee5e7 4744
e98a93eb 4745 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
c60ee5e7 4746
e98a93eb 4747 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
c60ee5e7
JB
4748
4749 0, 0, 0, 0, 0, 0, 0, 0, 0,
4750 0, 0, 0, 0, 0, 0, 0, 0, 0,
e98a93eb 4751 0, 0, 0, 0, 0, 0, 0, 0,
c60ee5e7 4752
e376f90d
RS
4753 "lwindow", /* VK_LWIN 0x5B */
4754 "rwindow", /* VK_RWIN 0x5C */
4755 "apps", /* VK_APPS 0x5D */
c60ee5e7 4756
e98a93eb 4757 0, 0, /* 0x5E .. 0x5F */
c60ee5e7 4758
e98a93eb
GV
4759 "kp-0", /* VK_NUMPAD0 0x60 */
4760 "kp-1", /* VK_NUMPAD1 0x61 */
4761 "kp-2", /* VK_NUMPAD2 0x62 */
4762 "kp-3", /* VK_NUMPAD3 0x63 */
4763 "kp-4", /* VK_NUMPAD4 0x64 */
4764 "kp-5", /* VK_NUMPAD5 0x65 */
4765 "kp-6", /* VK_NUMPAD6 0x66 */
4766 "kp-7", /* VK_NUMPAD7 0x67 */
4767 "kp-8", /* VK_NUMPAD8 0x68 */
4768 "kp-9", /* VK_NUMPAD9 0x69 */
4769 "kp-multiply", /* VK_MULTIPLY 0x6A */
4770 "kp-add", /* VK_ADD 0x6B */
4771 "kp-separator", /* VK_SEPARATOR 0x6C */
4772 "kp-subtract", /* VK_SUBTRACT 0x6D */
4773 "kp-decimal", /* VK_DECIMAL 0x6E */
4774 "kp-divide", /* VK_DIVIDE 0x6F */
4775 "f1", /* VK_F1 0x70 */
4776 "f2", /* VK_F2 0x71 */
4777 "f3", /* VK_F3 0x72 */
4778 "f4", /* VK_F4 0x73 */
4779 "f5", /* VK_F5 0x74 */
4780 "f6", /* VK_F6 0x75 */
4781 "f7", /* VK_F7 0x76 */
4782 "f8", /* VK_F8 0x77 */
4783 "f9", /* VK_F9 0x78 */
4784 "f10", /* VK_F10 0x79 */
4785 "f11", /* VK_F11 0x7A */
4786 "f12", /* VK_F12 0x7B */
4787 "f13", /* VK_F13 0x7C */
4788 "f14", /* VK_F14 0x7D */
4789 "f15", /* VK_F15 0x7E */
4790 "f16", /* VK_F16 0x7F */
4791 "f17", /* VK_F17 0x80 */
4792 "f18", /* VK_F18 0x81 */
4793 "f19", /* VK_F19 0x82 */
4794 "f20", /* VK_F20 0x83 */
4795 "f21", /* VK_F21 0x84 */
4796 "f22", /* VK_F22 0x85 */
4797 "f23", /* VK_F23 0x86 */
4798 "f24", /* VK_F24 0x87 */
c60ee5e7 4799
e98a93eb
GV
4800 0, 0, 0, 0, /* 0x88 .. 0x8B */
4801 0, 0, 0, 0, /* 0x8C .. 0x8F */
c60ee5e7 4802
e98a93eb
GV
4803 "kp-numlock", /* VK_NUMLOCK 0x90 */
4804 "scroll", /* VK_SCROLL 0x91 */
c60ee5e7 4805
e376f90d
RS
4806 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
4807 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
4808 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
4809 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
4810 "kp-end", /* VK_NUMPAD_END 0x96 */
4811 "kp-home", /* VK_NUMPAD_HOME 0x97 */
4812 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
4813 "kp-up", /* VK_NUMPAD_UP 0x99 */
4814 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
4815 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
4816 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
4817 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
4818
4819 0, 0, /* 0x9E .. 0x9F */
4820
e98a93eb
GV
4821 /*
4822 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
e8886a1d 4823 * Used only as parameters to GetAsyncKeyState and GetKeyState.
e98a93eb
GV
4824 * No other API or message will distinguish left and right keys this way.
4825 */
4826 /* 0xA0 .. 0xEF */
c60ee5e7 4827
e98a93eb
GV
4828 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4829 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4830 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4831 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4832 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
c60ee5e7 4833
e98a93eb 4834 /* 0xF0 .. 0xF5 */
c60ee5e7 4835
e98a93eb 4836 0, 0, 0, 0, 0, 0,
c60ee5e7 4837
e98a93eb
GV
4838 "attn", /* VK_ATTN 0xF6 */
4839 "crsel", /* VK_CRSEL 0xF7 */
4840 "exsel", /* VK_EXSEL 0xF8 */
4841 "ereof", /* VK_EREOF 0xF9 */
4842 "play", /* VK_PLAY 0xFA */
4843 "zoom", /* VK_ZOOM 0xFB */
4844 "noname", /* VK_NONAME 0xFC */
4845 "pa1", /* VK_PA1 0xFD */
4846 "oem_clear", /* VK_OEM_CLEAR 0xFE */
1161d367 4847 0 /* 0xFF */
e98a93eb
GV
4848 };
4849
04f215f0 4850#else /* not HAVE_NTGUI */
e98a93eb 4851
ed3230db
DL
4852/* This should be dealt with in XTread_socket now, and that doesn't
4853 depend on the client system having the Kana syms defined. See also
4854 the XK_kana_A case below. */
4855#if 0
37cd9f30
KH
4856#ifdef XK_kana_A
4857static char *lispy_kana_keys[] =
4858 {
4859 /* X Keysym value */
4860 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
4861 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
4862 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
4863 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
4864 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
4865 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
4866 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
4867 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
4868 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
4869 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
c60ee5e7 4870 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
37cd9f30
KH
4871 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
4872 "kana-i", "kana-u", "kana-e", "kana-o",
4873 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
4874 "prolongedsound", "kana-A", "kana-I", "kana-U",
4875 "kana-E", "kana-O", "kana-KA", "kana-KI",
4876 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
4877 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
4878 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
4879 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
4880 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
4881 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
4882 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
4883 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
4884 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
4885 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
4886 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
4887 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
4888 };
4889#endif /* XK_kana_A */
ed3230db 4890#endif /* 0 */
37cd9f30 4891
04f215f0
RS
4892#define FUNCTION_KEY_OFFSET 0xff00
4893
284f4730
JB
4894/* You'll notice that this table is arranged to be conveniently
4895 indexed by X Windows keysym values. */
4896static char *lispy_function_keys[] =
4897 {
4898 /* X Keysym value */
4899
75045dcb
RS
4900 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
4901 "backspace", "tab", "linefeed", "clear",
4902 0, "return", 0, 0,
4903 0, 0, 0, "pause", /* 0xff10...1f */
4904 0, 0, 0, 0, 0, 0, 0, "escape",
86e5706b 4905 0, 0, 0, 0,
75045dcb
RS
4906 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
4907 "romaji", "hiragana", "katakana", "hiragana-katakana",
4908 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
4909 "massyo", "kana-lock", "kana-shift", "eisu-shift",
4910 "eisu-toggle", /* 0xff30...3f */
4911 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
86e5706b
RS
4912 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
4913
75045dcb
RS
4914 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
4915 "down", "prior", "next", "end",
4916 "begin", 0, 0, 0, 0, 0, 0, 0,
284f4730
JB
4917 "select", /* 0xff60 */ /* IsMiscFunctionKey */
4918 "print",
4919 "execute",
4920 "insert",
4921 0, /* 0xff64 */
4922 "undo",
4923 "redo",
4924 "menu",
4925 "find",
4926 "cancel",
4927 "help",
4928 "break", /* 0xff6b */
4929
75045dcb
RS
4930 0, 0, 0, 0,
4931 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
4932 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
284f4730
JB
4933 "kp-space", /* 0xff80 */ /* IsKeypadKey */
4934 0, 0, 0, 0, 0, 0, 0, 0,
4935 "kp-tab", /* 0xff89 */
4936 0, 0, 0,
4937 "kp-enter", /* 0xff8d */
4938 0, 0, 0,
4939 "kp-f1", /* 0xff91 */
4940 "kp-f2",
4941 "kp-f3",
4942 "kp-f4",
872157e7
RS
4943 "kp-home", /* 0xff95 */
4944 "kp-left",
4945 "kp-up",
4946 "kp-right",
4947 "kp-down",
4948 "kp-prior", /* kp-page-up */
4949 "kp-next", /* kp-page-down */
4950 "kp-end",
4951 "kp-begin",
4952 "kp-insert",
4953 "kp-delete",
4954 0, /* 0xffa0 */
4955 0, 0, 0, 0, 0, 0, 0, 0, 0,
284f4730
JB
4956 "kp-multiply", /* 0xffaa */
4957 "kp-add",
4958 "kp-separator",
4959 "kp-subtract",
4960 "kp-decimal",
4961 "kp-divide", /* 0xffaf */
4962 "kp-0", /* 0xffb0 */
4963 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
4964 0, /* 0xffba */
4965 0, 0,
4966 "kp-equal", /* 0xffbd */
4967 "f1", /* 0xffbe */ /* IsFunctionKey */
86e5706b
RS
4968 "f2",
4969 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
4970 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
4971 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
4972 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
4973 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
4974 0, 0, 0, 0, 0, 0, 0, 0,
4975 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
4976 0, 0, 0, 0, 0, 0, 0, "delete"
04f215f0 4977 };
284f4730 4978
04f215f0
RS
4979/* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
4980#define ISO_FUNCTION_KEY_OFFSET 0xfe00
4981
4982static char *iso_lispy_function_keys[] =
4983 {
4984 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
4985 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
4986 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
4987 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
4988 "iso-lefttab", /* 0xfe20 */
c60ee5e7
JB
4989 "iso-move-line-up", "iso-move-line-down",
4990 "iso-partial-line-up", "iso-partial-line-down",
4991 "iso-partial-space-left", "iso-partial-space-right",
04f215f0
RS
4992 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
4993 "iso-release-margin-left", "iso-release-margin-right",
4994 "iso-release-both-margins",
4995 "iso-fast-cursor-left", "iso-fast-cursor-right",
4996 "iso-fast-cursor-up", "iso-fast-cursor-down",
4997 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
4998 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
4999 };
5000
5001#endif /* not HAVE_NTGUI */
e98a93eb 5002
8e1e4240 5003Lisp_Object Vlispy_mouse_stem;
284f4730 5004
8006e4bb
JR
5005static char *lispy_wheel_names[] =
5006{
5007 "wheel-up", "wheel-down"
5008};
5009
a24dc617
RS
5010/* drag-n-drop events are generated when a set of selected files are
5011 dragged from another application and dropped onto an Emacs window. */
5012static char *lispy_drag_n_drop_names[] =
5013{
5014 "drag-n-drop"
5015};
5016
3c370943 5017/* Scroll bar parts. */
4bb994d1 5018Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
7ee32cda 5019Lisp_Object Qup, Qdown, Qbottom, Qend_scroll;
eef28553 5020Lisp_Object Qtop, Qratio;
4bb994d1 5021
3c370943
JB
5022/* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
5023Lisp_Object *scroll_bar_parts[] = {
db08707d 5024 &Qabove_handle, &Qhandle, &Qbelow_handle,
eef28553 5025 &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio
4bb994d1
JB
5026};
5027
5bf68f6e
AS
5028/* User signal events. */
5029Lisp_Object Qusr1_signal, Qusr2_signal;
5030
5031Lisp_Object *lispy_user_signals[] =
5032{
5033 &Qusr1_signal, &Qusr2_signal
5034};
5035
4bb994d1 5036
7b4aedb9 5037/* A vector, indexed by button number, giving the down-going location
3c370943 5038 of currently depressed buttons, both scroll bar and non-scroll bar.
7b4aedb9
JB
5039
5040 The elements have the form
5041 (BUTTON-NUMBER MODIFIER-MASK . REST)
5042 where REST is the cdr of a position as it would be reported in the event.
5043
5044 The make_lispy_event function stores positions here to tell the
5045 difference between click and drag events, and to store the starting
5046 location to be included in drag events. */
5047
5048static Lisp_Object button_down_location;
88cb0656 5049
fbcd35bd
JB
5050/* Information about the most recent up-going button event: Which
5051 button, what location, and what time. */
5052
559f9d04
RS
5053static int last_mouse_button;
5054static int last_mouse_x;
5055static int last_mouse_y;
5056static unsigned long button_down_time;
fbcd35bd 5057
222d557c
GM
5058/* The maximum time between clicks to make a double-click, or Qnil to
5059 disable double-click detection, or Qt for no time limit. */
5060
564dc952 5061Lisp_Object Vdouble_click_time;
fbcd35bd 5062
222d557c
GM
5063/* Maximum number of pixels the mouse may be moved between clicks
5064 to make a double-click. */
5065
31ade731 5066EMACS_INT double_click_fuzz;
222d557c 5067
fbcd35bd
JB
5068/* The number of clicks in this multiple-click. */
5069
5070int double_click_count;
5071
3d566707
KS
5072/* Return position of a mouse click or wheel event */
5073
5074static Lisp_Object
5075make_lispy_position (f, x, y, time)
5076 struct frame *f;
5077 Lisp_Object *x, *y;
5078 unsigned long time;
5079{
5080 Lisp_Object window;
5081 enum window_part part;
5082 Lisp_Object posn = Qnil;
5083 Lisp_Object extra_info = Qnil;
5084 int wx, wy;
5085
5086 /* Set `window' to the window under frame pixel coordinates (x,y) */
5087 if (f)
5088 window = window_from_coordinates (f, XINT (*x), XINT (*y),
5089 &part, &wx, &wy, 0);
5090 else
5091 window = Qnil;
5092
5093 if (WINDOWP (window))
5094 {
5095 /* It's a click in window window at frame coordinates (x,y) */
5096 struct window *w = XWINDOW (window);
eee5863b 5097 Lisp_Object string_info = Qnil;
3d566707 5098 int textpos = -1, rx = -1, ry = -1;
45de137a 5099 int dx = -1, dy = -1;
eee5863b
KS
5100 int width = -1, height = -1;
5101 Lisp_Object object = Qnil;
3d566707
KS
5102
5103 /* Set event coordinates to window-relative coordinates
5104 for constructing the Lisp event below. */
5105 XSETINT (*x, wx);
5106 XSETINT (*y, wy);
5107
6507c4c7
KS
5108 if (part == ON_TEXT)
5109 {
5110 wx += WINDOW_LEFT_MARGIN_WIDTH (w);
5111 }
5112 else if (part == ON_MODE_LINE || part == ON_HEADER_LINE)
3d566707
KS
5113 {
5114 /* Mode line or header line. Look for a string under
5115 the mouse that may have a `local-map' property. */
5116 Lisp_Object string;
5117 int charpos;
5118
5119 posn = part == ON_MODE_LINE ? Qmode_line : Qheader_line;
5120 rx = wx, ry = wy;
eee5863b
KS
5121 string = mode_line_string (w, part, &rx, &ry, &charpos,
5122 &object, &dx, &dy, &width, &height);
3d566707 5123 if (STRINGP (string))
eee5863b 5124 string_info = Fcons (string, make_number (charpos));
3d566707
KS
5125 if (w == XWINDOW (selected_window))
5126 textpos = PT;
5127 else
5128 textpos = XMARKER (w->pointm)->charpos;
5129 }
5130 else if (part == ON_VERTICAL_BORDER)
5131 {
5132 posn = Qvertical_line;
5133 wx = -1;
45de137a 5134 dx = 0;
eee5863b 5135 width = 1;
3d566707
KS
5136 }
5137 else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
5138 {
5139 Lisp_Object string;
5140 int charpos;
2320865d 5141
3d566707
KS
5142 posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin;
5143 rx = wx, ry = wy;
eee5863b
KS
5144 string = marginal_area_string (w, part, &rx, &ry, &charpos,
5145 &object, &dx, &dy, &width, &height);
3d566707 5146 if (STRINGP (string))
eee5863b 5147 string_info = Fcons (string, make_number (charpos));
a65fc2c3
KS
5148 if (part == ON_LEFT_MARGIN)
5149 wx = 0;
5150 else
5151 wx = window_box_right_offset (w, TEXT_AREA) - 1;
5152 }
5153 else if (part == ON_LEFT_FRINGE)
5154 {
5155 posn = Qleft_fringe;
5156 rx = 0;
5157 dx = wx;
5158 wx = (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5159 ? 0
5160 : window_box_width (w, LEFT_MARGIN_AREA));
5161 dx -= wx;
3d566707 5162 }
a65fc2c3 5163 else if (part == ON_RIGHT_FRINGE)
3d566707 5164 {
a65fc2c3 5165 posn = Qright_fringe;
3d566707 5166 rx = 0;
45de137a 5167 dx = wx;
a65fc2c3
KS
5168 wx = (window_box_width (w, LEFT_MARGIN_AREA)
5169 + window_box_width (w, TEXT_AREA)
5170 + (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5171 ? window_box_width (w, RIGHT_MARGIN_AREA)
5172 : 0));
5173 dx -= wx;
5174 }
5175 else
5176 {
5177 /* Note: We have no special posn for part == ON_SCROLL_BAR. */
5178 wx = max (WINDOW_LEFT_MARGIN_WIDTH (w), wx);
3d566707
KS
5179 }
5180
5181 if (textpos < 0)
5182 {
eee5863b 5183 Lisp_Object string2, object2 = Qnil;
3d566707 5184 struct display_pos p;
45de137a 5185 int dx2, dy2;
eee5863b 5186 int width2, height2;
eee5863b
KS
5187 string2 = buffer_posn_from_coords (w, &wx, &wy, &p,
5188 &object2, &dx2, &dy2,
5189 &width2, &height2);
3d566707 5190 textpos = CHARPOS (p.pos);
45de137a
KS
5191 if (rx < 0) rx = wx;
5192 if (ry < 0) ry = wy;
5193 if (dx < 0) dx = dx2;
5194 if (dy < 0) dy = dy2;
eee5863b
KS
5195 if (width < 0) width = width2;
5196 if (height < 0) height = height2;
3d566707
KS
5197
5198 if (NILP (posn))
5199 {
5200 posn = make_number (textpos);
eee5863b
KS
5201 if (STRINGP (string2))
5202 string_info = Fcons (string2,
5203 make_number (CHARPOS (p.string_pos)));
3d566707 5204 }
eee5863b
KS
5205 if (NILP (object))
5206 object = object2;
3d566707
KS
5207 }
5208
eee5863b
KS
5209#ifdef HAVE_WINDOW_SYSTEM
5210 if (IMAGEP (object))
5211 {
5212 Lisp_Object image_map, hotspot;
5213 if ((image_map = Fplist_get (XCDR (object), QCmap),
5214 !NILP (image_map))
5215 && (hotspot = find_hot_spot (image_map, dx, dy),
5216 CONSP (hotspot))
5217 && (hotspot = XCDR (hotspot), CONSP (hotspot)))
5218 posn = XCAR (hotspot);
5219 }
5220#endif
5221
5222 /* Object info */
3d566707 5223 extra_info = Fcons (object,
eee5863b
KS
5224 Fcons (Fcons (make_number (dx),
5225 make_number (dy)),
5226 Fcons (Fcons (make_number (width),
5227 make_number (height)),
5228 Qnil)));
5229
5230 /* String info */
5231 extra_info = Fcons (string_info,
3d566707
KS
5232 Fcons (make_number (textpos),
5233 Fcons (Fcons (make_number (rx),
5234 make_number (ry)),
eee5863b 5235 extra_info)));
3d566707
KS
5236 }
5237 else if (f != 0)
5238 {
5239 XSETFRAME (window, f);
5240 }
5241 else
5242 {
5243 window = Qnil;
5244 XSETFASTINT (*x, 0);
5245 XSETFASTINT (*y, 0);
5246 }
5247
5248 return Fcons (window,
5249 Fcons (posn,
5250 Fcons (Fcons (*x, *y),
5251 Fcons (make_number (time),
5252 extra_info))));
5253}
5254
284f4730
JB
5255/* Given a struct input_event, build the lisp event which represents
5256 it. If EVENT is 0, build a mouse movement event from the mouse
88cb0656
JB
5257 movement buffer, which should have a movement event in it.
5258
5259 Note that events must be passed to this function in the order they
5260 are received; this function stores the location of button presses
5261 in order to build drag events when the button is released. */
284f4730
JB
5262
5263static Lisp_Object
5264make_lispy_event (event)
5265 struct input_event *event;
5266{
79a7046c
RS
5267 int i;
5268
0220c518 5269 switch (SWITCH_ENUM_CAST (event->kind))
284f4730 5270 {
284f4730 5271 /* A simple keystroke. */
3b8f9651 5272 case ASCII_KEYSTROKE_EVENT:
86e5706b 5273 {
9343ab07 5274 Lisp_Object lispy_c;
e9bf89a0 5275 int c = event->code & 0377;
5a1c6df8
JB
5276 /* Turn ASCII characters into control characters
5277 when proper. */
5278 if (event->modifiers & ctrl_modifier)
d205953b
JB
5279 c = make_ctrl_char (c);
5280
5281 /* Add in the other modifier bits. We took care of ctrl_modifier
5282 just above, and the shift key was taken care of by the X code,
5283 and applied to control characters by make_ctrl_char. */
86e5706b
RS
5284 c |= (event->modifiers
5285 & (meta_modifier | alt_modifier
5286 | hyper_modifier | super_modifier));
32454a9f
RS
5287 /* Distinguish Shift-SPC from SPC. */
5288 if ((event->code & 0377) == 040
5289 && event->modifiers & shift_modifier)
5290 c |= shift_modifier;
559f9d04 5291 button_down_time = 0;
bb9e9bed 5292 XSETFASTINT (lispy_c, c);
9343ab07 5293 return lispy_c;
86e5706b 5294 }
284f4730 5295
3b8f9651 5296 case MULTIBYTE_CHAR_KEYSTROKE_EVENT:
a50e723f
KH
5297 {
5298 Lisp_Object lispy_c;
24d80a06 5299 int c = event->code;
a50e723f 5300
24d80a06
SM
5301 /* Add in the other modifier bits. We took care of ctrl_modifier
5302 just above, and the shift key was taken care of by the X code,
5303 and applied to control characters by make_ctrl_char. */
5304 c |= (event->modifiers
5305 & (meta_modifier | alt_modifier
5306 | hyper_modifier | super_modifier | ctrl_modifier));
5307 /* What about the `shift' modifier ? */
5308 button_down_time = 0;
5309 XSETFASTINT (lispy_c, c);
a50e723f
KH
5310 return lispy_c;
5311 }
5312
284f4730
JB
5313 /* A function key. The symbol may need to have modifier prefixes
5314 tacked onto it. */
3b8f9651 5315 case NON_ASCII_KEYSTROKE_EVENT:
559f9d04 5316 button_down_time = 0;
e9bf89a0
RS
5317
5318 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
5319 if (event->code == lispy_accent_codes[i])
5320 return modify_event_symbol (i,
5321 event->modifiers,
80e4aa30 5322 Qfunction_key, Qnil,
e9bf89a0
RS
5323 lispy_accent_keys, &accent_key_syms,
5324 (sizeof (lispy_accent_keys)
5325 / sizeof (lispy_accent_keys[0])));
5326
ed3230db 5327#if 0
37cd9f30
KH
5328#ifdef XK_kana_A
5329 if (event->code >= 0x400 && event->code < 0x500)
5330 return modify_event_symbol (event->code - 0x400,
5331 event->modifiers & ~shift_modifier,
5332 Qfunction_key, Qnil,
5333 lispy_kana_keys, &func_key_syms,
5334 (sizeof (lispy_kana_keys)
5335 / sizeof (lispy_kana_keys[0])));
5336#endif /* XK_kana_A */
ed3230db 5337#endif /* 0 */
37cd9f30 5338
111c4138 5339#ifdef ISO_FUNCTION_KEY_OFFSET
04f215f0
RS
5340 if (event->code < FUNCTION_KEY_OFFSET
5341 && event->code >= ISO_FUNCTION_KEY_OFFSET)
5342 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
5343 event->modifiers,
5344 Qfunction_key, Qnil,
5345 iso_lispy_function_keys, &func_key_syms,
5346 (sizeof (iso_lispy_function_keys)
5347 / sizeof (iso_lispy_function_keys[0])));
111c4138 5348#endif
656280a6 5349
4c8bc894
SM
5350 /* Handle system-specific or unknown keysyms. */
5351 if (event->code & (1 << 28)
5352 || event->code - FUNCTION_KEY_OFFSET < 0
656280a6 5353 || (event->code - FUNCTION_KEY_OFFSET
4c8bc894
SM
5354 >= sizeof lispy_function_keys / sizeof *lispy_function_keys)
5355 || !lispy_function_keys[event->code - FUNCTION_KEY_OFFSET])
656280a6 5356 {
4c8bc894
SM
5357 /* We need to use an alist rather than a vector as the cache
5358 since we can't make a vector long enuf. */
5359 if (NILP (current_kboard->system_key_syms))
5360 current_kboard->system_key_syms = Fcons (Qnil, Qnil);
5361 return modify_event_symbol (event->code,
5362 event->modifiers,
5363 Qfunction_key,
5364 current_kboard->Vsystem_key_alist,
5365 0, &current_kboard->system_key_syms,
5366 (unsigned) -1);
656280a6 5367 }
656280a6
GM
5368
5369 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
5370 event->modifiers,
5371 Qfunction_key, Qnil,
5372 lispy_function_keys, &func_key_syms,
5373 (sizeof (lispy_function_keys)
5374 / sizeof (lispy_function_keys[0])));
284f4730 5375
514354e9 5376#ifdef HAVE_MOUSE
df0f2ba1 5377 /* A mouse click. Figure out where it is, decide whether it's
88cb0656 5378 a press, click or drag, and build the appropriate structure. */
3b8f9651 5379 case MOUSE_CLICK_EVENT:
7ee32cda 5380#ifndef USE_TOOLKIT_SCROLL_BARS
3b8f9651 5381 case SCROLL_BAR_CLICK_EVENT:
7ee32cda 5382#endif
284f4730 5383 {
e9bf89a0 5384 int button = event->code;
559f9d04 5385 int is_double;
7b4aedb9 5386 Lisp_Object position;
dbc4e1c1
JB
5387 Lisp_Object *start_pos_ptr;
5388 Lisp_Object start_pos;
284f4730 5389
8c907a56
GM
5390 position = Qnil;
5391
7b4aedb9 5392 /* Build the position as appropriate for this mouse click. */
3b8f9651 5393 if (event->kind == MOUSE_CLICK_EVENT)
284f4730 5394 {
c5cf2109 5395 struct frame *f = XFRAME (event->frame_or_window);
3d566707 5396#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
9e20143a 5397 int row, column;
3d566707 5398#endif
9e20143a 5399
5da3133a
RS
5400 /* Ignore mouse events that were made on frame that
5401 have been deleted. */
5402 if (! FRAME_LIVE_P (f))
5403 return Qnil;
5404
3d566707 5405#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
7ee32cda
GM
5406 /* EVENT->x and EVENT->y are frame-relative pixel
5407 coordinates at this place. Under old redisplay, COLUMN
5408 and ROW are set to frame relative glyph coordinates
5409 which are then used to determine whether this click is
5410 in a menu (non-toolkit version). */
5411 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
5412 &column, &row, NULL, 1);
7b4aedb9 5413
eef045bf
RS
5414 /* In the non-toolkit version, clicks on the menu bar
5415 are ordinary button events in the event buffer.
5416 Distinguish them, and invoke the menu.
5417
5418 (In the toolkit version, the toolkit handles the menu bar
5419 and Emacs doesn't know about it until after the user
5420 makes a selection.) */
2ee250ec
RS
5421 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
5422 && (event->modifiers & down_modifier))
bb936752 5423 {
b7c49376 5424 Lisp_Object items, item;
0a0e8fe6
RS
5425 int hpos;
5426 int i;
5427
2ee250ec 5428#if 0
0a0e8fe6
RS
5429 /* Activate the menu bar on the down event. If the
5430 up event comes in before the menu code can deal with it,
5431 just ignore it. */
5432 if (! (event->modifiers & down_modifier))
5433 return Qnil;
2ee250ec 5434#endif
0aafc975 5435
7ee32cda 5436 /* Find the menu bar item under `column'. */
f2ae6b3f 5437 item = Qnil;
5ec75a55 5438 items = FRAME_MENU_BAR_ITEMS (f);
35b3402f 5439 for (i = 0; i < XVECTOR (items)->size; i += 4)
5ec75a55
RS
5440 {
5441 Lisp_Object pos, string;
129004d3
GM
5442 string = AREF (items, i + 1);
5443 pos = AREF (items, i + 3);
b7c49376
RS
5444 if (NILP (string))
5445 break;
9e20143a 5446 if (column >= XINT (pos)
d5db4077 5447 && column < XINT (pos) + SCHARS (string))
b7c49376 5448 {
129004d3 5449 item = AREF (items, i);
b7c49376
RS
5450 break;
5451 }
5ec75a55 5452 }
9e20143a 5453
7ee32cda
GM
5454 /* ELisp manual 2.4b says (x y) are window relative but
5455 code says they are frame-relative. */
5ec75a55
RS
5456 position
5457 = Fcons (event->frame_or_window,
5458 Fcons (Qmenu_bar,
5459 Fcons (Fcons (event->x, event->y),
5460 Fcons (make_number (event->timestamp),
5461 Qnil))));
5462
b7c49376 5463 return Fcons (item, Fcons (position, Qnil));
5ec75a55 5464 }
488dd4c4 5465#endif /* not USE_X_TOOLKIT && not USE_GTK */
0aafc975 5466
3d566707
KS
5467 position = make_lispy_position (f, &event->x, &event->y,
5468 event->timestamp);
284f4730 5469 }
7ee32cda 5470#ifndef USE_TOOLKIT_SCROLL_BARS
7b4aedb9 5471 else
88cb0656 5472 {
7ee32cda 5473 /* It's a scrollbar click. */
3d566707 5474 Lisp_Object window;
9e20143a
RS
5475 Lisp_Object portion_whole;
5476 Lisp_Object part;
5477
5478 window = event->frame_or_window;
5479 portion_whole = Fcons (event->x, event->y);
5480 part = *scroll_bar_parts[(int) event->part];
7b4aedb9 5481
db08707d
RS
5482 position
5483 = Fcons (window,
5484 Fcons (Qvertical_scroll_bar,
5485 Fcons (portion_whole,
5486 Fcons (make_number (event->timestamp),
5487 Fcons (part, Qnil)))));
88cb0656 5488 }
7ee32cda 5489#endif /* not USE_TOOLKIT_SCROLL_BARS */
88cb0656 5490
129004d3 5491 if (button >= ASIZE (button_down_location))
8e1e4240
GM
5492 {
5493 button_down_location = larger_vector (button_down_location,
5494 button + 1, Qnil);
5495 mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
5496 }
c60ee5e7 5497
129004d3 5498 start_pos_ptr = &AREF (button_down_location, button);
dbc4e1c1
JB
5499 start_pos = *start_pos_ptr;
5500 *start_pos_ptr = Qnil;
7b4aedb9 5501
c5cf2109
GM
5502 {
5503 /* On window-system frames, use the value of
5504 double-click-fuzz as is. On other frames, interpret it
5505 as a multiple of 1/8 characters. */
5506 struct frame *f;
5507 int fuzz;
5508
5509 if (WINDOWP (event->frame_or_window))
5510 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
5511 else if (FRAMEP (event->frame_or_window))
5512 f = XFRAME (event->frame_or_window);
5513 else
5514 abort ();
5515
5516 if (FRAME_WINDOW_P (f))
5517 fuzz = double_click_fuzz;
5518 else
5519 fuzz = double_click_fuzz / 8;
5520
5521 is_double = (button == last_mouse_button
5522 && (abs (XINT (event->x) - last_mouse_x) <= fuzz)
5523 && (abs (XINT (event->y) - last_mouse_y) <= fuzz)
5524 && button_down_time != 0
5525 && (EQ (Vdouble_click_time, Qt)
5526 || (INTEGERP (Vdouble_click_time)
5527 && ((int)(event->timestamp - button_down_time)
5528 < XINT (Vdouble_click_time)))));
5529 }
c60ee5e7 5530
559f9d04
RS
5531 last_mouse_button = button;
5532 last_mouse_x = XINT (event->x);
5533 last_mouse_y = XINT (event->y);
5534
7b4aedb9
JB
5535 /* If this is a button press, squirrel away the location, so
5536 we can decide later whether it was a click or a drag. */
5537 if (event->modifiers & down_modifier)
559f9d04
RS
5538 {
5539 if (is_double)
5540 {
5541 double_click_count++;
5542 event->modifiers |= ((double_click_count > 2)
5543 ? triple_modifier
5544 : double_modifier);
5545 }
5546 else
5547 double_click_count = 1;
5548 button_down_time = event->timestamp;
5549 *start_pos_ptr = Fcopy_alist (position);
5550 }
7b4aedb9 5551
88cb0656 5552 /* Now we're releasing a button - check the co-ordinates to
7b4aedb9 5553 see if this was a click or a drag. */
88cb0656
JB
5554 else if (event->modifiers & up_modifier)
5555 {
129004d3
GM
5556 /* If we did not see a down before this up, ignore the up.
5557 Probably this happened because the down event chose a
5558 menu item. It would be an annoyance to treat the
5559 release of the button that chose the menu item as a
5560 separate event. */
48e416d4 5561
8c18cbfb 5562 if (!CONSP (start_pos))
48e416d4
RS
5563 return Qnil;
5564
88cb0656 5565 event->modifiers &= ~up_modifier;
48e416d4 5566#if 0 /* Formerly we treated an up with no down as a click event. */
8c18cbfb 5567 if (!CONSP (start_pos))
dbc4e1c1
JB
5568 event->modifiers |= click_modifier;
5569 else
48e416d4 5570#endif
dbc4e1c1 5571 {
9b8eb840 5572 Lisp_Object down;
d31053f9 5573 EMACS_INT xdiff = double_click_fuzz, ydiff = double_click_fuzz;
dbc4e1c1 5574
d31053f9
RS
5575 /* The third element of every position
5576 should be the (x,y) pair. */
5577 down = Fcar (Fcdr (Fcdr (start_pos)));
7a6a97d7
SM
5578 if (CONSP (down)
5579 && INTEGERP (XCAR (down)) && INTEGERP (XCDR (down)))
d31053f9 5580 {
4156359e
SM
5581 xdiff = XINT (event->x) - XINT (XCAR (down));
5582 ydiff = XINT (event->y) - XINT (XCDR (down));
d31053f9
RS
5583 }
5584
5585 if (xdiff < double_click_fuzz && xdiff > - double_click_fuzz
4156359e
SM
5586 && ydiff < double_click_fuzz && ydiff > - double_click_fuzz
5587 /* Maybe the mouse has moved a lot, caused scrolling, and
5588 eventually ended up at the same screen position (but
5589 not buffer position) in which case it is a drag, not
5590 a click. */
5591 /* FIXME: OTOH if the buffer position has changed
5592 because of a timer or process filter rather than
5593 because of mouse movement, it should be considered as
5594 a click. But mouse-drag-region completely ignores
5595 this case and it hasn't caused any real problem, so
5596 it's probably OK to ignore it as well. */
5597 && EQ (Fcar (Fcdr (start_pos)), Fcar (Fcdr (position))))
d31053f9 5598 /* Mouse hasn't moved (much). */
129004d3 5599 event->modifiers |= click_modifier;
fbcd35bd
JB
5600 else
5601 {
d31053f9
RS
5602 button_down_time = 0;
5603 event->modifiers |= drag_modifier;
fbcd35bd 5604 }
c60ee5e7 5605
bc536d84
RS
5606 /* Don't check is_double; treat this as multiple
5607 if the down-event was multiple. */
5608 if (double_click_count > 1)
5609 event->modifiers |= ((double_click_count > 2)
5610 ? triple_modifier
5611 : double_modifier);
dbc4e1c1 5612 }
88cb0656
JB
5613 }
5614 else
5615 /* Every mouse event should either have the down_modifier or
7b4aedb9 5616 the up_modifier set. */
88cb0656
JB
5617 abort ();
5618
88cb0656 5619 {
7b4aedb9 5620 /* Get the symbol we should use for the mouse click. */
9b8eb840
KH
5621 Lisp_Object head;
5622
5623 head = modify_event_symbol (button,
5624 event->modifiers,
8e1e4240
GM
5625 Qmouse_click, Vlispy_mouse_stem,
5626 NULL,
5627 &mouse_syms,
5628 XVECTOR (mouse_syms)->size);
88cb0656 5629 if (event->modifiers & drag_modifier)
dbc4e1c1
JB
5630 return Fcons (head,
5631 Fcons (start_pos,
5632 Fcons (position,
5633 Qnil)));
fbcd35bd
JB
5634 else if (event->modifiers & (double_modifier | triple_modifier))
5635 return Fcons (head,
5636 Fcons (position,
5637 Fcons (make_number (double_click_count),
5638 Qnil)));
88cb0656
JB
5639 else
5640 return Fcons (head,
7b4aedb9 5641 Fcons (position,
88cb0656
JB
5642 Qnil));
5643 }
284f4730 5644 }
db08707d 5645
8006e4bb
JR
5646 case WHEEL_EVENT:
5647 {
5648 Lisp_Object position;
8006e4bb 5649 Lisp_Object head;
2320865d 5650
87d386ff 5651 /* Build the position as appropriate for this mouse click. */
87d386ff 5652 struct frame *f = XFRAME (event->frame_or_window);
87d386ff
JR
5653
5654 /* Ignore wheel events that were made on frame that have been
5655 deleted. */
5656 if (! FRAME_LIVE_P (f))
5657 return Qnil;
5658
3d566707
KS
5659 position = make_lispy_position (f, &event->x, &event->y,
5660 event->timestamp);
87d386ff
JR
5661
5662 /* Set double or triple modifiers to indicate the wheel speed. */
5663 {
5664 /* On window-system frames, use the value of
5665 double-click-fuzz as is. On other frames, interpret it
5666 as a multiple of 1/8 characters. */
5667 struct frame *f;
5668 int fuzz;
5669 int is_double;
5670
5671 if (WINDOWP (event->frame_or_window))
5672 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
5673 else if (FRAMEP (event->frame_or_window))
5674 f = XFRAME (event->frame_or_window);
5675 else
5676 abort ();
5677
5678 if (FRAME_WINDOW_P (f))
5679 fuzz = double_click_fuzz;
5680 else
5681 fuzz = double_click_fuzz / 8;
5682
5683 is_double = (last_mouse_button < 0
5684 && (abs (XINT (event->x) - last_mouse_x) <= fuzz)
5685 && (abs (XINT (event->y) - last_mouse_y) <= fuzz)
5686 && button_down_time != 0
5687 && (EQ (Vdouble_click_time, Qt)
5688 || (INTEGERP (Vdouble_click_time)
5689 && ((int)(event->timestamp - button_down_time)
5690 < XINT (Vdouble_click_time)))));
5691 if (is_double)
5692 {
5693 double_click_count++;
5694 event->modifiers |= ((double_click_count > 2)
5695 ? triple_modifier
5696 : double_modifier);
5697 }
5698 else
5699 {
5700 double_click_count = 1;
5701 event->modifiers |= click_modifier;
5702 }
5703
5704 button_down_time = event->timestamp;
5705 /* Use a negative value to distinguish wheel from mouse button. */
5706 last_mouse_button = -1;
5707 last_mouse_x = XINT (event->x);
5708 last_mouse_y = XINT (event->y);
5709 }
5710
5711 {
5712 int symbol_num;
5713
5714 if (event->modifiers & up_modifier)
5715 {
5716 /* Emit a wheel-up event. */
5717 event->modifiers &= ~up_modifier;
5718 symbol_num = 0;
5719 }
5720 else if (event->modifiers & down_modifier)
5721 {
5722 /* Emit a wheel-down event. */
5723 event->modifiers &= ~down_modifier;
5724 symbol_num = 1;
5725 }
5726 else
5727 /* Every wheel event should either have the down_modifier or
5728 the up_modifier set. */
5729 abort ();
5730
5731 /* Get the symbol we should use for the wheel event. */
5732 head = modify_event_symbol (symbol_num,
5733 event->modifiers,
5734 Qmouse_click,
5735 Qnil,
5736 lispy_wheel_names,
5737 &wheel_syms,
5738 ASIZE (wheel_syms));
5739 }
5740
5741 if (event->modifiers & (double_modifier | triple_modifier))
5742 return Fcons (head,
5743 Fcons (position,
5744 Fcons (make_number (double_click_count),
5745 Qnil)));
5746 else
5747 return Fcons (head,
5748 Fcons (position,
5749 Qnil));
8006e4bb
JR
5750 }
5751
5752
05be3964 5753#ifdef USE_TOOLKIT_SCROLL_BARS
7ee32cda
GM
5754
5755 /* We don't have down and up events if using toolkit scroll bars,
5756 so make this always a click event. Store in the `part' of
5757 the Lisp event a symbol which maps to the following actions:
5758
5759 `above_handle' page up
5760 `below_handle' page down
5761 `up' line up
5762 `down' line down
5763 `top' top of buffer
5764 `bottom' bottom of buffer
5765 `handle' thumb has been dragged.
5766 `end-scroll' end of interaction with scroll bar
5767
5768 The incoming input_event contains in its `part' member an
5769 index of type `enum scroll_bar_part' which we can use as an
5770 index in scroll_bar_parts to get the appropriate symbol. */
c60ee5e7 5771
3b8f9651 5772 case SCROLL_BAR_CLICK_EVENT:
7ee32cda
GM
5773 {
5774 Lisp_Object position, head, window, portion_whole, part;
5775
5776 window = event->frame_or_window;
5777 portion_whole = Fcons (event->x, event->y);
5778 part = *scroll_bar_parts[(int) event->part];
5779
5780 position
5781 = Fcons (window,
5782 Fcons (Qvertical_scroll_bar,
5783 Fcons (portion_whole,
5784 Fcons (make_number (event->timestamp),
5785 Fcons (part, Qnil)))));
5786
5787 /* Always treat scroll bar events as clicks. */
5788 event->modifiers |= click_modifier;
05be3964 5789 event->modifiers &= ~up_modifier;
7ee32cda 5790
257f40f2
JD
5791 if (event->code >= ASIZE (mouse_syms))
5792 mouse_syms = larger_vector (mouse_syms, event->code + 1, Qnil);
5793
7ee32cda
GM
5794 /* Get the symbol we should use for the mouse click. */
5795 head = modify_event_symbol (event->code,
5796 event->modifiers,
14e40288 5797 Qmouse_click,
8e1e4240
GM
5798 Vlispy_mouse_stem,
5799 NULL, &mouse_syms,
5800 XVECTOR (mouse_syms)->size);
7ee32cda
GM
5801 return Fcons (head, Fcons (position, Qnil));
5802 }
c60ee5e7 5803
7ee32cda
GM
5804#endif /* USE_TOOLKIT_SCROLL_BARS */
5805
db08707d 5806#ifdef WINDOWSNT
3b8f9651 5807 case W32_SCROLL_BAR_CLICK_EVENT:
db08707d
RS
5808 {
5809 int button = event->code;
5810 int is_double;
5811 Lisp_Object position;
5812 Lisp_Object *start_pos_ptr;
5813 Lisp_Object start_pos;
5814
db08707d
RS
5815 {
5816 Lisp_Object window;
5817 Lisp_Object portion_whole;
5818 Lisp_Object part;
5819
5820 window = event->frame_or_window;
5821 portion_whole = Fcons (event->x, event->y);
5822 part = *scroll_bar_parts[(int) event->part];
5823
e8886a1d
RS
5824 position
5825 = Fcons (window,
5826 Fcons (Qvertical_scroll_bar,
5827 Fcons (portion_whole,
5828 Fcons (make_number (event->timestamp),
5829 Fcons (part, Qnil)))));
db08707d
RS
5830 }
5831
fbd6baed 5832 /* Always treat W32 scroll bar events as clicks. */
db08707d
RS
5833 event->modifiers |= click_modifier;
5834
5835 {
5836 /* Get the symbol we should use for the mouse click. */
5837 Lisp_Object head;
5838
5839 head = modify_event_symbol (button,
5840 event->modifiers,
c60ee5e7 5841 Qmouse_click,
8e1e4240
GM
5842 Vlispy_mouse_stem,
5843 NULL, &mouse_syms,
5844 XVECTOR (mouse_syms)->size);
db08707d
RS
5845 return Fcons (head,
5846 Fcons (position,
5847 Qnil));
5848 }
5849 }
1e7c162f 5850#endif /* WINDOWSNT */
a24dc617 5851
3b8f9651 5852 case DRAG_N_DROP_EVENT:
a24dc617 5853 {
a24dc617 5854 FRAME_PTR f;
3d566707 5855 Lisp_Object head, position;
a24dc617 5856 Lisp_Object files;
a24dc617
RS
5857
5858 /* The frame_or_window field should be a cons of the frame in
5859 which the event occurred and a list of the filenames
5860 dropped. */
5861 if (! CONSP (event->frame_or_window))
5862 abort ();
5863
7539e11f
KR
5864 f = XFRAME (XCAR (event->frame_or_window));
5865 files = XCDR (event->frame_or_window);
a24dc617
RS
5866
5867 /* Ignore mouse events that were made on frames that
5868 have been deleted. */
5869 if (! FRAME_LIVE_P (f))
5870 return Qnil;
afabdbe5 5871
3d566707
KS
5872 position = make_lispy_position (f, &event->x, &event->y,
5873 event->timestamp);
5874
5875 head = modify_event_symbol (0, event->modifiers,
5876 Qdrag_n_drop, Qnil,
5877 lispy_drag_n_drop_names,
5878 &drag_n_drop_syms, 1);
5879 return Fcons (head,
5880 Fcons (position,
5881 Fcons (files,
5882 Qnil)));
a24dc617 5883 }
514354e9 5884#endif /* HAVE_MOUSE */
284f4730 5885
488dd4c4
JD
5886#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
5887 || defined (USE_GTK)
da8f7368
GM
5888 case MENU_BAR_EVENT:
5889 if (EQ (event->arg, event->frame_or_window))
5890 /* This is the prefix key. We translate this to
5891 `(menu_bar)' because the code in keyboard.c for menu
5892 events, which we use, relies on this. */
5893 return Fcons (Qmenu_bar, Qnil);
5894 return event->arg;
2470a66f
KH
5895#endif
5896
a4e19f6e
SM
5897 case SELECT_WINDOW_EVENT:
5898 /* Make an event (select-window (WINDOW)). */
5899 return Fcons (Qselect_window,
5900 Fcons (Fcons (event->frame_or_window, Qnil),
5901 Qnil));
5902
9ea173e8 5903 case TOOL_BAR_EVENT:
da8f7368
GM
5904 if (EQ (event->arg, event->frame_or_window))
5905 /* This is the prefix key. We translate this to
27fd22dc 5906 `(tool_bar)' because the code in keyboard.c for tool bar
da8f7368
GM
5907 events, which we use, relies on this. */
5908 return Fcons (Qtool_bar, Qnil);
5909 else if (SYMBOLP (event->arg))
5910 return apply_modifiers (event->modifiers, event->arg);
5911 return event->arg;
5912
5913 case USER_SIGNAL_EVENT:
5bf68f6e
AS
5914 /* A user signal. */
5915 return *lispy_user_signals[event->code];
c60ee5e7 5916
3b8f9651 5917 case SAVE_SESSION_EVENT:
4ebc27a5 5918 return Qsave_session;
c60ee5e7 5919
284f4730
JB
5920 /* The 'kind' field of the event is something we don't recognize. */
5921 default:
48e416d4 5922 abort ();
284f4730
JB
5923 }
5924}
5925
514354e9 5926#ifdef HAVE_MOUSE
6cbff1cb 5927
284f4730 5928static Lisp_Object
7b4aedb9 5929make_lispy_movement (frame, bar_window, part, x, y, time)
ff11dfa1 5930 FRAME_PTR frame;
7b4aedb9 5931 Lisp_Object bar_window;
3c370943 5932 enum scroll_bar_part part;
284f4730 5933 Lisp_Object x, y;
e5d77022 5934 unsigned long time;
284f4730 5935{
3c370943 5936 /* Is it a scroll bar movement? */
7b4aedb9 5937 if (frame && ! NILP (bar_window))
4bb994d1 5938 {
9b8eb840 5939 Lisp_Object part_sym;
4bb994d1 5940
9b8eb840 5941 part_sym = *scroll_bar_parts[(int) part];
3c370943 5942 return Fcons (Qscroll_bar_movement,
7b4aedb9 5943 (Fcons (Fcons (bar_window,
3c370943 5944 Fcons (Qvertical_scroll_bar,
4bb994d1
JB
5945 Fcons (Fcons (x, y),
5946 Fcons (make_number (time),
cb5df6ae 5947 Fcons (part_sym,
4bb994d1
JB
5948 Qnil))))),
5949 Qnil)));
5950 }
5951
5952 /* Or is it an ordinary mouse movement? */
284f4730
JB
5953 else
5954 {
3d566707 5955 Lisp_Object position;
4bb994d1 5956
3d566707 5957 position = make_lispy_position (frame, &x, &y, time);
284f4730 5958
4bb994d1 5959 return Fcons (Qmouse_movement,
3d566707 5960 Fcons (position,
4bb994d1
JB
5961 Qnil));
5962 }
284f4730
JB
5963}
5964
514354e9 5965#endif /* HAVE_MOUSE */
6cbff1cb 5966
cd21b839
JB
5967/* Construct a switch frame event. */
5968static Lisp_Object
5969make_lispy_switch_frame (frame)
5970 Lisp_Object frame;
5971{
5972 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
5973}
0a7f1fc0
JB
5974\f
5975/* Manipulating modifiers. */
284f4730 5976
0a7f1fc0 5977/* Parse the name of SYMBOL, and return the set of modifiers it contains.
284f4730 5978
0a7f1fc0
JB
5979 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
5980 SYMBOL's name of the end of the modifiers; the string from this
5981 position is the unmodified symbol name.
284f4730 5982
0a7f1fc0 5983 This doesn't use any caches. */
6da3dd3a 5984
0a7f1fc0
JB
5985static int
5986parse_modifiers_uncached (symbol, modifier_end)
284f4730 5987 Lisp_Object symbol;
0a7f1fc0 5988 int *modifier_end;
284f4730 5989{
1b049b51 5990 Lisp_Object name;
284f4730
JB
5991 int i;
5992 int modifiers;
284f4730 5993
b7826503 5994 CHECK_SYMBOL (symbol);
df0f2ba1 5995
284f4730 5996 modifiers = 0;
1b049b51 5997 name = SYMBOL_NAME (symbol);
284f4730 5998
1b049b51 5999 for (i = 0; i+2 <= SBYTES (name); )
6da3dd3a
RS
6000 {
6001 int this_mod_end = 0;
6002 int this_mod = 0;
284f4730 6003
6da3dd3a
RS
6004 /* See if the name continues with a modifier word.
6005 Check that the word appears, but don't check what follows it.
6006 Set this_mod and this_mod_end to record what we find. */
fce33686 6007
1b049b51 6008 switch (SREF (name, i))
6da3dd3a
RS
6009 {
6010#define SINGLE_LETTER_MOD(BIT) \
6011 (this_mod_end = i + 1, this_mod = BIT)
6012
6da3dd3a
RS
6013 case 'A':
6014 SINGLE_LETTER_MOD (alt_modifier);
6015 break;
284f4730 6016
6da3dd3a
RS
6017 case 'C':
6018 SINGLE_LETTER_MOD (ctrl_modifier);
6019 break;
284f4730 6020
6da3dd3a
RS
6021 case 'H':
6022 SINGLE_LETTER_MOD (hyper_modifier);
6023 break;
6024
6da3dd3a
RS
6025 case 'M':
6026 SINGLE_LETTER_MOD (meta_modifier);
6027 break;
6028
6da3dd3a
RS
6029 case 'S':
6030 SINGLE_LETTER_MOD (shift_modifier);
6031 break;
6032
6033 case 's':
6da3dd3a
RS
6034 SINGLE_LETTER_MOD (super_modifier);
6035 break;
6036
0a7f1fc0 6037#undef SINGLE_LETTER_MOD
65470b52
SM
6038
6039#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6040 if (i + LEN + 1 <= SBYTES (name) \
6041 && ! strncmp (SDATA (name) + i, NAME, LEN)) \
6042 { \
6043 this_mod_end = i + LEN; \
6044 this_mod = BIT; \
6045 }
6046
6047 case 'd':
6048 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6049 MULTI_LETTER_MOD (down_modifier, "down", 4);
6050 MULTI_LETTER_MOD (double_modifier, "double", 6);
6051 break;
6052
6053 case 't':
6054 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6055 break;
6056#undef MULTI_LETTER_MOD
6057
6da3dd3a
RS
6058 }
6059
6060 /* If we found no modifier, stop looking for them. */
6061 if (this_mod_end == 0)
6062 break;
6063
6064 /* Check there is a dash after the modifier, so that it
6065 really is a modifier. */
1b049b51
KR
6066 if (this_mod_end >= SBYTES (name)
6067 || SREF (name, this_mod_end) != '-')
6da3dd3a
RS
6068 break;
6069
6070 /* This modifier is real; look for another. */
6071 modifiers |= this_mod;
6072 i = this_mod_end + 1;
6073 }
284f4730 6074
0a7f1fc0 6075 /* Should we include the `click' modifier? */
fbcd35bd
JB
6076 if (! (modifiers & (down_modifier | drag_modifier
6077 | double_modifier | triple_modifier))
1b049b51
KR
6078 && i + 7 == SBYTES (name)
6079 && strncmp (SDATA (name) + i, "mouse-", 6) == 0
6080 && ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9'))
0a7f1fc0
JB
6081 modifiers |= click_modifier;
6082
6083 if (modifier_end)
6084 *modifier_end = i;
6085
6086 return modifiers;
6087}
6088
0a7f1fc0
JB
6089/* Return a symbol whose name is the modifier prefixes for MODIFIERS
6090 prepended to the string BASE[0..BASE_LEN-1].
6091 This doesn't use any caches. */
6092static Lisp_Object
301738ed 6093apply_modifiers_uncached (modifiers, base, base_len, base_len_byte)
0a7f1fc0
JB
6094 int modifiers;
6095 char *base;
301738ed 6096 int base_len, base_len_byte;
0a7f1fc0
JB
6097{
6098 /* Since BASE could contain nulls, we can't use intern here; we have
6099 to use Fintern, which expects a genuine Lisp_String, and keeps a
6100 reference to it. */
301738ed
RS
6101 char *new_mods
6102 = (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
0a7f1fc0 6103 int mod_len;
284f4730 6104
284f4730 6105 {
0a7f1fc0
JB
6106 char *p = new_mods;
6107
6108 /* Only the event queue may use the `up' modifier; it should always
6109 be turned into a click or drag event before presented to lisp code. */
6110 if (modifiers & up_modifier)
6111 abort ();
6112
6113 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
6114 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
6115 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
6116 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
6117 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
86e5706b 6118 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
fbcd35bd
JB
6119 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
6120 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
559f9d04
RS
6121 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
6122 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
0a7f1fc0
JB
6123 /* The click modifier is denoted by the absence of other modifiers. */
6124
6125 *p = '\0';
6126
6127 mod_len = p - new_mods;
6128 }
284f4730 6129
0a7f1fc0 6130 {
9b8eb840 6131 Lisp_Object new_name;
df0f2ba1 6132
301738ed
RS
6133 new_name = make_uninit_multibyte_string (mod_len + base_len,
6134 mod_len + base_len_byte);
d5db4077
KR
6135 bcopy (new_mods, SDATA (new_name), mod_len);
6136 bcopy (base, SDATA (new_name) + mod_len, base_len_byte);
284f4730
JB
6137
6138 return Fintern (new_name, Qnil);
6139 }
6140}
6141
6142
0a7f1fc0
JB
6143static char *modifier_names[] =
6144{
fbcd35bd 6145 "up", "down", "drag", "click", "double", "triple", 0, 0,
f335fabe 6146 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
86e5706b 6147 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
0a7f1fc0 6148};
80645119 6149#define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
0a7f1fc0
JB
6150
6151static Lisp_Object modifier_symbols;
6152
6153/* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
6154static Lisp_Object
6155lispy_modifier_list (modifiers)
6156 int modifiers;
6157{
6158 Lisp_Object modifier_list;
6159 int i;
6160
6161 modifier_list = Qnil;
80645119 6162 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
0a7f1fc0 6163 if (modifiers & (1<<i))
80645119
JB
6164 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
6165 modifier_list);
0a7f1fc0
JB
6166
6167 return modifier_list;
6168}
6169
6170
6171/* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
6172 where UNMODIFIED is the unmodified form of SYMBOL,
6173 MASK is the set of modifiers present in SYMBOL's name.
6174 This is similar to parse_modifiers_uncached, but uses the cache in
6175 SYMBOL's Qevent_symbol_element_mask property, and maintains the
6176 Qevent_symbol_elements property. */
3d31316f 6177
1161d367 6178Lisp_Object
0a7f1fc0
JB
6179parse_modifiers (symbol)
6180 Lisp_Object symbol;
6181{
9b8eb840 6182 Lisp_Object elements;
0a7f1fc0 6183
9b8eb840 6184 elements = Fget (symbol, Qevent_symbol_element_mask);
0a7f1fc0
JB
6185 if (CONSP (elements))
6186 return elements;
6187 else
6188 {
6189 int end;
ec0faad2 6190 int modifiers = parse_modifiers_uncached (symbol, &end);
9b8eb840 6191 Lisp_Object unmodified;
0a7f1fc0
JB
6192 Lisp_Object mask;
6193
d5db4077
KR
6194 unmodified = Fintern (make_string (SDATA (SYMBOL_NAME (symbol)) + end,
6195 SBYTES (SYMBOL_NAME (symbol)) - end),
9b8eb840
KH
6196 Qnil);
6197
e22216b8 6198 if (modifiers & ~INTMASK)
734fef94 6199 abort ();
bb9e9bed 6200 XSETFASTINT (mask, modifiers);
0a7f1fc0
JB
6201 elements = Fcons (unmodified, Fcons (mask, Qnil));
6202
6203 /* Cache the parsing results on SYMBOL. */
6204 Fput (symbol, Qevent_symbol_element_mask,
6205 elements);
6206 Fput (symbol, Qevent_symbol_elements,
6207 Fcons (unmodified, lispy_modifier_list (modifiers)));
6208
6209 /* Since we know that SYMBOL is modifiers applied to unmodified,
6210 it would be nice to put that in unmodified's cache.
6211 But we can't, since we're not sure that parse_modifiers is
6212 canonical. */
6213
6214 return elements;
6215 }
6216}
6217
6218/* Apply the modifiers MODIFIERS to the symbol BASE.
6219 BASE must be unmodified.
6220
6221 This is like apply_modifiers_uncached, but uses BASE's
6222 Qmodifier_cache property, if present. It also builds
cd21b839
JB
6223 Qevent_symbol_elements properties, since it has that info anyway.
6224
6225 apply_modifiers copies the value of BASE's Qevent_kind property to
6226 the modified symbol. */
0a7f1fc0
JB
6227static Lisp_Object
6228apply_modifiers (modifiers, base)
6229 int modifiers;
6230 Lisp_Object base;
6231{
7b4aedb9 6232 Lisp_Object cache, index, entry, new_symbol;
0a7f1fc0 6233
80645119 6234 /* Mask out upper bits. We don't know where this value's been. */
e22216b8 6235 modifiers &= INTMASK;
80645119 6236
0a7f1fc0 6237 /* The click modifier never figures into cache indices. */
0a7f1fc0 6238 cache = Fget (base, Qmodifier_cache);
bb9e9bed 6239 XSETFASTINT (index, (modifiers & ~click_modifier));
697e4895 6240 entry = assq_no_quit (index, cache);
0a7f1fc0
JB
6241
6242 if (CONSP (entry))
7539e11f 6243 new_symbol = XCDR (entry);
7b4aedb9
JB
6244 else
6245 {
df0f2ba1 6246 /* We have to create the symbol ourselves. */
7b4aedb9 6247 new_symbol = apply_modifiers_uncached (modifiers,
d5db4077
KR
6248 SDATA (SYMBOL_NAME (base)),
6249 SCHARS (SYMBOL_NAME (base)),
6250 SBYTES (SYMBOL_NAME (base)));
7b4aedb9
JB
6251
6252 /* Add the new symbol to the base's cache. */
6253 entry = Fcons (index, new_symbol);
6254 Fput (base, Qmodifier_cache, Fcons (entry, cache));
6255
35fb885d
SM
6256 /* We have the parsing info now for free, so we could add it to
6257 the caches:
6258 XSETFASTINT (index, modifiers);
6259 Fput (new_symbol, Qevent_symbol_element_mask,
6260 Fcons (base, Fcons (index, Qnil)));
6261 Fput (new_symbol, Qevent_symbol_elements,
6262 Fcons (base, lispy_modifier_list (modifiers)));
6263 Sadly, this is only correct if `base' is indeed a base event,
6264 which is not necessarily the case. -stef */
7b4aedb9 6265 }
0a7f1fc0 6266
df0f2ba1 6267 /* Make sure this symbol is of the same kind as BASE.
7b4aedb9
JB
6268
6269 You'd think we could just set this once and for all when we
6270 intern the symbol above, but reorder_modifiers may call us when
6271 BASE's property isn't set right; we can't assume that just
80645119
JB
6272 because it has a Qmodifier_cache property it must have its
6273 Qevent_kind set right as well. */
7b4aedb9
JB
6274 if (NILP (Fget (new_symbol, Qevent_kind)))
6275 {
9b8eb840 6276 Lisp_Object kind;
7b4aedb9 6277
9b8eb840 6278 kind = Fget (base, Qevent_kind);
7b4aedb9
JB
6279 if (! NILP (kind))
6280 Fput (new_symbol, Qevent_kind, kind);
6281 }
6282
6283 return new_symbol;
0a7f1fc0
JB
6284}
6285
6286
6287/* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
6288 return a symbol with the modifiers placed in the canonical order.
6289 Canonical order is alphabetical, except for down and drag, which
6290 always come last. The 'click' modifier is never written out.
6291
6292 Fdefine_key calls this to make sure that (for example) C-M-foo
6293 and M-C-foo end up being equivalent in the keymap. */
6294
6295Lisp_Object
6296reorder_modifiers (symbol)
6297 Lisp_Object symbol;
6298{
6299 /* It's hopefully okay to write the code this way, since everything
6300 will soon be in caches, and no consing will be done at all. */
9b8eb840 6301 Lisp_Object parsed;
0a7f1fc0 6302
9b8eb840 6303 parsed = parse_modifiers (symbol);
7539e11f
KR
6304 return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))),
6305 XCAR (parsed));
0a7f1fc0
JB
6306}
6307
6308
284f4730
JB
6309/* For handling events, we often want to produce a symbol whose name
6310 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
6311 to some base, like the name of a function key or mouse button.
6312 modify_event_symbol produces symbols of this sort.
6313
6314 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
6315 is the name of the i'th symbol. TABLE_SIZE is the number of elements
6316 in the table.
6317
8e1e4240
GM
6318 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
6319 into symbol names, or a string specifying a name stem used to
a50e723f 6320 construct a symbol name or the form `STEM-N', where N is the decimal
8e1e4240
GM
6321 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
6322 non-nil; otherwise NAME_TABLE is used.
80e4aa30 6323
284f4730
JB
6324 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
6325 persist between calls to modify_event_symbol that it can use to
6326 store a cache of the symbols it's generated for this NAME_TABLE
80e4aa30 6327 before. The object stored there may be a vector or an alist.
284f4730
JB
6328
6329 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
df0f2ba1 6330
284f4730
JB
6331 MODIFIERS is a set of modifier bits (as given in struct input_events)
6332 whose prefixes should be applied to the symbol name.
6333
6334 SYMBOL_KIND is the value to be placed in the event_kind property of
df0f2ba1 6335 the returned symbol.
88cb0656
JB
6336
6337 The symbols we create are supposed to have an
eb8c3be9 6338 `event-symbol-elements' property, which lists the modifiers present
88cb0656
JB
6339 in the symbol's name. */
6340
284f4730 6341static Lisp_Object
8e1e4240 6342modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist_or_stem,
80e4aa30 6343 name_table, symbol_table, table_size)
284f4730
JB
6344 int symbol_num;
6345 unsigned modifiers;
6346 Lisp_Object symbol_kind;
8e1e4240 6347 Lisp_Object name_alist_or_stem;
284f4730
JB
6348 char **name_table;
6349 Lisp_Object *symbol_table;
2c834fb3 6350 unsigned int table_size;
284f4730 6351{
80e4aa30
RS
6352 Lisp_Object value;
6353 Lisp_Object symbol_int;
6354
2c834fb3
KH
6355 /* Get rid of the "vendor-specific" bit here. */
6356 XSETINT (symbol_int, symbol_num & 0xffffff);
284f4730
JB
6357
6358 /* Is this a request for a valid symbol? */
88cb0656 6359 if (symbol_num < 0 || symbol_num >= table_size)
0c2611c5 6360 return Qnil;
284f4730 6361
80e4aa30
RS
6362 if (CONSP (*symbol_table))
6363 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
6364
0a7f1fc0 6365 /* If *symbol_table doesn't seem to be initialized properly, fix that.
88cb0656 6366 *symbol_table should be a lisp vector TABLE_SIZE elements long,
4bb994d1
JB
6367 where the Nth element is the symbol for NAME_TABLE[N], or nil if
6368 we've never used that symbol before. */
80e4aa30 6369 else
88cb0656 6370 {
80e4aa30
RS
6371 if (! VECTORP (*symbol_table)
6372 || XVECTOR (*symbol_table)->size != table_size)
6373 {
6374 Lisp_Object size;
0a7f1fc0 6375
bb9e9bed 6376 XSETFASTINT (size, table_size);
80e4aa30
RS
6377 *symbol_table = Fmake_vector (size, Qnil);
6378 }
284f4730 6379
80e4aa30
RS
6380 value = XVECTOR (*symbol_table)->contents[symbol_num];
6381 }
284f4730 6382
0a7f1fc0 6383 /* Have we already used this symbol before? */
80e4aa30 6384 if (NILP (value))
284f4730 6385 {
0a7f1fc0 6386 /* No; let's create it. */
8e1e4240
GM
6387 if (CONSP (name_alist_or_stem))
6388 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
6389 else if (STRINGP (name_alist_or_stem))
6390 {
d5db4077 6391 int len = SBYTES (name_alist_or_stem);
8e1e4240 6392 char *buf = (char *) alloca (len + 50);
987a3489
KL
6393 sprintf (buf, "%s-%ld", SDATA (name_alist_or_stem),
6394 (long) XINT (symbol_int) + 1);
8e1e4240
GM
6395 value = intern (buf);
6396 }
2ff6714d 6397 else if (name_table != 0 && name_table[symbol_num])
80e4aa30 6398 value = intern (name_table[symbol_num]);
b64b4075 6399
e98a93eb 6400#ifdef HAVE_WINDOW_SYSTEM
2c834fb3
KH
6401 if (NILP (value))
6402 {
6403 char *name = x_get_keysym_name (symbol_num);
6404 if (name)
6405 value = intern (name);
6406 }
6407#endif
6408
b64b4075 6409 if (NILP (value))
d1f50460
RS
6410 {
6411 char buf[20];
6412 sprintf (buf, "key-%d", symbol_num);
80e4aa30 6413 value = intern (buf);
d1f50460 6414 }
0a7f1fc0 6415
80e4aa30 6416 if (CONSP (*symbol_table))
4205cb08 6417 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
80e4aa30
RS
6418 else
6419 XVECTOR (*symbol_table)->contents[symbol_num] = value;
6420
df0f2ba1 6421 /* Fill in the cache entries for this symbol; this also
0a7f1fc0
JB
6422 builds the Qevent_symbol_elements property, which the user
6423 cares about. */
80e4aa30
RS
6424 apply_modifiers (modifiers & click_modifier, value);
6425 Fput (value, Qevent_kind, symbol_kind);
284f4730 6426 }
88cb0656 6427
0a7f1fc0 6428 /* Apply modifiers to that symbol. */
80e4aa30 6429 return apply_modifiers (modifiers, value);
284f4730 6430}
6da3dd3a
RS
6431\f
6432/* Convert a list that represents an event type,
6433 such as (ctrl meta backspace), into the usual representation of that
6434 event type as a number or a symbol. */
6435
a1706c30 6436DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
4707d2d0
PJ
6437 doc: /* Convert the event description list EVENT-DESC to an event type.
6438EVENT-DESC should contain one base event type (a character or symbol)
6439and zero or more modifier names (control, meta, hyper, super, shift, alt,
6440drag, down, double or triple). The base must be last.
6441The return value is an event type (a character or symbol) which
6442has the same base event type and all the specified modifiers. */)
6443 (event_desc)
e57d8fd8 6444 Lisp_Object event_desc;
6da3dd3a
RS
6445{
6446 Lisp_Object base;
6447 int modifiers = 0;
6448 Lisp_Object rest;
6449
6450 base = Qnil;
e57d8fd8 6451 rest = event_desc;
6da3dd3a
RS
6452 while (CONSP (rest))
6453 {
6454 Lisp_Object elt;
6455 int this = 0;
6456
7539e11f
KR
6457 elt = XCAR (rest);
6458 rest = XCDR (rest);
6da3dd3a 6459
3d31316f 6460 /* Given a symbol, see if it is a modifier name. */
377f24f5 6461 if (SYMBOLP (elt) && CONSP (rest))
3d31316f 6462 this = parse_solitary_modifier (elt);
6da3dd3a
RS
6463
6464 if (this != 0)
6465 modifiers |= this;
6466 else if (!NILP (base))
6467 error ("Two bases given in one event");
6468 else
6469 base = elt;
6470
6da3dd3a
RS
6471 }
6472
3d31316f 6473 /* Let the symbol A refer to the character A. */
d5db4077 6474 if (SYMBOLP (base) && SCHARS (SYMBOL_NAME (base)) == 1)
4069e0f8 6475 XSETINT (base, SREF (SYMBOL_NAME (base), 0));
3d31316f 6476
6da3dd3a
RS
6477 if (INTEGERP (base))
6478 {
3d31316f
RS
6479 /* Turn (shift a) into A. */
6480 if ((modifiers & shift_modifier) != 0
6481 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
6482 {
6483 XSETINT (base, XINT (base) - ('a' - 'A'));
6484 modifiers &= ~shift_modifier;
6485 }
6486
6487 /* Turn (control a) into C-a. */
6da3dd3a 6488 if (modifiers & ctrl_modifier)
3d31316f 6489 return make_number ((modifiers & ~ctrl_modifier)
6da3dd3a
RS
6490 | make_ctrl_char (XINT (base)));
6491 else
6492 return make_number (modifiers | XINT (base));
6493 }
6494 else if (SYMBOLP (base))
6495 return apply_modifiers (modifiers, base);
6496 else
8c907a56
GM
6497 {
6498 error ("Invalid base event");
6499 return Qnil;
6500 }
6da3dd3a
RS
6501}
6502
3d31316f
RS
6503/* Try to recognize SYMBOL as a modifier name.
6504 Return the modifier flag bit, or 0 if not recognized. */
6505
6506static int
6507parse_solitary_modifier (symbol)
6508 Lisp_Object symbol;
6509{
1b049b51 6510 Lisp_Object name = SYMBOL_NAME (symbol);
3d31316f 6511
1b049b51 6512 switch (SREF (name, 0))
3d31316f
RS
6513 {
6514#define SINGLE_LETTER_MOD(BIT) \
1b049b51 6515 if (SBYTES (name) == 1) \
3d31316f
RS
6516 return BIT;
6517
6518#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
1b049b51
KR
6519 if (LEN == SBYTES (name) \
6520 && ! strncmp (SDATA (name), NAME, LEN)) \
3d31316f
RS
6521 return BIT;
6522
6523 case 'A':
6524 SINGLE_LETTER_MOD (alt_modifier);
6525 break;
6526
6527 case 'a':
6528 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
6529 break;
6530
6531 case 'C':
6532 SINGLE_LETTER_MOD (ctrl_modifier);
6533 break;
6534
6535 case 'c':
6536 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
6537 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
6538 break;
6539
6540 case 'H':
6541 SINGLE_LETTER_MOD (hyper_modifier);
6542 break;
6543
6544 case 'h':
6545 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
6546 break;
6547
6548 case 'M':
6549 SINGLE_LETTER_MOD (meta_modifier);
6550 break;
6551
6552 case 'm':
6553 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
6554 break;
6555
6556 case 'S':
6557 SINGLE_LETTER_MOD (shift_modifier);
6558 break;
6559
6560 case 's':
6561 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
6562 MULTI_LETTER_MOD (super_modifier, "super", 5);
6563 SINGLE_LETTER_MOD (super_modifier);
6564 break;
6565
6566 case 'd':
6567 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6568 MULTI_LETTER_MOD (down_modifier, "down", 4);
6569 MULTI_LETTER_MOD (double_modifier, "double", 6);
6570 break;
6571
6572 case 't':
6573 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6574 break;
6575
6576#undef SINGLE_LETTER_MOD
6577#undef MULTI_LETTER_MOD
6578 }
6579
6580 return 0;
6581}
6582
6da3dd3a
RS
6583/* Return 1 if EVENT is a list whose elements are all integers or symbols.
6584 Such a list is not valid as an event,
6585 but it can be a Lucid-style event type list. */
6586
6587int
6588lucid_event_type_list_p (object)
6589 Lisp_Object object;
6590{
6591 Lisp_Object tail;
6592
6593 if (! CONSP (object))
6594 return 0;
902ae620
GM
6595
6596 if (EQ (XCAR (object), Qhelp_echo)
6597 || EQ (XCAR (object), Qvertical_line)
6598 || EQ (XCAR (object), Qmode_line)
6599 || EQ (XCAR (object), Qheader_line))
6600 return 0;
6da3dd3a 6601
7539e11f 6602 for (tail = object; CONSP (tail); tail = XCDR (tail))
6da3dd3a
RS
6603 {
6604 Lisp_Object elt;
7539e11f 6605 elt = XCAR (tail);
6da3dd3a
RS
6606 if (! (INTEGERP (elt) || SYMBOLP (elt)))
6607 return 0;
6608 }
6609
6610 return NILP (tail);
6611}
284f4730 6612\f
284f4730
JB
6613/* Store into *addr a value nonzero if terminal input chars are available.
6614 Serves the purpose of ioctl (0, FIONREAD, addr)
6615 but works even if FIONREAD does not exist.
d9d4c147
KH
6616 (In fact, this may actually read some input.)
6617
a2d5fca0
JD
6618 If READABLE_EVENTS_DO_TIMERS_NOW is set in FLAGS, actually run
6619 timer events that are ripe.
6620 If READABLE_EVENTS_FILTER_EVENTS is set in FLAGS, ignore internal
6621 events (FOCUS_IN_EVENT).
6622 If READABLE_EVENTS_IGNORE_SQUEEZABLES is set in FLAGS, ignore mouse
354344a2 6623 movements and toolkit scroll bar thumb drags. */
284f4730
JB
6624
6625static void
a2d5fca0 6626get_input_pending (addr, flags)
284f4730 6627 int *addr;
a2d5fca0 6628 int flags;
284f4730
JB
6629{
6630 /* First of all, have we already counted some input? */
a2d5fca0 6631 *addr = (!NILP (Vquit_flag) || readable_events (flags));
284f4730
JB
6632
6633 /* If input is being read as it arrives, and we have none, there is none. */
6634 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
6635 return;
6636
6637 /* Try to read some input and see how much we get. */
6638 gobble_input (0);
a2d5fca0 6639 *addr = (!NILP (Vquit_flag) || readable_events (flags));
284f4730
JB
6640}
6641
81931ba1 6642/* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
284f4730 6643
07a59269 6644void
284f4730
JB
6645gobble_input (expected)
6646 int expected;
6647{
6648#ifndef VMS
6649#ifdef SIGIO
6650 if (interrupt_input)
6651 {
32676c08 6652 SIGMASKTYPE mask;
4f8aaa74 6653 mask = sigblock (sigmask (SIGIO));
284f4730 6654 read_avail_input (expected);
e065a56e 6655 sigsetmask (mask);
284f4730
JB
6656 }
6657 else
81931ba1 6658#ifdef POLL_FOR_INPUT
428a555e
KL
6659 /* XXX This condition was (read_socket_hook && !interrupt_input),
6660 but read_socket_hook is not global anymore. Let's pretend that
6661 it's always set. */
6662 if (!interrupt_input && poll_suppress_count == 0)
81931ba1
RS
6663 {
6664 SIGMASKTYPE mask;
4f8aaa74 6665 mask = sigblock (sigmask (SIGALRM));
81931ba1
RS
6666 read_avail_input (expected);
6667 sigsetmask (mask);
6668 }
6669 else
87485d6f 6670#endif
284f4730
JB
6671#endif
6672 read_avail_input (expected);
6673#endif
6674}
a8015ab5 6675
3b8f9651 6676/* Put a BUFFER_SWITCH_EVENT in the buffer
241ceaf7
RS
6677 so that read_key_sequence will notice the new current buffer. */
6678
07a59269 6679void
a8015ab5
KH
6680record_asynch_buffer_change ()
6681{
6682 struct input_event event;
a30f0615 6683 Lisp_Object tem;
1269a761 6684 EVENT_INIT (event);
a30f0615 6685
3b8f9651 6686 event.kind = BUFFER_SWITCH_EVENT;
a8015ab5 6687 event.frame_or_window = Qnil;
da8f7368 6688 event.arg = Qnil;
241ceaf7 6689
f65e6f7d 6690#ifdef subprocesses
a30f0615
RS
6691 /* We don't need a buffer-switch event unless Emacs is waiting for input.
6692 The purpose of the event is to make read_key_sequence look up the
6693 keymaps again. If we aren't in read_key_sequence, we don't need one,
6694 and the event could cause trouble by messing up (input-pending-p). */
6695 tem = Fwaiting_for_user_input_p ();
6696 if (NILP (tem))
6697 return;
f65e6f7d
RS
6698#else
6699 /* We never need these events if we have no asynchronous subprocesses. */
6700 return;
6701#endif
a30f0615 6702
241ceaf7
RS
6703 /* Make sure no interrupt happens while storing the event. */
6704#ifdef SIGIO
6705 if (interrupt_input)
6706 {
6707 SIGMASKTYPE mask;
4f8aaa74 6708 mask = sigblock (sigmask (SIGIO));
241ceaf7
RS
6709 kbd_buffer_store_event (&event);
6710 sigsetmask (mask);
6711 }
6712 else
6713#endif
6714 {
6715 stop_polling ();
6716 kbd_buffer_store_event (&event);
6717 start_polling ();
6718 }
a8015ab5 6719}
284f4730
JB
6720\f
6721#ifndef VMS
6722
6723/* Read any terminal input already buffered up by the system
6724 into the kbd_buffer, but do not wait.
6725
6726 EXPECTED should be nonzero if the caller knows there is some input.
6727
6728 Except on VMS, all input is read by this function.
6729 If interrupt_input is nonzero, this function MUST be called
6730 only when SIGIO is blocked.
6731
6732 Returns the number of keyboard chars read, or -1 meaning
0fc0bac9 6733 this is a bad time to try to read input. */
284f4730
JB
6734
6735static int
6736read_avail_input (expected)
6737 int expected;
6738{
7b00d185 6739 int nread = 0;
80d4c824 6740 int err = 0;
7e59217d 6741 struct device *d;
1269a761 6742
7e59217d
KL
6743 /* Loop through the available devices, and call their input hooks. */
6744 d = device_list;
d448e982 6745 while (d)
8f1ce423 6746 {
7e59217d 6747 struct device *next = d->next_device;
daf01701 6748
3b7fbceb 6749 if (d->read_socket_hook)
d448e982 6750 {
3b7fbceb 6751 int nr;
057a9ab4 6752 struct input_event hold_quit;
d448e982 6753
057a9ab4
KL
6754 EVENT_INIT (hold_quit);
6755 hold_quit.kind = NO_EVENT;
351d2e14 6756
057a9ab4
KL
6757 /* No need for FIONREAD or fcntl; just say don't wait. */
6758 while (nr = (*d->read_socket_hook) (d, expected, &hold_quit), nr > 0)
6759 {
6760 nread += nr;
6761 expected = 0;
6762 }
6763
6764 if (nr == -1) /* Not OK to read input now. */
6765 {
6766 err = 1;
6767 }
6768 else if (nr == -2) /* Non-transient error. */
6769 {
6770 /* The display device terminated; it should be closed. */
6771
6772 /* Kill Emacs if this was our last display. */
7e59217d 6773 if (! device_list->next_device)
057a9ab4
KL
6774 /* Formerly simply reported no input, but that
6775 sometimes led to a failure of Emacs to terminate.
6776 SIGHUP seems appropriate if we can't reach the
6777 terminal. */
6778 /* ??? Is it really right to send the signal just to
6779 this process rather than to the whole process
6780 group? Perhaps on systems with FIONREAD Emacs is
6781 alone in its group. */
6782 kill (getpid (), SIGHUP);
6783
7e59217d
KL
6784 /* XXX Is calling delete_device safe here? It calls Fdelete_frame. */
6785 if (d->delete_device_hook)
6786 (*d->delete_device_hook) (d);
057a9ab4 6787 else
7e59217d 6788 delete_device (d);
057a9ab4 6789 }
351d2e14 6790
057a9ab4
KL
6791 if (hold_quit.kind != NO_EVENT)
6792 kbd_buffer_store_event (&hold_quit);
d448e982
KL
6793 }
6794
6795 d = next;
8f1ce423 6796 }
428a555e 6797
1cbfd764
KL
6798 if (err && !nread)
6799 nread = -1;
6800
8f1ce423
KL
6801 return nread;
6802}
6803
6804/* This is the tty way of reading available input.
6805
7e59217d 6806 Note that each terminal device has its own `struct device' object,
8f1ce423
KL
6807 and so this function is called once for each individual termcap
6808 display. The first parameter indicates which device to read from. */
d448e982 6809
8f1ce423 6810int
7e59217d 6811tty_read_avail_input (struct device *device,
057a9ab4
KL
6812 int expected,
6813 struct input_event *hold_quit)
8f1ce423 6814{
057a9ab4
KL
6815 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
6816 the kbd_buffer can really hold. That may prevent loss
6817 of characters on some systems when input is stuffed at us. */
6818 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
8f1ce423 6819 int n_to_read, i;
7e59217d 6820 struct tty_display_info *tty = device->display_info.tty;
8f1ce423 6821 int nread = 0;
3b7fbceb 6822
7e59217d 6823 if (device->type != output_termcap)
8f1ce423 6824 abort ();
3b7fbceb 6825
ac3d2625 6826 /* XXX I think the following code should be moved to separate hook
8f1ce423 6827 functions in system-dependent files. */
bc536d84 6828#ifdef WINDOWSNT
8f1ce423 6829 return 0;
bc536d84 6830#else /* not WINDOWSNT */
80e4aa30 6831#ifdef MSDOS
8f1ce423
KL
6832 n_to_read = dos_keysns ();
6833 if (n_to_read == 0)
6834 return 0;
3b7fbceb 6835
8f1ce423
KL
6836 cbuf[0] = dos_keyread ();
6837 nread = 1;
3b7fbceb 6838
c3a2738c 6839#else /* not MSDOS */
9628b887 6840
ac3d2625 6841 if (! tty->term_initted) /* In case we get called during bootstrap. */
8f1ce423 6842 return 0;
3b7fbceb 6843
0b0d3e0b
KL
6844 if (! tty->input)
6845 return 0; /* The terminal is suspended. */
6846
8f1ce423 6847 /* Determine how many characters we should *try* to read. */
284f4730 6848#ifdef FIONREAD
8f1ce423 6849 /* Find out how much input is available. */
0b0d3e0b 6850 if (ioctl (fileno (tty->input), FIONREAD, &n_to_read) < 0)
8f1ce423
KL
6851 {
6852 if (! noninteractive)
7e59217d 6853 return -2; /* Close this device. */
8f1ce423 6854 else
d448e982 6855 n_to_read = 0;
8f1ce423
KL
6856 }
6857 if (n_to_read == 0)
6858 return 0;
6859 if (n_to_read > sizeof cbuf)
6860 n_to_read = sizeof cbuf;
284f4730 6861#else /* no FIONREAD */
c60ee5e7 6862#if defined (USG) || defined (DGUX) || defined(CYGWIN)
8f1ce423
KL
6863 /* Read some input if available, but don't wait. */
6864 n_to_read = sizeof cbuf;
0b0d3e0b 6865 fcntl (fileno (tty->input), F_SETFL, O_NDELAY);
284f4730 6866#else
8f1ce423 6867 you lose;
284f4730
JB
6868#endif
6869#endif
6870
8f1ce423
KL
6871 /* Now read; for one reason or another, this will not block.
6872 NREAD is set to the number of chars read. */
6873 do
6874 {
0b0d3e0b 6875 nread = emacs_read (fileno (tty->input), cbuf, n_to_read);
8f1ce423
KL
6876 /* POSIX infers that processes which are not in the session leader's
6877 process group won't get SIGHUP's at logout time. BSDI adheres to
6878 this part standard and returns -1 from read (0) with errno==EIO
6879 when the control tty is taken away.
ac3d2625 6880 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
8f1ce423 6881 if (nread == -1 && errno == EIO)
7e59217d 6882 return -2; /* Close this device. */
762f2b92 6883#if defined (AIX) && (! defined (aix386) && defined (_BSD))
8f1ce423
KL
6884 /* The kernel sometimes fails to deliver SIGHUP for ptys.
6885 This looks incorrect, but it isn't, because _BSD causes
6886 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
6887 and that causes a value other than 0 when there is no input. */
6888 if (nread == 0)
7e59217d 6889 return -2; /* Close this device. */
284f4730 6890#endif
8f1ce423
KL
6891 }
6892 while (
6893 /* We used to retry the read if it was interrupted.
6894 But this does the wrong thing when O_NDELAY causes
6895 an EAGAIN error. Does anybody know of a situation
6896 where a retry is actually needed? */
791587ee 6897#if 0
8f1ce423 6898 nread < 0 && (errno == EAGAIN
6aec06f5 6899#ifdef EFAULT
8f1ce423 6900 || errno == EFAULT
80e4aa30 6901#endif
284f4730 6902#ifdef EBADSLT
8f1ce423 6903 || errno == EBADSLT
284f4730 6904#endif
8f1ce423 6905 )
791587ee 6906#else
8f1ce423 6907 0
791587ee 6908#endif
8f1ce423 6909 );
284f4730
JB
6910
6911#ifndef FIONREAD
c60ee5e7 6912#if defined (USG) || defined (DGUX) || defined (CYGWIN)
0b0d3e0b 6913 fcntl (fileno (tty->input), F_SETFL, 0);
c60ee5e7 6914#endif /* USG or DGUX or CYGWIN */
284f4730 6915#endif /* no FIONREAD */
3b7fbceb 6916
8f1ce423
KL
6917 if (nread <= 0)
6918 return nread;
3b7fbceb 6919
9628b887
KL
6920#endif /* not MSDOS */
6921#endif /* not WINDOWSNT */
3b7fbceb 6922
284f4730
JB
6923 for (i = 0; i < nread; i++)
6924 {
057a9ab4
KL
6925 struct input_event buf;
6926 EVENT_INIT (buf);
6927 buf.kind = ASCII_KEYSTROKE_EVENT;
6928 buf.modifiers = 0;
8f1ce423 6929 if (tty->meta_key == 1 && (cbuf[i] & 0x80))
057a9ab4 6930 buf.modifiers = meta_modifier;
8f1ce423
KL
6931 if (tty->meta_key != 2)
6932 cbuf[i] &= ~0x80;
057a9ab4
KL
6933
6934 buf.code = cbuf[i];
ac3d2625
KL
6935 /* Set the frame corresponding to the active tty. Note that the
6936 value of selected_frame is not reliable here, redisplay tends
6937 to temporarily change it. */
057a9ab4
KL
6938 buf.frame_or_window = tty->top_frame;
6939 buf.arg = Qnil;
6940
6941 kbd_buffer_store_event (&buf);
6942 /* Don't look at input that follows a C-g too closely.
6943 This reduces lossage due to autorepeat on C-g. */
6944 if (buf.kind == ASCII_KEYSTROKE_EVENT
6945 && buf.code == quit_char)
6946 break;
284f4730
JB
6947 }
6948
6949 return nread;
6950}
6951#endif /* not VMS */
6952\f
b65c1b44
SM
6953void
6954handle_async_input ()
6955{
6956#ifdef BSD4_1
6957 extern int select_alarmed;
6958#endif
aa477689 6959
b65c1b44
SM
6960 interrupt_input_pending = 0;
6961
6962 while (1)
6963 {
6964 int nread;
6965 nread = read_avail_input (1);
6966 /* -1 means it's not ok to read the input now.
6967 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
6968 0 means there was no keyboard input available. */
6969 if (nread <= 0)
6970 break;
6971
6972#ifdef BSD4_1
6973 select_alarmed = 1; /* Force the select emulator back to life */
6974#endif
6975 }
6976}
6977
284f4730
JB
6978#ifdef SIGIO /* for entire page */
6979/* Note SIGIO has been undef'd if FIONREAD is missing. */
6980
4216b545 6981static SIGTYPE
284f4730
JB
6982input_available_signal (signo)
6983 int signo;
6984{
6985 /* Must preserve main program's value of errno. */
6986 int old_errno = errno;
5970a8cb 6987#if defined (USG) && !defined (POSIX_SIGNALS)
284f4730
JB
6988 /* USG systems forget handlers when they are used;
6989 must reestablish each time */
6990 signal (signo, input_available_signal);
6991#endif /* USG */
6992
6993#ifdef BSD4_1
6994 sigisheld (SIGIO);
6995#endif
6996
b65c1b44
SM
6997#ifdef SYNC_INPUT
6998 interrupt_input_pending = 1;
6999#else
333f1b6f 7000 SIGNAL_THREAD_CHECK (signo);
bd55c35c 7001#endif
a25f766a 7002
bd55c35c
JD
7003 if (input_available_clear_time)
7004 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
7005
7006#ifndef SYNC_INPUT
b65c1b44 7007 handle_async_input ();
284f4730 7008#endif
284f4730
JB
7009
7010#ifdef BSD4_1
7011 sigfree ();
7012#endif
7013 errno = old_errno;
7014}
7015#endif /* SIGIO */
ad163903
JB
7016
7017/* Send ourselves a SIGIO.
7018
7019 This function exists so that the UNBLOCK_INPUT macro in
7020 blockinput.h can have some way to take care of input we put off
7021 dealing with, without assuming that every file which uses
7022 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
7023void
7024reinvoke_input_signal ()
7025{
df0f2ba1 7026#ifdef SIGIO
b65c1b44 7027 handle_async_input ();
ad163903
JB
7028#endif
7029}
7030
7031
284f4730 7032\f
318ab85c
SM
7033static void menu_bar_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object, void*));
7034static Lisp_Object menu_bar_one_keymap_changed_items;
b7c49376
RS
7035
7036/* These variables hold the vector under construction within
7037 menu_bar_items and its subroutines, and the current index
7038 for storing into that vector. */
7039static Lisp_Object menu_bar_items_vector;
9343ab07 7040static int menu_bar_items_index;
5ec75a55 7041
b7c49376
RS
7042/* Return a vector of menu items for a menu bar, appropriate
7043 to the current buffer. Each item has three elements in the vector:
f5e09c8b 7044 KEY STRING MAPLIST.
b7c49376
RS
7045
7046 OLD is an old vector we can optionally reuse, or nil. */
5ec75a55
RS
7047
7048Lisp_Object
b7c49376
RS
7049menu_bar_items (old)
7050 Lisp_Object old;
5ec75a55
RS
7051{
7052 /* The number of keymaps we're scanning right now, and the number of
7053 keymaps we have allocated space for. */
7054 int nmaps;
7055
7056 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
7057 in the current keymaps, or nil where it is not a prefix. */
7058 Lisp_Object *maps;
7059
aebfea68 7060 Lisp_Object def, tail;
5ec75a55
RS
7061
7062 Lisp_Object result;
7063
7064 int mapno;
47d319aa 7065 Lisp_Object oquit;
5ec75a55 7066
b7c49376
RS
7067 int i;
7068
db60d856
JB
7069 /* In order to build the menus, we need to call the keymap
7070 accessors. They all call QUIT. But this function is called
7071 during redisplay, during which a quit is fatal. So inhibit
47d319aa
RS
7072 quitting while building the menus.
7073 We do this instead of specbind because (1) errors will clear it anyway
7074 and (2) this avoids risk of specpdl overflow. */
7075 oquit = Vinhibit_quit;
df0f2ba1 7076 Vinhibit_quit = Qt;
db60d856 7077
b7c49376
RS
7078 if (!NILP (old))
7079 menu_bar_items_vector = old;
7080 else
7081 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
7082 menu_bar_items_index = 0;
7083
5ec75a55
RS
7084 /* Build our list of keymaps.
7085 If we recognize a function key and replace its escape sequence in
7086 keybuf with its symbol, or if the sequence starts with a mouse
7087 click and we need to switch buffers, we jump back here to rebuild
7088 the initial keymaps from the current buffer. */
df0f2ba1 7089 {
5ec75a55
RS
7090 Lisp_Object *tmaps;
7091
217258d5 7092 /* Should overriding-terminal-local-map and overriding-local-map apply? */
d0a49716 7093 if (!NILP (Voverriding_local_map_menu_flag))
9dd3131c 7094 {
217258d5
KH
7095 /* Yes, use them (if non-nil) as well as the global map. */
7096 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
7097 nmaps = 0;
7098 if (!NILP (current_kboard->Voverriding_terminal_local_map))
7099 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
7100 if (!NILP (Voverriding_local_map))
7101 maps[nmaps++] = Voverriding_local_map;
9dd3131c
RS
7102 }
7103 else
7104 {
fd646341
KS
7105 /* No, so use major and minor mode keymaps and keymap property.
7106 Note that menu-bar bindings in the local-map and keymap
7107 properties may not work reliable, as they are only
7108 recognized when the menu-bar (or mode-line) is updated,
7109 which does not normally happen after every command. */
7110 Lisp_Object tem;
7111 int nminor;
7112 nminor = current_minor_maps (NULL, &tmaps);
7113 maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
7114 nmaps = 0;
7115 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
7116 maps[nmaps++] = tem;
7117 bcopy (tmaps, (void *) (maps + nmaps), nminor * sizeof (maps[0]));
7118 nmaps += nminor;
7119 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
9dd3131c 7120 }
217258d5 7121 maps[nmaps++] = current_global_map;
5ec75a55
RS
7122 }
7123
7124 /* Look up in each map the dummy prefix key `menu-bar'. */
7125
7126 result = Qnil;
7127
e58aa385 7128 for (mapno = nmaps - 1; mapno >= 0; mapno--)
25126faa
GM
7129 if (!NILP (maps[mapno]))
7130 {
341a09cf
SM
7131 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
7132 0, 1);
02067692 7133 if (CONSP (def))
4216b545
SM
7134 {
7135 menu_bar_one_keymap_changed_items = Qnil;
7136 map_keymap (def, menu_bar_item, Qnil, NULL, 1);
7137 }
25126faa 7138 }
5ec75a55 7139
b7c49376
RS
7140 /* Move to the end those items that should be at the end. */
7141
7539e11f 7142 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
9f9c0e27 7143 {
b7c49376
RS
7144 int i;
7145 int end = menu_bar_items_index;
7146
35b3402f 7147 for (i = 0; i < end; i += 4)
7539e11f 7148 if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i]))
b7c49376 7149 {
35b3402f 7150 Lisp_Object tem0, tem1, tem2, tem3;
0301268e
RS
7151 /* Move the item at index I to the end,
7152 shifting all the others forward. */
7153 tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
7154 tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
7155 tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
35b3402f
RS
7156 tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
7157 if (end > i + 4)
7158 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
0301268e 7159 &XVECTOR (menu_bar_items_vector)->contents[i],
35b3402f
RS
7160 (end - i - 4) * sizeof (Lisp_Object));
7161 XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
7162 XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
7163 XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
7164 XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
0301268e 7165 break;
b7c49376
RS
7166 }
7167 }
9f9c0e27 7168
0c9071cd 7169 /* Add nil, nil, nil, nil at the end. */
b7c49376 7170 i = menu_bar_items_index;
35b3402f 7171 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
b7c49376
RS
7172 {
7173 Lisp_Object tem;
b7c49376
RS
7174 tem = Fmake_vector (make_number (2 * i), Qnil);
7175 bcopy (XVECTOR (menu_bar_items_vector)->contents,
7176 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
7177 menu_bar_items_vector = tem;
9f9c0e27 7178 }
b7c49376
RS
7179 /* Add this item. */
7180 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
7181 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
7182 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
35b3402f 7183 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
b7c49376 7184 menu_bar_items_index = i;
a73c5e29 7185
47d319aa 7186 Vinhibit_quit = oquit;
b7c49376 7187 return menu_bar_items_vector;
5ec75a55
RS
7188}
7189\f
f5e09c8b
RS
7190/* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
7191 If there's already an item for KEY, add this DEF to it. */
7192
e8886a1d
RS
7193Lisp_Object item_properties;
7194
b7c49376 7195static void
4216b545
SM
7196menu_bar_item (key, item, dummy1, dummy2)
7197 Lisp_Object key, item, dummy1;
7198 void *dummy2;
5ec75a55 7199{
e8886a1d 7200 struct gcpro gcpro1;
b7c49376 7201 int i;
759860a6 7202 Lisp_Object tem;
5ec75a55 7203
e8886a1d 7204 if (EQ (item, Qundefined))
e58aa385 7205 {
f5e09c8b 7206 /* If a map has an explicit `undefined' as definition,
e58aa385 7207 discard any previously made menu bar item. */
b7c49376 7208
35b3402f 7209 for (i = 0; i < menu_bar_items_index; i += 4)
b7c49376
RS
7210 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
7211 {
35b3402f
RS
7212 if (menu_bar_items_index > i + 4)
7213 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
b7c49376 7214 &XVECTOR (menu_bar_items_vector)->contents[i],
35b3402f
RS
7215 (menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
7216 menu_bar_items_index -= 4;
b7c49376 7217 }
e58aa385
RS
7218 }
7219
759860a6
RS
7220 /* If this keymap has already contributed to this KEY,
7221 don't contribute to it a second time. */
7222 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
9cd2ced7 7223 if (!NILP (tem) || NILP (item))
759860a6
RS
7224 return;
7225
7226 menu_bar_one_keymap_changed_items
7227 = Fcons (key, menu_bar_one_keymap_changed_items);
7228
9cd2ced7
SM
7229 /* We add to menu_bar_one_keymap_changed_items before doing the
7230 parse_menu_item, so that if it turns out it wasn't a menu item,
7231 it still correctly hides any further menu item. */
7232 GCPRO1 (key);
7233 i = parse_menu_item (item, 0, 1);
7234 UNGCPRO;
7235 if (!i)
7236 return;
7237
e8886a1d
RS
7238 item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
7239
f5e09c8b 7240 /* Find any existing item for this KEY. */
35b3402f 7241 for (i = 0; i < menu_bar_items_index; i += 4)
b7c49376
RS
7242 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
7243 break;
7244
f5e09c8b 7245 /* If we did not find this KEY, add it at the end. */
b7c49376
RS
7246 if (i == menu_bar_items_index)
7247 {
7248 /* If vector is too small, get a bigger one. */
35b3402f 7249 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
b7c49376
RS
7250 {
7251 Lisp_Object tem;
b7c49376
RS
7252 tem = Fmake_vector (make_number (2 * i), Qnil);
7253 bcopy (XVECTOR (menu_bar_items_vector)->contents,
7254 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
7255 menu_bar_items_vector = tem;
7256 }
e8886a1d 7257
b7c49376
RS
7258 /* Add this item. */
7259 XVECTOR (menu_bar_items_vector)->contents[i++] = key;
e8886a1d
RS
7260 XVECTOR (menu_bar_items_vector)->contents[i++]
7261 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
7262 XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
35b3402f 7263 XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
b7c49376
RS
7264 menu_bar_items_index = i;
7265 }
e8886a1d 7266 /* We did find an item for this KEY. Add ITEM to its list of maps. */
f5e09c8b
RS
7267 else
7268 {
7269 Lisp_Object old;
7270 old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
4216b545
SM
7271 /* If the new and the old items are not both keymaps,
7272 the lookup will only find `item'. */
7273 item = Fcons (item, KEYMAPP (item) && KEYMAPP (XCAR (old)) ? old : Qnil);
7274 XVECTOR (menu_bar_items_vector)->contents[i + 2] = item;
f5e09c8b 7275 }
5ec75a55
RS
7276}
7277\f
e8886a1d
RS
7278 /* This is used as the handler when calling menu_item_eval_property. */
7279static Lisp_Object
7280menu_item_eval_property_1 (arg)
7281 Lisp_Object arg;
7282{
7283 /* If we got a quit from within the menu computation,
7284 quit all the way out of it. This takes care of C-] in the debugger. */
7539e11f 7285 if (CONSP (arg) && EQ (XCAR (arg), Qquit))
e8886a1d
RS
7286 Fsignal (Qquit, Qnil);
7287
7288 return Qnil;
7289}
7290
c60ee5e7 7291/* Evaluate an expression and return the result (or nil if something
e8886a1d 7292 went wrong). Used to evaluate dynamic parts of menu items. */
7ee32cda 7293Lisp_Object
e8886a1d
RS
7294menu_item_eval_property (sexpr)
7295 Lisp_Object sexpr;
7296{
aed13378 7297 int count = SPECPDL_INDEX ();
e8886a1d 7298 Lisp_Object val;
44e553a3 7299 specbind (Qinhibit_redisplay, Qt);
e8886a1d
RS
7300 val = internal_condition_case_1 (Feval, sexpr, Qerror,
7301 menu_item_eval_property_1);
44e553a3 7302 return unbind_to (count, val);
e8886a1d
RS
7303}
7304
7305/* This function parses a menu item and leaves the result in the
7306 vector item_properties.
7307 ITEM is a key binding, a possible menu item.
7308 If NOTREAL is nonzero, only check for equivalent key bindings, don't
7309 evaluate dynamic expressions in the menu item.
fd3613d7 7310 INMENUBAR is > 0 when this is considered for an entry in a menu bar
e8886a1d 7311 top level.
fd3613d7 7312 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
e8886a1d
RS
7313 parse_menu_item returns true if the item is a menu item and false
7314 otherwise. */
7315
7316int
7317parse_menu_item (item, notreal, inmenubar)
7318 Lisp_Object item;
7319 int notreal, inmenubar;
7320{
adc1d5c8 7321 Lisp_Object def, tem, item_string, start;
07ba902e
RS
7322 Lisp_Object cachelist;
7323 Lisp_Object filter;
7324 Lisp_Object keyhint;
e8886a1d 7325 int i;
74c1de23
RS
7326 int newcache = 0;
7327
07ba902e
RS
7328 cachelist = Qnil;
7329 filter = Qnil;
7330 keyhint = Qnil;
7331
e8886a1d
RS
7332 if (!CONSP (item))
7333 return 0;
7334
e8886a1d
RS
7335 /* Create item_properties vector if necessary. */
7336 if (NILP (item_properties))
7337 item_properties
7338 = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
7339
7340 /* Initialize optional entries. */
7341 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
3626fb1a
GM
7342 AREF (item_properties, i) = Qnil;
7343 AREF (item_properties, ITEM_PROPERTY_ENABLE) = Qt;
c60ee5e7 7344
e8886a1d 7345 /* Save the item here to protect it from GC. */
3626fb1a 7346 AREF (item_properties, ITEM_PROPERTY_ITEM) = item;
e8886a1d 7347
7539e11f 7348 item_string = XCAR (item);
e8886a1d
RS
7349
7350 start = item;
7539e11f 7351 item = XCDR (item);
e8886a1d
RS
7352 if (STRINGP (item_string))
7353 {
7354 /* Old format menu item. */
3626fb1a 7355 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
e8886a1d
RS
7356
7357 /* Maybe help string. */
7539e11f 7358 if (CONSP (item) && STRINGP (XCAR (item)))
e8886a1d 7359 {
3626fb1a 7360 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
e8886a1d 7361 start = item;
7539e11f 7362 item = XCDR (item);
e8886a1d 7363 }
c60ee5e7 7364
31f84d03 7365 /* Maybe key binding cache. */
7539e11f
KR
7366 if (CONSP (item) && CONSP (XCAR (item))
7367 && (NILP (XCAR (XCAR (item)))
7368 || VECTORP (XCAR (XCAR (item)))))
e8886a1d 7369 {
7539e11f
KR
7370 cachelist = XCAR (item);
7371 item = XCDR (item);
e8886a1d 7372 }
c60ee5e7 7373
e8886a1d 7374 /* This is the real definition--the function to run. */
3626fb1a 7375 AREF (item_properties, ITEM_PROPERTY_DEF) = item;
e8886a1d
RS
7376
7377 /* Get enable property, if any. */
7378 if (SYMBOLP (item))
7379 {
7380 tem = Fget (item, Qmenu_enable);
7381 if (!NILP (tem))
3626fb1a 7382 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
e8886a1d
RS
7383 }
7384 }
7385 else if (EQ (item_string, Qmenu_item) && CONSP (item))
7386 {
7387 /* New format menu item. */
3626fb1a 7388 AREF (item_properties, ITEM_PROPERTY_NAME) = XCAR (item);
7539e11f 7389 start = XCDR (item);
e8886a1d
RS
7390 if (CONSP (start))
7391 {
7392 /* We have a real binding. */
3626fb1a 7393 AREF (item_properties, ITEM_PROPERTY_DEF) = XCAR (start);
e8886a1d 7394
7539e11f 7395 item = XCDR (start);
e8886a1d 7396 /* Is there a cache list with key equivalences. */
7539e11f 7397 if (CONSP (item) && CONSP (XCAR (item)))
e8886a1d 7398 {
7539e11f
KR
7399 cachelist = XCAR (item);
7400 item = XCDR (item);
e8886a1d
RS
7401 }
7402
7403 /* Parse properties. */
7539e11f 7404 while (CONSP (item) && CONSP (XCDR (item)))
e8886a1d 7405 {
7539e11f
KR
7406 tem = XCAR (item);
7407 item = XCDR (item);
e8886a1d
RS
7408
7409 if (EQ (tem, QCenable))
3626fb1a 7410 AREF (item_properties, ITEM_PROPERTY_ENABLE) = XCAR (item);
e8886a1d
RS
7411 else if (EQ (tem, QCvisible) && !notreal)
7412 {
7413 /* If got a visible property and that evaluates to nil
7414 then ignore this item. */
7539e11f 7415 tem = menu_item_eval_property (XCAR (item));
e8886a1d 7416 if (NILP (tem))
adc1d5c8 7417 return 0;
e8886a1d
RS
7418 }
7419 else if (EQ (tem, QChelp))
3626fb1a 7420 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
e8886a1d 7421 else if (EQ (tem, QCfilter))
74c1de23
RS
7422 filter = item;
7423 else if (EQ (tem, QCkey_sequence))
7424 {
7539e11f 7425 tem = XCAR (item);
74c1de23
RS
7426 if (NILP (cachelist)
7427 && (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem)))
7428 /* Be GC protected. Set keyhint to item instead of tem. */
7429 keyhint = item;
7430 }
7431 else if (EQ (tem, QCkeys))
7432 {
7539e11f 7433 tem = XCAR (item);
03cee6ae 7434 if (CONSP (tem) || (STRINGP (tem) && NILP (cachelist)))
3626fb1a 7435 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
74c1de23 7436 }
7539e11f 7437 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
e8886a1d 7438 {
74c1de23 7439 Lisp_Object type;
7539e11f
KR
7440 tem = XCAR (item);
7441 type = XCAR (tem);
e8886a1d
RS
7442 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7443 {
3626fb1a 7444 AREF (item_properties, ITEM_PROPERTY_SELECTED)
7539e11f 7445 = XCDR (tem);
3626fb1a 7446 AREF (item_properties, ITEM_PROPERTY_TYPE)
e8886a1d
RS
7447 = type;
7448 }
7449 }
7539e11f 7450 item = XCDR (item);
e8886a1d
RS
7451 }
7452 }
7453 else if (inmenubar || !NILP (start))
adc1d5c8 7454 return 0;
e8886a1d
RS
7455 }
7456 else
adc1d5c8 7457 return 0; /* not a menu item */
e8886a1d
RS
7458
7459 /* If item string is not a string, evaluate it to get string.
7460 If we don't get a string, skip this item. */
3626fb1a 7461 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
e8886a1d
RS
7462 if (!(STRINGP (item_string) || notreal))
7463 {
7464 item_string = menu_item_eval_property (item_string);
7465 if (!STRINGP (item_string))
adc1d5c8 7466 return 0;
3626fb1a 7467 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
e8886a1d 7468 }
c60ee5e7 7469
e8886a1d 7470 /* If got a filter apply it on definition. */
3626fb1a 7471 def = AREF (item_properties, ITEM_PROPERTY_DEF);
e8886a1d
RS
7472 if (!NILP (filter))
7473 {
7539e11f 7474 def = menu_item_eval_property (list2 (XCAR (filter),
c5c5a6f8
RS
7475 list2 (Qquote, def)));
7476
3626fb1a 7477 AREF (item_properties, ITEM_PROPERTY_DEF) = def;
e8886a1d
RS
7478 }
7479
e8886a1d 7480 /* Enable or disable selection of item. */
3626fb1a 7481 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
e8886a1d
RS
7482 if (!EQ (tem, Qt))
7483 {
7484 if (notreal)
7485 tem = Qt;
7486 else
7487 tem = menu_item_eval_property (tem);
7488 if (inmenubar && NILP (tem))
adc1d5c8 7489 return 0; /* Ignore disabled items in menu bar. */
3626fb1a 7490 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
e8886a1d
RS
7491 }
7492
7189cad8
SM
7493 /* If we got no definition, this item is just unselectable text which
7494 is OK in a submenu but not in the menubar. */
7495 if (NILP (def))
7496 return (inmenubar ? 0 : 1);
c60ee5e7 7497
e8886a1d 7498 /* See if this is a separate pane or a submenu. */
3626fb1a 7499 def = AREF (item_properties, ITEM_PROPERTY_DEF);
02067692 7500 tem = get_keymap (def, 0, 1);
9ac425d1 7501 /* For a subkeymap, just record its details and exit. */
02067692 7502 if (CONSP (tem))
e8886a1d 7503 {
3626fb1a
GM
7504 AREF (item_properties, ITEM_PROPERTY_MAP) = tem;
7505 AREF (item_properties, ITEM_PROPERTY_DEF) = tem;
e8886a1d
RS
7506 return 1;
7507 }
c60ee5e7 7508
9ac425d1
RS
7509 /* At the top level in the menu bar, do likewise for commands also.
7510 The menu bar does not display equivalent key bindings anyway.
7511 ITEM_PROPERTY_DEF is already set up properly. */
7512 if (inmenubar > 0)
7513 return 1;
e8886a1d
RS
7514
7515 /* This is a command. See if there is an equivalent key binding. */
7516 if (NILP (cachelist))
7517 {
74c1de23 7518 /* We have to create a cachelist. */
e8886a1d 7519 CHECK_IMPURE (start);
f3fbd155 7520 XSETCDR (start, Fcons (Fcons (Qnil, Qnil), XCDR (start)));
7539e11f 7521 cachelist = XCAR (XCDR (start));
74c1de23 7522 newcache = 1;
3626fb1a 7523 tem = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
74c1de23
RS
7524 if (!NILP (keyhint))
7525 {
f3fbd155 7526 XSETCAR (cachelist, XCAR (keyhint));
74c1de23
RS
7527 newcache = 0;
7528 }
7529 else if (STRINGP (tem))
7530 {
f3fbd155
KR
7531 XSETCDR (cachelist, Fsubstitute_command_keys (tem));
7532 XSETCAR (cachelist, Qt);
74c1de23
RS
7533 }
7534 }
c60ee5e7 7535
7539e11f 7536 tem = XCAR (cachelist);
74c1de23
RS
7537 if (!EQ (tem, Qt))
7538 {
7539 int chkcache = 0;
7540 Lisp_Object prefix;
7541
7542 if (!NILP (tem))
8b9940e6 7543 tem = Fkey_binding (tem, Qnil, Qnil);
74c1de23 7544
3626fb1a 7545 prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
74c1de23
RS
7546 if (CONSP (prefix))
7547 {
7539e11f
KR
7548 def = XCAR (prefix);
7549 prefix = XCDR (prefix);
74c1de23 7550 }
e8886a1d 7551 else
3626fb1a 7552 def = AREF (item_properties, ITEM_PROPERTY_DEF);
74c1de23 7553
9867523c 7554 if (NILP (XCAR (cachelist))) /* Have no saved key. */
74c1de23
RS
7555 {
7556 if (newcache /* Always check first time. */
7557 /* Should we check everything when precomputing key
7558 bindings? */
74c1de23
RS
7559 /* If something had no key binding before, don't recheck it
7560 because that is too slow--except if we have a list of
7561 rebound commands in Vdefine_key_rebound_commands, do
7562 recheck any command that appears in that list. */
7563 || (CONSP (Vdefine_key_rebound_commands)
7564 && !NILP (Fmemq (def, Vdefine_key_rebound_commands))))
7565 chkcache = 1;
7566 }
7567 /* We had a saved key. Is it still bound to the command? */
7568 else if (NILP (tem)
03cee6ae
GM
7569 || (!EQ (tem, def)
7570 /* If the command is an alias for another
7571 (such as lmenu.el set it up), check if the
7572 original command matches the cached command. */
7573 && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))))
74c1de23
RS
7574 chkcache = 1; /* Need to recompute key binding. */
7575
7576 if (chkcache)
7577 {
7578 /* Recompute equivalent key binding. If the command is an alias
7579 for another (such as lmenu.el set it up), see if the original
7580 command name has equivalent keys. Otherwise look up the
7581 specified command itself. We don't try both, because that
7582 makes lmenu menus slow. */
3626fb1a
GM
7583 if (SYMBOLP (def)
7584 && SYMBOLP (XSYMBOL (def)->function)
74c1de23
RS
7585 && ! NILP (Fget (def, Qmenu_alias)))
7586 def = XSYMBOL (def)->function;
8b9940e6 7587 tem = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qt);
f3fbd155 7588 XSETCAR (cachelist, tem);
74c1de23
RS
7589 if (NILP (tem))
7590 {
f3fbd155 7591 XSETCDR (cachelist, Qnil);
74c1de23
RS
7592 chkcache = 0;
7593 }
7594 }
7539e11f 7595 else if (!NILP (keyhint) && !NILP (XCAR (cachelist)))
74c1de23 7596 {
7539e11f 7597 tem = XCAR (cachelist);
74c1de23
RS
7598 chkcache = 1;
7599 }
7600
7601 newcache = chkcache;
7602 if (chkcache)
7603 {
a1bfe073 7604 tem = Fkey_description (tem, Qnil);
74c1de23
RS
7605 if (CONSP (prefix))
7606 {
7539e11f
KR
7607 if (STRINGP (XCAR (prefix)))
7608 tem = concat2 (XCAR (prefix), tem);
7609 if (STRINGP (XCDR (prefix)))
7610 tem = concat2 (tem, XCDR (prefix));
74c1de23 7611 }
f3fbd155 7612 XSETCDR (cachelist, tem);
74c1de23
RS
7613 }
7614 }
7615
7539e11f 7616 tem = XCDR (cachelist);
74c1de23 7617 if (newcache && !NILP (tem))
e8886a1d 7618 {
74c1de23 7619 tem = concat3 (build_string (" ("), tem, build_string (")"));
f3fbd155 7620 XSETCDR (cachelist, tem);
e8886a1d
RS
7621 }
7622
7623 /* If we only want to precompute equivalent key bindings, stop here. */
7624 if (notreal)
adc1d5c8 7625 return 1;
e8886a1d
RS
7626
7627 /* If we have an equivalent key binding, use that. */
3626fb1a 7628 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
adc1d5c8
RS
7629
7630 /* Include this when menu help is implemented.
7631 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
7632 if (!(NILP (tem) || STRINGP (tem)))
7633 {
7634 tem = menu_item_eval_property (tem);
7635 if (!STRINGP (tem))
7636 tem = Qnil;
7637 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
7638 }
e8886a1d
RS
7639 */
7640
c60ee5e7 7641 /* Handle radio buttons or toggle boxes. */
3626fb1a 7642 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
e8886a1d 7643 if (!NILP (tem))
3626fb1a 7644 AREF (item_properties, ITEM_PROPERTY_SELECTED)
e8886a1d
RS
7645 = menu_item_eval_property (tem);
7646
e8886a1d
RS
7647 return 1;
7648}
7ee32cda
GM
7649
7650
7651\f
7652/***********************************************************************
7653 Tool-bars
7654 ***********************************************************************/
7655
9ea173e8 7656/* A vector holding tool bar items while they are parsed in function
27fd22dc 7657 tool_bar_items. Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
9ea173e8 7658 in the vector. */
7ee32cda 7659
9ea173e8 7660static Lisp_Object tool_bar_items_vector;
7ee32cda 7661
9ea173e8
GM
7662/* A vector holding the result of parse_tool_bar_item. Layout is like
7663 the one for a single item in tool_bar_items_vector. */
7ee32cda 7664
9ea173e8 7665static Lisp_Object tool_bar_item_properties;
7ee32cda 7666
9ea173e8 7667/* Next free index in tool_bar_items_vector. */
7ee32cda 7668
9ea173e8 7669static int ntool_bar_items;
7ee32cda 7670
9ea173e8 7671/* The symbols `tool-bar', and `:image'. */
7ee32cda 7672
9ea173e8 7673extern Lisp_Object Qtool_bar;
7ee32cda
GM
7674Lisp_Object QCimage;
7675
7676/* Function prototypes. */
7677
9ea173e8
GM
7678static void init_tool_bar_items P_ ((Lisp_Object));
7679static void process_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
7680static int parse_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
7681static void append_tool_bar_item P_ ((void));
7ee32cda
GM
7682
7683
9ea173e8 7684/* Return a vector of tool bar items for keymaps currently in effect.
7ee32cda 7685 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
9ea173e8 7686 tool bar items found. */
7ee32cda
GM
7687
7688Lisp_Object
9ea173e8 7689tool_bar_items (reuse, nitems)
7ee32cda
GM
7690 Lisp_Object reuse;
7691 int *nitems;
7692{
7693 Lisp_Object *maps;
7694 int nmaps, i;
7695 Lisp_Object oquit;
7696 Lisp_Object *tmaps;
7ee32cda
GM
7697
7698 *nitems = 0;
7699
7700 /* In order to build the menus, we need to call the keymap
7701 accessors. They all call QUIT. But this function is called
7702 during redisplay, during which a quit is fatal. So inhibit
7703 quitting while building the menus. We do this instead of
7704 specbind because (1) errors will clear it anyway and (2) this
7705 avoids risk of specpdl overflow. */
7706 oquit = Vinhibit_quit;
7707 Vinhibit_quit = Qt;
c60ee5e7 7708
9ea173e8
GM
7709 /* Initialize tool_bar_items_vector and protect it from GC. */
7710 init_tool_bar_items (reuse);
7ee32cda
GM
7711
7712 /* Build list of keymaps in maps. Set nmaps to the number of maps
7713 to process. */
c60ee5e7 7714
7ee32cda
GM
7715 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7716 if (!NILP (Voverriding_local_map_menu_flag))
7717 {
7718 /* Yes, use them (if non-nil) as well as the global map. */
7719 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
7720 nmaps = 0;
7721 if (!NILP (current_kboard->Voverriding_terminal_local_map))
7722 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
7723 if (!NILP (Voverriding_local_map))
7724 maps[nmaps++] = Voverriding_local_map;
7725 }
7726 else
7727 {
fd646341
KS
7728 /* No, so use major and minor mode keymaps and keymap property.
7729 Note that tool-bar bindings in the local-map and keymap
7730 properties may not work reliable, as they are only
7731 recognized when the tool-bar (or mode-line) is updated,
7732 which does not normally happen after every command. */
7733 Lisp_Object tem;
7734 int nminor;
7735 nminor = current_minor_maps (NULL, &tmaps);
7736 maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
7737 nmaps = 0;
7738 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
7739 maps[nmaps++] = tem;
7740 bcopy (tmaps, (void *) (maps + nmaps), nminor * sizeof (maps[0]));
7741 nmaps += nminor;
7742 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
7ee32cda
GM
7743 }
7744
7745 /* Add global keymap at the end. */
7746 maps[nmaps++] = current_global_map;
7747
7748 /* Process maps in reverse order and look up in each map the prefix
9ea173e8 7749 key `tool-bar'. */
7ee32cda
GM
7750 for (i = nmaps - 1; i >= 0; --i)
7751 if (!NILP (maps[i]))
7752 {
7753 Lisp_Object keymap;
db785038 7754
341a09cf 7755 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
02067692 7756 if (CONSP (keymap))
7ee32cda
GM
7757 {
7758 Lisp_Object tail;
c60ee5e7 7759
7ee32cda 7760 /* KEYMAP is a list `(keymap (KEY . BINDING) ...)'. */
7539e11f 7761 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
7ee32cda
GM
7762 {
7763 Lisp_Object keydef = XCAR (tail);
7764 if (CONSP (keydef))
9ea173e8 7765 process_tool_bar_item (XCAR (keydef), XCDR (keydef));
7ee32cda
GM
7766 }
7767 }
7768 }
7769
7770 Vinhibit_quit = oquit;
9ea173e8
GM
7771 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
7772 return tool_bar_items_vector;
7ee32cda
GM
7773}
7774
7775
7776/* Process the definition of KEY which is DEF. */
7777
7778static void
9ea173e8 7779process_tool_bar_item (key, def)
7ee32cda
GM
7780 Lisp_Object key, def;
7781{
7782 int i;
7783 extern Lisp_Object Qundefined;
7784 struct gcpro gcpro1, gcpro2;
7785
9ea173e8 7786 /* Protect KEY and DEF from GC because parse_tool_bar_item may call
7ee32cda
GM
7787 eval. */
7788 GCPRO2 (key, def);
7789
7790 if (EQ (def, Qundefined))
7791 {
7792 /* If a map has an explicit `undefined' as definition,
7793 discard any previously made item. */
9ea173e8 7794 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
7ee32cda 7795 {
9ea173e8 7796 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
c60ee5e7 7797
9ea173e8 7798 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
7ee32cda 7799 {
9ea173e8
GM
7800 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
7801 bcopy (v + TOOL_BAR_ITEM_NSLOTS, v,
7802 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
7ee32cda 7803 * sizeof (Lisp_Object)));
9ea173e8 7804 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
7ee32cda
GM
7805 break;
7806 }
7807 }
7808 }
9ea173e8
GM
7809 else if (parse_tool_bar_item (key, def))
7810 /* Append a new tool bar item to tool_bar_items_vector. Accept
7ee32cda 7811 more than one definition for the same key. */
9ea173e8 7812 append_tool_bar_item ();
7ee32cda
GM
7813
7814 UNGCPRO;
7815}
7816
7817
9ea173e8
GM
7818/* Parse a tool bar item specification ITEM for key KEY and return the
7819 result in tool_bar_item_properties. Value is zero if ITEM is
7ee32cda
GM
7820 invalid.
7821
7822 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
c60ee5e7 7823
7ee32cda
GM
7824 CAPTION is the caption of the item, If it's not a string, it is
7825 evaluated to get a string.
c60ee5e7 7826
9ea173e8 7827 BINDING is the tool bar item's binding. Tool-bar items with keymaps
7ee32cda
GM
7828 as binding are currently ignored.
7829
7830 The following properties are recognized:
7831
7832 - `:enable FORM'.
c60ee5e7 7833
9ea173e8
GM
7834 FORM is evaluated and specifies whether the tool bar item is
7835 enabled or disabled.
c60ee5e7 7836
7ee32cda 7837 - `:visible FORM'
c60ee5e7 7838
9ea173e8 7839 FORM is evaluated and specifies whether the tool bar item is visible.
c60ee5e7 7840
7ee32cda
GM
7841 - `:filter FUNCTION'
7842
7843 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
7844 result is stored as the new binding.
c60ee5e7 7845
7ee32cda
GM
7846 - `:button (TYPE SELECTED)'
7847
7848 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
7849 and specifies whether the button is selected (pressed) or not.
c60ee5e7 7850
7ee32cda
GM
7851 - `:image IMAGES'
7852
7853 IMAGES is either a single image specification or a vector of four
9ea173e8 7854 image specifications. See enum tool_bar_item_images.
c60ee5e7 7855
7ee32cda 7856 - `:help HELP-STRING'.
c60ee5e7 7857
9ea173e8 7858 Gives a help string to display for the tool bar item. */
7ee32cda
GM
7859
7860static int
9ea173e8 7861parse_tool_bar_item (key, item)
7ee32cda
GM
7862 Lisp_Object key, item;
7863{
9ea173e8
GM
7864 /* Access slot with index IDX of vector tool_bar_item_properties. */
7865#define PROP(IDX) XVECTOR (tool_bar_item_properties)->contents[IDX]
7ee32cda
GM
7866
7867 Lisp_Object filter = Qnil;
7868 Lisp_Object caption;
7ee32cda 7869 int i;
7ee32cda 7870
8c907a56
GM
7871 /* Defininition looks like `(menu-item CAPTION BINDING PROPS...)'.
7872 Rule out items that aren't lists, don't start with
7873 `menu-item' or whose rest following `tool-bar-item' is not a
7ee32cda
GM
7874 list. */
7875 if (!CONSP (item)
7876 || !EQ (XCAR (item), Qmenu_item)
7877 || (item = XCDR (item),
7878 !CONSP (item)))
7879 return 0;
7880
9ea173e8 7881 /* Create tool_bar_item_properties vector if necessary. Reset it to
7ee32cda 7882 defaults. */
9ea173e8 7883 if (VECTORP (tool_bar_item_properties))
7ee32cda 7884 {
9ea173e8 7885 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
7ee32cda
GM
7886 PROP (i) = Qnil;
7887 }
7888 else
9ea173e8
GM
7889 tool_bar_item_properties
7890 = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
c60ee5e7 7891
7ee32cda 7892 /* Set defaults. */
9ea173e8
GM
7893 PROP (TOOL_BAR_ITEM_KEY) = key;
7894 PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
c60ee5e7 7895
7ee32cda
GM
7896 /* Get the caption of the item. If the caption is not a string,
7897 evaluate it to get a string. If we don't get a string, skip this
7898 item. */
7899 caption = XCAR (item);
7900 if (!STRINGP (caption))
7901 {
7902 caption = menu_item_eval_property (caption);
7903 if (!STRINGP (caption))
7904 return 0;
7905 }
9ea173e8 7906 PROP (TOOL_BAR_ITEM_CAPTION) = caption;
7ee32cda
GM
7907
7908 /* Give up if rest following the caption is not a list. */
7909 item = XCDR (item);
7910 if (!CONSP (item))
7911 return 0;
7912
7913 /* Store the binding. */
9ea173e8 7914 PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item);
7ee32cda
GM
7915 item = XCDR (item);
7916
8c907a56
GM
7917 /* Ignore cached key binding, if any. */
7918 if (CONSP (item) && CONSP (XCAR (item)))
7919 item = XCDR (item);
7920
7ee32cda
GM
7921 /* Process the rest of the properties. */
7922 for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
7923 {
7924 Lisp_Object key, value;
7925
7926 key = XCAR (item);
7927 value = XCAR (XCDR (item));
7928
7929 if (EQ (key, QCenable))
7930 /* `:enable FORM'. */
9ea173e8 7931 PROP (TOOL_BAR_ITEM_ENABLED_P) = value;
7ee32cda
GM
7932 else if (EQ (key, QCvisible))
7933 {
7934 /* `:visible FORM'. If got a visible property and that
7935 evaluates to nil then ignore this item. */
7936 if (NILP (menu_item_eval_property (value)))
7937 return 0;
7938 }
7939 else if (EQ (key, QChelp))
7940 /* `:help HELP-STRING'. */
9ea173e8 7941 PROP (TOOL_BAR_ITEM_HELP) = value;
7ee32cda
GM
7942 else if (EQ (key, QCfilter))
7943 /* ':filter FORM'. */
7944 filter = value;
7945 else if (EQ (key, QCbutton) && CONSP (value))
7946 {
7947 /* `:button (TYPE . SELECTED)'. */
7948 Lisp_Object type, selected;
7949
7950 type = XCAR (value);
7951 selected = XCDR (value);
7952 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7953 {
9ea173e8
GM
7954 PROP (TOOL_BAR_ITEM_SELECTED_P) = selected;
7955 PROP (TOOL_BAR_ITEM_TYPE) = type;
7ee32cda
GM
7956 }
7957 }
7958 else if (EQ (key, QCimage)
7959 && (CONSP (value)
7960 || (VECTORP (value) && XVECTOR (value)->size == 4)))
7961 /* Value is either a single image specification or a vector
27fd22dc 7962 of 4 such specifications for the different button states. */
9ea173e8 7963 PROP (TOOL_BAR_ITEM_IMAGES) = value;
7ee32cda
GM
7964 }
7965
7966 /* If got a filter apply it on binding. */
7967 if (!NILP (filter))
9ea173e8 7968 PROP (TOOL_BAR_ITEM_BINDING)
7ee32cda
GM
7969 = menu_item_eval_property (list2 (filter,
7970 list2 (Qquote,
9ea173e8 7971 PROP (TOOL_BAR_ITEM_BINDING))));
7ee32cda
GM
7972
7973 /* See if the binding is a keymap. Give up if it is. */
02067692 7974 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
7ee32cda
GM
7975 return 0;
7976
7977 /* Enable or disable selection of item. */
9ea173e8
GM
7978 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
7979 PROP (TOOL_BAR_ITEM_ENABLED_P)
7980 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P));
7ee32cda 7981
c60ee5e7 7982 /* Handle radio buttons or toggle boxes. */
9ea173e8
GM
7983 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
7984 PROP (TOOL_BAR_ITEM_SELECTED_P)
7985 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P));
7ee32cda
GM
7986
7987 return 1;
c60ee5e7 7988
7ee32cda
GM
7989#undef PROP
7990}
7991
7992
9ea173e8
GM
7993/* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
7994 that can be reused. */
7ee32cda
GM
7995
7996static void
9ea173e8 7997init_tool_bar_items (reuse)
7ee32cda
GM
7998 Lisp_Object reuse;
7999{
8000 if (VECTORP (reuse))
9ea173e8 8001 tool_bar_items_vector = reuse;
7ee32cda 8002 else
9ea173e8
GM
8003 tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
8004 ntool_bar_items = 0;
7ee32cda
GM
8005}
8006
8007
9ea173e8
GM
8008/* Append parsed tool bar item properties from
8009 tool_bar_item_properties */
7ee32cda
GM
8010
8011static void
9ea173e8 8012append_tool_bar_item ()
7ee32cda
GM
8013{
8014 Lisp_Object *to, *from;
c60ee5e7 8015
9ea173e8
GM
8016 /* Enlarge tool_bar_items_vector if necessary. */
8017 if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
8018 >= XVECTOR (tool_bar_items_vector)->size)
7ee32cda
GM
8019 {
8020 Lisp_Object new_vector;
9ea173e8 8021 int old_size = XVECTOR (tool_bar_items_vector)->size;
7ee32cda
GM
8022
8023 new_vector = Fmake_vector (make_number (2 * old_size), Qnil);
9ea173e8 8024 bcopy (XVECTOR (tool_bar_items_vector)->contents,
7ee32cda
GM
8025 XVECTOR (new_vector)->contents,
8026 old_size * sizeof (Lisp_Object));
9ea173e8 8027 tool_bar_items_vector = new_vector;
7ee32cda
GM
8028 }
8029
9ea173e8
GM
8030 /* Append entries from tool_bar_item_properties to the end of
8031 tool_bar_items_vector. */
8032 to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
8033 from = XVECTOR (tool_bar_item_properties)->contents;
8034 bcopy (from, to, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
8035 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
7ee32cda
GM
8036}
8037
8038
8039
8040
e8886a1d 8041\f
dcc408a0
RS
8042/* Read a character using menus based on maps in the array MAPS.
8043 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
8044 Return t if we displayed a menu but the user rejected it.
7d6de002
RS
8045
8046 PREV_EVENT is the previous input event, or nil if we are reading
8047 the first event of a key sequence.
8048
83d68044 8049 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
6569cc8d 8050 if we used a mouse menu to read the input, or zero otherwise. If
83d68044 8051 USED_MOUSE_MENU is null, we don't dereference it.
284f4730
JB
8052
8053 The prompting is done based on the prompt-string of the map
df0f2ba1 8054 and the strings associated with various map elements.
8150596a
RS
8055
8056 This can be done with X menus or with menus put in the minibuf.
8057 These are done in different ways, depending on how the input will be read.
8058 Menus using X are done after auto-saving in read-char, getting the input
8059 event from Fx_popup_menu; menus using the minibuf use read_char recursively
8060 and do auto-saving in the inner call of read_char. */
284f4730 8061
7617111f 8062static Lisp_Object
8150596a 8063read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
7d6de002
RS
8064 int nmaps;
8065 Lisp_Object *maps;
8066 Lisp_Object prev_event;
8067 int *used_mouse_menu;
284f4730 8068{
7d6de002 8069 int mapno;
14e40288 8070 register Lisp_Object name = Qnil;
7d6de002 8071
6569cc8d
JB
8072 if (used_mouse_menu)
8073 *used_mouse_menu = 0;
284f4730
JB
8074
8075 /* Use local over global Menu maps */
8076
7d6de002
RS
8077 if (! menu_prompting)
8078 return Qnil;
8079
03361bcc
RS
8080 /* Optionally disregard all but the global map. */
8081 if (inhibit_local_menu_bar_menus)
8082 {
8083 maps += (nmaps - 1);
8084 nmaps = 1;
8085 }
8086
7d6de002
RS
8087 /* Get the menu name from the first map that has one (a prompt string). */
8088 for (mapno = 0; mapno < nmaps; mapno++)
8089 {
bdb7aa47 8090 name = Fkeymap_prompt (maps[mapno]);
7d6de002
RS
8091 if (!NILP (name))
8092 break;
8093 }
284f4730 8094
7d6de002 8095 /* If we don't have any menus, just read a character normally. */
fa113341 8096 if (!STRINGP (name))
7d6de002
RS
8097 return Qnil;
8098
1f5b1641 8099#ifdef HAVE_MENUS
7d6de002
RS
8100 /* If we got to this point via a mouse click,
8101 use a real menu for mouse selection. */
5a8d99e0 8102 if (EVENT_HAS_PARAMETERS (prev_event)
7539e11f
KR
8103 && !EQ (XCAR (prev_event), Qmenu_bar)
8104 && !EQ (XCAR (prev_event), Qtool_bar))
7d6de002
RS
8105 {
8106 /* Display the menu and get the selection. */
8107 Lisp_Object *realmaps
8108 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
8109 Lisp_Object value;
8110 int nmaps1 = 0;
8111
8112 /* Use the maps that are not nil. */
8113 for (mapno = 0; mapno < nmaps; mapno++)
8114 if (!NILP (maps[mapno]))
8115 realmaps[nmaps1++] = maps[mapno];
8116
8117 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
663258f2
JB
8118 if (CONSP (value))
8119 {
68f297c5
RS
8120 Lisp_Object tem;
8121
7539e11f 8122 record_menu_key (XCAR (value));
8eb4d8ef 8123
68f297c5
RS
8124 /* If we got multiple events, unread all but
8125 the first.
8126 There is no way to prevent those unread events
8127 from showing up later in last_nonmenu_event.
8128 So turn symbol and integer events into lists,
8129 to indicate that they came from a mouse menu,
8130 so that when present in last_nonmenu_event
8131 they won't confuse things. */
f4e05d97 8132 for (tem = XCDR (value); !NILP (tem); tem = XCDR (tem))
8eb4d8ef 8133 {
7539e11f
KR
8134 record_menu_key (XCAR (tem));
8135 if (SYMBOLP (XCAR (tem))
8136 || INTEGERP (XCAR (tem)))
f3fbd155 8137 XSETCAR (tem, Fcons (XCAR (tem), Qdisabled));
8eb4d8ef 8138 }
68f297c5 8139
663258f2
JB
8140 /* If we got more than one event, put all but the first
8141 onto this list to be read later.
8142 Return just the first event now. */
24597608 8143 Vunread_command_events
7539e11f
KR
8144 = nconc2 (XCDR (value), Vunread_command_events);
8145 value = XCAR (value);
663258f2 8146 }
1c90c381 8147 else if (NILP (value))
dcc408a0 8148 value = Qt;
6569cc8d
JB
8149 if (used_mouse_menu)
8150 *used_mouse_menu = 1;
7d6de002
RS
8151 return value;
8152 }
1f5b1641 8153#endif /* HAVE_MENUS */
8150596a
RS
8154 return Qnil ;
8155}
8156
af2b7cc9
KS
8157/* Buffer in use so far for the minibuf prompts for menu keymaps.
8158 We make this bigger when necessary, and never free it. */
8159static char *read_char_minibuf_menu_text;
8160/* Size of that buffer. */
8161static int read_char_minibuf_menu_width;
8162
8150596a 8163static Lisp_Object
24597608 8164read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
8150596a
RS
8165 int commandflag ;
8166 int nmaps;
8167 Lisp_Object *maps;
8168{
8169 int mapno;
8170 register Lisp_Object name;
af2b7cc9 8171 int nlength;
14e40288 8172 /* FIXME: Use the minibuffer's frame width. */
2cdbe73e 8173 int width = FRAME_COLS (SELECTED_FRAME ()) - 4;
8150596a 8174 int idx = -1;
af2b7cc9 8175 int nobindings = 1;
8150596a 8176 Lisp_Object rest, vector;
af2b7cc9 8177 char *menu;
8150596a 8178
8c907a56 8179 vector = Qnil;
7189cad8 8180 name = Qnil;
8c907a56 8181
8150596a
RS
8182 if (! menu_prompting)
8183 return Qnil;
8184
af2b7cc9
KS
8185 /* Make sure we have a big enough buffer for the menu text. */
8186 if (read_char_minibuf_menu_text == 0)
8187 {
8188 read_char_minibuf_menu_width = width + 4;
8189 read_char_minibuf_menu_text = (char *) xmalloc (width + 4);
8190 }
8191 else if (width + 4 > read_char_minibuf_menu_width)
8192 {
8193 read_char_minibuf_menu_width = width + 4;
8194 read_char_minibuf_menu_text
8195 = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
8196 }
8197 menu = read_char_minibuf_menu_text;
8198
8150596a
RS
8199 /* Get the menu name from the first map that has one (a prompt string). */
8200 for (mapno = 0; mapno < nmaps; mapno++)
8201 {
bdb7aa47 8202 name = Fkeymap_prompt (maps[mapno]);
8150596a
RS
8203 if (!NILP (name))
8204 break;
8205 }
8206
8207 /* If we don't have any menus, just read a character normally. */
fa113341 8208 if (!STRINGP (name))
8150596a 8209 return Qnil;
284f4730 8210
af2b7cc9 8211 /* Prompt string always starts with map's prompt, and a space. */
d5db4077
KR
8212 strcpy (menu, SDATA (name));
8213 nlength = SBYTES (name);
af2b7cc9
KS
8214 menu[nlength++] = ':';
8215 menu[nlength++] = ' ';
8216 menu[nlength] = 0;
8217
7d6de002
RS
8218 /* Start prompting at start of first map. */
8219 mapno = 0;
8220 rest = maps[mapno];
284f4730 8221
af2b7cc9
KS
8222 /* Present the documented bindings, a line at a time. */
8223 while (1)
284f4730 8224 {
af2b7cc9
KS
8225 int notfirst = 0;
8226 int i = nlength;
8227 Lisp_Object obj;
8228 int ch;
8229 Lisp_Object orig_defn_macro;
284f4730 8230
af2b7cc9
KS
8231 /* Loop over elements of map. */
8232 while (i < width)
284f4730 8233 {
af2b7cc9 8234 Lisp_Object elt;
284f4730 8235
af2b7cc9
KS
8236 /* If reached end of map, start at beginning of next map. */
8237 if (NILP (rest))
8238 {
8239 mapno++;
8240 /* At end of last map, wrap around to first map if just starting,
8241 or end this line if already have something on it. */
8242 if (mapno == nmaps)
8243 {
8244 mapno = 0;
8245 if (notfirst || nobindings) break;
8246 }
8247 rest = maps[mapno];
8248 }
7d6de002 8249
af2b7cc9
KS
8250 /* Look at the next element of the map. */
8251 if (idx >= 0)
8252 elt = XVECTOR (vector)->contents[idx];
8253 else
8254 elt = Fcar_safe (rest);
7d6de002 8255
af2b7cc9 8256 if (idx < 0 && VECTORP (elt))
284f4730 8257 {
af2b7cc9
KS
8258 /* If we found a dense table in the keymap,
8259 advanced past it, but start scanning its contents. */
8260 rest = Fcdr_safe (rest);
8261 vector = elt;
8262 idx = 0;
284f4730 8263 }
7d6de002
RS
8264 else
8265 {
af2b7cc9
KS
8266 /* An ordinary element. */
8267 Lisp_Object event, tem;
7d6de002 8268
af2b7cc9
KS
8269 if (idx < 0)
8270 {
8271 event = Fcar_safe (elt); /* alist */
8272 elt = Fcdr_safe (elt);
8273 }
8274 else
8275 {
8276 XSETINT (event, idx); /* vector */
8277 }
284f4730 8278
af2b7cc9
KS
8279 /* Ignore the element if it has no prompt string. */
8280 if (INTEGERP (event) && parse_menu_item (elt, 0, -1))
8281 {
8282 /* 1 if the char to type matches the string. */
8283 int char_matches;
8284 Lisp_Object upcased_event, downcased_event;
8285 Lisp_Object desc = Qnil;
8286 Lisp_Object s
8287 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
8288
8289 upcased_event = Fupcase (event);
8290 downcased_event = Fdowncase (event);
d5db4077
KR
8291 char_matches = (XINT (upcased_event) == SREF (s, 0)
8292 || XINT (downcased_event) == SREF (s, 0));
af2b7cc9
KS
8293 if (! char_matches)
8294 desc = Fsingle_key_description (event, Qnil);
8295
8296#if 0 /* It is redundant to list the equivalent key bindings because
8297 the prefix is what the user has already typed. */
8298 tem
8299 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
8300 if (!NILP (tem))
8301 /* Insert equivalent keybinding. */
8302 s = concat2 (s, tem);
8303#endif
8304 tem
8305 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
8306 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
8307 {
8308 /* Insert button prefix. */
8309 Lisp_Object selected
8310 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
8311 if (EQ (tem, QCradio))
8312 tem = build_string (NILP (selected) ? "(*) " : "( ) ");
8313 else
8314 tem = build_string (NILP (selected) ? "[X] " : "[ ] ");
8315 s = concat2 (tem, s);
8316 }
c60ee5e7 8317
af2b7cc9
KS
8318
8319 /* If we have room for the prompt string, add it to this line.
8320 If this is the first on the line, always add it. */
d5db4077
KR
8321 if ((SCHARS (s) + i + 2
8322 + (char_matches ? 0 : SCHARS (desc) + 3))
af2b7cc9
KS
8323 < width
8324 || !notfirst)
8325 {
8326 int thiswidth;
8327
8328 /* Punctuate between strings. */
8329 if (notfirst)
8330 {
8331 strcpy (menu + i, ", ");
8332 i += 2;
8333 }
8334 notfirst = 1;
8335 nobindings = 0 ;
8336
8337 /* If the char to type doesn't match the string's
8338 first char, explicitly show what char to type. */
8339 if (! char_matches)
8340 {
8341 /* Add as much of string as fits. */
d5db4077 8342 thiswidth = SCHARS (desc);
af2b7cc9
KS
8343 if (thiswidth + i > width)
8344 thiswidth = width - i;
d5db4077 8345 bcopy (SDATA (desc), menu + i, thiswidth);
af2b7cc9
KS
8346 i += thiswidth;
8347 strcpy (menu + i, " = ");
8348 i += 3;
8349 }
8350
8351 /* Add as much of string as fits. */
d5db4077 8352 thiswidth = SCHARS (s);
af2b7cc9
KS
8353 if (thiswidth + i > width)
8354 thiswidth = width - i;
d5db4077 8355 bcopy (SDATA (s), menu + i, thiswidth);
af2b7cc9
KS
8356 i += thiswidth;
8357 menu[i] = 0;
8358 }
8359 else
8360 {
8361 /* If this element does not fit, end the line now,
8362 and save the element for the next line. */
8363 strcpy (menu + i, "...");
8364 break;
8365 }
8366 }
8367
8368 /* Move past this element. */
8369 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
8370 /* Handle reaching end of dense table. */
8371 idx = -1;
8372 if (idx >= 0)
8373 idx++;
8374 else
8375 rest = Fcdr_safe (rest);
8376 }
325309f5 8377 }
8150596a 8378
af2b7cc9 8379 /* Prompt with that and read response. */
c60ee5e7 8380 message2_nolog (menu, strlen (menu),
af2b7cc9 8381 ! NILP (current_buffer->enable_multibyte_characters));
284f4730 8382
af2b7cc9
KS
8383 /* Make believe its not a keyboard macro in case the help char
8384 is pressed. Help characters are not recorded because menu prompting
8385 is not used on replay.
8386 */
8387 orig_defn_macro = current_kboard->defining_kbd_macro;
8388 current_kboard->defining_kbd_macro = Qnil;
8389 do
8390 obj = read_char (commandflag, 0, 0, Qt, 0);
8391 while (BUFFERP (obj));
8392 current_kboard->defining_kbd_macro = orig_defn_macro;
284f4730 8393
af2b7cc9
KS
8394 if (!INTEGERP (obj))
8395 return obj;
8396 else
8397 ch = XINT (obj);
8398
8399 if (! EQ (obj, menu_prompt_more_char)
8400 && (!INTEGERP (menu_prompt_more_char)
8401 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
8402 {
8403 if (!NILP (current_kboard->defining_kbd_macro))
8404 store_kbd_macro_char (obj);
8405 return obj;
8406 }
8407 /* Help char - go round again */
8408 }
284f4730 8409}
284f4730
JB
8410\f
8411/* Reading key sequences. */
8412
8413/* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
8414 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
8415 keymap, or nil otherwise. Return the index of the first keymap in
8416 which KEY has any binding, or NMAPS if no map has a binding.
8417
8418 If KEY is a meta ASCII character, treat it like meta-prefix-char
8419 followed by the corresponding non-meta character. Keymaps in
8420 CURRENT with non-prefix bindings for meta-prefix-char become nil in
8421 NEXT.
8422
88cb0656
JB
8423 If KEY has no bindings in any of the CURRENT maps, NEXT is left
8424 unmodified.
8425
569871d2 8426 NEXT may be the same array as CURRENT. */
284f4730
JB
8427
8428static int
4e50f26a 8429follow_key (key, nmaps, current, defs, next)
284f4730
JB
8430 Lisp_Object key;
8431 Lisp_Object *current, *defs, *next;
8432 int nmaps;
8433{
8434 int i, first_binding;
8435
284f4730
JB
8436 first_binding = nmaps;
8437 for (i = nmaps - 1; i >= 0; i--)
8438 {
8439 if (! NILP (current[i]))
8440 {
fe5b94c5 8441 defs[i] = access_keymap (current[i], key, 1, 0, 1);
284f4730
JB
8442 if (! NILP (defs[i]))
8443 first_binding = i;
8444 }
8445 else
8446 defs[i] = Qnil;
8447 }
8448
284f4730 8449 /* Given the set of bindings we've found, produce the next set of maps. */
0a7f1fc0
JB
8450 if (first_binding < nmaps)
8451 for (i = 0; i < nmaps; i++)
02067692 8452 next[i] = NILP (defs[i]) ? Qnil : get_keymap (defs[i], 0, 1);
284f4730
JB
8453
8454 return first_binding;
8455}
8456
a7f26f28
SM
8457/* Structure used to keep track of partial application of key remapping
8458 such as Vfunction_key_map and Vkey_translation_map. */
8459typedef struct keyremap
8460{
24d80a06 8461 Lisp_Object map, parent;
a7f26f28
SM
8462 int start, end;
8463} keyremap;
8464
fe5b94c5
SM
8465/* Lookup KEY in MAP.
8466 MAP is a keymap mapping keys to key vectors or functions.
8467 If the mapping is a function and DO_FUNCTION is non-zero, then
8468 the function is called with PROMPT as parameter and its return
8469 value is used as the return value of this function (after checking
8470 that it is indeed a vector). */
8471
8472static Lisp_Object
8473access_keymap_keyremap (map, key, prompt, do_funcall)
8474 Lisp_Object map, key, prompt;
8475 int do_funcall;
8476{
8477 Lisp_Object next;
2320865d 8478
fe5b94c5
SM
8479 next = access_keymap (map, key, 1, 0, 1);
8480
8481 /* Handle symbol with autoload definition. */
8482 if (SYMBOLP (next) && !NILP (Ffboundp (next))
8483 && CONSP (XSYMBOL (next)->function)
8484 && EQ (XCAR (XSYMBOL (next)->function), Qautoload))
8485 do_autoload (XSYMBOL (next)->function, next);
8486
8487 /* Handle a symbol whose function definition is a keymap
8488 or an array. */
8489 if (SYMBOLP (next) && !NILP (Ffboundp (next))
8490 && (!NILP (Farrayp (XSYMBOL (next)->function))
8491 || KEYMAPP (XSYMBOL (next)->function)))
8492 next = XSYMBOL (next)->function;
2320865d 8493
fe5b94c5
SM
8494 /* If the keymap gives a function, not an
8495 array, then call the function with one arg and use
8496 its value instead. */
8497 if (SYMBOLP (next) && !NILP (Ffboundp (next)) && do_funcall)
8498 {
8499 Lisp_Object tem;
8500 tem = next;
8501
8502 next = call1 (next, prompt);
8503 /* If the function returned something invalid,
8504 barf--don't ignore it.
8505 (To ignore it safely, we would need to gcpro a bunch of
8506 other variables.) */
8507 if (! (VECTORP (next) || STRINGP (next)))
8508 error ("Function %s returns invalid key sequence", tem);
8509 }
8510 return next;
8511}
8512
8513/* Do one step of the key remapping used for function-key-map and
8514 key-translation-map:
8515 KEYBUF is the buffer holding the input events.
8516 BUFSIZE is its maximum size.
8517 FKEY is a pointer to the keyremap structure to use.
8518 INPUT is the index of the last element in KEYBUF.
8519 DOIT if non-zero says that the remapping can actually take place.
8520 DIFF is used to return the number of keys added/removed by the remapping.
8521 PARENT is the root of the keymap.
8522 PROMPT is the prompt to use if the remapping happens through a function.
8523 The return value is non-zero if the remapping actually took place. */
8524
8525static int
24d80a06
SM
8526keyremap_step (keybuf, bufsize, fkey, input, doit, diff, prompt)
8527 Lisp_Object *keybuf, prompt;
fe5b94c5
SM
8528 keyremap *fkey;
8529 int input, doit, *diff, bufsize;
8530{
8531 Lisp_Object next, key;
8532
8533 key = keybuf[fkey->end++];
8534 next = access_keymap_keyremap (fkey->map, key, prompt, doit);
8535
8536 /* If keybuf[fkey->start..fkey->end] is bound in the
8537 map and we're in a position to do the key remapping, replace it with
8538 the binding and restart with fkey->start at the end. */
8539 if ((VECTORP (next) || STRINGP (next)) && doit)
8540 {
8541 int len = XFASTINT (Flength (next));
8542 int i;
8543
8544 *diff = len - (fkey->end - fkey->start);
8545
8546 if (input + *diff >= bufsize)
8547 error ("Key sequence too long");
8548
8549 /* Shift the keys that follow fkey->end. */
8550 if (*diff < 0)
8551 for (i = fkey->end; i < input; i++)
8552 keybuf[i + *diff] = keybuf[i];
8553 else if (*diff > 0)
8554 for (i = input - 1; i >= fkey->end; i--)
8555 keybuf[i + *diff] = keybuf[i];
8556 /* Overwrite the old keys with the new ones. */
8557 for (i = 0; i < len; i++)
8558 keybuf[fkey->start + i]
8559 = Faref (next, make_number (i));
8560
8561 fkey->start = fkey->end += *diff;
24d80a06 8562 fkey->map = fkey->parent;
fe5b94c5
SM
8563
8564 return 1;
8565 }
8566
8567 fkey->map = get_keymap (next, 0, 1);
8568
8569 /* If we no longer have a bound suffix, try a new position for
8570 fkey->start. */
8571 if (!CONSP (fkey->map))
8572 {
8573 fkey->end = ++fkey->start;
24d80a06 8574 fkey->map = fkey->parent;
fe5b94c5
SM
8575 }
8576 return 0;
8577}
a7f26f28 8578
df0f2ba1 8579/* Read a sequence of keys that ends with a non prefix character,
f4255cd1
JB
8580 storing it in KEYBUF, a buffer of size BUFSIZE.
8581 Prompt with PROMPT.
284f4730 8582 Return the length of the key sequence stored.
dcc408a0 8583 Return -1 if the user rejected a command menu.
284f4730 8584
f4255cd1
JB
8585 Echo starting immediately unless `prompt' is 0.
8586
8587 Where a key sequence ends depends on the currently active keymaps.
8588 These include any minor mode keymaps active in the current buffer,
8589 the current buffer's local map, and the global map.
8590
8591 If a key sequence has no other bindings, we check Vfunction_key_map
8592 to see if some trailing subsequence might be the beginning of a
8593 function key's sequence. If so, we try to read the whole function
8594 key, and substitute its symbolic name into the key sequence.
8595
fbcd35bd
JB
8596 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
8597 `double-' events into similar click events, if that would make them
8598 bound. We try to turn `triple-' events first into `double-' events,
8599 then into clicks.
f4255cd1
JB
8600
8601 If we get a mouse click in a mode line, vertical divider, or other
8602 non-text area, we treat the click as if it were prefixed by the
8603 symbol denoting that area - `mode-line', `vertical-line', or
8604 whatever.
8605
8606 If the sequence starts with a mouse click, we read the key sequence
8607 with respect to the buffer clicked on, not the current buffer.
284f4730 8608
f4255cd1
JB
8609 If the user switches frames in the midst of a key sequence, we put
8610 off the switch-frame event until later; the next call to
f571ae0d
RS
8611 read_char will return it.
8612
8613 If FIX_CURRENT_BUFFER is nonzero, we restore current_buffer
8614 from the selected window's buffer. */
48e416d4 8615
284f4730 8616static int
ce98e608 8617read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
f571ae0d 8618 can_return_switch_frame, fix_current_buffer)
284f4730
JB
8619 Lisp_Object *keybuf;
8620 int bufsize;
84d91fda 8621 Lisp_Object prompt;
309b0fc8 8622 int dont_downcase_last;
ce98e608 8623 int can_return_switch_frame;
f571ae0d 8624 int fix_current_buffer;
284f4730 8625{
db14cfc5 8626 volatile Lisp_Object from_string;
aed13378 8627 volatile int count = SPECPDL_INDEX ();
f4255cd1 8628
284f4730 8629 /* How many keys there are in the current key sequence. */
8c907a56 8630 volatile int t;
284f4730 8631
284f4730
JB
8632 /* The length of the echo buffer when we started reading, and
8633 the length of this_command_keys when we started reading. */
8c907a56
GM
8634 volatile int echo_start;
8635 volatile int keys_start;
284f4730
JB
8636
8637 /* The number of keymaps we're scanning right now, and the number of
8638 keymaps we have allocated space for. */
8c907a56
GM
8639 volatile int nmaps;
8640 volatile int nmaps_allocated = 0;
284f4730 8641
284f4730
JB
8642 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
8643 the current keymaps. */
8c907a56 8644 Lisp_Object *volatile defs = NULL;
284f4730 8645
f4255cd1
JB
8646 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
8647 in the current keymaps, or nil where it is not a prefix. */
8c907a56 8648 Lisp_Object *volatile submaps = NULL;
f4255cd1 8649
e0dff5f6 8650 /* The local map to start out with at start of key sequence. */
8c907a56 8651 volatile Lisp_Object orig_local_map;
e0dff5f6 8652
30690496
DL
8653 /* The map from the `keymap' property to start out with at start of
8654 key sequence. */
8c907a56 8655 volatile Lisp_Object orig_keymap;
30690496 8656
e0dff5f6
RS
8657 /* 1 if we have already considered switching to the local-map property
8658 of the place where a mouse click occurred. */
8c907a56 8659 volatile int localized_local_map = 0;
e0dff5f6 8660
f4255cd1
JB
8661 /* The index in defs[] of the first keymap that has a binding for
8662 this key sequence. In other words, the lowest i such that
8663 defs[i] is non-nil. */
8c907a56 8664 volatile int first_binding;
7189cad8 8665 /* Index of the first key that has no binding.
a7f26f28 8666 It is useless to try fkey.start larger than that. */
7189cad8 8667 volatile int first_unbound;
284f4730 8668
f4255cd1 8669 /* If t < mock_input, then KEYBUF[t] should be read as the next
253598e4
JB
8670 input key.
8671
8672 We use this to recover after recognizing a function key. Once we
8673 realize that a suffix of the current key sequence is actually a
8674 function key's escape sequence, we replace the suffix with the
8675 function key's binding from Vfunction_key_map. Now keybuf
f4255cd1
JB
8676 contains a new and different key sequence, so the echo area,
8677 this_command_keys, and the submaps and defs arrays are wrong. In
8678 this situation, we set mock_input to t, set t to 0, and jump to
8679 restart_sequence; the loop will read keys from keybuf up until
8680 mock_input, thus rebuilding the state; and then it will resume
8681 reading characters from the keyboard. */
8c907a56 8682 volatile int mock_input = 0;
284f4730 8683
253598e4 8684 /* If the sequence is unbound in submaps[], then
a7f26f28
SM
8685 keybuf[fkey.start..fkey.end-1] is a prefix in Vfunction_key_map,
8686 and fkey.map is its binding.
253598e4 8687
f4255cd1
JB
8688 These might be > t, indicating that all function key scanning
8689 should hold off until t reaches them. We do this when we've just
8690 recognized a function key, to avoid searching for the function
8691 key's again in Vfunction_key_map. */
a7f26f28 8692 volatile keyremap fkey;
284f4730 8693
a612e298 8694 /* Likewise, for key_translation_map. */
a7f26f28 8695 volatile keyremap keytran;
a612e298 8696
fe5b94c5
SM
8697 /* If we receive a `switch-frame' or `select-window' event in the middle of
8698 a key sequence, we put it off for later.
8699 While we're reading, we keep the event here. */
8c907a56 8700 volatile Lisp_Object delayed_switch_frame;
cd21b839 8701
51763820
BF
8702 /* See the comment below... */
8703#if defined (GOBBLE_FIRST_EVENT)
4efda7dd 8704 Lisp_Object first_event;
51763820 8705#endif
4efda7dd 8706
8c907a56
GM
8707 volatile Lisp_Object original_uppercase;
8708 volatile int original_uppercase_position = -1;
309b0fc8 8709
bc536d84 8710 /* Gets around Microsoft compiler limitations. */
309b0fc8 8711 int dummyflag = 0;
bc536d84 8712
3b9189f8
RS
8713 struct buffer *starting_buffer;
8714
2dc00208
GM
8715 /* List of events for which a fake prefix key has been generated. */
8716 volatile Lisp_Object fake_prefixed_keys = Qnil;
8717
03cee6ae 8718#if defined (GOBBLE_FIRST_EVENT)
4efda7dd 8719 int junk;
03cee6ae 8720#endif
4efda7dd 8721
2dc00208
GM
8722 struct gcpro gcpro1;
8723
8724 GCPRO1 (fake_prefixed_keys);
7d18f9ae
RS
8725 raw_keybuf_count = 0;
8726
4efda7dd
RS
8727 last_nonmenu_event = Qnil;
8728
8729 delayed_switch_frame = Qnil;
ac09dc1e
KL
8730 fkey.map = fkey.parent = current_kboard->Vlocal_function_key_map;
8731 keytran.map = keytran.parent = current_kboard->Vlocal_key_translation_map;
a7f26f28
SM
8732 /* If there is no translation-map, turn off scanning. */
8733 fkey.start = fkey.end = KEYMAPP (fkey.map) ? 0 : bufsize + 1;
8734 keytran.start = keytran.end = KEYMAPP (keytran.map) ? 0 : bufsize + 1;
a612e298 8735
284f4730
JB
8736 if (INTERACTIVE)
8737 {
84d91fda 8738 if (!NILP (prompt))
a4ef85ee 8739 echo_prompt (prompt);
f2647d04
DL
8740 else if (cursor_in_echo_area
8741 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8742 && NILP (Fzerop (Vecho_keystrokes)))
284f4730
JB
8743 /* This doesn't put in a dash if the echo buffer is empty, so
8744 you don't always see a dash hanging out in the minibuffer. */
8745 echo_dash ();
284f4730
JB
8746 }
8747
f4255cd1
JB
8748 /* Record the initial state of the echo area and this_command_keys;
8749 we will need to restore them if we replay a key sequence. */
0a7f1fc0 8750 if (INTERACTIVE)
df0f2ba1 8751 echo_start = echo_length ();
f4255cd1 8752 keys_start = this_command_key_count;
6321824f 8753 this_single_command_key_start = keys_start;
0a7f1fc0 8754
51763820
BF
8755#if defined (GOBBLE_FIRST_EVENT)
8756 /* This doesn't quite work, because some of the things that read_char
8757 does cannot safely be bypassed. It seems too risky to try to make
df0f2ba1 8758 this work right. */
51763820 8759
4efda7dd
RS
8760 /* Read the first char of the sequence specially, before setting
8761 up any keymaps, in case a filter runs and switches buffers on us. */
84d91fda 8762 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
4efda7dd 8763 &junk);
51763820 8764#endif /* GOBBLE_FIRST_EVENT */
4efda7dd 8765
24a40fbb
GM
8766 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8767 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
db14cfc5 8768 from_string = Qnil;
e0dff5f6 8769
7b4aedb9
JB
8770 /* We jump here when the key sequence has been thoroughly changed, and
8771 we need to rescan it starting from the beginning. When we jump here,
8772 keybuf[0..mock_input] holds the sequence we should reread. */
07d2b8de 8773 replay_sequence:
7b4aedb9 8774
3b9189f8 8775 starting_buffer = current_buffer;
7189cad8 8776 first_unbound = bufsize + 1;
3b9189f8 8777
f4255cd1 8778 /* Build our list of keymaps.
07d2b8de
JB
8779 If we recognize a function key and replace its escape sequence in
8780 keybuf with its symbol, or if the sequence starts with a mouse
8781 click and we need to switch buffers, we jump back here to rebuild
8782 the initial keymaps from the current buffer. */
4cbedc16 8783 nmaps = 0;
284f4730 8784
4cbedc16
RS
8785 if (!NILP (current_kboard->Voverriding_terminal_local_map)
8786 || !NILP (Voverriding_local_map))
8787 {
8788 if (3 > nmaps_allocated)
8789 {
8790 submaps = (Lisp_Object *) alloca (3 * sizeof (submaps[0]));
8791 defs = (Lisp_Object *) alloca (3 * sizeof (defs[0]));
8792 nmaps_allocated = 3;
8793 }
8794 if (!NILP (current_kboard->Voverriding_terminal_local_map))
8795 submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
8796 if (!NILP (Voverriding_local_map))
8797 submaps[nmaps++] = Voverriding_local_map;
8798 }
8799 else
8800 {
4cbedc16
RS
8801 int nminor;
8802 int total;
8803 Lisp_Object *maps;
8804
8805 nminor = current_minor_maps (0, &maps);
8806 total = nminor + (!NILP (orig_keymap) ? 3 : 2);
8807
8808 if (total > nmaps_allocated)
8809 {
8810 submaps = (Lisp_Object *) alloca (total * sizeof (submaps[0]));
8811 defs = (Lisp_Object *) alloca (total * sizeof (defs[0]));
8812 nmaps_allocated = total;
8813 }
8814
8815 if (!NILP (orig_keymap))
8816 submaps[nmaps++] = orig_keymap;
8817
7d1c4866 8818 bcopy (maps, (void *) (submaps + nmaps),
4cbedc16
RS
8819 nminor * sizeof (submaps[0]));
8820
8821 nmaps += nminor;
8822
8823 submaps[nmaps++] = orig_local_map;
8824 }
8825 submaps[nmaps++] = current_global_map;
284f4730
JB
8826
8827 /* Find an accurate initial value for first_binding. */
8828 for (first_binding = 0; first_binding < nmaps; first_binding++)
253598e4 8829 if (! NILP (submaps[first_binding]))
284f4730
JB
8830 break;
8831
3b9189f8 8832 /* Start from the beginning in keybuf. */
f4255cd1
JB
8833 t = 0;
8834
8835 /* These are no-ops the first time through, but if we restart, they
8836 revert the echo area and this_command_keys to their original state. */
8837 this_command_key_count = keys_start;
df0f2ba1 8838 if (INTERACTIVE && t < mock_input)
f4255cd1
JB
8839 echo_truncate (echo_start);
8840
cca310da
JB
8841 /* If the best binding for the current key sequence is a keymap, or
8842 we may be looking at a function key's escape sequence, keep on
8843 reading. */
a7f26f28
SM
8844 while (first_binding < nmaps
8845 /* Keep reading as long as there's a prefix binding. */
8846 ? !NILP (submaps[first_binding])
e9bf89a0
RS
8847 /* Don't return in the middle of a possible function key sequence,
8848 if the only bindings we found were via case conversion.
8849 Thus, if ESC O a has a function-key-map translation
8850 and ESC o has a binding, don't return after ESC O,
8851 so that we can translate ESC O plus the next character. */
a7f26f28 8852 : (fkey.start < t || keytran.start < t))
284f4730
JB
8853 {
8854 Lisp_Object key;
7d6de002 8855 int used_mouse_menu = 0;
284f4730 8856
7b4aedb9
JB
8857 /* Where the last real key started. If we need to throw away a
8858 key that has expanded into more than one element of keybuf
8859 (say, a mouse click on the mode line which is being treated
8860 as [mode-line (mouse-...)], then we backtrack to this point
8861 of keybuf. */
8c907a56 8862 volatile int last_real_key_start;
7b4aedb9 8863
0a7f1fc0
JB
8864 /* These variables are analogous to echo_start and keys_start;
8865 while those allow us to restart the entire key sequence,
8866 echo_local_start and keys_local_start allow us to throw away
8867 just one key. */
8c907a56 8868 volatile int echo_local_start, keys_local_start, local_first_binding;
f4255cd1 8869
fe5b94c5
SM
8870 eassert (fkey.end == t || (fkey.end > t && fkey.end <= mock_input));
8871 eassert (fkey.start <= fkey.end);
8872 eassert (keytran.start <= keytran.end);
2cf4b7b2 8873 /* key-translation-map is applied *after* function-key-map. */
a7f26f28 8874 eassert (keytran.end <= fkey.start);
7189cad8 8875
a7f26f28 8876 if (first_unbound < fkey.start && first_unbound < keytran.start)
7189cad8
SM
8877 { /* The prefix upto first_unbound has no binding and has
8878 no translation left to do either, so we know it's unbound.
8879 If we don't stop now, we risk staying here indefinitely
8880 (if the user keeps entering fkey or keytran prefixes
8881 like C-c ESC ESC ESC ESC ...) */
8882 int i;
8883 for (i = first_unbound + 1; i < t; i++)
8884 keybuf[i - first_unbound - 1] = keybuf[i];
8885 mock_input = t - first_unbound - 1;
a7f26f28 8886 fkey.end = fkey.start -= first_unbound + 1;
24d80a06 8887 fkey.map = fkey.parent;
a7f26f28 8888 keytran.end = keytran.start -= first_unbound + 1;
24d80a06 8889 keytran.map = keytran.parent;
7189cad8
SM
8890 goto replay_sequence;
8891 }
8892
284f4730 8893 if (t >= bufsize)
3fe8e9a2 8894 error ("Key sequence too long");
284f4730 8895
f4255cd1
JB
8896 if (INTERACTIVE)
8897 echo_local_start = echo_length ();
8898 keys_local_start = this_command_key_count;
8899 local_first_binding = first_binding;
df0f2ba1 8900
f4255cd1 8901 replay_key:
0a7f1fc0 8902 /* These are no-ops, unless we throw away a keystroke below and
f4255cd1
JB
8903 jumped back up to replay_key; in that case, these restore the
8904 variables to their original state, allowing us to replay the
0a7f1fc0 8905 loop. */
40932d1a 8906 if (INTERACTIVE && t < mock_input)
f4255cd1 8907 echo_truncate (echo_local_start);
0a7f1fc0
JB
8908 this_command_key_count = keys_local_start;
8909 first_binding = local_first_binding;
8910
7e85b935
RS
8911 /* By default, assume each event is "real". */
8912 last_real_key_start = t;
8913
f4255cd1 8914 /* Does mock_input indicate that we are re-reading a key sequence? */
284f4730
JB
8915 if (t < mock_input)
8916 {
8917 key = keybuf[t];
8918 add_command_key (key);
f2647d04
DL
8919 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8920 && NILP (Fzerop (Vecho_keystrokes)))
a98ea3f9 8921 echo_char (key);
284f4730 8922 }
253598e4
JB
8923
8924 /* If not, we should actually read a character. */
284f4730
JB
8925 else
8926 {
beecf6a1 8927 {
c5fdd383
KH
8928#ifdef MULTI_KBOARD
8929 KBOARD *interrupted_kboard = current_kboard;
788f89eb 8930 struct frame *interrupted_frame = SELECTED_FRAME ();
c5fdd383 8931 if (setjmp (wrong_kboard_jmpbuf))
beecf6a1 8932 {
5798cf15
KH
8933 if (!NILP (delayed_switch_frame))
8934 {
c5fdd383 8935 interrupted_kboard->kbd_queue
5798cf15 8936 = Fcons (delayed_switch_frame,
c5fdd383 8937 interrupted_kboard->kbd_queue);
5798cf15
KH
8938 delayed_switch_frame = Qnil;
8939 }
beecf6a1 8940 while (t > 0)
c5fdd383
KH
8941 interrupted_kboard->kbd_queue
8942 = Fcons (keybuf[--t], interrupted_kboard->kbd_queue);
5798cf15
KH
8943
8944 /* If the side queue is non-empty, ensure it begins with a
8945 switch-frame, so we'll replay it in the right context. */
c5fdd383 8946 if (CONSP (interrupted_kboard->kbd_queue)
7539e11f 8947 && (key = XCAR (interrupted_kboard->kbd_queue),
5798cf15
KH
8948 !(EVENT_HAS_PARAMETERS (key)
8949 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
8950 Qswitch_frame))))
df0f2ba1
KH
8951 {
8952 Lisp_Object frame;
8953 XSETFRAME (frame, interrupted_frame);
c5fdd383 8954 interrupted_kboard->kbd_queue
df0f2ba1 8955 = Fcons (make_lispy_switch_frame (frame),
c5fdd383 8956 interrupted_kboard->kbd_queue);
df0f2ba1 8957 }
beecf6a1 8958 mock_input = 0;
24a40fbb
GM
8959 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8960 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
beecf6a1
KH
8961 goto replay_sequence;
8962 }
bded54dd 8963#endif
8c907a56
GM
8964 key = read_char (NILP (prompt), nmaps,
8965 (Lisp_Object *) submaps, last_nonmenu_event,
beecf6a1
KH
8966 &used_mouse_menu);
8967 }
284f4730 8968
dcc408a0
RS
8969 /* read_char returns t when it shows a menu and the user rejects it.
8970 Just return -1. */
8971 if (EQ (key, Qt))
7d18f9ae
RS
8972 {
8973 unbind_to (count, Qnil);
2dc00208 8974 UNGCPRO;
7d18f9ae
RS
8975 return -1;
8976 }
dcc408a0 8977
f4255cd1 8978 /* read_char returns -1 at the end of a macro.
284f4730
JB
8979 Emacs 18 handles this by returning immediately with a
8980 zero, so that's what we'll do. */
8c18cbfb 8981 if (INTEGERP (key) && XINT (key) == -1)
cd21b839 8982 {
f4255cd1 8983 t = 0;
bc536d84
RS
8984 /* The Microsoft C compiler can't handle the goto that
8985 would go here. */
309b0fc8 8986 dummyflag = 1;
bc536d84 8987 break;
cd21b839 8988 }
df0f2ba1 8989
3cb81011
KH
8990 /* If the current buffer has been changed from under us, the
8991 keymap may have changed, so replay the sequence. */
8c18cbfb 8992 if (BUFFERP (key))
3cb81011 8993 {
5c12e63f 8994 timer_resume_idle ();
3021d3a9 8995
3cb81011 8996 mock_input = t;
f571ae0d
RS
8997 /* Reset the current buffer from the selected window
8998 in case something changed the former and not the latter.
8999 This is to be more consistent with the behavior
9000 of the command_loop_1. */
9001 if (fix_current_buffer)
a94a4335 9002 {
788f89eb 9003 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
a94a4335
KH
9004 Fkill_emacs (Qnil);
9005 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
9006 Fset_buffer (XWINDOW (selected_window)->buffer);
9007 }
f571ae0d 9008
24a40fbb
GM
9009 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
9010 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
3cb81011
KH
9011 goto replay_sequence;
9012 }
9013
3b9189f8
RS
9014 /* If we have a quit that was typed in another frame, and
9015 quit_throw_to_read_char switched buffers,
9016 replay to get the right keymap. */
f4e05d97
GM
9017 if (INTEGERP (key)
9018 && XINT (key) == quit_char
9019 && current_buffer != starting_buffer)
3b9189f8 9020 {
7d18f9ae
RS
9021 GROW_RAW_KEYBUF;
9022 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
3b9189f8
RS
9023 keybuf[t++] = key;
9024 mock_input = t;
9025 Vquit_flag = Qnil;
24a40fbb
GM
9026 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
9027 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
3b9189f8
RS
9028 goto replay_sequence;
9029 }
3cb81011 9030
284f4730 9031 Vquit_flag = Qnil;
7d18f9ae
RS
9032
9033 if (EVENT_HAS_PARAMETERS (key)
fe5b94c5 9034 /* Either a `switch-frame' or a `select-window' event. */
7d18f9ae
RS
9035 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
9036 {
9037 /* If we're at the beginning of a key sequence, and the caller
9038 says it's okay, go ahead and return this event. If we're
9039 in the midst of a key sequence, delay it until the end. */
9040 if (t > 0 || !can_return_switch_frame)
9041 {
9042 delayed_switch_frame = key;
9043 goto replay_key;
9044 }
9045 }
9046
9047 GROW_RAW_KEYBUF;
9048 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
7e85b935 9049 }
284f4730 9050
df0f2ba1 9051 /* Clicks in non-text areas get prefixed by the symbol
7e85b935
RS
9052 in their CHAR-ADDRESS field. For example, a click on
9053 the mode line is prefixed by the symbol `mode-line'.
9054
9055 Furthermore, key sequences beginning with mouse clicks
9056 are read using the keymaps of the buffer clicked on, not
9057 the current buffer. So we may have to switch the buffer
9058 here.
9059
9060 When we turn one event into two events, we must make sure
9061 that neither of the two looks like the original--so that,
9062 if we replay the events, they won't be expanded again.
9063 If not for this, such reexpansion could happen either here
9064 or when user programs play with this-command-keys. */
9065 if (EVENT_HAS_PARAMETERS (key))
9066 {
9b8eb840 9067 Lisp_Object kind;
45de137a 9068 Lisp_Object string;
cca310da 9069
9b8eb840 9070 kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
7e85b935 9071 if (EQ (kind, Qmouse_click))
0a7f1fc0 9072 {
9b8eb840 9073 Lisp_Object window, posn;
f4255cd1 9074
9b8eb840 9075 window = POSN_WINDOW (EVENT_START (key));
eee5863b 9076 posn = POSN_POSN (EVENT_START (key));
7ee32cda 9077
2cf066c3
GM
9078 if (CONSP (posn)
9079 || (!NILP (fake_prefixed_keys)
9080 && !NILP (Fmemq (key, fake_prefixed_keys))))
0a7f1fc0 9081 {
2cf066c3
GM
9082 /* We're looking a second time at an event for which
9083 we generated a fake prefix key. Set
7e85b935
RS
9084 last_real_key_start appropriately. */
9085 if (t > 0)
9086 last_real_key_start = t - 1;
cd21b839 9087 }
7e85b935
RS
9088
9089 /* Key sequences beginning with mouse clicks are
9090 read using the keymaps in the buffer clicked on,
9091 not the current buffer. If we're at the
9092 beginning of a key sequence, switch buffers. */
9093 if (last_real_key_start == 0
8c18cbfb
KH
9094 && WINDOWP (window)
9095 && BUFFERP (XWINDOW (window)->buffer)
7e85b935 9096 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
cd21b839 9097 {
7d18f9ae 9098 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
7e85b935
RS
9099 keybuf[t] = key;
9100 mock_input = t + 1;
9101
9102 /* Arrange to go back to the original buffer once we're
9103 done reading the key sequence. Note that we can't
9104 use save_excursion_{save,restore} here, because they
9105 save point as well as the current buffer; we don't
9106 want to save point, because redisplay may change it,
9107 to accommodate a Fset_window_start or something. We
9108 don't want to do this at the top of the function,
9109 because we may get input from a subprocess which
9110 wants to change the selected window and stuff (say,
9111 emacsclient). */
9112 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
9113
788f89eb 9114 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
a94a4335 9115 Fkill_emacs (Qnil);
24a40fbb 9116 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
30690496 9117 orig_local_map = get_local_map (PT, current_buffer,
24a40fbb
GM
9118 Qlocal_map);
9119 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
7e85b935 9120 goto replay_sequence;
0a7f1fc0 9121 }
c60ee5e7 9122
e0dff5f6
RS
9123 /* For a mouse click, get the local text-property keymap
9124 of the place clicked on, rather than point. */
7ee32cda 9125 if (last_real_key_start == 0
7539e11f 9126 && CONSP (XCDR (key))
e0dff5f6 9127 && ! localized_local_map)
5ec75a55 9128 {
e0dff5f6
RS
9129 Lisp_Object map_here, start, pos;
9130
9131 localized_local_map = 1;
9132 start = EVENT_START (key);
c60ee5e7 9133
eee5863b 9134 if (CONSP (start) && POSN_INBUFFER_P (start))
e0dff5f6
RS
9135 {
9136 pos = POSN_BUFFER_POSN (start);
b78ce8fb
RS
9137 if (INTEGERP (pos)
9138 && XINT (pos) >= BEG && XINT (pos) <= Z)
e0dff5f6 9139 {
30690496 9140 map_here = get_local_map (XINT (pos),
24a40fbb 9141 current_buffer, Qlocal_map);
e0dff5f6
RS
9142 if (!EQ (map_here, orig_local_map))
9143 {
9144 orig_local_map = map_here;
9145 keybuf[t] = key;
9146 mock_input = t + 1;
5ec75a55 9147
30690496
DL
9148 goto replay_sequence;
9149 }
9150 map_here = get_local_map (XINT (pos),
24a40fbb 9151 current_buffer, Qkeymap);
30690496
DL
9152 if (!EQ (map_here, orig_keymap))
9153 {
9154 orig_keymap = map_here;
9155 keybuf[t] = key;
9156 mock_input = t + 1;
9157
e0dff5f6
RS
9158 goto replay_sequence;
9159 }
9160 }
9161 }
9162 }
9163
9164 /* Expand mode-line and scroll-bar events into two events:
9165 use posn as a fake prefix key. */
2dc00208
GM
9166 if (SYMBOLP (posn)
9167 && (NILP (fake_prefixed_keys)
9168 || NILP (Fmemq (key, fake_prefixed_keys))))
e0dff5f6 9169 {
7e85b935 9170 if (t + 1 >= bufsize)
3fe8e9a2 9171 error ("Key sequence too long");
c60ee5e7 9172
2dc00208
GM
9173 keybuf[t] = posn;
9174 keybuf[t + 1] = key;
9175 mock_input = t + 2;
9176
9177 /* Record that a fake prefix key has been generated
9178 for KEY. Don't modify the event; this would
9179 prevent proper action when the event is pushed
c7f4f573 9180 back into unread-command-events. */
2dc00208 9181 fake_prefixed_keys = Fcons (key, fake_prefixed_keys);
7ee32cda
GM
9182
9183 /* If on a mode line string with a local keymap,
9184 reconsider the key sequence with that keymap. */
45de137a
KS
9185 if (string = POSN_STRING (EVENT_START (key)),
9186 (CONSP (string) && STRINGP (XCAR (string))))
7ee32cda 9187 {
45de137a 9188 Lisp_Object pos, map, map2;
7ee32cda 9189
7ee32cda
GM
9190 pos = XCDR (string);
9191 string = XCAR (string);
52e386c2 9192 if (XINT (pos) >= 0
d5db4077 9193 && XINT (pos) < SCHARS (string))
30690496
DL
9194 {
9195 map = Fget_text_property (pos, Qlocal_map, string);
9196 if (!NILP (map))
9197 orig_local_map = map;
9198 map2 = Fget_text_property (pos, Qkeymap, string);
9199 if (!NILP (map2))
9200 orig_keymap = map2;
9201 if (!NILP (map) || !NILP (map2))
9202 goto replay_sequence;
9203 }
7ee32cda
GM
9204 }
9205
7e85b935 9206 goto replay_key;
5ec75a55 9207 }
45de137a
KS
9208 else if (NILP (from_string)
9209 && (string = POSN_STRING (EVENT_START (key)),
9210 (CONSP (string) && STRINGP (XCAR (string)))))
db14cfc5
GM
9211 {
9212 /* For a click on a string, i.e. overlay string or a
9213 string displayed via the `display' property,
9214 consider `local-map' and `keymap' properties of
9215 that string. */
45de137a 9216 Lisp_Object pos, map, map2;
db14cfc5 9217
db14cfc5
GM
9218 pos = XCDR (string);
9219 string = XCAR (string);
9220 if (XINT (pos) >= 0
d5db4077 9221 && XINT (pos) < SCHARS (string))
db14cfc5
GM
9222 {
9223 map = Fget_text_property (pos, Qlocal_map, string);
9224 if (!NILP (map))
9225 orig_local_map = map;
9226 map2 = Fget_text_property (pos, Qkeymap, string);
9227 if (!NILP (map2))
9228 orig_keymap = map2;
9229
9230 if (!NILP (map) || !NILP (map2))
9231 {
9232 from_string = string;
9233 goto replay_sequence;
9234 }
9235 }
9236 }
0a7f1fc0 9237 }
7539e11f 9238 else if (CONSP (XCDR (key))
7a80a6f6 9239 && CONSP (EVENT_START (key))
7539e11f 9240 && CONSP (XCDR (EVENT_START (key))))
7e85b935 9241 {
9b8eb840 9242 Lisp_Object posn;
7e85b935 9243
eee5863b 9244 posn = POSN_POSN (EVENT_START (key));
7e85b935
RS
9245 /* Handle menu-bar events:
9246 insert the dummy prefix event `menu-bar'. */
9ea173e8 9247 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
7e85b935
RS
9248 {
9249 if (t + 1 >= bufsize)
3fe8e9a2 9250 error ("Key sequence too long");
7e85b935
RS
9251 keybuf[t] = posn;
9252 keybuf[t+1] = key;
9253
9254 /* Zap the position in key, so we know that we've
9255 expanded it, and don't try to do so again. */
eee5863b
KS
9256 POSN_SET_POSN (EVENT_START (key),
9257 Fcons (posn, Qnil));
7e85b935
RS
9258
9259 mock_input = t + 2;
9260 goto replay_sequence;
9261 }
8c18cbfb 9262 else if (CONSP (posn))
7e85b935
RS
9263 {
9264 /* We're looking at the second event of a
9265 sequence which we expanded before. Set
9266 last_real_key_start appropriately. */
9267 if (last_real_key_start == t && t > 0)
9268 last_real_key_start = t - 1;
9269 }
a6d53864 9270 }
284f4730 9271 }
f4255cd1
JB
9272
9273 /* We have finally decided that KEY is something we might want
9274 to look up. */
284f4730
JB
9275 first_binding = (follow_key (key,
9276 nmaps - first_binding,
253598e4 9277 submaps + first_binding,
284f4730 9278 defs + first_binding,
4e50f26a 9279 submaps + first_binding)
284f4730 9280 + first_binding);
0a7f1fc0 9281
f4255cd1 9282 /* If KEY wasn't bound, we'll try some fallbacks. */
65e0fbbf
SM
9283 if (first_binding < nmaps)
9284 /* This is needed for the following scenario:
9285 event 0: a down-event that gets dropped by calling replay_key.
9286 event 1: some normal prefix like C-h.
a7f26f28
SM
9287 After event 0, first_unbound is 0, after event 1 fkey.start
9288 and keytran.start are both 1, so when we see that C-h is bound,
65e0fbbf
SM
9289 we need to update first_unbound. */
9290 first_unbound = max (t + 1, first_unbound);
9291 else
0a7f1fc0 9292 {
9b8eb840 9293 Lisp_Object head;
c60ee5e7 9294
a7f26f28 9295 /* Remember the position to put an upper bound on fkey.start. */
7189cad8 9296 first_unbound = min (t, first_unbound);
0a7f1fc0 9297
9b8eb840 9298 head = EVENT_HEAD (key);
24736fbc 9299 if (help_char_p (head) && t > 0)
7e85b935
RS
9300 {
9301 read_key_sequence_cmd = Vprefix_help_command;
9302 keybuf[t++] = key;
9303 last_nonmenu_event = key;
bc536d84
RS
9304 /* The Microsoft C compiler can't handle the goto that
9305 would go here. */
309b0fc8 9306 dummyflag = 1;
0d882d52 9307 break;
7e85b935
RS
9308 }
9309
8c18cbfb 9310 if (SYMBOLP (head))
0a7f1fc0 9311 {
9b8eb840
KH
9312 Lisp_Object breakdown;
9313 int modifiers;
0a7f1fc0 9314
9b8eb840 9315 breakdown = parse_modifiers (head);
7539e11f 9316 modifiers = XINT (XCAR (XCDR (breakdown)));
559f9d04
RS
9317 /* Attempt to reduce an unbound mouse event to a simpler
9318 event that is bound:
9319 Drags reduce to clicks.
9320 Double-clicks reduce to clicks.
9321 Triple-clicks reduce to double-clicks, then to clicks.
9322 Down-clicks are eliminated.
9323 Double-downs reduce to downs, then are eliminated.
9324 Triple-downs reduce to double-downs, then to downs,
9325 then are eliminated. */
9326 if (modifiers & (down_modifier | drag_modifier
9327 | double_modifier | triple_modifier))
0a7f1fc0 9328 {
559f9d04
RS
9329 while (modifiers & (down_modifier | drag_modifier
9330 | double_modifier | triple_modifier))
fbcd35bd
JB
9331 {
9332 Lisp_Object new_head, new_click;
9333 if (modifiers & triple_modifier)
9334 modifiers ^= (double_modifier | triple_modifier);
bc536d84
RS
9335 else if (modifiers & double_modifier)
9336 modifiers &= ~double_modifier;
9337 else if (modifiers & drag_modifier)
9338 modifiers &= ~drag_modifier;
559f9d04
RS
9339 else
9340 {
9341 /* Dispose of this `down' event by simply jumping
9342 back to replay_key, to get another event.
9343
9344 Note that if this event came from mock input,
9345 then just jumping back to replay_key will just
9346 hand it to us again. So we have to wipe out any
9347 mock input.
9348
9349 We could delete keybuf[t] and shift everything
9350 after that to the left by one spot, but we'd also
9351 have to fix up any variable that points into
9352 keybuf, and shifting isn't really necessary
9353 anyway.
9354
9355 Adding prefixes for non-textual mouse clicks
9356 creates two characters of mock input, and both
9357 must be thrown away. If we're only looking at
9358 the prefix now, we can just jump back to
9359 replay_key. On the other hand, if we've already
9360 processed the prefix, and now the actual click
9361 itself is giving us trouble, then we've lost the
9362 state of the keymaps we want to backtrack to, and
9363 we need to replay the whole sequence to rebuild
9364 it.
9365
9366 Beyond that, only function key expansion could
9367 create more than two keys, but that should never
9368 generate mouse events, so it's okay to zero
9369 mock_input in that case too.
9370
65e0fbbf
SM
9371 FIXME: The above paragraph seems just plain
9372 wrong, if you consider things like
9373 xterm-mouse-mode. -stef
9374
559f9d04 9375 Isn't this just the most wonderful code ever? */
017be6c7
SM
9376
9377 /* If mock_input > t + 1, the above simplification
9378 will actually end up dropping keys on the floor.
9379 This is probably OK for now, but even
9380 if mock_input <= t + 1, we need to adjust fkey
9381 and keytran.
9382 Typical case [header-line down-mouse-N]:
9383 mock_input = 2, t = 1, fkey.end = 1,
9384 last_real_key_start = 0. */
9385 if (fkey.end > last_real_key_start)
9386 {
9387 fkey.end = fkey.start
9388 = min (last_real_key_start, fkey.start);
9389 fkey.map = fkey.parent;
9390 if (keytran.end > last_real_key_start)
9391 {
9392 keytran.end = keytran.start
9393 = min (last_real_key_start, keytran.start);
9394 keytran.map = keytran.parent;
9395 }
9396 }
559f9d04
RS
9397 if (t == last_real_key_start)
9398 {
9399 mock_input = 0;
9400 goto replay_key;
9401 }
9402 else
9403 {
9404 mock_input = last_real_key_start;
9405 goto replay_sequence;
9406 }
9407 }
9408
27203ead 9409 new_head
7539e11f 9410 = apply_modifiers (modifiers, XCAR (breakdown));
27203ead
RS
9411 new_click
9412 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
fbcd35bd
JB
9413
9414 /* Look for a binding for this new key. follow_key
9415 promises that it didn't munge submaps the
9416 last time we called it, since key was unbound. */
27203ead
RS
9417 first_binding
9418 = (follow_key (new_click,
9419 nmaps - local_first_binding,
9420 submaps + local_first_binding,
9421 defs + local_first_binding,
4e50f26a 9422 submaps + local_first_binding)
27203ead 9423 + local_first_binding);
fbcd35bd
JB
9424
9425 /* If that click is bound, go for it. */
9426 if (first_binding < nmaps)
9427 {
9428 key = new_click;
9429 break;
9430 }
9431 /* Otherwise, we'll leave key set to the drag event. */
9432 }
0a7f1fc0
JB
9433 }
9434 }
9435 }
9436
284f4730 9437 keybuf[t++] = key;
7d6de002
RS
9438 /* Normally, last_nonmenu_event gets the previous key we read.
9439 But when a mouse popup menu is being used,
9440 we don't update last_nonmenu_event; it continues to hold the mouse
9441 event that preceded the first level of menu. */
9442 if (!used_mouse_menu)
9443 last_nonmenu_event = key;
284f4730 9444
6321824f
RS
9445 /* Record what part of this_command_keys is the current key sequence. */
9446 this_single_command_key_start = this_command_key_count - t;
9447
65e0fbbf
SM
9448 if (first_binding < nmaps && NILP (submaps[first_binding]))
9449 /* There is a binding and it's not a prefix.
9450 There is thus no function-key in this sequence.
9451 Moving fkey.start is important in this case to allow keytran.start
9452 to go over the sequence before we return (since we keep the
9453 invariant that keytran.end <= fkey.start). */
9454 {
a7f26f28 9455 if (fkey.start < t)
24d80a06 9456 (fkey.start = fkey.end = t, fkey.map = fkey.parent);
65e0fbbf
SM
9457 }
9458 else
9459 /* If the sequence is unbound, see if we can hang a function key
9460 off the end of it. */
fe5b94c5
SM
9461 /* Continue scan from fkey.end until we find a bound suffix. */
9462 while (fkey.end < t)
a612e298 9463 {
fe5b94c5
SM
9464 struct gcpro gcpro1, gcpro2, gcpro3;
9465 int done, diff;
9466
9467 GCPRO3 (fkey.map, keytran.map, delayed_switch_frame);
9468 done = keyremap_step (keybuf, bufsize, &fkey,
9469 max (t, mock_input),
9470 /* If there's a binding (i.e.
9471 first_binding >= nmaps) we don't want
9472 to apply this function-key-mapping. */
9473 fkey.end + 1 == t && first_binding >= nmaps,
24d80a06 9474 &diff, prompt);
fe5b94c5
SM
9475 UNGCPRO;
9476 if (done)
a612e298 9477 {
fe5b94c5 9478 mock_input = diff + max (t, mock_input);
a612e298
RS
9479 goto replay_sequence;
9480 }
fe5b94c5 9481 }
a612e298 9482
fe5b94c5
SM
9483 /* Look for this sequence in key-translation-map.
9484 Scan from keytran.end until we find a bound suffix. */
9485 while (keytran.end < fkey.start)
9486 {
9487 struct gcpro gcpro1, gcpro2, gcpro3;
9488 int done, diff;
a612e298 9489
fe5b94c5
SM
9490 GCPRO3 (fkey.map, keytran.map, delayed_switch_frame);
9491 done = keyremap_step (keybuf, bufsize, &keytran, max (t, mock_input),
24d80a06 9492 1, &diff, prompt);
fe5b94c5
SM
9493 UNGCPRO;
9494 if (done)
9495 {
9496 mock_input = diff + max (t, mock_input);
9497 /* Adjust the function-key-map counters. */
9498 fkey.end += diff;
9499 fkey.start += diff;
2320865d 9500
fe5b94c5
SM
9501 goto replay_sequence;
9502 }
9503 }
4e50f26a
RS
9504
9505 /* If KEY is not defined in any of the keymaps,
9506 and cannot be part of a function key or translation,
9507 and is an upper case letter
9508 use the corresponding lower-case letter instead. */
65e0fbbf 9509 if (first_binding >= nmaps
a7f26f28 9510 && fkey.start >= t && keytran.start >= t
8c18cbfb 9511 && INTEGERP (key)
4e50f26a 9512 && ((((XINT (key) & 0x3ffff)
301738ed 9513 < XCHAR_TABLE (current_buffer->downcase_table)->size)
4e50f26a
RS
9514 && UPPERCASEP (XINT (key) & 0x3ffff))
9515 || (XINT (key) & shift_modifier)))
9516 {
569871d2 9517 Lisp_Object new_key;
569871d2 9518
309b0fc8
RS
9519 original_uppercase = key;
9520 original_uppercase_position = t - 1;
9521
831f35a2 9522 if (XINT (key) & shift_modifier)
569871d2 9523 XSETINT (new_key, XINT (key) & ~shift_modifier);
4e50f26a 9524 else
569871d2
RS
9525 XSETINT (new_key, (DOWNCASE (XINT (key) & 0x3ffff)
9526 | (XINT (key) & ~0x3ffff)));
9527
3fe8e9a2
RS
9528 /* We have to do this unconditionally, regardless of whether
9529 the lower-case char is defined in the keymaps, because they
9530 might get translated through function-key-map. */
9531 keybuf[t - 1] = new_key;
2cf4b7b2 9532 mock_input = max (t, mock_input);
3fe8e9a2
RS
9533
9534 goto replay_sequence;
4e50f26a 9535 }
ef8fd672
RS
9536 /* If KEY is not defined in any of the keymaps,
9537 and cannot be part of a function key or translation,
9538 and is a shifted function key,
9539 use the corresponding unshifted function key instead. */
65e0fbbf 9540 if (first_binding >= nmaps
a7f26f28 9541 && fkey.start >= t && keytran.start >= t
ef8fd672
RS
9542 && SYMBOLP (key))
9543 {
9544 Lisp_Object breakdown;
9545 int modifiers;
9546
9547 breakdown = parse_modifiers (key);
7539e11f 9548 modifiers = XINT (XCAR (XCDR (breakdown)));
ef8fd672
RS
9549 if (modifiers & shift_modifier)
9550 {
569871d2 9551 Lisp_Object new_key;
3fe8e9a2
RS
9552
9553 original_uppercase = key;
9554 original_uppercase_position = t - 1;
ef8fd672 9555
569871d2
RS
9556 modifiers &= ~shift_modifier;
9557 new_key = apply_modifiers (modifiers,
7539e11f 9558 XCAR (breakdown));
569871d2 9559
3fe8e9a2 9560 keybuf[t - 1] = new_key;
2cf4b7b2 9561 mock_input = max (t, mock_input);
f1871a7d
RS
9562 fkey.start = fkey.end = KEYMAPP (fkey.map) ? 0 : bufsize + 1;
9563 keytran.start = keytran.end = KEYMAPP (keytran.map) ? 0 : bufsize + 1;
3fe8e9a2
RS
9564
9565 goto replay_sequence;
ef8fd672
RS
9566 }
9567 }
284f4730
JB
9568 }
9569
309b0fc8 9570 if (!dummyflag)
bc536d84
RS
9571 read_key_sequence_cmd = (first_binding < nmaps
9572 ? defs[first_binding]
9573 : Qnil);
284f4730 9574
cd21b839 9575 unread_switch_frame = delayed_switch_frame;
f4255cd1 9576 unbind_to (count, Qnil);
07f76a14 9577
3fe8e9a2
RS
9578 /* Don't downcase the last character if the caller says don't.
9579 Don't downcase it if the result is undefined, either. */
9580 if ((dont_downcase_last || first_binding >= nmaps)
9581 && t - 1 == original_uppercase_position)
309b0fc8
RS
9582 keybuf[t - 1] = original_uppercase;
9583
07f76a14
JB
9584 /* Occasionally we fabricate events, perhaps by expanding something
9585 according to function-key-map, or by adding a prefix symbol to a
9586 mouse click in the scroll bar or modeline. In this cases, return
9587 the entire generated key sequence, even if we hit an unbound
9588 prefix or a definition before the end. This means that you will
9589 be able to push back the event properly, and also means that
9590 read-key-sequence will always return a logical unit.
9591
9592 Better ideas? */
cca310da
JB
9593 for (; t < mock_input; t++)
9594 {
f2647d04
DL
9595 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
9596 && NILP (Fzerop (Vecho_keystrokes)))
a98ea3f9 9597 echo_char (keybuf[t]);
cca310da
JB
9598 add_command_key (keybuf[t]);
9599 }
07f76a14 9600
c60ee5e7 9601
7d18f9ae 9602
2dc00208 9603 UNGCPRO;
284f4730
JB
9604 return t;
9605}
9606
d5eecefb 9607DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
4707d2d0
PJ
9608 doc: /* Read a sequence of keystrokes and return as a string or vector.
9609The sequence is sufficient to specify a non-prefix command in the
9610current local and global maps.
9611
9612First arg PROMPT is a prompt string. If nil, do not prompt specially.
9613Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos
9614as a continuation of the previous key.
9615
9616The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
9617convert the last event to lower case. (Normally any upper case event
9618is converted to lower case if the original event is undefined and the lower
9619case equivalent is defined.) A non-nil value is appropriate for reading
9620a key sequence to be defined.
9621
9622A C-g typed while in this function is treated like any other character,
9623and `quit-flag' is not set.
9624
9625If the key sequence starts with a mouse click, then the sequence is read
9626using the keymaps of the buffer of the window clicked in, not the buffer
9627of the selected window as normal.
9628
9629`read-key-sequence' drops unbound button-down events, since you normally
9630only care about the click or drag events which follow them. If a drag
9631or multi-click event is unbound, but the corresponding click event would
9632be bound, `read-key-sequence' turns the event into a click event at the
9633drag's starting position. This means that you don't have to distinguish
9634between click and drag, double, or triple events unless you want to.
9635
9636`read-key-sequence' prefixes mouse events on mode lines, the vertical
9637lines separating windows, and scroll bars with imaginary keys
9638`mode-line', `vertical-line', and `vertical-scroll-bar'.
9639
9640Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this
9641function will process a switch-frame event if the user switches frames
9642before typing anything. If the user switches frames in the middle of a
9643key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME
9644is nil, then the event will be put off until after the current key sequence.
9645
9646`read-key-sequence' checks `function-key-map' for function key
9647sequences, where they wouldn't conflict with ordinary bindings. See
9648`function-key-map' for more details.
9649
9650The optional fifth argument COMMAND-LOOP, if non-nil, means
9651that this key sequence is being read by something that will
9652read commands one after another. It should be nil if the caller
9653will read just one key sequence. */)
d5eecefb
RS
9654 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
9655 command_loop)
309b0fc8 9656 Lisp_Object prompt, continue_echo, dont_downcase_last;
d5eecefb 9657 Lisp_Object can_return_switch_frame, command_loop;
284f4730
JB
9658{
9659 Lisp_Object keybuf[30];
9660 register int i;
03cee6ae 9661 struct gcpro gcpro1;
aed13378 9662 int count = SPECPDL_INDEX ();
284f4730
JB
9663
9664 if (!NILP (prompt))
b7826503 9665 CHECK_STRING (prompt);
284f4730
JB
9666 QUIT;
9667
d5eecefb
RS
9668 specbind (Qinput_method_exit_on_first_char,
9669 (NILP (command_loop) ? Qt : Qnil));
9670 specbind (Qinput_method_use_echo_area,
9671 (NILP (command_loop) ? Qt : Qnil));
9672
284f4730
JB
9673 bzero (keybuf, sizeof keybuf);
9674 GCPRO1 (keybuf[0]);
9675 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
9676
daa37602 9677 if (NILP (continue_echo))
6321824f
RS
9678 {
9679 this_command_key_count = 0;
63020c46 9680 this_command_key_count_reset = 0;
6321824f
RS
9681 this_single_command_key_start = 0;
9682 }
c0a58692 9683
d0c48478 9684#ifdef HAVE_X_WINDOWS
526a058f
GM
9685 if (display_hourglass_p)
9686 cancel_hourglass ();
d0c48478
GM
9687#endif
9688
309b0fc8 9689 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
ce98e608 9690 prompt, ! NILP (dont_downcase_last),
f571ae0d 9691 ! NILP (can_return_switch_frame), 0);
284f4730 9692
ae18aa3b 9693#if 0 /* The following is fine for code reading a key sequence and
f95c4fe5 9694 then proceeding with a lenghty computation, but it's not good
ae18aa3b 9695 for code reading keys in a loop, like an input method. */
d0c48478 9696#ifdef HAVE_X_WINDOWS
526a058f
GM
9697 if (display_hourglass_p)
9698 start_hourglass ();
ae18aa3b 9699#endif
d0c48478
GM
9700#endif
9701
dcc408a0
RS
9702 if (i == -1)
9703 {
9704 Vquit_flag = Qt;
9705 QUIT;
9706 }
284f4730 9707 UNGCPRO;
d5eecefb 9708 return unbind_to (count, make_event_array (i, keybuf));
284f4730 9709}
e39da3d7
RS
9710
9711DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
d5eecefb 9712 Sread_key_sequence_vector, 1, 5, 0,
4707d2d0
PJ
9713 doc: /* Like `read-key-sequence' but always return a vector. */)
9714 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
9715 command_loop)
e39da3d7 9716 Lisp_Object prompt, continue_echo, dont_downcase_last;
d5eecefb 9717 Lisp_Object can_return_switch_frame, command_loop;
e39da3d7
RS
9718{
9719 Lisp_Object keybuf[30];
9720 register int i;
03cee6ae 9721 struct gcpro gcpro1;
aed13378 9722 int count = SPECPDL_INDEX ();
e39da3d7
RS
9723
9724 if (!NILP (prompt))
b7826503 9725 CHECK_STRING (prompt);
e39da3d7
RS
9726 QUIT;
9727
d5eecefb
RS
9728 specbind (Qinput_method_exit_on_first_char,
9729 (NILP (command_loop) ? Qt : Qnil));
9730 specbind (Qinput_method_use_echo_area,
9731 (NILP (command_loop) ? Qt : Qnil));
9732
e39da3d7
RS
9733 bzero (keybuf, sizeof keybuf);
9734 GCPRO1 (keybuf[0]);
9735 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
9736
9737 if (NILP (continue_echo))
9738 {
9739 this_command_key_count = 0;
63020c46 9740 this_command_key_count_reset = 0;
e39da3d7
RS
9741 this_single_command_key_start = 0;
9742 }
9743
d0c48478 9744#ifdef HAVE_X_WINDOWS
526a058f
GM
9745 if (display_hourglass_p)
9746 cancel_hourglass ();
d0c48478
GM
9747#endif
9748
e39da3d7
RS
9749 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
9750 prompt, ! NILP (dont_downcase_last),
9751 ! NILP (can_return_switch_frame), 0);
9752
d0c48478 9753#ifdef HAVE_X_WINDOWS
526a058f
GM
9754 if (display_hourglass_p)
9755 start_hourglass ();
d0c48478
GM
9756#endif
9757
e39da3d7
RS
9758 if (i == -1)
9759 {
9760 Vquit_flag = Qt;
9761 QUIT;
9762 }
9763 UNGCPRO;
d5eecefb 9764 return unbind_to (count, Fvector (i, keybuf));
e39da3d7 9765}
284f4730 9766\f
158f7532 9767DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0,
4707d2d0
PJ
9768 doc: /* Execute CMD as an editor command.
9769CMD must be a symbol that satisfies the `commandp' predicate.
9770Optional second arg RECORD-FLAG non-nil
9771means unconditionally put this command in `command-history'.
9772Otherwise, that is done only if an arg is read using the minibuffer.
9773The argument KEYS specifies the value to use instead of (this-command-keys)
9774when reading the arguments; if it is nil, (this-command-keys) is used.
9775The argument SPECIAL, if non-nil, means that this command is executing
9776a special event, so ignore the prefix argument and don't clear it. */)
158f7532
RS
9777 (cmd, record_flag, keys, special)
9778 Lisp_Object cmd, record_flag, keys, special;
284f4730
JB
9779{
9780 register Lisp_Object final;
9781 register Lisp_Object tem;
9782 Lisp_Object prefixarg;
9783 struct backtrace backtrace;
9784 extern int debug_on_next_call;
9785
284f4730
JB
9786 debug_on_next_call = 0;
9787
158f7532
RS
9788 if (NILP (special))
9789 {
9790 prefixarg = current_kboard->Vprefix_arg;
9791 Vcurrent_prefix_arg = prefixarg;
9792 current_kboard->Vprefix_arg = Qnil;
9793 }
9794 else
9795 prefixarg = Qnil;
9796
8c18cbfb 9797 if (SYMBOLP (cmd))
284f4730
JB
9798 {
9799 tem = Fget (cmd, Qdisabled);
88ce066e 9800 if (!NILP (tem) && !NILP (Vrun_hooks))
b78ce8fb 9801 {
971e4c98 9802 tem = Fsymbol_value (Qdisabled_command_function);
b78ce8fb 9803 if (!NILP (tem))
971e4c98 9804 return call1 (Vrun_hooks, Qdisabled_command_function);
b78ce8fb 9805 }
284f4730
JB
9806 }
9807
01e26217 9808 while (1)
284f4730 9809 {
ffd56f97 9810 final = Findirect_function (cmd);
284f4730
JB
9811
9812 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
b516a185
RS
9813 {
9814 struct gcpro gcpro1, gcpro2;
9815
9816 GCPRO2 (cmd, prefixarg);
9817 do_autoload (final, cmd);
9818 UNGCPRO;
9819 }
284f4730
JB
9820 else
9821 break;
9822 }
9823
8c18cbfb 9824 if (STRINGP (final) || VECTORP (final))
284f4730
JB
9825 {
9826 /* If requested, place the macro in the command history. For
9827 other sorts of commands, call-interactively takes care of
9828 this. */
e57d8fd8 9829 if (!NILP (record_flag))
f4385381
RS
9830 {
9831 Vcommand_history
9832 = Fcons (Fcons (Qexecute_kbd_macro,
9833 Fcons (final, Fcons (prefixarg, Qnil))),
9834 Vcommand_history);
9835
9836 /* Don't keep command history around forever. */
9837 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
9838 {
9839 tem = Fnthcdr (Vhistory_length, Vcommand_history);
9840 if (CONSP (tem))
f3fbd155 9841 XSETCDR (tem, Qnil);
f4385381
RS
9842 }
9843 }
284f4730 9844
caa06051 9845 return Fexecute_kbd_macro (final, prefixarg, Qnil);
284f4730 9846 }
f4385381 9847
8c18cbfb 9848 if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
284f4730
JB
9849 {
9850 backtrace.next = backtrace_list;
9851 backtrace_list = &backtrace;
9852 backtrace.function = &Qcall_interactively;
9853 backtrace.args = &cmd;
9854 backtrace.nargs = 1;
9855 backtrace.evalargs = 0;
080e18b1 9856 backtrace.debug_on_exit = 0;
284f4730 9857
e57d8fd8 9858 tem = Fcall_interactively (cmd, record_flag, keys);
284f4730
JB
9859
9860 backtrace_list = backtrace.next;
9861 return tem;
9862 }
9863 return Qnil;
9864}
c970a760
GM
9865
9866
284f4730 9867\f
284f4730 9868DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
4707d2d0
PJ
9869 1, 1, "P",
9870 doc: /* Read function name, then read its arguments and call it. */)
9871 (prefixarg)
284f4730
JB
9872 Lisp_Object prefixarg;
9873{
9874 Lisp_Object function;
9875 char buf[40];
2e1a49ad
SM
9876 int saved_last_point_position;
9877 Lisp_Object saved_keys, saved_last_point_position_buffer;
5434fce6 9878 Lisp_Object bindings, value;
2e1a49ad 9879 struct gcpro gcpro1, gcpro2, gcpro3;
a25e44b2
JD
9880#ifdef HAVE_X_WINDOWS
9881 /* The call to Fcompleting_read wil start and cancel the hourglass,
9882 but if the hourglass was already scheduled, this means that no
9883 hourglass will be shown for the actual M-x command itself.
9884 So we restart it if it is already scheduled. Note that checking
9885 hourglass_shown_p is not enough, normally the hourglass is not shown,
9886 just scheduled to be shown. */
9887 int hstarted = hourglass_started ();
9888#endif
284f4730 9889
b0f2a7bf
KH
9890 saved_keys = Fvector (this_command_key_count,
9891 XVECTOR (this_command_keys)->contents);
2e1a49ad
SM
9892 saved_last_point_position_buffer = last_point_position_buffer;
9893 saved_last_point_position = last_point_position;
284f4730 9894 buf[0] = 0;
2e1a49ad 9895 GCPRO3 (saved_keys, prefixarg, saved_last_point_position_buffer);
284f4730
JB
9896
9897 if (EQ (prefixarg, Qminus))
9898 strcpy (buf, "- ");
7539e11f 9899 else if (CONSP (prefixarg) && XINT (XCAR (prefixarg)) == 4)
284f4730 9900 strcpy (buf, "C-u ");
7539e11f 9901 else if (CONSP (prefixarg) && INTEGERP (XCAR (prefixarg)))
cea5d0d4 9902 sprintf (buf, "%ld ", (long) XINT (XCAR (prefixarg)));
8c18cbfb 9903 else if (INTEGERP (prefixarg))
cea5d0d4 9904 sprintf (buf, "%ld ", (long) XINT (prefixarg));
284f4730
JB
9905
9906 /* This isn't strictly correct if execute-extended-command
9907 is bound to anything else. Perhaps it should use
9908 this_command_keys? */
9909 strcat (buf, "M-x ");
9910
9911 /* Prompt with buf, and then read a string, completing from and
9912 restricting to the set of all defined commands. Don't provide
51763820 9913 any initial input. Save the command read on the extended-command
03b4122a 9914 history list. */
284f4730
JB
9915 function = Fcompleting_read (build_string (buf),
9916 Vobarray, Qcommandp,
4328577a
KH
9917 Qt, Qnil, Qextended_command_history, Qnil,
9918 Qnil);
284f4730 9919
a25e44b2
JD
9920#ifdef HAVE_X_WINDOWS
9921 if (hstarted) start_hourglass ();
9922#endif
9923
d5db4077 9924 if (STRINGP (function) && SCHARS (function) == 0)
1f5b1641
RS
9925 error ("No command name given");
9926
1113d9db
JB
9927 /* Set this_command_keys to the concatenation of saved_keys and
9928 function, followed by a RET. */
284f4730 9929 {
b0f2a7bf 9930 Lisp_Object *keys;
284f4730 9931 int i;
284f4730 9932
1113d9db 9933 this_command_key_count = 0;
63020c46 9934 this_command_key_count_reset = 0;
6321824f 9935 this_single_command_key_start = 0;
1113d9db 9936
b0f2a7bf
KH
9937 keys = XVECTOR (saved_keys)->contents;
9938 for (i = 0; i < XVECTOR (saved_keys)->size; i++)
9939 add_command_key (keys[i]);
1113d9db 9940
1b049b51 9941 for (i = 0; i < SCHARS (function); i++)
301738ed 9942 add_command_key (Faref (function, make_number (i)));
1113d9db 9943
301738ed 9944 add_command_key (make_number ('\015'));
284f4730
JB
9945 }
9946
2e1a49ad
SM
9947 last_point_position = saved_last_point_position;
9948 last_point_position_buffer = saved_last_point_position_buffer;
9949
284f4730
JB
9950 UNGCPRO;
9951
0a7f1fc0 9952 function = Fintern (function, Qnil);
d8bcf58e 9953 current_kboard->Vprefix_arg = prefixarg;
d5eecefb
RS
9954 Vthis_command = function;
9955 real_this_command = function;
284f4730 9956
6526ab49
RS
9957 /* If enabled, show which key runs this command. */
9958 if (!NILP (Vsuggest_key_bindings)
ce0d2858 9959 && NILP (Vexecuting_kbd_macro)
6526ab49 9960 && SYMBOLP (function))
5434fce6 9961 bindings = Fwhere_is_internal (function, Voverriding_local_map,
8b9940e6 9962 Qt, Qnil, Qnil);
5434fce6
RS
9963 else
9964 bindings = Qnil;
6526ab49 9965
5434fce6
RS
9966 value = Qnil;
9967 GCPRO2 (bindings, value);
9968 value = Fcommand_execute (function, Qt, Qnil, Qnil);
6526ab49 9969
5434fce6 9970 /* If the command has a key binding, print it now. */
3ababa60 9971 if (!NILP (bindings)
ee112567
KH
9972 && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
9973 Qmouse_movement)))
5434fce6
RS
9974 {
9975 /* But first wait, and skip the message if there is input. */
426939cc 9976 int delay_time;
985f9f66 9977 if (!NILP (echo_area_buffer[0]))
426939cc
RS
9978 /* This command displayed something in the echo area;
9979 so wait a few seconds, then display our suggestion message. */
9980 delay_time = (NUMBERP (Vsuggest_key_bindings)
9981 ? XINT (Vsuggest_key_bindings) : 2);
9982 else
9983 /* This command left the echo area empty,
9984 so display our message immediately. */
9985 delay_time = 0;
9986
9987 if (!NILP (Fsit_for (make_number (delay_time), Qnil, Qnil))
303b5b3f 9988 && ! CONSP (Vunread_command_events))
6526ab49 9989 {
5434fce6
RS
9990 Lisp_Object binding;
9991 char *newmessage;
985f9f66 9992 int message_p = push_message ();
331379bf 9993 int count = SPECPDL_INDEX ();
5434fce6 9994
65efd7da 9995 record_unwind_protect (pop_message_unwind, Qnil);
a1bfe073 9996 binding = Fkey_description (bindings, Qnil);
5434fce6
RS
9997
9998 newmessage
d5db4077
KR
9999 = (char *) alloca (SCHARS (SYMBOL_NAME (function))
10000 + SBYTES (binding)
5434fce6 10001 + 100);
3ababa60 10002 sprintf (newmessage, "You can run the command `%s' with %s",
d5db4077
KR
10003 SDATA (SYMBOL_NAME (function)),
10004 SDATA (binding));
301738ed
RS
10005 message2_nolog (newmessage,
10006 strlen (newmessage),
10007 STRING_MULTIBYTE (binding));
5434fce6
RS
10008 if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings)
10009 ? Vsuggest_key_bindings : make_number (2)),
985f9f66
GM
10010 Qnil, Qnil))
10011 && message_p)
10012 restore_message ();
10013
c970a760 10014 unbind_to (count, Qnil);
6526ab49
RS
10015 }
10016 }
10017
5434fce6 10018 RETURN_UNGCPRO (value);
284f4730 10019}
6526ab49 10020
284f4730 10021\f
d9d4c147 10022/* Return nonzero if input events are pending. */
284f4730 10023
dfcf069d 10024int
284f4730
JB
10025detect_input_pending ()
10026{
10027 if (!input_pending)
d9d4c147
KH
10028 get_input_pending (&input_pending, 0);
10029
10030 return input_pending;
10031}
10032
a2d5fca0
JD
10033/* Return nonzero if input events other than mouse movements are
10034 pending. */
10035
10036int
10037detect_input_pending_ignore_squeezables ()
10038{
10039 if (!input_pending)
10040 get_input_pending (&input_pending, READABLE_EVENTS_IGNORE_SQUEEZABLES);
10041
10042 return input_pending;
10043}
10044
b1878f45 10045/* Return nonzero if input events are pending, and run any pending timers. */
d9d4c147 10046
dfcf069d 10047int
87dd9b9b
RS
10048detect_input_pending_run_timers (do_display)
10049 int do_display;
d9d4c147 10050{
87dd9b9b
RS
10051 int old_timers_run = timers_run;
10052
d9d4c147 10053 if (!input_pending)
a2d5fca0 10054 get_input_pending (&input_pending, READABLE_EVENTS_DO_TIMERS_NOW);
284f4730 10055
87dd9b9b 10056 if (old_timers_run != timers_run && do_display)
7ee32cda 10057 {
3007ebfb 10058 redisplay_preserve_echo_area (8);
7ee32cda
GM
10059 /* The following fixes a bug when using lazy-lock with
10060 lazy-lock-defer-on-the-fly set to t, i.e. when fontifying
10061 from an idle timer function. The symptom of the bug is that
10062 the cursor sometimes doesn't become visible until the next X
10063 event is processed. --gerd. */
fa971ac3
KL
10064 {
10065 Lisp_Object tail, frame;
10066 FOR_EACH_FRAME (tail, frame)
10067 if (FRAME_RIF (XFRAME (frame)))
10068 FRAME_RIF (XFRAME (frame))->flush_display (XFRAME (frame));
10069 }
7ee32cda 10070 }
87dd9b9b 10071
284f4730
JB
10072 return input_pending;
10073}
10074
ffd56f97
JB
10075/* This is called in some cases before a possible quit.
10076 It cases the next call to detect_input_pending to recompute input_pending.
10077 So calling this function unnecessarily can't do any harm. */
07a59269
KH
10078
10079void
ffd56f97
JB
10080clear_input_pending ()
10081{
10082 input_pending = 0;
10083}
10084
b1878f45 10085/* Return nonzero if there are pending requeued events.
d64b707c 10086 This isn't used yet. The hope is to make wait_reading_process_output
27fd22dc 10087 call it, and return if it runs Lisp code that unreads something.
b1878f45
RS
10088 The problem is, kbd_buffer_get_event needs to be fixed to know what
10089 to do in that case. It isn't trivial. */
10090
dfcf069d 10091int
b1878f45
RS
10092requeued_events_pending_p ()
10093{
10094 return (!NILP (Vunread_command_events) || unread_command_char != -1);
10095}
10096
10097
284f4730 10098DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
a064684d
RS
10099 doc: /* Return t if command input is currently available with no wait.
10100Actually, the value is nil only if we can be sure that no input is available;
10101if there is a doubt, the value is t. */)
4707d2d0 10102 ()
284f4730 10103{
24597608 10104 if (!NILP (Vunread_command_events) || unread_command_char != -1)
284f4730
JB
10105 return (Qt);
10106
a2d5fca0
JD
10107 get_input_pending (&input_pending,
10108 READABLE_EVENTS_DO_TIMERS_NOW
10109 | READABLE_EVENTS_FILTER_EVENTS);
d9d4c147 10110 return input_pending > 0 ? Qt : Qnil;
284f4730
JB
10111}
10112
10113DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
4707d2d0
PJ
10114 doc: /* Return vector of last 100 events, not counting those from keyboard macros. */)
10115 ()
284f4730 10116{
5160df46 10117 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
284f4730
JB
10118 Lisp_Object val;
10119
10120 if (total_keys < NUM_RECENT_KEYS)
5160df46 10121 return Fvector (total_keys, keys);
284f4730
JB
10122 else
10123 {
5160df46
JB
10124 val = Fvector (NUM_RECENT_KEYS, keys);
10125 bcopy (keys + recent_keys_index,
284f4730
JB
10126 XVECTOR (val)->contents,
10127 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
5160df46 10128 bcopy (keys,
284f4730
JB
10129 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
10130 recent_keys_index * sizeof (Lisp_Object));
10131 return val;
10132 }
10133}
10134
10135DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
4707d2d0 10136 doc: /* Return the key sequence that invoked this command.
92501652 10137However, if the command has called `read-key-sequence', it returns
4052e7bb 10138the last key sequence that has been read.
4707d2d0
PJ
10139The value is a string or a vector. */)
10140 ()
284f4730 10141{
86e5706b
RS
10142 return make_event_array (this_command_key_count,
10143 XVECTOR (this_command_keys)->contents);
284f4730
JB
10144}
10145
e39da3d7 10146DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
92501652
RS
10147 doc: /* Return the key sequence that invoked this command, as a vector.
10148However, if the command has called `read-key-sequence', it returns
4052e7bb 10149the last key sequence that has been read. */)
4707d2d0 10150 ()
e39da3d7
RS
10151{
10152 return Fvector (this_command_key_count,
10153 XVECTOR (this_command_keys)->contents);
10154}
10155
6321824f
RS
10156DEFUN ("this-single-command-keys", Fthis_single_command_keys,
10157 Sthis_single_command_keys, 0, 0, 0,
4707d2d0 10158 doc: /* Return the key sequence that invoked this command.
92501652
RS
10159More generally, it returns the last key sequence read, either by
10160the command loop or by `read-key-sequence'.
4707d2d0
PJ
10161Unlike `this-command-keys', this function's value
10162does not include prefix arguments.
10163The value is always a vector. */)
10164 ()
6321824f 10165{
e39da3d7
RS
10166 return Fvector (this_command_key_count
10167 - this_single_command_key_start,
10168 (XVECTOR (this_command_keys)->contents
10169 + this_single_command_key_start));
6321824f
RS
10170}
10171
7d18f9ae
RS
10172DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
10173 Sthis_single_command_raw_keys, 0, 0, 0,
4707d2d0 10174 doc: /* Return the raw events that were read for this command.
92501652
RS
10175More generally, it returns the last key sequence read, either by
10176the command loop or by `read-key-sequence'.
4707d2d0
PJ
10177Unlike `this-single-command-keys', this function's value
10178shows the events before all translations (except for input methods).
10179The value is always a vector. */)
10180 ()
7d18f9ae
RS
10181{
10182 return Fvector (raw_keybuf_count,
10183 (XVECTOR (raw_keybuf)->contents));
10184}
10185
71918b75 10186DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
4707d2d0 10187 Sreset_this_command_lengths, 0, 0, 0,
63020c46
RS
10188 doc: /* Make the unread events replace the last command and echo.
10189Used in `universal-argument-other-key'.
4707d2d0
PJ
10190
10191`universal-argument-other-key' rereads the event just typed.
10192It then gets translated through `function-key-map'.
63020c46
RS
10193The translated event has to replace the real events,
10194both in the value of (this-command-keys) and in echoing.
10195To achieve this, `universal-argument-other-key' calls
10196`reset-this-command-lengths', which discards the record of reading
10197these events the first time. */)
4707d2d0 10198 ()
71918b75 10199{
22b94eeb
RS
10200 this_command_key_count = before_command_key_count;
10201 if (this_command_key_count < this_single_command_key_start)
10202 this_single_command_key_start = this_command_key_count;
63020c46 10203
22b94eeb
RS
10204 echo_truncate (before_command_echo_length);
10205
63020c46
RS
10206 /* Cause whatever we put into unread-command-events
10207 to echo as if it were being freshly read from the keyboard. */
10208 this_command_key_count_reset = 1;
10209
6e5742a0 10210 return Qnil;
71918b75
RS
10211}
10212
82e6e5af 10213DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
ab1959fc 10214 Sclear_this_command_keys, 0, 1, 0,
4707d2d0 10215 doc: /* Clear out the vector that `this-command-keys' returns.
ab1959fc
KS
10216Also clear the record of the last 100 events, unless optional arg
10217KEEP-RECORD is non-nil. */)
10218 (keep_record)
10219 Lisp_Object keep_record;
82e6e5af 10220{
fb0dde6c 10221 int i;
c60ee5e7 10222
82e6e5af 10223 this_command_key_count = 0;
63020c46 10224 this_command_key_count_reset = 0;
fb0dde6c 10225
ab1959fc
KS
10226 if (NILP (keep_record))
10227 {
10228 for (i = 0; i < XVECTOR (recent_keys)->size; ++i)
10229 XVECTOR (recent_keys)->contents[i] = Qnil;
10230 total_keys = 0;
10231 recent_keys_index = 0;
10232 }
82e6e5af
RS
10233 return Qnil;
10234}
10235
284f4730 10236DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
4707d2d0
PJ
10237 doc: /* Return the current depth in recursive edits. */)
10238 ()
284f4730
JB
10239{
10240 Lisp_Object temp;
bb9e9bed 10241 XSETFASTINT (temp, command_loop_level + minibuf_level);
284f4730
JB
10242 return temp;
10243}
10244
10245DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
4707d2d0
PJ
10246 "FOpen dribble file: ",
10247 doc: /* Start writing all keyboard characters to a dribble file called FILE.
10248If FILE is nil, close any open dribble file. */)
10249 (file)
284f4730
JB
10250 Lisp_Object file;
10251{
6cb52def 10252 if (dribble)
284f4730 10253 {
6cb52def
KH
10254 fclose (dribble);
10255 dribble = 0;
284f4730 10256 }
6cb52def 10257 if (!NILP (file))
284f4730
JB
10258 {
10259 file = Fexpand_file_name (file, Qnil);
d5db4077 10260 dribble = fopen (SDATA (file), "w");
ab6ca1de
KH
10261 if (dribble == 0)
10262 report_file_error ("Opening dribble", Fcons (file, Qnil));
284f4730
JB
10263 }
10264 return Qnil;
10265}
10266
10267DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
4707d2d0 10268 doc: /* Discard the contents of the terminal input buffer.
2b17d5ed 10269Also end any kbd macro being defined. */)
4707d2d0 10270 ()
284f4730 10271{
2b17d5ed
KS
10272 if (!NILP (current_kboard->defining_kbd_macro))
10273 {
10274 /* Discard the last command from the macro. */
10275 Fcancel_kbd_macro_events ();
10276 end_kbd_macro ();
10277 }
10278
284f4730
JB
10279 update_mode_lines++;
10280
24597608 10281 Vunread_command_events = Qnil;
86e5706b 10282 unread_command_char = -1;
284f4730
JB
10283
10284 discard_tty_input ();
10285
7ee32cda 10286 kbd_fetch_ptr = kbd_store_ptr;
284f4730
JB
10287 input_pending = 0;
10288
10289 return Qnil;
10290}
10291\f
10292DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
4707d2d0
PJ
10293 doc: /* Stop Emacs and return to superior process. You can resume later.
10294If `cannot-suspend' is non-nil, or if the system doesn't support job
10295control, run a subshell instead.
10296
10297If optional arg STUFFSTRING is non-nil, its characters are stuffed
10298to be read as terminal input by Emacs's parent, after suspension.
10299
10300Before suspending, run the normal hook `suspend-hook'.
10301After resumption run the normal hook `suspend-resume-hook'.
10302
10303Some operating systems cannot stop the Emacs process and resume it later.
10304On such systems, Emacs starts a subshell instead of suspending. */)
10305 (stuffstring)
284f4730
JB
10306 Lisp_Object stuffstring;
10307{
aed13378 10308 int count = SPECPDL_INDEX ();
284f4730
JB
10309 int old_height, old_width;
10310 int width, height;
03cee6ae 10311 struct gcpro gcpro1;
284f4730 10312
9628b887 10313 if (tty_list && tty_list->next)
4a933ef8 10314 error ("There are other tty frames open; close them before suspending Emacs");
3b7fbceb 10315
284f4730 10316 if (!NILP (stuffstring))
b7826503 10317 CHECK_STRING (stuffstring);
284f4730 10318
1e95ed28
JB
10319 /* Run the functions in suspend-hook. */
10320 if (!NILP (Vrun_hooks))
10321 call1 (Vrun_hooks, intern ("suspend-hook"));
284f4730 10322
b7d2ebbf 10323 GCPRO1 (stuffstring);
0b0d3e0b 10324 get_tty_size (fileno (CURTTY ()->input), &old_width, &old_height);
28d440ab 10325 reset_all_sys_modes ();
284f4730
JB
10326 /* sys_suspend can get an error if it tries to fork a subshell
10327 and the system resources aren't available for that. */
017bbc62
KL
10328 record_unwind_protect ((Lisp_Object (*) P_ ((Lisp_Object))) init_all_sys_modes,
10329 Qnil);
284f4730 10330 stuff_buffered_input (stuffstring);
8026024c
KH
10331 if (cannot_suspend)
10332 sys_subshell ();
10333 else
10334 sys_suspend ();
284f4730
JB
10335 unbind_to (count, Qnil);
10336
10337 /* Check if terminal/window size has changed.
10338 Note that this is not useful when we are running directly
10339 with a window system; but suspend should be disabled in that case. */
0b0d3e0b 10340 get_tty_size (fileno (CURTTY ()->input), &width, &height);
284f4730 10341 if (width != old_width || height != old_height)
788f89eb 10342 change_frame_size (SELECTED_FRAME (), height, width, 0, 0, 0);
284f4730 10343
1e95ed28 10344 /* Run suspend-resume-hook. */
284f4730
JB
10345 if (!NILP (Vrun_hooks))
10346 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
df0f2ba1 10347
284f4730
JB
10348 UNGCPRO;
10349 return Qnil;
10350}
10351
10352/* If STUFFSTRING is a string, stuff its contents as pending terminal input.
eb8c3be9 10353 Then in any case stuff anything Emacs has read ahead and not used. */
284f4730 10354
07a59269 10355void
284f4730
JB
10356stuff_buffered_input (stuffstring)
10357 Lisp_Object stuffstring;
10358{
0c1c1b93 10359#ifdef SIGTSTP /* stuff_char is defined if SIGTSTP. */
612b78ef 10360 register unsigned char *p;
612b78ef 10361
8c18cbfb 10362 if (STRINGP (stuffstring))
284f4730
JB
10363 {
10364 register int count;
10365
d5db4077
KR
10366 p = SDATA (stuffstring);
10367 count = SBYTES (stuffstring);
284f4730
JB
10368 while (count-- > 0)
10369 stuff_char (*p++);
10370 stuff_char ('\n');
10371 }
c60ee5e7 10372
284f4730 10373 /* Anything we have read ahead, put back for the shell to read. */
beecf6a1 10374 /* ?? What should this do when we have multiple keyboards??
0c1c1b93 10375 Should we ignore anything that was typed in at the "wrong" kboard?
26503ad2 10376
0c1c1b93
RS
10377 rms: we should stuff everything back into the kboard
10378 it came from. */
beecf6a1 10379 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
284f4730 10380 {
c60ee5e7 10381
beecf6a1
KH
10382 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
10383 kbd_fetch_ptr = kbd_buffer;
3b8f9651 10384 if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT)
beecf6a1 10385 stuff_char (kbd_fetch_ptr->code);
c60ee5e7 10386
d92f48d3 10387 clear_event (kbd_fetch_ptr);
284f4730 10388 }
c60ee5e7 10389
284f4730 10390 input_pending = 0;
0c1c1b93 10391#endif /* SIGTSTP */
284f4730
JB
10392}
10393\f
dfcf069d 10394void
ffd56f97
JB
10395set_waiting_for_input (time_to_clear)
10396 EMACS_TIME *time_to_clear;
284f4730 10397{
ffd56f97 10398 input_available_clear_time = time_to_clear;
284f4730 10399
114a8b8c 10400 /* Tell handle_interrupt to throw back to read_char, */
284f4730
JB
10401 waiting_for_input = 1;
10402
114a8b8c 10403 /* If handle_interrupt was called before and buffered a C-g,
284f4730
JB
10404 make it run again now, to avoid timing error. */
10405 if (!NILP (Vquit_flag))
10406 quit_throw_to_read_char ();
284f4730
JB
10407}
10408
07a59269 10409void
284f4730
JB
10410clear_waiting_for_input ()
10411{
114a8b8c 10412 /* Tell handle_interrupt not to throw back to read_char, */
284f4730 10413 waiting_for_input = 0;
ffd56f97 10414 input_available_clear_time = 0;
284f4730
JB
10415}
10416
da8e1115 10417/* The SIGINT handler.
114a8b8c 10418
e72cf5ee
KL
10419 If we have a frame on the controlling tty, we assume that the
10420 SIGINT was generated by C-g, so we call handle_interrupt.
10421 Otherwise, the handler kills Emacs. */
284f4730 10422
14e40288 10423static SIGTYPE
91c049d4
RS
10424interrupt_signal (signalnum) /* If we don't have an argument, */
10425 int signalnum; /* some compilers complain in signal calls. */
284f4730 10426{
284f4730
JB
10427 /* Must preserve main program's value of errno. */
10428 int old_errno = errno;
7e59217d 10429 struct device *device;
284f4730 10430
5970a8cb 10431#if defined (USG) && !defined (POSIX_SIGNALS)
7b00d185
KL
10432 /* USG systems forget handlers when they are used;
10433 must reestablish each time */
10434 signal (SIGINT, interrupt_signal);
10435 signal (SIGQUIT, interrupt_signal);
284f4730
JB
10436#endif /* USG */
10437
e72cf5ee
KL
10438 SIGNAL_THREAD_CHECK (signalnum);
10439
b6660415 10440 /* See if we have an active display on our controlling terminal. */
7e59217d
KL
10441 device = get_named_tty (NULL);
10442 if (!device)
3224dac1 10443 {
4ca927b4
KL
10444 /* If there are no frames there, let's pretend that we are a
10445 well-behaving UN*X program and quit. */
301f31cf 10446 fatal_error_signal (SIGTERM);
3224dac1 10447 }
4ca927b4
KL
10448 else
10449 {
10450 /* Otherwise, the SIGINT was probably generated by C-g. */
3b7fbceb 10451
4ca927b4
KL
10452 /* Set internal_last_event_frame to the top frame of the
10453 controlling tty, if we have a frame there. We disable the
10454 interrupt key on secondary ttys, so the SIGINT must have come
10455 from the controlling tty. */
7e59217d 10456 internal_last_event_frame = device->display_info.tty->top_frame;
4ca927b4
KL
10457
10458 handle_interrupt ();
4ca927b4 10459 }
114a8b8c
KL
10460
10461 errno = old_errno;
10462}
10463
da8e1115 10464/* This routine is called at interrupt level in response to C-g.
3b7fbceb 10465
da8e1115
KL
10466 It is called from the SIGINT handler or kbd_buffer_store_event.
10467
10468 If `waiting_for_input' is non zero, then unless `echoing' is
10469 nonzero, immediately throw back to read_char.
10470
10471 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
10472 eval to throw, when it gets a chance. If quit-flag is already
10473 non-nil, it stops the job right away. */
114a8b8c 10474
114a8b8c
KL
10475static void
10476handle_interrupt ()
10477{
3b7fbceb 10478 char c;
114a8b8c 10479
284f4730
JB
10480 cancel_echoing ();
10481
3224dac1 10482 /* XXX This code needs to be revised for multi-tty support. */
31e4e97b 10483 if (!NILP (Vquit_flag)
e72cf5ee 10484#ifndef MSDOS
7e59217d 10485 && get_named_tty (NULL)
e72cf5ee
KL
10486#endif
10487 )
284f4730 10488 {
31e4e97b
EZ
10489 /* If SIGINT isn't blocked, don't let us be interrupted by
10490 another SIGINT, it might be harmful due to non-reentrancy
10491 in I/O functions. */
10492 sigblock (sigmask (SIGINT));
10493
284f4730 10494 fflush (stdout);
28d440ab 10495 reset_all_sys_modes ();
31e4e97b 10496
284f4730
JB
10497#ifdef SIGTSTP /* Support possible in later USG versions */
10498/*
10499 * On systems which can suspend the current process and return to the original
10500 * shell, this command causes the user to end up back at the shell.
10501 * The "Auto-save" and "Abort" questions are not asked until
10502 * the user elects to return to emacs, at which point he can save the current
10503 * job and either dump core or continue.
10504 */
10505 sys_suspend ();
10506#else
10507#ifdef VMS
10508 if (sys_suspend () == -1)
10509 {
10510 printf ("Not running as a subprocess;\n");
10511 printf ("you can continue or abort.\n");
10512 }
10513#else /* not VMS */
10514 /* Perhaps should really fork an inferior shell?
10515 But that would not provide any way to get back
10516 to the original shell, ever. */
10517 printf ("No support for stopping a process on this operating system;\n");
10518 printf ("you can continue or abort.\n");
10519#endif /* not VMS */
10520#endif /* not SIGTSTP */
80e4aa30
RS
10521#ifdef MSDOS
10522 /* We must remain inside the screen area when the internal terminal
10523 is used. Note that [Enter] is not echoed by dos. */
10524 cursor_to (0, 0);
10525#endif
118d6ca9
RS
10526 /* It doesn't work to autosave while GC is in progress;
10527 the code used for auto-saving doesn't cope with the mark bit. */
10528 if (!gc_in_progress)
9fd7d808 10529 {
118d6ca9
RS
10530 printf ("Auto-save? (y or n) ");
10531 fflush (stdout);
10532 if (((c = getchar ()) & ~040) == 'Y')
10533 {
10534 Fdo_auto_save (Qt, Qnil);
80e4aa30 10535#ifdef MSDOS
118d6ca9 10536 printf ("\r\nAuto-save done");
80e4aa30 10537#else /* not MSDOS */
118d6ca9 10538 printf ("Auto-save done\n");
80e4aa30 10539#endif /* not MSDOS */
118d6ca9
RS
10540 }
10541 while (c != '\n') c = getchar ();
9fd7d808 10542 }
c60ee5e7 10543 else
118d6ca9
RS
10544 {
10545 /* During GC, it must be safe to reenable quitting again. */
10546 Vinhibit_quit = Qnil;
10547#ifdef MSDOS
10548 printf ("\r\n");
10549#endif /* not MSDOS */
10550 printf ("Garbage collection in progress; cannot auto-save now\r\n");
10551 printf ("but will instead do a real quit after garbage collection ends\r\n");
10552 fflush (stdout);
10553 }
10554
80e4aa30
RS
10555#ifdef MSDOS
10556 printf ("\r\nAbort? (y or n) ");
10557#else /* not MSDOS */
284f4730
JB
10558#ifdef VMS
10559 printf ("Abort (and enter debugger)? (y or n) ");
10560#else /* not VMS */
10561 printf ("Abort (and dump core)? (y or n) ");
10562#endif /* not VMS */
80e4aa30 10563#endif /* not MSDOS */
284f4730
JB
10564 fflush (stdout);
10565 if (((c = getchar ()) & ~040) == 'Y')
10566 abort ();
10567 while (c != '\n') c = getchar ();
80e4aa30
RS
10568#ifdef MSDOS
10569 printf ("\r\nContinuing...\r\n");
10570#else /* not MSDOS */
284f4730 10571 printf ("Continuing...\n");
80e4aa30 10572#endif /* not MSDOS */
284f4730 10573 fflush (stdout);
28d440ab 10574 init_all_sys_modes ();
31e4e97b 10575 sigfree ();
284f4730
JB
10576 }
10577 else
10578 {
10579 /* If executing a function that wants to be interrupted out of
10580 and the user has not deferred quitting by binding `inhibit-quit'
10581 then quit right away. */
10582 if (immediate_quit && NILP (Vinhibit_quit))
10583 {
e39da3d7
RS
10584 struct gl_state_s saved;
10585 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10586
284f4730
JB
10587 immediate_quit = 0;
10588 sigfree ();
e39da3d7
RS
10589 saved = gl_state;
10590 GCPRO4 (saved.object, saved.global_code,
10591 saved.current_syntax_table, saved.old_prop);
284f4730 10592 Fsignal (Qquit, Qnil);
e39da3d7
RS
10593 gl_state = saved;
10594 UNGCPRO;
284f4730
JB
10595 }
10596 else
10597 /* Else request quit when it's safe */
10598 Vquit_flag = Qt;
10599 }
10600
10601 if (waiting_for_input && !echoing)
4ca927b4 10602 quit_throw_to_read_char ();
284f4730
JB
10603}
10604
10605/* Handle a C-g by making read_char return C-g. */
10606
07a59269 10607void
284f4730
JB
10608quit_throw_to_read_char ()
10609{
284f4730
JB
10610 sigfree ();
10611 /* Prevent another signal from doing this before we finish. */
f76475ad 10612 clear_waiting_for_input ();
284f4730
JB
10613 input_pending = 0;
10614
24597608 10615 Vunread_command_events = Qnil;
86e5706b 10616 unread_command_char = -1;
284f4730 10617
087feab3
RS
10618#if 0 /* Currently, sit_for is called from read_char without turning
10619 off polling. And that can call set_waiting_for_input.
10620 It seems to be harmless. */
e6b01c14
JB
10621#ifdef POLL_FOR_INPUT
10622 /* May be > 1 if in recursive minibuffer. */
10623 if (poll_suppress_count == 0)
10624 abort ();
10625#endif
087feab3 10626#endif
4c52b668 10627 if (FRAMEP (internal_last_event_frame)
788f89eb 10628 && !EQ (internal_last_event_frame, selected_frame))
719191cf 10629 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
827c686c 10630 0, 0);
e6b01c14 10631
284f4730
JB
10632 _longjmp (getcjmp, 1);
10633}
10634\f
10635DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
4707d2d0
PJ
10636 doc: /* Set mode of reading keyboard input.
10637First arg INTERRUPT non-nil means use input interrupts;
10638 nil means use CBREAK mode.
10639Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
10640 (no effect except in CBREAK mode).
10641Third arg META t means accept 8-bit input (for a Meta key).
10642 META nil means ignore the top bit, on the assumption it is parity.
10643 Otherwise, accept 8-bit input and don't use the top bit for Meta.
10644Optional fourth arg QUIT if non-nil specifies character to use for quitting.
10645See also `current-input-mode'. */)
10646 (interrupt, flow, meta, quit)
284f4730
JB
10647 Lisp_Object interrupt, flow, meta, quit;
10648{
428a555e
KL
10649 /* XXX This function needs to be revised for multi-device support.
10650 Currently it compiles fine, but its semantics are wrong. It sets
10651 global parameters (e.g. interrupt_input) based on only the
10652 current frame's device. */
3b7fbceb 10653
284f4730 10654 if (!NILP (quit)
8c18cbfb 10655 && (!INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400))
34f04431
RS
10656 error ("set-input-mode: QUIT must be an ASCII character");
10657
10658#ifdef POLL_FOR_INPUT
10659 stop_polling ();
10660#endif
284f4730 10661
07de30b9 10662#ifndef DOS_NT
1fb8c4ad
KL
10663 if (FRAME_TERMCAP_P (XFRAME (selected_frame)))
10664 /* this causes startup screen to be restored and messes with the mouse */
10665 reset_sys_modes (CURTTY ());
2ee250ec
RS
10666#endif
10667
284f4730
JB
10668#ifdef SIGIO
10669/* Note SIGIO has been undef'd if FIONREAD is missing. */
7e59217d 10670 if (FRAME_DEVICE (SELECTED_FRAME ())->read_socket_hook)
9a0f60bb
KH
10671 {
10672 /* When using X, don't give the user a real choice,
10673 because we haven't implemented the mechanisms to support it. */
10674#ifdef NO_SOCK_SIGIO
10675 interrupt_input = 0;
10676#else /* not NO_SOCK_SIGIO */
10677 interrupt_input = 1;
284f4730 10678#endif /* NO_SOCK_SIGIO */
9a0f60bb
KH
10679 }
10680 else
284f4730
JB
10681 interrupt_input = !NILP (interrupt);
10682#else /* not SIGIO */
10683 interrupt_input = 0;
10684#endif /* not SIGIO */
9a0f60bb 10685
284f4730
JB
10686/* Our VMS input only works by interrupts, as of now. */
10687#ifdef VMS
10688 interrupt_input = 1;
10689#endif
9a0f60bb 10690
daf01701
KL
10691 if (FRAME_TERMCAP_P (XFRAME (selected_frame)))
10692 {
10693 struct tty_display_info *tty = CURTTY ();
10694 tty->flow_control = !NILP (flow);
10695 if (NILP (meta))
10696 tty->meta_key = 0;
10697 else if (EQ (meta, Qt))
10698 tty->meta_key = 1;
10699 else
10700 tty->meta_key = 2;
10701 }
3b7fbceb 10702
2246281f 10703 if (!NILP (quit))
284f4730 10704 /* Don't let this value be out of range. */
2246281f 10705 quit_char = XINT (quit) & (NILP (meta) ? 0177 : 0377);
284f4730 10706
07de30b9 10707#ifndef DOS_NT
1fb8c4ad
KL
10708 if (FRAME_TERMCAP_P (XFRAME (selected_frame)))
10709 init_sys_modes (CURTTY ());
2ee250ec 10710#endif
34f04431
RS
10711
10712#ifdef POLL_FOR_INPUT
10713 poll_suppress_count = 1;
10714 start_polling ();
10715#endif
284f4730
JB
10716 return Qnil;
10717}
80645119
JB
10718
10719DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
4707d2d0
PJ
10720 doc: /* Return information about the way Emacs currently reads keyboard input.
10721The value is a list of the form (INTERRUPT FLOW META QUIT), where
10722 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if
10723 nil, Emacs is using CBREAK mode.
10724 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
10725 terminal; this does not apply if Emacs uses interrupt-driven input.
10726 META is t if accepting 8-bit input with 8th bit as Meta flag.
10727 META nil means ignoring the top bit, on the assumption it is parity.
10728 META is neither t nor nil if accepting 8-bit input and using
10729 all 8 bits as the character code.
10730 QUIT is the character Emacs currently uses to quit.
10731The elements of this list correspond to the arguments of
10732`set-input-mode'. */)
10733 ()
80645119
JB
10734{
10735 Lisp_Object val[4];
daf01701 10736 struct frame *sf = XFRAME (selected_frame);
80645119
JB
10737
10738 val[0] = interrupt_input ? Qt : Qnil;
daf01701
KL
10739 if (FRAME_TERMCAP_P (sf))
10740 {
10741 val[1] = FRAME_TTY (sf)->flow_control ? Qt : Qnil;
c3b4957f
KL
10742 val[2] = (FRAME_TTY (sf)->meta_key == 2
10743 ? make_number (0)
10744 : (CURTTY ()->meta_key == 1 ? Qt : Qnil));
daf01701
KL
10745 }
10746 else
10747 {
10748 val[1] = Qnil;
10749 val[2] = Qt;
10750 }
bb9e9bed 10751 XSETFASTINT (val[3], quit_char);
80645119 10752
bf673a7a 10753 return Flist (sizeof (val) / sizeof (val[0]), val);
80645119
JB
10754}
10755
a25f766a 10756DEFUN ("posn-at-x-y", Fposn_at_x_y, Sposn_at_x_y, 2, 4, 0,
ec026e7a
KS
10757 doc: /* Return position information for pixel coordinates X and Y.
10758By default, X and Y are relative to text area of the selected window.
6e604a9b 10759Optional third arg FRAME-OR-WINDOW non-nil specifies frame or window.
a25f766a
KS
10760If optional fourth arg WHOLE is non-nil, X is relative to the left
10761edge of the window.
ec026e7a
KS
10762
10763The return value is similar to a mouse click position:
10764 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
10765 IMAGE (DX . DY) (WIDTH . HEIGHT))
10766The `posn-' functions access elements of such lists. */)
a25f766a
KS
10767 (x, y, frame_or_window, whole)
10768 Lisp_Object x, y, frame_or_window, whole;
ec026e7a 10769{
f4a5a485
SM
10770 CHECK_NATNUM (x);
10771 CHECK_NATNUM (y);
10772
ec026e7a
KS
10773 if (NILP (frame_or_window))
10774 frame_or_window = selected_window;
10775
10776 if (WINDOWP (frame_or_window))
10777 {
10778 struct window *w;
10779
10780 CHECK_LIVE_WINDOW (frame_or_window);
10781
10782 w = XWINDOW (frame_or_window);
6507c4c7
KS
10783 XSETINT (x, (XINT (x)
10784 + WINDOW_LEFT_EDGE_X (w)
a25f766a
KS
10785 + (NILP (whole)
10786 ? window_box_left_offset (w, TEXT_AREA)
6507c4c7 10787 : 0)));
ec026e7a
KS
10788 XSETINT (y, WINDOW_TO_FRAME_PIXEL_Y (w, XINT (y)));
10789 frame_or_window = w->frame;
10790 }
10791
10792 CHECK_LIVE_FRAME (frame_or_window);
10793
10794 return make_lispy_position (XFRAME (frame_or_window), &x, &y, 0);
10795}
10796
10797DEFUN ("posn-at-point", Fposn_at_point, Sposn_at_point, 0, 2, 0,
10798 doc: /* Return position information for buffer POS in WINDOW.
10799POS defaults to point in WINDOW; WINDOW defaults to the selected window.
10800
10801Return nil if position is not visible in window. Otherwise,
883d272e 10802the return value is similar to that returned by `event-start' for
ec026e7a
KS
10803a mouse click at the upper left corner of the glyph corresponding
10804to the given buffer position:
10805 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
10806 IMAGE (DX . DY) (WIDTH . HEIGHT))
8f1657f0 10807The `posn-' functions access elements of such lists. */)
ec026e7a
KS
10808 (pos, window)
10809 Lisp_Object pos, window;
10810{
10811 Lisp_Object tem;
10812
6507c4c7
KS
10813 if (NILP (window))
10814 window = selected_window;
10815
ec026e7a
KS
10816 tem = Fpos_visible_in_window_p (pos, window, Qt);
10817 if (!NILP (tem))
6507c4c7
KS
10818 {
10819 Lisp_Object x = XCAR (tem);
10820 Lisp_Object y = XCAR (XCDR (tem));
10821
10822 /* Point invisible due to hscrolling? */
10823 if (XINT (x) < 0)
10824 return Qnil;
10825 tem = Fposn_at_x_y (x, y, window, Qnil);
10826 }
10827
ec026e7a
KS
10828 return tem;
10829}
10830
284f4730 10831\f
6c6083a9 10832/*
c5fdd383 10833 * Set up a new kboard object with reasonable initial values.
6c6083a9
KH
10834 */
10835void
c5fdd383
KH
10836init_kboard (kb)
10837 KBOARD *kb;
6c6083a9 10838{
217258d5 10839 kb->Voverriding_terminal_local_map = Qnil;
6c7178b9 10840 kb->Vlast_command = Qnil;
75045dcb 10841 kb->Vreal_last_command = Qnil;
2e478293 10842 kb->Vkeyboard_translate_table = Qnil;
d8bcf58e 10843 kb->Vprefix_arg = Qnil;
75045dcb 10844 kb->Vlast_prefix_arg = Qnil;
c5fdd383
KH
10845 kb->kbd_queue = Qnil;
10846 kb->kbd_queue_has_data = 0;
10847 kb->immediate_echo = 0;
678e9d18 10848 kb->echo_string = Qnil;
c5fdd383
KH
10849 kb->echo_after_prompt = -1;
10850 kb->kbd_macro_buffer = 0;
10851 kb->kbd_macro_bufsize = 0;
10852 kb->defining_kbd_macro = Qnil;
10853 kb->Vlast_kbd_macro = Qnil;
10854 kb->reference_count = 0;
7c97ffdc 10855 kb->Vsystem_key_alist = Qnil;
142e6c73 10856 kb->system_key_syms = Qnil;
ac09dc1e
KL
10857 kb->Vlocal_function_key_map = Fmake_sparse_keymap (Qnil);
10858 Fset_keymap_parent (kb->Vlocal_function_key_map, Vfunction_key_map);
10859 kb->Vlocal_key_translation_map = Fmake_sparse_keymap (Qnil);
10860 Fset_keymap_parent (kb->Vlocal_key_translation_map, Vkey_translation_map);
9ba47203 10861 kb->Vdefault_minibuffer_frame = Qnil;
6c6083a9
KH
10862}
10863
10864/*
c5fdd383 10865 * Destroy the contents of a kboard object, but not the object itself.
8e6208c5 10866 * We use this just before deleting it, or if we're going to initialize
6c6083a9
KH
10867 * it a second time.
10868 */
e50b8090 10869static void
c5fdd383
KH
10870wipe_kboard (kb)
10871 KBOARD *kb;
6c6083a9 10872{
c5fdd383
KH
10873 if (kb->kbd_macro_buffer)
10874 xfree (kb->kbd_macro_buffer);
6c6083a9
KH
10875}
10876
e50b8090 10877#ifdef MULTI_KBOARD
a122a38e
GM
10878
10879/* Free KB and memory referenced from it. */
10880
e50b8090
KH
10881void
10882delete_kboard (kb)
a122a38e 10883 KBOARD *kb;
e50b8090
KH
10884{
10885 KBOARD **kbp;
c60ee5e7 10886
e50b8090
KH
10887 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
10888 if (*kbp == NULL)
10889 abort ();
10890 *kbp = kb->next_kboard;
a122a38e
GM
10891
10892 /* Prevent a dangling reference to KB. */
18f534df
GM
10893 if (kb == current_kboard
10894 && FRAMEP (selected_frame)
10895 && FRAME_LIVE_P (XFRAME (selected_frame)))
a122a38e 10896 {
7e59217d 10897 current_kboard = XFRAME (selected_frame)->device->kboard;
a122a38e
GM
10898 if (current_kboard == kb)
10899 abort ();
10900 }
c60ee5e7 10901
e50b8090
KH
10902 wipe_kboard (kb);
10903 xfree (kb);
10904}
a122a38e
GM
10905
10906#endif /* MULTI_KBOARD */
e50b8090 10907
dfcf069d 10908void
284f4730
JB
10909init_keyboard ()
10910{
284f4730
JB
10911 /* This is correct before outermost invocation of the editor loop */
10912 command_loop_level = -1;
10913 immediate_quit = 0;
10914 quit_char = Ctl ('g');
24597608 10915 Vunread_command_events = Qnil;
86e5706b 10916 unread_command_char = -1;
87dd9b9b 10917 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
284f4730 10918 total_keys = 0;
9deb415a 10919 recent_keys_index = 0;
beecf6a1
KH
10920 kbd_fetch_ptr = kbd_buffer;
10921 kbd_store_ptr = kbd_buffer;
2eb6bfbe 10922#ifdef HAVE_MOUSE
a9d77f1f 10923 do_mouse_tracking = Qnil;
2eb6bfbe 10924#endif
284f4730
JB
10925 input_pending = 0;
10926
4c52b668
KH
10927 /* This means that command_loop_1 won't try to select anything the first
10928 time through. */
10929 internal_last_event_frame = Qnil;
10930 Vlast_event_frame = internal_last_event_frame;
4c52b668 10931
c5fdd383 10932#ifdef MULTI_KBOARD
aaca43a1 10933 current_kboard = initial_kboard;
6c6083a9 10934#endif
aaca43a1 10935 wipe_kboard (current_kboard);
c5fdd383 10936 init_kboard (current_kboard);
07d2b8de 10937
7b00d185 10938 if (!noninteractive)
284f4730 10939 {
3224dac1
KL
10940 /* Before multi-tty support, these handlers used to be installed
10941 only if the current session was a tty session. Now an Emacs
10942 session may have multiple display types, so we always handle
10943 SIGINT. There is special code in interrupt_signal to exit
4ca927b4
KL
10944 Emacs on SIGINT when there are no termcap frames on the
10945 controlling terminal. */
284f4730 10946 signal (SIGINT, interrupt_signal);
cb5df6ae 10947#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
284f4730
JB
10948 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
10949 SIGQUIT and we can't tell which one it will give us. */
10950 signal (SIGQUIT, interrupt_signal);
10951#endif /* HAVE_TERMIO */
7a80a6f6 10952 }
284f4730
JB
10953/* Note SIGIO has been undef'd if FIONREAD is missing. */
10954#ifdef SIGIO
7a80a6f6
RS
10955 if (!noninteractive)
10956 signal (SIGIO, input_available_signal);
8ea0a720 10957#endif /* SIGIO */
284f4730
JB
10958
10959/* Use interrupt input by default, if it works and noninterrupt input
10960 has deficiencies. */
10961
10962#ifdef INTERRUPT_INPUT
10963 interrupt_input = 1;
10964#else
10965 interrupt_input = 0;
10966#endif
10967
10968/* Our VMS input only works by interrupts, as of now. */
10969#ifdef VMS
10970 interrupt_input = 1;
10971#endif
10972
10973 sigfree ();
10974 dribble = 0;
10975
10976 if (keyboard_init_hook)
10977 (*keyboard_init_hook) ();
10978
10979#ifdef POLL_FOR_INPUT
10980 poll_suppress_count = 1;
10981 start_polling ();
10982#endif
10983}
10984
df0f2ba1 10985/* This type's only use is in syms_of_keyboard, to initialize the
284f4730
JB
10986 event header symbols and put properties on them. */
10987struct event_head {
10988 Lisp_Object *var;
10989 char *name;
10990 Lisp_Object *kind;
10991};
10992
10993struct event_head head_table[] = {
7406e988
PJ
10994 {&Qmouse_movement, "mouse-movement", &Qmouse_movement},
10995 {&Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement},
10996 {&Qswitch_frame, "switch-frame", &Qswitch_frame},
10997 {&Qdelete_frame, "delete-frame", &Qdelete_frame},
10998 {&Qiconify_frame, "iconify-frame", &Qiconify_frame},
a697f886 10999 {&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible},
6901b111
SM
11000 /* `select-window' should be handled just like `switch-frame'
11001 in read_key_sequence. */
11002 {&Qselect_window, "select-window", &Qswitch_frame}
284f4730
JB
11003};
11004
dfcf069d 11005void
284f4730
JB
11006syms_of_keyboard ()
11007{
f0c1cc56
GM
11008 Vpre_help_message = Qnil;
11009 staticpro (&Vpre_help_message);
c60ee5e7 11010
8e1e4240
GM
11011 Vlispy_mouse_stem = build_string ("mouse");
11012 staticpro (&Vlispy_mouse_stem);
f0c1cc56 11013
9ea173e8 11014 /* Tool-bars. */
7ee32cda
GM
11015 QCimage = intern (":image");
11016 staticpro (&QCimage);
11017
11018 staticpro (&Qhelp_echo);
11019 Qhelp_echo = intern ("help-echo");
11020
e8886a1d
RS
11021 staticpro (&item_properties);
11022 item_properties = Qnil;
11023
9ea173e8
GM
11024 staticpro (&tool_bar_item_properties);
11025 tool_bar_item_properties = Qnil;
11026 staticpro (&tool_bar_items_vector);
11027 tool_bar_items_vector = Qnil;
7ee32cda 11028
d5eecefb
RS
11029 staticpro (&real_this_command);
11030 real_this_command = Qnil;
11031
d925fb39
RS
11032 Qtimer_event_handler = intern ("timer-event-handler");
11033 staticpro (&Qtimer_event_handler);
11034
971e4c98
LT
11035 Qdisabled_command_function = intern ("disabled-command-function");
11036 staticpro (&Qdisabled_command_function);
2e894dab 11037
284f4730
JB
11038 Qself_insert_command = intern ("self-insert-command");
11039 staticpro (&Qself_insert_command);
11040
11041 Qforward_char = intern ("forward-char");
11042 staticpro (&Qforward_char);
11043
11044 Qbackward_char = intern ("backward-char");
11045 staticpro (&Qbackward_char);
11046
11047 Qdisabled = intern ("disabled");
11048 staticpro (&Qdisabled);
11049
e58aa385
RS
11050 Qundefined = intern ("undefined");
11051 staticpro (&Qundefined);
11052
86e5706b
RS
11053 Qpre_command_hook = intern ("pre-command-hook");
11054 staticpro (&Qpre_command_hook);
11055
11056 Qpost_command_hook = intern ("post-command-hook");
11057 staticpro (&Qpost_command_hook);
11058
3ef14e46
RS
11059 Qdeferred_action_function = intern ("deferred-action-function");
11060 staticpro (&Qdeferred_action_function);
11061
40932d1a
RS
11062 Qcommand_hook_internal = intern ("command-hook-internal");
11063 staticpro (&Qcommand_hook_internal);
11064
284f4730
JB
11065 Qfunction_key = intern ("function-key");
11066 staticpro (&Qfunction_key);
13b5e56c 11067 Qmouse_click = intern ("mouse-click");
284f4730 11068 staticpro (&Qmouse_click);
c16dab62 11069#if defined (WINDOWSNT) || defined (MAC_OS)
1161d367
GV
11070 Qlanguage_change = intern ("language-change");
11071 staticpro (&Qlanguage_change);
07de30b9 11072#endif
a24dc617
RS
11073 Qdrag_n_drop = intern ("drag-n-drop");
11074 staticpro (&Qdrag_n_drop);
284f4730 11075
4ebc27a5 11076 Qsave_session = intern ("save-session");
6e604a9b 11077 staticpro (&Qsave_session);
c60ee5e7 11078
5bf68f6e
AS
11079 Qusr1_signal = intern ("usr1-signal");
11080 staticpro (&Qusr1_signal);
11081 Qusr2_signal = intern ("usr2-signal");
11082 staticpro (&Qusr2_signal);
11083
598a9fa7
JB
11084 Qmenu_enable = intern ("menu-enable");
11085 staticpro (&Qmenu_enable);
e8886a1d
RS
11086 Qmenu_alias = intern ("menu-alias");
11087 staticpro (&Qmenu_alias);
11088 QCenable = intern (":enable");
11089 staticpro (&QCenable);
11090 QCvisible = intern (":visible");
11091 staticpro (&QCvisible);
7ee32cda
GM
11092 QChelp = intern (":help");
11093 staticpro (&QChelp);
e8886a1d
RS
11094 QCfilter = intern (":filter");
11095 staticpro (&QCfilter);
11096 QCbutton = intern (":button");
11097 staticpro (&QCbutton);
74c1de23
RS
11098 QCkeys = intern (":keys");
11099 staticpro (&QCkeys);
11100 QCkey_sequence = intern (":key-sequence");
11101 staticpro (&QCkey_sequence);
e8886a1d
RS
11102 QCtoggle = intern (":toggle");
11103 staticpro (&QCtoggle);
11104 QCradio = intern (":radio");
11105 staticpro (&QCradio);
598a9fa7 11106
284f4730
JB
11107 Qmode_line = intern ("mode-line");
11108 staticpro (&Qmode_line);
e5d77022
JB
11109 Qvertical_line = intern ("vertical-line");
11110 staticpro (&Qvertical_line);
3c370943
JB
11111 Qvertical_scroll_bar = intern ("vertical-scroll-bar");
11112 staticpro (&Qvertical_scroll_bar);
5ec75a55
RS
11113 Qmenu_bar = intern ("menu-bar");
11114 staticpro (&Qmenu_bar);
4bb994d1 11115
c22237f7
KS
11116#ifdef HAVE_MOUSE
11117 Qmouse_fixup_help_message = intern ("mouse-fixup-help-message");
11118 staticpro (&Qmouse_fixup_help_message);
11119#endif
11120
4bb994d1
JB
11121 Qabove_handle = intern ("above-handle");
11122 staticpro (&Qabove_handle);
11123 Qhandle = intern ("handle");
11124 staticpro (&Qhandle);
11125 Qbelow_handle = intern ("below-handle");
11126 staticpro (&Qbelow_handle);
db08707d
RS
11127 Qup = intern ("up");
11128 staticpro (&Qup);
11129 Qdown = intern ("down");
11130 staticpro (&Qdown);
7ee32cda
GM
11131 Qtop = intern ("top");
11132 staticpro (&Qtop);
11133 Qbottom = intern ("bottom");
11134 staticpro (&Qbottom);
11135 Qend_scroll = intern ("end-scroll");
11136 staticpro (&Qend_scroll);
eef28553
SM
11137 Qratio = intern ("ratio");
11138 staticpro (&Qratio);
284f4730 11139
cd21b839 11140 Qevent_kind = intern ("event-kind");
284f4730 11141 staticpro (&Qevent_kind);
88cb0656
JB
11142 Qevent_symbol_elements = intern ("event-symbol-elements");
11143 staticpro (&Qevent_symbol_elements);
0a7f1fc0
JB
11144 Qevent_symbol_element_mask = intern ("event-symbol-element-mask");
11145 staticpro (&Qevent_symbol_element_mask);
11146 Qmodifier_cache = intern ("modifier-cache");
11147 staticpro (&Qmodifier_cache);
284f4730 11148
48e416d4
RS
11149 Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar");
11150 staticpro (&Qrecompute_lucid_menubar);
11151 Qactivate_menubar_hook = intern ("activate-menubar-hook");
11152 staticpro (&Qactivate_menubar_hook);
11153
f4eef8b4
RS
11154 Qpolling_period = intern ("polling-period");
11155 staticpro (&Qpolling_period);
11156
7d18f9ae
RS
11157 Qinput_method_function = intern ("input-method-function");
11158 staticpro (&Qinput_method_function);
11159
d5eecefb
RS
11160 Qinput_method_exit_on_first_char = intern ("input-method-exit-on-first-char");
11161 staticpro (&Qinput_method_exit_on_first_char);
11162 Qinput_method_use_echo_area = intern ("input-method-use-echo-area");
11163 staticpro (&Qinput_method_use_echo_area);
11164
11165 Fset (Qinput_method_exit_on_first_char, Qnil);
11166 Fset (Qinput_method_use_echo_area, Qnil);
11167
e18dfbf4
KR
11168 last_point_position_buffer = Qnil;
11169
284f4730
JB
11170 {
11171 struct event_head *p;
11172
11173 for (p = head_table;
11174 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
11175 p++)
11176 {
11177 *p->var = intern (p->name);
11178 staticpro (p->var);
11179 Fput (*p->var, Qevent_kind, *p->kind);
88cb0656 11180 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
284f4730
JB
11181 }
11182 }
11183
8e1e4240 11184 button_down_location = Fmake_vector (make_number (1), Qnil);
7b4aedb9 11185 staticpro (&button_down_location);
8e1e4240
GM
11186 mouse_syms = Fmake_vector (make_number (1), Qnil);
11187 staticpro (&mouse_syms);
8006e4bb
JR
11188 wheel_syms = Fmake_vector (make_number (2), Qnil);
11189 staticpro (&wheel_syms);
88cb0656
JB
11190
11191 {
11192 int i;
11193 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
11194
11195 modifier_symbols = Fmake_vector (make_number (len), Qnil);
11196 for (i = 0; i < len; i++)
86e5706b
RS
11197 if (modifier_names[i])
11198 XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]);
88cb0656
JB
11199 staticpro (&modifier_symbols);
11200 }
11201
9deb415a
JB
11202 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
11203 staticpro (&recent_keys);
11204
6569cc8d 11205 this_command_keys = Fmake_vector (make_number (40), Qnil);
715d9345 11206 staticpro (&this_command_keys);
6569cc8d 11207
7d18f9ae
RS
11208 raw_keybuf = Fmake_vector (make_number (30), Qnil);
11209 staticpro (&raw_keybuf);
11210
03b4122a
BF
11211 Qextended_command_history = intern ("extended-command-history");
11212 Fset (Qextended_command_history, Qnil);
11213 staticpro (&Qextended_command_history);
11214
24597608
RS
11215 accent_key_syms = Qnil;
11216 staticpro (&accent_key_syms);
11217
284f4730
JB
11218 func_key_syms = Qnil;
11219 staticpro (&func_key_syms);
11220
a24dc617
RS
11221 drag_n_drop_syms = Qnil;
11222 staticpro (&drag_n_drop_syms);
07de30b9 11223
cd21b839
JB
11224 unread_switch_frame = Qnil;
11225 staticpro (&unread_switch_frame);
11226
fe412364
EN
11227 internal_last_event_frame = Qnil;
11228 staticpro (&internal_last_event_frame);
11229
11230 read_key_sequence_cmd = Qnil;
11231 staticpro (&read_key_sequence_cmd);
11232
759860a6
RS
11233 menu_bar_one_keymap_changed_items = Qnil;
11234 staticpro (&menu_bar_one_keymap_changed_items);
11235
7320c7de
KS
11236 menu_bar_items_vector = Qnil;
11237 staticpro (&menu_bar_items_vector);
11238
a1706c30 11239 defsubr (&Sevent_convert_list);
284f4730 11240 defsubr (&Sread_key_sequence);
e39da3d7 11241 defsubr (&Sread_key_sequence_vector);
284f4730 11242 defsubr (&Srecursive_edit);
2eb6bfbe 11243#ifdef HAVE_MOUSE
284f4730 11244 defsubr (&Strack_mouse);
2eb6bfbe 11245#endif
284f4730
JB
11246 defsubr (&Sinput_pending_p);
11247 defsubr (&Scommand_execute);
11248 defsubr (&Srecent_keys);
11249 defsubr (&Sthis_command_keys);
e39da3d7 11250 defsubr (&Sthis_command_keys_vector);
6321824f 11251 defsubr (&Sthis_single_command_keys);
7d18f9ae 11252 defsubr (&Sthis_single_command_raw_keys);
71918b75 11253 defsubr (&Sreset_this_command_lengths);
82e6e5af 11254 defsubr (&Sclear_this_command_keys);
284f4730
JB
11255 defsubr (&Ssuspend_emacs);
11256 defsubr (&Sabort_recursive_edit);
11257 defsubr (&Sexit_recursive_edit);
11258 defsubr (&Srecursion_depth);
11259 defsubr (&Stop_level);
11260 defsubr (&Sdiscard_input);
11261 defsubr (&Sopen_dribble_file);
11262 defsubr (&Sset_input_mode);
80645119 11263 defsubr (&Scurrent_input_mode);
284f4730 11264 defsubr (&Sexecute_extended_command);
ec026e7a
KS
11265 defsubr (&Sposn_at_point);
11266 defsubr (&Sposn_at_x_y);
284f4730 11267
284f4730 11268 DEFVAR_LISP ("last-command-char", &last_command_char,
4707d2d0 11269 doc: /* Last input event that was part of a command. */);
86e5706b 11270
186cf719 11271 DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char,
4707d2d0 11272 doc: /* Last input event that was part of a command. */);
284f4730 11273
7d6de002 11274 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
4707d2d0
PJ
11275 doc: /* Last input event in a command, except for mouse menu events.
11276Mouse menus give back keys that don't look like mouse events;
11277this variable holds the actual mouse event that led to the menu,
11278so that you can determine whether the command was run by mouse or not. */);
7d6de002 11279
284f4730 11280 DEFVAR_LISP ("last-input-char", &last_input_char,
fa1361cb 11281 doc: /* Last input event. */);
86e5706b 11282
186cf719 11283 DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char,
4707d2d0 11284 doc: /* Last input event. */);
284f4730 11285
24597608 11286 DEFVAR_LISP ("unread-command-events", &Vunread_command_events,
4707d2d0
PJ
11287 doc: /* List of events to be read as the command input.
11288These events are processed first, before actual keyboard input. */);
7d18f9ae 11289 Vunread_command_events = Qnil;
284f4730 11290
86e5706b 11291 DEFVAR_INT ("unread-command-char", &unread_command_char,
4707d2d0 11292 doc: /* If not -1, an object to be read as next command input event. */);
86e5706b 11293
7d18f9ae 11294 DEFVAR_LISP ("unread-post-input-method-events", &Vunread_post_input_method_events,
4707d2d0
PJ
11295 doc: /* List of events to be processed as input by input methods.
11296These events are processed after `unread-command-events', but
11297before actual keyboard input. */);
7d18f9ae
RS
11298 Vunread_post_input_method_events = Qnil;
11299
11300 DEFVAR_LISP ("unread-input-method-events", &Vunread_input_method_events,
4707d2d0
PJ
11301 doc: /* List of events to be processed as input by input methods.
11302These events are processed after `unread-command-events', but
11303before actual keyboard input. */);
7d18f9ae
RS
11304 Vunread_input_method_events = Qnil;
11305
284f4730 11306 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
4707d2d0
PJ
11307 doc: /* Meta-prefix character code.
11308Meta-foo as command input turns into this character followed by foo. */);
18cd2eeb 11309 XSETINT (meta_prefix_char, 033);
284f4730 11310
6c7178b9 11311 DEFVAR_KBOARD ("last-command", Vlast_command,
4707d2d0
PJ
11312 doc: /* The last command executed.
11313Normally a symbol with a function definition, but can be whatever was found
11314in the keymap, or whatever the variable `this-command' was set to by that
11315command.
11316
11317The value `mode-exit' is special; it means that the previous command
11318read an event that told it to exit, and it did so and unread that event.
11319In other words, the present command is the event that made the previous
11320command exit.
11321
11322The value `kill-region' is special; it means that the previous command
2a42d440
KL
11323was a kill command.
11324
11325`last-command' has a separate binding for each display device.
11326See Info node `(elisp)Multiple displays'. */);
284f4730 11327
75045dcb 11328 DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
4707d2d0 11329 doc: /* Same as `last-command', but never altered by Lisp code. */);
75045dcb 11330
d5eecefb 11331 DEFVAR_LISP ("this-command", &Vthis_command,
4707d2d0
PJ
11332 doc: /* The command now being executed.
11333The command can set this variable; whatever is put here
11334will be in `last-command' during the following command. */);
d5eecefb 11335 Vthis_command = Qnil;
284f4730 11336
8b9940e6 11337 DEFVAR_LISP ("this-original-command", &Vthis_original_command,
f5613d1e
KS
11338 doc: /* The command bound to the current key sequence before remapping.
11339It equals `this-command' if the original command was not remapped through
11340any of the active keymaps. Otherwise, the value of `this-command' is the
177c0ea7 11341result of looking up the original command in the active keymaps. */);
8b9940e6
KS
11342 Vthis_original_command = Qnil;
11343
284f4730 11344 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
4707d2d0
PJ
11345 doc: /* *Number of input events between auto-saves.
11346Zero means disable autosaving due to number of characters typed. */);
284f4730
JB
11347 auto_save_interval = 300;
11348
11349 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
4707d2d0
PJ
11350 doc: /* *Number of seconds idle time before auto-save.
11351Zero or nil means disable auto-saving due to idleness.
11352After auto-saving due to this many seconds of idle time,
11353Emacs also does a garbage collection if that seems to be warranted. */);
bb9e9bed 11354 XSETFASTINT (Vauto_save_timeout, 30);
284f4730 11355
39aab679 11356 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes,
4707d2d0
PJ
11357 doc: /* *Nonzero means echo unfinished commands after this many seconds of pause.
11358The value may be integer or floating point. */);
39aab679 11359 Vecho_keystrokes = make_number (1);
284f4730
JB
11360
11361 DEFVAR_INT ("polling-period", &polling_period,
4707d2d0
PJ
11362 doc: /* *Interval between polling for input during Lisp execution.
11363The reason for polling is to make C-g work to stop a running program.
11364Polling is needed only when using X windows and SIGIO does not work.
11365Polling is automatically disabled in all other cases. */);
284f4730 11366 polling_period = 2;
df0f2ba1 11367
564dc952 11368 DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
4707d2d0
PJ
11369 doc: /* *Maximum time between mouse clicks to make a double-click.
11370Measured in milliseconds. nil means disable double-click recognition;
11371t means double-clicks have no time limit and are detected
11372by position only. */);
aab06933 11373 Vdouble_click_time = make_number (500);
fbcd35bd 11374
222d557c 11375 DEFVAR_INT ("double-click-fuzz", &double_click_fuzz,
4707d2d0
PJ
11376 doc: /* *Maximum mouse movement between clicks to make a double-click.
11377On window-system frames, value is the number of pixels the mouse may have
11378moved horizontally or vertically between two clicks to make a double-click.
11379On non window-system frames, value is interpreted in units of 1/8 characters
1ca6a9c4
RS
11380instead of pixels.
11381
11382This variable is also the threshold for motion of the mouse
11383to count as a drag. */);
222d557c 11384 double_click_fuzz = 3;
c60ee5e7 11385
03361bcc 11386 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
4707d2d0 11387 doc: /* *Non-nil means inhibit local map menu bar menus. */);
03361bcc
RS
11388 inhibit_local_menu_bar_menus = 0;
11389
284f4730 11390 DEFVAR_INT ("num-input-keys", &num_input_keys,
4707d2d0
PJ
11391 doc: /* Number of complete key sequences read as input so far.
11392This includes key sequences read from keyboard macros.
11393The number is effectively the number of interactive command invocations. */);
284f4730
JB
11394 num_input_keys = 0;
11395
c43b1734 11396 DEFVAR_INT ("num-nonmacro-input-events", &num_nonmacro_input_events,
4707d2d0
PJ
11397 doc: /* Number of input events read from the keyboard so far.
11398This does not include events generated by keyboard macros. */);
c43b1734 11399 num_nonmacro_input_events = 0;
fa90970d 11400
4c52b668 11401 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
4707d2d0
PJ
11402 doc: /* The frame in which the most recently read event occurred.
11403If the last event came from a keyboard macro, this is set to `macro'. */);
4c52b668
KH
11404 Vlast_event_frame = Qnil;
11405
fa90970d
RS
11406 /* This variable is set up in sysdep.c. */
11407 DEFVAR_LISP ("tty-erase-char", &Vtty_erase_char,
4707d2d0 11408 doc: /* The ERASE character as set by the user with stty. */);
fa90970d 11409
7e85b935 11410 DEFVAR_LISP ("help-char", &Vhelp_char,
4707d2d0
PJ
11411 doc: /* Character to recognize as meaning Help.
11412When it is read, do `(eval help-form)', and display result if it's a string.
11413If the value of `help-form' is nil, this char can be read normally. */);
18cd2eeb 11414 XSETINT (Vhelp_char, Ctl ('H'));
284f4730 11415
ecb7cb34 11416 DEFVAR_LISP ("help-event-list", &Vhelp_event_list,
4707d2d0
PJ
11417 doc: /* List of input events to recognize as meaning Help.
11418These work just like the value of `help-char' (see that). */);
ecb7cb34
KH
11419 Vhelp_event_list = Qnil;
11420
284f4730 11421 DEFVAR_LISP ("help-form", &Vhelp_form,
4707d2d0
PJ
11422 doc: /* Form to execute when character `help-char' is read.
11423If the form returns a string, that string is displayed.
11424If `help-form' is nil, the help char is not recognized. */);
284f4730
JB
11425 Vhelp_form = Qnil;
11426
7e85b935 11427 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
4707d2d0
PJ
11428 doc: /* Command to run when `help-char' character follows a prefix key.
11429This command is used only when there is no actual binding
11430for that character after that prefix key. */);
7e85b935
RS
11431 Vprefix_help_command = Qnil;
11432
284f4730 11433 DEFVAR_LISP ("top-level", &Vtop_level,
4707d2d0
PJ
11434 doc: /* Form to evaluate when Emacs starts up.
11435Useful to set before you dump a modified Emacs. */);
284f4730
JB
11436 Vtop_level = Qnil;
11437
2e478293
KL
11438 DEFVAR_KBOARD ("keyboard-translate-table", Vkeyboard_translate_table,
11439 doc: /* Translate table for local keyboard input, or nil.
669de2fb
LT
11440If non-nil, the value should be a char-table. Each character read
11441from the keyboard is looked up in this char-table. If the value found
11442there is non-nil, then it is used instead of the actual input character.
11443
11444The value can also be a string or vector, but this is considered obsolete.
11445If it is a string or vector of length N, character codes N and up are left
11446untranslated. In a vector, an element which is nil means "no translation".
a0acc6c7
DL
11447
11448This is applied to the characters supplied to input methods, not their
2e478293
KL
11449output. See also `translation-table-for-input'.
11450
11451`local-keyboard-translate-table' has a separate binding for each
11452terminal. See Info node `(elisp)Multiple displays'. */);
284f4730 11453
8026024c 11454 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
4707d2d0
PJ
11455 doc: /* Non-nil means to always spawn a subshell instead of suspending.
11456\(Even if the operating system has support for stopping a process.\) */);
8026024c
KH
11457 cannot_suspend = 0;
11458
284f4730 11459 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
4707d2d0
PJ
11460 doc: /* Non-nil means prompt with menus when appropriate.
11461This is done when reading from a keymap that has a prompt string,
11462for elements that have prompt strings.
11463The menu is displayed on the screen
11464if X menus were enabled at configuration
11465time and the previous event was a mouse click prefix key.
11466Otherwise, menu prompting uses the echo area. */);
284f4730
JB
11467 menu_prompting = 1;
11468
11469 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
4707d2d0
PJ
11470 doc: /* Character to see next line of menu prompt.
11471Type this character while in a menu prompt to rotate around the lines of it. */);
18cd2eeb 11472 XSETINT (menu_prompt_more_char, ' ');
9fa4395d
RS
11473
11474 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
4707d2d0
PJ
11475 doc: /* A mask of additional modifier keys to use with every keyboard character.
11476Emacs applies the modifiers of the character stored here to each keyboard
11477character it reads. For example, after evaluating the expression
11478 (setq extra-keyboard-modifiers ?\\C-x)
11479all input characters will have the control modifier applied to them.
11480
11481Note that the character ?\\C-@, equivalent to the integer zero, does
11482not count as a control character; rather, it counts as a character
11483with no modifiers; thus, setting `extra-keyboard-modifiers' to zero
11484cancels any modification. */);
9fa4395d 11485 extra_keyboard_modifiers = 0;
86e5706b
RS
11486
11487 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
4707d2d0
PJ
11488 doc: /* If an editing command sets this to t, deactivate the mark afterward.
11489The command loop sets this to nil before each command,
11490and tests the value when the command returns.
11491Buffer modification stores t in this variable. */);
86e5706b
RS
11492 Vdeactivate_mark = Qnil;
11493
b0f2a7bf 11494 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal,
4707d2d0 11495 doc: /* Temporary storage of pre-command-hook or post-command-hook. */);
b0f2a7bf
KH
11496 Vcommand_hook_internal = Qnil;
11497
86e5706b 11498 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
4707d2d0
PJ
11499 doc: /* Normal hook run before each command is executed.
11500If an unhandled error happens in running this hook,
11501the hook value is set to nil, since otherwise the error
11502might happen repeatedly and make Emacs nonfunctional. */);
86e5706b
RS
11503 Vpre_command_hook = Qnil;
11504
11505 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
4707d2d0
PJ
11506 doc: /* Normal hook run after each command is executed.
11507If an unhandled error happens in running this hook,
11508the hook value is set to nil, since otherwise the error
11509might happen repeatedly and make Emacs nonfunctional. */);
86e5706b 11510 Vpost_command_hook = Qnil;
48e416d4 11511
cf24f894
RS
11512#if 0
11513 DEFVAR_LISP ("echo-area-clear-hook", ...,
4707d2d0 11514 doc: /* Normal hook run when clearing the echo area. */);
cf24f894
RS
11515#endif
11516 Qecho_area_clear_hook = intern ("echo-area-clear-hook");
c8e16a02 11517 staticpro (&Qecho_area_clear_hook);
cf24f894 11518 SET_SYMBOL_VALUE (Qecho_area_clear_hook, Qnil);
cdb9d665 11519
48e416d4 11520 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
fa1361cb 11521 doc: /* Non-nil means menu bar, specified Lucid style, needs to be recomputed. */);
48e416d4 11522 Vlucid_menu_bar_dirty_flag = Qnil;
a73c5e29 11523
9f9c0e27 11524 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
4707d2d0
PJ
11525 doc: /* List of menu bar items to move to the end of the menu bar.
11526The elements of the list are event types that may have menu bar bindings. */);
9f9c0e27 11527 Vmenu_bar_final_items = Qnil;
e9bf89a0 11528
217258d5
KH
11529 DEFVAR_KBOARD ("overriding-terminal-local-map",
11530 Voverriding_terminal_local_map,
4707d2d0
PJ
11531 doc: /* Per-terminal keymap that overrides all other local keymaps.
11532If this variable is non-nil, it is used as a keymap instead of the
11533buffer's local map, and the minor mode keymaps and text property keymaps.
5a45dd33
RS
11534It also replaces `overriding-local-map'.
11535
4707d2d0 11536This variable is intended to let commands such as `universal-argument'
2a42d440
KL
11537set up a different keymap for reading the next command.
11538
11539`overriding-terminal-local-map' has a separate binding for each display device.
11540See Info node `(elisp)Multiple displays'. */);
217258d5 11541
9dd3131c 11542 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map,
4707d2d0 11543 doc: /* Keymap that overrides all other local keymaps.
5a45dd33
RS
11544If this variable is non-nil, it is used as a keymap--replacing the
11545buffer's local map, the minor mode keymaps, and char property keymaps. */);
9dd3131c
RS
11546 Voverriding_local_map = Qnil;
11547
d0a49716 11548 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag,
4707d2d0
PJ
11549 doc: /* Non-nil means `overriding-local-map' applies to the menu bar.
11550Otherwise, the menu bar continues to reflect the buffer's local map
11551and the minor mode maps regardless of `overriding-local-map'. */);
d0a49716
RS
11552 Voverriding_local_map_menu_flag = Qnil;
11553
7f07d5ca 11554 DEFVAR_LISP ("special-event-map", &Vspecial_event_map,
4707d2d0 11555 doc: /* Keymap defining bindings for special events to execute at low level. */);
7f07d5ca
RS
11556 Vspecial_event_map = Fcons (intern ("keymap"), Qnil);
11557
71edead1 11558 DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
4707d2d0 11559 doc: /* *Non-nil means generate motion events for mouse motion. */);
80e4aa30 11560
7c97ffdc 11561 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
4707d2d0
PJ
11562 doc: /* Alist of system-specific X windows key symbols.
11563Each element should have the form (N . SYMBOL) where N is the
11564numeric keysym code (sans the \"system-specific\" bit 1<<28)
2a42d440
KL
11565and SYMBOL is its name.
11566
11567`system-key-alist' has a separate binding for each display device.
11568See Info node `(elisp)Multiple displays'.
11569
11570Note that the currently selected frame has very little to do with
11571which binding of this variable is active at any given moment. If you
11572need set or get the binding on a specific display, use
11573`terminal-local-value' and `set-terminal-local-value'. */);
8a792f3a 11574
ac09dc1e 11575 DEFVAR_KBOARD ("local-function-key-map", Vlocal_function_key_map,
f01b6d17
KL
11576 doc: /* Keymap mapping ASCII function key sequences onto their preferred forms.
11577This allows Emacs to recognize function keys sent from ASCII
11578terminals at any point in a key sequence.
11579
11580The `read-key-sequence' function replaces any subsequence bound by
7a81ec10
KL
11581`local-function-key-map' with its binding. More precisely, when the
11582active keymaps have no binding for the current key sequence but
11583`local-function-key-map' binds a suffix of the sequence to a vector or
11584string, `read-key-sequence' replaces the matching suffix with its
11585binding, and continues with the new sequence.
f01b6d17 11586
7a81ec10
KL
11587The events that come from bindings in `local-function-key-map' are not
11588themselves looked up in `local-function-key-map'.
f01b6d17 11589
7a81ec10 11590For example, suppose `local-function-key-map' binds `ESC O P' to [f1].
f01b6d17 11591Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
7a81ec10
KL
11592`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix key,
11593typing `ESC O P x' would return [f1 x].
f01b6d17 11594
7a81ec10
KL
11595`local-function-key-map' has a separate binding for each display
11596device. See Info node `(elisp)Multiple displays'. If you need to
11597define a binding on all display devices, change `function-key-map'
11598instead. Initially, `local-function-key-map' is an empty keymap that
11599has `function-key-map' as its parent on all display devices.
2a42d440
KL
11600
11601Note that the currently selected frame has very little to do with
11602which binding of this variable is active at any given moment. If you
11603need set or get the binding on a specific display, use
11604`terminal-local-value' and `set-terminal-local-value'. */);
f01b6d17 11605
ac09dc1e
KL
11606 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
11607 doc: /* The parent keymap of all `local-function-key-map' instances.
11608Function key definitions that apply to all display devices should go
7a81ec10
KL
11609here. If a mapping is defined in both the current
11610`local-function-key-map' binding and this variable, then the local
11611definition will take precendence. */);
ac09dc1e
KL
11612 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
11613
11614 DEFVAR_KBOARD ("local-key-translation-map", Vlocal_key_translation_map,
4ea81208
KL
11615 doc: /* Keymap of key translations that can override keymaps.
11616This keymap works like `function-key-map', but comes after that,
11617and its non-prefix bindings override ordinary bindings.
11618
11619`key-translation-map' has a separate binding for each display device.
11620(See Info node `(elisp)Multiple displays'.) If you need to set a key
2a42d440
KL
11621translation on all devices, change `global-key-translation-map' instead.
11622
11623Note that the currently selected frame has very little to do with
11624which binding of this variable is active at any given moment. If you
11625need set or get the binding on a specific display, use
11626`terminal-local-value' and `set-terminal-local-value'. */);
4ea81208 11627
ac09dc1e
KL
11628 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
11629 doc: /* The parent keymap of all `local-key-translation-map' instances.
11630Key translations that apply to all display devices should go here. */);
11631 Vkey_translation_map = Fmake_sparse_keymap (Qnil);
4ea81208 11632
8a792f3a 11633 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list,
4707d2d0
PJ
11634 doc: /* List of deferred actions to be performed at a later time.
11635The precise format isn't relevant here; we just check whether it is nil. */);
8a792f3a
RS
11636 Vdeferred_action_list = Qnil;
11637
11638 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function,
4707d2d0
PJ
11639 doc: /* Function to call to handle deferred actions, after each command.
11640This function is called with no arguments after each command
11641whenever `deferred-action-list' is non-nil. */);
8a792f3a 11642 Vdeferred_action_function = Qnil;
6526ab49
RS
11643
11644 DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings,
4707d2d0
PJ
11645 doc: /* *Non-nil means show the equivalent key-binding when M-x command has one.
11646The value can be a length of time to show the message for.
11647If the value is non-nil and not a number, we wait 2 seconds. */);
6526ab49 11648 Vsuggest_key_bindings = Qt;
8bb1c042 11649
c04cbc3b 11650 DEFVAR_LISP ("timer-list", &Vtimer_list,
4707d2d0 11651 doc: /* List of active absolute time timers in order of increasing time. */);
c04cbc3b 11652 Vtimer_list = Qnil;
d9d4c147
KH
11653
11654 DEFVAR_LISP ("timer-idle-list", &Vtimer_idle_list,
4707d2d0 11655 doc: /* List of active idle-time timers in order of increasing time. */);
d9d4c147 11656 Vtimer_idle_list = Qnil;
7d18f9ae
RS
11657
11658 DEFVAR_LISP ("input-method-function", &Vinput_method_function,
4707d2d0
PJ
11659 doc: /* If non-nil, the function that implements the current input method.
11660It's called with one argument, a printing character that was just read.
11661\(That means a character with code 040...0176.)
11662Typically this function uses `read-event' to read additional events.
11663When it does so, it should first bind `input-method-function' to nil
11664so it will not be called recursively.
11665
11666The function should return a list of zero or more events
11667to be used as input. If it wants to put back some events
11668to be reconsidered, separately, by the input method,
11669it can add them to the beginning of `unread-command-events'.
11670
11671The input method function can find in `input-method-previous-method'
11672the previous echo area message.
11673
11674The input method function should refer to the variables
11675`input-method-use-echo-area' and `input-method-exit-on-first-char'
11676for guidance on what to do. */);
7d18f9ae 11677 Vinput_method_function = Qnil;
d5eecefb
RS
11678
11679 DEFVAR_LISP ("input-method-previous-message",
11680 &Vinput_method_previous_message,
4707d2d0
PJ
11681 doc: /* When `input-method-function' is called, hold the previous echo area message.
11682This variable exists because `read-event' clears the echo area
11683before running the input method. It is nil if there was no message. */);
d5eecefb 11684 Vinput_method_previous_message = Qnil;
7ee32cda
GM
11685
11686 DEFVAR_LISP ("show-help-function", &Vshow_help_function,
4707d2d0
PJ
11687 doc: /* If non-nil, the function that implements the display of help.
11688It's called with one argument, the help string to display. */);
7ee32cda 11689 Vshow_help_function = Qnil;
adf5cb9c
KH
11690
11691 DEFVAR_LISP ("disable-point-adjustment", &Vdisable_point_adjustment,
4707d2d0
PJ
11692 doc: /* If non-nil, suppress point adjustment after executing a command.
11693
11694After a command is executed, if point is moved into a region that has
11695special properties (e.g. composition, display), we adjust point to
5fee9a2f
LT
11696the boundary of the region. But, when a command sets this variable to
11697non-nil, we suppress the point adjustment.
4707d2d0
PJ
11698
11699This variable is set to nil before reading a command, and is checked
11700just after executing the command. */);
adf5cb9c
KH
11701 Vdisable_point_adjustment = Qnil;
11702
11703 DEFVAR_LISP ("global-disable-point-adjustment",
11704 &Vglobal_disable_point_adjustment,
4707d2d0
PJ
11705 doc: /* *If non-nil, always suppress point adjustment.
11706
11707The default value is nil, in which case, point adjustment are
11708suppressed only after special commands that set
11709`disable-point-adjustment' (which see) to non-nil. */);
adf5cb9c 11710 Vglobal_disable_point_adjustment = Qnil;
3626fb1a 11711
00392ce6 11712 DEFVAR_LISP ("minibuffer-message-timeout", &Vminibuffer_message_timeout,
4707d2d0
PJ
11713 doc: /* *How long to display an echo-area message when the minibuffer is active.
11714If the value is not a number, such messages don't time out. */);
00392ce6 11715 Vminibuffer_message_timeout = make_number (2);
2a84c6da
KS
11716
11717 DEFVAR_LISP ("throw-on-input", &Vthrow_on_input,
11718 doc: /* If non-nil, any keyboard input throws to this symbol.
11719The value of that variable is passed to `quit-flag' and later causes a
11720peculiar kind of quitting. */);
11721 Vthrow_on_input = Qnil;
284f4730
JB
11722}
11723
dfcf069d 11724void
284f4730
JB
11725keys_of_keyboard ()
11726{
11727 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
11728 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
11729 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
11730 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
11731 initial_define_key (meta_map, 'x', "execute-extended-command");
7f07d5ca
RS
11732
11733 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
11734 "handle-delete-frame");
a18bf897
SM
11735 /* Here we used to use `ignore-event' which would simple set prefix-arg to
11736 current-prefix-arg, as is done in `handle-switch-frame'.
11737 But `handle-switch-frame is not run from the special-map.
11738 Commands from that map are run in a special way that automatically
11739 preserves the prefix-arg. Restoring the prefix arg here is not just
11740 redundant but harmful:
11741 - C-u C-x v =
11742 - current-prefix-arg is set to non-nil, prefix-arg is set to nil.
11743 - after the first prompt, the exit-minibuffer-hook is run which may
11744 iconify a frame and thus push a `iconify-frame' event.
11745 - after running exit-minibuffer-hook, current-prefix-arg is
11746 restored to the non-nil value it had before the prompt.
11747 - we enter the second prompt.
11748 current-prefix-arg is non-nil, prefix-arg is nil.
11749 - before running the first real event, we run the special iconify-frame
11750 event, but we pass the `special' arg to execute-command so
11751 current-prefix-arg and prefix-arg are left untouched.
11752 - here we foolishly copy the non-nil current-prefix-arg to prefix-arg.
11753 - the next key event will have a spuriously non-nil current-prefix-arg. */
7f07d5ca 11754 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
a18bf897 11755 "ignore");
7f07d5ca 11756 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
a18bf897 11757 "ignore");
a4e19f6e
SM
11758 /* Handling it at such a low-level causes read_key_sequence to get
11759 * confused because it doesn't realize that the current_buffer was
11760 * changed by read_char.
2320865d 11761 *
a4e19f6e
SM
11762 * initial_define_lispy_key (Vspecial_event_map, "select-window",
11763 * "handle-select-window"); */
4ebc27a5
JD
11764 initial_define_lispy_key (Vspecial_event_map, "save-session",
11765 "handle-save-session");
284f4730 11766}
1269a761
SM
11767
11768/* Mark the pointers in the kboard objects.
11769 Called by the Fgarbage_collector. */
11770void
11771mark_kboards ()
11772{
11773 KBOARD *kb;
11774 Lisp_Object *p;
11775 for (kb = all_kboards; kb; kb = kb->next_kboard)
11776 {
11777 if (kb->kbd_macro_buffer)
11778 for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
3ebb8729
SM
11779 mark_object (*p);
11780 mark_object (kb->Voverriding_terminal_local_map);
11781 mark_object (kb->Vlast_command);
11782 mark_object (kb->Vreal_last_command);
1d33157f 11783 mark_object (kb->Vkeyboard_translate_table);
3ebb8729
SM
11784 mark_object (kb->Vprefix_arg);
11785 mark_object (kb->Vlast_prefix_arg);
11786 mark_object (kb->kbd_queue);
11787 mark_object (kb->defining_kbd_macro);
11788 mark_object (kb->Vlast_kbd_macro);
11789 mark_object (kb->Vsystem_key_alist);
11790 mark_object (kb->system_key_syms);
ac09dc1e
KL
11791 mark_object (kb->Vlocal_function_key_map);
11792 mark_object (kb->Vlocal_key_translation_map);
3ebb8729
SM
11793 mark_object (kb->Vdefault_minibuffer_frame);
11794 mark_object (kb->echo_string);
1269a761
SM
11795 }
11796 {
11797 struct input_event *event;
11798 for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++)
11799 {
11800 if (event == kbd_buffer + KBD_BUFFER_SIZE)
11801 event = kbd_buffer;
e3f6e7c7
KS
11802 if (event->kind != SELECTION_REQUEST_EVENT
11803 && event->kind != SELECTION_CLEAR_EVENT)
0161caf9
KS
11804 {
11805 mark_object (event->x);
11806 mark_object (event->y);
11807 }
3ebb8729
SM
11808 mark_object (event->frame_or_window);
11809 mark_object (event->arg);
1269a761
SM
11810 }
11811 }
11812}
ab5796a9
MB
11813
11814/* arch-tag: 774e34d7-6d31-42f3-8397-e079a4e4c9ca
11815 (do not change this comment) */