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