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