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