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