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