(main): Don't call setpgrp if !initialized.
[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 1067 if ((dp
82ba47d7 1068 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
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
e9bf89a0
RS
1425 if (commandflag >= 0 && !input_pending && !detect_input_pending ())
1426 prepare_menu_bars ();
1427
284f4730 1428 /* Save outer setjmp data, in case called recursively. */
f76475ad 1429 save_getcjmp (save_jump);
284f4730
JB
1430
1431 stop_polling ();
1432
1433 if (commandflag >= 0 && !input_pending && !detect_input_pending ())
1434 redisplay ();
1435
1436 if (_setjmp (getcjmp))
1437 {
1438 XSET (c, Lisp_Int, quit_char);
07d2b8de 1439#ifdef MULTI_FRAME
3c370943
JB
1440 XSET (internal_last_event_frame, Lisp_Frame, selected_frame);
1441 Vlast_event_frame = internal_last_event_frame;
07d2b8de 1442#endif
04904c29
RS
1443 /* If we report the quit char as an event,
1444 don't do so more than once. */
1445 if (!NILP (Vinhibit_quit))
1446 Vquit_flag = Qnil;
284f4730 1447
284f4730
JB
1448 goto non_reread;
1449 }
1450
1451 /* Message turns off echoing unless more keystrokes turn it on again. */
1452 if (echo_area_glyphs && *echo_area_glyphs && echo_area_glyphs != echobuf)
1453 cancel_echoing ();
1454 else
1455 /* If already echoing, continue. */
1456 echo_dash ();
1457
1458 /* If in middle of key sequence and minibuffer not active,
1459 start echoing if enough time elapses. */
1460 if (minibuf_level == 0 && !immediate_echo && this_command_key_count > 0
27203ead 1461 && ! noninteractive
284f4730
JB
1462 && echo_keystrokes > 0
1463 && (echo_area_glyphs == 0 || *echo_area_glyphs == 0))
1464 {
1465 Lisp_Object tem0;
1466
7d6de002
RS
1467 /* After a mouse event, start echoing right away.
1468 This is because we are probably about to display a menu,
1469 and we don't want to delay before doing so. */
dbc4e1c1 1470 if (EVENT_HAS_PARAMETERS (prev_event))
284f4730 1471 echo ();
7d6de002
RS
1472 else
1473 {
1474 tem0 = sit_for (echo_keystrokes, 0, 1, 1);
1475 if (EQ (tem0, Qt))
1476 echo ();
1477 }
284f4730
JB
1478 }
1479
1480 /* Maybe auto save due to number of keystrokes or idle time. */
1481
1482 if (commandflag != 0
1483 && auto_save_interval > 0
51172b6d 1484 && num_nonmacro_input_chars - last_auto_save > max (auto_save_interval, 20)
284f4730
JB
1485 && !detect_input_pending ())
1486 {
1487 jmp_buf temp;
1488 save_getcjmp (temp);
1489 Fdo_auto_save (Qnil, Qnil);
1490 restore_getcjmp (temp);
1491 }
1492
7d6de002
RS
1493 /* Try reading a character via menu prompting.
1494 Try this before the sit-for, because the sit-for
1495 would do the wrong thing if we are supposed to do
1496 menu prompting. */
1497 c = Qnil;
1498 if (INTERACTIVE && !NILP (prev_event))
1499 c = read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
1500
284f4730
JB
1501 /* Slow down auto saves logarithmically in size of current buffer,
1502 and garbage collect while we're at it. */
26c1639e 1503 if (INTERACTIVE && NILP (c))
7d6de002
RS
1504 {
1505 int delay_level, buffer_size;
1506
1507 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
1508 last_non_minibuf_size = Z - BEG;
1509 buffer_size = (last_non_minibuf_size >> 8) + 1;
1510 delay_level = 0;
1511 while (buffer_size > 64)
1512 delay_level++, buffer_size -= buffer_size >> 2;
1513 if (delay_level < 4) delay_level = 4;
1514 /* delay_level is 4 for files under around 50k, 7 at 100k,
1515 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
1516
1517 /* Auto save if enough time goes by without input. */
1518 if (commandflag != 0
51172b6d 1519 && num_nonmacro_input_chars > last_auto_save
7d6de002
RS
1520 && XTYPE (Vauto_save_timeout) == Lisp_Int
1521 && XINT (Vauto_save_timeout) > 0)
1522 {
1523 Lisp_Object tem0;
1524 int delay = delay_level * XFASTINT (Vauto_save_timeout) / 4;
1525 tem0 = sit_for (delay, 0, 1, 1);
1526 if (EQ (tem0, Qt))
1527 {
1528 jmp_buf temp;
1529 save_getcjmp (temp);
1530 Fdo_auto_save (Qnil, Qnil);
1531 restore_getcjmp (temp);
1532
1533 /* If we have auto-saved and there is still no input
1534 available, garbage collect if there has been enough
1535 consing going on to make it worthwhile. */
1536 if (!detect_input_pending ()
1537 && consing_since_gc > gc_cons_threshold / 2)
7e85b935
RS
1538 {
1539 Fgarbage_collect ();
e9bf89a0
RS
1540 /* prepare_menu_bars isn't safe here, but it should
1541 also be unnecessary. */
7e85b935
RS
1542 redisplay ();
1543 }
7d6de002
RS
1544 }
1545 }
1546 }
284f4730
JB
1547
1548 /* Actually read a character, waiting if necessary. */
4eb4f926 1549 while (NILP (c))
1e12dd87
RS
1550 {
1551 c = kbd_buffer_get_event ();
1552 if (!NILP (c))
1553 break;
1554 if (commandflag >= 0 && !input_pending && !detect_input_pending ())
1555 redisplay ();
1556 }
284f4730 1557
284f4730 1558 /* Terminate Emacs in batch mode if at eof. */
7d6de002 1559 if (noninteractive && XTYPE (c) == Lisp_Int && XINT (c) < 0)
284f4730
JB
1560 Fkill_emacs (make_number (1));
1561
80645119
JB
1562 if (XTYPE (c) == Lisp_Int)
1563 {
1564 /* Add in any extra modifiers, where appropriate. */
1565 if ((extra_keyboard_modifiers & CHAR_CTL)
1566 || ((extra_keyboard_modifiers & 0177) < ' '
1567 && (extra_keyboard_modifiers & 0177) != 0))
faf5e407 1568 XSETINT (c, make_ctrl_char (XINT (c)));
80645119
JB
1569
1570 /* Transfer any other modifier bits directly from
1571 extra_keyboard_modifiers to c. Ignore the actual character code
1572 in the low 16 bits of extra_keyboard_modifiers. */
b8d9050d 1573 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
80645119 1574 }
9fa4395d 1575
284f4730
JB
1576 non_reread:
1577
f76475ad 1578 restore_getcjmp (save_jump);
284f4730
JB
1579
1580 start_polling ();
1581
1582 echo_area_glyphs = 0;
1583
1584 /* Handle things that only apply to characters. */
1585 if (XTYPE (c) == Lisp_Int)
1586 {
1587 /* If kbd_buffer_get_event gave us an EOF, return that. */
86e5706b 1588 if (XINT (c) == -1)
284f4730
JB
1589 return c;
1590
284f4730 1591 if (XTYPE (Vkeyboard_translate_table) == Lisp_String
f4255cd1
JB
1592 && XSTRING (Vkeyboard_translate_table)->size > XFASTINT (c))
1593 XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[XFASTINT (c)]);
284f4730
JB
1594 }
1595
1596 total_keys++;
5160df46
JB
1597 XVECTOR (recent_keys)->contents[recent_keys_index] = c;
1598 if (++recent_keys_index >= NUM_RECENT_KEYS)
284f4730
JB
1599 recent_keys_index = 0;
1600
1601 /* Write c to the dribble file. If c is a lispy event, write
1602 the event's symbol to the dribble file, in <brackets>. Bleaugh.
1603 If you, dear reader, have a better idea, you've got the source. :-) */
1604 if (dribble)
1605 {
1606 if (XTYPE (c) == Lisp_Int)
f4255cd1 1607 putc (XINT (c), dribble);
284f4730
JB
1608 else
1609 {
1610 Lisp_Object dribblee = c;
1611
1612 /* If it's a structured event, take the event header. */
88cb0656 1613 dribblee = EVENT_HEAD (dribblee);
284f4730 1614
8f805655 1615 if (XTYPE (dribblee) == Lisp_Symbol)
284f4730
JB
1616 {
1617 putc ('<', dribble);
8f805655
JB
1618 fwrite (XSYMBOL (dribblee)->name->data, sizeof (char),
1619 XSYMBOL (dribblee)->name->size,
284f4730
JB
1620 dribble);
1621 putc ('>', dribble);
1622 }
1623 }
1624
1625 fflush (dribble);
1626 }
1627
1628 store_kbd_macro_char (c);
1629
51172b6d
RS
1630 num_nonmacro_input_chars++;
1631
284f4730
JB
1632 from_macro:
1633 reread_first:
284f4730 1634
4bb994d1
JB
1635 /* Record this character as part of the current key.
1636 Don't record mouse motion; it should never matter. */
1637 if (! (EVENT_HAS_PARAMETERS (c)
1638 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
7b4aedb9
JB
1639 {
1640 echo_char (c);
1641 add_command_key (c);
1642 }
284f4730
JB
1643
1644 /* Re-reading in the middle of a command */
1645 reread:
1646 last_input_char = c;
1647 num_input_chars++;
1648
1649 /* Process the help character specially if enabled */
7e85b935 1650 if (EQ (c, Vhelp_char) && !NILP (Vhelp_form))
284f4730
JB
1651 {
1652 Lisp_Object tem0;
1653 count = specpdl_ptr - specpdl;
1654
1655 record_unwind_protect (Fset_window_configuration,
1656 Fcurrent_window_configuration (Qnil));
1657
1658 tem0 = Feval (Vhelp_form);
1659 if (XTYPE (tem0) == Lisp_String)
1660 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
1661
1662 cancel_echoing ();
6569cc8d 1663 c = read_char (0, 0, 0, Qnil, 0);
ff11dfa1 1664 /* Remove the help from the frame */
284f4730 1665 unbind_to (count, Qnil);
e9bf89a0 1666 prepare_menu_bars ();
284f4730
JB
1667 redisplay ();
1668 if (EQ (c, make_number (040)))
1669 {
1670 cancel_echoing ();
7d6de002 1671 c = read_char (0, 0, 0, Qnil, 0);
284f4730
JB
1672 }
1673 }
1674
1675 return c;
1676}
1677
1678Lisp_Object
1679print_help (object)
1680 Lisp_Object object;
1681{
1682 Fprinc (object, Qnil);
1683 return Qnil;
1684}
1685
1686/* Copy out or in the info on where C-g should throw to.
1687 This is used when running Lisp code from within get_char,
1688 in case get_char is called recursively.
1689 See read_process_output. */
1690
1691save_getcjmp (temp)
1692 jmp_buf temp;
1693{
1694 bcopy (getcjmp, temp, sizeof getcjmp);
1695}
1696
1697restore_getcjmp (temp)
1698 jmp_buf temp;
1699{
1700 bcopy (temp, getcjmp, sizeof getcjmp);
1701}
1702
1703\f
284f4730
JB
1704/* Restore mouse tracking enablement. See Ftrack_mouse for the only use
1705 of this function. */
1706static Lisp_Object
1707tracking_off (old_value)
1708 Lisp_Object old_value;
1709{
1710 if (! XFASTINT (old_value))
1711 {
1712 do_mouse_tracking = 0;
1713
1714 /* Redisplay may have been preempted because there was input
1715 available, and it assumes it will be called again after the
1716 input has been processed. If the only input available was
1717 the sort that we have just disabled, then we need to call
1718 redisplay. */
1719 if (!readable_events ())
1720 {
e9bf89a0 1721 prepare_menu_bars ();
284f4730
JB
1722 redisplay_preserve_echo_area ();
1723 get_input_pending (&input_pending);
1724 }
1725 }
1726}
1727
1728DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
4bb994d1
JB
1729 "Evaluate BODY with mouse movement events enabled.\n\
1730Within a `track-mouse' form, mouse motion generates input events that\n\
1731you can read with `read-event'.\n\
1732Normally, mouse motion is ignored.")
284f4730
JB
1733 (args)
1734 Lisp_Object args;
1735{
1736 int count = specpdl_ptr - specpdl;
1737 Lisp_Object val;
1738
1739 XSET (val, Lisp_Int, do_mouse_tracking);
1740 record_unwind_protect (tracking_off, val);
1741
1742 do_mouse_tracking = 1;
1743
1744 val = Fprogn (args);
1745 return unbind_to (count, val);
1746}
a612e298
RS
1747\f
1748/* Low level keyboard/mouse input.
1749 kbd_buffer_store_event places events in kbd_buffer, and
1750 kbd_buffer_get_event retrieves them.
1751 mouse_moved indicates when the mouse has moved again, and
1752 *mouse_position_hook provides the mouse position. */
1753
1754/* Return true iff there are any events in the queue that read-char
1755 would return. If this returns false, a read-char would block. */
1756static int
1757readable_events ()
1758{
1759 return ! EVENT_QUEUES_EMPTY;
1760}
1761
1762/* Set this for debugging, to have a way to get out */
1763int stop_character;
284f4730
JB
1764
1765/* Store an event obtained at interrupt level into kbd_buffer, fifo */
1766
1767void
1768kbd_buffer_store_event (event)
1769 register struct input_event *event;
1770{
1771 if (event->kind == no_event)
1772 abort ();
1773
1774 if (event->kind == ascii_keystroke)
1775 {
e9bf89a0 1776 register int c = event->code & 0377;
284f4730 1777
faf5e407
JB
1778 if (event->modifiers & ctrl_modifier)
1779 c = make_ctrl_char (c);
1780
9fd7d808
RS
1781 c |= (event->modifiers
1782 & (meta_modifier | alt_modifier
1783 | hyper_modifier | super_modifier));
1784
86e5706b 1785 if (c == quit_char)
284f4730 1786 {
3e51c7b7
JB
1787 extern SIGTYPE interrupt_signal ();
1788
07d2b8de 1789#ifdef MULTI_FRAME
284f4730 1790 /* If this results in a quit_char being returned to Emacs as
3c370943 1791 input, set Vlast_event_frame properly. If this doesn't
284f4730 1792 get returned to Emacs as an event, the next event read
ff11dfa1 1793 will set Vlast_event_frame again, so this is safe to do. */
4bb994d1 1794 {
27203ead
RS
1795 Lisp_Object focus
1796 = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
4bb994d1
JB
1797
1798 if (NILP (focus))
3c370943 1799 internal_last_event_frame = event->frame_or_window;
4bb994d1 1800 else
3c370943
JB
1801 internal_last_event_frame = focus;
1802 Vlast_event_frame = internal_last_event_frame;
4bb994d1 1803 }
07d2b8de 1804#endif
3e51c7b7 1805
ffd56f97 1806 last_event_timestamp = event->timestamp;
284f4730
JB
1807 interrupt_signal ();
1808 return;
1809 }
1810
1811 if (c && c == stop_character)
1812 {
1813 sys_suspend ();
1814 return;
1815 }
284f4730
JB
1816 }
1817
1818 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
1819 kbd_store_ptr = kbd_buffer;
1820
1821 /* Don't let the very last slot in the buffer become full,
1822 since that would make the two pointers equal,
1823 and that is indistinguishable from an empty buffer.
1824 Discard the event if it would fill the last slot. */
1825 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
1826 {
1827 kbd_store_ptr->kind = event->kind;
27203ead
RS
1828 if (event->kind == selection_request_event)
1829 {
1830 /* We must not use the ordinary copying code for this case,
1831 since `part' is an enum and copying it might not copy enough
1832 in this case. */
1833 bcopy (event, kbd_store_ptr, sizeof (*event));
1834 }
1835 else
1836 {
1837 kbd_store_ptr->code = event->code;
1838 kbd_store_ptr->part = event->part;
1839 kbd_store_ptr->frame_or_window = event->frame_or_window;
1840 kbd_store_ptr->modifiers = event->modifiers;
1841 kbd_store_ptr->x = event->x;
1842 kbd_store_ptr->y = event->y;
1843 kbd_store_ptr->timestamp = event->timestamp;
1844 }
7b4aedb9
JB
1845 (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_store_ptr
1846 - kbd_buffer]
1847 = event->frame_or_window);
284f4730
JB
1848
1849 kbd_store_ptr++;
1850 }
1851}
a612e298
RS
1852\f
1853/* Read one event from the event buffer, waiting if necessary.
1854 The value is a Lisp object representing the event.
1855 The value is nil for an event that should be ignored,
1856 or that was handled here.
1857 We always read and discard one event. */
284f4730
JB
1858
1859static Lisp_Object
1860kbd_buffer_get_event ()
1861{
1862 register int c;
1863 Lisp_Object obj;
1864
1865 if (noninteractive)
1866 {
1867 c = getchar ();
1868 XSET (obj, Lisp_Int, c);
1869 return obj;
1870 }
1871
1872 /* Wait until there is input available. */
1873 for (;;)
1874 {
284f4730
JB
1875 if (!EVENT_QUEUES_EMPTY)
1876 break;
1877
1878 /* If the quit flag is set, then read_char will return
1879 quit_char, so that counts as "available input." */
1880 if (!NILP (Vquit_flag))
1881 quit_throw_to_read_char ();
1882
1883 /* One way or another, wait until input is available; then, if
1884 interrupt handlers have not read it, read it now. */
1885
1886#ifdef OLDVMS
1887 wait_for_kbd_input ();
1888#else
1889/* Note SIGIO has been undef'd if FIONREAD is missing. */
1890#ifdef SIGIO
1891 gobble_input (0);
1892#endif /* SIGIO */
1893 if (EVENT_QUEUES_EMPTY)
1894 {
f76475ad
JB
1895 Lisp_Object minus_one;
1896
1897 XSET (minus_one, Lisp_Int, -1);
1898 wait_reading_process_input (0, 0, minus_one, 1);
284f4730
JB
1899
1900 if (!interrupt_input && EVENT_QUEUES_EMPTY)
1901 {
1902 read_avail_input (0);
1903 }
1904 }
1905#endif /* not VMS */
1906 }
1907
1908 /* At this point, we know that there is a readable event available
1909 somewhere. If the event queue is empty, then there must be a
1910 mouse movement enabled and available. */
1911 if (kbd_fetch_ptr != kbd_store_ptr)
1912 {
cd21b839 1913 struct input_event *event;
3e51c7b7 1914
856bf263 1915 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
cd21b839
JB
1916 ? kbd_fetch_ptr
1917 : kbd_buffer);
3e51c7b7 1918
cd21b839 1919 last_event_timestamp = event->timestamp;
cd21b839 1920
4bb994d1
JB
1921 obj = Qnil;
1922
48e416d4 1923 /* These two kinds of events get special handling
a612e298
RS
1924 and don't actually appear to the command loop.
1925 We return nil for them. */
48e416d4
RS
1926 if (event->kind == selection_request_event)
1927 {
598a9fa7 1928#ifdef HAVE_X11
48e416d4
RS
1929 x_handle_selection_request (event);
1930 kbd_fetch_ptr = event + 1;
598a9fa7
JB
1931#else
1932 /* We're getting selection request events, but we don't have
1933 a window system. */
1934 abort ();
1935#endif
48e416d4
RS
1936 }
1937
1e12dd87 1938 else if (event->kind == selection_clear_event)
48e416d4 1939 {
598a9fa7 1940#ifdef HAVE_X11
48e416d4
RS
1941 x_handle_selection_clear (event);
1942 kbd_fetch_ptr = event + 1;
598a9fa7
JB
1943#else
1944 /* We're getting selection request events, but we don't have
1945 a window system. */
1946 abort ();
1947#endif
48e416d4 1948 }
990acea3
RS
1949#ifdef HAVE_X11
1950 else if (event->kind == delete_window_event)
1951 {
58f6c8ab
RS
1952 Lisp_Object tail, frame;
1953 struct frame *f;
1954
1955 /* If the user destroys the only frame, Emacs should exit.
1956 Count visible frames and iconified frames. */
1957 for (tail = Vframe_list; CONSP (tail); tail = XCONS (tail)->cdr)
1958 {
1959 frame = XCONS (tail)->car;
1960 if (XTYPE (frame) != Lisp_Frame || EQ (frame, event->frame_or_window))
1961 continue;
1962 f = XFRAME (frame);
1963 if (FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f))
1964 break;
1965 }
990acea3 1966
58f6c8ab 1967 if (! CONSP (tail))
990acea3 1968 kill (getpid (), SIGHUP);
854f3a54
RS
1969
1970 Fdelete_frame (event->frame_or_window, Qt);
1971 kbd_fetch_ptr = event + 1;
990acea3
RS
1972 }
1973#endif
a612e298
RS
1974 /* Just discard these, by returning nil.
1975 (They shouldn't be found in the buffer,
1976 but on some machines it appears they do show up.) */
1977 else if (event->kind == no_event)
1978 kbd_fetch_ptr = event + 1;
48e416d4 1979
4bb994d1
JB
1980 /* If this event is on a different frame, return a switch-frame this
1981 time, and leave the event in the queue for next time. */
1e12dd87
RS
1982 else
1983 {
a6d53864 1984#ifdef MULTI_FRAME
1e12dd87
RS
1985 Lisp_Object frame = event->frame_or_window;
1986 Lisp_Object focus;
7b4aedb9 1987
1e12dd87
RS
1988 if (XTYPE (frame) == Lisp_Window)
1989 frame = WINDOW_FRAME (XWINDOW (frame));
4bb994d1 1990
1e12dd87
RS
1991 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
1992 if (! NILP (focus))
1993 frame = focus;
07d2b8de 1994
1e12dd87
RS
1995 if (! EQ (frame, internal_last_event_frame)
1996 && XFRAME (frame) != selected_frame)
1997 obj = make_lispy_switch_frame (frame);
1998 internal_last_event_frame = frame;
a6d53864 1999#endif /* MULTI_FRAME */
4bb994d1 2000
1e12dd87
RS
2001 /* If we didn't decide to make a switch-frame event, go ahead
2002 and build a real event from the queue entry. */
cd21b839 2003
1e12dd87
RS
2004 if (NILP (obj))
2005 {
2006 obj = make_lispy_event (event);
2007
2008 /* Wipe out this event, to catch bugs. */
2009 event->kind = no_event;
2010 (XVECTOR (kbd_buffer_frame_or_window)->contents[event - kbd_buffer]
2011 = Qnil);
2012
2013 kbd_fetch_ptr = event + 1;
2014 }
4bb994d1 2015 }
284f4730 2016 }
a612e298 2017 /* Try generating a mouse motion event. */
284f4730
JB
2018 else if (do_mouse_tracking && mouse_moved)
2019 {
7e85b935 2020 FRAME_PTR f = 0;
7b4aedb9 2021 Lisp_Object bar_window;
3c370943 2022 enum scroll_bar_part part;
e5d77022
JB
2023 Lisp_Object x, y;
2024 unsigned long time;
284f4730 2025
7b4aedb9 2026 (*mouse_position_hook) (&f, &bar_window, &part, &x, &y, &time);
4bb994d1
JB
2027
2028 obj = Qnil;
284f4730 2029
07d2b8de 2030#ifdef MULTI_FRAME
4bb994d1
JB
2031 /* Decide if we should generate a switch-frame event. Don't
2032 generate switch-frame events for motion outside of all Emacs
2033 frames. */
2034 if (f)
cd21b839 2035 {
4bb994d1
JB
2036 Lisp_Object frame = FRAME_FOCUS_FRAME (f);
2037
2038 if (NILP (frame))
2039 XSET (frame, Lisp_Frame, f);
2040
80645119
JB
2041 if (! EQ (frame, internal_last_event_frame)
2042 && XFRAME (frame) != selected_frame)
764cb3f9 2043 obj = make_lispy_switch_frame (frame);
80645119 2044 internal_last_event_frame = frame;
cd21b839 2045 }
07d2b8de 2046#endif
4bb994d1
JB
2047
2048 /* If we didn't decide to make a switch-frame event, go ahead and
2049 return a mouse-motion event. */
2050 if (NILP (obj))
7b4aedb9 2051 obj = make_lispy_movement (f, bar_window, part, x, y, time);
4bb994d1 2052 }
284f4730
JB
2053 else
2054 /* We were promised by the above while loop that there was
2055 something for us to read! */
2056 abort ();
2057
2058 input_pending = readable_events ();
2059
3c370943
JB
2060#ifdef MULTI_FRAME
2061 Vlast_event_frame = internal_last_event_frame;
2062#endif
2063
284f4730
JB
2064 return (obj);
2065}
a612e298
RS
2066\f
2067/* Process any events that are not user-visible,
2068 then return, without reading any user-visible events. */
3a3b9632
RS
2069
2070void
2071swallow_events ()
2072{
2073 while (kbd_fetch_ptr != kbd_store_ptr)
2074 {
2075 struct input_event *event;
2076
2077 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
2078 ? kbd_fetch_ptr
2079 : kbd_buffer);
2080
2081 last_event_timestamp = event->timestamp;
2082
2083 /* These two kinds of events get special handling
2084 and don't actually appear to the command loop. */
2085 if (event->kind == selection_request_event)
2086 {
2087#ifdef HAVE_X11
2088 x_handle_selection_request (event);
2089 kbd_fetch_ptr = event + 1;
2090#else
2091 /* We're getting selection request events, but we don't have
2092 a window system. */
2093 abort ();
2094#endif
2095 }
2096
2097 else if (event->kind == selection_clear_event)
2098 {
2099#ifdef HAVE_X11
2100 x_handle_selection_clear (event);
2101 kbd_fetch_ptr = event + 1;
2102#else
2103 /* We're getting selection request events, but we don't have
2104 a window system. */
2105 abort ();
2106#endif
2107 }
2108 else
2109 break;
2110 }
2111
2112 get_input_pending (&input_pending);
2113}
a612e298 2114\f
284f4730 2115/* Caches for modify_event_symbol. */
e9bf89a0 2116static Lisp_Object accent_key_syms;
284f4730
JB
2117static Lisp_Object func_key_syms;
2118static Lisp_Object mouse_syms;
2119
e9bf89a0
RS
2120/* This is a list of keysym codes for special "accent" characters.
2121 It parallels lispy_accent_keys. */
2122
2123static int lispy_accent_codes[] =
2124{
79a7046c 2125#ifdef XK_dead_circumflex
e9bf89a0 2126 XK_dead_circumflex,
79a7046c
RS
2127#else
2128 0,
2129#endif
2130#ifdef XK_dead_grave
e9bf89a0 2131 XK_dead_grave,
79a7046c
RS
2132#else
2133 0,
2134#endif
2135#ifdef XK_dead_tilde
e9bf89a0 2136 XK_dead_tilde,
79a7046c
RS
2137#else
2138 0,
2139#endif
2140#ifdef XK_dead_diaeresis
e9bf89a0 2141 XK_dead_diaeresis,
79a7046c
RS
2142#else
2143 0,
2144#endif
2145#ifdef XK_dead_macron
e9bf89a0 2146 XK_dead_macron,
79a7046c
RS
2147#else
2148 0,
2149#endif
2150#ifdef XK_dead_degree
e9bf89a0 2151 XK_dead_degree,
79a7046c
RS
2152#else
2153 0,
2154#endif
2155#ifdef XK_dead_acute
e9bf89a0 2156 XK_dead_acute,
79a7046c
RS
2157#else
2158 0,
2159#endif
2160#ifdef XK_dead_cedilla
e9bf89a0 2161 XK_dead_cedilla,
79a7046c
RS
2162#else
2163 0,
2164#endif
2165#ifdef XK_dead_breve
e9bf89a0 2166 XK_dead_breve,
79a7046c
RS
2167#else
2168 0,
2169#endif
2170#ifdef XK_dead_ogonek
e9bf89a0 2171 XK_dead_ogonek,
79a7046c
RS
2172#else
2173 0,
2174#endif
2175#ifdef XK_dead_caron
e9bf89a0 2176 XK_dead_caron,
79a7046c
RS
2177#else
2178 0,
2179#endif
2180#ifdef XK_dead_doubleacute
e9bf89a0 2181 XK_dead_doubleacute,
79a7046c
RS
2182#else
2183 0,
2184#endif
2185#ifdef XK_dead_abovedot
e9bf89a0 2186 XK_dead_abovedot,
79a7046c
RS
2187#else
2188 0,
2189#endif
e9bf89a0
RS
2190};
2191
2192/* This is a list of Lisp names for special "accent" characters.
2193 It parallels lispy_accent_codes. */
2194
2195static char *lispy_accent_keys[] =
2196{
2197 "dead-circumflex",
2198 "dead-grave",
2199 "dead-tilde",
2200 "dead-diaeresis",
2201 "dead-macron",
2202 "dead-degree",
2203 "dead-acute",
2204 "dead-cedilla",
2205 "dead-breve",
2206 "dead-ogonek",
2207 "dead-caron",
2208 "dead-doubleacute",
2209 "dead-abovedot",
2210};
2211
284f4730
JB
2212/* You'll notice that this table is arranged to be conveniently
2213 indexed by X Windows keysym values. */
2214static char *lispy_function_keys[] =
2215 {
2216 /* X Keysym value */
2217
a6d53864 2218 "remove", 0, 0, 0, 0, 0, 0, 0, /* 0xff00 */
86e5706b
RS
2219 "backspace",
2220 "tab",
2221 "linefeed",
2222 "clear",
2223 0,
2224 "return",
2225 0, 0,
2226 0, 0, 0, /* 0xff10 */
2227 "pause",
2228 0, 0, 0, 0, 0, 0, 0,
2229 "escape",
2230 0, 0, 0, 0,
2231 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff20...2f */
2232 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff30...3f */
2233 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
2234
284f4730
JB
2235 "home", /* 0xff50 */ /* IsCursorKey */
2236 "left",
2237 "up",
2238 "right",
2239 "down",
2240 "prior",
2241 "next",
2242 "end",
2243 "begin",
2244 0, /* 0xff59 */
2245 0, 0, 0, 0, 0, 0,
2246 "select", /* 0xff60 */ /* IsMiscFunctionKey */
2247 "print",
2248 "execute",
2249 "insert",
2250 0, /* 0xff64 */
2251 "undo",
2252 "redo",
2253 "menu",
2254 "find",
2255 "cancel",
2256 "help",
2257 "break", /* 0xff6b */
2258
2259 /* Here are some keys found mostly on HP keyboards. The X event
2260 handling code will strip bit 29, which flags vendor-specific
2261 keysyms. */
2262 "reset", /* 0x1000ff6c */
2263 "system",
2264 "user",
2265 "clearline",
2266 "insertline",
2267 "deleteline",
2268 "insertchar",
2269 "deletechar",
2270 "backtab",
36ae397e 2271 "kp-backtab", /* 0x1000ff75 */
284f4730 2272 0, /* 0xff76 */
36ae397e 2273 0, 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff7f */
284f4730
JB
2274 "kp-space", /* 0xff80 */ /* IsKeypadKey */
2275 0, 0, 0, 0, 0, 0, 0, 0,
2276 "kp-tab", /* 0xff89 */
2277 0, 0, 0,
2278 "kp-enter", /* 0xff8d */
2279 0, 0, 0,
2280 "kp-f1", /* 0xff91 */
2281 "kp-f2",
2282 "kp-f3",
2283 "kp-f4",
2284 0, /* 0xff95 */
2285 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
2286 "kp-multiply", /* 0xffaa */
2287 "kp-add",
2288 "kp-separator",
2289 "kp-subtract",
2290 "kp-decimal",
2291 "kp-divide", /* 0xffaf */
2292 "kp-0", /* 0xffb0 */
2293 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
2294 0, /* 0xffba */
2295 0, 0,
2296 "kp-equal", /* 0xffbd */
2297 "f1", /* 0xffbe */ /* IsFunctionKey */
86e5706b
RS
2298 "f2",
2299 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
2300 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
2301 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
2302 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
2303 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
2304 0, 0, 0, 0, 0, 0, 0, 0,
2305 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
2306 0, 0, 0, 0, 0, 0, 0, "delete"
284f4730
JB
2307 };
2308
2309static char *lispy_mouse_names[] =
2310{
2311 "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5"
2312};
2313
3c370943 2314/* Scroll bar parts. */
4bb994d1
JB
2315Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
2316
3c370943
JB
2317/* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
2318Lisp_Object *scroll_bar_parts[] = {
4bb994d1
JB
2319 &Qabove_handle, &Qhandle, &Qbelow_handle
2320};
2321
2322
7b4aedb9 2323/* A vector, indexed by button number, giving the down-going location
3c370943 2324 of currently depressed buttons, both scroll bar and non-scroll bar.
7b4aedb9
JB
2325
2326 The elements have the form
2327 (BUTTON-NUMBER MODIFIER-MASK . REST)
2328 where REST is the cdr of a position as it would be reported in the event.
2329
2330 The make_lispy_event function stores positions here to tell the
2331 difference between click and drag events, and to store the starting
2332 location to be included in drag events. */
2333
2334static Lisp_Object button_down_location;
88cb0656 2335
fbcd35bd
JB
2336/* Information about the most recent up-going button event: Which
2337 button, what location, and what time. */
2338
559f9d04
RS
2339static int last_mouse_button;
2340static int last_mouse_x;
2341static int last_mouse_y;
2342static unsigned long button_down_time;
fbcd35bd 2343
564dc952
JB
2344/* The maximum time between clicks to make a double-click,
2345 or Qnil to disable double-click detection,
2346 or Qt for no time limit. */
2347Lisp_Object Vdouble_click_time;
fbcd35bd
JB
2348
2349/* The number of clicks in this multiple-click. */
2350
2351int double_click_count;
2352
284f4730
JB
2353/* Given a struct input_event, build the lisp event which represents
2354 it. If EVENT is 0, build a mouse movement event from the mouse
88cb0656
JB
2355 movement buffer, which should have a movement event in it.
2356
2357 Note that events must be passed to this function in the order they
2358 are received; this function stores the location of button presses
2359 in order to build drag events when the button is released. */
284f4730
JB
2360
2361static Lisp_Object
2362make_lispy_event (event)
2363 struct input_event *event;
2364{
79a7046c
RS
2365 int i;
2366
284f4730
JB
2367#ifdef SWITCH_ENUM_BUG
2368 switch ((int) event->kind)
2369#else
2370 switch (event->kind)
2371#endif
2372 {
284f4730
JB
2373 /* A simple keystroke. */
2374 case ascii_keystroke:
86e5706b 2375 {
e9bf89a0 2376 int c = event->code & 0377;
5a1c6df8
JB
2377 /* Turn ASCII characters into control characters
2378 when proper. */
2379 if (event->modifiers & ctrl_modifier)
d205953b
JB
2380 c = make_ctrl_char (c);
2381
2382 /* Add in the other modifier bits. We took care of ctrl_modifier
2383 just above, and the shift key was taken care of by the X code,
2384 and applied to control characters by make_ctrl_char. */
86e5706b
RS
2385 c |= (event->modifiers
2386 & (meta_modifier | alt_modifier
2387 | hyper_modifier | super_modifier));
559f9d04 2388 button_down_time = 0;
86e5706b
RS
2389 return c;
2390 }
284f4730
JB
2391
2392 /* A function key. The symbol may need to have modifier prefixes
2393 tacked onto it. */
2394 case non_ascii_keystroke:
559f9d04 2395 button_down_time = 0;
e9bf89a0
RS
2396
2397 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
2398 if (event->code == lispy_accent_codes[i])
2399 return modify_event_symbol (i,
2400 event->modifiers,
2401 Qfunction_key,
2402 lispy_accent_keys, &accent_key_syms,
2403 (sizeof (lispy_accent_keys)
2404 / sizeof (lispy_accent_keys[0])));
2405
2406 return modify_event_symbol (event->code - 0xff00,
2407 event->modifiers,
284f4730
JB
2408 Qfunction_key,
2409 lispy_function_keys, &func_key_syms,
2410 (sizeof (lispy_function_keys)
2411 / sizeof (lispy_function_keys[0])));
2412 break;
2413
88cb0656
JB
2414 /* A mouse click. Figure out where it is, decide whether it's
2415 a press, click or drag, and build the appropriate structure. */
284f4730 2416 case mouse_click:
3c370943 2417 case scroll_bar_click:
284f4730 2418 {
e9bf89a0 2419 int button = event->code;
559f9d04 2420 int is_double;
7b4aedb9 2421 Lisp_Object position;
dbc4e1c1
JB
2422 Lisp_Object *start_pos_ptr;
2423 Lisp_Object start_pos;
284f4730 2424
7b4aedb9 2425 if (button < 0 || button >= NUM_MOUSE_BUTTONS)
88cb0656
JB
2426 abort ();
2427
7b4aedb9
JB
2428 /* Build the position as appropriate for this mouse click. */
2429 if (event->kind == mouse_click)
284f4730 2430 {
7b4aedb9 2431 int part;
598a9fa7 2432 FRAME_PTR f = XFRAME (event->frame_or_window);
5ec75a55
RS
2433 Lisp_Object window
2434 = window_from_coordinates (f, XINT (event->x), XINT (event->y),
2435 &part);
7b4aedb9
JB
2436 Lisp_Object posn;
2437
5ec75a55
RS
2438 if (XINT (event->y) < FRAME_MENU_BAR_LINES (f))
2439 {
2440 int hpos;
2441 Lisp_Object items;
2442 items = FRAME_MENU_BAR_ITEMS (f);
2443 for (; CONSP (items); items = XCONS (items)->cdr)
2444 {
2445 Lisp_Object pos, string;
2446 pos = Fcdr (Fcdr (Fcar (items)));
2447 string = Fcar (Fcdr (Fcar (items)));
0a9b0670
RS
2448 if (XINT (event->x) >= XINT (pos)
2449 && XINT (event->x) < XINT (pos) + XSTRING (string)->size)
5ec75a55
RS
2450 break;
2451 }
2452 position
2453 = Fcons (event->frame_or_window,
2454 Fcons (Qmenu_bar,
2455 Fcons (Fcons (event->x, event->y),
2456 Fcons (make_number (event->timestamp),
2457 Qnil))));
2458
2459 if (CONSP (items))
2460 return Fcons (Fcar (Fcar (items)),
2461 Fcons (position, Qnil));
2462 else
2463 return Fcons (Qnil, Fcons (position, Qnil));
2464 }
2465 else if (XTYPE (window) != Lisp_Window)
7b4aedb9 2466 posn = Qnil;
284f4730 2467 else
7b4aedb9 2468 {
dbc4e1c1
JB
2469 XSETINT (event->x,
2470 (XINT (event->x) - XINT (XWINDOW (window)->left)));
2471 XSETINT (event->y,
2472 (XINT (event->y) - XINT (XWINDOW (window)->top)));
2473
7b4aedb9
JB
2474 if (part == 1)
2475 posn = Qmode_line;
2476 else if (part == 2)
2477 posn = Qvertical_line;
2478 else
dbc4e1c1
JB
2479 XSET (posn, Lisp_Int,
2480 buffer_posn_from_coords (XWINDOW (window),
2481 XINT (event->x),
2482 XINT (event->y)));
7b4aedb9
JB
2483 }
2484
5ec75a55
RS
2485 position
2486 = Fcons (window,
2487 Fcons (posn,
2488 Fcons (Fcons (event->x, event->y),
2489 Fcons (make_number (event->timestamp),
2490 Qnil))));
284f4730 2491 }
7b4aedb9 2492 else
88cb0656 2493 {
7b4aedb9
JB
2494 Lisp_Object window = event->frame_or_window;
2495 Lisp_Object portion_whole = Fcons (event->x, event->y);
3c370943 2496 Lisp_Object part = *scroll_bar_parts[(int) event->part];
7b4aedb9
JB
2497
2498 position =
2499 Fcons (window,
3c370943 2500 Fcons (Qvertical_scroll_bar,
7b4aedb9
JB
2501 Fcons (portion_whole,
2502 Fcons (make_number (event->timestamp),
2503 Fcons (part,
2504 Qnil)))));
88cb0656
JB
2505 }
2506
dbc4e1c1
JB
2507 start_pos_ptr = &XVECTOR (button_down_location)->contents[button];
2508
2509 start_pos = *start_pos_ptr;
2510 *start_pos_ptr = Qnil;
7b4aedb9 2511
559f9d04
RS
2512 is_double = (button == last_mouse_button
2513 && XINT (event->x) == last_mouse_x
2514 && XINT (event->y) == last_mouse_y
2515 && button_down_time != 0
2516 && (EQ (Vdouble_click_time, Qt)
2517 || (INTEGERP (Vdouble_click_time)
2518 && ((int)(event->timestamp - button_down_time)
2519 < XINT (Vdouble_click_time)))));
2520 last_mouse_button = button;
2521 last_mouse_x = XINT (event->x);
2522 last_mouse_y = XINT (event->y);
2523
7b4aedb9
JB
2524 /* If this is a button press, squirrel away the location, so
2525 we can decide later whether it was a click or a drag. */
2526 if (event->modifiers & down_modifier)
559f9d04
RS
2527 {
2528 if (is_double)
2529 {
2530 double_click_count++;
2531 event->modifiers |= ((double_click_count > 2)
2532 ? triple_modifier
2533 : double_modifier);
2534 }
2535 else
2536 double_click_count = 1;
2537 button_down_time = event->timestamp;
2538 *start_pos_ptr = Fcopy_alist (position);
2539 }
7b4aedb9 2540
88cb0656 2541 /* Now we're releasing a button - check the co-ordinates to
7b4aedb9 2542 see if this was a click or a drag. */
88cb0656
JB
2543 else if (event->modifiers & up_modifier)
2544 {
48e416d4
RS
2545 /* If we did not see a down before this up,
2546 ignore the up. Probably this happened because
2547 the down event chose a menu item.
2548 It would be an annoyance to treat the release
2549 of the button that chose the menu item
2550 as a separate event. */
2551
2552 if (XTYPE (start_pos) != Lisp_Cons)
2553 return Qnil;
2554
88cb0656 2555 event->modifiers &= ~up_modifier;
48e416d4 2556#if 0 /* Formerly we treated an up with no down as a click event. */
dbc4e1c1
JB
2557 if (XTYPE (start_pos) != Lisp_Cons)
2558 event->modifiers |= click_modifier;
2559 else
48e416d4 2560#endif
dbc4e1c1
JB
2561 {
2562 /* The third element of every position should be the (x,y)
2563 pair. */
2564 Lisp_Object down = Fnth (make_number (2), start_pos);
2565
fbcd35bd
JB
2566 if (EQ (event->x, XCONS (down)->car)
2567 && EQ (event->y, XCONS (down)->cdr))
2568 {
559f9d04
RS
2569 if (is_double && double_click_count > 1)
2570 event->modifiers |= ((double_click_count > 2)
2571 ? triple_modifier
2572 : double_modifier);
fbcd35bd 2573 else
559f9d04 2574 event->modifiers |= click_modifier;
fbcd35bd
JB
2575 }
2576 else
2577 {
559f9d04 2578 button_down_time = 0;
fbcd35bd
JB
2579 event->modifiers |= drag_modifier;
2580 }
dbc4e1c1 2581 }
88cb0656
JB
2582 }
2583 else
2584 /* Every mouse event should either have the down_modifier or
7b4aedb9 2585 the up_modifier set. */
88cb0656
JB
2586 abort ();
2587
88cb0656 2588 {
7b4aedb9 2589 /* Get the symbol we should use for the mouse click. */
5ec75a55
RS
2590 Lisp_Object head
2591 = modify_event_symbol (button,
2592 event->modifiers,
2593 Qmouse_click,
2594 lispy_mouse_names, &mouse_syms,
2595 (sizeof (lispy_mouse_names)
2596 / sizeof (lispy_mouse_names[0])));
7b4aedb9 2597
88cb0656 2598 if (event->modifiers & drag_modifier)
dbc4e1c1
JB
2599 return Fcons (head,
2600 Fcons (start_pos,
2601 Fcons (position,
2602 Qnil)));
fbcd35bd
JB
2603 else if (event->modifiers & (double_modifier | triple_modifier))
2604 return Fcons (head,
2605 Fcons (position,
2606 Fcons (make_number (double_click_count),
2607 Qnil)));
88cb0656
JB
2608 else
2609 return Fcons (head,
7b4aedb9 2610 Fcons (position,
88cb0656
JB
2611 Qnil));
2612 }
284f4730
JB
2613 }
2614
284f4730
JB
2615 /* The 'kind' field of the event is something we don't recognize. */
2616 default:
48e416d4 2617 abort ();
284f4730
JB
2618 }
2619}
2620
2621static Lisp_Object
7b4aedb9 2622make_lispy_movement (frame, bar_window, part, x, y, time)
ff11dfa1 2623 FRAME_PTR frame;
7b4aedb9 2624 Lisp_Object bar_window;
3c370943 2625 enum scroll_bar_part part;
284f4730 2626 Lisp_Object x, y;
e5d77022 2627 unsigned long time;
284f4730 2628{
3c370943 2629 /* Is it a scroll bar movement? */
7b4aedb9 2630 if (frame && ! NILP (bar_window))
4bb994d1 2631 {
3c370943 2632 Lisp_Object part_sym = *scroll_bar_parts[(int) part];
4bb994d1 2633
3c370943 2634 return Fcons (Qscroll_bar_movement,
7b4aedb9 2635 (Fcons (Fcons (bar_window,
3c370943 2636 Fcons (Qvertical_scroll_bar,
4bb994d1
JB
2637 Fcons (Fcons (x, y),
2638 Fcons (make_number (time),
cb5df6ae 2639 Fcons (part_sym,
4bb994d1
JB
2640 Qnil))))),
2641 Qnil)));
2642 }
2643
2644 /* Or is it an ordinary mouse movement? */
284f4730
JB
2645 else
2646 {
4bb994d1
JB
2647 int area;
2648 Lisp_Object window =
2649 (frame
2650 ? window_from_coordinates (frame, XINT (x), XINT (y), &area)
2651 : Qnil);
2652 Lisp_Object posn;
2653
2654 if (XTYPE (window) == Lisp_Window)
2655 {
2656 XSETINT (x, XINT (x) - XINT (XWINDOW (window)->left));
2657 XSETINT (y, XINT (y) - XINT (XWINDOW (window)->top));
2658
2659 if (area == 1)
2660 posn = Qmode_line;
2661 else if (area == 2)
2662 posn = Qvertical_line;
2663 else
2664 XSET (posn, Lisp_Int,
2665 buffer_posn_from_coords (XWINDOW (window),
2666 XINT (x), XINT (y)));
2667 }
e9bf89a0
RS
2668 else if (frame != 0)
2669 {
2670 XSET (window, Lisp_Frame, frame);
2671 posn = Qnil;
2672 }
284f4730 2673 else
4bb994d1
JB
2674 {
2675 window = Qnil;
2676 posn = Qnil;
f76b81d6
JB
2677 XFASTINT (x) = 0;
2678 XFASTINT (y) = 0;
4bb994d1 2679 }
284f4730 2680
4bb994d1
JB
2681 return Fcons (Qmouse_movement,
2682 Fcons (Fcons (window,
2683 Fcons (posn,
2684 Fcons (Fcons (x, y),
2685 Fcons (make_number (time),
2686 Qnil)))),
2687 Qnil));
2688 }
284f4730
JB
2689}
2690
cd21b839
JB
2691/* Construct a switch frame event. */
2692static Lisp_Object
2693make_lispy_switch_frame (frame)
2694 Lisp_Object frame;
2695{
2696 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
2697}
0a7f1fc0
JB
2698\f
2699/* Manipulating modifiers. */
284f4730 2700
0a7f1fc0 2701/* Parse the name of SYMBOL, and return the set of modifiers it contains.
284f4730 2702
0a7f1fc0
JB
2703 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
2704 SYMBOL's name of the end of the modifiers; the string from this
2705 position is the unmodified symbol name.
284f4730 2706
0a7f1fc0
JB
2707 This doesn't use any caches. */
2708static int
2709parse_modifiers_uncached (symbol, modifier_end)
284f4730 2710 Lisp_Object symbol;
0a7f1fc0 2711 int *modifier_end;
284f4730
JB
2712{
2713 struct Lisp_String *name;
2714 int i;
2715 int modifiers;
284f4730
JB
2716
2717 CHECK_SYMBOL (symbol, 1);
2718
2719 modifiers = 0;
2720 name = XSYMBOL (symbol)->name;
2721
284f4730 2722
0a7f1fc0 2723 for (i = 0; i+2 <= name->size; )
284f4730
JB
2724 switch (name->data[i])
2725 {
0a7f1fc0
JB
2726#define SINGLE_LETTER_MOD(bit) \
2727 if (name->data[i+1] != '-') \
2728 goto no_more_modifiers; \
2729 modifiers |= bit; \
fce33686 2730 i += 2;
0a7f1fc0
JB
2731
2732 case 'A':
2733 SINGLE_LETTER_MOD (alt_modifier);
284f4730
JB
2734 break;
2735
2736 case 'C':
0a7f1fc0 2737 SINGLE_LETTER_MOD (ctrl_modifier);
fce33686
JB
2738 break;
2739
2740 case 'H':
0a7f1fc0 2741 SINGLE_LETTER_MOD (hyper_modifier);
fce33686
JB
2742 break;
2743
2744 case 'M':
0a7f1fc0 2745 SINGLE_LETTER_MOD (meta_modifier);
284f4730
JB
2746 break;
2747
2748 case 'S':
0a7f1fc0 2749 SINGLE_LETTER_MOD (shift_modifier);
fce33686
JB
2750 break;
2751
2752 case 's':
86e5706b 2753 SINGLE_LETTER_MOD (super_modifier);
284f4730
JB
2754 break;
2755
fce33686
JB
2756 case 'd':
2757 if (i + 5 > name->size)
2758 goto no_more_modifiers;
2759 if (! strncmp (name->data + i, "drag-", 5))
2760 {
fce33686
JB
2761 modifiers |= drag_modifier;
2762 i += 5;
2763 }
2764 else if (! strncmp (name->data + i, "down-", 5))
2765 {
fce33686
JB
2766 modifiers |= down_modifier;
2767 i += 5;
2768 }
fbcd35bd
JB
2769 else if (i + 7 <= name->size
2770 && ! strncmp (name->data + i, "double-", 7))
2771 {
2772 modifiers |= double_modifier;
2773 i += 7;
2774 }
2775 else
2776 goto no_more_modifiers;
2777 break;
2778
2779 case 't':
2780 if (i + 7 > name->size)
2781 goto no_more_modifiers;
2782 if (! strncmp (name->data + i, "triple-", 7))
2783 {
2784 modifiers |= triple_modifier;
2785 i += 7;
2786 }
fce33686
JB
2787 else
2788 goto no_more_modifiers;
284f4730
JB
2789 break;
2790
2791 default:
2792 goto no_more_modifiers;
0a7f1fc0
JB
2793
2794#undef SINGLE_LETTER_MOD
284f4730
JB
2795 }
2796 no_more_modifiers:
2797
0a7f1fc0 2798 /* Should we include the `click' modifier? */
fbcd35bd
JB
2799 if (! (modifiers & (down_modifier | drag_modifier
2800 | double_modifier | triple_modifier))
0a7f1fc0 2801 && i + 7 == name->size
4bb994d1 2802 && strncmp (name->data + i, "mouse-", 6) == 0
6569cc8d 2803 && ('0' <= name->data[i + 6] && name->data[i + 6] <= '9'))
0a7f1fc0
JB
2804 modifiers |= click_modifier;
2805
2806 if (modifier_end)
2807 *modifier_end = i;
2808
2809 return modifiers;
2810}
2811
2812
2813/* Return a symbol whose name is the modifier prefixes for MODIFIERS
2814 prepended to the string BASE[0..BASE_LEN-1].
2815 This doesn't use any caches. */
2816static Lisp_Object
2817apply_modifiers_uncached (modifiers, base, base_len)
2818 int modifiers;
2819 char *base;
2820 int base_len;
2821{
2822 /* Since BASE could contain nulls, we can't use intern here; we have
2823 to use Fintern, which expects a genuine Lisp_String, and keeps a
2824 reference to it. */
2825 char *new_mods =
fbcd35bd 2826 (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
0a7f1fc0 2827 int mod_len;
284f4730 2828
284f4730 2829 {
0a7f1fc0
JB
2830 char *p = new_mods;
2831
2832 /* Only the event queue may use the `up' modifier; it should always
2833 be turned into a click or drag event before presented to lisp code. */
2834 if (modifiers & up_modifier)
2835 abort ();
2836
2837 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
2838 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
2839 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
2840 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
2841 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
86e5706b 2842 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
fbcd35bd
JB
2843 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
2844 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
559f9d04
RS
2845 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
2846 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
0a7f1fc0
JB
2847 /* The click modifier is denoted by the absence of other modifiers. */
2848
2849 *p = '\0';
2850
2851 mod_len = p - new_mods;
2852 }
284f4730 2853
0a7f1fc0
JB
2854 {
2855 Lisp_Object new_name = make_uninit_string (mod_len + base_len);
2856
2857 bcopy (new_mods, XSTRING (new_name)->data, mod_len);
2858 bcopy (base, XSTRING (new_name)->data + mod_len, base_len);
284f4730
JB
2859
2860 return Fintern (new_name, Qnil);
2861 }
2862}
2863
2864
0a7f1fc0
JB
2865static char *modifier_names[] =
2866{
fbcd35bd 2867 "up", "down", "drag", "click", "double", "triple", 0, 0,
1dfdf9e2 2868 0, 0, 0, 0, 0, 0, 0, 0,
86e5706b 2869 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
0a7f1fc0 2870};
80645119 2871#define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
0a7f1fc0
JB
2872
2873static Lisp_Object modifier_symbols;
2874
2875/* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
2876static Lisp_Object
2877lispy_modifier_list (modifiers)
2878 int modifiers;
2879{
2880 Lisp_Object modifier_list;
2881 int i;
2882
2883 modifier_list = Qnil;
80645119 2884 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
0a7f1fc0 2885 if (modifiers & (1<<i))
80645119
JB
2886 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
2887 modifier_list);
0a7f1fc0
JB
2888
2889 return modifier_list;
2890}
2891
2892
2893/* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
2894 where UNMODIFIED is the unmodified form of SYMBOL,
2895 MASK is the set of modifiers present in SYMBOL's name.
2896 This is similar to parse_modifiers_uncached, but uses the cache in
2897 SYMBOL's Qevent_symbol_element_mask property, and maintains the
2898 Qevent_symbol_elements property. */
2899static Lisp_Object
2900parse_modifiers (symbol)
2901 Lisp_Object symbol;
2902{
2903 Lisp_Object elements = Fget (symbol, Qevent_symbol_element_mask);
2904
2905 if (CONSP (elements))
2906 return elements;
2907 else
2908 {
2909 int end;
2910 int modifiers = parse_modifiers_uncached (symbol, &end);
2911 Lisp_Object unmodified
2912 = Fintern (make_string (XSYMBOL (symbol)->name->data + end,
2913 XSYMBOL (symbol)->name->size - end),
2914 Qnil);
2915 Lisp_Object mask;
2916
734fef94
JB
2917 if (modifiers & ~((1<<VALBITS) - 1))
2918 abort ();
0a7f1fc0
JB
2919 XFASTINT (mask) = modifiers;
2920 elements = Fcons (unmodified, Fcons (mask, Qnil));
2921
2922 /* Cache the parsing results on SYMBOL. */
2923 Fput (symbol, Qevent_symbol_element_mask,
2924 elements);
2925 Fput (symbol, Qevent_symbol_elements,
2926 Fcons (unmodified, lispy_modifier_list (modifiers)));
2927
2928 /* Since we know that SYMBOL is modifiers applied to unmodified,
2929 it would be nice to put that in unmodified's cache.
2930 But we can't, since we're not sure that parse_modifiers is
2931 canonical. */
2932
2933 return elements;
2934 }
2935}
2936
2937/* Apply the modifiers MODIFIERS to the symbol BASE.
2938 BASE must be unmodified.
2939
2940 This is like apply_modifiers_uncached, but uses BASE's
2941 Qmodifier_cache property, if present. It also builds
cd21b839
JB
2942 Qevent_symbol_elements properties, since it has that info anyway.
2943
2944 apply_modifiers copies the value of BASE's Qevent_kind property to
2945 the modified symbol. */
0a7f1fc0
JB
2946static Lisp_Object
2947apply_modifiers (modifiers, base)
2948 int modifiers;
2949 Lisp_Object base;
2950{
7b4aedb9 2951 Lisp_Object cache, index, entry, new_symbol;
0a7f1fc0 2952
80645119
JB
2953 /* Mask out upper bits. We don't know where this value's been. */
2954 modifiers &= (1<<VALBITS) - 1;
2955
0a7f1fc0 2956 /* The click modifier never figures into cache indices. */
0a7f1fc0 2957 cache = Fget (base, Qmodifier_cache);
cd21b839 2958 XFASTINT (index) = (modifiers & ~click_modifier);
0a7f1fc0
JB
2959 entry = Fassq (index, cache);
2960
2961 if (CONSP (entry))
7b4aedb9
JB
2962 new_symbol = XCONS (entry)->cdr;
2963 else
2964 {
2965 /* We have to create the symbol ourselves. */
2966 new_symbol = apply_modifiers_uncached (modifiers,
2967 XSYMBOL (base)->name->data,
2968 XSYMBOL (base)->name->size);
2969
2970 /* Add the new symbol to the base's cache. */
2971 entry = Fcons (index, new_symbol);
2972 Fput (base, Qmodifier_cache, Fcons (entry, cache));
2973
2974 /* We have the parsing info now for free, so add it to the caches. */
2975 XFASTINT (index) = modifiers;
2976 Fput (new_symbol, Qevent_symbol_element_mask,
2977 Fcons (base, Fcons (index, Qnil)));
2978 Fput (new_symbol, Qevent_symbol_elements,
2979 Fcons (base, lispy_modifier_list (modifiers)));
2980 }
0a7f1fc0 2981
7b4aedb9
JB
2982 /* Make sure this symbol is of the same kind as BASE.
2983
2984 You'd think we could just set this once and for all when we
2985 intern the symbol above, but reorder_modifiers may call us when
2986 BASE's property isn't set right; we can't assume that just
80645119
JB
2987 because it has a Qmodifier_cache property it must have its
2988 Qevent_kind set right as well. */
7b4aedb9
JB
2989 if (NILP (Fget (new_symbol, Qevent_kind)))
2990 {
2991 Lisp_Object kind = Fget (base, Qevent_kind);
2992
2993 if (! NILP (kind))
2994 Fput (new_symbol, Qevent_kind, kind);
2995 }
2996
2997 return new_symbol;
0a7f1fc0
JB
2998}
2999
3000
3001/* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
3002 return a symbol with the modifiers placed in the canonical order.
3003 Canonical order is alphabetical, except for down and drag, which
3004 always come last. The 'click' modifier is never written out.
3005
3006 Fdefine_key calls this to make sure that (for example) C-M-foo
3007 and M-C-foo end up being equivalent in the keymap. */
3008
3009Lisp_Object
3010reorder_modifiers (symbol)
3011 Lisp_Object symbol;
3012{
3013 /* It's hopefully okay to write the code this way, since everything
3014 will soon be in caches, and no consing will be done at all. */
3015 Lisp_Object parsed = parse_modifiers (symbol);
3016
3017 return apply_modifiers (XCONS (XCONS (parsed)->cdr)->car,
3018 XCONS (parsed)->car);
3019}
3020
3021
284f4730
JB
3022/* For handling events, we often want to produce a symbol whose name
3023 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
3024 to some base, like the name of a function key or mouse button.
3025 modify_event_symbol produces symbols of this sort.
3026
3027 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
3028 is the name of the i'th symbol. TABLE_SIZE is the number of elements
3029 in the table.
3030
3031 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
3032 persist between calls to modify_event_symbol that it can use to
3033 store a cache of the symbols it's generated for this NAME_TABLE
3034 before.
3035
3036 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
3037
3038 MODIFIERS is a set of modifier bits (as given in struct input_events)
3039 whose prefixes should be applied to the symbol name.
3040
3041 SYMBOL_KIND is the value to be placed in the event_kind property of
88cb0656
JB
3042 the returned symbol.
3043
3044 The symbols we create are supposed to have an
eb8c3be9 3045 `event-symbol-elements' property, which lists the modifiers present
88cb0656
JB
3046 in the symbol's name. */
3047
284f4730
JB
3048static Lisp_Object
3049modify_event_symbol (symbol_num, modifiers, symbol_kind, name_table,
3050 symbol_table, table_size)
3051 int symbol_num;
3052 unsigned modifiers;
3053 Lisp_Object symbol_kind;
3054 char **name_table;
3055 Lisp_Object *symbol_table;
3056 int table_size;
3057{
88cb0656 3058 Lisp_Object *slot;
284f4730
JB
3059
3060 /* Is this a request for a valid symbol? */
88cb0656 3061 if (symbol_num < 0 || symbol_num >= table_size)
284f4730
JB
3062 abort ();
3063
0a7f1fc0 3064 /* If *symbol_table doesn't seem to be initialized properly, fix that.
88cb0656 3065 *symbol_table should be a lisp vector TABLE_SIZE elements long,
4bb994d1
JB
3066 where the Nth element is the symbol for NAME_TABLE[N], or nil if
3067 we've never used that symbol before. */
284f4730
JB
3068 if (XTYPE (*symbol_table) != Lisp_Vector
3069 || XVECTOR (*symbol_table)->size != table_size)
88cb0656 3070 {
0a7f1fc0
JB
3071 Lisp_Object size;
3072
3073 XFASTINT (size) = table_size;
3074 *symbol_table = Fmake_vector (size, Qnil);
88cb0656 3075 }
284f4730 3076
88cb0656 3077 slot = & XVECTOR (*symbol_table)->contents[symbol_num];
284f4730 3078
0a7f1fc0
JB
3079 /* Have we already used this symbol before? */
3080 if (NILP (*slot))
284f4730 3081 {
0a7f1fc0 3082 /* No; let's create it. */
d1f50460
RS
3083 if (name_table[symbol_num])
3084 *slot = intern (name_table[symbol_num]);
3085 else
3086 {
3087 char buf[20];
3088 sprintf (buf, "key-%d", symbol_num);
3089 *slot = intern (buf);
3090 }
0a7f1fc0
JB
3091
3092 /* Fill in the cache entries for this symbol; this also
3093 builds the Qevent_symbol_elements property, which the user
3094 cares about. */
6569cc8d 3095 apply_modifiers (modifiers & click_modifier, *slot);
0a7f1fc0 3096 Fput (*slot, Qevent_kind, symbol_kind);
284f4730 3097 }
88cb0656 3098
0a7f1fc0
JB
3099 /* Apply modifiers to that symbol. */
3100 return apply_modifiers (modifiers, *slot);
284f4730 3101}
0a7f1fc0 3102
284f4730 3103\f
284f4730
JB
3104/* Store into *addr a value nonzero if terminal input chars are available.
3105 Serves the purpose of ioctl (0, FIONREAD, addr)
3106 but works even if FIONREAD does not exist.
3107 (In fact, this may actually read some input.) */
3108
3109static void
3110get_input_pending (addr)
3111 int *addr;
3112{
3113 /* First of all, have we already counted some input? */
3114 *addr = !NILP (Vquit_flag) || readable_events ();
3115
3116 /* If input is being read as it arrives, and we have none, there is none. */
3117 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
3118 return;
3119
3120 /* Try to read some input and see how much we get. */
3121 gobble_input (0);
3122 *addr = !NILP (Vquit_flag) || readable_events ();
3123}
3124
3125/* Interface to read_avail_input, blocking SIGIO if necessary. */
3126
3127int
3128gobble_input (expected)
3129 int expected;
3130{
3131#ifndef VMS
3132#ifdef SIGIO
3133 if (interrupt_input)
3134 {
32676c08 3135 SIGMASKTYPE mask;
e065a56e 3136 mask = sigblockx (SIGIO);
284f4730 3137 read_avail_input (expected);
e065a56e 3138 sigsetmask (mask);
284f4730
JB
3139 }
3140 else
3141#endif
3142 read_avail_input (expected);
3143#endif
3144}
3145\f
3146#ifndef VMS
3147
3148/* Read any terminal input already buffered up by the system
3149 into the kbd_buffer, but do not wait.
3150
3151 EXPECTED should be nonzero if the caller knows there is some input.
3152
3153 Except on VMS, all input is read by this function.
3154 If interrupt_input is nonzero, this function MUST be called
3155 only when SIGIO is blocked.
3156
3157 Returns the number of keyboard chars read, or -1 meaning
3158 this is a bad time to try to read input. */
3159
3160static int
3161read_avail_input (expected)
3162 int expected;
3163{
3164 struct input_event buf[KBD_BUFFER_SIZE];
3165 register int i;
3166 int nread;
3167
3168 if (read_socket_hook)
3169 /* No need for FIONREAD or fcntl; just say don't wait. */
3170 nread = (*read_socket_hook) (0, buf, KBD_BUFFER_SIZE, expected, expected);
3171 else
3172 {
17270835
RS
3173 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
3174 the kbd_buffer can really hold. That may prevent loss
3175 of characters on some systems when input is stuffed at us. */
3176 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
284f4730
JB
3177
3178#ifdef FIONREAD
3179 /* Find out how much input is available. */
3180 if (ioctl (0, FIONREAD, &nread) < 0)
3181 /* Formerly simply reported no input, but that sometimes led to
3182 a failure of Emacs to terminate.
3183 SIGHUP seems appropriate if we can't reach the terminal. */
e4535288
RS
3184 /* ??? Is it really right to send the signal just to this process
3185 rather than to the whole process group?
3186 Perhaps on systems with FIONREAD Emacs is alone in its group. */
284f4730
JB
3187 kill (getpid (), SIGHUP);
3188 if (nread == 0)
3189 return 0;
3190 if (nread > sizeof cbuf)
3191 nread = sizeof cbuf;
3192#else /* no FIONREAD */
482952ef 3193#if defined(USG) || defined(DGUX)
284f4730
JB
3194 /* Read some input if available, but don't wait. */
3195 nread = sizeof cbuf;
3196 fcntl (fileno (stdin), F_SETFL, O_NDELAY);
3197#else
3198 you lose;
3199#endif
3200#endif
3201
3202 /* Now read; for one reason or another, this will not block. */
3203 while (1)
3204 {
854f3a54 3205 nread = read (fileno (stdin), cbuf, nread);
284f4730
JB
3206#ifdef AIX
3207 /* The kernel sometimes fails to deliver SIGHUP for ptys.
3208 This looks incorrect, but it isn't, because _BSD causes
3209 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
3210 and that causes a value other than 0 when there is no input. */
854f3a54 3211 if (nread == 0)
284f4730
JB
3212 kill (SIGHUP, 0);
3213#endif
854f3a54
RS
3214 /* This code is wrong, but at least it gets the right results.
3215 Fix it for 19.23. */
284f4730 3216 /* Retry the read if it is interrupted. */
854f3a54 3217 if (nread >= 0
284f4730
JB
3218 || ! (errno == EAGAIN || errno == EFAULT
3219#ifdef EBADSLT
3220 || errno == EBADSLT
3221#endif
3222 ))
854f3a54 3223 break;
284f4730
JB
3224 }
3225
3226#ifndef FIONREAD
02c2c53f 3227#if defined (USG) || defined (DGUX)
284f4730 3228 fcntl (fileno (stdin), F_SETFL, 0);
02c2c53f 3229#endif /* USG or DGUX */
284f4730
JB
3230#endif /* no FIONREAD */
3231 for (i = 0; i < nread; i++)
3232 {
3233 buf[i].kind = ascii_keystroke;
86e5706b 3234 buf[i].modifiers = 0;
b04904fb 3235 if (meta_key == 1 && (cbuf[i] & 0x80))
86e5706b 3236 buf[i].modifiers = meta_modifier;
b04904fb
RS
3237 if (meta_key != 2)
3238 cbuf[i] &= ~0x80;
86e5706b 3239
7b4aedb9
JB
3240 XSET (buf[i].code, Lisp_Int, cbuf[i]);
3241#ifdef MULTI_FRAME
3242 XSET (buf[i].frame_or_window, Lisp_Frame, selected_frame);
3243#else
3244 buf[i].frame_or_window = Qnil;
3245#endif
284f4730
JB
3246 }
3247 }
3248
3249 /* Scan the chars for C-g and store them in kbd_buffer. */
3250 for (i = 0; i < nread; i++)
3251 {
3252 kbd_buffer_store_event (&buf[i]);
3253 /* Don't look at input that follows a C-g too closely.
3254 This reduces lossage due to autorepeat on C-g. */
3255 if (buf[i].kind == ascii_keystroke
3256 && XINT(buf[i].code) == quit_char)
3257 break;
3258 }
3259
3260 return nread;
3261}
3262#endif /* not VMS */
3263\f
3264#ifdef SIGIO /* for entire page */
3265/* Note SIGIO has been undef'd if FIONREAD is missing. */
3266
2ce30ea2 3267SIGTYPE
284f4730
JB
3268input_available_signal (signo)
3269 int signo;
3270{
3271 /* Must preserve main program's value of errno. */
3272 int old_errno = errno;
3273#ifdef BSD4_1
3274 extern int select_alarmed;
3275#endif
3276
3277#ifdef USG
3278 /* USG systems forget handlers when they are used;
3279 must reestablish each time */
3280 signal (signo, input_available_signal);
3281#endif /* USG */
3282
3283#ifdef BSD4_1
3284 sigisheld (SIGIO);
3285#endif
3286
ffd56f97
JB
3287 if (input_available_clear_time)
3288 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
284f4730
JB
3289
3290 while (1)
3291 {
3292 int nread;
3293 nread = read_avail_input (1);
3294 /* -1 means it's not ok to read the input now.
3295 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
3296 0 means there was no keyboard input available. */
3297 if (nread <= 0)
3298 break;
3299
3300#ifdef BSD4_1
3301 select_alarmed = 1; /* Force the select emulator back to life */
3302#endif
3303 }
3304
3305#ifdef BSD4_1
3306 sigfree ();
3307#endif
3308 errno = old_errno;
3309}
3310#endif /* SIGIO */
ad163903
JB
3311
3312/* Send ourselves a SIGIO.
3313
3314 This function exists so that the UNBLOCK_INPUT macro in
3315 blockinput.h can have some way to take care of input we put off
3316 dealing with, without assuming that every file which uses
3317 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
3318void
3319reinvoke_input_signal ()
3320{
3321#ifdef SIGIO
3322 kill (0, SIGIO);
3323#endif
3324}
3325
3326
284f4730
JB
3327\f
3328/* Return the prompt-string of a sparse keymap.
3329 This is the first element which is a string.
3330 Return nil if there is none. */
3331
3332Lisp_Object
3333map_prompt (map)
3334 Lisp_Object map;
3335{
3336 while (CONSP (map))
3337 {
3338 register Lisp_Object tem;
3339 tem = Fcar (map);
3340 if (XTYPE (tem) == Lisp_String)
3341 return tem;
3342 map = Fcdr (map);
3343 }
3344 return Qnil;
3345}
3346
5ec75a55
RS
3347static Lisp_Object menu_bar_item ();
3348static Lisp_Object menu_bar_one_keymap ();
3349
3350/* Return a list of menu items for a menu bar, appropriate
3351 to the current buffer.
3352 The elements have the form (KEY STRING . nil). */
3353
3354Lisp_Object
3355menu_bar_items ()
3356{
3357 /* The number of keymaps we're scanning right now, and the number of
3358 keymaps we have allocated space for. */
3359 int nmaps;
3360
3361 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
3362 in the current keymaps, or nil where it is not a prefix. */
3363 Lisp_Object *maps;
3364
9f9c0e27 3365 Lisp_Object def, tem, tail;
5ec75a55
RS
3366
3367 Lisp_Object result;
3368
3369 int mapno;
47d319aa 3370 Lisp_Object oquit;
5ec75a55 3371
db60d856
JB
3372 /* In order to build the menus, we need to call the keymap
3373 accessors. They all call QUIT. But this function is called
3374 during redisplay, during which a quit is fatal. So inhibit
47d319aa
RS
3375 quitting while building the menus.
3376 We do this instead of specbind because (1) errors will clear it anyway
3377 and (2) this avoids risk of specpdl overflow. */
3378 oquit = Vinhibit_quit;
3379 Vinhibit_quit = Qt;
db60d856 3380
5ec75a55
RS
3381 /* Build our list of keymaps.
3382 If we recognize a function key and replace its escape sequence in
3383 keybuf with its symbol, or if the sequence starts with a mouse
3384 click and we need to switch buffers, we jump back here to rebuild
3385 the initial keymaps from the current buffer. */
3386 {
3387 Lisp_Object *tmaps;
3388
3389 nmaps = current_minor_maps (0, &tmaps) + 2;
3390 maps = (Lisp_Object *) alloca (nmaps * sizeof (maps[0]));
3391 bcopy (tmaps, maps, (nmaps - 2) * sizeof (maps[0]));
3392#ifdef USE_TEXT_PROPERTIES
3393 maps[nmaps-2] = get_local_map (PT, current_buffer);
3394#else
a6d53864 3395 maps[nmaps-2] = current_buffer->keymap;
5ec75a55 3396#endif
7e6992e0 3397 maps[nmaps-1] = current_global_map;
5ec75a55
RS
3398 }
3399
3400 /* Look up in each map the dummy prefix key `menu-bar'. */
3401
3402 result = Qnil;
3403
e58aa385 3404 for (mapno = nmaps - 1; mapno >= 0; mapno--)
5ec75a55
RS
3405 {
3406 if (! NILP (maps[mapno]))
e74fbc70 3407 def = get_keyelt (access_keymap (maps[mapno], Qmenu_bar, 1, 0));
5ec75a55
RS
3408 else
3409 def = Qnil;
3410
3411 tem = Fkeymapp (def);
3412 if (!NILP (tem))
3413 result = menu_bar_one_keymap (def, result);
3414 }
3415
9f9c0e27
RS
3416 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCONS (tail)->cdr)
3417 {
3418 Lisp_Object elt;
3419
3420 elt = Fassq (XCONS (tail)->car, result);
3421 if (!NILP (elt))
3422 result = Fcons (elt, Fdelq (elt, result));
3423 }
a73c5e29 3424
85e28fa2 3425 result = Fnreverse (result);
47d319aa 3426 Vinhibit_quit = oquit;
85e28fa2 3427 return result;
5ec75a55
RS
3428}
3429\f
3430/* Scan one map KEYMAP, accumulating any menu items it defines
3431 that have not yet been seen in RESULT. Return the updated RESULT. */
3432
3433static Lisp_Object
3434menu_bar_one_keymap (keymap, result)
3435 Lisp_Object keymap, result;
3436{
3437 Lisp_Object tail, item, key, binding, item_string, table;
3438
3439 /* Loop over all keymap entries that have menu strings. */
3440 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
3441 {
3442 item = XCONS (tail)->car;
3443 if (XTYPE (item) == Lisp_Cons)
3444 {
3445 key = XCONS (item)->car;
3446 binding = XCONS (item)->cdr;
3447 if (XTYPE (binding) == Lisp_Cons)
3448 {
3449 item_string = XCONS (binding)->car;
3450 if (XTYPE (item_string) == Lisp_String)
3451 result = menu_bar_item (key, item_string,
3452 Fcdr (binding), result);
3453 }
e58aa385
RS
3454 else if (EQ (binding, Qundefined))
3455 result = menu_bar_item (key, item_string,
ae450a95 3456 binding, result);
5ec75a55
RS
3457 }
3458 else if (XTYPE (item) == Lisp_Vector)
3459 {
3460 /* Loop over the char values represented in the vector. */
3461 int len = XVECTOR (item)->size;
3462 int c;
3463 for (c = 0; c < len; c++)
3464 {
3465 Lisp_Object character;
3466 XFASTINT (character) = c;
3467 binding = XVECTOR (item)->contents[c];
3468 if (XTYPE (binding) == Lisp_Cons)
3469 {
3470 item_string = XCONS (binding)->car;
3471 if (XTYPE (item_string) == Lisp_String)
3472 result = menu_bar_item (key, item_string,
3473 Fcdr (binding), result);
3474 }
e58aa385
RS
3475 else if (EQ (binding, Qundefined))
3476 result = menu_bar_item (key, item_string,
ae450a95 3477 binding, result);
5ec75a55
RS
3478 }
3479 }
3480 }
3481
3482 return result;
3483}
3484
3485static Lisp_Object
3486menu_bar_item (key, item_string, def, result)
3487 Lisp_Object key, item_string, def, result;
3488{
e58aa385 3489 Lisp_Object tem;
5ec75a55
RS
3490 Lisp_Object enabled;
3491
e58aa385
RS
3492 if (EQ (def, Qundefined))
3493 {
3494 /* If a map has an explicit nil as definition,
3495 discard any previously made menu bar item. */
3496 tem = Fassq (key, result);
3497 return Fdelq (tem, result);
3498 }
3499
5ec75a55
RS
3500 /* See if this entry is enabled. */
3501 enabled = Qt;
3502
3503 if (XTYPE (def) == Lisp_Symbol)
3504 {
3505 /* No property, or nil, means enable.
3506 Otherwise, enable if value is not nil. */
3507 tem = Fget (def, Qmenu_enable);
3508 if (!NILP (tem))
3509 enabled = Feval (tem);
3510 }
3511
3512 /* Add an entry for this key and string
3513 if there is none yet. */
e58aa385
RS
3514 tem = Fassq (key, result);
3515 if (!NILP (enabled) && NILP (tem))
5ec75a55
RS
3516 result = Fcons (Fcons (key, Fcons (item_string, Qnil)), result);
3517
3518 return result;
3519}
3520\f
dcc408a0
RS
3521/* Read a character using menus based on maps in the array MAPS.
3522 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
3523 Return t if we displayed a menu but the user rejected it.
7d6de002
RS
3524
3525 PREV_EVENT is the previous input event, or nil if we are reading
3526 the first event of a key sequence.
3527
6569cc8d
JB
3528 If USED_MOUSE_MENU is non-zero, then we set *USED_MOUSE_MENU to 1
3529 if we used a mouse menu to read the input, or zero otherwise. If
3530 USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone.
284f4730
JB
3531
3532 The prompting is done based on the prompt-string of the map
3533 and the strings associated with various map elements. */
3534
7617111f 3535static Lisp_Object
7d6de002
RS
3536read_char_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
3537 int nmaps;
3538 Lisp_Object *maps;
3539 Lisp_Object prev_event;
3540 int *used_mouse_menu;
284f4730 3541{
7d6de002
RS
3542 int mapno;
3543 register Lisp_Object name;
284f4730 3544 int nlength;
ff11dfa1 3545 int width = FRAME_WIDTH (selected_frame) - 4;
7d6de002
RS
3546 char *menu = (char *) alloca (width + 4);
3547 int idx = -1;
3548 Lisp_Object rest, vector;
3549
6569cc8d
JB
3550 if (used_mouse_menu)
3551 *used_mouse_menu = 0;
284f4730
JB
3552
3553 /* Use local over global Menu maps */
3554
7d6de002
RS
3555 if (! menu_prompting)
3556 return Qnil;
3557
3558 /* Get the menu name from the first map that has one (a prompt string). */
3559 for (mapno = 0; mapno < nmaps; mapno++)
3560 {
3561 name = map_prompt (maps[mapno]);
3562 if (!NILP (name))
3563 break;
3564 }
284f4730 3565
7d6de002 3566 /* If we don't have any menus, just read a character normally. */
dbc4e1c1 3567 if (mapno >= nmaps)
7d6de002
RS
3568 return Qnil;
3569
dbc4e1c1
JB
3570#ifdef HAVE_X_WINDOWS
3571#ifdef HAVE_X_MENU
7d6de002
RS
3572 /* If we got to this point via a mouse click,
3573 use a real menu for mouse selection. */
dbc4e1c1 3574 if (EVENT_HAS_PARAMETERS (prev_event))
7d6de002
RS
3575 {
3576 /* Display the menu and get the selection. */
3577 Lisp_Object *realmaps
3578 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
3579 Lisp_Object value;
3580 int nmaps1 = 0;
3581
3582 /* Use the maps that are not nil. */
3583 for (mapno = 0; mapno < nmaps; mapno++)
3584 if (!NILP (maps[mapno]))
3585 realmaps[nmaps1++] = maps[mapno];
3586
3587 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
663258f2
JB
3588 if (CONSP (value))
3589 {
3590 /* If we got more than one event, put all but the first
3591 onto this list to be read later.
3592 Return just the first event now. */
3593 unread_command_events
3594 = nconc2 (XCONS (value)->cdr, unread_command_events);
3595 value = XCONS (value)->car;
3596 }
7d6de002 3597 if (NILP (value))
dcc408a0 3598 value = Qt;
6569cc8d
JB
3599 if (used_mouse_menu)
3600 *used_mouse_menu = 1;
7d6de002
RS
3601 return value;
3602 }
dbc4e1c1
JB
3603#endif /* HAVE_X_MENU */
3604#endif /* HAVE_X_WINDOWS */
284f4730
JB
3605
3606 /* Prompt string always starts with map's prompt, and a space. */
3607 strcpy (menu, XSTRING (name)->data);
3608 nlength = XSTRING (name)->size;
7d6de002 3609 menu[nlength++] = ':';
284f4730
JB
3610 menu[nlength++] = ' ';
3611 menu[nlength] = 0;
3612
7d6de002
RS
3613 /* Start prompting at start of first map. */
3614 mapno = 0;
3615 rest = maps[mapno];
284f4730
JB
3616
3617 /* Present the documented bindings, a line at a time. */
3618 while (1)
3619 {
3620 int notfirst = 0;
3621 int i = nlength;
3622 Lisp_Object obj;
3623 int ch;
3624
284f4730 3625 /* Loop over elements of map. */
7d6de002 3626 while (i < width)
284f4730 3627 {
7d6de002 3628 Lisp_Object s, elt;
284f4730 3629
7d6de002
RS
3630 /* If reached end of map, start at beginning of next map. */
3631 if (NILP (rest))
3632 {
3633 mapno++;
3634 /* At end of last map, wrap around to first map if just starting,
3635 or end this line if already have something on it. */
3636 if (mapno == nmaps)
284f4730 3637 {
7d6de002
RS
3638 if (notfirst)
3639 break;
3640 else
3641 mapno = 0;
284f4730 3642 }
7d6de002 3643 rest = maps[mapno];
284f4730 3644 }
7d6de002
RS
3645
3646 /* Look at the next element of the map. */
3647 if (idx >= 0)
3648 elt = XVECTOR (vector)->contents[idx];
284f4730 3649 else
7d6de002
RS
3650 elt = Fcar_safe (rest);
3651
3652 if (idx < 0 && XTYPE (elt) == Lisp_Vector)
284f4730 3653 {
7d6de002
RS
3654 /* If we found a dense table in the keymap,
3655 advanced past it, but start scanning its contents. */
3656 rest = Fcdr_safe (rest);
3657 vector = elt;
3658 idx = 0;
284f4730 3659 }
7d6de002
RS
3660 else
3661 {
3662 /* An ordinary element. */
3663 s = Fcar_safe (Fcdr_safe (elt));
3664 if (XTYPE (s) != Lisp_String)
3665 /* Ignore the element if it has no prompt string. */
3666 ;
3667 /* If we have room for the prompt string, add it to this line.
3668 If this is the first on the line, always add it. */
3669 else if (XSTRING (s)->size + i < width
3670 || !notfirst)
3671 {
3672 int thiswidth;
284f4730 3673
7d6de002
RS
3674 /* Punctuate between strings. */
3675 if (notfirst)
3676 {
3677 strcpy (menu + i, ", ");
3678 i += 2;
3679 }
3680 notfirst = 1;
3681
3682 /* Add as much of string as fits. */
3683 thiswidth = XSTRING (s)->size;
3684 if (thiswidth + i > width)
3685 thiswidth = width - i;
3686 bcopy (XSTRING (s)->data, menu + i, thiswidth);
3687 i += thiswidth;
3688 }
3689 else
3690 {
3691 /* If this element does not fit, end the line now,
3692 and save the element for the next line. */
3693 strcpy (menu + i, "...");
3694 break;
3695 }
3696
3697 /* Move past this element. */
3698 if (idx >= 0 && idx + 1 >= XVECTOR (rest)->size)
3699 /* Handle reaching end of dense table. */
3700 idx = -1;
3701 if (idx >= 0)
3702 idx++;
3703 else
3704 rest = Fcdr_safe (rest);
3705 }
284f4730
JB
3706 }
3707
3708 /* Prompt with that and read response. */
3709 message1 (menu);
7d6de002 3710 obj = read_char (1, 0, 0, Qnil, 0);
284f4730
JB
3711
3712 if (XTYPE (obj) != Lisp_Int)
3713 return obj;
3714 else
3715 ch = XINT (obj);
3716
f4255cd1 3717 if (! EQ (obj, menu_prompt_more_char)
284f4730 3718 && (XTYPE (menu_prompt_more_char) != Lisp_Int
f4255cd1 3719 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
284f4730
JB
3720 return obj;
3721 }
3722}
284f4730
JB
3723\f
3724/* Reading key sequences. */
3725
3726/* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
3727 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
3728 keymap, or nil otherwise. Return the index of the first keymap in
3729 which KEY has any binding, or NMAPS if no map has a binding.
3730
3731 If KEY is a meta ASCII character, treat it like meta-prefix-char
3732 followed by the corresponding non-meta character. Keymaps in
3733 CURRENT with non-prefix bindings for meta-prefix-char become nil in
3734 NEXT.
3735
3736 When KEY is not defined in any of the keymaps, if it is an upper
3737 case letter and there are bindings for the corresponding lower-case
3738 letter, return the bindings for the lower-case letter.
e9bf89a0
RS
3739 We store 1 in *CASE_CONVERTED in this case.
3740 Otherwise, we don't change *CASE_CONVERTED.
284f4730 3741
88cb0656
JB
3742 If KEY has no bindings in any of the CURRENT maps, NEXT is left
3743 unmodified.
3744
284f4730
JB
3745 NEXT may == CURRENT. */
3746
3747static int
e9bf89a0 3748follow_key (key, nmaps, current, defs, next, case_converted)
284f4730
JB
3749 Lisp_Object key;
3750 Lisp_Object *current, *defs, *next;
3751 int nmaps;
e9bf89a0 3752 int *case_converted;
284f4730
JB
3753{
3754 int i, first_binding;
3755
3756 /* If KEY is a meta ASCII character, treat it like meta-prefix-char
3757 followed by the corresponding non-meta character. */
86e5706b 3758 if (XTYPE (key) == Lisp_Int && (XINT (key) & CHAR_META))
284f4730
JB
3759 {
3760 for (i = 0; i < nmaps; i++)
3761 if (! NILP (current[i]))
3762 {
cd21b839 3763 next[i] =
e74fbc70 3764 get_keyelt (access_keymap (current[i], meta_prefix_char, 1, 0));
284f4730
JB
3765
3766 /* Note that since we pass the resulting bindings through
3767 get_keymap_1, non-prefix bindings for meta-prefix-char
3768 disappear. */
f4255cd1 3769 next[i] = get_keymap_1 (next[i], 0, 1);
284f4730
JB
3770 }
3771 else
3772 next[i] = Qnil;
3773
3774 current = next;
86e5706b 3775 XSET (key, Lisp_Int, XFASTINT (key) & ~CHAR_META);
284f4730
JB
3776 }
3777
3778 first_binding = nmaps;
3779 for (i = nmaps - 1; i >= 0; i--)
3780 {
3781 if (! NILP (current[i]))
3782 {
e74fbc70 3783 defs[i] = get_keyelt (access_keymap (current[i], key, 1, 0));
284f4730
JB
3784 if (! NILP (defs[i]))
3785 first_binding = i;
3786 }
3787 else
3788 defs[i] = Qnil;
3789 }
3790
3791 /* When KEY is not defined in any of the keymaps, if it is an upper
3792 case letter and there are bindings for the corresponding
3793 lower-case letter, return the bindings for the lower-case letter. */
3794 if (first_binding == nmaps
3795 && XTYPE (key) == Lisp_Int
bb1ef421
RS
3796 && ((((XINT (key) & 0x3ffff)
3797 < XSTRING (current_buffer->downcase_table)->size)
3798 && UPPERCASEP (XINT (key) & 0x3ffff))
86e5706b 3799 || (XINT (key) & shift_modifier)))
284f4730 3800 {
86e5706b
RS
3801 if (XINT (key) & shift_modifier)
3802 XSETINT (key, XINT (key) & ~shift_modifier);
3803 else
398b666f
RS
3804 XSETINT (key, (DOWNCASE (XINT (key) & 0x3ffff)
3805 | (XINT (key) & ~0x3ffff)));
284f4730
JB
3806
3807 first_binding = nmaps;
3808 for (i = nmaps - 1; i >= 0; i--)
3809 {
3810 if (! NILP (current[i]))
3811 {
e74fbc70 3812 defs[i] = get_keyelt (access_keymap (current[i], key, 1, 0));
284f4730
JB
3813 if (! NILP (defs[i]))
3814 first_binding = i;
3815 }
3816 else
3817 defs[i] = Qnil;
3818 }
e9bf89a0
RS
3819 if (first_binding != nmaps)
3820 *case_converted = 1;
284f4730 3821 }
86e5706b 3822
284f4730 3823 /* Given the set of bindings we've found, produce the next set of maps. */
0a7f1fc0
JB
3824 if (first_binding < nmaps)
3825 for (i = 0; i < nmaps; i++)
f4255cd1 3826 next[i] = NILP (defs[i]) ? Qnil : get_keymap_1 (defs[i], 0, 1);
284f4730
JB
3827
3828 return first_binding;
3829}
3830
f4255cd1
JB
3831/* Read a sequence of keys that ends with a non prefix character,
3832 storing it in KEYBUF, a buffer of size BUFSIZE.
3833 Prompt with PROMPT.
284f4730 3834 Return the length of the key sequence stored.
dcc408a0 3835 Return -1 if the user rejected a command menu.
284f4730 3836
f4255cd1
JB
3837 Echo starting immediately unless `prompt' is 0.
3838
3839 Where a key sequence ends depends on the currently active keymaps.
3840 These include any minor mode keymaps active in the current buffer,
3841 the current buffer's local map, and the global map.
3842
3843 If a key sequence has no other bindings, we check Vfunction_key_map
3844 to see if some trailing subsequence might be the beginning of a
3845 function key's sequence. If so, we try to read the whole function
3846 key, and substitute its symbolic name into the key sequence.
3847
fbcd35bd
JB
3848 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
3849 `double-' events into similar click events, if that would make them
3850 bound. We try to turn `triple-' events first into `double-' events,
3851 then into clicks.
f4255cd1
JB
3852
3853 If we get a mouse click in a mode line, vertical divider, or other
3854 non-text area, we treat the click as if it were prefixed by the
3855 symbol denoting that area - `mode-line', `vertical-line', or
3856 whatever.
3857
3858 If the sequence starts with a mouse click, we read the key sequence
3859 with respect to the buffer clicked on, not the current buffer.
284f4730 3860
f4255cd1
JB
3861 If the user switches frames in the midst of a key sequence, we put
3862 off the switch-frame event until later; the next call to
3863 read_char will return it. */
48e416d4 3864
284f4730
JB
3865static int
3866read_key_sequence (keybuf, bufsize, prompt)
3867 Lisp_Object *keybuf;
3868 int bufsize;
84d91fda 3869 Lisp_Object prompt;
284f4730 3870{
f4255cd1
JB
3871 int count = specpdl_ptr - specpdl;
3872
284f4730
JB
3873 /* How many keys there are in the current key sequence. */
3874 int t;
3875
284f4730
JB
3876 /* The length of the echo buffer when we started reading, and
3877 the length of this_command_keys when we started reading. */
3878 int echo_start;
f4255cd1 3879 int keys_start;
284f4730
JB
3880
3881 /* The number of keymaps we're scanning right now, and the number of
3882 keymaps we have allocated space for. */
3883 int nmaps;
3884 int nmaps_allocated = 0;
3885
284f4730
JB
3886 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
3887 the current keymaps. */
3888 Lisp_Object *defs;
3889
f4255cd1
JB
3890 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
3891 in the current keymaps, or nil where it is not a prefix. */
3892 Lisp_Object *submaps;
3893
3894 /* The index in defs[] of the first keymap that has a binding for
3895 this key sequence. In other words, the lowest i such that
3896 defs[i] is non-nil. */
284f4730
JB
3897 int first_binding;
3898
f4255cd1 3899 /* If t < mock_input, then KEYBUF[t] should be read as the next
253598e4
JB
3900 input key.
3901
3902 We use this to recover after recognizing a function key. Once we
3903 realize that a suffix of the current key sequence is actually a
3904 function key's escape sequence, we replace the suffix with the
3905 function key's binding from Vfunction_key_map. Now keybuf
f4255cd1
JB
3906 contains a new and different key sequence, so the echo area,
3907 this_command_keys, and the submaps and defs arrays are wrong. In
3908 this situation, we set mock_input to t, set t to 0, and jump to
3909 restart_sequence; the loop will read keys from keybuf up until
3910 mock_input, thus rebuilding the state; and then it will resume
3911 reading characters from the keyboard. */
284f4730
JB
3912 int mock_input = 0;
3913
253598e4 3914 /* If the sequence is unbound in submaps[], then
f4255cd1
JB
3915 keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map,
3916 and fkey_map is its binding.
253598e4 3917
f4255cd1
JB
3918 These might be > t, indicating that all function key scanning
3919 should hold off until t reaches them. We do this when we've just
3920 recognized a function key, to avoid searching for the function
3921 key's again in Vfunction_key_map. */
284f4730 3922 int fkey_start = 0, fkey_end = 0;
4efda7dd 3923 Lisp_Object fkey_map;
284f4730 3924
a612e298
RS
3925 /* Likewise, for key_translation_map. */
3926 int keytran_start = 0, keytran_end = 0;
3927 Lisp_Object keytran_map;
3928
cd21b839
JB
3929 /* If we receive a ``switch-frame'' event in the middle of a key sequence,
3930 we put it off for later. While we're reading, we keep the event here. */
4efda7dd 3931 Lisp_Object delayed_switch_frame;
cd21b839 3932
51763820
BF
3933 /* See the comment below... */
3934#if defined (GOBBLE_FIRST_EVENT)
4efda7dd 3935 Lisp_Object first_event;
51763820 3936#endif
4efda7dd 3937
3b9189f8
RS
3938 struct buffer *starting_buffer;
3939
e9bf89a0
RS
3940 /* Nonzero if we found the binding for one of the chars
3941 in this key sequence by downcasing it. */
3942 int case_converted = 0;
3943
3944 /* Nonzero if we seem to have got the beginning of a binding
3945 in function_key_map. */
3946 int function_key_possible = 0;
3947
4efda7dd
RS
3948 int junk;
3949
3950 last_nonmenu_event = Qnil;
3951
3952 delayed_switch_frame = Qnil;
3953 fkey_map = Vfunction_key_map;
a612e298 3954 keytran_map = Vkey_translation_map;
f4255cd1 3955
a612e298 3956 /* If there is no function-key-map, turn off function key scanning. */
f4255cd1
JB
3957 if (NILP (Fkeymapp (Vfunction_key_map)))
3958 fkey_start = fkey_end = bufsize + 1;
3959
a612e298
RS
3960 /* If there is no key-translation-map, turn off scanning. */
3961 if (NILP (Fkeymapp (Vkey_translation_map)))
3962 keytran_start = keytran_end = bufsize + 1;
3963
284f4730
JB
3964 if (INTERACTIVE)
3965 {
84d91fda
RS
3966 if (!NILP (prompt))
3967 echo_prompt (XSTRING (prompt)->data);
284f4730
JB
3968 else if (cursor_in_echo_area)
3969 /* This doesn't put in a dash if the echo buffer is empty, so
3970 you don't always see a dash hanging out in the minibuffer. */
3971 echo_dash ();
284f4730
JB
3972 }
3973
f4255cd1
JB
3974 /* Record the initial state of the echo area and this_command_keys;
3975 we will need to restore them if we replay a key sequence. */
0a7f1fc0 3976 if (INTERACTIVE)
f4255cd1
JB
3977 echo_start = echo_length ();
3978 keys_start = this_command_key_count;
0a7f1fc0 3979
51763820
BF
3980#if defined (GOBBLE_FIRST_EVENT)
3981 /* This doesn't quite work, because some of the things that read_char
3982 does cannot safely be bypassed. It seems too risky to try to make
3983 this work right. */
3984
4efda7dd
RS
3985 /* Read the first char of the sequence specially, before setting
3986 up any keymaps, in case a filter runs and switches buffers on us. */
84d91fda 3987 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
4efda7dd 3988 &junk);
51763820 3989#endif /* GOBBLE_FIRST_EVENT */
4efda7dd 3990
7b4aedb9
JB
3991 /* We jump here when the key sequence has been thoroughly changed, and
3992 we need to rescan it starting from the beginning. When we jump here,
3993 keybuf[0..mock_input] holds the sequence we should reread. */
07d2b8de 3994 replay_sequence:
7b4aedb9 3995
3b9189f8 3996 starting_buffer = current_buffer;
e9bf89a0
RS
3997 case_converted = 0;
3998 function_key_possible = 0;
3b9189f8 3999
f4255cd1 4000 /* Build our list of keymaps.
07d2b8de
JB
4001 If we recognize a function key and replace its escape sequence in
4002 keybuf with its symbol, or if the sequence starts with a mouse
4003 click and we need to switch buffers, we jump back here to rebuild
4004 the initial keymaps from the current buffer. */
284f4730
JB
4005 {
4006 Lisp_Object *maps;
4007
4008 nmaps = current_minor_maps (0, &maps) + 2;
4009 if (nmaps > nmaps_allocated)
4010 {
253598e4 4011 submaps = (Lisp_Object *) alloca (nmaps * sizeof (submaps[0]));
284f4730
JB
4012 defs = (Lisp_Object *) alloca (nmaps * sizeof (defs[0]));
4013 nmaps_allocated = nmaps;
4014 }
253598e4 4015 bcopy (maps, submaps, (nmaps - 2) * sizeof (submaps[0]));
497ba7a1
RS
4016#ifdef USE_TEXT_PROPERTIES
4017 submaps[nmaps-2] = get_local_map (PT, current_buffer);
4018#else
a6d53864 4019 submaps[nmaps-2] = current_buffer->keymap;
497ba7a1 4020#endif
7e6992e0 4021 submaps[nmaps-1] = current_global_map;
284f4730
JB
4022 }
4023
4024 /* Find an accurate initial value for first_binding. */
4025 for (first_binding = 0; first_binding < nmaps; first_binding++)
253598e4 4026 if (! NILP (submaps[first_binding]))
284f4730
JB
4027 break;
4028
3b9189f8 4029 /* Start from the beginning in keybuf. */
f4255cd1
JB
4030 t = 0;
4031
4032 /* These are no-ops the first time through, but if we restart, they
4033 revert the echo area and this_command_keys to their original state. */
4034 this_command_key_count = keys_start;
4035 if (INTERACTIVE)
4036 echo_truncate (echo_start);
4037
cca310da
JB
4038 /* If the best binding for the current key sequence is a keymap, or
4039 we may be looking at a function key's escape sequence, keep on
4040 reading. */
253598e4 4041 while ((first_binding < nmaps && ! NILP (submaps[first_binding]))
cca310da
JB
4042 || (first_binding >= nmaps
4043 && fkey_start < t
4044 /* mock input is never part of a function key's sequence. */
a612e298
RS
4045 && mock_input <= fkey_start)
4046 || (first_binding >= nmaps
4047 && keytran_start < t
4048 /* mock input is never part of a function key's sequence. */
e9bf89a0
RS
4049 && mock_input <= keytran_start)
4050 /* Don't return in the middle of a possible function key sequence,
4051 if the only bindings we found were via case conversion.
4052 Thus, if ESC O a has a function-key-map translation
4053 and ESC o has a binding, don't return after ESC O,
4054 so that we can translate ESC O plus the next character. */
4055 || (function_key_possible && case_converted))
284f4730
JB
4056 {
4057 Lisp_Object key;
7d6de002 4058 int used_mouse_menu = 0;
284f4730 4059
7b4aedb9
JB
4060 /* Where the last real key started. If we need to throw away a
4061 key that has expanded into more than one element of keybuf
4062 (say, a mouse click on the mode line which is being treated
4063 as [mode-line (mouse-...)], then we backtrack to this point
4064 of keybuf. */
4065 int last_real_key_start;
4066
0a7f1fc0
JB
4067 /* These variables are analogous to echo_start and keys_start;
4068 while those allow us to restart the entire key sequence,
4069 echo_local_start and keys_local_start allow us to throw away
4070 just one key. */
f4255cd1
JB
4071 int echo_local_start, keys_local_start, local_first_binding;
4072
284f4730
JB
4073 if (t >= bufsize)
4074 error ("key sequence too long");
4075
f4255cd1
JB
4076 if (INTERACTIVE)
4077 echo_local_start = echo_length ();
4078 keys_local_start = this_command_key_count;
4079 local_first_binding = first_binding;
4080
4081 replay_key:
0a7f1fc0 4082 /* These are no-ops, unless we throw away a keystroke below and
f4255cd1
JB
4083 jumped back up to replay_key; in that case, these restore the
4084 variables to their original state, allowing us to replay the
0a7f1fc0 4085 loop. */
f4255cd1
JB
4086 if (INTERACTIVE)
4087 echo_truncate (echo_local_start);
0a7f1fc0
JB
4088 this_command_key_count = keys_local_start;
4089 first_binding = local_first_binding;
4090
7e85b935
RS
4091 /* By default, assume each event is "real". */
4092 last_real_key_start = t;
4093
f4255cd1 4094 /* Does mock_input indicate that we are re-reading a key sequence? */
284f4730
JB
4095 if (t < mock_input)
4096 {
4097 key = keybuf[t];
4098 add_command_key (key);
4099 echo_char (key);
4100 }
253598e4
JB
4101
4102 /* If not, we should actually read a character. */
284f4730
JB
4103 else
4104 {
a6d53864
RS
4105 struct buffer *buf = current_buffer;
4106
84d91fda 4107 key = read_char (NILP (prompt), nmaps, submaps, last_nonmenu_event,
a6d53864 4108 &used_mouse_menu);
284f4730 4109
dcc408a0
RS
4110 /* read_char returns t when it shows a menu and the user rejects it.
4111 Just return -1. */
4112 if (EQ (key, Qt))
4113 return -1;
4114
f4255cd1 4115 /* read_char returns -1 at the end of a macro.
284f4730
JB
4116 Emacs 18 handles this by returning immediately with a
4117 zero, so that's what we'll do. */
86e5706b 4118 if (XTYPE (key) == Lisp_Int && XINT (key) == -1)
cd21b839 4119 {
f4255cd1
JB
4120 t = 0;
4121 goto done;
cd21b839 4122 }
284f4730 4123
3b9189f8
RS
4124 /* If we have a quit that was typed in another frame, and
4125 quit_throw_to_read_char switched buffers,
4126 replay to get the right keymap. */
4127 if (EQ (key, quit_char) && current_buffer != starting_buffer)
4128 {
4129 keybuf[t++] = key;
4130 mock_input = t;
4131 Vquit_flag = Qnil;
4132 goto replay_sequence;
4133 }
4134
284f4730 4135 Vquit_flag = Qnil;
7e85b935 4136 }
284f4730 4137
7e85b935
RS
4138 /* Clicks in non-text areas get prefixed by the symbol
4139 in their CHAR-ADDRESS field. For example, a click on
4140 the mode line is prefixed by the symbol `mode-line'.
4141
4142 Furthermore, key sequences beginning with mouse clicks
4143 are read using the keymaps of the buffer clicked on, not
4144 the current buffer. So we may have to switch the buffer
4145 here.
4146
4147 When we turn one event into two events, we must make sure
4148 that neither of the two looks like the original--so that,
4149 if we replay the events, they won't be expanded again.
4150 If not for this, such reexpansion could happen either here
4151 or when user programs play with this-command-keys. */
4152 if (EVENT_HAS_PARAMETERS (key))
4153 {
4154 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
cca310da 4155
7e85b935 4156 if (EQ (kind, Qmouse_click))
0a7f1fc0 4157 {
7e85b935
RS
4158 Lisp_Object window = POSN_WINDOW (EVENT_START (key));
4159 Lisp_Object posn = POSN_BUFFER_POSN (EVENT_START (key));
f4255cd1 4160
7e85b935 4161 if (XTYPE (posn) == Lisp_Cons)
0a7f1fc0 4162 {
7e85b935
RS
4163 /* We're looking at the second event of a
4164 sequence which we expanded before. Set
4165 last_real_key_start appropriately. */
4166 if (t > 0)
4167 last_real_key_start = t - 1;
cd21b839 4168 }
7e85b935
RS
4169
4170 /* Key sequences beginning with mouse clicks are
4171 read using the keymaps in the buffer clicked on,
4172 not the current buffer. If we're at the
4173 beginning of a key sequence, switch buffers. */
4174 if (last_real_key_start == 0
4175 && XTYPE (window) == Lisp_Window
4176 && XTYPE (XWINDOW (window)->buffer) == Lisp_Buffer
4177 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
cd21b839 4178 {
7e85b935
RS
4179 keybuf[t] = key;
4180 mock_input = t + 1;
4181
4182 /* Arrange to go back to the original buffer once we're
4183 done reading the key sequence. Note that we can't
4184 use save_excursion_{save,restore} here, because they
4185 save point as well as the current buffer; we don't
4186 want to save point, because redisplay may change it,
4187 to accommodate a Fset_window_start or something. We
4188 don't want to do this at the top of the function,
4189 because we may get input from a subprocess which
4190 wants to change the selected window and stuff (say,
4191 emacsclient). */
4192 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
4193
4194 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
4195 goto replay_sequence;
0a7f1fc0 4196 }
7e85b935 4197 else if (XTYPE (posn) == Lisp_Symbol)
5ec75a55 4198 {
7e85b935
RS
4199 /* Expand mode-line and scroll-bar events into two events:
4200 use posn as a fake prefix key. */
5ec75a55 4201
7e85b935
RS
4202 if (t + 1 >= bufsize)
4203 error ("key sequence too long");
4204 keybuf[t] = posn;
4205 keybuf[t+1] = key;
4206 mock_input = t + 2;
4207
4208 /* Zap the position in key, so we know that we've
4209 expanded it, and don't try to do so again. */
4210 POSN_BUFFER_POSN (EVENT_START (key))
4211 = Fcons (posn, Qnil);
4212 goto replay_key;
5ec75a55 4213 }
0a7f1fc0 4214 }
7e85b935 4215 else if (EQ (kind, Qswitch_frame))
a6d53864 4216 {
7e85b935
RS
4217 /* If we're at the beginning of a key sequence, go
4218 ahead and return this event. If we're in the
4219 midst of a key sequence, delay it until the end. */
4220 if (t > 0)
4221 {
4222 delayed_switch_frame = key;
4223 goto replay_key;
4224 }
4225 }
4226 else
4227 {
4228 Lisp_Object posn = POSN_BUFFER_POSN (EVENT_START (key));
4229
4230 /* Handle menu-bar events:
4231 insert the dummy prefix event `menu-bar'. */
4232 if (EQ (posn, Qmenu_bar))
4233 {
4234 if (t + 1 >= bufsize)
4235 error ("key sequence too long");
4236 /* Run the Lucid hook. */
4237 call1 (Vrun_hooks, Qactivate_menubar_hook);
4238 /* If it has changed current-menubar from previous value,
4239 really recompute the menubar from the value. */
4240 if (! NILP (Vlucid_menu_bar_dirty_flag))
4241 call0 (Qrecompute_lucid_menubar);
4242 keybuf[t] = posn;
4243 keybuf[t+1] = key;
4244
4245 /* Zap the position in key, so we know that we've
4246 expanded it, and don't try to do so again. */
4247 POSN_BUFFER_POSN (EVENT_START (key))
4248 = Fcons (posn, Qnil);
4249
4250 mock_input = t + 2;
4251 goto replay_sequence;
4252 }
4253 else if (XTYPE (posn) == Lisp_Cons)
4254 {
4255 /* We're looking at the second event of a
4256 sequence which we expanded before. Set
4257 last_real_key_start appropriately. */
4258 if (last_real_key_start == t && t > 0)
4259 last_real_key_start = t - 1;
4260 }
a6d53864 4261 }
284f4730 4262 }
f4255cd1
JB
4263
4264 /* We have finally decided that KEY is something we might want
4265 to look up. */
284f4730
JB
4266 first_binding = (follow_key (key,
4267 nmaps - first_binding,
253598e4 4268 submaps + first_binding,
284f4730 4269 defs + first_binding,
e9bf89a0
RS
4270 submaps + first_binding,
4271 &case_converted)
284f4730 4272 + first_binding);
0a7f1fc0 4273
f4255cd1 4274 /* If KEY wasn't bound, we'll try some fallbacks. */
0a7f1fc0
JB
4275 if (first_binding >= nmaps)
4276 {
4277 Lisp_Object head = EVENT_HEAD (key);
4278
7e85b935
RS
4279 if (EQ (head, Vhelp_char))
4280 {
4281 read_key_sequence_cmd = Vprefix_help_command;
4282 keybuf[t++] = key;
4283 last_nonmenu_event = key;
4284 goto done;
4285 }
4286
0a7f1fc0
JB
4287 if (XTYPE (head) == Lisp_Symbol)
4288 {
4289 Lisp_Object breakdown = parse_modifiers (head);
80645119 4290 int modifiers = XINT (XCONS (XCONS (breakdown)->cdr)->car);
0a7f1fc0 4291
559f9d04
RS
4292 /* Attempt to reduce an unbound mouse event to a simpler
4293 event that is bound:
4294 Drags reduce to clicks.
4295 Double-clicks reduce to clicks.
4296 Triple-clicks reduce to double-clicks, then to clicks.
4297 Down-clicks are eliminated.
4298 Double-downs reduce to downs, then are eliminated.
4299 Triple-downs reduce to double-downs, then to downs,
4300 then are eliminated. */
4301 if (modifiers & (down_modifier | drag_modifier
4302 | double_modifier | triple_modifier))
0a7f1fc0 4303 {
559f9d04
RS
4304 while (modifiers & (down_modifier | drag_modifier
4305 | double_modifier | triple_modifier))
fbcd35bd
JB
4306 {
4307 Lisp_Object new_head, new_click;
4308 if (modifiers & triple_modifier)
4309 modifiers ^= (double_modifier | triple_modifier);
559f9d04 4310 else if (modifiers & (drag_modifier | double_modifier))
fbcd35bd 4311 modifiers &= ~(drag_modifier | double_modifier);
559f9d04
RS
4312 else
4313 {
4314 /* Dispose of this `down' event by simply jumping
4315 back to replay_key, to get another event.
4316
4317 Note that if this event came from mock input,
4318 then just jumping back to replay_key will just
4319 hand it to us again. So we have to wipe out any
4320 mock input.
4321
4322 We could delete keybuf[t] and shift everything
4323 after that to the left by one spot, but we'd also
4324 have to fix up any variable that points into
4325 keybuf, and shifting isn't really necessary
4326 anyway.
4327
4328 Adding prefixes for non-textual mouse clicks
4329 creates two characters of mock input, and both
4330 must be thrown away. If we're only looking at
4331 the prefix now, we can just jump back to
4332 replay_key. On the other hand, if we've already
4333 processed the prefix, and now the actual click
4334 itself is giving us trouble, then we've lost the
4335 state of the keymaps we want to backtrack to, and
4336 we need to replay the whole sequence to rebuild
4337 it.
4338
4339 Beyond that, only function key expansion could
4340 create more than two keys, but that should never
4341 generate mouse events, so it's okay to zero
4342 mock_input in that case too.
4343
4344 Isn't this just the most wonderful code ever? */
4345 if (t == last_real_key_start)
4346 {
4347 mock_input = 0;
4348 goto replay_key;
4349 }
4350 else
4351 {
4352 mock_input = last_real_key_start;
4353 goto replay_sequence;
4354 }
4355 }
4356
27203ead
RS
4357 new_head
4358 = apply_modifiers (modifiers, XCONS (breakdown)->car);
4359 new_click
4360 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
fbcd35bd
JB
4361
4362 /* Look for a binding for this new key. follow_key
4363 promises that it didn't munge submaps the
4364 last time we called it, since key was unbound. */
27203ead
RS
4365 first_binding
4366 = (follow_key (new_click,
4367 nmaps - local_first_binding,
4368 submaps + local_first_binding,
4369 defs + local_first_binding,
e9bf89a0
RS
4370 submaps + local_first_binding,
4371 &case_converted)
27203ead 4372 + local_first_binding);
fbcd35bd
JB
4373
4374 /* If that click is bound, go for it. */
4375 if (first_binding < nmaps)
4376 {
4377 key = new_click;
4378 break;
4379 }
4380 /* Otherwise, we'll leave key set to the drag event. */
4381 }
0a7f1fc0
JB
4382 }
4383 }
4384 }
4385
284f4730 4386 keybuf[t++] = key;
7d6de002
RS
4387 /* Normally, last_nonmenu_event gets the previous key we read.
4388 But when a mouse popup menu is being used,
4389 we don't update last_nonmenu_event; it continues to hold the mouse
4390 event that preceded the first level of menu. */
4391 if (!used_mouse_menu)
4392 last_nonmenu_event = key;
284f4730
JB
4393
4394 /* If the sequence is unbound, see if we can hang a function key
253598e4
JB
4395 off the end of it. We only want to scan real keyboard input
4396 for function key sequences, so if mock_input says that we're
f4255cd1 4397 re-reading old events, don't examine it. */
e9bf89a0 4398 if ((first_binding >= nmaps || case_converted)
253598e4 4399 && t >= mock_input)
284f4730
JB
4400 {
4401 Lisp_Object fkey_next;
4402
e9bf89a0
RS
4403 /* Continue scan from fkey_end until we find a bound suffix.
4404 If we fail, increment fkey_start
4405 and start fkey_end from there. */
284f4730
JB
4406 while (fkey_end < t)
4407 {
f4255cd1
JB
4408 Lisp_Object key;
4409
4410 key = keybuf[fkey_end++];
067ffa38
JB
4411 /* Look up meta-characters by prefixing them
4412 with meta_prefix_char. I hate this. */
d3cc13fa 4413 if (XTYPE (key) == Lisp_Int && XINT (key) & meta_modifier)
f4255cd1 4414 {
e74fbc70
RS
4415 fkey_next
4416 = get_keymap_1
f4255cd1 4417 (get_keyelt
e74fbc70 4418 (access_keymap (fkey_map, meta_prefix_char, 1, 0)),
f4255cd1 4419 0, 1);
d3cc13fa 4420 XFASTINT (key) = XFASTINT (key) & ~meta_modifier;
f4255cd1 4421 }
067ffa38
JB
4422 else
4423 fkey_next = fkey_map;
4424
e74fbc70
RS
4425 fkey_next
4426 = get_keyelt (access_keymap (fkey_next, key, 1, 0));
067ffa38 4427
1abe6abe
RS
4428 /* If the function key map gives a function, not an
4429 array, then call the function with no args and use
4430 its value instead. */
4431 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
4432 && fkey_end == t)
4433 {
4434 struct gcpro gcpro1, gcpro2, gcpro3;
4435 Lisp_Object tem;
4436 tem = fkey_next;
4437
4438 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
84d91fda 4439 fkey_next = call1 (fkey_next, prompt);
1abe6abe
RS
4440 UNGCPRO;
4441 /* If the function returned something invalid,
4442 barf--don't ignore it.
4443 (To ignore it safely, we would need to gcpro a bunch of
4444 other variables.) */
4445 if (! (VECTORP (fkey_next) || STRINGP (fkey_next)))
4446 error ("Function in function-key-map returns invalid key sequence");
4447 }
4448
e9bf89a0
RS
4449 function_key_possible = ! NILP (fkey_next);
4450
85bc5181 4451 /* If keybuf[fkey_start..fkey_end] is bound in the
a764a753 4452 function key map and it's a suffix of the current
85bc5181 4453 sequence (i.e. fkey_end == t), replace it with
a764a753 4454 the binding and restart with fkey_start at the end. */
f5ea6163 4455 if ((VECTORP (fkey_next) || STRINGP (fkey_next))
284f4730
JB
4456 && fkey_end == t)
4457 {
2e864a76 4458 int len = XFASTINT (Flength (fkey_next));
f5ea6163
JB
4459
4460 t = fkey_start + len;
284f4730
JB
4461 if (t >= bufsize)
4462 error ("key sequence too long");
4463
f5ea6163
JB
4464 if (VECTORP (fkey_next))
4465 bcopy (XVECTOR (fkey_next)->contents,
4466 keybuf + fkey_start,
4467 (t - fkey_start) * sizeof (keybuf[0]));
4468 else if (STRINGP (fkey_next))
4469 {
4470 int i;
4471
4472 for (i = 0; i < len; i++)
1abe6abe
RS
4473 XFASTINT (keybuf[fkey_start + i])
4474 = XSTRING (fkey_next)->data[i];
f5ea6163 4475 }
284f4730
JB
4476
4477 mock_input = t;
4478 fkey_start = fkey_end = t;
32e6d806 4479 fkey_map = Vfunction_key_map;
284f4730 4480
f4255cd1 4481 goto replay_sequence;
284f4730
JB
4482 }
4483
f4255cd1 4484 fkey_map = get_keymap_1 (fkey_next, 0, 1);
284f4730 4485
a764a753
JB
4486 /* If we no longer have a bound suffix, try a new positions for
4487 fkey_start. */
284f4730
JB
4488 if (NILP (fkey_map))
4489 {
4490 fkey_end = ++fkey_start;
4491 fkey_map = Vfunction_key_map;
e9bf89a0 4492 function_key_possible = 0;
284f4730
JB
4493 }
4494 }
4495 }
a612e298
RS
4496
4497 /* Look for this sequence in key-translation-map. */
4498 {
4499 Lisp_Object keytran_next;
4500
4501 /* Scan from keytran_end until we find a bound suffix. */
4502 while (keytran_end < t)
4503 {
4504 Lisp_Object key;
4505
4506 key = keybuf[keytran_end++];
4507 /* Look up meta-characters by prefixing them
4508 with meta_prefix_char. I hate this. */
4509 if (XTYPE (key) == Lisp_Int && XINT (key) & meta_modifier)
4510 {
4511 keytran_next
4512 = get_keymap_1
4513 (get_keyelt
4514 (access_keymap (keytran_map, meta_prefix_char, 1, 0)),
4515 0, 1);
4516 XFASTINT (key) = XFASTINT (key) & ~meta_modifier;
4517 }
4518 else
4519 keytran_next = keytran_map;
4520
4521 keytran_next
4522 = get_keyelt (access_keymap (keytran_next, key, 1, 0));
4523
1abe6abe
RS
4524 /* If the key translation map gives a function, not an
4525 array, then call the function with no args and use
4526 its value instead. */
4527 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
4528 && keytran_end == t)
4529 {
4530 struct gcpro gcpro1, gcpro2, gcpro3;
4531 Lisp_Object tem;
4532 tem = keytran_next;
4533
4534 GCPRO3 (keytran_map, keytran_map, delayed_switch_frame);
84d91fda 4535 keytran_next = call1 (keytran_next, prompt);
1abe6abe
RS
4536 UNGCPRO;
4537 /* If the function returned something invalid,
4538 barf--don't ignore it.
4539 (To ignore it safely, we would need to gcpro a bunch of
4540 other variables.) */
4541 if (! (VECTORP (keytran_next) || STRINGP (keytran_next)))
4542 error ("Function in function-key-map returns invalid key sequence");
4543 }
4544
a612e298 4545 /* If keybuf[keytran_start..keytran_end] is bound in the
1abe6abe 4546 key translation map and it's a suffix of the current
a612e298
RS
4547 sequence (i.e. keytran_end == t), replace it with
4548 the binding and restart with keytran_start at the end. */
4549 if ((VECTORP (keytran_next) || STRINGP (keytran_next))
4550 && keytran_end == t)
4551 {
2e864a76 4552 int len = XFASTINT (Flength (keytran_next));
a612e298
RS
4553
4554 t = keytran_start + len;
4555 if (t >= bufsize)
4556 error ("key sequence too long");
4557
4558 if (VECTORP (keytran_next))
4559 bcopy (XVECTOR (keytran_next)->contents,
4560 keybuf + keytran_start,
4561 (t - keytran_start) * sizeof (keybuf[0]));
4562 else if (STRINGP (keytran_next))
4563 {
4564 int i;
4565
4566 for (i = 0; i < len; i++)
4567 XFASTINT (keybuf[keytran_start + i])
4568 = XSTRING (keytran_next)->data[i];
4569 }
4570
4571 mock_input = t;
4572 keytran_start = keytran_end = t;
4573 keytran_map = Vkey_translation_map;
4574
4575 goto replay_sequence;
4576 }
4577
4578 keytran_map = get_keymap_1 (keytran_next, 0, 1);
4579
4580 /* If we no longer have a bound suffix, try a new positions for
4581 keytran_start. */
4582 if (NILP (keytran_map))
4583 {
4584 keytran_end = ++keytran_start;
4585 keytran_map = Vkey_translation_map;
4586 }
4587 }
4588 }
284f4730
JB
4589 }
4590
4591 read_key_sequence_cmd = (first_binding < nmaps
4592 ? defs[first_binding]
4593 : Qnil);
4594
f4255cd1 4595 done:
cd21b839 4596 unread_switch_frame = delayed_switch_frame;
f4255cd1 4597 unbind_to (count, Qnil);
07f76a14
JB
4598
4599 /* Occasionally we fabricate events, perhaps by expanding something
4600 according to function-key-map, or by adding a prefix symbol to a
4601 mouse click in the scroll bar or modeline. In this cases, return
4602 the entire generated key sequence, even if we hit an unbound
4603 prefix or a definition before the end. This means that you will
4604 be able to push back the event properly, and also means that
4605 read-key-sequence will always return a logical unit.
4606
4607 Better ideas? */
cca310da
JB
4608 for (; t < mock_input; t++)
4609 {
4610 echo_char (keybuf[t]);
4611 add_command_key (keybuf[t]);
4612 }
07f76a14 4613
284f4730
JB
4614 return t;
4615}
4616
a612e298
RS
4617#if 0 /* This doc string is too long for some compilers.
4618 This commented-out definition serves for DOC. */
c0a58692 4619DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 2, 0,
284f4730
JB
4620 "Read a sequence of keystrokes and return as a string or vector.\n\
4621The sequence is sufficient to specify a non-prefix command in the\n\
4622current local and global maps.\n\
4623\n\
c0a58692
RS
4624First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
4625Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\
4626as a continuation of the previous key.\n\
284f4730 4627\n\
cb5df6ae
JB
4628A C-g typed while in this function is treated like any other character,\n\
4629and `quit-flag' is not set.\n\
4630\n\
4631If the key sequence starts with a mouse click, then the sequence is read\n\
4632using the keymaps of the buffer of the window clicked in, not the buffer\n\
4633of the selected window as normal.\n\
ede41463 4634""\n\
cb5df6ae
JB
4635`read-key-sequence' drops unbound button-down events, since you normally\n\
4636only care about the click or drag events which follow them. If a drag\n\
fbcd35bd
JB
4637or multi-click event is unbound, but the corresponding click event would\n\
4638be bound, `read-key-sequence' turns the event into a click event at the\n\
cb5df6ae 4639drag's starting position. This means that you don't have to distinguish\n\
fbcd35bd 4640between click and drag, double, or triple events unless you want to.\n\
cb5df6ae
JB
4641\n\
4642`read-key-sequence' prefixes mouse events on mode lines, the vertical\n\
3c370943
JB
4643lines separating windows, and scroll bars with imaginary keys\n\
4644`mode-line', `vertical-line', and `vertical-scroll-bar'.\n\
cb5df6ae
JB
4645\n\
4646If the user switches frames in the middle of a key sequence, the\n\
4647frame-switch event is put off until after the current key sequence.\n\
4648\n\
4649`read-key-sequence' checks `function-key-map' for function key\n\
4650sequences, where they wouldn't conflict with ordinary bindings. See\n\
4bb994d1 4651`function-key-map' for more details.")
a612e298
RS
4652 (prompt, continue_echo)
4653#endif
4654
4655DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 2, 0,
4656 0)
c0a58692
RS
4657 (prompt, continue_echo)
4658 Lisp_Object prompt, continue_echo;
284f4730
JB
4659{
4660 Lisp_Object keybuf[30];
4661 register int i;
4662 struct gcpro gcpro1, gcpro2;
4663
4664 if (!NILP (prompt))
4665 CHECK_STRING (prompt, 0);
4666 QUIT;
4667
4668 bzero (keybuf, sizeof keybuf);
4669 GCPRO1 (keybuf[0]);
4670 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
4671
daa37602 4672 if (NILP (continue_echo))
c0a58692
RS
4673 this_command_key_count = 0;
4674
84d91fda 4675 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])), prompt);
284f4730 4676
dcc408a0
RS
4677 if (i == -1)
4678 {
4679 Vquit_flag = Qt;
4680 QUIT;
4681 }
284f4730 4682 UNGCPRO;
86e5706b 4683 return make_event_array (i, keybuf);
284f4730
JB
4684}
4685\f
4686DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 2, 0,
4687 "Execute CMD as an editor command.\n\
4688CMD must be a symbol that satisfies the `commandp' predicate.\n\
4689Optional second arg RECORD-FLAG non-nil\n\
4690means unconditionally put this command in `command-history'.\n\
4691Otherwise, that is done only if an arg is read using the minibuffer.")
4692 (cmd, record)
4693 Lisp_Object cmd, record;
4694{
4695 register Lisp_Object final;
4696 register Lisp_Object tem;
4697 Lisp_Object prefixarg;
4698 struct backtrace backtrace;
4699 extern int debug_on_next_call;
4700
4701 prefixarg = Vprefix_arg, Vprefix_arg = Qnil;
4702 Vcurrent_prefix_arg = prefixarg;
4703 debug_on_next_call = 0;
4704
4705 if (XTYPE (cmd) == Lisp_Symbol)
4706 {
4707 tem = Fget (cmd, Qdisabled);
4708 if (!NILP (tem))
2e894dab 4709 return call1 (Vrun_hooks, Qdisabled_command_hook);
284f4730
JB
4710 }
4711
4712 while (1)
4713 {
ffd56f97 4714 final = Findirect_function (cmd);
284f4730
JB
4715
4716 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
4717 do_autoload (final, cmd);
4718 else
4719 break;
4720 }
4721
4722 if (XTYPE (final) == Lisp_String
4723 || XTYPE (final) == Lisp_Vector)
4724 {
4725 /* If requested, place the macro in the command history. For
4726 other sorts of commands, call-interactively takes care of
4727 this. */
4728 if (!NILP (record))
4729 Vcommand_history
4730 = Fcons (Fcons (Qexecute_kbd_macro,
4731 Fcons (final, Fcons (prefixarg, Qnil))),
4732 Vcommand_history);
4733
4734 return Fexecute_kbd_macro (final, prefixarg);
4735 }
4736 if (CONSP (final) || XTYPE (final) == Lisp_Subr
4737 || XTYPE (final) == Lisp_Compiled)
4738 {
4739 backtrace.next = backtrace_list;
4740 backtrace_list = &backtrace;
4741 backtrace.function = &Qcall_interactively;
4742 backtrace.args = &cmd;
4743 backtrace.nargs = 1;
4744 backtrace.evalargs = 0;
4745
4746 tem = Fcall_interactively (cmd, record);
4747
4748 backtrace_list = backtrace.next;
4749 return tem;
4750 }
4751 return Qnil;
4752}
4753\f
284f4730
JB
4754DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
4755 1, 1, "P",
4756 "Read function name, then read its arguments and call it.")
4757 (prefixarg)
4758 Lisp_Object prefixarg;
4759{
4760 Lisp_Object function;
4761 char buf[40];
4762 Lisp_Object saved_keys;
4763 struct gcpro gcpro1;
4764
4765 saved_keys = Fthis_command_keys ();
4766 buf[0] = 0;
4767 GCPRO1 (saved_keys);
4768
4769 if (EQ (prefixarg, Qminus))
4770 strcpy (buf, "- ");
4771 else if (CONSP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4)
4772 strcpy (buf, "C-u ");
4773 else if (CONSP (prefixarg) && XTYPE (XCONS (prefixarg)->car) == Lisp_Int)
4774 sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car));
4775 else if (XTYPE (prefixarg) == Lisp_Int)
4776 sprintf (buf, "%d ", XINT (prefixarg));
4777
4778 /* This isn't strictly correct if execute-extended-command
4779 is bound to anything else. Perhaps it should use
4780 this_command_keys? */
4781 strcat (buf, "M-x ");
4782
4783 /* Prompt with buf, and then read a string, completing from and
4784 restricting to the set of all defined commands. Don't provide
51763820 4785 any initial input. Save the command read on the extended-command
03b4122a 4786 history list. */
284f4730
JB
4787 function = Fcompleting_read (build_string (buf),
4788 Vobarray, Qcommandp,
03b4122a 4789 Qt, Qnil, Qextended_command_history);
284f4730 4790
1113d9db
JB
4791 /* Set this_command_keys to the concatenation of saved_keys and
4792 function, followed by a RET. */
284f4730 4793 {
1113d9db 4794 struct Lisp_String *str;
284f4730
JB
4795 int i;
4796 Lisp_Object tem;
4797
1113d9db
JB
4798 this_command_key_count = 0;
4799
4800 str = XSTRING (saved_keys);
4801 for (i = 0; i < str->size; i++)
284f4730 4802 {
1113d9db 4803 XFASTINT (tem) = str->data[i];
284f4730
JB
4804 add_command_key (tem);
4805 }
1113d9db
JB
4806
4807 str = XSTRING (function);
4808 for (i = 0; i < str->size; i++)
4809 {
4810 XFASTINT (tem) = str->data[i];
4811 add_command_key (tem);
4812 }
4813
4814 XFASTINT (tem) = '\015';
4815 add_command_key (tem);
284f4730
JB
4816 }
4817
4818 UNGCPRO;
4819
0a7f1fc0 4820 function = Fintern (function, Qnil);
284f4730
JB
4821 Vprefix_arg = prefixarg;
4822 this_command = function;
4823
4824 return Fcommand_execute (function, Qt);
4825}
4826\f
4827
4828detect_input_pending ()
4829{
4830 if (!input_pending)
4831 get_input_pending (&input_pending);
4832
4833 return input_pending;
4834}
4835
ffd56f97
JB
4836/* This is called in some cases before a possible quit.
4837 It cases the next call to detect_input_pending to recompute input_pending.
4838 So calling this function unnecessarily can't do any harm. */
4839clear_input_pending ()
4840{
4841 input_pending = 0;
4842}
4843
284f4730
JB
4844DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
4845 "T if command input is currently available with no waiting.\n\
4846Actually, the value is nil only if we can be sure that no input is available.")
4847 ()
4848{
86e5706b 4849 if (!NILP (unread_command_events) || unread_command_char != -1)
284f4730
JB
4850 return (Qt);
4851
4852 return detect_input_pending () ? Qt : Qnil;
4853}
4854
4855DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
22d7cb89 4856 "Return vector of last 100 events, not counting those from keyboard macros.")
284f4730
JB
4857 ()
4858{
5160df46 4859 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
284f4730
JB
4860 Lisp_Object val;
4861
4862 if (total_keys < NUM_RECENT_KEYS)
5160df46 4863 return Fvector (total_keys, keys);
284f4730
JB
4864 else
4865 {
5160df46
JB
4866 val = Fvector (NUM_RECENT_KEYS, keys);
4867 bcopy (keys + recent_keys_index,
284f4730
JB
4868 XVECTOR (val)->contents,
4869 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
5160df46 4870 bcopy (keys,
284f4730
JB
4871 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
4872 recent_keys_index * sizeof (Lisp_Object));
4873 return val;
4874 }
4875}
4876
4877DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
e5f920d7
RS
4878 "Return the key sequence that invoked this command.\n\
4879The value is a string or a vector.")
284f4730
JB
4880 ()
4881{
86e5706b
RS
4882 return make_event_array (this_command_key_count,
4883 XVECTOR (this_command_keys)->contents);
284f4730
JB
4884}
4885
4886DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
4887 "Return the current depth in recursive edits.")
4888 ()
4889{
4890 Lisp_Object temp;
4891 XFASTINT (temp) = command_loop_level + minibuf_level;
4892 return temp;
4893}
4894
4895DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
4896 "FOpen dribble file: ",
9b2471df
RS
4897 "Start writing all keyboard characters to a dribble file called FILE.\n\
4898If FILE is nil, close any open dribble file.")
284f4730
JB
4899 (file)
4900 Lisp_Object file;
4901{
4902 if (NILP (file))
4903 {
4904 fclose (dribble);
4905 dribble = 0;
4906 }
4907 else
4908 {
4909 file = Fexpand_file_name (file, Qnil);
4910 dribble = fopen (XSTRING (file)->data, "w");
4911 }
4912 return Qnil;
4913}
4914
4915DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
4916 "Discard the contents of the terminal input buffer.\n\
4917Also cancel any kbd macro being defined.")
4918 ()
4919{
4920 defining_kbd_macro = 0;
4921 update_mode_lines++;
4922
dbc4e1c1 4923 unread_command_events = Qnil;
86e5706b 4924 unread_command_char = -1;
284f4730
JB
4925
4926 discard_tty_input ();
4927
ff0b5f4c
JB
4928 /* Without the cast, GCC complains that this assignment loses the
4929 volatile qualifier of kbd_store_ptr. Is there anything wrong
4930 with that? */
4931 kbd_fetch_ptr = (struct input_event *) kbd_store_ptr;
7b4aedb9 4932 Ffillarray (kbd_buffer_frame_or_window, Qnil);
284f4730
JB
4933 input_pending = 0;
4934
4935 return Qnil;
4936}
4937\f
4938DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
4939 "Stop Emacs and return to superior process. You can resume later.\n\
4940On systems that don't have job control, run a subshell instead.\n\n\
4941If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
b7d2ebbf
RS
4942to be read as terminal input by Emacs's parent, after suspension.\n\
4943\n\
7df30614 4944Before suspending, call the functions in `suspend-hook' with no args.\n\
b7d2ebbf
RS
4945If any of them returns nil, don't call the rest and don't suspend.\n\
4946Otherwise, suspend normally and after resumption run the normal hook\n\
284f4730
JB
4947`suspend-resume-hook' if that is bound and non-nil.\n\
4948\n\
4949Some operating systems cannot stop the Emacs process and resume it later.\n\
b7d2ebbf 4950On such systems, Emacs starts a subshell instead of suspending.")
284f4730
JB
4951 (stuffstring)
4952 Lisp_Object stuffstring;
4953{
3a69360c 4954 Lisp_Object tem;
284f4730
JB
4955 int count = specpdl_ptr - specpdl;
4956 int old_height, old_width;
4957 int width, height;
b7d2ebbf 4958 struct gcpro gcpro1, gcpro2;
284f4730
JB
4959 extern init_sys_modes ();
4960
4961 if (!NILP (stuffstring))
4962 CHECK_STRING (stuffstring, 0);
284f4730 4963
1e95ed28
JB
4964 /* Run the functions in suspend-hook. */
4965 if (!NILP (Vrun_hooks))
4966 call1 (Vrun_hooks, intern ("suspend-hook"));
284f4730 4967
b7d2ebbf 4968 GCPRO1 (stuffstring);
ff11dfa1 4969 get_frame_size (&old_width, &old_height);
284f4730
JB
4970 reset_sys_modes ();
4971 /* sys_suspend can get an error if it tries to fork a subshell
4972 and the system resources aren't available for that. */
4973 record_unwind_protect (init_sys_modes, 0);
4974 stuff_buffered_input (stuffstring);
4975 sys_suspend ();
4976 unbind_to (count, Qnil);
4977
4978 /* Check if terminal/window size has changed.
4979 Note that this is not useful when we are running directly
4980 with a window system; but suspend should be disabled in that case. */
ff11dfa1 4981 get_frame_size (&width, &height);
284f4730 4982 if (width != old_width || height != old_height)
f5ea6163 4983 change_frame_size (selected_frame, height, width, 0, 0);
284f4730 4984
1e95ed28 4985 /* Run suspend-resume-hook. */
284f4730
JB
4986 if (!NILP (Vrun_hooks))
4987 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
4988
4989 UNGCPRO;
4990 return Qnil;
4991}
4992
4993/* If STUFFSTRING is a string, stuff its contents as pending terminal input.
eb8c3be9 4994 Then in any case stuff anything Emacs has read ahead and not used. */
284f4730
JB
4995
4996stuff_buffered_input (stuffstring)
4997 Lisp_Object stuffstring;
4998{
4999 register unsigned char *p;
5000
5001/* stuff_char works only in BSD, versions 4.2 and up. */
5002#ifdef BSD
5003#ifndef BSD4_1
5004 if (XTYPE (stuffstring) == Lisp_String)
5005 {
5006 register int count;
5007
5008 p = XSTRING (stuffstring)->data;
5009 count = XSTRING (stuffstring)->size;
5010 while (count-- > 0)
5011 stuff_char (*p++);
5012 stuff_char ('\n');
5013 }
5014 /* Anything we have read ahead, put back for the shell to read. */
5015 while (kbd_fetch_ptr != kbd_store_ptr)
5016 {
5017 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
5018 kbd_fetch_ptr = kbd_buffer;
5019 if (kbd_fetch_ptr->kind == ascii_keystroke)
e9bf89a0 5020 stuff_char (kbd_fetch_ptr->code);
4bb994d1 5021 kbd_fetch_ptr->kind = no_event;
7b4aedb9
JB
5022 (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_fetch_ptr
5023 - kbd_buffer]
5024 = Qnil);
284f4730
JB
5025 kbd_fetch_ptr++;
5026 }
5027 input_pending = 0;
5028#endif
5029#endif /* BSD and not BSD4_1 */
5030}
5031\f
ffd56f97
JB
5032set_waiting_for_input (time_to_clear)
5033 EMACS_TIME *time_to_clear;
284f4730 5034{
ffd56f97 5035 input_available_clear_time = time_to_clear;
284f4730
JB
5036
5037 /* Tell interrupt_signal to throw back to read_char, */
5038 waiting_for_input = 1;
5039
5040 /* If interrupt_signal was called before and buffered a C-g,
5041 make it run again now, to avoid timing error. */
5042 if (!NILP (Vquit_flag))
5043 quit_throw_to_read_char ();
284f4730
JB
5044}
5045
5046clear_waiting_for_input ()
5047{
5048 /* Tell interrupt_signal not to throw back to read_char, */
5049 waiting_for_input = 0;
ffd56f97 5050 input_available_clear_time = 0;
284f4730
JB
5051}
5052
5053/* This routine is called at interrupt level in response to C-G.
5054 If interrupt_input, this is the handler for SIGINT.
5055 Otherwise, it is called from kbd_buffer_store_event,
5056 in handling SIGIO or SIGTINT.
5057
5058 If `waiting_for_input' is non zero, then unless `echoing' is nonzero,
5059 immediately throw back to read_char.
5060
5061 Otherwise it sets the Lisp variable quit-flag not-nil.
5062 This causes eval to throw, when it gets a chance.
5063 If quit-flag is already non-nil, it stops the job right away. */
5064
5065SIGTYPE
5066interrupt_signal ()
5067{
5068 char c;
5069 /* Must preserve main program's value of errno. */
5070 int old_errno = errno;
284f4730
JB
5071
5072#ifdef USG
5073 /* USG systems forget handlers when they are used;
5074 must reestablish each time */
5075 signal (SIGINT, interrupt_signal);
5076 signal (SIGQUIT, interrupt_signal);
5077#endif /* USG */
5078
5079 cancel_echoing ();
5080
d5045cf9 5081 if (!NILP (Vquit_flag) && FRAME_TERMCAP_P (selected_frame))
284f4730
JB
5082 {
5083 fflush (stdout);
5084 reset_sys_modes ();
5085 sigfree ();
5086#ifdef SIGTSTP /* Support possible in later USG versions */
5087/*
5088 * On systems which can suspend the current process and return to the original
5089 * shell, this command causes the user to end up back at the shell.
5090 * The "Auto-save" and "Abort" questions are not asked until
5091 * the user elects to return to emacs, at which point he can save the current
5092 * job and either dump core or continue.
5093 */
5094 sys_suspend ();
5095#else
5096#ifdef VMS
5097 if (sys_suspend () == -1)
5098 {
5099 printf ("Not running as a subprocess;\n");
5100 printf ("you can continue or abort.\n");
5101 }
5102#else /* not VMS */
5103 /* Perhaps should really fork an inferior shell?
5104 But that would not provide any way to get back
5105 to the original shell, ever. */
5106 printf ("No support for stopping a process on this operating system;\n");
5107 printf ("you can continue or abort.\n");
5108#endif /* not VMS */
5109#endif /* not SIGTSTP */
5110 printf ("Auto-save? (y or n) ");
5111 fflush (stdout);
5112 if (((c = getchar ()) & ~040) == 'Y')
9fd7d808
RS
5113 {
5114 Fdo_auto_save (Qt, Qnil);
5115 printf ("Auto-save done\n");
5116 }
284f4730
JB
5117 while (c != '\n') c = getchar ();
5118#ifdef VMS
5119 printf ("Abort (and enter debugger)? (y or n) ");
5120#else /* not VMS */
5121 printf ("Abort (and dump core)? (y or n) ");
5122#endif /* not VMS */
5123 fflush (stdout);
5124 if (((c = getchar ()) & ~040) == 'Y')
5125 abort ();
5126 while (c != '\n') c = getchar ();
5127 printf ("Continuing...\n");
5128 fflush (stdout);
5129 init_sys_modes ();
5130 }
5131 else
5132 {
5133 /* If executing a function that wants to be interrupted out of
5134 and the user has not deferred quitting by binding `inhibit-quit'
5135 then quit right away. */
5136 if (immediate_quit && NILP (Vinhibit_quit))
5137 {
5138 immediate_quit = 0;
5139 sigfree ();
5140 Fsignal (Qquit, Qnil);
5141 }
5142 else
5143 /* Else request quit when it's safe */
5144 Vquit_flag = Qt;
5145 }
5146
5147 if (waiting_for_input && !echoing)
5148 quit_throw_to_read_char ();
5149
5150 errno = old_errno;
5151}
5152
5153/* Handle a C-g by making read_char return C-g. */
5154
5155quit_throw_to_read_char ()
5156{
5157 quit_error_check ();
5158 sigfree ();
5159 /* Prevent another signal from doing this before we finish. */
f76475ad 5160 clear_waiting_for_input ();
284f4730
JB
5161 input_pending = 0;
5162
dbc4e1c1 5163 unread_command_events = Qnil;
86e5706b 5164 unread_command_char = -1;
284f4730 5165
e6b01c14
JB
5166#ifdef POLL_FOR_INPUT
5167 /* May be > 1 if in recursive minibuffer. */
5168 if (poll_suppress_count == 0)
5169 abort ();
5170#endif
0dfcc832 5171#ifdef MULTI_FRAME
e9bf89a0
RS
5172 if (XTYPE (internal_last_event_frame) == Lisp_Frame
5173 && XFRAME (internal_last_event_frame) != selected_frame)
3b9189f8 5174 Fhandle_switch_frame (make_lispy_switch_frame (internal_last_event_frame));
0dfcc832 5175#endif
e6b01c14 5176
284f4730
JB
5177 _longjmp (getcjmp, 1);
5178}
5179\f
5180DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
5181 "Set mode of reading keyboard input.\n\
464f8898
RS
5182First arg INTERRUPT non-nil means use input interrupts;\n\
5183 nil means use CBREAK mode.\n\
5184Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
284f4730 5185 (no effect except in CBREAK mode).\n\
b04904fb
RS
5186Third arg META t means accept 8-bit input (for a Meta key).\n\
5187 META nil means ignore the top bit, on the assumption it is parity.\n\
5188 Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\
a8ee7ef9
RS
5189Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\
5190See also `current-input-mode'.")
284f4730
JB
5191 (interrupt, flow, meta, quit)
5192 Lisp_Object interrupt, flow, meta, quit;
5193{
5194 if (!NILP (quit)
5195 && (XTYPE (quit) != Lisp_Int
5196 || XINT (quit) < 0 || XINT (quit) > 0400))
34f04431
RS
5197 error ("set-input-mode: QUIT must be an ASCII character");
5198
5199#ifdef POLL_FOR_INPUT
5200 stop_polling ();
5201#endif
284f4730
JB
5202
5203 reset_sys_modes ();
5204#ifdef SIGIO
5205/* Note SIGIO has been undef'd if FIONREAD is missing. */
5206#ifdef NO_SOCK_SIGIO
5207 if (read_socket_hook)
5208 interrupt_input = 0; /* No interrupts if reading from a socket. */
5209 else
5210#endif /* NO_SOCK_SIGIO */
5211 interrupt_input = !NILP (interrupt);
5212#else /* not SIGIO */
5213 interrupt_input = 0;
5214#endif /* not SIGIO */
5215/* Our VMS input only works by interrupts, as of now. */
5216#ifdef VMS
5217 interrupt_input = 1;
5218#endif
5219 flow_control = !NILP (flow);
b04904fb
RS
5220 if (NILP (meta))
5221 meta_key = 0;
5222 else if (EQ (meta, Qt))
5223 meta_key = 1;
5224 else
5225 meta_key = 2;
284f4730
JB
5226 if (!NILP (quit))
5227 /* Don't let this value be out of range. */
5228 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
5229
5230 init_sys_modes ();
34f04431
RS
5231
5232#ifdef POLL_FOR_INPUT
5233 poll_suppress_count = 1;
5234 start_polling ();
5235#endif
284f4730
JB
5236 return Qnil;
5237}
80645119
JB
5238
5239DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
5240 "Return information about the way Emacs currently reads keyboard input.\n\
5241The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\
5242 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\
5243 nil, Emacs is using CBREAK mode.\n\
5244 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\
5245 terminal; this does not apply if Emacs uses interrupt-driven input.\n\
a8ee7ef9
RS
5246 META is t if accepting 8-bit input with 8th bit as Meta flag.\n\
5247 META nil means ignoring the top bit, on the assumption it is parity.\n\
5248 META is neither t nor nil if accepting 8-bit input and using\n\
5249 all 8 bits as the character code.\n\
80645119
JB
5250 QUIT is the character Emacs currently uses to quit.\n\
5251The elements of this list correspond to the arguments of\n\
a8ee7ef9 5252`set-input-mode'.")
80645119
JB
5253 ()
5254{
5255 Lisp_Object val[4];
5256
5257 val[0] = interrupt_input ? Qt : Qnil;
5258 val[1] = flow_control ? Qt : Qnil;
a8ee7ef9 5259 val[2] = meta_key == 2 ? make_number (0) : meta_key == 1 ? Qt : Qnil;
7b50ece7 5260 XFASTINT (val[3]) = quit_char;
80645119 5261
bf673a7a 5262 return Flist (sizeof (val) / sizeof (val[0]), val);
80645119
JB
5263}
5264
284f4730
JB
5265\f
5266init_keyboard ()
5267{
284f4730
JB
5268 /* This is correct before outermost invocation of the editor loop */
5269 command_loop_level = -1;
5270 immediate_quit = 0;
5271 quit_char = Ctl ('g');
dbc4e1c1 5272 unread_command_events = Qnil;
86e5706b 5273 unread_command_char = -1;
284f4730 5274 total_keys = 0;
9deb415a 5275 recent_keys_index = 0;
284f4730
JB
5276 kbd_fetch_ptr = kbd_buffer;
5277 kbd_store_ptr = kbd_buffer;
5278 do_mouse_tracking = 0;
5279 input_pending = 0;
5280
07d2b8de 5281#ifdef MULTI_FRAME
8f805655
JB
5282 /* This means that command_loop_1 won't try to select anything the first
5283 time through. */
3c370943
JB
5284 internal_last_event_frame = Qnil;
5285 Vlast_event_frame = internal_last_event_frame;
7b4aedb9
JB
5286#endif
5287
5288 /* If we're running a dumped Emacs, we need to clear out
5289 kbd_buffer_frame_or_window, in case some events got into it
5290 before we dumped.
4bb994d1 5291
7b4aedb9
JB
5292 If we're running an undumped Emacs, it hasn't been initialized by
5293 syms_of_keyboard yet. */
4bb994d1 5294 if (initialized)
7b4aedb9 5295 Ffillarray (kbd_buffer_frame_or_window, Qnil);
07d2b8de 5296
284f4730
JB
5297 if (!noninteractive)
5298 {
5299 signal (SIGINT, interrupt_signal);
cb5df6ae 5300#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
284f4730
JB
5301 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
5302 SIGQUIT and we can't tell which one it will give us. */
5303 signal (SIGQUIT, interrupt_signal);
5304#endif /* HAVE_TERMIO */
5305/* Note SIGIO has been undef'd if FIONREAD is missing. */
5306#ifdef SIGIO
5307 signal (SIGIO, input_available_signal);
8ea0a720 5308#endif /* SIGIO */
284f4730
JB
5309 }
5310
5311/* Use interrupt input by default, if it works and noninterrupt input
5312 has deficiencies. */
5313
5314#ifdef INTERRUPT_INPUT
5315 interrupt_input = 1;
5316#else
5317 interrupt_input = 0;
5318#endif
5319
5320/* Our VMS input only works by interrupts, as of now. */
5321#ifdef VMS
5322 interrupt_input = 1;
5323#endif
5324
5325 sigfree ();
5326 dribble = 0;
5327
5328 if (keyboard_init_hook)
5329 (*keyboard_init_hook) ();
5330
5331#ifdef POLL_FOR_INPUT
5332 poll_suppress_count = 1;
5333 start_polling ();
5334#endif
5335}
5336
5337/* This type's only use is in syms_of_keyboard, to initialize the
5338 event header symbols and put properties on them. */
5339struct event_head {
5340 Lisp_Object *var;
5341 char *name;
5342 Lisp_Object *kind;
5343};
5344
5345struct event_head head_table[] = {
7b4aedb9 5346 &Qmouse_movement, "mouse-movement", &Qmouse_movement,
3c370943 5347 &Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement,
7b4aedb9 5348 &Qswitch_frame, "switch-frame", &Qswitch_frame,
284f4730
JB
5349};
5350
5351syms_of_keyboard ()
5352{
2e894dab
RS
5353 Qdisabled_command_hook = intern ("disabled-command-hook");
5354 staticpro (&Qdisabled_command_hook);
5355
284f4730
JB
5356 Qself_insert_command = intern ("self-insert-command");
5357 staticpro (&Qself_insert_command);
5358
5359 Qforward_char = intern ("forward-char");
5360 staticpro (&Qforward_char);
5361
5362 Qbackward_char = intern ("backward-char");
5363 staticpro (&Qbackward_char);
5364
5365 Qdisabled = intern ("disabled");
5366 staticpro (&Qdisabled);
5367
e58aa385
RS
5368 Qundefined = intern ("undefined");
5369 staticpro (&Qundefined);
5370
86e5706b
RS
5371 Qpre_command_hook = intern ("pre-command-hook");
5372 staticpro (&Qpre_command_hook);
5373
5374 Qpost_command_hook = intern ("post-command-hook");
5375 staticpro (&Qpost_command_hook);
5376
284f4730
JB
5377 Qfunction_key = intern ("function-key");
5378 staticpro (&Qfunction_key);
13b5e56c 5379 Qmouse_click = intern ("mouse-click");
284f4730 5380 staticpro (&Qmouse_click);
284f4730 5381
598a9fa7
JB
5382 Qmenu_enable = intern ("menu-enable");
5383 staticpro (&Qmenu_enable);
5384
284f4730
JB
5385 Qmode_line = intern ("mode-line");
5386 staticpro (&Qmode_line);
e5d77022
JB
5387 Qvertical_line = intern ("vertical-line");
5388 staticpro (&Qvertical_line);
3c370943
JB
5389 Qvertical_scroll_bar = intern ("vertical-scroll-bar");
5390 staticpro (&Qvertical_scroll_bar);
5ec75a55
RS
5391 Qmenu_bar = intern ("menu-bar");
5392 staticpro (&Qmenu_bar);
4bb994d1
JB
5393
5394 Qabove_handle = intern ("above-handle");
5395 staticpro (&Qabove_handle);
5396 Qhandle = intern ("handle");
5397 staticpro (&Qhandle);
5398 Qbelow_handle = intern ("below-handle");
5399 staticpro (&Qbelow_handle);
284f4730 5400
cd21b839 5401 Qevent_kind = intern ("event-kind");
284f4730 5402 staticpro (&Qevent_kind);
88cb0656
JB
5403 Qevent_symbol_elements = intern ("event-symbol-elements");
5404 staticpro (&Qevent_symbol_elements);
0a7f1fc0
JB
5405 Qevent_symbol_element_mask = intern ("event-symbol-element-mask");
5406 staticpro (&Qevent_symbol_element_mask);
5407 Qmodifier_cache = intern ("modifier-cache");
5408 staticpro (&Qmodifier_cache);
284f4730 5409
48e416d4
RS
5410 Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar");
5411 staticpro (&Qrecompute_lucid_menubar);
5412 Qactivate_menubar_hook = intern ("activate-menubar-hook");
5413 staticpro (&Qactivate_menubar_hook);
5414
284f4730
JB
5415 {
5416 struct event_head *p;
5417
5418 for (p = head_table;
5419 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
5420 p++)
5421 {
5422 *p->var = intern (p->name);
5423 staticpro (p->var);
5424 Fput (*p->var, Qevent_kind, *p->kind);
88cb0656 5425 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
284f4730
JB
5426 }
5427 }
5428
7b4aedb9
JB
5429 button_down_location = Fmake_vector (make_number (NUM_MOUSE_BUTTONS), Qnil);
5430 staticpro (&button_down_location);
88cb0656
JB
5431
5432 {
5433 int i;
5434 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
5435
5436 modifier_symbols = Fmake_vector (make_number (len), Qnil);
5437 for (i = 0; i < len; i++)
86e5706b
RS
5438 if (modifier_names[i])
5439 XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]);
88cb0656
JB
5440 staticpro (&modifier_symbols);
5441 }
5442
9deb415a
JB
5443 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
5444 staticpro (&recent_keys);
5445
6569cc8d 5446 this_command_keys = Fmake_vector (make_number (40), Qnil);
715d9345 5447 staticpro (&this_command_keys);
6569cc8d 5448
03b4122a
BF
5449 Qextended_command_history = intern ("extended-command-history");
5450 Fset (Qextended_command_history, Qnil);
5451 staticpro (&Qextended_command_history);
5452
7b4aedb9
JB
5453 kbd_buffer_frame_or_window
5454 = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil);
5455 staticpro (&kbd_buffer_frame_or_window);
4bb994d1 5456
284f4730
JB
5457 func_key_syms = Qnil;
5458 staticpro (&func_key_syms);
5459
5460 mouse_syms = Qnil;
5461 staticpro (&mouse_syms);
5462
cd21b839
JB
5463 unread_switch_frame = Qnil;
5464 staticpro (&unread_switch_frame);
5465
284f4730
JB
5466 defsubr (&Sread_key_sequence);
5467 defsubr (&Srecursive_edit);
5468 defsubr (&Strack_mouse);
284f4730
JB
5469 defsubr (&Sinput_pending_p);
5470 defsubr (&Scommand_execute);
5471 defsubr (&Srecent_keys);
5472 defsubr (&Sthis_command_keys);
5473 defsubr (&Ssuspend_emacs);
5474 defsubr (&Sabort_recursive_edit);
5475 defsubr (&Sexit_recursive_edit);
5476 defsubr (&Srecursion_depth);
5477 defsubr (&Stop_level);
5478 defsubr (&Sdiscard_input);
5479 defsubr (&Sopen_dribble_file);
5480 defsubr (&Sset_input_mode);
80645119 5481 defsubr (&Scurrent_input_mode);
284f4730
JB
5482 defsubr (&Sexecute_extended_command);
5483
284f4730 5484 DEFVAR_LISP ("last-command-char", &last_command_char,
86e5706b
RS
5485 "Last input event that was part of a command.");
5486
5487 DEFVAR_LISP ("last-command-event", &last_command_char,
5488 "Last input event that was part of a command.");
284f4730 5489
7d6de002 5490 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
86e5706b 5491 "Last input event in a command, except for mouse menu events.\n\
7d6de002
RS
5492Mouse menus give back keys that don't look like mouse events;\n\
5493this variable holds the actual mouse event that led to the menu,\n\
5494so that you can determine whether the command was run by mouse or not.");
5495
284f4730 5496 DEFVAR_LISP ("last-input-char", &last_input_char,
86e5706b
RS
5497 "Last input event.");
5498
5499 DEFVAR_LISP ("last-input-event", &last_input_char,
5500 "Last input event.");
284f4730 5501
dbc4e1c1 5502 DEFVAR_LISP ("unread-command-events", &unread_command_events,
1c07d0a6 5503 "List of objects to be read as next command input events.");
284f4730 5504
86e5706b
RS
5505 DEFVAR_INT ("unread-command-char", &unread_command_char,
5506 "If not -1, an object to be read as next command input event.");
5507
284f4730
JB
5508 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
5509 "Meta-prefix character code. Meta-foo as command input\n\
5510turns into this character followed by foo.");
5511 XSET (meta_prefix_char, Lisp_Int, 033);
5512
5513 DEFVAR_LISP ("last-command", &last_command,
5514 "The last command executed. Normally a symbol with a function definition,\n\
5515but can be whatever was found in the keymap, or whatever the variable\n\
5516`this-command' was set to by that command.");
5517 last_command = Qnil;
5518
5519 DEFVAR_LISP ("this-command", &this_command,
5520 "The command now being executed.\n\
5521The command can set this variable; whatever is put here\n\
5522will be in `last-command' during the following command.");
5523 this_command = Qnil;
5524
5525 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
5526 "*Number of keyboard input characters between auto-saves.\n\
5527Zero means disable autosaving due to number of characters typed.");
5528 auto_save_interval = 300;
5529
5530 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
5531 "*Number of seconds idle time before auto-save.\n\
06ef7355
RS
5532Zero or nil means disable auto-saving due to idleness.\n\
5533After auto-saving due to this many seconds of idle time,\n\
84447c71 5534Emacs also does a garbage collection if that seems to be warranted.");
284f4730
JB
5535 XFASTINT (Vauto_save_timeout) = 30;
5536
5537 DEFVAR_INT ("echo-keystrokes", &echo_keystrokes,
5538 "*Nonzero means echo unfinished commands after this many seconds of pause.");
5539 echo_keystrokes = 1;
5540
5541 DEFVAR_INT ("polling-period", &polling_period,
5542 "*Interval between polling for input during Lisp execution.\n\
5543The reason for polling is to make C-g work to stop a running program.\n\
5544Polling is needed only when using X windows and SIGIO does not work.\n\
5545Polling is automatically disabled in all other cases.");
5546 polling_period = 2;
5547
564dc952 5548 DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
fbcd35bd 5549 "*Maximum time between mouse clicks to make a double-click.\n\
564dc952
JB
5550Measured in milliseconds. nil means disable double-click recognition;\n\
5551t means double-clicks have no time limit and are detected\n\
fbcd35bd 5552by position only.");
aab06933 5553 Vdouble_click_time = make_number (500);
fbcd35bd 5554
284f4730
JB
5555 DEFVAR_INT ("num-input-keys", &num_input_keys,
5556 "*Number of complete keys read from the keyboard so far.");
5557 num_input_keys = 0;
5558
07d2b8de 5559#ifdef MULTI_FRAME
ff11dfa1 5560 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
fce33686
JB
5561 "*The frame in which the most recently read event occurred.\n\
5562If the last event came from a keyboard macro, this is set to `macro'.");
ff11dfa1 5563 Vlast_event_frame = Qnil;
07d2b8de 5564#endif
284f4730 5565
7e85b935 5566 DEFVAR_LISP ("help-char", &Vhelp_char,
284f4730
JB
5567 "Character to recognize as meaning Help.\n\
5568When it is read, do `(eval help-form)', and display result if it's a string.\n\
5569If the value of `help-form' is nil, this char can be read normally.");
7e85b935 5570 XSET (Vhelp_char, Lisp_Int, Ctl ('H'));
284f4730
JB
5571
5572 DEFVAR_LISP ("help-form", &Vhelp_form,
7e85b935 5573 "Form to execute when character `help-char' is read.\n\
284f4730
JB
5574If the form returns a string, that string is displayed.\n\
5575If `help-form' is nil, the help char is not recognized.");
5576 Vhelp_form = Qnil;
5577
7e85b935
RS
5578 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
5579 "Command to run when `help-char' character follows a prefix key.\n\
5580This command is used only when there is no actual binding\n\
5581for that character after that prefix key.");
5582 Vprefix_help_command = Qnil;
5583
284f4730
JB
5584 DEFVAR_LISP ("top-level", &Vtop_level,
5585 "Form to evaluate when Emacs starts up.\n\
5586Useful to set before you dump a modified Emacs.");
5587 Vtop_level = Qnil;
5588
5589 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
5590 "String used as translate table for keyboard input, or nil.\n\
5591Each character is looked up in this string and the contents used instead.\n\
5592If string is of length N, character codes N and up are untranslated.");
5593 Vkeyboard_translate_table = Qnil;
5594
a612e298
RS
5595 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
5596 "Keymap of key translations that can override keymaps.\n\
5597This keymap works like `function-key-map', but comes after that,\n\
5598and applies even for keys that have ordinary bindings.");
5599 Vkey_translation_map = Qnil;
5600
284f4730 5601 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
7d6de002 5602 "Non-nil means prompt with menus when appropriate.\n\
284f4730 5603This is done when reading from a keymap that has a prompt string,\n\
7d6de002
RS
5604for elements that have prompt strings.\n\
5605The menu is displayed on the screen\n\
5606if X menus were enabled at configuration\n\
5607time and the previous event was a mouse click prefix key.\n\
5608Otherwise, menu prompting uses the echo area.");
284f4730
JB
5609 menu_prompting = 1;
5610
5611 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
5612 "Character to see next line of menu prompt.\n\
5613Type this character while in a menu prompt to rotate around the lines of it.");
5614 XSET (menu_prompt_more_char, Lisp_Int, ' ');
9fa4395d
RS
5615
5616 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
5617 "A mask of additional modifier keys to use with every keyboard character.\n\
ad163903
JB
5618Emacs applies the modifiers of the character stored here to each keyboard\n\
5619character it reads. For example, after evaluating the expression\n\
80645119
JB
5620 (setq extra-keyboard-modifiers ?\C-x)\n\
5621all input characters will have the control modifier applied to them.\n\
5622\n\
5623Note that the character ?\C-@, equivalent to the integer zero, does\n\
5624not count as a control character; rather, it counts as a character\n\
27203ead 5625with no modifiers; thus, setting `extra-keyboard-modifiers' to zero\n\
80645119 5626cancels any modification.");
9fa4395d 5627 extra_keyboard_modifiers = 0;
86e5706b
RS
5628
5629 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
5630 "If an editing command sets this to t, deactivate the mark afterward.\n\
5631The command loop sets this to nil before each command,\n\
5632and tests the value when the command returns.\n\
5633Buffer modification stores t in this variable.");
5634 Vdeactivate_mark = Qnil;
5635
5636 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
5637 "Normal hook run before each command is executed.");
5638 Vpre_command_hook = Qnil;
5639
5640 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
7e85b935 5641 "Normal hook run after each command is executed.");
86e5706b 5642 Vpost_command_hook = Qnil;
48e416d4
RS
5643
5644 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
5645 "t means menu bar, specified Lucid style, needs to be recomputed.");
5646 Vlucid_menu_bar_dirty_flag = Qnil;
a73c5e29 5647
9f9c0e27
RS
5648 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
5649 "List of menu bar items to move to the end of the menu bar.\n\
a612e298 5650The elements of the list are event types that may have menu bar bindings.");
9f9c0e27 5651 Vmenu_bar_final_items = Qnil;
e9bf89a0
RS
5652
5653 DEFVAR_BOOL ("track-mouse", &do_mouse_tracking,
5654 "*Non-nil means generate motion events for mouse motion.");
284f4730
JB
5655}
5656
5657keys_of_keyboard ()
5658{
5659 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
5660 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
5661 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
5662 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
5663 initial_define_key (meta_map, 'x', "execute-extended-command");
5664}