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