(get_specified_cursor_type, get_window_cursor_type):
[bpt/emacs.git] / src / keyboard.c
CommitLineData
284f4730 1/* Keyboard and mouse input; editor command loop.
0bbdffbd 2 Copyright (C) 1985,86,87,88,89,93,94,95,96,97,99,2000,01,02,03
39aab679 3 Free Software Foundation, Inc.
284f4730
JB
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
7b4aedb9 9the Free Software Foundation; either version 2, or (at your option)
284f4730
JB
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
284f4730 21
18160b98 22#include <config.h>
68c45bf0 23#include <signal.h>
284f4730 24#include <stdio.h>
284f4730
JB
25#include "termchar.h"
26#include "termopts.h"
27#include "lisp.h"
28#include "termhooks.h"
29#include "macros.h"
02639609 30#include "keyboard.h"
ff11dfa1 31#include "frame.h"
284f4730
JB
32#include "window.h"
33#include "commands.h"
34#include "buffer.h"
37cd9f30 35#include "charset.h"
284f4730 36#include "disptab.h"
f4255cd1 37#include "dispextern.h"
e39da3d7 38#include "syntax.h"
497ba7a1 39#include "intervals.h"
bdb7aa47 40#include "keymap.h"
9ac0d9e0 41#include "blockinput.h"
e8886a1d 42#include "puresize.h"
8a9f5d3c
GM
43#include "systime.h"
44#include "atimer.h"
284f4730
JB
45#include <setjmp.h>
46#include <errno.h>
47
80e4aa30
RS
48#ifdef MSDOS
49#include "msdos.h"
50#include <time.h>
51#else /* not MSDOS */
284f4730
JB
52#ifndef VMS
53#include <sys/ioctl.h>
284f4730 54#endif
80e4aa30 55#endif /* not MSDOS */
284f4730 56
52baf19e 57#include "syssignal.h"
6ef5b54f 58#include "systty.h"
52baf19e 59
03cee6ae
GM
60#include <sys/types.h>
61#ifdef HAVE_UNISTD_H
62#include <unistd.h>
63#endif
64
c5e3b6c5
RS
65/* This is to get the definitions of the XK_ symbols. */
66#ifdef HAVE_X_WINDOWS
67#include "xterm.h"
68#endif
69
e98a93eb
GV
70#ifdef HAVE_NTGUI
71#include "w32term.h"
72#endif /* HAVE_NTGUI */
73
e0f712ba 74#ifdef MAC_OS
1a578e9b
AC
75#include "macterm.h"
76#endif
77
02639609 78#ifndef USE_CRT_DLL
52baf19e 79extern int errno;
02639609 80#endif
52baf19e 81
9ac0d9e0
JB
82/* Variables for blockinput.h: */
83
84/* Non-zero if interrupt input is blocked right now. */
63927c41 85int interrupt_input_blocked;
9ac0d9e0
JB
86
87/* Nonzero means an input interrupt has arrived
88 during the current critical section. */
63927c41 89int interrupt_input_pending;
9ac0d9e0
JB
90
91
437f6112
RS
92/* File descriptor to use for input. */
93extern int input_fd;
284f4730 94
e98a93eb 95#ifdef HAVE_WINDOW_SYSTEM
284f4730 96/* Make all keyboard buffers much bigger when using X windows. */
e0f712ba
AC
97#ifdef MAC_OS8
98/* But not too big (local data > 32K error) if on Mac OS Classic. */
f019cded
RS
99#define KBD_BUFFER_SIZE 512
100#else
284f4730 101#define KBD_BUFFER_SIZE 4096
f019cded 102#endif
284f4730 103#else /* No X-windows, character input */
de11c1ea 104#define KBD_BUFFER_SIZE 4096
284f4730
JB
105#endif /* No X-windows */
106
222d557c
GM
107#define abs(x) ((x) >= 0 ? (x) : -(x))
108
284f4730
JB
109/* Following definition copied from eval.c */
110
111struct backtrace
112 {
113 struct backtrace *next;
114 Lisp_Object *function;
115 Lisp_Object *args; /* Points to vector of args. */
116 int nargs; /* length of vector. If nargs is UNEVALLED,
117 args points to slot holding list of
118 unevalled args */
119 char evalargs;
120 };
121
c5fdd383
KH
122#ifdef MULTI_KBOARD
123KBOARD *initial_kboard;
124KBOARD *current_kboard;
125KBOARD *all_kboards;
1e8bd3da 126int single_kboard;
6c6083a9 127#else
c5fdd383 128KBOARD the_only_kboard;
6c6083a9 129#endif
612b78ef 130
284f4730
JB
131/* Non-nil disable property on a command means
132 do not execute it; call disabled-command-hook's value instead. */
2e894dab 133Lisp_Object Qdisabled, Qdisabled_command_hook;
284f4730
JB
134
135#define NUM_RECENT_KEYS (100)
136int recent_keys_index; /* Index for storing next element into recent_keys */
137int total_keys; /* Total number of elements stored into recent_keys */
5160df46 138Lisp_Object recent_keys; /* A vector, holding the last 100 keystrokes */
284f4730 139
6569cc8d
JB
140/* Vector holding the key sequence that invoked the current command.
141 It is reused for each command, and it may be longer than the current
142 sequence; this_command_key_count indicates how many elements
143 actually mean something.
144 It's easier to staticpro a single Lisp_Object than an array. */
145Lisp_Object this_command_keys;
146int this_command_key_count;
284f4730 147
63020c46
RS
148/* 1 after calling Freset_this_command_lengths.
149 Usually it is 0. */
150int this_command_key_count_reset;
151
7d18f9ae
RS
152/* This vector is used as a buffer to record the events that were actually read
153 by read_key_sequence. */
154Lisp_Object raw_keybuf;
155int raw_keybuf_count;
156
157#define GROW_RAW_KEYBUF \
7189cad8 158 if (raw_keybuf_count == XVECTOR (raw_keybuf)->size) \
7d18f9ae
RS
159 { \
160 int newsize = 2 * XVECTOR (raw_keybuf)->size; \
161 Lisp_Object new; \
162 new = Fmake_vector (make_number (newsize), Qnil); \
163 bcopy (XVECTOR (raw_keybuf)->contents, XVECTOR (new)->contents, \
164 raw_keybuf_count * sizeof (Lisp_Object)); \
165 raw_keybuf = new; \
166 }
167
6321824f
RS
168/* Number of elements of this_command_keys
169 that precede this key sequence. */
170int this_single_command_key_start;
171
71918b75
RS
172/* Record values of this_command_key_count and echo_length ()
173 before this command was read. */
174static int before_command_key_count;
175static int before_command_echo_length;
71918b75 176
284f4730
JB
177extern int minbuf_level;
178
a59b172a
RS
179extern int message_enable_multibyte;
180
284f4730
JB
181extern struct backtrace *backtrace_list;
182
7ee32cda
GM
183/* If non-nil, the function that implements the display of help.
184 It's called with one argument, the help string to display. */
185
186Lisp_Object Vshow_help_function;
187
f0c1cc56
GM
188/* If a string, the message displayed before displaying a help-echo
189 in the echo area. */
190
191Lisp_Object Vpre_help_message;
192
284f4730 193/* Nonzero means do menu prompting. */
f0c1cc56 194
284f4730
JB
195static int menu_prompting;
196
197/* Character to see next line of menu prompt. */
f0c1cc56 198
284f4730
JB
199static Lisp_Object menu_prompt_more_char;
200
201/* For longjmp to where kbd input is being done. */
f0c1cc56 202
284f4730
JB
203static jmp_buf getcjmp;
204
205/* True while doing kbd input. */
206int waiting_for_input;
207
208/* True while displaying for echoing. Delays C-g throwing. */
985f9f66 209
c843d6c6 210int echoing;
284f4730 211
985f9f66
GM
212/* Non-null means we can start echoing at the next input pause even
213 though there is something in the echo area. */
214
215static struct kboard *ok_to_echo_at_next_pause;
216
59a84f8e
GM
217/* The kboard last echoing, or null for none. Reset to 0 in
218 cancel_echoing. If non-null, and a current echo area message
219 exists, and echo_message_buffer is eq to the current message
220 buffer, we know that the message comes from echo_kboard. */
985f9f66 221
f49aedfd 222struct kboard *echo_kboard;
1fc93d49 223
59a84f8e
GM
224/* The buffer used for echoing. Set in echo_now, reset in
225 cancel_echoing. */
226
c843d6c6 227Lisp_Object echo_message_buffer;
59a84f8e 228
03361bcc
RS
229/* Nonzero means disregard local maps for the menu bar. */
230static int inhibit_local_menu_bar_menus;
231
80e4aa30 232/* Nonzero means C-g should cause immediate error-signal. */
284f4730
JB
233int immediate_quit;
234
fa90970d
RS
235/* The user's ERASE setting. */
236Lisp_Object Vtty_erase_char;
237
284f4730 238/* Character to recognize as the help char. */
7e85b935 239Lisp_Object Vhelp_char;
284f4730 240
ecb7cb34
KH
241/* List of other event types to recognize as meaning "help". */
242Lisp_Object Vhelp_event_list;
243
284f4730
JB
244/* Form to execute when help char is typed. */
245Lisp_Object Vhelp_form;
246
7e85b935
RS
247/* Command to run when the help character follows a prefix key. */
248Lisp_Object Vprefix_help_command;
249
9f9c0e27
RS
250/* List of items that should move to the end of the menu bar. */
251Lisp_Object Vmenu_bar_final_items;
a73c5e29 252
6526ab49
RS
253/* Non-nil means show the equivalent key-binding for
254 any M-x command that has one.
255 The value can be a length of time to show the message for.
256 If the value is non-nil and not a number, we wait 2 seconds. */
257Lisp_Object Vsuggest_key_bindings;
258
00392ce6
MB
259/* How long to display an echo-area message when the minibuffer is active.
260 If the value is not a number, such messages don't time out. */
261Lisp_Object Vminibuffer_message_timeout;
262
284f4730
JB
263/* Character that causes a quit. Normally C-g.
264
265 If we are running on an ordinary terminal, this must be an ordinary
266 ASCII char, since we want to make it our interrupt character.
267
268 If we are not running on an ordinary terminal, it still needs to be
269 an ordinary ASCII char. This character needs to be recognized in
270 the input interrupt handler. At this point, the keystroke is
271 represented as a struct input_event, while the desired quit
272 character is specified as a lispy event. The mapping from struct
273 input_events to lispy events cannot run in an interrupt handler,
274 and the reverse mapping is difficult for anything but ASCII
275 keystrokes.
276
277 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
278 ASCII character. */
279int quit_char;
280
281extern Lisp_Object current_global_map;
282extern int minibuf_level;
283
9dd3131c
RS
284/* If non-nil, this is a map that overrides all other local maps. */
285Lisp_Object Voverriding_local_map;
286
d0a49716
RS
287/* If non-nil, Voverriding_local_map applies to the menu bar. */
288Lisp_Object Voverriding_local_map_menu_flag;
289
7f07d5ca
RS
290/* Keymap that defines special misc events that should
291 be processed immediately at a low level. */
292Lisp_Object Vspecial_event_map;
293
284f4730
JB
294/* Current depth in recursive edits. */
295int command_loop_level;
296
297/* Total number of times command_loop has read a key sequence. */
31ade731 298EMACS_INT num_input_keys;
284f4730
JB
299
300/* Last input character read as a command. */
301Lisp_Object last_command_char;
302
7d6de002
RS
303/* Last input character read as a command, not counting menus
304 reached by the mouse. */
305Lisp_Object last_nonmenu_event;
306
284f4730
JB
307/* Last input character read for any purpose. */
308Lisp_Object last_input_char;
309
dbc4e1c1 310/* If not Qnil, a list of objects to be read as subsequent command input. */
24597608 311Lisp_Object Vunread_command_events;
284f4730 312
7d18f9ae
RS
313/* If not Qnil, a list of objects to be read as subsequent command input
314 including input method processing. */
315Lisp_Object Vunread_input_method_events;
316
317/* If not Qnil, a list of objects to be read as subsequent command input
318 but NOT including input method processing. */
319Lisp_Object Vunread_post_input_method_events;
320
86e5706b 321/* If not -1, an event to be read as subsequent command input. */
31ade731 322EMACS_INT unread_command_char;
86e5706b 323
cd21b839
JB
324/* If not Qnil, this is a switch-frame event which we decided to put
325 off until the end of a key sequence. This should be read as the
dbc4e1c1 326 next command input, after any unread_command_events.
8f805655
JB
327
328 read_key_sequence uses this to delay switch-frame events until the
329 end of the key sequence; Fread_char uses it to put off switch-frame
330 events until a non-ASCII event is acceptable as input. */
331Lisp_Object unread_switch_frame;
cd21b839 332
9fa4395d 333/* A mask of extra modifier bits to put into every keyboard char. */
31ade731 334EMACS_INT extra_keyboard_modifiers;
9fa4395d 335
284f4730
JB
336/* Char to use as prefix when a meta character is typed in.
337 This is bound on entry to minibuffer in case ESC is changed there. */
338
339Lisp_Object meta_prefix_char;
340
341/* Last size recorded for a current buffer which is not a minibuffer. */
342static int last_non_minibuf_size;
343
06ef7355 344/* Number of idle seconds before an auto-save and garbage collection. */
284f4730
JB
345static Lisp_Object Vauto_save_timeout;
346
347/* Total number of times read_char has returned. */
4abfba1f 348int num_input_events;
284f4730 349
51172b6d 350/* Total number of times read_char has returned, outside of macros. */
31ade731 351EMACS_INT num_nonmacro_input_events;
51172b6d 352
284f4730
JB
353/* Auto-save automatically when this many characters have been typed
354 since the last time. */
355
31ade731 356static EMACS_INT auto_save_interval;
284f4730 357
c43b1734 358/* Value of num_nonmacro_input_events as of last auto save. */
284f4730
JB
359
360int last_auto_save;
361
284f4730 362/* The command being executed by the command loop.
6c7178b9
KH
363 Commands may set this, and the value set will be copied into
364 current_kboard->Vlast_command instead of the actual command. */
d5eecefb
RS
365Lisp_Object Vthis_command;
366
367/* This is like Vthis_command, except that commands never set it. */
368Lisp_Object real_this_command;
284f4730 369
8b9940e6
KS
370/* If the lookup of the command returns a binding, the original
371 command is stored in this-original-command. It is nil otherwise. */
372Lisp_Object Vthis_original_command;
373
b453f72e
KH
374/* The value of point when the last command was executed. */
375int last_point_position;
376
047688cb
RS
377/* The buffer that was current when the last command was started. */
378Lisp_Object last_point_position_buffer;
379
4c52b668
KH
380/* The frame in which the last input event occurred, or Qmacro if the
381 last event came from a macro. We use this to determine when to
382 generate switch-frame events. This may be cleared by functions
383 like Fselect_frame, to make sure that a switch-frame event is
384 generated by the next character. */
385Lisp_Object internal_last_event_frame;
4c52b668
KH
386
387/* A user-visible version of the above, intended to allow users to
388 figure out where the last event came from, if the event doesn't
389 carry that information itself (i.e. if it was a character). */
390Lisp_Object Vlast_event_frame;
391
1113d9db
JB
392/* The timestamp of the last input event we received from the X server.
393 X Windows wants this for selection ownership. */
284f4730
JB
394unsigned long last_event_timestamp;
395
396Lisp_Object Qself_insert_command;
397Lisp_Object Qforward_char;
398Lisp_Object Qbackward_char;
e58aa385 399Lisp_Object Qundefined;
d925fb39 400Lisp_Object Qtimer_event_handler;
284f4730
JB
401
402/* read_key_sequence stores here the command definition of the
403 key sequence that it reads. */
404Lisp_Object read_key_sequence_cmd;
405
39aab679
DL
406/* Echo unfinished commands after this many seconds of pause. */
407Lisp_Object Vecho_keystrokes;
408
284f4730
JB
409/* Form to evaluate (if non-nil) when Emacs is started. */
410Lisp_Object Vtop_level;
411
a0acc6c7 412/* User-supplied table to translate input characters. */
284f4730
JB
413Lisp_Object Vkeyboard_translate_table;
414
415/* Keymap mapping ASCII function key sequences onto their preferred forms. */
416extern Lisp_Object Vfunction_key_map;
417
e0301c07
RS
418/* Another keymap that maps key sequences into key sequences.
419 This one takes precedence over ordinary definitions. */
420extern Lisp_Object Vkey_translation_map;
a612e298 421
7d18f9ae
RS
422/* If non-nil, this implements the current input method. */
423Lisp_Object Vinput_method_function;
424Lisp_Object Qinput_method_function;
425
d5eecefb
RS
426/* When we call Vinput_method_function,
427 this holds the echo area message that was just erased. */
428Lisp_Object Vinput_method_previous_message;
429
86e5706b
RS
430/* Non-nil means deactivate the mark at end of this command. */
431Lisp_Object Vdeactivate_mark;
432
48e416d4
RS
433/* Menu bar specified in Lucid Emacs fashion. */
434
435Lisp_Object Vlucid_menu_bar_dirty_flag;
436Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
437
cf24f894 438Lisp_Object Qecho_area_clear_hook;
cdb9d665 439
86e5706b 440/* Hooks to run before and after each command. */
59aadc81
RS
441Lisp_Object Qpre_command_hook, Vpre_command_hook;
442Lisp_Object Qpost_command_hook, Vpost_command_hook;
40932d1a 443Lisp_Object Qcommand_hook_internal, Vcommand_hook_internal;
59aadc81
RS
444/* Hook run after a command if there's no more input soon. */
445Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
446
447/* Delay time in microseconds before running post-command-idle-hook. */
31ade731 448EMACS_INT post_command_idle_delay;
86e5706b 449
8a792f3a
RS
450/* List of deferred actions to be performed at a later time.
451 The precise format isn't relevant here; we just check whether it is nil. */
452Lisp_Object Vdeferred_action_list;
453
454/* Function to call to handle deferred actions, when there are any. */
455Lisp_Object Vdeferred_action_function;
3ef14e46 456Lisp_Object Qdeferred_action_function;
8a792f3a 457
d5eecefb
RS
458Lisp_Object Qinput_method_exit_on_first_char;
459Lisp_Object Qinput_method_use_echo_area;
460
284f4730
JB
461/* File in which we write all commands we read. */
462FILE *dribble;
463
464/* Nonzero if input is available. */
465int input_pending;
466
b04904fb
RS
467/* 1 if should obey 0200 bit in input chars as "Meta", 2 if should
468 keep 0200 bit in input chars. 0 to ignore the 0200 bit. */
469
284f4730
JB
470int meta_key;
471
3626fb1a
GM
472/* Non-zero means force key bindings update in parse_menu_item. */
473
474int update_menu_bindings;
475
284f4730
JB
476extern char *pending_malloc_warning;
477
beecf6a1 478/* Circular buffer for pre-read keyboard input. */
da8f7368 479
beecf6a1
KH
480static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
481
da8f7368 482/* Vector to GCPRO the Lisp objects referenced from kbd_buffer.
beecf6a1
KH
483
484 The interrupt-level event handlers will never enqueue an event on a
485 frame which is not in Vframe_list, and once an event is dequeued,
486 internal_last_event_frame or the event itself points to the frame.
487 So that's all fine.
488
489 But while the event is sitting in the queue, it's completely
490 unprotected. Suppose the user types one command which will run for
491 a while and then delete a frame, and then types another event at
492 the frame that will be deleted, before the command gets around to
493 it. Suppose there are no references to this frame elsewhere in
494 Emacs, and a GC occurs before the second event is dequeued. Now we
495 have an event referring to a freed frame, which will crash Emacs
496 when it is dequeued.
497
498 Similar things happen when an event on a scroll bar is enqueued; the
499 window may be deleted while the event is in the queue.
500
da8f7368
GM
501 So, we use this vector to protect the Lisp_Objects in the event
502 queue. That way, they'll be dequeued as dead frames or windows,
503 but still valid Lisp objects.
beecf6a1 504
3b8f9651 505 If kbd_buffer[i].kind != NO_EVENT, then
da8f7368
GM
506
507 AREF (kbd_buffer_gcpro, 2 * i) == kbd_buffer[i].frame_or_window.
508 AREF (kbd_buffer_gcpro, 2 * i + 1) == kbd_buffer[i].arg. */
509
510static Lisp_Object kbd_buffer_gcpro;
beecf6a1
KH
511
512/* Pointer to next available character in kbd_buffer.
513 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
5cb6905d 514 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the
beecf6a1
KH
515 next available char is in kbd_buffer[0]. */
516static struct input_event *kbd_fetch_ptr;
517
518/* Pointer to next place to store character in kbd_buffer. This
519 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
520 character should go in kbd_buffer[0]. */
7ee32cda 521static struct input_event * volatile kbd_store_ptr;
beecf6a1
KH
522
523/* The above pair of variables forms a "queue empty" flag. When we
524 enqueue a non-hook event, we increment kbd_store_ptr. When we
525 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
526 there is input available iff the two pointers are not equal.
527
528 Why not just have a flag set and cleared by the enqueuing and
529 dequeuing functions? Such a flag could be screwed up by interrupts
530 at inopportune times. */
531
f3253854 532/* If this flag is non-nil, we check mouse_moved to see when the
a9d77f1f
RS
533 mouse moves, and motion events will appear in the input stream.
534 Otherwise, mouse motion is ignored. */
e10da507 535Lisp_Object do_mouse_tracking;
284f4730 536
284f4730
JB
537/* Symbols to head events. */
538Lisp_Object Qmouse_movement;
3c370943 539Lisp_Object Qscroll_bar_movement;
cd21b839 540Lisp_Object Qswitch_frame;
bbdc2092 541Lisp_Object Qdelete_frame;
af17bd2b
KH
542Lisp_Object Qiconify_frame;
543Lisp_Object Qmake_frame_visible;
a697f886 544Lisp_Object Qselect_window;
7ee32cda 545Lisp_Object Qhelp_echo;
cd21b839 546
284f4730
JB
547/* Symbols to denote kinds of events. */
548Lisp_Object Qfunction_key;
549Lisp_Object Qmouse_click;
742fbed7 550#ifdef WINDOWSNT
1161d367 551Lisp_Object Qlanguage_change;
07de30b9 552#endif
a24dc617 553Lisp_Object Qdrag_n_drop;
4ebc27a5
JD
554Lisp_Object Qsave_session;
555
284f4730 556/* Lisp_Object Qmouse_movement; - also an event header */
284f4730
JB
557
558/* Properties of event headers. */
559Lisp_Object Qevent_kind;
88cb0656 560Lisp_Object Qevent_symbol_elements;
284f4730 561
e8886a1d
RS
562/* menu item parts */
563Lisp_Object Qmenu_alias;
598a9fa7 564Lisp_Object Qmenu_enable;
74c1de23
RS
565Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCkeys, QCkey_sequence;
566Lisp_Object QCbutton, QCtoggle, QCradio;
e8886a1d
RS
567extern Lisp_Object Vdefine_key_rebound_commands;
568extern Lisp_Object Qmenu_item;
598a9fa7 569
0a7f1fc0
JB
570/* An event header symbol HEAD may have a property named
571 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
572 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
573 mask of modifiers applied to it. If present, this is used to help
574 speed up parse_modifiers. */
575Lisp_Object Qevent_symbol_element_mask;
576
577/* An unmodified event header BASE may have a property named
578 Qmodifier_cache, which is an alist mapping modifier masks onto
579 modified versions of BASE. If present, this helps speed up
580 apply_modifiers. */
581Lisp_Object Qmodifier_cache;
582
5ec75a55 583/* Symbols to use for parts of windows. */
284f4730 584Lisp_Object Qmode_line;
e5d77022 585Lisp_Object Qvertical_line;
3c370943 586Lisp_Object Qvertical_scroll_bar;
5ec75a55 587Lisp_Object Qmenu_bar;
7d60ad8a 588extern Lisp_Object Qleft_margin, Qright_margin;
3d566707 589extern Lisp_Object Qleft_fringe, Qright_fringe;
5ec75a55 590
f4255cd1
JB
591Lisp_Object recursive_edit_unwind (), command_loop ();
592Lisp_Object Fthis_command_keys ();
03b4122a 593Lisp_Object Qextended_command_history;
c04cbc3b 594EMACS_TIME timer_check ();
284f4730 595
a0acc6c7 596extern Lisp_Object Vhistory_length, Vtranslation_table_for_input;
f4385381 597
2c834fb3
KH
598extern char *x_get_keysym_name ();
599
8eb4d8ef 600static void record_menu_key ();
22b94eeb 601static int echo_length ();
8eb4d8ef 602
f4eef8b4
RS
603Lisp_Object Qpolling_period;
604
d9d4c147 605/* List of absolute timers. Appears in order of next scheduled event. */
c04cbc3b
RS
606Lisp_Object Vtimer_list;
607
d9d4c147
KH
608/* List of idle time timers. Appears in order of next scheduled event. */
609Lisp_Object Vtimer_idle_list;
610
87dd9b9b
RS
611/* Incremented whenever a timer is run. */
612int timers_run;
613
a9f16aa9
KH
614extern Lisp_Object Vprint_level, Vprint_length;
615
ffd56f97
JB
616/* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
617 happens. */
618EMACS_TIME *input_available_clear_time;
284f4730
JB
619
620/* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
621 Default is 1 if INTERRUPT_INPUT is defined. */
622int interrupt_input;
623
624/* Nonzero while interrupts are temporarily deferred during redisplay. */
625int interrupts_deferred;
626
87dd9b9b 627/* Nonzero means use ^S/^Q for flow control. */
284f4730
JB
628int flow_control;
629
284f4730
JB
630/* Allow m- file to inhibit use of FIONREAD. */
631#ifdef BROKEN_FIONREAD
632#undef FIONREAD
633#endif
634
635/* We are unable to use interrupts if FIONREAD is not available,
636 so flush SIGIO so we won't try. */
637#ifndef FIONREAD
638#ifdef SIGIO
639#undef SIGIO
640#endif
641#endif
642
e98a93eb 643/* If we support a window system, turn on the code to poll periodically
34f04431 644 to detect C-g. It isn't actually used when doing interrupt input. */
742fbed7 645#if defined(HAVE_WINDOW_SYSTEM) && !defined(USE_ASYNC_EVENTS)
284f4730
JB
646#define POLL_FOR_INPUT
647#endif
adf5cb9c
KH
648
649/* After a command is executed, if point is moved into a region that
650 has specific properties (e.g. composition, display), we adjust
651 point to the boundary of the region. But, if a command sets this
27fd22dc 652 variable to non-nil, we suppress this point adjustment. This
adf5cb9c 653 variable is set to nil before reading a command. */
da8f7368 654
adf5cb9c
KH
655Lisp_Object Vdisable_point_adjustment;
656
657/* If non-nil, always disable point adjustment. */
da8f7368 658
adf5cb9c
KH
659Lisp_Object Vglobal_disable_point_adjustment;
660
fdbb67fe
GM
661/* The time when Emacs started being idle. */
662
663static EMACS_TIME timer_idleness_start_time;
664
3021d3a9
RS
665/* After Emacs stops being idle, this saves the last value
666 of timer_idleness_start_time from when it was idle. */
667
668static EMACS_TIME timer_last_idleness_start_time;
669
284f4730
JB
670\f
671/* Global variable declarations. */
672
673/* Function for init_keyboard to call with no args (if nonzero). */
674void (*keyboard_init_hook) ();
675
0bbfdc25
GM
676static int read_avail_input P_ ((int));
677static void get_input_pending P_ ((int *, int));
20057d52 678static void get_filtered_input_pending P_ ((int *, int, int));
0bbfdc25 679static int readable_events P_ ((int));
20057d52 680static int readable_filtered_events P_ ((int, int));
0bbfdc25
GM
681static Lisp_Object read_char_x_menu_prompt P_ ((int, Lisp_Object *,
682 Lisp_Object, int *));
8150596a 683static Lisp_Object read_char_x_menu_prompt ();
0bbfdc25
GM
684static Lisp_Object read_char_minibuf_menu_prompt P_ ((int, int,
685 Lisp_Object *));
686static Lisp_Object make_lispy_event P_ ((struct input_event *));
514354e9 687#ifdef HAVE_MOUSE
0bbfdc25
GM
688static Lisp_Object make_lispy_movement P_ ((struct frame *, Lisp_Object,
689 enum scroll_bar_part,
690 Lisp_Object, Lisp_Object,
691 unsigned long));
514354e9 692#endif
0bbfdc25
GM
693static Lisp_Object modify_event_symbol P_ ((int, unsigned, Lisp_Object,
694 Lisp_Object, char **,
695 Lisp_Object *, unsigned));
696static Lisp_Object make_lispy_switch_frame P_ ((Lisp_Object));
697static int parse_solitary_modifier P_ ((Lisp_Object));
3d31316f 698static int parse_solitary_modifier ();
0bbfdc25 699static void save_getcjmp P_ ((jmp_buf));
dfcf069d 700static void save_getcjmp ();
0bbfdc25 701static void restore_getcjmp P_ ((jmp_buf));
7ee32cda 702static Lisp_Object apply_modifiers P_ ((int, Lisp_Object));
0bbfdc25 703static void clear_event P_ ((struct input_event *));
9ce50b1e 704static void any_kboard_state P_ ((void));
5598c32e 705static SIGTYPE interrupt_signal P_ ((int signalnum));
284f4730 706
8026024c
KH
707/* Nonzero means don't try to suspend even if the operating system seems
708 to support it. */
709static int cannot_suspend;
710
284f4730
JB
711/* Install the string STR as the beginning of the string of echoing,
712 so that it serves as a prompt for the next character.
713 Also start echoing. */
714
dfcf069d 715void
284f4730 716echo_prompt (str)
a4ef85ee 717 Lisp_Object str;
284f4730 718{
678e9d18 719 current_kboard->echo_string = str;
0d121f7c 720 current_kboard->echo_after_prompt = SCHARS (str);
3dbd9ee4 721 echo_now ();
284f4730
JB
722}
723
df0f2ba1 724/* Add C to the echo string, if echoing is going on.
284f4730
JB
725 C can be a character, which is printed prettily ("M-C-x" and all that
726 jazz), or a symbol, whose name is printed. */
727
dfcf069d 728void
284f4730
JB
729echo_char (c)
730 Lisp_Object c;
731{
c5fdd383 732 if (current_kboard->immediate_echo)
284f4730 733 {
678e9d18
GM
734 int size = KEY_DESCRIPTION_SIZE + 100;
735 char *buffer = (char *) alloca (size);
736 char *ptr = buffer;
737 Lisp_Object echo_string;
284f4730 738
0d121f7c 739 echo_string = current_kboard->echo_string;
c60ee5e7 740
284f4730 741 /* If someone has passed us a composite event, use its head symbol. */
88cb0656 742 c = EVENT_HEAD (c);
284f4730 743
8c18cbfb 744 if (INTEGERP (c))
284f4730 745 {
678e9d18 746 ptr = push_key_description (XINT (c), ptr, 1);
284f4730 747 }
8c18cbfb 748 else if (SYMBOLP (c))
284f4730 749 {
1b049b51
KR
750 Lisp_Object name = SYMBOL_NAME (c);
751 int nbytes = SBYTES (name);
c60ee5e7 752
0d121f7c 753 if (size - (ptr - buffer) < nbytes)
678e9d18
GM
754 {
755 int offset = ptr - buffer;
0d121f7c 756 size = max (2 * size, size + nbytes);
678e9d18
GM
757 buffer = (char *) alloca (size);
758 ptr = buffer + offset;
759 }
760
1b049b51
KR
761 ptr += copy_text (SDATA (name), ptr, nbytes,
762 STRING_MULTIBYTE (name), 1);
284f4730
JB
763 }
764
0d121f7c 765 if ((NILP (echo_string) || SCHARS (echo_string) == 0)
ecb7cb34 766 && help_char_p (c))
284f4730 767 {
678e9d18
GM
768 const char *text = " (Type ? for further options)";
769 int len = strlen (text);
c60ee5e7 770
678e9d18
GM
771 if (size - (ptr - buffer) < len)
772 {
773 int offset = ptr - buffer;
774 size += len;
775 buffer = (char *) alloca (size);
776 ptr = buffer + offset;
777 }
778
779 bcopy (text, ptr, len);
780 ptr += len;
284f4730
JB
781 }
782
0d121f7c
GM
783 /* Replace a dash from echo_dash with a space, otherwise
784 add a space at the end as a separator between keys. */
678e9d18 785 if (STRINGP (echo_string)
2ff4d3d9 786 && SCHARS (echo_string) > 1)
0d121f7c 787 {
2ff4d3d9
RS
788 Lisp_Object last_char, prev_char, idx;
789
790 idx = make_number (SCHARS (echo_string) - 2);
791 prev_char = Faref (echo_string, idx);
0d121f7c
GM
792
793 idx = make_number (SCHARS (echo_string) - 1);
794 last_char = Faref (echo_string, idx);
795
2ff4d3d9
RS
796 /* We test PREV_CHAR to make sure this isn't the echoing
797 of a minus-sign. */
798 if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
0d121f7c
GM
799 Faset (echo_string, idx, make_number (' '));
800 else
801 echo_string = concat2 (echo_string, build_string (" "));
802 }
678e9d18
GM
803
804 current_kboard->echo_string
805 = concat2 (echo_string, make_string (buffer, ptr - buffer));
284f4730 806
3dbd9ee4 807 echo_now ();
284f4730
JB
808 }
809}
810
811/* Temporarily add a dash to the end of the echo string if it's not
812 empty, so that it serves as a mini-prompt for the very next character. */
813
dfcf069d 814void
284f4730
JB
815echo_dash ()
816{
678e9d18
GM
817 /* Do nothing if not echoing at all. */
818 if (NILP (current_kboard->echo_string))
819 return;
820
c5fdd383 821 if (!current_kboard->immediate_echo
0d121f7c 822 && SCHARS (current_kboard->echo_string) == 0)
284f4730 823 return;
c60ee5e7 824
7a80a6f6 825 /* Do nothing if we just printed a prompt. */
c5fdd383 826 if (current_kboard->echo_after_prompt
0d121f7c 827 == SCHARS (current_kboard->echo_string))
4bafa972 828 return;
c60ee5e7 829
284f4730
JB
830 /* Put a dash at the end of the buffer temporarily,
831 but make it go away when the next character is added. */
678e9d18
GM
832 current_kboard->echo_string = concat2 (current_kboard->echo_string,
833 build_string ("-"));
3dbd9ee4 834 echo_now ();
284f4730
JB
835}
836
837/* Display the current echo string, and begin echoing if not already
838 doing so. */
839
07a59269 840void
3dbd9ee4 841echo_now ()
284f4730 842{
c5fdd383 843 if (!current_kboard->immediate_echo)
284f4730
JB
844 {
845 int i;
c5fdd383 846 current_kboard->immediate_echo = 1;
284f4730
JB
847
848 for (i = 0; i < this_command_key_count; i++)
d0a57728
RS
849 {
850 Lisp_Object c;
22b94eeb
RS
851
852 /* Set before_command_echo_length to the value that would
853 have been saved before the start of this subcommand in
854 command_loop_1, if we had already been echoing then. */
855 if (i == this_single_command_key_start)
856 before_command_echo_length = echo_length ();
857
d0a57728
RS
858 c = XVECTOR (this_command_keys)->contents[i];
859 if (! (EVENT_HAS_PARAMETERS (c)
860 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
861 echo_char (c);
862 }
22b94eeb
RS
863
864 /* Set before_command_echo_length to the value that would
865 have been saved before the start of this subcommand in
866 command_loop_1, if we had already been echoing then. */
867 if (this_command_key_count == this_single_command_key_start)
868 before_command_echo_length = echo_length ();
869
870 /* Put a dash at the end to invite the user to type more. */
284f4730
JB
871 echo_dash ();
872 }
873
874 echoing = 1;
678e9d18 875 message3_nolog (current_kboard->echo_string,
0d121f7c 876 SBYTES (current_kboard->echo_string),
d5db4077 877 STRING_MULTIBYTE (current_kboard->echo_string));
284f4730
JB
878 echoing = 0;
879
59a84f8e
GM
880 /* Record in what buffer we echoed, and from which kboard. */
881 echo_message_buffer = echo_area_buffer[0];
882 echo_kboard = current_kboard;
883
284f4730
JB
884 if (waiting_for_input && !NILP (Vquit_flag))
885 quit_throw_to_read_char ();
886}
887
888/* Turn off echoing, for the start of a new command. */
889
dfcf069d 890void
284f4730
JB
891cancel_echoing ()
892{
c5fdd383 893 current_kboard->immediate_echo = 0;
c5fdd383 894 current_kboard->echo_after_prompt = -1;
678e9d18 895 current_kboard->echo_string = Qnil;
59a84f8e
GM
896 ok_to_echo_at_next_pause = NULL;
897 echo_kboard = NULL;
898 echo_message_buffer = Qnil;
284f4730
JB
899}
900
901/* Return the length of the current echo string. */
902
903static int
904echo_length ()
905{
678e9d18 906 return (STRINGP (current_kboard->echo_string)
0d121f7c 907 ? SCHARS (current_kboard->echo_string)
678e9d18 908 : 0);
284f4730
JB
909}
910
911/* Truncate the current echo message to its first LEN chars.
912 This and echo_char get used by read_key_sequence when the user
ff11dfa1 913 switches frames while entering a key sequence. */
284f4730
JB
914
915static void
678e9d18
GM
916echo_truncate (nchars)
917 int nchars;
918{
919 if (STRINGP (current_kboard->echo_string))
920 current_kboard->echo_string
921 = Fsubstring (current_kboard->echo_string,
922 make_number (0), make_number (nchars));
923 truncate_echo_area (nchars);
284f4730
JB
924}
925
926\f
927/* Functions for manipulating this_command_keys. */
928static void
929add_command_key (key)
930 Lisp_Object key;
931{
22b94eeb
RS
932#if 0 /* Not needed after we made Freset_this_command_lengths
933 do the job immediately. */
71918b75
RS
934 /* If reset-this-command-length was called recently, obey it now.
935 See the doc string of that function for an explanation of why. */
936 if (before_command_restore_flag)
937 {
938 this_command_key_count = before_command_key_count_1;
6321824f
RS
939 if (this_command_key_count < this_single_command_key_start)
940 this_single_command_key_start = this_command_key_count;
71918b75
RS
941 echo_truncate (before_command_echo_length_1);
942 before_command_restore_flag = 0;
943 }
22b94eeb 944#endif
71918b75 945
f4e05d97
GM
946 if (this_command_key_count >= ASIZE (this_command_keys))
947 this_command_keys = larger_vector (this_command_keys,
948 2 * ASIZE (this_command_keys),
949 Qnil);
6569cc8d 950
f4e05d97
GM
951 AREF (this_command_keys, this_command_key_count) = key;
952 ++this_command_key_count;
284f4730 953}
f4e05d97 954
284f4730
JB
955\f
956Lisp_Object
957recursive_edit_1 ()
958{
aed13378 959 int count = SPECPDL_INDEX ();
284f4730
JB
960 Lisp_Object val;
961
962 if (command_loop_level > 0)
963 {
964 specbind (Qstandard_output, Qt);
965 specbind (Qstandard_input, Qt);
966 }
967
84265027 968#ifdef HAVE_X_WINDOWS
526a058f 969 /* The command loop has started an hourglass timer, so we have to
84265027 970 cancel it here, otherwise it will fire because the recursive edit
d8e2d5ba
PJ
971 can take some time. Do not check for display_hourglass_p here,
972 because it could already be nil. */
526a058f 973 cancel_hourglass ();
84265027
GM
974#endif
975
980a2d69
GM
976 /* This function may have been called from a debugger called from
977 within redisplay, for instance by Edebugging a function called
978 from fontification-functions. We want to allow redisplay in
979 the debugging session.
980
981 The recursive edit is left with a `(throw exit ...)'. The `exit'
982 tag is not caught anywhere in redisplay, i.e. when we leave the
983 recursive edit, the original redisplay leading to the recursive
984 edit will be unwound. The outcome should therefore be safe. */
985 specbind (Qinhibit_redisplay, Qnil);
986 redisplaying_p = 0;
987
284f4730
JB
988 val = command_loop ();
989 if (EQ (val, Qt))
990 Fsignal (Qquit, Qnil);
cb252880
RS
991 /* Handle throw from read_minibuf when using minibuffer
992 while it's active but we're in another window. */
993 if (STRINGP (val))
994 Fsignal (Qerror, Fcons (val, Qnil));
284f4730 995
cb5df6ae 996 return unbind_to (count, Qnil);
284f4730
JB
997}
998
999/* When an auto-save happens, record the "time", and don't do again soon. */
5846638c 1000
07a59269 1001void
284f4730
JB
1002record_auto_save ()
1003{
c43b1734 1004 last_auto_save = num_nonmacro_input_events;
284f4730 1005}
5846638c
RS
1006
1007/* Make an auto save happen as soon as possible at command level. */
1008
dfcf069d 1009void
5846638c
RS
1010force_auto_save_soon ()
1011{
1012 last_auto_save = - auto_save_interval - 1;
241ceaf7
RS
1013
1014 record_asynch_buffer_change ();
5846638c 1015}
284f4730 1016\f
284f4730 1017DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
4707d2d0
PJ
1018 doc: /* Invoke the editor command loop recursively.
1019To get out of the recursive edit, a command can do `(throw 'exit nil)';
1020that tells this function to return.
1021Alternately, `(throw 'exit t)' makes this function signal an error.
1022This function is called by the editor initialization to begin editing. */)
1023 ()
284f4730 1024{
aed13378 1025 int count = SPECPDL_INDEX ();
9ce50b1e 1026 Lisp_Object buffer;
284f4730
JB
1027
1028 command_loop_level++;
1029 update_mode_lines = 1;
1030
9ce50b1e
GM
1031 if (command_loop_level
1032 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
1033 buffer = Fcurrent_buffer ();
1034 else
1035 buffer = Qnil;
1036
1037 /* If we leave recursive_edit_1 below with a `throw' for instance,
1038 like it is done in the splash screen display, we have to
1039 make sure that we restore single_kboard as command_loop_1
1040 would have done if it were left normally. */
284f4730 1041 record_unwind_protect (recursive_edit_unwind,
9ce50b1e
GM
1042 Fcons (buffer, single_kboard ? Qt : Qnil));
1043
284f4730
JB
1044 recursive_edit_1 ();
1045 return unbind_to (count, Qnil);
1046}
1047
1048Lisp_Object
9ce50b1e
GM
1049recursive_edit_unwind (info)
1050 Lisp_Object info;
284f4730 1051{
9ce50b1e
GM
1052 if (BUFFERP (XCAR (info)))
1053 Fset_buffer (XCAR (info));
c60ee5e7 1054
9ce50b1e
GM
1055 if (NILP (XCDR (info)))
1056 any_kboard_state ();
1057 else
1058 single_kboard_state ();
c60ee5e7 1059
284f4730
JB
1060 command_loop_level--;
1061 update_mode_lines = 1;
1062 return Qnil;
1063}
9ce50b1e 1064
284f4730 1065\f
604ccd1d 1066static void
1e8bd3da 1067any_kboard_state ()
604ccd1d 1068{
1e8bd3da
RS
1069#ifdef MULTI_KBOARD
1070#if 0 /* Theory: if there's anything in Vunread_command_events,
1071 it will right away be read by read_key_sequence,
1072 and then if we do switch KBOARDS, it will go into the side
1073 queue then. So we don't need to do anything special here -- rms. */
604ccd1d 1074 if (CONSP (Vunread_command_events))
4524b161 1075 {
c5fdd383
KH
1076 current_kboard->kbd_queue
1077 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
1078 current_kboard->kbd_queue_has_data = 1;
4524b161 1079 }
604ccd1d 1080 Vunread_command_events = Qnil;
1e8bd3da
RS
1081#endif
1082 single_kboard = 0;
1083#endif
604ccd1d 1084}
1e8bd3da
RS
1085
1086/* Switch to the single-kboard state, making current_kboard
1087 the only KBOARD from which further input is accepted. */
1088
1089void
1090single_kboard_state ()
1091{
1092#ifdef MULTI_KBOARD
1093 single_kboard = 1;
604ccd1d 1094#endif
1e8bd3da
RS
1095}
1096
1097/* Maintain a stack of kboards, so other parts of Emacs
1098 can switch temporarily to the kboard of a given frame
1099 and then revert to the previous status. */
1100
1101struct kboard_stack
1102{
1103 KBOARD *kboard;
1104 struct kboard_stack *next;
1105};
1106
1107static struct kboard_stack *kboard_stack;
1108
1109void
1110push_frame_kboard (f)
1111 FRAME_PTR f;
1112{
ab48365b 1113#ifdef MULTI_KBOARD
1e8bd3da
RS
1114 struct kboard_stack *p
1115 = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
1116
1117 p->next = kboard_stack;
1118 p->kboard = current_kboard;
1119 kboard_stack = p;
1120
1121 current_kboard = FRAME_KBOARD (f);
ab48365b 1122#endif
1e8bd3da
RS
1123}
1124
1125void
1126pop_frame_kboard ()
1127{
ab48365b 1128#ifdef MULTI_KBOARD
1e8bd3da
RS
1129 struct kboard_stack *p = kboard_stack;
1130 current_kboard = p->kboard;
1131 kboard_stack = p->next;
1132 xfree (p);
ab48365b 1133#endif
1e8bd3da
RS
1134}
1135\f
1136/* Handle errors that are not handled at inner levels
1137 by printing an error message and returning to the editor command loop. */
604ccd1d 1138
284f4730
JB
1139Lisp_Object
1140cmd_error (data)
1141 Lisp_Object data;
a1341f75 1142{
a9f16aa9 1143 Lisp_Object old_level, old_length;
e881d8b2
RS
1144 char macroerror[50];
1145
160552c5
RS
1146#ifdef HAVE_X_WINDOWS
1147 if (display_hourglass_p)
1148 cancel_hourglass ();
1149#endif
1150
e881d8b2
RS
1151 if (!NILP (executing_macro))
1152 {
1153 if (executing_macro_iterations == 1)
1154 sprintf (macroerror, "After 1 kbd macro iteration: ");
1155 else
1156 sprintf (macroerror, "After %d kbd macro iterations: ",
1157 executing_macro_iterations);
1158 }
1159 else
1160 *macroerror = 0;
a9f16aa9 1161
a1341f75
RS
1162 Vstandard_output = Qt;
1163 Vstandard_input = Qt;
1164 Vexecuting_macro = Qnil;
9f58e89e 1165 executing_macro = Qnil;
d8bcf58e 1166 current_kboard->Vprefix_arg = Qnil;
75045dcb 1167 current_kboard->Vlast_prefix_arg = Qnil;
df0f2ba1 1168 cancel_echoing ();
a9f16aa9
KH
1169
1170 /* Avoid unquittable loop if data contains a circular list. */
1171 old_level = Vprint_level;
1172 old_length = Vprint_length;
0c04a67e
RS
1173 XSETFASTINT (Vprint_level, 10);
1174 XSETFASTINT (Vprint_length, 10);
e881d8b2 1175 cmd_error_internal (data, macroerror);
a9f16aa9
KH
1176 Vprint_level = old_level;
1177 Vprint_length = old_length;
a1341f75
RS
1178
1179 Vquit_flag = Qnil;
1180
1181 Vinhibit_quit = Qnil;
c5fdd383 1182#ifdef MULTI_KBOARD
1e8bd3da 1183 any_kboard_state ();
ff4b06d3 1184#endif
a1341f75
RS
1185
1186 return make_number (0);
1187}
1188
301738ed
RS
1189/* Take actions on handling an error. DATA is the data that describes
1190 the error.
1191
1192 CONTEXT is a C-string containing ASCII characters only which
1193 describes the context in which the error happened. If we need to
1194 generalize CONTEXT to allow multibyte characters, make it a Lisp
1195 string. */
1196
07a59269 1197void
a1341f75
RS
1198cmd_error_internal (data, context)
1199 Lisp_Object data;
1200 char *context;
284f4730 1201{
284f4730 1202 Lisp_Object stream;
7ee32cda 1203 int kill_emacs_p = 0;
788f89eb 1204 struct frame *sf = SELECTED_FRAME ();
284f4730
JB
1205
1206 Vquit_flag = Qnil;
1207 Vinhibit_quit = Qt;
985f9f66 1208 clear_message (1, 0);
284f4730 1209
ff11dfa1 1210 /* If the window system or terminal frame hasn't been initialized
284f4730
JB
1211 yet, or we're not interactive, it's best to dump this message out
1212 to stderr and exit. */
788f89eb 1213 if (!sf->glyphs_initialized_p
7ee32cda
GM
1214 /* This is the case of the frame dumped with Emacs, when we're
1215 running under a window system. */
1216 || (!NILP (Vwindow_system)
1217 && !inhibit_window_system
788f89eb 1218 && FRAME_TERMCAP_P (sf))
284f4730 1219 || noninteractive)
7ee32cda
GM
1220 {
1221 stream = Qexternal_debugging_output;
1222 kill_emacs_p = 1;
1223 }
284f4730
JB
1224 else
1225 {
1226 Fdiscard_input ();
dc4854ce 1227 message_log_maybe_newline ();
284f4730
JB
1228 bitch_at_user ();
1229 stream = Qt;
1230 }
1231
dc4854ce
RS
1232 /* The immediate context is not interesting for Quits,
1233 since they are asyncronous. */
1234 if (EQ (XCAR (data), Qquit))
1235 Vsignaling_function = Qnil;
c60ee5e7 1236
dc4854ce 1237 print_error_message (data, stream, context, Vsignaling_function);
a1341f75 1238
dc4854ce 1239 Vsignaling_function = Qnil;
284f4730 1240
ff11dfa1 1241 /* If the window system or terminal frame hasn't been initialized
284f4730 1242 yet, or we're in -batch mode, this error should cause Emacs to exit. */
7ee32cda 1243 if (kill_emacs_p)
284f4730
JB
1244 {
1245 Fterpri (stream);
1246 Fkill_emacs (make_number (-1));
1247 }
284f4730
JB
1248}
1249\f
1250Lisp_Object command_loop_1 ();
1251Lisp_Object command_loop_2 ();
1252Lisp_Object top_level_1 ();
1253
1254/* Entry to editor-command-loop.
1255 This level has the catches for exiting/returning to editor command loop.
1256 It returns nil to exit recursive edit, t to abort it. */
1257
1258Lisp_Object
1259command_loop ()
1260{
1261 if (command_loop_level > 0 || minibuf_level > 0)
1262 {
07ba902e
RS
1263 Lisp_Object val;
1264 val = internal_catch (Qexit, command_loop_2, Qnil);
68c46464
RS
1265 executing_macro = Qnil;
1266 return val;
284f4730
JB
1267 }
1268 else
1269 while (1)
1270 {
1271 internal_catch (Qtop_level, top_level_1, Qnil);
1272 internal_catch (Qtop_level, command_loop_2, Qnil);
68c46464 1273 executing_macro = Qnil;
df0f2ba1 1274
284f4730
JB
1275 /* End of file in -batch run causes exit here. */
1276 if (noninteractive)
1277 Fkill_emacs (Qt);
1278 }
1279}
1280
1281/* Here we catch errors in execution of commands within the
1282 editing loop, and reenter the editing loop.
1283 When there is an error, cmd_error runs and returns a non-nil
27fd22dc 1284 value to us. A value of nil means that command_loop_1 itself
284f4730
JB
1285 returned due to end of file (or end of kbd macro). */
1286
1287Lisp_Object
1288command_loop_2 ()
1289{
1290 register Lisp_Object val;
1291
1292 do
1293 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1294 while (!NILP (val));
1295
1296 return Qnil;
1297}
1298
1299Lisp_Object
1300top_level_2 ()
1301{
1302 return Feval (Vtop_level);
1303}
1304
1305Lisp_Object
1306top_level_1 ()
1307{
1308 /* On entry to the outer level, run the startup file */
1309 if (!NILP (Vtop_level))
1310 internal_condition_case (top_level_2, Qerror, cmd_error);
1311 else if (!NILP (Vpurify_flag))
1312 message ("Bare impure Emacs (standard Lisp code not loaded)");
1313 else
1314 message ("Bare Emacs (standard Lisp code not loaded)");
1315 return Qnil;
1316}
1317
1318DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
4707d2d0
PJ
1319 doc: /* Exit all recursive editing levels. */)
1320 ()
284f4730 1321{
2c9cf2c8 1322#ifdef HAVE_X_WINDOWS
526a058f
GM
1323 if (display_hourglass_p)
1324 cancel_hourglass ();
2c9cf2c8 1325#endif
8c907a56 1326 return Fthrow (Qtop_level, Qnil);
284f4730
JB
1327}
1328
1329DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
4707d2d0
PJ
1330 doc: /* Exit from the innermost recursive edit or minibuffer. */)
1331 ()
284f4730
JB
1332{
1333 if (command_loop_level > 0 || minibuf_level > 0)
1334 Fthrow (Qexit, Qnil);
1335
1336 error ("No recursive edit is in progress");
8c907a56 1337 return Qnil;
284f4730
JB
1338}
1339
1340DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
4707d2d0
PJ
1341 doc: /* Abort the command that requested this recursive edit or minibuffer input. */)
1342 ()
284f4730
JB
1343{
1344 if (command_loop_level > 0 || minibuf_level > 0)
1345 Fthrow (Qexit, Qt);
1346
1347 error ("No recursive edit is in progress");
8c907a56 1348 return Qnil;
284f4730
JB
1349}
1350\f
1351/* This is the actual command reading loop,
1352 sans error-handling encapsulation. */
1353
a7b772c1
GM
1354static int read_key_sequence P_ ((Lisp_Object *, int, Lisp_Object,
1355 int, int, int));
1356void safe_run_hooks P_ ((Lisp_Object));
2a026b04 1357static void adjust_point_for_property P_ ((int, int));
284f4730 1358
0af912f0
JD
1359/* Cancel hourglass from protect_unwind.
1360 ARG is not used. */
bb8db7e1 1361#ifdef HAVE_X_WINDOWS
0af912f0
JD
1362static Lisp_Object
1363cancel_hourglass_unwind (arg)
1364 Lisp_Object arg;
1365{
1366 cancel_hourglass ();
1367}
bb8db7e1 1368#endif
0af912f0 1369
284f4730
JB
1370Lisp_Object
1371command_loop_1 ()
1372{
03cee6ae
GM
1373 Lisp_Object cmd;
1374 int lose;
284f4730
JB
1375 int nonundocount;
1376 Lisp_Object keybuf[30];
1377 int i;
284f4730 1378 int no_direct;
86e5706b 1379 int prev_modiff;
8c907a56 1380 struct buffer *prev_buffer = NULL;
c5fdd383 1381#ifdef MULTI_KBOARD
1e8bd3da 1382 int was_locked = single_kboard;
bded54dd 1383#endif
2764bebd 1384 int already_adjusted;
284f4730 1385
d9b641bb 1386 current_kboard->Vprefix_arg = Qnil;
75045dcb 1387 current_kboard->Vlast_prefix_arg = Qnil;
86e5706b 1388 Vdeactivate_mark = Qnil;
284f4730 1389 waiting_for_input = 0;
df0f2ba1 1390 cancel_echoing ();
284f4730 1391
284f4730 1392 nonundocount = 0;
284f4730 1393 this_command_key_count = 0;
63020c46 1394 this_command_key_count_reset = 0;
6321824f 1395 this_single_command_key_start = 0;
284f4730 1396
325309f5 1397 if (NILP (Vmemory_full))
59aadc81 1398 {
10ffcb64
RS
1399 /* Make sure this hook runs after commands that get errors and
1400 throw to top level. */
1401 /* Note that the value cell will never directly contain nil
1402 if the symbol is a local variable. */
1403 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1404 safe_run_hooks (Qpost_command_hook);
1405
1406 /* If displaying a message, resize the echo area window to fit
1407 that message's size exactly. */
1408 if (!NILP (echo_area_buffer[0]))
1409 resize_echo_area_exactly ();
1410
1411 if (!NILP (Vdeferred_action_list))
1412 call0 (Vdeferred_action_function);
1413
1414 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1415 {
1416 if (NILP (Vunread_command_events)
1417 && NILP (Vunread_input_method_events)
1418 && NILP (Vunread_post_input_method_events)
1419 && NILP (Vexecuting_macro)
1420 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
1421 safe_run_hooks (Qpost_command_idle_hook);
1422 }
59aadc81
RS
1423 }
1424
10ffcb64
RS
1425 Vmemory_full = Qnil;
1426
51d5a2c9 1427 /* Do this after running Vpost_command_hook, for consistency. */
d5eecefb
RS
1428 current_kboard->Vlast_command = Vthis_command;
1429 current_kboard->Vreal_last_command = real_this_command;
51d5a2c9 1430
284f4730
JB
1431 while (1)
1432 {
788f89eb 1433 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
a94a4335
KH
1434 Fkill_emacs (Qnil);
1435
284f4730
JB
1436 /* Make sure the current window's buffer is selected. */
1437 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1438 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1439
1440 /* Display any malloc warning that just came out. Use while because
1441 displaying one warning can cause another. */
1442
1443 while (pending_malloc_warning)
1444 display_malloc_warning ();
1445
1446 no_direct = 0;
1447
86e5706b
RS
1448 Vdeactivate_mark = Qnil;
1449
284f4730 1450 /* If minibuffer on and echo area in use,
00392ce6 1451 wait a short time and redraw minibuffer. */
284f4730 1452
7ee32cda 1453 if (minibuf_level
985f9f66 1454 && !NILP (echo_area_buffer[0])
00392ce6
MB
1455 && EQ (minibuf_window, echo_area_window)
1456 && NUMBERP (Vminibuffer_message_timeout))
284f4730 1457 {
f1bed6d8
RS
1458 /* Bind inhibit-quit to t so that C-g gets read in
1459 rather than quitting back to the minibuffer. */
aed13378 1460 int count = SPECPDL_INDEX ();
f1bed6d8 1461 specbind (Qinhibit_quit, Qt);
f1bed6d8 1462
00392ce6 1463 Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil);
e6aa7813 1464 /* Clear the echo area. */
301738ed 1465 message2 (0, 0, 0);
cdb9d665 1466 safe_run_hooks (Qecho_area_clear_hook);
e6aa7813 1467
db08707d
RS
1468 unbind_to (count, Qnil);
1469
e6aa7813 1470 /* If a C-g came in before, treat it as input now. */
284f4730
JB
1471 if (!NILP (Vquit_flag))
1472 {
1473 Vquit_flag = Qnil;
24597608 1474 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
284f4730
JB
1475 }
1476 }
1477
1478#ifdef C_ALLOCA
ff4b06d3 1479 alloca (0); /* Cause a garbage collection now */
284f4730
JB
1480 /* Since we can free the most stuff here. */
1481#endif /* C_ALLOCA */
1482
8f805655 1483#if 0
8f805655
JB
1484 /* Select the frame that the last event came from. Usually,
1485 switch-frame events will take care of this, but if some lisp
1486 code swallows a switch-frame event, we'll fix things up here.
1487 Is this a good idea? */
8c18cbfb 1488 if (FRAMEP (internal_last_event_frame)
788f89eb 1489 && !EQ (internal_last_event_frame, selected_frame))
3c370943 1490 Fselect_frame (internal_last_event_frame, Qnil);
284f4730 1491#endif
48e416d4
RS
1492 /* If it has changed current-menubar from previous value,
1493 really recompute the menubar from the value. */
a646e520
RS
1494 if (! NILP (Vlucid_menu_bar_dirty_flag)
1495 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
48e416d4
RS
1496 call0 (Qrecompute_lucid_menubar);
1497
71918b75
RS
1498 before_command_key_count = this_command_key_count;
1499 before_command_echo_length = echo_length ();
1500
d5eecefb
RS
1501 Vthis_command = Qnil;
1502 real_this_command = Qnil;
d7437ef6 1503
8f805655 1504 /* Read next key sequence; i gets its length. */
ce98e608 1505 i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
f571ae0d 1506 Qnil, 0, 1, 1);
8f805655 1507
6fac1409 1508 /* A filter may have run while we were reading the input. */
788f89eb 1509 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
a94a4335 1510 Fkill_emacs (Qnil);
6fac1409
RS
1511 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1512 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1513
8f805655
JB
1514 ++num_input_keys;
1515
284f4730
JB
1516 /* Now we have read a key sequence of length I,
1517 or else I is 0 and we found end of file. */
1518
1519 if (i == 0) /* End of file -- happens only in */
1520 return Qnil; /* a kbd macro, at the end. */
dcc408a0
RS
1521 /* -1 means read_key_sequence got a menu that was rejected.
1522 Just loop around and read another command. */
1523 if (i == -1)
1524 {
1525 cancel_echoing ();
1526 this_command_key_count = 0;
63020c46 1527 this_command_key_count_reset = 0;
6321824f 1528 this_single_command_key_start = 0;
ff4b06d3 1529 goto finalize;
dcc408a0 1530 }
284f4730 1531
284f4730
JB
1532 last_command_char = keybuf[i - 1];
1533
75c0b143
RS
1534 /* If the previous command tried to force a specific window-start,
1535 forget about that, in case this command moves point far away
c422836d
KH
1536 from that position. But also throw away beg_unchanged and
1537 end_unchanged information in that case, so that redisplay will
1538 update the whole window properly. */
1539 if (!NILP (XWINDOW (selected_window)->force_start))
1540 {
9351ebd0 1541 struct buffer *b;
c422836d 1542 XWINDOW (selected_window)->force_start = Qnil;
9351ebd0
GM
1543 b = XBUFFER (XWINDOW (selected_window)->buffer);
1544 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
c422836d 1545 }
75c0b143 1546
284f4730
JB
1547 cmd = read_key_sequence_cmd;
1548 if (!NILP (Vexecuting_macro))
1549 {
1550 if (!NILP (Vquit_flag))
1551 {
1552 Vexecuting_macro = Qt;
1553 QUIT; /* Make some noise. */
1554 /* Will return since macro now empty. */
1555 }
1556 }
1557
1558 /* Do redisplay processing after this command except in special
e35b6123 1559 cases identified below. */
86e5706b
RS
1560 prev_buffer = current_buffer;
1561 prev_modiff = MODIFF;
8746da95 1562 last_point_position = PT;
18cd2eeb 1563 XSETBUFFER (last_point_position_buffer, prev_buffer);
86e5706b 1564
adf5cb9c
KH
1565 /* By default, we adjust point to a boundary of a region that
1566 has such a property that should be treated intangible
1567 (e.g. composition, display). But, some commands will set
1568 this variable differently. */
1569 Vdisable_point_adjustment = Qnil;
a7b772c1 1570
be2488ca
GM
1571 /* Process filters and timers may have messed with deactivate-mark.
1572 reset it before we execute the command. */
1573 Vdeactivate_mark = Qnil;
1574
8b9940e6
KS
1575 /* Remap command through active keymaps */
1576 Vthis_original_command = cmd;
a34cb674 1577 if (SYMBOLP (cmd))
8b9940e6
KS
1578 {
1579 Lisp_Object cmd1;
023b93f6 1580 if (cmd1 = Fcommand_remapping (cmd), !NILP (cmd1))
8b9940e6
KS
1581 cmd = cmd1;
1582 }
1583
284f4730
JB
1584 /* Execute the command. */
1585
d5eecefb
RS
1586 Vthis_command = cmd;
1587 real_this_command = cmd;
a98ea3f9
RS
1588 /* Note that the value cell will never directly contain nil
1589 if the symbol is a local variable. */
e98a93eb 1590 if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks))
a98ea3f9 1591 safe_run_hooks (Qpre_command_hook);
c60ee5e7 1592
2764bebd
RS
1593 already_adjusted = 0;
1594
d5eecefb 1595 if (NILP (Vthis_command))
284f4730
JB
1596 {
1597 /* nil means key is undefined. */
1598 bitch_at_user ();
c5fdd383 1599 current_kboard->defining_kbd_macro = Qnil;
284f4730 1600 update_mode_lines = 1;
d8bcf58e 1601 current_kboard->Vprefix_arg = Qnil;
284f4730
JB
1602 }
1603 else
1604 {
d8bcf58e 1605 if (NILP (current_kboard->Vprefix_arg) && ! no_direct)
284f4730 1606 {
75045dcb
RS
1607 /* In case we jump to directly_done. */
1608 Vcurrent_prefix_arg = current_kboard->Vprefix_arg;
1609
284f4730
JB
1610 /* Recognize some common commands in common situations and
1611 do them directly. */
d5eecefb 1612 if (EQ (Vthis_command, Qforward_char) && PT < ZV)
284f4730 1613 {
51ad8a68 1614 struct Lisp_Char_Table *dp
284f4730 1615 = window_display_table (XWINDOW (selected_window));
aaf35234 1616 lose = FETCH_CHAR (PT_BYTE);
8458ede6 1617 SET_PT (PT + 1);
d86ba5c5
RS
1618 if (! NILP (Vpost_command_hook))
1619 /* Put this before calling adjust_point_for_property
1620 so it will only get called once in any case. */
1621 goto directly_done;
22b94eeb
RS
1622 if (current_buffer == prev_buffer
1623 && last_point_position != PT
1624 && NILP (Vdisable_point_adjustment)
1625 && NILP (Vglobal_disable_point_adjustment))
1626 adjust_point_for_property (last_point_position, 0);
2764bebd
RS
1627 already_adjusted = 1;
1628 if (PT == last_point_position + 1
1629 && (dp
1630 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1631 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1632 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1633 && (lose >= 0x20 && lose < 0x7f)))
1634 : (lose >= 0x20 && lose < 0x7f))
37cd9f30
KH
1635 /* To extract the case of continuation on
1636 wide-column characters. */
8458ede6 1637 && (WIDTH_BY_CHAR_HEAD (FETCH_BYTE (PT_BYTE)) == 1)
284f4730
JB
1638 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1639 >= MODIFF)
598ba4c7
RS
1640 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1641 >= OVERLAY_MODIFF)
284f4730 1642 && (XFASTINT (XWINDOW (selected_window)->last_point)
8001d352 1643 == PT - 1)
284f4730
JB
1644 && !windows_or_buffers_changed
1645 && EQ (current_buffer->selective_display, Qnil)
1646 && !detect_input_pending ()
962ae636 1647 && NILP (XWINDOW (selected_window)->column_number_displayed)
284f4730 1648 && NILP (Vexecuting_macro))
e35b6123 1649 direct_output_forward_char (1);
284f4730
JB
1650 goto directly_done;
1651 }
d5eecefb 1652 else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV)
284f4730 1653 {
51ad8a68 1654 struct Lisp_Char_Table *dp
284f4730 1655 = window_display_table (XWINDOW (selected_window));
8458ede6 1656 SET_PT (PT - 1);
aaf35234 1657 lose = FETCH_CHAR (PT_BYTE);
d86ba5c5
RS
1658 if (! NILP (Vpost_command_hook))
1659 goto directly_done;
22b94eeb
RS
1660 if (current_buffer == prev_buffer
1661 && last_point_position != PT
1662 && NILP (Vdisable_point_adjustment)
1663 && NILP (Vglobal_disable_point_adjustment))
1664 adjust_point_for_property (last_point_position, 0);
2764bebd
RS
1665 already_adjusted = 1;
1666 if (PT == last_point_position - 1
1667 && (dp
1668 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1669 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1670 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1671 && (lose >= 0x20 && lose < 0x7f)))
1672 : (lose >= 0x20 && lose < 0x7f))
284f4730
JB
1673 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1674 >= MODIFF)
598ba4c7
RS
1675 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1676 >= OVERLAY_MODIFF)
284f4730 1677 && (XFASTINT (XWINDOW (selected_window)->last_point)
8001d352 1678 == PT + 1)
284f4730
JB
1679 && !windows_or_buffers_changed
1680 && EQ (current_buffer->selective_display, Qnil)
1681 && !detect_input_pending ()
962ae636 1682 && NILP (XWINDOW (selected_window)->column_number_displayed)
284f4730 1683 && NILP (Vexecuting_macro))
e35b6123 1684 direct_output_forward_char (-1);
284f4730
JB
1685 goto directly_done;
1686 }
d5eecefb 1687 else if (EQ (Vthis_command, Qself_insert_command)
14e40288
SM
1688 /* Try this optimization only on char keystrokes. */
1689 && NATNUMP (last_command_char)
1690 && CHAR_VALID_P (XFASTINT (last_command_char), 0))
284f4730 1691 {
d86ba5c5
RS
1692 unsigned int c
1693 = translate_char (Vtranslation_table_for_input,
1694 XFASTINT (last_command_char), 0, 0, 0);
fc9cce4e 1695 int value;
fc9cce4e
RS
1696 if (NILP (Vexecuting_macro)
1697 && !EQ (minibuf_window, selected_window))
284f4730
JB
1698 {
1699 if (!nonundocount || nonundocount >= 20)
1700 {
1701 Fundo_boundary ();
1702 nonundocount = 0;
1703 }
1704 nonundocount++;
1705 }
c60ee5e7 1706
fc9cce4e
RS
1707 lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
1708 < MODIFF)
598ba4c7
RS
1709 || (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1710 < OVERLAY_MODIFF)
fc9cce4e
RS
1711 || (XFASTINT (XWINDOW (selected_window)->last_point)
1712 != PT)
4c61f38e 1713 || MODIFF <= SAVE_MODIFF
fc9cce4e
RS
1714 || windows_or_buffers_changed
1715 || !EQ (current_buffer->selective_display, Qnil)
1716 || detect_input_pending ()
962ae636 1717 || !NILP (XWINDOW (selected_window)->column_number_displayed)
fc9cce4e 1718 || !NILP (Vexecuting_macro));
c60ee5e7 1719
fc9cce4e 1720 value = internal_self_insert (c, 0);
7ee32cda 1721
fc9cce4e
RS
1722 if (value == 2)
1723 nonundocount = 0;
1724
294d643a
RS
1725 if (! NILP (Vpost_command_hook))
1726 /* Put this before calling adjust_point_for_property
1727 so it will only get called once in any case. */
1728 goto directly_done;
1729
7ee32cda
GM
1730 /* VALUE == 1 when AFTER-CHANGE functions are
1731 installed which is the case most of the time
1732 because FONT-LOCK installs one. */
1733 if (!lose && !value)
e35b6123 1734 direct_output_for_insert (c);
284f4730
JB
1735 goto directly_done;
1736 }
1737 }
1738
1739 /* Here for a command that isn't executed directly */
1740
0af912f0 1741 {
7ee32cda 1742#ifdef HAVE_X_WINDOWS
0af912f0
JD
1743 int scount = SPECPDL_INDEX ();
1744
1745 if (display_hourglass_p
1746 && NILP (Vexecuting_macro))
1747 {
1748 record_unwind_protect (cancel_hourglass_unwind, Qnil);
1749 start_hourglass ();
1750 }
7ee32cda
GM
1751#endif
1752
0af912f0
JD
1753 nonundocount = 0;
1754 if (NILP (current_kboard->Vprefix_arg))
1755 Fundo_boundary ();
1756 Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
d0c48478
GM
1757
1758#ifdef HAVE_X_WINDOWS
4fbcc9b1
PJ
1759 /* Do not check display_hourglass_p here, because
1760 Fcommand_execute could change it, but we should cancel
e1204d39
RS
1761 hourglass cursor anyway.
1762 But don't cancel the hourglass within a macro
1763 just because a command in the macro finishes. */
1764 if (NILP (Vexecuting_macro))
0af912f0 1765 unbind_to (scount, Qnil);
d0c48478 1766#endif
0af912f0 1767 }
284f4730 1768 }
a764a753 1769 directly_done: ;
75045dcb 1770 current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg;
284f4730 1771
84ee6048
RS
1772 /* Note that the value cell will never directly contain nil
1773 if the symbol is a local variable. */
1774 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1775 safe_run_hooks (Qpost_command_hook);
1776
8f12e41d
GM
1777 /* If displaying a message, resize the echo area window to fit
1778 that message's size exactly. */
1779 if (!NILP (echo_area_buffer[0]))
f09c15ed 1780 resize_echo_area_exactly ();
8f12e41d 1781
84ee6048
RS
1782 if (!NILP (Vdeferred_action_list))
1783 safe_run_hooks (Qdeferred_action_function);
1784
1785 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1786 {
1787 if (NILP (Vunread_command_events)
7d18f9ae
RS
1788 && NILP (Vunread_input_method_events)
1789 && NILP (Vunread_post_input_method_events)
84ee6048
RS
1790 && NILP (Vexecuting_macro)
1791 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
1792 safe_run_hooks (Qpost_command_idle_hook);
1793 }
1794
284f4730 1795 /* If there is a prefix argument,
6c7178b9
KH
1796 1) We don't want Vlast_command to be ``universal-argument''
1797 (that would be dumb), so don't set Vlast_command,
284f4730
JB
1798 2) we want to leave echoing on so that the prefix will be
1799 echoed as part of this key sequence, so don't call
1800 cancel_echoing, and
1801 3) we want to leave this_command_key_count non-zero, so that
1802 read_char will realize that it is re-reading a character, and
217258d5
KH
1803 not echo it a second time.
1804
1805 If the command didn't actually create a prefix arg,
1806 but is merely a frame event that is transparent to prefix args,
1807 then the above doesn't apply. */
1808 if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_char))
284f4730 1809 {
d5eecefb
RS
1810 current_kboard->Vlast_command = Vthis_command;
1811 current_kboard->Vreal_last_command = real_this_command;
284f4730
JB
1812 cancel_echoing ();
1813 this_command_key_count = 0;
63020c46 1814 this_command_key_count_reset = 0;
6321824f 1815 this_single_command_key_start = 0;
284f4730 1816 }
86e5706b 1817
88ce066e 1818 if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks))
86e5706b
RS
1819 {
1820 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
1821 {
2e1a49ad
SM
1822 /* We could also call `deactivate'mark'. */
1823 if (EQ (Vtransient_mark_mode, Qlambda))
1824 Vtransient_mark_mode = Qnil;
1825 else
1826 {
1827 current_buffer->mark_active = Qnil;
1828 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
1829 }
86e5706b
RS
1830 }
1831 else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1832 call1 (Vrun_hooks, intern ("activate-mark-hook"));
1833 }
ff4b06d3
KH
1834
1835 finalize:
adf5cb9c
KH
1836
1837 if (current_buffer == prev_buffer
1838 && last_point_position != PT
1839 && NILP (Vdisable_point_adjustment)
2764bebd
RS
1840 && NILP (Vglobal_disable_point_adjustment)
1841 && !already_adjusted)
2a026b04 1842 adjust_point_for_property (last_point_position, MODIFF != prev_modiff);
adf5cb9c 1843
ff4b06d3
KH
1844 /* Install chars successfully executed in kbd macro. */
1845
d8bcf58e
KH
1846 if (!NILP (current_kboard->defining_kbd_macro)
1847 && NILP (current_kboard->Vprefix_arg))
ff4b06d3
KH
1848 finalize_kbd_macro_chars ();
1849
c5fdd383 1850#ifdef MULTI_KBOARD
604ccd1d 1851 if (!was_locked)
1e8bd3da 1852 any_kboard_state ();
ff4b06d3 1853#endif
284f4730
JB
1854 }
1855}
1c9784c9 1856
adf5cb9c
KH
1857extern Lisp_Object Qcomposition, Qdisplay;
1858
1859/* Adjust point to a boundary of a region that has such a property
1860 that should be treated intangible. For the moment, we check
7e16ef60
SM
1861 `composition', `display' and `invisible' properties.
1862 LAST_PT is the last position of point. */
adf5cb9c 1863
14e40288
SM
1864extern Lisp_Object Qafter_string, Qbefore_string;
1865extern Lisp_Object get_pos_property P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
1866
adf5cb9c 1867static void
2a026b04 1868adjust_point_for_property (last_pt, modified)
adf5cb9c 1869 int last_pt;
2a026b04 1870 int modified;
adf5cb9c 1871{
7e16ef60
SM
1872 int beg, end;
1873 Lisp_Object val, overlay, tmp;
1874 int check_composition = 1, check_display = 1, check_invisible = 1;
0bbdffbd 1875 int orig_pt = PT;
adf5cb9c 1876
0bbdffbd
SM
1877 /* FIXME: cycling is probably not necessary because these properties
1878 can't be usefully combined anyway. */
7e16ef60 1879 while (check_composition || check_display || check_invisible)
adf5cb9c
KH
1880 {
1881 if (check_composition
1882 && PT > BEGV && PT < ZV
7e16ef60
SM
1883 && get_property_and_range (PT, Qcomposition, &val, &beg, &end, Qnil)
1884 && COMPOSITION_VALID_P (beg, end, val)
1885 && beg < PT /* && end > PT <- It's always the case. */
1886 && (last_pt <= beg || last_pt >= end))
adf5cb9c 1887 {
14e40288 1888 xassert (end > PT);
7e16ef60 1889 SET_PT (PT < last_pt ? beg : end);
14e40288 1890 check_display = check_invisible = 1;
adf5cb9c
KH
1891 }
1892 check_composition = 0;
1893 if (check_display
1894 && PT > BEGV && PT < ZV
7e16ef60
SM
1895 && !NILP (val = get_char_property_and_overlay
1896 (make_number (PT), Qdisplay, Qnil, &overlay))
3e9ac4b7 1897 && display_prop_intangible_p (val)
7e16ef60
SM
1898 && (!OVERLAYP (overlay)
1899 ? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil)
1900 : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)),
1901 end = OVERLAY_POSITION (OVERLAY_END (overlay))))
14e40288 1902 && beg < PT) /* && end > PT <- It's always the case. */
adf5cb9c 1903 {
14e40288 1904 xassert (end > PT);
7e16ef60 1905 SET_PT (PT < last_pt ? beg : end);
14e40288 1906 check_composition = check_invisible = 1;
adf5cb9c
KH
1907 }
1908 check_display = 0;
14e40288 1909 if (check_invisible && PT > BEGV && PT < ZV)
7e16ef60 1910 {
14e40288
SM
1911 int inv, ellipsis = 0;
1912 beg = end = PT;
1913
1914 /* Find boundaries `beg' and `end' of the invisible area, if any. */
1915 while (end < ZV
1916 && !NILP (val = get_char_property_and_overlay
1917 (make_number (end), Qinvisible, Qnil, &overlay))
1918 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1919 {
1920 ellipsis = ellipsis || inv > 1
1921 || (OVERLAYP (overlay)
1922 && (!NILP (Foverlay_get (overlay, Qafter_string))
1923 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1924 tmp = Fnext_single_char_property_change
1925 (make_number (end), Qinvisible, Qnil, Qnil);
1926 end = NATNUMP (tmp) ? XFASTINT (tmp) : ZV;
1927 }
1928 while (beg > BEGV
1929 && !NILP (val = get_char_property_and_overlay
1930 (make_number (beg - 1), Qinvisible, Qnil, &overlay))
1931 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1932 {
1933 ellipsis = ellipsis || inv > 1
1934 || (OVERLAYP (overlay)
1935 && (!NILP (Foverlay_get (overlay, Qafter_string))
1936 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1937 tmp = Fprevious_single_char_property_change
1938 (make_number (beg), Qinvisible, Qnil, Qnil);
1939 beg = NATNUMP (tmp) ? XFASTINT (tmp) : BEGV;
1940 }
c60ee5e7 1941
14e40288
SM
1942 /* Move away from the inside area. */
1943 if (beg < PT && end > PT)
1944 {
0bbdffbd
SM
1945 SET_PT ((orig_pt == PT && (last_pt < beg || last_pt > end))
1946 /* We haven't moved yet (so we don't need to fear
1947 infinite-looping) and we were outside the range
1948 before (so either end of the range still corresponds
1949 to a move in the right direction): pretend we moved
1950 less than we actually did, so that we still have
1951 more freedom below in choosing which end of the range
1952 to go to. */
9465a86c 1953 ? (orig_pt = -1, PT < last_pt ? end : beg)
0bbdffbd
SM
1954 /* We either have moved already or the last point
1955 was already in the range: we don't get to choose
1956 which end of the range we have to go to. */
1957 : (PT < last_pt ? beg : end));
14e40288
SM
1958 check_composition = check_display = 1;
1959 }
1960 xassert (PT == beg || PT == end);
2a026b04
KH
1961 /* Pretend the area doesn't exist if the buffer is not
1962 modified. */
1963 if (!modified && !ellipsis && beg < end)
14e40288
SM
1964 {
1965 if (last_pt == beg && PT == end && end < ZV)
1966 (check_composition = check_display = 1, SET_PT (end + 1));
1967 else if (last_pt == end && PT == beg && beg > BEGV)
1968 (check_composition = check_display = 1, SET_PT (beg - 1));
1969 else if (PT == ((PT < last_pt) ? beg : end))
1970 /* We've already moved as far as we can. Trying to go
1971 to the other end would mean moving backwards and thus
1972 could lead to an infinite loop. */
1973 ;
1974 else if (val = get_pos_property (make_number (PT),
1975 Qinvisible, Qnil),
1976 TEXT_PROP_MEANS_INVISIBLE (val)
1977 && (val = get_pos_property
1978 (make_number (PT == beg ? end : beg),
1979 Qinvisible, Qnil),
1980 !TEXT_PROP_MEANS_INVISIBLE (val)))
1981 (check_composition = check_display = 1,
1982 SET_PT (PT == beg ? end : beg));
1983 }
7e16ef60
SM
1984 }
1985 check_invisible = 0;
adf5cb9c
KH
1986 }
1987}
1988
0bc3db2b
RS
1989/* Subroutine for safe_run_hooks: run the hook HOOK. */
1990
1991static Lisp_Object
1992safe_run_hooks_1 (hook)
1993 Lisp_Object hook;
1994{
1995 return call1 (Vrun_hooks, Vinhibit_quit);
1996}
1997
1998/* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */
1999
2000static Lisp_Object
2001safe_run_hooks_error (data)
2002 Lisp_Object data;
2003{
adec392e
SM
2004 Lisp_Object args[3];
2005 args[0] = build_string ("Error in %s: %s");
2006 args[1] = Vinhibit_quit;
2007 args[2] = data;
2008 Fmessage (3, args);
30690496 2009 return Fset (Vinhibit_quit, Qnil);
0bc3db2b
RS
2010}
2011
1c9784c9
KH
2012/* If we get an error while running the hook, cause the hook variable
2013 to be nil. Also inhibit quits, so that C-g won't cause the hook
2014 to mysteriously evaporate. */
0bc3db2b 2015
68f297c5 2016void
1c9784c9 2017safe_run_hooks (hook)
a98ea3f9 2018 Lisp_Object hook;
1c9784c9 2019{
aed13378 2020 int count = SPECPDL_INDEX ();
0bc3db2b
RS
2021 specbind (Qinhibit_quit, hook);
2022
e702932d 2023 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
1c9784c9
KH
2024
2025 unbind_to (count, Qnil);
2026}
8a9f5d3c 2027
284f4730 2028\f
8a9f5d3c
GM
2029/* Number of seconds between polling for input. This is a Lisp
2030 variable that can be bound. */
2031
31ade731 2032EMACS_INT polling_period;
284f4730 2033
eb8c3be9 2034/* Nonzero means polling for input is temporarily suppressed. */
8a9f5d3c 2035
284f4730
JB
2036int poll_suppress_count;
2037
8a9f5d3c
GM
2038/* Asynchronous timer for polling. */
2039
2040struct atimer *poll_timer;
2041
284f4730 2042
36922b18
RS
2043#ifdef POLL_FOR_INPUT
2044
8a9f5d3c
GM
2045/* Poll for input, so what we catch a C-g if it comes in. This
2046 function is called from x_make_frame_visible, see comment
2047 there. */
284f4730 2048
8a9f5d3c
GM
2049void
2050poll_for_input_1 ()
284f4730 2051{
9ac0d9e0
JB
2052 if (interrupt_input_blocked == 0
2053 && !waiting_for_input)
2054 read_avail_input (0);
284f4730
JB
2055}
2056
8a9f5d3c
GM
2057/* Timer callback function for poll_timer. TIMER is equal to
2058 poll_timer. */
2059
2060void
2061poll_for_input (timer)
2062 struct atimer *timer;
2063{
2064 if (poll_suppress_count == 0)
2065 poll_for_input_1 ();
2066}
2067
2068#endif /* POLL_FOR_INPUT */
284f4730
JB
2069
2070/* Begin signals to poll for input, if they are appropriate.
2071 This function is called unconditionally from various places. */
2072
07a59269 2073void
284f4730
JB
2074start_polling ()
2075{
2076#ifdef POLL_FOR_INPUT
34f04431 2077 if (read_socket_hook && !interrupt_input)
284f4730 2078 {
8a9f5d3c
GM
2079 /* Turn alarm handling on unconditionally. It might have
2080 been turned off in process.c. */
2081 turn_on_atimers (1);
c60ee5e7 2082
8a9f5d3c
GM
2083 /* If poll timer doesn't exist, are we need one with
2084 a different interval, start a new one. */
2085 if (poll_timer == NULL
2086 || EMACS_SECS (poll_timer->interval) != polling_period)
284f4730 2087 {
8a9f5d3c
GM
2088 EMACS_TIME interval;
2089
2090 if (poll_timer)
2091 cancel_atimer (poll_timer);
c60ee5e7 2092
8a9f5d3c
GM
2093 EMACS_SET_SECS_USECS (interval, polling_period, 0);
2094 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
2095 poll_for_input, NULL);
284f4730 2096 }
8a9f5d3c
GM
2097
2098 /* Let the timer's callback function poll for input
2099 if this becomes zero. */
2100 --poll_suppress_count;
284f4730
JB
2101 }
2102#endif
2103}
2104
1d3195db
RS
2105/* Nonzero if we are using polling to handle input asynchronously. */
2106
2107int
2108input_polling_used ()
2109{
2110#ifdef POLL_FOR_INPUT
2111 return read_socket_hook && !interrupt_input;
2112#else
2113 return 0;
2114#endif
2115}
2116
284f4730
JB
2117/* Turn off polling. */
2118
07a59269 2119void
284f4730
JB
2120stop_polling ()
2121{
2122#ifdef POLL_FOR_INPUT
34f04431 2123 if (read_socket_hook && !interrupt_input)
8a9f5d3c 2124 ++poll_suppress_count;
284f4730
JB
2125#endif
2126}
fe8aeef3
RS
2127
2128/* Set the value of poll_suppress_count to COUNT
2129 and start or stop polling accordingly. */
2130
2131void
2132set_poll_suppress_count (count)
2133 int count;
2134{
2135#ifdef POLL_FOR_INPUT
2136 if (count == 0 && poll_suppress_count != 0)
2137 {
2138 poll_suppress_count = 1;
2139 start_polling ();
2140 }
2141 else if (count != 0 && poll_suppress_count == 0)
2142 {
2143 stop_polling ();
2144 }
2145 poll_suppress_count = count;
2146#endif
2147}
f4eef8b4 2148
d0a57728
RS
2149/* Bind polling_period to a value at least N.
2150 But don't decrease it. */
2151
07a59269 2152void
f4eef8b4
RS
2153bind_polling_period (n)
2154 int n;
2155{
2156#ifdef POLL_FOR_INPUT
d0a57728
RS
2157 int new = polling_period;
2158
2159 if (n > new)
2160 new = n;
2161
6fe007f7 2162 stop_other_atimers (poll_timer);
f4eef8b4 2163 stop_polling ();
d0a57728
RS
2164 specbind (Qpolling_period, make_number (new));
2165 /* Start a new alarm with the new period. */
f4eef8b4
RS
2166 start_polling ();
2167#endif
2168}
284f4730 2169\f
6da3dd3a
RS
2170/* Apply the control modifier to CHARACTER. */
2171
faf5e407
JB
2172int
2173make_ctrl_char (c)
2174 int c;
2175{
d205953b
JB
2176 /* Save the upper bits here. */
2177 int upper = c & ~0177;
2178
2179 c &= 0177;
2180
2181 /* Everything in the columns containing the upper-case letters
2182 denotes a control character. */
2183 if (c >= 0100 && c < 0140)
2184 {
2185 int oc = c;
2186 c &= ~0140;
2187 /* Set the shift modifier for a control char
2188 made from a shifted letter. But only for letters! */
2189 if (oc >= 'A' && oc <= 'Z')
2190 c |= shift_modifier;
2191 }
2192
2193 /* The lower-case letters denote control characters too. */
2194 else if (c >= 'a' && c <= 'z')
2195 c &= ~0140;
2196
2197 /* Include the bits for control and shift
2198 only if the basic ASCII code can't indicate them. */
2199 else if (c >= ' ')
2200 c |= ctrl_modifier;
2201
2202 /* Replace the high bits. */
2203 c |= (upper & ~ctrl_modifier);
faf5e407
JB
2204
2205 return c;
2206}
2207
d4e68eea
GM
2208/* Display help echo in the echo area.
2209
8dfd92c9
GM
2210 HELP a string means display that string, HELP nil means clear the
2211 help echo. If HELP is a function, call it with OBJECT and POS as
2212 arguments; the function should return a help string or nil for
2213 none. For all other types of HELP evaluate it to obtain a string.
2214
2190735a
GM
2215 WINDOW is the window in which the help was generated, if any.
2216 It is nil if not in a window.
2217
5b2ec2d0
GM
2218 If OBJECT is a buffer, POS is the position in the buffer where the
2219 `help-echo' text property was found.
2220
2221 If OBJECT is an overlay, that overlay has a `help-echo' property,
2222 and POS is the position in the overlay's buffer under the mouse.
2223
2224 If OBJECT is a string (an overlay string or a string displayed with
2225 the `display' property). POS is the position in that string under
2226 the mouse.
d4e68eea 2227
27fd22dc 2228 OK_TO_OVERWRITE_KEYSTROKE_ECHO non-zero means it's okay if the help
d4e68eea
GM
2229 echo overwrites a keystroke echo currently displayed in the echo
2230 area.
2231
8dfd92c9
GM
2232 Note: this function may only be called with HELP nil or a string
2233 from X code running asynchronously. */
d4e68eea 2234
31f84d03 2235void
2190735a
GM
2236show_help_echo (help, window, object, pos, ok_to_overwrite_keystroke_echo)
2237 Lisp_Object help, window, object, pos;
adc84f48 2238 int ok_to_overwrite_keystroke_echo;
31f84d03 2239{
8dfd92c9 2240 if (!NILP (help) && !STRINGP (help))
d4e68eea 2241 {
8dfd92c9
GM
2242 if (FUNCTIONP (help))
2243 {
2190735a 2244 Lisp_Object args[4];
8dfd92c9 2245 args[0] = help;
2190735a
GM
2246 args[1] = window;
2247 args[2] = object;
2248 args[3] = pos;
1db0076e 2249 help = safe_call (4, args);
8dfd92c9
GM
2250 }
2251 else
1db0076e 2252 help = safe_eval (help);
c60ee5e7 2253
8dfd92c9 2254 if (!STRINGP (help))
d4e68eea 2255 return;
31f84d03
SM
2256 }
2257
8dfd92c9 2258 if (STRINGP (help) || NILP (help))
d4e68eea
GM
2259 {
2260 if (!NILP (Vshow_help_function))
8dfd92c9 2261 call1 (Vshow_help_function, help);
d4e68eea
GM
2262 else if (/* Don't overwrite minibuffer contents. */
2263 !MINI_WINDOW_P (XWINDOW (selected_window))
2264 /* Don't overwrite a keystroke echo. */
8dfd92c9
GM
2265 && (NILP (echo_message_buffer)
2266 || ok_to_overwrite_keystroke_echo)
d4e68eea
GM
2267 /* Don't overwrite a prompt. */
2268 && !cursor_in_echo_area)
2269 {
8dfd92c9 2270 if (STRINGP (help))
d4e68eea 2271 {
331379bf 2272 int count = SPECPDL_INDEX ();
f0c1cc56
GM
2273
2274 if (!help_echo_showing_p)
2275 Vpre_help_message = current_message ();
c60ee5e7 2276
d4e68eea 2277 specbind (Qmessage_truncate_lines, Qt);
d5db4077 2278 message3_nolog (help, SBYTES (help),
8dfd92c9 2279 STRING_MULTIBYTE (help));
d4e68eea
GM
2280 unbind_to (count, Qnil);
2281 }
f0c1cc56
GM
2282 else if (STRINGP (Vpre_help_message))
2283 {
2284 message3_nolog (Vpre_help_message,
d5db4077 2285 SBYTES (Vpre_help_message),
f0c1cc56
GM
2286 STRING_MULTIBYTE (Vpre_help_message));
2287 Vpre_help_message = Qnil;
2288 }
d4e68eea 2289 else
f0c1cc56 2290 message (0);
d4e68eea 2291 }
c60ee5e7 2292
5295a500 2293 help_echo_showing_p = STRINGP (help);
d4e68eea 2294 }
31f84d03
SM
2295}
2296
faf5e407
JB
2297
2298\f
284f4730
JB
2299/* Input of single characters from keyboard */
2300
2301Lisp_Object print_help ();
2302static Lisp_Object kbd_buffer_get_event ();
e4fe371d 2303static void record_char ();
284f4730 2304
c5fdd383
KH
2305#ifdef MULTI_KBOARD
2306static jmp_buf wrong_kboard_jmpbuf;
bded54dd 2307#endif
beecf6a1 2308
184c3d81
RS
2309#define STOP_POLLING \
2310do { if (! polling_stopped_here) stop_polling (); \
2311 polling_stopped_here = 1; } while (0)
2312
2313#define RESUME_POLLING \
2314do { if (polling_stopped_here) start_polling (); \
2315 polling_stopped_here = 0; } while (0)
2316
284f4730
JB
2317/* read a character from the keyboard; call the redisplay if needed */
2318/* commandflag 0 means do not do auto-saving, but do do redisplay.
2319 -1 means do not do redisplay, but do do autosaving.
2320 1 means do both. */
2321
7d6de002
RS
2322/* The arguments MAPS and NMAPS are for menu prompting.
2323 MAPS is an array of keymaps; NMAPS is the length of MAPS.
2324
2325 PREV_EVENT is the previous input event, or nil if we are reading
b638f328
RS
2326 the first event of a key sequence (or not reading a key sequence).
2327 If PREV_EVENT is t, that is a "magic" value that says
2328 not to run input methods, but in other respects to act as if
2329 not reading a key sequence.
7d6de002 2330
83d68044 2331 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
6569cc8d 2332 if we used a mouse menu to read the input, or zero otherwise. If
83d68044 2333 USED_MOUSE_MENU is null, we don't dereference it.
dcc408a0
RS
2334
2335 Value is t if we showed a menu and the user rejected it. */
7d6de002 2336
284f4730 2337Lisp_Object
7d6de002 2338read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
284f4730 2339 int commandflag;
7d6de002
RS
2340 int nmaps;
2341 Lisp_Object *maps;
2342 Lisp_Object prev_event;
2343 int *used_mouse_menu;
284f4730 2344{
8c907a56 2345 volatile Lisp_Object c;
284f4730 2346 int count;
410d4de9 2347 jmp_buf local_getcjmp;
284f4730 2348 jmp_buf save_jump;
8c907a56 2349 volatile int key_already_recorded = 0;
017c7cb6 2350 Lisp_Object tem, save;
8c907a56
GM
2351 volatile Lisp_Object previous_echo_area_message;
2352 volatile Lisp_Object also_record;
2353 volatile int reread;
d5eecefb 2354 struct gcpro gcpro1, gcpro2;
fdbb67fe 2355 EMACS_TIME last_idle_start;
184c3d81 2356 int polling_stopped_here = 0;
7c3bc944 2357
e4fe371d 2358 also_record = Qnil;
284f4730 2359
22b94eeb 2360#if 0 /* This was commented out as part of fixing echo for C-u left. */
71918b75
RS
2361 before_command_key_count = this_command_key_count;
2362 before_command_echo_length = echo_length ();
22b94eeb 2363#endif
ef6661f7 2364 c = Qnil;
7ee32cda 2365 previous_echo_area_message = Qnil;
71918b75 2366
7ee32cda 2367 GCPRO2 (c, previous_echo_area_message);
7c3bc944 2368
7f07d5ca
RS
2369 retry:
2370
7d18f9ae
RS
2371 reread = 0;
2372 if (CONSP (Vunread_post_input_method_events))
284f4730 2373 {
7539e11f 2374 c = XCAR (Vunread_post_input_method_events);
7d18f9ae 2375 Vunread_post_input_method_events
7539e11f 2376 = XCDR (Vunread_post_input_method_events);
284f4730 2377
2479e91e
RS
2378 /* Undo what read_char_x_menu_prompt did when it unread
2379 additional keys returned by Fx_popup_menu. */
2380 if (CONSP (c)
7539e11f
KR
2381 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2382 && NILP (XCDR (c)))
2383 c = XCAR (c);
2479e91e 2384
7d18f9ae
RS
2385 reread = 1;
2386 goto reread_first;
284f4730
JB
2387 }
2388
86e5706b
RS
2389 if (unread_command_char != -1)
2390 {
18cd2eeb 2391 XSETINT (c, unread_command_char);
86e5706b
RS
2392 unread_command_char = -1;
2393
7d18f9ae
RS
2394 reread = 1;
2395 goto reread_first;
2396 }
2397
2398 if (CONSP (Vunread_command_events))
2399 {
7539e11f
KR
2400 c = XCAR (Vunread_command_events);
2401 Vunread_command_events = XCDR (Vunread_command_events);
7d18f9ae
RS
2402
2403 /* Undo what read_char_x_menu_prompt did when it unread
2404 additional keys returned by Fx_popup_menu. */
2405 if (CONSP (c)
f4e05d97
GM
2406 && EQ (XCDR (c), Qdisabled)
2407 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))))
7539e11f 2408 c = XCAR (c);
c60ee5e7 2409
d17e49a8
GM
2410 /* If the queued event is something that used the mouse,
2411 set used_mouse_menu accordingly. */
2412 if (used_mouse_menu
2413 && (EQ (c, Qtool_bar) || EQ (c, Qmenu_bar)))
2414 *used_mouse_menu = 1;
c60ee5e7 2415
7d18f9ae
RS
2416 reread = 1;
2417 goto reread_for_input_method;
2418 }
2419
2420 if (CONSP (Vunread_input_method_events))
2421 {
7539e11f
KR
2422 c = XCAR (Vunread_input_method_events);
2423 Vunread_input_method_events = XCDR (Vunread_input_method_events);
7d18f9ae
RS
2424
2425 /* Undo what read_char_x_menu_prompt did when it unread
2426 additional keys returned by Fx_popup_menu. */
2427 if (CONSP (c)
7539e11f
KR
2428 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2429 && NILP (XCDR (c)))
2430 c = XCAR (c);
7d18f9ae
RS
2431 reread = 1;
2432 goto reread_for_input_method;
86e5706b
RS
2433 }
2434
63020c46
RS
2435 this_command_key_count_reset = 0;
2436
284f4730
JB
2437 if (!NILP (Vexecuting_macro))
2438 {
fce33686
JB
2439 /* We set this to Qmacro; since that's not a frame, nobody will
2440 try to switch frames on us, and the selected window will
2441 remain unchanged.
2442
2443 Since this event came from a macro, it would be misleading to
eb8c3be9 2444 leave internal_last_event_frame set to wherever the last
3c370943
JB
2445 real event came from. Normally, a switch-frame event selects
2446 internal_last_event_frame after each command is read, but
2447 events read from a macro should never cause a new frame to be
2448 selected. */
4c52b668 2449 Vlast_event_frame = internal_last_event_frame = Qmacro;
fce33686 2450
663258f2
JB
2451 /* Exit the macro if we are at the end.
2452 Also, some things replace the macro with t
2453 to force an early exit. */
2454 if (EQ (Vexecuting_macro, Qt)
2455 || executing_macro_index >= XFASTINT (Flength (Vexecuting_macro)))
284f4730 2456 {
18cd2eeb 2457 XSETINT (c, -1);
184c3d81 2458 goto exit;
284f4730 2459 }
df0f2ba1 2460
284f4730 2461 c = Faref (Vexecuting_macro, make_number (executing_macro_index));
8c18cbfb 2462 if (STRINGP (Vexecuting_macro)
86e5706b 2463 && (XINT (c) & 0x80))
bb9e9bed 2464 XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
86e5706b 2465
284f4730
JB
2466 executing_macro_index++;
2467
2468 goto from_macro;
2469 }
2470
cd21b839
JB
2471 if (!NILP (unread_switch_frame))
2472 {
2473 c = unread_switch_frame;
2474 unread_switch_frame = Qnil;
2475
2476 /* This event should make it into this_command_keys, and get echoed
7d18f9ae 2477 again, so we do not set `reread'. */
f4255cd1 2478 goto reread_first;
cd21b839
JB
2479 }
2480
adc1d5c8 2481 /* if redisplay was requested */
6e4e64a8
RS
2482 if (commandflag >= 0)
2483 {
adc1d5c8
RS
2484 /* If there is pending input, process any events which are not
2485 user-visible, such as X selection_request events. */
6e4e64a8
RS
2486 if (input_pending
2487 || detect_input_pending_run_timers (0))
adc1d5c8 2488 swallow_events (0); /* may clear input_pending */
6e4e64a8 2489
adc1d5c8
RS
2490 /* Redisplay if no pending input. */
2491 while (!input_pending)
2492 {
5295a500 2493 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
3007ebfb 2494 redisplay_preserve_echo_area (5);
5295a500
GM
2495 else
2496 redisplay ();
adc1d5c8
RS
2497
2498 if (!input_pending)
2499 /* Normal case: no input arrived during redisplay. */
2500 break;
2501
2502 /* Input arrived and pre-empted redisplay.
2503 Process any events which are not user-visible. */
2504 swallow_events (0);
2505 /* If that cleared input_pending, try again to redisplay. */
2506 }
6e4e64a8 2507 }
e9bf89a0 2508
59a84f8e 2509 /* Message turns off echoing unless more keystrokes turn it on again.
c60ee5e7 2510
59a84f8e
GM
2511 The code in 20.x for the condition was
2512
2513 1. echo_area_glyphs && *echo_area_glyphs
2514 2. && echo_area_glyphs != current_kboard->echobuf
2515 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2516
2517 (1) means there's a current message displayed
c60ee5e7 2518
59a84f8e
GM
2519 (2) means it's not the message from echoing from the current
2520 kboard.
c60ee5e7 2521
59a84f8e
GM
2522 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2523 is set to a non-null value. This is done in read_char and it is
2524 set to echo_area_glyphs after a call to echo_char. That means
2525 ok_to_echo_at_next_pause is either null or
2526 current_kboard->echobuf with the appropriate current_kboard at
2527 that time.
2528
2529 So, condition (3) means in clear text ok_to_echo_at_next_pause
2530 must be either null, or the current message isn't from echoing at
2531 all, or it's from echoing from a different kboard than the
2532 current one. */
c60ee5e7 2533
27fd22dc 2534 if (/* There currently is something in the echo area. */
985f9f66 2535 !NILP (echo_area_buffer[0])
59a84f8e
GM
2536 && (/* And it's either not from echoing. */
2537 !EQ (echo_area_buffer[0], echo_message_buffer)
2538 /* Or it's an echo from a different kboard. */
2539 || echo_kboard != current_kboard
2540 /* Or we explicitly allow overwriting whatever there is. */
2541 || ok_to_echo_at_next_pause == NULL))
7ee32cda 2542 cancel_echoing ();
410d4de9 2543 else
410d4de9 2544 echo_dash ();
c60ee5e7 2545
410d4de9
RS
2546 /* Try reading a character via menu prompting in the minibuf.
2547 Try this before the sit-for, because the sit-for
2548 would do the wrong thing if we are supposed to do
2549 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2550 after a mouse event so don't try a minibuf menu. */
2551 c = Qnil;
2552 if (nmaps > 0 && INTERACTIVE
2553 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2554 /* Don't bring up a menu if we already have another event. */
2555 && NILP (Vunread_command_events)
2556 && unread_command_char < 0
4ec4ed6a 2557 && !detect_input_pending_run_timers (0))
410d4de9
RS
2558 {
2559 c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
2560 if (! NILP (c))
2561 {
2562 key_already_recorded = 1;
2563 goto non_reread_1;
2564 }
2565 }
284f4730 2566
410d4de9
RS
2567 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2568 We will do that below, temporarily for short sections of code,
2569 when appropriate. local_getcjmp must be in effect
2570 around any call to sit_for or kbd_buffer_get_event;
2571 it *must not* be in effect when we call redisplay. */
284f4730 2572
410d4de9 2573 if (_setjmp (local_getcjmp))
284f4730 2574 {
18cd2eeb 2575 XSETINT (c, quit_char);
788f89eb 2576 internal_last_event_frame = selected_frame;
4c52b668 2577 Vlast_event_frame = internal_last_event_frame;
04904c29
RS
2578 /* If we report the quit char as an event,
2579 don't do so more than once. */
2580 if (!NILP (Vinhibit_quit))
2581 Vquit_flag = Qnil;
284f4730 2582
c5fdd383 2583#ifdef MULTI_KBOARD
df0f2ba1 2584 {
788f89eb 2585 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
c5fdd383 2586 if (kb != current_kboard)
df0f2ba1 2587 {
f3fbd155 2588 Lisp_Object link = kb->kbd_queue;
1e8bd3da
RS
2589 /* We shouldn't get here if we were in single-kboard mode! */
2590 if (single_kboard)
df0f2ba1 2591 abort ();
f3fbd155
KR
2592 if (CONSP (link))
2593 {
2594 while (CONSP (XCDR (link)))
2595 link = XCDR (link);
2596 if (!NILP (XCDR (link)))
2597 abort ();
2598 }
2599 if (!CONSP (link))
2600 kb->kbd_queue = Fcons (c, Qnil);
2601 else
2602 XSETCDR (link, Fcons (c, Qnil));
c5fdd383
KH
2603 kb->kbd_queue_has_data = 1;
2604 current_kboard = kb;
ef6661f7
RS
2605 /* This is going to exit from read_char
2606 so we had better get rid of this frame's stuff. */
2607 UNGCPRO;
c5fdd383 2608 longjmp (wrong_kboard_jmpbuf, 1);
df0f2ba1
KH
2609 }
2610 }
2611#endif
284f4730
JB
2612 goto non_reread;
2613 }
2614
d9d4c147
KH
2615 timer_start_idle ();
2616
284f4730
JB
2617 /* If in middle of key sequence and minibuffer not active,
2618 start echoing if enough time elapses. */
410d4de9 2619
c60ee5e7 2620 if (minibuf_level == 0
7ee32cda 2621 && !current_kboard->immediate_echo
6c6083a9 2622 && this_command_key_count > 0
27203ead 2623 && ! noninteractive
f2647d04
DL
2624 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2625 && NILP (Fzerop (Vecho_keystrokes))
985f9f66
GM
2626 && (/* No message. */
2627 NILP (echo_area_buffer[0])
2628 /* Or empty message. */
2629 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2630 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2631 /* Or already echoing from same kboard. */
2632 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2633 /* Or not echoing before and echoing allowed. */
2634 || (!echo_kboard && ok_to_echo_at_next_pause)))
284f4730
JB
2635 {
2636 Lisp_Object tem0;
c60ee5e7 2637
7d6de002
RS
2638 /* After a mouse event, start echoing right away.
2639 This is because we are probably about to display a menu,
2640 and we don't want to delay before doing so. */
dbc4e1c1 2641 if (EVENT_HAS_PARAMETERS (prev_event))
3dbd9ee4 2642 echo_now ();
7d6de002
RS
2643 else
2644 {
39aab679
DL
2645 int sec, usec;
2646 double duration = extract_float (Vecho_keystrokes);
2647 sec = (int) duration;
15fa88ab 2648 usec = (duration - sec) * 1000000;
410d4de9
RS
2649 save_getcjmp (save_jump);
2650 restore_getcjmp (local_getcjmp);
39aab679 2651 tem0 = sit_for (sec, usec, 1, 1, 0);
410d4de9 2652 restore_getcjmp (save_jump);
303b5b3f
RS
2653 if (EQ (tem0, Qt)
2654 && ! CONSP (Vunread_command_events))
3dbd9ee4 2655 echo_now ();
7d6de002 2656 }
284f4730
JB
2657 }
2658
410d4de9 2659 /* Maybe auto save due to number of keystrokes. */
284f4730
JB
2660
2661 if (commandflag != 0
2662 && auto_save_interval > 0
c43b1734 2663 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
4ec4ed6a 2664 && !detect_input_pending_run_timers (0))
284f4730 2665 {
284f4730 2666 Fdo_auto_save (Qnil, Qnil);
ef8fd672
RS
2667 /* Hooks can actually change some buffers in auto save. */
2668 redisplay ();
284f4730
JB
2669 }
2670
8150596a 2671 /* Try reading using an X menu.
24597608
RS
2672 This is never confused with reading using the minibuf
2673 because the recursive call of read_char in read_char_minibuf_menu_prompt
2674 does not pass on any keymaps. */
410d4de9 2675
24597608 2676 if (nmaps > 0 && INTERACTIVE
5a8d99e0
KH
2677 && !NILP (prev_event)
2678 && EVENT_HAS_PARAMETERS (prev_event)
7539e11f
KR
2679 && !EQ (XCAR (prev_event), Qmenu_bar)
2680 && !EQ (XCAR (prev_event), Qtool_bar)
24597608
RS
2681 /* Don't bring up a menu if we already have another event. */
2682 && NILP (Vunread_command_events)
b8556aee 2683 && unread_command_char < 0)
8eb4d8ef
RS
2684 {
2685 c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
2686
2687 /* Now that we have read an event, Emacs is not idle. */
2688 timer_stop_idle ();
2689
184c3d81 2690 goto exit;
8eb4d8ef 2691 }
7d6de002 2692
410d4de9
RS
2693 /* Maybe autosave and/or garbage collect due to idleness. */
2694
26c1639e 2695 if (INTERACTIVE && NILP (c))
7d6de002
RS
2696 {
2697 int delay_level, buffer_size;
2698
410d4de9
RS
2699 /* Slow down auto saves logarithmically in size of current buffer,
2700 and garbage collect while we're at it. */
7d6de002
RS
2701 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2702 last_non_minibuf_size = Z - BEG;
2703 buffer_size = (last_non_minibuf_size >> 8) + 1;
2704 delay_level = 0;
2705 while (buffer_size > 64)
2706 delay_level++, buffer_size -= buffer_size >> 2;
2707 if (delay_level < 4) delay_level = 4;
2708 /* delay_level is 4 for files under around 50k, 7 at 100k,
2709 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2710
2711 /* Auto save if enough time goes by without input. */
2712 if (commandflag != 0
c43b1734 2713 && num_nonmacro_input_events > last_auto_save
8c18cbfb 2714 && INTEGERP (Vauto_save_timeout)
7d6de002
RS
2715 && XINT (Vauto_save_timeout) > 0)
2716 {
2717 Lisp_Object tem0;
410d4de9
RS
2718
2719 save_getcjmp (save_jump);
2720 restore_getcjmp (local_getcjmp);
d9d4c147 2721 tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4,
41365083 2722 0, 1, 1, 0);
410d4de9
RS
2723 restore_getcjmp (save_jump);
2724
303b5b3f
RS
2725 if (EQ (tem0, Qt)
2726 && ! CONSP (Vunread_command_events))
7d6de002 2727 {
7d6de002 2728 Fdo_auto_save (Qnil, Qnil);
7d6de002
RS
2729
2730 /* If we have auto-saved and there is still no input
2731 available, garbage collect if there has been enough
2732 consing going on to make it worthwhile. */
4ec4ed6a 2733 if (!detect_input_pending_run_timers (0)
7d6de002 2734 && consing_since_gc > gc_cons_threshold / 2)
ef8fd672 2735 Fgarbage_collect ();
410d4de9 2736
ef8fd672 2737 redisplay ();
7d6de002
RS
2738 }
2739 }
2740 }
284f4730 2741
303b5b3f
RS
2742 /* If this has become non-nil here, it has been set by a timer
2743 or sentinel or filter. */
2744 if (CONSP (Vunread_command_events))
2745 {
7539e11f
KR
2746 c = XCAR (Vunread_command_events);
2747 Vunread_command_events = XCDR (Vunread_command_events);
303b5b3f
RS
2748 }
2749
410d4de9
RS
2750 /* Read something from current KBOARD's side queue, if possible. */
2751
beecf6a1 2752 if (NILP (c))
1e12dd87 2753 {
c5fdd383 2754 if (current_kboard->kbd_queue_has_data)
beecf6a1 2755 {
c5fdd383 2756 if (!CONSP (current_kboard->kbd_queue))
4524b161 2757 abort ();
7539e11f 2758 c = XCAR (current_kboard->kbd_queue);
c5fdd383 2759 current_kboard->kbd_queue
7539e11f 2760 = XCDR (current_kboard->kbd_queue);
c5fdd383
KH
2761 if (NILP (current_kboard->kbd_queue))
2762 current_kboard->kbd_queue_has_data = 0;
d9d4c147 2763 input_pending = readable_events (0);
4c52b668
KH
2764 if (EVENT_HAS_PARAMETERS (c)
2765 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
7539e11f 2766 internal_last_event_frame = XCAR (XCDR (c));
4c52b668 2767 Vlast_event_frame = internal_last_event_frame;
beecf6a1 2768 }
1e8bd3da
RS
2769 }
2770
c5fdd383 2771#ifdef MULTI_KBOARD
1e8bd3da
RS
2772 /* If current_kboard's side queue is empty check the other kboards.
2773 If one of them has data that we have not yet seen here,
2774 switch to it and process the data waiting for it.
2775
2776 Note: if the events queued up for another kboard
2777 have already been seen here, and therefore are not a complete command,
2778 the kbd_queue_has_data field is 0, so we skip that kboard here.
2779 That's to avoid an infinite loop switching between kboards here. */
2780 if (NILP (c) && !single_kboard)
2781 {
2782 KBOARD *kb;
2783 for (kb = all_kboards; kb; kb = kb->next_kboard)
2784 if (kb->kbd_queue_has_data)
2785 {
2786 current_kboard = kb;
ef6661f7
RS
2787 /* This is going to exit from read_char
2788 so we had better get rid of this frame's stuff. */
2789 UNGCPRO;
1e8bd3da
RS
2790 longjmp (wrong_kboard_jmpbuf, 1);
2791 }
2792 }
df0f2ba1
KH
2793#endif
2794
410d4de9
RS
2795 wrong_kboard:
2796
184c3d81 2797 STOP_POLLING;
410d4de9 2798
1e8bd3da
RS
2799 /* Finally, we read from the main queue,
2800 and if that gives us something we can't use yet, we put it on the
2801 appropriate side queue and try again. */
410d4de9 2802
1e8bd3da
RS
2803 if (NILP (c))
2804 {
2805 KBOARD *kb;
2806
1e8bd3da 2807 /* Actually read a character, waiting if necessary. */
410d4de9
RS
2808 save_getcjmp (save_jump);
2809 restore_getcjmp (local_getcjmp);
5b7bc0da 2810 timer_start_idle ();
83d68044 2811 c = kbd_buffer_get_event (&kb, used_mouse_menu);
410d4de9
RS
2812 restore_getcjmp (save_jump);
2813
c5fdd383 2814#ifdef MULTI_KBOARD
410d4de9 2815 if (! NILP (c) && (kb != current_kboard))
1e8bd3da 2816 {
f3fbd155
KR
2817 Lisp_Object link = kb->kbd_queue;
2818 if (CONSP (link))
2819 {
2820 while (CONSP (XCDR (link)))
2821 link = XCDR (link);
2822 if (!NILP (XCDR (link)))
2823 abort ();
2824 }
2825 if (!CONSP (link))
2826 kb->kbd_queue = Fcons (c, Qnil);
2827 else
2828 XSETCDR (link, Fcons (c, Qnil));
1e8bd3da 2829 kb->kbd_queue_has_data = 1;
46b84797 2830 c = Qnil;
1e8bd3da
RS
2831 if (single_kboard)
2832 goto wrong_kboard;
2833 current_kboard = kb;
ef6661f7
RS
2834 /* This is going to exit from read_char
2835 so we had better get rid of this frame's stuff. */
2836 UNGCPRO;
1e8bd3da 2837 longjmp (wrong_kboard_jmpbuf, 1);
df0f2ba1 2838 }
1e8bd3da 2839#endif
beecf6a1 2840 }
1e8bd3da 2841
284f4730 2842 /* Terminate Emacs in batch mode if at eof. */
8c18cbfb 2843 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
284f4730
JB
2844 Fkill_emacs (make_number (1));
2845
8c18cbfb 2846 if (INTEGERP (c))
80645119
JB
2847 {
2848 /* Add in any extra modifiers, where appropriate. */
2849 if ((extra_keyboard_modifiers & CHAR_CTL)
2850 || ((extra_keyboard_modifiers & 0177) < ' '
2851 && (extra_keyboard_modifiers & 0177) != 0))
faf5e407 2852 XSETINT (c, make_ctrl_char (XINT (c)));
80645119
JB
2853
2854 /* Transfer any other modifier bits directly from
2855 extra_keyboard_modifiers to c. Ignore the actual character code
2856 in the low 16 bits of extra_keyboard_modifiers. */
b8d9050d 2857 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
80645119 2858 }
9fa4395d 2859
284f4730
JB
2860 non_reread:
2861
fdbb67fe
GM
2862 /* Record the last idle start time so that we can reset it
2863 should the next event read be a help-echo. */
2864 last_idle_start = timer_idleness_start_time;
2fb9049e 2865 timer_stop_idle ();
184c3d81 2866 RESUME_POLLING;
284f4730 2867
410d4de9
RS
2868 if (NILP (c))
2869 {
2870 if (commandflag >= 0
4ec4ed6a 2871 && !input_pending && !detect_input_pending_run_timers (0))
410d4de9
RS
2872 redisplay ();
2873
2874 goto wrong_kboard;
2875 }
2876
2877 non_reread_1:
2878
dfd11da7 2879 /* Buffer switch events are only for internal wakeups
7c3bc944
RS
2880 so don't show them to the user.
2881 Also, don't record a key if we already did. */
2882 if (BUFFERP (c) || key_already_recorded)
184c3d81 2883 goto exit;
a1341f75 2884
7f07d5ca
RS
2885 /* Process special events within read_char
2886 and loop around to read another event. */
017c7cb6
RS
2887 save = Vquit_flag;
2888 Vquit_flag = Qnil;
02067692 2889 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
017c7cb6 2890 Vquit_flag = save;
7f07d5ca
RS
2891
2892 if (!NILP (tem))
2893 {
ba8dfba8
RS
2894 int was_locked = single_kboard;
2895
7f07d5ca 2896 last_input_char = c;
158f7532 2897 Fcommand_execute (tem, Qnil, Fvector (1, &last_input_char), Qt);
ba8dfba8 2898
5d12f14d
EZ
2899 if (CONSP (c) && EQ (XCAR (c), Qselect_window))
2900 /* We stopped being idle for this event; undo that. This
2901 prevents automatic window selection (under
0b9a1d3d 2902 mouse_autoselect_window from acting as a real input event, for
5d12f14d
EZ
2903 example banishing the mouse under mouse-avoidance-mode. */
2904 timer_idleness_start_time = last_idle_start;
2905
ba8dfba8
RS
2906 /* Resume allowing input from any kboard, if that was true before. */
2907 if (!was_locked)
2908 any_kboard_state ();
2909
7f07d5ca
RS
2910 goto retry;
2911 }
2912
284f4730 2913 /* Handle things that only apply to characters. */
8c18cbfb 2914 if (INTEGERP (c))
284f4730
JB
2915 {
2916 /* If kbd_buffer_get_event gave us an EOF, return that. */
86e5706b 2917 if (XINT (c) == -1)
184c3d81 2918 goto exit;
284f4730 2919
301738ed 2920 if ((STRINGP (Vkeyboard_translate_table)
d5db4077 2921 && SCHARS (Vkeyboard_translate_table) > (unsigned) XFASTINT (c))
301738ed
RS
2922 || (VECTORP (Vkeyboard_translate_table)
2923 && XVECTOR (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
2924 || (CHAR_TABLE_P (Vkeyboard_translate_table)
5e3cb80d 2925 && CHAR_VALID_P (XINT (c), 0)))
f9414d62
RS
2926 {
2927 Lisp_Object d;
2928 d = Faref (Vkeyboard_translate_table, c);
2929 /* nil in keyboard-translate-table means no translation. */
2930 if (!NILP (d))
2931 c = d;
2932 }
284f4730
JB
2933 }
2934
e4fe371d
RS
2935 /* If this event is a mouse click in the menu bar,
2936 return just menu-bar for now. Modify the mouse click event
2937 so we won't do this twice, then queue it up. */
2938 if (EVENT_HAS_PARAMETERS (c)
7539e11f 2939 && CONSP (XCDR (c))
e4fe371d 2940 && CONSP (EVENT_START (c))
7539e11f 2941 && CONSP (XCDR (EVENT_START (c))))
284f4730 2942 {
e4fe371d 2943 Lisp_Object posn;
284f4730 2944
e4fe371d
RS
2945 posn = POSN_BUFFER_POSN (EVENT_START (c));
2946 /* Handle menu-bar events:
2947 insert the dummy prefix event `menu-bar'. */
9ea173e8 2948 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
e4fe371d
RS
2949 {
2950 /* Change menu-bar to (menu-bar) as the event "position". */
f3fbd155 2951 POSN_BUFFER_SET_POSN (EVENT_START (c), Fcons (posn, Qnil));
284f4730 2952
e4fe371d
RS
2953 also_record = c;
2954 Vunread_command_events = Fcons (c, Vunread_command_events);
2955 c = posn;
284f4730 2956 }
284f4730
JB
2957 }
2958
7d18f9ae
RS
2959 /* Store these characters into recent_keys, the dribble file if any,
2960 and the keyboard macro being defined, if any. */
e4fe371d
RS
2961 record_char (c);
2962 if (! NILP (also_record))
2963 record_char (also_record);
51172b6d 2964
d5eecefb
RS
2965 /* Wipe the echo area.
2966 But first, if we are about to use an input method,
2967 save the echo area contents for it to refer to. */
2968 if (INTEGERP (c)
2969 && ! NILP (Vinput_method_function)
2970 && (unsigned) XINT (c) >= ' '
8d769115
KH
2971 && (unsigned) XINT (c) != 127
2972 && (unsigned) XINT (c) < 256)
7ee32cda
GM
2973 {
2974 previous_echo_area_message = Fcurrent_message ();
2975 Vinput_method_previous_message = previous_echo_area_message;
2976 }
d5eecefb 2977
1172eb8d
GM
2978 /* Now wipe the echo area, except for help events which do their
2979 own stuff with the echo area. */
4d2e9f95
GM
2980 if (!CONSP (c)
2981 || (!(EQ (Qhelp_echo, XCAR (c)))
2982 && !(EQ (Qswitch_frame, XCAR (c)))))
1172eb8d
GM
2983 {
2984 if (!NILP (echo_area_buffer[0]))
2985 safe_run_hooks (Qecho_area_clear_hook);
2986 clear_message (1, 0);
2987 }
d5eecefb 2988
7d18f9ae 2989 reread_for_input_method:
284f4730 2990 from_macro:
7d18f9ae 2991 /* Pass this to the input method, if appropriate. */
d5eecefb
RS
2992 if (INTEGERP (c)
2993 && ! NILP (Vinput_method_function)
b638f328
RS
2994 /* Don't run the input method within a key sequence,
2995 after the first event of the key sequence. */
2996 && NILP (prev_event)
d5eecefb 2997 && (unsigned) XINT (c) >= ' '
8d769115
KH
2998 && (unsigned) XINT (c) != 127
2999 && (unsigned) XINT (c) < 256)
d5eecefb 3000 {
c60ee5e7 3001 Lisp_Object keys;
63020c46 3002 int key_count, key_count_reset;
d5eecefb 3003 struct gcpro gcpro1;
aed13378 3004 int count = SPECPDL_INDEX ();
d5eecefb 3005
6e5742a0
RS
3006 /* Save the echo status. */
3007 int saved_immediate_echo = current_kboard->immediate_echo;
985f9f66 3008 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
6e5742a0
RS
3009 int saved_echo_after_prompt = current_kboard->echo_after_prompt;
3010
22b94eeb 3011#if 0
6e5742a0
RS
3012 if (before_command_restore_flag)
3013 {
3014 this_command_key_count = before_command_key_count_1;
3015 if (this_command_key_count < this_single_command_key_start)
3016 this_single_command_key_start = this_command_key_count;
3017 echo_truncate (before_command_echo_length_1);
3018 before_command_restore_flag = 0;
3019 }
22b94eeb 3020#endif
6e5742a0
RS
3021
3022 /* Save the this_command_keys status. */
3023 key_count = this_command_key_count;
63020c46 3024 key_count_reset = this_command_key_count_reset;
6e5742a0
RS
3025
3026 if (key_count > 0)
3027 keys = Fcopy_sequence (this_command_keys);
3028 else
3029 keys = Qnil;
d5eecefb 3030 GCPRO1 (keys);
6e5742a0
RS
3031
3032 /* Clear out this_command_keys. */
3033 this_command_key_count = 0;
63020c46 3034 this_command_key_count_reset = 0;
6e5742a0
RS
3035
3036 /* Now wipe the echo area. */
985f9f66 3037 if (!NILP (echo_area_buffer[0]))
6e5742a0 3038 safe_run_hooks (Qecho_area_clear_hook);
985f9f66 3039 clear_message (1, 0);
6e5742a0
RS
3040 echo_truncate (0);
3041
b638f328
RS
3042 /* If we are not reading a key sequence,
3043 never use the echo area. */
3044 if (maps == 0)
3045 {
b638f328
RS
3046 specbind (Qinput_method_use_echo_area, Qt);
3047 }
3048
6e5742a0 3049 /* Call the input method. */
d5eecefb 3050 tem = call1 (Vinput_method_function, c);
b638f328
RS
3051
3052 tem = unbind_to (count, tem);
3053
6e5742a0
RS
3054 /* Restore the saved echoing state
3055 and this_command_keys state. */
3056 this_command_key_count = key_count;
63020c46 3057 this_command_key_count_reset = key_count_reset;
6e5742a0
RS
3058 if (key_count > 0)
3059 this_command_keys = keys;
3060
3061 cancel_echoing ();
3062 ok_to_echo_at_next_pause = saved_ok_to_echo;
3063 current_kboard->echo_after_prompt = saved_echo_after_prompt;
3064 if (saved_immediate_echo)
3065 echo_now ();
3066
d5eecefb 3067 UNGCPRO;
6e5742a0 3068
d5eecefb
RS
3069 /* The input method can return no events. */
3070 if (! CONSP (tem))
7d18f9ae 3071 {
d5eecefb 3072 /* Bring back the previous message, if any. */
7ee32cda
GM
3073 if (! NILP (previous_echo_area_message))
3074 message_with_string ("%s", previous_echo_area_message, 0);
d5eecefb 3075 goto retry;
7d18f9ae 3076 }
d5eecefb 3077 /* It returned one event or more. */
7539e11f 3078 c = XCAR (tem);
d5eecefb 3079 Vunread_post_input_method_events
7539e11f 3080 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
7d18f9ae 3081 }
7c3bc944 3082
7d18f9ae 3083 reread_first:
284f4730 3084
7ee32cda 3085 /* Display help if not echoing. */
1172eb8d 3086 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
7ee32cda 3087 {
2190735a 3088 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
d31053f9
RS
3089 Lisp_Object help, object, position, window, tem;
3090
3091 tem = Fcdr (XCDR (c));
3092 help = Fcar (tem);
3093 tem = Fcdr (tem);
3094 window = Fcar (tem);
3095 tem = Fcdr (tem);
3096 object = Fcar (tem);
3097 tem = Fcdr (tem);
3098 position = Fcar (tem);
3099
2190735a 3100 show_help_echo (help, window, object, position, 0);
fdbb67fe
GM
3101
3102 /* We stopped being idle for this event; undo that. */
3103 timer_idleness_start_time = last_idle_start;
7ee32cda
GM
3104 goto retry;
3105 }
c60ee5e7 3106
63020c46
RS
3107 if (! reread || this_command_key_count == 0
3108 || this_command_key_count_reset)
e4fe371d 3109 {
7d18f9ae
RS
3110
3111 /* Don't echo mouse motion events. */
f2647d04
DL
3112 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
3113 && NILP (Fzerop (Vecho_keystrokes))
7d18f9ae
RS
3114 && ! (EVENT_HAS_PARAMETERS (c)
3115 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
3116 {
3117 echo_char (c);
3118 if (! NILP (also_record))
3119 echo_char (also_record);
3120 /* Once we reread a character, echoing can happen
3121 the next time we pause to read a new one. */
985f9f66 3122 ok_to_echo_at_next_pause = current_kboard;
7d18f9ae
RS
3123 }
3124
3125 /* Record this character as part of the current key. */
3126 add_command_key (c);
e4fe371d 3127 if (! NILP (also_record))
7d18f9ae 3128 add_command_key (also_record);
e4fe371d 3129 }
b8556aee 3130
284f4730 3131 last_input_char = c;
c43b1734 3132 num_input_events++;
284f4730
JB
3133
3134 /* Process the help character specially if enabled */
ecb7cb34 3135 if (!NILP (Vhelp_form) && help_char_p (c))
284f4730
JB
3136 {
3137 Lisp_Object tem0;
aed13378 3138 count = SPECPDL_INDEX ();
284f4730
JB
3139
3140 record_unwind_protect (Fset_window_configuration,
3141 Fcurrent_window_configuration (Qnil));
3142
3143 tem0 = Feval (Vhelp_form);
8c18cbfb 3144 if (STRINGP (tem0))
284f4730
JB
3145 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
3146
3147 cancel_echoing ();
3cb81011
KH
3148 do
3149 c = read_char (0, 0, 0, Qnil, 0);
8c18cbfb 3150 while (BUFFERP (c));
ff11dfa1 3151 /* Remove the help from the frame */
284f4730 3152 unbind_to (count, Qnil);
410d4de9 3153
284f4730
JB
3154 redisplay ();
3155 if (EQ (c, make_number (040)))
3156 {
3157 cancel_echoing ();
3cb81011
KH
3158 do
3159 c = read_char (0, 0, 0, Qnil, 0);
8c18cbfb 3160 while (BUFFERP (c));
284f4730
JB
3161 }
3162 }
3163
184c3d81
RS
3164 exit:
3165 RESUME_POLLING;
7c3bc944 3166 RETURN_UNGCPRO (c);
284f4730
JB
3167}
3168
8eb4d8ef
RS
3169/* Record a key that came from a mouse menu.
3170 Record it for echoing, for this-command-keys, and so on. */
3171
3172static void
3173record_menu_key (c)
3174 Lisp_Object c;
3175{
3176 /* Wipe the echo area. */
985f9f66 3177 clear_message (1, 0);
8eb4d8ef
RS
3178
3179 record_char (c);
3180
22b94eeb 3181#if 0
8eb4d8ef
RS
3182 before_command_key_count = this_command_key_count;
3183 before_command_echo_length = echo_length ();
22b94eeb 3184#endif
8eb4d8ef
RS
3185
3186 /* Don't echo mouse motion events. */
f2647d04
DL
3187 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
3188 && NILP (Fzerop (Vecho_keystrokes)))
8eb4d8ef
RS
3189 {
3190 echo_char (c);
3191
3192 /* Once we reread a character, echoing can happen
3193 the next time we pause to read a new one. */
3194 ok_to_echo_at_next_pause = 0;
3195 }
3196
3197 /* Record this character as part of the current key. */
3198 add_command_key (c);
3199
3200 /* Re-reading in the middle of a command */
3201 last_input_char = c;
c43b1734 3202 num_input_events++;
8eb4d8ef
RS
3203}
3204
ecb7cb34
KH
3205/* Return 1 if should recognize C as "the help character". */
3206
3207int
3208help_char_p (c)
3209 Lisp_Object c;
3210{
3211 Lisp_Object tail;
3212
3213 if (EQ (c, Vhelp_char))
3214 return 1;
7539e11f
KR
3215 for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
3216 if (EQ (c, XCAR (tail)))
ecb7cb34
KH
3217 return 1;
3218 return 0;
3219}
3220
e4fe371d
RS
3221/* Record the input event C in various ways. */
3222
3223static void
3224record_char (c)
3225 Lisp_Object c;
3226{
090c68b9 3227 int recorded = 0;
52be17cc 3228
090c68b9
KS
3229 if (CONSP (c) && (EQ (XCAR (c), Qhelp_echo) || EQ (XCAR (c), Qmouse_movement)))
3230 {
3231 /* To avoid filling recent_keys with help-echo and mouse-movement
3232 events, we filter out repeated help-echo events, only store the
3233 first and last in a series of mouse-movement events, and don't
3234 store repeated help-echo events which are only separated by
3235 mouse-movement events. */
3236
3237 Lisp_Object ev1, ev2, ev3;
3238 int ix1, ix2, ix3;
c60ee5e7 3239
090c68b9
KS
3240 if ((ix1 = recent_keys_index - 1) < 0)
3241 ix1 = NUM_RECENT_KEYS - 1;
3242 ev1 = AREF (recent_keys, ix1);
c60ee5e7 3243
090c68b9
KS
3244 if ((ix2 = ix1 - 1) < 0)
3245 ix2 = NUM_RECENT_KEYS - 1;
3246 ev2 = AREF (recent_keys, ix2);
c60ee5e7 3247
090c68b9
KS
3248 if ((ix3 = ix2 - 1) < 0)
3249 ix3 = NUM_RECENT_KEYS - 1;
3250 ev3 = AREF (recent_keys, ix3);
c60ee5e7 3251
090c68b9
KS
3252 if (EQ (XCAR (c), Qhelp_echo))
3253 {
3254 /* Don't record `help-echo' in recent_keys unless it shows some help
a978004d 3255 message, and a different help than the previously recorded
090c68b9
KS
3256 event. */
3257 Lisp_Object help, last_help;
3258
3259 help = Fcar_safe (Fcdr_safe (XCDR (c)));
3260 if (!STRINGP (help))
3261 recorded = 1;
3262 else if (CONSP (ev1) && EQ (XCAR (ev1), Qhelp_echo)
3263 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev1))), EQ (last_help, help)))
3264 recorded = 1;
3265 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3266 && CONSP (ev2) && EQ (XCAR (ev2), Qhelp_echo)
3267 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev2))), EQ (last_help, help)))
3268 recorded = -1;
3269 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3270 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3271 && CONSP (ev3) && EQ (XCAR (ev3), Qhelp_echo)
3272 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev3))), EQ (last_help, help)))
3273 recorded = -2;
3274 }
3275 else if (EQ (XCAR (c), Qmouse_movement))
52be17cc 3276 {
090c68b9
KS
3277 /* Only record one pair of `mouse-movement' on a window in recent_keys.
3278 So additional mouse movement events replace the last element. */
3279 Lisp_Object last_window, window;
3280
3281 window = Fcar_safe (Fcar_safe (XCDR (c)));
3282 if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3283 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev1))), EQ (last_window, window))
3284 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3285 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev2))), EQ (last_window, window)))
52be17cc 3286 {
090c68b9
KS
3287 ASET (recent_keys, ix1, c);
3288 recorded = 1;
52be17cc
GM
3289 }
3290 }
3291 }
3292 else
090c68b9
KS
3293 store_kbd_macro_char (c);
3294
3295 if (!recorded)
e8a50785
GM
3296 {
3297 total_keys++;
3298 ASET (recent_keys, recent_keys_index, c);
3299 if (++recent_keys_index >= NUM_RECENT_KEYS)
3300 recent_keys_index = 0;
3301 }
090c68b9
KS
3302 else if (recorded < 0)
3303 {
3304 /* We need to remove one or two events from recent_keys.
3305 To do this, we simply put nil at those events and move the
3306 recent_keys_index backwards over those events. Usually,
3307 users will never see those nil events, as they will be
3308 overwritten by the command keys entered to see recent_keys
3309 (e.g. C-h l). */
3310
3311 while (recorded++ < 0 && total_keys > 0)
3312 {
3313 if (total_keys < NUM_RECENT_KEYS)
3314 total_keys--;
3315 if (--recent_keys_index < 0)
3316 recent_keys_index = NUM_RECENT_KEYS - 1;
3317 ASET (recent_keys, recent_keys_index, Qnil);
3318 }
3319 }
3320
3321 num_nonmacro_input_events++;
c60ee5e7 3322
e4fe371d
RS
3323 /* Write c to the dribble file. If c is a lispy event, write
3324 the event's symbol to the dribble file, in <brackets>. Bleaugh.
3325 If you, dear reader, have a better idea, you've got the source. :-) */
3326 if (dribble)
3327 {
3328 if (INTEGERP (c))
3329 {
3330 if (XUINT (c) < 0x100)
3331 putc (XINT (c), dribble);
3332 else
6de34814 3333 fprintf (dribble, " 0x%x", (int) XUINT (c));
e4fe371d
RS
3334 }
3335 else
3336 {
3337 Lisp_Object dribblee;
3338
3339 /* If it's a structured event, take the event header. */
3340 dribblee = EVENT_HEAD (c);
3341
3342 if (SYMBOLP (dribblee))
3343 {
3344 putc ('<', dribble);
d5db4077
KR
3345 fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
3346 SBYTES (SYMBOL_NAME (dribblee)),
e4fe371d
RS
3347 dribble);
3348 putc ('>', dribble);
3349 }
3350 }
3351
3352 fflush (dribble);
3353 }
e4fe371d
RS
3354}
3355
284f4730
JB
3356Lisp_Object
3357print_help (object)
3358 Lisp_Object object;
3359{
622de3e9 3360 struct buffer *old = current_buffer;
284f4730 3361 Fprinc (object, Qnil);
622de3e9
KH
3362 set_buffer_internal (XBUFFER (Vstandard_output));
3363 call0 (intern ("help-mode"));
3364 set_buffer_internal (old);
284f4730
JB
3365 return Qnil;
3366}
3367
3368/* Copy out or in the info on where C-g should throw to.
3369 This is used when running Lisp code from within get_char,
3370 in case get_char is called recursively.
3371 See read_process_output. */
3372
dfcf069d 3373static void
284f4730
JB
3374save_getcjmp (temp)
3375 jmp_buf temp;
3376{
3377 bcopy (getcjmp, temp, sizeof getcjmp);
3378}
3379
dfcf069d 3380static void
284f4730
JB
3381restore_getcjmp (temp)
3382 jmp_buf temp;
3383{
3384 bcopy (temp, getcjmp, sizeof getcjmp);
3385}
284f4730 3386\f
2eb6bfbe
RM
3387#ifdef HAVE_MOUSE
3388
284f4730
JB
3389/* Restore mouse tracking enablement. See Ftrack_mouse for the only use
3390 of this function. */
a9d77f1f 3391
284f4730
JB
3392static Lisp_Object
3393tracking_off (old_value)
3394 Lisp_Object old_value;
3395{
71edead1
RS
3396 do_mouse_tracking = old_value;
3397 if (NILP (old_value))
284f4730 3398 {
284f4730
JB
3399 /* Redisplay may have been preempted because there was input
3400 available, and it assumes it will be called again after the
3401 input has been processed. If the only input available was
3402 the sort that we have just disabled, then we need to call
3403 redisplay. */
d9d4c147 3404 if (!readable_events (1))
284f4730 3405 {
3007ebfb 3406 redisplay_preserve_echo_area (6);
d9d4c147 3407 get_input_pending (&input_pending, 1);
284f4730
JB
3408 }
3409 }
30690496 3410 return Qnil;
284f4730
JB
3411}
3412
3413DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
4707d2d0
PJ
3414 doc: /* Evaluate BODY with mouse movement events enabled.
3415Within a `track-mouse' form, mouse motion generates input events that
3416you can read with `read-event'.
3417Normally, mouse motion is ignored.
3418usage: (track-mouse BODY ...) */)
3419 (args)
284f4730
JB
3420 Lisp_Object args;
3421{
aed13378 3422 int count = SPECPDL_INDEX ();
284f4730
JB
3423 Lisp_Object val;
3424
a9d77f1f 3425 record_unwind_protect (tracking_off, do_mouse_tracking);
284f4730 3426
f3253854 3427 do_mouse_tracking = Qt;
df0f2ba1 3428
284f4730
JB
3429 val = Fprogn (args);
3430 return unbind_to (count, val);
3431}
2eb6bfbe 3432
f3253854
KH
3433/* If mouse has moved on some frame, return one of those frames.
3434 Return 0 otherwise. */
3435
3436static FRAME_PTR
3437some_mouse_moved ()
3438{
3439 Lisp_Object tail, frame;
3440
3441 FOR_EACH_FRAME (tail, frame)
3442 {
3443 if (XFRAME (frame)->mouse_moved)
3444 return XFRAME (frame);
3445 }
3446
3447 return 0;
3448}
3449
2eb6bfbe 3450#endif /* HAVE_MOUSE */
a612e298
RS
3451\f
3452/* Low level keyboard/mouse input.
3453 kbd_buffer_store_event places events in kbd_buffer, and
0646c0dd 3454 kbd_buffer_get_event retrieves them. */
a612e298
RS
3455
3456/* Return true iff there are any events in the queue that read-char
3457 would return. If this returns false, a read-char would block. */
3458static int
20057d52 3459readable_filtered_events (do_timers_now, filter_events)
d9d4c147 3460 int do_timers_now;
20057d52 3461 int filter_events;
a612e298 3462{
4ec4ed6a
RS
3463 if (do_timers_now)
3464 timer_check (do_timers_now);
3465
a0ba8995 3466 /* If the buffer contains only FOCUS_IN_EVENT events,
20057d52 3467 and FILTER_EVENTS is nonzero, report it as empty. */
beecf6a1 3468 if (kbd_fetch_ptr != kbd_store_ptr)
a0ba8995 3469 {
20057d52 3470 int have_live_event = 1;
a0ba8995 3471
20057d52
JD
3472 if (filter_events)
3473 {
3474 struct input_event *event;
3475
3476 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3477 ? kbd_fetch_ptr
3478 : kbd_buffer);
3479
3480 while (have_live_event && event->kind == FOCUS_IN_EVENT)
3481 {
3482 event++;
3483 if (event == kbd_buffer + KBD_BUFFER_SIZE)
3484 event = kbd_buffer;
3485 if (event == kbd_store_ptr)
3486 have_live_event = 0;
3487 }
3488 }
3489 if (have_live_event) return 1;
a0ba8995
RS
3490 }
3491
beecf6a1 3492#ifdef HAVE_MOUSE
f3253854 3493 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
beecf6a1
KH
3494 return 1;
3495#endif
1e8bd3da 3496 if (single_kboard)
4c52b668 3497 {
c5fdd383 3498 if (current_kboard->kbd_queue_has_data)
4c52b668
KH
3499 return 1;
3500 }
3501 else
3502 {
c5fdd383
KH
3503 KBOARD *kb;
3504 for (kb = all_kboards; kb; kb = kb->next_kboard)
3505 if (kb->kbd_queue_has_data)
4c52b668
KH
3506 return 1;
3507 }
beecf6a1 3508 return 0;
a612e298
RS
3509}
3510
20057d52
JD
3511/* Return true iff there are any events in the queue that read-char
3512 would return. If this returns false, a read-char would block. */
3513static int
3514readable_events (do_timers_now)
3515 int do_timers_now;
3516{
3517 return readable_filtered_events (do_timers_now, 0);
3518}
3519
a612e298
RS
3520/* Set this for debugging, to have a way to get out */
3521int stop_character;
284f4730 3522
c5fdd383
KH
3523#ifdef MULTI_KBOARD
3524static KBOARD *
3525event_to_kboard (event)
5798cf15
KH
3526 struct input_event *event;
3527{
3528 Lisp_Object frame;
3529 frame = event->frame_or_window;
3530 if (CONSP (frame))
7539e11f 3531 frame = XCAR (frame);
5798cf15
KH
3532 else if (WINDOWP (frame))
3533 frame = WINDOW_FRAME (XWINDOW (frame));
3534
3535 /* There are still some events that don't set this field.
f5b56972
KH
3536 For now, just ignore the problem.
3537 Also ignore dead frames here. */
3538 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
5798cf15
KH
3539 return 0;
3540 else
c5fdd383 3541 return FRAME_KBOARD (XFRAME (frame));
5798cf15
KH
3542}
3543#endif
3544
284f4730
JB
3545/* Store an event obtained at interrupt level into kbd_buffer, fifo */
3546
3547void
3548kbd_buffer_store_event (event)
3549 register struct input_event *event;
3550{
3b8f9651 3551 if (event->kind == NO_EVENT)
284f4730
JB
3552 abort ();
3553
3b8f9651 3554 if (event->kind == ASCII_KEYSTROKE_EVENT)
284f4730 3555 {
e9bf89a0 3556 register int c = event->code & 0377;
284f4730 3557
faf5e407
JB
3558 if (event->modifiers & ctrl_modifier)
3559 c = make_ctrl_char (c);
3560
9fd7d808
RS
3561 c |= (event->modifiers
3562 & (meta_modifier | alt_modifier
3563 | hyper_modifier | super_modifier));
3564
86e5706b 3565 if (c == quit_char)
284f4730 3566 {
c5fdd383
KH
3567#ifdef MULTI_KBOARD
3568 KBOARD *kb;
5798cf15
KH
3569 struct input_event *sp;
3570
1e8bd3da 3571 if (single_kboard
c5fdd383
KH
3572 && (kb = FRAME_KBOARD (XFRAME (event->frame_or_window)),
3573 kb != current_kboard))
5798cf15 3574 {
c5fdd383 3575 kb->kbd_queue
5798cf15
KH
3576 = Fcons (make_lispy_switch_frame (event->frame_or_window),
3577 Fcons (make_number (c), Qnil));
c5fdd383 3578 kb->kbd_queue_has_data = 1;
5798cf15
KH
3579 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3580 {
3581 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3582 sp = kbd_buffer;
3583
c5fdd383 3584 if (event_to_kboard (sp) == kb)
5798cf15 3585 {
3b8f9651 3586 sp->kind = NO_EVENT;
5798cf15 3587 sp->frame_or_window = Qnil;
da8f7368 3588 sp->arg = Qnil;
5798cf15
KH
3589 }
3590 }
3591 return;
3592 }
3593#endif
3e51c7b7 3594
284f4730 3595 /* If this results in a quit_char being returned to Emacs as
3c370943 3596 input, set Vlast_event_frame properly. If this doesn't
284f4730 3597 get returned to Emacs as an event, the next event read
ff11dfa1 3598 will set Vlast_event_frame again, so this is safe to do. */
4bb994d1 3599 {
9b8eb840 3600 Lisp_Object focus;
4bb994d1 3601
9b8eb840 3602 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
4bb994d1 3603 if (NILP (focus))
beecf6a1 3604 focus = event->frame_or_window;
4c52b668
KH
3605 internal_last_event_frame = focus;
3606 Vlast_event_frame = focus;
4bb994d1 3607 }
3e51c7b7 3608
ffd56f97 3609 last_event_timestamp = event->timestamp;
7189cad8 3610 interrupt_signal (0 /* dummy */);
284f4730
JB
3611 return;
3612 }
3613
3614 if (c && c == stop_character)
3615 {
3616 sys_suspend ();
3617 return;
3618 }
284f4730 3619 }
3b8f9651 3620 /* Don't insert two BUFFER_SWITCH_EVENT's in a row.
3fe8e9a2 3621 Just ignore the second one. */
3b8f9651 3622 else if (event->kind == BUFFER_SWITCH_EVENT
3fe8e9a2 3623 && kbd_fetch_ptr != kbd_store_ptr
3b8f9651 3624 && kbd_store_ptr->kind == BUFFER_SWITCH_EVENT)
3fe8e9a2 3625 return;
284f4730 3626
beecf6a1
KH
3627 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
3628 kbd_store_ptr = kbd_buffer;
284f4730
JB
3629
3630 /* Don't let the very last slot in the buffer become full,
3631 since that would make the two pointers equal,
3632 and that is indistinguishable from an empty buffer.
3633 Discard the event if it would fill the last slot. */
beecf6a1 3634 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
284f4730 3635 {
da8f7368 3636 int idx;
c60ee5e7 3637
3b8f9651 3638#if 0 /* The SELECTION_REQUEST_EVENT case looks bogus, and it's error
da8f7368
GM
3639 prone to assign individual members for other events, in case
3640 the input_event structure is changed. --2000-07-13, gerd. */
7ee32cda 3641 struct input_event *sp = kbd_store_ptr;
612b78ef 3642 sp->kind = event->kind;
3b8f9651 3643 if (event->kind == SELECTION_REQUEST_EVENT)
27203ead
RS
3644 {
3645 /* We must not use the ordinary copying code for this case,
3646 since `part' is an enum and copying it might not copy enough
3647 in this case. */
612b78ef 3648 bcopy (event, (char *) sp, sizeof (*event));
27203ead
RS
3649 }
3650 else
da8f7368 3651
27203ead 3652 {
612b78ef
KH
3653 sp->code = event->code;
3654 sp->part = event->part;
3655 sp->frame_or_window = event->frame_or_window;
da8f7368 3656 sp->arg = event->arg;
612b78ef
KH
3657 sp->modifiers = event->modifiers;
3658 sp->x = event->x;
3659 sp->y = event->y;
3660 sp->timestamp = event->timestamp;
27203ead 3661 }
da8f7368
GM
3662#else
3663 *kbd_store_ptr = *event;
3664#endif
284f4730 3665
da8f7368
GM
3666 idx = 2 * (kbd_store_ptr - kbd_buffer);
3667 ASET (kbd_buffer_gcpro, idx, event->frame_or_window);
3668 ASET (kbd_buffer_gcpro, idx + 1, event->arg);
3669 ++kbd_store_ptr;
284f4730
JB
3670 }
3671}
8dfd92c9
GM
3672
3673
f139e559 3674/* Generate HELP_EVENT input_events in BUFP which has room for
0bbfdc25
GM
3675 SIZE events. If there's not enough room in BUFP, ignore this
3676 event.
8dfd92c9
GM
3677
3678 HELP is the help form.
3679
3680 FRAME is the frame on which the help is generated. OBJECT is the
5b2ec2d0
GM
3681 Lisp object where the help was found (a buffer, a string, an
3682 overlay, or nil if neither from a string nor from a buffer. POS is
3683 the position within OBJECT where the help was found.
8dfd92c9
GM
3684
3685 Value is the number of input_events generated. */
3686
3687int
0bbfdc25 3688gen_help_event (bufp, size, help, frame, window, object, pos)
8dfd92c9 3689 struct input_event *bufp;
0bbfdc25 3690 int size;
2190735a 3691 Lisp_Object help, frame, object, window;
8dfd92c9
GM
3692 int pos;
3693{
2e1a49ad 3694 if (size >= 1)
0bbfdc25
GM
3695 {
3696 bufp->kind = HELP_EVENT;
3697 bufp->frame_or_window = frame;
3698 bufp->arg = object;
2e1a49ad
SM
3699 bufp->x = WINDOWP (window) ? window : frame;
3700 bufp->y = help;
78134789 3701 bufp->code = pos;
2e1a49ad 3702 return 1;
0bbfdc25 3703 }
2e1a49ad 3704 return 0;
8dfd92c9
GM
3705}
3706
3707
3708/* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3709
3710void
3711kbd_buffer_store_help_event (frame, help)
3712 Lisp_Object frame, help;
3713{
3714 struct input_event event;
3715
3716 event.kind = HELP_EVENT;
3717 event.frame_or_window = frame;
3718 event.arg = Qnil;
2e1a49ad
SM
3719 event.x = Qnil;
3720 event.y = help;
8dfd92c9
GM
3721 event.code = 0;
3722 kbd_buffer_store_event (&event);
8dfd92c9
GM
3723}
3724
a612e298 3725\f
07de30b9 3726/* Discard any mouse events in the event buffer by setting them to
3b8f9651 3727 NO_EVENT. */
07de30b9
GV
3728void
3729discard_mouse_events ()
3730{
3731 struct input_event *sp;
3732 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3733 {
3734 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3735 sp = kbd_buffer;
3736
3b8f9651 3737 if (sp->kind == MOUSE_CLICK_EVENT
8006e4bb 3738 || sp->kind == WHEEL_EVENT
07de30b9 3739#ifdef WINDOWSNT
3b8f9651 3740 || sp->kind == W32_SCROLL_BAR_CLICK_EVENT
07de30b9 3741#endif
3b8f9651 3742 || sp->kind == SCROLL_BAR_CLICK_EVENT)
07de30b9 3743 {
3b8f9651 3744 sp->kind = NO_EVENT;
07de30b9
GV
3745 }
3746 }
3747}
eeabfe76 3748
0bbfdc25
GM
3749
3750/* Return non-zero if there are any real events waiting in the event
3b8f9651 3751 buffer, not counting `NO_EVENT's.
0bbfdc25 3752
3b8f9651 3753 If DISCARD is non-zero, discard NO_EVENT events at the front of
0bbfdc25
GM
3754 the input queue, possibly leaving the input queue empty if there
3755 are no real input events. */
3756
eeabfe76
EZ
3757int
3758kbd_buffer_events_waiting (discard)
3759 int discard;
3760{
3761 struct input_event *sp;
c60ee5e7 3762
0bbfdc25 3763 for (sp = kbd_fetch_ptr;
3b8f9651 3764 sp != kbd_store_ptr && sp->kind == NO_EVENT;
0bbfdc25 3765 ++sp)
eeabfe76
EZ
3766 {
3767 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3768 sp = kbd_buffer;
eeabfe76 3769 }
0bbfdc25 3770
eeabfe76
EZ
3771 if (discard)
3772 kbd_fetch_ptr = sp;
0bbfdc25 3773
3b8f9651 3774 return sp != kbd_store_ptr && sp->kind != NO_EVENT;
eeabfe76 3775}
0bbfdc25 3776
07de30b9 3777\f
0bbfdc25
GM
3778/* Clear input event EVENT. */
3779
3780static INLINE void
3781clear_event (event)
3782 struct input_event *event;
3783{
3784 int idx = 2 * (event - kbd_buffer);
3785 ASET (kbd_buffer_gcpro, idx, Qnil);
3786 ASET (kbd_buffer_gcpro, idx + 1, Qnil);
3b8f9651 3787 event->kind = NO_EVENT;
0bbfdc25
GM
3788}
3789
3790
a612e298
RS
3791/* Read one event from the event buffer, waiting if necessary.
3792 The value is a Lisp object representing the event.
3793 The value is nil for an event that should be ignored,
3794 or that was handled here.
3795 We always read and discard one event. */
284f4730
JB
3796
3797static Lisp_Object
83d68044 3798kbd_buffer_get_event (kbp, used_mouse_menu)
410d4de9 3799 KBOARD **kbp;
83d68044 3800 int *used_mouse_menu;
284f4730
JB
3801{
3802 register int c;
3803 Lisp_Object obj;
3804
3805 if (noninteractive)
3806 {
3807 c = getchar ();
18cd2eeb 3808 XSETINT (obj, c);
f5b56972 3809 *kbp = current_kboard;
284f4730
JB
3810 return obj;
3811 }
3812
3813 /* Wait until there is input available. */
3814 for (;;)
3815 {
beecf6a1
KH
3816 if (kbd_fetch_ptr != kbd_store_ptr)
3817 break;
3818#ifdef HAVE_MOUSE
f3253854 3819 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
284f4730 3820 break;
beecf6a1 3821#endif
284f4730
JB
3822
3823 /* If the quit flag is set, then read_char will return
3824 quit_char, so that counts as "available input." */
3825 if (!NILP (Vquit_flag))
3826 quit_throw_to_read_char ();
3827
3828 /* One way or another, wait until input is available; then, if
3829 interrupt handlers have not read it, read it now. */
3830
3831#ifdef OLDVMS
3832 wait_for_kbd_input ();
3833#else
3834/* Note SIGIO has been undef'd if FIONREAD is missing. */
3835#ifdef SIGIO
3836 gobble_input (0);
3837#endif /* SIGIO */
beecf6a1
KH
3838 if (kbd_fetch_ptr != kbd_store_ptr)
3839 break;
3840#ifdef HAVE_MOUSE
f3253854 3841 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
beecf6a1
KH
3842 break;
3843#endif
3844 {
3845 Lisp_Object minus_one;
f76475ad 3846
beecf6a1 3847 XSETINT (minus_one, -1);
d9d4c147 3848 wait_reading_process_input (0, 0, minus_one, 1);
284f4730 3849
beecf6a1
KH
3850 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
3851 /* Pass 1 for EXPECT since we just waited to have input. */
3852 read_avail_input (1);
3853 }
284f4730
JB
3854#endif /* not VMS */
3855 }
3856
303b5b3f
RS
3857 if (CONSP (Vunread_command_events))
3858 {
3859 Lisp_Object first;
7539e11f
KR
3860 first = XCAR (Vunread_command_events);
3861 Vunread_command_events = XCDR (Vunread_command_events);
303b5b3f
RS
3862 *kbp = current_kboard;
3863 return first;
3864 }
3865
284f4730
JB
3866 /* At this point, we know that there is a readable event available
3867 somewhere. If the event queue is empty, then there must be a
3868 mouse movement enabled and available. */
beecf6a1 3869 if (kbd_fetch_ptr != kbd_store_ptr)
284f4730 3870 {
cd21b839 3871 struct input_event *event;
3e51c7b7 3872
beecf6a1
KH
3873 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3874 ? kbd_fetch_ptr
3875 : kbd_buffer);
3e51c7b7 3876
cd21b839 3877 last_event_timestamp = event->timestamp;
cd21b839 3878
c5fdd383
KH
3879#ifdef MULTI_KBOARD
3880 *kbp = event_to_kboard (event);
3881 if (*kbp == 0)
3882 *kbp = current_kboard; /* Better than returning null ptr? */
5798cf15 3883#else
c5fdd383 3884 *kbp = &the_only_kboard;
5798cf15 3885#endif
beecf6a1 3886
4bb994d1
JB
3887 obj = Qnil;
3888
48e416d4 3889 /* These two kinds of events get special handling
a612e298
RS
3890 and don't actually appear to the command loop.
3891 We return nil for them. */
3b8f9651 3892 if (event->kind == SELECTION_REQUEST_EVENT)
48e416d4 3893 {
598a9fa7 3894#ifdef HAVE_X11
1e8bd3da
RS
3895 struct input_event copy;
3896
4581e928
RS
3897 /* Remove it from the buffer before processing it,
3898 since otherwise swallow_events will see it
3899 and process it again. */
1e8bd3da 3900 copy = *event;
beecf6a1 3901 kbd_fetch_ptr = event + 1;
d9d4c147 3902 input_pending = readable_events (0);
4581e928 3903 x_handle_selection_request (&copy);
598a9fa7
JB
3904#else
3905 /* We're getting selection request events, but we don't have
3906 a window system. */
3907 abort ();
3908#endif
48e416d4
RS
3909 }
3910
3b8f9651 3911 else if (event->kind == SELECTION_CLEAR_EVENT)
48e416d4 3912 {
598a9fa7 3913#ifdef HAVE_X11
e0301c07
RS
3914 struct input_event copy;
3915
3916 /* Remove it from the buffer before processing it. */
3917 copy = *event;
beecf6a1 3918 kbd_fetch_ptr = event + 1;
d9d4c147 3919 input_pending = readable_events (0);
90c2bb0c 3920 x_handle_selection_clear (&copy);
598a9fa7
JB
3921#else
3922 /* We're getting selection request events, but we don't have
3923 a window system. */
3924 abort ();
3925#endif
48e416d4 3926 }
e0f712ba 3927#if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (MAC_OS)
3b8f9651 3928 else if (event->kind == DELETE_WINDOW_EVENT)
990acea3 3929 {
bbdc2092
RS
3930 /* Make an event (delete-frame (FRAME)). */
3931 obj = Fcons (event->frame_or_window, Qnil);
af17bd2b 3932 obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
beecf6a1 3933 kbd_fetch_ptr = event + 1;
af17bd2b 3934 }
1a578e9b
AC
3935#endif
3936#if defined (HAVE_X11) || defined (HAVE_NTGUI)
3b8f9651 3937 else if (event->kind == ICONIFY_EVENT)
af17bd2b
KH
3938 {
3939 /* Make an event (iconify-frame (FRAME)). */
3940 obj = Fcons (event->frame_or_window, Qnil);
3941 obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
beecf6a1 3942 kbd_fetch_ptr = event + 1;
af17bd2b 3943 }
3b8f9651 3944 else if (event->kind == DEICONIFY_EVENT)
af17bd2b
KH
3945 {
3946 /* Make an event (make-frame-visible (FRAME)). */
3947 obj = Fcons (event->frame_or_window, Qnil);
3948 obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
beecf6a1 3949 kbd_fetch_ptr = event + 1;
990acea3
RS
3950 }
3951#endif
3b8f9651 3952 else if (event->kind == BUFFER_SWITCH_EVENT)
a8015ab5
KH
3953 {
3954 /* The value doesn't matter here; only the type is tested. */
18cd2eeb 3955 XSETBUFFER (obj, current_buffer);
beecf6a1 3956 kbd_fetch_ptr = event + 1;
a8015ab5 3957 }
488dd4c4
JD
3958#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
3959 || defined (USE_GTK)
3b8f9651 3960 else if (event->kind == MENU_BAR_ACTIVATE_EVENT)
099787c1
RS
3961 {
3962 kbd_fetch_ptr = event + 1;
d9d4c147 3963 input_pending = readable_events (0);
e649d076
RS
3964 if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
3965 x_activate_menubar (XFRAME (event->frame_or_window));
099787c1 3966 }
1161d367
GV
3967#endif
3968#ifdef WINDOWSNT
3b8f9651 3969 else if (event->kind == LANGUAGE_CHANGE_EVENT)
1161d367
GV
3970 {
3971 /* Make an event (language-change (FRAME CHARSET LCID)). */
3972 obj = Fcons (event->modifiers, Qnil);
15fdc2e3 3973 obj = Fcons (event->code, obj);
1161d367
GV
3974 obj = Fcons (event->frame_or_window, obj);
3975 obj = Fcons (Qlanguage_change, Fcons (obj, Qnil));
3976 kbd_fetch_ptr = event + 1;
3977 }
099787c1 3978#endif
3b8f9651 3979 else if (event->kind == SAVE_SESSION_EVENT)
4ebc27a5
JD
3980 {
3981 obj = Fcons (Qsave_session, Qnil);
3982 kbd_fetch_ptr = event + 1;
3983 }
a612e298 3984 /* Just discard these, by returning nil.
c5fdd383 3985 With MULTI_KBOARD, these events are used as placeholders
5798cf15
KH
3986 when we need to randomly delete events from the queue.
3987 (They shouldn't otherwise be found in the buffer,
3988 but on some machines it appears they do show up
c5fdd383 3989 even without MULTI_KBOARD.) */
3b8f9651 3990 /* On Windows NT/9X, NO_EVENT is used to delete extraneous
07de30b9 3991 mouse events during a popup-menu call. */
3b8f9651 3992 else if (event->kind == NO_EVENT)
beecf6a1 3993 kbd_fetch_ptr = event + 1;
7ee32cda
GM
3994 else if (event->kind == HELP_EVENT)
3995 {
2190735a 3996 Lisp_Object object, position, help, frame, window;
e4457b09 3997
8dfd92c9
GM
3998 frame = event->frame_or_window;
3999 object = event->arg;
2e1a49ad
SM
4000 position = make_number (event->code);
4001 window = event->x;
4002 help = event->y;
0bbfdc25 4003 clear_event (event);
e4457b09
GM
4004
4005 kbd_fetch_ptr = event + 1;
2190735a
GM
4006 if (!WINDOWP (window))
4007 window = Qnil;
4008 obj = Fcons (Qhelp_echo,
4009 list5 (frame, help, window, object, position));
7ee32cda 4010 }
c51c7093
GM
4011 else if (event->kind == FOCUS_IN_EVENT)
4012 {
4013 /* Notification of a FocusIn event. The frame receiving the
4014 focus is in event->frame_or_window. Generate a
4015 switch-frame event if necessary. */
4016 Lisp_Object frame, focus;
4017
4018 frame = event->frame_or_window;
4019 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4020 if (FRAMEP (focus))
4021 frame = focus;
4022
4023 if (!EQ (frame, internal_last_event_frame)
4024 && !EQ (frame, selected_frame))
4025 obj = make_lispy_switch_frame (frame);
4026 internal_last_event_frame = frame;
4027 kbd_fetch_ptr = event + 1;
4028 }
1e12dd87
RS
4029 else
4030 {
c51c7093
GM
4031 /* If this event is on a different frame, return a switch-frame this
4032 time, and leave the event in the queue for next time. */
9b8eb840 4033 Lisp_Object frame;
1e12dd87 4034 Lisp_Object focus;
7b4aedb9 4035
9b8eb840 4036 frame = event->frame_or_window;
2470a66f 4037 if (CONSP (frame))
7539e11f 4038 frame = XCAR (frame);
2470a66f 4039 else if (WINDOWP (frame))
1e12dd87 4040 frame = WINDOW_FRAME (XWINDOW (frame));
4bb994d1 4041
1e12dd87
RS
4042 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4043 if (! NILP (focus))
4044 frame = focus;
07d2b8de 4045
4c52b668 4046 if (! EQ (frame, internal_last_event_frame)
788f89eb 4047 && !EQ (frame, selected_frame))
1e12dd87 4048 obj = make_lispy_switch_frame (frame);
4c52b668 4049 internal_last_event_frame = frame;
4bb994d1 4050
1e12dd87
RS
4051 /* If we didn't decide to make a switch-frame event, go ahead
4052 and build a real event from the queue entry. */
cd21b839 4053
1e12dd87
RS
4054 if (NILP (obj))
4055 {
4056 obj = make_lispy_event (event);
c60ee5e7 4057
488dd4c4
JD
4058#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined(MAC_OS) \
4059 || defined (USE_GTK)
83d68044
KH
4060 /* If this was a menu selection, then set the flag to inhibit
4061 writing to last_nonmenu_event. Don't do this if the event
4062 we're returning is (menu-bar), though; that indicates the
4063 beginning of the menu sequence, and we might as well leave
4064 that as the `event with parameters' for this selection. */
da8f7368
GM
4065 if (used_mouse_menu
4066 && !EQ (event->frame_or_window, event->arg)
4067 && (event->kind == MENU_BAR_EVENT
4068 || event->kind == TOOL_BAR_EVENT))
83d68044
KH
4069 *used_mouse_menu = 1;
4070#endif
1e12dd87
RS
4071
4072 /* Wipe out this event, to catch bugs. */
0bbfdc25 4073 clear_event (event);
beecf6a1 4074 kbd_fetch_ptr = event + 1;
1e12dd87 4075 }
4bb994d1 4076 }
284f4730 4077 }
2eb6bfbe 4078#ifdef HAVE_MOUSE
a612e298 4079 /* Try generating a mouse motion event. */
f3253854 4080 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
284f4730 4081 {
f3253854 4082 FRAME_PTR f = some_mouse_moved ();
7b4aedb9 4083 Lisp_Object bar_window;
3c370943 4084 enum scroll_bar_part part;
e5d77022
JB
4085 Lisp_Object x, y;
4086 unsigned long time;
284f4730 4087
c5fdd383 4088 *kbp = current_kboard;
e177ac3a
RS
4089 /* Note that this uses F to determine which display to look at.
4090 If there is no valid info, it does not store anything
4091 so x remains nil. */
4092 x = Qnil;
dd26ab75 4093 (*mouse_position_hook) (&f, 0, &bar_window, &part, &x, &y, &time);
4bb994d1
JB
4094
4095 obj = Qnil;
284f4730 4096
4bb994d1
JB
4097 /* Decide if we should generate a switch-frame event. Don't
4098 generate switch-frame events for motion outside of all Emacs
4099 frames. */
e177ac3a 4100 if (!NILP (x) && f)
cd21b839 4101 {
9b8eb840 4102 Lisp_Object frame;
4bb994d1 4103
9b8eb840 4104 frame = FRAME_FOCUS_FRAME (f);
4bb994d1 4105 if (NILP (frame))
18cd2eeb 4106 XSETFRAME (frame, f);
4bb994d1 4107
4c52b668 4108 if (! EQ (frame, internal_last_event_frame)
788f89eb 4109 && !EQ (frame, selected_frame))
764cb3f9 4110 obj = make_lispy_switch_frame (frame);
4c52b668 4111 internal_last_event_frame = frame;
cd21b839 4112 }
4bb994d1 4113
df0f2ba1 4114 /* If we didn't decide to make a switch-frame event, go ahead and
4bb994d1 4115 return a mouse-motion event. */
e177ac3a 4116 if (!NILP (x) && NILP (obj))
7b4aedb9 4117 obj = make_lispy_movement (f, bar_window, part, x, y, time);
6cbff1cb 4118 }
2eb6bfbe 4119#endif /* HAVE_MOUSE */
284f4730
JB
4120 else
4121 /* We were promised by the above while loop that there was
4122 something for us to read! */
4123 abort ();
4124
d9d4c147 4125 input_pending = readable_events (0);
284f4730 4126
4c52b668 4127 Vlast_event_frame = internal_last_event_frame;
3c370943 4128
284f4730
JB
4129 return (obj);
4130}
a612e298
RS
4131\f
4132/* Process any events that are not user-visible,
4133 then return, without reading any user-visible events. */
3a3b9632
RS
4134
4135void
d9d4c147
KH
4136swallow_events (do_display)
4137 int do_display;
3a3b9632 4138{
87dd9b9b
RS
4139 int old_timers_run;
4140
beecf6a1 4141 while (kbd_fetch_ptr != kbd_store_ptr)
3a3b9632
RS
4142 {
4143 struct input_event *event;
4144
beecf6a1
KH
4145 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
4146 ? kbd_fetch_ptr
4147 : kbd_buffer);
3a3b9632
RS
4148
4149 last_event_timestamp = event->timestamp;
4150
4151 /* These two kinds of events get special handling
4152 and don't actually appear to the command loop. */
3b8f9651 4153 if (event->kind == SELECTION_REQUEST_EVENT)
3a3b9632
RS
4154 {
4155#ifdef HAVE_X11
4581e928 4156 struct input_event copy;
e0301c07
RS
4157
4158 /* Remove it from the buffer before processing it,
4159 since otherwise swallow_events called recursively could see it
4160 and process it again. */
4581e928 4161 copy = *event;
beecf6a1 4162 kbd_fetch_ptr = event + 1;
d9d4c147 4163 input_pending = readable_events (0);
4581e928 4164 x_handle_selection_request (&copy);
3a3b9632
RS
4165#else
4166 /* We're getting selection request events, but we don't have
4167 a window system. */
4168 abort ();
4169#endif
4170 }
4171
3b8f9651 4172 else if (event->kind == SELECTION_CLEAR_EVENT)
3a3b9632
RS
4173 {
4174#ifdef HAVE_X11
e0301c07
RS
4175 struct input_event copy;
4176
4177 /* Remove it from the buffer before processing it, */
4178 copy = *event;
4179
beecf6a1 4180 kbd_fetch_ptr = event + 1;
d9d4c147 4181 input_pending = readable_events (0);
90c2bb0c 4182 x_handle_selection_clear (&copy);
3a3b9632
RS
4183#else
4184 /* We're getting selection request events, but we don't have
4185 a window system. */
4186 abort ();
4187#endif
4188 }
4189 else
4190 break;
4191 }
4192
87dd9b9b 4193 old_timers_run = timers_run;
d9d4c147 4194 get_input_pending (&input_pending, 1);
87dd9b9b
RS
4195
4196 if (timers_run != old_timers_run && do_display)
3007ebfb 4197 redisplay_preserve_echo_area (7);
3a3b9632 4198}
a612e298 4199\f
d9d4c147
KH
4200/* Record the start of when Emacs is idle,
4201 for the sake of running idle-time timers. */
4202
07a59269 4203void
d9d4c147
KH
4204timer_start_idle ()
4205{
4206 Lisp_Object timers;
4207
4208 /* If we are already in the idle state, do nothing. */
4209 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4210 return;
4211
4212 EMACS_GET_TIME (timer_idleness_start_time);
4213
3021d3a9
RS
4214 timer_last_idleness_start_time = timer_idleness_start_time;
4215
d9d4c147 4216 /* Mark all idle-time timers as once again candidates for running. */
7539e11f 4217 for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers))
d9d4c147
KH
4218 {
4219 Lisp_Object timer;
4220
7539e11f 4221 timer = XCAR (timers);
d9d4c147
KH
4222
4223 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4224 continue;
4225 XVECTOR (timer)->contents[0] = Qnil;
4226 }
4227}
4228
4229/* Record that Emacs is no longer idle, so stop running idle-time timers. */
4230
07a59269 4231void
d9d4c147
KH
4232timer_stop_idle ()
4233{
4234 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
4235}
4236
e044e87c
RS
4237/* This is only for debugging. */
4238struct input_event last_timer_event;
4239
c04cbc3b
RS
4240/* Check whether a timer has fired. To prevent larger problems we simply
4241 disregard elements that are not proper timers. Do not make a circular
4242 timer list for the time being.
4243
4244 Returns the number of seconds to wait until the next timer fires. If a
4245 timer is triggering now, return zero seconds.
4246 If no timer is active, return -1 seconds.
4247
4ec4ed6a
RS
4248 If a timer is ripe, we run it, with quitting turned off.
4249
4250 DO_IT_NOW is now ignored. It used to mean that we should
4251 run the timer directly instead of queueing a timer-event.
4252 Now we always run timers directly. */
c04cbc3b
RS
4253
4254EMACS_TIME
4255timer_check (do_it_now)
4256 int do_it_now;
4257{
4258 EMACS_TIME nexttime;
9291c072
RS
4259 EMACS_TIME now, idleness_now;
4260 Lisp_Object timers, idle_timers, chosen_timer;
9291c072 4261 struct gcpro gcpro1, gcpro2, gcpro3;
c04cbc3b 4262
c04cbc3b
RS
4263 EMACS_SET_SECS (nexttime, -1);
4264 EMACS_SET_USECS (nexttime, -1);
4265
9291c072 4266 /* Always consider the ordinary timers. */
7ea13e12 4267 timers = Vtimer_list;
9291c072
RS
4268 /* Consider the idle timers only if Emacs is idle. */
4269 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4270 idle_timers = Vtimer_idle_list;
4271 else
4272 idle_timers = Qnil;
4273 chosen_timer = Qnil;
4274 GCPRO3 (timers, idle_timers, chosen_timer);
7ea13e12 4275
9291c072 4276 if (CONSP (timers) || CONSP (idle_timers))
c04cbc3b 4277 {
9291c072
RS
4278 EMACS_GET_TIME (now);
4279 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4280 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
4281 }
c04cbc3b 4282
9291c072
RS
4283 while (CONSP (timers) || CONSP (idle_timers))
4284 {
9291c072 4285 Lisp_Object *vector;
8c907a56 4286 Lisp_Object timer = Qnil, idle_timer = Qnil;
9291c072
RS
4287 EMACS_TIME timer_time, idle_timer_time;
4288 EMACS_TIME difference, timer_difference, idle_timer_difference;
4289
4290 /* Skip past invalid timers and timers already handled. */
4291 if (!NILP (timers))
c04cbc3b 4292 {
7539e11f 4293 timer = XCAR (timers);
9291c072
RS
4294 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4295 {
7539e11f 4296 timers = XCDR (timers);
9291c072
RS
4297 continue;
4298 }
4299 vector = XVECTOR (timer)->contents;
d9d4c147 4300
9291c072
RS
4301 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
4302 || !INTEGERP (vector[3])
4303 || ! NILP (vector[0]))
4304 {
7539e11f 4305 timers = XCDR (timers);
9291c072
RS
4306 continue;
4307 }
4308 }
4309 if (!NILP (idle_timers))
4310 {
7539e11f 4311 timer = XCAR (idle_timers);
d9d4c147 4312 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
9291c072 4313 {
7539e11f 4314 idle_timers = XCDR (idle_timers);
9291c072
RS
4315 continue;
4316 }
d9d4c147
KH
4317 vector = XVECTOR (timer)->contents;
4318
4319 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
9291c072
RS
4320 || !INTEGERP (vector[3])
4321 || ! NILP (vector[0]))
4322 {
7539e11f 4323 idle_timers = XCDR (idle_timers);
9291c072
RS
4324 continue;
4325 }
4326 }
d9d4c147 4327
9291c072
RS
4328 /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
4329 based on the next ordinary timer.
4330 TIMER_DIFFERENCE is the distance in time from NOW to when
4331 this timer becomes ripe (negative if it's already ripe). */
4332 if (!NILP (timers))
4333 {
7539e11f 4334 timer = XCAR (timers);
9291c072 4335 vector = XVECTOR (timer)->contents;
d9d4c147
KH
4336 EMACS_SET_SECS (timer_time,
4337 (XINT (vector[1]) << 16) | (XINT (vector[2])));
4338 EMACS_SET_USECS (timer_time, XINT (vector[3]));
9291c072
RS
4339 EMACS_SUB_TIME (timer_difference, timer_time, now);
4340 }
ba8dfba8 4341
9291c072
RS
4342 /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
4343 based on the next idle timer. */
4344 if (!NILP (idle_timers))
4345 {
7539e11f 4346 idle_timer = XCAR (idle_timers);
9291c072
RS
4347 vector = XVECTOR (idle_timer)->contents;
4348 EMACS_SET_SECS (idle_timer_time,
4349 (XINT (vector[1]) << 16) | (XINT (vector[2])));
4350 EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
4351 EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
4352 }
ba8dfba8 4353
9291c072
RS
4354 /* Decide which timer is the next timer,
4355 and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
4356 Also step down the list where we found that timer. */
d9d4c147 4357
9291c072
RS
4358 if (! NILP (timers) && ! NILP (idle_timers))
4359 {
4360 EMACS_TIME temp;
4361 EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
4362 if (EMACS_TIME_NEG_P (temp))
4363 {
4364 chosen_timer = timer;
7539e11f 4365 timers = XCDR (timers);
9291c072 4366 difference = timer_difference;
c04cbc3b 4367 }
d9d4c147 4368 else
d9d4c147 4369 {
9291c072 4370 chosen_timer = idle_timer;
7539e11f 4371 idle_timers = XCDR (idle_timers);
9291c072 4372 difference = idle_timer_difference;
d9d4c147 4373 }
7ea13e12 4374 }
9291c072
RS
4375 else if (! NILP (timers))
4376 {
4377 chosen_timer = timer;
7539e11f 4378 timers = XCDR (timers);
9291c072
RS
4379 difference = timer_difference;
4380 }
4381 else
4382 {
4383 chosen_timer = idle_timer;
7539e11f 4384 idle_timers = XCDR (idle_timers);
9291c072
RS
4385 difference = idle_timer_difference;
4386 }
4387 vector = XVECTOR (chosen_timer)->contents;
c60ee5e7 4388
bd55b860 4389 /* If timer is ripe, run it if it hasn't been run. */
9291c072
RS
4390 if (EMACS_TIME_NEG_P (difference)
4391 || (EMACS_SECS (difference) == 0
4392 && EMACS_USECS (difference) == 0))
4393 {
4394 if (NILP (vector[0]))
4395 {
d925fb39 4396 int was_locked = single_kboard;
331379bf 4397 int count = SPECPDL_INDEX ();
d0bbfc99 4398 Lisp_Object old_deactivate_mark = Vdeactivate_mark;
d925fb39 4399
9291c072
RS
4400 /* Mark the timer as triggered to prevent problems if the lisp
4401 code fails to reschedule it right. */
4402 vector[0] = Qt;
4403
d925fb39 4404 specbind (Qinhibit_quit, Qt);
c60ee5e7 4405
d925fb39 4406 call1 (Qtimer_event_handler, chosen_timer);
d0bbfc99 4407 Vdeactivate_mark = old_deactivate_mark;
d925fb39 4408 timers_run++;
d925fb39 4409 unbind_to (count, Qnil);
4ec4ed6a 4410
d925fb39
RS
4411 /* Resume allowing input from any kboard, if that was true before. */
4412 if (!was_locked)
4413 any_kboard_state ();
9291c072 4414
d925fb39
RS
4415 /* Since we have handled the event,
4416 we don't need to tell the caller to wake up and do it. */
9291c072
RS
4417 }
4418 }
4419 else
4420 /* When we encounter a timer that is still waiting,
4421 return the amount of time to wait before it is ripe. */
4422 {
4423 UNGCPRO;
9291c072
RS
4424 return difference;
4425 }
c04cbc3b 4426 }
9291c072 4427
7ea13e12
RS
4428 /* No timers are pending in the future. */
4429 /* Return 0 if we generated an event, and -1 if not. */
4430 UNGCPRO;
c04cbc3b
RS
4431 return nexttime;
4432}
4433\f
284f4730 4434/* Caches for modify_event_symbol. */
e9bf89a0 4435static Lisp_Object accent_key_syms;
284f4730
JB
4436static Lisp_Object func_key_syms;
4437static Lisp_Object mouse_syms;
8006e4bb 4438static Lisp_Object wheel_syms;
a24dc617 4439static Lisp_Object drag_n_drop_syms;
284f4730 4440
e9bf89a0
RS
4441/* This is a list of keysym codes for special "accent" characters.
4442 It parallels lispy_accent_keys. */
4443
4444static int lispy_accent_codes[] =
4445{
79a7046c 4446#ifdef XK_dead_circumflex
e9bf89a0 4447 XK_dead_circumflex,
79a7046c
RS
4448#else
4449 0,
4450#endif
4451#ifdef XK_dead_grave
e9bf89a0 4452 XK_dead_grave,
79a7046c
RS
4453#else
4454 0,
4455#endif
4456#ifdef XK_dead_tilde
e9bf89a0 4457 XK_dead_tilde,
79a7046c
RS
4458#else
4459 0,
4460#endif
4461#ifdef XK_dead_diaeresis
e9bf89a0 4462 XK_dead_diaeresis,
79a7046c
RS
4463#else
4464 0,
4465#endif
4466#ifdef XK_dead_macron
e9bf89a0 4467 XK_dead_macron,
79a7046c
RS
4468#else
4469 0,
4470#endif
4471#ifdef XK_dead_degree
e9bf89a0 4472 XK_dead_degree,
79a7046c
RS
4473#else
4474 0,
4475#endif
4476#ifdef XK_dead_acute
e9bf89a0 4477 XK_dead_acute,
79a7046c
RS
4478#else
4479 0,
4480#endif
4481#ifdef XK_dead_cedilla
e9bf89a0 4482 XK_dead_cedilla,
79a7046c
RS
4483#else
4484 0,
4485#endif
4486#ifdef XK_dead_breve
e9bf89a0 4487 XK_dead_breve,
79a7046c
RS
4488#else
4489 0,
4490#endif
4491#ifdef XK_dead_ogonek
e9bf89a0 4492 XK_dead_ogonek,
79a7046c
RS
4493#else
4494 0,
4495#endif
4496#ifdef XK_dead_caron
e9bf89a0 4497 XK_dead_caron,
79a7046c
RS
4498#else
4499 0,
4500#endif
4501#ifdef XK_dead_doubleacute
e9bf89a0 4502 XK_dead_doubleacute,
79a7046c
RS
4503#else
4504 0,
4505#endif
4506#ifdef XK_dead_abovedot
e9bf89a0 4507 XK_dead_abovedot,
79a7046c
RS
4508#else
4509 0,
4510#endif
ed3230db
DL
4511#ifdef XK_dead_abovering
4512 XK_dead_abovering,
4513#else
4514 0,
4515#endif
4516#ifdef XK_dead_iota
4517 XK_dead_iota,
4518#else
4519 0,
4520#endif
4521#ifdef XK_dead_belowdot
4522 XK_dead_belowdot,
4523#else
4524 0,
4525#endif
4526#ifdef XK_dead_voiced_sound
4527 XK_dead_voiced_sound,
4528#else
4529 0,
4530#endif
4531#ifdef XK_dead_semivoiced_sound
4532 XK_dead_semivoiced_sound,
4533#else
4534 0,
4535#endif
4536#ifdef XK_dead_hook
4537 XK_dead_hook,
4538#else
4539 0,
4540#endif
4541#ifdef XK_dead_horn
4542 XK_dead_horn,
4543#else
4544 0,
4545#endif
e9bf89a0
RS
4546};
4547
4548/* This is a list of Lisp names for special "accent" characters.
4549 It parallels lispy_accent_codes. */
4550
4551static char *lispy_accent_keys[] =
4552{
4553 "dead-circumflex",
4554 "dead-grave",
4555 "dead-tilde",
4556 "dead-diaeresis",
4557 "dead-macron",
4558 "dead-degree",
4559 "dead-acute",
4560 "dead-cedilla",
4561 "dead-breve",
4562 "dead-ogonek",
4563 "dead-caron",
4564 "dead-doubleacute",
4565 "dead-abovedot",
ed3230db
DL
4566 "dead-abovering",
4567 "dead-iota",
4568 "dead-belowdot",
4569 "dead-voiced-sound",
4570 "dead-semivoiced-sound",
4571 "dead-hook",
4572 "dead-horn",
e9bf89a0
RS
4573};
4574
e98a93eb
GV
4575#ifdef HAVE_NTGUI
4576#define FUNCTION_KEY_OFFSET 0x0
4577
4578char *lispy_function_keys[] =
4579 {
4580 0, /* 0 */
c60ee5e7 4581
e98a93eb
GV
4582 0, /* VK_LBUTTON 0x01 */
4583 0, /* VK_RBUTTON 0x02 */
4584 "cancel", /* VK_CANCEL 0x03 */
4585 0, /* VK_MBUTTON 0x04 */
c60ee5e7 4586
e98a93eb 4587 0, 0, 0, /* 0x05 .. 0x07 */
c60ee5e7 4588
e98a93eb
GV
4589 "backspace", /* VK_BACK 0x08 */
4590 "tab", /* VK_TAB 0x09 */
c60ee5e7 4591
e98a93eb 4592 0, 0, /* 0x0A .. 0x0B */
c60ee5e7 4593
e98a93eb
GV
4594 "clear", /* VK_CLEAR 0x0C */
4595 "return", /* VK_RETURN 0x0D */
c60ee5e7 4596
e98a93eb 4597 0, 0, /* 0x0E .. 0x0F */
c60ee5e7 4598
1161d367
GV
4599 0, /* VK_SHIFT 0x10 */
4600 0, /* VK_CONTROL 0x11 */
4601 0, /* VK_MENU 0x12 */
e98a93eb 4602 "pause", /* VK_PAUSE 0x13 */
1161d367 4603 "capslock", /* VK_CAPITAL 0x14 */
c60ee5e7 4604
e98a93eb 4605 0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */
c60ee5e7 4606
1161d367 4607 "escape", /* VK_ESCAPE 0x1B */
c60ee5e7 4608
e98a93eb 4609 0, 0, 0, 0, /* 0x1C .. 0x1F */
c60ee5e7 4610
e98a93eb
GV
4611 0, /* VK_SPACE 0x20 */
4612 "prior", /* VK_PRIOR 0x21 */
4613 "next", /* VK_NEXT 0x22 */
4614 "end", /* VK_END 0x23 */
4615 "home", /* VK_HOME 0x24 */
4616 "left", /* VK_LEFT 0x25 */
4617 "up", /* VK_UP 0x26 */
4618 "right", /* VK_RIGHT 0x27 */
4619 "down", /* VK_DOWN 0x28 */
4620 "select", /* VK_SELECT 0x29 */
4621 "print", /* VK_PRINT 0x2A */
4622 "execute", /* VK_EXECUTE 0x2B */
4623 "snapshot", /* VK_SNAPSHOT 0x2C */
4624 "insert", /* VK_INSERT 0x2D */
4625 "delete", /* VK_DELETE 0x2E */
4626 "help", /* VK_HELP 0x2F */
c60ee5e7 4627
e98a93eb 4628 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
c60ee5e7 4629
e98a93eb 4630 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
c60ee5e7 4631
e98a93eb 4632 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
c60ee5e7 4633
e98a93eb 4634 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
c60ee5e7
JB
4635
4636 0, 0, 0, 0, 0, 0, 0, 0, 0,
4637 0, 0, 0, 0, 0, 0, 0, 0, 0,
e98a93eb 4638 0, 0, 0, 0, 0, 0, 0, 0,
c60ee5e7 4639
e376f90d
RS
4640 "lwindow", /* VK_LWIN 0x5B */
4641 "rwindow", /* VK_RWIN 0x5C */
4642 "apps", /* VK_APPS 0x5D */
c60ee5e7 4643
e98a93eb 4644 0, 0, /* 0x5E .. 0x5F */
c60ee5e7 4645
e98a93eb
GV
4646 "kp-0", /* VK_NUMPAD0 0x60 */
4647 "kp-1", /* VK_NUMPAD1 0x61 */
4648 "kp-2", /* VK_NUMPAD2 0x62 */
4649 "kp-3", /* VK_NUMPAD3 0x63 */
4650 "kp-4", /* VK_NUMPAD4 0x64 */
4651 "kp-5", /* VK_NUMPAD5 0x65 */
4652 "kp-6", /* VK_NUMPAD6 0x66 */
4653 "kp-7", /* VK_NUMPAD7 0x67 */
4654 "kp-8", /* VK_NUMPAD8 0x68 */
4655 "kp-9", /* VK_NUMPAD9 0x69 */
4656 "kp-multiply", /* VK_MULTIPLY 0x6A */
4657 "kp-add", /* VK_ADD 0x6B */
4658 "kp-separator", /* VK_SEPARATOR 0x6C */
4659 "kp-subtract", /* VK_SUBTRACT 0x6D */
4660 "kp-decimal", /* VK_DECIMAL 0x6E */
4661 "kp-divide", /* VK_DIVIDE 0x6F */
4662 "f1", /* VK_F1 0x70 */
4663 "f2", /* VK_F2 0x71 */
4664 "f3", /* VK_F3 0x72 */
4665 "f4", /* VK_F4 0x73 */
4666 "f5", /* VK_F5 0x74 */
4667 "f6", /* VK_F6 0x75 */
4668 "f7", /* VK_F7 0x76 */
4669 "f8", /* VK_F8 0x77 */
4670 "f9", /* VK_F9 0x78 */
4671 "f10", /* VK_F10 0x79 */
4672 "f11", /* VK_F11 0x7A */
4673 "f12", /* VK_F12 0x7B */
4674 "f13", /* VK_F13 0x7C */
4675 "f14", /* VK_F14 0x7D */
4676 "f15", /* VK_F15 0x7E */
4677 "f16", /* VK_F16 0x7F */
4678 "f17", /* VK_F17 0x80 */
4679 "f18", /* VK_F18 0x81 */
4680 "f19", /* VK_F19 0x82 */
4681 "f20", /* VK_F20 0x83 */
4682 "f21", /* VK_F21 0x84 */
4683 "f22", /* VK_F22 0x85 */
4684 "f23", /* VK_F23 0x86 */
4685 "f24", /* VK_F24 0x87 */
c60ee5e7 4686
e98a93eb
GV
4687 0, 0, 0, 0, /* 0x88 .. 0x8B */
4688 0, 0, 0, 0, /* 0x8C .. 0x8F */
c60ee5e7 4689
e98a93eb
GV
4690 "kp-numlock", /* VK_NUMLOCK 0x90 */
4691 "scroll", /* VK_SCROLL 0x91 */
c60ee5e7 4692
e376f90d
RS
4693 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
4694 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
4695 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
4696 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
4697 "kp-end", /* VK_NUMPAD_END 0x96 */
4698 "kp-home", /* VK_NUMPAD_HOME 0x97 */
4699 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
4700 "kp-up", /* VK_NUMPAD_UP 0x99 */
4701 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
4702 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
4703 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
4704 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
4705
4706 0, 0, /* 0x9E .. 0x9F */
4707
e98a93eb
GV
4708 /*
4709 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
e8886a1d 4710 * Used only as parameters to GetAsyncKeyState and GetKeyState.
e98a93eb
GV
4711 * No other API or message will distinguish left and right keys this way.
4712 */
4713 /* 0xA0 .. 0xEF */
c60ee5e7 4714
e98a93eb
GV
4715 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4716 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4717 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4718 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4719 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
c60ee5e7 4720
e98a93eb 4721 /* 0xF0 .. 0xF5 */
c60ee5e7 4722
e98a93eb 4723 0, 0, 0, 0, 0, 0,
c60ee5e7 4724
e98a93eb
GV
4725 "attn", /* VK_ATTN 0xF6 */
4726 "crsel", /* VK_CRSEL 0xF7 */
4727 "exsel", /* VK_EXSEL 0xF8 */
4728 "ereof", /* VK_EREOF 0xF9 */
4729 "play", /* VK_PLAY 0xFA */
4730 "zoom", /* VK_ZOOM 0xFB */
4731 "noname", /* VK_NONAME 0xFC */
4732 "pa1", /* VK_PA1 0xFD */
4733 "oem_clear", /* VK_OEM_CLEAR 0xFE */
1161d367 4734 0 /* 0xFF */
e98a93eb
GV
4735 };
4736
04f215f0 4737#else /* not HAVE_NTGUI */
e98a93eb 4738
ed3230db
DL
4739/* This should be dealt with in XTread_socket now, and that doesn't
4740 depend on the client system having the Kana syms defined. See also
4741 the XK_kana_A case below. */
4742#if 0
37cd9f30
KH
4743#ifdef XK_kana_A
4744static char *lispy_kana_keys[] =
4745 {
4746 /* X Keysym value */
4747 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
4748 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
4749 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
4750 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
4751 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
4752 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
4753 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
4754 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
4755 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
4756 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
c60ee5e7 4757 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
37cd9f30
KH
4758 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
4759 "kana-i", "kana-u", "kana-e", "kana-o",
4760 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
4761 "prolongedsound", "kana-A", "kana-I", "kana-U",
4762 "kana-E", "kana-O", "kana-KA", "kana-KI",
4763 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
4764 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
4765 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
4766 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
4767 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
4768 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
4769 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
4770 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
4771 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
4772 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
4773 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
4774 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
4775 };
4776#endif /* XK_kana_A */
ed3230db 4777#endif /* 0 */
37cd9f30 4778
04f215f0
RS
4779#define FUNCTION_KEY_OFFSET 0xff00
4780
284f4730
JB
4781/* You'll notice that this table is arranged to be conveniently
4782 indexed by X Windows keysym values. */
4783static char *lispy_function_keys[] =
4784 {
4785 /* X Keysym value */
4786
75045dcb
RS
4787 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
4788 "backspace", "tab", "linefeed", "clear",
4789 0, "return", 0, 0,
4790 0, 0, 0, "pause", /* 0xff10...1f */
4791 0, 0, 0, 0, 0, 0, 0, "escape",
86e5706b 4792 0, 0, 0, 0,
75045dcb
RS
4793 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
4794 "romaji", "hiragana", "katakana", "hiragana-katakana",
4795 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
4796 "massyo", "kana-lock", "kana-shift", "eisu-shift",
4797 "eisu-toggle", /* 0xff30...3f */
4798 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
86e5706b
RS
4799 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
4800
75045dcb
RS
4801 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
4802 "down", "prior", "next", "end",
4803 "begin", 0, 0, 0, 0, 0, 0, 0,
284f4730
JB
4804 "select", /* 0xff60 */ /* IsMiscFunctionKey */
4805 "print",
4806 "execute",
4807 "insert",
4808 0, /* 0xff64 */
4809 "undo",
4810 "redo",
4811 "menu",
4812 "find",
4813 "cancel",
4814 "help",
4815 "break", /* 0xff6b */
4816
75045dcb
RS
4817 0, 0, 0, 0,
4818 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
4819 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
284f4730
JB
4820 "kp-space", /* 0xff80 */ /* IsKeypadKey */
4821 0, 0, 0, 0, 0, 0, 0, 0,
4822 "kp-tab", /* 0xff89 */
4823 0, 0, 0,
4824 "kp-enter", /* 0xff8d */
4825 0, 0, 0,
4826 "kp-f1", /* 0xff91 */
4827 "kp-f2",
4828 "kp-f3",
4829 "kp-f4",
872157e7
RS
4830 "kp-home", /* 0xff95 */
4831 "kp-left",
4832 "kp-up",
4833 "kp-right",
4834 "kp-down",
4835 "kp-prior", /* kp-page-up */
4836 "kp-next", /* kp-page-down */
4837 "kp-end",
4838 "kp-begin",
4839 "kp-insert",
4840 "kp-delete",
4841 0, /* 0xffa0 */
4842 0, 0, 0, 0, 0, 0, 0, 0, 0,
284f4730
JB
4843 "kp-multiply", /* 0xffaa */
4844 "kp-add",
4845 "kp-separator",
4846 "kp-subtract",
4847 "kp-decimal",
4848 "kp-divide", /* 0xffaf */
4849 "kp-0", /* 0xffb0 */
4850 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
4851 0, /* 0xffba */
4852 0, 0,
4853 "kp-equal", /* 0xffbd */
4854 "f1", /* 0xffbe */ /* IsFunctionKey */
86e5706b
RS
4855 "f2",
4856 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
4857 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
4858 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
4859 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
4860 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
4861 0, 0, 0, 0, 0, 0, 0, 0,
4862 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
4863 0, 0, 0, 0, 0, 0, 0, "delete"
04f215f0 4864 };
284f4730 4865
04f215f0
RS
4866/* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
4867#define ISO_FUNCTION_KEY_OFFSET 0xfe00
4868
4869static char *iso_lispy_function_keys[] =
4870 {
4871 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
4872 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
4873 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
4874 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
4875 "iso-lefttab", /* 0xfe20 */
c60ee5e7
JB
4876 "iso-move-line-up", "iso-move-line-down",
4877 "iso-partial-line-up", "iso-partial-line-down",
4878 "iso-partial-space-left", "iso-partial-space-right",
04f215f0
RS
4879 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
4880 "iso-release-margin-left", "iso-release-margin-right",
4881 "iso-release-both-margins",
4882 "iso-fast-cursor-left", "iso-fast-cursor-right",
4883 "iso-fast-cursor-up", "iso-fast-cursor-down",
4884 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
4885 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
4886 };
4887
4888#endif /* not HAVE_NTGUI */
e98a93eb 4889
8e1e4240 4890Lisp_Object Vlispy_mouse_stem;
284f4730 4891
8006e4bb
JR
4892static char *lispy_wheel_names[] =
4893{
4894 "wheel-up", "wheel-down"
4895};
4896
a24dc617
RS
4897/* drag-n-drop events are generated when a set of selected files are
4898 dragged from another application and dropped onto an Emacs window. */
4899static char *lispy_drag_n_drop_names[] =
4900{
4901 "drag-n-drop"
4902};
4903
3c370943 4904/* Scroll bar parts. */
4bb994d1 4905Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
7ee32cda 4906Lisp_Object Qup, Qdown, Qbottom, Qend_scroll;
eef28553 4907Lisp_Object Qtop, Qratio;
4bb994d1 4908
3c370943
JB
4909/* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
4910Lisp_Object *scroll_bar_parts[] = {
db08707d 4911 &Qabove_handle, &Qhandle, &Qbelow_handle,
eef28553 4912 &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio
4bb994d1
JB
4913};
4914
5bf68f6e
AS
4915/* User signal events. */
4916Lisp_Object Qusr1_signal, Qusr2_signal;
4917
4918Lisp_Object *lispy_user_signals[] =
4919{
4920 &Qusr1_signal, &Qusr2_signal
4921};
4922
4bb994d1 4923
7b4aedb9 4924/* A vector, indexed by button number, giving the down-going location
3c370943 4925 of currently depressed buttons, both scroll bar and non-scroll bar.
7b4aedb9
JB
4926
4927 The elements have the form
4928 (BUTTON-NUMBER MODIFIER-MASK . REST)
4929 where REST is the cdr of a position as it would be reported in the event.
4930
4931 The make_lispy_event function stores positions here to tell the
4932 difference between click and drag events, and to store the starting
4933 location to be included in drag events. */
4934
4935static Lisp_Object button_down_location;
88cb0656 4936
fbcd35bd
JB
4937/* Information about the most recent up-going button event: Which
4938 button, what location, and what time. */
4939
559f9d04
RS
4940static int last_mouse_button;
4941static int last_mouse_x;
4942static int last_mouse_y;
4943static unsigned long button_down_time;
fbcd35bd 4944
222d557c
GM
4945/* The maximum time between clicks to make a double-click, or Qnil to
4946 disable double-click detection, or Qt for no time limit. */
4947
564dc952 4948Lisp_Object Vdouble_click_time;
fbcd35bd 4949
222d557c
GM
4950/* Maximum number of pixels the mouse may be moved between clicks
4951 to make a double-click. */
4952
31ade731 4953EMACS_INT double_click_fuzz;
222d557c 4954
fbcd35bd
JB
4955/* The number of clicks in this multiple-click. */
4956
4957int double_click_count;
4958
3d566707
KS
4959/* Return position of a mouse click or wheel event */
4960
4961static Lisp_Object
4962make_lispy_position (f, x, y, time)
4963 struct frame *f;
4964 Lisp_Object *x, *y;
4965 unsigned long time;
4966{
4967 Lisp_Object window;
4968 enum window_part part;
4969 Lisp_Object posn = Qnil;
4970 Lisp_Object extra_info = Qnil;
4971 int wx, wy;
4972
4973 /* Set `window' to the window under frame pixel coordinates (x,y) */
4974 if (f)
4975 window = window_from_coordinates (f, XINT (*x), XINT (*y),
4976 &part, &wx, &wy, 0);
4977 else
4978 window = Qnil;
4979
4980 if (WINDOWP (window))
4981 {
4982 /* It's a click in window window at frame coordinates (x,y) */
4983 struct window *w = XWINDOW (window);
4984 Lisp_Object object = Qnil;
4985 int textpos = -1, rx = -1, ry = -1;
4986
4987 /* Set event coordinates to window-relative coordinates
4988 for constructing the Lisp event below. */
4989 XSETINT (*x, wx);
4990 XSETINT (*y, wy);
4991
4992 if (part == ON_MODE_LINE || part == ON_HEADER_LINE)
4993 {
4994 /* Mode line or header line. Look for a string under
4995 the mouse that may have a `local-map' property. */
4996 Lisp_Object string;
4997 int charpos;
4998
4999 posn = part == ON_MODE_LINE ? Qmode_line : Qheader_line;
5000 rx = wx, ry = wy;
5001 string = mode_line_string (w, &rx, &ry, part, &charpos);
5002 if (STRINGP (string))
5003 object = Fcons (string, make_number (charpos));
5004 if (w == XWINDOW (selected_window))
5005 textpos = PT;
5006 else
5007 textpos = XMARKER (w->pointm)->charpos;
5008 }
5009 else if (part == ON_VERTICAL_BORDER)
5010 {
5011 posn = Qvertical_line;
5012 wx = -1;
5013 }
5014 else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
5015 {
5016 Lisp_Object string;
5017 int charpos;
5018
5019 posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin;
5020 rx = wx, ry = wy;
5021 string = marginal_area_string (w, &rx, &ry, part, &charpos);
5022 if (STRINGP (string))
5023 object = Fcons (string, make_number (charpos));
5024 }
5025 else if (part == ON_LEFT_FRINGE || part == ON_RIGHT_FRINGE)
5026 {
5027 posn = (part == ON_LEFT_FRINGE) ? Qleft_fringe : Qright_fringe;
5028 rx = 0;
5029 }
5030
5031 if (textpos < 0)
5032 {
5033 Lisp_Object string;
5034 struct display_pos p;
5035 wx = max (WINDOW_LEFT_MARGIN_WIDTH (w), wx);
5036 buffer_posn_from_coords (w, &wx, &wy, &string, &p);
5037 textpos = CHARPOS (p.pos);
5038 if (rx < 0)
5039 rx = wx;
5040 if (ry < 0)
5041 ry = wy;
5042
5043 if (NILP (posn))
5044 {
5045 posn = make_number (textpos);
5046 if (STRINGP (string))
5047 object = Fcons (string,
5048 make_number (CHARPOS (p.string_pos)));
5049 }
5050 }
5051
5052 extra_info = Fcons (object,
5053 Fcons (make_number (textpos),
5054 Fcons (Fcons (make_number (rx),
5055 make_number (ry)),
5056 Qnil)));
5057 }
5058 else if (f != 0)
5059 {
5060 XSETFRAME (window, f);
5061 }
5062 else
5063 {
5064 window = Qnil;
5065 XSETFASTINT (*x, 0);
5066 XSETFASTINT (*y, 0);
5067 }
5068
5069 return Fcons (window,
5070 Fcons (posn,
5071 Fcons (Fcons (*x, *y),
5072 Fcons (make_number (time),
5073 extra_info))));
5074}
5075
284f4730
JB
5076/* Given a struct input_event, build the lisp event which represents
5077 it. If EVENT is 0, build a mouse movement event from the mouse
88cb0656
JB
5078 movement buffer, which should have a movement event in it.
5079
5080 Note that events must be passed to this function in the order they
5081 are received; this function stores the location of button presses
5082 in order to build drag events when the button is released. */
284f4730
JB
5083
5084static Lisp_Object
5085make_lispy_event (event)
5086 struct input_event *event;
5087{
79a7046c
RS
5088 int i;
5089
0220c518 5090 switch (SWITCH_ENUM_CAST (event->kind))
284f4730 5091 {
284f4730 5092 /* A simple keystroke. */
3b8f9651 5093 case ASCII_KEYSTROKE_EVENT:
86e5706b 5094 {
9343ab07 5095 Lisp_Object lispy_c;
e9bf89a0 5096 int c = event->code & 0377;
5a1c6df8
JB
5097 /* Turn ASCII characters into control characters
5098 when proper. */
5099 if (event->modifiers & ctrl_modifier)
d205953b
JB
5100 c = make_ctrl_char (c);
5101
5102 /* Add in the other modifier bits. We took care of ctrl_modifier
5103 just above, and the shift key was taken care of by the X code,
5104 and applied to control characters by make_ctrl_char. */
86e5706b
RS
5105 c |= (event->modifiers
5106 & (meta_modifier | alt_modifier
5107 | hyper_modifier | super_modifier));
32454a9f
RS
5108 /* Distinguish Shift-SPC from SPC. */
5109 if ((event->code & 0377) == 040
5110 && event->modifiers & shift_modifier)
5111 c |= shift_modifier;
559f9d04 5112 button_down_time = 0;
bb9e9bed 5113 XSETFASTINT (lispy_c, c);
9343ab07 5114 return lispy_c;
86e5706b 5115 }
284f4730 5116
3b8f9651 5117 case MULTIBYTE_CHAR_KEYSTROKE_EVENT:
a50e723f
KH
5118 {
5119 Lisp_Object lispy_c;
24d80a06 5120 int c = event->code;
a50e723f 5121
24d80a06
SM
5122 /* Add in the other modifier bits. We took care of ctrl_modifier
5123 just above, and the shift key was taken care of by the X code,
5124 and applied to control characters by make_ctrl_char. */
5125 c |= (event->modifiers
5126 & (meta_modifier | alt_modifier
5127 | hyper_modifier | super_modifier | ctrl_modifier));
5128 /* What about the `shift' modifier ? */
5129 button_down_time = 0;
5130 XSETFASTINT (lispy_c, c);
a50e723f
KH
5131 return lispy_c;
5132 }
5133
284f4730
JB
5134 /* A function key. The symbol may need to have modifier prefixes
5135 tacked onto it. */
3b8f9651 5136 case NON_ASCII_KEYSTROKE_EVENT:
559f9d04 5137 button_down_time = 0;
e9bf89a0
RS
5138
5139 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
5140 if (event->code == lispy_accent_codes[i])
5141 return modify_event_symbol (i,
5142 event->modifiers,
80e4aa30 5143 Qfunction_key, Qnil,
e9bf89a0
RS
5144 lispy_accent_keys, &accent_key_syms,
5145 (sizeof (lispy_accent_keys)
5146 / sizeof (lispy_accent_keys[0])));
5147
ed3230db 5148#if 0
37cd9f30
KH
5149#ifdef XK_kana_A
5150 if (event->code >= 0x400 && event->code < 0x500)
5151 return modify_event_symbol (event->code - 0x400,
5152 event->modifiers & ~shift_modifier,
5153 Qfunction_key, Qnil,
5154 lispy_kana_keys, &func_key_syms,
5155 (sizeof (lispy_kana_keys)
5156 / sizeof (lispy_kana_keys[0])));
5157#endif /* XK_kana_A */
ed3230db 5158#endif /* 0 */
37cd9f30 5159
111c4138 5160#ifdef ISO_FUNCTION_KEY_OFFSET
04f215f0
RS
5161 if (event->code < FUNCTION_KEY_OFFSET
5162 && event->code >= ISO_FUNCTION_KEY_OFFSET)
5163 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
5164 event->modifiers,
5165 Qfunction_key, Qnil,
5166 iso_lispy_function_keys, &func_key_syms,
5167 (sizeof (iso_lispy_function_keys)
5168 / sizeof (iso_lispy_function_keys[0])));
111c4138 5169#endif
656280a6 5170
4c8bc894
SM
5171 /* Handle system-specific or unknown keysyms. */
5172 if (event->code & (1 << 28)
5173 || event->code - FUNCTION_KEY_OFFSET < 0
656280a6 5174 || (event->code - FUNCTION_KEY_OFFSET
4c8bc894
SM
5175 >= sizeof lispy_function_keys / sizeof *lispy_function_keys)
5176 || !lispy_function_keys[event->code - FUNCTION_KEY_OFFSET])
656280a6 5177 {
4c8bc894
SM
5178 /* We need to use an alist rather than a vector as the cache
5179 since we can't make a vector long enuf. */
5180 if (NILP (current_kboard->system_key_syms))
5181 current_kboard->system_key_syms = Fcons (Qnil, Qnil);
5182 return modify_event_symbol (event->code,
5183 event->modifiers,
5184 Qfunction_key,
5185 current_kboard->Vsystem_key_alist,
5186 0, &current_kboard->system_key_syms,
5187 (unsigned) -1);
656280a6 5188 }
656280a6
GM
5189
5190 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
5191 event->modifiers,
5192 Qfunction_key, Qnil,
5193 lispy_function_keys, &func_key_syms,
5194 (sizeof (lispy_function_keys)
5195 / sizeof (lispy_function_keys[0])));
284f4730 5196
514354e9 5197#ifdef HAVE_MOUSE
df0f2ba1 5198 /* A mouse click. Figure out where it is, decide whether it's
88cb0656 5199 a press, click or drag, and build the appropriate structure. */
3b8f9651 5200 case MOUSE_CLICK_EVENT:
7ee32cda 5201#ifndef USE_TOOLKIT_SCROLL_BARS
3b8f9651 5202 case SCROLL_BAR_CLICK_EVENT:
7ee32cda 5203#endif
284f4730 5204 {
e9bf89a0 5205 int button = event->code;
559f9d04 5206 int is_double;
7b4aedb9 5207 Lisp_Object position;
dbc4e1c1
JB
5208 Lisp_Object *start_pos_ptr;
5209 Lisp_Object start_pos;
284f4730 5210
8c907a56
GM
5211 position = Qnil;
5212
7b4aedb9 5213 /* Build the position as appropriate for this mouse click. */
3b8f9651 5214 if (event->kind == MOUSE_CLICK_EVENT)
284f4730 5215 {
c5cf2109 5216 struct frame *f = XFRAME (event->frame_or_window);
3d566707 5217#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
9e20143a 5218 int row, column;
3d566707 5219#endif
9e20143a 5220
5da3133a
RS
5221 /* Ignore mouse events that were made on frame that
5222 have been deleted. */
5223 if (! FRAME_LIVE_P (f))
5224 return Qnil;
5225
3d566707 5226#if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
7ee32cda
GM
5227 /* EVENT->x and EVENT->y are frame-relative pixel
5228 coordinates at this place. Under old redisplay, COLUMN
5229 and ROW are set to frame relative glyph coordinates
5230 which are then used to determine whether this click is
5231 in a menu (non-toolkit version). */
5232 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
5233 &column, &row, NULL, 1);
7b4aedb9 5234
eef045bf
RS
5235 /* In the non-toolkit version, clicks on the menu bar
5236 are ordinary button events in the event buffer.
5237 Distinguish them, and invoke the menu.
5238
5239 (In the toolkit version, the toolkit handles the menu bar
5240 and Emacs doesn't know about it until after the user
5241 makes a selection.) */
2ee250ec
RS
5242 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
5243 && (event->modifiers & down_modifier))
bb936752 5244 {
b7c49376 5245 Lisp_Object items, item;
0a0e8fe6
RS
5246 int hpos;
5247 int i;
5248
2ee250ec 5249#if 0
0a0e8fe6
RS
5250 /* Activate the menu bar on the down event. If the
5251 up event comes in before the menu code can deal with it,
5252 just ignore it. */
5253 if (! (event->modifiers & down_modifier))
5254 return Qnil;
2ee250ec 5255#endif
0aafc975 5256
7ee32cda 5257 /* Find the menu bar item under `column'. */
f2ae6b3f 5258 item = Qnil;
5ec75a55 5259 items = FRAME_MENU_BAR_ITEMS (f);
35b3402f 5260 for (i = 0; i < XVECTOR (items)->size; i += 4)
5ec75a55
RS
5261 {
5262 Lisp_Object pos, string;
129004d3
GM
5263 string = AREF (items, i + 1);
5264 pos = AREF (items, i + 3);
b7c49376
RS
5265 if (NILP (string))
5266 break;
9e20143a 5267 if (column >= XINT (pos)
d5db4077 5268 && column < XINT (pos) + SCHARS (string))
b7c49376 5269 {
129004d3 5270 item = AREF (items, i);
b7c49376
RS
5271 break;
5272 }
5ec75a55 5273 }
9e20143a 5274
7ee32cda
GM
5275 /* ELisp manual 2.4b says (x y) are window relative but
5276 code says they are frame-relative. */
5ec75a55
RS
5277 position
5278 = Fcons (event->frame_or_window,
5279 Fcons (Qmenu_bar,
5280 Fcons (Fcons (event->x, event->y),
5281 Fcons (make_number (event->timestamp),
5282 Qnil))));
5283
b7c49376 5284 return Fcons (item, Fcons (position, Qnil));
5ec75a55 5285 }
488dd4c4 5286#endif /* not USE_X_TOOLKIT && not USE_GTK */
0aafc975 5287
3d566707
KS
5288 position = make_lispy_position (f, &event->x, &event->y,
5289 event->timestamp);
284f4730 5290 }
7ee32cda 5291#ifndef USE_TOOLKIT_SCROLL_BARS
7b4aedb9 5292 else
88cb0656 5293 {
7ee32cda 5294 /* It's a scrollbar click. */
3d566707 5295 Lisp_Object window;
9e20143a
RS
5296 Lisp_Object portion_whole;
5297 Lisp_Object part;
5298
5299 window = event->frame_or_window;
5300 portion_whole = Fcons (event->x, event->y);
5301 part = *scroll_bar_parts[(int) event->part];
7b4aedb9 5302
db08707d
RS
5303 position
5304 = Fcons (window,
5305 Fcons (Qvertical_scroll_bar,
5306 Fcons (portion_whole,
5307 Fcons (make_number (event->timestamp),
5308 Fcons (part, Qnil)))));
88cb0656 5309 }
7ee32cda 5310#endif /* not USE_TOOLKIT_SCROLL_BARS */
88cb0656 5311
129004d3 5312 if (button >= ASIZE (button_down_location))
8e1e4240
GM
5313 {
5314 button_down_location = larger_vector (button_down_location,
5315 button + 1, Qnil);
5316 mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
5317 }
c60ee5e7 5318
129004d3 5319 start_pos_ptr = &AREF (button_down_location, button);
dbc4e1c1
JB
5320 start_pos = *start_pos_ptr;
5321 *start_pos_ptr = Qnil;
7b4aedb9 5322
c5cf2109
GM
5323 {
5324 /* On window-system frames, use the value of
5325 double-click-fuzz as is. On other frames, interpret it
5326 as a multiple of 1/8 characters. */
5327 struct frame *f;
5328 int fuzz;
5329
5330 if (WINDOWP (event->frame_or_window))
5331 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
5332 else if (FRAMEP (event->frame_or_window))
5333 f = XFRAME (event->frame_or_window);
5334 else
5335 abort ();
5336
5337 if (FRAME_WINDOW_P (f))
5338 fuzz = double_click_fuzz;
5339 else
5340 fuzz = double_click_fuzz / 8;
5341
5342 is_double = (button == last_mouse_button
5343 && (abs (XINT (event->x) - last_mouse_x) <= fuzz)
5344 && (abs (XINT (event->y) - last_mouse_y) <= fuzz)
5345 && button_down_time != 0
5346 && (EQ (Vdouble_click_time, Qt)
5347 || (INTEGERP (Vdouble_click_time)
5348 && ((int)(event->timestamp - button_down_time)
5349 < XINT (Vdouble_click_time)))));
5350 }
c60ee5e7 5351
559f9d04
RS
5352 last_mouse_button = button;
5353 last_mouse_x = XINT (event->x);
5354 last_mouse_y = XINT (event->y);
5355
7b4aedb9
JB
5356 /* If this is a button press, squirrel away the location, so
5357 we can decide later whether it was a click or a drag. */
5358 if (event->modifiers & down_modifier)
559f9d04
RS
5359 {
5360 if (is_double)
5361 {
5362 double_click_count++;
5363 event->modifiers |= ((double_click_count > 2)
5364 ? triple_modifier
5365 : double_modifier);
5366 }
5367 else
5368 double_click_count = 1;
5369 button_down_time = event->timestamp;
5370 *start_pos_ptr = Fcopy_alist (position);
5371 }
7b4aedb9 5372
88cb0656 5373 /* Now we're releasing a button - check the co-ordinates to
7b4aedb9 5374 see if this was a click or a drag. */
88cb0656
JB
5375 else if (event->modifiers & up_modifier)
5376 {
129004d3
GM
5377 /* If we did not see a down before this up, ignore the up.
5378 Probably this happened because the down event chose a
5379 menu item. It would be an annoyance to treat the
5380 release of the button that chose the menu item as a
5381 separate event. */
48e416d4 5382
8c18cbfb 5383 if (!CONSP (start_pos))
48e416d4
RS
5384 return Qnil;
5385
88cb0656 5386 event->modifiers &= ~up_modifier;
48e416d4 5387#if 0 /* Formerly we treated an up with no down as a click event. */
8c18cbfb 5388 if (!CONSP (start_pos))
dbc4e1c1
JB
5389 event->modifiers |= click_modifier;
5390 else
48e416d4 5391#endif
dbc4e1c1 5392 {
9b8eb840 5393 Lisp_Object down;
d31053f9 5394 EMACS_INT xdiff = double_click_fuzz, ydiff = double_click_fuzz;
dbc4e1c1 5395
d31053f9
RS
5396 /* The third element of every position
5397 should be the (x,y) pair. */
5398 down = Fcar (Fcdr (Fcdr (start_pos)));
7a6a97d7
SM
5399 if (CONSP (down)
5400 && INTEGERP (XCAR (down)) && INTEGERP (XCDR (down)))
d31053f9 5401 {
7a6a97d7
SM
5402 xdiff = XFASTINT (event->x) - XFASTINT (XCAR (down));
5403 ydiff = XFASTINT (event->y) - XFASTINT (XCDR (down));
d31053f9
RS
5404 }
5405
5406 if (xdiff < double_click_fuzz && xdiff > - double_click_fuzz
5407 && ydiff < double_click_fuzz
5408 && ydiff > - double_click_fuzz)
5409 /* Mouse hasn't moved (much). */
129004d3 5410 event->modifiers |= click_modifier;
fbcd35bd
JB
5411 else
5412 {
d31053f9
RS
5413 button_down_time = 0;
5414 event->modifiers |= drag_modifier;
fbcd35bd 5415 }
c60ee5e7 5416
bc536d84
RS
5417 /* Don't check is_double; treat this as multiple
5418 if the down-event was multiple. */
5419 if (double_click_count > 1)
5420 event->modifiers |= ((double_click_count > 2)
5421 ? triple_modifier
5422 : double_modifier);
dbc4e1c1 5423 }
88cb0656
JB
5424 }
5425 else
5426 /* Every mouse event should either have the down_modifier or
7b4aedb9 5427 the up_modifier set. */
88cb0656
JB
5428 abort ();
5429
88cb0656 5430 {
7b4aedb9 5431 /* Get the symbol we should use for the mouse click. */
9b8eb840
KH
5432 Lisp_Object head;
5433
5434 head = modify_event_symbol (button,
5435 event->modifiers,
8e1e4240
GM
5436 Qmouse_click, Vlispy_mouse_stem,
5437 NULL,
5438 &mouse_syms,
5439 XVECTOR (mouse_syms)->size);
88cb0656 5440 if (event->modifiers & drag_modifier)
dbc4e1c1
JB
5441 return Fcons (head,
5442 Fcons (start_pos,
5443 Fcons (position,
5444 Qnil)));
fbcd35bd
JB
5445 else if (event->modifiers & (double_modifier | triple_modifier))
5446 return Fcons (head,
5447 Fcons (position,
5448 Fcons (make_number (double_click_count),
5449 Qnil)));
88cb0656
JB
5450 else
5451 return Fcons (head,
7b4aedb9 5452 Fcons (position,
88cb0656
JB
5453 Qnil));
5454 }
284f4730 5455 }
db08707d 5456
8006e4bb
JR
5457 case WHEEL_EVENT:
5458 {
5459 Lisp_Object position;
8006e4bb
JR
5460 Lisp_Object head;
5461
87d386ff 5462 /* Build the position as appropriate for this mouse click. */
87d386ff 5463 struct frame *f = XFRAME (event->frame_or_window);
87d386ff
JR
5464
5465 /* Ignore wheel events that were made on frame that have been
5466 deleted. */
5467 if (! FRAME_LIVE_P (f))
5468 return Qnil;
5469
3d566707
KS
5470 position = make_lispy_position (f, &event->x, &event->y,
5471 event->timestamp);
87d386ff
JR
5472
5473 /* Set double or triple modifiers to indicate the wheel speed. */
5474 {
5475 /* On window-system frames, use the value of
5476 double-click-fuzz as is. On other frames, interpret it
5477 as a multiple of 1/8 characters. */
5478 struct frame *f;
5479 int fuzz;
5480 int is_double;
5481
5482 if (WINDOWP (event->frame_or_window))
5483 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
5484 else if (FRAMEP (event->frame_or_window))
5485 f = XFRAME (event->frame_or_window);
5486 else
5487 abort ();
5488
5489 if (FRAME_WINDOW_P (f))
5490 fuzz = double_click_fuzz;
5491 else
5492 fuzz = double_click_fuzz / 8;
5493
5494 is_double = (last_mouse_button < 0
5495 && (abs (XINT (event->x) - last_mouse_x) <= fuzz)
5496 && (abs (XINT (event->y) - last_mouse_y) <= fuzz)
5497 && button_down_time != 0
5498 && (EQ (Vdouble_click_time, Qt)
5499 || (INTEGERP (Vdouble_click_time)
5500 && ((int)(event->timestamp - button_down_time)
5501 < XINT (Vdouble_click_time)))));
5502 if (is_double)
5503 {
5504 double_click_count++;
5505 event->modifiers |= ((double_click_count > 2)
5506 ? triple_modifier
5507 : double_modifier);
5508 }
5509 else
5510 {
5511 double_click_count = 1;
5512 event->modifiers |= click_modifier;
5513 }
5514
5515 button_down_time = event->timestamp;
5516 /* Use a negative value to distinguish wheel from mouse button. */
5517 last_mouse_button = -1;
5518 last_mouse_x = XINT (event->x);
5519 last_mouse_y = XINT (event->y);
5520 }
5521
5522 {
5523 int symbol_num;
5524
5525 if (event->modifiers & up_modifier)
5526 {
5527 /* Emit a wheel-up event. */
5528 event->modifiers &= ~up_modifier;
5529 symbol_num = 0;
5530 }
5531 else if (event->modifiers & down_modifier)
5532 {
5533 /* Emit a wheel-down event. */
5534 event->modifiers &= ~down_modifier;
5535 symbol_num = 1;
5536 }
5537 else
5538 /* Every wheel event should either have the down_modifier or
5539 the up_modifier set. */
5540 abort ();
5541
5542 /* Get the symbol we should use for the wheel event. */
5543 head = modify_event_symbol (symbol_num,
5544 event->modifiers,
5545 Qmouse_click,
5546 Qnil,
5547 lispy_wheel_names,
5548 &wheel_syms,
5549 ASIZE (wheel_syms));
5550 }
5551
5552 if (event->modifiers & (double_modifier | triple_modifier))
5553 return Fcons (head,
5554 Fcons (position,
5555 Fcons (make_number (double_click_count),
5556 Qnil)));
5557 else
5558 return Fcons (head,
5559 Fcons (position,
5560 Qnil));
8006e4bb
JR
5561 }
5562
5563
05be3964 5564#ifdef USE_TOOLKIT_SCROLL_BARS
7ee32cda
GM
5565
5566 /* We don't have down and up events if using toolkit scroll bars,
5567 so make this always a click event. Store in the `part' of
5568 the Lisp event a symbol which maps to the following actions:
5569
5570 `above_handle' page up
5571 `below_handle' page down
5572 `up' line up
5573 `down' line down
5574 `top' top of buffer
5575 `bottom' bottom of buffer
5576 `handle' thumb has been dragged.
5577 `end-scroll' end of interaction with scroll bar
5578
5579 The incoming input_event contains in its `part' member an
5580 index of type `enum scroll_bar_part' which we can use as an
5581 index in scroll_bar_parts to get the appropriate symbol. */
c60ee5e7 5582
3b8f9651 5583 case SCROLL_BAR_CLICK_EVENT:
7ee32cda
GM
5584 {
5585 Lisp_Object position, head, window, portion_whole, part;
5586
5587 window = event->frame_or_window;
5588 portion_whole = Fcons (event->x, event->y);
5589 part = *scroll_bar_parts[(int) event->part];
5590
5591 position
5592 = Fcons (window,
5593 Fcons (Qvertical_scroll_bar,
5594 Fcons (portion_whole,
5595 Fcons (make_number (event->timestamp),
5596 Fcons (part, Qnil)))));
5597
5598 /* Always treat scroll bar events as clicks. */
5599 event->modifiers |= click_modifier;
05be3964 5600 event->modifiers &= ~up_modifier;
7ee32cda 5601
257f40f2
JD
5602 if (event->code >= ASIZE (mouse_syms))
5603 mouse_syms = larger_vector (mouse_syms, event->code + 1, Qnil);
5604
7ee32cda
GM
5605 /* Get the symbol we should use for the mouse click. */
5606 head = modify_event_symbol (event->code,
5607 event->modifiers,
14e40288 5608 Qmouse_click,
8e1e4240
GM
5609 Vlispy_mouse_stem,
5610 NULL, &mouse_syms,
5611 XVECTOR (mouse_syms)->size);
7ee32cda
GM
5612 return Fcons (head, Fcons (position, Qnil));
5613 }
c60ee5e7 5614
7ee32cda
GM
5615#endif /* USE_TOOLKIT_SCROLL_BARS */
5616
db08707d 5617#ifdef WINDOWSNT
3b8f9651 5618 case W32_SCROLL_BAR_CLICK_EVENT:
db08707d
RS
5619 {
5620 int button = event->code;
5621 int is_double;
5622 Lisp_Object position;
5623 Lisp_Object *start_pos_ptr;
5624 Lisp_Object start_pos;
5625
db08707d
RS
5626 {
5627 Lisp_Object window;
5628 Lisp_Object portion_whole;
5629 Lisp_Object part;
5630
5631 window = event->frame_or_window;
5632 portion_whole = Fcons (event->x, event->y);
5633 part = *scroll_bar_parts[(int) event->part];
5634
e8886a1d
RS
5635 position
5636 = Fcons (window,
5637 Fcons (Qvertical_scroll_bar,
5638 Fcons (portion_whole,
5639 Fcons (make_number (event->timestamp),
5640 Fcons (part, Qnil)))));
db08707d
RS
5641 }
5642
fbd6baed 5643 /* Always treat W32 scroll bar events as clicks. */
db08707d
RS
5644 event->modifiers |= click_modifier;
5645
5646 {
5647 /* Get the symbol we should use for the mouse click. */
5648 Lisp_Object head;
5649
5650 head = modify_event_symbol (button,
5651 event->modifiers,
c60ee5e7 5652 Qmouse_click,
8e1e4240
GM
5653 Vlispy_mouse_stem,
5654 NULL, &mouse_syms,
5655 XVECTOR (mouse_syms)->size);
db08707d
RS
5656 return Fcons (head,
5657 Fcons (position,
5658 Qnil));
5659 }
5660 }
1e7c162f 5661#endif /* WINDOWSNT */
a24dc617 5662
3b8f9651 5663 case DRAG_N_DROP_EVENT:
a24dc617 5664 {
a24dc617 5665 FRAME_PTR f;
3d566707 5666 Lisp_Object head, position;
a24dc617 5667 Lisp_Object files;
a24dc617
RS
5668
5669 /* The frame_or_window field should be a cons of the frame in
5670 which the event occurred and a list of the filenames
5671 dropped. */
5672 if (! CONSP (event->frame_or_window))
5673 abort ();
5674
7539e11f
KR
5675 f = XFRAME (XCAR (event->frame_or_window));
5676 files = XCDR (event->frame_or_window);
a24dc617
RS
5677
5678 /* Ignore mouse events that were made on frames that
5679 have been deleted. */
5680 if (! FRAME_LIVE_P (f))
5681 return Qnil;
afabdbe5 5682
3d566707
KS
5683 position = make_lispy_position (f, &event->x, &event->y,
5684 event->timestamp);
5685
5686 head = modify_event_symbol (0, event->modifiers,
5687 Qdrag_n_drop, Qnil,
5688 lispy_drag_n_drop_names,
5689 &drag_n_drop_syms, 1);
5690 return Fcons (head,
5691 Fcons (position,
5692 Fcons (files,
5693 Qnil)));
a24dc617 5694 }
514354e9 5695#endif /* HAVE_MOUSE */
284f4730 5696
488dd4c4
JD
5697#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
5698 || defined (USE_GTK)
da8f7368
GM
5699 case MENU_BAR_EVENT:
5700 if (EQ (event->arg, event->frame_or_window))
5701 /* This is the prefix key. We translate this to
5702 `(menu_bar)' because the code in keyboard.c for menu
5703 events, which we use, relies on this. */
5704 return Fcons (Qmenu_bar, Qnil);
5705 return event->arg;
2470a66f
KH
5706#endif
5707
a4e19f6e
SM
5708 case SELECT_WINDOW_EVENT:
5709 /* Make an event (select-window (WINDOW)). */
5710 return Fcons (Qselect_window,
5711 Fcons (Fcons (event->frame_or_window, Qnil),
5712 Qnil));
5713
9ea173e8 5714 case TOOL_BAR_EVENT:
da8f7368
GM
5715 if (EQ (event->arg, event->frame_or_window))
5716 /* This is the prefix key. We translate this to
27fd22dc 5717 `(tool_bar)' because the code in keyboard.c for tool bar
da8f7368
GM
5718 events, which we use, relies on this. */
5719 return Fcons (Qtool_bar, Qnil);
5720 else if (SYMBOLP (event->arg))
5721 return apply_modifiers (event->modifiers, event->arg);
5722 return event->arg;
5723
5724 case USER_SIGNAL_EVENT:
5bf68f6e
AS
5725 /* A user signal. */
5726 return *lispy_user_signals[event->code];
c60ee5e7 5727
3b8f9651 5728 case SAVE_SESSION_EVENT:
4ebc27a5 5729 return Qsave_session;
c60ee5e7 5730
284f4730
JB
5731 /* The 'kind' field of the event is something we don't recognize. */
5732 default:
48e416d4 5733 abort ();
284f4730
JB
5734 }
5735}
5736
514354e9 5737#ifdef HAVE_MOUSE
6cbff1cb 5738
284f4730 5739static Lisp_Object
7b4aedb9 5740make_lispy_movement (frame, bar_window, part, x, y, time)
ff11dfa1 5741 FRAME_PTR frame;
7b4aedb9 5742 Lisp_Object bar_window;
3c370943 5743 enum scroll_bar_part part;
284f4730 5744 Lisp_Object x, y;
e5d77022 5745 unsigned long time;
284f4730 5746{
3c370943 5747 /* Is it a scroll bar movement? */
7b4aedb9 5748 if (frame && ! NILP (bar_window))
4bb994d1 5749 {
9b8eb840 5750 Lisp_Object part_sym;
4bb994d1 5751
9b8eb840 5752 part_sym = *scroll_bar_parts[(int) part];
3c370943 5753 return Fcons (Qscroll_bar_movement,
7b4aedb9 5754 (Fcons (Fcons (bar_window,
3c370943 5755 Fcons (Qvertical_scroll_bar,
4bb994d1
JB
5756 Fcons (Fcons (x, y),
5757 Fcons (make_number (time),
cb5df6ae 5758 Fcons (part_sym,
4bb994d1
JB
5759 Qnil))))),
5760 Qnil)));
5761 }
5762
5763 /* Or is it an ordinary mouse movement? */
284f4730
JB
5764 else
5765 {
3d566707 5766 Lisp_Object position;
4bb994d1 5767
3d566707 5768 position = make_lispy_position (frame, &x, &y, time);
284f4730 5769
4bb994d1 5770 return Fcons (Qmouse_movement,
3d566707 5771 Fcons (position,
4bb994d1
JB
5772 Qnil));
5773 }
284f4730
JB
5774}
5775
514354e9 5776#endif /* HAVE_MOUSE */
6cbff1cb 5777
cd21b839
JB
5778/* Construct a switch frame event. */
5779static Lisp_Object
5780make_lispy_switch_frame (frame)
5781 Lisp_Object frame;
5782{
5783 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
5784}
0a7f1fc0
JB
5785\f
5786/* Manipulating modifiers. */
284f4730 5787
0a7f1fc0 5788/* Parse the name of SYMBOL, and return the set of modifiers it contains.
284f4730 5789
0a7f1fc0
JB
5790 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
5791 SYMBOL's name of the end of the modifiers; the string from this
5792 position is the unmodified symbol name.
284f4730 5793
0a7f1fc0 5794 This doesn't use any caches. */
6da3dd3a 5795
0a7f1fc0
JB
5796static int
5797parse_modifiers_uncached (symbol, modifier_end)
284f4730 5798 Lisp_Object symbol;
0a7f1fc0 5799 int *modifier_end;
284f4730 5800{
1b049b51 5801 Lisp_Object name;
284f4730
JB
5802 int i;
5803 int modifiers;
284f4730 5804
b7826503 5805 CHECK_SYMBOL (symbol);
df0f2ba1 5806
284f4730 5807 modifiers = 0;
1b049b51 5808 name = SYMBOL_NAME (symbol);
284f4730 5809
1b049b51 5810 for (i = 0; i+2 <= SBYTES (name); )
6da3dd3a
RS
5811 {
5812 int this_mod_end = 0;
5813 int this_mod = 0;
284f4730 5814
6da3dd3a
RS
5815 /* See if the name continues with a modifier word.
5816 Check that the word appears, but don't check what follows it.
5817 Set this_mod and this_mod_end to record what we find. */
fce33686 5818
1b049b51 5819 switch (SREF (name, i))
6da3dd3a
RS
5820 {
5821#define SINGLE_LETTER_MOD(BIT) \
5822 (this_mod_end = i + 1, this_mod = BIT)
5823
6da3dd3a
RS
5824 case 'A':
5825 SINGLE_LETTER_MOD (alt_modifier);
5826 break;
284f4730 5827
6da3dd3a
RS
5828 case 'C':
5829 SINGLE_LETTER_MOD (ctrl_modifier);
5830 break;
284f4730 5831
6da3dd3a
RS
5832 case 'H':
5833 SINGLE_LETTER_MOD (hyper_modifier);
5834 break;
5835
6da3dd3a
RS
5836 case 'M':
5837 SINGLE_LETTER_MOD (meta_modifier);
5838 break;
5839
6da3dd3a
RS
5840 case 'S':
5841 SINGLE_LETTER_MOD (shift_modifier);
5842 break;
5843
5844 case 's':
6da3dd3a
RS
5845 SINGLE_LETTER_MOD (super_modifier);
5846 break;
5847
0a7f1fc0 5848#undef SINGLE_LETTER_MOD
65470b52
SM
5849
5850#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
5851 if (i + LEN + 1 <= SBYTES (name) \
5852 && ! strncmp (SDATA (name) + i, NAME, LEN)) \
5853 { \
5854 this_mod_end = i + LEN; \
5855 this_mod = BIT; \
5856 }
5857
5858 case 'd':
5859 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
5860 MULTI_LETTER_MOD (down_modifier, "down", 4);
5861 MULTI_LETTER_MOD (double_modifier, "double", 6);
5862 break;
5863
5864 case 't':
5865 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
5866 break;
5867#undef MULTI_LETTER_MOD
5868
6da3dd3a
RS
5869 }
5870
5871 /* If we found no modifier, stop looking for them. */
5872 if (this_mod_end == 0)
5873 break;
5874
5875 /* Check there is a dash after the modifier, so that it
5876 really is a modifier. */
1b049b51
KR
5877 if (this_mod_end >= SBYTES (name)
5878 || SREF (name, this_mod_end) != '-')
6da3dd3a
RS
5879 break;
5880
5881 /* This modifier is real; look for another. */
5882 modifiers |= this_mod;
5883 i = this_mod_end + 1;
5884 }
284f4730 5885
0a7f1fc0 5886 /* Should we include the `click' modifier? */
fbcd35bd
JB
5887 if (! (modifiers & (down_modifier | drag_modifier
5888 | double_modifier | triple_modifier))
1b049b51
KR
5889 && i + 7 == SBYTES (name)
5890 && strncmp (SDATA (name) + i, "mouse-", 6) == 0
5891 && ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9'))
0a7f1fc0
JB
5892 modifiers |= click_modifier;
5893
5894 if (modifier_end)
5895 *modifier_end = i;
5896
5897 return modifiers;
5898}
5899
0a7f1fc0
JB
5900/* Return a symbol whose name is the modifier prefixes for MODIFIERS
5901 prepended to the string BASE[0..BASE_LEN-1].
5902 This doesn't use any caches. */
5903static Lisp_Object
301738ed 5904apply_modifiers_uncached (modifiers, base, base_len, base_len_byte)
0a7f1fc0
JB
5905 int modifiers;
5906 char *base;
301738ed 5907 int base_len, base_len_byte;
0a7f1fc0
JB
5908{
5909 /* Since BASE could contain nulls, we can't use intern here; we have
5910 to use Fintern, which expects a genuine Lisp_String, and keeps a
5911 reference to it. */
301738ed
RS
5912 char *new_mods
5913 = (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
0a7f1fc0 5914 int mod_len;
284f4730 5915
284f4730 5916 {
0a7f1fc0
JB
5917 char *p = new_mods;
5918
5919 /* Only the event queue may use the `up' modifier; it should always
5920 be turned into a click or drag event before presented to lisp code. */
5921 if (modifiers & up_modifier)
5922 abort ();
5923
5924 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
5925 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
5926 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
5927 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
5928 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
86e5706b 5929 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
fbcd35bd
JB
5930 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
5931 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
559f9d04
RS
5932 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
5933 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
0a7f1fc0
JB
5934 /* The click modifier is denoted by the absence of other modifiers. */
5935
5936 *p = '\0';
5937
5938 mod_len = p - new_mods;
5939 }
284f4730 5940
0a7f1fc0 5941 {
9b8eb840 5942 Lisp_Object new_name;
df0f2ba1 5943
301738ed
RS
5944 new_name = make_uninit_multibyte_string (mod_len + base_len,
5945 mod_len + base_len_byte);
d5db4077
KR
5946 bcopy (new_mods, SDATA (new_name), mod_len);
5947 bcopy (base, SDATA (new_name) + mod_len, base_len_byte);
284f4730
JB
5948
5949 return Fintern (new_name, Qnil);
5950 }
5951}
5952
5953
0a7f1fc0
JB
5954static char *modifier_names[] =
5955{
fbcd35bd 5956 "up", "down", "drag", "click", "double", "triple", 0, 0,
f335fabe 5957 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
86e5706b 5958 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
0a7f1fc0 5959};
80645119 5960#define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
0a7f1fc0
JB
5961
5962static Lisp_Object modifier_symbols;
5963
5964/* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
5965static Lisp_Object
5966lispy_modifier_list (modifiers)
5967 int modifiers;
5968{
5969 Lisp_Object modifier_list;
5970 int i;
5971
5972 modifier_list = Qnil;
80645119 5973 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
0a7f1fc0 5974 if (modifiers & (1<<i))
80645119
JB
5975 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
5976 modifier_list);
0a7f1fc0
JB
5977
5978 return modifier_list;
5979}
5980
5981
5982/* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
5983 where UNMODIFIED is the unmodified form of SYMBOL,
5984 MASK is the set of modifiers present in SYMBOL's name.
5985 This is similar to parse_modifiers_uncached, but uses the cache in
5986 SYMBOL's Qevent_symbol_element_mask property, and maintains the
5987 Qevent_symbol_elements property. */
3d31316f 5988
1161d367 5989Lisp_Object
0a7f1fc0
JB
5990parse_modifiers (symbol)
5991 Lisp_Object symbol;
5992{
9b8eb840 5993 Lisp_Object elements;
0a7f1fc0 5994
9b8eb840 5995 elements = Fget (symbol, Qevent_symbol_element_mask);
0a7f1fc0
JB
5996 if (CONSP (elements))
5997 return elements;
5998 else
5999 {
6000 int end;
ec0faad2 6001 int modifiers = parse_modifiers_uncached (symbol, &end);
9b8eb840 6002 Lisp_Object unmodified;
0a7f1fc0
JB
6003 Lisp_Object mask;
6004
d5db4077
KR
6005 unmodified = Fintern (make_string (SDATA (SYMBOL_NAME (symbol)) + end,
6006 SBYTES (SYMBOL_NAME (symbol)) - end),
9b8eb840
KH
6007 Qnil);
6008
e22216b8 6009 if (modifiers & ~INTMASK)
734fef94 6010 abort ();
bb9e9bed 6011 XSETFASTINT (mask, modifiers);
0a7f1fc0
JB
6012 elements = Fcons (unmodified, Fcons (mask, Qnil));
6013
6014 /* Cache the parsing results on SYMBOL. */
6015 Fput (symbol, Qevent_symbol_element_mask,
6016 elements);
6017 Fput (symbol, Qevent_symbol_elements,
6018 Fcons (unmodified, lispy_modifier_list (modifiers)));
6019
6020 /* Since we know that SYMBOL is modifiers applied to unmodified,
6021 it would be nice to put that in unmodified's cache.
6022 But we can't, since we're not sure that parse_modifiers is
6023 canonical. */
6024
6025 return elements;
6026 }
6027}
6028
6029/* Apply the modifiers MODIFIERS to the symbol BASE.
6030 BASE must be unmodified.
6031
6032 This is like apply_modifiers_uncached, but uses BASE's
6033 Qmodifier_cache property, if present. It also builds
cd21b839
JB
6034 Qevent_symbol_elements properties, since it has that info anyway.
6035
6036 apply_modifiers copies the value of BASE's Qevent_kind property to
6037 the modified symbol. */
0a7f1fc0
JB
6038static Lisp_Object
6039apply_modifiers (modifiers, base)
6040 int modifiers;
6041 Lisp_Object base;
6042{
7b4aedb9 6043 Lisp_Object cache, index, entry, new_symbol;
0a7f1fc0 6044
80645119 6045 /* Mask out upper bits. We don't know where this value's been. */
e22216b8 6046 modifiers &= INTMASK;
80645119 6047
0a7f1fc0 6048 /* The click modifier never figures into cache indices. */
0a7f1fc0 6049 cache = Fget (base, Qmodifier_cache);
bb9e9bed 6050 XSETFASTINT (index, (modifiers & ~click_modifier));
697e4895 6051 entry = assq_no_quit (index, cache);
0a7f1fc0
JB
6052
6053 if (CONSP (entry))
7539e11f 6054 new_symbol = XCDR (entry);
7b4aedb9
JB
6055 else
6056 {
df0f2ba1 6057 /* We have to create the symbol ourselves. */
7b4aedb9 6058 new_symbol = apply_modifiers_uncached (modifiers,
d5db4077
KR
6059 SDATA (SYMBOL_NAME (base)),
6060 SCHARS (SYMBOL_NAME (base)),
6061 SBYTES (SYMBOL_NAME (base)));
7b4aedb9
JB
6062
6063 /* Add the new symbol to the base's cache. */
6064 entry = Fcons (index, new_symbol);
6065 Fput (base, Qmodifier_cache, Fcons (entry, cache));
6066
35fb885d
SM
6067 /* We have the parsing info now for free, so we could add it to
6068 the caches:
6069 XSETFASTINT (index, modifiers);
6070 Fput (new_symbol, Qevent_symbol_element_mask,
6071 Fcons (base, Fcons (index, Qnil)));
6072 Fput (new_symbol, Qevent_symbol_elements,
6073 Fcons (base, lispy_modifier_list (modifiers)));
6074 Sadly, this is only correct if `base' is indeed a base event,
6075 which is not necessarily the case. -stef */
7b4aedb9 6076 }
0a7f1fc0 6077
df0f2ba1 6078 /* Make sure this symbol is of the same kind as BASE.
7b4aedb9
JB
6079
6080 You'd think we could just set this once and for all when we
6081 intern the symbol above, but reorder_modifiers may call us when
6082 BASE's property isn't set right; we can't assume that just
80645119
JB
6083 because it has a Qmodifier_cache property it must have its
6084 Qevent_kind set right as well. */
7b4aedb9
JB
6085 if (NILP (Fget (new_symbol, Qevent_kind)))
6086 {
9b8eb840 6087 Lisp_Object kind;
7b4aedb9 6088
9b8eb840 6089 kind = Fget (base, Qevent_kind);
7b4aedb9
JB
6090 if (! NILP (kind))
6091 Fput (new_symbol, Qevent_kind, kind);
6092 }
6093
6094 return new_symbol;
0a7f1fc0
JB
6095}
6096
6097
6098/* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
6099 return a symbol with the modifiers placed in the canonical order.
6100 Canonical order is alphabetical, except for down and drag, which
6101 always come last. The 'click' modifier is never written out.
6102
6103 Fdefine_key calls this to make sure that (for example) C-M-foo
6104 and M-C-foo end up being equivalent in the keymap. */
6105
6106Lisp_Object
6107reorder_modifiers (symbol)
6108 Lisp_Object symbol;
6109{
6110 /* It's hopefully okay to write the code this way, since everything
6111 will soon be in caches, and no consing will be done at all. */
9b8eb840 6112 Lisp_Object parsed;
0a7f1fc0 6113
9b8eb840 6114 parsed = parse_modifiers (symbol);
7539e11f
KR
6115 return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))),
6116 XCAR (parsed));
0a7f1fc0
JB
6117}
6118
6119
284f4730
JB
6120/* For handling events, we often want to produce a symbol whose name
6121 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
6122 to some base, like the name of a function key or mouse button.
6123 modify_event_symbol produces symbols of this sort.
6124
6125 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
6126 is the name of the i'th symbol. TABLE_SIZE is the number of elements
6127 in the table.
6128
8e1e4240
GM
6129 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
6130 into symbol names, or a string specifying a name stem used to
a50e723f 6131 construct a symbol name or the form `STEM-N', where N is the decimal
8e1e4240
GM
6132 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
6133 non-nil; otherwise NAME_TABLE is used.
80e4aa30 6134
284f4730
JB
6135 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
6136 persist between calls to modify_event_symbol that it can use to
6137 store a cache of the symbols it's generated for this NAME_TABLE
80e4aa30 6138 before. The object stored there may be a vector or an alist.
284f4730
JB
6139
6140 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
df0f2ba1 6141
284f4730
JB
6142 MODIFIERS is a set of modifier bits (as given in struct input_events)
6143 whose prefixes should be applied to the symbol name.
6144
6145 SYMBOL_KIND is the value to be placed in the event_kind property of
df0f2ba1 6146 the returned symbol.
88cb0656
JB
6147
6148 The symbols we create are supposed to have an
eb8c3be9 6149 `event-symbol-elements' property, which lists the modifiers present
88cb0656
JB
6150 in the symbol's name. */
6151
284f4730 6152static Lisp_Object
8e1e4240 6153modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist_or_stem,
80e4aa30 6154 name_table, symbol_table, table_size)
284f4730
JB
6155 int symbol_num;
6156 unsigned modifiers;
6157 Lisp_Object symbol_kind;
8e1e4240 6158 Lisp_Object name_alist_or_stem;
284f4730
JB
6159 char **name_table;
6160 Lisp_Object *symbol_table;
2c834fb3 6161 unsigned int table_size;
284f4730 6162{
80e4aa30
RS
6163 Lisp_Object value;
6164 Lisp_Object symbol_int;
6165
2c834fb3
KH
6166 /* Get rid of the "vendor-specific" bit here. */
6167 XSETINT (symbol_int, symbol_num & 0xffffff);
284f4730
JB
6168
6169 /* Is this a request for a valid symbol? */
88cb0656 6170 if (symbol_num < 0 || symbol_num >= table_size)
0c2611c5 6171 return Qnil;
284f4730 6172
80e4aa30
RS
6173 if (CONSP (*symbol_table))
6174 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
6175
0a7f1fc0 6176 /* If *symbol_table doesn't seem to be initialized properly, fix that.
88cb0656 6177 *symbol_table should be a lisp vector TABLE_SIZE elements long,
4bb994d1
JB
6178 where the Nth element is the symbol for NAME_TABLE[N], or nil if
6179 we've never used that symbol before. */
80e4aa30 6180 else
88cb0656 6181 {
80e4aa30
RS
6182 if (! VECTORP (*symbol_table)
6183 || XVECTOR (*symbol_table)->size != table_size)
6184 {
6185 Lisp_Object size;
0a7f1fc0 6186
bb9e9bed 6187 XSETFASTINT (size, table_size);
80e4aa30
RS
6188 *symbol_table = Fmake_vector (size, Qnil);
6189 }
284f4730 6190
80e4aa30
RS
6191 value = XVECTOR (*symbol_table)->contents[symbol_num];
6192 }
284f4730 6193
0a7f1fc0 6194 /* Have we already used this symbol before? */
80e4aa30 6195 if (NILP (value))
284f4730 6196 {
0a7f1fc0 6197 /* No; let's create it. */
8e1e4240
GM
6198 if (CONSP (name_alist_or_stem))
6199 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
6200 else if (STRINGP (name_alist_or_stem))
6201 {
d5db4077 6202 int len = SBYTES (name_alist_or_stem);
8e1e4240 6203 char *buf = (char *) alloca (len + 50);
ed3230db
DL
6204 if (sizeof (int) == sizeof (EMACS_INT))
6205 sprintf (buf, "%s-%d", SDATA (name_alist_or_stem),
6206 XINT (symbol_int) + 1);
6207 else if (sizeof (long) == sizeof (EMACS_INT))
6208 sprintf (buf, "%s-%ld", SDATA (name_alist_or_stem),
6209 XINT (symbol_int) + 1);
8e1e4240
GM
6210 value = intern (buf);
6211 }
2ff6714d 6212 else if (name_table != 0 && name_table[symbol_num])
80e4aa30 6213 value = intern (name_table[symbol_num]);
b64b4075 6214
e98a93eb 6215#ifdef HAVE_WINDOW_SYSTEM
2c834fb3
KH
6216 if (NILP (value))
6217 {
6218 char *name = x_get_keysym_name (symbol_num);
6219 if (name)
6220 value = intern (name);
6221 }
6222#endif
6223
b64b4075 6224 if (NILP (value))
d1f50460
RS
6225 {
6226 char buf[20];
6227 sprintf (buf, "key-%d", symbol_num);
80e4aa30 6228 value = intern (buf);
d1f50460 6229 }
0a7f1fc0 6230
80e4aa30 6231 if (CONSP (*symbol_table))
4205cb08 6232 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
80e4aa30
RS
6233 else
6234 XVECTOR (*symbol_table)->contents[symbol_num] = value;
6235
df0f2ba1 6236 /* Fill in the cache entries for this symbol; this also
0a7f1fc0
JB
6237 builds the Qevent_symbol_elements property, which the user
6238 cares about. */
80e4aa30
RS
6239 apply_modifiers (modifiers & click_modifier, value);
6240 Fput (value, Qevent_kind, symbol_kind);
284f4730 6241 }
88cb0656 6242
0a7f1fc0 6243 /* Apply modifiers to that symbol. */
80e4aa30 6244 return apply_modifiers (modifiers, value);
284f4730 6245}
6da3dd3a
RS
6246\f
6247/* Convert a list that represents an event type,
6248 such as (ctrl meta backspace), into the usual representation of that
6249 event type as a number or a symbol. */
6250
a1706c30 6251DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
4707d2d0
PJ
6252 doc: /* Convert the event description list EVENT-DESC to an event type.
6253EVENT-DESC should contain one base event type (a character or symbol)
6254and zero or more modifier names (control, meta, hyper, super, shift, alt,
6255drag, down, double or triple). The base must be last.
6256The return value is an event type (a character or symbol) which
6257has the same base event type and all the specified modifiers. */)
6258 (event_desc)
e57d8fd8 6259 Lisp_Object event_desc;
6da3dd3a
RS
6260{
6261 Lisp_Object base;
6262 int modifiers = 0;
6263 Lisp_Object rest;
6264
6265 base = Qnil;
e57d8fd8 6266 rest = event_desc;
6da3dd3a
RS
6267 while (CONSP (rest))
6268 {
6269 Lisp_Object elt;
6270 int this = 0;
6271
7539e11f
KR
6272 elt = XCAR (rest);
6273 rest = XCDR (rest);
6da3dd3a 6274
3d31316f 6275 /* Given a symbol, see if it is a modifier name. */
377f24f5 6276 if (SYMBOLP (elt) && CONSP (rest))
3d31316f 6277 this = parse_solitary_modifier (elt);
6da3dd3a
RS
6278
6279 if (this != 0)
6280 modifiers |= this;
6281 else if (!NILP (base))
6282 error ("Two bases given in one event");
6283 else
6284 base = elt;
6285
6da3dd3a
RS
6286 }
6287
3d31316f 6288 /* Let the symbol A refer to the character A. */
d5db4077 6289 if (SYMBOLP (base) && SCHARS (SYMBOL_NAME (base)) == 1)
4069e0f8 6290 XSETINT (base, SREF (SYMBOL_NAME (base), 0));
3d31316f 6291
6da3dd3a
RS
6292 if (INTEGERP (base))
6293 {
3d31316f
RS
6294 /* Turn (shift a) into A. */
6295 if ((modifiers & shift_modifier) != 0
6296 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
6297 {
6298 XSETINT (base, XINT (base) - ('a' - 'A'));
6299 modifiers &= ~shift_modifier;
6300 }
6301
6302 /* Turn (control a) into C-a. */
6da3dd3a 6303 if (modifiers & ctrl_modifier)
3d31316f 6304 return make_number ((modifiers & ~ctrl_modifier)
6da3dd3a
RS
6305 | make_ctrl_char (XINT (base)));
6306 else
6307 return make_number (modifiers | XINT (base));
6308 }
6309 else if (SYMBOLP (base))
6310 return apply_modifiers (modifiers, base);
6311 else
8c907a56
GM
6312 {
6313 error ("Invalid base event");
6314 return Qnil;
6315 }
6da3dd3a
RS
6316}
6317
3d31316f
RS
6318/* Try to recognize SYMBOL as a modifier name.
6319 Return the modifier flag bit, or 0 if not recognized. */
6320
6321static int
6322parse_solitary_modifier (symbol)
6323 Lisp_Object symbol;
6324{
1b049b51 6325 Lisp_Object name = SYMBOL_NAME (symbol);
3d31316f 6326
1b049b51 6327 switch (SREF (name, 0))
3d31316f
RS
6328 {
6329#define SINGLE_LETTER_MOD(BIT) \
1b049b51 6330 if (SBYTES (name) == 1) \
3d31316f
RS
6331 return BIT;
6332
6333#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
1b049b51
KR
6334 if (LEN == SBYTES (name) \
6335 && ! strncmp (SDATA (name), NAME, LEN)) \
3d31316f
RS
6336 return BIT;
6337
6338 case 'A':
6339 SINGLE_LETTER_MOD (alt_modifier);
6340 break;
6341
6342 case 'a':
6343 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
6344 break;
6345
6346 case 'C':
6347 SINGLE_LETTER_MOD (ctrl_modifier);
6348 break;
6349
6350 case 'c':
6351 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
6352 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
6353 break;
6354
6355 case 'H':
6356 SINGLE_LETTER_MOD (hyper_modifier);
6357 break;
6358
6359 case 'h':
6360 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
6361 break;
6362
6363 case 'M':
6364 SINGLE_LETTER_MOD (meta_modifier);
6365 break;
6366
6367 case 'm':
6368 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
6369 break;
6370
6371 case 'S':
6372 SINGLE_LETTER_MOD (shift_modifier);
6373 break;
6374
6375 case 's':
6376 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
6377 MULTI_LETTER_MOD (super_modifier, "super", 5);
6378 SINGLE_LETTER_MOD (super_modifier);
6379 break;
6380
6381 case 'd':
6382 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6383 MULTI_LETTER_MOD (down_modifier, "down", 4);
6384 MULTI_LETTER_MOD (double_modifier, "double", 6);
6385 break;
6386
6387 case 't':
6388 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6389 break;
6390
6391#undef SINGLE_LETTER_MOD
6392#undef MULTI_LETTER_MOD
6393 }
6394
6395 return 0;
6396}
6397
6da3dd3a
RS
6398/* Return 1 if EVENT is a list whose elements are all integers or symbols.
6399 Such a list is not valid as an event,
6400 but it can be a Lucid-style event type list. */
6401
6402int
6403lucid_event_type_list_p (object)
6404 Lisp_Object object;
6405{
6406 Lisp_Object tail;
6407
6408 if (! CONSP (object))
6409 return 0;
902ae620
GM
6410
6411 if (EQ (XCAR (object), Qhelp_echo)
6412 || EQ (XCAR (object), Qvertical_line)
6413 || EQ (XCAR (object), Qmode_line)
6414 || EQ (XCAR (object), Qheader_line))
6415 return 0;
6da3dd3a 6416
7539e11f 6417 for (tail = object; CONSP (tail); tail = XCDR (tail))
6da3dd3a
RS
6418 {
6419 Lisp_Object elt;
7539e11f 6420 elt = XCAR (tail);
6da3dd3a
RS
6421 if (! (INTEGERP (elt) || SYMBOLP (elt)))
6422 return 0;
6423 }
6424
6425 return NILP (tail);
6426}
284f4730 6427\f
284f4730
JB
6428/* Store into *addr a value nonzero if terminal input chars are available.
6429 Serves the purpose of ioctl (0, FIONREAD, addr)
6430 but works even if FIONREAD does not exist.
d9d4c147
KH
6431 (In fact, this may actually read some input.)
6432
20057d52
JD
6433 If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe.
6434 If FILTER_EVENTS is nonzero, ignore internal events (FOCUS_IN_EVENT). */
284f4730
JB
6435
6436static void
20057d52 6437get_filtered_input_pending (addr, do_timers_now, filter_events)
284f4730 6438 int *addr;
d9d4c147 6439 int do_timers_now;
20057d52 6440 int filter_events;
284f4730
JB
6441{
6442 /* First of all, have we already counted some input? */
20057d52
JD
6443 *addr = (!NILP (Vquit_flag)
6444 || readable_filtered_events (do_timers_now, filter_events));
284f4730
JB
6445
6446 /* If input is being read as it arrives, and we have none, there is none. */
6447 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
6448 return;
6449
6450 /* Try to read some input and see how much we get. */
6451 gobble_input (0);
20057d52
JD
6452 *addr = (!NILP (Vquit_flag)
6453 || readable_filtered_events (do_timers_now, filter_events));
6454}
6455
6456/* Store into *addr a value nonzero if terminal input chars are available.
6457 Serves the purpose of ioctl (0, FIONREAD, addr)
6458 but works even if FIONREAD does not exist.
6459 (In fact, this may actually read some input.)
6460
6461 If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe. */
6462
6463static void
6464get_input_pending (addr, do_timers_now)
6465 int *addr;
6466 int do_timers_now;
6467{
6468 get_filtered_input_pending (addr, do_timers_now, 0);
284f4730
JB
6469}
6470
81931ba1 6471/* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
284f4730 6472
07a59269 6473void
284f4730
JB
6474gobble_input (expected)
6475 int expected;
6476{
6477#ifndef VMS
6478#ifdef SIGIO
6479 if (interrupt_input)
6480 {
32676c08 6481 SIGMASKTYPE mask;
4f8aaa74 6482 mask = sigblock (sigmask (SIGIO));
284f4730 6483 read_avail_input (expected);
e065a56e 6484 sigsetmask (mask);
284f4730
JB
6485 }
6486 else
81931ba1
RS
6487#ifdef POLL_FOR_INPUT
6488 if (read_socket_hook && !interrupt_input && poll_suppress_count == 0)
6489 {
6490 SIGMASKTYPE mask;
4f8aaa74 6491 mask = sigblock (sigmask (SIGALRM));
81931ba1
RS
6492 read_avail_input (expected);
6493 sigsetmask (mask);
6494 }
6495 else
87485d6f 6496#endif
284f4730
JB
6497#endif
6498 read_avail_input (expected);
6499#endif
6500}
a8015ab5 6501
3b8f9651 6502/* Put a BUFFER_SWITCH_EVENT in the buffer
241ceaf7
RS
6503 so that read_key_sequence will notice the new current buffer. */
6504
07a59269 6505void
a8015ab5
KH
6506record_asynch_buffer_change ()
6507{
6508 struct input_event event;
a30f0615 6509 Lisp_Object tem;
1269a761 6510 EVENT_INIT (event);
a30f0615 6511
3b8f9651 6512 event.kind = BUFFER_SWITCH_EVENT;
a8015ab5 6513 event.frame_or_window = Qnil;
da8f7368 6514 event.arg = Qnil;
241ceaf7 6515
f65e6f7d 6516#ifdef subprocesses
a30f0615
RS
6517 /* We don't need a buffer-switch event unless Emacs is waiting for input.
6518 The purpose of the event is to make read_key_sequence look up the
6519 keymaps again. If we aren't in read_key_sequence, we don't need one,
6520 and the event could cause trouble by messing up (input-pending-p). */
6521 tem = Fwaiting_for_user_input_p ();
6522 if (NILP (tem))
6523 return;
f65e6f7d
RS
6524#else
6525 /* We never need these events if we have no asynchronous subprocesses. */
6526 return;
6527#endif
a30f0615 6528
241ceaf7
RS
6529 /* Make sure no interrupt happens while storing the event. */
6530#ifdef SIGIO
6531 if (interrupt_input)
6532 {
6533 SIGMASKTYPE mask;
4f8aaa74 6534 mask = sigblock (sigmask (SIGIO));
241ceaf7
RS
6535 kbd_buffer_store_event (&event);
6536 sigsetmask (mask);
6537 }
6538 else
6539#endif
6540 {
6541 stop_polling ();
6542 kbd_buffer_store_event (&event);
6543 start_polling ();
6544 }
a8015ab5 6545}
284f4730
JB
6546\f
6547#ifndef VMS
6548
6549/* Read any terminal input already buffered up by the system
6550 into the kbd_buffer, but do not wait.
6551
6552 EXPECTED should be nonzero if the caller knows there is some input.
6553
6554 Except on VMS, all input is read by this function.
6555 If interrupt_input is nonzero, this function MUST be called
6556 only when SIGIO is blocked.
6557
6558 Returns the number of keyboard chars read, or -1 meaning
6559 this is a bad time to try to read input. */
6560
6561static int
6562read_avail_input (expected)
6563 int expected;
6564{
6565 struct input_event buf[KBD_BUFFER_SIZE];
6566 register int i;
6567 int nread;
6568
1269a761
SM
6569 for (i = 0; i < KBD_BUFFER_SIZE; i++)
6570 EVENT_INIT (buf[i]);
6571
284f4730
JB
6572 if (read_socket_hook)
6573 /* No need for FIONREAD or fcntl; just say don't wait. */
33e19c6e 6574 nread = (*read_socket_hook) (input_fd, buf, KBD_BUFFER_SIZE, expected);
284f4730
JB
6575 else
6576 {
17270835
RS
6577 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
6578 the kbd_buffer can really hold. That may prevent loss
6579 of characters on some systems when input is stuffed at us. */
6580 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
58788063 6581 int n_to_read;
284f4730 6582
58788063 6583 /* Determine how many characters we should *try* to read. */
bc536d84
RS
6584#ifdef WINDOWSNT
6585 return 0;
6586#else /* not WINDOWSNT */
80e4aa30 6587#ifdef MSDOS
58788063
RS
6588 n_to_read = dos_keysns ();
6589 if (n_to_read == 0)
6590 return 0;
c3a2738c 6591#else /* not MSDOS */
284f4730
JB
6592#ifdef FIONREAD
6593 /* Find out how much input is available. */
437f6112 6594 if (ioctl (input_fd, FIONREAD, &n_to_read) < 0)
284f4730
JB
6595 /* Formerly simply reported no input, but that sometimes led to
6596 a failure of Emacs to terminate.
6597 SIGHUP seems appropriate if we can't reach the terminal. */
e4535288
RS
6598 /* ??? Is it really right to send the signal just to this process
6599 rather than to the whole process group?
6600 Perhaps on systems with FIONREAD Emacs is alone in its group. */
f1871a7d
RS
6601 {
6602 if (! noninteractive)
6603 kill (getpid (), SIGHUP);
6604 else
6605 n_to_read = 0;
6606 }
58788063 6607 if (n_to_read == 0)
284f4730 6608 return 0;
58788063
RS
6609 if (n_to_read > sizeof cbuf)
6610 n_to_read = sizeof cbuf;
284f4730 6611#else /* no FIONREAD */
c60ee5e7 6612#if defined (USG) || defined (DGUX) || defined(CYGWIN)
284f4730 6613 /* Read some input if available, but don't wait. */
58788063 6614 n_to_read = sizeof cbuf;
437f6112 6615 fcntl (input_fd, F_SETFL, O_NDELAY);
284f4730
JB
6616#else
6617 you lose;
6618#endif
6619#endif
80e4aa30 6620#endif /* not MSDOS */
bc536d84 6621#endif /* not WINDOWSNT */
284f4730 6622
58788063
RS
6623 /* Now read; for one reason or another, this will not block.
6624 NREAD is set to the number of chars read. */
9134775b 6625 do
284f4730 6626 {
80e4aa30 6627#ifdef MSDOS
0c04a67e 6628 cbuf[0] = dos_keyread ();
80e4aa30
RS
6629 nread = 1;
6630#else
68c45bf0 6631 nread = emacs_read (input_fd, cbuf, n_to_read);
80e4aa30 6632#endif
49854566
RS
6633 /* POSIX infers that processes which are not in the session leader's
6634 process group won't get SIGHUP's at logout time. BSDI adheres to
e8886a1d 6635 this part standard and returns -1 from read (0) with errno==EIO
49854566
RS
6636 when the control tty is taken away.
6637 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
6638 if (nread == -1 && errno == EIO)
6639 kill (0, SIGHUP);
762f2b92 6640#if defined (AIX) && (! defined (aix386) && defined (_BSD))
284f4730
JB
6641 /* The kernel sometimes fails to deliver SIGHUP for ptys.
6642 This looks incorrect, but it isn't, because _BSD causes
6643 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
6644 and that causes a value other than 0 when there is no input. */
854f3a54 6645 if (nread == 0)
80e4aa30 6646 kill (0, SIGHUP);
284f4730 6647#endif
9134775b 6648 }
791587ee
KH
6649 while (
6650 /* We used to retry the read if it was interrupted.
6651 But this does the wrong thing when O_NDELAY causes
6652 an EAGAIN error. Does anybody know of a situation
6653 where a retry is actually needed? */
6654#if 0
6655 nread < 0 && (errno == EAGAIN
6aec06f5 6656#ifdef EFAULT
9134775b 6657 || errno == EFAULT
80e4aa30 6658#endif
284f4730 6659#ifdef EBADSLT
9134775b 6660 || errno == EBADSLT
284f4730 6661#endif
791587ee
KH
6662 )
6663#else
6664 0
6665#endif
6666 );
284f4730
JB
6667
6668#ifndef FIONREAD
c60ee5e7 6669#if defined (USG) || defined (DGUX) || defined (CYGWIN)
437f6112 6670 fcntl (input_fd, F_SETFL, 0);
c60ee5e7 6671#endif /* USG or DGUX or CYGWIN */
284f4730
JB
6672#endif /* no FIONREAD */
6673 for (i = 0; i < nread; i++)
6674 {
3b8f9651 6675 buf[i].kind = ASCII_KEYSTROKE_EVENT;
86e5706b 6676 buf[i].modifiers = 0;
b04904fb 6677 if (meta_key == 1 && (cbuf[i] & 0x80))
86e5706b 6678 buf[i].modifiers = meta_modifier;
b04904fb
RS
6679 if (meta_key != 2)
6680 cbuf[i] &= ~0x80;
f3e59d5e
KH
6681
6682 buf[i].code = cbuf[i];
788f89eb 6683 buf[i].frame_or_window = selected_frame;
da8f7368 6684 buf[i].arg = Qnil;
284f4730
JB
6685 }
6686 }
6687
6688 /* Scan the chars for C-g and store them in kbd_buffer. */
6689 for (i = 0; i < nread; i++)
6690 {
6691 kbd_buffer_store_event (&buf[i]);
6692 /* Don't look at input that follows a C-g too closely.
6693 This reduces lossage due to autorepeat on C-g. */
3b8f9651 6694 if (buf[i].kind == ASCII_KEYSTROKE_EVENT
9343ab07 6695 && buf[i].code == quit_char)
284f4730
JB
6696 break;
6697 }
6698
6699 return nread;
6700}
6701#endif /* not VMS */
6702\f
6703#ifdef SIGIO /* for entire page */
6704/* Note SIGIO has been undef'd if FIONREAD is missing. */
6705
4216b545 6706static SIGTYPE
284f4730
JB
6707input_available_signal (signo)
6708 int signo;
6709{
6710 /* Must preserve main program's value of errno. */
6711 int old_errno = errno;
6712#ifdef BSD4_1
6713 extern int select_alarmed;
6714#endif
6715
5970a8cb 6716#if defined (USG) && !defined (POSIX_SIGNALS)
284f4730
JB
6717 /* USG systems forget handlers when they are used;
6718 must reestablish each time */
6719 signal (signo, input_available_signal);
6720#endif /* USG */
6721
6722#ifdef BSD4_1
6723 sigisheld (SIGIO);
6724#endif
6725
ffd56f97
JB
6726 if (input_available_clear_time)
6727 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
284f4730
JB
6728
6729 while (1)
6730 {
6731 int nread;
6732 nread = read_avail_input (1);
6733 /* -1 means it's not ok to read the input now.
6734 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
6735 0 means there was no keyboard input available. */
6736 if (nread <= 0)
6737 break;
6738
6739#ifdef BSD4_1
6740 select_alarmed = 1; /* Force the select emulator back to life */
6741#endif
6742 }
6743
6744#ifdef BSD4_1
6745 sigfree ();
6746#endif
6747 errno = old_errno;
6748}
6749#endif /* SIGIO */
ad163903
JB
6750
6751/* Send ourselves a SIGIO.
6752
6753 This function exists so that the UNBLOCK_INPUT macro in
6754 blockinput.h can have some way to take care of input we put off
6755 dealing with, without assuming that every file which uses
6756 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
6757void
6758reinvoke_input_signal ()
6759{
df0f2ba1 6760#ifdef SIGIO
87dd9b9b 6761 kill (getpid (), SIGIO);
ad163903
JB
6762#endif
6763}
6764
6765
284f4730 6766\f
318ab85c
SM
6767static void menu_bar_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object, void*));
6768static Lisp_Object menu_bar_one_keymap_changed_items;
b7c49376
RS
6769
6770/* These variables hold the vector under construction within
6771 menu_bar_items and its subroutines, and the current index
6772 for storing into that vector. */
6773static Lisp_Object menu_bar_items_vector;
9343ab07 6774static int menu_bar_items_index;
5ec75a55 6775
b7c49376
RS
6776/* Return a vector of menu items for a menu bar, appropriate
6777 to the current buffer. Each item has three elements in the vector:
f5e09c8b 6778 KEY STRING MAPLIST.
b7c49376
RS
6779
6780 OLD is an old vector we can optionally reuse, or nil. */
5ec75a55
RS
6781
6782Lisp_Object
b7c49376
RS
6783menu_bar_items (old)
6784 Lisp_Object old;
5ec75a55
RS
6785{
6786 /* The number of keymaps we're scanning right now, and the number of
6787 keymaps we have allocated space for. */
6788 int nmaps;
6789
6790 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
6791 in the current keymaps, or nil where it is not a prefix. */
6792 Lisp_Object *maps;
6793
aebfea68 6794 Lisp_Object def, tail;
5ec75a55
RS
6795
6796 Lisp_Object result;
6797
6798 int mapno;
47d319aa 6799 Lisp_Object oquit;
5ec75a55 6800
b7c49376
RS
6801 int i;
6802
6803 struct gcpro gcpro1;
6804
db60d856
JB
6805 /* In order to build the menus, we need to call the keymap
6806 accessors. They all call QUIT. But this function is called
6807 during redisplay, during which a quit is fatal. So inhibit
47d319aa
RS
6808 quitting while building the menus.
6809 We do this instead of specbind because (1) errors will clear it anyway
6810 and (2) this avoids risk of specpdl overflow. */
6811 oquit = Vinhibit_quit;
df0f2ba1 6812 Vinhibit_quit = Qt;
db60d856 6813
b7c49376
RS
6814 if (!NILP (old))
6815 menu_bar_items_vector = old;
6816 else
6817 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
6818 menu_bar_items_index = 0;
6819
6820 GCPRO1 (menu_bar_items_vector);
6821
5ec75a55
RS
6822 /* Build our list of keymaps.
6823 If we recognize a function key and replace its escape sequence in
6824 keybuf with its symbol, or if the sequence starts with a mouse
6825 click and we need to switch buffers, we jump back here to rebuild
6826 the initial keymaps from the current buffer. */
df0f2ba1 6827 {
5ec75a55
RS
6828 Lisp_Object *tmaps;
6829
217258d5 6830 /* Should overriding-terminal-local-map and overriding-local-map apply? */
d0a49716 6831 if (!NILP (Voverriding_local_map_menu_flag))
9dd3131c 6832 {
217258d5
KH
6833 /* Yes, use them (if non-nil) as well as the global map. */
6834 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
6835 nmaps = 0;
6836 if (!NILP (current_kboard->Voverriding_terminal_local_map))
6837 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
6838 if (!NILP (Voverriding_local_map))
6839 maps[nmaps++] = Voverriding_local_map;
9dd3131c
RS
6840 }
6841 else
6842 {
fd646341
KS
6843 /* No, so use major and minor mode keymaps and keymap property.
6844 Note that menu-bar bindings in the local-map and keymap
6845 properties may not work reliable, as they are only
6846 recognized when the menu-bar (or mode-line) is updated,
6847 which does not normally happen after every command. */
6848 Lisp_Object tem;
6849 int nminor;
6850 nminor = current_minor_maps (NULL, &tmaps);
6851 maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
6852 nmaps = 0;
6853 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
6854 maps[nmaps++] = tem;
6855 bcopy (tmaps, (void *) (maps + nmaps), nminor * sizeof (maps[0]));
6856 nmaps += nminor;
6857 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
9dd3131c 6858 }
217258d5 6859 maps[nmaps++] = current_global_map;
5ec75a55
RS
6860 }
6861
6862 /* Look up in each map the dummy prefix key `menu-bar'. */
6863
6864 result = Qnil;
6865
e58aa385 6866 for (mapno = nmaps - 1; mapno >= 0; mapno--)
25126faa
GM
6867 if (!NILP (maps[mapno]))
6868 {
341a09cf
SM
6869 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
6870 0, 1);
02067692 6871 if (CONSP (def))
4216b545
SM
6872 {
6873 menu_bar_one_keymap_changed_items = Qnil;
6874 map_keymap (def, menu_bar_item, Qnil, NULL, 1);
6875 }
25126faa 6876 }
5ec75a55 6877
b7c49376
RS
6878 /* Move to the end those items that should be at the end. */
6879
7539e11f 6880 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
9f9c0e27 6881 {
b7c49376
RS
6882 int i;
6883 int end = menu_bar_items_index;
6884
35b3402f 6885 for (i = 0; i < end; i += 4)
7539e11f 6886 if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i]))
b7c49376 6887 {
35b3402f 6888 Lisp_Object tem0, tem1, tem2, tem3;
0301268e
RS
6889 /* Move the item at index I to the end,
6890 shifting all the others forward. */
6891 tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
6892 tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
6893 tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
35b3402f
RS
6894 tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
6895 if (end > i + 4)
6896 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
0301268e 6897 &XVECTOR (menu_bar_items_vector)->contents[i],
35b3402f
RS
6898 (end - i - 4) * sizeof (Lisp_Object));
6899 XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
6900 XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
6901 XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
6902 XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
0301268e 6903 break;
b7c49376
RS
6904 }
6905 }
9f9c0e27 6906
0c9071cd 6907 /* Add nil, nil, nil, nil at the end. */
b7c49376 6908 i = menu_bar_items_index;
35b3402f 6909 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
b7c49376
RS
6910 {
6911 Lisp_Object tem;
b7c49376
RS
6912 tem = Fmake_vector (make_number (2 * i), Qnil);
6913 bcopy (XVECTOR (menu_bar_items_vector)->contents,
6914 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
6915 menu_bar_items_vector = tem;
9f9c0e27 6916 }
b7c49376
RS
6917 /* Add this item. */
6918 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6919 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6920 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
35b3402f 6921 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
b7c49376 6922 menu_bar_items_index = i;
a73c5e29 6923
47d319aa 6924 Vinhibit_quit = oquit;
b7c49376
RS
6925 UNGCPRO;
6926 return menu_bar_items_vector;
5ec75a55
RS
6927}
6928\f
f5e09c8b
RS
6929/* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
6930 If there's already an item for KEY, add this DEF to it. */
6931
e8886a1d
RS
6932Lisp_Object item_properties;
6933
b7c49376 6934static void
4216b545
SM
6935menu_bar_item (key, item, dummy1, dummy2)
6936 Lisp_Object key, item, dummy1;
6937 void *dummy2;
5ec75a55 6938{
e8886a1d 6939 struct gcpro gcpro1;
b7c49376 6940 int i;
759860a6 6941 Lisp_Object tem;
5ec75a55 6942
e8886a1d 6943 if (EQ (item, Qundefined))
e58aa385 6944 {
f5e09c8b 6945 /* If a map has an explicit `undefined' as definition,
e58aa385 6946 discard any previously made menu bar item. */
b7c49376 6947
35b3402f 6948 for (i = 0; i < menu_bar_items_index; i += 4)
b7c49376
RS
6949 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
6950 {
35b3402f
RS
6951 if (menu_bar_items_index > i + 4)
6952 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
b7c49376 6953 &XVECTOR (menu_bar_items_vector)->contents[i],
35b3402f
RS
6954 (menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
6955 menu_bar_items_index -= 4;
b7c49376 6956 }
e58aa385
RS
6957 }
6958
759860a6
RS
6959 /* If this keymap has already contributed to this KEY,
6960 don't contribute to it a second time. */
6961 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
9cd2ced7 6962 if (!NILP (tem) || NILP (item))
759860a6
RS
6963 return;
6964
6965 menu_bar_one_keymap_changed_items
6966 = Fcons (key, menu_bar_one_keymap_changed_items);
6967
9cd2ced7
SM
6968 /* We add to menu_bar_one_keymap_changed_items before doing the
6969 parse_menu_item, so that if it turns out it wasn't a menu item,
6970 it still correctly hides any further menu item. */
6971 GCPRO1 (key);
6972 i = parse_menu_item (item, 0, 1);
6973 UNGCPRO;
6974 if (!i)
6975 return;
6976
e8886a1d
RS
6977 item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
6978
f5e09c8b 6979 /* Find any existing item for this KEY. */
35b3402f 6980 for (i = 0; i < menu_bar_items_index; i += 4)
b7c49376
RS
6981 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
6982 break;
6983
f5e09c8b 6984 /* If we did not find this KEY, add it at the end. */
b7c49376
RS
6985 if (i == menu_bar_items_index)
6986 {
6987 /* If vector is too small, get a bigger one. */
35b3402f 6988 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
b7c49376
RS
6989 {
6990 Lisp_Object tem;
b7c49376
RS
6991 tem = Fmake_vector (make_number (2 * i), Qnil);
6992 bcopy (XVECTOR (menu_bar_items_vector)->contents,
6993 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
6994 menu_bar_items_vector = tem;
6995 }
e8886a1d 6996
b7c49376
RS
6997 /* Add this item. */
6998 XVECTOR (menu_bar_items_vector)->contents[i++] = key;
e8886a1d
RS
6999 XVECTOR (menu_bar_items_vector)->contents[i++]
7000 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
7001 XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
35b3402f 7002 XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
b7c49376
RS
7003 menu_bar_items_index = i;
7004 }
e8886a1d 7005 /* We did find an item for this KEY. Add ITEM to its list of maps. */
f5e09c8b
RS
7006 else
7007 {
7008 Lisp_Object old;
7009 old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
4216b545
SM
7010 /* If the new and the old items are not both keymaps,
7011 the lookup will only find `item'. */
7012 item = Fcons (item, KEYMAPP (item) && KEYMAPP (XCAR (old)) ? old : Qnil);
7013 XVECTOR (menu_bar_items_vector)->contents[i + 2] = item;
f5e09c8b 7014 }
5ec75a55
RS
7015}
7016\f
e8886a1d
RS
7017 /* This is used as the handler when calling menu_item_eval_property. */
7018static Lisp_Object
7019menu_item_eval_property_1 (arg)
7020 Lisp_Object arg;
7021{
7022 /* If we got a quit from within the menu computation,
7023 quit all the way out of it. This takes care of C-] in the debugger. */
7539e11f 7024 if (CONSP (arg) && EQ (XCAR (arg), Qquit))
e8886a1d
RS
7025 Fsignal (Qquit, Qnil);
7026
7027 return Qnil;
7028}
7029
c60ee5e7 7030/* Evaluate an expression and return the result (or nil if something
e8886a1d 7031 went wrong). Used to evaluate dynamic parts of menu items. */
7ee32cda 7032Lisp_Object
e8886a1d
RS
7033menu_item_eval_property (sexpr)
7034 Lisp_Object sexpr;
7035{
aed13378 7036 int count = SPECPDL_INDEX ();
e8886a1d 7037 Lisp_Object val;
44e553a3 7038 specbind (Qinhibit_redisplay, Qt);
e8886a1d
RS
7039 val = internal_condition_case_1 (Feval, sexpr, Qerror,
7040 menu_item_eval_property_1);
44e553a3 7041 return unbind_to (count, val);
e8886a1d
RS
7042}
7043
7044/* This function parses a menu item and leaves the result in the
7045 vector item_properties.
7046 ITEM is a key binding, a possible menu item.
7047 If NOTREAL is nonzero, only check for equivalent key bindings, don't
7048 evaluate dynamic expressions in the menu item.
fd3613d7 7049 INMENUBAR is > 0 when this is considered for an entry in a menu bar
e8886a1d 7050 top level.
fd3613d7 7051 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
e8886a1d
RS
7052 parse_menu_item returns true if the item is a menu item and false
7053 otherwise. */
7054
7055int
7056parse_menu_item (item, notreal, inmenubar)
7057 Lisp_Object item;
7058 int notreal, inmenubar;
7059{
adc1d5c8 7060 Lisp_Object def, tem, item_string, start;
07ba902e
RS
7061 Lisp_Object cachelist;
7062 Lisp_Object filter;
7063 Lisp_Object keyhint;
e8886a1d 7064 int i;
74c1de23
RS
7065 int newcache = 0;
7066
07ba902e
RS
7067 cachelist = Qnil;
7068 filter = Qnil;
7069 keyhint = Qnil;
7070
e8886a1d
RS
7071 if (!CONSP (item))
7072 return 0;
7073
e8886a1d
RS
7074 /* Create item_properties vector if necessary. */
7075 if (NILP (item_properties))
7076 item_properties
7077 = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
7078
7079 /* Initialize optional entries. */
7080 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
3626fb1a
GM
7081 AREF (item_properties, i) = Qnil;
7082 AREF (item_properties, ITEM_PROPERTY_ENABLE) = Qt;
c60ee5e7 7083
e8886a1d 7084 /* Save the item here to protect it from GC. */
3626fb1a 7085 AREF (item_properties, ITEM_PROPERTY_ITEM) = item;
e8886a1d 7086
7539e11f 7087 item_string = XCAR (item);
e8886a1d
RS
7088
7089 start = item;
7539e11f 7090 item = XCDR (item);
e8886a1d
RS
7091 if (STRINGP (item_string))
7092 {
7093 /* Old format menu item. */
3626fb1a 7094 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
e8886a1d
RS
7095
7096 /* Maybe help string. */
7539e11f 7097 if (CONSP (item) && STRINGP (XCAR (item)))
e8886a1d 7098 {
3626fb1a 7099 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
e8886a1d 7100 start = item;
7539e11f 7101 item = XCDR (item);
e8886a1d 7102 }
c60ee5e7 7103
31f84d03 7104 /* Maybe key binding cache. */
7539e11f
KR
7105 if (CONSP (item) && CONSP (XCAR (item))
7106 && (NILP (XCAR (XCAR (item)))
7107 || VECTORP (XCAR (XCAR (item)))))
e8886a1d 7108 {
7539e11f
KR
7109 cachelist = XCAR (item);
7110 item = XCDR (item);
e8886a1d 7111 }
c60ee5e7 7112
e8886a1d 7113 /* This is the real definition--the function to run. */
3626fb1a 7114 AREF (item_properties, ITEM_PROPERTY_DEF) = item;
e8886a1d
RS
7115
7116 /* Get enable property, if any. */
7117 if (SYMBOLP (item))
7118 {
7119 tem = Fget (item, Qmenu_enable);
7120 if (!NILP (tem))
3626fb1a 7121 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
e8886a1d
RS
7122 }
7123 }
7124 else if (EQ (item_string, Qmenu_item) && CONSP (item))
7125 {
7126 /* New format menu item. */
3626fb1a 7127 AREF (item_properties, ITEM_PROPERTY_NAME) = XCAR (item);
7539e11f 7128 start = XCDR (item);
e8886a1d
RS
7129 if (CONSP (start))
7130 {
7131 /* We have a real binding. */
3626fb1a 7132 AREF (item_properties, ITEM_PROPERTY_DEF) = XCAR (start);
e8886a1d 7133
7539e11f 7134 item = XCDR (start);
e8886a1d 7135 /* Is there a cache list with key equivalences. */
7539e11f 7136 if (CONSP (item) && CONSP (XCAR (item)))
e8886a1d 7137 {
7539e11f
KR
7138 cachelist = XCAR (item);
7139 item = XCDR (item);
e8886a1d
RS
7140 }
7141
7142 /* Parse properties. */
7539e11f 7143 while (CONSP (item) && CONSP (XCDR (item)))
e8886a1d 7144 {
7539e11f
KR
7145 tem = XCAR (item);
7146 item = XCDR (item);
e8886a1d
RS
7147
7148 if (EQ (tem, QCenable))
3626fb1a 7149 AREF (item_properties, ITEM_PROPERTY_ENABLE) = XCAR (item);
e8886a1d
RS
7150 else if (EQ (tem, QCvisible) && !notreal)
7151 {
7152 /* If got a visible property and that evaluates to nil
7153 then ignore this item. */
7539e11f 7154 tem = menu_item_eval_property (XCAR (item));
e8886a1d 7155 if (NILP (tem))
adc1d5c8 7156 return 0;
e8886a1d
RS
7157 }
7158 else if (EQ (tem, QChelp))
3626fb1a 7159 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
e8886a1d 7160 else if (EQ (tem, QCfilter))
74c1de23
RS
7161 filter = item;
7162 else if (EQ (tem, QCkey_sequence))
7163 {
7539e11f 7164 tem = XCAR (item);
74c1de23
RS
7165 if (NILP (cachelist)
7166 && (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem)))
7167 /* Be GC protected. Set keyhint to item instead of tem. */
7168 keyhint = item;
7169 }
7170 else if (EQ (tem, QCkeys))
7171 {
7539e11f 7172 tem = XCAR (item);
03cee6ae 7173 if (CONSP (tem) || (STRINGP (tem) && NILP (cachelist)))
3626fb1a 7174 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
74c1de23 7175 }
7539e11f 7176 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
e8886a1d 7177 {
74c1de23 7178 Lisp_Object type;
7539e11f
KR
7179 tem = XCAR (item);
7180 type = XCAR (tem);
e8886a1d
RS
7181 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7182 {
3626fb1a 7183 AREF (item_properties, ITEM_PROPERTY_SELECTED)
7539e11f 7184 = XCDR (tem);
3626fb1a 7185 AREF (item_properties, ITEM_PROPERTY_TYPE)
e8886a1d
RS
7186 = type;
7187 }
7188 }
7539e11f 7189 item = XCDR (item);
e8886a1d
RS
7190 }
7191 }
7192 else if (inmenubar || !NILP (start))
adc1d5c8 7193 return 0;
e8886a1d
RS
7194 }
7195 else
adc1d5c8 7196 return 0; /* not a menu item */
e8886a1d
RS
7197
7198 /* If item string is not a string, evaluate it to get string.
7199 If we don't get a string, skip this item. */
3626fb1a 7200 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
e8886a1d
RS
7201 if (!(STRINGP (item_string) || notreal))
7202 {
7203 item_string = menu_item_eval_property (item_string);
7204 if (!STRINGP (item_string))
adc1d5c8 7205 return 0;
3626fb1a 7206 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
e8886a1d 7207 }
c60ee5e7 7208
e8886a1d 7209 /* If got a filter apply it on definition. */
3626fb1a 7210 def = AREF (item_properties, ITEM_PROPERTY_DEF);
e8886a1d
RS
7211 if (!NILP (filter))
7212 {
7539e11f 7213 def = menu_item_eval_property (list2 (XCAR (filter),
c5c5a6f8
RS
7214 list2 (Qquote, def)));
7215
3626fb1a 7216 AREF (item_properties, ITEM_PROPERTY_DEF) = def;
e8886a1d
RS
7217 }
7218
e8886a1d 7219 /* Enable or disable selection of item. */
3626fb1a 7220 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
e8886a1d
RS
7221 if (!EQ (tem, Qt))
7222 {
7223 if (notreal)
7224 tem = Qt;
7225 else
7226 tem = menu_item_eval_property (tem);
7227 if (inmenubar && NILP (tem))
adc1d5c8 7228 return 0; /* Ignore disabled items in menu bar. */
3626fb1a 7229 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
e8886a1d
RS
7230 }
7231
7189cad8
SM
7232 /* If we got no definition, this item is just unselectable text which
7233 is OK in a submenu but not in the menubar. */
7234 if (NILP (def))
7235 return (inmenubar ? 0 : 1);
c60ee5e7 7236
e8886a1d 7237 /* See if this is a separate pane or a submenu. */
3626fb1a 7238 def = AREF (item_properties, ITEM_PROPERTY_DEF);
02067692 7239 tem = get_keymap (def, 0, 1);
9ac425d1 7240 /* For a subkeymap, just record its details and exit. */
02067692 7241 if (CONSP (tem))
e8886a1d 7242 {
3626fb1a
GM
7243 AREF (item_properties, ITEM_PROPERTY_MAP) = tem;
7244 AREF (item_properties, ITEM_PROPERTY_DEF) = tem;
e8886a1d
RS
7245 return 1;
7246 }
c60ee5e7 7247
9ac425d1
RS
7248 /* At the top level in the menu bar, do likewise for commands also.
7249 The menu bar does not display equivalent key bindings anyway.
7250 ITEM_PROPERTY_DEF is already set up properly. */
7251 if (inmenubar > 0)
7252 return 1;
e8886a1d
RS
7253
7254 /* This is a command. See if there is an equivalent key binding. */
7255 if (NILP (cachelist))
7256 {
74c1de23 7257 /* We have to create a cachelist. */
e8886a1d 7258 CHECK_IMPURE (start);
f3fbd155 7259 XSETCDR (start, Fcons (Fcons (Qnil, Qnil), XCDR (start)));
7539e11f 7260 cachelist = XCAR (XCDR (start));
74c1de23 7261 newcache = 1;
3626fb1a 7262 tem = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
74c1de23
RS
7263 if (!NILP (keyhint))
7264 {
f3fbd155 7265 XSETCAR (cachelist, XCAR (keyhint));
74c1de23
RS
7266 newcache = 0;
7267 }
7268 else if (STRINGP (tem))
7269 {
f3fbd155
KR
7270 XSETCDR (cachelist, Fsubstitute_command_keys (tem));
7271 XSETCAR (cachelist, Qt);
74c1de23
RS
7272 }
7273 }
c60ee5e7 7274
7539e11f 7275 tem = XCAR (cachelist);
74c1de23
RS
7276 if (!EQ (tem, Qt))
7277 {
7278 int chkcache = 0;
7279 Lisp_Object prefix;
7280
7281 if (!NILP (tem))
8b9940e6 7282 tem = Fkey_binding (tem, Qnil, Qnil);
74c1de23 7283
3626fb1a 7284 prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
74c1de23
RS
7285 if (CONSP (prefix))
7286 {
7539e11f
KR
7287 def = XCAR (prefix);
7288 prefix = XCDR (prefix);
74c1de23 7289 }
e8886a1d 7290 else
3626fb1a 7291 def = AREF (item_properties, ITEM_PROPERTY_DEF);
74c1de23 7292
3626fb1a
GM
7293 if (!update_menu_bindings)
7294 chkcache = 0;
7295 else if (NILP (XCAR (cachelist))) /* Have no saved key. */
74c1de23
RS
7296 {
7297 if (newcache /* Always check first time. */
7298 /* Should we check everything when precomputing key
7299 bindings? */
74c1de23
RS
7300 /* If something had no key binding before, don't recheck it
7301 because that is too slow--except if we have a list of
7302 rebound commands in Vdefine_key_rebound_commands, do
7303 recheck any command that appears in that list. */
7304 || (CONSP (Vdefine_key_rebound_commands)
7305 && !NILP (Fmemq (def, Vdefine_key_rebound_commands))))
7306 chkcache = 1;
7307 }
7308 /* We had a saved key. Is it still bound to the command? */
7309 else if (NILP (tem)
03cee6ae
GM
7310 || (!EQ (tem, def)
7311 /* If the command is an alias for another
7312 (such as lmenu.el set it up), check if the
7313 original command matches the cached command. */
7314 && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))))
74c1de23
RS
7315 chkcache = 1; /* Need to recompute key binding. */
7316
7317 if (chkcache)
7318 {
7319 /* Recompute equivalent key binding. If the command is an alias
7320 for another (such as lmenu.el set it up), see if the original
7321 command name has equivalent keys. Otherwise look up the
7322 specified command itself. We don't try both, because that
7323 makes lmenu menus slow. */
3626fb1a
GM
7324 if (SYMBOLP (def)
7325 && SYMBOLP (XSYMBOL (def)->function)
74c1de23
RS
7326 && ! NILP (Fget (def, Qmenu_alias)))
7327 def = XSYMBOL (def)->function;
8b9940e6 7328 tem = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qt);
f3fbd155 7329 XSETCAR (cachelist, tem);
74c1de23
RS
7330 if (NILP (tem))
7331 {
f3fbd155 7332 XSETCDR (cachelist, Qnil);
74c1de23
RS
7333 chkcache = 0;
7334 }
7335 }
7539e11f 7336 else if (!NILP (keyhint) && !NILP (XCAR (cachelist)))
74c1de23 7337 {
7539e11f 7338 tem = XCAR (cachelist);
74c1de23
RS
7339 chkcache = 1;
7340 }
7341
7342 newcache = chkcache;
7343 if (chkcache)
7344 {
7345 tem = Fkey_description (tem);
7346 if (CONSP (prefix))
7347 {
7539e11f
KR
7348 if (STRINGP (XCAR (prefix)))
7349 tem = concat2 (XCAR (prefix), tem);
7350 if (STRINGP (XCDR (prefix)))
7351 tem = concat2 (tem, XCDR (prefix));
74c1de23 7352 }
f3fbd155 7353 XSETCDR (cachelist, tem);
74c1de23
RS
7354 }
7355 }
7356
7539e11f 7357 tem = XCDR (cachelist);
74c1de23 7358 if (newcache && !NILP (tem))
e8886a1d 7359 {
74c1de23 7360 tem = concat3 (build_string (" ("), tem, build_string (")"));
f3fbd155 7361 XSETCDR (cachelist, tem);
e8886a1d
RS
7362 }
7363
7364 /* If we only want to precompute equivalent key bindings, stop here. */
7365 if (notreal)
adc1d5c8 7366 return 1;
e8886a1d
RS
7367
7368 /* If we have an equivalent key binding, use that. */
3626fb1a 7369 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
adc1d5c8
RS
7370
7371 /* Include this when menu help is implemented.
7372 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
7373 if (!(NILP (tem) || STRINGP (tem)))
7374 {
7375 tem = menu_item_eval_property (tem);
7376 if (!STRINGP (tem))
7377 tem = Qnil;
7378 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
7379 }
e8886a1d
RS
7380 */
7381
c60ee5e7 7382 /* Handle radio buttons or toggle boxes. */
3626fb1a 7383 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
e8886a1d 7384 if (!NILP (tem))
3626fb1a 7385 AREF (item_properties, ITEM_PROPERTY_SELECTED)
e8886a1d
RS
7386 = menu_item_eval_property (tem);
7387
e8886a1d
RS
7388 return 1;
7389}
7ee32cda
GM
7390
7391
7392\f
7393/***********************************************************************
7394 Tool-bars
7395 ***********************************************************************/
7396
9ea173e8 7397/* A vector holding tool bar items while they are parsed in function
27fd22dc 7398 tool_bar_items. Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
9ea173e8 7399 in the vector. */
7ee32cda 7400
9ea173e8 7401static Lisp_Object tool_bar_items_vector;
7ee32cda 7402
9ea173e8
GM
7403/* A vector holding the result of parse_tool_bar_item. Layout is like
7404 the one for a single item in tool_bar_items_vector. */
7ee32cda 7405
9ea173e8 7406static Lisp_Object tool_bar_item_properties;
7ee32cda 7407
9ea173e8 7408/* Next free index in tool_bar_items_vector. */
7ee32cda 7409
9ea173e8 7410static int ntool_bar_items;
7ee32cda 7411
9ea173e8 7412/* The symbols `tool-bar', and `:image'. */
7ee32cda 7413
9ea173e8 7414extern Lisp_Object Qtool_bar;
7ee32cda
GM
7415Lisp_Object QCimage;
7416
7417/* Function prototypes. */
7418
9ea173e8
GM
7419static void init_tool_bar_items P_ ((Lisp_Object));
7420static void process_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
7421static int parse_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
7422static void append_tool_bar_item P_ ((void));
7ee32cda
GM
7423
7424
9ea173e8 7425/* Return a vector of tool bar items for keymaps currently in effect.
7ee32cda 7426 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
9ea173e8 7427 tool bar items found. */
7ee32cda
GM
7428
7429Lisp_Object
9ea173e8 7430tool_bar_items (reuse, nitems)
7ee32cda
GM
7431 Lisp_Object reuse;
7432 int *nitems;
7433{
7434 Lisp_Object *maps;
7435 int nmaps, i;
7436 Lisp_Object oquit;
7437 Lisp_Object *tmaps;
7ee32cda
GM
7438
7439 *nitems = 0;
7440
7441 /* In order to build the menus, we need to call the keymap
7442 accessors. They all call QUIT. But this function is called
7443 during redisplay, during which a quit is fatal. So inhibit
7444 quitting while building the menus. We do this instead of
7445 specbind because (1) errors will clear it anyway and (2) this
7446 avoids risk of specpdl overflow. */
7447 oquit = Vinhibit_quit;
7448 Vinhibit_quit = Qt;
c60ee5e7 7449
9ea173e8
GM
7450 /* Initialize tool_bar_items_vector and protect it from GC. */
7451 init_tool_bar_items (reuse);
7ee32cda
GM
7452
7453 /* Build list of keymaps in maps. Set nmaps to the number of maps
7454 to process. */
c60ee5e7 7455
7ee32cda
GM
7456 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7457 if (!NILP (Voverriding_local_map_menu_flag))
7458 {
7459 /* Yes, use them (if non-nil) as well as the global map. */
7460 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
7461 nmaps = 0;
7462 if (!NILP (current_kboard->Voverriding_terminal_local_map))
7463 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
7464 if (!NILP (Voverriding_local_map))
7465 maps[nmaps++] = Voverriding_local_map;
7466 }
7467 else
7468 {
fd646341
KS
7469 /* No, so use major and minor mode keymaps and keymap property.
7470 Note that tool-bar bindings in the local-map and keymap
7471 properties may not work reliable, as they are only
7472 recognized when the tool-bar (or mode-line) is updated,
7473 which does not normally happen after every command. */
7474 Lisp_Object tem;
7475 int nminor;
7476 nminor = current_minor_maps (NULL, &tmaps);
7477 maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
7478 nmaps = 0;
7479 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
7480 maps[nmaps++] = tem;
7481 bcopy (tmaps, (void *) (maps + nmaps), nminor * sizeof (maps[0]));
7482 nmaps += nminor;
7483 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
7ee32cda
GM
7484 }
7485
7486 /* Add global keymap at the end. */
7487 maps[nmaps++] = current_global_map;
7488
7489 /* Process maps in reverse order and look up in each map the prefix
9ea173e8 7490 key `tool-bar'. */
7ee32cda
GM
7491 for (i = nmaps - 1; i >= 0; --i)
7492 if (!NILP (maps[i]))
7493 {
7494 Lisp_Object keymap;
db785038 7495
341a09cf 7496 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
02067692 7497 if (CONSP (keymap))
7ee32cda
GM
7498 {
7499 Lisp_Object tail;
c60ee5e7 7500
7ee32cda 7501 /* KEYMAP is a list `(keymap (KEY . BINDING) ...)'. */
7539e11f 7502 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
7ee32cda
GM
7503 {
7504 Lisp_Object keydef = XCAR (tail);
7505 if (CONSP (keydef))
9ea173e8 7506 process_tool_bar_item (XCAR (keydef), XCDR (keydef));
7ee32cda
GM
7507 }
7508 }
7509 }
7510
7511 Vinhibit_quit = oquit;
9ea173e8
GM
7512 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
7513 return tool_bar_items_vector;
7ee32cda
GM
7514}
7515
7516
7517/* Process the definition of KEY which is DEF. */
7518
7519static void
9ea173e8 7520process_tool_bar_item (key, def)
7ee32cda
GM
7521 Lisp_Object key, def;
7522{
7523 int i;
7524 extern Lisp_Object Qundefined;
7525 struct gcpro gcpro1, gcpro2;
7526
9ea173e8 7527 /* Protect KEY and DEF from GC because parse_tool_bar_item may call
7ee32cda
GM
7528 eval. */
7529 GCPRO2 (key, def);
7530
7531 if (EQ (def, Qundefined))
7532 {
7533 /* If a map has an explicit `undefined' as definition,
7534 discard any previously made item. */
9ea173e8 7535 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
7ee32cda 7536 {
9ea173e8 7537 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
c60ee5e7 7538
9ea173e8 7539 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
7ee32cda 7540 {
9ea173e8
GM
7541 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
7542 bcopy (v + TOOL_BAR_ITEM_NSLOTS, v,
7543 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
7ee32cda 7544 * sizeof (Lisp_Object)));
9ea173e8 7545 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
7ee32cda
GM
7546 break;
7547 }
7548 }
7549 }
9ea173e8
GM
7550 else if (parse_tool_bar_item (key, def))
7551 /* Append a new tool bar item to tool_bar_items_vector. Accept
7ee32cda 7552 more than one definition for the same key. */
9ea173e8 7553 append_tool_bar_item ();
7ee32cda
GM
7554
7555 UNGCPRO;
7556}
7557
7558
9ea173e8
GM
7559/* Parse a tool bar item specification ITEM for key KEY and return the
7560 result in tool_bar_item_properties. Value is zero if ITEM is
7ee32cda
GM
7561 invalid.
7562
7563 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
c60ee5e7 7564
7ee32cda
GM
7565 CAPTION is the caption of the item, If it's not a string, it is
7566 evaluated to get a string.
c60ee5e7 7567
9ea173e8 7568 BINDING is the tool bar item's binding. Tool-bar items with keymaps
7ee32cda
GM
7569 as binding are currently ignored.
7570
7571 The following properties are recognized:
7572
7573 - `:enable FORM'.
c60ee5e7 7574
9ea173e8
GM
7575 FORM is evaluated and specifies whether the tool bar item is
7576 enabled or disabled.
c60ee5e7 7577
7ee32cda 7578 - `:visible FORM'
c60ee5e7 7579
9ea173e8 7580 FORM is evaluated and specifies whether the tool bar item is visible.
c60ee5e7 7581
7ee32cda
GM
7582 - `:filter FUNCTION'
7583
7584 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
7585 result is stored as the new binding.
c60ee5e7 7586
7ee32cda
GM
7587 - `:button (TYPE SELECTED)'
7588
7589 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
7590 and specifies whether the button is selected (pressed) or not.
c60ee5e7 7591
7ee32cda
GM
7592 - `:image IMAGES'
7593
7594 IMAGES is either a single image specification or a vector of four
9ea173e8 7595 image specifications. See enum tool_bar_item_images.
c60ee5e7 7596
7ee32cda 7597 - `:help HELP-STRING'.
c60ee5e7 7598
9ea173e8 7599 Gives a help string to display for the tool bar item. */
7ee32cda
GM
7600
7601static int
9ea173e8 7602parse_tool_bar_item (key, item)
7ee32cda
GM
7603 Lisp_Object key, item;
7604{
9ea173e8
GM
7605 /* Access slot with index IDX of vector tool_bar_item_properties. */
7606#define PROP(IDX) XVECTOR (tool_bar_item_properties)->contents[IDX]
7ee32cda
GM
7607
7608 Lisp_Object filter = Qnil;
7609 Lisp_Object caption;
7ee32cda 7610 int i;
7ee32cda 7611
8c907a56
GM
7612 /* Defininition looks like `(menu-item CAPTION BINDING PROPS...)'.
7613 Rule out items that aren't lists, don't start with
7614 `menu-item' or whose rest following `tool-bar-item' is not a
7ee32cda
GM
7615 list. */
7616 if (!CONSP (item)
7617 || !EQ (XCAR (item), Qmenu_item)
7618 || (item = XCDR (item),
7619 !CONSP (item)))
7620 return 0;
7621
9ea173e8 7622 /* Create tool_bar_item_properties vector if necessary. Reset it to
7ee32cda 7623 defaults. */
9ea173e8 7624 if (VECTORP (tool_bar_item_properties))
7ee32cda 7625 {
9ea173e8 7626 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
7ee32cda
GM
7627 PROP (i) = Qnil;
7628 }
7629 else
9ea173e8
GM
7630 tool_bar_item_properties
7631 = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
c60ee5e7 7632
7ee32cda 7633 /* Set defaults. */
9ea173e8
GM
7634 PROP (TOOL_BAR_ITEM_KEY) = key;
7635 PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
c60ee5e7 7636
7ee32cda
GM
7637 /* Get the caption of the item. If the caption is not a string,
7638 evaluate it to get a string. If we don't get a string, skip this
7639 item. */
7640 caption = XCAR (item);
7641 if (!STRINGP (caption))
7642 {
7643 caption = menu_item_eval_property (caption);
7644 if (!STRINGP (caption))
7645 return 0;
7646 }
9ea173e8 7647 PROP (TOOL_BAR_ITEM_CAPTION) = caption;
7ee32cda
GM
7648
7649 /* Give up if rest following the caption is not a list. */
7650 item = XCDR (item);
7651 if (!CONSP (item))
7652 return 0;
7653
7654 /* Store the binding. */
9ea173e8 7655 PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item);
7ee32cda
GM
7656 item = XCDR (item);
7657
8c907a56
GM
7658 /* Ignore cached key binding, if any. */
7659 if (CONSP (item) && CONSP (XCAR (item)))
7660 item = XCDR (item);
7661
7ee32cda
GM
7662 /* Process the rest of the properties. */
7663 for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
7664 {
7665 Lisp_Object key, value;
7666
7667 key = XCAR (item);
7668 value = XCAR (XCDR (item));
7669
7670 if (EQ (key, QCenable))
7671 /* `:enable FORM'. */
9ea173e8 7672 PROP (TOOL_BAR_ITEM_ENABLED_P) = value;
7ee32cda
GM
7673 else if (EQ (key, QCvisible))
7674 {
7675 /* `:visible FORM'. If got a visible property and that
7676 evaluates to nil then ignore this item. */
7677 if (NILP (menu_item_eval_property (value)))
7678 return 0;
7679 }
7680 else if (EQ (key, QChelp))
7681 /* `:help HELP-STRING'. */
9ea173e8 7682 PROP (TOOL_BAR_ITEM_HELP) = value;
7ee32cda
GM
7683 else if (EQ (key, QCfilter))
7684 /* ':filter FORM'. */
7685 filter = value;
7686 else if (EQ (key, QCbutton) && CONSP (value))
7687 {
7688 /* `:button (TYPE . SELECTED)'. */
7689 Lisp_Object type, selected;
7690
7691 type = XCAR (value);
7692 selected = XCDR (value);
7693 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7694 {
9ea173e8
GM
7695 PROP (TOOL_BAR_ITEM_SELECTED_P) = selected;
7696 PROP (TOOL_BAR_ITEM_TYPE) = type;
7ee32cda
GM
7697 }
7698 }
7699 else if (EQ (key, QCimage)
7700 && (CONSP (value)
7701 || (VECTORP (value) && XVECTOR (value)->size == 4)))
7702 /* Value is either a single image specification or a vector
27fd22dc 7703 of 4 such specifications for the different button states. */
9ea173e8 7704 PROP (TOOL_BAR_ITEM_IMAGES) = value;
7ee32cda
GM
7705 }
7706
7707 /* If got a filter apply it on binding. */
7708 if (!NILP (filter))
9ea173e8 7709 PROP (TOOL_BAR_ITEM_BINDING)
7ee32cda
GM
7710 = menu_item_eval_property (list2 (filter,
7711 list2 (Qquote,
9ea173e8 7712 PROP (TOOL_BAR_ITEM_BINDING))));
7ee32cda
GM
7713
7714 /* See if the binding is a keymap. Give up if it is. */
02067692 7715 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
7ee32cda
GM
7716 return 0;
7717
7718 /* Enable or disable selection of item. */
9ea173e8
GM
7719 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
7720 PROP (TOOL_BAR_ITEM_ENABLED_P)
7721 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P));
7ee32cda 7722
c60ee5e7 7723 /* Handle radio buttons or toggle boxes. */
9ea173e8
GM
7724 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
7725 PROP (TOOL_BAR_ITEM_SELECTED_P)
7726 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P));
7ee32cda
GM
7727
7728 return 1;
c60ee5e7 7729
7ee32cda
GM
7730#undef PROP
7731}
7732
7733
9ea173e8
GM
7734/* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
7735 that can be reused. */
7ee32cda
GM
7736
7737static void
9ea173e8 7738init_tool_bar_items (reuse)
7ee32cda
GM
7739 Lisp_Object reuse;
7740{
7741 if (VECTORP (reuse))
9ea173e8 7742 tool_bar_items_vector = reuse;
7ee32cda 7743 else
9ea173e8
GM
7744 tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
7745 ntool_bar_items = 0;
7ee32cda
GM
7746}
7747
7748
9ea173e8
GM
7749/* Append parsed tool bar item properties from
7750 tool_bar_item_properties */
7ee32cda
GM
7751
7752static void
9ea173e8 7753append_tool_bar_item ()
7ee32cda
GM
7754{
7755 Lisp_Object *to, *from;
c60ee5e7 7756
9ea173e8
GM
7757 /* Enlarge tool_bar_items_vector if necessary. */
7758 if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
7759 >= XVECTOR (tool_bar_items_vector)->size)
7ee32cda
GM
7760 {
7761 Lisp_Object new_vector;
9ea173e8 7762 int old_size = XVECTOR (tool_bar_items_vector)->size;
7ee32cda
GM
7763
7764 new_vector = Fmake_vector (make_number (2 * old_size), Qnil);
9ea173e8 7765 bcopy (XVECTOR (tool_bar_items_vector)->contents,
7ee32cda
GM
7766 XVECTOR (new_vector)->contents,
7767 old_size * sizeof (Lisp_Object));
9ea173e8 7768 tool_bar_items_vector = new_vector;
7ee32cda
GM
7769 }
7770
9ea173e8
GM
7771 /* Append entries from tool_bar_item_properties to the end of
7772 tool_bar_items_vector. */
7773 to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
7774 from = XVECTOR (tool_bar_item_properties)->contents;
7775 bcopy (from, to, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
7776 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
7ee32cda
GM
7777}
7778
7779
7780
7781
e8886a1d 7782\f
dcc408a0
RS
7783/* Read a character using menus based on maps in the array MAPS.
7784 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
7785 Return t if we displayed a menu but the user rejected it.
7d6de002
RS
7786
7787 PREV_EVENT is the previous input event, or nil if we are reading
7788 the first event of a key sequence.
7789
83d68044 7790 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
6569cc8d 7791 if we used a mouse menu to read the input, or zero otherwise. If
83d68044 7792 USED_MOUSE_MENU is null, we don't dereference it.
284f4730
JB
7793
7794 The prompting is done based on the prompt-string of the map
df0f2ba1 7795 and the strings associated with various map elements.
8150596a
RS
7796
7797 This can be done with X menus or with menus put in the minibuf.
7798 These are done in different ways, depending on how the input will be read.
7799 Menus using X are done after auto-saving in read-char, getting the input
7800 event from Fx_popup_menu; menus using the minibuf use read_char recursively
7801 and do auto-saving in the inner call of read_char. */
284f4730 7802
7617111f 7803static Lisp_Object
8150596a 7804read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
7d6de002
RS
7805 int nmaps;
7806 Lisp_Object *maps;
7807 Lisp_Object prev_event;
7808 int *used_mouse_menu;
284f4730 7809{
7d6de002 7810 int mapno;
14e40288 7811 register Lisp_Object name = Qnil;
7d6de002 7812
6569cc8d
JB
7813 if (used_mouse_menu)
7814 *used_mouse_menu = 0;
284f4730
JB
7815
7816 /* Use local over global Menu maps */
7817
7d6de002
RS
7818 if (! menu_prompting)
7819 return Qnil;
7820
03361bcc
RS
7821 /* Optionally disregard all but the global map. */
7822 if (inhibit_local_menu_bar_menus)
7823 {
7824 maps += (nmaps - 1);
7825 nmaps = 1;
7826 }
7827
7d6de002
RS
7828 /* Get the menu name from the first map that has one (a prompt string). */
7829 for (mapno = 0; mapno < nmaps; mapno++)
7830 {
bdb7aa47 7831 name = Fkeymap_prompt (maps[mapno]);
7d6de002
RS
7832 if (!NILP (name))
7833 break;
7834 }
284f4730 7835
7d6de002 7836 /* If we don't have any menus, just read a character normally. */
fa113341 7837 if (!STRINGP (name))
7d6de002
RS
7838 return Qnil;
7839
1f5b1641 7840#ifdef HAVE_MENUS
7d6de002
RS
7841 /* If we got to this point via a mouse click,
7842 use a real menu for mouse selection. */
5a8d99e0 7843 if (EVENT_HAS_PARAMETERS (prev_event)
7539e11f
KR
7844 && !EQ (XCAR (prev_event), Qmenu_bar)
7845 && !EQ (XCAR (prev_event), Qtool_bar))
7d6de002
RS
7846 {
7847 /* Display the menu and get the selection. */
7848 Lisp_Object *realmaps
7849 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
7850 Lisp_Object value;
7851 int nmaps1 = 0;
7852
7853 /* Use the maps that are not nil. */
7854 for (mapno = 0; mapno < nmaps; mapno++)
7855 if (!NILP (maps[mapno]))
7856 realmaps[nmaps1++] = maps[mapno];
7857
7858 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
663258f2
JB
7859 if (CONSP (value))
7860 {
68f297c5
RS
7861 Lisp_Object tem;
7862
7539e11f 7863 record_menu_key (XCAR (value));
8eb4d8ef 7864
68f297c5
RS
7865 /* If we got multiple events, unread all but
7866 the first.
7867 There is no way to prevent those unread events
7868 from showing up later in last_nonmenu_event.
7869 So turn symbol and integer events into lists,
7870 to indicate that they came from a mouse menu,
7871 so that when present in last_nonmenu_event
7872 they won't confuse things. */
f4e05d97 7873 for (tem = XCDR (value); !NILP (tem); tem = XCDR (tem))
8eb4d8ef 7874 {
7539e11f
KR
7875 record_menu_key (XCAR (tem));
7876 if (SYMBOLP (XCAR (tem))
7877 || INTEGERP (XCAR (tem)))
f3fbd155 7878 XSETCAR (tem, Fcons (XCAR (tem), Qdisabled));
8eb4d8ef 7879 }
68f297c5 7880
663258f2
JB
7881 /* If we got more than one event, put all but the first
7882 onto this list to be read later.
7883 Return just the first event now. */
24597608 7884 Vunread_command_events
7539e11f
KR
7885 = nconc2 (XCDR (value), Vunread_command_events);
7886 value = XCAR (value);
663258f2 7887 }
1c90c381 7888 else if (NILP (value))
dcc408a0 7889 value = Qt;
6569cc8d
JB
7890 if (used_mouse_menu)
7891 *used_mouse_menu = 1;
7d6de002
RS
7892 return value;
7893 }
1f5b1641 7894#endif /* HAVE_MENUS */
8150596a
RS
7895 return Qnil ;
7896}
7897
af2b7cc9
KS
7898/* Buffer in use so far for the minibuf prompts for menu keymaps.
7899 We make this bigger when necessary, and never free it. */
7900static char *read_char_minibuf_menu_text;
7901/* Size of that buffer. */
7902static int read_char_minibuf_menu_width;
7903
8150596a 7904static Lisp_Object
24597608 7905read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
8150596a
RS
7906 int commandflag ;
7907 int nmaps;
7908 Lisp_Object *maps;
7909{
7910 int mapno;
7911 register Lisp_Object name;
af2b7cc9 7912 int nlength;
14e40288 7913 /* FIXME: Use the minibuffer's frame width. */
2cdbe73e 7914 int width = FRAME_COLS (SELECTED_FRAME ()) - 4;
8150596a 7915 int idx = -1;
af2b7cc9 7916 int nobindings = 1;
8150596a 7917 Lisp_Object rest, vector;
af2b7cc9 7918 char *menu;
8150596a 7919
8c907a56 7920 vector = Qnil;
7189cad8 7921 name = Qnil;
8c907a56 7922
8150596a
RS
7923 if (! menu_prompting)
7924 return Qnil;
7925
af2b7cc9
KS
7926 /* Make sure we have a big enough buffer for the menu text. */
7927 if (read_char_minibuf_menu_text == 0)
7928 {
7929 read_char_minibuf_menu_width = width + 4;
7930 read_char_minibuf_menu_text = (char *) xmalloc (width + 4);
7931 }
7932 else if (width + 4 > read_char_minibuf_menu_width)
7933 {
7934 read_char_minibuf_menu_width = width + 4;
7935 read_char_minibuf_menu_text
7936 = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
7937 }
7938 menu = read_char_minibuf_menu_text;
7939
8150596a
RS
7940 /* Get the menu name from the first map that has one (a prompt string). */
7941 for (mapno = 0; mapno < nmaps; mapno++)
7942 {
bdb7aa47 7943 name = Fkeymap_prompt (maps[mapno]);
8150596a
RS
7944 if (!NILP (name))
7945 break;
7946 }
7947
7948 /* If we don't have any menus, just read a character normally. */
fa113341 7949 if (!STRINGP (name))
8150596a 7950 return Qnil;
284f4730 7951
af2b7cc9 7952 /* Prompt string always starts with map's prompt, and a space. */
d5db4077
KR
7953 strcpy (menu, SDATA (name));
7954 nlength = SBYTES (name);
af2b7cc9
KS
7955 menu[nlength++] = ':';
7956 menu[nlength++] = ' ';
7957 menu[nlength] = 0;
7958
7d6de002
RS
7959 /* Start prompting at start of first map. */
7960 mapno = 0;
7961 rest = maps[mapno];
284f4730 7962
af2b7cc9
KS
7963 /* Present the documented bindings, a line at a time. */
7964 while (1)
284f4730 7965 {
af2b7cc9
KS
7966 int notfirst = 0;
7967 int i = nlength;
7968 Lisp_Object obj;
7969 int ch;
7970 Lisp_Object orig_defn_macro;
284f4730 7971
af2b7cc9
KS
7972 /* Loop over elements of map. */
7973 while (i < width)
284f4730 7974 {
af2b7cc9 7975 Lisp_Object elt;
284f4730 7976
af2b7cc9
KS
7977 /* If reached end of map, start at beginning of next map. */
7978 if (NILP (rest))
7979 {
7980 mapno++;
7981 /* At end of last map, wrap around to first map if just starting,
7982 or end this line if already have something on it. */
7983 if (mapno == nmaps)
7984 {
7985 mapno = 0;
7986 if (notfirst || nobindings) break;
7987 }
7988 rest = maps[mapno];
7989 }
7d6de002 7990
af2b7cc9
KS
7991 /* Look at the next element of the map. */
7992 if (idx >= 0)
7993 elt = XVECTOR (vector)->contents[idx];
7994 else
7995 elt = Fcar_safe (rest);
7d6de002 7996
af2b7cc9 7997 if (idx < 0 && VECTORP (elt))
284f4730 7998 {
af2b7cc9
KS
7999 /* If we found a dense table in the keymap,
8000 advanced past it, but start scanning its contents. */
8001 rest = Fcdr_safe (rest);
8002 vector = elt;
8003 idx = 0;
284f4730 8004 }
7d6de002
RS
8005 else
8006 {
af2b7cc9
KS
8007 /* An ordinary element. */
8008 Lisp_Object event, tem;
7d6de002 8009
af2b7cc9
KS
8010 if (idx < 0)
8011 {
8012 event = Fcar_safe (elt); /* alist */
8013 elt = Fcdr_safe (elt);
8014 }
8015 else
8016 {
8017 XSETINT (event, idx); /* vector */
8018 }
284f4730 8019
af2b7cc9
KS
8020 /* Ignore the element if it has no prompt string. */
8021 if (INTEGERP (event) && parse_menu_item (elt, 0, -1))
8022 {
8023 /* 1 if the char to type matches the string. */
8024 int char_matches;
8025 Lisp_Object upcased_event, downcased_event;
8026 Lisp_Object desc = Qnil;
8027 Lisp_Object s
8028 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
8029
8030 upcased_event = Fupcase (event);
8031 downcased_event = Fdowncase (event);
d5db4077
KR
8032 char_matches = (XINT (upcased_event) == SREF (s, 0)
8033 || XINT (downcased_event) == SREF (s, 0));
af2b7cc9
KS
8034 if (! char_matches)
8035 desc = Fsingle_key_description (event, Qnil);
8036
8037#if 0 /* It is redundant to list the equivalent key bindings because
8038 the prefix is what the user has already typed. */
8039 tem
8040 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
8041 if (!NILP (tem))
8042 /* Insert equivalent keybinding. */
8043 s = concat2 (s, tem);
8044#endif
8045 tem
8046 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
8047 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
8048 {
8049 /* Insert button prefix. */
8050 Lisp_Object selected
8051 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
8052 if (EQ (tem, QCradio))
8053 tem = build_string (NILP (selected) ? "(*) " : "( ) ");
8054 else
8055 tem = build_string (NILP (selected) ? "[X] " : "[ ] ");
8056 s = concat2 (tem, s);
8057 }
c60ee5e7 8058
af2b7cc9
KS
8059
8060 /* If we have room for the prompt string, add it to this line.
8061 If this is the first on the line, always add it. */
d5db4077
KR
8062 if ((SCHARS (s) + i + 2
8063 + (char_matches ? 0 : SCHARS (desc) + 3))
af2b7cc9
KS
8064 < width
8065 || !notfirst)
8066 {
8067 int thiswidth;
8068
8069 /* Punctuate between strings. */
8070 if (notfirst)
8071 {
8072 strcpy (menu + i, ", ");
8073 i += 2;
8074 }
8075 notfirst = 1;
8076 nobindings = 0 ;
8077
8078 /* If the char to type doesn't match the string's
8079 first char, explicitly show what char to type. */
8080 if (! char_matches)
8081 {
8082 /* Add as much of string as fits. */
d5db4077 8083 thiswidth = SCHARS (desc);
af2b7cc9
KS
8084 if (thiswidth + i > width)
8085 thiswidth = width - i;
d5db4077 8086 bcopy (SDATA (desc), menu + i, thiswidth);
af2b7cc9
KS
8087 i += thiswidth;
8088 strcpy (menu + i, " = ");
8089 i += 3;
8090 }
8091
8092 /* Add as much of string as fits. */
d5db4077 8093 thiswidth = SCHARS (s);
af2b7cc9
KS
8094 if (thiswidth + i > width)
8095 thiswidth = width - i;
d5db4077 8096 bcopy (SDATA (s), menu + i, thiswidth);
af2b7cc9
KS
8097 i += thiswidth;
8098 menu[i] = 0;
8099 }
8100 else
8101 {
8102 /* If this element does not fit, end the line now,
8103 and save the element for the next line. */
8104 strcpy (menu + i, "...");
8105 break;
8106 }
8107 }
8108
8109 /* Move past this element. */
8110 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
8111 /* Handle reaching end of dense table. */
8112 idx = -1;
8113 if (idx >= 0)
8114 idx++;
8115 else
8116 rest = Fcdr_safe (rest);
8117 }
325309f5 8118 }
8150596a 8119
af2b7cc9 8120 /* Prompt with that and read response. */
c60ee5e7 8121 message2_nolog (menu, strlen (menu),
af2b7cc9 8122 ! NILP (current_buffer->enable_multibyte_characters));
284f4730 8123
af2b7cc9
KS
8124 /* Make believe its not a keyboard macro in case the help char
8125 is pressed. Help characters are not recorded because menu prompting
8126 is not used on replay.
8127 */
8128 orig_defn_macro = current_kboard->defining_kbd_macro;
8129 current_kboard->defining_kbd_macro = Qnil;
8130 do
8131 obj = read_char (commandflag, 0, 0, Qt, 0);
8132 while (BUFFERP (obj));
8133 current_kboard->defining_kbd_macro = orig_defn_macro;
284f4730 8134
af2b7cc9
KS
8135 if (!INTEGERP (obj))
8136 return obj;
8137 else
8138 ch = XINT (obj);
8139
8140 if (! EQ (obj, menu_prompt_more_char)
8141 && (!INTEGERP (menu_prompt_more_char)
8142 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
8143 {
8144 if (!NILP (current_kboard->defining_kbd_macro))
8145 store_kbd_macro_char (obj);
8146 return obj;
8147 }
8148 /* Help char - go round again */
8149 }
284f4730 8150}
284f4730
JB
8151\f
8152/* Reading key sequences. */
8153
8154/* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
8155 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
8156 keymap, or nil otherwise. Return the index of the first keymap in
8157 which KEY has any binding, or NMAPS if no map has a binding.
8158
8159 If KEY is a meta ASCII character, treat it like meta-prefix-char
8160 followed by the corresponding non-meta character. Keymaps in
8161 CURRENT with non-prefix bindings for meta-prefix-char become nil in
8162 NEXT.
8163
88cb0656
JB
8164 If KEY has no bindings in any of the CURRENT maps, NEXT is left
8165 unmodified.
8166
569871d2 8167 NEXT may be the same array as CURRENT. */
284f4730
JB
8168
8169static int
4e50f26a 8170follow_key (key, nmaps, current, defs, next)
284f4730
JB
8171 Lisp_Object key;
8172 Lisp_Object *current, *defs, *next;
8173 int nmaps;
8174{
8175 int i, first_binding;
8176
284f4730
JB
8177 first_binding = nmaps;
8178 for (i = nmaps - 1; i >= 0; i--)
8179 {
8180 if (! NILP (current[i]))
8181 {
fe5b94c5 8182 defs[i] = access_keymap (current[i], key, 1, 0, 1);
284f4730
JB
8183 if (! NILP (defs[i]))
8184 first_binding = i;
8185 }
8186 else
8187 defs[i] = Qnil;
8188 }
8189
284f4730 8190 /* Given the set of bindings we've found, produce the next set of maps. */
0a7f1fc0
JB
8191 if (first_binding < nmaps)
8192 for (i = 0; i < nmaps; i++)
02067692 8193 next[i] = NILP (defs[i]) ? Qnil : get_keymap (defs[i], 0, 1);
284f4730
JB
8194
8195 return first_binding;
8196}
8197
a7f26f28
SM
8198/* Structure used to keep track of partial application of key remapping
8199 such as Vfunction_key_map and Vkey_translation_map. */
8200typedef struct keyremap
8201{
24d80a06 8202 Lisp_Object map, parent;
a7f26f28
SM
8203 int start, end;
8204} keyremap;
8205
fe5b94c5
SM
8206/* Lookup KEY in MAP.
8207 MAP is a keymap mapping keys to key vectors or functions.
8208 If the mapping is a function and DO_FUNCTION is non-zero, then
8209 the function is called with PROMPT as parameter and its return
8210 value is used as the return value of this function (after checking
8211 that it is indeed a vector). */
8212
8213static Lisp_Object
8214access_keymap_keyremap (map, key, prompt, do_funcall)
8215 Lisp_Object map, key, prompt;
8216 int do_funcall;
8217{
8218 Lisp_Object next;
8219
8220 next = access_keymap (map, key, 1, 0, 1);
8221
8222 /* Handle symbol with autoload definition. */
8223 if (SYMBOLP (next) && !NILP (Ffboundp (next))
8224 && CONSP (XSYMBOL (next)->function)
8225 && EQ (XCAR (XSYMBOL (next)->function), Qautoload))
8226 do_autoload (XSYMBOL (next)->function, next);
8227
8228 /* Handle a symbol whose function definition is a keymap
8229 or an array. */
8230 if (SYMBOLP (next) && !NILP (Ffboundp (next))
8231 && (!NILP (Farrayp (XSYMBOL (next)->function))
8232 || KEYMAPP (XSYMBOL (next)->function)))
8233 next = XSYMBOL (next)->function;
8234
8235 /* If the keymap gives a function, not an
8236 array, then call the function with one arg and use
8237 its value instead. */
8238 if (SYMBOLP (next) && !NILP (Ffboundp (next)) && do_funcall)
8239 {
8240 Lisp_Object tem;
8241 tem = next;
8242
8243 next = call1 (next, prompt);
8244 /* If the function returned something invalid,
8245 barf--don't ignore it.
8246 (To ignore it safely, we would need to gcpro a bunch of
8247 other variables.) */
8248 if (! (VECTORP (next) || STRINGP (next)))
8249 error ("Function %s returns invalid key sequence", tem);
8250 }
8251 return next;
8252}
8253
8254/* Do one step of the key remapping used for function-key-map and
8255 key-translation-map:
8256 KEYBUF is the buffer holding the input events.
8257 BUFSIZE is its maximum size.
8258 FKEY is a pointer to the keyremap structure to use.
8259 INPUT is the index of the last element in KEYBUF.
8260 DOIT if non-zero says that the remapping can actually take place.
8261 DIFF is used to return the number of keys added/removed by the remapping.
8262 PARENT is the root of the keymap.
8263 PROMPT is the prompt to use if the remapping happens through a function.
8264 The return value is non-zero if the remapping actually took place. */
8265
8266static int
24d80a06
SM
8267keyremap_step (keybuf, bufsize, fkey, input, doit, diff, prompt)
8268 Lisp_Object *keybuf, prompt;
fe5b94c5
SM
8269 keyremap *fkey;
8270 int input, doit, *diff, bufsize;
8271{
8272 Lisp_Object next, key;
8273
8274 key = keybuf[fkey->end++];
8275 next = access_keymap_keyremap (fkey->map, key, prompt, doit);
8276
8277 /* If keybuf[fkey->start..fkey->end] is bound in the
8278 map and we're in a position to do the key remapping, replace it with
8279 the binding and restart with fkey->start at the end. */
8280 if ((VECTORP (next) || STRINGP (next)) && doit)
8281 {
8282 int len = XFASTINT (Flength (next));
8283 int i;
8284
8285 *diff = len - (fkey->end - fkey->start);
8286
8287 if (input + *diff >= bufsize)
8288 error ("Key sequence too long");
8289
8290 /* Shift the keys that follow fkey->end. */
8291 if (*diff < 0)
8292 for (i = fkey->end; i < input; i++)
8293 keybuf[i + *diff] = keybuf[i];
8294 else if (*diff > 0)
8295 for (i = input - 1; i >= fkey->end; i--)
8296 keybuf[i + *diff] = keybuf[i];
8297 /* Overwrite the old keys with the new ones. */
8298 for (i = 0; i < len; i++)
8299 keybuf[fkey->start + i]
8300 = Faref (next, make_number (i));
8301
8302 fkey->start = fkey->end += *diff;
24d80a06 8303 fkey->map = fkey->parent;
fe5b94c5
SM
8304
8305 return 1;
8306 }
8307
8308 fkey->map = get_keymap (next, 0, 1);
8309
8310 /* If we no longer have a bound suffix, try a new position for
8311 fkey->start. */
8312 if (!CONSP (fkey->map))
8313 {
8314 fkey->end = ++fkey->start;
24d80a06 8315 fkey->map = fkey->parent;
fe5b94c5
SM
8316 }
8317 return 0;
8318}
a7f26f28 8319
df0f2ba1 8320/* Read a sequence of keys that ends with a non prefix character,
f4255cd1
JB
8321 storing it in KEYBUF, a buffer of size BUFSIZE.
8322 Prompt with PROMPT.
284f4730 8323 Return the length of the key sequence stored.
dcc408a0 8324 Return -1 if the user rejected a command menu.
284f4730 8325
f4255cd1
JB
8326 Echo starting immediately unless `prompt' is 0.
8327
8328 Where a key sequence ends depends on the currently active keymaps.
8329 These include any minor mode keymaps active in the current buffer,
8330 the current buffer's local map, and the global map.
8331
8332 If a key sequence has no other bindings, we check Vfunction_key_map
8333 to see if some trailing subsequence might be the beginning of a
8334 function key's sequence. If so, we try to read the whole function
8335 key, and substitute its symbolic name into the key sequence.
8336
fbcd35bd
JB
8337 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
8338 `double-' events into similar click events, if that would make them
8339 bound. We try to turn `triple-' events first into `double-' events,
8340 then into clicks.
f4255cd1
JB
8341
8342 If we get a mouse click in a mode line, vertical divider, or other
8343 non-text area, we treat the click as if it were prefixed by the
8344 symbol denoting that area - `mode-line', `vertical-line', or
8345 whatever.
8346
8347 If the sequence starts with a mouse click, we read the key sequence
8348 with respect to the buffer clicked on, not the current buffer.
284f4730 8349
f4255cd1
JB
8350 If the user switches frames in the midst of a key sequence, we put
8351 off the switch-frame event until later; the next call to
f571ae0d
RS
8352 read_char will return it.
8353
8354 If FIX_CURRENT_BUFFER is nonzero, we restore current_buffer
8355 from the selected window's buffer. */
48e416d4 8356
284f4730 8357static int
ce98e608 8358read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
f571ae0d 8359 can_return_switch_frame, fix_current_buffer)
284f4730
JB
8360 Lisp_Object *keybuf;
8361 int bufsize;
84d91fda 8362 Lisp_Object prompt;
309b0fc8 8363 int dont_downcase_last;
ce98e608 8364 int can_return_switch_frame;
f571ae0d 8365 int fix_current_buffer;
284f4730 8366{
db14cfc5 8367 volatile Lisp_Object from_string;
aed13378 8368 volatile int count = SPECPDL_INDEX ();
f4255cd1 8369
284f4730 8370 /* How many keys there are in the current key sequence. */
8c907a56 8371 volatile int t;
284f4730 8372
284f4730
JB
8373 /* The length of the echo buffer when we started reading, and
8374 the length of this_command_keys when we started reading. */
8c907a56
GM
8375 volatile int echo_start;
8376 volatile int keys_start;
284f4730
JB
8377
8378 /* The number of keymaps we're scanning right now, and the number of
8379 keymaps we have allocated space for. */
8c907a56
GM
8380 volatile int nmaps;
8381 volatile int nmaps_allocated = 0;
284f4730 8382
284f4730
JB
8383 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
8384 the current keymaps. */
8c907a56 8385 Lisp_Object *volatile defs = NULL;
284f4730 8386
f4255cd1
JB
8387 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
8388 in the current keymaps, or nil where it is not a prefix. */
8c907a56 8389 Lisp_Object *volatile submaps = NULL;
f4255cd1 8390
e0dff5f6 8391 /* The local map to start out with at start of key sequence. */
8c907a56 8392 volatile Lisp_Object orig_local_map;
e0dff5f6 8393
30690496
DL
8394 /* The map from the `keymap' property to start out with at start of
8395 key sequence. */
8c907a56 8396 volatile Lisp_Object orig_keymap;
30690496 8397
e0dff5f6
RS
8398 /* 1 if we have already considered switching to the local-map property
8399 of the place where a mouse click occurred. */
8c907a56 8400 volatile int localized_local_map = 0;
e0dff5f6 8401
f4255cd1
JB
8402 /* The index in defs[] of the first keymap that has a binding for
8403 this key sequence. In other words, the lowest i such that
8404 defs[i] is non-nil. */
8c907a56 8405 volatile int first_binding;
7189cad8 8406 /* Index of the first key that has no binding.
a7f26f28 8407 It is useless to try fkey.start larger than that. */
7189cad8 8408 volatile int first_unbound;
284f4730 8409
f4255cd1 8410 /* If t < mock_input, then KEYBUF[t] should be read as the next
253598e4
JB
8411 input key.
8412
8413 We use this to recover after recognizing a function key. Once we
8414 realize that a suffix of the current key sequence is actually a
8415 function key's escape sequence, we replace the suffix with the
8416 function key's binding from Vfunction_key_map. Now keybuf
f4255cd1
JB
8417 contains a new and different key sequence, so the echo area,
8418 this_command_keys, and the submaps and defs arrays are wrong. In
8419 this situation, we set mock_input to t, set t to 0, and jump to
8420 restart_sequence; the loop will read keys from keybuf up until
8421 mock_input, thus rebuilding the state; and then it will resume
8422 reading characters from the keyboard. */
8c907a56 8423 volatile int mock_input = 0;
284f4730 8424
253598e4 8425 /* If the sequence is unbound in submaps[], then
a7f26f28
SM
8426 keybuf[fkey.start..fkey.end-1] is a prefix in Vfunction_key_map,
8427 and fkey.map is its binding.
253598e4 8428
f4255cd1
JB
8429 These might be > t, indicating that all function key scanning
8430 should hold off until t reaches them. We do this when we've just
8431 recognized a function key, to avoid searching for the function
8432 key's again in Vfunction_key_map. */
a7f26f28 8433 volatile keyremap fkey;
284f4730 8434
a612e298 8435 /* Likewise, for key_translation_map. */
a7f26f28 8436 volatile keyremap keytran;
a612e298 8437
fe5b94c5
SM
8438 /* If we receive a `switch-frame' or `select-window' event in the middle of
8439 a key sequence, we put it off for later.
8440 While we're reading, we keep the event here. */
8c907a56 8441 volatile Lisp_Object delayed_switch_frame;
cd21b839 8442
51763820
BF
8443 /* See the comment below... */
8444#if defined (GOBBLE_FIRST_EVENT)
4efda7dd 8445 Lisp_Object first_event;
51763820 8446#endif
4efda7dd 8447
8c907a56
GM
8448 volatile Lisp_Object original_uppercase;
8449 volatile int original_uppercase_position = -1;
309b0fc8 8450
bc536d84 8451 /* Gets around Microsoft compiler limitations. */
309b0fc8 8452 int dummyflag = 0;
bc536d84 8453
3b9189f8
RS
8454 struct buffer *starting_buffer;
8455
2dc00208
GM
8456 /* List of events for which a fake prefix key has been generated. */
8457 volatile Lisp_Object fake_prefixed_keys = Qnil;
8458
03cee6ae 8459#if defined (GOBBLE_FIRST_EVENT)
4efda7dd 8460 int junk;
03cee6ae 8461#endif
4efda7dd 8462
2dc00208
GM
8463 struct gcpro gcpro1;
8464
8465 GCPRO1 (fake_prefixed_keys);
7d18f9ae
RS
8466 raw_keybuf_count = 0;
8467
4efda7dd
RS
8468 last_nonmenu_event = Qnil;
8469
8470 delayed_switch_frame = Qnil;
24d80a06
SM
8471 fkey.map = fkey.parent = Vfunction_key_map;
8472 keytran.map = keytran.parent = Vkey_translation_map;
a7f26f28
SM
8473 /* If there is no translation-map, turn off scanning. */
8474 fkey.start = fkey.end = KEYMAPP (fkey.map) ? 0 : bufsize + 1;
8475 keytran.start = keytran.end = KEYMAPP (keytran.map) ? 0 : bufsize + 1;
a612e298 8476
284f4730
JB
8477 if (INTERACTIVE)
8478 {
84d91fda 8479 if (!NILP (prompt))
a4ef85ee 8480 echo_prompt (prompt);
f2647d04
DL
8481 else if (cursor_in_echo_area
8482 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8483 && NILP (Fzerop (Vecho_keystrokes)))
284f4730
JB
8484 /* This doesn't put in a dash if the echo buffer is empty, so
8485 you don't always see a dash hanging out in the minibuffer. */
8486 echo_dash ();
284f4730
JB
8487 }
8488
f4255cd1
JB
8489 /* Record the initial state of the echo area and this_command_keys;
8490 we will need to restore them if we replay a key sequence. */
0a7f1fc0 8491 if (INTERACTIVE)
df0f2ba1 8492 echo_start = echo_length ();
f4255cd1 8493 keys_start = this_command_key_count;
6321824f 8494 this_single_command_key_start = keys_start;
0a7f1fc0 8495
51763820
BF
8496#if defined (GOBBLE_FIRST_EVENT)
8497 /* This doesn't quite work, because some of the things that read_char
8498 does cannot safely be bypassed. It seems too risky to try to make
df0f2ba1 8499 this work right. */
51763820 8500
4efda7dd
RS
8501 /* Read the first char of the sequence specially, before setting
8502 up any keymaps, in case a filter runs and switches buffers on us. */
84d91fda 8503 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
4efda7dd 8504 &junk);
51763820 8505#endif /* GOBBLE_FIRST_EVENT */
4efda7dd 8506
24a40fbb
GM
8507 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8508 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
db14cfc5 8509 from_string = Qnil;
e0dff5f6 8510
7b4aedb9
JB
8511 /* We jump here when the key sequence has been thoroughly changed, and
8512 we need to rescan it starting from the beginning. When we jump here,
8513 keybuf[0..mock_input] holds the sequence we should reread. */
07d2b8de 8514 replay_sequence:
7b4aedb9 8515
3b9189f8 8516 starting_buffer = current_buffer;
7189cad8 8517 first_unbound = bufsize + 1;
3b9189f8 8518
f4255cd1 8519 /* Build our list of keymaps.
07d2b8de
JB
8520 If we recognize a function key and replace its escape sequence in
8521 keybuf with its symbol, or if the sequence starts with a mouse
8522 click and we need to switch buffers, we jump back here to rebuild
8523 the initial keymaps from the current buffer. */
4cbedc16 8524 nmaps = 0;
284f4730 8525
4cbedc16
RS
8526 if (!NILP (current_kboard->Voverriding_terminal_local_map)
8527 || !NILP (Voverriding_local_map))
8528 {
8529 if (3 > nmaps_allocated)
8530 {
8531 submaps = (Lisp_Object *) alloca (3 * sizeof (submaps[0]));
8532 defs = (Lisp_Object *) alloca (3 * sizeof (defs[0]));
8533 nmaps_allocated = 3;
8534 }
8535 if (!NILP (current_kboard->Voverriding_terminal_local_map))
8536 submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
8537 if (!NILP (Voverriding_local_map))
8538 submaps[nmaps++] = Voverriding_local_map;
8539 }
8540 else
8541 {
4cbedc16
RS
8542 int nminor;
8543 int total;
8544 Lisp_Object *maps;
8545
8546 nminor = current_minor_maps (0, &maps);
8547 total = nminor + (!NILP (orig_keymap) ? 3 : 2);
8548
8549 if (total > nmaps_allocated)
8550 {
8551 submaps = (Lisp_Object *) alloca (total * sizeof (submaps[0]));
8552 defs = (Lisp_Object *) alloca (total * sizeof (defs[0]));
8553 nmaps_allocated = total;
8554 }
8555
8556 if (!NILP (orig_keymap))
8557 submaps[nmaps++] = orig_keymap;
8558
7d1c4866 8559 bcopy (maps, (void *) (submaps + nmaps),
4cbedc16
RS
8560 nminor * sizeof (submaps[0]));
8561
8562 nmaps += nminor;
8563
8564 submaps[nmaps++] = orig_local_map;
8565 }
8566 submaps[nmaps++] = current_global_map;
284f4730
JB
8567
8568 /* Find an accurate initial value for first_binding. */
8569 for (first_binding = 0; first_binding < nmaps; first_binding++)
253598e4 8570 if (! NILP (submaps[first_binding]))
284f4730
JB
8571 break;
8572
3b9189f8 8573 /* Start from the beginning in keybuf. */
f4255cd1
JB
8574 t = 0;
8575
8576 /* These are no-ops the first time through, but if we restart, they
8577 revert the echo area and this_command_keys to their original state. */
8578 this_command_key_count = keys_start;
df0f2ba1 8579 if (INTERACTIVE && t < mock_input)
f4255cd1
JB
8580 echo_truncate (echo_start);
8581
cca310da
JB
8582 /* If the best binding for the current key sequence is a keymap, or
8583 we may be looking at a function key's escape sequence, keep on
8584 reading. */
a7f26f28
SM
8585 while (first_binding < nmaps
8586 /* Keep reading as long as there's a prefix binding. */
8587 ? !NILP (submaps[first_binding])
e9bf89a0
RS
8588 /* Don't return in the middle of a possible function key sequence,
8589 if the only bindings we found were via case conversion.
8590 Thus, if ESC O a has a function-key-map translation
8591 and ESC o has a binding, don't return after ESC O,
8592 so that we can translate ESC O plus the next character. */
a7f26f28 8593 : (fkey.start < t || keytran.start < t))
284f4730
JB
8594 {
8595 Lisp_Object key;
7d6de002 8596 int used_mouse_menu = 0;
284f4730 8597
7b4aedb9
JB
8598 /* Where the last real key started. If we need to throw away a
8599 key that has expanded into more than one element of keybuf
8600 (say, a mouse click on the mode line which is being treated
8601 as [mode-line (mouse-...)], then we backtrack to this point
8602 of keybuf. */
8c907a56 8603 volatile int last_real_key_start;
7b4aedb9 8604
0a7f1fc0
JB
8605 /* These variables are analogous to echo_start and keys_start;
8606 while those allow us to restart the entire key sequence,
8607 echo_local_start and keys_local_start allow us to throw away
8608 just one key. */
8c907a56 8609 volatile int echo_local_start, keys_local_start, local_first_binding;
f4255cd1 8610
fe5b94c5
SM
8611 eassert (fkey.end == t || (fkey.end > t && fkey.end <= mock_input));
8612 eassert (fkey.start <= fkey.end);
8613 eassert (keytran.start <= keytran.end);
2cf4b7b2 8614 /* key-translation-map is applied *after* function-key-map. */
a7f26f28 8615 eassert (keytran.end <= fkey.start);
7189cad8 8616
a7f26f28 8617 if (first_unbound < fkey.start && first_unbound < keytran.start)
7189cad8
SM
8618 { /* The prefix upto first_unbound has no binding and has
8619 no translation left to do either, so we know it's unbound.
8620 If we don't stop now, we risk staying here indefinitely
8621 (if the user keeps entering fkey or keytran prefixes
8622 like C-c ESC ESC ESC ESC ...) */
8623 int i;
8624 for (i = first_unbound + 1; i < t; i++)
8625 keybuf[i - first_unbound - 1] = keybuf[i];
8626 mock_input = t - first_unbound - 1;
a7f26f28 8627 fkey.end = fkey.start -= first_unbound + 1;
24d80a06 8628 fkey.map = fkey.parent;
a7f26f28 8629 keytran.end = keytran.start -= first_unbound + 1;
24d80a06 8630 keytran.map = keytran.parent;
7189cad8
SM
8631 goto replay_sequence;
8632 }
8633
284f4730 8634 if (t >= bufsize)
3fe8e9a2 8635 error ("Key sequence too long");
284f4730 8636
f4255cd1
JB
8637 if (INTERACTIVE)
8638 echo_local_start = echo_length ();
8639 keys_local_start = this_command_key_count;
8640 local_first_binding = first_binding;
df0f2ba1 8641
f4255cd1 8642 replay_key:
0a7f1fc0 8643 /* These are no-ops, unless we throw away a keystroke below and
f4255cd1
JB
8644 jumped back up to replay_key; in that case, these restore the
8645 variables to their original state, allowing us to replay the
0a7f1fc0 8646 loop. */
40932d1a 8647 if (INTERACTIVE && t < mock_input)
f4255cd1 8648 echo_truncate (echo_local_start);
0a7f1fc0
JB
8649 this_command_key_count = keys_local_start;
8650 first_binding = local_first_binding;
8651
7e85b935
RS
8652 /* By default, assume each event is "real". */
8653 last_real_key_start = t;
8654
f4255cd1 8655 /* Does mock_input indicate that we are re-reading a key sequence? */
284f4730
JB
8656 if (t < mock_input)
8657 {
8658 key = keybuf[t];
8659 add_command_key (key);
f2647d04
DL
8660 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8661 && NILP (Fzerop (Vecho_keystrokes)))
a98ea3f9 8662 echo_char (key);
284f4730 8663 }
253598e4
JB
8664
8665 /* If not, we should actually read a character. */
284f4730
JB
8666 else
8667 {
beecf6a1 8668 {
c5fdd383
KH
8669#ifdef MULTI_KBOARD
8670 KBOARD *interrupted_kboard = current_kboard;
788f89eb 8671 struct frame *interrupted_frame = SELECTED_FRAME ();
c5fdd383 8672 if (setjmp (wrong_kboard_jmpbuf))
beecf6a1 8673 {
5798cf15
KH
8674 if (!NILP (delayed_switch_frame))
8675 {
c5fdd383 8676 interrupted_kboard->kbd_queue
5798cf15 8677 = Fcons (delayed_switch_frame,
c5fdd383 8678 interrupted_kboard->kbd_queue);
5798cf15
KH
8679 delayed_switch_frame = Qnil;
8680 }
beecf6a1 8681 while (t > 0)
c5fdd383
KH
8682 interrupted_kboard->kbd_queue
8683 = Fcons (keybuf[--t], interrupted_kboard->kbd_queue);
5798cf15
KH
8684
8685 /* If the side queue is non-empty, ensure it begins with a
8686 switch-frame, so we'll replay it in the right context. */
c5fdd383 8687 if (CONSP (interrupted_kboard->kbd_queue)
7539e11f 8688 && (key = XCAR (interrupted_kboard->kbd_queue),
5798cf15
KH
8689 !(EVENT_HAS_PARAMETERS (key)
8690 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
8691 Qswitch_frame))))
df0f2ba1
KH
8692 {
8693 Lisp_Object frame;
8694 XSETFRAME (frame, interrupted_frame);
c5fdd383 8695 interrupted_kboard->kbd_queue
df0f2ba1 8696 = Fcons (make_lispy_switch_frame (frame),
c5fdd383 8697 interrupted_kboard->kbd_queue);
df0f2ba1 8698 }
beecf6a1 8699 mock_input = 0;
24a40fbb
GM
8700 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8701 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
beecf6a1
KH
8702 goto replay_sequence;
8703 }
bded54dd 8704#endif
8c907a56
GM
8705 key = read_char (NILP (prompt), nmaps,
8706 (Lisp_Object *) submaps, last_nonmenu_event,
beecf6a1
KH
8707 &used_mouse_menu);
8708 }
284f4730 8709
dcc408a0
RS
8710 /* read_char returns t when it shows a menu and the user rejects it.
8711 Just return -1. */
8712 if (EQ (key, Qt))
7d18f9ae
RS
8713 {
8714 unbind_to (count, Qnil);
2dc00208 8715 UNGCPRO;
7d18f9ae
RS
8716 return -1;
8717 }
dcc408a0 8718
f4255cd1 8719 /* read_char returns -1 at the end of a macro.
284f4730
JB
8720 Emacs 18 handles this by returning immediately with a
8721 zero, so that's what we'll do. */
8c18cbfb 8722 if (INTEGERP (key) && XINT (key) == -1)
cd21b839 8723 {
f4255cd1 8724 t = 0;
bc536d84
RS
8725 /* The Microsoft C compiler can't handle the goto that
8726 would go here. */
309b0fc8 8727 dummyflag = 1;
bc536d84 8728 break;
cd21b839 8729 }
df0f2ba1 8730
3cb81011
KH
8731 /* If the current buffer has been changed from under us, the
8732 keymap may have changed, so replay the sequence. */
8c18cbfb 8733 if (BUFFERP (key))
3cb81011 8734 {
e431fcda
DL
8735 EMACS_TIME initial_idleness_start_time;
8736 EMACS_SET_SECS_USECS (initial_idleness_start_time,
8737 EMACS_SECS (timer_last_idleness_start_time),
8738 EMACS_USECS (timer_last_idleness_start_time));
3021d3a9
RS
8739
8740 /* Resume idle state, using the same start-time as before. */
8741 timer_start_idle ();
8742 timer_idleness_start_time = initial_idleness_start_time;
8743
3cb81011 8744 mock_input = t;
f571ae0d
RS
8745 /* Reset the current buffer from the selected window
8746 in case something changed the former and not the latter.
8747 This is to be more consistent with the behavior
8748 of the command_loop_1. */
8749 if (fix_current_buffer)
a94a4335 8750 {
788f89eb 8751 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
a94a4335
KH
8752 Fkill_emacs (Qnil);
8753 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
8754 Fset_buffer (XWINDOW (selected_window)->buffer);
8755 }
f571ae0d 8756
24a40fbb
GM
8757 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8758 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
3cb81011
KH
8759 goto replay_sequence;
8760 }
8761
3b9189f8
RS
8762 /* If we have a quit that was typed in another frame, and
8763 quit_throw_to_read_char switched buffers,
8764 replay to get the right keymap. */
f4e05d97
GM
8765 if (INTEGERP (key)
8766 && XINT (key) == quit_char
8767 && current_buffer != starting_buffer)
3b9189f8 8768 {
7d18f9ae
RS
8769 GROW_RAW_KEYBUF;
8770 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
3b9189f8
RS
8771 keybuf[t++] = key;
8772 mock_input = t;
8773 Vquit_flag = Qnil;
24a40fbb
GM
8774 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8775 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
3b9189f8
RS
8776 goto replay_sequence;
8777 }
3cb81011 8778
284f4730 8779 Vquit_flag = Qnil;
7d18f9ae
RS
8780
8781 if (EVENT_HAS_PARAMETERS (key)
fe5b94c5 8782 /* Either a `switch-frame' or a `select-window' event. */
7d18f9ae
RS
8783 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
8784 {
8785 /* If we're at the beginning of a key sequence, and the caller
8786 says it's okay, go ahead and return this event. If we're
8787 in the midst of a key sequence, delay it until the end. */
8788 if (t > 0 || !can_return_switch_frame)
8789 {
8790 delayed_switch_frame = key;
8791 goto replay_key;
8792 }
8793 }
8794
8795 GROW_RAW_KEYBUF;
8796 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
7e85b935 8797 }
284f4730 8798
df0f2ba1 8799 /* Clicks in non-text areas get prefixed by the symbol
7e85b935
RS
8800 in their CHAR-ADDRESS field. For example, a click on
8801 the mode line is prefixed by the symbol `mode-line'.
8802
8803 Furthermore, key sequences beginning with mouse clicks
8804 are read using the keymaps of the buffer clicked on, not
8805 the current buffer. So we may have to switch the buffer
8806 here.
8807
8808 When we turn one event into two events, we must make sure
8809 that neither of the two looks like the original--so that,
8810 if we replay the events, they won't be expanded again.
8811 If not for this, such reexpansion could happen either here
8812 or when user programs play with this-command-keys. */
8813 if (EVENT_HAS_PARAMETERS (key))
8814 {
9b8eb840 8815 Lisp_Object kind;
cca310da 8816
9b8eb840 8817 kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
7e85b935 8818 if (EQ (kind, Qmouse_click))
0a7f1fc0 8819 {
9b8eb840 8820 Lisp_Object window, posn;
f4255cd1 8821
9b8eb840
KH
8822 window = POSN_WINDOW (EVENT_START (key));
8823 posn = POSN_BUFFER_POSN (EVENT_START (key));
7ee32cda 8824
2cf066c3
GM
8825 if (CONSP (posn)
8826 || (!NILP (fake_prefixed_keys)
8827 && !NILP (Fmemq (key, fake_prefixed_keys))))
0a7f1fc0 8828 {
2cf066c3
GM
8829 /* We're looking a second time at an event for which
8830 we generated a fake prefix key. Set
7e85b935
RS
8831 last_real_key_start appropriately. */
8832 if (t > 0)
8833 last_real_key_start = t - 1;
cd21b839 8834 }
7e85b935
RS
8835
8836 /* Key sequences beginning with mouse clicks are
8837 read using the keymaps in the buffer clicked on,
8838 not the current buffer. If we're at the
8839 beginning of a key sequence, switch buffers. */
8840 if (last_real_key_start == 0
8c18cbfb
KH
8841 && WINDOWP (window)
8842 && BUFFERP (XWINDOW (window)->buffer)
7e85b935 8843 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
cd21b839 8844 {
7d18f9ae 8845 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
7e85b935
RS
8846 keybuf[t] = key;
8847 mock_input = t + 1;
8848
8849 /* Arrange to go back to the original buffer once we're
8850 done reading the key sequence. Note that we can't
8851 use save_excursion_{save,restore} here, because they
8852 save point as well as the current buffer; we don't
8853 want to save point, because redisplay may change it,
8854 to accommodate a Fset_window_start or something. We
8855 don't want to do this at the top of the function,
8856 because we may get input from a subprocess which
8857 wants to change the selected window and stuff (say,
8858 emacsclient). */
8859 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
8860
788f89eb 8861 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
a94a4335 8862 Fkill_emacs (Qnil);
24a40fbb 8863 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
30690496 8864 orig_local_map = get_local_map (PT, current_buffer,
24a40fbb
GM
8865 Qlocal_map);
8866 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
7e85b935 8867 goto replay_sequence;
0a7f1fc0 8868 }
c60ee5e7 8869
e0dff5f6
RS
8870 /* For a mouse click, get the local text-property keymap
8871 of the place clicked on, rather than point. */
7ee32cda 8872 if (last_real_key_start == 0
7539e11f 8873 && CONSP (XCDR (key))
e0dff5f6 8874 && ! localized_local_map)
5ec75a55 8875 {
e0dff5f6
RS
8876 Lisp_Object map_here, start, pos;
8877
8878 localized_local_map = 1;
8879 start = EVENT_START (key);
c60ee5e7 8880
7539e11f 8881 if (CONSP (start) && CONSP (XCDR (start)))
e0dff5f6
RS
8882 {
8883 pos = POSN_BUFFER_POSN (start);
b78ce8fb
RS
8884 if (INTEGERP (pos)
8885 && XINT (pos) >= BEG && XINT (pos) <= Z)
e0dff5f6 8886 {
30690496 8887 map_here = get_local_map (XINT (pos),
24a40fbb 8888 current_buffer, Qlocal_map);
e0dff5f6
RS
8889 if (!EQ (map_here, orig_local_map))
8890 {
8891 orig_local_map = map_here;
8892 keybuf[t] = key;
8893 mock_input = t + 1;
5ec75a55 8894
30690496
DL
8895 goto replay_sequence;
8896 }
8897 map_here = get_local_map (XINT (pos),
24a40fbb 8898 current_buffer, Qkeymap);
30690496
DL
8899 if (!EQ (map_here, orig_keymap))
8900 {
8901 orig_keymap = map_here;
8902 keybuf[t] = key;
8903 mock_input = t + 1;
8904
e0dff5f6
RS
8905 goto replay_sequence;
8906 }
8907 }
8908 }
8909 }
8910
8911 /* Expand mode-line and scroll-bar events into two events:
8912 use posn as a fake prefix key. */
2dc00208
GM
8913 if (SYMBOLP (posn)
8914 && (NILP (fake_prefixed_keys)
8915 || NILP (Fmemq (key, fake_prefixed_keys))))
e0dff5f6 8916 {
7e85b935 8917 if (t + 1 >= bufsize)
3fe8e9a2 8918 error ("Key sequence too long");
c60ee5e7 8919
2dc00208
GM
8920 keybuf[t] = posn;
8921 keybuf[t + 1] = key;
8922 mock_input = t + 2;
8923
8924 /* Record that a fake prefix key has been generated
8925 for KEY. Don't modify the event; this would
8926 prevent proper action when the event is pushed
c7f4f573 8927 back into unread-command-events. */
2dc00208 8928 fake_prefixed_keys = Fcons (key, fake_prefixed_keys);
7ee32cda
GM
8929
8930 /* If on a mode line string with a local keymap,
8931 reconsider the key sequence with that keymap. */
8932 if (CONSP (POSN_STRING (EVENT_START (key))))
8933 {
30690496 8934 Lisp_Object string, pos, map, map2;
7ee32cda
GM
8935
8936 string = POSN_STRING (EVENT_START (key));
8937 pos = XCDR (string);
8938 string = XCAR (string);
52e386c2 8939 if (XINT (pos) >= 0
d5db4077 8940 && XINT (pos) < SCHARS (string))
30690496
DL
8941 {
8942 map = Fget_text_property (pos, Qlocal_map, string);
8943 if (!NILP (map))
8944 orig_local_map = map;
8945 map2 = Fget_text_property (pos, Qkeymap, string);
8946 if (!NILP (map2))
8947 orig_keymap = map2;
8948 if (!NILP (map) || !NILP (map2))
8949 goto replay_sequence;
8950 }
7ee32cda
GM
8951 }
8952
7e85b935 8953 goto replay_key;
5ec75a55 8954 }
db14cfc5
GM
8955 else if (CONSP (POSN_STRING (EVENT_START (key)))
8956 && NILP (from_string))
8957 {
8958 /* For a click on a string, i.e. overlay string or a
8959 string displayed via the `display' property,
8960 consider `local-map' and `keymap' properties of
8961 that string. */
8962 Lisp_Object string, pos, map, map2;
8963
8964 string = POSN_STRING (EVENT_START (key));
8965 pos = XCDR (string);
8966 string = XCAR (string);
8967 if (XINT (pos) >= 0
d5db4077 8968 && XINT (pos) < SCHARS (string))
db14cfc5
GM
8969 {
8970 map = Fget_text_property (pos, Qlocal_map, string);
8971 if (!NILP (map))
8972 orig_local_map = map;
8973 map2 = Fget_text_property (pos, Qkeymap, string);
8974 if (!NILP (map2))
8975 orig_keymap = map2;
8976
8977 if (!NILP (map) || !NILP (map2))
8978 {
8979 from_string = string;
8980 goto replay_sequence;
8981 }
8982 }
8983 }
0a7f1fc0 8984 }
7539e11f 8985 else if (CONSP (XCDR (key))
7a80a6f6 8986 && CONSP (EVENT_START (key))
7539e11f 8987 && CONSP (XCDR (EVENT_START (key))))
7e85b935 8988 {
9b8eb840 8989 Lisp_Object posn;
7e85b935 8990
9b8eb840 8991 posn = POSN_BUFFER_POSN (EVENT_START (key));
7e85b935
RS
8992 /* Handle menu-bar events:
8993 insert the dummy prefix event `menu-bar'. */
9ea173e8 8994 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
7e85b935
RS
8995 {
8996 if (t + 1 >= bufsize)
3fe8e9a2 8997 error ("Key sequence too long");
7e85b935
RS
8998 keybuf[t] = posn;
8999 keybuf[t+1] = key;
9000
9001 /* Zap the position in key, so we know that we've
9002 expanded it, and don't try to do so again. */
f3fbd155
KR
9003 POSN_BUFFER_SET_POSN (EVENT_START (key),
9004 Fcons (posn, Qnil));
7e85b935
RS
9005
9006 mock_input = t + 2;
9007 goto replay_sequence;
9008 }
8c18cbfb 9009 else if (CONSP (posn))
7e85b935
RS
9010 {
9011 /* We're looking at the second event of a
9012 sequence which we expanded before. Set
9013 last_real_key_start appropriately. */
9014 if (last_real_key_start == t && t > 0)
9015 last_real_key_start = t - 1;
9016 }
a6d53864 9017 }
284f4730 9018 }
f4255cd1
JB
9019
9020 /* We have finally decided that KEY is something we might want
9021 to look up. */
284f4730
JB
9022 first_binding = (follow_key (key,
9023 nmaps - first_binding,
253598e4 9024 submaps + first_binding,
284f4730 9025 defs + first_binding,
4e50f26a 9026 submaps + first_binding)
284f4730 9027 + first_binding);
0a7f1fc0 9028
f4255cd1 9029 /* If KEY wasn't bound, we'll try some fallbacks. */
65e0fbbf
SM
9030 if (first_binding < nmaps)
9031 /* This is needed for the following scenario:
9032 event 0: a down-event that gets dropped by calling replay_key.
9033 event 1: some normal prefix like C-h.
a7f26f28
SM
9034 After event 0, first_unbound is 0, after event 1 fkey.start
9035 and keytran.start are both 1, so when we see that C-h is bound,
65e0fbbf
SM
9036 we need to update first_unbound. */
9037 first_unbound = max (t + 1, first_unbound);
9038 else
0a7f1fc0 9039 {
9b8eb840 9040 Lisp_Object head;
c60ee5e7 9041
a7f26f28 9042 /* Remember the position to put an upper bound on fkey.start. */
7189cad8 9043 first_unbound = min (t, first_unbound);
0a7f1fc0 9044
9b8eb840 9045 head = EVENT_HEAD (key);
24736fbc 9046 if (help_char_p (head) && t > 0)
7e85b935
RS
9047 {
9048 read_key_sequence_cmd = Vprefix_help_command;
9049 keybuf[t++] = key;
9050 last_nonmenu_event = key;
bc536d84
RS
9051 /* The Microsoft C compiler can't handle the goto that
9052 would go here. */
309b0fc8 9053 dummyflag = 1;
0d882d52 9054 break;
7e85b935
RS
9055 }
9056
8c18cbfb 9057 if (SYMBOLP (head))
0a7f1fc0 9058 {
9b8eb840
KH
9059 Lisp_Object breakdown;
9060 int modifiers;
0a7f1fc0 9061
9b8eb840 9062 breakdown = parse_modifiers (head);
7539e11f 9063 modifiers = XINT (XCAR (XCDR (breakdown)));
559f9d04
RS
9064 /* Attempt to reduce an unbound mouse event to a simpler
9065 event that is bound:
9066 Drags reduce to clicks.
9067 Double-clicks reduce to clicks.
9068 Triple-clicks reduce to double-clicks, then to clicks.
9069 Down-clicks are eliminated.
9070 Double-downs reduce to downs, then are eliminated.
9071 Triple-downs reduce to double-downs, then to downs,
9072 then are eliminated. */
9073 if (modifiers & (down_modifier | drag_modifier
9074 | double_modifier | triple_modifier))
0a7f1fc0 9075 {
559f9d04
RS
9076 while (modifiers & (down_modifier | drag_modifier
9077 | double_modifier | triple_modifier))
fbcd35bd
JB
9078 {
9079 Lisp_Object new_head, new_click;
9080 if (modifiers & triple_modifier)
9081 modifiers ^= (double_modifier | triple_modifier);
bc536d84
RS
9082 else if (modifiers & double_modifier)
9083 modifiers &= ~double_modifier;
9084 else if (modifiers & drag_modifier)
9085 modifiers &= ~drag_modifier;
559f9d04
RS
9086 else
9087 {
9088 /* Dispose of this `down' event by simply jumping
9089 back to replay_key, to get another event.
9090
9091 Note that if this event came from mock input,
9092 then just jumping back to replay_key will just
9093 hand it to us again. So we have to wipe out any
9094 mock input.
9095
9096 We could delete keybuf[t] and shift everything
9097 after that to the left by one spot, but we'd also
9098 have to fix up any variable that points into
9099 keybuf, and shifting isn't really necessary
9100 anyway.
9101
9102 Adding prefixes for non-textual mouse clicks
9103 creates two characters of mock input, and both
9104 must be thrown away. If we're only looking at
9105 the prefix now, we can just jump back to
9106 replay_key. On the other hand, if we've already
9107 processed the prefix, and now the actual click
9108 itself is giving us trouble, then we've lost the
9109 state of the keymaps we want to backtrack to, and
9110 we need to replay the whole sequence to rebuild
9111 it.
9112
9113 Beyond that, only function key expansion could
9114 create more than two keys, but that should never
9115 generate mouse events, so it's okay to zero
9116 mock_input in that case too.
9117
65e0fbbf
SM
9118 FIXME: The above paragraph seems just plain
9119 wrong, if you consider things like
9120 xterm-mouse-mode. -stef
9121
559f9d04 9122 Isn't this just the most wonderful code ever? */
017be6c7
SM
9123
9124 /* If mock_input > t + 1, the above simplification
9125 will actually end up dropping keys on the floor.
9126 This is probably OK for now, but even
9127 if mock_input <= t + 1, we need to adjust fkey
9128 and keytran.
9129 Typical case [header-line down-mouse-N]:
9130 mock_input = 2, t = 1, fkey.end = 1,
9131 last_real_key_start = 0. */
9132 if (fkey.end > last_real_key_start)
9133 {
9134 fkey.end = fkey.start
9135 = min (last_real_key_start, fkey.start);
9136 fkey.map = fkey.parent;
9137 if (keytran.end > last_real_key_start)
9138 {
9139 keytran.end = keytran.start
9140 = min (last_real_key_start, keytran.start);
9141 keytran.map = keytran.parent;
9142 }
9143 }
559f9d04
RS
9144 if (t == last_real_key_start)
9145 {
9146 mock_input = 0;
9147 goto replay_key;
9148 }
9149 else
9150 {
9151 mock_input = last_real_key_start;
9152 goto replay_sequence;
9153 }
9154 }
9155
27203ead 9156 new_head
7539e11f 9157 = apply_modifiers (modifiers, XCAR (breakdown));
27203ead
RS
9158 new_click
9159 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
fbcd35bd
JB
9160
9161 /* Look for a binding for this new key. follow_key
9162 promises that it didn't munge submaps the
9163 last time we called it, since key was unbound. */
27203ead
RS
9164 first_binding
9165 = (follow_key (new_click,
9166 nmaps - local_first_binding,
9167 submaps + local_first_binding,
9168 defs + local_first_binding,
4e50f26a 9169 submaps + local_first_binding)
27203ead 9170 + local_first_binding);
fbcd35bd
JB
9171
9172 /* If that click is bound, go for it. */
9173 if (first_binding < nmaps)
9174 {
9175 key = new_click;
9176 break;
9177 }
9178 /* Otherwise, we'll leave key set to the drag event. */
9179 }
0a7f1fc0
JB
9180 }
9181 }
9182 }
9183
284f4730 9184 keybuf[t++] = key;
7d6de002
RS
9185 /* Normally, last_nonmenu_event gets the previous key we read.
9186 But when a mouse popup menu is being used,
9187 we don't update last_nonmenu_event; it continues to hold the mouse
9188 event that preceded the first level of menu. */
9189 if (!used_mouse_menu)
9190 last_nonmenu_event = key;
284f4730 9191
6321824f
RS
9192 /* Record what part of this_command_keys is the current key sequence. */
9193 this_single_command_key_start = this_command_key_count - t;
9194
65e0fbbf
SM
9195 if (first_binding < nmaps && NILP (submaps[first_binding]))
9196 /* There is a binding and it's not a prefix.
9197 There is thus no function-key in this sequence.
9198 Moving fkey.start is important in this case to allow keytran.start
9199 to go over the sequence before we return (since we keep the
9200 invariant that keytran.end <= fkey.start). */
9201 {
a7f26f28 9202 if (fkey.start < t)
24d80a06 9203 (fkey.start = fkey.end = t, fkey.map = fkey.parent);
65e0fbbf
SM
9204 }
9205 else
9206 /* If the sequence is unbound, see if we can hang a function key
9207 off the end of it. */
fe5b94c5
SM
9208 /* Continue scan from fkey.end until we find a bound suffix. */
9209 while (fkey.end < t)
a612e298 9210 {
fe5b94c5
SM
9211 struct gcpro gcpro1, gcpro2, gcpro3;
9212 int done, diff;
9213
9214 GCPRO3 (fkey.map, keytran.map, delayed_switch_frame);
9215 done = keyremap_step (keybuf, bufsize, &fkey,
9216 max (t, mock_input),
9217 /* If there's a binding (i.e.
9218 first_binding >= nmaps) we don't want
9219 to apply this function-key-mapping. */
9220 fkey.end + 1 == t && first_binding >= nmaps,
24d80a06 9221 &diff, prompt);
fe5b94c5
SM
9222 UNGCPRO;
9223 if (done)
a612e298 9224 {
fe5b94c5 9225 mock_input = diff + max (t, mock_input);
a612e298
RS
9226 goto replay_sequence;
9227 }
fe5b94c5 9228 }
a612e298 9229
fe5b94c5
SM
9230 /* Look for this sequence in key-translation-map.
9231 Scan from keytran.end until we find a bound suffix. */
9232 while (keytran.end < fkey.start)
9233 {
9234 struct gcpro gcpro1, gcpro2, gcpro3;
9235 int done, diff;
a612e298 9236
fe5b94c5
SM
9237 GCPRO3 (fkey.map, keytran.map, delayed_switch_frame);
9238 done = keyremap_step (keybuf, bufsize, &keytran, max (t, mock_input),
24d80a06 9239 1, &diff, prompt);
fe5b94c5
SM
9240 UNGCPRO;
9241 if (done)
9242 {
9243 mock_input = diff + max (t, mock_input);
9244 /* Adjust the function-key-map counters. */
9245 fkey.end += diff;
9246 fkey.start += diff;
9247
9248 goto replay_sequence;
9249 }
9250 }
4e50f26a
RS
9251
9252 /* If KEY is not defined in any of the keymaps,
9253 and cannot be part of a function key or translation,
9254 and is an upper case letter
9255 use the corresponding lower-case letter instead. */
65e0fbbf 9256 if (first_binding >= nmaps
a7f26f28 9257 && fkey.start >= t && keytran.start >= t
8c18cbfb 9258 && INTEGERP (key)
4e50f26a 9259 && ((((XINT (key) & 0x3ffff)
301738ed 9260 < XCHAR_TABLE (current_buffer->downcase_table)->size)
4e50f26a
RS
9261 && UPPERCASEP (XINT (key) & 0x3ffff))
9262 || (XINT (key) & shift_modifier)))
9263 {
569871d2 9264 Lisp_Object new_key;
569871d2 9265
309b0fc8
RS
9266 original_uppercase = key;
9267 original_uppercase_position = t - 1;
9268
831f35a2 9269 if (XINT (key) & shift_modifier)
569871d2 9270 XSETINT (new_key, XINT (key) & ~shift_modifier);
4e50f26a 9271 else
569871d2
RS
9272 XSETINT (new_key, (DOWNCASE (XINT (key) & 0x3ffff)
9273 | (XINT (key) & ~0x3ffff)));
9274
3fe8e9a2
RS
9275 /* We have to do this unconditionally, regardless of whether
9276 the lower-case char is defined in the keymaps, because they
9277 might get translated through function-key-map. */
9278 keybuf[t - 1] = new_key;
2cf4b7b2 9279 mock_input = max (t, mock_input);
3fe8e9a2
RS
9280
9281 goto replay_sequence;
4e50f26a 9282 }
ef8fd672
RS
9283 /* If KEY is not defined in any of the keymaps,
9284 and cannot be part of a function key or translation,
9285 and is a shifted function key,
9286 use the corresponding unshifted function key instead. */
65e0fbbf 9287 if (first_binding >= nmaps
a7f26f28 9288 && fkey.start >= t && keytran.start >= t
ef8fd672
RS
9289 && SYMBOLP (key))
9290 {
9291 Lisp_Object breakdown;
9292 int modifiers;
9293
9294 breakdown = parse_modifiers (key);
7539e11f 9295 modifiers = XINT (XCAR (XCDR (breakdown)));
ef8fd672
RS
9296 if (modifiers & shift_modifier)
9297 {
569871d2 9298 Lisp_Object new_key;
3fe8e9a2
RS
9299
9300 original_uppercase = key;
9301 original_uppercase_position = t - 1;
ef8fd672 9302
569871d2
RS
9303 modifiers &= ~shift_modifier;
9304 new_key = apply_modifiers (modifiers,
7539e11f 9305 XCAR (breakdown));
569871d2 9306
3fe8e9a2 9307 keybuf[t - 1] = new_key;
2cf4b7b2 9308 mock_input = max (t, mock_input);
f1871a7d
RS
9309 fkey.start = fkey.end = KEYMAPP (fkey.map) ? 0 : bufsize + 1;
9310 keytran.start = keytran.end = KEYMAPP (keytran.map) ? 0 : bufsize + 1;
3fe8e9a2
RS
9311
9312 goto replay_sequence;
ef8fd672
RS
9313 }
9314 }
284f4730
JB
9315 }
9316
309b0fc8 9317 if (!dummyflag)
bc536d84
RS
9318 read_key_sequence_cmd = (first_binding < nmaps
9319 ? defs[first_binding]
9320 : Qnil);
284f4730 9321
cd21b839 9322 unread_switch_frame = delayed_switch_frame;
f4255cd1 9323 unbind_to (count, Qnil);
07f76a14 9324
3fe8e9a2
RS
9325 /* Don't downcase the last character if the caller says don't.
9326 Don't downcase it if the result is undefined, either. */
9327 if ((dont_downcase_last || first_binding >= nmaps)
9328 && t - 1 == original_uppercase_position)
309b0fc8
RS
9329 keybuf[t - 1] = original_uppercase;
9330
07f76a14
JB
9331 /* Occasionally we fabricate events, perhaps by expanding something
9332 according to function-key-map, or by adding a prefix symbol to a
9333 mouse click in the scroll bar or modeline. In this cases, return
9334 the entire generated key sequence, even if we hit an unbound
9335 prefix or a definition before the end. This means that you will
9336 be able to push back the event properly, and also means that
9337 read-key-sequence will always return a logical unit.
9338
9339 Better ideas? */
cca310da
JB
9340 for (; t < mock_input; t++)
9341 {
f2647d04
DL
9342 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
9343 && NILP (Fzerop (Vecho_keystrokes)))
a98ea3f9 9344 echo_char (keybuf[t]);
cca310da
JB
9345 add_command_key (keybuf[t]);
9346 }
07f76a14 9347
c60ee5e7 9348
7d18f9ae 9349
2dc00208 9350 UNGCPRO;
284f4730
JB
9351 return t;
9352}
9353
d5eecefb 9354DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
4707d2d0
PJ
9355 doc: /* Read a sequence of keystrokes and return as a string or vector.
9356The sequence is sufficient to specify a non-prefix command in the
9357current local and global maps.
9358
9359First arg PROMPT is a prompt string. If nil, do not prompt specially.
9360Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos
9361as a continuation of the previous key.
9362
9363The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
9364convert the last event to lower case. (Normally any upper case event
9365is converted to lower case if the original event is undefined and the lower
9366case equivalent is defined.) A non-nil value is appropriate for reading
9367a key sequence to be defined.
9368
9369A C-g typed while in this function is treated like any other character,
9370and `quit-flag' is not set.
9371
9372If the key sequence starts with a mouse click, then the sequence is read
9373using the keymaps of the buffer of the window clicked in, not the buffer
9374of the selected window as normal.
9375
9376`read-key-sequence' drops unbound button-down events, since you normally
9377only care about the click or drag events which follow them. If a drag
9378or multi-click event is unbound, but the corresponding click event would
9379be bound, `read-key-sequence' turns the event into a click event at the
9380drag's starting position. This means that you don't have to distinguish
9381between click and drag, double, or triple events unless you want to.
9382
9383`read-key-sequence' prefixes mouse events on mode lines, the vertical
9384lines separating windows, and scroll bars with imaginary keys
9385`mode-line', `vertical-line', and `vertical-scroll-bar'.
9386
9387Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this
9388function will process a switch-frame event if the user switches frames
9389before typing anything. If the user switches frames in the middle of a
9390key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME
9391is nil, then the event will be put off until after the current key sequence.
9392
9393`read-key-sequence' checks `function-key-map' for function key
9394sequences, where they wouldn't conflict with ordinary bindings. See
9395`function-key-map' for more details.
9396
9397The optional fifth argument COMMAND-LOOP, if non-nil, means
9398that this key sequence is being read by something that will
9399read commands one after another. It should be nil if the caller
9400will read just one key sequence. */)
d5eecefb
RS
9401 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
9402 command_loop)
309b0fc8 9403 Lisp_Object prompt, continue_echo, dont_downcase_last;
d5eecefb 9404 Lisp_Object can_return_switch_frame, command_loop;
284f4730
JB
9405{
9406 Lisp_Object keybuf[30];
9407 register int i;
03cee6ae 9408 struct gcpro gcpro1;
aed13378 9409 int count = SPECPDL_INDEX ();
284f4730
JB
9410
9411 if (!NILP (prompt))
b7826503 9412 CHECK_STRING (prompt);
284f4730
JB
9413 QUIT;
9414
d5eecefb
RS
9415 specbind (Qinput_method_exit_on_first_char,
9416 (NILP (command_loop) ? Qt : Qnil));
9417 specbind (Qinput_method_use_echo_area,
9418 (NILP (command_loop) ? Qt : Qnil));
9419
284f4730
JB
9420 bzero (keybuf, sizeof keybuf);
9421 GCPRO1 (keybuf[0]);
9422 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
9423
daa37602 9424 if (NILP (continue_echo))
6321824f
RS
9425 {
9426 this_command_key_count = 0;
63020c46 9427 this_command_key_count_reset = 0;
6321824f
RS
9428 this_single_command_key_start = 0;
9429 }
c0a58692 9430
d0c48478 9431#ifdef HAVE_X_WINDOWS
526a058f
GM
9432 if (display_hourglass_p)
9433 cancel_hourglass ();
d0c48478
GM
9434#endif
9435
309b0fc8 9436 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
ce98e608 9437 prompt, ! NILP (dont_downcase_last),
f571ae0d 9438 ! NILP (can_return_switch_frame), 0);
284f4730 9439
ae18aa3b 9440#if 0 /* The following is fine for code reading a key sequence and
f95c4fe5 9441 then proceeding with a lenghty computation, but it's not good
ae18aa3b 9442 for code reading keys in a loop, like an input method. */
d0c48478 9443#ifdef HAVE_X_WINDOWS
526a058f
GM
9444 if (display_hourglass_p)
9445 start_hourglass ();
ae18aa3b 9446#endif
d0c48478
GM
9447#endif
9448
dcc408a0
RS
9449 if (i == -1)
9450 {
9451 Vquit_flag = Qt;
9452 QUIT;
9453 }
284f4730 9454 UNGCPRO;
d5eecefb 9455 return unbind_to (count, make_event_array (i, keybuf));
284f4730 9456}
e39da3d7
RS
9457
9458DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
d5eecefb 9459 Sread_key_sequence_vector, 1, 5, 0,
4707d2d0
PJ
9460 doc: /* Like `read-key-sequence' but always return a vector. */)
9461 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
9462 command_loop)
e39da3d7 9463 Lisp_Object prompt, continue_echo, dont_downcase_last;
d5eecefb 9464 Lisp_Object can_return_switch_frame, command_loop;
e39da3d7
RS
9465{
9466 Lisp_Object keybuf[30];
9467 register int i;
03cee6ae 9468 struct gcpro gcpro1;
aed13378 9469 int count = SPECPDL_INDEX ();
e39da3d7
RS
9470
9471 if (!NILP (prompt))
b7826503 9472 CHECK_STRING (prompt);
e39da3d7
RS
9473 QUIT;
9474
d5eecefb
RS
9475 specbind (Qinput_method_exit_on_first_char,
9476 (NILP (command_loop) ? Qt : Qnil));
9477 specbind (Qinput_method_use_echo_area,
9478 (NILP (command_loop) ? Qt : Qnil));
9479
e39da3d7
RS
9480 bzero (keybuf, sizeof keybuf);
9481 GCPRO1 (keybuf[0]);
9482 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
9483
9484 if (NILP (continue_echo))
9485 {
9486 this_command_key_count = 0;
63020c46 9487 this_command_key_count_reset = 0;
e39da3d7
RS
9488 this_single_command_key_start = 0;
9489 }
9490
d0c48478 9491#ifdef HAVE_X_WINDOWS
526a058f
GM
9492 if (display_hourglass_p)
9493 cancel_hourglass ();
d0c48478
GM
9494#endif
9495
e39da3d7
RS
9496 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
9497 prompt, ! NILP (dont_downcase_last),
9498 ! NILP (can_return_switch_frame), 0);
9499
d0c48478 9500#ifdef HAVE_X_WINDOWS
526a058f
GM
9501 if (display_hourglass_p)
9502 start_hourglass ();
d0c48478
GM
9503#endif
9504
e39da3d7
RS
9505 if (i == -1)
9506 {
9507 Vquit_flag = Qt;
9508 QUIT;
9509 }
9510 UNGCPRO;
d5eecefb 9511 return unbind_to (count, Fvector (i, keybuf));
e39da3d7 9512}
284f4730 9513\f
158f7532 9514DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0,
4707d2d0
PJ
9515 doc: /* Execute CMD as an editor command.
9516CMD must be a symbol that satisfies the `commandp' predicate.
9517Optional second arg RECORD-FLAG non-nil
9518means unconditionally put this command in `command-history'.
9519Otherwise, that is done only if an arg is read using the minibuffer.
9520The argument KEYS specifies the value to use instead of (this-command-keys)
9521when reading the arguments; if it is nil, (this-command-keys) is used.
9522The argument SPECIAL, if non-nil, means that this command is executing
9523a special event, so ignore the prefix argument and don't clear it. */)
158f7532
RS
9524 (cmd, record_flag, keys, special)
9525 Lisp_Object cmd, record_flag, keys, special;
284f4730
JB
9526{
9527 register Lisp_Object final;
9528 register Lisp_Object tem;
9529 Lisp_Object prefixarg;
9530 struct backtrace backtrace;
9531 extern int debug_on_next_call;
9532
284f4730
JB
9533 debug_on_next_call = 0;
9534
158f7532
RS
9535 if (NILP (special))
9536 {
9537 prefixarg = current_kboard->Vprefix_arg;
9538 Vcurrent_prefix_arg = prefixarg;
9539 current_kboard->Vprefix_arg = Qnil;
9540 }
9541 else
9542 prefixarg = Qnil;
9543
8c18cbfb 9544 if (SYMBOLP (cmd))
284f4730
JB
9545 {
9546 tem = Fget (cmd, Qdisabled);
88ce066e 9547 if (!NILP (tem) && !NILP (Vrun_hooks))
b78ce8fb
RS
9548 {
9549 tem = Fsymbol_value (Qdisabled_command_hook);
9550 if (!NILP (tem))
9551 return call1 (Vrun_hooks, Qdisabled_command_hook);
9552 }
284f4730
JB
9553 }
9554
01e26217 9555 while (1)
284f4730 9556 {
ffd56f97 9557 final = Findirect_function (cmd);
284f4730
JB
9558
9559 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
b516a185
RS
9560 {
9561 struct gcpro gcpro1, gcpro2;
9562
9563 GCPRO2 (cmd, prefixarg);
9564 do_autoload (final, cmd);
9565 UNGCPRO;
9566 }
284f4730
JB
9567 else
9568 break;
9569 }
9570
8c18cbfb 9571 if (STRINGP (final) || VECTORP (final))
284f4730
JB
9572 {
9573 /* If requested, place the macro in the command history. For
9574 other sorts of commands, call-interactively takes care of
9575 this. */
e57d8fd8 9576 if (!NILP (record_flag))
f4385381
RS
9577 {
9578 Vcommand_history
9579 = Fcons (Fcons (Qexecute_kbd_macro,
9580 Fcons (final, Fcons (prefixarg, Qnil))),
9581 Vcommand_history);
9582
9583 /* Don't keep command history around forever. */
9584 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
9585 {
9586 tem = Fnthcdr (Vhistory_length, Vcommand_history);
9587 if (CONSP (tem))
f3fbd155 9588 XSETCDR (tem, Qnil);
f4385381
RS
9589 }
9590 }
284f4730 9591
caa06051 9592 return Fexecute_kbd_macro (final, prefixarg, Qnil);
284f4730 9593 }
f4385381 9594
8c18cbfb 9595 if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
284f4730
JB
9596 {
9597 backtrace.next = backtrace_list;
9598 backtrace_list = &backtrace;
9599 backtrace.function = &Qcall_interactively;
9600 backtrace.args = &cmd;
9601 backtrace.nargs = 1;
9602 backtrace.evalargs = 0;
9603
e57d8fd8 9604 tem = Fcall_interactively (cmd, record_flag, keys);
284f4730
JB
9605
9606 backtrace_list = backtrace.next;
9607 return tem;
9608 }
9609 return Qnil;
9610}
c970a760
GM
9611
9612
284f4730 9613\f
284f4730 9614DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
4707d2d0
PJ
9615 1, 1, "P",
9616 doc: /* Read function name, then read its arguments and call it. */)
9617 (prefixarg)
284f4730
JB
9618 Lisp_Object prefixarg;
9619{
9620 Lisp_Object function;
9621 char buf[40];
2e1a49ad
SM
9622 int saved_last_point_position;
9623 Lisp_Object saved_keys, saved_last_point_position_buffer;
5434fce6 9624 Lisp_Object bindings, value;
2e1a49ad 9625 struct gcpro gcpro1, gcpro2, gcpro3;
284f4730 9626
b0f2a7bf
KH
9627 saved_keys = Fvector (this_command_key_count,
9628 XVECTOR (this_command_keys)->contents);
2e1a49ad
SM
9629 saved_last_point_position_buffer = last_point_position_buffer;
9630 saved_last_point_position = last_point_position;
284f4730 9631 buf[0] = 0;
2e1a49ad 9632 GCPRO3 (saved_keys, prefixarg, saved_last_point_position_buffer);
284f4730
JB
9633
9634 if (EQ (prefixarg, Qminus))
9635 strcpy (buf, "- ");
7539e11f 9636 else if (CONSP (prefixarg) && XINT (XCAR (prefixarg)) == 4)
284f4730 9637 strcpy (buf, "C-u ");
7539e11f 9638 else if (CONSP (prefixarg) && INTEGERP (XCAR (prefixarg)))
5d5b907f
RS
9639 {
9640 if (sizeof (int) == sizeof (EMACS_INT))
7539e11f 9641 sprintf (buf, "%d ", XINT (XCAR (prefixarg)));
5d5b907f 9642 else if (sizeof (long) == sizeof (EMACS_INT))
7539e11f 9643 sprintf (buf, "%ld ", (long) XINT (XCAR (prefixarg)));
5d5b907f
RS
9644 else
9645 abort ();
9646 }
8c18cbfb 9647 else if (INTEGERP (prefixarg))
5d5b907f
RS
9648 {
9649 if (sizeof (int) == sizeof (EMACS_INT))
9650 sprintf (buf, "%d ", XINT (prefixarg));
9651 else if (sizeof (long) == sizeof (EMACS_INT))
03cee6ae 9652 sprintf (buf, "%ld ", (long) XINT (prefixarg));
5d5b907f
RS
9653 else
9654 abort ();
9655 }
284f4730
JB
9656
9657 /* This isn't strictly correct if execute-extended-command
9658 is bound to anything else. Perhaps it should use
9659 this_command_keys? */
9660 strcat (buf, "M-x ");
9661
9662 /* Prompt with buf, and then read a string, completing from and
9663 restricting to the set of all defined commands. Don't provide
51763820 9664 any initial input. Save the command read on the extended-command
03b4122a 9665 history list. */
284f4730
JB
9666 function = Fcompleting_read (build_string (buf),
9667 Vobarray, Qcommandp,
4328577a
KH
9668 Qt, Qnil, Qextended_command_history, Qnil,
9669 Qnil);
284f4730 9670
d5db4077 9671 if (STRINGP (function) && SCHARS (function) == 0)
1f5b1641
RS
9672 error ("No command name given");
9673
1113d9db
JB
9674 /* Set this_command_keys to the concatenation of saved_keys and
9675 function, followed by a RET. */
284f4730 9676 {
b0f2a7bf 9677 Lisp_Object *keys;
284f4730 9678 int i;
284f4730 9679
1113d9db 9680 this_command_key_count = 0;
63020c46 9681 this_command_key_count_reset = 0;
6321824f 9682 this_single_command_key_start = 0;
1113d9db 9683
b0f2a7bf
KH
9684 keys = XVECTOR (saved_keys)->contents;
9685 for (i = 0; i < XVECTOR (saved_keys)->size; i++)
9686 add_command_key (keys[i]);
1113d9db 9687
1b049b51 9688 for (i = 0; i < SCHARS (function); i++)
301738ed 9689 add_command_key (Faref (function, make_number (i)));
1113d9db 9690
301738ed 9691 add_command_key (make_number ('\015'));
284f4730
JB
9692 }
9693
2e1a49ad
SM
9694 last_point_position = saved_last_point_position;
9695 last_point_position_buffer = saved_last_point_position_buffer;
9696
284f4730
JB
9697 UNGCPRO;
9698
0a7f1fc0 9699 function = Fintern (function, Qnil);
d8bcf58e 9700 current_kboard->Vprefix_arg = prefixarg;
d5eecefb
RS
9701 Vthis_command = function;
9702 real_this_command = function;
284f4730 9703
6526ab49
RS
9704 /* If enabled, show which key runs this command. */
9705 if (!NILP (Vsuggest_key_bindings)
71012575 9706 && NILP (Vexecuting_macro)
6526ab49 9707 && SYMBOLP (function))
5434fce6 9708 bindings = Fwhere_is_internal (function, Voverriding_local_map,
8b9940e6 9709 Qt, Qnil, Qnil);
5434fce6
RS
9710 else
9711 bindings = Qnil;
6526ab49 9712
5434fce6
RS
9713 value = Qnil;
9714 GCPRO2 (bindings, value);
9715 value = Fcommand_execute (function, Qt, Qnil, Qnil);
6526ab49 9716
5434fce6 9717 /* If the command has a key binding, print it now. */
3ababa60 9718 if (!NILP (bindings)
ee112567
KH
9719 && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
9720 Qmouse_movement)))
5434fce6
RS
9721 {
9722 /* But first wait, and skip the message if there is input. */
426939cc 9723 int delay_time;
985f9f66 9724 if (!NILP (echo_area_buffer[0]))
426939cc
RS
9725 /* This command displayed something in the echo area;
9726 so wait a few seconds, then display our suggestion message. */
9727 delay_time = (NUMBERP (Vsuggest_key_bindings)
9728 ? XINT (Vsuggest_key_bindings) : 2);
9729 else
9730 /* This command left the echo area empty,
9731 so display our message immediately. */
9732 delay_time = 0;
9733
9734 if (!NILP (Fsit_for (make_number (delay_time), Qnil, Qnil))
303b5b3f 9735 && ! CONSP (Vunread_command_events))
6526ab49 9736 {
5434fce6
RS
9737 Lisp_Object binding;
9738 char *newmessage;
985f9f66 9739 int message_p = push_message ();
331379bf 9740 int count = SPECPDL_INDEX ();
5434fce6 9741
65efd7da 9742 record_unwind_protect (pop_message_unwind, Qnil);
5434fce6
RS
9743 binding = Fkey_description (bindings);
9744
9745 newmessage
d5db4077
KR
9746 = (char *) alloca (SCHARS (SYMBOL_NAME (function))
9747 + SBYTES (binding)
5434fce6 9748 + 100);
3ababa60 9749 sprintf (newmessage, "You can run the command `%s' with %s",
d5db4077
KR
9750 SDATA (SYMBOL_NAME (function)),
9751 SDATA (binding));
301738ed
RS
9752 message2_nolog (newmessage,
9753 strlen (newmessage),
9754 STRING_MULTIBYTE (binding));
5434fce6
RS
9755 if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings)
9756 ? Vsuggest_key_bindings : make_number (2)),
985f9f66
GM
9757 Qnil, Qnil))
9758 && message_p)
9759 restore_message ();
9760
c970a760 9761 unbind_to (count, Qnil);
6526ab49
RS
9762 }
9763 }
9764
5434fce6 9765 RETURN_UNGCPRO (value);
284f4730 9766}
6526ab49 9767
284f4730 9768\f
d9d4c147 9769/* Return nonzero if input events are pending. */
284f4730 9770
dfcf069d 9771int
284f4730
JB
9772detect_input_pending ()
9773{
9774 if (!input_pending)
d9d4c147
KH
9775 get_input_pending (&input_pending, 0);
9776
9777 return input_pending;
9778}
9779
b1878f45 9780/* Return nonzero if input events are pending, and run any pending timers. */
d9d4c147 9781
dfcf069d 9782int
87dd9b9b
RS
9783detect_input_pending_run_timers (do_display)
9784 int do_display;
d9d4c147 9785{
87dd9b9b
RS
9786 int old_timers_run = timers_run;
9787
d9d4c147
KH
9788 if (!input_pending)
9789 get_input_pending (&input_pending, 1);
284f4730 9790
87dd9b9b 9791 if (old_timers_run != timers_run && do_display)
7ee32cda 9792 {
3007ebfb 9793 redisplay_preserve_echo_area (8);
7ee32cda
GM
9794 /* The following fixes a bug when using lazy-lock with
9795 lazy-lock-defer-on-the-fly set to t, i.e. when fontifying
9796 from an idle timer function. The symptom of the bug is that
9797 the cursor sometimes doesn't become visible until the next X
9798 event is processed. --gerd. */
9799 if (rif)
9800 rif->flush_display (NULL);
9801 }
87dd9b9b 9802
284f4730
JB
9803 return input_pending;
9804}
9805
ffd56f97
JB
9806/* This is called in some cases before a possible quit.
9807 It cases the next call to detect_input_pending to recompute input_pending.
9808 So calling this function unnecessarily can't do any harm. */
07a59269
KH
9809
9810void
ffd56f97
JB
9811clear_input_pending ()
9812{
9813 input_pending = 0;
9814}
9815
b1878f45
RS
9816/* Return nonzero if there are pending requeued events.
9817 This isn't used yet. The hope is to make wait_reading_process_input
27fd22dc 9818 call it, and return if it runs Lisp code that unreads something.
b1878f45
RS
9819 The problem is, kbd_buffer_get_event needs to be fixed to know what
9820 to do in that case. It isn't trivial. */
9821
dfcf069d 9822int
b1878f45
RS
9823requeued_events_pending_p ()
9824{
9825 return (!NILP (Vunread_command_events) || unread_command_char != -1);
9826}
9827
9828
284f4730 9829DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
a064684d
RS
9830 doc: /* Return t if command input is currently available with no wait.
9831Actually, the value is nil only if we can be sure that no input is available;
9832if there is a doubt, the value is t. */)
4707d2d0 9833 ()
284f4730 9834{
24597608 9835 if (!NILP (Vunread_command_events) || unread_command_char != -1)
284f4730
JB
9836 return (Qt);
9837
20057d52 9838 get_filtered_input_pending (&input_pending, 1, 1);
d9d4c147 9839 return input_pending > 0 ? Qt : Qnil;
284f4730
JB
9840}
9841
9842DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
4707d2d0
PJ
9843 doc: /* Return vector of last 100 events, not counting those from keyboard macros. */)
9844 ()
284f4730 9845{
5160df46 9846 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
284f4730
JB
9847 Lisp_Object val;
9848
9849 if (total_keys < NUM_RECENT_KEYS)
5160df46 9850 return Fvector (total_keys, keys);
284f4730
JB
9851 else
9852 {
5160df46
JB
9853 val = Fvector (NUM_RECENT_KEYS, keys);
9854 bcopy (keys + recent_keys_index,
284f4730
JB
9855 XVECTOR (val)->contents,
9856 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
5160df46 9857 bcopy (keys,
284f4730
JB
9858 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
9859 recent_keys_index * sizeof (Lisp_Object));
9860 return val;
9861 }
9862}
9863
9864DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
4707d2d0 9865 doc: /* Return the key sequence that invoked this command.
92501652 9866However, if the command has called `read-key-sequence', it returns
4052e7bb 9867the last key sequence that has been read.
4707d2d0
PJ
9868The value is a string or a vector. */)
9869 ()
284f4730 9870{
86e5706b
RS
9871 return make_event_array (this_command_key_count,
9872 XVECTOR (this_command_keys)->contents);
284f4730
JB
9873}
9874
e39da3d7 9875DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
92501652
RS
9876 doc: /* Return the key sequence that invoked this command, as a vector.
9877However, if the command has called `read-key-sequence', it returns
4052e7bb 9878the last key sequence that has been read. */)
4707d2d0 9879 ()
e39da3d7
RS
9880{
9881 return Fvector (this_command_key_count,
9882 XVECTOR (this_command_keys)->contents);
9883}
9884
6321824f
RS
9885DEFUN ("this-single-command-keys", Fthis_single_command_keys,
9886 Sthis_single_command_keys, 0, 0, 0,
4707d2d0 9887 doc: /* Return the key sequence that invoked this command.
92501652
RS
9888More generally, it returns the last key sequence read, either by
9889the command loop or by `read-key-sequence'.
4707d2d0
PJ
9890Unlike `this-command-keys', this function's value
9891does not include prefix arguments.
9892The value is always a vector. */)
9893 ()
6321824f 9894{
e39da3d7
RS
9895 return Fvector (this_command_key_count
9896 - this_single_command_key_start,
9897 (XVECTOR (this_command_keys)->contents
9898 + this_single_command_key_start));
6321824f
RS
9899}
9900
7d18f9ae
RS
9901DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
9902 Sthis_single_command_raw_keys, 0, 0, 0,
4707d2d0 9903 doc: /* Return the raw events that were read for this command.
92501652
RS
9904More generally, it returns the last key sequence read, either by
9905the command loop or by `read-key-sequence'.
4707d2d0
PJ
9906Unlike `this-single-command-keys', this function's value
9907shows the events before all translations (except for input methods).
9908The value is always a vector. */)
9909 ()
7d18f9ae
RS
9910{
9911 return Fvector (raw_keybuf_count,
9912 (XVECTOR (raw_keybuf)->contents));
9913}
9914
71918b75 9915DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
4707d2d0 9916 Sreset_this_command_lengths, 0, 0, 0,
63020c46
RS
9917 doc: /* Make the unread events replace the last command and echo.
9918Used in `universal-argument-other-key'.
4707d2d0
PJ
9919
9920`universal-argument-other-key' rereads the event just typed.
9921It then gets translated through `function-key-map'.
63020c46
RS
9922The translated event has to replace the real events,
9923both in the value of (this-command-keys) and in echoing.
9924To achieve this, `universal-argument-other-key' calls
9925`reset-this-command-lengths', which discards the record of reading
9926these events the first time. */)
4707d2d0 9927 ()
71918b75 9928{
22b94eeb
RS
9929 this_command_key_count = before_command_key_count;
9930 if (this_command_key_count < this_single_command_key_start)
9931 this_single_command_key_start = this_command_key_count;
63020c46 9932
22b94eeb
RS
9933 echo_truncate (before_command_echo_length);
9934
63020c46
RS
9935 /* Cause whatever we put into unread-command-events
9936 to echo as if it were being freshly read from the keyboard. */
9937 this_command_key_count_reset = 1;
9938
6e5742a0 9939 return Qnil;
71918b75
RS
9940}
9941
82e6e5af 9942DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
ab1959fc 9943 Sclear_this_command_keys, 0, 1, 0,
4707d2d0 9944 doc: /* Clear out the vector that `this-command-keys' returns.
ab1959fc
KS
9945Also clear the record of the last 100 events, unless optional arg
9946KEEP-RECORD is non-nil. */)
9947 (keep_record)
9948 Lisp_Object keep_record;
82e6e5af 9949{
fb0dde6c 9950 int i;
c60ee5e7 9951
82e6e5af 9952 this_command_key_count = 0;
63020c46 9953 this_command_key_count_reset = 0;
fb0dde6c 9954
ab1959fc
KS
9955 if (NILP (keep_record))
9956 {
9957 for (i = 0; i < XVECTOR (recent_keys)->size; ++i)
9958 XVECTOR (recent_keys)->contents[i] = Qnil;
9959 total_keys = 0;
9960 recent_keys_index = 0;
9961 }
82e6e5af
RS
9962 return Qnil;
9963}
9964
284f4730 9965DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
4707d2d0
PJ
9966 doc: /* Return the current depth in recursive edits. */)
9967 ()
284f4730
JB
9968{
9969 Lisp_Object temp;
bb9e9bed 9970 XSETFASTINT (temp, command_loop_level + minibuf_level);
284f4730
JB
9971 return temp;
9972}
9973
9974DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
4707d2d0
PJ
9975 "FOpen dribble file: ",
9976 doc: /* Start writing all keyboard characters to a dribble file called FILE.
9977If FILE is nil, close any open dribble file. */)
9978 (file)
284f4730
JB
9979 Lisp_Object file;
9980{
6cb52def 9981 if (dribble)
284f4730 9982 {
6cb52def
KH
9983 fclose (dribble);
9984 dribble = 0;
284f4730 9985 }
6cb52def 9986 if (!NILP (file))
284f4730
JB
9987 {
9988 file = Fexpand_file_name (file, Qnil);
d5db4077 9989 dribble = fopen (SDATA (file), "w");
ab6ca1de
KH
9990 if (dribble == 0)
9991 report_file_error ("Opening dribble", Fcons (file, Qnil));
284f4730
JB
9992 }
9993 return Qnil;
9994}
9995
9996DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
4707d2d0 9997 doc: /* Discard the contents of the terminal input buffer.
2b17d5ed 9998Also end any kbd macro being defined. */)
4707d2d0 9999 ()
284f4730 10000{
2b17d5ed
KS
10001 if (!NILP (current_kboard->defining_kbd_macro))
10002 {
10003 /* Discard the last command from the macro. */
10004 Fcancel_kbd_macro_events ();
10005 end_kbd_macro ();
10006 }
10007
284f4730
JB
10008 update_mode_lines++;
10009
24597608 10010 Vunread_command_events = Qnil;
86e5706b 10011 unread_command_char = -1;
284f4730
JB
10012
10013 discard_tty_input ();
10014
7ee32cda 10015 kbd_fetch_ptr = kbd_store_ptr;
da8f7368 10016 Ffillarray (kbd_buffer_gcpro, Qnil);
284f4730
JB
10017 input_pending = 0;
10018
10019 return Qnil;
10020}
10021\f
10022DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
4707d2d0
PJ
10023 doc: /* Stop Emacs and return to superior process. You can resume later.
10024If `cannot-suspend' is non-nil, or if the system doesn't support job
10025control, run a subshell instead.
10026
10027If optional arg STUFFSTRING is non-nil, its characters are stuffed
10028to be read as terminal input by Emacs's parent, after suspension.
10029
10030Before suspending, run the normal hook `suspend-hook'.
10031After resumption run the normal hook `suspend-resume-hook'.
10032
10033Some operating systems cannot stop the Emacs process and resume it later.
10034On such systems, Emacs starts a subshell instead of suspending. */)
10035 (stuffstring)
284f4730
JB
10036 Lisp_Object stuffstring;
10037{
aed13378 10038 int count = SPECPDL_INDEX ();
284f4730
JB
10039 int old_height, old_width;
10040 int width, height;
03cee6ae 10041 struct gcpro gcpro1;
284f4730
JB
10042
10043 if (!NILP (stuffstring))
b7826503 10044 CHECK_STRING (stuffstring);
284f4730 10045
1e95ed28
JB
10046 /* Run the functions in suspend-hook. */
10047 if (!NILP (Vrun_hooks))
10048 call1 (Vrun_hooks, intern ("suspend-hook"));
284f4730 10049
b7d2ebbf 10050 GCPRO1 (stuffstring);
ff11dfa1 10051 get_frame_size (&old_width, &old_height);
284f4730
JB
10052 reset_sys_modes ();
10053 /* sys_suspend can get an error if it tries to fork a subshell
10054 and the system resources aren't available for that. */
91a0da02 10055 record_unwind_protect ((Lisp_Object (*) P_ ((Lisp_Object))) init_sys_modes,
d52a7a92 10056 Qnil);
284f4730 10057 stuff_buffered_input (stuffstring);
8026024c
KH
10058 if (cannot_suspend)
10059 sys_subshell ();
10060 else
10061 sys_suspend ();
284f4730
JB
10062 unbind_to (count, Qnil);
10063
10064 /* Check if terminal/window size has changed.
10065 Note that this is not useful when we are running directly
10066 with a window system; but suspend should be disabled in that case. */
ff11dfa1 10067 get_frame_size (&width, &height);
284f4730 10068 if (width != old_width || height != old_height)
788f89eb 10069 change_frame_size (SELECTED_FRAME (), height, width, 0, 0, 0);
284f4730 10070
1e95ed28 10071 /* Run suspend-resume-hook. */
284f4730
JB
10072 if (!NILP (Vrun_hooks))
10073 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
df0f2ba1 10074
284f4730
JB
10075 UNGCPRO;
10076 return Qnil;
10077}
10078
10079/* If STUFFSTRING is a string, stuff its contents as pending terminal input.
eb8c3be9 10080 Then in any case stuff anything Emacs has read ahead and not used. */
284f4730 10081
07a59269 10082void
284f4730
JB
10083stuff_buffered_input (stuffstring)
10084 Lisp_Object stuffstring;
10085{
284f4730 10086/* stuff_char works only in BSD, versions 4.2 and up. */
6df54671 10087#ifdef BSD_SYSTEM
284f4730 10088#ifndef BSD4_1
612b78ef 10089 register unsigned char *p;
612b78ef 10090
8c18cbfb 10091 if (STRINGP (stuffstring))
284f4730
JB
10092 {
10093 register int count;
10094
d5db4077
KR
10095 p = SDATA (stuffstring);
10096 count = SBYTES (stuffstring);
284f4730
JB
10097 while (count-- > 0)
10098 stuff_char (*p++);
10099 stuff_char ('\n');
10100 }
c60ee5e7 10101
284f4730 10102 /* Anything we have read ahead, put back for the shell to read. */
beecf6a1 10103 /* ?? What should this do when we have multiple keyboards??
c5fdd383 10104 Should we ignore anything that was typed in at the "wrong" kboard? */
beecf6a1 10105 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
284f4730 10106 {
da8f7368 10107 int idx;
c60ee5e7 10108
beecf6a1
KH
10109 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
10110 kbd_fetch_ptr = kbd_buffer;
3b8f9651 10111 if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT)
beecf6a1 10112 stuff_char (kbd_fetch_ptr->code);
c60ee5e7 10113
3b8f9651 10114 kbd_fetch_ptr->kind = NO_EVENT;
da8f7368
GM
10115 idx = 2 * (kbd_fetch_ptr - kbd_buffer);
10116 ASET (kbd_buffer_gcpro, idx, Qnil);
10117 ASET (kbd_buffer_gcpro, idx + 1, Qnil);
284f4730 10118 }
c60ee5e7 10119
284f4730
JB
10120 input_pending = 0;
10121#endif
6df54671 10122#endif /* BSD_SYSTEM and not BSD4_1 */
284f4730
JB
10123}
10124\f
dfcf069d 10125void
ffd56f97
JB
10126set_waiting_for_input (time_to_clear)
10127 EMACS_TIME *time_to_clear;
284f4730 10128{
ffd56f97 10129 input_available_clear_time = time_to_clear;
284f4730
JB
10130
10131 /* Tell interrupt_signal to throw back to read_char, */
10132 waiting_for_input = 1;
10133
10134 /* If interrupt_signal was called before and buffered a C-g,
10135 make it run again now, to avoid timing error. */
10136 if (!NILP (Vquit_flag))
10137 quit_throw_to_read_char ();
284f4730
JB
10138}
10139
07a59269 10140void
284f4730
JB
10141clear_waiting_for_input ()
10142{
10143 /* Tell interrupt_signal not to throw back to read_char, */
10144 waiting_for_input = 0;
ffd56f97 10145 input_available_clear_time = 0;
284f4730
JB
10146}
10147
27fd22dc 10148/* This routine is called at interrupt level in response to C-g.
c60ee5e7 10149
d4e68eea
GM
10150 If interrupt_input, this is the handler for SIGINT. Otherwise, it
10151 is called from kbd_buffer_store_event, in handling SIGIO or
10152 SIGTINT.
284f4730 10153
d4e68eea
GM
10154 If `waiting_for_input' is non zero, then unless `echoing' is
10155 nonzero, immediately throw back to read_char.
284f4730 10156
d4e68eea
GM
10157 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
10158 eval to throw, when it gets a chance. If quit-flag is already
10159 non-nil, it stops the job right away. */
284f4730 10160
14e40288 10161static SIGTYPE
91c049d4
RS
10162interrupt_signal (signalnum) /* If we don't have an argument, */
10163 int signalnum; /* some compilers complain in signal calls. */
284f4730
JB
10164{
10165 char c;
10166 /* Must preserve main program's value of errno. */
10167 int old_errno = errno;
788f89eb 10168 struct frame *sf = SELECTED_FRAME ();
284f4730 10169
5970a8cb 10170#if defined (USG) && !defined (POSIX_SIGNALS)
7a80a6f6
RS
10171 if (!read_socket_hook && NILP (Vwindow_system))
10172 {
10173 /* USG systems forget handlers when they are used;
10174 must reestablish each time */
10175 signal (SIGINT, interrupt_signal);
10176 signal (SIGQUIT, interrupt_signal);
10177 }
284f4730
JB
10178#endif /* USG */
10179
10180 cancel_echoing ();
10181
31e4e97b 10182 if (!NILP (Vquit_flag)
788f89eb 10183 && (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf)))
284f4730 10184 {
31e4e97b
EZ
10185 /* If SIGINT isn't blocked, don't let us be interrupted by
10186 another SIGINT, it might be harmful due to non-reentrancy
10187 in I/O functions. */
10188 sigblock (sigmask (SIGINT));
10189
284f4730
JB
10190 fflush (stdout);
10191 reset_sys_modes ();
31e4e97b 10192
284f4730
JB
10193#ifdef SIGTSTP /* Support possible in later USG versions */
10194/*
10195 * On systems which can suspend the current process and return to the original
10196 * shell, this command causes the user to end up back at the shell.
10197 * The "Auto-save" and "Abort" questions are not asked until
10198 * the user elects to return to emacs, at which point he can save the current
10199 * job and either dump core or continue.
10200 */
10201 sys_suspend ();
10202#else
10203#ifdef VMS
10204 if (sys_suspend () == -1)
10205 {
10206 printf ("Not running as a subprocess;\n");
10207 printf ("you can continue or abort.\n");
10208 }
10209#else /* not VMS */
10210 /* Perhaps should really fork an inferior shell?
10211 But that would not provide any way to get back
10212 to the original shell, ever. */
10213 printf ("No support for stopping a process on this operating system;\n");
10214 printf ("you can continue or abort.\n");
10215#endif /* not VMS */
10216#endif /* not SIGTSTP */
80e4aa30
RS
10217#ifdef MSDOS
10218 /* We must remain inside the screen area when the internal terminal
10219 is used. Note that [Enter] is not echoed by dos. */
10220 cursor_to (0, 0);
10221#endif
118d6ca9
RS
10222 /* It doesn't work to autosave while GC is in progress;
10223 the code used for auto-saving doesn't cope with the mark bit. */
10224 if (!gc_in_progress)
9fd7d808 10225 {
118d6ca9
RS
10226 printf ("Auto-save? (y or n) ");
10227 fflush (stdout);
10228 if (((c = getchar ()) & ~040) == 'Y')
10229 {
10230 Fdo_auto_save (Qt, Qnil);
80e4aa30 10231#ifdef MSDOS
118d6ca9 10232 printf ("\r\nAuto-save done");
80e4aa30 10233#else /* not MSDOS */
118d6ca9 10234 printf ("Auto-save done\n");
80e4aa30 10235#endif /* not MSDOS */
118d6ca9
RS
10236 }
10237 while (c != '\n') c = getchar ();
9fd7d808 10238 }
c60ee5e7 10239 else
118d6ca9
RS
10240 {
10241 /* During GC, it must be safe to reenable quitting again. */
10242 Vinhibit_quit = Qnil;
10243#ifdef MSDOS
10244 printf ("\r\n");
10245#endif /* not MSDOS */
10246 printf ("Garbage collection in progress; cannot auto-save now\r\n");
10247 printf ("but will instead do a real quit after garbage collection ends\r\n");
10248 fflush (stdout);
10249 }
10250
80e4aa30
RS
10251#ifdef MSDOS
10252 printf ("\r\nAbort? (y or n) ");
10253#else /* not MSDOS */
284f4730
JB
10254#ifdef VMS
10255 printf ("Abort (and enter debugger)? (y or n) ");
10256#else /* not VMS */
10257 printf ("Abort (and dump core)? (y or n) ");
10258#endif /* not VMS */
80e4aa30 10259#endif /* not MSDOS */
284f4730
JB
10260 fflush (stdout);
10261 if (((c = getchar ()) & ~040) == 'Y')
10262 abort ();
10263 while (c != '\n') c = getchar ();
80e4aa30
RS
10264#ifdef MSDOS
10265 printf ("\r\nContinuing...\r\n");
10266#else /* not MSDOS */
284f4730 10267 printf ("Continuing...\n");
80e4aa30 10268#endif /* not MSDOS */
284f4730
JB
10269 fflush (stdout);
10270 init_sys_modes ();
31e4e97b 10271 sigfree ();
284f4730
JB
10272 }
10273 else
10274 {
10275 /* If executing a function that wants to be interrupted out of
10276 and the user has not deferred quitting by binding `inhibit-quit'
10277 then quit right away. */
10278 if (immediate_quit && NILP (Vinhibit_quit))
10279 {
e39da3d7
RS
10280 struct gl_state_s saved;
10281 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10282
284f4730
JB
10283 immediate_quit = 0;
10284 sigfree ();
e39da3d7
RS
10285 saved = gl_state;
10286 GCPRO4 (saved.object, saved.global_code,
10287 saved.current_syntax_table, saved.old_prop);
284f4730 10288 Fsignal (Qquit, Qnil);
e39da3d7
RS
10289 gl_state = saved;
10290 UNGCPRO;
284f4730
JB
10291 }
10292 else
10293 /* Else request quit when it's safe */
10294 Vquit_flag = Qt;
10295 }
10296
10297 if (waiting_for_input && !echoing)
10298 quit_throw_to_read_char ();
10299
10300 errno = old_errno;
10301}
10302
10303/* Handle a C-g by making read_char return C-g. */
10304
07a59269 10305void
284f4730
JB
10306quit_throw_to_read_char ()
10307{
284f4730
JB
10308 sigfree ();
10309 /* Prevent another signal from doing this before we finish. */
f76475ad 10310 clear_waiting_for_input ();
284f4730
JB
10311 input_pending = 0;
10312
24597608 10313 Vunread_command_events = Qnil;
86e5706b 10314 unread_command_char = -1;
284f4730 10315
087feab3
RS
10316#if 0 /* Currently, sit_for is called from read_char without turning
10317 off polling. And that can call set_waiting_for_input.
10318 It seems to be harmless. */
e6b01c14
JB
10319#ifdef POLL_FOR_INPUT
10320 /* May be > 1 if in recursive minibuffer. */
10321 if (poll_suppress_count == 0)
10322 abort ();
10323#endif
087feab3 10324#endif
4c52b668 10325 if (FRAMEP (internal_last_event_frame)
788f89eb 10326 && !EQ (internal_last_event_frame, selected_frame))
719191cf 10327 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
827c686c 10328 0, 0);
e6b01c14 10329
284f4730
JB
10330 _longjmp (getcjmp, 1);
10331}
10332\f
10333DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
4707d2d0
PJ
10334 doc: /* Set mode of reading keyboard input.
10335First arg INTERRUPT non-nil means use input interrupts;
10336 nil means use CBREAK mode.
10337Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
10338 (no effect except in CBREAK mode).
10339Third arg META t means accept 8-bit input (for a Meta key).
10340 META nil means ignore the top bit, on the assumption it is parity.
10341 Otherwise, accept 8-bit input and don't use the top bit for Meta.
10342Optional fourth arg QUIT if non-nil specifies character to use for quitting.
10343See also `current-input-mode'. */)
10344 (interrupt, flow, meta, quit)
284f4730
JB
10345 Lisp_Object interrupt, flow, meta, quit;
10346{
10347 if (!NILP (quit)
8c18cbfb 10348 && (!INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400))
34f04431
RS
10349 error ("set-input-mode: QUIT must be an ASCII character");
10350
10351#ifdef POLL_FOR_INPUT
10352 stop_polling ();
10353#endif
284f4730 10354
07de30b9 10355#ifndef DOS_NT
2ee250ec 10356 /* this causes startup screen to be restored and messes with the mouse */
284f4730 10357 reset_sys_modes ();
2ee250ec
RS
10358#endif
10359
284f4730
JB
10360#ifdef SIGIO
10361/* Note SIGIO has been undef'd if FIONREAD is missing. */
284f4730 10362 if (read_socket_hook)
9a0f60bb
KH
10363 {
10364 /* When using X, don't give the user a real choice,
10365 because we haven't implemented the mechanisms to support it. */
10366#ifdef NO_SOCK_SIGIO
10367 interrupt_input = 0;
10368#else /* not NO_SOCK_SIGIO */
10369 interrupt_input = 1;
284f4730 10370#endif /* NO_SOCK_SIGIO */
9a0f60bb
KH
10371 }
10372 else
284f4730
JB
10373 interrupt_input = !NILP (interrupt);
10374#else /* not SIGIO */
10375 interrupt_input = 0;
10376#endif /* not SIGIO */
9a0f60bb 10377
284f4730
JB
10378/* Our VMS input only works by interrupts, as of now. */
10379#ifdef VMS
10380 interrupt_input = 1;
10381#endif
9a0f60bb 10382
284f4730 10383 flow_control = !NILP (flow);
b04904fb
RS
10384 if (NILP (meta))
10385 meta_key = 0;
10386 else if (EQ (meta, Qt))
10387 meta_key = 1;
10388 else
10389 meta_key = 2;
284f4730
JB
10390 if (!NILP (quit))
10391 /* Don't let this value be out of range. */
10392 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
10393
07de30b9 10394#ifndef DOS_NT
284f4730 10395 init_sys_modes ();
2ee250ec 10396#endif
34f04431
RS
10397
10398#ifdef POLL_FOR_INPUT
10399 poll_suppress_count = 1;
10400 start_polling ();
10401#endif
284f4730
JB
10402 return Qnil;
10403}
80645119
JB
10404
10405DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
4707d2d0
PJ
10406 doc: /* Return information about the way Emacs currently reads keyboard input.
10407The value is a list of the form (INTERRUPT FLOW META QUIT), where
10408 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if
10409 nil, Emacs is using CBREAK mode.
10410 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
10411 terminal; this does not apply if Emacs uses interrupt-driven input.
10412 META is t if accepting 8-bit input with 8th bit as Meta flag.
10413 META nil means ignoring the top bit, on the assumption it is parity.
10414 META is neither t nor nil if accepting 8-bit input and using
10415 all 8 bits as the character code.
10416 QUIT is the character Emacs currently uses to quit.
10417The elements of this list correspond to the arguments of
10418`set-input-mode'. */)
10419 ()
80645119
JB
10420{
10421 Lisp_Object val[4];
10422
10423 val[0] = interrupt_input ? Qt : Qnil;
10424 val[1] = flow_control ? Qt : Qnil;
a8ee7ef9 10425 val[2] = meta_key == 2 ? make_number (0) : meta_key == 1 ? Qt : Qnil;
bb9e9bed 10426 XSETFASTINT (val[3], quit_char);
80645119 10427
bf673a7a 10428 return Flist (sizeof (val) / sizeof (val[0]), val);
80645119
JB
10429}
10430
284f4730 10431\f
6c6083a9 10432/*
c5fdd383 10433 * Set up a new kboard object with reasonable initial values.
6c6083a9
KH
10434 */
10435void
c5fdd383
KH
10436init_kboard (kb)
10437 KBOARD *kb;
6c6083a9 10438{
217258d5 10439 kb->Voverriding_terminal_local_map = Qnil;
6c7178b9 10440 kb->Vlast_command = Qnil;
75045dcb 10441 kb->Vreal_last_command = Qnil;
d8bcf58e 10442 kb->Vprefix_arg = Qnil;
75045dcb 10443 kb->Vlast_prefix_arg = Qnil;
c5fdd383
KH
10444 kb->kbd_queue = Qnil;
10445 kb->kbd_queue_has_data = 0;
10446 kb->immediate_echo = 0;
678e9d18 10447 kb->echo_string = Qnil;
c5fdd383
KH
10448 kb->echo_after_prompt = -1;
10449 kb->kbd_macro_buffer = 0;
10450 kb->kbd_macro_bufsize = 0;
10451 kb->defining_kbd_macro = Qnil;
10452 kb->Vlast_kbd_macro = Qnil;
10453 kb->reference_count = 0;
7c97ffdc 10454 kb->Vsystem_key_alist = Qnil;
142e6c73 10455 kb->system_key_syms = Qnil;
9ba47203 10456 kb->Vdefault_minibuffer_frame = Qnil;
6c6083a9
KH
10457}
10458
10459/*
c5fdd383 10460 * Destroy the contents of a kboard object, but not the object itself.
8e6208c5 10461 * We use this just before deleting it, or if we're going to initialize
6c6083a9
KH
10462 * it a second time.
10463 */
e50b8090 10464static void
c5fdd383
KH
10465wipe_kboard (kb)
10466 KBOARD *kb;
6c6083a9 10467{
c5fdd383
KH
10468 if (kb->kbd_macro_buffer)
10469 xfree (kb->kbd_macro_buffer);
6c6083a9
KH
10470}
10471
e50b8090 10472#ifdef MULTI_KBOARD
a122a38e
GM
10473
10474/* Free KB and memory referenced from it. */
10475
e50b8090
KH
10476void
10477delete_kboard (kb)
a122a38e 10478 KBOARD *kb;
e50b8090
KH
10479{
10480 KBOARD **kbp;
c60ee5e7 10481
e50b8090
KH
10482 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
10483 if (*kbp == NULL)
10484 abort ();
10485 *kbp = kb->next_kboard;
a122a38e
GM
10486
10487 /* Prevent a dangling reference to KB. */
18f534df
GM
10488 if (kb == current_kboard
10489 && FRAMEP (selected_frame)
10490 && FRAME_LIVE_P (XFRAME (selected_frame)))
a122a38e 10491 {
18f534df 10492 current_kboard = XFRAME (selected_frame)->kboard;
a122a38e
GM
10493 if (current_kboard == kb)
10494 abort ();
10495 }
c60ee5e7 10496
e50b8090
KH
10497 wipe_kboard (kb);
10498 xfree (kb);
10499}
a122a38e
GM
10500
10501#endif /* MULTI_KBOARD */
e50b8090 10502
dfcf069d 10503void
284f4730
JB
10504init_keyboard ()
10505{
284f4730
JB
10506 /* This is correct before outermost invocation of the editor loop */
10507 command_loop_level = -1;
10508 immediate_quit = 0;
10509 quit_char = Ctl ('g');
24597608 10510 Vunread_command_events = Qnil;
86e5706b 10511 unread_command_char = -1;
87dd9b9b 10512 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
284f4730 10513 total_keys = 0;
9deb415a 10514 recent_keys_index = 0;
beecf6a1
KH
10515 kbd_fetch_ptr = kbd_buffer;
10516 kbd_store_ptr = kbd_buffer;
da8f7368 10517 kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
2eb6bfbe 10518#ifdef HAVE_MOUSE
a9d77f1f 10519 do_mouse_tracking = Qnil;
2eb6bfbe 10520#endif
284f4730
JB
10521 input_pending = 0;
10522
4c52b668
KH
10523 /* This means that command_loop_1 won't try to select anything the first
10524 time through. */
10525 internal_last_event_frame = Qnil;
10526 Vlast_event_frame = internal_last_event_frame;
4c52b668 10527
c5fdd383 10528#ifdef MULTI_KBOARD
aaca43a1 10529 current_kboard = initial_kboard;
6c6083a9 10530#endif
aaca43a1 10531 wipe_kboard (current_kboard);
c5fdd383 10532 init_kboard (current_kboard);
07d2b8de 10533
7a80a6f6 10534 if (!noninteractive && !read_socket_hook && NILP (Vwindow_system))
284f4730
JB
10535 {
10536 signal (SIGINT, interrupt_signal);
cb5df6ae 10537#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
284f4730
JB
10538 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
10539 SIGQUIT and we can't tell which one it will give us. */
10540 signal (SIGQUIT, interrupt_signal);
10541#endif /* HAVE_TERMIO */
7a80a6f6 10542 }
284f4730
JB
10543/* Note SIGIO has been undef'd if FIONREAD is missing. */
10544#ifdef SIGIO
7a80a6f6
RS
10545 if (!noninteractive)
10546 signal (SIGIO, input_available_signal);
8ea0a720 10547#endif /* SIGIO */
284f4730
JB
10548
10549/* Use interrupt input by default, if it works and noninterrupt input
10550 has deficiencies. */
10551
10552#ifdef INTERRUPT_INPUT
10553 interrupt_input = 1;
10554#else
10555 interrupt_input = 0;
10556#endif
10557
10558/* Our VMS input only works by interrupts, as of now. */
10559#ifdef VMS
10560 interrupt_input = 1;
10561#endif
10562
10563 sigfree ();
10564 dribble = 0;
10565
10566 if (keyboard_init_hook)
10567 (*keyboard_init_hook) ();
10568
10569#ifdef POLL_FOR_INPUT
10570 poll_suppress_count = 1;
10571 start_polling ();
10572#endif
365fa1b3
AC
10573
10574#ifdef MAC_OSX
10575 /* At least provide an escape route since C-g doesn't work. */
10576 signal (SIGINT, interrupt_signal);
10577#endif
284f4730
JB
10578}
10579
df0f2ba1 10580/* This type's only use is in syms_of_keyboard, to initialize the
284f4730
JB
10581 event header symbols and put properties on them. */
10582struct event_head {
10583 Lisp_Object *var;
10584 char *name;
10585 Lisp_Object *kind;
10586};
10587
10588struct event_head head_table[] = {
7406e988
PJ
10589 {&Qmouse_movement, "mouse-movement", &Qmouse_movement},
10590 {&Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement},
10591 {&Qswitch_frame, "switch-frame", &Qswitch_frame},
10592 {&Qdelete_frame, "delete-frame", &Qdelete_frame},
10593 {&Qiconify_frame, "iconify-frame", &Qiconify_frame},
a697f886 10594 {&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible},
6901b111
SM
10595 /* `select-window' should be handled just like `switch-frame'
10596 in read_key_sequence. */
10597 {&Qselect_window, "select-window", &Qswitch_frame}
284f4730
JB
10598};
10599
dfcf069d 10600void
284f4730
JB
10601syms_of_keyboard ()
10602{
f0c1cc56
GM
10603 Vpre_help_message = Qnil;
10604 staticpro (&Vpre_help_message);
c60ee5e7 10605
8e1e4240
GM
10606 Vlispy_mouse_stem = build_string ("mouse");
10607 staticpro (&Vlispy_mouse_stem);
f0c1cc56 10608
9ea173e8 10609 /* Tool-bars. */
7ee32cda
GM
10610 QCimage = intern (":image");
10611 staticpro (&QCimage);
10612
10613 staticpro (&Qhelp_echo);
10614 Qhelp_echo = intern ("help-echo");
10615
e8886a1d
RS
10616 staticpro (&item_properties);
10617 item_properties = Qnil;
10618
9ea173e8
GM
10619 staticpro (&tool_bar_item_properties);
10620 tool_bar_item_properties = Qnil;
10621 staticpro (&tool_bar_items_vector);
10622 tool_bar_items_vector = Qnil;
7ee32cda 10623
d5eecefb
RS
10624 staticpro (&real_this_command);
10625 real_this_command = Qnil;
10626
d925fb39
RS
10627 Qtimer_event_handler = intern ("timer-event-handler");
10628 staticpro (&Qtimer_event_handler);
10629
2e894dab
RS
10630 Qdisabled_command_hook = intern ("disabled-command-hook");
10631 staticpro (&Qdisabled_command_hook);
10632
284f4730
JB
10633 Qself_insert_command = intern ("self-insert-command");
10634 staticpro (&Qself_insert_command);
10635
10636 Qforward_char = intern ("forward-char");
10637 staticpro (&Qforward_char);
10638
10639 Qbackward_char = intern ("backward-char");
10640 staticpro (&Qbackward_char);
10641
10642 Qdisabled = intern ("disabled");
10643 staticpro (&Qdisabled);
10644
e58aa385
RS
10645 Qundefined = intern ("undefined");
10646 staticpro (&Qundefined);
10647
86e5706b
RS
10648 Qpre_command_hook = intern ("pre-command-hook");
10649 staticpro (&Qpre_command_hook);
10650
10651 Qpost_command_hook = intern ("post-command-hook");
10652 staticpro (&Qpost_command_hook);
10653
59aadc81
RS
10654 Qpost_command_idle_hook = intern ("post-command-idle-hook");
10655 staticpro (&Qpost_command_idle_hook);
10656
3ef14e46
RS
10657 Qdeferred_action_function = intern ("deferred-action-function");
10658 staticpro (&Qdeferred_action_function);
10659
40932d1a
RS
10660 Qcommand_hook_internal = intern ("command-hook-internal");
10661 staticpro (&Qcommand_hook_internal);
10662
284f4730
JB
10663 Qfunction_key = intern ("function-key");
10664 staticpro (&Qfunction_key);
13b5e56c 10665 Qmouse_click = intern ("mouse-click");
284f4730 10666 staticpro (&Qmouse_click);
742fbed7 10667#ifdef WINDOWSNT
1161d367
GV
10668 Qlanguage_change = intern ("language-change");
10669 staticpro (&Qlanguage_change);
07de30b9 10670#endif
a24dc617
RS
10671 Qdrag_n_drop = intern ("drag-n-drop");
10672 staticpro (&Qdrag_n_drop);
284f4730 10673
4ebc27a5
JD
10674 Qsave_session = intern ("save-session");
10675 staticpro(&Qsave_session);
c60ee5e7 10676
5bf68f6e
AS
10677 Qusr1_signal = intern ("usr1-signal");
10678 staticpro (&Qusr1_signal);
10679 Qusr2_signal = intern ("usr2-signal");
10680 staticpro (&Qusr2_signal);
10681
598a9fa7
JB
10682 Qmenu_enable = intern ("menu-enable");
10683 staticpro (&Qmenu_enable);
e8886a1d
RS
10684 Qmenu_alias = intern ("menu-alias");
10685 staticpro (&Qmenu_alias);
10686 QCenable = intern (":enable");
10687 staticpro (&QCenable);
10688 QCvisible = intern (":visible");
10689 staticpro (&QCvisible);
7ee32cda
GM
10690 QChelp = intern (":help");
10691 staticpro (&QChelp);
e8886a1d
RS
10692 QCfilter = intern (":filter");
10693 staticpro (&QCfilter);
10694 QCbutton = intern (":button");
10695 staticpro (&QCbutton);
74c1de23
RS
10696 QCkeys = intern (":keys");
10697 staticpro (&QCkeys);
10698 QCkey_sequence = intern (":key-sequence");
10699 staticpro (&QCkey_sequence);
e8886a1d
RS
10700 QCtoggle = intern (":toggle");
10701 staticpro (&QCtoggle);
10702 QCradio = intern (":radio");
10703 staticpro (&QCradio);
598a9fa7 10704
284f4730
JB
10705 Qmode_line = intern ("mode-line");
10706 staticpro (&Qmode_line);
e5d77022
JB
10707 Qvertical_line = intern ("vertical-line");
10708 staticpro (&Qvertical_line);
3c370943
JB
10709 Qvertical_scroll_bar = intern ("vertical-scroll-bar");
10710 staticpro (&Qvertical_scroll_bar);
5ec75a55
RS
10711 Qmenu_bar = intern ("menu-bar");
10712 staticpro (&Qmenu_bar);
4bb994d1
JB
10713
10714 Qabove_handle = intern ("above-handle");
10715 staticpro (&Qabove_handle);
10716 Qhandle = intern ("handle");
10717 staticpro (&Qhandle);
10718 Qbelow_handle = intern ("below-handle");
10719 staticpro (&Qbelow_handle);
db08707d
RS
10720 Qup = intern ("up");
10721 staticpro (&Qup);
10722 Qdown = intern ("down");
10723 staticpro (&Qdown);
7ee32cda
GM
10724 Qtop = intern ("top");
10725 staticpro (&Qtop);
10726 Qbottom = intern ("bottom");
10727 staticpro (&Qbottom);
10728 Qend_scroll = intern ("end-scroll");
10729 staticpro (&Qend_scroll);
eef28553
SM
10730 Qratio = intern ("ratio");
10731 staticpro (&Qratio);
284f4730 10732
cd21b839 10733 Qevent_kind = intern ("event-kind");
284f4730 10734 staticpro (&Qevent_kind);
88cb0656
JB
10735 Qevent_symbol_elements = intern ("event-symbol-elements");
10736 staticpro (&Qevent_symbol_elements);
0a7f1fc0
JB
10737 Qevent_symbol_element_mask = intern ("event-symbol-element-mask");
10738 staticpro (&Qevent_symbol_element_mask);
10739 Qmodifier_cache = intern ("modifier-cache");
10740 staticpro (&Qmodifier_cache);
284f4730 10741
48e416d4
RS
10742 Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar");
10743 staticpro (&Qrecompute_lucid_menubar);
10744 Qactivate_menubar_hook = intern ("activate-menubar-hook");
10745 staticpro (&Qactivate_menubar_hook);
10746
f4eef8b4
RS
10747 Qpolling_period = intern ("polling-period");
10748 staticpro (&Qpolling_period);
10749
7d18f9ae
RS
10750 Qinput_method_function = intern ("input-method-function");
10751 staticpro (&Qinput_method_function);
10752
d5eecefb
RS
10753 Qinput_method_exit_on_first_char = intern ("input-method-exit-on-first-char");
10754 staticpro (&Qinput_method_exit_on_first_char);
10755 Qinput_method_use_echo_area = intern ("input-method-use-echo-area");
10756 staticpro (&Qinput_method_use_echo_area);
10757
10758 Fset (Qinput_method_exit_on_first_char, Qnil);
10759 Fset (Qinput_method_use_echo_area, Qnil);
10760
e18dfbf4
KR
10761 last_point_position_buffer = Qnil;
10762
284f4730
JB
10763 {
10764 struct event_head *p;
10765
10766 for (p = head_table;
10767 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
10768 p++)
10769 {
10770 *p->var = intern (p->name);
10771 staticpro (p->var);
10772 Fput (*p->var, Qevent_kind, *p->kind);
88cb0656 10773 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
284f4730
JB
10774 }
10775 }
10776
8e1e4240 10777 button_down_location = Fmake_vector (make_number (1), Qnil);
7b4aedb9 10778 staticpro (&button_down_location);
8e1e4240
GM
10779 mouse_syms = Fmake_vector (make_number (1), Qnil);
10780 staticpro (&mouse_syms);
8006e4bb
JR
10781 wheel_syms = Fmake_vector (make_number (2), Qnil);
10782 staticpro (&wheel_syms);
88cb0656
JB
10783
10784 {
10785 int i;
10786 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
10787
10788 modifier_symbols = Fmake_vector (make_number (len), Qnil);
10789 for (i = 0; i < len; i++)
86e5706b
RS
10790 if (modifier_names[i])
10791 XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]);
88cb0656
JB
10792 staticpro (&modifier_symbols);
10793 }
10794
9deb415a
JB
10795 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
10796 staticpro (&recent_keys);
10797
6569cc8d 10798 this_command_keys = Fmake_vector (make_number (40), Qnil);
715d9345 10799 staticpro (&this_command_keys);
6569cc8d 10800
7d18f9ae
RS
10801 raw_keybuf = Fmake_vector (make_number (30), Qnil);
10802 staticpro (&raw_keybuf);
10803
03b4122a
BF
10804 Qextended_command_history = intern ("extended-command-history");
10805 Fset (Qextended_command_history, Qnil);
10806 staticpro (&Qextended_command_history);
10807
da8f7368
GM
10808 kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
10809 staticpro (&kbd_buffer_gcpro);
beecf6a1 10810
24597608
RS
10811 accent_key_syms = Qnil;
10812 staticpro (&accent_key_syms);
10813
284f4730
JB
10814 func_key_syms = Qnil;
10815 staticpro (&func_key_syms);
10816
a24dc617
RS
10817 drag_n_drop_syms = Qnil;
10818 staticpro (&drag_n_drop_syms);
07de30b9 10819
cd21b839
JB
10820 unread_switch_frame = Qnil;
10821 staticpro (&unread_switch_frame);
10822
fe412364
EN
10823 internal_last_event_frame = Qnil;
10824 staticpro (&internal_last_event_frame);
10825
10826 read_key_sequence_cmd = Qnil;
10827 staticpro (&read_key_sequence_cmd);
10828
759860a6
RS
10829 menu_bar_one_keymap_changed_items = Qnil;
10830 staticpro (&menu_bar_one_keymap_changed_items);
10831
a1706c30 10832 defsubr (&Sevent_convert_list);
284f4730 10833 defsubr (&Sread_key_sequence);
e39da3d7 10834 defsubr (&Sread_key_sequence_vector);
284f4730 10835 defsubr (&Srecursive_edit);
2eb6bfbe 10836#ifdef HAVE_MOUSE
284f4730 10837 defsubr (&Strack_mouse);
2eb6bfbe 10838#endif
284f4730
JB
10839 defsubr (&Sinput_pending_p);
10840 defsubr (&Scommand_execute);
10841 defsubr (&Srecent_keys);
10842 defsubr (&Sthis_command_keys);
e39da3d7 10843 defsubr (&Sthis_command_keys_vector);
6321824f 10844 defsubr (&Sthis_single_command_keys);
7d18f9ae 10845 defsubr (&Sthis_single_command_raw_keys);
71918b75 10846 defsubr (&Sreset_this_command_lengths);
82e6e5af 10847 defsubr (&Sclear_this_command_keys);
284f4730
JB
10848 defsubr (&Ssuspend_emacs);
10849 defsubr (&Sabort_recursive_edit);
10850 defsubr (&Sexit_recursive_edit);
10851 defsubr (&Srecursion_depth);
10852 defsubr (&Stop_level);
10853 defsubr (&Sdiscard_input);
10854 defsubr (&Sopen_dribble_file);
10855 defsubr (&Sset_input_mode);
80645119 10856 defsubr (&Scurrent_input_mode);
284f4730
JB
10857 defsubr (&Sexecute_extended_command);
10858
284f4730 10859 DEFVAR_LISP ("last-command-char", &last_command_char,
4707d2d0 10860 doc: /* Last input event that was part of a command. */);
86e5706b 10861
186cf719 10862 DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char,
4707d2d0 10863 doc: /* Last input event that was part of a command. */);
284f4730 10864
7d6de002 10865 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
4707d2d0
PJ
10866 doc: /* Last input event in a command, except for mouse menu events.
10867Mouse menus give back keys that don't look like mouse events;
10868this variable holds the actual mouse event that led to the menu,
10869so that you can determine whether the command was run by mouse or not. */);
7d6de002 10870
284f4730 10871 DEFVAR_LISP ("last-input-char", &last_input_char,
fa1361cb 10872 doc: /* Last input event. */);
86e5706b 10873
186cf719 10874 DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char,
4707d2d0 10875 doc: /* Last input event. */);
284f4730 10876
24597608 10877 DEFVAR_LISP ("unread-command-events", &Vunread_command_events,
4707d2d0
PJ
10878 doc: /* List of events to be read as the command input.
10879These events are processed first, before actual keyboard input. */);
7d18f9ae 10880 Vunread_command_events = Qnil;
284f4730 10881
86e5706b 10882 DEFVAR_INT ("unread-command-char", &unread_command_char,
4707d2d0 10883 doc: /* If not -1, an object to be read as next command input event. */);
86e5706b 10884
7d18f9ae 10885 DEFVAR_LISP ("unread-post-input-method-events", &Vunread_post_input_method_events,
4707d2d0
PJ
10886 doc: /* List of events to be processed as input by input methods.
10887These events are processed after `unread-command-events', but
10888before actual keyboard input. */);
7d18f9ae
RS
10889 Vunread_post_input_method_events = Qnil;
10890
10891 DEFVAR_LISP ("unread-input-method-events", &Vunread_input_method_events,
4707d2d0
PJ
10892 doc: /* List of events to be processed as input by input methods.
10893These events are processed after `unread-command-events', but
10894before actual keyboard input. */);
7d18f9ae
RS
10895 Vunread_input_method_events = Qnil;
10896
284f4730 10897 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
4707d2d0
PJ
10898 doc: /* Meta-prefix character code.
10899Meta-foo as command input turns into this character followed by foo. */);
18cd2eeb 10900 XSETINT (meta_prefix_char, 033);
284f4730 10901
6c7178b9 10902 DEFVAR_KBOARD ("last-command", Vlast_command,
4707d2d0
PJ
10903 doc: /* The last command executed.
10904Normally a symbol with a function definition, but can be whatever was found
10905in the keymap, or whatever the variable `this-command' was set to by that
10906command.
10907
10908The value `mode-exit' is special; it means that the previous command
10909read an event that told it to exit, and it did so and unread that event.
10910In other words, the present command is the event that made the previous
10911command exit.
10912
10913The value `kill-region' is special; it means that the previous command
10914was a kill command. */);
284f4730 10915
75045dcb 10916 DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
4707d2d0 10917 doc: /* Same as `last-command', but never altered by Lisp code. */);
75045dcb 10918
d5eecefb 10919 DEFVAR_LISP ("this-command", &Vthis_command,
4707d2d0
PJ
10920 doc: /* The command now being executed.
10921The command can set this variable; whatever is put here
10922will be in `last-command' during the following command. */);
d5eecefb 10923 Vthis_command = Qnil;
284f4730 10924
8b9940e6 10925 DEFVAR_LISP ("this-original-command", &Vthis_original_command,
f5613d1e
KS
10926 doc: /* The command bound to the current key sequence before remapping.
10927It equals `this-command' if the original command was not remapped through
10928any of the active keymaps. Otherwise, the value of `this-command' is the
177c0ea7 10929result of looking up the original command in the active keymaps. */);
8b9940e6
KS
10930 Vthis_original_command = Qnil;
10931
284f4730 10932 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
4707d2d0
PJ
10933 doc: /* *Number of input events between auto-saves.
10934Zero means disable autosaving due to number of characters typed. */);
284f4730
JB
10935 auto_save_interval = 300;
10936
10937 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
4707d2d0
PJ
10938 doc: /* *Number of seconds idle time before auto-save.
10939Zero or nil means disable auto-saving due to idleness.
10940After auto-saving due to this many seconds of idle time,
10941Emacs also does a garbage collection if that seems to be warranted. */);
bb9e9bed 10942 XSETFASTINT (Vauto_save_timeout, 30);
284f4730 10943
39aab679 10944 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes,
4707d2d0
PJ
10945 doc: /* *Nonzero means echo unfinished commands after this many seconds of pause.
10946The value may be integer or floating point. */);
39aab679 10947 Vecho_keystrokes = make_number (1);
284f4730
JB
10948
10949 DEFVAR_INT ("polling-period", &polling_period,
4707d2d0
PJ
10950 doc: /* *Interval between polling for input during Lisp execution.
10951The reason for polling is to make C-g work to stop a running program.
10952Polling is needed only when using X windows and SIGIO does not work.
10953Polling is automatically disabled in all other cases. */);
284f4730 10954 polling_period = 2;
df0f2ba1 10955
564dc952 10956 DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
4707d2d0
PJ
10957 doc: /* *Maximum time between mouse clicks to make a double-click.
10958Measured in milliseconds. nil means disable double-click recognition;
10959t means double-clicks have no time limit and are detected
10960by position only. */);
aab06933 10961 Vdouble_click_time = make_number (500);
fbcd35bd 10962
222d557c 10963 DEFVAR_INT ("double-click-fuzz", &double_click_fuzz,
4707d2d0
PJ
10964 doc: /* *Maximum mouse movement between clicks to make a double-click.
10965On window-system frames, value is the number of pixels the mouse may have
10966moved horizontally or vertically between two clicks to make a double-click.
10967On non window-system frames, value is interpreted in units of 1/8 characters
1ca6a9c4
RS
10968instead of pixels.
10969
10970This variable is also the threshold for motion of the mouse
10971to count as a drag. */);
222d557c 10972 double_click_fuzz = 3;
c60ee5e7 10973
03361bcc 10974 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
4707d2d0 10975 doc: /* *Non-nil means inhibit local map menu bar menus. */);
03361bcc
RS
10976 inhibit_local_menu_bar_menus = 0;
10977
284f4730 10978 DEFVAR_INT ("num-input-keys", &num_input_keys,
4707d2d0
PJ
10979 doc: /* Number of complete key sequences read as input so far.
10980This includes key sequences read from keyboard macros.
10981The number is effectively the number of interactive command invocations. */);
284f4730
JB
10982 num_input_keys = 0;
10983
c43b1734 10984 DEFVAR_INT ("num-nonmacro-input-events", &num_nonmacro_input_events,
4707d2d0
PJ
10985 doc: /* Number of input events read from the keyboard so far.
10986This does not include events generated by keyboard macros. */);
c43b1734 10987 num_nonmacro_input_events = 0;
fa90970d 10988
4c52b668 10989 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
4707d2d0
PJ
10990 doc: /* The frame in which the most recently read event occurred.
10991If the last event came from a keyboard macro, this is set to `macro'. */);
4c52b668
KH
10992 Vlast_event_frame = Qnil;
10993
fa90970d
RS
10994 /* This variable is set up in sysdep.c. */
10995 DEFVAR_LISP ("tty-erase-char", &Vtty_erase_char,
4707d2d0 10996 doc: /* The ERASE character as set by the user with stty. */);
fa90970d 10997
7e85b935 10998 DEFVAR_LISP ("help-char", &Vhelp_char,
4707d2d0
PJ
10999 doc: /* Character to recognize as meaning Help.
11000When it is read, do `(eval help-form)', and display result if it's a string.
11001If the value of `help-form' is nil, this char can be read normally. */);
18cd2eeb 11002 XSETINT (Vhelp_char, Ctl ('H'));
284f4730 11003
ecb7cb34 11004 DEFVAR_LISP ("help-event-list", &Vhelp_event_list,
4707d2d0
PJ
11005 doc: /* List of input events to recognize as meaning Help.
11006These work just like the value of `help-char' (see that). */);
ecb7cb34
KH
11007 Vhelp_event_list = Qnil;
11008
284f4730 11009 DEFVAR_LISP ("help-form", &Vhelp_form,
4707d2d0
PJ
11010 doc: /* Form to execute when character `help-char' is read.
11011If the form returns a string, that string is displayed.
11012If `help-form' is nil, the help char is not recognized. */);
284f4730
JB
11013 Vhelp_form = Qnil;
11014
7e85b935 11015 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
4707d2d0
PJ
11016 doc: /* Command to run when `help-char' character follows a prefix key.
11017This command is used only when there is no actual binding
11018for that character after that prefix key. */);
7e85b935
RS
11019 Vprefix_help_command = Qnil;
11020
284f4730 11021 DEFVAR_LISP ("top-level", &Vtop_level,
4707d2d0
PJ
11022 doc: /* Form to evaluate when Emacs starts up.
11023Useful to set before you dump a modified Emacs. */);
284f4730
JB
11024 Vtop_level = Qnil;
11025
11026 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
4707d2d0
PJ
11027 doc: /* Translate table for keyboard input, or nil.
11028Each character is looked up in this string and the contents used instead.
11029The value may be a string, a vector, or a char-table.
11030If it is a string or vector of length N,
11031character codes N and up are untranslated.
a0acc6c7
DL
11032In a vector or a char-table, an element which is nil means "no translation".
11033
11034This is applied to the characters supplied to input methods, not their
11035output. See also `translation-table-for-input'. */);
284f4730
JB
11036 Vkeyboard_translate_table = Qnil;
11037
8026024c 11038 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
4707d2d0
PJ
11039 doc: /* Non-nil means to always spawn a subshell instead of suspending.
11040\(Even if the operating system has support for stopping a process.\) */);
8026024c
KH
11041 cannot_suspend = 0;
11042
284f4730 11043 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
4707d2d0
PJ
11044 doc: /* Non-nil means prompt with menus when appropriate.
11045This is done when reading from a keymap that has a prompt string,
11046for elements that have prompt strings.
11047The menu is displayed on the screen
11048if X menus were enabled at configuration
11049time and the previous event was a mouse click prefix key.
11050Otherwise, menu prompting uses the echo area. */);
284f4730
JB
11051 menu_prompting = 1;
11052
11053 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
4707d2d0
PJ
11054 doc: /* Character to see next line of menu prompt.
11055Type this character while in a menu prompt to rotate around the lines of it. */);
18cd2eeb 11056 XSETINT (menu_prompt_more_char, ' ');
9fa4395d
RS
11057
11058 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
4707d2d0
PJ
11059 doc: /* A mask of additional modifier keys to use with every keyboard character.
11060Emacs applies the modifiers of the character stored here to each keyboard
11061character it reads. For example, after evaluating the expression
11062 (setq extra-keyboard-modifiers ?\\C-x)
11063all input characters will have the control modifier applied to them.
11064
11065Note that the character ?\\C-@, equivalent to the integer zero, does
11066not count as a control character; rather, it counts as a character
11067with no modifiers; thus, setting `extra-keyboard-modifiers' to zero
11068cancels any modification. */);
9fa4395d 11069 extra_keyboard_modifiers = 0;
86e5706b
RS
11070
11071 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
4707d2d0
PJ
11072 doc: /* If an editing command sets this to t, deactivate the mark afterward.
11073The command loop sets this to nil before each command,
11074and tests the value when the command returns.
11075Buffer modification stores t in this variable. */);
86e5706b
RS
11076 Vdeactivate_mark = Qnil;
11077
b0f2a7bf 11078 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal,
4707d2d0 11079 doc: /* Temporary storage of pre-command-hook or post-command-hook. */);
b0f2a7bf
KH
11080 Vcommand_hook_internal = Qnil;
11081
86e5706b 11082 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
4707d2d0
PJ
11083 doc: /* Normal hook run before each command is executed.
11084If an unhandled error happens in running this hook,
11085the hook value is set to nil, since otherwise the error
11086might happen repeatedly and make Emacs nonfunctional. */);
86e5706b
RS
11087 Vpre_command_hook = Qnil;
11088
11089 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
4707d2d0
PJ
11090 doc: /* Normal hook run after each command is executed.
11091If an unhandled error happens in running this hook,
11092the hook value is set to nil, since otherwise the error
11093might happen repeatedly and make Emacs nonfunctional. */);
86e5706b 11094 Vpost_command_hook = Qnil;
48e416d4 11095
59aadc81 11096 DEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook,
4707d2d0 11097 doc: /* Normal hook run after each command is executed, if idle.
cf9b6656 11098Errors running the hook are caught and ignored. */);
59aadc81
RS
11099 Vpost_command_idle_hook = Qnil;
11100
11101 DEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay,
4707d2d0
PJ
11102 doc: /* Delay time before running `post-command-idle-hook'.
11103This is measured in microseconds. */);
59aadc81
RS
11104 post_command_idle_delay = 100000;
11105
cf24f894
RS
11106#if 0
11107 DEFVAR_LISP ("echo-area-clear-hook", ...,
4707d2d0 11108 doc: /* Normal hook run when clearing the echo area. */);
cf24f894
RS
11109#endif
11110 Qecho_area_clear_hook = intern ("echo-area-clear-hook");
11111 SET_SYMBOL_VALUE (Qecho_area_clear_hook, Qnil);
cdb9d665 11112
48e416d4 11113 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
fa1361cb 11114 doc: /* Non-nil means menu bar, specified Lucid style, needs to be recomputed. */);
48e416d4 11115 Vlucid_menu_bar_dirty_flag = Qnil;
a73c5e29 11116
9f9c0e27 11117 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
4707d2d0
PJ
11118 doc: /* List of menu bar items to move to the end of the menu bar.
11119The elements of the list are event types that may have menu bar bindings. */);
9f9c0e27 11120 Vmenu_bar_final_items = Qnil;
e9bf89a0 11121
217258d5
KH
11122 DEFVAR_KBOARD ("overriding-terminal-local-map",
11123 Voverriding_terminal_local_map,
4707d2d0
PJ
11124 doc: /* Per-terminal keymap that overrides all other local keymaps.
11125If this variable is non-nil, it is used as a keymap instead of the
11126buffer's local map, and the minor mode keymaps and text property keymaps.
11127This variable is intended to let commands such as `universal-argument'
11128set up a different keymap for reading the next command. */);
217258d5 11129
9dd3131c 11130 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map,
4707d2d0
PJ
11131 doc: /* Keymap that overrides all other local keymaps.
11132If this variable is non-nil, it is used as a keymap instead of the
11133buffer's local map, and the minor mode keymaps and text property keymaps. */);
9dd3131c
RS
11134 Voverriding_local_map = Qnil;
11135
d0a49716 11136 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag,
4707d2d0
PJ
11137 doc: /* Non-nil means `overriding-local-map' applies to the menu bar.
11138Otherwise, the menu bar continues to reflect the buffer's local map
11139and the minor mode maps regardless of `overriding-local-map'. */);
d0a49716
RS
11140 Voverriding_local_map_menu_flag = Qnil;
11141
7f07d5ca 11142 DEFVAR_LISP ("special-event-map", &Vspecial_event_map,
4707d2d0 11143 doc: /* Keymap defining bindings for special events to execute at low level. */);
7f07d5ca
RS
11144 Vspecial_event_map = Fcons (intern ("keymap"), Qnil);
11145
71edead1 11146 DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
4707d2d0 11147 doc: /* *Non-nil means generate motion events for mouse motion. */);
80e4aa30 11148
7c97ffdc 11149 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
4707d2d0
PJ
11150 doc: /* Alist of system-specific X windows key symbols.
11151Each element should have the form (N . SYMBOL) where N is the
11152numeric keysym code (sans the \"system-specific\" bit 1<<28)
11153and SYMBOL is its name. */);
8a792f3a
RS
11154
11155 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list,
4707d2d0
PJ
11156 doc: /* List of deferred actions to be performed at a later time.
11157The precise format isn't relevant here; we just check whether it is nil. */);
8a792f3a
RS
11158 Vdeferred_action_list = Qnil;
11159
11160 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function,
4707d2d0
PJ
11161 doc: /* Function to call to handle deferred actions, after each command.
11162This function is called with no arguments after each command
11163whenever `deferred-action-list' is non-nil. */);
8a792f3a 11164 Vdeferred_action_function = Qnil;
6526ab49
RS
11165
11166 DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings,
4707d2d0
PJ
11167 doc: /* *Non-nil means show the equivalent key-binding when M-x command has one.
11168The value can be a length of time to show the message for.
11169If the value is non-nil and not a number, we wait 2 seconds. */);
6526ab49 11170 Vsuggest_key_bindings = Qt;
8bb1c042 11171
c04cbc3b 11172 DEFVAR_LISP ("timer-list", &Vtimer_list,
4707d2d0 11173 doc: /* List of active absolute time timers in order of increasing time. */);
c04cbc3b 11174 Vtimer_list = Qnil;
d9d4c147
KH
11175
11176 DEFVAR_LISP ("timer-idle-list", &Vtimer_idle_list,
4707d2d0 11177 doc: /* List of active idle-time timers in order of increasing time. */);
d9d4c147 11178 Vtimer_idle_list = Qnil;
7d18f9ae
RS
11179
11180 DEFVAR_LISP ("input-method-function", &Vinput_method_function,
4707d2d0
PJ
11181 doc: /* If non-nil, the function that implements the current input method.
11182It's called with one argument, a printing character that was just read.
11183\(That means a character with code 040...0176.)
11184Typically this function uses `read-event' to read additional events.
11185When it does so, it should first bind `input-method-function' to nil
11186so it will not be called recursively.
11187
11188The function should return a list of zero or more events
11189to be used as input. If it wants to put back some events
11190to be reconsidered, separately, by the input method,
11191it can add them to the beginning of `unread-command-events'.
11192
11193The input method function can find in `input-method-previous-method'
11194the previous echo area message.
11195
11196The input method function should refer to the variables
11197`input-method-use-echo-area' and `input-method-exit-on-first-char'
11198for guidance on what to do. */);
7d18f9ae 11199 Vinput_method_function = Qnil;
d5eecefb
RS
11200
11201 DEFVAR_LISP ("input-method-previous-message",
11202 &Vinput_method_previous_message,
4707d2d0
PJ
11203 doc: /* When `input-method-function' is called, hold the previous echo area message.
11204This variable exists because `read-event' clears the echo area
11205before running the input method. It is nil if there was no message. */);
d5eecefb 11206 Vinput_method_previous_message = Qnil;
7ee32cda
GM
11207
11208 DEFVAR_LISP ("show-help-function", &Vshow_help_function,
4707d2d0
PJ
11209 doc: /* If non-nil, the function that implements the display of help.
11210It's called with one argument, the help string to display. */);
7ee32cda 11211 Vshow_help_function = Qnil;
adf5cb9c
KH
11212
11213 DEFVAR_LISP ("disable-point-adjustment", &Vdisable_point_adjustment,
4707d2d0
PJ
11214 doc: /* If non-nil, suppress point adjustment after executing a command.
11215
11216After a command is executed, if point is moved into a region that has
11217special properties (e.g. composition, display), we adjust point to
11218the boundary of the region. But, several special commands sets this
11219variable to non-nil, then we suppress the point adjustment.
11220
11221This variable is set to nil before reading a command, and is checked
11222just after executing the command. */);
adf5cb9c
KH
11223 Vdisable_point_adjustment = Qnil;
11224
11225 DEFVAR_LISP ("global-disable-point-adjustment",
11226 &Vglobal_disable_point_adjustment,
4707d2d0
PJ
11227 doc: /* *If non-nil, always suppress point adjustment.
11228
11229The default value is nil, in which case, point adjustment are
11230suppressed only after special commands that set
11231`disable-point-adjustment' (which see) to non-nil. */);
adf5cb9c 11232 Vglobal_disable_point_adjustment = Qnil;
3626fb1a 11233
a1d34b1e 11234 DEFVAR_BOOL ("update-menu-bindings", &update_menu_bindings,
4707d2d0
PJ
11235 doc: /* Non-nil means updating menu bindings is allowed.
11236A value of nil means menu bindings should not be updated.
11237Used during Emacs' startup. */);
3626fb1a 11238 update_menu_bindings = 1;
00392ce6
MB
11239
11240 DEFVAR_LISP ("minibuffer-message-timeout", &Vminibuffer_message_timeout,
4707d2d0
PJ
11241 doc: /* *How long to display an echo-area message when the minibuffer is active.
11242If the value is not a number, such messages don't time out. */);
00392ce6 11243 Vminibuffer_message_timeout = make_number (2);
284f4730
JB
11244}
11245
dfcf069d 11246void
284f4730
JB
11247keys_of_keyboard ()
11248{
11249 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
11250 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
11251 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
11252 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
11253 initial_define_key (meta_map, 'x', "execute-extended-command");
7f07d5ca
RS
11254
11255 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
11256 "handle-delete-frame");
11257 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
11258 "ignore-event");
11259 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
11260 "ignore-event");
a4e19f6e
SM
11261 /* Handling it at such a low-level causes read_key_sequence to get
11262 * confused because it doesn't realize that the current_buffer was
11263 * changed by read_char.
11264 *
11265 * initial_define_lispy_key (Vspecial_event_map, "select-window",
11266 * "handle-select-window"); */
4ebc27a5
JD
11267 initial_define_lispy_key (Vspecial_event_map, "save-session",
11268 "handle-save-session");
284f4730 11269}
1269a761
SM
11270
11271/* Mark the pointers in the kboard objects.
11272 Called by the Fgarbage_collector. */
11273void
11274mark_kboards ()
11275{
11276 KBOARD *kb;
11277 Lisp_Object *p;
11278 for (kb = all_kboards; kb; kb = kb->next_kboard)
11279 {
11280 if (kb->kbd_macro_buffer)
11281 for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
3ebb8729
SM
11282 mark_object (*p);
11283 mark_object (kb->Voverriding_terminal_local_map);
11284 mark_object (kb->Vlast_command);
11285 mark_object (kb->Vreal_last_command);
11286 mark_object (kb->Vprefix_arg);
11287 mark_object (kb->Vlast_prefix_arg);
11288 mark_object (kb->kbd_queue);
11289 mark_object (kb->defining_kbd_macro);
11290 mark_object (kb->Vlast_kbd_macro);
11291 mark_object (kb->Vsystem_key_alist);
11292 mark_object (kb->system_key_syms);
11293 mark_object (kb->Vdefault_minibuffer_frame);
11294 mark_object (kb->echo_string);
1269a761
SM
11295 }
11296 {
11297 struct input_event *event;
11298 for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++)
11299 {
11300 if (event == kbd_buffer + KBD_BUFFER_SIZE)
11301 event = kbd_buffer;
3ebb8729
SM
11302 mark_object (event->x);
11303 mark_object (event->y);
11304 mark_object (event->frame_or_window);
11305 mark_object (event->arg);
1269a761
SM
11306 }
11307 }
11308}
ab5796a9
MB
11309
11310/* arch-tag: 774e34d7-6d31-42f3-8397-e079a4e4c9ca
11311 (do not change this comment) */