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