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