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