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