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