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