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