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