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