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