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