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