(x_make_frame_visible): Give dummy arg to
[bpt/emacs.git] / src / keyboard.c
CommitLineData
284f4730 1/* Keyboard and mouse input; editor command loop.
d925fb39 2 Copyright (C) 1985,86,87,88,89,93,94,95,96,97 Free Software Foundation, Inc.
284f4730
JB
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
7b4aedb9 8the Free Software Foundation; either version 2, or (at your option)
284f4730
JB
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */
284f4730
JB
20
21/* Allow config.h to undefine symbols found here. */
22#include <signal.h>
23
18160b98 24#include <config.h>
284f4730 25#include <stdio.h>
284f4730
JB
26#include "termchar.h"
27#include "termopts.h"
28#include "lisp.h"
29#include "termhooks.h"
30#include "macros.h"
ff11dfa1 31#include "frame.h"
284f4730
JB
32#include "window.h"
33#include "commands.h"
34#include "buffer.h"
37cd9f30 35#include "charset.h"
284f4730 36#include "disptab.h"
f4255cd1 37#include "dispextern.h"
284f4730 38#include "keyboard.h"
497ba7a1 39#include "intervals.h"
9ac0d9e0 40#include "blockinput.h"
284f4730
JB
41#include <setjmp.h>
42#include <errno.h>
43
80e4aa30
RS
44#ifdef MSDOS
45#include "msdos.h"
46#include <time.h>
47#else /* not MSDOS */
284f4730
JB
48#ifndef VMS
49#include <sys/ioctl.h>
284f4730 50#endif
80e4aa30 51#endif /* not MSDOS */
284f4730 52
52baf19e 53#include "syssignal.h"
6ef5b54f 54#include "systty.h"
52baf19e 55
c5e3b6c5
RS
56/* This is to get the definitions of the XK_ symbols. */
57#ifdef HAVE_X_WINDOWS
58#include "xterm.h"
59#endif
60
e98a93eb
GV
61#ifdef HAVE_NTGUI
62#include "w32term.h"
63#endif /* HAVE_NTGUI */
64
0c2611c5
RS
65/* Include systime.h after xterm.h to avoid double inclusion of time.h. */
66#include "systime.h"
67
52baf19e
JB
68extern int errno;
69
9ac0d9e0
JB
70/* Variables for blockinput.h: */
71
72/* Non-zero if interrupt input is blocked right now. */
63927c41 73int interrupt_input_blocked;
9ac0d9e0
JB
74
75/* Nonzero means an input interrupt has arrived
76 during the current critical section. */
63927c41 77int interrupt_input_pending;
9ac0d9e0
JB
78
79
437f6112
RS
80/* File descriptor to use for input. */
81extern int input_fd;
284f4730 82
e98a93eb 83#ifdef HAVE_WINDOW_SYSTEM
284f4730
JB
84/* Make all keyboard buffers much bigger when using X windows. */
85#define KBD_BUFFER_SIZE 4096
86#else /* No X-windows, character input */
87#define KBD_BUFFER_SIZE 256
88#endif /* No X-windows */
89
90/* Following definition copied from eval.c */
91
92struct backtrace
93 {
94 struct backtrace *next;
95 Lisp_Object *function;
96 Lisp_Object *args; /* Points to vector of args. */
97 int nargs; /* length of vector. If nargs is UNEVALLED,
98 args points to slot holding list of
99 unevalled args */
100 char evalargs;
101 };
102
c5fdd383
KH
103#ifdef MULTI_KBOARD
104KBOARD *initial_kboard;
105KBOARD *current_kboard;
106KBOARD *all_kboards;
1e8bd3da 107int single_kboard;
6c6083a9 108#else
c5fdd383 109KBOARD the_only_kboard;
6c6083a9 110#endif
612b78ef 111
284f4730
JB
112/* Non-nil disable property on a command means
113 do not execute it; call disabled-command-hook's value instead. */
2e894dab 114Lisp_Object Qdisabled, Qdisabled_command_hook;
284f4730
JB
115
116#define NUM_RECENT_KEYS (100)
117int recent_keys_index; /* Index for storing next element into recent_keys */
118int total_keys; /* Total number of elements stored into recent_keys */
5160df46 119Lisp_Object recent_keys; /* A vector, holding the last 100 keystrokes */
284f4730 120
6569cc8d
JB
121/* Vector holding the key sequence that invoked the current command.
122 It is reused for each command, and it may be longer than the current
123 sequence; this_command_key_count indicates how many elements
124 actually mean something.
125 It's easier to staticpro a single Lisp_Object than an array. */
126Lisp_Object this_command_keys;
127int this_command_key_count;
284f4730 128
6321824f
RS
129/* Number of elements of this_command_keys
130 that precede this key sequence. */
131int this_single_command_key_start;
132
71918b75
RS
133/* Record values of this_command_key_count and echo_length ()
134 before this command was read. */
135static int before_command_key_count;
136static int before_command_echo_length;
137/* Values of before_command_key_count and before_command_echo_length
138 saved by reset-this-command-lengths. */
139static int before_command_key_count_1;
140static int before_command_echo_length_1;
141/* Flag set by reset-this-command-lengths,
142 saying to reset the lengths when add_command_key is called. */
143static int before_command_restore_flag;
144
284f4730
JB
145extern int minbuf_level;
146
147extern struct backtrace *backtrace_list;
148
149/* Nonzero means do menu prompting. */
150static int menu_prompting;
151
152/* Character to see next line of menu prompt. */
153static Lisp_Object menu_prompt_more_char;
154
155/* For longjmp to where kbd input is being done. */
156static jmp_buf getcjmp;
157
158/* True while doing kbd input. */
159int waiting_for_input;
160
161/* True while displaying for echoing. Delays C-g throwing. */
162static int echoing;
163
1fc93d49
RS
164/* True means we can start echoing at the next input pause
165 even though there is something in the echo area. */
0c04a67e 166static char *ok_to_echo_at_next_pause;
1fc93d49 167
03361bcc
RS
168/* Nonzero means disregard local maps for the menu bar. */
169static int inhibit_local_menu_bar_menus;
170
80e4aa30 171/* Nonzero means C-g should cause immediate error-signal. */
284f4730
JB
172int immediate_quit;
173
fa90970d
RS
174/* The user's ERASE setting. */
175Lisp_Object Vtty_erase_char;
176
284f4730 177/* Character to recognize as the help char. */
7e85b935 178Lisp_Object Vhelp_char;
284f4730 179
ecb7cb34
KH
180/* List of other event types to recognize as meaning "help". */
181Lisp_Object Vhelp_event_list;
182
284f4730
JB
183/* Form to execute when help char is typed. */
184Lisp_Object Vhelp_form;
185
7e85b935
RS
186/* Command to run when the help character follows a prefix key. */
187Lisp_Object Vprefix_help_command;
188
9f9c0e27
RS
189/* List of items that should move to the end of the menu bar. */
190Lisp_Object Vmenu_bar_final_items;
a73c5e29 191
6526ab49
RS
192/* Non-nil means show the equivalent key-binding for
193 any M-x command that has one.
194 The value can be a length of time to show the message for.
195 If the value is non-nil and not a number, we wait 2 seconds. */
196Lisp_Object Vsuggest_key_bindings;
197
284f4730
JB
198/* Character that causes a quit. Normally C-g.
199
200 If we are running on an ordinary terminal, this must be an ordinary
201 ASCII char, since we want to make it our interrupt character.
202
203 If we are not running on an ordinary terminal, it still needs to be
204 an ordinary ASCII char. This character needs to be recognized in
205 the input interrupt handler. At this point, the keystroke is
206 represented as a struct input_event, while the desired quit
207 character is specified as a lispy event. The mapping from struct
208 input_events to lispy events cannot run in an interrupt handler,
209 and the reverse mapping is difficult for anything but ASCII
210 keystrokes.
211
212 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
213 ASCII character. */
214int quit_char;
215
216extern Lisp_Object current_global_map;
217extern int minibuf_level;
218
9dd3131c
RS
219/* If non-nil, this is a map that overrides all other local maps. */
220Lisp_Object Voverriding_local_map;
221
d0a49716
RS
222/* If non-nil, Voverriding_local_map applies to the menu bar. */
223Lisp_Object Voverriding_local_map_menu_flag;
224
7f07d5ca
RS
225/* Keymap that defines special misc events that should
226 be processed immediately at a low level. */
227Lisp_Object Vspecial_event_map;
228
284f4730
JB
229/* Current depth in recursive edits. */
230int command_loop_level;
231
232/* Total number of times command_loop has read a key sequence. */
233int num_input_keys;
234
235/* Last input character read as a command. */
236Lisp_Object last_command_char;
237
7d6de002
RS
238/* Last input character read as a command, not counting menus
239 reached by the mouse. */
240Lisp_Object last_nonmenu_event;
241
284f4730
JB
242/* Last input character read for any purpose. */
243Lisp_Object last_input_char;
244
dbc4e1c1 245/* If not Qnil, a list of objects to be read as subsequent command input. */
24597608 246Lisp_Object Vunread_command_events;
284f4730 247
86e5706b
RS
248/* If not -1, an event to be read as subsequent command input. */
249int unread_command_char;
250
cd21b839
JB
251/* If not Qnil, this is a switch-frame event which we decided to put
252 off until the end of a key sequence. This should be read as the
dbc4e1c1 253 next command input, after any unread_command_events.
8f805655
JB
254
255 read_key_sequence uses this to delay switch-frame events until the
256 end of the key sequence; Fread_char uses it to put off switch-frame
257 events until a non-ASCII event is acceptable as input. */
258Lisp_Object unread_switch_frame;
cd21b839 259
9fa4395d
RS
260/* A mask of extra modifier bits to put into every keyboard char. */
261int extra_keyboard_modifiers;
262
284f4730
JB
263/* Char to use as prefix when a meta character is typed in.
264 This is bound on entry to minibuffer in case ESC is changed there. */
265
266Lisp_Object meta_prefix_char;
267
268/* Last size recorded for a current buffer which is not a minibuffer. */
269static int last_non_minibuf_size;
270
06ef7355 271/* Number of idle seconds before an auto-save and garbage collection. */
284f4730
JB
272static Lisp_Object Vauto_save_timeout;
273
274/* Total number of times read_char has returned. */
4abfba1f 275int num_input_events;
284f4730 276
51172b6d 277/* Total number of times read_char has returned, outside of macros. */
c43b1734 278int num_nonmacro_input_events;
51172b6d 279
284f4730
JB
280/* Auto-save automatically when this many characters have been typed
281 since the last time. */
282
283static int auto_save_interval;
284
c43b1734 285/* Value of num_nonmacro_input_events as of last auto save. */
284f4730
JB
286
287int last_auto_save;
288
284f4730 289/* The command being executed by the command loop.
6c7178b9
KH
290 Commands may set this, and the value set will be copied into
291 current_kboard->Vlast_command instead of the actual command. */
284f4730
JB
292Lisp_Object this_command;
293
b453f72e
KH
294/* The value of point when the last command was executed. */
295int last_point_position;
296
047688cb
RS
297/* The buffer that was current when the last command was started. */
298Lisp_Object last_point_position_buffer;
299
4c52b668
KH
300/* The frame in which the last input event occurred, or Qmacro if the
301 last event came from a macro. We use this to determine when to
302 generate switch-frame events. This may be cleared by functions
303 like Fselect_frame, to make sure that a switch-frame event is
304 generated by the next character. */
305Lisp_Object internal_last_event_frame;
4c52b668
KH
306
307/* A user-visible version of the above, intended to allow users to
308 figure out where the last event came from, if the event doesn't
309 carry that information itself (i.e. if it was a character). */
310Lisp_Object Vlast_event_frame;
311
1113d9db
JB
312/* The timestamp of the last input event we received from the X server.
313 X Windows wants this for selection ownership. */
284f4730
JB
314unsigned long last_event_timestamp;
315
316Lisp_Object Qself_insert_command;
317Lisp_Object Qforward_char;
318Lisp_Object Qbackward_char;
e58aa385 319Lisp_Object Qundefined;
d925fb39 320Lisp_Object Qtimer_event_handler;
284f4730
JB
321
322/* read_key_sequence stores here the command definition of the
323 key sequence that it reads. */
324Lisp_Object read_key_sequence_cmd;
325
326/* Form to evaluate (if non-nil) when Emacs is started. */
327Lisp_Object Vtop_level;
328
329/* User-supplied string to translate input characters through. */
330Lisp_Object Vkeyboard_translate_table;
331
332/* Keymap mapping ASCII function key sequences onto their preferred forms. */
333extern Lisp_Object Vfunction_key_map;
334
e0301c07
RS
335/* Another keymap that maps key sequences into key sequences.
336 This one takes precedence over ordinary definitions. */
337extern Lisp_Object Vkey_translation_map;
a612e298 338
86e5706b
RS
339/* Non-nil means deactivate the mark at end of this command. */
340Lisp_Object Vdeactivate_mark;
341
48e416d4
RS
342/* Menu bar specified in Lucid Emacs fashion. */
343
344Lisp_Object Vlucid_menu_bar_dirty_flag;
345Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
346
cdb9d665
RS
347Lisp_Object Qecho_area_clear_hook;
348
86e5706b 349/* Hooks to run before and after each command. */
59aadc81
RS
350Lisp_Object Qpre_command_hook, Vpre_command_hook;
351Lisp_Object Qpost_command_hook, Vpost_command_hook;
40932d1a 352Lisp_Object Qcommand_hook_internal, Vcommand_hook_internal;
59aadc81
RS
353/* Hook run after a command if there's no more input soon. */
354Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
355
356/* Delay time in microseconds before running post-command-idle-hook. */
357int post_command_idle_delay;
86e5706b 358
8a792f3a
RS
359/* List of deferred actions to be performed at a later time.
360 The precise format isn't relevant here; we just check whether it is nil. */
361Lisp_Object Vdeferred_action_list;
362
363/* Function to call to handle deferred actions, when there are any. */
364Lisp_Object Vdeferred_action_function;
3ef14e46 365Lisp_Object Qdeferred_action_function;
8a792f3a 366
284f4730
JB
367/* File in which we write all commands we read. */
368FILE *dribble;
369
370/* Nonzero if input is available. */
371int input_pending;
372
b04904fb
RS
373/* 1 if should obey 0200 bit in input chars as "Meta", 2 if should
374 keep 0200 bit in input chars. 0 to ignore the 0200 bit. */
375
284f4730
JB
376int meta_key;
377
378extern char *pending_malloc_warning;
379
beecf6a1
KH
380/* Circular buffer for pre-read keyboard input. */
381static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
382
383/* Vector to GCPRO the frames and windows mentioned in kbd_buffer.
384
385 The interrupt-level event handlers will never enqueue an event on a
386 frame which is not in Vframe_list, and once an event is dequeued,
387 internal_last_event_frame or the event itself points to the frame.
388 So that's all fine.
389
390 But while the event is sitting in the queue, it's completely
391 unprotected. Suppose the user types one command which will run for
392 a while and then delete a frame, and then types another event at
393 the frame that will be deleted, before the command gets around to
394 it. Suppose there are no references to this frame elsewhere in
395 Emacs, and a GC occurs before the second event is dequeued. Now we
396 have an event referring to a freed frame, which will crash Emacs
397 when it is dequeued.
398
399 Similar things happen when an event on a scroll bar is enqueued; the
400 window may be deleted while the event is in the queue.
401
402 So, we use this vector to protect the frame_or_window field in the
403 event queue. That way, they'll be dequeued as dead frames or
404 windows, but still valid lisp objects.
405
406 If kbd_buffer[i].kind != no_event, then
407 (XVECTOR (kbd_buffer_frame_or_window)->contents[i]
408 == kbd_buffer[i].frame_or_window. */
409static Lisp_Object kbd_buffer_frame_or_window;
410
411/* Pointer to next available character in kbd_buffer.
412 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
413 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the the
414 next available char is in kbd_buffer[0]. */
415static struct input_event *kbd_fetch_ptr;
416
417/* Pointer to next place to store character in kbd_buffer. This
418 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
419 character should go in kbd_buffer[0]. */
420static volatile struct input_event *kbd_store_ptr;
421
422/* The above pair of variables forms a "queue empty" flag. When we
423 enqueue a non-hook event, we increment kbd_store_ptr. When we
424 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
425 there is input available iff the two pointers are not equal.
426
427 Why not just have a flag set and cleared by the enqueuing and
428 dequeuing functions? Such a flag could be screwed up by interrupts
429 at inopportune times. */
430
f3253854 431/* If this flag is non-nil, we check mouse_moved to see when the
a9d77f1f
RS
432 mouse moves, and motion events will appear in the input stream.
433 Otherwise, mouse motion is ignored. */
434static Lisp_Object do_mouse_tracking;
284f4730 435
284f4730
JB
436/* Symbols to head events. */
437Lisp_Object Qmouse_movement;
3c370943 438Lisp_Object Qscroll_bar_movement;
cd21b839 439Lisp_Object Qswitch_frame;
bbdc2092 440Lisp_Object Qdelete_frame;
af17bd2b
KH
441Lisp_Object Qiconify_frame;
442Lisp_Object Qmake_frame_visible;
cd21b839 443
284f4730
JB
444/* Symbols to denote kinds of events. */
445Lisp_Object Qfunction_key;
446Lisp_Object Qmouse_click;
07de30b9
GV
447#ifdef WINDOWSNT
448Lisp_Object Qmouse_wheel;
449#endif
284f4730 450/* Lisp_Object Qmouse_movement; - also an event header */
284f4730
JB
451
452/* Properties of event headers. */
453Lisp_Object Qevent_kind;
88cb0656 454Lisp_Object Qevent_symbol_elements;
284f4730 455
598a9fa7
JB
456Lisp_Object Qmenu_enable;
457
0a7f1fc0
JB
458/* An event header symbol HEAD may have a property named
459 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
460 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
461 mask of modifiers applied to it. If present, this is used to help
462 speed up parse_modifiers. */
463Lisp_Object Qevent_symbol_element_mask;
464
465/* An unmodified event header BASE may have a property named
466 Qmodifier_cache, which is an alist mapping modifier masks onto
467 modified versions of BASE. If present, this helps speed up
468 apply_modifiers. */
469Lisp_Object Qmodifier_cache;
470
5ec75a55 471/* Symbols to use for parts of windows. */
284f4730 472Lisp_Object Qmode_line;
e5d77022 473Lisp_Object Qvertical_line;
3c370943 474Lisp_Object Qvertical_scroll_bar;
5ec75a55
RS
475Lisp_Object Qmenu_bar;
476
477extern Lisp_Object Qmenu_enable;
284f4730 478
f4255cd1
JB
479Lisp_Object recursive_edit_unwind (), command_loop ();
480Lisp_Object Fthis_command_keys ();
03b4122a 481Lisp_Object Qextended_command_history;
c04cbc3b 482EMACS_TIME timer_check ();
284f4730 483
2c834fb3
KH
484extern char *x_get_keysym_name ();
485
8eb4d8ef
RS
486static void record_menu_key ();
487
6e4e64a8
RS
488void swallow_events ();
489
f4eef8b4
RS
490Lisp_Object Qpolling_period;
491
d9d4c147 492/* List of absolute timers. Appears in order of next scheduled event. */
c04cbc3b
RS
493Lisp_Object Vtimer_list;
494
d9d4c147
KH
495/* List of idle time timers. Appears in order of next scheduled event. */
496Lisp_Object Vtimer_idle_list;
497
87dd9b9b
RS
498/* Incremented whenever a timer is run. */
499int timers_run;
500
a9f16aa9
KH
501extern Lisp_Object Vprint_level, Vprint_length;
502
e3ee7487
RS
503extern nonascii_insert_offset;
504
ffd56f97
JB
505/* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
506 happens. */
507EMACS_TIME *input_available_clear_time;
284f4730
JB
508
509/* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
510 Default is 1 if INTERRUPT_INPUT is defined. */
511int interrupt_input;
512
513/* Nonzero while interrupts are temporarily deferred during redisplay. */
514int interrupts_deferred;
515
87dd9b9b 516/* Nonzero means use ^S/^Q for flow control. */
284f4730
JB
517int flow_control;
518
284f4730
JB
519/* Allow m- file to inhibit use of FIONREAD. */
520#ifdef BROKEN_FIONREAD
521#undef FIONREAD
522#endif
523
524/* We are unable to use interrupts if FIONREAD is not available,
525 so flush SIGIO so we won't try. */
526#ifndef FIONREAD
527#ifdef SIGIO
528#undef SIGIO
529#endif
530#endif
531
e98a93eb 532/* If we support a window system, turn on the code to poll periodically
34f04431 533 to detect C-g. It isn't actually used when doing interrupt input. */
e98a93eb 534#ifdef HAVE_WINDOW_SYSTEM
284f4730
JB
535#define POLL_FOR_INPUT
536#endif
284f4730
JB
537\f
538/* Global variable declarations. */
539
540/* Function for init_keyboard to call with no args (if nonzero). */
541void (*keyboard_init_hook) ();
542
543static int read_avail_input ();
544static void get_input_pending ();
9fd7d808 545static int readable_events ();
8150596a
RS
546static Lisp_Object read_char_x_menu_prompt ();
547static Lisp_Object read_char_minibuf_menu_prompt ();
a612e298 548static Lisp_Object make_lispy_event ();
514354e9 549#ifdef HAVE_MOUSE
a612e298 550static Lisp_Object make_lispy_movement ();
514354e9 551#endif
a612e298
RS
552static Lisp_Object modify_event_symbol ();
553static Lisp_Object make_lispy_switch_frame ();
3d31316f 554static int parse_solitary_modifier ();
284f4730
JB
555
556/* > 0 if we are to echo keystrokes. */
557static int echo_keystrokes;
558
8026024c
KH
559/* Nonzero means don't try to suspend even if the operating system seems
560 to support it. */
561static int cannot_suspend;
562
284f4730
JB
563#define min(a,b) ((a)<(b)?(a):(b))
564#define max(a,b) ((a)>(b)?(a):(b))
565
566/* Install the string STR as the beginning of the string of echoing,
567 so that it serves as a prompt for the next character.
568 Also start echoing. */
569
570echo_prompt (str)
571 char *str;
572{
573 int len = strlen (str);
7a80a6f6 574
ba72822c
KH
575 if (len > ECHOBUFSIZE - 4)
576 len = ECHOBUFSIZE - 4;
c5fdd383
KH
577 bcopy (str, current_kboard->echobuf, len);
578 current_kboard->echoptr = current_kboard->echobuf + len;
579 *current_kboard->echoptr = '\0';
284f4730 580
c5fdd383 581 current_kboard->echo_after_prompt = len;
7a80a6f6 582
3dbd9ee4 583 echo_now ();
284f4730
JB
584}
585
df0f2ba1 586/* Add C to the echo string, if echoing is going on.
284f4730
JB
587 C can be a character, which is printed prettily ("M-C-x" and all that
588 jazz), or a symbol, whose name is printed. */
589
590echo_char (c)
591 Lisp_Object c;
592{
593 extern char *push_key_description ();
594
c5fdd383 595 if (current_kboard->immediate_echo)
284f4730 596 {
c5fdd383 597 char *ptr = current_kboard->echoptr;
df0f2ba1 598
c5fdd383 599 if (ptr != current_kboard->echobuf)
284f4730
JB
600 *ptr++ = ' ';
601
602 /* If someone has passed us a composite event, use its head symbol. */
88cb0656 603 c = EVENT_HEAD (c);
284f4730 604
8c18cbfb 605 if (INTEGERP (c))
284f4730 606 {
c5fdd383 607 if (ptr - current_kboard->echobuf > ECHOBUFSIZE - 6)
284f4730
JB
608 return;
609
cb5df6ae 610 ptr = push_key_description (XINT (c), ptr);
284f4730 611 }
8c18cbfb 612 else if (SYMBOLP (c))
284f4730
JB
613 {
614 struct Lisp_String *name = XSYMBOL (c)->name;
c5fdd383 615 if ((ptr - current_kboard->echobuf) + name->size + 4 > ECHOBUFSIZE)
284f4730
JB
616 return;
617 bcopy (name->data, ptr, name->size);
618 ptr += name->size;
619 }
620
c5fdd383 621 if (current_kboard->echoptr == current_kboard->echobuf
ecb7cb34 622 && help_char_p (c))
284f4730
JB
623 {
624 strcpy (ptr, " (Type ? for further options)");
625 ptr += strlen (ptr);
626 }
627
628 *ptr = 0;
c5fdd383 629 current_kboard->echoptr = ptr;
284f4730 630
3dbd9ee4 631 echo_now ();
284f4730
JB
632 }
633}
634
635/* Temporarily add a dash to the end of the echo string if it's not
636 empty, so that it serves as a mini-prompt for the very next character. */
637
638echo_dash ()
639{
c5fdd383
KH
640 if (!current_kboard->immediate_echo
641 && current_kboard->echoptr == current_kboard->echobuf)
284f4730 642 return;
7a80a6f6 643 /* Do nothing if we just printed a prompt. */
c5fdd383
KH
644 if (current_kboard->echo_after_prompt
645 == current_kboard->echoptr - current_kboard->echobuf)
7a80a6f6 646 return;
4bafa972 647 /* Do nothing if not echoing at all. */
c5fdd383 648 if (current_kboard->echoptr == 0)
4bafa972 649 return;
284f4730
JB
650
651 /* Put a dash at the end of the buffer temporarily,
652 but make it go away when the next character is added. */
c5fdd383
KH
653 current_kboard->echoptr[0] = '-';
654 current_kboard->echoptr[1] = 0;
284f4730 655
3dbd9ee4 656 echo_now ();
284f4730
JB
657}
658
659/* Display the current echo string, and begin echoing if not already
660 doing so. */
661
3dbd9ee4 662echo_now ()
284f4730 663{
c5fdd383 664 if (!current_kboard->immediate_echo)
284f4730
JB
665 {
666 int i;
c5fdd383 667 current_kboard->immediate_echo = 1;
284f4730
JB
668
669 for (i = 0; i < this_command_key_count; i++)
d0a57728
RS
670 {
671 Lisp_Object c;
672 c = XVECTOR (this_command_keys)->contents[i];
673 if (! (EVENT_HAS_PARAMETERS (c)
674 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
675 echo_char (c);
676 }
284f4730
JB
677 echo_dash ();
678 }
679
680 echoing = 1;
c5fdd383 681 message1_nolog (current_kboard->echobuf);
284f4730
JB
682 echoing = 0;
683
684 if (waiting_for_input && !NILP (Vquit_flag))
685 quit_throw_to_read_char ();
686}
687
688/* Turn off echoing, for the start of a new command. */
689
690cancel_echoing ()
691{
c5fdd383
KH
692 current_kboard->immediate_echo = 0;
693 current_kboard->echoptr = current_kboard->echobuf;
694 current_kboard->echo_after_prompt = -1;
1fc93d49 695 ok_to_echo_at_next_pause = 0;
284f4730
JB
696}
697
698/* Return the length of the current echo string. */
699
700static int
701echo_length ()
702{
c5fdd383 703 return current_kboard->echoptr - current_kboard->echobuf;
284f4730
JB
704}
705
706/* Truncate the current echo message to its first LEN chars.
707 This and echo_char get used by read_key_sequence when the user
ff11dfa1 708 switches frames while entering a key sequence. */
284f4730
JB
709
710static void
711echo_truncate (len)
712 int len;
713{
c5fdd383
KH
714 current_kboard->echobuf[len] = '\0';
715 current_kboard->echoptr = current_kboard->echobuf + len;
40932d1a 716 truncate_echo_area (len);
284f4730
JB
717}
718
719\f
720/* Functions for manipulating this_command_keys. */
721static void
722add_command_key (key)
723 Lisp_Object key;
724{
6569cc8d
JB
725 int size = XVECTOR (this_command_keys)->size;
726
71918b75
RS
727 /* If reset-this-command-length was called recently, obey it now.
728 See the doc string of that function for an explanation of why. */
729 if (before_command_restore_flag)
730 {
731 this_command_key_count = before_command_key_count_1;
6321824f
RS
732 if (this_command_key_count < this_single_command_key_start)
733 this_single_command_key_start = this_command_key_count;
71918b75
RS
734 echo_truncate (before_command_echo_length_1);
735 before_command_restore_flag = 0;
736 }
737
6569cc8d 738 if (this_command_key_count >= size)
284f4730 739 {
9b8eb840 740 Lisp_Object new_keys;
6569cc8d 741
9b8eb840 742 new_keys = Fmake_vector (make_number (size * 2), Qnil);
6569cc8d
JB
743 bcopy (XVECTOR (this_command_keys)->contents,
744 XVECTOR (new_keys)->contents,
8f805655 745 size * sizeof (Lisp_Object));
6569cc8d
JB
746
747 this_command_keys = new_keys;
284f4730 748 }
6569cc8d
JB
749
750 XVECTOR (this_command_keys)->contents[this_command_key_count++] = key;
284f4730
JB
751}
752\f
753Lisp_Object
754recursive_edit_1 ()
755{
756 int count = specpdl_ptr - specpdl;
757 Lisp_Object val;
758
759 if (command_loop_level > 0)
760 {
761 specbind (Qstandard_output, Qt);
762 specbind (Qstandard_input, Qt);
763 }
764
765 val = command_loop ();
766 if (EQ (val, Qt))
767 Fsignal (Qquit, Qnil);
cb252880
RS
768 /* Handle throw from read_minibuf when using minibuffer
769 while it's active but we're in another window. */
770 if (STRINGP (val))
771 Fsignal (Qerror, Fcons (val, Qnil));
284f4730 772
cb5df6ae 773 return unbind_to (count, Qnil);
284f4730
JB
774}
775
776/* When an auto-save happens, record the "time", and don't do again soon. */
5846638c 777
284f4730
JB
778record_auto_save ()
779{
c43b1734 780 last_auto_save = num_nonmacro_input_events;
284f4730 781}
5846638c
RS
782
783/* Make an auto save happen as soon as possible at command level. */
784
785force_auto_save_soon ()
786{
787 last_auto_save = - auto_save_interval - 1;
241ceaf7
RS
788
789 record_asynch_buffer_change ();
5846638c 790}
284f4730 791\f
284f4730
JB
792DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
793 "Invoke the editor command loop recursively.\n\
794To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
795that tells this function to return.\n\
796Alternately, `(throw 'exit t)' makes this function signal an error.\n\
797This function is called by the editor initialization to begin editing.")
798 ()
799{
800 int count = specpdl_ptr - specpdl;
801 Lisp_Object val;
802
803 command_loop_level++;
804 update_mode_lines = 1;
805
806 record_unwind_protect (recursive_edit_unwind,
807 (command_loop_level
808 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
809 ? Fcurrent_buffer ()
810 : Qnil);
811 recursive_edit_1 ();
812 return unbind_to (count, Qnil);
813}
814
815Lisp_Object
816recursive_edit_unwind (buffer)
817 Lisp_Object buffer;
818{
819 if (!NILP (buffer))
820 Fset_buffer (buffer);
821
822 command_loop_level--;
823 update_mode_lines = 1;
824 return Qnil;
825}
826\f
604ccd1d 827static void
1e8bd3da 828any_kboard_state ()
604ccd1d 829{
1e8bd3da
RS
830#ifdef MULTI_KBOARD
831#if 0 /* Theory: if there's anything in Vunread_command_events,
832 it will right away be read by read_key_sequence,
833 and then if we do switch KBOARDS, it will go into the side
834 queue then. So we don't need to do anything special here -- rms. */
604ccd1d 835 if (CONSP (Vunread_command_events))
4524b161 836 {
c5fdd383
KH
837 current_kboard->kbd_queue
838 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
839 current_kboard->kbd_queue_has_data = 1;
4524b161 840 }
604ccd1d 841 Vunread_command_events = Qnil;
1e8bd3da
RS
842#endif
843 single_kboard = 0;
844#endif
604ccd1d 845}
1e8bd3da
RS
846
847/* Switch to the single-kboard state, making current_kboard
848 the only KBOARD from which further input is accepted. */
849
850void
851single_kboard_state ()
852{
853#ifdef MULTI_KBOARD
854 single_kboard = 1;
604ccd1d 855#endif
1e8bd3da
RS
856}
857
858/* Maintain a stack of kboards, so other parts of Emacs
859 can switch temporarily to the kboard of a given frame
860 and then revert to the previous status. */
861
862struct kboard_stack
863{
864 KBOARD *kboard;
865 struct kboard_stack *next;
866};
867
868static struct kboard_stack *kboard_stack;
869
870void
871push_frame_kboard (f)
872 FRAME_PTR f;
873{
ab48365b 874#ifdef MULTI_KBOARD
1e8bd3da
RS
875 struct kboard_stack *p
876 = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
877
878 p->next = kboard_stack;
879 p->kboard = current_kboard;
880 kboard_stack = p;
881
882 current_kboard = FRAME_KBOARD (f);
ab48365b 883#endif
1e8bd3da
RS
884}
885
886void
887pop_frame_kboard ()
888{
ab48365b 889#ifdef MULTI_KBOARD
1e8bd3da
RS
890 struct kboard_stack *p = kboard_stack;
891 current_kboard = p->kboard;
892 kboard_stack = p->next;
893 xfree (p);
ab48365b 894#endif
1e8bd3da
RS
895}
896\f
897/* Handle errors that are not handled at inner levels
898 by printing an error message and returning to the editor command loop. */
604ccd1d 899
284f4730
JB
900Lisp_Object
901cmd_error (data)
902 Lisp_Object data;
a1341f75 903{
a9f16aa9 904 Lisp_Object old_level, old_length;
e881d8b2
RS
905 char macroerror[50];
906
907 if (!NILP (executing_macro))
908 {
909 if (executing_macro_iterations == 1)
910 sprintf (macroerror, "After 1 kbd macro iteration: ");
911 else
912 sprintf (macroerror, "After %d kbd macro iterations: ",
913 executing_macro_iterations);
914 }
915 else
916 *macroerror = 0;
a9f16aa9 917
a1341f75
RS
918 Vstandard_output = Qt;
919 Vstandard_input = Qt;
920 Vexecuting_macro = Qnil;
9f58e89e 921 executing_macro = Qnil;
d8bcf58e 922 current_kboard->Vprefix_arg = Qnil;
df0f2ba1 923 cancel_echoing ();
a9f16aa9
KH
924
925 /* Avoid unquittable loop if data contains a circular list. */
926 old_level = Vprint_level;
927 old_length = Vprint_length;
0c04a67e
RS
928 XSETFASTINT (Vprint_level, 10);
929 XSETFASTINT (Vprint_length, 10);
e881d8b2 930 cmd_error_internal (data, macroerror);
a9f16aa9
KH
931 Vprint_level = old_level;
932 Vprint_length = old_length;
a1341f75
RS
933
934 Vquit_flag = Qnil;
935
936 Vinhibit_quit = Qnil;
c5fdd383 937#ifdef MULTI_KBOARD
1e8bd3da 938 any_kboard_state ();
ff4b06d3 939#endif
a1341f75
RS
940
941 return make_number (0);
942}
943
944cmd_error_internal (data, context)
945 Lisp_Object data;
946 char *context;
284f4730 947{
284f4730 948 Lisp_Object stream;
284f4730
JB
949
950 Vquit_flag = Qnil;
951 Vinhibit_quit = Qt;
284f4730
JB
952 echo_area_glyphs = 0;
953
ff11dfa1 954 /* If the window system or terminal frame hasn't been initialized
284f4730
JB
955 yet, or we're not interactive, it's best to dump this message out
956 to stderr and exit. */
ff11dfa1 957 if (! FRAME_MESSAGE_BUF (selected_frame)
284f4730
JB
958 || noninteractive)
959 stream = Qexternal_debugging_output;
960 else
961 {
962 Fdiscard_input ();
963 bitch_at_user ();
964 stream = Qt;
965 }
966
a1341f75
RS
967 if (context != 0)
968 write_string_1 (context, -1, stream);
969
22a51344 970 print_error_message (data, stream);
284f4730 971
ff11dfa1 972 /* If the window system or terminal frame hasn't been initialized
284f4730 973 yet, or we're in -batch mode, this error should cause Emacs to exit. */
ff11dfa1 974 if (! FRAME_MESSAGE_BUF (selected_frame)
284f4730
JB
975 || noninteractive)
976 {
977 Fterpri (stream);
978 Fkill_emacs (make_number (-1));
979 }
284f4730
JB
980}
981\f
982Lisp_Object command_loop_1 ();
983Lisp_Object command_loop_2 ();
984Lisp_Object top_level_1 ();
985
986/* Entry to editor-command-loop.
987 This level has the catches for exiting/returning to editor command loop.
988 It returns nil to exit recursive edit, t to abort it. */
989
990Lisp_Object
991command_loop ()
992{
993 if (command_loop_level > 0 || minibuf_level > 0)
994 {
995 return internal_catch (Qexit, command_loop_2, Qnil);
996 }
997 else
998 while (1)
999 {
1000 internal_catch (Qtop_level, top_level_1, Qnil);
1001 internal_catch (Qtop_level, command_loop_2, Qnil);
df0f2ba1 1002
284f4730
JB
1003 /* End of file in -batch run causes exit here. */
1004 if (noninteractive)
1005 Fkill_emacs (Qt);
1006 }
1007}
1008
1009/* Here we catch errors in execution of commands within the
1010 editing loop, and reenter the editing loop.
1011 When there is an error, cmd_error runs and returns a non-nil
1012 value to us. A value of nil means that cmd_loop_1 itself
1013 returned due to end of file (or end of kbd macro). */
1014
1015Lisp_Object
1016command_loop_2 ()
1017{
1018 register Lisp_Object val;
1019
1020 do
1021 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1022 while (!NILP (val));
1023
1024 return Qnil;
1025}
1026
1027Lisp_Object
1028top_level_2 ()
1029{
1030 return Feval (Vtop_level);
1031}
1032
1033Lisp_Object
1034top_level_1 ()
1035{
1036 /* On entry to the outer level, run the startup file */
1037 if (!NILP (Vtop_level))
1038 internal_condition_case (top_level_2, Qerror, cmd_error);
1039 else if (!NILP (Vpurify_flag))
1040 message ("Bare impure Emacs (standard Lisp code not loaded)");
1041 else
1042 message ("Bare Emacs (standard Lisp code not loaded)");
1043 return Qnil;
1044}
1045
1046DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1047 "Exit all recursive editing levels.")
1048 ()
1049{
1050 Fthrow (Qtop_level, Qnil);
1051}
1052
1053DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1054 "Exit from the innermost recursive edit or minibuffer.")
1055 ()
1056{
1057 if (command_loop_level > 0 || minibuf_level > 0)
1058 Fthrow (Qexit, Qnil);
1059
1060 error ("No recursive edit is in progress");
1061}
1062
1063DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1064 "Abort the command that requested this recursive edit or minibuffer input.")
1065 ()
1066{
1067 if (command_loop_level > 0 || minibuf_level > 0)
1068 Fthrow (Qexit, Qt);
1069
1070 error ("No recursive edit is in progress");
1071}
1072\f
1073/* This is the actual command reading loop,
1074 sans error-handling encapsulation. */
1075
1076Lisp_Object Fcommand_execute ();
1077static int read_key_sequence ();
68f297c5 1078void safe_run_hooks ();
284f4730
JB
1079
1080Lisp_Object
1081command_loop_1 ()
1082{
48e416d4 1083 Lisp_Object cmd, tem;
37cd9f30 1084 int lose, lose2;
284f4730
JB
1085 int nonundocount;
1086 Lisp_Object keybuf[30];
1087 int i;
1088 int no_redisplay;
1089 int no_direct;
86e5706b
RS
1090 int prev_modiff;
1091 struct buffer *prev_buffer;
c5fdd383 1092#ifdef MULTI_KBOARD
1e8bd3da 1093 int was_locked = single_kboard;
bded54dd 1094#endif
284f4730 1095
d9b641bb 1096 current_kboard->Vprefix_arg = Qnil;
86e5706b 1097 Vdeactivate_mark = Qnil;
284f4730 1098 waiting_for_input = 0;
df0f2ba1 1099 cancel_echoing ();
284f4730 1100
284f4730
JB
1101 nonundocount = 0;
1102 no_redisplay = 0;
1103 this_command_key_count = 0;
6321824f 1104 this_single_command_key_start = 0;
284f4730 1105
a612e298
RS
1106 /* Make sure this hook runs after commands that get errors and
1107 throw to top level. */
a98ea3f9
RS
1108 /* Note that the value cell will never directly contain nil
1109 if the symbol is a local variable. */
e98a93eb 1110 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
a98ea3f9 1111 safe_run_hooks (Qpost_command_hook);
a612e298 1112
8a792f3a
RS
1113 if (!NILP (Vdeferred_action_list))
1114 call0 (Vdeferred_action_function);
1115
e98a93eb 1116 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
59aadc81
RS
1117 {
1118 if (NILP (Vunread_command_events)
1119 && NILP (Vexecuting_macro)
41365083 1120 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
59aadc81
RS
1121 safe_run_hooks (Qpost_command_idle_hook);
1122 }
1123
51d5a2c9 1124 /* Do this after running Vpost_command_hook, for consistency. */
6c7178b9 1125 current_kboard->Vlast_command = this_command;
51d5a2c9 1126
284f4730
JB
1127 while (1)
1128 {
284f4730
JB
1129 /* Make sure the current window's buffer is selected. */
1130 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1131 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1132
1133 /* Display any malloc warning that just came out. Use while because
1134 displaying one warning can cause another. */
1135
1136 while (pending_malloc_warning)
1137 display_malloc_warning ();
1138
1139 no_direct = 0;
1140
86e5706b
RS
1141 Vdeactivate_mark = Qnil;
1142
284f4730 1143 /* If minibuffer on and echo area in use,
eb8c3be9 1144 wait 2 sec and redraw minibuffer. */
284f4730 1145
93127526
RS
1146 if (minibuf_level && echo_area_glyphs
1147 && EQ (minibuf_window, echo_area_window))
284f4730 1148 {
f1bed6d8
RS
1149 /* Bind inhibit-quit to t so that C-g gets read in
1150 rather than quitting back to the minibuffer. */
1151 int count = specpdl_ptr - specpdl;
1152 specbind (Qinhibit_quit, Qt);
f1bed6d8 1153
db08707d 1154 Fsit_for (make_number (2), Qnil, Qnil);
e6aa7813 1155 /* Clear the echo area. */
c6a67acd 1156 message2 (0, 0);
cdb9d665 1157 safe_run_hooks (Qecho_area_clear_hook);
e6aa7813 1158
db08707d
RS
1159 unbind_to (count, Qnil);
1160
e6aa7813 1161 /* If a C-g came in before, treat it as input now. */
284f4730
JB
1162 if (!NILP (Vquit_flag))
1163 {
1164 Vquit_flag = Qnil;
24597608 1165 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
284f4730
JB
1166 }
1167 }
1168
1169#ifdef C_ALLOCA
ff4b06d3 1170 alloca (0); /* Cause a garbage collection now */
284f4730
JB
1171 /* Since we can free the most stuff here. */
1172#endif /* C_ALLOCA */
1173
8f805655 1174#if 0
8f805655
JB
1175 /* Select the frame that the last event came from. Usually,
1176 switch-frame events will take care of this, but if some lisp
1177 code swallows a switch-frame event, we'll fix things up here.
1178 Is this a good idea? */
8c18cbfb 1179 if (FRAMEP (internal_last_event_frame)
3c370943
JB
1180 && XFRAME (internal_last_event_frame) != selected_frame)
1181 Fselect_frame (internal_last_event_frame, Qnil);
284f4730 1182#endif
48e416d4
RS
1183 /* If it has changed current-menubar from previous value,
1184 really recompute the menubar from the value. */
a646e520
RS
1185 if (! NILP (Vlucid_menu_bar_dirty_flag)
1186 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
48e416d4
RS
1187 call0 (Qrecompute_lucid_menubar);
1188
71918b75
RS
1189 before_command_key_count = this_command_key_count;
1190 before_command_echo_length = echo_length ();
1191
d7437ef6
RS
1192 this_command = Qnil;
1193
8f805655 1194 /* Read next key sequence; i gets its length. */
ce98e608 1195 i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
f571ae0d 1196 Qnil, 0, 1, 1);
8f805655 1197
6fac1409
RS
1198 /* A filter may have run while we were reading the input. */
1199 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1200 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1201
8f805655
JB
1202 ++num_input_keys;
1203
284f4730
JB
1204 /* Now we have read a key sequence of length I,
1205 or else I is 0 and we found end of file. */
1206
1207 if (i == 0) /* End of file -- happens only in */
1208 return Qnil; /* a kbd macro, at the end. */
dcc408a0
RS
1209 /* -1 means read_key_sequence got a menu that was rejected.
1210 Just loop around and read another command. */
1211 if (i == -1)
1212 {
1213 cancel_echoing ();
1214 this_command_key_count = 0;
6321824f 1215 this_single_command_key_start = 0;
ff4b06d3 1216 goto finalize;
dcc408a0 1217 }
284f4730 1218
284f4730
JB
1219 last_command_char = keybuf[i - 1];
1220
75c0b143
RS
1221 /* If the previous command tried to force a specific window-start,
1222 forget about that, in case this command moves point far away
c422836d
KH
1223 from that position. But also throw away beg_unchanged and
1224 end_unchanged information in that case, so that redisplay will
1225 update the whole window properly. */
1226 if (!NILP (XWINDOW (selected_window)->force_start))
1227 {
1228 XWINDOW (selected_window)->force_start = Qnil;
1229 beg_unchanged = end_unchanged = 0;
1230 }
75c0b143 1231
284f4730
JB
1232 cmd = read_key_sequence_cmd;
1233 if (!NILP (Vexecuting_macro))
1234 {
1235 if (!NILP (Vquit_flag))
1236 {
1237 Vexecuting_macro = Qt;
1238 QUIT; /* Make some noise. */
1239 /* Will return since macro now empty. */
1240 }
1241 }
1242
1243 /* Do redisplay processing after this command except in special
40932d1a
RS
1244 cases identified below that set no_redisplay to 1.
1245 (actually, there's currently no way to prevent the redisplay,
1246 and no_redisplay is ignored.
beecf6a1 1247 Perhaps someday we will really implement it.) */
284f4730
JB
1248 no_redisplay = 0;
1249
86e5706b
RS
1250 prev_buffer = current_buffer;
1251 prev_modiff = MODIFF;
8746da95 1252 last_point_position = PT;
18cd2eeb 1253 XSETBUFFER (last_point_position_buffer, prev_buffer);
86e5706b 1254
284f4730
JB
1255 /* Execute the command. */
1256
86e5706b 1257 this_command = cmd;
a98ea3f9
RS
1258 /* Note that the value cell will never directly contain nil
1259 if the symbol is a local variable. */
e98a93eb 1260 if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks))
a98ea3f9 1261 safe_run_hooks (Qpre_command_hook);
86e5706b 1262
258bf746 1263 if (NILP (this_command))
284f4730
JB
1264 {
1265 /* nil means key is undefined. */
1266 bitch_at_user ();
c5fdd383 1267 current_kboard->defining_kbd_macro = Qnil;
284f4730 1268 update_mode_lines = 1;
d8bcf58e 1269 current_kboard->Vprefix_arg = Qnil;
284f4730
JB
1270 }
1271 else
1272 {
d8bcf58e 1273 if (NILP (current_kboard->Vprefix_arg) && ! no_direct)
284f4730
JB
1274 {
1275 /* Recognize some common commands in common situations and
1276 do them directly. */
8001d352 1277 if (EQ (this_command, Qforward_char) && PT < ZV)
284f4730 1278 {
51ad8a68 1279 struct Lisp_Char_Table *dp
284f4730 1280 = window_display_table (XWINDOW (selected_window));
37cd9f30
KH
1281 lose = FETCH_BYTE (PT);
1282 SET_PT (forward_point (1));
0f7a8fee 1283 if ((dp
82ba47d7 1284 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
9a5540db
RS
1285 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1286 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1287 && (lose >= 0x20 && lose < 0x7f)))
0f7a8fee 1288 : (lose >= 0x20 && lose < 0x7f))
37cd9f30
KH
1289 /* To extract the case of continuation on
1290 wide-column characters. */
1291 && (WIDTH_BY_CHAR_HEAD (FETCH_BYTE (PT)) == 1)
284f4730
JB
1292 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1293 >= MODIFF)
598ba4c7
RS
1294 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1295 >= OVERLAY_MODIFF)
284f4730 1296 && (XFASTINT (XWINDOW (selected_window)->last_point)
8001d352 1297 == PT - 1)
284f4730
JB
1298 && !windows_or_buffers_changed
1299 && EQ (current_buffer->selective_display, Qnil)
1300 && !detect_input_pending ()
962ae636 1301 && NILP (XWINDOW (selected_window)->column_number_displayed)
284f4730
JB
1302 && NILP (Vexecuting_macro))
1303 no_redisplay = direct_output_forward_char (1);
1304 goto directly_done;
1305 }
8001d352 1306 else if (EQ (this_command, Qbackward_char) && PT > BEGV)
284f4730 1307 {
51ad8a68 1308 struct Lisp_Char_Table *dp
284f4730 1309 = window_display_table (XWINDOW (selected_window));
37cd9f30
KH
1310 SET_PT (forward_point (-1));
1311 lose = FETCH_BYTE (PT);
0f7a8fee 1312 if ((dp
ca873d73 1313 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
9a5540db
RS
1314 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1315 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1316 && (lose >= 0x20 && lose < 0x7f)))
0f7a8fee 1317 : (lose >= 0x20 && lose < 0x7f))
284f4730
JB
1318 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1319 >= MODIFF)
598ba4c7
RS
1320 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1321 >= OVERLAY_MODIFF)
284f4730 1322 && (XFASTINT (XWINDOW (selected_window)->last_point)
8001d352 1323 == PT + 1)
284f4730
JB
1324 && !windows_or_buffers_changed
1325 && EQ (current_buffer->selective_display, Qnil)
1326 && !detect_input_pending ()
962ae636 1327 && NILP (XWINDOW (selected_window)->column_number_displayed)
284f4730
JB
1328 && NILP (Vexecuting_macro))
1329 no_redisplay = direct_output_forward_char (-1);
1330 goto directly_done;
1331 }
258bf746 1332 else if (EQ (this_command, Qself_insert_command)
284f4730 1333 /* Try this optimization only on ascii keystrokes. */
8c18cbfb 1334 && INTEGERP (last_command_char))
284f4730 1335 {
89599794 1336 unsigned int c = XINT (last_command_char);
fc9cce4e 1337 int value;
284f4730 1338
fc9cce4e
RS
1339 if (NILP (Vexecuting_macro)
1340 && !EQ (minibuf_window, selected_window))
284f4730
JB
1341 {
1342 if (!nonundocount || nonundocount >= 20)
1343 {
1344 Fundo_boundary ();
1345 nonundocount = 0;
1346 }
1347 nonundocount++;
1348 }
fc9cce4e
RS
1349 lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
1350 < MODIFF)
598ba4c7
RS
1351 || (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1352 < OVERLAY_MODIFF)
fc9cce4e
RS
1353 || (XFASTINT (XWINDOW (selected_window)->last_point)
1354 != PT)
4c61f38e 1355 || MODIFF <= SAVE_MODIFF
fc9cce4e
RS
1356 || windows_or_buffers_changed
1357 || !EQ (current_buffer->selective_display, Qnil)
1358 || detect_input_pending ()
962ae636 1359 || !NILP (XWINDOW (selected_window)->column_number_displayed)
fc9cce4e
RS
1360 || !NILP (Vexecuting_macro));
1361 value = internal_self_insert (c, 0);
1362 if (value)
1363 lose = 1;
1364 if (value == 2)
1365 nonundocount = 0;
1366
1367 if (!lose
37cd9f30 1368 && (PT == ZV || FETCH_BYTE (PT) == '\n'))
284f4730 1369 {
51ad8a68 1370 struct Lisp_Char_Table *dp
284f4730 1371 = window_display_table (XWINDOW (selected_window));
b8d9050d 1372 int lose = c;
284f4730 1373
e3ee7487
RS
1374 /* Add the offset to the character, for Finsert_char.
1375 We pass internal_self_insert the unmodified character
1376 because it itself does this offsetting. */
1377 if (lose >= 0200 && lose <= 0377
1378 && ! NILP (current_buffer->enable_multibyte_characters))
1379 lose += nonascii_insert_offset;
1380
0f7a8fee
JB
1381 if (dp)
1382 {
9b8eb840 1383 Lisp_Object obj;
0f7a8fee 1384
9b8eb840 1385 obj = DISP_CHAR_VECTOR (dp, lose);
054c8675 1386 if (NILP (obj))
8e91f441
RS
1387 {
1388 /* Do it only for char codes
1389 that by default display as themselves. */
1390 if (lose >= 0x20 && lose <= 0x7e)
1391 no_redisplay = direct_output_for_insert (lose);
1392 }
8c18cbfb 1393 else if (VECTORP (obj)
054c8675 1394 && XVECTOR (obj)->size == 1
8c18cbfb
KH
1395 && (obj = XVECTOR (obj)->contents[0],
1396 INTEGERP (obj))
054c8675
RS
1397 /* Insist face not specified in glyph. */
1398 && (XINT (obj) & ((-1) << 8)) == 0)
bd48a052
RS
1399 no_redisplay
1400 = direct_output_for_insert (XINT (obj));
0f7a8fee
JB
1401 }
1402 else
1403 {
1404 if (lose >= 0x20 && lose <= 0x7e)
1405 no_redisplay = direct_output_for_insert (lose);
1406 }
284f4730
JB
1407 }
1408 goto directly_done;
1409 }
1410 }
1411
1412 /* Here for a command that isn't executed directly */
1413
1414 nonundocount = 0;
d8bcf58e 1415 if (NILP (current_kboard->Vprefix_arg))
284f4730 1416 Fundo_boundary ();
158f7532 1417 Fcommand_execute (this_command, Qnil, Qnil, Qnil);
284f4730 1418
284f4730 1419 }
a764a753 1420 directly_done: ;
284f4730
JB
1421
1422 /* If there is a prefix argument,
6c7178b9
KH
1423 1) We don't want Vlast_command to be ``universal-argument''
1424 (that would be dumb), so don't set Vlast_command,
284f4730
JB
1425 2) we want to leave echoing on so that the prefix will be
1426 echoed as part of this key sequence, so don't call
1427 cancel_echoing, and
1428 3) we want to leave this_command_key_count non-zero, so that
1429 read_char will realize that it is re-reading a character, and
217258d5
KH
1430 not echo it a second time.
1431
1432 If the command didn't actually create a prefix arg,
1433 but is merely a frame event that is transparent to prefix args,
1434 then the above doesn't apply. */
1435 if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_char))
284f4730 1436 {
6c7178b9 1437 current_kboard->Vlast_command = this_command;
284f4730
JB
1438 cancel_echoing ();
1439 this_command_key_count = 0;
6321824f 1440 this_single_command_key_start = 0;
284f4730 1441 }
86e5706b 1442
51603bd0
RS
1443 /* Note that the value cell will never directly contain nil
1444 if the symbol is a local variable. */
1445 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1446 safe_run_hooks (Qpost_command_hook);
1447
1448 if (!NILP (Vdeferred_action_list))
1449 safe_run_hooks (Qdeferred_action_function);
1450
1451 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1452 {
1453 if (NILP (Vunread_command_events)
1454 && NILP (Vexecuting_macro)
41365083 1455 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
51603bd0
RS
1456 safe_run_hooks (Qpost_command_idle_hook);
1457 }
1458
88ce066e 1459 if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks))
86e5706b
RS
1460 {
1461 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
1462 {
1463 current_buffer->mark_active = Qnil;
1464 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
1465 }
1466 else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1467 call1 (Vrun_hooks, intern ("activate-mark-hook"));
1468 }
ff4b06d3
KH
1469
1470 finalize:
1471 /* Install chars successfully executed in kbd macro. */
1472
d8bcf58e
KH
1473 if (!NILP (current_kboard->defining_kbd_macro)
1474 && NILP (current_kboard->Vprefix_arg))
ff4b06d3
KH
1475 finalize_kbd_macro_chars ();
1476
c5fdd383 1477#ifdef MULTI_KBOARD
604ccd1d 1478 if (!was_locked)
1e8bd3da 1479 any_kboard_state ();
ff4b06d3 1480#endif
284f4730
JB
1481 }
1482}
1c9784c9 1483
0bc3db2b
RS
1484/* Subroutine for safe_run_hooks: run the hook HOOK. */
1485
1486static Lisp_Object
1487safe_run_hooks_1 (hook)
1488 Lisp_Object hook;
1489{
1490 return call1 (Vrun_hooks, Vinhibit_quit);
1491}
1492
1493/* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */
1494
1495static Lisp_Object
1496safe_run_hooks_error (data)
1497 Lisp_Object data;
1498{
1499 Fset (Vinhibit_quit, Qnil);
1500}
1501
1c9784c9
KH
1502/* If we get an error while running the hook, cause the hook variable
1503 to be nil. Also inhibit quits, so that C-g won't cause the hook
1504 to mysteriously evaporate. */
0bc3db2b 1505
68f297c5 1506void
1c9784c9 1507safe_run_hooks (hook)
a98ea3f9 1508 Lisp_Object hook;
1c9784c9 1509{
68553292 1510 Lisp_Object value;
1c9784c9 1511 int count = specpdl_ptr - specpdl;
0bc3db2b
RS
1512 specbind (Qinhibit_quit, hook);
1513
e702932d 1514 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
1c9784c9
KH
1515
1516 unbind_to (count, Qnil);
1517}
284f4730
JB
1518\f
1519/* Number of seconds between polling for input. */
1520int polling_period;
1521
eb8c3be9 1522/* Nonzero means polling for input is temporarily suppressed. */
284f4730
JB
1523int poll_suppress_count;
1524
36922b18 1525/* Nonzero if polling_for_input is actually being used. */
284f4730
JB
1526int polling_for_input;
1527
36922b18
RS
1528#ifdef POLL_FOR_INPUT
1529
284f4730
JB
1530/* Handle an alarm once each second and read pending input
1531 so as to handle a C-g if it comces in. */
1532
1533SIGTYPE
91c049d4
RS
1534input_poll_signal (signalnum) /* If we don't have an argument, */
1535 int signalnum; /* some compilers complain in signal calls. */
284f4730 1536{
87dd9b9b
RS
1537 /* This causes the call to start_polling at the end
1538 to do its job. It also arranges for a quit or error
1539 from within read_avail_input to resume polling. */
1540 poll_suppress_count++;
9ac0d9e0
JB
1541 if (interrupt_input_blocked == 0
1542 && !waiting_for_input)
1543 read_avail_input (0);
87dd9b9b
RS
1544 /* Turn on the SIGALRM handler and request another alarm. */
1545 start_polling ();
284f4730
JB
1546}
1547
1548#endif
1549
1550/* Begin signals to poll for input, if they are appropriate.
1551 This function is called unconditionally from various places. */
1552
1553start_polling ()
1554{
1555#ifdef POLL_FOR_INPUT
34f04431 1556 if (read_socket_hook && !interrupt_input)
284f4730
JB
1557 {
1558 poll_suppress_count--;
1559 if (poll_suppress_count == 0)
1560 {
1561 signal (SIGALRM, input_poll_signal);
1562 polling_for_input = 1;
1563 alarm (polling_period);
1564 }
1565 }
1566#endif
1567}
1568
1d3195db
RS
1569/* Nonzero if we are using polling to handle input asynchronously. */
1570
1571int
1572input_polling_used ()
1573{
1574#ifdef POLL_FOR_INPUT
1575 return read_socket_hook && !interrupt_input;
1576#else
1577 return 0;
1578#endif
1579}
1580
284f4730
JB
1581/* Turn off polling. */
1582
1583stop_polling ()
1584{
1585#ifdef POLL_FOR_INPUT
34f04431 1586 if (read_socket_hook && !interrupt_input)
284f4730
JB
1587 {
1588 if (poll_suppress_count == 0)
1589 {
1590 polling_for_input = 0;
1591 alarm (0);
1592 }
1593 poll_suppress_count++;
1594 }
1595#endif
1596}
fe8aeef3
RS
1597
1598/* Set the value of poll_suppress_count to COUNT
1599 and start or stop polling accordingly. */
1600
1601void
1602set_poll_suppress_count (count)
1603 int count;
1604{
1605#ifdef POLL_FOR_INPUT
1606 if (count == 0 && poll_suppress_count != 0)
1607 {
1608 poll_suppress_count = 1;
1609 start_polling ();
1610 }
1611 else if (count != 0 && poll_suppress_count == 0)
1612 {
1613 stop_polling ();
1614 }
1615 poll_suppress_count = count;
1616#endif
1617}
f4eef8b4 1618
d0a57728
RS
1619/* Bind polling_period to a value at least N.
1620 But don't decrease it. */
1621
f4eef8b4
RS
1622bind_polling_period (n)
1623 int n;
1624{
1625#ifdef POLL_FOR_INPUT
d0a57728
RS
1626 int new = polling_period;
1627
1628 if (n > new)
1629 new = n;
1630
f4eef8b4 1631 stop_polling ();
d0a57728
RS
1632 specbind (Qpolling_period, make_number (new));
1633 /* Start a new alarm with the new period. */
f4eef8b4
RS
1634 start_polling ();
1635#endif
1636}
284f4730 1637\f
6da3dd3a
RS
1638/* Apply the control modifier to CHARACTER. */
1639
faf5e407
JB
1640int
1641make_ctrl_char (c)
1642 int c;
1643{
d205953b
JB
1644 /* Save the upper bits here. */
1645 int upper = c & ~0177;
1646
1647 c &= 0177;
1648
1649 /* Everything in the columns containing the upper-case letters
1650 denotes a control character. */
1651 if (c >= 0100 && c < 0140)
1652 {
1653 int oc = c;
1654 c &= ~0140;
1655 /* Set the shift modifier for a control char
1656 made from a shifted letter. But only for letters! */
1657 if (oc >= 'A' && oc <= 'Z')
1658 c |= shift_modifier;
1659 }
1660
1661 /* The lower-case letters denote control characters too. */
1662 else if (c >= 'a' && c <= 'z')
1663 c &= ~0140;
1664
1665 /* Include the bits for control and shift
1666 only if the basic ASCII code can't indicate them. */
1667 else if (c >= ' ')
1668 c |= ctrl_modifier;
1669
1670 /* Replace the high bits. */
1671 c |= (upper & ~ctrl_modifier);
faf5e407
JB
1672
1673 return c;
1674}
1675
1676
1677\f
284f4730
JB
1678/* Input of single characters from keyboard */
1679
1680Lisp_Object print_help ();
1681static Lisp_Object kbd_buffer_get_event ();
e4fe371d 1682static void record_char ();
284f4730 1683
c5fdd383
KH
1684#ifdef MULTI_KBOARD
1685static jmp_buf wrong_kboard_jmpbuf;
bded54dd 1686#endif
beecf6a1 1687
284f4730
JB
1688/* read a character from the keyboard; call the redisplay if needed */
1689/* commandflag 0 means do not do auto-saving, but do do redisplay.
1690 -1 means do not do redisplay, but do do autosaving.
1691 1 means do both. */
1692
7d6de002
RS
1693/* The arguments MAPS and NMAPS are for menu prompting.
1694 MAPS is an array of keymaps; NMAPS is the length of MAPS.
1695
1696 PREV_EVENT is the previous input event, or nil if we are reading
1697 the first event of a key sequence.
1698
83d68044 1699 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
6569cc8d 1700 if we used a mouse menu to read the input, or zero otherwise. If
83d68044 1701 USED_MOUSE_MENU is null, we don't dereference it.
dcc408a0
RS
1702
1703 Value is t if we showed a menu and the user rejected it. */
7d6de002 1704
284f4730 1705Lisp_Object
7d6de002 1706read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
284f4730 1707 int commandflag;
7d6de002
RS
1708 int nmaps;
1709 Lisp_Object *maps;
1710 Lisp_Object prev_event;
1711 int *used_mouse_menu;
284f4730 1712{
7c3bc944 1713 Lisp_Object c;
284f4730 1714 int count;
410d4de9 1715 jmp_buf local_getcjmp;
284f4730 1716 jmp_buf save_jump;
a1341f75 1717 int key_already_recorded = 0;
017c7cb6 1718 Lisp_Object tem, save;
e4fe371d 1719 Lisp_Object also_record;
7c3bc944
RS
1720 struct gcpro gcpro1;
1721
e4fe371d 1722 also_record = Qnil;
284f4730 1723
71918b75
RS
1724 before_command_key_count = this_command_key_count;
1725 before_command_echo_length = echo_length ();
ef6661f7 1726 c = Qnil;
71918b75 1727
7c3bc944
RS
1728 GCPRO1 (c);
1729
7f07d5ca
RS
1730 retry:
1731
24597608 1732 if (CONSP (Vunread_command_events))
284f4730 1733 {
24597608
RS
1734 c = XCONS (Vunread_command_events)->car;
1735 Vunread_command_events = XCONS (Vunread_command_events)->cdr;
284f4730 1736
2479e91e
RS
1737 /* Undo what read_char_x_menu_prompt did when it unread
1738 additional keys returned by Fx_popup_menu. */
1739 if (CONSP (c)
1740 && (SYMBOLP (XCONS (c)->car) || INTEGERP (XCONS (c)->car))
1741 && NILP (XCONS (c)->cdr))
1742 c = XCONS (c)->car;
1743
284f4730
JB
1744 if (this_command_key_count == 0)
1745 goto reread_first;
1746 else
1747 goto reread;
1748 }
1749
86e5706b
RS
1750 if (unread_command_char != -1)
1751 {
18cd2eeb 1752 XSETINT (c, unread_command_char);
86e5706b
RS
1753 unread_command_char = -1;
1754
1755 if (this_command_key_count == 0)
1756 goto reread_first;
1757 else
1758 goto reread;
1759 }
1760
71918b75
RS
1761 /* If there is no function key translated before
1762 reset-this-command-lengths takes effect, forget about it. */
1763 before_command_restore_flag = 0;
1764
284f4730
JB
1765 if (!NILP (Vexecuting_macro))
1766 {
fce33686
JB
1767 /* We set this to Qmacro; since that's not a frame, nobody will
1768 try to switch frames on us, and the selected window will
1769 remain unchanged.
1770
1771 Since this event came from a macro, it would be misleading to
eb8c3be9 1772 leave internal_last_event_frame set to wherever the last
3c370943
JB
1773 real event came from. Normally, a switch-frame event selects
1774 internal_last_event_frame after each command is read, but
1775 events read from a macro should never cause a new frame to be
1776 selected. */
4c52b668 1777 Vlast_event_frame = internal_last_event_frame = Qmacro;
fce33686 1778
663258f2
JB
1779 /* Exit the macro if we are at the end.
1780 Also, some things replace the macro with t
1781 to force an early exit. */
1782 if (EQ (Vexecuting_macro, Qt)
1783 || executing_macro_index >= XFASTINT (Flength (Vexecuting_macro)))
284f4730 1784 {
18cd2eeb 1785 XSETINT (c, -1);
7c3bc944 1786 RETURN_UNGCPRO (c);
284f4730 1787 }
df0f2ba1 1788
284f4730 1789 c = Faref (Vexecuting_macro, make_number (executing_macro_index));
8c18cbfb 1790 if (STRINGP (Vexecuting_macro)
86e5706b 1791 && (XINT (c) & 0x80))
bb9e9bed 1792 XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
86e5706b 1793
284f4730
JB
1794 executing_macro_index++;
1795
1796 goto from_macro;
1797 }
1798
cd21b839
JB
1799 if (!NILP (unread_switch_frame))
1800 {
1801 c = unread_switch_frame;
1802 unread_switch_frame = Qnil;
1803
1804 /* This event should make it into this_command_keys, and get echoed
f4255cd1
JB
1805 again, so we go to reread_first, rather than reread. */
1806 goto reread_first;
cd21b839
JB
1807 }
1808
6e4e64a8
RS
1809 if (commandflag >= 0)
1810 {
1811 if (input_pending
1812 || detect_input_pending_run_timers (0))
1813 swallow_events (0);
1814
1815 if (!input_pending)
1816 redisplay ();
1817 }
e9bf89a0 1818
410d4de9
RS
1819 /* Message turns off echoing unless more keystrokes turn it on again. */
1820 if (echo_area_glyphs && *echo_area_glyphs
1fc93d49 1821 && echo_area_glyphs != current_kboard->echobuf
0c04a67e 1822 && ok_to_echo_at_next_pause != echo_area_glyphs)
410d4de9
RS
1823 cancel_echoing ();
1824 else
1825 /* If already echoing, continue. */
1826 echo_dash ();
284f4730 1827
410d4de9
RS
1828 /* Try reading a character via menu prompting in the minibuf.
1829 Try this before the sit-for, because the sit-for
1830 would do the wrong thing if we are supposed to do
1831 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
1832 after a mouse event so don't try a minibuf menu. */
1833 c = Qnil;
1834 if (nmaps > 0 && INTERACTIVE
1835 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
1836 /* Don't bring up a menu if we already have another event. */
1837 && NILP (Vunread_command_events)
1838 && unread_command_char < 0
4ec4ed6a 1839 && !detect_input_pending_run_timers (0))
410d4de9
RS
1840 {
1841 c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
1842 if (! NILP (c))
1843 {
1844 key_already_recorded = 1;
1845 goto non_reread_1;
1846 }
1847 }
284f4730 1848
410d4de9
RS
1849 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
1850 We will do that below, temporarily for short sections of code,
1851 when appropriate. local_getcjmp must be in effect
1852 around any call to sit_for or kbd_buffer_get_event;
1853 it *must not* be in effect when we call redisplay. */
284f4730 1854
410d4de9 1855 if (_setjmp (local_getcjmp))
284f4730 1856 {
18cd2eeb 1857 XSETINT (c, quit_char);
4c52b668
KH
1858 XSETFRAME (internal_last_event_frame, selected_frame);
1859 Vlast_event_frame = internal_last_event_frame;
04904c29
RS
1860 /* If we report the quit char as an event,
1861 don't do so more than once. */
1862 if (!NILP (Vinhibit_quit))
1863 Vquit_flag = Qnil;
284f4730 1864
c5fdd383 1865#ifdef MULTI_KBOARD
df0f2ba1 1866 {
c5fdd383
KH
1867 KBOARD *kb = FRAME_KBOARD (selected_frame);
1868 if (kb != current_kboard)
df0f2ba1 1869 {
c5fdd383 1870 Lisp_Object *tailp = &kb->kbd_queue;
1e8bd3da
RS
1871 /* We shouldn't get here if we were in single-kboard mode! */
1872 if (single_kboard)
df0f2ba1
KH
1873 abort ();
1874 while (CONSP (*tailp))
1875 tailp = &XCONS (*tailp)->cdr;
1876 if (!NILP (*tailp))
1877 abort ();
1878 *tailp = Fcons (c, Qnil);
c5fdd383
KH
1879 kb->kbd_queue_has_data = 1;
1880 current_kboard = kb;
ef6661f7
RS
1881 /* This is going to exit from read_char
1882 so we had better get rid of this frame's stuff. */
1883 UNGCPRO;
c5fdd383 1884 longjmp (wrong_kboard_jmpbuf, 1);
df0f2ba1
KH
1885 }
1886 }
1887#endif
284f4730
JB
1888 goto non_reread;
1889 }
1890
d9d4c147
KH
1891 timer_start_idle ();
1892
284f4730
JB
1893 /* If in middle of key sequence and minibuffer not active,
1894 start echoing if enough time elapses. */
410d4de9 1895
c5fdd383 1896 if (minibuf_level == 0 && !current_kboard->immediate_echo
6c6083a9 1897 && this_command_key_count > 0
27203ead 1898 && ! noninteractive
284f4730 1899 && echo_keystrokes > 0
1fc93d49 1900 && (echo_area_glyphs == 0 || *echo_area_glyphs == 0
0c04a67e 1901 || ok_to_echo_at_next_pause == echo_area_glyphs))
284f4730
JB
1902 {
1903 Lisp_Object tem0;
1904
7d6de002
RS
1905 /* After a mouse event, start echoing right away.
1906 This is because we are probably about to display a menu,
1907 and we don't want to delay before doing so. */
dbc4e1c1 1908 if (EVENT_HAS_PARAMETERS (prev_event))
3dbd9ee4 1909 echo_now ();
7d6de002
RS
1910 else
1911 {
410d4de9
RS
1912 save_getcjmp (save_jump);
1913 restore_getcjmp (local_getcjmp);
41365083 1914 tem0 = sit_for (echo_keystrokes, 0, 1, 1, 0);
410d4de9 1915 restore_getcjmp (save_jump);
303b5b3f
RS
1916 if (EQ (tem0, Qt)
1917 && ! CONSP (Vunread_command_events))
3dbd9ee4 1918 echo_now ();
7d6de002 1919 }
284f4730
JB
1920 }
1921
410d4de9 1922 /* Maybe auto save due to number of keystrokes. */
284f4730
JB
1923
1924 if (commandflag != 0
1925 && auto_save_interval > 0
c43b1734 1926 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
4ec4ed6a 1927 && !detect_input_pending_run_timers (0))
284f4730 1928 {
284f4730 1929 Fdo_auto_save (Qnil, Qnil);
ef8fd672
RS
1930 /* Hooks can actually change some buffers in auto save. */
1931 redisplay ();
284f4730
JB
1932 }
1933
8150596a 1934 /* Try reading using an X menu.
24597608
RS
1935 This is never confused with reading using the minibuf
1936 because the recursive call of read_char in read_char_minibuf_menu_prompt
1937 does not pass on any keymaps. */
410d4de9 1938
24597608 1939 if (nmaps > 0 && INTERACTIVE
5a8d99e0
KH
1940 && !NILP (prev_event)
1941 && EVENT_HAS_PARAMETERS (prev_event)
1942 && !EQ (XCONS (prev_event)->car, Qmenu_bar)
24597608
RS
1943 /* Don't bring up a menu if we already have another event. */
1944 && NILP (Vunread_command_events)
b8556aee 1945 && unread_command_char < 0)
8eb4d8ef
RS
1946 {
1947 c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
1948
1949 /* Now that we have read an event, Emacs is not idle. */
1950 timer_stop_idle ();
1951
7c3bc944 1952 RETURN_UNGCPRO (c);
8eb4d8ef 1953 }
7d6de002 1954
410d4de9
RS
1955 /* Maybe autosave and/or garbage collect due to idleness. */
1956
26c1639e 1957 if (INTERACTIVE && NILP (c))
7d6de002
RS
1958 {
1959 int delay_level, buffer_size;
1960
410d4de9
RS
1961 /* Slow down auto saves logarithmically in size of current buffer,
1962 and garbage collect while we're at it. */
7d6de002
RS
1963 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
1964 last_non_minibuf_size = Z - BEG;
1965 buffer_size = (last_non_minibuf_size >> 8) + 1;
1966 delay_level = 0;
1967 while (buffer_size > 64)
1968 delay_level++, buffer_size -= buffer_size >> 2;
1969 if (delay_level < 4) delay_level = 4;
1970 /* delay_level is 4 for files under around 50k, 7 at 100k,
1971 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
1972
1973 /* Auto save if enough time goes by without input. */
1974 if (commandflag != 0
c43b1734 1975 && num_nonmacro_input_events > last_auto_save
8c18cbfb 1976 && INTEGERP (Vauto_save_timeout)
7d6de002
RS
1977 && XINT (Vauto_save_timeout) > 0)
1978 {
1979 Lisp_Object tem0;
410d4de9
RS
1980
1981 save_getcjmp (save_jump);
1982 restore_getcjmp (local_getcjmp);
d9d4c147 1983 tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4,
41365083 1984 0, 1, 1, 0);
410d4de9
RS
1985 restore_getcjmp (save_jump);
1986
303b5b3f
RS
1987 if (EQ (tem0, Qt)
1988 && ! CONSP (Vunread_command_events))
7d6de002 1989 {
7d6de002 1990 Fdo_auto_save (Qnil, Qnil);
7d6de002
RS
1991
1992 /* If we have auto-saved and there is still no input
1993 available, garbage collect if there has been enough
1994 consing going on to make it worthwhile. */
4ec4ed6a 1995 if (!detect_input_pending_run_timers (0)
7d6de002 1996 && consing_since_gc > gc_cons_threshold / 2)
ef8fd672 1997 Fgarbage_collect ();
410d4de9 1998
ef8fd672 1999 redisplay ();
7d6de002
RS
2000 }
2001 }
2002 }
284f4730 2003
303b5b3f
RS
2004 /* If this has become non-nil here, it has been set by a timer
2005 or sentinel or filter. */
2006 if (CONSP (Vunread_command_events))
2007 {
2008 c = XCONS (Vunread_command_events)->car;
2009 Vunread_command_events = XCONS (Vunread_command_events)->cdr;
2010 }
2011
410d4de9
RS
2012 /* Read something from current KBOARD's side queue, if possible. */
2013
beecf6a1 2014 if (NILP (c))
1e12dd87 2015 {
c5fdd383 2016 if (current_kboard->kbd_queue_has_data)
beecf6a1 2017 {
c5fdd383 2018 if (!CONSP (current_kboard->kbd_queue))
4524b161 2019 abort ();
c5fdd383
KH
2020 c = XCONS (current_kboard->kbd_queue)->car;
2021 current_kboard->kbd_queue
2022 = XCONS (current_kboard->kbd_queue)->cdr;
2023 if (NILP (current_kboard->kbd_queue))
2024 current_kboard->kbd_queue_has_data = 0;
d9d4c147 2025 input_pending = readable_events (0);
4c52b668
KH
2026 if (EVENT_HAS_PARAMETERS (c)
2027 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
2028 internal_last_event_frame = XCONS (XCONS (c)->cdr)->car;
2029 Vlast_event_frame = internal_last_event_frame;
beecf6a1 2030 }
1e8bd3da
RS
2031 }
2032
c5fdd383 2033#ifdef MULTI_KBOARD
1e8bd3da
RS
2034 /* If current_kboard's side queue is empty check the other kboards.
2035 If one of them has data that we have not yet seen here,
2036 switch to it and process the data waiting for it.
2037
2038 Note: if the events queued up for another kboard
2039 have already been seen here, and therefore are not a complete command,
2040 the kbd_queue_has_data field is 0, so we skip that kboard here.
2041 That's to avoid an infinite loop switching between kboards here. */
2042 if (NILP (c) && !single_kboard)
2043 {
2044 KBOARD *kb;
2045 for (kb = all_kboards; kb; kb = kb->next_kboard)
2046 if (kb->kbd_queue_has_data)
2047 {
2048 current_kboard = kb;
ef6661f7
RS
2049 /* This is going to exit from read_char
2050 so we had better get rid of this frame's stuff. */
2051 UNGCPRO;
1e8bd3da
RS
2052 longjmp (wrong_kboard_jmpbuf, 1);
2053 }
2054 }
df0f2ba1
KH
2055#endif
2056
410d4de9
RS
2057 wrong_kboard:
2058
2059 stop_polling ();
2060
1e8bd3da
RS
2061 /* Finally, we read from the main queue,
2062 and if that gives us something we can't use yet, we put it on the
2063 appropriate side queue and try again. */
410d4de9 2064
1e8bd3da
RS
2065 if (NILP (c))
2066 {
2067 KBOARD *kb;
2068
1e8bd3da 2069 /* Actually read a character, waiting if necessary. */
410d4de9
RS
2070 save_getcjmp (save_jump);
2071 restore_getcjmp (local_getcjmp);
83d68044 2072 c = kbd_buffer_get_event (&kb, used_mouse_menu);
410d4de9
RS
2073 restore_getcjmp (save_jump);
2074
c5fdd383 2075#ifdef MULTI_KBOARD
410d4de9 2076 if (! NILP (c) && (kb != current_kboard))
1e8bd3da
RS
2077 {
2078 Lisp_Object *tailp = &kb->kbd_queue;
2079 while (CONSP (*tailp))
2080 tailp = &XCONS (*tailp)->cdr;
2081 if (!NILP (*tailp))
2082 abort ();
2083 *tailp = Fcons (c, Qnil);
2084 kb->kbd_queue_has_data = 1;
46b84797 2085 c = Qnil;
1e8bd3da
RS
2086 if (single_kboard)
2087 goto wrong_kboard;
2088 current_kboard = kb;
ef6661f7
RS
2089 /* This is going to exit from read_char
2090 so we had better get rid of this frame's stuff. */
2091 UNGCPRO;
1e8bd3da 2092 longjmp (wrong_kboard_jmpbuf, 1);
df0f2ba1 2093 }
1e8bd3da 2094#endif
beecf6a1 2095 }
1e8bd3da 2096
284f4730 2097 /* Terminate Emacs in batch mode if at eof. */
8c18cbfb 2098 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
284f4730
JB
2099 Fkill_emacs (make_number (1));
2100
8c18cbfb 2101 if (INTEGERP (c))
80645119
JB
2102 {
2103 /* Add in any extra modifiers, where appropriate. */
2104 if ((extra_keyboard_modifiers & CHAR_CTL)
2105 || ((extra_keyboard_modifiers & 0177) < ' '
2106 && (extra_keyboard_modifiers & 0177) != 0))
faf5e407 2107 XSETINT (c, make_ctrl_char (XINT (c)));
80645119
JB
2108
2109 /* Transfer any other modifier bits directly from
2110 extra_keyboard_modifiers to c. Ignore the actual character code
2111 in the low 16 bits of extra_keyboard_modifiers. */
b8d9050d 2112 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
80645119 2113 }
9fa4395d 2114
284f4730
JB
2115 non_reread:
2116
2fb9049e 2117 timer_stop_idle ();
d9d4c147 2118
284f4730
JB
2119 start_polling ();
2120
410d4de9
RS
2121 if (NILP (c))
2122 {
2123 if (commandflag >= 0
4ec4ed6a 2124 && !input_pending && !detect_input_pending_run_timers (0))
410d4de9
RS
2125 redisplay ();
2126
2127 goto wrong_kboard;
2128 }
2129
2130 non_reread_1:
2131
dfd11da7 2132 /* Buffer switch events are only for internal wakeups
7c3bc944
RS
2133 so don't show them to the user.
2134 Also, don't record a key if we already did. */
2135 if (BUFFERP (c) || key_already_recorded)
2136 RETURN_UNGCPRO (c);
a1341f75 2137
7f07d5ca
RS
2138 /* Process special events within read_char
2139 and loop around to read another event. */
017c7cb6
RS
2140 save = Vquit_flag;
2141 Vquit_flag = Qnil;
7f07d5ca
RS
2142 tem = get_keyelt (access_keymap (get_keymap_1 (Vspecial_event_map, 0, 0),
2143 c, 0, 0), 1);
017c7cb6 2144 Vquit_flag = save;
7f07d5ca
RS
2145
2146 if (!NILP (tem))
2147 {
ba8dfba8
RS
2148 int was_locked = single_kboard;
2149
7f07d5ca 2150 last_input_char = c;
158f7532 2151 Fcommand_execute (tem, Qnil, Fvector (1, &last_input_char), Qt);
ba8dfba8
RS
2152
2153 /* Resume allowing input from any kboard, if that was true before. */
2154 if (!was_locked)
2155 any_kboard_state ();
2156
7f07d5ca
RS
2157 goto retry;
2158 }
2159
dfd11da7 2160 /* Wipe the echo area. */
cdb9d665
RS
2161 if (echo_area_glyphs)
2162 safe_run_hooks (Qecho_area_clear_hook);
dfd11da7 2163 echo_area_glyphs = 0;
284f4730
JB
2164
2165 /* Handle things that only apply to characters. */
8c18cbfb 2166 if (INTEGERP (c))
284f4730
JB
2167 {
2168 /* If kbd_buffer_get_event gave us an EOF, return that. */
86e5706b 2169 if (XINT (c) == -1)
7c3bc944 2170 RETURN_UNGCPRO (c);
284f4730 2171
8c18cbfb 2172 if (STRINGP (Vkeyboard_translate_table)
845fe94e 2173 && XSTRING (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
f4255cd1 2174 XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[XFASTINT (c)]);
f9414d62 2175 else if ((VECTORP (Vkeyboard_translate_table)
845fe94e
RS
2176 && XVECTOR (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
2177 || (CHAR_TABLE_P (Vkeyboard_translate_table)
2178 && CHAR_TABLE_ORDINARY_SLOTS > (unsigned) XFASTINT (c)))
f9414d62
RS
2179 {
2180 Lisp_Object d;
2181 d = Faref (Vkeyboard_translate_table, c);
2182 /* nil in keyboard-translate-table means no translation. */
2183 if (!NILP (d))
2184 c = d;
2185 }
284f4730
JB
2186 }
2187
e4fe371d
RS
2188 /* If this event is a mouse click in the menu bar,
2189 return just menu-bar for now. Modify the mouse click event
2190 so we won't do this twice, then queue it up. */
2191 if (EVENT_HAS_PARAMETERS (c)
2192 && CONSP (XCONS (c)->cdr)
2193 && CONSP (EVENT_START (c))
2194 && CONSP (XCONS (EVENT_START (c))->cdr))
284f4730 2195 {
e4fe371d 2196 Lisp_Object posn;
284f4730 2197
e4fe371d
RS
2198 posn = POSN_BUFFER_POSN (EVENT_START (c));
2199 /* Handle menu-bar events:
2200 insert the dummy prefix event `menu-bar'. */
2201 if (EQ (posn, Qmenu_bar))
2202 {
2203 /* Change menu-bar to (menu-bar) as the event "position". */
2204 POSN_BUFFER_POSN (EVENT_START (c)) = Fcons (posn, Qnil);
284f4730 2205
e4fe371d
RS
2206 also_record = c;
2207 Vunread_command_events = Fcons (c, Vunread_command_events);
2208 c = posn;
284f4730 2209 }
284f4730
JB
2210 }
2211
e4fe371d
RS
2212 record_char (c);
2213 if (! NILP (also_record))
2214 record_char (also_record);
51172b6d 2215
284f4730
JB
2216 from_macro:
2217 reread_first:
7c3bc944 2218
71918b75
RS
2219 before_command_key_count = this_command_key_count;
2220 before_command_echo_length = echo_length ();
284f4730 2221
b8556aee 2222 /* Don't echo mouse motion events. */
8ea231fc
RS
2223 if (echo_keystrokes
2224 && ! (EVENT_HAS_PARAMETERS (c)
2225 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
e4fe371d
RS
2226 {
2227 echo_char (c);
2228 if (! NILP (also_record))
2229 echo_char (also_record);
1fc93d49
RS
2230 /* Once we reread a character, echoing can happen
2231 the next time we pause to read a new one. */
0c04a67e 2232 ok_to_echo_at_next_pause = echo_area_glyphs;
e4fe371d 2233 }
b8556aee 2234
db8c1663 2235 /* Record this character as part of the current key. */
b8556aee 2236 add_command_key (c);
e4fe371d
RS
2237 if (! NILP (also_record))
2238 add_command_key (also_record);
284f4730
JB
2239
2240 /* Re-reading in the middle of a command */
2241 reread:
2242 last_input_char = c;
c43b1734 2243 num_input_events++;
284f4730
JB
2244
2245 /* Process the help character specially if enabled */
ecb7cb34 2246 if (!NILP (Vhelp_form) && help_char_p (c))
284f4730
JB
2247 {
2248 Lisp_Object tem0;
2249 count = specpdl_ptr - specpdl;
2250
2251 record_unwind_protect (Fset_window_configuration,
2252 Fcurrent_window_configuration (Qnil));
2253
2254 tem0 = Feval (Vhelp_form);
8c18cbfb 2255 if (STRINGP (tem0))
284f4730
JB
2256 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
2257
2258 cancel_echoing ();
3cb81011
KH
2259 do
2260 c = read_char (0, 0, 0, Qnil, 0);
8c18cbfb 2261 while (BUFFERP (c));
ff11dfa1 2262 /* Remove the help from the frame */
284f4730 2263 unbind_to (count, Qnil);
410d4de9 2264
284f4730
JB
2265 redisplay ();
2266 if (EQ (c, make_number (040)))
2267 {
2268 cancel_echoing ();
3cb81011
KH
2269 do
2270 c = read_char (0, 0, 0, Qnil, 0);
8c18cbfb 2271 while (BUFFERP (c));
284f4730
JB
2272 }
2273 }
2274
7c3bc944 2275 RETURN_UNGCPRO (c);
284f4730
JB
2276}
2277
8eb4d8ef
RS
2278/* Record a key that came from a mouse menu.
2279 Record it for echoing, for this-command-keys, and so on. */
2280
2281static void
2282record_menu_key (c)
2283 Lisp_Object c;
2284{
2285 /* Wipe the echo area. */
2286 echo_area_glyphs = 0;
2287
2288 record_char (c);
2289
2290 before_command_key_count = this_command_key_count;
2291 before_command_echo_length = echo_length ();
2292
2293 /* Don't echo mouse motion events. */
2294 if (echo_keystrokes)
2295 {
2296 echo_char (c);
2297
2298 /* Once we reread a character, echoing can happen
2299 the next time we pause to read a new one. */
2300 ok_to_echo_at_next_pause = 0;
2301 }
2302
2303 /* Record this character as part of the current key. */
2304 add_command_key (c);
2305
2306 /* Re-reading in the middle of a command */
2307 last_input_char = c;
c43b1734 2308 num_input_events++;
8eb4d8ef
RS
2309}
2310
ecb7cb34
KH
2311/* Return 1 if should recognize C as "the help character". */
2312
2313int
2314help_char_p (c)
2315 Lisp_Object c;
2316{
2317 Lisp_Object tail;
2318
2319 if (EQ (c, Vhelp_char))
2320 return 1;
2321 for (tail = Vhelp_event_list; CONSP (tail); tail = XCONS (tail)->cdr)
2322 if (EQ (c, XCONS (tail)->car))
2323 return 1;
2324 return 0;
2325}
2326
e4fe371d
RS
2327/* Record the input event C in various ways. */
2328
2329static void
2330record_char (c)
2331 Lisp_Object c;
2332{
2333 total_keys++;
2334 XVECTOR (recent_keys)->contents[recent_keys_index] = c;
2335 if (++recent_keys_index >= NUM_RECENT_KEYS)
2336 recent_keys_index = 0;
2337
2338 /* Write c to the dribble file. If c is a lispy event, write
2339 the event's symbol to the dribble file, in <brackets>. Bleaugh.
2340 If you, dear reader, have a better idea, you've got the source. :-) */
2341 if (dribble)
2342 {
2343 if (INTEGERP (c))
2344 {
2345 if (XUINT (c) < 0x100)
2346 putc (XINT (c), dribble);
2347 else
6de34814 2348 fprintf (dribble, " 0x%x", (int) XUINT (c));
e4fe371d
RS
2349 }
2350 else
2351 {
2352 Lisp_Object dribblee;
2353
2354 /* If it's a structured event, take the event header. */
2355 dribblee = EVENT_HEAD (c);
2356
2357 if (SYMBOLP (dribblee))
2358 {
2359 putc ('<', dribble);
2360 fwrite (XSYMBOL (dribblee)->name->data, sizeof (char),
2361 XSYMBOL (dribblee)->name->size,
2362 dribble);
2363 putc ('>', dribble);
2364 }
2365 }
2366
2367 fflush (dribble);
2368 }
2369
2370 store_kbd_macro_char (c);
2371
c43b1734 2372 num_nonmacro_input_events++;
e4fe371d
RS
2373}
2374
284f4730
JB
2375Lisp_Object
2376print_help (object)
2377 Lisp_Object object;
2378{
622de3e9 2379 struct buffer *old = current_buffer;
284f4730 2380 Fprinc (object, Qnil);
622de3e9
KH
2381 set_buffer_internal (XBUFFER (Vstandard_output));
2382 call0 (intern ("help-mode"));
2383 set_buffer_internal (old);
284f4730
JB
2384 return Qnil;
2385}
2386
2387/* Copy out or in the info on where C-g should throw to.
2388 This is used when running Lisp code from within get_char,
2389 in case get_char is called recursively.
2390 See read_process_output. */
2391
2392save_getcjmp (temp)
2393 jmp_buf temp;
2394{
2395 bcopy (getcjmp, temp, sizeof getcjmp);
2396}
2397
2398restore_getcjmp (temp)
2399 jmp_buf temp;
2400{
2401 bcopy (temp, getcjmp, sizeof getcjmp);
2402}
284f4730 2403\f
2eb6bfbe
RM
2404#ifdef HAVE_MOUSE
2405
284f4730
JB
2406/* Restore mouse tracking enablement. See Ftrack_mouse for the only use
2407 of this function. */
a9d77f1f 2408
284f4730
JB
2409static Lisp_Object
2410tracking_off (old_value)
2411 Lisp_Object old_value;
2412{
71edead1
RS
2413 do_mouse_tracking = old_value;
2414 if (NILP (old_value))
284f4730 2415 {
284f4730
JB
2416 /* Redisplay may have been preempted because there was input
2417 available, and it assumes it will be called again after the
2418 input has been processed. If the only input available was
2419 the sort that we have just disabled, then we need to call
2420 redisplay. */
d9d4c147 2421 if (!readable_events (1))
284f4730
JB
2422 {
2423 redisplay_preserve_echo_area ();
d9d4c147 2424 get_input_pending (&input_pending, 1);
284f4730
JB
2425 }
2426 }
2427}
2428
2429DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
4bb994d1
JB
2430 "Evaluate BODY with mouse movement events enabled.\n\
2431Within a `track-mouse' form, mouse motion generates input events that\n\
2432you can read with `read-event'.\n\
2433Normally, mouse motion is ignored.")
284f4730
JB
2434 (args)
2435 Lisp_Object args;
2436{
2437 int count = specpdl_ptr - specpdl;
2438 Lisp_Object val;
2439
a9d77f1f 2440 record_unwind_protect (tracking_off, do_mouse_tracking);
284f4730 2441
f3253854 2442 do_mouse_tracking = Qt;
df0f2ba1 2443
284f4730
JB
2444 val = Fprogn (args);
2445 return unbind_to (count, val);
2446}
2eb6bfbe 2447
f3253854
KH
2448/* If mouse has moved on some frame, return one of those frames.
2449 Return 0 otherwise. */
2450
2451static FRAME_PTR
2452some_mouse_moved ()
2453{
2454 Lisp_Object tail, frame;
2455
2456 FOR_EACH_FRAME (tail, frame)
2457 {
2458 if (XFRAME (frame)->mouse_moved)
2459 return XFRAME (frame);
2460 }
2461
2462 return 0;
2463}
2464
2eb6bfbe 2465#endif /* HAVE_MOUSE */
a612e298
RS
2466\f
2467/* Low level keyboard/mouse input.
2468 kbd_buffer_store_event places events in kbd_buffer, and
0646c0dd 2469 kbd_buffer_get_event retrieves them. */
a612e298
RS
2470
2471/* Return true iff there are any events in the queue that read-char
2472 would return. If this returns false, a read-char would block. */
2473static int
d9d4c147
KH
2474readable_events (do_timers_now)
2475 int do_timers_now;
a612e298 2476{
4ec4ed6a
RS
2477 if (do_timers_now)
2478 timer_check (do_timers_now);
2479
beecf6a1
KH
2480 if (kbd_fetch_ptr != kbd_store_ptr)
2481 return 1;
2482#ifdef HAVE_MOUSE
f3253854 2483 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
beecf6a1
KH
2484 return 1;
2485#endif
1e8bd3da 2486 if (single_kboard)
4c52b668 2487 {
c5fdd383 2488 if (current_kboard->kbd_queue_has_data)
4c52b668
KH
2489 return 1;
2490 }
2491 else
2492 {
c5fdd383
KH
2493 KBOARD *kb;
2494 for (kb = all_kboards; kb; kb = kb->next_kboard)
2495 if (kb->kbd_queue_has_data)
4c52b668
KH
2496 return 1;
2497 }
beecf6a1 2498 return 0;
a612e298
RS
2499}
2500
2501/* Set this for debugging, to have a way to get out */
2502int stop_character;
284f4730 2503
c5fdd383
KH
2504#ifdef MULTI_KBOARD
2505static KBOARD *
2506event_to_kboard (event)
5798cf15
KH
2507 struct input_event *event;
2508{
2509 Lisp_Object frame;
2510 frame = event->frame_or_window;
2511 if (CONSP (frame))
2512 frame = XCONS (frame)->car;
2513 else if (WINDOWP (frame))
2514 frame = WINDOW_FRAME (XWINDOW (frame));
2515
2516 /* There are still some events that don't set this field.
f5b56972
KH
2517 For now, just ignore the problem.
2518 Also ignore dead frames here. */
2519 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
5798cf15
KH
2520 return 0;
2521 else
c5fdd383 2522 return FRAME_KBOARD (XFRAME (frame));
5798cf15
KH
2523}
2524#endif
2525
284f4730
JB
2526/* Store an event obtained at interrupt level into kbd_buffer, fifo */
2527
2528void
2529kbd_buffer_store_event (event)
2530 register struct input_event *event;
2531{
2532 if (event->kind == no_event)
2533 abort ();
2534
2535 if (event->kind == ascii_keystroke)
2536 {
e9bf89a0 2537 register int c = event->code & 0377;
284f4730 2538
faf5e407
JB
2539 if (event->modifiers & ctrl_modifier)
2540 c = make_ctrl_char (c);
2541
9fd7d808
RS
2542 c |= (event->modifiers
2543 & (meta_modifier | alt_modifier
2544 | hyper_modifier | super_modifier));
2545
86e5706b 2546 if (c == quit_char)
284f4730 2547 {
3e51c7b7 2548 extern SIGTYPE interrupt_signal ();
c5fdd383
KH
2549#ifdef MULTI_KBOARD
2550 KBOARD *kb;
5798cf15
KH
2551 struct input_event *sp;
2552
1e8bd3da 2553 if (single_kboard
c5fdd383
KH
2554 && (kb = FRAME_KBOARD (XFRAME (event->frame_or_window)),
2555 kb != current_kboard))
5798cf15 2556 {
c5fdd383 2557 kb->kbd_queue
5798cf15
KH
2558 = Fcons (make_lispy_switch_frame (event->frame_or_window),
2559 Fcons (make_number (c), Qnil));
c5fdd383 2560 kb->kbd_queue_has_data = 1;
5798cf15
KH
2561 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
2562 {
2563 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
2564 sp = kbd_buffer;
2565
c5fdd383 2566 if (event_to_kboard (sp) == kb)
5798cf15
KH
2567 {
2568 sp->kind = no_event;
2569 sp->frame_or_window = Qnil;
2570 }
2571 }
2572 return;
2573 }
2574#endif
3e51c7b7 2575
284f4730 2576 /* If this results in a quit_char being returned to Emacs as
3c370943 2577 input, set Vlast_event_frame properly. If this doesn't
284f4730 2578 get returned to Emacs as an event, the next event read
ff11dfa1 2579 will set Vlast_event_frame again, so this is safe to do. */
4bb994d1 2580 {
9b8eb840 2581 Lisp_Object focus;
4bb994d1 2582
9b8eb840 2583 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
4bb994d1 2584 if (NILP (focus))
beecf6a1 2585 focus = event->frame_or_window;
4c52b668
KH
2586 internal_last_event_frame = focus;
2587 Vlast_event_frame = focus;
4bb994d1 2588 }
3e51c7b7 2589
ffd56f97 2590 last_event_timestamp = event->timestamp;
284f4730
JB
2591 interrupt_signal ();
2592 return;
2593 }
2594
2595 if (c && c == stop_character)
2596 {
2597 sys_suspend ();
2598 return;
2599 }
284f4730 2600 }
3fe8e9a2
RS
2601 /* Don't insert two buffer_switch_event's in a row.
2602 Just ignore the second one. */
2603 else if (event->kind == buffer_switch_event
2604 && kbd_fetch_ptr != kbd_store_ptr
2605 && kbd_store_ptr->kind == buffer_switch_event)
2606 return;
284f4730 2607
beecf6a1
KH
2608 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
2609 kbd_store_ptr = kbd_buffer;
284f4730
JB
2610
2611 /* Don't let the very last slot in the buffer become full,
2612 since that would make the two pointers equal,
2613 and that is indistinguishable from an empty buffer.
2614 Discard the event if it would fill the last slot. */
beecf6a1 2615 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
284f4730 2616 {
beecf6a1 2617 volatile struct input_event *sp = kbd_store_ptr;
612b78ef 2618 sp->kind = event->kind;
27203ead
RS
2619 if (event->kind == selection_request_event)
2620 {
2621 /* We must not use the ordinary copying code for this case,
2622 since `part' is an enum and copying it might not copy enough
2623 in this case. */
612b78ef 2624 bcopy (event, (char *) sp, sizeof (*event));
27203ead
RS
2625 }
2626 else
2627 {
612b78ef
KH
2628 sp->code = event->code;
2629 sp->part = event->part;
2630 sp->frame_or_window = event->frame_or_window;
2631 sp->modifiers = event->modifiers;
2632 sp->x = event->x;
2633 sp->y = event->y;
2634 sp->timestamp = event->timestamp;
27203ead 2635 }
beecf6a1
KH
2636 (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_store_ptr
2637 - kbd_buffer]
7b4aedb9 2638 = event->frame_or_window);
284f4730 2639
beecf6a1 2640 kbd_store_ptr++;
284f4730
JB
2641 }
2642}
a612e298 2643\f
07de30b9
GV
2644/* Discard any mouse events in the event buffer by setting them to
2645 no_event. */
2646void
2647discard_mouse_events ()
2648{
2649 struct input_event *sp;
2650 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
2651 {
2652 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
2653 sp = kbd_buffer;
2654
2655 if (sp->kind == mouse_click
2656#ifdef WINDOWSNT
2657 || sp->kind == w32_scroll_bar_click
2658#endif
2659 || sp->kind == scroll_bar_click)
2660 {
2661 sp->kind = no_event;
2662 }
2663 }
2664}
2665\f
a612e298
RS
2666/* Read one event from the event buffer, waiting if necessary.
2667 The value is a Lisp object representing the event.
2668 The value is nil for an event that should be ignored,
2669 or that was handled here.
2670 We always read and discard one event. */
284f4730
JB
2671
2672static Lisp_Object
83d68044 2673kbd_buffer_get_event (kbp, used_mouse_menu)
410d4de9 2674 KBOARD **kbp;
83d68044 2675 int *used_mouse_menu;
284f4730
JB
2676{
2677 register int c;
2678 Lisp_Object obj;
c04cbc3b 2679 EMACS_TIME next_timer_delay;
284f4730
JB
2680
2681 if (noninteractive)
2682 {
2683 c = getchar ();
18cd2eeb 2684 XSETINT (obj, c);
f5b56972 2685 *kbp = current_kboard;
284f4730
JB
2686 return obj;
2687 }
2688
2689 /* Wait until there is input available. */
2690 for (;;)
2691 {
beecf6a1
KH
2692 if (kbd_fetch_ptr != kbd_store_ptr)
2693 break;
2694#ifdef HAVE_MOUSE
f3253854 2695 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
284f4730 2696 break;
beecf6a1 2697#endif
284f4730
JB
2698
2699 /* If the quit flag is set, then read_char will return
2700 quit_char, so that counts as "available input." */
2701 if (!NILP (Vquit_flag))
2702 quit_throw_to_read_char ();
2703
2704 /* One way or another, wait until input is available; then, if
2705 interrupt handlers have not read it, read it now. */
2706
2707#ifdef OLDVMS
2708 wait_for_kbd_input ();
2709#else
2710/* Note SIGIO has been undef'd if FIONREAD is missing. */
2711#ifdef SIGIO
2712 gobble_input (0);
2713#endif /* SIGIO */
beecf6a1
KH
2714 if (kbd_fetch_ptr != kbd_store_ptr)
2715 break;
2716#ifdef HAVE_MOUSE
f3253854 2717 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
beecf6a1
KH
2718 break;
2719#endif
2720 {
2721 Lisp_Object minus_one;
f76475ad 2722
beecf6a1 2723 XSETINT (minus_one, -1);
d9d4c147 2724 wait_reading_process_input (0, 0, minus_one, 1);
284f4730 2725
beecf6a1
KH
2726 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
2727 /* Pass 1 for EXPECT since we just waited to have input. */
2728 read_avail_input (1);
2729 }
284f4730
JB
2730#endif /* not VMS */
2731 }
2732
303b5b3f
RS
2733 if (CONSP (Vunread_command_events))
2734 {
2735 Lisp_Object first;
2736 first = XCONS (Vunread_command_events)->car;
2737 Vunread_command_events = XCONS (Vunread_command_events)->cdr;
2738 *kbp = current_kboard;
2739 return first;
2740 }
2741
284f4730
JB
2742 /* At this point, we know that there is a readable event available
2743 somewhere. If the event queue is empty, then there must be a
2744 mouse movement enabled and available. */
beecf6a1 2745 if (kbd_fetch_ptr != kbd_store_ptr)
284f4730 2746 {
cd21b839 2747 struct input_event *event;
3e51c7b7 2748
beecf6a1
KH
2749 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
2750 ? kbd_fetch_ptr
2751 : kbd_buffer);
3e51c7b7 2752
cd21b839 2753 last_event_timestamp = event->timestamp;
cd21b839 2754
c5fdd383
KH
2755#ifdef MULTI_KBOARD
2756 *kbp = event_to_kboard (event);
2757 if (*kbp == 0)
2758 *kbp = current_kboard; /* Better than returning null ptr? */
5798cf15 2759#else
c5fdd383 2760 *kbp = &the_only_kboard;
5798cf15 2761#endif
beecf6a1 2762
4bb994d1
JB
2763 obj = Qnil;
2764
48e416d4 2765 /* These two kinds of events get special handling
a612e298
RS
2766 and don't actually appear to the command loop.
2767 We return nil for them. */
48e416d4
RS
2768 if (event->kind == selection_request_event)
2769 {
598a9fa7 2770#ifdef HAVE_X11
1e8bd3da
RS
2771 struct input_event copy;
2772
4581e928
RS
2773 /* Remove it from the buffer before processing it,
2774 since otherwise swallow_events will see it
2775 and process it again. */
1e8bd3da 2776 copy = *event;
beecf6a1 2777 kbd_fetch_ptr = event + 1;
d9d4c147 2778 input_pending = readable_events (0);
4581e928 2779 x_handle_selection_request (&copy);
598a9fa7
JB
2780#else
2781 /* We're getting selection request events, but we don't have
2782 a window system. */
2783 abort ();
2784#endif
48e416d4
RS
2785 }
2786
1e12dd87 2787 else if (event->kind == selection_clear_event)
48e416d4 2788 {
598a9fa7 2789#ifdef HAVE_X11
e0301c07
RS
2790 struct input_event copy;
2791
2792 /* Remove it from the buffer before processing it. */
2793 copy = *event;
beecf6a1 2794 kbd_fetch_ptr = event + 1;
d9d4c147 2795 input_pending = readable_events (0);
90c2bb0c 2796 x_handle_selection_clear (&copy);
598a9fa7
JB
2797#else
2798 /* We're getting selection request events, but we don't have
2799 a window system. */
2800 abort ();
2801#endif
48e416d4 2802 }
e98a93eb 2803#if defined (HAVE_X11) || defined (HAVE_NTGUI)
990acea3
RS
2804 else if (event->kind == delete_window_event)
2805 {
bbdc2092
RS
2806 /* Make an event (delete-frame (FRAME)). */
2807 obj = Fcons (event->frame_or_window, Qnil);
af17bd2b 2808 obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
beecf6a1 2809 kbd_fetch_ptr = event + 1;
af17bd2b
KH
2810 }
2811 else if (event->kind == iconify_event)
2812 {
2813 /* Make an event (iconify-frame (FRAME)). */
2814 obj = Fcons (event->frame_or_window, Qnil);
2815 obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
beecf6a1 2816 kbd_fetch_ptr = event + 1;
af17bd2b
KH
2817 }
2818 else if (event->kind == deiconify_event)
2819 {
2820 /* Make an event (make-frame-visible (FRAME)). */
2821 obj = Fcons (event->frame_or_window, Qnil);
2822 obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
beecf6a1 2823 kbd_fetch_ptr = event + 1;
990acea3
RS
2824 }
2825#endif
a8015ab5
KH
2826 else if (event->kind == buffer_switch_event)
2827 {
2828 /* The value doesn't matter here; only the type is tested. */
18cd2eeb 2829 XSETBUFFER (obj, current_buffer);
beecf6a1 2830 kbd_fetch_ptr = event + 1;
a8015ab5 2831 }
07de30b9 2832#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI)
099787c1
RS
2833 else if (event->kind == menu_bar_activate_event)
2834 {
2835 kbd_fetch_ptr = event + 1;
d9d4c147 2836 input_pending = readable_events (0);
e649d076
RS
2837 if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
2838 x_activate_menubar (XFRAME (event->frame_or_window));
099787c1
RS
2839 }
2840#endif
a612e298 2841 /* Just discard these, by returning nil.
c5fdd383 2842 With MULTI_KBOARD, these events are used as placeholders
5798cf15
KH
2843 when we need to randomly delete events from the queue.
2844 (They shouldn't otherwise be found in the buffer,
2845 but on some machines it appears they do show up
c5fdd383 2846 even without MULTI_KBOARD.) */
07de30b9
GV
2847 /* On Windows NT/9X, no_event is used to delete extraneous
2848 mouse events during a popup-menu call. */
a612e298 2849 else if (event->kind == no_event)
beecf6a1 2850 kbd_fetch_ptr = event + 1;
48e416d4 2851
4bb994d1
JB
2852 /* If this event is on a different frame, return a switch-frame this
2853 time, and leave the event in the queue for next time. */
1e12dd87
RS
2854 else
2855 {
9b8eb840 2856 Lisp_Object frame;
1e12dd87 2857 Lisp_Object focus;
7b4aedb9 2858
9b8eb840 2859 frame = event->frame_or_window;
2470a66f
KH
2860 if (CONSP (frame))
2861 frame = XCONS (frame)->car;
2862 else if (WINDOWP (frame))
1e12dd87 2863 frame = WINDOW_FRAME (XWINDOW (frame));
4bb994d1 2864
1e12dd87
RS
2865 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
2866 if (! NILP (focus))
2867 frame = focus;
07d2b8de 2868
4c52b668 2869 if (! EQ (frame, internal_last_event_frame)
1e12dd87
RS
2870 && XFRAME (frame) != selected_frame)
2871 obj = make_lispy_switch_frame (frame);
4c52b668 2872 internal_last_event_frame = frame;
4bb994d1 2873
1e12dd87
RS
2874 /* If we didn't decide to make a switch-frame event, go ahead
2875 and build a real event from the queue entry. */
cd21b839 2876
1e12dd87
RS
2877 if (NILP (obj))
2878 {
2879 obj = make_lispy_event (event);
e98a93eb 2880#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI)
83d68044
KH
2881 /* If this was a menu selection, then set the flag to inhibit
2882 writing to last_nonmenu_event. Don't do this if the event
2883 we're returning is (menu-bar), though; that indicates the
2884 beginning of the menu sequence, and we might as well leave
2885 that as the `event with parameters' for this selection. */
2886 if (event->kind == menu_bar_event
2887 && !(CONSP (obj) && EQ (XCONS (obj)->car, Qmenu_bar))
2888 && used_mouse_menu)
2889 *used_mouse_menu = 1;
2890#endif
1e12dd87
RS
2891
2892 /* Wipe out this event, to catch bugs. */
2893 event->kind = no_event;
beecf6a1 2894 XVECTOR (kbd_buffer_frame_or_window)->contents[event - kbd_buffer] = Qnil;
1e12dd87 2895
beecf6a1 2896 kbd_fetch_ptr = event + 1;
1e12dd87 2897 }
4bb994d1 2898 }
284f4730 2899 }
2eb6bfbe 2900#ifdef HAVE_MOUSE
a612e298 2901 /* Try generating a mouse motion event. */
f3253854 2902 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
284f4730 2903 {
f3253854 2904 FRAME_PTR f = some_mouse_moved ();
7b4aedb9 2905 Lisp_Object bar_window;
3c370943 2906 enum scroll_bar_part part;
e5d77022
JB
2907 Lisp_Object x, y;
2908 unsigned long time;
284f4730 2909
c5fdd383 2910 *kbp = current_kboard;
e177ac3a
RS
2911 /* Note that this uses F to determine which display to look at.
2912 If there is no valid info, it does not store anything
2913 so x remains nil. */
2914 x = Qnil;
dd26ab75 2915 (*mouse_position_hook) (&f, 0, &bar_window, &part, &x, &y, &time);
4bb994d1
JB
2916
2917 obj = Qnil;
284f4730 2918
4bb994d1
JB
2919 /* Decide if we should generate a switch-frame event. Don't
2920 generate switch-frame events for motion outside of all Emacs
2921 frames. */
e177ac3a 2922 if (!NILP (x) && f)
cd21b839 2923 {
9b8eb840 2924 Lisp_Object frame;
4bb994d1 2925
9b8eb840 2926 frame = FRAME_FOCUS_FRAME (f);
4bb994d1 2927 if (NILP (frame))
18cd2eeb 2928 XSETFRAME (frame, f);
4bb994d1 2929
4c52b668 2930 if (! EQ (frame, internal_last_event_frame)
80645119 2931 && XFRAME (frame) != selected_frame)
764cb3f9 2932 obj = make_lispy_switch_frame (frame);
4c52b668 2933 internal_last_event_frame = frame;
cd21b839 2934 }
4bb994d1 2935
df0f2ba1 2936 /* If we didn't decide to make a switch-frame event, go ahead and
4bb994d1 2937 return a mouse-motion event. */
e177ac3a 2938 if (!NILP (x) && NILP (obj))
7b4aedb9 2939 obj = make_lispy_movement (f, bar_window, part, x, y, time);
6cbff1cb 2940 }
2eb6bfbe 2941#endif /* HAVE_MOUSE */
284f4730
JB
2942 else
2943 /* We were promised by the above while loop that there was
2944 something for us to read! */
2945 abort ();
2946
d9d4c147 2947 input_pending = readable_events (0);
284f4730 2948
4c52b668 2949 Vlast_event_frame = internal_last_event_frame;
3c370943 2950
284f4730
JB
2951 return (obj);
2952}
a612e298
RS
2953\f
2954/* Process any events that are not user-visible,
2955 then return, without reading any user-visible events. */
3a3b9632
RS
2956
2957void
d9d4c147
KH
2958swallow_events (do_display)
2959 int do_display;
3a3b9632 2960{
87dd9b9b
RS
2961 int old_timers_run;
2962
beecf6a1 2963 while (kbd_fetch_ptr != kbd_store_ptr)
3a3b9632
RS
2964 {
2965 struct input_event *event;
2966
beecf6a1
KH
2967 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
2968 ? kbd_fetch_ptr
2969 : kbd_buffer);
3a3b9632
RS
2970
2971 last_event_timestamp = event->timestamp;
2972
2973 /* These two kinds of events get special handling
2974 and don't actually appear to the command loop. */
2975 if (event->kind == selection_request_event)
2976 {
2977#ifdef HAVE_X11
4581e928 2978 struct input_event copy;
e0301c07
RS
2979
2980 /* Remove it from the buffer before processing it,
2981 since otherwise swallow_events called recursively could see it
2982 and process it again. */
4581e928 2983 copy = *event;
beecf6a1 2984 kbd_fetch_ptr = event + 1;
d9d4c147 2985 input_pending = readable_events (0);
4581e928 2986 x_handle_selection_request (&copy);
3a3b9632
RS
2987#else
2988 /* We're getting selection request events, but we don't have
2989 a window system. */
2990 abort ();
2991#endif
2992 }
2993
2994 else if (event->kind == selection_clear_event)
2995 {
2996#ifdef HAVE_X11
e0301c07
RS
2997 struct input_event copy;
2998
2999 /* Remove it from the buffer before processing it, */
3000 copy = *event;
3001
beecf6a1 3002 kbd_fetch_ptr = event + 1;
d9d4c147 3003 input_pending = readable_events (0);
90c2bb0c 3004 x_handle_selection_clear (&copy);
3a3b9632
RS
3005#else
3006 /* We're getting selection request events, but we don't have
3007 a window system. */
3008 abort ();
3009#endif
3010 }
3011 else
3012 break;
3013 }
3014
87dd9b9b 3015 old_timers_run = timers_run;
d9d4c147 3016 get_input_pending (&input_pending, 1);
87dd9b9b
RS
3017
3018 if (timers_run != old_timers_run && do_display)
3019 redisplay_preserve_echo_area ();
3a3b9632 3020}
a612e298 3021\f
d9d4c147
KH
3022static EMACS_TIME timer_idleness_start_time;
3023
3024/* Record the start of when Emacs is idle,
3025 for the sake of running idle-time timers. */
3026
3027timer_start_idle ()
3028{
3029 Lisp_Object timers;
3030
3031 /* If we are already in the idle state, do nothing. */
3032 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3033 return;
3034
3035 EMACS_GET_TIME (timer_idleness_start_time);
3036
3037 /* Mark all idle-time timers as once again candidates for running. */
3038 for (timers = Vtimer_idle_list; CONSP (timers); timers = XCONS (timers)->cdr)
3039 {
3040 Lisp_Object timer;
3041
3042 timer = XCONS (timers)->car;
3043
3044 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3045 continue;
3046 XVECTOR (timer)->contents[0] = Qnil;
3047 }
3048}
3049
3050/* Record that Emacs is no longer idle, so stop running idle-time timers. */
3051
3052timer_stop_idle ()
3053{
3054 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
3055}
3056
e044e87c
RS
3057/* This is only for debugging. */
3058struct input_event last_timer_event;
3059
c04cbc3b
RS
3060/* Check whether a timer has fired. To prevent larger problems we simply
3061 disregard elements that are not proper timers. Do not make a circular
3062 timer list for the time being.
3063
3064 Returns the number of seconds to wait until the next timer fires. If a
3065 timer is triggering now, return zero seconds.
3066 If no timer is active, return -1 seconds.
3067
4ec4ed6a
RS
3068 If a timer is ripe, we run it, with quitting turned off.
3069
3070 DO_IT_NOW is now ignored. It used to mean that we should
3071 run the timer directly instead of queueing a timer-event.
3072 Now we always run timers directly. */
c04cbc3b
RS
3073
3074EMACS_TIME
3075timer_check (do_it_now)
3076 int do_it_now;
3077{
3078 EMACS_TIME nexttime;
9291c072
RS
3079 EMACS_TIME now, idleness_now;
3080 Lisp_Object timers, idle_timers, chosen_timer;
9291c072 3081 struct gcpro gcpro1, gcpro2, gcpro3;
c04cbc3b 3082
c04cbc3b
RS
3083 EMACS_SET_SECS (nexttime, -1);
3084 EMACS_SET_USECS (nexttime, -1);
3085
9291c072 3086 /* Always consider the ordinary timers. */
7ea13e12 3087 timers = Vtimer_list;
9291c072
RS
3088 /* Consider the idle timers only if Emacs is idle. */
3089 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3090 idle_timers = Vtimer_idle_list;
3091 else
3092 idle_timers = Qnil;
3093 chosen_timer = Qnil;
3094 GCPRO3 (timers, idle_timers, chosen_timer);
7ea13e12 3095
9291c072 3096 if (CONSP (timers) || CONSP (idle_timers))
c04cbc3b 3097 {
9291c072
RS
3098 EMACS_GET_TIME (now);
3099 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3100 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
3101 }
c04cbc3b 3102
9291c072
RS
3103 while (CONSP (timers) || CONSP (idle_timers))
3104 {
3105 int triggertime = EMACS_SECS (now);
3106 Lisp_Object *vector;
3107 Lisp_Object timer, idle_timer;
3108 EMACS_TIME timer_time, idle_timer_time;
3109 EMACS_TIME difference, timer_difference, idle_timer_difference;
3110
3111 /* Skip past invalid timers and timers already handled. */
3112 if (!NILP (timers))
c04cbc3b 3113 {
d9d4c147 3114 timer = XCONS (timers)->car;
9291c072
RS
3115 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3116 {
3117 timers = XCONS (timers)->cdr;
3118 continue;
3119 }
3120 vector = XVECTOR (timer)->contents;
d9d4c147 3121
9291c072
RS
3122 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
3123 || !INTEGERP (vector[3])
3124 || ! NILP (vector[0]))
3125 {
3126 timers = XCONS (timers)->cdr;
3127 continue;
3128 }
3129 }
3130 if (!NILP (idle_timers))
3131 {
3132 timer = XCONS (idle_timers)->car;
d9d4c147 3133 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
9291c072
RS
3134 {
3135 idle_timers = XCONS (idle_timers)->cdr;
3136 continue;
3137 }
d9d4c147
KH
3138 vector = XVECTOR (timer)->contents;
3139
3140 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
9291c072
RS
3141 || !INTEGERP (vector[3])
3142 || ! NILP (vector[0]))
3143 {
3144 idle_timers = XCONS (idle_timers)->cdr;
3145 continue;
3146 }
3147 }
d9d4c147 3148
9291c072
RS
3149 /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
3150 based on the next ordinary timer.
3151 TIMER_DIFFERENCE is the distance in time from NOW to when
3152 this timer becomes ripe (negative if it's already ripe). */
3153 if (!NILP (timers))
3154 {
3155 timer = XCONS (timers)->car;
3156 vector = XVECTOR (timer)->contents;
d9d4c147
KH
3157 EMACS_SET_SECS (timer_time,
3158 (XINT (vector[1]) << 16) | (XINT (vector[2])));
3159 EMACS_SET_USECS (timer_time, XINT (vector[3]));
9291c072
RS
3160 EMACS_SUB_TIME (timer_difference, timer_time, now);
3161 }
ba8dfba8 3162
9291c072
RS
3163 /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
3164 based on the next idle timer. */
3165 if (!NILP (idle_timers))
3166 {
3167 idle_timer = XCONS (idle_timers)->car;
3168 vector = XVECTOR (idle_timer)->contents;
3169 EMACS_SET_SECS (idle_timer_time,
3170 (XINT (vector[1]) << 16) | (XINT (vector[2])));
3171 EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
3172 EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
3173 }
ba8dfba8 3174
9291c072
RS
3175 /* Decide which timer is the next timer,
3176 and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
3177 Also step down the list where we found that timer. */
d9d4c147 3178
9291c072
RS
3179 if (! NILP (timers) && ! NILP (idle_timers))
3180 {
3181 EMACS_TIME temp;
3182 EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
3183 if (EMACS_TIME_NEG_P (temp))
3184 {
3185 chosen_timer = timer;
3186 timers = XCONS (timers)->cdr;
3187 difference = timer_difference;
c04cbc3b 3188 }
d9d4c147 3189 else
d9d4c147 3190 {
9291c072
RS
3191 chosen_timer = idle_timer;
3192 idle_timers = XCONS (idle_timers)->cdr;
3193 difference = idle_timer_difference;
d9d4c147 3194 }
7ea13e12 3195 }
9291c072
RS
3196 else if (! NILP (timers))
3197 {
3198 chosen_timer = timer;
3199 timers = XCONS (timers)->cdr;
3200 difference = timer_difference;
3201 }
3202 else
3203 {
3204 chosen_timer = idle_timer;
3205 idle_timers = XCONS (idle_timers)->cdr;
3206 difference = idle_timer_difference;
3207 }
3208 vector = XVECTOR (chosen_timer)->contents;
3209
3210 /* If timer is rupe, run it if it hasn't been run. */
3211 if (EMACS_TIME_NEG_P (difference)
3212 || (EMACS_SECS (difference) == 0
3213 && EMACS_USECS (difference) == 0))
3214 {
3215 if (NILP (vector[0]))
3216 {
d925fb39
RS
3217 Lisp_Object tem;
3218 int was_locked = single_kboard;
3219 int count = specpdl_ptr - specpdl;
3220
9291c072
RS
3221 /* Mark the timer as triggered to prevent problems if the lisp
3222 code fails to reschedule it right. */
3223 vector[0] = Qt;
3224
d925fb39 3225 specbind (Qinhibit_quit, Qt);
9291c072 3226
d925fb39
RS
3227 call1 (Qtimer_event_handler, chosen_timer);
3228 timers_run++;
9291c072 3229
d925fb39 3230 unbind_to (count, Qnil);
4ec4ed6a 3231
d925fb39
RS
3232 /* Resume allowing input from any kboard, if that was true before. */
3233 if (!was_locked)
3234 any_kboard_state ();
9291c072 3235
d925fb39
RS
3236 /* Since we have handled the event,
3237 we don't need to tell the caller to wake up and do it. */
9291c072
RS
3238 }
3239 }
3240 else
3241 /* When we encounter a timer that is still waiting,
3242 return the amount of time to wait before it is ripe. */
3243 {
3244 UNGCPRO;
9291c072
RS
3245 return difference;
3246 }
c04cbc3b 3247 }
9291c072 3248
7ea13e12
RS
3249 /* No timers are pending in the future. */
3250 /* Return 0 if we generated an event, and -1 if not. */
3251 UNGCPRO;
c04cbc3b
RS
3252 return nexttime;
3253}
3254\f
284f4730 3255/* Caches for modify_event_symbol. */
e9bf89a0 3256static Lisp_Object accent_key_syms;
284f4730
JB
3257static Lisp_Object func_key_syms;
3258static Lisp_Object mouse_syms;
07de30b9
GV
3259#ifdef WINDOWSNT
3260static Lisp_Object mouse_wheel_syms;
3261#endif
284f4730 3262
e9bf89a0
RS
3263/* This is a list of keysym codes for special "accent" characters.
3264 It parallels lispy_accent_keys. */
3265
3266static int lispy_accent_codes[] =
3267{
79a7046c 3268#ifdef XK_dead_circumflex
e9bf89a0 3269 XK_dead_circumflex,
79a7046c
RS
3270#else
3271 0,
3272#endif
3273#ifdef XK_dead_grave
e9bf89a0 3274 XK_dead_grave,
79a7046c
RS
3275#else
3276 0,
3277#endif
3278#ifdef XK_dead_tilde
e9bf89a0 3279 XK_dead_tilde,
79a7046c
RS
3280#else
3281 0,
3282#endif
3283#ifdef XK_dead_diaeresis
e9bf89a0 3284 XK_dead_diaeresis,
79a7046c
RS
3285#else
3286 0,
3287#endif
3288#ifdef XK_dead_macron
e9bf89a0 3289 XK_dead_macron,
79a7046c
RS
3290#else
3291 0,
3292#endif
3293#ifdef XK_dead_degree
e9bf89a0 3294 XK_dead_degree,
79a7046c
RS
3295#else
3296 0,
3297#endif
3298#ifdef XK_dead_acute
e9bf89a0 3299 XK_dead_acute,
79a7046c
RS
3300#else
3301 0,
3302#endif
3303#ifdef XK_dead_cedilla
e9bf89a0 3304 XK_dead_cedilla,
79a7046c
RS
3305#else
3306 0,
3307#endif
3308#ifdef XK_dead_breve
e9bf89a0 3309 XK_dead_breve,
79a7046c
RS
3310#else
3311 0,
3312#endif
3313#ifdef XK_dead_ogonek
e9bf89a0 3314 XK_dead_ogonek,
79a7046c
RS
3315#else
3316 0,
3317#endif
3318#ifdef XK_dead_caron
e9bf89a0 3319 XK_dead_caron,
79a7046c
RS
3320#else
3321 0,
3322#endif
3323#ifdef XK_dead_doubleacute
e9bf89a0 3324 XK_dead_doubleacute,
79a7046c
RS
3325#else
3326 0,
3327#endif
3328#ifdef XK_dead_abovedot
e9bf89a0 3329 XK_dead_abovedot,
79a7046c
RS
3330#else
3331 0,
3332#endif
e9bf89a0
RS
3333};
3334
3335/* This is a list of Lisp names for special "accent" characters.
3336 It parallels lispy_accent_codes. */
3337
3338static char *lispy_accent_keys[] =
3339{
3340 "dead-circumflex",
3341 "dead-grave",
3342 "dead-tilde",
3343 "dead-diaeresis",
3344 "dead-macron",
3345 "dead-degree",
3346 "dead-acute",
3347 "dead-cedilla",
3348 "dead-breve",
3349 "dead-ogonek",
3350 "dead-caron",
3351 "dead-doubleacute",
3352 "dead-abovedot",
3353};
3354
e98a93eb
GV
3355#ifdef HAVE_NTGUI
3356#define FUNCTION_KEY_OFFSET 0x0
3357
3358char *lispy_function_keys[] =
3359 {
3360 0, /* 0 */
3361
3362 0, /* VK_LBUTTON 0x01 */
3363 0, /* VK_RBUTTON 0x02 */
3364 "cancel", /* VK_CANCEL 0x03 */
3365 0, /* VK_MBUTTON 0x04 */
3366
3367 0, 0, 0, /* 0x05 .. 0x07 */
3368
3369 "backspace", /* VK_BACK 0x08 */
3370 "tab", /* VK_TAB 0x09 */
3371
3372 0, 0, /* 0x0A .. 0x0B */
3373
3374 "clear", /* VK_CLEAR 0x0C */
3375 "return", /* VK_RETURN 0x0D */
3376
3377 0, 0, /* 0x0E .. 0x0F */
3378
3379 "shift", /* VK_SHIFT 0x10 */
3380 "control", /* VK_CONTROL 0x11 */
3381 "menu", /* VK_MENU 0x12 */
3382 "pause", /* VK_PAUSE 0x13 */
3383 "capital", /* VK_CAPITAL 0x14 */
3384
3385 0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */
3386
3387 0, /* VK_ESCAPE 0x1B */
3388
3389 0, 0, 0, 0, /* 0x1C .. 0x1F */
3390
3391 0, /* VK_SPACE 0x20 */
3392 "prior", /* VK_PRIOR 0x21 */
3393 "next", /* VK_NEXT 0x22 */
3394 "end", /* VK_END 0x23 */
3395 "home", /* VK_HOME 0x24 */
3396 "left", /* VK_LEFT 0x25 */
3397 "up", /* VK_UP 0x26 */
3398 "right", /* VK_RIGHT 0x27 */
3399 "down", /* VK_DOWN 0x28 */
3400 "select", /* VK_SELECT 0x29 */
3401 "print", /* VK_PRINT 0x2A */
3402 "execute", /* VK_EXECUTE 0x2B */
3403 "snapshot", /* VK_SNAPSHOT 0x2C */
3404 "insert", /* VK_INSERT 0x2D */
3405 "delete", /* VK_DELETE 0x2E */
3406 "help", /* VK_HELP 0x2F */
3407
3408 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
3409
3410 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3411
3412 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
3413
3414 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
3415
3416 0, 0, 0, 0, 0, 0, 0, 0, 0,
3417 0, 0, 0, 0, 0, 0, 0, 0, 0,
3418 0, 0, 0, 0, 0, 0, 0, 0,
3419
e376f90d
RS
3420 "lwindow", /* VK_LWIN 0x5B */
3421 "rwindow", /* VK_RWIN 0x5C */
3422 "apps", /* VK_APPS 0x5D */
e98a93eb
GV
3423
3424 0, 0, /* 0x5E .. 0x5F */
3425
3426 "kp-0", /* VK_NUMPAD0 0x60 */
3427 "kp-1", /* VK_NUMPAD1 0x61 */
3428 "kp-2", /* VK_NUMPAD2 0x62 */
3429 "kp-3", /* VK_NUMPAD3 0x63 */
3430 "kp-4", /* VK_NUMPAD4 0x64 */
3431 "kp-5", /* VK_NUMPAD5 0x65 */
3432 "kp-6", /* VK_NUMPAD6 0x66 */
3433 "kp-7", /* VK_NUMPAD7 0x67 */
3434 "kp-8", /* VK_NUMPAD8 0x68 */
3435 "kp-9", /* VK_NUMPAD9 0x69 */
3436 "kp-multiply", /* VK_MULTIPLY 0x6A */
3437 "kp-add", /* VK_ADD 0x6B */
3438 "kp-separator", /* VK_SEPARATOR 0x6C */
3439 "kp-subtract", /* VK_SUBTRACT 0x6D */
3440 "kp-decimal", /* VK_DECIMAL 0x6E */
3441 "kp-divide", /* VK_DIVIDE 0x6F */
3442 "f1", /* VK_F1 0x70 */
3443 "f2", /* VK_F2 0x71 */
3444 "f3", /* VK_F3 0x72 */
3445 "f4", /* VK_F4 0x73 */
3446 "f5", /* VK_F5 0x74 */
3447 "f6", /* VK_F6 0x75 */
3448 "f7", /* VK_F7 0x76 */
3449 "f8", /* VK_F8 0x77 */
3450 "f9", /* VK_F9 0x78 */
3451 "f10", /* VK_F10 0x79 */
3452 "f11", /* VK_F11 0x7A */
3453 "f12", /* VK_F12 0x7B */
3454 "f13", /* VK_F13 0x7C */
3455 "f14", /* VK_F14 0x7D */
3456 "f15", /* VK_F15 0x7E */
3457 "f16", /* VK_F16 0x7F */
3458 "f17", /* VK_F17 0x80 */
3459 "f18", /* VK_F18 0x81 */
3460 "f19", /* VK_F19 0x82 */
3461 "f20", /* VK_F20 0x83 */
3462 "f21", /* VK_F21 0x84 */
3463 "f22", /* VK_F22 0x85 */
3464 "f23", /* VK_F23 0x86 */
3465 "f24", /* VK_F24 0x87 */
3466
3467 0, 0, 0, 0, /* 0x88 .. 0x8B */
3468 0, 0, 0, 0, /* 0x8C .. 0x8F */
3469
3470 "kp-numlock", /* VK_NUMLOCK 0x90 */
3471 "scroll", /* VK_SCROLL 0x91 */
3472
e376f90d
RS
3473 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
3474 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
3475 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
3476 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
3477 "kp-end", /* VK_NUMPAD_END 0x96 */
3478 "kp-home", /* VK_NUMPAD_HOME 0x97 */
3479 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
3480 "kp-up", /* VK_NUMPAD_UP 0x99 */
3481 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
3482 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
3483 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
3484 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
3485
3486 0, 0, /* 0x9E .. 0x9F */
3487
e98a93eb
GV
3488 /*
3489 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
3490 * Used only as parameters to GetAsyncKeyState() and GetKeyState().
3491 * No other API or message will distinguish left and right keys this way.
3492 */
3493 /* 0xA0 .. 0xEF */
3494
3495 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3496 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3497 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3498 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3499 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3500
3501 /* 0xF0 .. 0xF5 */
3502
3503 0, 0, 0, 0, 0, 0,
3504
3505 "attn", /* VK_ATTN 0xF6 */
3506 "crsel", /* VK_CRSEL 0xF7 */
3507 "exsel", /* VK_EXSEL 0xF8 */
3508 "ereof", /* VK_EREOF 0xF9 */
3509 "play", /* VK_PLAY 0xFA */
3510 "zoom", /* VK_ZOOM 0xFB */
3511 "noname", /* VK_NONAME 0xFC */
3512 "pa1", /* VK_PA1 0xFD */
3513 "oem_clear", /* VK_OEM_CLEAR 0xFE */
3514 };
3515
04f215f0 3516#else /* not HAVE_NTGUI */
e98a93eb 3517
37cd9f30
KH
3518#ifdef XK_kana_A
3519static char *lispy_kana_keys[] =
3520 {
3521 /* X Keysym value */
3522 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
3523 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
3524 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
3525 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
3526 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
3527 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
3528 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
3529 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
3530 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
3531 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
3532 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
3533 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
3534 "kana-i", "kana-u", "kana-e", "kana-o",
3535 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
3536 "prolongedsound", "kana-A", "kana-I", "kana-U",
3537 "kana-E", "kana-O", "kana-KA", "kana-KI",
3538 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
3539 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
3540 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
3541 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
3542 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
3543 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
3544 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
3545 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
3546 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
3547 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
3548 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
3549 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
3550 };
3551#endif /* XK_kana_A */
3552
04f215f0
RS
3553#define FUNCTION_KEY_OFFSET 0xff00
3554
284f4730
JB
3555/* You'll notice that this table is arranged to be conveniently
3556 indexed by X Windows keysym values. */
3557static char *lispy_function_keys[] =
3558 {
3559 /* X Keysym value */
3560
80e4aa30 3561 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00 */
86e5706b
RS
3562 "backspace",
3563 "tab",
3564 "linefeed",
3565 "clear",
3566 0,
3567 "return",
3568 0, 0,
3569 0, 0, 0, /* 0xff10 */
3570 "pause",
3571 0, 0, 0, 0, 0, 0, 0,
3572 "escape",
3573 0, 0, 0, 0,
37cd9f30
KH
3574 0, "kanji", "muhenkan",
3575 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff20...2f */
86e5706b
RS
3576 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff30...3f */
3577 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
3578
284f4730
JB
3579 "home", /* 0xff50 */ /* IsCursorKey */
3580 "left",
3581 "up",
3582 "right",
3583 "down",
3584 "prior",
3585 "next",
3586 "end",
3587 "begin",
3588 0, /* 0xff59 */
3589 0, 0, 0, 0, 0, 0,
3590 "select", /* 0xff60 */ /* IsMiscFunctionKey */
3591 "print",
3592 "execute",
3593 "insert",
3594 0, /* 0xff64 */
3595 "undo",
3596 "redo",
3597 "menu",
3598 "find",
3599 "cancel",
3600 "help",
3601 "break", /* 0xff6b */
3602
9fdbfdf8 3603 0, 0, 0, 0, 0, 0, 0, 0, "backtab", 0,
284f4730 3604 0, /* 0xff76 */
36ae397e 3605 0, 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff7f */
284f4730
JB
3606 "kp-space", /* 0xff80 */ /* IsKeypadKey */
3607 0, 0, 0, 0, 0, 0, 0, 0,
3608 "kp-tab", /* 0xff89 */
3609 0, 0, 0,
3610 "kp-enter", /* 0xff8d */
3611 0, 0, 0,
3612 "kp-f1", /* 0xff91 */
3613 "kp-f2",
3614 "kp-f3",
3615 "kp-f4",
872157e7
RS
3616 "kp-home", /* 0xff95 */
3617 "kp-left",
3618 "kp-up",
3619 "kp-right",
3620 "kp-down",
3621 "kp-prior", /* kp-page-up */
3622 "kp-next", /* kp-page-down */
3623 "kp-end",
3624 "kp-begin",
3625 "kp-insert",
3626 "kp-delete",
3627 0, /* 0xffa0 */
3628 0, 0, 0, 0, 0, 0, 0, 0, 0,
284f4730
JB
3629 "kp-multiply", /* 0xffaa */
3630 "kp-add",
3631 "kp-separator",
3632 "kp-subtract",
3633 "kp-decimal",
3634 "kp-divide", /* 0xffaf */
3635 "kp-0", /* 0xffb0 */
3636 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
3637 0, /* 0xffba */
3638 0, 0,
3639 "kp-equal", /* 0xffbd */
3640 "f1", /* 0xffbe */ /* IsFunctionKey */
86e5706b
RS
3641 "f2",
3642 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
3643 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
3644 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
3645 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
3646 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
3647 0, 0, 0, 0, 0, 0, 0, 0,
3648 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
3649 0, 0, 0, 0, 0, 0, 0, "delete"
04f215f0 3650 };
284f4730 3651
04f215f0
RS
3652/* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
3653#define ISO_FUNCTION_KEY_OFFSET 0xfe00
3654
3655static char *iso_lispy_function_keys[] =
3656 {
3657 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
3658 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
3659 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
3660 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
3661 "iso-lefttab", /* 0xfe20 */
3662 "iso-move-line-up", "iso-move-line-down",
3663 "iso-partial-line-up", "iso-partial-line-down",
3664 "iso-partial-space-left", "iso-partial-space-right",
3665 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
3666 "iso-release-margin-left", "iso-release-margin-right",
3667 "iso-release-both-margins",
3668 "iso-fast-cursor-left", "iso-fast-cursor-right",
3669 "iso-fast-cursor-up", "iso-fast-cursor-down",
3670 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
3671 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
3672 };
3673
3674#endif /* not HAVE_NTGUI */
e98a93eb 3675
df0f2ba1 3676static char *lispy_mouse_names[] =
284f4730
JB
3677{
3678 "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5"
3679};
3680
07de30b9
GV
3681#ifdef WINDOWSNT
3682/* mouse-wheel events are generated by the wheel on devices such as
3683 the MS Intellimouse. The wheel sits in between the left and right
3684 mouse buttons, and is typically used to scroll or zoom the window
3685 underneath the pointer. mouse-wheel events specify the object on
3686 which they operate, and a delta corresponding to the amount and
3687 direction that the wheel is rotated. Clicking the mouse-wheel
3688 generates a mouse-2 event. */
3689static char *lispy_mouse_wheel_names[] =
3690{
3691 "mouse-wheel"
3692};
3693#endif /* WINDOWSNT */
3694
3c370943 3695/* Scroll bar parts. */
4bb994d1 3696Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
db08707d 3697Lisp_Object Qup, Qdown;
4bb994d1 3698
3c370943
JB
3699/* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
3700Lisp_Object *scroll_bar_parts[] = {
db08707d
RS
3701 &Qabove_handle, &Qhandle, &Qbelow_handle,
3702 &Qup, &Qdown,
4bb994d1
JB
3703};
3704
3705
7b4aedb9 3706/* A vector, indexed by button number, giving the down-going location
3c370943 3707 of currently depressed buttons, both scroll bar and non-scroll bar.
7b4aedb9
JB
3708
3709 The elements have the form
3710 (BUTTON-NUMBER MODIFIER-MASK . REST)
3711 where REST is the cdr of a position as it would be reported in the event.
3712
3713 The make_lispy_event function stores positions here to tell the
3714 difference between click and drag events, and to store the starting
3715 location to be included in drag events. */
3716
3717static Lisp_Object button_down_location;
88cb0656 3718
fbcd35bd
JB
3719/* Information about the most recent up-going button event: Which
3720 button, what location, and what time. */
3721
559f9d04
RS
3722static int last_mouse_button;
3723static int last_mouse_x;
3724static int last_mouse_y;
3725static unsigned long button_down_time;
fbcd35bd 3726
564dc952
JB
3727/* The maximum time between clicks to make a double-click,
3728 or Qnil to disable double-click detection,
3729 or Qt for no time limit. */
3730Lisp_Object Vdouble_click_time;
fbcd35bd
JB
3731
3732/* The number of clicks in this multiple-click. */
3733
3734int double_click_count;
3735
284f4730
JB
3736/* Given a struct input_event, build the lisp event which represents
3737 it. If EVENT is 0, build a mouse movement event from the mouse
88cb0656
JB
3738 movement buffer, which should have a movement event in it.
3739
3740 Note that events must be passed to this function in the order they
3741 are received; this function stores the location of button presses
3742 in order to build drag events when the button is released. */
284f4730
JB
3743
3744static Lisp_Object
3745make_lispy_event (event)
3746 struct input_event *event;
3747{
79a7046c
RS
3748 int i;
3749
0220c518 3750 switch (SWITCH_ENUM_CAST (event->kind))
284f4730 3751 {
284f4730
JB
3752 /* A simple keystroke. */
3753 case ascii_keystroke:
86e5706b 3754 {
9343ab07 3755 Lisp_Object lispy_c;
e9bf89a0 3756 int c = event->code & 0377;
5a1c6df8
JB
3757 /* Turn ASCII characters into control characters
3758 when proper. */
3759 if (event->modifiers & ctrl_modifier)
d205953b
JB
3760 c = make_ctrl_char (c);
3761
3762 /* Add in the other modifier bits. We took care of ctrl_modifier
3763 just above, and the shift key was taken care of by the X code,
3764 and applied to control characters by make_ctrl_char. */
86e5706b
RS
3765 c |= (event->modifiers
3766 & (meta_modifier | alt_modifier
3767 | hyper_modifier | super_modifier));
32454a9f
RS
3768 /* Distinguish Shift-SPC from SPC. */
3769 if ((event->code & 0377) == 040
3770 && event->modifiers & shift_modifier)
3771 c |= shift_modifier;
559f9d04 3772 button_down_time = 0;
bb9e9bed 3773 XSETFASTINT (lispy_c, c);
9343ab07 3774 return lispy_c;
86e5706b 3775 }
284f4730
JB
3776
3777 /* A function key. The symbol may need to have modifier prefixes
3778 tacked onto it. */
3779 case non_ascii_keystroke:
559f9d04 3780 button_down_time = 0;
e9bf89a0
RS
3781
3782 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
3783 if (event->code == lispy_accent_codes[i])
3784 return modify_event_symbol (i,
3785 event->modifiers,
80e4aa30 3786 Qfunction_key, Qnil,
e9bf89a0
RS
3787 lispy_accent_keys, &accent_key_syms,
3788 (sizeof (lispy_accent_keys)
3789 / sizeof (lispy_accent_keys[0])));
3790
270a208f 3791 /* Handle system-specific keysyms. */
80e4aa30
RS
3792 if (event->code & (1 << 28))
3793 {
3794 /* We need to use an alist rather than a vector as the cache
3795 since we can't make a vector long enuf. */
142e6c73
KH
3796 if (NILP (current_kboard->system_key_syms))
3797 current_kboard->system_key_syms = Fcons (Qnil, Qnil);
2c834fb3 3798 return modify_event_symbol (event->code,
80e4aa30 3799 event->modifiers,
7c97ffdc
KH
3800 Qfunction_key,
3801 current_kboard->Vsystem_key_alist,
142e6c73
KH
3802 0, &current_kboard->system_key_syms,
3803 (unsigned)-1);
80e4aa30
RS
3804 }
3805
37cd9f30
KH
3806#ifdef XK_kana_A
3807 if (event->code >= 0x400 && event->code < 0x500)
3808 return modify_event_symbol (event->code - 0x400,
3809 event->modifiers & ~shift_modifier,
3810 Qfunction_key, Qnil,
3811 lispy_kana_keys, &func_key_syms,
3812 (sizeof (lispy_kana_keys)
3813 / sizeof (lispy_kana_keys[0])));
3814#endif /* XK_kana_A */
3815
111c4138 3816#ifdef ISO_FUNCTION_KEY_OFFSET
04f215f0
RS
3817 if (event->code < FUNCTION_KEY_OFFSET
3818 && event->code >= ISO_FUNCTION_KEY_OFFSET)
3819 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
3820 event->modifiers,
3821 Qfunction_key, Qnil,
3822 iso_lispy_function_keys, &func_key_syms,
3823 (sizeof (iso_lispy_function_keys)
3824 / sizeof (iso_lispy_function_keys[0])));
3825 else
111c4138 3826#endif
04f215f0
RS
3827 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
3828 event->modifiers,
3829 Qfunction_key, Qnil,
3830 lispy_function_keys, &func_key_syms,
3831 (sizeof (lispy_function_keys)
3832 / sizeof (lispy_function_keys[0])));
284f4730 3833
514354e9 3834#ifdef HAVE_MOUSE
df0f2ba1 3835 /* A mouse click. Figure out where it is, decide whether it's
88cb0656 3836 a press, click or drag, and build the appropriate structure. */
284f4730 3837 case mouse_click:
3c370943 3838 case scroll_bar_click:
284f4730 3839 {
e9bf89a0 3840 int button = event->code;
559f9d04 3841 int is_double;
7b4aedb9 3842 Lisp_Object position;
dbc4e1c1
JB
3843 Lisp_Object *start_pos_ptr;
3844 Lisp_Object start_pos;
284f4730 3845
7b4aedb9 3846 if (button < 0 || button >= NUM_MOUSE_BUTTONS)
88cb0656
JB
3847 abort ();
3848
7b4aedb9
JB
3849 /* Build the position as appropriate for this mouse click. */
3850 if (event->kind == mouse_click)
284f4730 3851 {
7b4aedb9 3852 int part;
598a9fa7 3853 FRAME_PTR f = XFRAME (event->frame_or_window);
0aafc975 3854 Lisp_Object window;
7b4aedb9 3855 Lisp_Object posn;
9e20143a
RS
3856 int row, column;
3857
5da3133a
RS
3858 /* Ignore mouse events that were made on frame that
3859 have been deleted. */
3860 if (! FRAME_LIVE_P (f))
3861 return Qnil;
3862
9e20143a 3863 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
6c6a9be8 3864 &column, &row, NULL, 1);
7b4aedb9 3865
eef045bf
RS
3866#ifndef USE_X_TOOLKIT
3867 /* In the non-toolkit version, clicks on the menu bar
3868 are ordinary button events in the event buffer.
3869 Distinguish them, and invoke the menu.
3870
3871 (In the toolkit version, the toolkit handles the menu bar
3872 and Emacs doesn't know about it until after the user
3873 makes a selection.) */
2ee250ec
RS
3874 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
3875 && (event->modifiers & down_modifier))
bb936752 3876 {
b7c49376 3877 Lisp_Object items, item;
0a0e8fe6
RS
3878 int hpos;
3879 int i;
3880
2ee250ec 3881#if 0
0a0e8fe6
RS
3882 /* Activate the menu bar on the down event. If the
3883 up event comes in before the menu code can deal with it,
3884 just ignore it. */
3885 if (! (event->modifiers & down_modifier))
3886 return Qnil;
2ee250ec 3887#endif
0aafc975 3888
f2ae6b3f 3889 item = Qnil;
5ec75a55 3890 items = FRAME_MENU_BAR_ITEMS (f);
35b3402f 3891 for (i = 0; i < XVECTOR (items)->size; i += 4)
5ec75a55
RS
3892 {
3893 Lisp_Object pos, string;
b7c49376 3894 string = XVECTOR (items)->contents[i + 1];
35b3402f 3895 pos = XVECTOR (items)->contents[i + 3];
b7c49376
RS
3896 if (NILP (string))
3897 break;
9e20143a
RS
3898 if (column >= XINT (pos)
3899 && column < XINT (pos) + XSTRING (string)->size)
b7c49376
RS
3900 {
3901 item = XVECTOR (items)->contents[i];
3902 break;
3903 }
5ec75a55 3904 }
9e20143a 3905
5ec75a55
RS
3906 position
3907 = Fcons (event->frame_or_window,
3908 Fcons (Qmenu_bar,
3909 Fcons (Fcons (event->x, event->y),
3910 Fcons (make_number (event->timestamp),
3911 Qnil))));
3912
b7c49376 3913 return Fcons (item, Fcons (position, Qnil));
5ec75a55 3914 }
eef045bf 3915#endif /* not USE_X_TOOLKIT */
0aafc975 3916
9e20143a 3917 window = window_from_coordinates (f, column, row, &part);
0aafc975 3918
8c18cbfb 3919 if (!WINDOWP (window))
78ced549
RS
3920 {
3921 window = event->frame_or_window;
3922 posn = Qnil;
3923 }
284f4730 3924 else
7b4aedb9 3925 {
9e20143a 3926 int pixcolumn, pixrow;
c8738c33 3927 column -= WINDOW_LEFT_MARGIN (XWINDOW (window));
9e20143a
RS
3928 row -= XINT (XWINDOW (window)->top);
3929 glyph_to_pixel_coords (f, column, row, &pixcolumn, &pixrow);
3930 XSETINT (event->x, pixcolumn);
3931 XSETINT (event->y, pixrow);
dbc4e1c1 3932
7b4aedb9
JB
3933 if (part == 1)
3934 posn = Qmode_line;
3935 else if (part == 2)
3936 posn = Qvertical_line;
3937 else
18cd2eeb
KH
3938 XSETINT (posn,
3939 buffer_posn_from_coords (XWINDOW (window),
3940 column, row));
7b4aedb9
JB
3941 }
3942
5ec75a55
RS
3943 position
3944 = Fcons (window,
3945 Fcons (posn,
3946 Fcons (Fcons (event->x, event->y),
3947 Fcons (make_number (event->timestamp),
3948 Qnil))));
284f4730 3949 }
7b4aedb9 3950 else
88cb0656 3951 {
9e20143a
RS
3952 Lisp_Object window;
3953 Lisp_Object portion_whole;
3954 Lisp_Object part;
3955
3956 window = event->frame_or_window;
3957 portion_whole = Fcons (event->x, event->y);
3958 part = *scroll_bar_parts[(int) event->part];
7b4aedb9 3959
db08707d
RS
3960 position
3961 = Fcons (window,
3962 Fcons (Qvertical_scroll_bar,
3963 Fcons (portion_whole,
3964 Fcons (make_number (event->timestamp),
3965 Fcons (part, Qnil)))));
88cb0656
JB
3966 }
3967
dbc4e1c1
JB
3968 start_pos_ptr = &XVECTOR (button_down_location)->contents[button];
3969
3970 start_pos = *start_pos_ptr;
3971 *start_pos_ptr = Qnil;
7b4aedb9 3972
559f9d04
RS
3973 is_double = (button == last_mouse_button
3974 && XINT (event->x) == last_mouse_x
3975 && XINT (event->y) == last_mouse_y
3976 && button_down_time != 0
3977 && (EQ (Vdouble_click_time, Qt)
3978 || (INTEGERP (Vdouble_click_time)
3979 && ((int)(event->timestamp - button_down_time)
3980 < XINT (Vdouble_click_time)))));
3981 last_mouse_button = button;
3982 last_mouse_x = XINT (event->x);
3983 last_mouse_y = XINT (event->y);
3984
7b4aedb9
JB
3985 /* If this is a button press, squirrel away the location, so
3986 we can decide later whether it was a click or a drag. */
3987 if (event->modifiers & down_modifier)
559f9d04
RS
3988 {
3989 if (is_double)
3990 {
3991 double_click_count++;
3992 event->modifiers |= ((double_click_count > 2)
3993 ? triple_modifier
3994 : double_modifier);
3995 }
3996 else
3997 double_click_count = 1;
3998 button_down_time = event->timestamp;
3999 *start_pos_ptr = Fcopy_alist (position);
4000 }
7b4aedb9 4001
88cb0656 4002 /* Now we're releasing a button - check the co-ordinates to
7b4aedb9 4003 see if this was a click or a drag. */
88cb0656
JB
4004 else if (event->modifiers & up_modifier)
4005 {
48e416d4
RS
4006 /* If we did not see a down before this up,
4007 ignore the up. Probably this happened because
4008 the down event chose a menu item.
4009 It would be an annoyance to treat the release
4010 of the button that chose the menu item
4011 as a separate event. */
4012
8c18cbfb 4013 if (!CONSP (start_pos))
48e416d4
RS
4014 return Qnil;
4015
88cb0656 4016 event->modifiers &= ~up_modifier;
48e416d4 4017#if 0 /* Formerly we treated an up with no down as a click event. */
8c18cbfb 4018 if (!CONSP (start_pos))
dbc4e1c1
JB
4019 event->modifiers |= click_modifier;
4020 else
48e416d4 4021#endif
dbc4e1c1
JB
4022 {
4023 /* The third element of every position should be the (x,y)
4024 pair. */
9b8eb840 4025 Lisp_Object down;
dbc4e1c1 4026
9b8eb840 4027 down = Fnth (make_number (2), start_pos);
fbcd35bd
JB
4028 if (EQ (event->x, XCONS (down)->car)
4029 && EQ (event->y, XCONS (down)->cdr))
4030 {
bc536d84 4031 event->modifiers |= click_modifier;
fbcd35bd
JB
4032 }
4033 else
4034 {
559f9d04 4035 button_down_time = 0;
fbcd35bd
JB
4036 event->modifiers |= drag_modifier;
4037 }
bc536d84
RS
4038 /* Don't check is_double; treat this as multiple
4039 if the down-event was multiple. */
4040 if (double_click_count > 1)
4041 event->modifiers |= ((double_click_count > 2)
4042 ? triple_modifier
4043 : double_modifier);
dbc4e1c1 4044 }
88cb0656
JB
4045 }
4046 else
4047 /* Every mouse event should either have the down_modifier or
7b4aedb9 4048 the up_modifier set. */
88cb0656
JB
4049 abort ();
4050
88cb0656 4051 {
7b4aedb9 4052 /* Get the symbol we should use for the mouse click. */
9b8eb840
KH
4053 Lisp_Object head;
4054
4055 head = modify_event_symbol (button,
4056 event->modifiers,
4057 Qmouse_click, Qnil,
4058 lispy_mouse_names, &mouse_syms,
4059 (sizeof (lispy_mouse_names)
4060 / sizeof (lispy_mouse_names[0])));
88cb0656 4061 if (event->modifiers & drag_modifier)
dbc4e1c1
JB
4062 return Fcons (head,
4063 Fcons (start_pos,
4064 Fcons (position,
4065 Qnil)));
fbcd35bd
JB
4066 else if (event->modifiers & (double_modifier | triple_modifier))
4067 return Fcons (head,
4068 Fcons (position,
4069 Fcons (make_number (double_click_count),
4070 Qnil)));
88cb0656
JB
4071 else
4072 return Fcons (head,
7b4aedb9 4073 Fcons (position,
88cb0656
JB
4074 Qnil));
4075 }
284f4730 4076 }
db08707d
RS
4077
4078#ifdef WINDOWSNT
fbd6baed 4079 case w32_scroll_bar_click:
db08707d
RS
4080 {
4081 int button = event->code;
4082 int is_double;
4083 Lisp_Object position;
4084 Lisp_Object *start_pos_ptr;
4085 Lisp_Object start_pos;
4086
4087 if (button < 0 || button >= NUM_MOUSE_BUTTONS)
4088 abort ();
4089
4090 {
4091 Lisp_Object window;
4092 Lisp_Object portion_whole;
4093 Lisp_Object part;
4094
4095 window = event->frame_or_window;
4096 portion_whole = Fcons (event->x, event->y);
4097 part = *scroll_bar_parts[(int) event->part];
4098
4099 position =
4100 Fcons (window,
4101 Fcons (Qvertical_scroll_bar,
4102 Fcons (portion_whole,
4103 Fcons (make_number (event->timestamp),
4104 Fcons (part, Qnil)))));
4105 }
4106
fbd6baed 4107 /* Always treat W32 scroll bar events as clicks. */
db08707d
RS
4108 event->modifiers |= click_modifier;
4109
4110 {
4111 /* Get the symbol we should use for the mouse click. */
4112 Lisp_Object head;
4113
4114 head = modify_event_symbol (button,
4115 event->modifiers,
4116 Qmouse_click, Qnil,
4117 lispy_mouse_names, &mouse_syms,
4118 (sizeof (lispy_mouse_names)
4119 / sizeof (lispy_mouse_names[0])));
4120 return Fcons (head,
4121 Fcons (position,
4122 Qnil));
4123 }
4124 }
07de30b9
GV
4125 case mouse_wheel:
4126 {
4127 int part;
4128 FRAME_PTR f = XFRAME (event->frame_or_window);
4129 Lisp_Object window;
4130 Lisp_Object posn;
4131 Lisp_Object head, position;
4132 int row, column;
4133
4134 /* Ignore mouse events that were made on frame that
4135 have been deleted. */
4136 if (! FRAME_LIVE_P (f))
4137 return Qnil;
4138 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
4139 &column, &row, NULL, 1);
4140 window = window_from_coordinates (f, column, row, &part);
4141
4142 if (!WINDOWP (window))
4143 {
4144 window = event->frame_or_window;
4145 posn = Qnil;
4146 }
4147 else
4148 {
4149 int pixcolumn, pixrow;
4150 column -= XINT (XWINDOW (window)->left);
4151 row -= XINT (XWINDOW (window)->top);
4152 glyph_to_pixel_coords (f, column, row, &pixcolumn, &pixrow);
4153 XSETINT (event->x, pixcolumn);
4154 XSETINT (event->y, pixrow);
4155
4156 if (part == 1)
4157 posn = Qmode_line;
4158 else if (part == 2)
4159 posn = Qvertical_line;
4160 else
4161 XSETINT (posn,
4162 buffer_posn_from_coords (XWINDOW (window),
4163 column, row));
4164 }
db08707d 4165
07de30b9
GV
4166 {
4167 Lisp_Object head, position;
4168
4169 position
4170 = Fcons (window,
4171 Fcons (posn,
4172 Fcons (Fcons (event->x, event->y),
4173 Fcons (make_number (event->timestamp),
4174 Qnil))));
4175
4176 head = modify_event_symbol (0, event->modifiers,
4177 Qmouse_wheel, Qnil,
4178 lispy_mouse_wheel_names,
4179 &mouse_wheel_syms, 1);
4180 return Fcons (head,
4181 Fcons (position,
4182 Fcons (make_number (event->code),
4183 Qnil)));
4184 }
4185 }
4186#endif /* WINDOWSNT */
514354e9 4187#endif /* HAVE_MOUSE */
284f4730 4188
e98a93eb 4189#if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI)
2470a66f
KH
4190 case menu_bar_event:
4191 /* The event value is in the cdr of the frame_or_window slot. */
4192 if (!CONSP (event->frame_or_window))
4193 abort ();
4194 return XCONS (event->frame_or_window)->cdr;
4195#endif
4196
284f4730
JB
4197 /* The 'kind' field of the event is something we don't recognize. */
4198 default:
48e416d4 4199 abort ();
284f4730
JB
4200 }
4201}
4202
514354e9 4203#ifdef HAVE_MOUSE
6cbff1cb 4204
284f4730 4205static Lisp_Object
7b4aedb9 4206make_lispy_movement (frame, bar_window, part, x, y, time)
ff11dfa1 4207 FRAME_PTR frame;
7b4aedb9 4208 Lisp_Object bar_window;
3c370943 4209 enum scroll_bar_part part;
284f4730 4210 Lisp_Object x, y;
e5d77022 4211 unsigned long time;
284f4730 4212{
3c370943 4213 /* Is it a scroll bar movement? */
7b4aedb9 4214 if (frame && ! NILP (bar_window))
4bb994d1 4215 {
9b8eb840 4216 Lisp_Object part_sym;
4bb994d1 4217
9b8eb840 4218 part_sym = *scroll_bar_parts[(int) part];
3c370943 4219 return Fcons (Qscroll_bar_movement,
7b4aedb9 4220 (Fcons (Fcons (bar_window,
3c370943 4221 Fcons (Qvertical_scroll_bar,
4bb994d1
JB
4222 Fcons (Fcons (x, y),
4223 Fcons (make_number (time),
cb5df6ae 4224 Fcons (part_sym,
4bb994d1
JB
4225 Qnil))))),
4226 Qnil)));
4227 }
4228
4229 /* Or is it an ordinary mouse movement? */
284f4730
JB
4230 else
4231 {
4bb994d1 4232 int area;
9e20143a 4233 Lisp_Object window;
4bb994d1 4234 Lisp_Object posn;
9e20143a
RS
4235 int column, row;
4236
9e20143a 4237 if (frame)
047688cb
RS
4238 {
4239 /* It's in a frame; which window on that frame? */
6c6a9be8
KH
4240 pixel_to_glyph_coords (frame, XINT (x), XINT (y), &column, &row,
4241 NULL, 1);
047688cb
RS
4242 window = window_from_coordinates (frame, column, row, &area);
4243 }
9e20143a
RS
4244 else
4245 window = Qnil;
4bb994d1 4246
8c18cbfb 4247 if (WINDOWP (window))
4bb994d1 4248 {
9e20143a 4249 int pixcolumn, pixrow;
c8738c33 4250 column -= WINDOW_LEFT_MARGIN (XWINDOW (window));
9e20143a
RS
4251 row -= XINT (XWINDOW (window)->top);
4252 glyph_to_pixel_coords (frame, column, row, &pixcolumn, &pixrow);
4253 XSETINT (x, pixcolumn);
4254 XSETINT (y, pixrow);
4bb994d1
JB
4255
4256 if (area == 1)
4257 posn = Qmode_line;
4258 else if (area == 2)
4259 posn = Qvertical_line;
4260 else
18cd2eeb
KH
4261 XSETINT (posn,
4262 buffer_posn_from_coords (XWINDOW (window), column, row));
4bb994d1 4263 }
e9bf89a0
RS
4264 else if (frame != 0)
4265 {
18cd2eeb 4266 XSETFRAME (window, frame);
e9bf89a0
RS
4267 posn = Qnil;
4268 }
284f4730 4269 else
4bb994d1
JB
4270 {
4271 window = Qnil;
4272 posn = Qnil;
bb9e9bed
KH
4273 XSETFASTINT (x, 0);
4274 XSETFASTINT (y, 0);
4bb994d1 4275 }
284f4730 4276
4bb994d1
JB
4277 return Fcons (Qmouse_movement,
4278 Fcons (Fcons (window,
4279 Fcons (posn,
4280 Fcons (Fcons (x, y),
4281 Fcons (make_number (time),
4282 Qnil)))),
4283 Qnil));
4284 }
284f4730
JB
4285}
4286
514354e9 4287#endif /* HAVE_MOUSE */
6cbff1cb 4288
cd21b839
JB
4289/* Construct a switch frame event. */
4290static Lisp_Object
4291make_lispy_switch_frame (frame)
4292 Lisp_Object frame;
4293{
4294 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
4295}
0a7f1fc0
JB
4296\f
4297/* Manipulating modifiers. */
284f4730 4298
0a7f1fc0 4299/* Parse the name of SYMBOL, and return the set of modifiers it contains.
284f4730 4300
0a7f1fc0
JB
4301 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
4302 SYMBOL's name of the end of the modifiers; the string from this
4303 position is the unmodified symbol name.
284f4730 4304
0a7f1fc0 4305 This doesn't use any caches. */
6da3dd3a 4306
0a7f1fc0
JB
4307static int
4308parse_modifiers_uncached (symbol, modifier_end)
284f4730 4309 Lisp_Object symbol;
0a7f1fc0 4310 int *modifier_end;
284f4730
JB
4311{
4312 struct Lisp_String *name;
4313 int i;
4314 int modifiers;
284f4730
JB
4315
4316 CHECK_SYMBOL (symbol, 1);
df0f2ba1 4317
284f4730
JB
4318 modifiers = 0;
4319 name = XSYMBOL (symbol)->name;
4320
0a7f1fc0 4321 for (i = 0; i+2 <= name->size; )
6da3dd3a
RS
4322 {
4323 int this_mod_end = 0;
4324 int this_mod = 0;
284f4730 4325
6da3dd3a
RS
4326 /* See if the name continues with a modifier word.
4327 Check that the word appears, but don't check what follows it.
4328 Set this_mod and this_mod_end to record what we find. */
fce33686 4329
6da3dd3a
RS
4330 switch (name->data[i])
4331 {
4332#define SINGLE_LETTER_MOD(BIT) \
4333 (this_mod_end = i + 1, this_mod = BIT)
4334
6da3dd3a
RS
4335 case 'A':
4336 SINGLE_LETTER_MOD (alt_modifier);
4337 break;
284f4730 4338
6da3dd3a
RS
4339 case 'C':
4340 SINGLE_LETTER_MOD (ctrl_modifier);
4341 break;
284f4730 4342
6da3dd3a
RS
4343 case 'H':
4344 SINGLE_LETTER_MOD (hyper_modifier);
4345 break;
4346
6da3dd3a
RS
4347 case 'M':
4348 SINGLE_LETTER_MOD (meta_modifier);
4349 break;
4350
6da3dd3a
RS
4351 case 'S':
4352 SINGLE_LETTER_MOD (shift_modifier);
4353 break;
4354
4355 case 's':
6da3dd3a
RS
4356 SINGLE_LETTER_MOD (super_modifier);
4357 break;
4358
0a7f1fc0 4359#undef SINGLE_LETTER_MOD
6da3dd3a
RS
4360 }
4361
4362 /* If we found no modifier, stop looking for them. */
4363 if (this_mod_end == 0)
4364 break;
4365
4366 /* Check there is a dash after the modifier, so that it
4367 really is a modifier. */
4368 if (this_mod_end >= name->size || name->data[this_mod_end] != '-')
4369 break;
4370
4371 /* This modifier is real; look for another. */
4372 modifiers |= this_mod;
4373 i = this_mod_end + 1;
4374 }
284f4730 4375
0a7f1fc0 4376 /* Should we include the `click' modifier? */
fbcd35bd
JB
4377 if (! (modifiers & (down_modifier | drag_modifier
4378 | double_modifier | triple_modifier))
0a7f1fc0 4379 && i + 7 == name->size
4bb994d1 4380 && strncmp (name->data + i, "mouse-", 6) == 0
6569cc8d 4381 && ('0' <= name->data[i + 6] && name->data[i + 6] <= '9'))
0a7f1fc0
JB
4382 modifiers |= click_modifier;
4383
4384 if (modifier_end)
4385 *modifier_end = i;
4386
4387 return modifiers;
4388}
4389
0a7f1fc0
JB
4390/* Return a symbol whose name is the modifier prefixes for MODIFIERS
4391 prepended to the string BASE[0..BASE_LEN-1].
4392 This doesn't use any caches. */
4393static Lisp_Object
4394apply_modifiers_uncached (modifiers, base, base_len)
4395 int modifiers;
4396 char *base;
4397 int base_len;
4398{
4399 /* Since BASE could contain nulls, we can't use intern here; we have
4400 to use Fintern, which expects a genuine Lisp_String, and keeps a
4401 reference to it. */
4402 char *new_mods =
fbcd35bd 4403 (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
0a7f1fc0 4404 int mod_len;
284f4730 4405
284f4730 4406 {
0a7f1fc0
JB
4407 char *p = new_mods;
4408
4409 /* Only the event queue may use the `up' modifier; it should always
4410 be turned into a click or drag event before presented to lisp code. */
4411 if (modifiers & up_modifier)
4412 abort ();
4413
4414 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
4415 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
4416 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
4417 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
4418 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
86e5706b 4419 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
fbcd35bd
JB
4420 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
4421 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
559f9d04
RS
4422 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
4423 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
0a7f1fc0
JB
4424 /* The click modifier is denoted by the absence of other modifiers. */
4425
4426 *p = '\0';
4427
4428 mod_len = p - new_mods;
4429 }
284f4730 4430
0a7f1fc0 4431 {
9b8eb840 4432 Lisp_Object new_name;
df0f2ba1 4433
9b8eb840 4434 new_name = make_uninit_string (mod_len + base_len);
0a7f1fc0
JB
4435 bcopy (new_mods, XSTRING (new_name)->data, mod_len);
4436 bcopy (base, XSTRING (new_name)->data + mod_len, base_len);
284f4730
JB
4437
4438 return Fintern (new_name, Qnil);
4439 }
4440}
4441
4442
0a7f1fc0
JB
4443static char *modifier_names[] =
4444{
fbcd35bd 4445 "up", "down", "drag", "click", "double", "triple", 0, 0,
f335fabe 4446 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
86e5706b 4447 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
0a7f1fc0 4448};
80645119 4449#define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
0a7f1fc0
JB
4450
4451static Lisp_Object modifier_symbols;
4452
4453/* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
4454static Lisp_Object
4455lispy_modifier_list (modifiers)
4456 int modifiers;
4457{
4458 Lisp_Object modifier_list;
4459 int i;
4460
4461 modifier_list = Qnil;
80645119 4462 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
0a7f1fc0 4463 if (modifiers & (1<<i))
80645119
JB
4464 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
4465 modifier_list);
0a7f1fc0
JB
4466
4467 return modifier_list;
4468}
4469
4470
4471/* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
4472 where UNMODIFIED is the unmodified form of SYMBOL,
4473 MASK is the set of modifiers present in SYMBOL's name.
4474 This is similar to parse_modifiers_uncached, but uses the cache in
4475 SYMBOL's Qevent_symbol_element_mask property, and maintains the
4476 Qevent_symbol_elements property. */
3d31316f 4477
0a7f1fc0
JB
4478static Lisp_Object
4479parse_modifiers (symbol)
4480 Lisp_Object symbol;
4481{
9b8eb840 4482 Lisp_Object elements;
0a7f1fc0 4483
9b8eb840 4484 elements = Fget (symbol, Qevent_symbol_element_mask);
0a7f1fc0
JB
4485 if (CONSP (elements))
4486 return elements;
4487 else
4488 {
4489 int end;
ec0faad2 4490 int modifiers = parse_modifiers_uncached (symbol, &end);
9b8eb840 4491 Lisp_Object unmodified;
0a7f1fc0
JB
4492 Lisp_Object mask;
4493
9b8eb840
KH
4494 unmodified = Fintern (make_string (XSYMBOL (symbol)->name->data + end,
4495 XSYMBOL (symbol)->name->size - end),
4496 Qnil);
4497
ec0faad2 4498 if (modifiers & ~(((EMACS_INT)1 << VALBITS) - 1))
734fef94 4499 abort ();
bb9e9bed 4500 XSETFASTINT (mask, modifiers);
0a7f1fc0
JB
4501 elements = Fcons (unmodified, Fcons (mask, Qnil));
4502
4503 /* Cache the parsing results on SYMBOL. */
4504 Fput (symbol, Qevent_symbol_element_mask,
4505 elements);
4506 Fput (symbol, Qevent_symbol_elements,
4507 Fcons (unmodified, lispy_modifier_list (modifiers)));
4508
4509 /* Since we know that SYMBOL is modifiers applied to unmodified,
4510 it would be nice to put that in unmodified's cache.
4511 But we can't, since we're not sure that parse_modifiers is
4512 canonical. */
4513
4514 return elements;
4515 }
4516}
4517
4518/* Apply the modifiers MODIFIERS to the symbol BASE.
4519 BASE must be unmodified.
4520
4521 This is like apply_modifiers_uncached, but uses BASE's
4522 Qmodifier_cache property, if present. It also builds
cd21b839
JB
4523 Qevent_symbol_elements properties, since it has that info anyway.
4524
4525 apply_modifiers copies the value of BASE's Qevent_kind property to
4526 the modified symbol. */
0a7f1fc0
JB
4527static Lisp_Object
4528apply_modifiers (modifiers, base)
4529 int modifiers;
4530 Lisp_Object base;
4531{
7b4aedb9 4532 Lisp_Object cache, index, entry, new_symbol;
0a7f1fc0 4533
80645119 4534 /* Mask out upper bits. We don't know where this value's been. */
ec0faad2 4535 modifiers &= ((EMACS_INT)1 << VALBITS) - 1;
80645119 4536
0a7f1fc0 4537 /* The click modifier never figures into cache indices. */
0a7f1fc0 4538 cache = Fget (base, Qmodifier_cache);
bb9e9bed 4539 XSETFASTINT (index, (modifiers & ~click_modifier));
697e4895 4540 entry = assq_no_quit (index, cache);
0a7f1fc0
JB
4541
4542 if (CONSP (entry))
7b4aedb9
JB
4543 new_symbol = XCONS (entry)->cdr;
4544 else
4545 {
df0f2ba1 4546 /* We have to create the symbol ourselves. */
7b4aedb9
JB
4547 new_symbol = apply_modifiers_uncached (modifiers,
4548 XSYMBOL (base)->name->data,
4549 XSYMBOL (base)->name->size);
4550
4551 /* Add the new symbol to the base's cache. */
4552 entry = Fcons (index, new_symbol);
4553 Fput (base, Qmodifier_cache, Fcons (entry, cache));
4554
4555 /* We have the parsing info now for free, so add it to the caches. */
bb9e9bed 4556 XSETFASTINT (index, modifiers);
7b4aedb9
JB
4557 Fput (new_symbol, Qevent_symbol_element_mask,
4558 Fcons (base, Fcons (index, Qnil)));
4559 Fput (new_symbol, Qevent_symbol_elements,
4560 Fcons (base, lispy_modifier_list (modifiers)));
4561 }
0a7f1fc0 4562
df0f2ba1 4563 /* Make sure this symbol is of the same kind as BASE.
7b4aedb9
JB
4564
4565 You'd think we could just set this once and for all when we
4566 intern the symbol above, but reorder_modifiers may call us when
4567 BASE's property isn't set right; we can't assume that just
80645119
JB
4568 because it has a Qmodifier_cache property it must have its
4569 Qevent_kind set right as well. */
7b4aedb9
JB
4570 if (NILP (Fget (new_symbol, Qevent_kind)))
4571 {
9b8eb840 4572 Lisp_Object kind;
7b4aedb9 4573
9b8eb840 4574 kind = Fget (base, Qevent_kind);
7b4aedb9
JB
4575 if (! NILP (kind))
4576 Fput (new_symbol, Qevent_kind, kind);
4577 }
4578
4579 return new_symbol;
0a7f1fc0
JB
4580}
4581
4582
4583/* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
4584 return a symbol with the modifiers placed in the canonical order.
4585 Canonical order is alphabetical, except for down and drag, which
4586 always come last. The 'click' modifier is never written out.
4587
4588 Fdefine_key calls this to make sure that (for example) C-M-foo
4589 and M-C-foo end up being equivalent in the keymap. */
4590
4591Lisp_Object
4592reorder_modifiers (symbol)
4593 Lisp_Object symbol;
4594{
4595 /* It's hopefully okay to write the code this way, since everything
4596 will soon be in caches, and no consing will be done at all. */
9b8eb840 4597 Lisp_Object parsed;
0a7f1fc0 4598
9b8eb840 4599 parsed = parse_modifiers (symbol);
54593ed9 4600 return apply_modifiers ((int) XINT (XCONS (XCONS (parsed)->cdr)->car),
0a7f1fc0
JB
4601 XCONS (parsed)->car);
4602}
4603
4604
284f4730
JB
4605/* For handling events, we often want to produce a symbol whose name
4606 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
4607 to some base, like the name of a function key or mouse button.
4608 modify_event_symbol produces symbols of this sort.
4609
4610 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
4611 is the name of the i'th symbol. TABLE_SIZE is the number of elements
4612 in the table.
4613
80e4aa30
RS
4614 Alternatively, NAME_ALIST is an alist mapping codes into symbol names.
4615 NAME_ALIST is used if it is non-nil; otherwise NAME_TABLE is used.
4616
284f4730
JB
4617 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
4618 persist between calls to modify_event_symbol that it can use to
4619 store a cache of the symbols it's generated for this NAME_TABLE
80e4aa30 4620 before. The object stored there may be a vector or an alist.
284f4730
JB
4621
4622 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
df0f2ba1 4623
284f4730
JB
4624 MODIFIERS is a set of modifier bits (as given in struct input_events)
4625 whose prefixes should be applied to the symbol name.
4626
4627 SYMBOL_KIND is the value to be placed in the event_kind property of
df0f2ba1 4628 the returned symbol.
88cb0656
JB
4629
4630 The symbols we create are supposed to have an
eb8c3be9 4631 `event-symbol-elements' property, which lists the modifiers present
88cb0656
JB
4632 in the symbol's name. */
4633
284f4730 4634static Lisp_Object
80e4aa30
RS
4635modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist,
4636 name_table, symbol_table, table_size)
284f4730
JB
4637 int symbol_num;
4638 unsigned modifiers;
4639 Lisp_Object symbol_kind;
80e4aa30 4640 Lisp_Object name_alist;
284f4730
JB
4641 char **name_table;
4642 Lisp_Object *symbol_table;
2c834fb3 4643 unsigned int table_size;
284f4730 4644{
80e4aa30
RS
4645 Lisp_Object value;
4646 Lisp_Object symbol_int;
4647
2c834fb3
KH
4648 /* Get rid of the "vendor-specific" bit here. */
4649 XSETINT (symbol_int, symbol_num & 0xffffff);
284f4730
JB
4650
4651 /* Is this a request for a valid symbol? */
88cb0656 4652 if (symbol_num < 0 || symbol_num >= table_size)
0c2611c5 4653 return Qnil;
284f4730 4654
80e4aa30
RS
4655 if (CONSP (*symbol_table))
4656 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
4657
0a7f1fc0 4658 /* If *symbol_table doesn't seem to be initialized properly, fix that.
88cb0656 4659 *symbol_table should be a lisp vector TABLE_SIZE elements long,
4bb994d1
JB
4660 where the Nth element is the symbol for NAME_TABLE[N], or nil if
4661 we've never used that symbol before. */
80e4aa30 4662 else
88cb0656 4663 {
80e4aa30
RS
4664 if (! VECTORP (*symbol_table)
4665 || XVECTOR (*symbol_table)->size != table_size)
4666 {
4667 Lisp_Object size;
0a7f1fc0 4668
bb9e9bed 4669 XSETFASTINT (size, table_size);
80e4aa30
RS
4670 *symbol_table = Fmake_vector (size, Qnil);
4671 }
284f4730 4672
80e4aa30
RS
4673 value = XVECTOR (*symbol_table)->contents[symbol_num];
4674 }
284f4730 4675
0a7f1fc0 4676 /* Have we already used this symbol before? */
80e4aa30 4677 if (NILP (value))
284f4730 4678 {
0a7f1fc0 4679 /* No; let's create it. */
80e4aa30 4680 if (!NILP (name_alist))
b64b4075 4681 value = Fcdr_safe (Fassq (symbol_int, name_alist));
2ff6714d 4682 else if (name_table != 0 && name_table[symbol_num])
80e4aa30 4683 value = intern (name_table[symbol_num]);
b64b4075 4684
e98a93eb 4685#ifdef HAVE_WINDOW_SYSTEM
2c834fb3
KH
4686 if (NILP (value))
4687 {
4688 char *name = x_get_keysym_name (symbol_num);
4689 if (name)
4690 value = intern (name);
4691 }
4692#endif
4693
b64b4075 4694 if (NILP (value))
d1f50460
RS
4695 {
4696 char buf[20];
4697 sprintf (buf, "key-%d", symbol_num);
80e4aa30 4698 value = intern (buf);
d1f50460 4699 }
0a7f1fc0 4700
80e4aa30 4701 if (CONSP (*symbol_table))
4205cb08 4702 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
80e4aa30
RS
4703 else
4704 XVECTOR (*symbol_table)->contents[symbol_num] = value;
4705
df0f2ba1 4706 /* Fill in the cache entries for this symbol; this also
0a7f1fc0
JB
4707 builds the Qevent_symbol_elements property, which the user
4708 cares about. */
80e4aa30
RS
4709 apply_modifiers (modifiers & click_modifier, value);
4710 Fput (value, Qevent_kind, symbol_kind);
284f4730 4711 }
88cb0656 4712
0a7f1fc0 4713 /* Apply modifiers to that symbol. */
80e4aa30 4714 return apply_modifiers (modifiers, value);
284f4730 4715}
6da3dd3a
RS
4716\f
4717/* Convert a list that represents an event type,
4718 such as (ctrl meta backspace), into the usual representation of that
4719 event type as a number or a symbol. */
4720
a1706c30 4721DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
e57d8fd8
EN
4722 "Convert the event description list EVENT-DESC to an event type.\n\
4723EVENT-DESC should contain one base event type (a character or symbol)\n\
a1706c30 4724and zero or more modifier names (control, meta, hyper, super, shift, alt,\n\
377f24f5 4725drag, down, double or triple). The base must be last.\n\
a1706c30
KH
4726The return value is an event type (a character or symbol) which\n\
4727has the same base event type and all the specified modifiers.")
e57d8fd8
EN
4728 (event_desc)
4729 Lisp_Object event_desc;
6da3dd3a
RS
4730{
4731 Lisp_Object base;
4732 int modifiers = 0;
4733 Lisp_Object rest;
4734
4735 base = Qnil;
e57d8fd8 4736 rest = event_desc;
6da3dd3a
RS
4737 while (CONSP (rest))
4738 {
4739 Lisp_Object elt;
4740 int this = 0;
4741
4742 elt = XCONS (rest)->car;
377f24f5 4743 rest = XCONS (rest)->cdr;
6da3dd3a 4744
3d31316f 4745 /* Given a symbol, see if it is a modifier name. */
377f24f5 4746 if (SYMBOLP (elt) && CONSP (rest))
3d31316f 4747 this = parse_solitary_modifier (elt);
6da3dd3a
RS
4748
4749 if (this != 0)
4750 modifiers |= this;
4751 else if (!NILP (base))
4752 error ("Two bases given in one event");
4753 else
4754 base = elt;
4755
6da3dd3a
RS
4756 }
4757
3d31316f
RS
4758 /* Let the symbol A refer to the character A. */
4759 if (SYMBOLP (base) && XSYMBOL (base)->name->size == 1)
4760 XSETINT (base, XSYMBOL (base)->name->data[0]);
4761
6da3dd3a
RS
4762 if (INTEGERP (base))
4763 {
3d31316f
RS
4764 /* Turn (shift a) into A. */
4765 if ((modifiers & shift_modifier) != 0
4766 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
4767 {
4768 XSETINT (base, XINT (base) - ('a' - 'A'));
4769 modifiers &= ~shift_modifier;
4770 }
4771
4772 /* Turn (control a) into C-a. */
6da3dd3a 4773 if (modifiers & ctrl_modifier)
3d31316f 4774 return make_number ((modifiers & ~ctrl_modifier)
6da3dd3a
RS
4775 | make_ctrl_char (XINT (base)));
4776 else
4777 return make_number (modifiers | XINT (base));
4778 }
4779 else if (SYMBOLP (base))
4780 return apply_modifiers (modifiers, base);
4781 else
4782 error ("Invalid base event");
4783}
4784
3d31316f
RS
4785/* Try to recognize SYMBOL as a modifier name.
4786 Return the modifier flag bit, or 0 if not recognized. */
4787
4788static int
4789parse_solitary_modifier (symbol)
4790 Lisp_Object symbol;
4791{
4792 struct Lisp_String *name = XSYMBOL (symbol)->name;
4793
4794 switch (name->data[0])
4795 {
4796#define SINGLE_LETTER_MOD(BIT) \
4797 if (name->size == 1) \
4798 return BIT;
4799
4800#define MULTI_LETTER_MOD(BIT, NAME, LEN) \
4801 if (LEN == name->size \
4802 && ! strncmp (name->data, NAME, LEN)) \
4803 return BIT;
4804
4805 case 'A':
4806 SINGLE_LETTER_MOD (alt_modifier);
4807 break;
4808
4809 case 'a':
4810 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
4811 break;
4812
4813 case 'C':
4814 SINGLE_LETTER_MOD (ctrl_modifier);
4815 break;
4816
4817 case 'c':
4818 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
4819 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
4820 break;
4821
4822 case 'H':
4823 SINGLE_LETTER_MOD (hyper_modifier);
4824 break;
4825
4826 case 'h':
4827 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
4828 break;
4829
4830 case 'M':
4831 SINGLE_LETTER_MOD (meta_modifier);
4832 break;
4833
4834 case 'm':
4835 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
4836 break;
4837
4838 case 'S':
4839 SINGLE_LETTER_MOD (shift_modifier);
4840 break;
4841
4842 case 's':
4843 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
4844 MULTI_LETTER_MOD (super_modifier, "super", 5);
4845 SINGLE_LETTER_MOD (super_modifier);
4846 break;
4847
4848 case 'd':
4849 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
4850 MULTI_LETTER_MOD (down_modifier, "down", 4);
4851 MULTI_LETTER_MOD (double_modifier, "double", 6);
4852 break;
4853
4854 case 't':
4855 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
4856 break;
4857
4858#undef SINGLE_LETTER_MOD
4859#undef MULTI_LETTER_MOD
4860 }
4861
4862 return 0;
4863}
4864
6da3dd3a
RS
4865/* Return 1 if EVENT is a list whose elements are all integers or symbols.
4866 Such a list is not valid as an event,
4867 but it can be a Lucid-style event type list. */
4868
4869int
4870lucid_event_type_list_p (object)
4871 Lisp_Object object;
4872{
4873 Lisp_Object tail;
4874
4875 if (! CONSP (object))
4876 return 0;
4877
4878 for (tail = object; CONSP (tail); tail = XCONS (tail)->cdr)
4879 {
4880 Lisp_Object elt;
4881 elt = XCONS (tail)->car;
4882 if (! (INTEGERP (elt) || SYMBOLP (elt)))
4883 return 0;
4884 }
4885
4886 return NILP (tail);
4887}
284f4730 4888\f
284f4730
JB
4889/* Store into *addr a value nonzero if terminal input chars are available.
4890 Serves the purpose of ioctl (0, FIONREAD, addr)
4891 but works even if FIONREAD does not exist.
d9d4c147
KH
4892 (In fact, this may actually read some input.)
4893
4894 If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe. */
284f4730
JB
4895
4896static void
d9d4c147 4897get_input_pending (addr, do_timers_now)
284f4730 4898 int *addr;
d9d4c147 4899 int do_timers_now;
284f4730
JB
4900{
4901 /* First of all, have we already counted some input? */
d9d4c147 4902 *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
284f4730
JB
4903
4904 /* If input is being read as it arrives, and we have none, there is none. */
4905 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
4906 return;
4907
4908 /* Try to read some input and see how much we get. */
4909 gobble_input (0);
d9d4c147 4910 *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
284f4730
JB
4911}
4912
81931ba1 4913/* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
284f4730
JB
4914
4915int
4916gobble_input (expected)
4917 int expected;
4918{
4919#ifndef VMS
4920#ifdef SIGIO
4921 if (interrupt_input)
4922 {
32676c08 4923 SIGMASKTYPE mask;
4f8aaa74 4924 mask = sigblock (sigmask (SIGIO));
284f4730 4925 read_avail_input (expected);
e065a56e 4926 sigsetmask (mask);
284f4730
JB
4927 }
4928 else
81931ba1
RS
4929#ifdef POLL_FOR_INPUT
4930 if (read_socket_hook && !interrupt_input && poll_suppress_count == 0)
4931 {
4932 SIGMASKTYPE mask;
4f8aaa74 4933 mask = sigblock (sigmask (SIGALRM));
81931ba1
RS
4934 read_avail_input (expected);
4935 sigsetmask (mask);
4936 }
4937 else
87485d6f 4938#endif
284f4730
JB
4939#endif
4940 read_avail_input (expected);
4941#endif
4942}
a8015ab5 4943
241ceaf7
RS
4944/* Put a buffer_switch_event in the buffer
4945 so that read_key_sequence will notice the new current buffer. */
4946
a8015ab5
KH
4947record_asynch_buffer_change ()
4948{
4949 struct input_event event;
a30f0615
RS
4950 Lisp_Object tem;
4951
a8015ab5
KH
4952 event.kind = buffer_switch_event;
4953 event.frame_or_window = Qnil;
241ceaf7 4954
f65e6f7d 4955#ifdef subprocesses
a30f0615
RS
4956 /* We don't need a buffer-switch event unless Emacs is waiting for input.
4957 The purpose of the event is to make read_key_sequence look up the
4958 keymaps again. If we aren't in read_key_sequence, we don't need one,
4959 and the event could cause trouble by messing up (input-pending-p). */
4960 tem = Fwaiting_for_user_input_p ();
4961 if (NILP (tem))
4962 return;
f65e6f7d
RS
4963#else
4964 /* We never need these events if we have no asynchronous subprocesses. */
4965 return;
4966#endif
a30f0615 4967
241ceaf7
RS
4968 /* Make sure no interrupt happens while storing the event. */
4969#ifdef SIGIO
4970 if (interrupt_input)
4971 {
4972 SIGMASKTYPE mask;
4f8aaa74 4973 mask = sigblock (sigmask (SIGIO));
241ceaf7
RS
4974 kbd_buffer_store_event (&event);
4975 sigsetmask (mask);
4976 }
4977 else
4978#endif
4979 {
4980 stop_polling ();
4981 kbd_buffer_store_event (&event);
4982 start_polling ();
4983 }
a8015ab5 4984}
284f4730
JB
4985\f
4986#ifndef VMS
4987
4988/* Read any terminal input already buffered up by the system
4989 into the kbd_buffer, but do not wait.
4990
4991 EXPECTED should be nonzero if the caller knows there is some input.
4992
4993 Except on VMS, all input is read by this function.
4994 If interrupt_input is nonzero, this function MUST be called
4995 only when SIGIO is blocked.
4996
4997 Returns the number of keyboard chars read, or -1 meaning
4998 this is a bad time to try to read input. */
4999
5000static int
5001read_avail_input (expected)
5002 int expected;
5003{
5004 struct input_event buf[KBD_BUFFER_SIZE];
5005 register int i;
5006 int nread;
5007
5008 if (read_socket_hook)
5009 /* No need for FIONREAD or fcntl; just say don't wait. */
33e19c6e 5010 nread = (*read_socket_hook) (input_fd, buf, KBD_BUFFER_SIZE, expected);
284f4730
JB
5011 else
5012 {
17270835
RS
5013 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
5014 the kbd_buffer can really hold. That may prevent loss
5015 of characters on some systems when input is stuffed at us. */
5016 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
58788063 5017 int n_to_read;
284f4730 5018
58788063 5019 /* Determine how many characters we should *try* to read. */
bc536d84
RS
5020#ifdef WINDOWSNT
5021 return 0;
5022#else /* not WINDOWSNT */
80e4aa30 5023#ifdef MSDOS
58788063
RS
5024 n_to_read = dos_keysns ();
5025 if (n_to_read == 0)
5026 return 0;
c3a2738c 5027#else /* not MSDOS */
284f4730
JB
5028#ifdef FIONREAD
5029 /* Find out how much input is available. */
437f6112 5030 if (ioctl (input_fd, FIONREAD, &n_to_read) < 0)
284f4730
JB
5031 /* Formerly simply reported no input, but that sometimes led to
5032 a failure of Emacs to terminate.
5033 SIGHUP seems appropriate if we can't reach the terminal. */
e4535288
RS
5034 /* ??? Is it really right to send the signal just to this process
5035 rather than to the whole process group?
5036 Perhaps on systems with FIONREAD Emacs is alone in its group. */
284f4730 5037 kill (getpid (), SIGHUP);
58788063 5038 if (n_to_read == 0)
284f4730 5039 return 0;
58788063
RS
5040 if (n_to_read > sizeof cbuf)
5041 n_to_read = sizeof cbuf;
284f4730 5042#else /* no FIONREAD */
0c04a67e 5043#if defined (USG) || defined (DGUX)
284f4730 5044 /* Read some input if available, but don't wait. */
58788063 5045 n_to_read = sizeof cbuf;
437f6112 5046 fcntl (input_fd, F_SETFL, O_NDELAY);
284f4730
JB
5047#else
5048 you lose;
5049#endif
5050#endif
80e4aa30 5051#endif /* not MSDOS */
bc536d84 5052#endif /* not WINDOWSNT */
284f4730 5053
58788063
RS
5054 /* Now read; for one reason or another, this will not block.
5055 NREAD is set to the number of chars read. */
9134775b 5056 do
284f4730 5057 {
80e4aa30 5058#ifdef MSDOS
0c04a67e 5059 cbuf[0] = dos_keyread ();
80e4aa30
RS
5060 nread = 1;
5061#else
437f6112 5062 nread = read (input_fd, cbuf, n_to_read);
80e4aa30 5063#endif
49854566
RS
5064 /* POSIX infers that processes which are not in the session leader's
5065 process group won't get SIGHUP's at logout time. BSDI adheres to
5066 this part standard and returns -1 from read(0) with errno==EIO
5067 when the control tty is taken away.
5068 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
5069 if (nread == -1 && errno == EIO)
5070 kill (0, SIGHUP);
762f2b92 5071#if defined (AIX) && (! defined (aix386) && defined (_BSD))
284f4730
JB
5072 /* The kernel sometimes fails to deliver SIGHUP for ptys.
5073 This looks incorrect, but it isn't, because _BSD causes
5074 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
5075 and that causes a value other than 0 when there is no input. */
854f3a54 5076 if (nread == 0)
80e4aa30 5077 kill (0, SIGHUP);
284f4730 5078#endif
9134775b 5079 }
791587ee
KH
5080 while (
5081 /* We used to retry the read if it was interrupted.
5082 But this does the wrong thing when O_NDELAY causes
5083 an EAGAIN error. Does anybody know of a situation
5084 where a retry is actually needed? */
5085#if 0
5086 nread < 0 && (errno == EAGAIN
6aec06f5 5087#ifdef EFAULT
9134775b 5088 || errno == EFAULT
80e4aa30 5089#endif
284f4730 5090#ifdef EBADSLT
9134775b 5091 || errno == EBADSLT
284f4730 5092#endif
791587ee
KH
5093 )
5094#else
5095 0
5096#endif
5097 );
284f4730
JB
5098
5099#ifndef FIONREAD
02c2c53f 5100#if defined (USG) || defined (DGUX)
437f6112 5101 fcntl (input_fd, F_SETFL, 0);
02c2c53f 5102#endif /* USG or DGUX */
284f4730
JB
5103#endif /* no FIONREAD */
5104 for (i = 0; i < nread; i++)
5105 {
5106 buf[i].kind = ascii_keystroke;
86e5706b 5107 buf[i].modifiers = 0;
b04904fb 5108 if (meta_key == 1 && (cbuf[i] & 0x80))
86e5706b 5109 buf[i].modifiers = meta_modifier;
b04904fb
RS
5110 if (meta_key != 2)
5111 cbuf[i] &= ~0x80;
f3e59d5e
KH
5112
5113 buf[i].code = cbuf[i];
18cd2eeb 5114 XSETFRAME (buf[i].frame_or_window, selected_frame);
284f4730
JB
5115 }
5116 }
5117
5118 /* Scan the chars for C-g and store them in kbd_buffer. */
5119 for (i = 0; i < nread; i++)
5120 {
5121 kbd_buffer_store_event (&buf[i]);
5122 /* Don't look at input that follows a C-g too closely.
5123 This reduces lossage due to autorepeat on C-g. */
5124 if (buf[i].kind == ascii_keystroke
9343ab07 5125 && buf[i].code == quit_char)
284f4730
JB
5126 break;
5127 }
5128
5129 return nread;
5130}
5131#endif /* not VMS */
5132\f
5133#ifdef SIGIO /* for entire page */
5134/* Note SIGIO has been undef'd if FIONREAD is missing. */
5135
2ce30ea2 5136SIGTYPE
284f4730
JB
5137input_available_signal (signo)
5138 int signo;
5139{
5140 /* Must preserve main program's value of errno. */
5141 int old_errno = errno;
5142#ifdef BSD4_1
5143 extern int select_alarmed;
5144#endif
5145
5970a8cb 5146#if defined (USG) && !defined (POSIX_SIGNALS)
284f4730
JB
5147 /* USG systems forget handlers when they are used;
5148 must reestablish each time */
5149 signal (signo, input_available_signal);
5150#endif /* USG */
5151
5152#ifdef BSD4_1
5153 sigisheld (SIGIO);
5154#endif
5155
ffd56f97
JB
5156 if (input_available_clear_time)
5157 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
284f4730
JB
5158
5159 while (1)
5160 {
5161 int nread;
5162 nread = read_avail_input (1);
5163 /* -1 means it's not ok to read the input now.
5164 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
5165 0 means there was no keyboard input available. */
5166 if (nread <= 0)
5167 break;
5168
5169#ifdef BSD4_1
5170 select_alarmed = 1; /* Force the select emulator back to life */
5171#endif
5172 }
5173
5174#ifdef BSD4_1
5175 sigfree ();
5176#endif
5177 errno = old_errno;
5178}
5179#endif /* SIGIO */
ad163903
JB
5180
5181/* Send ourselves a SIGIO.
5182
5183 This function exists so that the UNBLOCK_INPUT macro in
5184 blockinput.h can have some way to take care of input we put off
5185 dealing with, without assuming that every file which uses
5186 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
5187void
5188reinvoke_input_signal ()
5189{
df0f2ba1 5190#ifdef SIGIO
87dd9b9b 5191 kill (getpid (), SIGIO);
ad163903
JB
5192#endif
5193}
5194
5195
284f4730
JB
5196\f
5197/* Return the prompt-string of a sparse keymap.
5198 This is the first element which is a string.
5199 Return nil if there is none. */
5200
5201Lisp_Object
5202map_prompt (map)
5203 Lisp_Object map;
5204{
5205 while (CONSP (map))
5206 {
5207 register Lisp_Object tem;
5208 tem = Fcar (map);
8c18cbfb 5209 if (STRINGP (tem))
284f4730
JB
5210 return tem;
5211 map = Fcdr (map);
5212 }
5213 return Qnil;
5214}
5215
b7c49376
RS
5216static void menu_bar_item ();
5217static void menu_bar_one_keymap ();
5218
5219/* These variables hold the vector under construction within
5220 menu_bar_items and its subroutines, and the current index
5221 for storing into that vector. */
5222static Lisp_Object menu_bar_items_vector;
9343ab07 5223static int menu_bar_items_index;
5ec75a55 5224
b7c49376
RS
5225/* Return a vector of menu items for a menu bar, appropriate
5226 to the current buffer. Each item has three elements in the vector:
f5e09c8b 5227 KEY STRING MAPLIST.
b7c49376
RS
5228
5229 OLD is an old vector we can optionally reuse, or nil. */
5ec75a55
RS
5230
5231Lisp_Object
b7c49376
RS
5232menu_bar_items (old)
5233 Lisp_Object old;
5ec75a55
RS
5234{
5235 /* The number of keymaps we're scanning right now, and the number of
5236 keymaps we have allocated space for. */
5237 int nmaps;
5238
5239 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
5240 in the current keymaps, or nil where it is not a prefix. */
5241 Lisp_Object *maps;
5242
9f9c0e27 5243 Lisp_Object def, tem, tail;
5ec75a55
RS
5244
5245 Lisp_Object result;
5246
5247 int mapno;
47d319aa 5248 Lisp_Object oquit;
5ec75a55 5249
b7c49376
RS
5250 int i;
5251
5252 struct gcpro gcpro1;
5253
db60d856
JB
5254 /* In order to build the menus, we need to call the keymap
5255 accessors. They all call QUIT. But this function is called
5256 during redisplay, during which a quit is fatal. So inhibit
47d319aa
RS
5257 quitting while building the menus.
5258 We do this instead of specbind because (1) errors will clear it anyway
5259 and (2) this avoids risk of specpdl overflow. */
5260 oquit = Vinhibit_quit;
df0f2ba1 5261 Vinhibit_quit = Qt;
db60d856 5262
b7c49376
RS
5263 if (!NILP (old))
5264 menu_bar_items_vector = old;
5265 else
5266 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
5267 menu_bar_items_index = 0;
5268
5269 GCPRO1 (menu_bar_items_vector);
5270
5ec75a55
RS
5271 /* Build our list of keymaps.
5272 If we recognize a function key and replace its escape sequence in
5273 keybuf with its symbol, or if the sequence starts with a mouse
5274 click and we need to switch buffers, we jump back here to rebuild
5275 the initial keymaps from the current buffer. */
df0f2ba1 5276 {
5ec75a55
RS
5277 Lisp_Object *tmaps;
5278
217258d5 5279 /* Should overriding-terminal-local-map and overriding-local-map apply? */
d0a49716 5280 if (!NILP (Voverriding_local_map_menu_flag))
9dd3131c 5281 {
217258d5
KH
5282 /* Yes, use them (if non-nil) as well as the global map. */
5283 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
5284 nmaps = 0;
5285 if (!NILP (current_kboard->Voverriding_terminal_local_map))
5286 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
5287 if (!NILP (Voverriding_local_map))
5288 maps[nmaps++] = Voverriding_local_map;
9dd3131c
RS
5289 }
5290 else
5291 {
d0a49716 5292 /* No, so use major and minor mode keymaps. */
217258d5
KH
5293 nmaps = current_minor_maps (NULL, &tmaps);
5294 maps = (Lisp_Object *) alloca ((nmaps + 2) * sizeof (maps[0]));
5295 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
5ec75a55 5296#ifdef USE_TEXT_PROPERTIES
217258d5 5297 maps[nmaps++] = get_local_map (PT, current_buffer);
5ec75a55 5298#else
217258d5 5299 maps[nmaps++] = current_buffer->keymap;
5ec75a55 5300#endif
9dd3131c 5301 }
217258d5 5302 maps[nmaps++] = current_global_map;
5ec75a55
RS
5303 }
5304
5305 /* Look up in each map the dummy prefix key `menu-bar'. */
5306
5307 result = Qnil;
5308
e58aa385 5309 for (mapno = nmaps - 1; mapno >= 0; mapno--)
5ec75a55
RS
5310 {
5311 if (! NILP (maps[mapno]))
c6a67acd 5312 def = get_keyelt (access_keymap (maps[mapno], Qmenu_bar, 1, 0), 0);
5ec75a55
RS
5313 else
5314 def = Qnil;
5315
5316 tem = Fkeymapp (def);
5317 if (!NILP (tem))
b7c49376 5318 menu_bar_one_keymap (def);
5ec75a55
RS
5319 }
5320
b7c49376
RS
5321 /* Move to the end those items that should be at the end. */
5322
9f9c0e27
RS
5323 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCONS (tail)->cdr)
5324 {
b7c49376
RS
5325 int i;
5326 int end = menu_bar_items_index;
5327
35b3402f 5328 for (i = 0; i < end; i += 4)
b7c49376
RS
5329 if (EQ (XCONS (tail)->car, XVECTOR (menu_bar_items_vector)->contents[i]))
5330 {
35b3402f 5331 Lisp_Object tem0, tem1, tem2, tem3;
0301268e
RS
5332 /* Move the item at index I to the end,
5333 shifting all the others forward. */
5334 tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
5335 tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
5336 tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
35b3402f
RS
5337 tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
5338 if (end > i + 4)
5339 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
0301268e 5340 &XVECTOR (menu_bar_items_vector)->contents[i],
35b3402f
RS
5341 (end - i - 4) * sizeof (Lisp_Object));
5342 XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
5343 XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
5344 XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
5345 XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
0301268e 5346 break;
b7c49376
RS
5347 }
5348 }
9f9c0e27 5349
0c9071cd 5350 /* Add nil, nil, nil, nil at the end. */
b7c49376 5351 i = menu_bar_items_index;
35b3402f 5352 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
b7c49376
RS
5353 {
5354 Lisp_Object tem;
5355 int newsize = 2 * i;
5356 tem = Fmake_vector (make_number (2 * i), Qnil);
5357 bcopy (XVECTOR (menu_bar_items_vector)->contents,
5358 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
5359 menu_bar_items_vector = tem;
9f9c0e27 5360 }
b7c49376
RS
5361 /* Add this item. */
5362 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
5363 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
5364 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
35b3402f 5365 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
b7c49376 5366 menu_bar_items_index = i;
a73c5e29 5367
47d319aa 5368 Vinhibit_quit = oquit;
b7c49376
RS
5369 UNGCPRO;
5370 return menu_bar_items_vector;
5ec75a55
RS
5371}
5372\f
5373/* Scan one map KEYMAP, accumulating any menu items it defines
f5e09c8b 5374 in menu_bar_items_vector. */
5ec75a55 5375
b7c49376
RS
5376static void
5377menu_bar_one_keymap (keymap)
5378 Lisp_Object keymap;
5ec75a55
RS
5379{
5380 Lisp_Object tail, item, key, binding, item_string, table;
5381
5382 /* Loop over all keymap entries that have menu strings. */
8c18cbfb 5383 for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr)
5ec75a55
RS
5384 {
5385 item = XCONS (tail)->car;
8c18cbfb 5386 if (CONSP (item))
5ec75a55
RS
5387 {
5388 key = XCONS (item)->car;
5389 binding = XCONS (item)->cdr;
8c18cbfb 5390 if (CONSP (binding))
5ec75a55
RS
5391 {
5392 item_string = XCONS (binding)->car;
8c18cbfb 5393 if (STRINGP (item_string))
b7c49376 5394 menu_bar_item (key, item_string, Fcdr (binding));
5ec75a55 5395 }
e58aa385 5396 else if (EQ (binding, Qundefined))
8aa034e1 5397 menu_bar_item (key, Qnil, binding);
5ec75a55 5398 }
8c18cbfb 5399 else if (VECTORP (item))
5ec75a55
RS
5400 {
5401 /* Loop over the char values represented in the vector. */
5402 int len = XVECTOR (item)->size;
5403 int c;
5404 for (c = 0; c < len; c++)
5405 {
5406 Lisp_Object character;
bb9e9bed 5407 XSETFASTINT (character, c);
5ec75a55 5408 binding = XVECTOR (item)->contents[c];
8c18cbfb 5409 if (CONSP (binding))
5ec75a55
RS
5410 {
5411 item_string = XCONS (binding)->car;
8c18cbfb 5412 if (STRINGP (item_string))
b7c49376 5413 menu_bar_item (key, item_string, Fcdr (binding));
5ec75a55 5414 }
e58aa385 5415 else if (EQ (binding, Qundefined))
8aa034e1 5416 menu_bar_item (key, Qnil, binding);
5ec75a55
RS
5417 }
5418 }
5419 }
5ec75a55
RS
5420}
5421
047a8ea7
RS
5422/* This is used as the handler when calling internal_condition_case_1. */
5423
5424static Lisp_Object
5425menu_bar_item_1 (arg)
5426 Lisp_Object arg;
5427{
5428 return Qnil;
5429}
5430
f5e09c8b
RS
5431/* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
5432 If there's already an item for KEY, add this DEF to it. */
5433
b7c49376
RS
5434static void
5435menu_bar_item (key, item_string, def)
5436 Lisp_Object key, item_string, def;
5ec75a55 5437{
e58aa385 5438 Lisp_Object tem;
5ec75a55 5439 Lisp_Object enabled;
b7c49376 5440 int i;
5ec75a55 5441
210df3bf
KH
5442 /* Skip menu-bar equiv keys data. */
5443 if (CONSP (def) && CONSP (XCONS (def)->car))
5444 def = XCONS (def)->cdr;
5445
e58aa385
RS
5446 if (EQ (def, Qundefined))
5447 {
f5e09c8b 5448 /* If a map has an explicit `undefined' as definition,
e58aa385 5449 discard any previously made menu bar item. */
b7c49376 5450
35b3402f 5451 for (i = 0; i < menu_bar_items_index; i += 4)
b7c49376
RS
5452 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
5453 {
35b3402f
RS
5454 if (menu_bar_items_index > i + 4)
5455 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
b7c49376 5456 &XVECTOR (menu_bar_items_vector)->contents[i],
35b3402f
RS
5457 (menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
5458 menu_bar_items_index -= 4;
b7c49376
RS
5459 return;
5460 }
8aa034e1
RS
5461
5462 /* If there's no definition for this key yet,
5463 just ignore `undefined'. */
5464 return;
e58aa385
RS
5465 }
5466
5ec75a55
RS
5467 /* See if this entry is enabled. */
5468 enabled = Qt;
5469
8c18cbfb 5470 if (SYMBOLP (def))
5ec75a55
RS
5471 {
5472 /* No property, or nil, means enable.
5473 Otherwise, enable if value is not nil. */
5474 tem = Fget (def, Qmenu_enable);
5475 if (!NILP (tem))
047a8ea7
RS
5476 /* (condition-case nil (eval tem)
5477 (error nil)) */
5478 enabled = internal_condition_case_1 (Feval, tem, Qerror,
5479 menu_bar_item_1);
5ec75a55
RS
5480 }
5481
b7c49376
RS
5482 /* Ignore this item if it's not enabled. */
5483 if (NILP (enabled))
5484 return;
5ec75a55 5485
f5e09c8b 5486 /* Find any existing item for this KEY. */
35b3402f 5487 for (i = 0; i < menu_bar_items_index; i += 4)
b7c49376
RS
5488 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
5489 break;
5490
f5e09c8b 5491 /* If we did not find this KEY, add it at the end. */
b7c49376
RS
5492 if (i == menu_bar_items_index)
5493 {
5494 /* If vector is too small, get a bigger one. */
35b3402f 5495 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
b7c49376
RS
5496 {
5497 Lisp_Object tem;
5498 int newsize = 2 * i;
5499 tem = Fmake_vector (make_number (2 * i), Qnil);
5500 bcopy (XVECTOR (menu_bar_items_vector)->contents,
5501 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
5502 menu_bar_items_vector = tem;
5503 }
5504 /* Add this item. */
5505 XVECTOR (menu_bar_items_vector)->contents[i++] = key;
5506 XVECTOR (menu_bar_items_vector)->contents[i++] = item_string;
f5e09c8b 5507 XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (def, Qnil);
35b3402f 5508 XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
b7c49376
RS
5509 menu_bar_items_index = i;
5510 }
f5e09c8b
RS
5511 /* We did find an item for this KEY. Add DEF to its list of maps. */
5512 else
5513 {
5514 Lisp_Object old;
5515 old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
5516 XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (def, old);
5517 }
5ec75a55
RS
5518}
5519\f
dcc408a0
RS
5520/* Read a character using menus based on maps in the array MAPS.
5521 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
5522 Return t if we displayed a menu but the user rejected it.
7d6de002
RS
5523
5524 PREV_EVENT is the previous input event, or nil if we are reading
5525 the first event of a key sequence.
5526
83d68044 5527 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
6569cc8d 5528 if we used a mouse menu to read the input, or zero otherwise. If
83d68044 5529 USED_MOUSE_MENU is null, we don't dereference it.
284f4730
JB
5530
5531 The prompting is done based on the prompt-string of the map
df0f2ba1 5532 and the strings associated with various map elements.
8150596a
RS
5533
5534 This can be done with X menus or with menus put in the minibuf.
5535 These are done in different ways, depending on how the input will be read.
5536 Menus using X are done after auto-saving in read-char, getting the input
5537 event from Fx_popup_menu; menus using the minibuf use read_char recursively
5538 and do auto-saving in the inner call of read_char. */
284f4730 5539
7617111f 5540static Lisp_Object
8150596a 5541read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
7d6de002
RS
5542 int nmaps;
5543 Lisp_Object *maps;
5544 Lisp_Object prev_event;
5545 int *used_mouse_menu;
284f4730 5546{
7d6de002
RS
5547 int mapno;
5548 register Lisp_Object name;
7d6de002
RS
5549 Lisp_Object rest, vector;
5550
6569cc8d
JB
5551 if (used_mouse_menu)
5552 *used_mouse_menu = 0;
284f4730
JB
5553
5554 /* Use local over global Menu maps */
5555
7d6de002
RS
5556 if (! menu_prompting)
5557 return Qnil;
5558
03361bcc
RS
5559 /* Optionally disregard all but the global map. */
5560 if (inhibit_local_menu_bar_menus)
5561 {
5562 maps += (nmaps - 1);
5563 nmaps = 1;
5564 }
5565
7d6de002
RS
5566 /* Get the menu name from the first map that has one (a prompt string). */
5567 for (mapno = 0; mapno < nmaps; mapno++)
5568 {
5569 name = map_prompt (maps[mapno]);
5570 if (!NILP (name))
5571 break;
5572 }
284f4730 5573
7d6de002 5574 /* If we don't have any menus, just read a character normally. */
dbc4e1c1 5575 if (mapno >= nmaps)
7d6de002
RS
5576 return Qnil;
5577
1f5b1641 5578#ifdef HAVE_MENUS
7d6de002
RS
5579 /* If we got to this point via a mouse click,
5580 use a real menu for mouse selection. */
5a8d99e0
KH
5581 if (EVENT_HAS_PARAMETERS (prev_event)
5582 && !EQ (XCONS (prev_event)->car, Qmenu_bar))
7d6de002
RS
5583 {
5584 /* Display the menu and get the selection. */
5585 Lisp_Object *realmaps
5586 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
5587 Lisp_Object value;
5588 int nmaps1 = 0;
5589
5590 /* Use the maps that are not nil. */
5591 for (mapno = 0; mapno < nmaps; mapno++)
5592 if (!NILP (maps[mapno]))
5593 realmaps[nmaps1++] = maps[mapno];
5594
5595 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
663258f2
JB
5596 if (CONSP (value))
5597 {
68f297c5
RS
5598 Lisp_Object tem;
5599
8eb4d8ef
RS
5600 record_menu_key (XCONS (value)->car);
5601
68f297c5
RS
5602 /* If we got multiple events, unread all but
5603 the first.
5604 There is no way to prevent those unread events
5605 from showing up later in last_nonmenu_event.
5606 So turn symbol and integer events into lists,
5607 to indicate that they came from a mouse menu,
5608 so that when present in last_nonmenu_event
5609 they won't confuse things. */
5610 for (tem = XCONS (value)->cdr; !NILP (tem);
5611 tem = XCONS (tem)->cdr)
8eb4d8ef
RS
5612 {
5613 record_menu_key (XCONS (tem)->car);
5614 if (SYMBOLP (XCONS (tem)->car)
5615 || INTEGERP (XCONS (tem)->car))
5616 XCONS (tem)->car
5617 = Fcons (XCONS (tem)->car, Qnil);
5618 }
68f297c5 5619
663258f2
JB
5620 /* If we got more than one event, put all but the first
5621 onto this list to be read later.
5622 Return just the first event now. */
24597608
RS
5623 Vunread_command_events
5624 = nconc2 (XCONS (value)->cdr, Vunread_command_events);
663258f2
JB
5625 value = XCONS (value)->car;
5626 }
1c90c381 5627 else if (NILP (value))
dcc408a0 5628 value = Qt;
6569cc8d
JB
5629 if (used_mouse_menu)
5630 *used_mouse_menu = 1;
7d6de002
RS
5631 return value;
5632 }
1f5b1641 5633#endif /* HAVE_MENUS */
8150596a
RS
5634 return Qnil ;
5635}
5636
68e0de82
RS
5637/* Buffer in use so far for the minibuf prompts for menu keymaps.
5638 We make this bigger when necessary, and never free it. */
5639static char *read_char_minibuf_menu_text;
5640/* Size of that buffer. */
5641static int read_char_minibuf_menu_width;
5642
8150596a 5643static Lisp_Object
24597608 5644read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
8150596a
RS
5645 int commandflag ;
5646 int nmaps;
5647 Lisp_Object *maps;
5648{
5649 int mapno;
5650 register Lisp_Object name;
5651 int nlength;
5652 int width = FRAME_WIDTH (selected_frame) - 4;
8150596a 5653 int idx = -1;
9fdbfdf8 5654 int nobindings = 1;
8150596a 5655 Lisp_Object rest, vector;
68e0de82 5656 char *menu;
8150596a
RS
5657
5658 if (! menu_prompting)
5659 return Qnil;
5660
68e0de82
RS
5661 /* Make sure we have a big enough buffer for the menu text. */
5662 if (read_char_minibuf_menu_text == 0)
5663 {
5664 read_char_minibuf_menu_width = width + 4;
5665 read_char_minibuf_menu_text = (char *) xmalloc (width + 4);
5666 }
5667 else if (width + 4 > read_char_minibuf_menu_width)
5668 {
5669 read_char_minibuf_menu_width = width + 4;
5670 read_char_minibuf_menu_text
5671 = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
5672 }
5673 menu = read_char_minibuf_menu_text;
5674
8150596a
RS
5675 /* Get the menu name from the first map that has one (a prompt string). */
5676 for (mapno = 0; mapno < nmaps; mapno++)
5677 {
5678 name = map_prompt (maps[mapno]);
5679 if (!NILP (name))
5680 break;
5681 }
5682
5683 /* If we don't have any menus, just read a character normally. */
5684 if (mapno >= nmaps)
5685 return Qnil;
284f4730
JB
5686
5687 /* Prompt string always starts with map's prompt, and a space. */
5688 strcpy (menu, XSTRING (name)->data);
5689 nlength = XSTRING (name)->size;
7d6de002 5690 menu[nlength++] = ':';
284f4730
JB
5691 menu[nlength++] = ' ';
5692 menu[nlength] = 0;
5693
7d6de002
RS
5694 /* Start prompting at start of first map. */
5695 mapno = 0;
5696 rest = maps[mapno];
284f4730
JB
5697
5698 /* Present the documented bindings, a line at a time. */
5699 while (1)
5700 {
5701 int notfirst = 0;
5702 int i = nlength;
5703 Lisp_Object obj;
5704 int ch;
8066f1a1 5705 Lisp_Object orig_defn_macro;
284f4730 5706
284f4730 5707 /* Loop over elements of map. */
7d6de002 5708 while (i < width)
284f4730 5709 {
7d6de002 5710 Lisp_Object s, elt;
284f4730 5711
7d6de002
RS
5712 /* If reached end of map, start at beginning of next map. */
5713 if (NILP (rest))
5714 {
5715 mapno++;
5716 /* At end of last map, wrap around to first map if just starting,
5717 or end this line if already have something on it. */
5718 if (mapno == nmaps)
284f4730 5719 {
8150596a 5720 mapno = 0;
40932d1a 5721 if (notfirst || nobindings) break;
284f4730 5722 }
7d6de002 5723 rest = maps[mapno];
284f4730 5724 }
7d6de002
RS
5725
5726 /* Look at the next element of the map. */
5727 if (idx >= 0)
5728 elt = XVECTOR (vector)->contents[idx];
284f4730 5729 else
7d6de002
RS
5730 elt = Fcar_safe (rest);
5731
8c18cbfb 5732 if (idx < 0 && VECTORP (elt))
284f4730 5733 {
7d6de002
RS
5734 /* If we found a dense table in the keymap,
5735 advanced past it, but start scanning its contents. */
5736 rest = Fcdr_safe (rest);
5737 vector = elt;
5738 idx = 0;
284f4730 5739 }
7d6de002
RS
5740 else
5741 {
5742 /* An ordinary element. */
0a2ea221
KH
5743 Lisp_Object event;
5744
5745 if (idx < 0)
5746 {
5747 s = Fcar_safe (Fcdr_safe (elt)); /* alist */
5748 event = Fcar_safe (elt);
5749 }
8150596a 5750 else
7d6de002 5751 {
0a2ea221
KH
5752 s = Fcar_safe (elt); /* vector */
5753 XSETINT (event, idx);
5754 }
5755
5756 /* Ignore the element if it has no prompt string. */
5757 if (STRINGP (s) && INTEGERP (event))
5758 {
5759 /* 1 if the char to type matches the string. */
5760 int char_matches;
5761 Lisp_Object upcased_event, downcased_event;
5762 Lisp_Object desc;
5763
5764 upcased_event = Fupcase (event);
5765 downcased_event = Fdowncase (event);
5766 char_matches = (XINT (upcased_event) == XSTRING (s)->data[0]
5767 || XINT (downcased_event) == XSTRING (s)->data[0]);
5768 if (! char_matches)
5769 desc = Fsingle_key_description (event);
5770
5771 /* If we have room for the prompt string, add it to this line.
5772 If this is the first on the line, always add it. */
5773 if ((XSTRING (s)->size + i + 2
5774 + (char_matches ? 0 : XSTRING (desc)->size + 3))
5775 < width
5776 || !notfirst)
5777 {
5778 int thiswidth;
5779
5780 /* Punctuate between strings. */
5781 if (notfirst)
5782 {
5783 strcpy (menu + i, ", ");
5784 i += 2;
5785 }
5786 notfirst = 1;
5787 nobindings = 0 ;
284f4730 5788
0a2ea221
KH
5789 /* If the char to type doesn't match the string's
5790 first char, explicitly show what char to type. */
5791 if (! char_matches)
5792 {
5793 /* Add as much of string as fits. */
5794 thiswidth = XSTRING (desc)->size;
5795 if (thiswidth + i > width)
5796 thiswidth = width - i;
5797 bcopy (XSTRING (desc)->data, menu + i, thiswidth);
5798 i += thiswidth;
5799 strcpy (menu + i, " = ");
5800 i += 3;
5801 }
5802
5803 /* Add as much of string as fits. */
5804 thiswidth = XSTRING (s)->size;
5805 if (thiswidth + i > width)
5806 thiswidth = width - i;
5807 bcopy (XSTRING (s)->data, menu + i, thiswidth);
5808 i += thiswidth;
5809 menu[i] = 0;
5810 }
5811 else
7d6de002 5812 {
0a2ea221
KH
5813 /* If this element does not fit, end the line now,
5814 and save the element for the next line. */
5815 strcpy (menu + i, "...");
5816 break;
7d6de002 5817 }
7d6de002
RS
5818 }
5819
5820 /* Move past this element. */
8150596a 5821 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
7d6de002
RS
5822 /* Handle reaching end of dense table. */
5823 idx = -1;
5824 if (idx >= 0)
5825 idx++;
5826 else
5827 rest = Fcdr_safe (rest);
5828 }
284f4730
JB
5829 }
5830
5831 /* Prompt with that and read response. */
5832 message1 (menu);
8150596a 5833
df0f2ba1 5834 /* Make believe its not a keyboard macro in case the help char
8150596a
RS
5835 is pressed. Help characters are not recorded because menu prompting
5836 is not used on replay.
5837 */
c5fdd383
KH
5838 orig_defn_macro = current_kboard->defining_kbd_macro;
5839 current_kboard->defining_kbd_macro = Qnil;
3cb81011
KH
5840 do
5841 obj = read_char (commandflag, 0, 0, Qnil, 0);
8c18cbfb 5842 while (BUFFERP (obj));
c5fdd383 5843 current_kboard->defining_kbd_macro = orig_defn_macro;
284f4730 5844
8c18cbfb 5845 if (!INTEGERP (obj))
284f4730
JB
5846 return obj;
5847 else
5848 ch = XINT (obj);
5849
f4255cd1 5850 if (! EQ (obj, menu_prompt_more_char)
8c18cbfb 5851 && (!INTEGERP (menu_prompt_more_char)
f4255cd1 5852 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
8150596a 5853 {
c5fdd383 5854 if (!NILP (current_kboard->defining_kbd_macro))
8066f1a1 5855 store_kbd_macro_char (obj);
8150596a
RS
5856 return obj;
5857 }
5858 /* Help char - go round again */
284f4730
JB
5859 }
5860}
284f4730
JB
5861\f
5862/* Reading key sequences. */
5863
5864/* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
5865 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
5866 keymap, or nil otherwise. Return the index of the first keymap in
5867 which KEY has any binding, or NMAPS if no map has a binding.
5868
5869 If KEY is a meta ASCII character, treat it like meta-prefix-char
5870 followed by the corresponding non-meta character. Keymaps in
5871 CURRENT with non-prefix bindings for meta-prefix-char become nil in
5872 NEXT.
5873
88cb0656
JB
5874 If KEY has no bindings in any of the CURRENT maps, NEXT is left
5875 unmodified.
5876
569871d2 5877 NEXT may be the same array as CURRENT. */
284f4730
JB
5878
5879static int
4e50f26a 5880follow_key (key, nmaps, current, defs, next)
284f4730
JB
5881 Lisp_Object key;
5882 Lisp_Object *current, *defs, *next;
5883 int nmaps;
5884{
5885 int i, first_binding;
569871d2 5886 int did_meta = 0;
284f4730
JB
5887
5888 /* If KEY is a meta ASCII character, treat it like meta-prefix-char
569871d2
RS
5889 followed by the corresponding non-meta character.
5890 Put the results into DEFS, since we are going to alter that anyway.
5891 Do not alter CURRENT or NEXT. */
8c18cbfb 5892 if (INTEGERP (key) && (XINT (key) & CHAR_META))
284f4730
JB
5893 {
5894 for (i = 0; i < nmaps; i++)
5895 if (! NILP (current[i]))
5896 {
569871d2
RS
5897 Lisp_Object def;
5898 def = get_keyelt (access_keymap (current[i],
c6a67acd 5899 meta_prefix_char, 1, 0), 0);
284f4730
JB
5900
5901 /* Note that since we pass the resulting bindings through
5902 get_keymap_1, non-prefix bindings for meta-prefix-char
5903 disappear. */
569871d2 5904 defs[i] = get_keymap_1 (def, 0, 1);
284f4730
JB
5905 }
5906 else
569871d2 5907 defs[i] = Qnil;
284f4730 5908
569871d2 5909 did_meta = 1;
18cd2eeb 5910 XSETINT (key, XFASTINT (key) & ~CHAR_META);
284f4730
JB
5911 }
5912
5913 first_binding = nmaps;
5914 for (i = nmaps - 1; i >= 0; i--)
5915 {
5916 if (! NILP (current[i]))
5917 {
569871d2
RS
5918 Lisp_Object map;
5919 if (did_meta)
5920 map = defs[i];
5921 else
5922 map = current[i];
5923
c6a67acd 5924 defs[i] = get_keyelt (access_keymap (map, key, 1, 0), 0);
284f4730
JB
5925 if (! NILP (defs[i]))
5926 first_binding = i;
5927 }
5928 else
5929 defs[i] = Qnil;
5930 }
5931
284f4730 5932 /* Given the set of bindings we've found, produce the next set of maps. */
0a7f1fc0
JB
5933 if (first_binding < nmaps)
5934 for (i = 0; i < nmaps; i++)
f4255cd1 5935 next[i] = NILP (defs[i]) ? Qnil : get_keymap_1 (defs[i], 0, 1);
284f4730
JB
5936
5937 return first_binding;
5938}
5939
df0f2ba1 5940/* Read a sequence of keys that ends with a non prefix character,
f4255cd1
JB
5941 storing it in KEYBUF, a buffer of size BUFSIZE.
5942 Prompt with PROMPT.
284f4730 5943 Return the length of the key sequence stored.
dcc408a0 5944 Return -1 if the user rejected a command menu.
284f4730 5945
f4255cd1
JB
5946 Echo starting immediately unless `prompt' is 0.
5947
5948 Where a key sequence ends depends on the currently active keymaps.
5949 These include any minor mode keymaps active in the current buffer,
5950 the current buffer's local map, and the global map.
5951
5952 If a key sequence has no other bindings, we check Vfunction_key_map
5953 to see if some trailing subsequence might be the beginning of a
5954 function key's sequence. If so, we try to read the whole function
5955 key, and substitute its symbolic name into the key sequence.
5956
fbcd35bd
JB
5957 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
5958 `double-' events into similar click events, if that would make them
5959 bound. We try to turn `triple-' events first into `double-' events,
5960 then into clicks.
f4255cd1
JB
5961
5962 If we get a mouse click in a mode line, vertical divider, or other
5963 non-text area, we treat the click as if it were prefixed by the
5964 symbol denoting that area - `mode-line', `vertical-line', or
5965 whatever.
5966
5967 If the sequence starts with a mouse click, we read the key sequence
5968 with respect to the buffer clicked on, not the current buffer.
284f4730 5969
f4255cd1
JB
5970 If the user switches frames in the midst of a key sequence, we put
5971 off the switch-frame event until later; the next call to
f571ae0d
RS
5972 read_char will return it.
5973
5974 If FIX_CURRENT_BUFFER is nonzero, we restore current_buffer
5975 from the selected window's buffer. */
48e416d4 5976
284f4730 5977static int
ce98e608 5978read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
f571ae0d 5979 can_return_switch_frame, fix_current_buffer)
284f4730
JB
5980 Lisp_Object *keybuf;
5981 int bufsize;
84d91fda 5982 Lisp_Object prompt;
309b0fc8 5983 int dont_downcase_last;
ce98e608 5984 int can_return_switch_frame;
f571ae0d 5985 int fix_current_buffer;
284f4730 5986{
f4255cd1
JB
5987 int count = specpdl_ptr - specpdl;
5988
284f4730
JB
5989 /* How many keys there are in the current key sequence. */
5990 int t;
5991
284f4730
JB
5992 /* The length of the echo buffer when we started reading, and
5993 the length of this_command_keys when we started reading. */
5994 int echo_start;
f4255cd1 5995 int keys_start;
284f4730
JB
5996
5997 /* The number of keymaps we're scanning right now, and the number of
5998 keymaps we have allocated space for. */
5999 int nmaps;
6000 int nmaps_allocated = 0;
6001
284f4730
JB
6002 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
6003 the current keymaps. */
6004 Lisp_Object *defs;
6005
f4255cd1
JB
6006 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
6007 in the current keymaps, or nil where it is not a prefix. */
6008 Lisp_Object *submaps;
6009
e0dff5f6
RS
6010 /* The local map to start out with at start of key sequence. */
6011 Lisp_Object orig_local_map;
6012
6013 /* 1 if we have already considered switching to the local-map property
6014 of the place where a mouse click occurred. */
6015 int localized_local_map = 0;
6016
f4255cd1
JB
6017 /* The index in defs[] of the first keymap that has a binding for
6018 this key sequence. In other words, the lowest i such that
6019 defs[i] is non-nil. */
284f4730
JB
6020 int first_binding;
6021
f4255cd1 6022 /* If t < mock_input, then KEYBUF[t] should be read as the next
253598e4
JB
6023 input key.
6024
6025 We use this to recover after recognizing a function key. Once we
6026 realize that a suffix of the current key sequence is actually a
6027 function key's escape sequence, we replace the suffix with the
6028 function key's binding from Vfunction_key_map. Now keybuf
f4255cd1
JB
6029 contains a new and different key sequence, so the echo area,
6030 this_command_keys, and the submaps and defs arrays are wrong. In
6031 this situation, we set mock_input to t, set t to 0, and jump to
6032 restart_sequence; the loop will read keys from keybuf up until
6033 mock_input, thus rebuilding the state; and then it will resume
6034 reading characters from the keyboard. */
284f4730
JB
6035 int mock_input = 0;
6036
253598e4 6037 /* If the sequence is unbound in submaps[], then
f4255cd1
JB
6038 keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map,
6039 and fkey_map is its binding.
253598e4 6040
f4255cd1
JB
6041 These might be > t, indicating that all function key scanning
6042 should hold off until t reaches them. We do this when we've just
6043 recognized a function key, to avoid searching for the function
6044 key's again in Vfunction_key_map. */
284f4730 6045 int fkey_start = 0, fkey_end = 0;
4efda7dd 6046 Lisp_Object fkey_map;
284f4730 6047
a612e298
RS
6048 /* Likewise, for key_translation_map. */
6049 int keytran_start = 0, keytran_end = 0;
6050 Lisp_Object keytran_map;
6051
cd21b839
JB
6052 /* If we receive a ``switch-frame'' event in the middle of a key sequence,
6053 we put it off for later. While we're reading, we keep the event here. */
4efda7dd 6054 Lisp_Object delayed_switch_frame;
cd21b839 6055
51763820
BF
6056 /* See the comment below... */
6057#if defined (GOBBLE_FIRST_EVENT)
4efda7dd 6058 Lisp_Object first_event;
51763820 6059#endif
4efda7dd 6060
309b0fc8
RS
6061 Lisp_Object original_uppercase;
6062 int original_uppercase_position = -1;
6063
bc536d84 6064 /* Gets around Microsoft compiler limitations. */
309b0fc8 6065 int dummyflag = 0;
bc536d84 6066
3b9189f8
RS
6067 struct buffer *starting_buffer;
6068
e9bf89a0
RS
6069 /* Nonzero if we seem to have got the beginning of a binding
6070 in function_key_map. */
6071 int function_key_possible = 0;
00a78037 6072 int key_translation_possible = 0;
e9bf89a0 6073
3fe8e9a2
RS
6074 /* Save the status of key translation before each step,
6075 so that we can restore this after downcasing. */
6076 Lisp_Object prev_fkey_map;
3fdfceb3
RS
6077 int prev_fkey_start;
6078 int prev_fkey_end;
3fe8e9a2
RS
6079
6080 Lisp_Object prev_keytran_map;
3fdfceb3
RS
6081 int prev_keytran_start;
6082 int prev_keytran_end;
3fe8e9a2 6083
4efda7dd
RS
6084 int junk;
6085
6086 last_nonmenu_event = Qnil;
6087
6088 delayed_switch_frame = Qnil;
6089 fkey_map = Vfunction_key_map;
a612e298 6090 keytran_map = Vkey_translation_map;
f4255cd1 6091
a612e298 6092 /* If there is no function-key-map, turn off function key scanning. */
f4255cd1
JB
6093 if (NILP (Fkeymapp (Vfunction_key_map)))
6094 fkey_start = fkey_end = bufsize + 1;
6095
a612e298
RS
6096 /* If there is no key-translation-map, turn off scanning. */
6097 if (NILP (Fkeymapp (Vkey_translation_map)))
6098 keytran_start = keytran_end = bufsize + 1;
6099
284f4730
JB
6100 if (INTERACTIVE)
6101 {
84d91fda
RS
6102 if (!NILP (prompt))
6103 echo_prompt (XSTRING (prompt)->data);
a98ea3f9 6104 else if (cursor_in_echo_area && echo_keystrokes)
284f4730
JB
6105 /* This doesn't put in a dash if the echo buffer is empty, so
6106 you don't always see a dash hanging out in the minibuffer. */
6107 echo_dash ();
284f4730
JB
6108 }
6109
f4255cd1
JB
6110 /* Record the initial state of the echo area and this_command_keys;
6111 we will need to restore them if we replay a key sequence. */
0a7f1fc0 6112 if (INTERACTIVE)
df0f2ba1 6113 echo_start = echo_length ();
f4255cd1 6114 keys_start = this_command_key_count;
6321824f 6115 this_single_command_key_start = keys_start;
0a7f1fc0 6116
51763820
BF
6117#if defined (GOBBLE_FIRST_EVENT)
6118 /* This doesn't quite work, because some of the things that read_char
6119 does cannot safely be bypassed. It seems too risky to try to make
df0f2ba1 6120 this work right. */
51763820 6121
4efda7dd
RS
6122 /* Read the first char of the sequence specially, before setting
6123 up any keymaps, in case a filter runs and switches buffers on us. */
84d91fda 6124 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
4efda7dd 6125 &junk);
51763820 6126#endif /* GOBBLE_FIRST_EVENT */
4efda7dd 6127
e0dff5f6
RS
6128 orig_local_map = get_local_map (PT, current_buffer);
6129
7b4aedb9
JB
6130 /* We jump here when the key sequence has been thoroughly changed, and
6131 we need to rescan it starting from the beginning. When we jump here,
6132 keybuf[0..mock_input] holds the sequence we should reread. */
07d2b8de 6133 replay_sequence:
7b4aedb9 6134
3b9189f8 6135 starting_buffer = current_buffer;
e9bf89a0 6136 function_key_possible = 0;
00a78037 6137 key_translation_possible = 0;
3b9189f8 6138
f4255cd1 6139 /* Build our list of keymaps.
07d2b8de
JB
6140 If we recognize a function key and replace its escape sequence in
6141 keybuf with its symbol, or if the sequence starts with a mouse
6142 click and we need to switch buffers, we jump back here to rebuild
6143 the initial keymaps from the current buffer. */
df0f2ba1 6144 {
284f4730
JB
6145 Lisp_Object *maps;
6146
217258d5
KH
6147 if (!NILP (current_kboard->Voverriding_terminal_local_map)
6148 || !NILP (Voverriding_local_map))
284f4730 6149 {
217258d5 6150 if (3 > nmaps_allocated)
9dd3131c 6151 {
217258d5
KH
6152 submaps = (Lisp_Object *) alloca (3 * sizeof (submaps[0]));
6153 defs = (Lisp_Object *) alloca (3 * sizeof (defs[0]));
6154 nmaps_allocated = 3;
9dd3131c 6155 }
217258d5
KH
6156 nmaps = 0;
6157 if (!NILP (current_kboard->Voverriding_terminal_local_map))
6158 submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
6159 if (!NILP (Voverriding_local_map))
6160 submaps[nmaps++] = Voverriding_local_map;
284f4730 6161 }
9dd3131c
RS
6162 else
6163 {
217258d5
KH
6164 nmaps = current_minor_maps (0, &maps);
6165 if (nmaps + 2 > nmaps_allocated)
9dd3131c 6166 {
217258d5
KH
6167 submaps = (Lisp_Object *) alloca ((nmaps+2) * sizeof (submaps[0]));
6168 defs = (Lisp_Object *) alloca ((nmaps+2) * sizeof (defs[0]));
6169 nmaps_allocated = nmaps + 2;
9dd3131c 6170 }
217258d5 6171 bcopy (maps, submaps, nmaps * sizeof (submaps[0]));
497ba7a1 6172#ifdef USE_TEXT_PROPERTIES
217258d5 6173 submaps[nmaps++] = orig_local_map;
497ba7a1 6174#else
217258d5 6175 submaps[nmaps++] = current_buffer->keymap;
497ba7a1 6176#endif
9dd3131c 6177 }
217258d5 6178 submaps[nmaps++] = current_global_map;
284f4730
JB
6179 }
6180
6181 /* Find an accurate initial value for first_binding. */
6182 for (first_binding = 0; first_binding < nmaps; first_binding++)
253598e4 6183 if (! NILP (submaps[first_binding]))
284f4730
JB
6184 break;
6185
3b9189f8 6186 /* Start from the beginning in keybuf. */
f4255cd1
JB
6187 t = 0;
6188
6189 /* These are no-ops the first time through, but if we restart, they
6190 revert the echo area and this_command_keys to their original state. */
6191 this_command_key_count = keys_start;
df0f2ba1 6192 if (INTERACTIVE && t < mock_input)
f4255cd1
JB
6193 echo_truncate (echo_start);
6194
cca310da
JB
6195 /* If the best binding for the current key sequence is a keymap, or
6196 we may be looking at a function key's escape sequence, keep on
6197 reading. */
253598e4 6198 while ((first_binding < nmaps && ! NILP (submaps[first_binding]))
cca310da
JB
6199 || (first_binding >= nmaps
6200 && fkey_start < t
6201 /* mock input is never part of a function key's sequence. */
a612e298 6202 && mock_input <= fkey_start)
0d882d52
KH
6203 || (first_binding >= nmaps
6204 && keytran_start < t && key_translation_possible)
e9bf89a0
RS
6205 /* Don't return in the middle of a possible function key sequence,
6206 if the only bindings we found were via case conversion.
6207 Thus, if ESC O a has a function-key-map translation
6208 and ESC o has a binding, don't return after ESC O,
6209 so that we can translate ESC O plus the next character. */
4e50f26a 6210 )
284f4730
JB
6211 {
6212 Lisp_Object key;
7d6de002 6213 int used_mouse_menu = 0;
284f4730 6214
7b4aedb9
JB
6215 /* Where the last real key started. If we need to throw away a
6216 key that has expanded into more than one element of keybuf
6217 (say, a mouse click on the mode line which is being treated
6218 as [mode-line (mouse-...)], then we backtrack to this point
6219 of keybuf. */
6220 int last_real_key_start;
6221
0a7f1fc0
JB
6222 /* These variables are analogous to echo_start and keys_start;
6223 while those allow us to restart the entire key sequence,
6224 echo_local_start and keys_local_start allow us to throw away
6225 just one key. */
f4255cd1
JB
6226 int echo_local_start, keys_local_start, local_first_binding;
6227
284f4730 6228 if (t >= bufsize)
3fe8e9a2 6229 error ("Key sequence too long");
284f4730 6230
f4255cd1
JB
6231 if (INTERACTIVE)
6232 echo_local_start = echo_length ();
6233 keys_local_start = this_command_key_count;
6234 local_first_binding = first_binding;
df0f2ba1 6235
f4255cd1 6236 replay_key:
0a7f1fc0 6237 /* These are no-ops, unless we throw away a keystroke below and
f4255cd1
JB
6238 jumped back up to replay_key; in that case, these restore the
6239 variables to their original state, allowing us to replay the
0a7f1fc0 6240 loop. */
40932d1a 6241 if (INTERACTIVE && t < mock_input)
f4255cd1 6242 echo_truncate (echo_local_start);
0a7f1fc0
JB
6243 this_command_key_count = keys_local_start;
6244 first_binding = local_first_binding;
6245
7e85b935
RS
6246 /* By default, assume each event is "real". */
6247 last_real_key_start = t;
6248
f4255cd1 6249 /* Does mock_input indicate that we are re-reading a key sequence? */
284f4730
JB
6250 if (t < mock_input)
6251 {
6252 key = keybuf[t];
6253 add_command_key (key);
a98ea3f9
RS
6254 if (echo_keystrokes)
6255 echo_char (key);
284f4730 6256 }
253598e4
JB
6257
6258 /* If not, we should actually read a character. */
284f4730
JB
6259 else
6260 {
a6d53864
RS
6261 struct buffer *buf = current_buffer;
6262
beecf6a1 6263 {
c5fdd383
KH
6264#ifdef MULTI_KBOARD
6265 KBOARD *interrupted_kboard = current_kboard;
df0f2ba1 6266 struct frame *interrupted_frame = selected_frame;
c5fdd383 6267 if (setjmp (wrong_kboard_jmpbuf))
beecf6a1 6268 {
5798cf15
KH
6269 if (!NILP (delayed_switch_frame))
6270 {
c5fdd383 6271 interrupted_kboard->kbd_queue
5798cf15 6272 = Fcons (delayed_switch_frame,
c5fdd383 6273 interrupted_kboard->kbd_queue);
5798cf15
KH
6274 delayed_switch_frame = Qnil;
6275 }
beecf6a1 6276 while (t > 0)
c5fdd383
KH
6277 interrupted_kboard->kbd_queue
6278 = Fcons (keybuf[--t], interrupted_kboard->kbd_queue);
5798cf15
KH
6279
6280 /* If the side queue is non-empty, ensure it begins with a
6281 switch-frame, so we'll replay it in the right context. */
c5fdd383
KH
6282 if (CONSP (interrupted_kboard->kbd_queue)
6283 && (key = XCONS (interrupted_kboard->kbd_queue)->car,
5798cf15
KH
6284 !(EVENT_HAS_PARAMETERS (key)
6285 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
6286 Qswitch_frame))))
df0f2ba1
KH
6287 {
6288 Lisp_Object frame;
6289 XSETFRAME (frame, interrupted_frame);
c5fdd383 6290 interrupted_kboard->kbd_queue
df0f2ba1 6291 = Fcons (make_lispy_switch_frame (frame),
c5fdd383 6292 interrupted_kboard->kbd_queue);
df0f2ba1 6293 }
beecf6a1 6294 mock_input = 0;
a6e0153c 6295 orig_local_map = get_local_map (PT, current_buffer);
beecf6a1
KH
6296 goto replay_sequence;
6297 }
bded54dd 6298#endif
beecf6a1
KH
6299 key = read_char (NILP (prompt), nmaps, submaps, last_nonmenu_event,
6300 &used_mouse_menu);
6301 }
284f4730 6302
dcc408a0
RS
6303 /* read_char returns t when it shows a menu and the user rejects it.
6304 Just return -1. */
6305 if (EQ (key, Qt))
6306 return -1;
6307
f4255cd1 6308 /* read_char returns -1 at the end of a macro.
284f4730
JB
6309 Emacs 18 handles this by returning immediately with a
6310 zero, so that's what we'll do. */
8c18cbfb 6311 if (INTEGERP (key) && XINT (key) == -1)
cd21b839 6312 {
f4255cd1 6313 t = 0;
bc536d84
RS
6314 /* The Microsoft C compiler can't handle the goto that
6315 would go here. */
309b0fc8 6316 dummyflag = 1;
bc536d84 6317 break;
cd21b839 6318 }
df0f2ba1 6319
3cb81011
KH
6320 /* If the current buffer has been changed from under us, the
6321 keymap may have changed, so replay the sequence. */
8c18cbfb 6322 if (BUFFERP (key))
3cb81011
KH
6323 {
6324 mock_input = t;
f571ae0d
RS
6325 /* Reset the current buffer from the selected window
6326 in case something changed the former and not the latter.
6327 This is to be more consistent with the behavior
6328 of the command_loop_1. */
6329 if (fix_current_buffer)
6330 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
6331 Fset_buffer (XWINDOW (selected_window)->buffer);
6332
a6e0153c 6333 orig_local_map = get_local_map (PT, current_buffer);
3cb81011
KH
6334 goto replay_sequence;
6335 }
6336
3b9189f8
RS
6337 /* If we have a quit that was typed in another frame, and
6338 quit_throw_to_read_char switched buffers,
6339 replay to get the right keymap. */
9343ab07 6340 if (XINT (key) == quit_char && current_buffer != starting_buffer)
3b9189f8
RS
6341 {
6342 keybuf[t++] = key;
6343 mock_input = t;
6344 Vquit_flag = Qnil;
a6e0153c 6345 orig_local_map = get_local_map (PT, current_buffer);
3b9189f8
RS
6346 goto replay_sequence;
6347 }
3cb81011 6348
284f4730 6349 Vquit_flag = Qnil;
7e85b935 6350 }
284f4730 6351
df0f2ba1 6352 /* Clicks in non-text areas get prefixed by the symbol
7e85b935
RS
6353 in their CHAR-ADDRESS field. For example, a click on
6354 the mode line is prefixed by the symbol `mode-line'.
6355
6356 Furthermore, key sequences beginning with mouse clicks
6357 are read using the keymaps of the buffer clicked on, not
6358 the current buffer. So we may have to switch the buffer
6359 here.
6360
6361 When we turn one event into two events, we must make sure
6362 that neither of the two looks like the original--so that,
6363 if we replay the events, they won't be expanded again.
6364 If not for this, such reexpansion could happen either here
6365 or when user programs play with this-command-keys. */
6366 if (EVENT_HAS_PARAMETERS (key))
6367 {
9b8eb840 6368 Lisp_Object kind;
cca310da 6369
9b8eb840 6370 kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
7e85b935 6371 if (EQ (kind, Qmouse_click))
0a7f1fc0 6372 {
9b8eb840 6373 Lisp_Object window, posn;
f4255cd1 6374
9b8eb840
KH
6375 window = POSN_WINDOW (EVENT_START (key));
6376 posn = POSN_BUFFER_POSN (EVENT_START (key));
8c18cbfb 6377 if (CONSP (posn))
0a7f1fc0 6378 {
7e85b935
RS
6379 /* We're looking at the second event of a
6380 sequence which we expanded before. Set
6381 last_real_key_start appropriately. */
6382 if (t > 0)
6383 last_real_key_start = t - 1;
cd21b839 6384 }
7e85b935
RS
6385
6386 /* Key sequences beginning with mouse clicks are
6387 read using the keymaps in the buffer clicked on,
6388 not the current buffer. If we're at the
6389 beginning of a key sequence, switch buffers. */
6390 if (last_real_key_start == 0
8c18cbfb
KH
6391 && WINDOWP (window)
6392 && BUFFERP (XWINDOW (window)->buffer)
7e85b935 6393 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
cd21b839 6394 {
7e85b935
RS
6395 keybuf[t] = key;
6396 mock_input = t + 1;
6397
6398 /* Arrange to go back to the original buffer once we're
6399 done reading the key sequence. Note that we can't
6400 use save_excursion_{save,restore} here, because they
6401 save point as well as the current buffer; we don't
6402 want to save point, because redisplay may change it,
6403 to accommodate a Fset_window_start or something. We
6404 don't want to do this at the top of the function,
6405 because we may get input from a subprocess which
6406 wants to change the selected window and stuff (say,
6407 emacsclient). */
6408 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
6409
6410 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
e0dff5f6 6411 orig_local_map = get_local_map (PT, current_buffer);
7e85b935 6412 goto replay_sequence;
0a7f1fc0 6413 }
e0dff5f6
RS
6414 /* For a mouse click, get the local text-property keymap
6415 of the place clicked on, rather than point. */
6416 if (last_real_key_start == 0 && CONSP (XCONS (key)->cdr)
6417 && ! localized_local_map)
5ec75a55 6418 {
e0dff5f6
RS
6419 Lisp_Object map_here, start, pos;
6420
6421 localized_local_map = 1;
6422 start = EVENT_START (key);
6423 if (CONSP (start) && CONSP (XCONS (start)->cdr))
6424 {
6425 pos = POSN_BUFFER_POSN (start);
b78ce8fb
RS
6426 if (INTEGERP (pos)
6427 && XINT (pos) >= BEG && XINT (pos) <= Z)
e0dff5f6
RS
6428 {
6429 map_here = get_local_map (XINT (pos), current_buffer);
6430 if (!EQ (map_here, orig_local_map))
6431 {
6432 orig_local_map = map_here;
6433 keybuf[t] = key;
6434 mock_input = t + 1;
5ec75a55 6435
e0dff5f6
RS
6436 goto replay_sequence;
6437 }
6438 }
6439 }
6440 }
6441
6442 /* Expand mode-line and scroll-bar events into two events:
6443 use posn as a fake prefix key. */
6444 if (SYMBOLP (posn))
6445 {
7e85b935 6446 if (t + 1 >= bufsize)
3fe8e9a2 6447 error ("Key sequence too long");
7e85b935
RS
6448 keybuf[t] = posn;
6449 keybuf[t+1] = key;
6450 mock_input = t + 2;
6451
6452 /* Zap the position in key, so we know that we've
6453 expanded it, and don't try to do so again. */
6454 POSN_BUFFER_POSN (EVENT_START (key))
6455 = Fcons (posn, Qnil);
6456 goto replay_key;
5ec75a55 6457 }
0a7f1fc0 6458 }
7e85b935 6459 else if (EQ (kind, Qswitch_frame))
a6d53864 6460 {
ce98e608
KH
6461 /* If we're at the beginning of a key sequence, and the caller
6462 says it's okay, go ahead and return this event. If we're
6463 in the midst of a key sequence, delay it until the end. */
6464 if (t > 0 || !can_return_switch_frame)
7e85b935
RS
6465 {
6466 delayed_switch_frame = key;
6467 goto replay_key;
6468 }
6469 }
7a80a6f6
RS
6470 else if (CONSP (XCONS (key)->cdr)
6471 && CONSP (EVENT_START (key))
6472 && CONSP (XCONS (EVENT_START (key))->cdr))
7e85b935 6473 {
9b8eb840 6474 Lisp_Object posn;
7e85b935 6475
9b8eb840 6476 posn = POSN_BUFFER_POSN (EVENT_START (key));
7e85b935
RS
6477 /* Handle menu-bar events:
6478 insert the dummy prefix event `menu-bar'. */
6479 if (EQ (posn, Qmenu_bar))
6480 {
6481 if (t + 1 >= bufsize)
3fe8e9a2 6482 error ("Key sequence too long");
7e85b935
RS
6483 keybuf[t] = posn;
6484 keybuf[t+1] = key;
6485
6486 /* Zap the position in key, so we know that we've
6487 expanded it, and don't try to do so again. */
6488 POSN_BUFFER_POSN (EVENT_START (key))
6489 = Fcons (posn, Qnil);
6490
6491 mock_input = t + 2;
6492 goto replay_sequence;
6493 }
8c18cbfb 6494 else if (CONSP (posn))
7e85b935
RS
6495 {
6496 /* We're looking at the second event of a
6497 sequence which we expanded before. Set
6498 last_real_key_start appropriately. */
6499 if (last_real_key_start == t && t > 0)
6500 last_real_key_start = t - 1;
6501 }
a6d53864 6502 }
284f4730 6503 }
f4255cd1
JB
6504
6505 /* We have finally decided that KEY is something we might want
6506 to look up. */
284f4730
JB
6507 first_binding = (follow_key (key,
6508 nmaps - first_binding,
253598e4 6509 submaps + first_binding,
284f4730 6510 defs + first_binding,
4e50f26a 6511 submaps + first_binding)
284f4730 6512 + first_binding);
0a7f1fc0 6513
f4255cd1 6514 /* If KEY wasn't bound, we'll try some fallbacks. */
0a7f1fc0
JB
6515 if (first_binding >= nmaps)
6516 {
9b8eb840 6517 Lisp_Object head;
0a7f1fc0 6518
9b8eb840 6519 head = EVENT_HEAD (key);
24736fbc 6520 if (help_char_p (head) && t > 0)
7e85b935
RS
6521 {
6522 read_key_sequence_cmd = Vprefix_help_command;
6523 keybuf[t++] = key;
6524 last_nonmenu_event = key;
bc536d84
RS
6525 /* The Microsoft C compiler can't handle the goto that
6526 would go here. */
309b0fc8 6527 dummyflag = 1;
0d882d52 6528 break;
7e85b935
RS
6529 }
6530
8c18cbfb 6531 if (SYMBOLP (head))
0a7f1fc0 6532 {
9b8eb840
KH
6533 Lisp_Object breakdown;
6534 int modifiers;
0a7f1fc0 6535
9b8eb840
KH
6536 breakdown = parse_modifiers (head);
6537 modifiers = XINT (XCONS (XCONS (breakdown)->cdr)->car);
559f9d04
RS
6538 /* Attempt to reduce an unbound mouse event to a simpler
6539 event that is bound:
6540 Drags reduce to clicks.
6541 Double-clicks reduce to clicks.
6542 Triple-clicks reduce to double-clicks, then to clicks.
6543 Down-clicks are eliminated.
6544 Double-downs reduce to downs, then are eliminated.
6545 Triple-downs reduce to double-downs, then to downs,
6546 then are eliminated. */
6547 if (modifiers & (down_modifier | drag_modifier
6548 | double_modifier | triple_modifier))
0a7f1fc0 6549 {
559f9d04
RS
6550 while (modifiers & (down_modifier | drag_modifier
6551 | double_modifier | triple_modifier))
fbcd35bd
JB
6552 {
6553 Lisp_Object new_head, new_click;
6554 if (modifiers & triple_modifier)
6555 modifiers ^= (double_modifier | triple_modifier);
bc536d84
RS
6556 else if (modifiers & double_modifier)
6557 modifiers &= ~double_modifier;
6558 else if (modifiers & drag_modifier)
6559 modifiers &= ~drag_modifier;
559f9d04
RS
6560 else
6561 {
6562 /* Dispose of this `down' event by simply jumping
6563 back to replay_key, to get another event.
6564
6565 Note that if this event came from mock input,
6566 then just jumping back to replay_key will just
6567 hand it to us again. So we have to wipe out any
6568 mock input.
6569
6570 We could delete keybuf[t] and shift everything
6571 after that to the left by one spot, but we'd also
6572 have to fix up any variable that points into
6573 keybuf, and shifting isn't really necessary
6574 anyway.
6575
6576 Adding prefixes for non-textual mouse clicks
6577 creates two characters of mock input, and both
6578 must be thrown away. If we're only looking at
6579 the prefix now, we can just jump back to
6580 replay_key. On the other hand, if we've already
6581 processed the prefix, and now the actual click
6582 itself is giving us trouble, then we've lost the
6583 state of the keymaps we want to backtrack to, and
6584 we need to replay the whole sequence to rebuild
6585 it.
6586
6587 Beyond that, only function key expansion could
6588 create more than two keys, but that should never
6589 generate mouse events, so it's okay to zero
6590 mock_input in that case too.
6591
6592 Isn't this just the most wonderful code ever? */
6593 if (t == last_real_key_start)
6594 {
6595 mock_input = 0;
6596 goto replay_key;
6597 }
6598 else
6599 {
6600 mock_input = last_real_key_start;
6601 goto replay_sequence;
6602 }
6603 }
6604
27203ead
RS
6605 new_head
6606 = apply_modifiers (modifiers, XCONS (breakdown)->car);
6607 new_click
6608 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
fbcd35bd
JB
6609
6610 /* Look for a binding for this new key. follow_key
6611 promises that it didn't munge submaps the
6612 last time we called it, since key was unbound. */
27203ead
RS
6613 first_binding
6614 = (follow_key (new_click,
6615 nmaps - local_first_binding,
6616 submaps + local_first_binding,
6617 defs + local_first_binding,
4e50f26a 6618 submaps + local_first_binding)
27203ead 6619 + local_first_binding);
fbcd35bd
JB
6620
6621 /* If that click is bound, go for it. */
6622 if (first_binding < nmaps)
6623 {
6624 key = new_click;
6625 break;
6626 }
6627 /* Otherwise, we'll leave key set to the drag event. */
6628 }
0a7f1fc0
JB
6629 }
6630 }
6631 }
6632
284f4730 6633 keybuf[t++] = key;
7d6de002
RS
6634 /* Normally, last_nonmenu_event gets the previous key we read.
6635 But when a mouse popup menu is being used,
6636 we don't update last_nonmenu_event; it continues to hold the mouse
6637 event that preceded the first level of menu. */
6638 if (!used_mouse_menu)
6639 last_nonmenu_event = key;
284f4730 6640
6321824f
RS
6641 /* Record what part of this_command_keys is the current key sequence. */
6642 this_single_command_key_start = this_command_key_count - t;
6643
3fe8e9a2
RS
6644 prev_fkey_map = fkey_map;
6645 prev_fkey_start = fkey_start;
6646 prev_fkey_end = fkey_end;
6647
6648 prev_keytran_map = keytran_map;
6649 prev_keytran_start = keytran_start;
6650 prev_keytran_end = keytran_end;
6651
284f4730 6652 /* If the sequence is unbound, see if we can hang a function key
253598e4
JB
6653 off the end of it. We only want to scan real keyboard input
6654 for function key sequences, so if mock_input says that we're
f4255cd1 6655 re-reading old events, don't examine it. */
4e50f26a 6656 if (first_binding >= nmaps
253598e4 6657 && t >= mock_input)
284f4730
JB
6658 {
6659 Lisp_Object fkey_next;
6660
e9bf89a0
RS
6661 /* Continue scan from fkey_end until we find a bound suffix.
6662 If we fail, increment fkey_start
6663 and start fkey_end from there. */
284f4730
JB
6664 while (fkey_end < t)
6665 {
f4255cd1
JB
6666 Lisp_Object key;
6667
6668 key = keybuf[fkey_end++];
067ffa38
JB
6669 /* Look up meta-characters by prefixing them
6670 with meta_prefix_char. I hate this. */
8c18cbfb 6671 if (INTEGERP (key) && XINT (key) & meta_modifier)
f4255cd1 6672 {
e74fbc70
RS
6673 fkey_next
6674 = get_keymap_1
f4255cd1 6675 (get_keyelt
c6a67acd 6676 (access_keymap (fkey_map, meta_prefix_char, 1, 0), 0),
f4255cd1 6677 0, 1);
bb9e9bed 6678 XSETFASTINT (key, XFASTINT (key) & ~meta_modifier);
f4255cd1 6679 }
067ffa38
JB
6680 else
6681 fkey_next = fkey_map;
6682
e74fbc70 6683 fkey_next
c6a67acd 6684 = get_keyelt (access_keymap (fkey_next, key, 1, 0), 0);
067ffa38 6685
7a80a6f6
RS
6686#if 0 /* I didn't turn this on, because it might cause trouble
6687 for the mapping of return into C-m and tab into C-i. */
6688 /* Optionally don't map function keys into other things.
6689 This enables the user to redefine kp- keys easily. */
6690 if (SYMBOLP (key) && !NILP (Vinhibit_function_key_mapping))
6691 fkey_next = Qnil;
6692#endif
6693
1abe6abe
RS
6694 /* If the function key map gives a function, not an
6695 array, then call the function with no args and use
6696 its value instead. */
6697 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
6698 && fkey_end == t)
6699 {
6700 struct gcpro gcpro1, gcpro2, gcpro3;
6701 Lisp_Object tem;
6702 tem = fkey_next;
6703
6704 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
84d91fda 6705 fkey_next = call1 (fkey_next, prompt);
1abe6abe
RS
6706 UNGCPRO;
6707 /* If the function returned something invalid,
6708 barf--don't ignore it.
df0f2ba1 6709 (To ignore it safely, we would need to gcpro a bunch of
1abe6abe
RS
6710 other variables.) */
6711 if (! (VECTORP (fkey_next) || STRINGP (fkey_next)))
6321824f 6712 error ("Function in key-translation-map returns invalid key sequence");
1abe6abe
RS
6713 }
6714
e9bf89a0
RS
6715 function_key_possible = ! NILP (fkey_next);
6716
85bc5181 6717 /* If keybuf[fkey_start..fkey_end] is bound in the
a764a753 6718 function key map and it's a suffix of the current
85bc5181 6719 sequence (i.e. fkey_end == t), replace it with
a764a753 6720 the binding and restart with fkey_start at the end. */
f5ea6163 6721 if ((VECTORP (fkey_next) || STRINGP (fkey_next))
284f4730
JB
6722 && fkey_end == t)
6723 {
2e864a76 6724 int len = XFASTINT (Flength (fkey_next));
f5ea6163
JB
6725
6726 t = fkey_start + len;
284f4730 6727 if (t >= bufsize)
3fe8e9a2 6728 error ("Key sequence too long");
284f4730 6729
f5ea6163
JB
6730 if (VECTORP (fkey_next))
6731 bcopy (XVECTOR (fkey_next)->contents,
6732 keybuf + fkey_start,
6733 (t - fkey_start) * sizeof (keybuf[0]));
6734 else if (STRINGP (fkey_next))
6735 {
6736 int i;
6737
6738 for (i = 0; i < len; i++)
bb9e9bed
KH
6739 XSETFASTINT (keybuf[fkey_start + i],
6740 XSTRING (fkey_next)->data[i]);
f5ea6163 6741 }
df0f2ba1 6742
284f4730
JB
6743 mock_input = t;
6744 fkey_start = fkey_end = t;
32e6d806 6745 fkey_map = Vfunction_key_map;
284f4730 6746
00a78037
RS
6747 /* Do pass the results through key-translation-map. */
6748 keytran_start = keytran_end = 0;
6749 keytran_map = Vkey_translation_map;
6750
f4255cd1 6751 goto replay_sequence;
284f4730 6752 }
df0f2ba1 6753
f4255cd1 6754 fkey_map = get_keymap_1 (fkey_next, 0, 1);
284f4730 6755
df0f2ba1 6756 /* If we no longer have a bound suffix, try a new positions for
a764a753 6757 fkey_start. */
284f4730
JB
6758 if (NILP (fkey_map))
6759 {
6760 fkey_end = ++fkey_start;
6761 fkey_map = Vfunction_key_map;
e9bf89a0 6762 function_key_possible = 0;
284f4730
JB
6763 }
6764 }
6765 }
a612e298
RS
6766
6767 /* Look for this sequence in key-translation-map. */
6768 {
6769 Lisp_Object keytran_next;
6770
6771 /* Scan from keytran_end until we find a bound suffix. */
6772 while (keytran_end < t)
6773 {
6774 Lisp_Object key;
6775
6776 key = keybuf[keytran_end++];
6777 /* Look up meta-characters by prefixing them
6778 with meta_prefix_char. I hate this. */
8c18cbfb 6779 if (INTEGERP (key) && XINT (key) & meta_modifier)
a612e298
RS
6780 {
6781 keytran_next
6782 = get_keymap_1
6783 (get_keyelt
c6a67acd 6784 (access_keymap (keytran_map, meta_prefix_char, 1, 0), 0),
a612e298 6785 0, 1);
bb9e9bed 6786 XSETFASTINT (key, XFASTINT (key) & ~meta_modifier);
a612e298
RS
6787 }
6788 else
6789 keytran_next = keytran_map;
6790
6791 keytran_next
c6a67acd 6792 = get_keyelt (access_keymap (keytran_next, key, 1, 0), 0);
a612e298 6793
1abe6abe
RS
6794 /* If the key translation map gives a function, not an
6795 array, then call the function with no args and use
6796 its value instead. */
6797 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
6798 && keytran_end == t)
6799 {
6800 struct gcpro gcpro1, gcpro2, gcpro3;
6801 Lisp_Object tem;
6802 tem = keytran_next;
6803
40932d1a 6804 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
84d91fda 6805 keytran_next = call1 (keytran_next, prompt);
1abe6abe
RS
6806 UNGCPRO;
6807 /* If the function returned something invalid,
6808 barf--don't ignore it.
df0f2ba1 6809 (To ignore it safely, we would need to gcpro a bunch of
1abe6abe
RS
6810 other variables.) */
6811 if (! (VECTORP (keytran_next) || STRINGP (keytran_next)))
40932d1a 6812 error ("Function in key-translation-map returns invalid key sequence");
1abe6abe
RS
6813 }
6814
00a78037
RS
6815 key_translation_possible = ! NILP (keytran_next);
6816
a612e298 6817 /* If keybuf[keytran_start..keytran_end] is bound in the
1abe6abe 6818 key translation map and it's a suffix of the current
a612e298
RS
6819 sequence (i.e. keytran_end == t), replace it with
6820 the binding and restart with keytran_start at the end. */
6821 if ((VECTORP (keytran_next) || STRINGP (keytran_next))
6822 && keytran_end == t)
6823 {
2e864a76 6824 int len = XFASTINT (Flength (keytran_next));
a612e298
RS
6825
6826 t = keytran_start + len;
6827 if (t >= bufsize)
3fe8e9a2 6828 error ("Key sequence too long");
a612e298
RS
6829
6830 if (VECTORP (keytran_next))
6831 bcopy (XVECTOR (keytran_next)->contents,
6832 keybuf + keytran_start,
6833 (t - keytran_start) * sizeof (keybuf[0]));
6834 else if (STRINGP (keytran_next))
6835 {
6836 int i;
6837
6838 for (i = 0; i < len; i++)
bb9e9bed
KH
6839 XSETFASTINT (keybuf[keytran_start + i],
6840 XSTRING (keytran_next)->data[i]);
a612e298
RS
6841 }
6842
6843 mock_input = t;
6844 keytran_start = keytran_end = t;
6845 keytran_map = Vkey_translation_map;
6846
00a78037
RS
6847 /* Don't pass the results of key-translation-map
6848 through function-key-map. */
6849 fkey_start = fkey_end = t;
6850 fkey_map = Vkey_translation_map;
6851
a612e298
RS
6852 goto replay_sequence;
6853 }
6854
6855 keytran_map = get_keymap_1 (keytran_next, 0, 1);
6856
df0f2ba1 6857 /* If we no longer have a bound suffix, try a new positions for
a612e298
RS
6858 keytran_start. */
6859 if (NILP (keytran_map))
6860 {
6861 keytran_end = ++keytran_start;
6862 keytran_map = Vkey_translation_map;
00a78037 6863 key_translation_possible = 0;
a612e298
RS
6864 }
6865 }
6866 }
4e50f26a
RS
6867
6868 /* If KEY is not defined in any of the keymaps,
6869 and cannot be part of a function key or translation,
6870 and is an upper case letter
6871 use the corresponding lower-case letter instead. */
6872 if (first_binding == nmaps && ! function_key_possible
00a78037 6873 && ! key_translation_possible
8c18cbfb 6874 && INTEGERP (key)
4e50f26a
RS
6875 && ((((XINT (key) & 0x3ffff)
6876 < XSTRING (current_buffer->downcase_table)->size)
6877 && UPPERCASEP (XINT (key) & 0x3ffff))
6878 || (XINT (key) & shift_modifier)))
6879 {
569871d2 6880 Lisp_Object new_key;
569871d2 6881
309b0fc8
RS
6882 original_uppercase = key;
6883 original_uppercase_position = t - 1;
6884
831f35a2 6885 if (XINT (key) & shift_modifier)
569871d2 6886 XSETINT (new_key, XINT (key) & ~shift_modifier);
4e50f26a 6887 else
569871d2
RS
6888 XSETINT (new_key, (DOWNCASE (XINT (key) & 0x3ffff)
6889 | (XINT (key) & ~0x3ffff)));
6890
3fe8e9a2
RS
6891 /* We have to do this unconditionally, regardless of whether
6892 the lower-case char is defined in the keymaps, because they
6893 might get translated through function-key-map. */
6894 keybuf[t - 1] = new_key;
6895 mock_input = t;
6896
6897 fkey_map = prev_fkey_map;
6898 fkey_start = prev_fkey_start;
6899 fkey_end = prev_fkey_end;
6900
6901 keytran_map = prev_keytran_map;
6902 keytran_start = prev_keytran_start;
6903 keytran_end = prev_keytran_end;
6904
6905 goto replay_sequence;
4e50f26a 6906 }
ef8fd672
RS
6907 /* If KEY is not defined in any of the keymaps,
6908 and cannot be part of a function key or translation,
6909 and is a shifted function key,
6910 use the corresponding unshifted function key instead. */
6911 if (first_binding == nmaps && ! function_key_possible
6912 && ! key_translation_possible
6913 && SYMBOLP (key))
6914 {
6915 Lisp_Object breakdown;
6916 int modifiers;
6917
6918 breakdown = parse_modifiers (key);
6919 modifiers = XINT (XCONS (XCONS (breakdown)->cdr)->car);
6920 if (modifiers & shift_modifier)
6921 {
569871d2 6922 Lisp_Object new_key;
3fe8e9a2
RS
6923
6924 original_uppercase = key;
6925 original_uppercase_position = t - 1;
ef8fd672 6926
569871d2
RS
6927 modifiers &= ~shift_modifier;
6928 new_key = apply_modifiers (modifiers,
6929 XCONS (breakdown)->car);
6930
3fe8e9a2
RS
6931 keybuf[t - 1] = new_key;
6932 mock_input = t;
6933
6934 fkey_map = prev_fkey_map;
6935 fkey_start = prev_fkey_start;
6936 fkey_end = prev_fkey_end;
6937
6938 keytran_map = prev_keytran_map;
6939 keytran_start = prev_keytran_start;
6940 keytran_end = prev_keytran_end;
6941
6942 goto replay_sequence;
ef8fd672
RS
6943 }
6944 }
284f4730
JB
6945 }
6946
309b0fc8 6947 if (!dummyflag)
bc536d84
RS
6948 read_key_sequence_cmd = (first_binding < nmaps
6949 ? defs[first_binding]
6950 : Qnil);
284f4730 6951
cd21b839 6952 unread_switch_frame = delayed_switch_frame;
f4255cd1 6953 unbind_to (count, Qnil);
07f76a14 6954
3fe8e9a2
RS
6955 /* Don't downcase the last character if the caller says don't.
6956 Don't downcase it if the result is undefined, either. */
6957 if ((dont_downcase_last || first_binding >= nmaps)
6958 && t - 1 == original_uppercase_position)
309b0fc8
RS
6959 keybuf[t - 1] = original_uppercase;
6960
07f76a14
JB
6961 /* Occasionally we fabricate events, perhaps by expanding something
6962 according to function-key-map, or by adding a prefix symbol to a
6963 mouse click in the scroll bar or modeline. In this cases, return
6964 the entire generated key sequence, even if we hit an unbound
6965 prefix or a definition before the end. This means that you will
6966 be able to push back the event properly, and also means that
6967 read-key-sequence will always return a logical unit.
6968
6969 Better ideas? */
cca310da
JB
6970 for (; t < mock_input; t++)
6971 {
a98ea3f9
RS
6972 if (echo_keystrokes)
6973 echo_char (keybuf[t]);
cca310da
JB
6974 add_command_key (keybuf[t]);
6975 }
07f76a14 6976
284f4730
JB
6977 return t;
6978}
6979
a612e298
RS
6980#if 0 /* This doc string is too long for some compilers.
6981 This commented-out definition serves for DOC. */
ce98e608 6982DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0,
284f4730
JB
6983 "Read a sequence of keystrokes and return as a string or vector.\n\
6984The sequence is sufficient to specify a non-prefix command in the\n\
6985current local and global maps.\n\
6986\n\
c0a58692
RS
6987First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
6988Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\
6989as a continuation of the previous key.\n\
284f4730 6990\n\
309b0fc8
RS
6991The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not\n\
6992convert the last event to lower case. (Normally any upper case event\n\
6993is converted to lower case if the original event is undefined and the lower\n\
6994case equivalent is defined.) A non-nil value is appropriate for reading\n\
6995a key sequence to be defined.\n\
6996\n\
cb5df6ae
JB
6997A C-g typed while in this function is treated like any other character,\n\
6998and `quit-flag' is not set.\n\
6999\n\
7000If the key sequence starts with a mouse click, then the sequence is read\n\
7001using the keymaps of the buffer of the window clicked in, not the buffer\n\
7002of the selected window as normal.\n\
ede41463 7003""\n\
cb5df6ae
JB
7004`read-key-sequence' drops unbound button-down events, since you normally\n\
7005only care about the click or drag events which follow them. If a drag\n\
fbcd35bd
JB
7006or multi-click event is unbound, but the corresponding click event would\n\
7007be bound, `read-key-sequence' turns the event into a click event at the\n\
cb5df6ae 7008drag's starting position. This means that you don't have to distinguish\n\
fbcd35bd 7009between click and drag, double, or triple events unless you want to.\n\
cb5df6ae
JB
7010\n\
7011`read-key-sequence' prefixes mouse events on mode lines, the vertical\n\
3c370943
JB
7012lines separating windows, and scroll bars with imaginary keys\n\
7013`mode-line', `vertical-line', and `vertical-scroll-bar'.\n\
cb5df6ae 7014\n\
ce98e608
KH
7015Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this\n\
7016function will process a switch-frame event if the user switches frames\n\
7017before typing anything. If the user switches frames in the middle of a\n\
7018key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME\n\
7019is nil, then the event will be put off until after the current key sequence.\n\
cb5df6ae
JB
7020\n\
7021`read-key-sequence' checks `function-key-map' for function key\n\
7022sequences, where they wouldn't conflict with ordinary bindings. See\n\
4bb994d1 7023`function-key-map' for more details.")
11e08aab 7024 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame)
a612e298
RS
7025#endif
7026
ce98e608 7027DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0,
a612e298 7028 0)
ce98e608 7029 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame)
309b0fc8 7030 Lisp_Object prompt, continue_echo, dont_downcase_last;
ce98e608 7031 Lisp_Object can_return_switch_frame;
284f4730
JB
7032{
7033 Lisp_Object keybuf[30];
7034 register int i;
7035 struct gcpro gcpro1, gcpro2;
7036
7037 if (!NILP (prompt))
7038 CHECK_STRING (prompt, 0);
7039 QUIT;
7040
7041 bzero (keybuf, sizeof keybuf);
7042 GCPRO1 (keybuf[0]);
7043 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
7044
daa37602 7045 if (NILP (continue_echo))
6321824f
RS
7046 {
7047 this_command_key_count = 0;
7048 this_single_command_key_start = 0;
7049 }
c0a58692 7050
309b0fc8 7051 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
ce98e608 7052 prompt, ! NILP (dont_downcase_last),
f571ae0d 7053 ! NILP (can_return_switch_frame), 0);
284f4730 7054
dcc408a0
RS
7055 if (i == -1)
7056 {
7057 Vquit_flag = Qt;
7058 QUIT;
7059 }
284f4730 7060 UNGCPRO;
86e5706b 7061 return make_event_array (i, keybuf);
284f4730
JB
7062}
7063\f
158f7532 7064DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0,
284f4730
JB
7065 "Execute CMD as an editor command.\n\
7066CMD must be a symbol that satisfies the `commandp' predicate.\n\
7067Optional second arg RECORD-FLAG non-nil\n\
7068means unconditionally put this command in `command-history'.\n\
aaf2ead7
RS
7069Otherwise, that is done only if an arg is read using the minibuffer.\n\
7070The argument KEYS specifies the value to use instead of (this-command-keys)\n\
6321824f 7071when reading the arguments; if it is nil, (this-command-keys) is used.\n\
158f7532
RS
7072The argument SPECIAL, if non-nil, means that this command is executing\n\
7073a special event, so ignore the prefix argument and don't clear it.")
7074 (cmd, record_flag, keys, special)
7075 Lisp_Object cmd, record_flag, keys, special;
284f4730
JB
7076{
7077 register Lisp_Object final;
7078 register Lisp_Object tem;
7079 Lisp_Object prefixarg;
7080 struct backtrace backtrace;
7081 extern int debug_on_next_call;
7082
284f4730
JB
7083 debug_on_next_call = 0;
7084
158f7532
RS
7085 if (NILP (special))
7086 {
7087 prefixarg = current_kboard->Vprefix_arg;
7088 Vcurrent_prefix_arg = prefixarg;
7089 current_kboard->Vprefix_arg = Qnil;
7090 }
7091 else
7092 prefixarg = Qnil;
7093
8c18cbfb 7094 if (SYMBOLP (cmd))
284f4730
JB
7095 {
7096 tem = Fget (cmd, Qdisabled);
88ce066e 7097 if (!NILP (tem) && !NILP (Vrun_hooks))
b78ce8fb
RS
7098 {
7099 tem = Fsymbol_value (Qdisabled_command_hook);
7100 if (!NILP (tem))
7101 return call1 (Vrun_hooks, Qdisabled_command_hook);
7102 }
284f4730
JB
7103 }
7104
01e26217 7105 while (1)
284f4730 7106 {
ffd56f97 7107 final = Findirect_function (cmd);
284f4730
JB
7108
7109 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
b516a185
RS
7110 {
7111 struct gcpro gcpro1, gcpro2;
7112
7113 GCPRO2 (cmd, prefixarg);
7114 do_autoload (final, cmd);
7115 UNGCPRO;
7116 }
284f4730
JB
7117 else
7118 break;
7119 }
7120
8c18cbfb 7121 if (STRINGP (final) || VECTORP (final))
284f4730
JB
7122 {
7123 /* If requested, place the macro in the command history. For
7124 other sorts of commands, call-interactively takes care of
7125 this. */
e57d8fd8 7126 if (!NILP (record_flag))
284f4730
JB
7127 Vcommand_history
7128 = Fcons (Fcons (Qexecute_kbd_macro,
7129 Fcons (final, Fcons (prefixarg, Qnil))),
7130 Vcommand_history);
7131
7132 return Fexecute_kbd_macro (final, prefixarg);
7133 }
8c18cbfb 7134 if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
284f4730
JB
7135 {
7136 backtrace.next = backtrace_list;
7137 backtrace_list = &backtrace;
7138 backtrace.function = &Qcall_interactively;
7139 backtrace.args = &cmd;
7140 backtrace.nargs = 1;
7141 backtrace.evalargs = 0;
7142
e57d8fd8 7143 tem = Fcall_interactively (cmd, record_flag, keys);
284f4730
JB
7144
7145 backtrace_list = backtrace.next;
7146 return tem;
7147 }
7148 return Qnil;
7149}
7150\f
284f4730
JB
7151DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
7152 1, 1, "P",
7153 "Read function name, then read its arguments and call it.")
7154 (prefixarg)
7155 Lisp_Object prefixarg;
7156{
7157 Lisp_Object function;
7158 char buf[40];
7159 Lisp_Object saved_keys;
5434fce6 7160 Lisp_Object bindings, value;
214360e9 7161 struct gcpro gcpro1, gcpro2;
284f4730 7162
b0f2a7bf
KH
7163 saved_keys = Fvector (this_command_key_count,
7164 XVECTOR (this_command_keys)->contents);
284f4730 7165 buf[0] = 0;
fde7aff8 7166 GCPRO2 (saved_keys, prefixarg);
284f4730
JB
7167
7168 if (EQ (prefixarg, Qminus))
7169 strcpy (buf, "- ");
7170 else if (CONSP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4)
7171 strcpy (buf, "C-u ");
8c18cbfb 7172 else if (CONSP (prefixarg) && INTEGERP (XCONS (prefixarg)->car))
5d5b907f
RS
7173 {
7174 if (sizeof (int) == sizeof (EMACS_INT))
7175 sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car));
7176 else if (sizeof (long) == sizeof (EMACS_INT))
7177 sprintf (buf, "%ld ", XINT (XCONS (prefixarg)->car));
7178 else
7179 abort ();
7180 }
8c18cbfb 7181 else if (INTEGERP (prefixarg))
5d5b907f
RS
7182 {
7183 if (sizeof (int) == sizeof (EMACS_INT))
7184 sprintf (buf, "%d ", XINT (prefixarg));
7185 else if (sizeof (long) == sizeof (EMACS_INT))
7186 sprintf (buf, "%ld ", XINT (prefixarg));
7187 else
7188 abort ();
7189 }
284f4730
JB
7190
7191 /* This isn't strictly correct if execute-extended-command
7192 is bound to anything else. Perhaps it should use
7193 this_command_keys? */
7194 strcat (buf, "M-x ");
7195
7196 /* Prompt with buf, and then read a string, completing from and
7197 restricting to the set of all defined commands. Don't provide
51763820 7198 any initial input. Save the command read on the extended-command
03b4122a 7199 history list. */
284f4730
JB
7200 function = Fcompleting_read (build_string (buf),
7201 Vobarray, Qcommandp,
4328577a
KH
7202 Qt, Qnil, Qextended_command_history, Qnil,
7203 Qnil);
284f4730 7204
1f5b1641
RS
7205 if (STRINGP (function) && XSTRING (function)->size == 0)
7206 error ("No command name given");
7207
1113d9db
JB
7208 /* Set this_command_keys to the concatenation of saved_keys and
7209 function, followed by a RET. */
284f4730 7210 {
1113d9db 7211 struct Lisp_String *str;
b0f2a7bf 7212 Lisp_Object *keys;
284f4730
JB
7213 int i;
7214 Lisp_Object tem;
7215
1113d9db 7216 this_command_key_count = 0;
6321824f 7217 this_single_command_key_start = 0;
1113d9db 7218
b0f2a7bf
KH
7219 keys = XVECTOR (saved_keys)->contents;
7220 for (i = 0; i < XVECTOR (saved_keys)->size; i++)
7221 add_command_key (keys[i]);
1113d9db
JB
7222
7223 str = XSTRING (function);
7224 for (i = 0; i < str->size; i++)
7225 {
bb9e9bed 7226 XSETFASTINT (tem, str->data[i]);
1113d9db
JB
7227 add_command_key (tem);
7228 }
7229
bb9e9bed 7230 XSETFASTINT (tem, '\015');
1113d9db 7231 add_command_key (tem);
284f4730
JB
7232 }
7233
7234 UNGCPRO;
7235
0a7f1fc0 7236 function = Fintern (function, Qnil);
d8bcf58e 7237 current_kboard->Vprefix_arg = prefixarg;
284f4730
JB
7238 this_command = function;
7239
6526ab49
RS
7240 /* If enabled, show which key runs this command. */
7241 if (!NILP (Vsuggest_key_bindings)
71012575 7242 && NILP (Vexecuting_macro)
6526ab49 7243 && SYMBOLP (function))
5434fce6
RS
7244 bindings = Fwhere_is_internal (function, Voverriding_local_map,
7245 Qt, Qnil);
7246 else
7247 bindings = Qnil;
6526ab49 7248
5434fce6
RS
7249 value = Qnil;
7250 GCPRO2 (bindings, value);
7251 value = Fcommand_execute (function, Qt, Qnil, Qnil);
6526ab49 7252
5434fce6 7253 /* If the command has a key binding, print it now. */
3ababa60
KH
7254 if (!NILP (bindings)
7255 && ! (ARRAYP (bindings) && EQ (Faref (bindings), Qmouse_movement)))
5434fce6
RS
7256 {
7257 /* But first wait, and skip the message if there is input. */
7258 if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings)
7259 ? Vsuggest_key_bindings : make_number (2)),
303b5b3f
RS
7260 Qnil, Qnil))
7261 && ! CONSP (Vunread_command_events))
6526ab49 7262 {
5434fce6
RS
7263 Lisp_Object binding;
7264 char *newmessage;
7265 char *oldmessage = echo_area_glyphs;
7266 int oldmessage_len = echo_area_glyphs_length;
7267
7268 binding = Fkey_description (bindings);
7269
7270 newmessage
7271 = (char *) alloca (XSYMBOL (function)->name->size
7272 + XSTRING (binding)->size
7273 + 100);
3ababa60 7274 sprintf (newmessage, "You can run the command `%s' with %s",
6526ab49 7275 XSYMBOL (function)->name->data,
5434fce6
RS
7276 XSTRING (binding)->data);
7277 message1_nolog (newmessage);
7278 if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings)
7279 ? Vsuggest_key_bindings : make_number (2)),
7280 Qnil, Qnil)))
7281 message2_nolog (oldmessage, oldmessage_len);
6526ab49
RS
7282 }
7283 }
7284
5434fce6 7285 RETURN_UNGCPRO (value);
284f4730 7286}
6526ab49
RS
7287
7288/* Find the set of keymaps now active.
7289 Store into *MAPS_P a vector holding the various maps
7290 and return the number of them. The vector was malloc'd
7291 and the caller should free it. */
7292
7293int
7294current_active_maps (maps_p)
7295 Lisp_Object **maps_p;
7296{
7297 Lisp_Object *tmaps, *maps;
7298 int nmaps;
7299
7300 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7301 if (!NILP (Voverriding_local_map_menu_flag))
7302 {
7303 /* Yes, use them (if non-nil) as well as the global map. */
7304 maps = (Lisp_Object *) xmalloc (3 * sizeof (maps[0]));
7305 nmaps = 0;
7306 if (!NILP (current_kboard->Voverriding_terminal_local_map))
7307 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
7308 if (!NILP (Voverriding_local_map))
7309 maps[nmaps++] = Voverriding_local_map;
7310 }
7311 else
7312 {
7313 /* No, so use major and minor mode keymaps. */
7314 nmaps = current_minor_maps (NULL, &tmaps);
7315 maps = (Lisp_Object *) xmalloc ((nmaps + 2) * sizeof (maps[0]));
7316 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
7317#ifdef USE_TEXT_PROPERTIES
7318 maps[nmaps++] = get_local_map (PT, current_buffer);
7319#else
7320 maps[nmaps++] = current_buffer->keymap;
7321#endif
7322 }
7323 maps[nmaps++] = current_global_map;
7324
7325 *maps_p = maps;
7326 return nmaps;
7327}
284f4730 7328\f
d9d4c147 7329/* Return nonzero if input events are pending. */
284f4730
JB
7330
7331detect_input_pending ()
7332{
7333 if (!input_pending)
d9d4c147
KH
7334 get_input_pending (&input_pending, 0);
7335
7336 return input_pending;
7337}
7338
b1878f45 7339/* Return nonzero if input events are pending, and run any pending timers. */
d9d4c147 7340
87dd9b9b
RS
7341detect_input_pending_run_timers (do_display)
7342 int do_display;
d9d4c147 7343{
87dd9b9b
RS
7344 int old_timers_run = timers_run;
7345
d9d4c147
KH
7346 if (!input_pending)
7347 get_input_pending (&input_pending, 1);
284f4730 7348
87dd9b9b
RS
7349 if (old_timers_run != timers_run && do_display)
7350 redisplay_preserve_echo_area ();
7351
284f4730
JB
7352 return input_pending;
7353}
7354
ffd56f97
JB
7355/* This is called in some cases before a possible quit.
7356 It cases the next call to detect_input_pending to recompute input_pending.
7357 So calling this function unnecessarily can't do any harm. */
7358clear_input_pending ()
7359{
7360 input_pending = 0;
7361}
7362
b1878f45
RS
7363/* Return nonzero if there are pending requeued events.
7364 This isn't used yet. The hope is to make wait_reading_process_input
7365 call it, and return return if it runs Lisp code that unreads something.
7366 The problem is, kbd_buffer_get_event needs to be fixed to know what
7367 to do in that case. It isn't trivial. */
7368
7369requeued_events_pending_p ()
7370{
7371 return (!NILP (Vunread_command_events) || unread_command_char != -1);
7372}
7373
7374
284f4730
JB
7375DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
7376 "T if command input is currently available with no waiting.\n\
7377Actually, the value is nil only if we can be sure that no input is available.")
7378 ()
7379{
24597608 7380 if (!NILP (Vunread_command_events) || unread_command_char != -1)
284f4730
JB
7381 return (Qt);
7382
d9d4c147
KH
7383 get_input_pending (&input_pending, 1);
7384 return input_pending > 0 ? Qt : Qnil;
284f4730
JB
7385}
7386
7387DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
22d7cb89 7388 "Return vector of last 100 events, not counting those from keyboard macros.")
284f4730
JB
7389 ()
7390{
5160df46 7391 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
284f4730
JB
7392 Lisp_Object val;
7393
7394 if (total_keys < NUM_RECENT_KEYS)
5160df46 7395 return Fvector (total_keys, keys);
284f4730
JB
7396 else
7397 {
5160df46
JB
7398 val = Fvector (NUM_RECENT_KEYS, keys);
7399 bcopy (keys + recent_keys_index,
284f4730
JB
7400 XVECTOR (val)->contents,
7401 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
5160df46 7402 bcopy (keys,
284f4730
JB
7403 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
7404 recent_keys_index * sizeof (Lisp_Object));
7405 return val;
7406 }
7407}
7408
7409DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
e5f920d7
RS
7410 "Return the key sequence that invoked this command.\n\
7411The value is a string or a vector.")
284f4730
JB
7412 ()
7413{
86e5706b
RS
7414 return make_event_array (this_command_key_count,
7415 XVECTOR (this_command_keys)->contents);
284f4730
JB
7416}
7417
6321824f
RS
7418DEFUN ("this-single-command-keys", Fthis_single_command_keys,
7419 Sthis_single_command_keys, 0, 0, 0,
7420 "Return the key sequence that invoked this command.\n\
7421Unlike `this-command-keys', this function's value\n\
7422does not include prefix arguments.\n\
7423The value is a string or a vector.")
7424 ()
7425{
7426 return make_event_array (this_command_key_count
7427 - this_single_command_key_start,
7428 (XVECTOR (this_command_keys)->contents
7429 + this_single_command_key_start));
7430}
7431
71918b75
RS
7432DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
7433 Sreset_this_command_lengths, 0, 0, 0,
7434 "Used for complicated reasons in `universal-argument-other-key'.\n\
7435\n\
7436`universal-argument-other-key' rereads the event just typed.\n\
7437It then gets translated through `function-key-map'.\n\
7438The translated event gets included in the echo area and in\n\
7439the value of `this-command-keys' in addition to the raw original event.\n\
7440That is not right.\n\
7441\n\
7442Calling this function directs the translated event to replace\n\
7443the original event, so that only one version of the event actually\n\
7444appears in the echo area and in the value of `this-command-keys.'.")
7445 ()
7446{
7447 before_command_restore_flag = 1;
7448 before_command_key_count_1 = before_command_key_count;
7449 before_command_echo_length_1 = before_command_echo_length;
7450}
7451
284f4730
JB
7452DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
7453 "Return the current depth in recursive edits.")
7454 ()
7455{
7456 Lisp_Object temp;
bb9e9bed 7457 XSETFASTINT (temp, command_loop_level + minibuf_level);
284f4730
JB
7458 return temp;
7459}
7460
7461DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
7462 "FOpen dribble file: ",
9b2471df
RS
7463 "Start writing all keyboard characters to a dribble file called FILE.\n\
7464If FILE is nil, close any open dribble file.")
284f4730
JB
7465 (file)
7466 Lisp_Object file;
7467{
6cb52def 7468 if (dribble)
284f4730 7469 {
6cb52def
KH
7470 fclose (dribble);
7471 dribble = 0;
284f4730 7472 }
6cb52def 7473 if (!NILP (file))
284f4730
JB
7474 {
7475 file = Fexpand_file_name (file, Qnil);
7476 dribble = fopen (XSTRING (file)->data, "w");
ab6ca1de
KH
7477 if (dribble == 0)
7478 report_file_error ("Opening dribble", Fcons (file, Qnil));
284f4730
JB
7479 }
7480 return Qnil;
7481}
7482
7483DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
7484 "Discard the contents of the terminal input buffer.\n\
7485Also cancel any kbd macro being defined.")
7486 ()
7487{
c5fdd383 7488 current_kboard->defining_kbd_macro = Qnil;
284f4730
JB
7489 update_mode_lines++;
7490
24597608 7491 Vunread_command_events = Qnil;
86e5706b 7492 unread_command_char = -1;
284f4730
JB
7493
7494 discard_tty_input ();
7495
ff0b5f4c
JB
7496 /* Without the cast, GCC complains that this assignment loses the
7497 volatile qualifier of kbd_store_ptr. Is there anything wrong
7498 with that? */
beecf6a1
KH
7499 kbd_fetch_ptr = (struct input_event *) kbd_store_ptr;
7500 Ffillarray (kbd_buffer_frame_or_window, Qnil);
284f4730
JB
7501 input_pending = 0;
7502
7503 return Qnil;
7504}
7505\f
7506DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
7507 "Stop Emacs and return to superior process. You can resume later.\n\
8026024c
KH
7508If `cannot-suspend' is non-nil, or if the system doesn't support job\n\
7509control, run a subshell instead.\n\n\
284f4730 7510If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
b7d2ebbf
RS
7511to be read as terminal input by Emacs's parent, after suspension.\n\
7512\n\
bbdc2092
RS
7513Before suspending, run the normal hook `suspend-hook'.\n\
7514After resumption run the normal hook `suspend-resume-hook'.\n\
284f4730
JB
7515\n\
7516Some operating systems cannot stop the Emacs process and resume it later.\n\
b7d2ebbf 7517On such systems, Emacs starts a subshell instead of suspending.")
284f4730
JB
7518 (stuffstring)
7519 Lisp_Object stuffstring;
7520{
3a69360c 7521 Lisp_Object tem;
284f4730
JB
7522 int count = specpdl_ptr - specpdl;
7523 int old_height, old_width;
7524 int width, height;
b7d2ebbf 7525 struct gcpro gcpro1, gcpro2;
284f4730
JB
7526 extern init_sys_modes ();
7527
7528 if (!NILP (stuffstring))
7529 CHECK_STRING (stuffstring, 0);
284f4730 7530
1e95ed28
JB
7531 /* Run the functions in suspend-hook. */
7532 if (!NILP (Vrun_hooks))
7533 call1 (Vrun_hooks, intern ("suspend-hook"));
284f4730 7534
b7d2ebbf 7535 GCPRO1 (stuffstring);
ff11dfa1 7536 get_frame_size (&old_width, &old_height);
284f4730
JB
7537 reset_sys_modes ();
7538 /* sys_suspend can get an error if it tries to fork a subshell
7539 and the system resources aren't available for that. */
7540 record_unwind_protect (init_sys_modes, 0);
7541 stuff_buffered_input (stuffstring);
8026024c
KH
7542 if (cannot_suspend)
7543 sys_subshell ();
7544 else
7545 sys_suspend ();
284f4730
JB
7546 unbind_to (count, Qnil);
7547
7548 /* Check if terminal/window size has changed.
7549 Note that this is not useful when we are running directly
7550 with a window system; but suspend should be disabled in that case. */
ff11dfa1 7551 get_frame_size (&width, &height);
284f4730 7552 if (width != old_width || height != old_height)
f5ea6163 7553 change_frame_size (selected_frame, height, width, 0, 0);
284f4730 7554
1e95ed28 7555 /* Run suspend-resume-hook. */
284f4730
JB
7556 if (!NILP (Vrun_hooks))
7557 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
df0f2ba1 7558
284f4730
JB
7559 UNGCPRO;
7560 return Qnil;
7561}
7562
7563/* If STUFFSTRING is a string, stuff its contents as pending terminal input.
eb8c3be9 7564 Then in any case stuff anything Emacs has read ahead and not used. */
284f4730
JB
7565
7566stuff_buffered_input (stuffstring)
7567 Lisp_Object stuffstring;
7568{
284f4730 7569/* stuff_char works only in BSD, versions 4.2 and up. */
6df54671 7570#ifdef BSD_SYSTEM
284f4730 7571#ifndef BSD4_1
612b78ef 7572 register unsigned char *p;
612b78ef 7573
8c18cbfb 7574 if (STRINGP (stuffstring))
284f4730
JB
7575 {
7576 register int count;
7577
7578 p = XSTRING (stuffstring)->data;
7579 count = XSTRING (stuffstring)->size;
7580 while (count-- > 0)
7581 stuff_char (*p++);
7582 stuff_char ('\n');
7583 }
7584 /* Anything we have read ahead, put back for the shell to read. */
beecf6a1 7585 /* ?? What should this do when we have multiple keyboards??
c5fdd383 7586 Should we ignore anything that was typed in at the "wrong" kboard? */
beecf6a1 7587 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
284f4730 7588 {
beecf6a1
KH
7589 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
7590 kbd_fetch_ptr = kbd_buffer;
7591 if (kbd_fetch_ptr->kind == ascii_keystroke)
7592 stuff_char (kbd_fetch_ptr->code);
7593 kbd_fetch_ptr->kind = no_event;
7594 (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_fetch_ptr
7595 - kbd_buffer]
7b4aedb9 7596 = Qnil);
284f4730
JB
7597 }
7598 input_pending = 0;
7599#endif
6df54671 7600#endif /* BSD_SYSTEM and not BSD4_1 */
284f4730
JB
7601}
7602\f
ffd56f97
JB
7603set_waiting_for_input (time_to_clear)
7604 EMACS_TIME *time_to_clear;
284f4730 7605{
ffd56f97 7606 input_available_clear_time = time_to_clear;
284f4730
JB
7607
7608 /* Tell interrupt_signal to throw back to read_char, */
7609 waiting_for_input = 1;
7610
7611 /* If interrupt_signal was called before and buffered a C-g,
7612 make it run again now, to avoid timing error. */
7613 if (!NILP (Vquit_flag))
7614 quit_throw_to_read_char ();
284f4730
JB
7615}
7616
7617clear_waiting_for_input ()
7618{
7619 /* Tell interrupt_signal not to throw back to read_char, */
7620 waiting_for_input = 0;
ffd56f97 7621 input_available_clear_time = 0;
284f4730
JB
7622}
7623
7624/* This routine is called at interrupt level in response to C-G.
7625 If interrupt_input, this is the handler for SIGINT.
7626 Otherwise, it is called from kbd_buffer_store_event,
7627 in handling SIGIO or SIGTINT.
7628
7629 If `waiting_for_input' is non zero, then unless `echoing' is nonzero,
7630 immediately throw back to read_char.
7631
7632 Otherwise it sets the Lisp variable quit-flag not-nil.
7633 This causes eval to throw, when it gets a chance.
7634 If quit-flag is already non-nil, it stops the job right away. */
7635
7636SIGTYPE
91c049d4
RS
7637interrupt_signal (signalnum) /* If we don't have an argument, */
7638 int signalnum; /* some compilers complain in signal calls. */
284f4730
JB
7639{
7640 char c;
7641 /* Must preserve main program's value of errno. */
7642 int old_errno = errno;
284f4730 7643
5970a8cb 7644#if defined (USG) && !defined (POSIX_SIGNALS)
7a80a6f6
RS
7645 if (!read_socket_hook && NILP (Vwindow_system))
7646 {
7647 /* USG systems forget handlers when they are used;
7648 must reestablish each time */
7649 signal (SIGINT, interrupt_signal);
7650 signal (SIGQUIT, interrupt_signal);
7651 }
284f4730
JB
7652#endif /* USG */
7653
7654 cancel_echoing ();
7655
31e4e97b
EZ
7656 if (!NILP (Vquit_flag)
7657 && (FRAME_TERMCAP_P (selected_frame) || FRAME_MSDOS_P (selected_frame)))
284f4730 7658 {
31e4e97b
EZ
7659 /* If SIGINT isn't blocked, don't let us be interrupted by
7660 another SIGINT, it might be harmful due to non-reentrancy
7661 in I/O functions. */
7662 sigblock (sigmask (SIGINT));
7663
284f4730
JB
7664 fflush (stdout);
7665 reset_sys_modes ();
31e4e97b 7666
284f4730
JB
7667#ifdef SIGTSTP /* Support possible in later USG versions */
7668/*
7669 * On systems which can suspend the current process and return to the original
7670 * shell, this command causes the user to end up back at the shell.
7671 * The "Auto-save" and "Abort" questions are not asked until
7672 * the user elects to return to emacs, at which point he can save the current
7673 * job and either dump core or continue.
7674 */
7675 sys_suspend ();
7676#else
7677#ifdef VMS
7678 if (sys_suspend () == -1)
7679 {
7680 printf ("Not running as a subprocess;\n");
7681 printf ("you can continue or abort.\n");
7682 }
7683#else /* not VMS */
7684 /* Perhaps should really fork an inferior shell?
7685 But that would not provide any way to get back
7686 to the original shell, ever. */
7687 printf ("No support for stopping a process on this operating system;\n");
7688 printf ("you can continue or abort.\n");
7689#endif /* not VMS */
7690#endif /* not SIGTSTP */
80e4aa30
RS
7691#ifdef MSDOS
7692 /* We must remain inside the screen area when the internal terminal
7693 is used. Note that [Enter] is not echoed by dos. */
7694 cursor_to (0, 0);
7695#endif
118d6ca9
RS
7696 /* It doesn't work to autosave while GC is in progress;
7697 the code used for auto-saving doesn't cope with the mark bit. */
7698 if (!gc_in_progress)
9fd7d808 7699 {
118d6ca9
RS
7700 printf ("Auto-save? (y or n) ");
7701 fflush (stdout);
7702 if (((c = getchar ()) & ~040) == 'Y')
7703 {
7704 Fdo_auto_save (Qt, Qnil);
80e4aa30 7705#ifdef MSDOS
118d6ca9 7706 printf ("\r\nAuto-save done");
80e4aa30 7707#else /* not MSDOS */
118d6ca9 7708 printf ("Auto-save done\n");
80e4aa30 7709#endif /* not MSDOS */
118d6ca9
RS
7710 }
7711 while (c != '\n') c = getchar ();
9fd7d808 7712 }
118d6ca9
RS
7713 else
7714 {
7715 /* During GC, it must be safe to reenable quitting again. */
7716 Vinhibit_quit = Qnil;
7717#ifdef MSDOS
7718 printf ("\r\n");
7719#endif /* not MSDOS */
7720 printf ("Garbage collection in progress; cannot auto-save now\r\n");
7721 printf ("but will instead do a real quit after garbage collection ends\r\n");
7722 fflush (stdout);
7723 }
7724
80e4aa30
RS
7725#ifdef MSDOS
7726 printf ("\r\nAbort? (y or n) ");
7727#else /* not MSDOS */
284f4730
JB
7728#ifdef VMS
7729 printf ("Abort (and enter debugger)? (y or n) ");
7730#else /* not VMS */
7731 printf ("Abort (and dump core)? (y or n) ");
7732#endif /* not VMS */
80e4aa30 7733#endif /* not MSDOS */
284f4730
JB
7734 fflush (stdout);
7735 if (((c = getchar ()) & ~040) == 'Y')
7736 abort ();
7737 while (c != '\n') c = getchar ();
80e4aa30
RS
7738#ifdef MSDOS
7739 printf ("\r\nContinuing...\r\n");
7740#else /* not MSDOS */
284f4730 7741 printf ("Continuing...\n");
80e4aa30 7742#endif /* not MSDOS */
284f4730
JB
7743 fflush (stdout);
7744 init_sys_modes ();
31e4e97b 7745 sigfree ();
284f4730
JB
7746 }
7747 else
7748 {
7749 /* If executing a function that wants to be interrupted out of
7750 and the user has not deferred quitting by binding `inhibit-quit'
7751 then quit right away. */
7752 if (immediate_quit && NILP (Vinhibit_quit))
7753 {
7754 immediate_quit = 0;
7755 sigfree ();
7756 Fsignal (Qquit, Qnil);
7757 }
7758 else
7759 /* Else request quit when it's safe */
7760 Vquit_flag = Qt;
7761 }
7762
7763 if (waiting_for_input && !echoing)
7764 quit_throw_to_read_char ();
7765
7766 errno = old_errno;
7767}
7768
7769/* Handle a C-g by making read_char return C-g. */
7770
7771quit_throw_to_read_char ()
7772{
7773 quit_error_check ();
7774 sigfree ();
7775 /* Prevent another signal from doing this before we finish. */
f76475ad 7776 clear_waiting_for_input ();
284f4730
JB
7777 input_pending = 0;
7778
24597608 7779 Vunread_command_events = Qnil;
86e5706b 7780 unread_command_char = -1;
284f4730 7781
087feab3
RS
7782#if 0 /* Currently, sit_for is called from read_char without turning
7783 off polling. And that can call set_waiting_for_input.
7784 It seems to be harmless. */
e6b01c14
JB
7785#ifdef POLL_FOR_INPUT
7786 /* May be > 1 if in recursive minibuffer. */
7787 if (poll_suppress_count == 0)
7788 abort ();
7789#endif
087feab3 7790#endif
4c52b668
KH
7791 if (FRAMEP (internal_last_event_frame)
7792 && XFRAME (internal_last_event_frame) != selected_frame)
719191cf
RS
7793 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
7794 Qnil, 0);
e6b01c14 7795
284f4730
JB
7796 _longjmp (getcjmp, 1);
7797}
7798\f
7799DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
7800 "Set mode of reading keyboard input.\n\
464f8898
RS
7801First arg INTERRUPT non-nil means use input interrupts;\n\
7802 nil means use CBREAK mode.\n\
7803Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
284f4730 7804 (no effect except in CBREAK mode).\n\
b04904fb
RS
7805Third arg META t means accept 8-bit input (for a Meta key).\n\
7806 META nil means ignore the top bit, on the assumption it is parity.\n\
7807 Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\
a8ee7ef9
RS
7808Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\
7809See also `current-input-mode'.")
284f4730
JB
7810 (interrupt, flow, meta, quit)
7811 Lisp_Object interrupt, flow, meta, quit;
7812{
7813 if (!NILP (quit)
8c18cbfb 7814 && (!INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400))
34f04431
RS
7815 error ("set-input-mode: QUIT must be an ASCII character");
7816
7817#ifdef POLL_FOR_INPUT
7818 stop_polling ();
7819#endif
284f4730 7820
07de30b9 7821#ifndef DOS_NT
2ee250ec 7822 /* this causes startup screen to be restored and messes with the mouse */
284f4730 7823 reset_sys_modes ();
2ee250ec
RS
7824#endif
7825
284f4730
JB
7826#ifdef SIGIO
7827/* Note SIGIO has been undef'd if FIONREAD is missing. */
284f4730 7828 if (read_socket_hook)
9a0f60bb
KH
7829 {
7830 /* When using X, don't give the user a real choice,
7831 because we haven't implemented the mechanisms to support it. */
7832#ifdef NO_SOCK_SIGIO
7833 interrupt_input = 0;
7834#else /* not NO_SOCK_SIGIO */
7835 interrupt_input = 1;
284f4730 7836#endif /* NO_SOCK_SIGIO */
9a0f60bb
KH
7837 }
7838 else
284f4730
JB
7839 interrupt_input = !NILP (interrupt);
7840#else /* not SIGIO */
7841 interrupt_input = 0;
7842#endif /* not SIGIO */
9a0f60bb 7843
284f4730
JB
7844/* Our VMS input only works by interrupts, as of now. */
7845#ifdef VMS
7846 interrupt_input = 1;
7847#endif
9a0f60bb 7848
284f4730 7849 flow_control = !NILP (flow);
b04904fb
RS
7850 if (NILP (meta))
7851 meta_key = 0;
7852 else if (EQ (meta, Qt))
7853 meta_key = 1;
7854 else
7855 meta_key = 2;
284f4730
JB
7856 if (!NILP (quit))
7857 /* Don't let this value be out of range. */
7858 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
7859
07de30b9 7860#ifndef DOS_NT
284f4730 7861 init_sys_modes ();
2ee250ec 7862#endif
34f04431
RS
7863
7864#ifdef POLL_FOR_INPUT
7865 poll_suppress_count = 1;
7866 start_polling ();
7867#endif
284f4730
JB
7868 return Qnil;
7869}
80645119
JB
7870
7871DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
7872 "Return information about the way Emacs currently reads keyboard input.\n\
7873The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\
7874 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\
7875 nil, Emacs is using CBREAK mode.\n\
7876 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\
7877 terminal; this does not apply if Emacs uses interrupt-driven input.\n\
a8ee7ef9
RS
7878 META is t if accepting 8-bit input with 8th bit as Meta flag.\n\
7879 META nil means ignoring the top bit, on the assumption it is parity.\n\
7880 META is neither t nor nil if accepting 8-bit input and using\n\
7881 all 8 bits as the character code.\n\
80645119
JB
7882 QUIT is the character Emacs currently uses to quit.\n\
7883The elements of this list correspond to the arguments of\n\
a8ee7ef9 7884`set-input-mode'.")
80645119
JB
7885 ()
7886{
7887 Lisp_Object val[4];
7888
7889 val[0] = interrupt_input ? Qt : Qnil;
7890 val[1] = flow_control ? Qt : Qnil;
a8ee7ef9 7891 val[2] = meta_key == 2 ? make_number (0) : meta_key == 1 ? Qt : Qnil;
bb9e9bed 7892 XSETFASTINT (val[3], quit_char);
80645119 7893
bf673a7a 7894 return Flist (sizeof (val) / sizeof (val[0]), val);
80645119
JB
7895}
7896
284f4730 7897\f
6c6083a9 7898/*
c5fdd383 7899 * Set up a new kboard object with reasonable initial values.
6c6083a9
KH
7900 */
7901void
c5fdd383
KH
7902init_kboard (kb)
7903 KBOARD *kb;
6c6083a9 7904{
217258d5 7905 kb->Voverriding_terminal_local_map = Qnil;
6c7178b9 7906 kb->Vlast_command = Qnil;
d8bcf58e 7907 kb->Vprefix_arg = Qnil;
c5fdd383
KH
7908 kb->kbd_queue = Qnil;
7909 kb->kbd_queue_has_data = 0;
7910 kb->immediate_echo = 0;
7911 kb->echoptr = kb->echobuf;
7912 kb->echo_after_prompt = -1;
7913 kb->kbd_macro_buffer = 0;
7914 kb->kbd_macro_bufsize = 0;
7915 kb->defining_kbd_macro = Qnil;
7916 kb->Vlast_kbd_macro = Qnil;
7917 kb->reference_count = 0;
7c97ffdc 7918 kb->Vsystem_key_alist = Qnil;
142e6c73 7919 kb->system_key_syms = Qnil;
9ba47203 7920 kb->Vdefault_minibuffer_frame = Qnil;
6c6083a9
KH
7921}
7922
7923/*
c5fdd383 7924 * Destroy the contents of a kboard object, but not the object itself.
8e6208c5 7925 * We use this just before deleting it, or if we're going to initialize
6c6083a9
KH
7926 * it a second time.
7927 */
e50b8090 7928static void
c5fdd383
KH
7929wipe_kboard (kb)
7930 KBOARD *kb;
6c6083a9 7931{
c5fdd383
KH
7932 if (kb->kbd_macro_buffer)
7933 xfree (kb->kbd_macro_buffer);
6c6083a9
KH
7934}
7935
e50b8090
KH
7936#ifdef MULTI_KBOARD
7937void
7938delete_kboard (kb)
7939 KBOARD *kb;
7940{
7941 KBOARD **kbp;
7942 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
7943 if (*kbp == NULL)
7944 abort ();
7945 *kbp = kb->next_kboard;
7946 wipe_kboard (kb);
7947 xfree (kb);
7948}
7949#endif
7950
284f4730
JB
7951init_keyboard ()
7952{
284f4730
JB
7953 /* This is correct before outermost invocation of the editor loop */
7954 command_loop_level = -1;
7955 immediate_quit = 0;
7956 quit_char = Ctl ('g');
24597608 7957 Vunread_command_events = Qnil;
86e5706b 7958 unread_command_char = -1;
87dd9b9b 7959 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
284f4730 7960 total_keys = 0;
9deb415a 7961 recent_keys_index = 0;
beecf6a1
KH
7962 kbd_fetch_ptr = kbd_buffer;
7963 kbd_store_ptr = kbd_buffer;
7964 kbd_buffer_frame_or_window
7965 = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil);
2eb6bfbe 7966#ifdef HAVE_MOUSE
a9d77f1f 7967 do_mouse_tracking = Qnil;
2eb6bfbe 7968#endif
284f4730
JB
7969 input_pending = 0;
7970
4c52b668
KH
7971 /* This means that command_loop_1 won't try to select anything the first
7972 time through. */
7973 internal_last_event_frame = Qnil;
7974 Vlast_event_frame = internal_last_event_frame;
4c52b668 7975
c5fdd383 7976#ifdef MULTI_KBOARD
aaca43a1 7977 current_kboard = initial_kboard;
6c6083a9 7978#endif
aaca43a1 7979 wipe_kboard (current_kboard);
c5fdd383 7980 init_kboard (current_kboard);
07d2b8de 7981
beecf6a1
KH
7982 if (initialized)
7983 Ffillarray (kbd_buffer_frame_or_window, Qnil);
7984
7985 kbd_buffer_frame_or_window
7986 = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil);
7a80a6f6 7987 if (!noninteractive && !read_socket_hook && NILP (Vwindow_system))
284f4730
JB
7988 {
7989 signal (SIGINT, interrupt_signal);
cb5df6ae 7990#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
284f4730
JB
7991 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
7992 SIGQUIT and we can't tell which one it will give us. */
7993 signal (SIGQUIT, interrupt_signal);
7994#endif /* HAVE_TERMIO */
7a80a6f6 7995 }
284f4730
JB
7996/* Note SIGIO has been undef'd if FIONREAD is missing. */
7997#ifdef SIGIO
7a80a6f6
RS
7998 if (!noninteractive)
7999 signal (SIGIO, input_available_signal);
8ea0a720 8000#endif /* SIGIO */
284f4730
JB
8001
8002/* Use interrupt input by default, if it works and noninterrupt input
8003 has deficiencies. */
8004
8005#ifdef INTERRUPT_INPUT
8006 interrupt_input = 1;
8007#else
8008 interrupt_input = 0;
8009#endif
8010
8011/* Our VMS input only works by interrupts, as of now. */
8012#ifdef VMS
8013 interrupt_input = 1;
8014#endif
8015
8016 sigfree ();
8017 dribble = 0;
8018
8019 if (keyboard_init_hook)
8020 (*keyboard_init_hook) ();
8021
8022#ifdef POLL_FOR_INPUT
8023 poll_suppress_count = 1;
8024 start_polling ();
8025#endif
8026}
8027
df0f2ba1 8028/* This type's only use is in syms_of_keyboard, to initialize the
284f4730
JB
8029 event header symbols and put properties on them. */
8030struct event_head {
8031 Lisp_Object *var;
8032 char *name;
8033 Lisp_Object *kind;
8034};
8035
8036struct event_head head_table[] = {
7b4aedb9 8037 &Qmouse_movement, "mouse-movement", &Qmouse_movement,
3c370943 8038 &Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement,
7b4aedb9 8039 &Qswitch_frame, "switch-frame", &Qswitch_frame,
bbdc2092 8040 &Qdelete_frame, "delete-frame", &Qdelete_frame,
af17bd2b
KH
8041 &Qiconify_frame, "iconify-frame", &Qiconify_frame,
8042 &Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible,
284f4730
JB
8043};
8044
8045syms_of_keyboard ()
8046{
d925fb39
RS
8047 Qtimer_event_handler = intern ("timer-event-handler");
8048 staticpro (&Qtimer_event_handler);
8049
2e894dab
RS
8050 Qdisabled_command_hook = intern ("disabled-command-hook");
8051 staticpro (&Qdisabled_command_hook);
8052
284f4730
JB
8053 Qself_insert_command = intern ("self-insert-command");
8054 staticpro (&Qself_insert_command);
8055
8056 Qforward_char = intern ("forward-char");
8057 staticpro (&Qforward_char);
8058
8059 Qbackward_char = intern ("backward-char");
8060 staticpro (&Qbackward_char);
8061
8062 Qdisabled = intern ("disabled");
8063 staticpro (&Qdisabled);
8064
e58aa385
RS
8065 Qundefined = intern ("undefined");
8066 staticpro (&Qundefined);
8067
86e5706b
RS
8068 Qpre_command_hook = intern ("pre-command-hook");
8069 staticpro (&Qpre_command_hook);
8070
8071 Qpost_command_hook = intern ("post-command-hook");
8072 staticpro (&Qpost_command_hook);
8073
59aadc81
RS
8074 Qpost_command_idle_hook = intern ("post-command-idle-hook");
8075 staticpro (&Qpost_command_idle_hook);
8076
3ef14e46
RS
8077 Qdeferred_action_function = intern ("deferred-action-function");
8078 staticpro (&Qdeferred_action_function);
8079
40932d1a
RS
8080 Qcommand_hook_internal = intern ("command-hook-internal");
8081 staticpro (&Qcommand_hook_internal);
8082
284f4730
JB
8083 Qfunction_key = intern ("function-key");
8084 staticpro (&Qfunction_key);
13b5e56c 8085 Qmouse_click = intern ("mouse-click");
284f4730 8086 staticpro (&Qmouse_click);
07de30b9
GV
8087#ifdef WINDOWSNT
8088 Qmouse_wheel = intern ("mouse-wheel");
8089 staticpro (&Qmouse_wheel);
8090#endif
284f4730 8091
598a9fa7
JB
8092 Qmenu_enable = intern ("menu-enable");
8093 staticpro (&Qmenu_enable);
8094
284f4730
JB
8095 Qmode_line = intern ("mode-line");
8096 staticpro (&Qmode_line);
e5d77022
JB
8097 Qvertical_line = intern ("vertical-line");
8098 staticpro (&Qvertical_line);
3c370943
JB
8099 Qvertical_scroll_bar = intern ("vertical-scroll-bar");
8100 staticpro (&Qvertical_scroll_bar);
5ec75a55
RS
8101 Qmenu_bar = intern ("menu-bar");
8102 staticpro (&Qmenu_bar);
4bb994d1
JB
8103
8104 Qabove_handle = intern ("above-handle");
8105 staticpro (&Qabove_handle);
8106 Qhandle = intern ("handle");
8107 staticpro (&Qhandle);
8108 Qbelow_handle = intern ("below-handle");
8109 staticpro (&Qbelow_handle);
db08707d
RS
8110 Qup = intern ("up");
8111 staticpro (&Qup);
8112 Qdown = intern ("down");
8113 staticpro (&Qdown);
284f4730 8114
cd21b839 8115 Qevent_kind = intern ("event-kind");
284f4730 8116 staticpro (&Qevent_kind);
88cb0656
JB
8117 Qevent_symbol_elements = intern ("event-symbol-elements");
8118 staticpro (&Qevent_symbol_elements);
0a7f1fc0
JB
8119 Qevent_symbol_element_mask = intern ("event-symbol-element-mask");
8120 staticpro (&Qevent_symbol_element_mask);
8121 Qmodifier_cache = intern ("modifier-cache");
8122 staticpro (&Qmodifier_cache);
284f4730 8123
48e416d4
RS
8124 Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar");
8125 staticpro (&Qrecompute_lucid_menubar);
8126 Qactivate_menubar_hook = intern ("activate-menubar-hook");
8127 staticpro (&Qactivate_menubar_hook);
8128
f4eef8b4
RS
8129 Qpolling_period = intern ("polling-period");
8130 staticpro (&Qpolling_period);
8131
284f4730
JB
8132 {
8133 struct event_head *p;
8134
8135 for (p = head_table;
8136 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
8137 p++)
8138 {
8139 *p->var = intern (p->name);
8140 staticpro (p->var);
8141 Fput (*p->var, Qevent_kind, *p->kind);
88cb0656 8142 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
284f4730
JB
8143 }
8144 }
8145
7b4aedb9
JB
8146 button_down_location = Fmake_vector (make_number (NUM_MOUSE_BUTTONS), Qnil);
8147 staticpro (&button_down_location);
88cb0656
JB
8148
8149 {
8150 int i;
8151 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
8152
8153 modifier_symbols = Fmake_vector (make_number (len), Qnil);
8154 for (i = 0; i < len; i++)
86e5706b
RS
8155 if (modifier_names[i])
8156 XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]);
88cb0656
JB
8157 staticpro (&modifier_symbols);
8158 }
8159
9deb415a
JB
8160 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
8161 staticpro (&recent_keys);
8162
6569cc8d 8163 this_command_keys = Fmake_vector (make_number (40), Qnil);
715d9345 8164 staticpro (&this_command_keys);
6569cc8d 8165
03b4122a
BF
8166 Qextended_command_history = intern ("extended-command-history");
8167 Fset (Qextended_command_history, Qnil);
8168 staticpro (&Qextended_command_history);
8169
beecf6a1
KH
8170 kbd_buffer_frame_or_window
8171 = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil);
8172 staticpro (&kbd_buffer_frame_or_window);
8173
24597608
RS
8174 accent_key_syms = Qnil;
8175 staticpro (&accent_key_syms);
8176
284f4730
JB
8177 func_key_syms = Qnil;
8178 staticpro (&func_key_syms);
8179
8180 mouse_syms = Qnil;
8181 staticpro (&mouse_syms);
8182
07de30b9
GV
8183#ifdef WINDOWSNT
8184 mouse_wheel_syms = Qnil;
8185 staticpro (&mouse_wheel_syms);
8186#endif
8187
cd21b839
JB
8188 unread_switch_frame = Qnil;
8189 staticpro (&unread_switch_frame);
8190
fe412364
EN
8191 internal_last_event_frame = Qnil;
8192 staticpro (&internal_last_event_frame);
8193
8194 read_key_sequence_cmd = Qnil;
8195 staticpro (&read_key_sequence_cmd);
8196
a1706c30 8197 defsubr (&Sevent_convert_list);
284f4730
JB
8198 defsubr (&Sread_key_sequence);
8199 defsubr (&Srecursive_edit);
2eb6bfbe 8200#ifdef HAVE_MOUSE
284f4730 8201 defsubr (&Strack_mouse);
2eb6bfbe 8202#endif
284f4730
JB
8203 defsubr (&Sinput_pending_p);
8204 defsubr (&Scommand_execute);
8205 defsubr (&Srecent_keys);
8206 defsubr (&Sthis_command_keys);
6321824f 8207 defsubr (&Sthis_single_command_keys);
71918b75 8208 defsubr (&Sreset_this_command_lengths);
284f4730
JB
8209 defsubr (&Ssuspend_emacs);
8210 defsubr (&Sabort_recursive_edit);
8211 defsubr (&Sexit_recursive_edit);
8212 defsubr (&Srecursion_depth);
8213 defsubr (&Stop_level);
8214 defsubr (&Sdiscard_input);
8215 defsubr (&Sopen_dribble_file);
8216 defsubr (&Sset_input_mode);
80645119 8217 defsubr (&Scurrent_input_mode);
284f4730
JB
8218 defsubr (&Sexecute_extended_command);
8219
284f4730 8220 DEFVAR_LISP ("last-command-char", &last_command_char,
86e5706b
RS
8221 "Last input event that was part of a command.");
8222
186cf719 8223 DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char,
86e5706b 8224 "Last input event that was part of a command.");
284f4730 8225
7d6de002 8226 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
86e5706b 8227 "Last input event in a command, except for mouse menu events.\n\
7d6de002
RS
8228Mouse menus give back keys that don't look like mouse events;\n\
8229this variable holds the actual mouse event that led to the menu,\n\
8230so that you can determine whether the command was run by mouse or not.");
8231
284f4730 8232 DEFVAR_LISP ("last-input-char", &last_input_char,
86e5706b
RS
8233 "Last input event.");
8234
186cf719 8235 DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char,
86e5706b 8236 "Last input event.");
284f4730 8237
24597608 8238 DEFVAR_LISP ("unread-command-events", &Vunread_command_events,
1c07d0a6 8239 "List of objects to be read as next command input events.");
284f4730 8240
86e5706b
RS
8241 DEFVAR_INT ("unread-command-char", &unread_command_char,
8242 "If not -1, an object to be read as next command input event.");
8243
284f4730
JB
8244 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
8245 "Meta-prefix character code. Meta-foo as command input\n\
8246turns into this character followed by foo.");
18cd2eeb 8247 XSETINT (meta_prefix_char, 033);
284f4730 8248
6c7178b9 8249 DEFVAR_KBOARD ("last-command", Vlast_command,
284f4730
JB
8250 "The last command executed. Normally a symbol with a function definition,\n\
8251but can be whatever was found in the keymap, or whatever the variable\n\
18f29056
RS
8252`this-command' was set to by that command.\n\
8253\n\
8254The value `mode-exit' is special; it means that the previous command\n\
8255read an event that told it to exit, and it did so and unread that event.\n\
8256In other words, the present command is the event that made the previous\n\
8257command exit.\n\
8258\n\
8259The value `kill-region' is special; it means that the previous command\n\
8260was a kill command.");
284f4730
JB
8261
8262 DEFVAR_LISP ("this-command", &this_command,
8263 "The command now being executed.\n\
8264The command can set this variable; whatever is put here\n\
8265will be in `last-command' during the following command.");
8266 this_command = Qnil;
8267
8268 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
8269 "*Number of keyboard input characters between auto-saves.\n\
8270Zero means disable autosaving due to number of characters typed.");
8271 auto_save_interval = 300;
8272
8273 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
8274 "*Number of seconds idle time before auto-save.\n\
06ef7355
RS
8275Zero or nil means disable auto-saving due to idleness.\n\
8276After auto-saving due to this many seconds of idle time,\n\
84447c71 8277Emacs also does a garbage collection if that seems to be warranted.");
bb9e9bed 8278 XSETFASTINT (Vauto_save_timeout, 30);
284f4730
JB
8279
8280 DEFVAR_INT ("echo-keystrokes", &echo_keystrokes,
8281 "*Nonzero means echo unfinished commands after this many seconds of pause.");
8282 echo_keystrokes = 1;
8283
8284 DEFVAR_INT ("polling-period", &polling_period,
8285 "*Interval between polling for input during Lisp execution.\n\
8286The reason for polling is to make C-g work to stop a running program.\n\
8287Polling is needed only when using X windows and SIGIO does not work.\n\
8288Polling is automatically disabled in all other cases.");
8289 polling_period = 2;
df0f2ba1 8290
564dc952 8291 DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
fbcd35bd 8292 "*Maximum time between mouse clicks to make a double-click.\n\
564dc952
JB
8293Measured in milliseconds. nil means disable double-click recognition;\n\
8294t means double-clicks have no time limit and are detected\n\
fbcd35bd 8295by position only.");
aab06933 8296 Vdouble_click_time = make_number (500);
fbcd35bd 8297
03361bcc
RS
8298 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
8299 "*Non-nil means inhibit local map menu bar menus.");
8300 inhibit_local_menu_bar_menus = 0;
8301
284f4730 8302 DEFVAR_INT ("num-input-keys", &num_input_keys,
c43b1734 8303 "Number of complete key sequences read as input so far.\n\
58ce35fb
KH
8304This includes key sequences read from keyboard macros.\n\
8305The number is effectively the number of interactive command invocations.");
284f4730
JB
8306 num_input_keys = 0;
8307
c43b1734
RS
8308 DEFVAR_INT ("num-nonmacro-input-events", &num_nonmacro_input_events,
8309 "Number of input events read from the keyboard so far.\n\
8310This does not include events generated by keyboard macros.");
8311 num_nonmacro_input_events = 0;
fa90970d 8312
4c52b668
KH
8313 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
8314 "The frame in which the most recently read event occurred.\n\
8315If the last event came from a keyboard macro, this is set to `macro'.");
8316 Vlast_event_frame = Qnil;
8317
fa90970d
RS
8318 /* This variable is set up in sysdep.c. */
8319 DEFVAR_LISP ("tty-erase-char", &Vtty_erase_char,
8320 "The ERASE character as set by the user with stty.");
8321
7e85b935 8322 DEFVAR_LISP ("help-char", &Vhelp_char,
284f4730
JB
8323 "Character to recognize as meaning Help.\n\
8324When it is read, do `(eval help-form)', and display result if it's a string.\n\
8325If the value of `help-form' is nil, this char can be read normally.");
18cd2eeb 8326 XSETINT (Vhelp_char, Ctl ('H'));
284f4730 8327
ecb7cb34
KH
8328 DEFVAR_LISP ("help-event-list", &Vhelp_event_list,
8329 "List of input events to recognize as meaning Help.\n\
8330These work just like the value of `help-char' (see that).");
8331 Vhelp_event_list = Qnil;
8332
284f4730 8333 DEFVAR_LISP ("help-form", &Vhelp_form,
7e85b935 8334 "Form to execute when character `help-char' is read.\n\
284f4730
JB
8335If the form returns a string, that string is displayed.\n\
8336If `help-form' is nil, the help char is not recognized.");
8337 Vhelp_form = Qnil;
8338
7e85b935
RS
8339 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
8340 "Command to run when `help-char' character follows a prefix key.\n\
8341This command is used only when there is no actual binding\n\
8342for that character after that prefix key.");
8343 Vprefix_help_command = Qnil;
8344
284f4730
JB
8345 DEFVAR_LISP ("top-level", &Vtop_level,
8346 "Form to evaluate when Emacs starts up.\n\
8347Useful to set before you dump a modified Emacs.");
8348 Vtop_level = Qnil;
8349
8350 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
f9414d62 8351 "Translate table for keyboard input, or nil.\n\
284f4730 8352Each character is looked up in this string and the contents used instead.\n\
f9414d62
RS
8353The value may be a string, a vector, or a char-table.\n\
8354If it is a string or vector of length N,\n\
8355character codes N and up are untranslated.\n\
8356In a vector or a char-table, an element which is nil means \"no translation\".");
284f4730
JB
8357 Vkeyboard_translate_table = Qnil;
8358
8026024c
KH
8359 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
8360 "Non-nil means to always spawn a subshell instead of suspending,\n\
8361even if the operating system has support for stopping a process.");
8362 cannot_suspend = 0;
8363
284f4730 8364 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
7d6de002 8365 "Non-nil means prompt with menus when appropriate.\n\
284f4730 8366This is done when reading from a keymap that has a prompt string,\n\
7d6de002
RS
8367for elements that have prompt strings.\n\
8368The menu is displayed on the screen\n\
8369if X menus were enabled at configuration\n\
8370time and the previous event was a mouse click prefix key.\n\
8371Otherwise, menu prompting uses the echo area.");
284f4730
JB
8372 menu_prompting = 1;
8373
8374 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
8375 "Character to see next line of menu prompt.\n\
8376Type this character while in a menu prompt to rotate around the lines of it.");
18cd2eeb 8377 XSETINT (menu_prompt_more_char, ' ');
9fa4395d
RS
8378
8379 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
8380 "A mask of additional modifier keys to use with every keyboard character.\n\
ad163903
JB
8381Emacs applies the modifiers of the character stored here to each keyboard\n\
8382character it reads. For example, after evaluating the expression\n\
9d9f56dd 8383 (setq extra-keyboard-modifiers ?\\C-x)\n\
80645119
JB
8384all input characters will have the control modifier applied to them.\n\
8385\n\
9d9f56dd 8386Note that the character ?\\C-@, equivalent to the integer zero, does\n\
80645119 8387not count as a control character; rather, it counts as a character\n\
27203ead 8388with no modifiers; thus, setting `extra-keyboard-modifiers' to zero\n\
80645119 8389cancels any modification.");
9fa4395d 8390 extra_keyboard_modifiers = 0;
86e5706b
RS
8391
8392 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
8393 "If an editing command sets this to t, deactivate the mark afterward.\n\
8394The command loop sets this to nil before each command,\n\
8395and tests the value when the command returns.\n\
8396Buffer modification stores t in this variable.");
8397 Vdeactivate_mark = Qnil;
8398
b0f2a7bf
KH
8399 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal,
8400 "Temporary storage of pre-command-hook or post-command-hook.");
8401 Vcommand_hook_internal = Qnil;
8402
86e5706b 8403 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
a1fd42c0 8404 "Normal hook run before each command is executed.\n\
59aadc81 8405Errors running the hook are caught and ignored.");
86e5706b
RS
8406 Vpre_command_hook = Qnil;
8407
8408 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
a1fd42c0 8409 "Normal hook run after each command is executed.\n\
59aadc81 8410Errors running the hook are caught and ignored.");
86e5706b 8411 Vpost_command_hook = Qnil;
48e416d4 8412
59aadc81
RS
8413 DEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook,
8414 "Normal hook run after each command is executed, if idle.\n\
d4d62e8d
RS
8415Errors running the hook are caught and ignored.\n\
8416This feature is obsolete; use idle timers instead. See `etc/NEWS'.");
59aadc81
RS
8417 Vpost_command_idle_hook = Qnil;
8418
8419 DEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay,
7051b69b 8420 "Delay time before running `post-command-idle-hook'.\n\
59aadc81
RS
8421This is measured in microseconds.");
8422 post_command_idle_delay = 100000;
8423
cdb9d665
RS
8424#if 0
8425 DEFVAR_LISP ("echo-area-clear-hook", ...,
8426 "Normal hook run when clearing the echo area.");
8427#endif
8428 Qecho_area_clear_hook = intern ("echo-area-clear-hook");
8429 XSYMBOL (Qecho_area_clear_hook)->value = Qnil;
8430
48e416d4
RS
8431 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
8432 "t means menu bar, specified Lucid style, needs to be recomputed.");
8433 Vlucid_menu_bar_dirty_flag = Qnil;
a73c5e29 8434
9f9c0e27
RS
8435 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
8436 "List of menu bar items to move to the end of the menu bar.\n\
a612e298 8437The elements of the list are event types that may have menu bar bindings.");
9f9c0e27 8438 Vmenu_bar_final_items = Qnil;
e9bf89a0 8439
217258d5
KH
8440 DEFVAR_KBOARD ("overriding-terminal-local-map",
8441 Voverriding_terminal_local_map,
779b34df 8442 "Per-terminal keymap that overrides all other local keymaps.\n\
217258d5 8443If this variable is non-nil, it is used as a keymap instead of the\n\
779b34df
RS
8444buffer's local map, and the minor mode keymaps and text property keymaps.\n\
8445This variable is intended to let commands such as `universal-argumemnt'\n\
8446set up a different keymap for reading the next command.");
217258d5 8447
9dd3131c
RS
8448 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map,
8449 "Keymap that overrides all other local keymaps.\n\
8450If this variable is non-nil, it is used as a keymap instead of the\n\
8451buffer's local map, and the minor mode keymaps and text property keymaps.");
8452 Voverriding_local_map = Qnil;
8453
d0a49716
RS
8454 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag,
8455 "Non-nil means `overriding-local-map' applies to the menu bar.\n\
8456Otherwise, the menu bar continues to reflect the buffer's local map\n\
8457and the minor mode maps regardless of `overriding-local-map'.");
8458 Voverriding_local_map_menu_flag = Qnil;
8459
7f07d5ca
RS
8460 DEFVAR_LISP ("special-event-map", &Vspecial_event_map,
8461 "Keymap defining bindings for special events to execute at low level.");
8462 Vspecial_event_map = Fcons (intern ("keymap"), Qnil);
8463
71edead1 8464 DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
a53c7666 8465 "*Non-nil means generate motion events for mouse motion.");
80e4aa30 8466
7c97ffdc 8467 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
270a208f 8468 "Alist of system-specific X windows key symbols.\n\
80e4aa30 8469Each element should have the form (N . SYMBOL) where N is the\n\
270a208f 8470numeric keysym code (sans the \"system-specific\" bit 1<<28)\n\
80e4aa30 8471and SYMBOL is its name.");
8a792f3a
RS
8472
8473 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list,
8474 "List of deferred actions to be performed at a later time.\n\
8475The precise format isn't relevant here; we just check whether it is nil.");
8476 Vdeferred_action_list = Qnil;
8477
8478 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function,
8479 "Function to call to handle deferred actions, after each command.\n\
8480This function is called with no arguments after each command\n\
8481whenever `deferred-action-list' is non-nil.");
8482 Vdeferred_action_function = Qnil;
6526ab49
RS
8483
8484 DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings,
8485 "Non-nil means show the equivalent key-binding when M-x command has one.\n\
8486The value can be a length of time to show the message for.\n\
8487If the value is non-nil and not a number, we wait 2 seconds.");
8488 Vsuggest_key_bindings = Qt;
8bb1c042 8489
c04cbc3b 8490 DEFVAR_LISP ("timer-list", &Vtimer_list,
d9d4c147 8491 "List of active absolute time timers in order of increasing time");
c04cbc3b 8492 Vtimer_list = Qnil;
d9d4c147
KH
8493
8494 DEFVAR_LISP ("timer-idle-list", &Vtimer_idle_list,
8495 "List of active idle-time timers in order of increasing time");
8496 Vtimer_idle_list = Qnil;
284f4730
JB
8497}
8498
8499keys_of_keyboard ()
8500{
8501 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
8502 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
8503 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
8504 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
8505 initial_define_key (meta_map, 'x', "execute-extended-command");
7f07d5ca
RS
8506
8507 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
8508 "handle-delete-frame");
8509 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
8510 "ignore-event");
8511 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
8512 "ignore-event");
284f4730 8513}