(eww): Don't interpret "org/foo" as an URL.
[emacs.git] / src / keyboard.c
blob2a50003038d4ffed33a7be9de6a69555fae1fc57
1 /* Keyboard and mouse input; editor command loop.
3 Copyright (C) 1985-1989, 1993-1997, 1999-2015 Free Software Foundation,
4 Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
23 #include "sysstdio.h"
24 #include <sys/stat.h>
26 #include "lisp.h"
27 #include "termchar.h"
28 #include "termopts.h"
29 #include "frame.h"
30 #include "termhooks.h"
31 #include "macros.h"
32 #include "keyboard.h"
33 #include "window.h"
34 #include "commands.h"
35 #include "character.h"
36 #include "buffer.h"
37 #include "disptab.h"
38 #include "dispextern.h"
39 #include "syntax.h"
40 #include "intervals.h"
41 #include "keymap.h"
42 #include "blockinput.h"
43 #include "puresize.h"
44 #include "systime.h"
45 #include "atimer.h"
46 #include "process.h"
47 #include <errno.h>
49 #ifdef HAVE_PTHREAD
50 #include <pthread.h>
51 #endif
52 #ifdef MSDOS
53 #include "msdos.h"
54 #include <time.h>
55 #else /* not MSDOS */
56 #include <sys/ioctl.h>
57 #endif /* not MSDOS */
59 #if defined USABLE_FIONREAD && defined USG5_4
60 # include <sys/filio.h>
61 #endif
63 #include "syssignal.h"
65 #include <sys/types.h>
66 #include <unistd.h>
67 #include <fcntl.h>
69 #ifdef HAVE_WINDOW_SYSTEM
70 #include TERM_HEADER
71 #endif /* HAVE_WINDOW_SYSTEM */
73 /* Variables for blockinput.h: */
75 /* Positive if interrupt input is blocked right now. */
76 volatile int interrupt_input_blocked;
78 /* True means an input interrupt or alarm signal has arrived.
79 The QUIT macro checks this. */
80 volatile bool pending_signals;
82 #define KBD_BUFFER_SIZE 4096
84 KBOARD *initial_kboard;
85 KBOARD *current_kboard;
86 static KBOARD *all_kboards;
88 /* True in the single-kboard state, false in the any-kboard state. */
89 static bool single_kboard;
91 #define NUM_RECENT_KEYS (300)
93 /* Index for storing next element into recent_keys. */
94 static int recent_keys_index;
96 /* Total number of elements stored into recent_keys. */
97 static int total_keys;
99 /* This vector holds the last NUM_RECENT_KEYS keystrokes. */
100 static Lisp_Object recent_keys;
102 /* Vector holding the key sequence that invoked the current command.
103 It is reused for each command, and it may be longer than the current
104 sequence; this_command_key_count indicates how many elements
105 actually mean something.
106 It's easier to staticpro a single Lisp_Object than an array. */
107 Lisp_Object this_command_keys;
108 ptrdiff_t this_command_key_count;
110 /* True after calling Freset_this_command_lengths.
111 Usually it is false. */
112 static bool this_command_key_count_reset;
114 /* This vector is used as a buffer to record the events that were actually read
115 by read_key_sequence. */
116 static Lisp_Object raw_keybuf;
117 static int raw_keybuf_count;
119 #define GROW_RAW_KEYBUF \
120 if (raw_keybuf_count == ASIZE (raw_keybuf)) \
121 raw_keybuf = larger_vector (raw_keybuf, 1, -1)
123 /* Number of elements of this_command_keys
124 that precede this key sequence. */
125 static ptrdiff_t this_single_command_key_start;
127 /* Record values of this_command_key_count and echo_length ()
128 before this command was read. */
129 static ptrdiff_t before_command_key_count;
130 static ptrdiff_t before_command_echo_length;
132 #ifdef HAVE_STACK_OVERFLOW_HANDLING
134 /* For longjmp to recover from C stack overflow. */
135 sigjmp_buf return_to_command_loop;
137 /* Message displayed by Vtop_level when recovering from C stack overflow. */
138 static Lisp_Object recover_top_level_message;
140 #endif /* HAVE_STACK_OVERFLOW_HANDLING */
142 /* Message normally displayed by Vtop_level. */
143 static Lisp_Object regular_top_level_message;
145 /* For longjmp to where kbd input is being done. */
147 static sys_jmp_buf getcjmp;
149 /* True while doing kbd input. */
150 bool waiting_for_input;
152 /* True while displaying for echoing. Delays C-g throwing. */
154 static bool echoing;
156 /* Non-null means we can start echoing at the next input pause even
157 though there is something in the echo area. */
159 static struct kboard *ok_to_echo_at_next_pause;
161 /* The kboard last echoing, or null for none. Reset to 0 in
162 cancel_echoing. If non-null, and a current echo area message
163 exists, and echo_message_buffer is eq to the current message
164 buffer, we know that the message comes from echo_kboard. */
166 struct kboard *echo_kboard;
168 /* The buffer used for echoing. Set in echo_now, reset in
169 cancel_echoing. */
171 Lisp_Object echo_message_buffer;
173 /* True means C-g should cause immediate error-signal. */
174 bool immediate_quit;
176 /* Character that causes a quit. Normally C-g.
178 If we are running on an ordinary terminal, this must be an ordinary
179 ASCII char, since we want to make it our interrupt character.
181 If we are not running on an ordinary terminal, it still needs to be
182 an ordinary ASCII char. This character needs to be recognized in
183 the input interrupt handler. At this point, the keystroke is
184 represented as a struct input_event, while the desired quit
185 character is specified as a lispy event. The mapping from struct
186 input_events to lispy events cannot run in an interrupt handler,
187 and the reverse mapping is difficult for anything but ASCII
188 keystrokes.
190 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
191 ASCII character. */
192 int quit_char;
194 /* Current depth in recursive edits. */
195 EMACS_INT command_loop_level;
197 /* If not Qnil, this is a switch-frame event which we decided to put
198 off until the end of a key sequence. This should be read as the
199 next command input, after any unread_command_events.
201 read_key_sequence uses this to delay switch-frame events until the
202 end of the key sequence; Fread_char uses it to put off switch-frame
203 events until a non-ASCII event is acceptable as input. */
204 Lisp_Object unread_switch_frame;
206 /* Last size recorded for a current buffer which is not a minibuffer. */
207 static ptrdiff_t last_non_minibuf_size;
209 /* Total number of times read_char has returned, modulo UINTMAX_MAX + 1. */
210 uintmax_t num_input_events;
212 /* Value of num_nonmacro_input_events as of last auto save. */
214 static EMACS_INT last_auto_save;
216 /* The value of point when the last command was started. */
217 static ptrdiff_t last_point_position;
219 /* The frame in which the last input event occurred, or Qmacro if the
220 last event came from a macro. We use this to determine when to
221 generate switch-frame events. This may be cleared by functions
222 like Fselect_frame, to make sure that a switch-frame event is
223 generated by the next character.
225 FIXME: This is modified by a signal handler so it should be volatile.
226 It's exported to Lisp, though, so it can't simply be marked
227 'volatile' here. */
228 Lisp_Object internal_last_event_frame;
230 /* `read_key_sequence' stores here the command definition of the
231 key sequence that it reads. */
232 static Lisp_Object read_key_sequence_cmd;
233 static Lisp_Object read_key_sequence_remapped;
235 /* File in which we write all commands we read. */
236 static FILE *dribble;
238 /* True if input is available. */
239 bool input_pending;
241 /* True if more input was available last time we read an event.
243 Since redisplay can take a significant amount of time and is not
244 indispensable to perform the user's commands, when input arrives
245 "too fast", Emacs skips redisplay. More specifically, if the next
246 command has already been input when we finish the previous command,
247 we skip the intermediate redisplay.
249 This is useful to try and make sure Emacs keeps up with fast input
250 rates, such as auto-repeating keys. But in some cases, this proves
251 too conservative: we may end up disabling redisplay for the whole
252 duration of a key repetition, even though we could afford to
253 redisplay every once in a while.
255 So we "sample" the input_pending flag before running a command and
256 use *that* value after running the command to decide whether to
257 skip redisplay or not. This way, we only skip redisplay if we
258 really can't keep up with the repeat rate.
260 This only makes a difference if the next input arrives while running the
261 command, which is very unlikely if the command is executed quickly.
262 IOW this tends to avoid skipping redisplay after a long running command
263 (which is a case where skipping redisplay is not very useful since the
264 redisplay time is small compared to the time it took to run the command).
266 A typical use case is when scrolling. Scrolling time can be split into:
267 - Time to do jit-lock on the newly displayed portion of buffer.
268 - Time to run the actual scroll command.
269 - Time to perform the redisplay.
270 Jit-lock can happen either during the command or during the redisplay.
271 In the most painful cases, the jit-lock time is the one that dominates.
272 Also jit-lock can be tweaked (via jit-lock-defer) to delay its job, at the
273 cost of temporary inaccuracy in display and scrolling.
274 So without input_was_pending, what typically happens is the following:
275 - when the command starts, there's no pending input (yet).
276 - the scroll command triggers jit-lock.
277 - during the long jit-lock time the next input arrives.
278 - at the end of the command, we check input_pending and hence decide to
279 skip redisplay.
280 - we read the next input and start over.
281 End result: all the hard work of jit-locking is "wasted" since redisplay
282 doesn't actually happens (at least not before the input rate slows down).
283 With input_was_pending redisplay is still skipped if Emacs can't keep up
284 with the input rate, but if it can keep up just enough that there's no
285 input_pending when we begin the command, then redisplay is not skipped
286 which results in better feedback to the user. */
287 static bool input_was_pending;
289 /* Circular buffer for pre-read keyboard input. */
291 static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
293 /* Pointer to next available character in kbd_buffer.
294 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
295 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the
296 next available char is in kbd_buffer[0]. */
297 static struct input_event *kbd_fetch_ptr;
299 /* Pointer to next place to store character in kbd_buffer. This
300 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
301 character should go in kbd_buffer[0]. */
302 static struct input_event * volatile kbd_store_ptr;
304 /* The above pair of variables forms a "queue empty" flag. When we
305 enqueue a non-hook event, we increment kbd_store_ptr. When we
306 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
307 there is input available if the two pointers are not equal.
309 Why not just have a flag set and cleared by the enqueuing and
310 dequeuing functions? Such a flag could be screwed up by interrupts
311 at inopportune times. */
313 static void recursive_edit_unwind (Lisp_Object buffer);
314 static Lisp_Object command_loop (void);
316 static void echo_now (void);
317 static ptrdiff_t echo_length (void);
319 /* Incremented whenever a timer is run. */
320 unsigned timers_run;
322 /* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt
323 happens. */
324 struct timespec *input_available_clear_time;
326 /* True means use SIGIO interrupts; false means use CBREAK mode.
327 Default is true if INTERRUPT_INPUT is defined. */
328 bool interrupt_input;
330 /* Nonzero while interrupts are temporarily deferred during redisplay. */
331 bool interrupts_deferred;
333 /* The time when Emacs started being idle. */
335 static struct timespec timer_idleness_start_time;
337 /* After Emacs stops being idle, this saves the last value
338 of timer_idleness_start_time from when it was idle. */
340 static struct timespec timer_last_idleness_start_time;
343 /* Global variable declarations. */
345 /* Flags for readable_events. */
346 #define READABLE_EVENTS_DO_TIMERS_NOW (1 << 0)
347 #define READABLE_EVENTS_FILTER_EVENTS (1 << 1)
348 #define READABLE_EVENTS_IGNORE_SQUEEZABLES (1 << 2)
350 /* Function for init_keyboard to call with no args (if nonzero). */
351 static void (*keyboard_init_hook) (void);
353 static bool get_input_pending (int);
354 static bool readable_events (int);
355 static Lisp_Object read_char_x_menu_prompt (Lisp_Object,
356 Lisp_Object, bool *);
357 static Lisp_Object read_char_minibuf_menu_prompt (int, Lisp_Object);
358 static Lisp_Object make_lispy_event (struct input_event *);
359 static Lisp_Object make_lispy_movement (struct frame *, Lisp_Object,
360 enum scroll_bar_part,
361 Lisp_Object, Lisp_Object,
362 Time);
363 static Lisp_Object modify_event_symbol (ptrdiff_t, int, Lisp_Object,
364 Lisp_Object, const char *const *,
365 Lisp_Object *, ptrdiff_t);
366 static Lisp_Object make_lispy_switch_frame (Lisp_Object);
367 static Lisp_Object make_lispy_focus_in (Lisp_Object);
368 #ifdef HAVE_WINDOW_SYSTEM
369 static Lisp_Object make_lispy_focus_out (Lisp_Object);
370 #endif /* HAVE_WINDOW_SYSTEM */
371 static bool help_char_p (Lisp_Object);
372 static void save_getcjmp (sys_jmp_buf);
373 static void restore_getcjmp (sys_jmp_buf);
374 static Lisp_Object apply_modifiers (int, Lisp_Object);
375 static void clear_event (struct input_event *);
376 static void restore_kboard_configuration (int);
377 #ifdef USABLE_SIGIO
378 static void deliver_input_available_signal (int signo);
379 #endif
380 static void handle_interrupt (bool);
381 static _Noreturn void quit_throw_to_read_char (bool);
382 static void process_special_events (void);
383 static void timer_start_idle (void);
384 static void timer_stop_idle (void);
385 static void timer_resume_idle (void);
386 static void deliver_user_signal (int);
387 static char *find_user_signal_name (int);
388 static void store_user_signal_events (void);
390 /* These setters are used only in this file, so they can be private. */
391 static void
392 kset_echo_string (struct kboard *kb, Lisp_Object val)
394 kb->INTERNAL_FIELD (echo_string) = val;
396 static void
397 kset_kbd_queue (struct kboard *kb, Lisp_Object val)
399 kb->INTERNAL_FIELD (kbd_queue) = val;
401 static void
402 kset_keyboard_translate_table (struct kboard *kb, Lisp_Object val)
404 kb->INTERNAL_FIELD (Vkeyboard_translate_table) = val;
406 static void
407 kset_last_prefix_arg (struct kboard *kb, Lisp_Object val)
409 kb->INTERNAL_FIELD (Vlast_prefix_arg) = val;
411 static void
412 kset_last_repeatable_command (struct kboard *kb, Lisp_Object val)
414 kb->INTERNAL_FIELD (Vlast_repeatable_command) = val;
416 static void
417 kset_local_function_key_map (struct kboard *kb, Lisp_Object val)
419 kb->INTERNAL_FIELD (Vlocal_function_key_map) = val;
421 static void
422 kset_overriding_terminal_local_map (struct kboard *kb, Lisp_Object val)
424 kb->INTERNAL_FIELD (Voverriding_terminal_local_map) = val;
426 static void
427 kset_real_last_command (struct kboard *kb, Lisp_Object val)
429 kb->INTERNAL_FIELD (Vreal_last_command) = val;
431 static void
432 kset_system_key_syms (struct kboard *kb, Lisp_Object val)
434 kb->INTERNAL_FIELD (system_key_syms) = val;
438 /* Add C to the echo string, without echoing it immediately. C can be
439 a character, which is pretty-printed, or a symbol, whose name is
440 printed. */
442 static void
443 echo_add_key (Lisp_Object c)
445 char initbuf[KEY_DESCRIPTION_SIZE + 100];
446 ptrdiff_t size = sizeof initbuf;
447 char *buffer = initbuf;
448 char *ptr = buffer;
449 Lisp_Object echo_string;
450 USE_SAFE_ALLOCA;
452 echo_string = KVAR (current_kboard, echo_string);
454 /* If someone has passed us a composite event, use its head symbol. */
455 c = EVENT_HEAD (c);
457 if (INTEGERP (c))
458 ptr = push_key_description (XINT (c), ptr);
459 else if (SYMBOLP (c))
461 Lisp_Object name = SYMBOL_NAME (c);
462 ptrdiff_t nbytes = SBYTES (name);
464 if (size - (ptr - buffer) < nbytes)
466 ptrdiff_t offset = ptr - buffer;
467 size = max (2 * size, size + nbytes);
468 buffer = SAFE_ALLOCA (size);
469 ptr = buffer + offset;
472 ptr += copy_text (SDATA (name), (unsigned char *) ptr, nbytes,
473 STRING_MULTIBYTE (name), 1);
476 if ((NILP (echo_string) || SCHARS (echo_string) == 0)
477 && help_char_p (c))
479 static const char text[] = " (Type ? for further options)";
480 int len = sizeof text - 1;
482 if (size - (ptr - buffer) < len)
484 ptrdiff_t offset = ptr - buffer;
485 size += len;
486 buffer = SAFE_ALLOCA (size);
487 ptr = buffer + offset;
490 memcpy (ptr, text, len);
491 ptr += len;
494 /* Replace a dash from echo_dash with a space, otherwise add a space
495 at the end as a separator between keys. */
496 AUTO_STRING (space, " ");
497 if (STRINGP (echo_string) && SCHARS (echo_string) > 1)
499 Lisp_Object last_char, prev_char, idx;
501 idx = make_number (SCHARS (echo_string) - 2);
502 prev_char = Faref (echo_string, idx);
504 idx = make_number (SCHARS (echo_string) - 1);
505 last_char = Faref (echo_string, idx);
507 /* We test PREV_CHAR to make sure this isn't the echoing of a
508 minus-sign. */
509 if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
510 Faset (echo_string, idx, make_number (' '));
511 else
512 echo_string = concat2 (echo_string, space);
514 else if (STRINGP (echo_string) && SCHARS (echo_string) > 0)
515 echo_string = concat2 (echo_string, space);
517 kset_echo_string
518 (current_kboard,
519 concat2 (echo_string, make_string (buffer, ptr - buffer)));
520 SAFE_FREE ();
523 /* Add C to the echo string, if echoing is going on. C can be a
524 character or a symbol. */
526 static void
527 echo_char (Lisp_Object c)
529 if (current_kboard->immediate_echo)
531 echo_add_key (c);
532 echo_now ();
536 /* Temporarily add a dash to the end of the echo string if it's not
537 empty, so that it serves as a mini-prompt for the very next
538 character. */
540 static void
541 echo_dash (void)
543 /* Do nothing if not echoing at all. */
544 if (NILP (KVAR (current_kboard, echo_string)))
545 return;
547 if (this_command_key_count == 0)
548 return;
550 if (!current_kboard->immediate_echo
551 && SCHARS (KVAR (current_kboard, echo_string)) == 0)
552 return;
554 /* Do nothing if we just printed a prompt. */
555 if (current_kboard->echo_after_prompt
556 == SCHARS (KVAR (current_kboard, echo_string)))
557 return;
559 /* Do nothing if we have already put a dash at the end. */
560 if (SCHARS (KVAR (current_kboard, echo_string)) > 1)
562 Lisp_Object last_char, prev_char, idx;
564 idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 2);
565 prev_char = Faref (KVAR (current_kboard, echo_string), idx);
567 idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 1);
568 last_char = Faref (KVAR (current_kboard, echo_string), idx);
570 if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
571 return;
574 /* Put a dash at the end of the buffer temporarily,
575 but make it go away when the next character is added. */
576 AUTO_STRING (dash, "-");
577 kset_echo_string (current_kboard,
578 concat2 (KVAR (current_kboard, echo_string), dash));
579 echo_now ();
582 /* Display the current echo string, and begin echoing if not already
583 doing so. */
585 static void
586 echo_now (void)
588 if (!current_kboard->immediate_echo)
590 ptrdiff_t i;
591 current_kboard->immediate_echo = 1;
593 for (i = 0; i < this_command_key_count; i++)
595 Lisp_Object c;
597 /* Set before_command_echo_length to the value that would
598 have been saved before the start of this subcommand in
599 command_loop_1, if we had already been echoing then. */
600 if (i == this_single_command_key_start)
601 before_command_echo_length = echo_length ();
603 c = AREF (this_command_keys, i);
604 if (! (EVENT_HAS_PARAMETERS (c)
605 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
606 echo_char (c);
609 /* Set before_command_echo_length to the value that would
610 have been saved before the start of this subcommand in
611 command_loop_1, if we had already been echoing then. */
612 if (this_command_key_count == this_single_command_key_start)
613 before_command_echo_length = echo_length ();
615 /* Put a dash at the end to invite the user to type more. */
616 echo_dash ();
619 echoing = 1;
620 /* FIXME: Use call (Qmessage) so it can be advised (e.g. emacspeak). */
621 message3_nolog (KVAR (current_kboard, echo_string));
622 echoing = 0;
624 /* Record in what buffer we echoed, and from which kboard. */
625 echo_message_buffer = echo_area_buffer[0];
626 echo_kboard = current_kboard;
628 if (waiting_for_input && !NILP (Vquit_flag))
629 quit_throw_to_read_char (0);
632 /* Turn off echoing, for the start of a new command. */
634 void
635 cancel_echoing (void)
637 current_kboard->immediate_echo = 0;
638 current_kboard->echo_after_prompt = -1;
639 kset_echo_string (current_kboard, Qnil);
640 ok_to_echo_at_next_pause = NULL;
641 echo_kboard = NULL;
642 echo_message_buffer = Qnil;
645 /* Return the length of the current echo string. */
647 static ptrdiff_t
648 echo_length (void)
650 return (STRINGP (KVAR (current_kboard, echo_string))
651 ? SCHARS (KVAR (current_kboard, echo_string))
652 : 0);
655 /* Truncate the current echo message to its first LEN chars.
656 This and echo_char get used by read_key_sequence when the user
657 switches frames while entering a key sequence. */
659 static void
660 echo_truncate (ptrdiff_t nchars)
662 if (STRINGP (KVAR (current_kboard, echo_string)))
663 kset_echo_string (current_kboard,
664 Fsubstring (KVAR (current_kboard, echo_string),
665 make_number (0), make_number (nchars)));
666 truncate_echo_area (nchars);
670 /* Functions for manipulating this_command_keys. */
671 static void
672 add_command_key (Lisp_Object key)
674 #if 0 /* Not needed after we made Freset_this_command_lengths
675 do the job immediately. */
676 /* If reset-this-command-length was called recently, obey it now.
677 See the doc string of that function for an explanation of why. */
678 if (before_command_restore_flag)
680 this_command_key_count = before_command_key_count_1;
681 if (this_command_key_count < this_single_command_key_start)
682 this_single_command_key_start = this_command_key_count;
683 echo_truncate (before_command_echo_length_1);
684 before_command_restore_flag = 0;
686 #endif
688 if (this_command_key_count >= ASIZE (this_command_keys))
689 this_command_keys = larger_vector (this_command_keys, 1, -1);
691 ASET (this_command_keys, this_command_key_count, key);
692 ++this_command_key_count;
696 Lisp_Object
697 recursive_edit_1 (void)
699 ptrdiff_t count = SPECPDL_INDEX ();
700 Lisp_Object val;
702 if (command_loop_level > 0)
704 specbind (Qstandard_output, Qt);
705 specbind (Qstandard_input, Qt);
708 #ifdef HAVE_WINDOW_SYSTEM
709 /* The command loop has started an hourglass timer, so we have to
710 cancel it here, otherwise it will fire because the recursive edit
711 can take some time. Do not check for display_hourglass_p here,
712 because it could already be nil. */
713 cancel_hourglass ();
714 #endif
716 /* This function may have been called from a debugger called from
717 within redisplay, for instance by Edebugging a function called
718 from fontification-functions. We want to allow redisplay in
719 the debugging session.
721 The recursive edit is left with a `(throw exit ...)'. The `exit'
722 tag is not caught anywhere in redisplay, i.e. when we leave the
723 recursive edit, the original redisplay leading to the recursive
724 edit will be unwound. The outcome should therefore be safe. */
725 specbind (Qinhibit_redisplay, Qnil);
726 redisplaying_p = 0;
728 val = command_loop ();
729 if (EQ (val, Qt))
730 Fsignal (Qquit, Qnil);
731 /* Handle throw from read_minibuf when using minibuffer
732 while it's active but we're in another window. */
733 if (STRINGP (val))
734 xsignal1 (Qerror, val);
736 return unbind_to (count, Qnil);
739 /* When an auto-save happens, record the "time", and don't do again soon. */
741 void
742 record_auto_save (void)
744 last_auto_save = num_nonmacro_input_events;
747 /* Make an auto save happen as soon as possible at command level. */
749 #ifdef SIGDANGER
750 void
751 force_auto_save_soon (void)
753 last_auto_save = - auto_save_interval - 1;
755 record_asynch_buffer_change ();
757 #endif
759 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
760 doc: /* Invoke the editor command loop recursively.
761 To get out of the recursive edit, a command can throw to `exit' -- for
762 instance `(throw 'exit nil)'.
763 If you throw a value other than t, `recursive-edit' returns normally
764 to the function that called it. Throwing a t value causes
765 `recursive-edit' to quit, so that control returns to the command loop
766 one level up.
768 This function is called by the editor initialization to begin editing. */)
769 (void)
771 ptrdiff_t count = SPECPDL_INDEX ();
772 Lisp_Object buffer;
774 /* If we enter while input is blocked, don't lock up here.
775 This may happen through the debugger during redisplay. */
776 if (input_blocked_p ())
777 return Qnil;
779 if (command_loop_level >= 0
780 && current_buffer != XBUFFER (XWINDOW (selected_window)->contents))
781 buffer = Fcurrent_buffer ();
782 else
783 buffer = Qnil;
785 /* Don't do anything interesting between the increment and the
786 record_unwind_protect! Otherwise, we could get distracted and
787 never decrement the counter again. */
788 command_loop_level++;
789 update_mode_lines = 17;
790 record_unwind_protect (recursive_edit_unwind, buffer);
792 /* If we leave recursive_edit_1 below with a `throw' for instance,
793 like it is done in the splash screen display, we have to
794 make sure that we restore single_kboard as command_loop_1
795 would have done if it were left normally. */
796 if (command_loop_level > 0)
797 temporarily_switch_to_single_kboard (SELECTED_FRAME ());
799 recursive_edit_1 ();
800 return unbind_to (count, Qnil);
803 void
804 recursive_edit_unwind (Lisp_Object buffer)
806 if (BUFFERP (buffer))
807 Fset_buffer (buffer);
809 command_loop_level--;
810 update_mode_lines = 18;
814 #if 0 /* These two functions are now replaced with
815 temporarily_switch_to_single_kboard. */
816 static void
817 any_kboard_state ()
819 #if 0 /* Theory: if there's anything in Vunread_command_events,
820 it will right away be read by read_key_sequence,
821 and then if we do switch KBOARDS, it will go into the side
822 queue then. So we don't need to do anything special here -- rms. */
823 if (CONSP (Vunread_command_events))
825 current_kboard->kbd_queue
826 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
827 current_kboard->kbd_queue_has_data = 1;
829 Vunread_command_events = Qnil;
830 #endif
831 single_kboard = 0;
834 /* Switch to the single-kboard state, making current_kboard
835 the only KBOARD from which further input is accepted. */
837 void
838 single_kboard_state ()
840 single_kboard = 1;
842 #endif
844 /* If we're in single_kboard state for kboard KBOARD,
845 get out of it. */
847 void
848 not_single_kboard_state (KBOARD *kboard)
850 if (kboard == current_kboard)
851 single_kboard = 0;
854 /* Maintain a stack of kboards, so other parts of Emacs
855 can switch temporarily to the kboard of a given frame
856 and then revert to the previous status. */
858 struct kboard_stack
860 KBOARD *kboard;
861 struct kboard_stack *next;
864 static struct kboard_stack *kboard_stack;
866 void
867 push_kboard (struct kboard *k)
869 struct kboard_stack *p = xmalloc (sizeof *p);
871 p->next = kboard_stack;
872 p->kboard = current_kboard;
873 kboard_stack = p;
875 current_kboard = k;
878 void
879 pop_kboard (void)
881 struct terminal *t;
882 struct kboard_stack *p = kboard_stack;
883 bool found = 0;
884 for (t = terminal_list; t; t = t->next_terminal)
886 if (t->kboard == p->kboard)
888 current_kboard = p->kboard;
889 found = 1;
890 break;
893 if (!found)
895 /* The terminal we remembered has been deleted. */
896 current_kboard = FRAME_KBOARD (SELECTED_FRAME ());
897 single_kboard = 0;
899 kboard_stack = p->next;
900 xfree (p);
903 /* Switch to single_kboard mode, making current_kboard the only KBOARD
904 from which further input is accepted. If F is non-nil, set its
905 KBOARD as the current keyboard.
907 This function uses record_unwind_protect_int to return to the previous
908 state later.
910 If Emacs is already in single_kboard mode, and F's keyboard is
911 locked, then this function will throw an error. */
913 void
914 temporarily_switch_to_single_kboard (struct frame *f)
916 bool was_locked = single_kboard;
917 if (was_locked)
919 if (f != NULL && FRAME_KBOARD (f) != current_kboard)
920 /* We can not switch keyboards while in single_kboard mode.
921 In rare cases, Lisp code may call `recursive-edit' (or
922 `read-minibuffer' or `y-or-n-p') after it switched to a
923 locked frame. For example, this is likely to happen
924 when server.el connects to a new terminal while Emacs is in
925 single_kboard mode. It is best to throw an error instead
926 of presenting the user with a frozen screen. */
927 error ("Terminal %d is locked, cannot read from it",
928 FRAME_TERMINAL (f)->id);
929 else
930 /* This call is unnecessary, but helps
931 `restore_kboard_configuration' discover if somebody changed
932 `current_kboard' behind our back. */
933 push_kboard (current_kboard);
935 else if (f != NULL)
936 current_kboard = FRAME_KBOARD (f);
937 single_kboard = 1;
938 record_unwind_protect_int (restore_kboard_configuration, was_locked);
941 #if 0 /* This function is not needed anymore. */
942 void
943 record_single_kboard_state ()
945 if (single_kboard)
946 push_kboard (current_kboard);
947 record_unwind_protect_int (restore_kboard_configuration, single_kboard);
949 #endif
951 static void
952 restore_kboard_configuration (int was_locked)
954 single_kboard = was_locked;
955 if (was_locked)
957 struct kboard *prev = current_kboard;
958 pop_kboard ();
959 /* The pop should not change the kboard. */
960 if (single_kboard && current_kboard != prev)
961 emacs_abort ();
966 /* Handle errors that are not handled at inner levels
967 by printing an error message and returning to the editor command loop. */
969 static Lisp_Object
970 cmd_error (Lisp_Object data)
972 Lisp_Object old_level, old_length;
973 char macroerror[sizeof "After..kbd macro iterations: "
974 + INT_STRLEN_BOUND (EMACS_INT)];
976 #ifdef HAVE_WINDOW_SYSTEM
977 if (display_hourglass_p)
978 cancel_hourglass ();
979 #endif
981 if (!NILP (executing_kbd_macro))
983 if (executing_kbd_macro_iterations == 1)
984 sprintf (macroerror, "After 1 kbd macro iteration: ");
985 else
986 sprintf (macroerror, "After %"pI"d kbd macro iterations: ",
987 executing_kbd_macro_iterations);
989 else
990 *macroerror = 0;
992 Vstandard_output = Qt;
993 Vstandard_input = Qt;
994 Vexecuting_kbd_macro = Qnil;
995 executing_kbd_macro = Qnil;
996 kset_prefix_arg (current_kboard, Qnil);
997 kset_last_prefix_arg (current_kboard, Qnil);
998 cancel_echoing ();
1000 /* Avoid unquittable loop if data contains a circular list. */
1001 old_level = Vprint_level;
1002 old_length = Vprint_length;
1003 XSETFASTINT (Vprint_level, 10);
1004 XSETFASTINT (Vprint_length, 10);
1005 cmd_error_internal (data, macroerror);
1006 Vprint_level = old_level;
1007 Vprint_length = old_length;
1009 Vquit_flag = Qnil;
1010 Vinhibit_quit = Qnil;
1012 return make_number (0);
1015 /* Take actions on handling an error. DATA is the data that describes
1016 the error.
1018 CONTEXT is a C-string containing ASCII characters only which
1019 describes the context in which the error happened. If we need to
1020 generalize CONTEXT to allow multibyte characters, make it a Lisp
1021 string. */
1023 void
1024 cmd_error_internal (Lisp_Object data, const char *context)
1026 /* The immediate context is not interesting for Quits,
1027 since they are asynchronous. */
1028 if (EQ (XCAR (data), Qquit))
1029 Vsignaling_function = Qnil;
1031 Vquit_flag = Qnil;
1032 Vinhibit_quit = Qt;
1034 /* Use user's specified output function if any. */
1035 if (!NILP (Vcommand_error_function))
1036 call3 (Vcommand_error_function, data,
1037 context ? build_string (context) : empty_unibyte_string,
1038 Vsignaling_function);
1040 Vsignaling_function = Qnil;
1043 DEFUN ("command-error-default-function", Fcommand_error_default_function,
1044 Scommand_error_default_function, 3, 3, 0,
1045 doc: /* Produce default output for unhandled error message.
1046 Default value of `command-error-function'. */)
1047 (Lisp_Object data, Lisp_Object context, Lisp_Object signal)
1049 struct frame *sf = SELECTED_FRAME ();
1051 CHECK_STRING (context);
1053 /* If the window system or terminal frame hasn't been initialized
1054 yet, or we're not interactive, write the message to stderr and exit. */
1055 if (!sf->glyphs_initialized_p
1056 /* The initial frame is a special non-displaying frame. It
1057 will be current in daemon mode when there are no frames
1058 to display, and in non-daemon mode before the real frame
1059 has finished initializing. If an error is thrown in the
1060 latter case while creating the frame, then the frame
1061 will never be displayed, so the safest thing to do is
1062 write to stderr and quit. In daemon mode, there are
1063 many other potential errors that do not prevent frames
1064 from being created, so continuing as normal is better in
1065 that case. */
1066 || (!IS_DAEMON && FRAME_INITIAL_P (sf))
1067 || noninteractive)
1069 print_error_message (data, Qexternal_debugging_output,
1070 SSDATA (context), signal);
1071 Fterpri (Qexternal_debugging_output, Qnil);
1072 Fkill_emacs (make_number (-1));
1074 else
1076 clear_message (1, 0);
1077 Fdiscard_input ();
1078 message_log_maybe_newline ();
1079 bitch_at_user ();
1081 print_error_message (data, Qt, SSDATA (context), signal);
1083 return Qnil;
1086 static Lisp_Object command_loop_2 (Lisp_Object);
1087 static Lisp_Object top_level_1 (Lisp_Object);
1089 /* Entry to editor-command-loop.
1090 This level has the catches for exiting/returning to editor command loop.
1091 It returns nil to exit recursive edit, t to abort it. */
1093 Lisp_Object
1094 command_loop (void)
1096 #ifdef HAVE_STACK_OVERFLOW_HANDLING
1097 /* At least on GNU/Linux, saving signal mask is important here. */
1098 if (sigsetjmp (return_to_command_loop, 1) != 0)
1100 /* Comes here from handle_sigsegv, see sysdep.c. */
1101 init_eval ();
1102 Vinternal__top_level_message = recover_top_level_message;
1104 else
1105 Vinternal__top_level_message = regular_top_level_message;
1106 #endif /* HAVE_STACK_OVERFLOW_HANDLING */
1107 if (command_loop_level > 0 || minibuf_level > 0)
1109 Lisp_Object val;
1110 val = internal_catch (Qexit, command_loop_2, Qnil);
1111 executing_kbd_macro = Qnil;
1112 return val;
1114 else
1115 while (1)
1117 internal_catch (Qtop_level, top_level_1, Qnil);
1118 internal_catch (Qtop_level, command_loop_2, Qnil);
1119 executing_kbd_macro = Qnil;
1121 /* End of file in -batch run causes exit here. */
1122 if (noninteractive)
1123 Fkill_emacs (Qt);
1127 /* Here we catch errors in execution of commands within the
1128 editing loop, and reenter the editing loop.
1129 When there is an error, cmd_error runs and returns a non-nil
1130 value to us. A value of nil means that command_loop_1 itself
1131 returned due to end of file (or end of kbd macro). */
1133 static Lisp_Object
1134 command_loop_2 (Lisp_Object ignore)
1136 register Lisp_Object val;
1139 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1140 while (!NILP (val));
1142 return Qnil;
1145 static Lisp_Object
1146 top_level_2 (void)
1148 return Feval (Vtop_level, Qnil);
1151 static Lisp_Object
1152 top_level_1 (Lisp_Object ignore)
1154 /* On entry to the outer level, run the startup file. */
1155 if (!NILP (Vtop_level))
1156 internal_condition_case (top_level_2, Qerror, cmd_error);
1157 else if (!NILP (Vpurify_flag))
1158 message1 ("Bare impure Emacs (standard Lisp code not loaded)");
1159 else
1160 message1 ("Bare Emacs (standard Lisp code not loaded)");
1161 return Qnil;
1164 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1165 doc: /* Exit all recursive editing levels.
1166 This also exits all active minibuffers. */)
1167 (void)
1169 #ifdef HAVE_WINDOW_SYSTEM
1170 if (display_hourglass_p)
1171 cancel_hourglass ();
1172 #endif
1174 /* Unblock input if we enter with input blocked. This may happen if
1175 redisplay traps e.g. during tool-bar update with input blocked. */
1176 totally_unblock_input ();
1178 Fthrow (Qtop_level, Qnil);
1181 static _Noreturn void
1182 user_error (const char *msg)
1184 xsignal1 (Quser_error, build_string (msg));
1187 /* _Noreturn will be added to prototype by make-docfile. */
1188 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1189 doc: /* Exit from the innermost recursive edit or minibuffer. */)
1190 (void)
1192 if (command_loop_level > 0 || minibuf_level > 0)
1193 Fthrow (Qexit, Qnil);
1195 user_error ("No recursive edit is in progress");
1198 /* _Noreturn will be added to prototype by make-docfile. */
1199 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1200 doc: /* Abort the command that requested this recursive edit or minibuffer input. */)
1201 (void)
1203 if (command_loop_level > 0 || minibuf_level > 0)
1204 Fthrow (Qexit, Qt);
1206 user_error ("No recursive edit is in progress");
1209 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
1210 of this function. */
1212 static void
1213 tracking_off (Lisp_Object old_value)
1215 do_mouse_tracking = old_value;
1216 if (NILP (old_value))
1218 /* Redisplay may have been preempted because there was input
1219 available, and it assumes it will be called again after the
1220 input has been processed. If the only input available was
1221 the sort that we have just disabled, then we need to call
1222 redisplay. */
1223 if (!readable_events (READABLE_EVENTS_DO_TIMERS_NOW))
1225 redisplay_preserve_echo_area (6);
1226 get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
1231 DEFUN ("internal--track-mouse", Ftrack_mouse, Strack_mouse, 1, 1, 0,
1232 doc: /* Call BODYFUN with mouse movement events enabled. */)
1233 (Lisp_Object bodyfun)
1235 ptrdiff_t count = SPECPDL_INDEX ();
1236 Lisp_Object val;
1238 record_unwind_protect (tracking_off, do_mouse_tracking);
1240 do_mouse_tracking = Qt;
1242 val = call0 (bodyfun);
1243 return unbind_to (count, val);
1246 /* If mouse has moved on some frame, return one of those frames.
1248 Return 0 otherwise.
1250 If ignore_mouse_drag_p is non-zero, ignore (implicit) mouse movement
1251 after resizing the tool-bar window. */
1253 bool ignore_mouse_drag_p;
1255 static struct frame *
1256 some_mouse_moved (void)
1258 Lisp_Object tail, frame;
1260 if (ignore_mouse_drag_p)
1262 /* ignore_mouse_drag_p = 0; */
1263 return 0;
1266 FOR_EACH_FRAME (tail, frame)
1268 if (XFRAME (frame)->mouse_moved)
1269 return XFRAME (frame);
1272 return 0;
1276 /* This is the actual command reading loop,
1277 sans error-handling encapsulation. */
1279 static int read_key_sequence (Lisp_Object *, int, Lisp_Object,
1280 bool, bool, bool, bool);
1281 static void adjust_point_for_property (ptrdiff_t, bool);
1283 /* The last boundary auto-added to buffer-undo-list. */
1284 Lisp_Object last_undo_boundary;
1286 /* FIXME: This is wrong rather than test window-system, we should call
1287 a new set-selection, which will then dispatch to x-set-selection, or
1288 tty-set-selection, or w32-set-selection, ... */
1290 Lisp_Object
1291 command_loop_1 (void)
1293 Lisp_Object cmd;
1294 Lisp_Object keybuf[30];
1295 int i;
1296 EMACS_INT prev_modiff = 0;
1297 struct buffer *prev_buffer = NULL;
1298 bool already_adjusted = 0;
1300 kset_prefix_arg (current_kboard, Qnil);
1301 kset_last_prefix_arg (current_kboard, Qnil);
1302 Vdeactivate_mark = Qnil;
1303 waiting_for_input = 0;
1304 cancel_echoing ();
1306 this_command_key_count = 0;
1307 this_command_key_count_reset = 0;
1308 this_single_command_key_start = 0;
1310 if (NILP (Vmemory_full))
1312 /* Make sure this hook runs after commands that get errors and
1313 throw to top level. */
1314 /* Note that the value cell will never directly contain nil
1315 if the symbol is a local variable. */
1316 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1317 safe_run_hooks (Qpost_command_hook);
1319 /* If displaying a message, resize the echo area window to fit
1320 that message's size exactly. */
1321 if (!NILP (echo_area_buffer[0]))
1322 resize_echo_area_exactly ();
1324 /* If there are warnings waiting, process them. */
1325 if (!NILP (Vdelayed_warnings_list))
1326 safe_run_hooks (Qdelayed_warnings_hook);
1328 if (!NILP (Vdeferred_action_list))
1329 safe_run_hooks (Qdeferred_action_function);
1332 /* Do this after running Vpost_command_hook, for consistency. */
1333 kset_last_command (current_kboard, Vthis_command);
1334 kset_real_last_command (current_kboard, Vreal_this_command);
1335 if (!CONSP (last_command_event))
1336 kset_last_repeatable_command (current_kboard, Vreal_this_command);
1338 while (1)
1340 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1341 Fkill_emacs (Qnil);
1343 /* Make sure the current window's buffer is selected. */
1344 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents));
1346 /* Display any malloc warning that just came out. Use while because
1347 displaying one warning can cause another. */
1349 while (pending_malloc_warning)
1350 display_malloc_warning ();
1352 Vdeactivate_mark = Qnil;
1354 /* Don't ignore mouse movements for more than a single command
1355 loop. (This flag is set in xdisp.c whenever the tool bar is
1356 resized, because the resize moves text up or down, and would
1357 generate false mouse drag events if we don't ignore them.) */
1358 ignore_mouse_drag_p = 0;
1360 /* If minibuffer on and echo area in use,
1361 wait a short time and redraw minibuffer. */
1363 if (minibuf_level
1364 && !NILP (echo_area_buffer[0])
1365 && EQ (minibuf_window, echo_area_window)
1366 && NUMBERP (Vminibuffer_message_timeout))
1368 /* Bind inhibit-quit to t so that C-g gets read in
1369 rather than quitting back to the minibuffer. */
1370 ptrdiff_t count = SPECPDL_INDEX ();
1371 specbind (Qinhibit_quit, Qt);
1373 sit_for (Vminibuffer_message_timeout, 0, 2);
1375 /* Clear the echo area. */
1376 message1 (0);
1377 safe_run_hooks (Qecho_area_clear_hook);
1379 unbind_to (count, Qnil);
1381 /* If a C-g came in before, treat it as input now. */
1382 if (!NILP (Vquit_flag))
1384 Vquit_flag = Qnil;
1385 Vunread_command_events = list1 (make_number (quit_char));
1389 /* If it has changed current-menubar from previous value,
1390 really recompute the menubar from the value. */
1391 if (! NILP (Vlucid_menu_bar_dirty_flag)
1392 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
1393 call0 (Qrecompute_lucid_menubar);
1395 before_command_key_count = this_command_key_count;
1396 before_command_echo_length = echo_length ();
1398 Vthis_command = Qnil;
1399 Vreal_this_command = Qnil;
1400 Vthis_original_command = Qnil;
1401 Vthis_command_keys_shift_translated = Qnil;
1403 /* Read next key sequence; i gets its length. */
1404 i = read_key_sequence (keybuf, ARRAYELTS (keybuf),
1405 Qnil, 0, 1, 1, 0);
1407 /* A filter may have run while we were reading the input. */
1408 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1409 Fkill_emacs (Qnil);
1410 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents));
1412 ++num_input_keys;
1414 /* Now we have read a key sequence of length I,
1415 or else I is 0 and we found end of file. */
1417 if (i == 0) /* End of file -- happens only in */
1418 return Qnil; /* a kbd macro, at the end. */
1419 /* -1 means read_key_sequence got a menu that was rejected.
1420 Just loop around and read another command. */
1421 if (i == -1)
1423 cancel_echoing ();
1424 this_command_key_count = 0;
1425 this_command_key_count_reset = 0;
1426 this_single_command_key_start = 0;
1427 goto finalize;
1430 last_command_event = keybuf[i - 1];
1432 /* If the previous command tried to force a specific window-start,
1433 forget about that, in case this command moves point far away
1434 from that position. But also throw away beg_unchanged and
1435 end_unchanged information in that case, so that redisplay will
1436 update the whole window properly. */
1437 if (XWINDOW (selected_window)->force_start)
1439 struct buffer *b;
1440 XWINDOW (selected_window)->force_start = 0;
1441 b = XBUFFER (XWINDOW (selected_window)->contents);
1442 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
1445 cmd = read_key_sequence_cmd;
1446 if (!NILP (Vexecuting_kbd_macro))
1448 if (!NILP (Vquit_flag))
1450 Vexecuting_kbd_macro = Qt;
1451 QUIT; /* Make some noise. */
1452 /* Will return since macro now empty. */
1456 /* Do redisplay processing after this command except in special
1457 cases identified below. */
1458 prev_buffer = current_buffer;
1459 prev_modiff = MODIFF;
1460 last_point_position = PT;
1462 /* By default, we adjust point to a boundary of a region that
1463 has such a property that should be treated intangible
1464 (e.g. composition, display). But, some commands will set
1465 this variable differently. */
1466 Vdisable_point_adjustment = Qnil;
1468 /* Process filters and timers may have messed with deactivate-mark.
1469 reset it before we execute the command. */
1470 Vdeactivate_mark = Qnil;
1472 /* Remap command through active keymaps. */
1473 Vthis_original_command = cmd;
1474 if (!NILP (read_key_sequence_remapped))
1475 cmd = read_key_sequence_remapped;
1477 /* Execute the command. */
1480 total_keys += total_keys < NUM_RECENT_KEYS;
1481 ASET (recent_keys, recent_keys_index,
1482 Fcons (Qnil, cmd));
1483 if (++recent_keys_index >= NUM_RECENT_KEYS)
1484 recent_keys_index = 0;
1486 Vthis_command = cmd;
1487 Vreal_this_command = cmd;
1488 safe_run_hooks (Qpre_command_hook);
1490 already_adjusted = 0;
1492 if (NILP (Vthis_command))
1493 /* nil means key is undefined. */
1494 call0 (Qundefined);
1495 else
1497 /* Here for a command that isn't executed directly. */
1499 #ifdef HAVE_WINDOW_SYSTEM
1500 ptrdiff_t scount = SPECPDL_INDEX ();
1502 if (display_hourglass_p
1503 && NILP (Vexecuting_kbd_macro))
1505 record_unwind_protect_void (cancel_hourglass);
1506 start_hourglass ();
1508 #endif
1510 if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */
1512 Lisp_Object undo = BVAR (current_buffer, undo_list);
1513 Fundo_boundary ();
1514 last_undo_boundary
1515 = (EQ (undo, BVAR (current_buffer, undo_list))
1516 ? Qnil : BVAR (current_buffer, undo_list));
1518 call1 (Qcommand_execute, Vthis_command);
1520 #ifdef HAVE_WINDOW_SYSTEM
1521 /* Do not check display_hourglass_p here, because
1522 `command-execute' could change it, but we should cancel
1523 hourglass cursor anyway.
1524 But don't cancel the hourglass within a macro
1525 just because a command in the macro finishes. */
1526 if (NILP (Vexecuting_kbd_macro))
1527 unbind_to (scount, Qnil);
1528 #endif
1530 kset_last_prefix_arg (current_kboard, Vcurrent_prefix_arg);
1532 safe_run_hooks (Qpost_command_hook);
1534 /* If displaying a message, resize the echo area window to fit
1535 that message's size exactly. */
1536 if (!NILP (echo_area_buffer[0]))
1537 resize_echo_area_exactly ();
1539 /* If there are warnings waiting, process them. */
1540 if (!NILP (Vdelayed_warnings_list))
1541 safe_run_hooks (Qdelayed_warnings_hook);
1543 safe_run_hooks (Qdeferred_action_function);
1545 /* If there is a prefix argument,
1546 1) We don't want Vlast_command to be ``universal-argument''
1547 (that would be dumb), so don't set Vlast_command,
1548 2) we want to leave echoing on so that the prefix will be
1549 echoed as part of this key sequence, so don't call
1550 cancel_echoing, and
1551 3) we want to leave this_command_key_count non-zero, so that
1552 read_char will realize that it is re-reading a character, and
1553 not echo it a second time.
1555 If the command didn't actually create a prefix arg,
1556 but is merely a frame event that is transparent to prefix args,
1557 then the above doesn't apply. */
1558 if (NILP (KVAR (current_kboard, Vprefix_arg))
1559 || CONSP (last_command_event))
1561 kset_last_command (current_kboard, Vthis_command);
1562 kset_real_last_command (current_kboard, Vreal_this_command);
1563 if (!CONSP (last_command_event))
1564 kset_last_repeatable_command (current_kboard, Vreal_this_command);
1565 cancel_echoing ();
1566 this_command_key_count = 0;
1567 this_command_key_count_reset = 0;
1568 this_single_command_key_start = 0;
1571 if (!NILP (BVAR (current_buffer, mark_active))
1572 && !NILP (Vrun_hooks))
1574 /* In Emacs 22, setting transient-mark-mode to `only' was a
1575 way of turning it on for just one command. This usage is
1576 obsolete, but support it anyway. */
1577 if (EQ (Vtransient_mark_mode, Qidentity))
1578 Vtransient_mark_mode = Qnil;
1579 else if (EQ (Vtransient_mark_mode, Qonly))
1580 Vtransient_mark_mode = Qidentity;
1582 if (!NILP (Vdeactivate_mark))
1583 /* If `select-active-regions' is non-nil, this call to
1584 `deactivate-mark' also sets the PRIMARY selection. */
1585 call0 (Qdeactivate_mark);
1586 else
1588 /* Even if not deactivating the mark, set PRIMARY if
1589 `select-active-regions' is non-nil. */
1590 if (!NILP (Fwindow_system (Qnil))
1591 /* Even if mark_active is non-nil, the actual buffer
1592 marker may not have been set yet (Bug#7044). */
1593 && XMARKER (BVAR (current_buffer, mark))->buffer
1594 && (EQ (Vselect_active_regions, Qonly)
1595 ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly)
1596 : (!NILP (Vselect_active_regions)
1597 && !NILP (Vtransient_mark_mode)))
1598 && NILP (Fmemq (Vthis_command,
1599 Vselection_inhibit_update_commands)))
1601 Lisp_Object txt
1602 = call1 (Fsymbol_value (Qregion_extract_function), Qnil);
1603 if (XINT (Flength (txt)) > 0)
1604 /* Don't set empty selections. */
1605 call2 (Qgui_set_selection, QPRIMARY, txt);
1608 if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1609 run_hook (intern ("activate-mark-hook"));
1612 Vsaved_region_selection = Qnil;
1615 finalize:
1617 if (current_buffer == prev_buffer
1618 && last_point_position != PT
1619 && NILP (Vdisable_point_adjustment)
1620 && NILP (Vglobal_disable_point_adjustment))
1622 if (last_point_position > BEGV
1623 && last_point_position < ZV
1624 && (composition_adjust_point (last_point_position,
1625 last_point_position)
1626 != last_point_position))
1627 /* The last point was temporarily set within a grapheme
1628 cluster to prevent automatic composition. To recover
1629 the automatic composition, we must update the
1630 display. */
1631 windows_or_buffers_changed = 21;
1632 if (!already_adjusted)
1633 adjust_point_for_property (last_point_position,
1634 MODIFF != prev_modiff);
1637 /* Install chars successfully executed in kbd macro. */
1639 if (!NILP (KVAR (current_kboard, defining_kbd_macro))
1640 && NILP (KVAR (current_kboard, Vprefix_arg)))
1641 finalize_kbd_macro_chars ();
1645 Lisp_Object
1646 read_menu_command (void)
1648 Lisp_Object keybuf[30];
1649 ptrdiff_t count = SPECPDL_INDEX ();
1650 int i;
1652 /* We don't want to echo the keystrokes while navigating the
1653 menus. */
1654 specbind (Qecho_keystrokes, make_number (0));
1656 i = read_key_sequence (keybuf, ARRAYELTS (keybuf),
1657 Qnil, 0, 1, 1, 1);
1659 unbind_to (count, Qnil);
1661 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1662 Fkill_emacs (Qnil);
1663 if (i == 0 || i == -1)
1664 return Qt;
1666 return read_key_sequence_cmd;
1669 /* Adjust point to a boundary of a region that has such a property
1670 that should be treated intangible. For the moment, we check
1671 `composition', `display' and `invisible' properties.
1672 LAST_PT is the last position of point. */
1674 static void
1675 adjust_point_for_property (ptrdiff_t last_pt, bool modified)
1677 ptrdiff_t beg, end;
1678 Lisp_Object val, overlay, tmp;
1679 /* When called after buffer modification, we should temporarily
1680 suppress the point adjustment for automatic composition so that a
1681 user can keep inserting another character at point or keep
1682 deleting characters around point. */
1683 bool check_composition = ! modified, check_display = 1, check_invisible = 1;
1684 ptrdiff_t orig_pt = PT;
1686 /* FIXME: cycling is probably not necessary because these properties
1687 can't be usefully combined anyway. */
1688 while (check_composition || check_display || check_invisible)
1690 /* FIXME: check `intangible'. */
1691 if (check_composition
1692 && PT > BEGV && PT < ZV
1693 && (beg = composition_adjust_point (last_pt, PT)) != PT)
1695 SET_PT (beg);
1696 check_display = check_invisible = 1;
1698 check_composition = 0;
1699 if (check_display
1700 && PT > BEGV && PT < ZV
1701 && !NILP (val = get_char_property_and_overlay
1702 (make_number (PT), Qdisplay, Qnil, &overlay))
1703 && display_prop_intangible_p (val, overlay, PT, PT_BYTE)
1704 && (!OVERLAYP (overlay)
1705 ? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil)
1706 : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)),
1707 end = OVERLAY_POSITION (OVERLAY_END (overlay))))
1708 && (beg < PT /* && end > PT <- It's always the case. */
1709 || (beg <= PT && STRINGP (val) && SCHARS (val) == 0)))
1711 eassert (end > PT);
1712 SET_PT (PT < last_pt
1713 ? (STRINGP (val) && SCHARS (val) == 0
1714 ? max (beg - 1, BEGV)
1715 : beg)
1716 : end);
1717 check_composition = check_invisible = 1;
1719 check_display = 0;
1720 if (check_invisible && PT > BEGV && PT < ZV)
1722 int inv;
1723 bool ellipsis = 0;
1724 beg = end = PT;
1726 /* Find boundaries `beg' and `end' of the invisible area, if any. */
1727 while (end < ZV
1728 #if 0
1729 /* FIXME: We should stop if we find a spot between
1730 two runs of `invisible' where inserted text would
1731 be visible. This is important when we have two
1732 invisible boundaries that enclose an area: if the
1733 area is empty, we need this test in order to make
1734 it possible to place point in the middle rather
1735 than skip both boundaries. However, this code
1736 also stops anywhere in a non-sticky text-property,
1737 which breaks (e.g.) Org mode. */
1738 && (val = Fget_pos_property (make_number (end),
1739 Qinvisible, Qnil),
1740 TEXT_PROP_MEANS_INVISIBLE (val))
1741 #endif
1742 && !NILP (val = get_char_property_and_overlay
1743 (make_number (end), Qinvisible, Qnil, &overlay))
1744 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1746 ellipsis = ellipsis || inv > 1
1747 || (OVERLAYP (overlay)
1748 && (!NILP (Foverlay_get (overlay, Qafter_string))
1749 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1750 tmp = Fnext_single_char_property_change
1751 (make_number (end), Qinvisible, Qnil, Qnil);
1752 end = NATNUMP (tmp) ? XFASTINT (tmp) : ZV;
1754 while (beg > BEGV
1755 #if 0
1756 && (val = Fget_pos_property (make_number (beg),
1757 Qinvisible, Qnil),
1758 TEXT_PROP_MEANS_INVISIBLE (val))
1759 #endif
1760 && !NILP (val = get_char_property_and_overlay
1761 (make_number (beg - 1), Qinvisible, Qnil, &overlay))
1762 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1764 ellipsis = ellipsis || inv > 1
1765 || (OVERLAYP (overlay)
1766 && (!NILP (Foverlay_get (overlay, Qafter_string))
1767 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1768 tmp = Fprevious_single_char_property_change
1769 (make_number (beg), Qinvisible, Qnil, Qnil);
1770 beg = NATNUMP (tmp) ? XFASTINT (tmp) : BEGV;
1773 /* Move away from the inside area. */
1774 if (beg < PT && end > PT)
1776 SET_PT ((orig_pt == PT && (last_pt < beg || last_pt > end))
1777 /* We haven't moved yet (so we don't need to fear
1778 infinite-looping) and we were outside the range
1779 before (so either end of the range still corresponds
1780 to a move in the right direction): pretend we moved
1781 less than we actually did, so that we still have
1782 more freedom below in choosing which end of the range
1783 to go to. */
1784 ? (orig_pt = -1, PT < last_pt ? end : beg)
1785 /* We either have moved already or the last point
1786 was already in the range: we don't get to choose
1787 which end of the range we have to go to. */
1788 : (PT < last_pt ? beg : end));
1789 check_composition = check_display = 1;
1791 #if 0 /* This assertion isn't correct, because SET_PT may end up setting
1792 the point to something other than its argument, due to
1793 point-motion hooks, intangibility, etc. */
1794 eassert (PT == beg || PT == end);
1795 #endif
1797 /* Pretend the area doesn't exist if the buffer is not
1798 modified. */
1799 if (!modified && !ellipsis && beg < end)
1801 if (last_pt == beg && PT == end && end < ZV)
1802 (check_composition = check_display = 1, SET_PT (end + 1));
1803 else if (last_pt == end && PT == beg && beg > BEGV)
1804 (check_composition = check_display = 1, SET_PT (beg - 1));
1805 else if (PT == ((PT < last_pt) ? beg : end))
1806 /* We've already moved as far as we can. Trying to go
1807 to the other end would mean moving backwards and thus
1808 could lead to an infinite loop. */
1810 else if (val = Fget_pos_property (make_number (PT),
1811 Qinvisible, Qnil),
1812 TEXT_PROP_MEANS_INVISIBLE (val)
1813 && (val = (Fget_pos_property
1814 (make_number (PT == beg ? end : beg),
1815 Qinvisible, Qnil)),
1816 !TEXT_PROP_MEANS_INVISIBLE (val)))
1817 (check_composition = check_display = 1,
1818 SET_PT (PT == beg ? end : beg));
1821 check_invisible = 0;
1825 /* Subroutine for safe_run_hooks: run the hook, which is ARGS[1]. */
1827 static Lisp_Object
1828 safe_run_hooks_1 (ptrdiff_t nargs, Lisp_Object *args)
1830 eassert (nargs == 2);
1831 return call0 (args[1]);
1834 /* Subroutine for safe_run_hooks: handle an error by clearing out the function
1835 from the hook. */
1837 static Lisp_Object
1838 safe_run_hooks_error (Lisp_Object error, ptrdiff_t nargs, Lisp_Object *args)
1840 eassert (nargs == 2);
1841 AUTO_STRING (format, "Error in %s (%S): %S");
1842 Lisp_Object hook = args[0];
1843 Lisp_Object fun = args[1];
1844 Fmessage (4, (Lisp_Object []) {format, hook, fun, error});
1846 if (SYMBOLP (hook))
1848 Lisp_Object val;
1849 bool found = 0;
1850 Lisp_Object newval = Qnil;
1851 for (val = find_symbol_value (hook); CONSP (val); val = XCDR (val))
1852 if (EQ (fun, XCAR (val)))
1853 found = 1;
1854 else
1855 newval = Fcons (XCAR (val), newval);
1856 if (found)
1857 return Fset (hook, Fnreverse (newval));
1858 /* Not found in the local part of the hook. Let's look at the global
1859 part. */
1860 newval = Qnil;
1861 for (val = (NILP (Fdefault_boundp (hook)) ? Qnil
1862 : Fdefault_value (hook));
1863 CONSP (val); val = XCDR (val))
1864 if (EQ (fun, XCAR (val)))
1865 found = 1;
1866 else
1867 newval = Fcons (XCAR (val), newval);
1868 if (found)
1869 return Fset_default (hook, Fnreverse (newval));
1871 return Qnil;
1874 static Lisp_Object
1875 safe_run_hook_funcall (ptrdiff_t nargs, Lisp_Object *args)
1877 Lisp_Object iargs[2];
1879 eassert (nargs == 2);
1880 /* Yes, run_hook_with_args works this way. */
1881 iargs[0] = args[1];
1882 iargs[1] = args[0];
1883 internal_condition_case_n (safe_run_hooks_1, 2, iargs,
1884 Qt, safe_run_hooks_error);
1885 return Qnil;
1888 /* If we get an error while running the hook, cause the hook variable
1889 to be nil. Also inhibit quits, so that C-g won't cause the hook
1890 to mysteriously evaporate. */
1892 void
1893 safe_run_hooks (Lisp_Object hook)
1895 Lisp_Object args[2];
1896 struct gcpro gcpro1;
1897 ptrdiff_t count = SPECPDL_INDEX ();
1899 args[0] = hook;
1900 args[1] = hook;
1902 GCPRO1 (hook);
1903 specbind (Qinhibit_quit, Qt);
1904 run_hook_with_args (2, args, safe_run_hook_funcall);
1905 unbind_to (count, Qnil);
1906 UNGCPRO;
1910 /* Nonzero means polling for input is temporarily suppressed. */
1912 int poll_suppress_count;
1915 #ifdef POLL_FOR_INPUT
1917 /* Asynchronous timer for polling. */
1919 static struct atimer *poll_timer;
1921 /* Poll for input, so that we catch a C-g if it comes in. */
1922 void
1923 poll_for_input_1 (void)
1925 if (! input_blocked_p ()
1926 && !waiting_for_input)
1927 gobble_input ();
1930 /* Timer callback function for poll_timer. TIMER is equal to
1931 poll_timer. */
1933 static void
1934 poll_for_input (struct atimer *timer)
1936 if (poll_suppress_count == 0)
1937 pending_signals = 1;
1940 #endif /* POLL_FOR_INPUT */
1942 /* Begin signals to poll for input, if they are appropriate.
1943 This function is called unconditionally from various places. */
1945 void
1946 start_polling (void)
1948 #ifdef POLL_FOR_INPUT
1949 /* XXX This condition was (read_socket_hook && !interrupt_input),
1950 but read_socket_hook is not global anymore. Let's pretend that
1951 it's always set. */
1952 if (!interrupt_input)
1954 /* Turn alarm handling on unconditionally. It might have
1955 been turned off in process.c. */
1956 turn_on_atimers (1);
1958 /* If poll timer doesn't exist, or we need one with
1959 a different interval, start a new one. */
1960 if (poll_timer == NULL
1961 || poll_timer->interval.tv_sec != polling_period)
1963 time_t period = max (1, min (polling_period, TYPE_MAXIMUM (time_t)));
1964 struct timespec interval = make_timespec (period, 0);
1966 if (poll_timer)
1967 cancel_atimer (poll_timer);
1969 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
1970 poll_for_input, NULL);
1973 /* Let the timer's callback function poll for input
1974 if this becomes zero. */
1975 --poll_suppress_count;
1977 #endif
1980 /* True if we are using polling to handle input asynchronously. */
1982 bool
1983 input_polling_used (void)
1985 #ifdef POLL_FOR_INPUT
1986 /* XXX This condition was (read_socket_hook && !interrupt_input),
1987 but read_socket_hook is not global anymore. Let's pretend that
1988 it's always set. */
1989 return !interrupt_input;
1990 #else
1991 return 0;
1992 #endif
1995 /* Turn off polling. */
1997 void
1998 stop_polling (void)
2000 #ifdef POLL_FOR_INPUT
2001 /* XXX This condition was (read_socket_hook && !interrupt_input),
2002 but read_socket_hook is not global anymore. Let's pretend that
2003 it's always set. */
2004 if (!interrupt_input)
2005 ++poll_suppress_count;
2006 #endif
2009 /* Set the value of poll_suppress_count to COUNT
2010 and start or stop polling accordingly. */
2012 void
2013 set_poll_suppress_count (int count)
2015 #ifdef POLL_FOR_INPUT
2016 if (count == 0 && poll_suppress_count != 0)
2018 poll_suppress_count = 1;
2019 start_polling ();
2021 else if (count != 0 && poll_suppress_count == 0)
2023 stop_polling ();
2025 poll_suppress_count = count;
2026 #endif
2029 /* Bind polling_period to a value at least N.
2030 But don't decrease it. */
2032 void
2033 bind_polling_period (int n)
2035 #ifdef POLL_FOR_INPUT
2036 EMACS_INT new = polling_period;
2038 if (n > new)
2039 new = n;
2041 stop_other_atimers (poll_timer);
2042 stop_polling ();
2043 specbind (Qpolling_period, make_number (new));
2044 /* Start a new alarm with the new period. */
2045 start_polling ();
2046 #endif
2049 /* Apply the control modifier to CHARACTER. */
2052 make_ctrl_char (int c)
2054 /* Save the upper bits here. */
2055 int upper = c & ~0177;
2057 if (! ASCII_CHAR_P (c))
2058 return c |= ctrl_modifier;
2060 c &= 0177;
2062 /* Everything in the columns containing the upper-case letters
2063 denotes a control character. */
2064 if (c >= 0100 && c < 0140)
2066 int oc = c;
2067 c &= ~0140;
2068 /* Set the shift modifier for a control char
2069 made from a shifted letter. But only for letters! */
2070 if (oc >= 'A' && oc <= 'Z')
2071 c |= shift_modifier;
2074 /* The lower-case letters denote control characters too. */
2075 else if (c >= 'a' && c <= 'z')
2076 c &= ~0140;
2078 /* Include the bits for control and shift
2079 only if the basic ASCII code can't indicate them. */
2080 else if (c >= ' ')
2081 c |= ctrl_modifier;
2083 /* Replace the high bits. */
2084 c |= (upper & ~ctrl_modifier);
2086 return c;
2089 /* Display the help-echo property of the character after the mouse pointer.
2090 Either show it in the echo area, or call show-help-function to display
2091 it by other means (maybe in a tooltip).
2093 If HELP is nil, that means clear the previous help echo.
2095 If HELP is a string, display that string. If HELP is a function,
2096 call it with OBJECT and POS as arguments; the function should
2097 return a help string or nil for none. For all other types of HELP,
2098 evaluate it to obtain a string.
2100 WINDOW is the window in which the help was generated, if any.
2101 It is nil if not in a window.
2103 If OBJECT is a buffer, POS is the position in the buffer where the
2104 `help-echo' text property was found.
2106 If OBJECT is an overlay, that overlay has a `help-echo' property,
2107 and POS is the position in the overlay's buffer under the mouse.
2109 If OBJECT is a string (an overlay string or a string displayed with
2110 the `display' property). POS is the position in that string under
2111 the mouse.
2113 Note: this function may only be called with HELP nil or a string
2114 from X code running asynchronously. */
2116 void
2117 show_help_echo (Lisp_Object help, Lisp_Object window, Lisp_Object object,
2118 Lisp_Object pos)
2120 if (!NILP (help) && !STRINGP (help))
2122 if (FUNCTIONP (help))
2123 help = safe_call (4, help, window, object, pos);
2124 else
2125 help = safe_eval (help);
2127 if (!STRINGP (help))
2128 return;
2131 if (!noninteractive && STRINGP (help))
2133 /* The mouse-fixup-help-message Lisp function can call
2134 mouse_position_hook, which resets the mouse_moved flags.
2135 This causes trouble if we are trying to read a mouse motion
2136 event (i.e., if we are inside a `track-mouse' form), so we
2137 restore the mouse_moved flag. */
2138 struct frame *f = NILP (do_mouse_tracking) ? NULL : some_mouse_moved ();
2139 help = call1 (Qmouse_fixup_help_message, help);
2140 if (f)
2141 f->mouse_moved = 1;
2144 if (STRINGP (help) || NILP (help))
2146 if (!NILP (Vshow_help_function))
2147 call1 (Vshow_help_function, help);
2148 help_echo_showing_p = STRINGP (help);
2154 /* Input of single characters from keyboard. */
2156 static Lisp_Object kbd_buffer_get_event (KBOARD **kbp, bool *used_mouse_menu,
2157 struct timespec *end_time);
2158 static void record_char (Lisp_Object c);
2160 static Lisp_Object help_form_saved_window_configs;
2161 static void
2162 read_char_help_form_unwind (void)
2164 Lisp_Object window_config = XCAR (help_form_saved_window_configs);
2165 help_form_saved_window_configs = XCDR (help_form_saved_window_configs);
2166 if (!NILP (window_config))
2167 Fset_window_configuration (window_config);
2170 #define STOP_POLLING \
2171 do { if (! polling_stopped_here) stop_polling (); \
2172 polling_stopped_here = 1; } while (0)
2174 #define RESUME_POLLING \
2175 do { if (polling_stopped_here) start_polling (); \
2176 polling_stopped_here = 0; } while (0)
2178 static Lisp_Object
2179 read_event_from_main_queue (struct timespec *end_time,
2180 sys_jmp_buf local_getcjmp,
2181 bool *used_mouse_menu)
2183 Lisp_Object c = Qnil;
2184 sys_jmp_buf save_jump;
2185 KBOARD *kb IF_LINT (= NULL);
2187 start:
2189 /* Read from the main queue, and if that gives us something we can't use yet,
2190 we put it on the appropriate side queue and try again. */
2192 if (end_time && timespec_cmp (*end_time, current_timespec ()) <= 0)
2193 return c;
2195 /* Actually read a character, waiting if necessary. */
2196 save_getcjmp (save_jump);
2197 restore_getcjmp (local_getcjmp);
2198 if (!end_time)
2199 timer_start_idle ();
2200 c = kbd_buffer_get_event (&kb, used_mouse_menu, end_time);
2201 restore_getcjmp (save_jump);
2203 if (! NILP (c) && (kb != current_kboard))
2205 Lisp_Object last = KVAR (kb, kbd_queue);
2206 if (CONSP (last))
2208 while (CONSP (XCDR (last)))
2209 last = XCDR (last);
2210 if (!NILP (XCDR (last)))
2211 emacs_abort ();
2213 if (!CONSP (last))
2214 kset_kbd_queue (kb, list1 (c));
2215 else
2216 XSETCDR (last, list1 (c));
2217 kb->kbd_queue_has_data = 1;
2218 c = Qnil;
2219 if (single_kboard)
2220 goto start;
2221 current_kboard = kb;
2222 /* This is going to exit from read_char
2223 so we had better get rid of this frame's stuff. */
2224 return make_number (-2);
2227 /* Terminate Emacs in batch mode if at eof. */
2228 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
2229 Fkill_emacs (make_number (1));
2231 if (INTEGERP (c))
2233 /* Add in any extra modifiers, where appropriate. */
2234 if ((extra_keyboard_modifiers & CHAR_CTL)
2235 || ((extra_keyboard_modifiers & 0177) < ' '
2236 && (extra_keyboard_modifiers & 0177) != 0))
2237 XSETINT (c, make_ctrl_char (XINT (c)));
2239 /* Transfer any other modifier bits directly from
2240 extra_keyboard_modifiers to c. Ignore the actual character code
2241 in the low 16 bits of extra_keyboard_modifiers. */
2242 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
2245 return c;
2250 /* Like `read_event_from_main_queue' but applies keyboard-coding-system
2251 to tty input. */
2252 static Lisp_Object
2253 read_decoded_event_from_main_queue (struct timespec *end_time,
2254 sys_jmp_buf local_getcjmp,
2255 Lisp_Object prev_event,
2256 bool *used_mouse_menu)
2258 #define MAX_ENCODED_BYTES 16
2259 #ifndef WINDOWSNT
2260 Lisp_Object events[MAX_ENCODED_BYTES];
2261 int n = 0;
2262 #endif
2263 while (true)
2265 Lisp_Object nextevt
2266 = read_event_from_main_queue (end_time, local_getcjmp,
2267 used_mouse_menu);
2268 #ifdef WINDOWSNT
2269 /* w32_console already returns decoded events. It either reads
2270 Unicode characters from the Windows keyboard input, or
2271 converts characters encoded in the current codepage into
2272 Unicode. See w32inevt.c:key_event, near its end. */
2273 return nextevt;
2274 #else
2275 struct frame *frame = XFRAME (selected_frame);
2276 struct terminal *terminal = frame->terminal;
2277 if (!((FRAME_TERMCAP_P (frame) || FRAME_MSDOS_P (frame))
2278 /* Don't apply decoding if we're just reading a raw event
2279 (e.g. reading bytes sent by the xterm to specify the position
2280 of a mouse click). */
2281 && (!EQ (prev_event, Qt))
2282 && (TERMINAL_KEYBOARD_CODING (terminal)->common_flags
2283 & CODING_REQUIRE_DECODING_MASK)))
2284 return nextevt; /* No decoding needed. */
2285 else
2287 int meta_key = terminal->display_info.tty->meta_key;
2288 eassert (n < MAX_ENCODED_BYTES);
2289 events[n++] = nextevt;
2290 if (NATNUMP (nextevt)
2291 && XINT (nextevt) < (meta_key == 1 ? 0x80 : 0x100))
2292 { /* An encoded byte sequence, let's try to decode it. */
2293 struct coding_system *coding
2294 = TERMINAL_KEYBOARD_CODING (terminal);
2295 unsigned char src[MAX_ENCODED_BYTES];
2296 unsigned char dest[MAX_ENCODED_BYTES * MAX_MULTIBYTE_LENGTH];
2297 int i;
2298 for (i = 0; i < n; i++)
2299 src[i] = XINT (events[i]);
2300 if (meta_key != 2)
2301 for (i = 0; i < n; i++)
2302 src[i] &= ~0x80;
2303 coding->destination = dest;
2304 coding->dst_bytes = sizeof dest;
2305 decode_coding_c_string (coding, src, n, Qnil);
2306 eassert (coding->produced_char <= n);
2307 if (coding->produced_char == 0)
2308 { /* The encoded sequence is incomplete. */
2309 if (n < MAX_ENCODED_BYTES) /* Avoid buffer overflow. */
2310 continue; /* Read on! */
2312 else
2314 const unsigned char *p = coding->destination;
2315 eassert (coding->carryover_bytes == 0);
2316 n = 0;
2317 while (n < coding->produced_char)
2318 events[n++] = make_number (STRING_CHAR_ADVANCE (p));
2321 /* Now `events' should hold decoded events.
2322 Normally, n should be equal to 1, but better not rely on it.
2323 We can only return one event here, so return the first we
2324 had and keep the others (if any) for later. */
2325 while (n > 1)
2326 Vunread_command_events
2327 = Fcons (events[--n], Vunread_command_events);
2328 return events[0];
2330 #endif
2334 static bool
2335 echo_keystrokes_p (void)
2337 return (FLOATP (Vecho_keystrokes) ? XFLOAT_DATA (Vecho_keystrokes) > 0.0
2338 : INTEGERP (Vecho_keystrokes) ? XINT (Vecho_keystrokes) > 0 : false);
2341 /* Read a character from the keyboard; call the redisplay if needed. */
2342 /* commandflag 0 means do not autosave, but do redisplay.
2343 -1 means do not redisplay, but do autosave.
2344 -2 means do neither.
2345 1 means do both.
2347 The argument MAP is a keymap for menu prompting.
2349 PREV_EVENT is the previous input event, or nil if we are reading
2350 the first event of a key sequence (or not reading a key sequence).
2351 If PREV_EVENT is t, that is a "magic" value that says
2352 not to run input methods, but in other respects to act as if
2353 not reading a key sequence.
2355 If USED_MOUSE_MENU is non-null, then set *USED_MOUSE_MENU to true
2356 if we used a mouse menu to read the input, or false otherwise. If
2357 USED_MOUSE_MENU is null, don't dereference it.
2359 Value is -2 when we find input on another keyboard. A second call
2360 to read_char will read it.
2362 If END_TIME is non-null, it is a pointer to a struct timespec
2363 specifying the maximum time to wait until. If no input arrives by
2364 that time, stop waiting and return nil.
2366 Value is t if we showed a menu and the user rejected it. */
2368 Lisp_Object
2369 read_char (int commandflag, Lisp_Object map,
2370 Lisp_Object prev_event,
2371 bool *used_mouse_menu, struct timespec *end_time)
2373 Lisp_Object c;
2374 ptrdiff_t jmpcount;
2375 sys_jmp_buf local_getcjmp;
2376 sys_jmp_buf save_jump;
2377 Lisp_Object tem, save;
2378 volatile Lisp_Object previous_echo_area_message;
2379 volatile Lisp_Object also_record;
2380 volatile bool reread;
2381 struct gcpro gcpro1, gcpro2;
2382 bool volatile polling_stopped_here = 0;
2383 struct kboard *orig_kboard = current_kboard;
2385 also_record = Qnil;
2387 #if 0 /* This was commented out as part of fixing echo for C-u left. */
2388 before_command_key_count = this_command_key_count;
2389 before_command_echo_length = echo_length ();
2390 #endif
2391 c = Qnil;
2392 previous_echo_area_message = Qnil;
2394 GCPRO2 (c, previous_echo_area_message);
2396 retry:
2398 if (CONSP (Vunread_post_input_method_events))
2400 c = XCAR (Vunread_post_input_method_events);
2401 Vunread_post_input_method_events
2402 = XCDR (Vunread_post_input_method_events);
2404 /* Undo what read_char_x_menu_prompt did when it unread
2405 additional keys returned by Fx_popup_menu. */
2406 if (CONSP (c)
2407 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2408 && NILP (XCDR (c)))
2409 c = XCAR (c);
2411 reread = true;
2412 goto reread_first;
2414 else
2415 reread = false;
2418 if (CONSP (Vunread_command_events))
2420 bool was_disabled = 0;
2422 c = XCAR (Vunread_command_events);
2423 Vunread_command_events = XCDR (Vunread_command_events);
2425 /* Undo what sit-for did when it unread additional keys
2426 inside universal-argument. */
2428 if (CONSP (c) && EQ (XCAR (c), Qt))
2429 c = XCDR (c);
2430 else
2431 reread = true;
2433 /* Undo what read_char_x_menu_prompt did when it unread
2434 additional keys returned by Fx_popup_menu. */
2435 if (CONSP (c)
2436 && EQ (XCDR (c), Qdisabled)
2437 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))))
2439 was_disabled = 1;
2440 c = XCAR (c);
2443 /* If the queued event is something that used the mouse,
2444 set used_mouse_menu accordingly. */
2445 if (used_mouse_menu
2446 /* Also check was_disabled so last-nonmenu-event won't return
2447 a bad value when submenus are involved. (Bug#447) */
2448 && (EQ (c, Qtool_bar) || EQ (c, Qmenu_bar) || was_disabled))
2449 *used_mouse_menu = 1;
2451 goto reread_for_input_method;
2454 if (CONSP (Vunread_input_method_events))
2456 c = XCAR (Vunread_input_method_events);
2457 Vunread_input_method_events = XCDR (Vunread_input_method_events);
2459 /* Undo what read_char_x_menu_prompt did when it unread
2460 additional keys returned by Fx_popup_menu. */
2461 if (CONSP (c)
2462 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2463 && NILP (XCDR (c)))
2464 c = XCAR (c);
2465 reread = true;
2466 goto reread_for_input_method;
2469 this_command_key_count_reset = 0;
2471 if (!NILP (Vexecuting_kbd_macro))
2473 /* We set this to Qmacro; since that's not a frame, nobody will
2474 try to switch frames on us, and the selected window will
2475 remain unchanged.
2477 Since this event came from a macro, it would be misleading to
2478 leave internal_last_event_frame set to wherever the last
2479 real event came from. Normally, a switch-frame event selects
2480 internal_last_event_frame after each command is read, but
2481 events read from a macro should never cause a new frame to be
2482 selected. */
2483 Vlast_event_frame = internal_last_event_frame = Qmacro;
2485 /* Exit the macro if we are at the end.
2486 Also, some things replace the macro with t
2487 to force an early exit. */
2488 if (EQ (Vexecuting_kbd_macro, Qt)
2489 || executing_kbd_macro_index >= XFASTINT (Flength (Vexecuting_kbd_macro)))
2491 XSETINT (c, -1);
2492 goto exit;
2495 c = Faref (Vexecuting_kbd_macro, make_number (executing_kbd_macro_index));
2496 if (STRINGP (Vexecuting_kbd_macro)
2497 && (XFASTINT (c) & 0x80) && (XFASTINT (c) <= 0xff))
2498 XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80));
2500 executing_kbd_macro_index++;
2502 goto from_macro;
2505 if (!NILP (unread_switch_frame))
2507 c = unread_switch_frame;
2508 unread_switch_frame = Qnil;
2510 /* This event should make it into this_command_keys, and get echoed
2511 again, so we do not set `reread'. */
2512 goto reread_first;
2515 /* If redisplay was requested. */
2516 if (commandflag >= 0)
2518 bool echo_current = EQ (echo_message_buffer, echo_area_buffer[0]);
2520 /* If there is pending input, process any events which are not
2521 user-visible, such as X selection_request events. */
2522 if (input_pending
2523 || detect_input_pending_run_timers (0))
2524 swallow_events (false); /* May clear input_pending. */
2526 /* Redisplay if no pending input. */
2527 while (!(input_pending
2528 && (input_was_pending || !redisplay_dont_pause)))
2530 input_was_pending = input_pending;
2531 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
2532 redisplay_preserve_echo_area (5);
2533 else
2534 redisplay ();
2536 if (!input_pending)
2537 /* Normal case: no input arrived during redisplay. */
2538 break;
2540 /* Input arrived and pre-empted redisplay.
2541 Process any events which are not user-visible. */
2542 swallow_events (false);
2543 /* If that cleared input_pending, try again to redisplay. */
2546 /* Prevent the redisplay we just did
2547 from messing up echoing of the input after the prompt. */
2548 if (commandflag == 0 && echo_current)
2549 echo_message_buffer = echo_area_buffer[0];
2553 /* Message turns off echoing unless more keystrokes turn it on again.
2555 The code in 20.x for the condition was
2557 1. echo_area_glyphs && *echo_area_glyphs
2558 2. && echo_area_glyphs != current_kboard->echobuf
2559 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2561 (1) means there's a current message displayed
2563 (2) means it's not the message from echoing from the current
2564 kboard.
2566 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2567 is set to a non-null value. This is done in read_char and it is
2568 set to echo_area_glyphs after a call to echo_char. That means
2569 ok_to_echo_at_next_pause is either null or
2570 current_kboard->echobuf with the appropriate current_kboard at
2571 that time.
2573 So, condition (3) means in clear text ok_to_echo_at_next_pause
2574 must be either null, or the current message isn't from echoing at
2575 all, or it's from echoing from a different kboard than the
2576 current one. */
2578 if (/* There currently is something in the echo area. */
2579 !NILP (echo_area_buffer[0])
2580 && (/* It's an echo from a different kboard. */
2581 echo_kboard != current_kboard
2582 /* Or we explicitly allow overwriting whatever there is. */
2583 || ok_to_echo_at_next_pause == NULL))
2584 cancel_echoing ();
2585 else
2586 echo_dash ();
2588 /* Try reading a character via menu prompting in the minibuf.
2589 Try this before the sit-for, because the sit-for
2590 would do the wrong thing if we are supposed to do
2591 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2592 after a mouse event so don't try a minibuf menu. */
2593 c = Qnil;
2594 if (KEYMAPP (map) && INTERACTIVE
2595 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2596 /* Don't bring up a menu if we already have another event. */
2597 && NILP (Vunread_command_events)
2598 && !detect_input_pending_run_timers (0))
2600 c = read_char_minibuf_menu_prompt (commandflag, map);
2602 if (INTEGERP (c) && XINT (c) == -2)
2603 return c; /* wrong_kboard_jmpbuf */
2605 if (! NILP (c))
2606 goto exit;
2609 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2610 We will do that below, temporarily for short sections of code,
2611 when appropriate. local_getcjmp must be in effect
2612 around any call to sit_for or kbd_buffer_get_event;
2613 it *must not* be in effect when we call redisplay. */
2615 jmpcount = SPECPDL_INDEX ();
2616 if (sys_setjmp (local_getcjmp))
2618 /* Handle quits while reading the keyboard. */
2619 /* We must have saved the outer value of getcjmp here,
2620 so restore it now. */
2621 restore_getcjmp (save_jump);
2622 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
2623 unbind_to (jmpcount, Qnil);
2624 XSETINT (c, quit_char);
2625 internal_last_event_frame = selected_frame;
2626 Vlast_event_frame = internal_last_event_frame;
2627 /* If we report the quit char as an event,
2628 don't do so more than once. */
2629 if (!NILP (Vinhibit_quit))
2630 Vquit_flag = Qnil;
2633 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
2634 if (kb != current_kboard)
2636 Lisp_Object last = KVAR (kb, kbd_queue);
2637 /* We shouldn't get here if we were in single-kboard mode! */
2638 if (single_kboard)
2639 emacs_abort ();
2640 if (CONSP (last))
2642 while (CONSP (XCDR (last)))
2643 last = XCDR (last);
2644 if (!NILP (XCDR (last)))
2645 emacs_abort ();
2647 if (!CONSP (last))
2648 kset_kbd_queue (kb, list1 (c));
2649 else
2650 XSETCDR (last, list1 (c));
2651 kb->kbd_queue_has_data = 1;
2652 current_kboard = kb;
2653 /* This is going to exit from read_char
2654 so we had better get rid of this frame's stuff. */
2655 UNGCPRO;
2656 return make_number (-2); /* wrong_kboard_jmpbuf */
2659 goto non_reread;
2662 /* Start idle timers if no time limit is supplied. We don't do it
2663 if a time limit is supplied to avoid an infinite recursion in the
2664 situation where an idle timer calls `sit-for'. */
2666 if (!end_time)
2667 timer_start_idle ();
2669 /* If in middle of key sequence and minibuffer not active,
2670 start echoing if enough time elapses. */
2672 if (minibuf_level == 0
2673 && !end_time
2674 && !current_kboard->immediate_echo
2675 && this_command_key_count > 0
2676 && ! noninteractive
2677 && echo_keystrokes_p ()
2678 && (/* No message. */
2679 NILP (echo_area_buffer[0])
2680 /* Or empty message. */
2681 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2682 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2683 /* Or already echoing from same kboard. */
2684 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2685 /* Or not echoing before and echoing allowed. */
2686 || (!echo_kboard && ok_to_echo_at_next_pause)))
2688 /* After a mouse event, start echoing right away.
2689 This is because we are probably about to display a menu,
2690 and we don't want to delay before doing so. */
2691 if (EVENT_HAS_PARAMETERS (prev_event))
2692 echo_now ();
2693 else
2695 Lisp_Object tem0;
2697 save_getcjmp (save_jump);
2698 restore_getcjmp (local_getcjmp);
2699 tem0 = sit_for (Vecho_keystrokes, 1, 1);
2700 restore_getcjmp (save_jump);
2701 if (EQ (tem0, Qt)
2702 && ! CONSP (Vunread_command_events))
2703 echo_now ();
2707 /* Maybe auto save due to number of keystrokes. */
2709 if (commandflag != 0 && commandflag != -2
2710 && auto_save_interval > 0
2711 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
2712 && !detect_input_pending_run_timers (0))
2714 Fdo_auto_save (Qnil, Qnil);
2715 /* Hooks can actually change some buffers in auto save. */
2716 redisplay ();
2719 /* Try reading using an X menu.
2720 This is never confused with reading using the minibuf
2721 because the recursive call of read_char in read_char_minibuf_menu_prompt
2722 does not pass on any keymaps. */
2724 if (KEYMAPP (map) && INTERACTIVE
2725 && !NILP (prev_event)
2726 && EVENT_HAS_PARAMETERS (prev_event)
2727 && !EQ (XCAR (prev_event), Qmenu_bar)
2728 && !EQ (XCAR (prev_event), Qtool_bar)
2729 /* Don't bring up a menu if we already have another event. */
2730 && NILP (Vunread_command_events))
2732 c = read_char_x_menu_prompt (map, prev_event, used_mouse_menu);
2734 /* Now that we have read an event, Emacs is not idle. */
2735 if (!end_time)
2736 timer_stop_idle ();
2738 goto exit;
2741 /* Maybe autosave and/or garbage collect due to idleness. */
2743 if (INTERACTIVE && NILP (c))
2745 int delay_level;
2746 ptrdiff_t buffer_size;
2748 /* Slow down auto saves logarithmically in size of current buffer,
2749 and garbage collect while we're at it. */
2750 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2751 last_non_minibuf_size = Z - BEG;
2752 buffer_size = (last_non_minibuf_size >> 8) + 1;
2753 delay_level = 0;
2754 while (buffer_size > 64)
2755 delay_level++, buffer_size -= buffer_size >> 2;
2756 if (delay_level < 4) delay_level = 4;
2757 /* delay_level is 4 for files under around 50k, 7 at 100k,
2758 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2760 /* Auto save if enough time goes by without input. */
2761 if (commandflag != 0 && commandflag != -2
2762 && num_nonmacro_input_events > last_auto_save
2763 && INTEGERP (Vauto_save_timeout)
2764 && XINT (Vauto_save_timeout) > 0)
2766 Lisp_Object tem0;
2767 EMACS_INT timeout = XFASTINT (Vauto_save_timeout);
2769 timeout = min (timeout, MOST_POSITIVE_FIXNUM / delay_level * 4);
2770 timeout = delay_level * timeout / 4;
2771 save_getcjmp (save_jump);
2772 restore_getcjmp (local_getcjmp);
2773 tem0 = sit_for (make_number (timeout), 1, 1);
2774 restore_getcjmp (save_jump);
2776 if (EQ (tem0, Qt)
2777 && ! CONSP (Vunread_command_events))
2779 Fdo_auto_save (Qnil, Qnil);
2780 redisplay ();
2784 /* If there is still no input available, ask for GC. */
2785 if (!detect_input_pending_run_timers (0))
2786 maybe_gc ();
2789 /* Notify the caller if an autosave hook, or a timer, sentinel or
2790 filter in the sit_for calls above have changed the current
2791 kboard. This could happen if they use the minibuffer or start a
2792 recursive edit, like the fancy splash screen in server.el's
2793 filter. If this longjmp wasn't here, read_key_sequence would
2794 interpret the next key sequence using the wrong translation
2795 tables and function keymaps. */
2796 if (NILP (c) && current_kboard != orig_kboard)
2798 UNGCPRO;
2799 return make_number (-2); /* wrong_kboard_jmpbuf */
2802 /* If this has become non-nil here, it has been set by a timer
2803 or sentinel or filter. */
2804 if (CONSP (Vunread_command_events))
2806 c = XCAR (Vunread_command_events);
2807 Vunread_command_events = XCDR (Vunread_command_events);
2809 if (CONSP (c) && EQ (XCAR (c), Qt))
2810 c = XCDR (c);
2811 else
2812 reread = true;
2815 /* Read something from current KBOARD's side queue, if possible. */
2817 if (NILP (c))
2819 if (current_kboard->kbd_queue_has_data)
2821 if (!CONSP (KVAR (current_kboard, kbd_queue)))
2822 emacs_abort ();
2823 c = XCAR (KVAR (current_kboard, kbd_queue));
2824 kset_kbd_queue (current_kboard,
2825 XCDR (KVAR (current_kboard, kbd_queue)));
2826 if (NILP (KVAR (current_kboard, kbd_queue)))
2827 current_kboard->kbd_queue_has_data = 0;
2828 input_pending = readable_events (0);
2829 if (EVENT_HAS_PARAMETERS (c)
2830 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
2831 internal_last_event_frame = XCAR (XCDR (c));
2832 Vlast_event_frame = internal_last_event_frame;
2836 /* If current_kboard's side queue is empty check the other kboards.
2837 If one of them has data that we have not yet seen here,
2838 switch to it and process the data waiting for it.
2840 Note: if the events queued up for another kboard
2841 have already been seen here, and therefore are not a complete command,
2842 the kbd_queue_has_data field is 0, so we skip that kboard here.
2843 That's to avoid an infinite loop switching between kboards here. */
2844 if (NILP (c) && !single_kboard)
2846 KBOARD *kb;
2847 for (kb = all_kboards; kb; kb = kb->next_kboard)
2848 if (kb->kbd_queue_has_data)
2850 current_kboard = kb;
2851 /* This is going to exit from read_char
2852 so we had better get rid of this frame's stuff. */
2853 UNGCPRO;
2854 return make_number (-2); /* wrong_kboard_jmpbuf */
2858 wrong_kboard:
2860 STOP_POLLING;
2862 if (NILP (c))
2864 c = read_decoded_event_from_main_queue (end_time, local_getcjmp,
2865 prev_event, used_mouse_menu);
2866 if (NILP (c) && end_time
2867 && timespec_cmp (*end_time, current_timespec ()) <= 0)
2869 goto exit;
2872 if (EQ (c, make_number (-2)))
2874 /* This is going to exit from read_char
2875 so we had better get rid of this frame's stuff. */
2876 UNGCPRO;
2877 return c;
2881 non_reread:
2883 if (!end_time)
2884 timer_stop_idle ();
2885 RESUME_POLLING;
2887 if (NILP (c))
2889 if (commandflag >= 0
2890 && !input_pending && !detect_input_pending_run_timers (0))
2891 redisplay ();
2893 goto wrong_kboard;
2896 /* Buffer switch events are only for internal wakeups
2897 so don't show them to the user.
2898 Also, don't record a key if we already did. */
2899 if (BUFFERP (c))
2900 goto exit;
2902 /* Process special events within read_char
2903 and loop around to read another event. */
2904 save = Vquit_flag;
2905 Vquit_flag = Qnil;
2906 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
2907 Vquit_flag = save;
2909 if (!NILP (tem))
2911 struct buffer *prev_buffer = current_buffer;
2912 last_input_event = c;
2913 call4 (Qcommand_execute, tem, Qnil, Fvector (1, &last_input_event), Qt);
2915 if (CONSP (c) && EQ (XCAR (c), Qselect_window) && !end_time)
2916 /* We stopped being idle for this event; undo that. This
2917 prevents automatic window selection (under
2918 mouse_autoselect_window from acting as a real input event, for
2919 example banishing the mouse under mouse-avoidance-mode. */
2920 timer_resume_idle ();
2922 if (current_buffer != prev_buffer)
2924 /* The command may have changed the keymaps. Pretend there
2925 is input in another keyboard and return. This will
2926 recalculate keymaps. */
2927 c = make_number (-2);
2928 goto exit;
2930 else
2931 goto retry;
2934 /* Handle things that only apply to characters. */
2935 if (INTEGERP (c))
2937 /* If kbd_buffer_get_event gave us an EOF, return that. */
2938 if (XINT (c) == -1)
2939 goto exit;
2941 if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table))
2942 && UNSIGNED_CMP (XFASTINT (c), <,
2943 SCHARS (KVAR (current_kboard,
2944 Vkeyboard_translate_table))))
2945 || (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table))
2946 && UNSIGNED_CMP (XFASTINT (c), <,
2947 ASIZE (KVAR (current_kboard,
2948 Vkeyboard_translate_table))))
2949 || (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table))
2950 && CHARACTERP (c)))
2952 Lisp_Object d;
2953 d = Faref (KVAR (current_kboard, Vkeyboard_translate_table), c);
2954 /* nil in keyboard-translate-table means no translation. */
2955 if (!NILP (d))
2956 c = d;
2960 /* If this event is a mouse click in the menu bar,
2961 return just menu-bar for now. Modify the mouse click event
2962 so we won't do this twice, then queue it up. */
2963 if (EVENT_HAS_PARAMETERS (c)
2964 && CONSP (XCDR (c))
2965 && CONSP (EVENT_START (c))
2966 && CONSP (XCDR (EVENT_START (c))))
2968 Lisp_Object posn;
2970 posn = POSN_POSN (EVENT_START (c));
2971 /* Handle menu-bar events:
2972 insert the dummy prefix event `menu-bar'. */
2973 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
2975 /* Change menu-bar to (menu-bar) as the event "position". */
2976 POSN_SET_POSN (EVENT_START (c), list1 (posn));
2978 also_record = c;
2979 Vunread_command_events = Fcons (c, Vunread_command_events);
2980 c = posn;
2984 /* Store these characters into recent_keys, the dribble file if any,
2985 and the keyboard macro being defined, if any. */
2986 record_char (c);
2987 if (! NILP (also_record))
2988 record_char (also_record);
2990 /* Wipe the echo area.
2991 But first, if we are about to use an input method,
2992 save the echo area contents for it to refer to. */
2993 if (INTEGERP (c)
2994 && ! NILP (Vinput_method_function)
2995 && ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127)
2997 previous_echo_area_message = Fcurrent_message ();
2998 Vinput_method_previous_message = previous_echo_area_message;
3001 /* Now wipe the echo area, except for help events which do their
3002 own stuff with the echo area. */
3003 if (!CONSP (c)
3004 || (!(EQ (Qhelp_echo, XCAR (c)))
3005 && !(EQ (Qswitch_frame, XCAR (c)))
3006 /* Don't wipe echo area for select window events: These might
3007 get delayed via `mouse-autoselect-window' (Bug#11304). */
3008 && !(EQ (Qselect_window, XCAR (c)))))
3010 if (!NILP (echo_area_buffer[0]))
3012 safe_run_hooks (Qecho_area_clear_hook);
3013 clear_message (1, 0);
3017 reread_for_input_method:
3018 from_macro:
3019 /* Pass this to the input method, if appropriate. */
3020 if (INTEGERP (c)
3021 && ! NILP (Vinput_method_function)
3022 /* Don't run the input method within a key sequence,
3023 after the first event of the key sequence. */
3024 && NILP (prev_event)
3025 && ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127)
3027 Lisp_Object keys;
3028 ptrdiff_t key_count;
3029 bool key_count_reset;
3030 struct gcpro gcpro1;
3031 ptrdiff_t count = SPECPDL_INDEX ();
3033 /* Save the echo status. */
3034 bool saved_immediate_echo = current_kboard->immediate_echo;
3035 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
3036 Lisp_Object saved_echo_string = KVAR (current_kboard, echo_string);
3037 ptrdiff_t saved_echo_after_prompt = current_kboard->echo_after_prompt;
3039 #if 0
3040 if (before_command_restore_flag)
3042 this_command_key_count = before_command_key_count_1;
3043 if (this_command_key_count < this_single_command_key_start)
3044 this_single_command_key_start = this_command_key_count;
3045 echo_truncate (before_command_echo_length_1);
3046 before_command_restore_flag = 0;
3048 #endif
3050 /* Save the this_command_keys status. */
3051 key_count = this_command_key_count;
3052 key_count_reset = this_command_key_count_reset;
3054 if (key_count > 0)
3055 keys = Fcopy_sequence (this_command_keys);
3056 else
3057 keys = Qnil;
3058 GCPRO1 (keys);
3060 /* Clear out this_command_keys. */
3061 this_command_key_count = 0;
3062 this_command_key_count_reset = 0;
3064 /* Now wipe the echo area. */
3065 if (!NILP (echo_area_buffer[0]))
3066 safe_run_hooks (Qecho_area_clear_hook);
3067 clear_message (1, 0);
3068 echo_truncate (0);
3070 /* If we are not reading a key sequence,
3071 never use the echo area. */
3072 if (!KEYMAPP (map))
3074 specbind (Qinput_method_use_echo_area, Qt);
3077 /* Call the input method. */
3078 tem = call1 (Vinput_method_function, c);
3080 tem = unbind_to (count, tem);
3082 /* Restore the saved echoing state
3083 and this_command_keys state. */
3084 this_command_key_count = key_count;
3085 this_command_key_count_reset = key_count_reset;
3086 if (key_count > 0)
3087 this_command_keys = keys;
3089 cancel_echoing ();
3090 ok_to_echo_at_next_pause = saved_ok_to_echo;
3091 kset_echo_string (current_kboard, saved_echo_string);
3092 current_kboard->echo_after_prompt = saved_echo_after_prompt;
3093 if (saved_immediate_echo)
3094 echo_now ();
3096 UNGCPRO;
3098 /* The input method can return no events. */
3099 if (! CONSP (tem))
3101 /* Bring back the previous message, if any. */
3102 if (! NILP (previous_echo_area_message))
3103 message_with_string ("%s", previous_echo_area_message, 0);
3104 goto retry;
3106 /* It returned one event or more. */
3107 c = XCAR (tem);
3108 Vunread_post_input_method_events
3109 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
3112 reread_first:
3114 /* Display help if not echoing. */
3115 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
3117 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
3118 Lisp_Object help, object, position, window, htem;
3120 htem = Fcdr (XCDR (c));
3121 help = Fcar (htem);
3122 htem = Fcdr (htem);
3123 window = Fcar (htem);
3124 htem = Fcdr (htem);
3125 object = Fcar (htem);
3126 htem = Fcdr (htem);
3127 position = Fcar (htem);
3129 show_help_echo (help, window, object, position);
3131 /* We stopped being idle for this event; undo that. */
3132 if (!end_time)
3133 timer_resume_idle ();
3134 goto retry;
3137 if ((! reread || this_command_key_count == 0
3138 || this_command_key_count_reset)
3139 && !end_time)
3142 /* Don't echo mouse motion events. */
3143 if (echo_keystrokes_p ()
3144 && ! (EVENT_HAS_PARAMETERS (c)
3145 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
3147 echo_char (c);
3148 if (! NILP (also_record))
3149 echo_char (also_record);
3150 /* Once we reread a character, echoing can happen
3151 the next time we pause to read a new one. */
3152 ok_to_echo_at_next_pause = current_kboard;
3155 /* Record this character as part of the current key. */
3156 add_command_key (c);
3157 if (! NILP (also_record))
3158 add_command_key (also_record);
3161 last_input_event = c;
3162 num_input_events++;
3164 /* Process the help character specially if enabled. */
3165 if (!NILP (Vhelp_form) && help_char_p (c))
3167 ptrdiff_t count = SPECPDL_INDEX ();
3169 help_form_saved_window_configs
3170 = Fcons (Fcurrent_window_configuration (Qnil),
3171 help_form_saved_window_configs);
3172 record_unwind_protect_void (read_char_help_form_unwind);
3173 call0 (Qhelp_form_show);
3175 cancel_echoing ();
3178 c = read_char (0, Qnil, Qnil, 0, NULL);
3179 if (EVENT_HAS_PARAMETERS (c)
3180 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_click))
3181 XSETCAR (help_form_saved_window_configs, Qnil);
3183 while (BUFFERP (c));
3184 /* Remove the help from the frame. */
3185 unbind_to (count, Qnil);
3187 redisplay ();
3188 if (EQ (c, make_number (040)))
3190 cancel_echoing ();
3192 c = read_char (0, Qnil, Qnil, 0, NULL);
3193 while (BUFFERP (c));
3197 exit:
3198 RESUME_POLLING;
3199 input_was_pending = input_pending;
3200 RETURN_UNGCPRO (c);
3203 /* Record a key that came from a mouse menu.
3204 Record it for echoing, for this-command-keys, and so on. */
3206 static void
3207 record_menu_key (Lisp_Object c)
3209 /* Wipe the echo area. */
3210 clear_message (1, 0);
3212 record_char (c);
3214 #if 0
3215 before_command_key_count = this_command_key_count;
3216 before_command_echo_length = echo_length ();
3217 #endif
3219 /* Don't echo mouse motion events. */
3220 if (echo_keystrokes_p ())
3222 echo_char (c);
3224 /* Once we reread a character, echoing can happen
3225 the next time we pause to read a new one. */
3226 ok_to_echo_at_next_pause = 0;
3229 /* Record this character as part of the current key. */
3230 add_command_key (c);
3232 /* Re-reading in the middle of a command. */
3233 last_input_event = c;
3234 num_input_events++;
3237 /* Return true if should recognize C as "the help character". */
3239 static bool
3240 help_char_p (Lisp_Object c)
3242 Lisp_Object tail;
3244 if (EQ (c, Vhelp_char))
3245 return 1;
3246 for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
3247 if (EQ (c, XCAR (tail)))
3248 return 1;
3249 return 0;
3252 /* Record the input event C in various ways. */
3254 static void
3255 record_char (Lisp_Object c)
3257 int recorded = 0;
3259 if (CONSP (c) && (EQ (XCAR (c), Qhelp_echo) || EQ (XCAR (c), Qmouse_movement)))
3261 /* To avoid filling recent_keys with help-echo and mouse-movement
3262 events, we filter out repeated help-echo events, only store the
3263 first and last in a series of mouse-movement events, and don't
3264 store repeated help-echo events which are only separated by
3265 mouse-movement events. */
3267 Lisp_Object ev1, ev2, ev3;
3268 int ix1, ix2, ix3;
3270 if ((ix1 = recent_keys_index - 1) < 0)
3271 ix1 = NUM_RECENT_KEYS - 1;
3272 ev1 = AREF (recent_keys, ix1);
3274 if ((ix2 = ix1 - 1) < 0)
3275 ix2 = NUM_RECENT_KEYS - 1;
3276 ev2 = AREF (recent_keys, ix2);
3278 if ((ix3 = ix2 - 1) < 0)
3279 ix3 = NUM_RECENT_KEYS - 1;
3280 ev3 = AREF (recent_keys, ix3);
3282 if (EQ (XCAR (c), Qhelp_echo))
3284 /* Don't record `help-echo' in recent_keys unless it shows some help
3285 message, and a different help than the previously recorded
3286 event. */
3287 Lisp_Object help, last_help;
3289 help = Fcar_safe (Fcdr_safe (XCDR (c)));
3290 if (!STRINGP (help))
3291 recorded = 1;
3292 else if (CONSP (ev1) && EQ (XCAR (ev1), Qhelp_echo)
3293 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev1))), EQ (last_help, help)))
3294 recorded = 1;
3295 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3296 && CONSP (ev2) && EQ (XCAR (ev2), Qhelp_echo)
3297 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev2))), EQ (last_help, help)))
3298 recorded = -1;
3299 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3300 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3301 && CONSP (ev3) && EQ (XCAR (ev3), Qhelp_echo)
3302 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev3))), EQ (last_help, help)))
3303 recorded = -2;
3305 else if (EQ (XCAR (c), Qmouse_movement))
3307 /* Only record one pair of `mouse-movement' on a window in recent_keys.
3308 So additional mouse movement events replace the last element. */
3309 Lisp_Object last_window, window;
3311 window = Fcar_safe (Fcar_safe (XCDR (c)));
3312 if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3313 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev1))), EQ (last_window, window))
3314 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3315 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev2))), EQ (last_window, window)))
3317 ASET (recent_keys, ix1, c);
3318 recorded = 1;
3322 else
3323 store_kbd_macro_char (c);
3325 if (!recorded)
3327 total_keys += total_keys < NUM_RECENT_KEYS;
3328 ASET (recent_keys, recent_keys_index, c);
3329 if (++recent_keys_index >= NUM_RECENT_KEYS)
3330 recent_keys_index = 0;
3332 else if (recorded < 0)
3334 /* We need to remove one or two events from recent_keys.
3335 To do this, we simply put nil at those events and move the
3336 recent_keys_index backwards over those events. Usually,
3337 users will never see those nil events, as they will be
3338 overwritten by the command keys entered to see recent_keys
3339 (e.g. C-h l). */
3341 while (recorded++ < 0 && total_keys > 0)
3343 if (total_keys < NUM_RECENT_KEYS)
3344 total_keys--;
3345 if (--recent_keys_index < 0)
3346 recent_keys_index = NUM_RECENT_KEYS - 1;
3347 ASET (recent_keys, recent_keys_index, Qnil);
3351 num_nonmacro_input_events++;
3353 /* Write c to the dribble file. If c is a lispy event, write
3354 the event's symbol to the dribble file, in <brackets>. Bleaugh.
3355 If you, dear reader, have a better idea, you've got the source. :-) */
3356 if (dribble)
3358 block_input ();
3359 if (INTEGERP (c))
3361 if (XUINT (c) < 0x100)
3362 putc (XUINT (c), dribble);
3363 else
3364 fprintf (dribble, " 0x%"pI"x", XUINT (c));
3366 else
3368 Lisp_Object dribblee;
3370 /* If it's a structured event, take the event header. */
3371 dribblee = EVENT_HEAD (c);
3373 if (SYMBOLP (dribblee))
3375 putc ('<', dribble);
3376 fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
3377 SBYTES (SYMBOL_NAME (dribblee)),
3378 dribble);
3379 putc ('>', dribble);
3383 fflush (dribble);
3384 unblock_input ();
3388 /* Copy out or in the info on where C-g should throw to.
3389 This is used when running Lisp code from within get_char,
3390 in case get_char is called recursively.
3391 See read_process_output. */
3393 static void
3394 save_getcjmp (sys_jmp_buf temp)
3396 memcpy (temp, getcjmp, sizeof getcjmp);
3399 static void
3400 restore_getcjmp (sys_jmp_buf temp)
3402 memcpy (getcjmp, temp, sizeof getcjmp);
3405 /* Low level keyboard/mouse input.
3406 kbd_buffer_store_event places events in kbd_buffer, and
3407 kbd_buffer_get_event retrieves them. */
3409 /* Return true if there are any events in the queue that read-char
3410 would return. If this returns false, a read-char would block. */
3411 static bool
3412 readable_events (int flags)
3414 if (flags & READABLE_EVENTS_DO_TIMERS_NOW)
3415 timer_check ();
3417 /* If the buffer contains only FOCUS_IN_EVENT events, and
3418 READABLE_EVENTS_FILTER_EVENTS is set, report it as empty. */
3419 if (kbd_fetch_ptr != kbd_store_ptr)
3421 if (flags & (READABLE_EVENTS_FILTER_EVENTS
3422 #ifdef USE_TOOLKIT_SCROLL_BARS
3423 | READABLE_EVENTS_IGNORE_SQUEEZABLES
3424 #endif
3427 struct input_event *event;
3429 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3430 ? kbd_fetch_ptr
3431 : kbd_buffer);
3435 if (!(
3436 #ifdef USE_TOOLKIT_SCROLL_BARS
3437 (flags & READABLE_EVENTS_FILTER_EVENTS) &&
3438 #endif
3439 event->kind == FOCUS_IN_EVENT)
3440 #ifdef USE_TOOLKIT_SCROLL_BARS
3441 && !((flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3442 && (event->kind == SCROLL_BAR_CLICK_EVENT
3443 || event->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT)
3444 && event->part == scroll_bar_handle
3445 && event->modifiers == 0)
3446 #endif
3447 && !((flags & READABLE_EVENTS_FILTER_EVENTS)
3448 && event->kind == BUFFER_SWITCH_EVENT))
3449 return 1;
3450 event++;
3451 if (event == kbd_buffer + KBD_BUFFER_SIZE)
3452 event = kbd_buffer;
3454 while (event != kbd_store_ptr);
3456 else
3457 return 1;
3460 if (!(flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3461 && !NILP (do_mouse_tracking) && some_mouse_moved ())
3462 return 1;
3463 if (single_kboard)
3465 if (current_kboard->kbd_queue_has_data)
3466 return 1;
3468 else
3470 KBOARD *kb;
3471 for (kb = all_kboards; kb; kb = kb->next_kboard)
3472 if (kb->kbd_queue_has_data)
3473 return 1;
3475 return 0;
3478 /* Set this for debugging, to have a way to get out */
3479 int stop_character EXTERNALLY_VISIBLE;
3481 static KBOARD *
3482 event_to_kboard (struct input_event *event)
3484 /* Not applicable for these special events. */
3485 if (event->kind == SELECTION_REQUEST_EVENT
3486 || event->kind == SELECTION_CLEAR_EVENT)
3487 return NULL;
3488 else
3490 Lisp_Object obj = event->frame_or_window;
3491 /* There are some events that set this field to nil or string. */
3492 if (WINDOWP (obj))
3493 obj = WINDOW_FRAME (XWINDOW (obj));
3494 /* Also ignore dead frames here. */
3495 return ((FRAMEP (obj) && FRAME_LIVE_P (XFRAME (obj)))
3496 ? FRAME_KBOARD (XFRAME (obj)) : NULL);
3500 #ifdef subprocesses
3501 /* Return the number of slots occupied in kbd_buffer. */
3503 static int
3504 kbd_buffer_nr_stored (void)
3506 return kbd_fetch_ptr == kbd_store_ptr
3508 : (kbd_fetch_ptr < kbd_store_ptr
3509 ? kbd_store_ptr - kbd_fetch_ptr
3510 : ((kbd_buffer + KBD_BUFFER_SIZE) - kbd_fetch_ptr
3511 + (kbd_store_ptr - kbd_buffer)));
3513 #endif /* Store an event obtained at interrupt level into kbd_buffer, fifo */
3515 void
3516 kbd_buffer_store_event (register struct input_event *event)
3518 kbd_buffer_store_event_hold (event, 0);
3521 /* Store EVENT obtained at interrupt level into kbd_buffer, fifo.
3523 If HOLD_QUIT is 0, just stuff EVENT into the fifo.
3524 Else, if HOLD_QUIT.kind != NO_EVENT, discard EVENT.
3525 Else, if EVENT is a quit event, store the quit event
3526 in HOLD_QUIT, and return (thus ignoring further events).
3528 This is used to postpone the processing of the quit event until all
3529 subsequent input events have been parsed (and discarded). */
3531 void
3532 kbd_buffer_store_event_hold (register struct input_event *event,
3533 struct input_event *hold_quit)
3535 if (event->kind == NO_EVENT)
3536 emacs_abort ();
3538 if (hold_quit && hold_quit->kind != NO_EVENT)
3539 return;
3541 if (event->kind == ASCII_KEYSTROKE_EVENT)
3543 register int c = event->code & 0377;
3545 if (event->modifiers & ctrl_modifier)
3546 c = make_ctrl_char (c);
3548 c |= (event->modifiers
3549 & (meta_modifier | alt_modifier
3550 | hyper_modifier | super_modifier));
3552 if (c == quit_char)
3554 KBOARD *kb = FRAME_KBOARD (XFRAME (event->frame_or_window));
3555 struct input_event *sp;
3557 if (single_kboard && kb != current_kboard)
3559 kset_kbd_queue
3560 (kb, list2 (make_lispy_switch_frame (event->frame_or_window),
3561 make_number (c)));
3562 kb->kbd_queue_has_data = 1;
3563 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3565 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3566 sp = kbd_buffer;
3568 if (event_to_kboard (sp) == kb)
3570 sp->kind = NO_EVENT;
3571 sp->frame_or_window = Qnil;
3572 sp->arg = Qnil;
3575 return;
3578 if (hold_quit)
3580 *hold_quit = *event;
3581 return;
3584 /* If this results in a quit_char being returned to Emacs as
3585 input, set Vlast_event_frame properly. If this doesn't
3586 get returned to Emacs as an event, the next event read
3587 will set Vlast_event_frame again, so this is safe to do. */
3589 Lisp_Object focus;
3591 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
3592 if (NILP (focus))
3593 focus = event->frame_or_window;
3594 internal_last_event_frame = focus;
3595 Vlast_event_frame = focus;
3598 handle_interrupt (0);
3599 return;
3602 if (c && c == stop_character)
3604 sys_suspend ();
3605 return;
3608 /* Don't insert two BUFFER_SWITCH_EVENT's in a row.
3609 Just ignore the second one. */
3610 else if (event->kind == BUFFER_SWITCH_EVENT
3611 && kbd_fetch_ptr != kbd_store_ptr
3612 && ((kbd_store_ptr == kbd_buffer
3613 ? kbd_buffer + KBD_BUFFER_SIZE - 1
3614 : kbd_store_ptr - 1)->kind) == BUFFER_SWITCH_EVENT)
3615 return;
3617 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
3618 kbd_store_ptr = kbd_buffer;
3620 /* Don't let the very last slot in the buffer become full,
3621 since that would make the two pointers equal,
3622 and that is indistinguishable from an empty buffer.
3623 Discard the event if it would fill the last slot. */
3624 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3626 *kbd_store_ptr = *event;
3627 ++kbd_store_ptr;
3628 #ifdef subprocesses
3629 if (kbd_buffer_nr_stored () > KBD_BUFFER_SIZE / 2
3630 && ! kbd_on_hold_p ())
3632 /* Don't read keyboard input until we have processed kbd_buffer.
3633 This happens when pasting text longer than KBD_BUFFER_SIZE/2. */
3634 hold_keyboard_input ();
3635 if (!noninteractive)
3636 ignore_sigio ();
3637 stop_polling ();
3639 #endif /* subprocesses */
3642 /* If we're inside while-no-input, and this event qualifies
3643 as input, set quit-flag to cause an interrupt. */
3644 if (!NILP (Vthrow_on_input)
3645 && event->kind != FOCUS_IN_EVENT
3646 && event->kind != HELP_EVENT
3647 && event->kind != DEICONIFY_EVENT)
3649 Vquit_flag = Vthrow_on_input;
3650 /* If we're inside a function that wants immediate quits,
3651 do it now. */
3652 if (immediate_quit && NILP (Vinhibit_quit))
3654 immediate_quit = 0;
3655 QUIT;
3661 /* Put an input event back in the head of the event queue. */
3663 void
3664 kbd_buffer_unget_event (register struct input_event *event)
3666 if (kbd_fetch_ptr == kbd_buffer)
3667 kbd_fetch_ptr = kbd_buffer + KBD_BUFFER_SIZE;
3669 /* Don't let the very last slot in the buffer become full, */
3670 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3672 --kbd_fetch_ptr;
3673 *kbd_fetch_ptr = *event;
3677 /* Limit help event positions to this range, to avoid overflow problems. */
3678 #define INPUT_EVENT_POS_MAX \
3679 ((ptrdiff_t) min (PTRDIFF_MAX, min (TYPE_MAXIMUM (Time) / 2, \
3680 MOST_POSITIVE_FIXNUM)))
3681 #define INPUT_EVENT_POS_MIN (-1 - INPUT_EVENT_POS_MAX)
3683 /* Return a Time that encodes position POS. POS must be in range. */
3685 static Time
3686 position_to_Time (ptrdiff_t pos)
3688 eassert (INPUT_EVENT_POS_MIN <= pos && pos <= INPUT_EVENT_POS_MAX);
3689 return pos;
3692 /* Return the position that ENCODED_POS encodes.
3693 Avoid signed integer overflow. */
3695 static ptrdiff_t
3696 Time_to_position (Time encoded_pos)
3698 if (encoded_pos <= INPUT_EVENT_POS_MAX)
3699 return encoded_pos;
3700 Time encoded_pos_min = INPUT_EVENT_POS_MIN;
3701 eassert (encoded_pos_min <= encoded_pos);
3702 ptrdiff_t notpos = -1 - encoded_pos;
3703 return -1 - notpos;
3706 /* Generate a HELP_EVENT input_event and store it in the keyboard
3707 buffer.
3709 HELP is the help form.
3711 FRAME and WINDOW are the frame and window where the help is
3712 generated. OBJECT is the Lisp object where the help was found (a
3713 buffer, a string, an overlay, or nil if neither from a string nor
3714 from a buffer). POS is the position within OBJECT where the help
3715 was found. */
3717 void
3718 gen_help_event (Lisp_Object help, Lisp_Object frame, Lisp_Object window,
3719 Lisp_Object object, ptrdiff_t pos)
3721 struct input_event event;
3723 event.kind = HELP_EVENT;
3724 event.frame_or_window = frame;
3725 event.arg = object;
3726 event.x = WINDOWP (window) ? window : frame;
3727 event.y = help;
3728 event.timestamp = position_to_Time (pos);
3729 kbd_buffer_store_event (&event);
3733 /* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3735 void
3736 kbd_buffer_store_help_event (Lisp_Object frame, Lisp_Object help)
3738 struct input_event event;
3740 event.kind = HELP_EVENT;
3741 event.frame_or_window = frame;
3742 event.arg = Qnil;
3743 event.x = Qnil;
3744 event.y = help;
3745 event.timestamp = 0;
3746 kbd_buffer_store_event (&event);
3750 /* Discard any mouse events in the event buffer by setting them to
3751 NO_EVENT. */
3752 void
3753 discard_mouse_events (void)
3755 struct input_event *sp;
3756 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3758 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3759 sp = kbd_buffer;
3761 if (sp->kind == MOUSE_CLICK_EVENT
3762 || sp->kind == WHEEL_EVENT
3763 || sp->kind == HORIZ_WHEEL_EVENT
3764 #ifdef HAVE_GPM
3765 || sp->kind == GPM_CLICK_EVENT
3766 #endif
3767 || sp->kind == SCROLL_BAR_CLICK_EVENT
3768 || sp->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT)
3770 sp->kind = NO_EVENT;
3776 /* Return true if there are any real events waiting in the event
3777 buffer, not counting `NO_EVENT's.
3779 Discard NO_EVENT events at the front of the input queue, possibly
3780 leaving the input queue empty if there are no real input events. */
3782 bool
3783 kbd_buffer_events_waiting (void)
3785 struct input_event *sp;
3787 for (sp = kbd_fetch_ptr;
3788 sp != kbd_store_ptr && sp->kind == NO_EVENT;
3789 ++sp)
3791 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3792 sp = kbd_buffer;
3795 kbd_fetch_ptr = sp;
3796 return sp != kbd_store_ptr && sp->kind != NO_EVENT;
3800 /* Clear input event EVENT. */
3802 static void
3803 clear_event (struct input_event *event)
3805 event->kind = NO_EVENT;
3809 /* Read one event from the event buffer, waiting if necessary.
3810 The value is a Lisp object representing the event.
3811 The value is nil for an event that should be ignored,
3812 or that was handled here.
3813 We always read and discard one event. */
3815 static Lisp_Object
3816 kbd_buffer_get_event (KBOARD **kbp,
3817 bool *used_mouse_menu,
3818 struct timespec *end_time)
3820 Lisp_Object obj;
3822 #ifdef subprocesses
3823 if (kbd_on_hold_p () && kbd_buffer_nr_stored () < KBD_BUFFER_SIZE / 4)
3825 /* Start reading input again because we have processed enough to
3826 be able to accept new events again. */
3827 unhold_keyboard_input ();
3828 start_polling ();
3830 #endif /* subprocesses */
3832 #if !defined HAVE_DBUS && !defined USE_FILE_NOTIFY
3833 if (noninteractive
3834 /* In case we are running as a daemon, only do this before
3835 detaching from the terminal. */
3836 || (IS_DAEMON && daemon_pipe[1] >= 0))
3838 int c = getchar ();
3839 XSETINT (obj, c);
3840 *kbp = current_kboard;
3841 return obj;
3843 #endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY */
3845 /* Wait until there is input available. */
3846 for (;;)
3848 /* Break loop if there's an unread command event. Needed in
3849 moused window autoselection which uses a timer to insert such
3850 events. */
3851 if (CONSP (Vunread_command_events))
3852 break;
3854 if (kbd_fetch_ptr != kbd_store_ptr)
3855 break;
3856 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3857 break;
3859 /* If the quit flag is set, then read_char will return
3860 quit_char, so that counts as "available input." */
3861 if (!NILP (Vquit_flag))
3862 quit_throw_to_read_char (0);
3864 /* One way or another, wait until input is available; then, if
3865 interrupt handlers have not read it, read it now. */
3867 #ifdef USABLE_SIGIO
3868 gobble_input ();
3869 #endif
3870 if (kbd_fetch_ptr != kbd_store_ptr)
3871 break;
3872 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3873 break;
3874 if (end_time)
3876 struct timespec now = current_timespec ();
3877 if (timespec_cmp (*end_time, now) <= 0)
3878 return Qnil; /* Finished waiting. */
3879 else
3881 struct timespec duration = timespec_sub (*end_time, now);
3882 wait_reading_process_output (min (duration.tv_sec,
3883 WAIT_READING_MAX),
3884 duration.tv_nsec,
3885 -1, 1, Qnil, NULL, 0);
3888 else
3890 bool do_display = true;
3892 if (FRAME_TERMCAP_P (SELECTED_FRAME ()))
3894 struct tty_display_info *tty = CURTTY ();
3896 /* When this TTY is displaying a menu, we must prevent
3897 any redisplay, because we modify the frame's glyph
3898 matrix behind the back of the display engine. */
3899 if (tty->showing_menu)
3900 do_display = false;
3903 wait_reading_process_output (0, 0, -1, do_display, Qnil, NULL, 0);
3906 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
3907 gobble_input ();
3910 if (CONSP (Vunread_command_events))
3912 Lisp_Object first;
3913 first = XCAR (Vunread_command_events);
3914 Vunread_command_events = XCDR (Vunread_command_events);
3915 *kbp = current_kboard;
3916 return first;
3919 /* At this point, we know that there is a readable event available
3920 somewhere. If the event queue is empty, then there must be a
3921 mouse movement enabled and available. */
3922 if (kbd_fetch_ptr != kbd_store_ptr)
3924 struct input_event *event;
3926 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3927 ? kbd_fetch_ptr
3928 : kbd_buffer);
3930 *kbp = event_to_kboard (event);
3931 if (*kbp == 0)
3932 *kbp = current_kboard; /* Better than returning null ptr? */
3934 obj = Qnil;
3936 /* These two kinds of events get special handling
3937 and don't actually appear to the command loop.
3938 We return nil for them. */
3939 if (event->kind == SELECTION_REQUEST_EVENT
3940 || event->kind == SELECTION_CLEAR_EVENT)
3942 #ifdef HAVE_X11
3943 struct input_event copy;
3945 /* Remove it from the buffer before processing it,
3946 since otherwise swallow_events will see it
3947 and process it again. */
3948 copy = *event;
3949 kbd_fetch_ptr = event + 1;
3950 input_pending = readable_events (0);
3951 x_handle_selection_event (&copy);
3952 #else
3953 /* We're getting selection request events, but we don't have
3954 a window system. */
3955 emacs_abort ();
3956 #endif
3959 #if defined (HAVE_NS)
3960 else if (event->kind == NS_TEXT_EVENT)
3962 if (event->code == KEY_NS_PUT_WORKING_TEXT)
3963 obj = list1 (intern ("ns-put-working-text"));
3964 else
3965 obj = list1 (intern ("ns-unput-working-text"));
3966 kbd_fetch_ptr = event + 1;
3967 if (used_mouse_menu)
3968 *used_mouse_menu = 1;
3970 #endif
3972 #if defined (HAVE_X11) || defined (HAVE_NTGUI) \
3973 || defined (HAVE_NS)
3974 else if (event->kind == DELETE_WINDOW_EVENT)
3976 /* Make an event (delete-frame (FRAME)). */
3977 obj = list2 (Qdelete_frame, list1 (event->frame_or_window));
3978 kbd_fetch_ptr = event + 1;
3980 #endif
3981 #if defined (HAVE_X11) || defined (HAVE_NTGUI) \
3982 || defined (HAVE_NS)
3983 else if (event->kind == ICONIFY_EVENT)
3985 /* Make an event (iconify-frame (FRAME)). */
3986 obj = list2 (Qiconify_frame, list1 (event->frame_or_window));
3987 kbd_fetch_ptr = event + 1;
3989 else if (event->kind == DEICONIFY_EVENT)
3991 /* Make an event (make-frame-visible (FRAME)). */
3992 obj = list2 (Qmake_frame_visible, list1 (event->frame_or_window));
3993 kbd_fetch_ptr = event + 1;
3995 #endif
3996 else if (event->kind == BUFFER_SWITCH_EVENT)
3998 /* The value doesn't matter here; only the type is tested. */
3999 XSETBUFFER (obj, current_buffer);
4000 kbd_fetch_ptr = event + 1;
4002 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
4003 || defined (HAVE_NS) || defined (USE_GTK)
4004 else if (event->kind == MENU_BAR_ACTIVATE_EVENT)
4006 kbd_fetch_ptr = event + 1;
4007 input_pending = readable_events (0);
4008 if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
4009 x_activate_menubar (XFRAME (event->frame_or_window));
4011 #endif
4012 #ifdef HAVE_NTGUI
4013 else if (event->kind == LANGUAGE_CHANGE_EVENT)
4015 /* Make an event (language-change FRAME CODEPAGE LANGUAGE-ID). */
4016 obj = list4 (Qlanguage_change,
4017 event->frame_or_window,
4018 make_number (event->code),
4019 make_number (event->modifiers));
4020 kbd_fetch_ptr = event + 1;
4022 #endif
4023 #ifdef USE_FILE_NOTIFY
4024 else if (event->kind == FILE_NOTIFY_EVENT)
4026 #ifdef HAVE_W32NOTIFY
4027 /* Make an event (file-notify (DESCRIPTOR ACTION FILE) CALLBACK). */
4028 obj = list3 (Qfile_notify, event->arg, event->frame_or_window);
4029 #else
4030 obj = make_lispy_event (event);
4031 #endif
4032 kbd_fetch_ptr = event + 1;
4034 #endif /* USE_FILE_NOTIFY */
4035 else if (event->kind == SAVE_SESSION_EVENT)
4037 obj = list2 (Qsave_session, event->arg);
4038 kbd_fetch_ptr = event + 1;
4040 /* Just discard these, by returning nil.
4041 With MULTI_KBOARD, these events are used as placeholders
4042 when we need to randomly delete events from the queue.
4043 (They shouldn't otherwise be found in the buffer,
4044 but on some machines it appears they do show up
4045 even without MULTI_KBOARD.) */
4046 /* On Windows NT/9X, NO_EVENT is used to delete extraneous
4047 mouse events during a popup-menu call. */
4048 else if (event->kind == NO_EVENT)
4049 kbd_fetch_ptr = event + 1;
4050 else if (event->kind == HELP_EVENT)
4052 Lisp_Object object, position, help, frame, window;
4054 frame = event->frame_or_window;
4055 object = event->arg;
4056 position = make_number (Time_to_position (event->timestamp));
4057 window = event->x;
4058 help = event->y;
4059 clear_event (event);
4061 kbd_fetch_ptr = event + 1;
4062 if (!WINDOWP (window))
4063 window = Qnil;
4064 obj = Fcons (Qhelp_echo,
4065 list5 (frame, help, window, object, position));
4067 else if (event->kind == FOCUS_IN_EVENT)
4069 /* Notification of a FocusIn event. The frame receiving the
4070 focus is in event->frame_or_window. Generate a
4071 switch-frame event if necessary. */
4072 Lisp_Object frame, focus;
4074 frame = event->frame_or_window;
4075 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4076 if (FRAMEP (focus))
4077 frame = focus;
4079 if (
4080 #ifdef HAVE_X11
4081 ! NILP (event->arg)
4083 #endif
4084 !EQ (frame, internal_last_event_frame)
4085 && !EQ (frame, selected_frame))
4086 obj = make_lispy_switch_frame (frame);
4087 else
4088 obj = make_lispy_focus_in (frame);
4090 internal_last_event_frame = frame;
4091 kbd_fetch_ptr = event + 1;
4093 else if (event->kind == FOCUS_OUT_EVENT)
4095 #ifdef HAVE_WINDOW_SYSTEM
4097 Display_Info *di;
4098 Lisp_Object frame = event->frame_or_window;
4099 bool focused = false;
4101 for (di = x_display_list; di && ! focused; di = di->next)
4102 focused = di->x_highlight_frame != 0;
4104 if (!focused)
4105 obj = make_lispy_focus_out (frame);
4107 #endif /* HAVE_WINDOW_SYSTEM */
4109 kbd_fetch_ptr = event + 1;
4111 #ifdef HAVE_DBUS
4112 else if (event->kind == DBUS_EVENT)
4114 obj = make_lispy_event (event);
4115 kbd_fetch_ptr = event + 1;
4117 #endif
4118 else if (event->kind == CONFIG_CHANGED_EVENT)
4120 obj = make_lispy_event (event);
4121 kbd_fetch_ptr = event + 1;
4123 else
4125 /* If this event is on a different frame, return a switch-frame this
4126 time, and leave the event in the queue for next time. */
4127 Lisp_Object frame;
4128 Lisp_Object focus;
4130 frame = event->frame_or_window;
4131 if (CONSP (frame))
4132 frame = XCAR (frame);
4133 else if (WINDOWP (frame))
4134 frame = WINDOW_FRAME (XWINDOW (frame));
4136 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4137 if (! NILP (focus))
4138 frame = focus;
4140 if (! EQ (frame, internal_last_event_frame)
4141 && !EQ (frame, selected_frame))
4142 obj = make_lispy_switch_frame (frame);
4143 internal_last_event_frame = frame;
4145 /* If we didn't decide to make a switch-frame event, go ahead
4146 and build a real event from the queue entry. */
4148 if (NILP (obj))
4150 obj = make_lispy_event (event);
4152 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
4153 || defined (HAVE_NS) || defined (USE_GTK)
4154 /* If this was a menu selection, then set the flag to inhibit
4155 writing to last_nonmenu_event. Don't do this if the event
4156 we're returning is (menu-bar), though; that indicates the
4157 beginning of the menu sequence, and we might as well leave
4158 that as the `event with parameters' for this selection. */
4159 if (used_mouse_menu
4160 && !EQ (event->frame_or_window, event->arg)
4161 && (event->kind == MENU_BAR_EVENT
4162 || event->kind == TOOL_BAR_EVENT))
4163 *used_mouse_menu = 1;
4164 #endif
4165 #ifdef HAVE_NS
4166 /* Certain system events are non-key events. */
4167 if (used_mouse_menu
4168 && event->kind == NS_NONKEY_EVENT)
4169 *used_mouse_menu = 1;
4170 #endif
4172 /* Wipe out this event, to catch bugs. */
4173 clear_event (event);
4174 kbd_fetch_ptr = event + 1;
4178 /* Try generating a mouse motion event. */
4179 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
4181 struct frame *f = some_mouse_moved ();
4182 Lisp_Object bar_window;
4183 enum scroll_bar_part part;
4184 Lisp_Object x, y;
4185 Time t;
4187 *kbp = current_kboard;
4188 /* Note that this uses F to determine which terminal to look at.
4189 If there is no valid info, it does not store anything
4190 so x remains nil. */
4191 x = Qnil;
4193 /* XXX Can f or mouse_position_hook be NULL here? */
4194 if (f && FRAME_TERMINAL (f)->mouse_position_hook)
4195 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, 0, &bar_window,
4196 &part, &x, &y, &t);
4198 obj = Qnil;
4200 /* Decide if we should generate a switch-frame event. Don't
4201 generate switch-frame events for motion outside of all Emacs
4202 frames. */
4203 if (!NILP (x) && f)
4205 Lisp_Object frame;
4207 frame = FRAME_FOCUS_FRAME (f);
4208 if (NILP (frame))
4209 XSETFRAME (frame, f);
4211 if (! EQ (frame, internal_last_event_frame)
4212 && !EQ (frame, selected_frame))
4213 obj = make_lispy_switch_frame (frame);
4214 internal_last_event_frame = frame;
4217 /* If we didn't decide to make a switch-frame event, go ahead and
4218 return a mouse-motion event. */
4219 if (!NILP (x) && NILP (obj))
4220 obj = make_lispy_movement (f, bar_window, part, x, y, t);
4222 else
4223 /* We were promised by the above while loop that there was
4224 something for us to read! */
4225 emacs_abort ();
4227 input_pending = readable_events (0);
4229 Vlast_event_frame = internal_last_event_frame;
4231 return (obj);
4234 /* Process any non-user-visible events (currently X selection events),
4235 without reading any user-visible events. */
4237 static void
4238 process_special_events (void)
4240 struct input_event *event;
4242 for (event = kbd_fetch_ptr; event != kbd_store_ptr; ++event)
4244 if (event == kbd_buffer + KBD_BUFFER_SIZE)
4246 event = kbd_buffer;
4247 if (event == kbd_store_ptr)
4248 break;
4251 /* If we find a stored X selection request, handle it now. */
4252 if (event->kind == SELECTION_REQUEST_EVENT
4253 || event->kind == SELECTION_CLEAR_EVENT)
4255 #ifdef HAVE_X11
4257 /* Remove the event from the fifo buffer before processing;
4258 otherwise swallow_events called recursively could see it
4259 and process it again. To do this, we move the events
4260 between kbd_fetch_ptr and EVENT one slot to the right,
4261 cyclically. */
4263 struct input_event copy = *event;
4264 struct input_event *beg
4265 = (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
4266 ? kbd_buffer : kbd_fetch_ptr;
4268 if (event > beg)
4269 memmove (beg + 1, beg, (event - beg) * sizeof (struct input_event));
4270 else if (event < beg)
4272 if (event > kbd_buffer)
4273 memmove (kbd_buffer + 1, kbd_buffer,
4274 (event - kbd_buffer) * sizeof (struct input_event));
4275 *kbd_buffer = *(kbd_buffer + KBD_BUFFER_SIZE - 1);
4276 if (beg < kbd_buffer + KBD_BUFFER_SIZE - 1)
4277 memmove (beg + 1, beg,
4278 (kbd_buffer + KBD_BUFFER_SIZE - 1 - beg)
4279 * sizeof (struct input_event));
4282 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
4283 kbd_fetch_ptr = kbd_buffer + 1;
4284 else
4285 kbd_fetch_ptr++;
4287 input_pending = readable_events (0);
4288 x_handle_selection_event (&copy);
4289 #else
4290 /* We're getting selection request events, but we don't have
4291 a window system. */
4292 emacs_abort ();
4293 #endif
4298 /* Process any events that are not user-visible, run timer events that
4299 are ripe, and return, without reading any user-visible events. */
4301 void
4302 swallow_events (bool do_display)
4304 unsigned old_timers_run;
4306 process_special_events ();
4308 old_timers_run = timers_run;
4309 get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
4311 if (!input_pending && timers_run != old_timers_run && do_display)
4312 redisplay_preserve_echo_area (7);
4315 /* Record the start of when Emacs is idle,
4316 for the sake of running idle-time timers. */
4318 static void
4319 timer_start_idle (void)
4321 /* If we are already in the idle state, do nothing. */
4322 if (timespec_valid_p (timer_idleness_start_time))
4323 return;
4325 timer_idleness_start_time = current_timespec ();
4326 timer_last_idleness_start_time = timer_idleness_start_time;
4328 /* Mark all idle-time timers as once again candidates for running. */
4329 call0 (intern ("internal-timer-start-idle"));
4332 /* Record that Emacs is no longer idle, so stop running idle-time timers. */
4334 static void
4335 timer_stop_idle (void)
4337 timer_idleness_start_time = invalid_timespec ();
4340 /* Resume idle timer from last idle start time. */
4342 static void
4343 timer_resume_idle (void)
4345 if (timespec_valid_p (timer_idleness_start_time))
4346 return;
4348 timer_idleness_start_time = timer_last_idleness_start_time;
4351 /* This is only for debugging. */
4352 struct input_event last_timer_event EXTERNALLY_VISIBLE;
4354 /* List of elisp functions to call, delayed because they were generated in
4355 a context where Elisp could not be safely run (e.g. redisplay, signal,
4356 ...). Each element has the form (FUN . ARGS). */
4357 Lisp_Object pending_funcalls;
4359 /* Return true if TIMER is a valid timer, placing its value into *RESULT. */
4360 static bool
4361 decode_timer (Lisp_Object timer, struct timespec *result)
4363 Lisp_Object *vector;
4365 if (! (VECTORP (timer) && ASIZE (timer) == 9))
4366 return 0;
4367 vector = XVECTOR (timer)->contents;
4368 if (! NILP (vector[0]))
4369 return 0;
4370 if (! INTEGERP (vector[2]))
4371 return false;
4373 struct lisp_time t;
4374 if (! decode_time_components (vector[1], vector[2], vector[3], vector[8],
4375 &t, 0))
4376 return false;
4377 *result = lisp_to_timespec (t);
4378 return timespec_valid_p (*result);
4382 /* Check whether a timer has fired. To prevent larger problems we simply
4383 disregard elements that are not proper timers. Do not make a circular
4384 timer list for the time being.
4386 Returns the time to wait until the next timer fires. If a
4387 timer is triggering now, return zero.
4388 If no timer is active, return -1.
4390 If a timer is ripe, we run it, with quitting turned off.
4391 In that case we return 0 to indicate that a new timer_check_2 call
4392 should be done. */
4394 static struct timespec
4395 timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
4397 struct timespec nexttime;
4398 struct timespec now;
4399 struct timespec idleness_now;
4400 Lisp_Object chosen_timer;
4401 struct gcpro gcpro1;
4403 nexttime = invalid_timespec ();
4405 chosen_timer = Qnil;
4406 GCPRO1 (chosen_timer);
4408 /* First run the code that was delayed. */
4409 while (CONSP (pending_funcalls))
4411 Lisp_Object funcall = XCAR (pending_funcalls);
4412 pending_funcalls = XCDR (pending_funcalls);
4413 safe_call2 (Qapply, XCAR (funcall), XCDR (funcall));
4416 if (CONSP (timers) || CONSP (idle_timers))
4418 now = current_timespec ();
4419 idleness_now = (timespec_valid_p (timer_idleness_start_time)
4420 ? timespec_sub (now, timer_idleness_start_time)
4421 : make_timespec (0, 0));
4424 while (CONSP (timers) || CONSP (idle_timers))
4426 Lisp_Object timer = Qnil, idle_timer = Qnil;
4427 struct timespec timer_time, idle_timer_time;
4428 struct timespec difference;
4429 struct timespec timer_difference = invalid_timespec ();
4430 struct timespec idle_timer_difference = invalid_timespec ();
4431 bool ripe, timer_ripe = 0, idle_timer_ripe = 0;
4433 /* Set TIMER and TIMER_DIFFERENCE
4434 based on the next ordinary timer.
4435 TIMER_DIFFERENCE is the distance in time from NOW to when
4436 this timer becomes ripe (negative if it's already ripe).
4437 Skip past invalid timers and timers already handled. */
4438 if (CONSP (timers))
4440 timer = XCAR (timers);
4441 if (! decode_timer (timer, &timer_time))
4443 timers = XCDR (timers);
4444 continue;
4447 timer_ripe = timespec_cmp (timer_time, now) <= 0;
4448 timer_difference = (timer_ripe
4449 ? timespec_sub (now, timer_time)
4450 : timespec_sub (timer_time, now));
4453 /* Likewise for IDLE_TIMER and IDLE_TIMER_DIFFERENCE
4454 based on the next idle timer. */
4455 if (CONSP (idle_timers))
4457 idle_timer = XCAR (idle_timers);
4458 if (! decode_timer (idle_timer, &idle_timer_time))
4460 idle_timers = XCDR (idle_timers);
4461 continue;
4464 idle_timer_ripe = timespec_cmp (idle_timer_time, idleness_now) <= 0;
4465 idle_timer_difference
4466 = (idle_timer_ripe
4467 ? timespec_sub (idleness_now, idle_timer_time)
4468 : timespec_sub (idle_timer_time, idleness_now));
4471 /* Decide which timer is the next timer,
4472 and set CHOSEN_TIMER, DIFFERENCE, and RIPE accordingly.
4473 Also step down the list where we found that timer. */
4475 if (timespec_valid_p (timer_difference)
4476 && (! timespec_valid_p (idle_timer_difference)
4477 || idle_timer_ripe < timer_ripe
4478 || (idle_timer_ripe == timer_ripe
4479 && ((timer_ripe
4480 ? timespec_cmp (idle_timer_difference,
4481 timer_difference)
4482 : timespec_cmp (timer_difference,
4483 idle_timer_difference))
4484 < 0))))
4486 chosen_timer = timer;
4487 timers = XCDR (timers);
4488 difference = timer_difference;
4489 ripe = timer_ripe;
4491 else
4493 chosen_timer = idle_timer;
4494 idle_timers = XCDR (idle_timers);
4495 difference = idle_timer_difference;
4496 ripe = idle_timer_ripe;
4499 /* If timer is ripe, run it if it hasn't been run. */
4500 if (ripe)
4502 if (NILP (AREF (chosen_timer, 0)))
4504 ptrdiff_t count = SPECPDL_INDEX ();
4505 Lisp_Object old_deactivate_mark = Vdeactivate_mark;
4507 /* Mark the timer as triggered to prevent problems if the lisp
4508 code fails to reschedule it right. */
4509 ASET (chosen_timer, 0, Qt);
4511 specbind (Qinhibit_quit, Qt);
4513 call1 (Qtimer_event_handler, chosen_timer);
4514 Vdeactivate_mark = old_deactivate_mark;
4515 timers_run++;
4516 unbind_to (count, Qnil);
4518 /* Since we have handled the event,
4519 we don't need to tell the caller to wake up and do it. */
4520 /* But the caller must still wait for the next timer, so
4521 return 0 to indicate that. */
4524 nexttime = make_timespec (0, 0);
4525 break;
4527 else
4528 /* When we encounter a timer that is still waiting,
4529 return the amount of time to wait before it is ripe. */
4531 UNGCPRO;
4532 return difference;
4536 /* No timers are pending in the future. */
4537 /* Return 0 if we generated an event, and -1 if not. */
4538 UNGCPRO;
4539 return nexttime;
4543 /* Check whether a timer has fired. To prevent larger problems we simply
4544 disregard elements that are not proper timers. Do not make a circular
4545 timer list for the time being.
4547 Returns the time to wait until the next timer fires.
4548 If no timer is active, return an invalid value.
4550 As long as any timer is ripe, we run it. */
4552 struct timespec
4553 timer_check (void)
4555 struct timespec nexttime;
4556 Lisp_Object timers, idle_timers;
4557 struct gcpro gcpro1, gcpro2;
4559 Lisp_Object tem = Vinhibit_quit;
4560 Vinhibit_quit = Qt;
4562 /* We use copies of the timers' lists to allow a timer to add itself
4563 again, without locking up Emacs if the newly added timer is
4564 already ripe when added. */
4566 /* Always consider the ordinary timers. */
4567 timers = Fcopy_sequence (Vtimer_list);
4568 /* Consider the idle timers only if Emacs is idle. */
4569 if (timespec_valid_p (timer_idleness_start_time))
4570 idle_timers = Fcopy_sequence (Vtimer_idle_list);
4571 else
4572 idle_timers = Qnil;
4574 Vinhibit_quit = tem;
4576 GCPRO2 (timers, idle_timers);
4580 nexttime = timer_check_2 (timers, idle_timers);
4582 while (nexttime.tv_sec == 0 && nexttime.tv_nsec == 0);
4584 UNGCPRO;
4585 return nexttime;
4588 DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0,
4589 doc: /* Return the current length of Emacs idleness, or nil.
4590 The value when Emacs is idle is a list of four integers (HIGH LOW USEC PSEC)
4591 in the same style as (current-time).
4593 The value when Emacs is not idle is nil.
4595 PSEC is a multiple of the system clock resolution. */)
4596 (void)
4598 if (timespec_valid_p (timer_idleness_start_time))
4599 return make_lisp_time (timespec_sub (current_timespec (),
4600 timer_idleness_start_time));
4602 return Qnil;
4605 /* Caches for modify_event_symbol. */
4606 static Lisp_Object accent_key_syms;
4607 static Lisp_Object func_key_syms;
4608 static Lisp_Object mouse_syms;
4609 static Lisp_Object wheel_syms;
4610 static Lisp_Object drag_n_drop_syms;
4612 /* This is a list of keysym codes for special "accent" characters.
4613 It parallels lispy_accent_keys. */
4615 static const int lispy_accent_codes[] =
4617 #ifdef XK_dead_circumflex
4618 XK_dead_circumflex,
4619 #else
4621 #endif
4622 #ifdef XK_dead_grave
4623 XK_dead_grave,
4624 #else
4626 #endif
4627 #ifdef XK_dead_tilde
4628 XK_dead_tilde,
4629 #else
4631 #endif
4632 #ifdef XK_dead_diaeresis
4633 XK_dead_diaeresis,
4634 #else
4636 #endif
4637 #ifdef XK_dead_macron
4638 XK_dead_macron,
4639 #else
4641 #endif
4642 #ifdef XK_dead_degree
4643 XK_dead_degree,
4644 #else
4646 #endif
4647 #ifdef XK_dead_acute
4648 XK_dead_acute,
4649 #else
4651 #endif
4652 #ifdef XK_dead_cedilla
4653 XK_dead_cedilla,
4654 #else
4656 #endif
4657 #ifdef XK_dead_breve
4658 XK_dead_breve,
4659 #else
4661 #endif
4662 #ifdef XK_dead_ogonek
4663 XK_dead_ogonek,
4664 #else
4666 #endif
4667 #ifdef XK_dead_caron
4668 XK_dead_caron,
4669 #else
4671 #endif
4672 #ifdef XK_dead_doubleacute
4673 XK_dead_doubleacute,
4674 #else
4676 #endif
4677 #ifdef XK_dead_abovedot
4678 XK_dead_abovedot,
4679 #else
4681 #endif
4682 #ifdef XK_dead_abovering
4683 XK_dead_abovering,
4684 #else
4686 #endif
4687 #ifdef XK_dead_iota
4688 XK_dead_iota,
4689 #else
4691 #endif
4692 #ifdef XK_dead_belowdot
4693 XK_dead_belowdot,
4694 #else
4696 #endif
4697 #ifdef XK_dead_voiced_sound
4698 XK_dead_voiced_sound,
4699 #else
4701 #endif
4702 #ifdef XK_dead_semivoiced_sound
4703 XK_dead_semivoiced_sound,
4704 #else
4706 #endif
4707 #ifdef XK_dead_hook
4708 XK_dead_hook,
4709 #else
4711 #endif
4712 #ifdef XK_dead_horn
4713 XK_dead_horn,
4714 #else
4716 #endif
4719 /* This is a list of Lisp names for special "accent" characters.
4720 It parallels lispy_accent_codes. */
4722 static const char *const lispy_accent_keys[] =
4724 "dead-circumflex",
4725 "dead-grave",
4726 "dead-tilde",
4727 "dead-diaeresis",
4728 "dead-macron",
4729 "dead-degree",
4730 "dead-acute",
4731 "dead-cedilla",
4732 "dead-breve",
4733 "dead-ogonek",
4734 "dead-caron",
4735 "dead-doubleacute",
4736 "dead-abovedot",
4737 "dead-abovering",
4738 "dead-iota",
4739 "dead-belowdot",
4740 "dead-voiced-sound",
4741 "dead-semivoiced-sound",
4742 "dead-hook",
4743 "dead-horn",
4746 #ifdef HAVE_NTGUI
4747 #define FUNCTION_KEY_OFFSET 0x0
4749 const char *const lispy_function_keys[] =
4751 0, /* 0 */
4753 0, /* VK_LBUTTON 0x01 */
4754 0, /* VK_RBUTTON 0x02 */
4755 "cancel", /* VK_CANCEL 0x03 */
4756 0, /* VK_MBUTTON 0x04 */
4758 0, 0, 0, /* 0x05 .. 0x07 */
4760 "backspace", /* VK_BACK 0x08 */
4761 "tab", /* VK_TAB 0x09 */
4763 0, 0, /* 0x0A .. 0x0B */
4765 "clear", /* VK_CLEAR 0x0C */
4766 "return", /* VK_RETURN 0x0D */
4768 0, 0, /* 0x0E .. 0x0F */
4770 0, /* VK_SHIFT 0x10 */
4771 0, /* VK_CONTROL 0x11 */
4772 0, /* VK_MENU 0x12 */
4773 "pause", /* VK_PAUSE 0x13 */
4774 "capslock", /* VK_CAPITAL 0x14 */
4775 "kana", /* VK_KANA/VK_HANGUL 0x15 */
4776 0, /* 0x16 */
4777 "junja", /* VK_JUNJA 0x17 */
4778 "final", /* VK_FINAL 0x18 */
4779 "kanji", /* VK_KANJI/VK_HANJA 0x19 */
4780 0, /* 0x1A */
4781 "escape", /* VK_ESCAPE 0x1B */
4782 "convert", /* VK_CONVERT 0x1C */
4783 "non-convert", /* VK_NONCONVERT 0x1D */
4784 "accept", /* VK_ACCEPT 0x1E */
4785 "mode-change", /* VK_MODECHANGE 0x1F */
4786 0, /* VK_SPACE 0x20 */
4787 "prior", /* VK_PRIOR 0x21 */
4788 "next", /* VK_NEXT 0x22 */
4789 "end", /* VK_END 0x23 */
4790 "home", /* VK_HOME 0x24 */
4791 "left", /* VK_LEFT 0x25 */
4792 "up", /* VK_UP 0x26 */
4793 "right", /* VK_RIGHT 0x27 */
4794 "down", /* VK_DOWN 0x28 */
4795 "select", /* VK_SELECT 0x29 */
4796 "print", /* VK_PRINT 0x2A */
4797 "execute", /* VK_EXECUTE 0x2B */
4798 "snapshot", /* VK_SNAPSHOT 0x2C */
4799 "insert", /* VK_INSERT 0x2D */
4800 "delete", /* VK_DELETE 0x2E */
4801 "help", /* VK_HELP 0x2F */
4803 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
4805 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4807 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
4809 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
4811 0, 0, 0, 0, 0, 0, 0, 0, 0,
4812 0, 0, 0, 0, 0, 0, 0, 0, 0,
4813 0, 0, 0, 0, 0, 0, 0, 0,
4815 "lwindow", /* VK_LWIN 0x5B */
4816 "rwindow", /* VK_RWIN 0x5C */
4817 "apps", /* VK_APPS 0x5D */
4818 0, /* 0x5E */
4819 "sleep",
4820 "kp-0", /* VK_NUMPAD0 0x60 */
4821 "kp-1", /* VK_NUMPAD1 0x61 */
4822 "kp-2", /* VK_NUMPAD2 0x62 */
4823 "kp-3", /* VK_NUMPAD3 0x63 */
4824 "kp-4", /* VK_NUMPAD4 0x64 */
4825 "kp-5", /* VK_NUMPAD5 0x65 */
4826 "kp-6", /* VK_NUMPAD6 0x66 */
4827 "kp-7", /* VK_NUMPAD7 0x67 */
4828 "kp-8", /* VK_NUMPAD8 0x68 */
4829 "kp-9", /* VK_NUMPAD9 0x69 */
4830 "kp-multiply", /* VK_MULTIPLY 0x6A */
4831 "kp-add", /* VK_ADD 0x6B */
4832 "kp-separator", /* VK_SEPARATOR 0x6C */
4833 "kp-subtract", /* VK_SUBTRACT 0x6D */
4834 "kp-decimal", /* VK_DECIMAL 0x6E */
4835 "kp-divide", /* VK_DIVIDE 0x6F */
4836 "f1", /* VK_F1 0x70 */
4837 "f2", /* VK_F2 0x71 */
4838 "f3", /* VK_F3 0x72 */
4839 "f4", /* VK_F4 0x73 */
4840 "f5", /* VK_F5 0x74 */
4841 "f6", /* VK_F6 0x75 */
4842 "f7", /* VK_F7 0x76 */
4843 "f8", /* VK_F8 0x77 */
4844 "f9", /* VK_F9 0x78 */
4845 "f10", /* VK_F10 0x79 */
4846 "f11", /* VK_F11 0x7A */
4847 "f12", /* VK_F12 0x7B */
4848 "f13", /* VK_F13 0x7C */
4849 "f14", /* VK_F14 0x7D */
4850 "f15", /* VK_F15 0x7E */
4851 "f16", /* VK_F16 0x7F */
4852 "f17", /* VK_F17 0x80 */
4853 "f18", /* VK_F18 0x81 */
4854 "f19", /* VK_F19 0x82 */
4855 "f20", /* VK_F20 0x83 */
4856 "f21", /* VK_F21 0x84 */
4857 "f22", /* VK_F22 0x85 */
4858 "f23", /* VK_F23 0x86 */
4859 "f24", /* VK_F24 0x87 */
4861 0, 0, 0, 0, /* 0x88 .. 0x8B */
4862 0, 0, 0, 0, /* 0x8C .. 0x8F */
4864 "kp-numlock", /* VK_NUMLOCK 0x90 */
4865 "scroll", /* VK_SCROLL 0x91 */
4866 /* Not sure where the following block comes from.
4867 Windows headers have NEC and Fujitsu specific keys in
4868 this block, but nothing generic. */
4869 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
4870 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
4871 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
4872 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
4873 "kp-end", /* VK_NUMPAD_END 0x96 */
4874 "kp-home", /* VK_NUMPAD_HOME 0x97 */
4875 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
4876 "kp-up", /* VK_NUMPAD_UP 0x99 */
4877 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
4878 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
4879 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
4880 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
4882 0, 0, /* 0x9E .. 0x9F */
4885 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
4886 * Used only as parameters to GetAsyncKeyState and GetKeyState.
4887 * No other API or message will distinguish left and right keys this way.
4888 * 0xA0 .. 0xA5
4890 0, 0, 0, 0, 0, 0,
4892 /* Multimedia keys. These are handled as WM_APPCOMMAND, which allows us
4893 to enable them selectively, and gives access to a few more functions.
4894 See lispy_multimedia_keys below. */
4895 0, 0, 0, 0, 0, 0, 0, /* 0xA6 .. 0xAC Browser */
4896 0, 0, 0, /* 0xAD .. 0xAF Volume */
4897 0, 0, 0, 0, /* 0xB0 .. 0xB3 Media */
4898 0, 0, 0, 0, /* 0xB4 .. 0xB7 Apps */
4900 /* 0xB8 .. 0xC0 "OEM" keys - all seem to be punctuation. */
4901 0, 0, 0, 0, 0, 0, 0, 0, 0,
4903 /* 0xC1 - 0xDA unallocated, 0xDB-0xDF more OEM keys */
4904 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4905 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4907 0, /* 0xE0 */
4908 "ax", /* VK_OEM_AX 0xE1 */
4909 0, /* VK_OEM_102 0xE2 */
4910 "ico-help", /* VK_ICO_HELP 0xE3 */
4911 "ico-00", /* VK_ICO_00 0xE4 */
4912 0, /* VK_PROCESSKEY 0xE5 - used by IME */
4913 "ico-clear", /* VK_ICO_CLEAR 0xE6 */
4914 0, /* VK_PACKET 0xE7 - used to pass Unicode chars */
4915 0, /* 0xE8 */
4916 "reset", /* VK_OEM_RESET 0xE9 */
4917 "jump", /* VK_OEM_JUMP 0xEA */
4918 "oem-pa1", /* VK_OEM_PA1 0xEB */
4919 "oem-pa2", /* VK_OEM_PA2 0xEC */
4920 "oem-pa3", /* VK_OEM_PA3 0xED */
4921 "wsctrl", /* VK_OEM_WSCTRL 0xEE */
4922 "cusel", /* VK_OEM_CUSEL 0xEF */
4923 "oem-attn", /* VK_OEM_ATTN 0xF0 */
4924 "finish", /* VK_OEM_FINISH 0xF1 */
4925 "copy", /* VK_OEM_COPY 0xF2 */
4926 "auto", /* VK_OEM_AUTO 0xF3 */
4927 "enlw", /* VK_OEM_ENLW 0xF4 */
4928 "backtab", /* VK_OEM_BACKTAB 0xF5 */
4929 "attn", /* VK_ATTN 0xF6 */
4930 "crsel", /* VK_CRSEL 0xF7 */
4931 "exsel", /* VK_EXSEL 0xF8 */
4932 "ereof", /* VK_EREOF 0xF9 */
4933 "play", /* VK_PLAY 0xFA */
4934 "zoom", /* VK_ZOOM 0xFB */
4935 "noname", /* VK_NONAME 0xFC */
4936 "pa1", /* VK_PA1 0xFD */
4937 "oem_clear", /* VK_OEM_CLEAR 0xFE */
4938 0 /* 0xFF */
4941 /* Some of these duplicate the "Media keys" on newer keyboards,
4942 but they are delivered to the application in a different way. */
4943 static const char *const lispy_multimedia_keys[] =
4946 "browser-back",
4947 "browser-forward",
4948 "browser-refresh",
4949 "browser-stop",
4950 "browser-search",
4951 "browser-favorites",
4952 "browser-home",
4953 "volume-mute",
4954 "volume-down",
4955 "volume-up",
4956 "media-next",
4957 "media-previous",
4958 "media-stop",
4959 "media-play-pause",
4960 "mail",
4961 "media-select",
4962 "app-1",
4963 "app-2",
4964 "bass-down",
4965 "bass-boost",
4966 "bass-up",
4967 "treble-down",
4968 "treble-up",
4969 "mic-volume-mute",
4970 "mic-volume-down",
4971 "mic-volume-up",
4972 "help",
4973 "find",
4974 "new",
4975 "open",
4976 "close",
4977 "save",
4978 "print",
4979 "undo",
4980 "redo",
4981 "copy",
4982 "cut",
4983 "paste",
4984 "mail-reply",
4985 "mail-forward",
4986 "mail-send",
4987 "spell-check",
4988 "toggle-dictate-command",
4989 "mic-toggle",
4990 "correction-list",
4991 "media-play",
4992 "media-pause",
4993 "media-record",
4994 "media-fast-forward",
4995 "media-rewind",
4996 "media-channel-up",
4997 "media-channel-down"
5000 #else /* not HAVE_NTGUI */
5002 /* This should be dealt with in XTread_socket now, and that doesn't
5003 depend on the client system having the Kana syms defined. See also
5004 the XK_kana_A case below. */
5005 #if 0
5006 #ifdef XK_kana_A
5007 static const char *const lispy_kana_keys[] =
5009 /* X Keysym value */
5010 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
5011 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
5012 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
5013 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
5014 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
5015 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
5016 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
5017 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
5018 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
5019 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
5020 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
5021 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
5022 "kana-i", "kana-u", "kana-e", "kana-o",
5023 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
5024 "prolongedsound", "kana-A", "kana-I", "kana-U",
5025 "kana-E", "kana-O", "kana-KA", "kana-KI",
5026 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
5027 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
5028 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
5029 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
5030 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
5031 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
5032 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
5033 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
5034 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
5035 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
5036 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
5037 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
5039 #endif /* XK_kana_A */
5040 #endif /* 0 */
5042 #define FUNCTION_KEY_OFFSET 0xff00
5044 /* You'll notice that this table is arranged to be conveniently
5045 indexed by X Windows keysym values. */
5046 static const char *const lispy_function_keys[] =
5048 /* X Keysym value */
5050 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
5051 "backspace", "tab", "linefeed", "clear",
5052 0, "return", 0, 0,
5053 0, 0, 0, "pause", /* 0xff10...1f */
5054 0, 0, 0, 0, 0, 0, 0, "escape",
5055 0, 0, 0, 0,
5056 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
5057 "romaji", "hiragana", "katakana", "hiragana-katakana",
5058 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
5059 "massyo", "kana-lock", "kana-shift", "eisu-shift",
5060 "eisu-toggle", /* 0xff30...3f */
5061 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5062 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
5064 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
5065 "down", "prior", "next", "end",
5066 "begin", 0, 0, 0, 0, 0, 0, 0,
5067 "select", /* 0xff60 */ /* IsMiscFunctionKey */
5068 "print",
5069 "execute",
5070 "insert",
5071 0, /* 0xff64 */
5072 "undo",
5073 "redo",
5074 "menu",
5075 "find",
5076 "cancel",
5077 "help",
5078 "break", /* 0xff6b */
5080 0, 0, 0, 0,
5081 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
5082 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
5083 "kp-space", /* 0xff80 */ /* IsKeypadKey */
5084 0, 0, 0, 0, 0, 0, 0, 0,
5085 "kp-tab", /* 0xff89 */
5086 0, 0, 0,
5087 "kp-enter", /* 0xff8d */
5088 0, 0, 0,
5089 "kp-f1", /* 0xff91 */
5090 "kp-f2",
5091 "kp-f3",
5092 "kp-f4",
5093 "kp-home", /* 0xff95 */
5094 "kp-left",
5095 "kp-up",
5096 "kp-right",
5097 "kp-down",
5098 "kp-prior", /* kp-page-up */
5099 "kp-next", /* kp-page-down */
5100 "kp-end",
5101 "kp-begin",
5102 "kp-insert",
5103 "kp-delete",
5104 0, /* 0xffa0 */
5105 0, 0, 0, 0, 0, 0, 0, 0, 0,
5106 "kp-multiply", /* 0xffaa */
5107 "kp-add",
5108 "kp-separator",
5109 "kp-subtract",
5110 "kp-decimal",
5111 "kp-divide", /* 0xffaf */
5112 "kp-0", /* 0xffb0 */
5113 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
5114 0, /* 0xffba */
5115 0, 0,
5116 "kp-equal", /* 0xffbd */
5117 "f1", /* 0xffbe */ /* IsFunctionKey */
5118 "f2",
5119 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
5120 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
5121 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
5122 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
5123 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
5124 0, 0, 0, 0, 0, 0, 0, 0,
5125 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
5126 0, 0, 0, 0, 0, 0, 0, "delete"
5129 /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
5130 #define ISO_FUNCTION_KEY_OFFSET 0xfe00
5132 static const char *const iso_lispy_function_keys[] =
5134 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
5135 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
5136 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
5137 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
5138 "iso-lefttab", /* 0xfe20 */
5139 "iso-move-line-up", "iso-move-line-down",
5140 "iso-partial-line-up", "iso-partial-line-down",
5141 "iso-partial-space-left", "iso-partial-space-right",
5142 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
5143 "iso-release-margin-left", "iso-release-margin-right",
5144 "iso-release-both-margins",
5145 "iso-fast-cursor-left", "iso-fast-cursor-right",
5146 "iso-fast-cursor-up", "iso-fast-cursor-down",
5147 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
5148 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
5151 #endif /* not HAVE_NTGUI */
5153 static Lisp_Object Vlispy_mouse_stem;
5155 static const char *const lispy_wheel_names[] =
5157 "wheel-up", "wheel-down", "wheel-left", "wheel-right"
5160 /* drag-n-drop events are generated when a set of selected files are
5161 dragged from another application and dropped onto an Emacs window. */
5162 static const char *const lispy_drag_n_drop_names[] =
5164 "drag-n-drop"
5167 /* An array of scroll bar parts, indexed by an enum scroll_bar_part value.
5168 Note that Qnil corresponds to scroll_bar_nowhere and should not appear
5169 in Lisp events. */
5170 static struct Lisp_Symbol *const scroll_bar_parts[] = {
5171 XSYMBOL_INIT (Qnil), XSYMBOL_INIT (Qabove_handle), XSYMBOL_INIT (Qhandle),
5172 XSYMBOL_INIT (Qbelow_handle), XSYMBOL_INIT (Qup), XSYMBOL_INIT (Qdown),
5173 XSYMBOL_INIT (Qtop), XSYMBOL_INIT (Qbottom), XSYMBOL_INIT (Qend_scroll),
5174 XSYMBOL_INIT (Qratio), XSYMBOL_INIT (Qbefore_handle),
5175 XSYMBOL_INIT (Qhorizontal_handle), XSYMBOL_INIT (Qafter_handle),
5176 XSYMBOL_INIT (Qleft), XSYMBOL_INIT (Qright), XSYMBOL_INIT (Qleftmost),
5177 XSYMBOL_INIT (Qrightmost), XSYMBOL_INIT (Qend_scroll), XSYMBOL_INIT (Qratio)
5180 /* A vector, indexed by button number, giving the down-going location
5181 of currently depressed buttons, both scroll bar and non-scroll bar.
5183 The elements have the form
5184 (BUTTON-NUMBER MODIFIER-MASK . REST)
5185 where REST is the cdr of a position as it would be reported in the event.
5187 The make_lispy_event function stores positions here to tell the
5188 difference between click and drag events, and to store the starting
5189 location to be included in drag events. */
5191 static Lisp_Object button_down_location;
5193 /* Information about the most recent up-going button event: Which
5194 button, what location, and what time. */
5196 static int last_mouse_button;
5197 static int last_mouse_x;
5198 static int last_mouse_y;
5199 static Time button_down_time;
5201 /* The number of clicks in this multiple-click. */
5203 static int double_click_count;
5205 /* X and Y are frame-relative coordinates for a click or wheel event.
5206 Return a Lisp-style event list. */
5208 static Lisp_Object
5209 make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
5210 Time t)
5212 enum window_part part;
5213 Lisp_Object posn = Qnil;
5214 Lisp_Object extra_info = Qnil;
5215 /* Coordinate pixel positions to return. */
5216 int xret = 0, yret = 0;
5217 /* The window under frame pixel coordinates (x,y) */
5218 Lisp_Object window = f
5219 ? window_from_coordinates (f, XINT (x), XINT (y), &part, 0)
5220 : Qnil;
5222 if (WINDOWP (window))
5224 /* It's a click in window WINDOW at frame coordinates (X,Y) */
5225 struct window *w = XWINDOW (window);
5226 Lisp_Object string_info = Qnil;
5227 ptrdiff_t textpos = 0;
5228 int col = -1, row = -1;
5229 int dx = -1, dy = -1;
5230 int width = -1, height = -1;
5231 Lisp_Object object = Qnil;
5233 /* Pixel coordinates relative to the window corner. */
5234 int wx = XINT (x) - WINDOW_LEFT_EDGE_X (w);
5235 int wy = XINT (y) - WINDOW_TOP_EDGE_Y (w);
5237 /* For text area clicks, return X, Y relative to the corner of
5238 this text area. Note that dX, dY etc are set below, by
5239 buffer_posn_from_coords. */
5240 if (part == ON_TEXT)
5242 xret = XINT (x) - window_box_left (w, TEXT_AREA);
5243 yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5245 /* For mode line and header line clicks, return X, Y relative to
5246 the left window edge. Use mode_line_string to look for a
5247 string on the click position. */
5248 else if (part == ON_MODE_LINE || part == ON_HEADER_LINE)
5250 Lisp_Object string;
5251 ptrdiff_t charpos;
5253 posn = (part == ON_MODE_LINE) ? Qmode_line : Qheader_line;
5254 /* Note that mode_line_string takes COL, ROW as pixels and
5255 converts them to characters. */
5256 col = wx;
5257 row = wy;
5258 string = mode_line_string (w, part, &col, &row, &charpos,
5259 &object, &dx, &dy, &width, &height);
5260 if (STRINGP (string))
5261 string_info = Fcons (string, make_number (charpos));
5262 textpos = -1;
5264 xret = wx;
5265 yret = wy;
5267 /* For fringes and margins, Y is relative to the area's (and the
5268 window's) top edge, while X is meaningless. */
5269 else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
5271 Lisp_Object string;
5272 ptrdiff_t charpos;
5274 posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin;
5275 col = wx;
5276 row = wy;
5277 string = marginal_area_string (w, part, &col, &row, &charpos,
5278 &object, &dx, &dy, &width, &height);
5279 if (STRINGP (string))
5280 string_info = Fcons (string, make_number (charpos));
5281 xret = wx;
5282 yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5284 else if (part == ON_LEFT_FRINGE)
5286 posn = Qleft_fringe;
5287 col = 0;
5288 xret = wx;
5289 dx = wx
5290 - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5291 ? 0 : window_box_width (w, LEFT_MARGIN_AREA));
5292 dy = yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5294 else if (part == ON_RIGHT_FRINGE)
5296 posn = Qright_fringe;
5297 col = 0;
5298 xret = wx;
5299 dx = wx
5300 - window_box_width (w, LEFT_MARGIN_AREA)
5301 - window_box_width (w, TEXT_AREA)
5302 - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5303 ? window_box_width (w, RIGHT_MARGIN_AREA)
5304 : 0);
5305 dy = yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5307 else if (part == ON_VERTICAL_BORDER)
5309 posn = Qvertical_line;
5310 width = 1;
5311 dx = 0;
5312 xret = wx;
5313 dy = yret = wy;
5315 else if (part == ON_VERTICAL_SCROLL_BAR)
5317 posn = Qvertical_scroll_bar;
5318 width = WINDOW_SCROLL_BAR_AREA_WIDTH (w);
5319 dx = xret = wx;
5320 dy = yret = wy;
5322 else if (part == ON_HORIZONTAL_SCROLL_BAR)
5324 posn = Qhorizontal_scroll_bar;
5325 width = WINDOW_SCROLL_BAR_AREA_HEIGHT (w);
5326 dx = xret = wx;
5327 dy = yret = wy;
5329 else if (part == ON_RIGHT_DIVIDER)
5331 posn = Qright_divider;
5332 width = WINDOW_RIGHT_DIVIDER_WIDTH (w);
5333 dx = xret = wx;
5334 dy = yret = wy;
5336 else if (part == ON_BOTTOM_DIVIDER)
5338 posn = Qbottom_divider;
5339 width = WINDOW_BOTTOM_DIVIDER_WIDTH (w);
5340 dx = xret = wx;
5341 dy = yret = wy;
5344 /* For clicks in the text area, fringes, or margins, call
5345 buffer_posn_from_coords to extract TEXTPOS, the buffer
5346 position nearest to the click. */
5347 if (!textpos)
5349 Lisp_Object string2, object2 = Qnil;
5350 struct display_pos p;
5351 int dx2, dy2;
5352 int width2, height2;
5353 /* The pixel X coordinate passed to buffer_posn_from_coords
5354 is the X coordinate relative to the text area for
5355 text-area and right-margin clicks, zero otherwise. */
5356 int x2
5357 = (part == ON_TEXT) ? xret
5358 : (part == ON_RIGHT_FRINGE || part == ON_RIGHT_MARGIN)
5359 ? (XINT (x) - window_box_left (w, TEXT_AREA))
5360 : 0;
5361 int y2 = wy;
5363 string2 = buffer_posn_from_coords (w, &x2, &y2, &p,
5364 &object2, &dx2, &dy2,
5365 &width2, &height2);
5366 textpos = CHARPOS (p.pos);
5367 if (col < 0) col = x2;
5368 if (row < 0) row = y2;
5369 if (dx < 0) dx = dx2;
5370 if (dy < 0) dy = dy2;
5371 if (width < 0) width = width2;
5372 if (height < 0) height = height2;
5374 if (NILP (posn))
5376 posn = make_number (textpos);
5377 if (STRINGP (string2))
5378 string_info = Fcons (string2,
5379 make_number (CHARPOS (p.string_pos)));
5381 if (NILP (object))
5382 object = object2;
5385 #ifdef HAVE_WINDOW_SYSTEM
5386 if (IMAGEP (object))
5388 Lisp_Object image_map, hotspot;
5389 if ((image_map = Fplist_get (XCDR (object), QCmap),
5390 !NILP (image_map))
5391 && (hotspot = find_hot_spot (image_map, dx, dy),
5392 CONSP (hotspot))
5393 && (hotspot = XCDR (hotspot), CONSP (hotspot)))
5394 posn = XCAR (hotspot);
5396 #endif
5398 /* Object info. */
5399 extra_info
5400 = list3 (object,
5401 Fcons (make_number (dx), make_number (dy)),
5402 Fcons (make_number (width), make_number (height)));
5404 /* String info. */
5405 extra_info = Fcons (string_info,
5406 Fcons (textpos < 0 ? Qnil : make_number (textpos),
5407 Fcons (Fcons (make_number (col),
5408 make_number (row)),
5409 extra_info)));
5411 else if (f != 0)
5413 /* Return mouse pixel coordinates here. */
5414 XSETFRAME (window, f);
5415 xret = XINT (x);
5416 yret = XINT (y);
5418 else
5419 window = Qnil;
5421 return Fcons (window,
5422 Fcons (posn,
5423 Fcons (Fcons (make_number (xret),
5424 make_number (yret)),
5425 Fcons (make_number (t),
5426 extra_info))));
5429 /* Return non-zero if F is a GUI frame that uses some toolkit-managed
5430 menu bar. This really means that Emacs draws and manages the menu
5431 bar as part of its normal display, and therefore can compute its
5432 geometry. */
5433 static bool
5434 toolkit_menubar_in_use (struct frame *f)
5436 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
5437 return !(!FRAME_WINDOW_P (f));
5438 #else
5439 return false;
5440 #endif
5443 /* Build the part of Lisp event which represents scroll bar state from
5444 EV. TYPE is one of Qvertical_scroll_bar or Qhorizontal_scroll_bar. */
5446 static Lisp_Object
5447 make_scroll_bar_position (struct input_event *ev, Lisp_Object type)
5449 return list5 (ev->frame_or_window, type, Fcons (ev->x, ev->y),
5450 make_number (ev->timestamp),
5451 make_lisp_symbol (scroll_bar_parts[ev->part]));
5454 /* Given a struct input_event, build the lisp event which represents
5455 it. If EVENT is 0, build a mouse movement event from the mouse
5456 movement buffer, which should have a movement event in it.
5458 Note that events must be passed to this function in the order they
5459 are received; this function stores the location of button presses
5460 in order to build drag events when the button is released. */
5462 static Lisp_Object
5463 make_lispy_event (struct input_event *event)
5465 int i;
5467 switch (event->kind)
5469 /* A simple keystroke. */
5470 case ASCII_KEYSTROKE_EVENT:
5471 case MULTIBYTE_CHAR_KEYSTROKE_EVENT:
5473 Lisp_Object lispy_c;
5474 EMACS_INT c = event->code;
5475 if (event->kind == ASCII_KEYSTROKE_EVENT)
5477 c &= 0377;
5478 eassert (c == event->code);
5479 /* Turn ASCII characters into control characters
5480 when proper. */
5481 if (event->modifiers & ctrl_modifier)
5483 c = make_ctrl_char (c);
5484 event->modifiers &= ~ctrl_modifier;
5488 /* Add in the other modifier bits. The shift key was taken care
5489 of by the X code. */
5490 c |= (event->modifiers
5491 & (meta_modifier | alt_modifier
5492 | hyper_modifier | super_modifier | ctrl_modifier));
5493 /* Distinguish Shift-SPC from SPC. */
5494 if ((event->code) == 040
5495 && event->modifiers & shift_modifier)
5496 c |= shift_modifier;
5497 button_down_time = 0;
5498 XSETFASTINT (lispy_c, c);
5499 return lispy_c;
5502 #ifdef HAVE_NS
5503 /* NS_NONKEY_EVENTs are just like NON_ASCII_KEYSTROKE_EVENTs,
5504 except that they are non-key events (last-nonmenu-event is nil). */
5505 case NS_NONKEY_EVENT:
5506 #endif
5508 /* A function key. The symbol may need to have modifier prefixes
5509 tacked onto it. */
5510 case NON_ASCII_KEYSTROKE_EVENT:
5511 button_down_time = 0;
5513 for (i = 0; i < ARRAYELTS (lispy_accent_codes); i++)
5514 if (event->code == lispy_accent_codes[i])
5515 return modify_event_symbol (i,
5516 event->modifiers,
5517 Qfunction_key, Qnil,
5518 lispy_accent_keys, &accent_key_syms,
5519 ARRAYELTS (lispy_accent_keys));
5521 #if 0
5522 #ifdef XK_kana_A
5523 if (event->code >= 0x400 && event->code < 0x500)
5524 return modify_event_symbol (event->code - 0x400,
5525 event->modifiers & ~shift_modifier,
5526 Qfunction_key, Qnil,
5527 lispy_kana_keys, &func_key_syms,
5528 ARRAYELTS (lispy_kana_keys));
5529 #endif /* XK_kana_A */
5530 #endif /* 0 */
5532 #ifdef ISO_FUNCTION_KEY_OFFSET
5533 if (event->code < FUNCTION_KEY_OFFSET
5534 && event->code >= ISO_FUNCTION_KEY_OFFSET)
5535 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
5536 event->modifiers,
5537 Qfunction_key, Qnil,
5538 iso_lispy_function_keys, &func_key_syms,
5539 ARRAYELTS (iso_lispy_function_keys));
5540 #endif
5542 if ((FUNCTION_KEY_OFFSET <= event->code
5543 && (event->code
5544 < FUNCTION_KEY_OFFSET + ARRAYELTS (lispy_function_keys)))
5545 && lispy_function_keys[event->code - FUNCTION_KEY_OFFSET])
5546 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
5547 event->modifiers,
5548 Qfunction_key, Qnil,
5549 lispy_function_keys, &func_key_syms,
5550 ARRAYELTS (lispy_function_keys));
5552 /* Handle system-specific or unknown keysyms.
5553 We need to use an alist rather than a vector as the cache
5554 since we can't make a vector long enough. */
5555 if (NILP (KVAR (current_kboard, system_key_syms)))
5556 kset_system_key_syms (current_kboard, Fcons (Qnil, Qnil));
5557 return modify_event_symbol (event->code,
5558 event->modifiers,
5559 Qfunction_key,
5560 KVAR (current_kboard, Vsystem_key_alist),
5561 0, &KVAR (current_kboard, system_key_syms),
5562 PTRDIFF_MAX);
5564 #ifdef HAVE_NTGUI
5565 case MULTIMEDIA_KEY_EVENT:
5566 if (event->code < ARRAYELTS (lispy_multimedia_keys)
5567 && event->code > 0 && lispy_multimedia_keys[event->code])
5569 return modify_event_symbol (event->code, event->modifiers,
5570 Qfunction_key, Qnil,
5571 lispy_multimedia_keys, &func_key_syms,
5572 ARRAYELTS (lispy_multimedia_keys));
5574 return Qnil;
5575 #endif
5577 /* A mouse click. Figure out where it is, decide whether it's
5578 a press, click or drag, and build the appropriate structure. */
5579 case MOUSE_CLICK_EVENT:
5580 #ifdef HAVE_GPM
5581 case GPM_CLICK_EVENT:
5582 #endif
5583 #ifndef USE_TOOLKIT_SCROLL_BARS
5584 case SCROLL_BAR_CLICK_EVENT:
5585 case HORIZONTAL_SCROLL_BAR_CLICK_EVENT:
5586 #endif
5588 int button = event->code;
5589 bool is_double;
5590 Lisp_Object position;
5591 Lisp_Object *start_pos_ptr;
5592 Lisp_Object start_pos;
5594 position = Qnil;
5596 /* Build the position as appropriate for this mouse click. */
5597 if (event->kind == MOUSE_CLICK_EVENT
5598 #ifdef HAVE_GPM
5599 || event->kind == GPM_CLICK_EVENT
5600 #endif
5603 struct frame *f = XFRAME (event->frame_or_window);
5604 int row, column;
5606 /* Ignore mouse events that were made on frame that
5607 have been deleted. */
5608 if (! FRAME_LIVE_P (f))
5609 return Qnil;
5611 /* EVENT->x and EVENT->y are frame-relative pixel
5612 coordinates at this place. Under old redisplay, COLUMN
5613 and ROW are set to frame relative glyph coordinates
5614 which are then used to determine whether this click is
5615 in a menu (non-toolkit version). */
5616 if (!toolkit_menubar_in_use (f))
5618 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
5619 &column, &row, NULL, 1);
5621 /* In the non-toolkit version, clicks on the menu bar
5622 are ordinary button events in the event buffer.
5623 Distinguish them, and invoke the menu.
5625 (In the toolkit version, the toolkit handles the
5626 menu bar and Emacs doesn't know about it until
5627 after the user makes a selection.) */
5628 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
5629 && (event->modifiers & down_modifier))
5631 Lisp_Object items, item;
5633 /* Find the menu bar item under `column'. */
5634 item = Qnil;
5635 items = FRAME_MENU_BAR_ITEMS (f);
5636 for (i = 0; i < ASIZE (items); i += 4)
5638 Lisp_Object pos, string;
5639 string = AREF (items, i + 1);
5640 pos = AREF (items, i + 3);
5641 if (NILP (string))
5642 break;
5643 if (column >= XINT (pos)
5644 && column < XINT (pos) + SCHARS (string))
5646 item = AREF (items, i);
5647 break;
5651 /* ELisp manual 2.4b says (x y) are window
5652 relative but code says they are
5653 frame-relative. */
5654 position = list4 (event->frame_or_window,
5655 Qmenu_bar,
5656 Fcons (event->x, event->y),
5657 make_number (event->timestamp));
5659 return list2 (item, position);
5663 position = make_lispy_position (f, event->x, event->y,
5664 event->timestamp);
5666 #ifndef USE_TOOLKIT_SCROLL_BARS
5667 else
5668 /* It's a scrollbar click. */
5669 position = make_scroll_bar_position (event, Qvertical_scroll_bar);
5670 #endif /* not USE_TOOLKIT_SCROLL_BARS */
5672 if (button >= ASIZE (button_down_location))
5674 ptrdiff_t incr = button - ASIZE (button_down_location) + 1;
5675 button_down_location = larger_vector (button_down_location,
5676 incr, -1);
5677 mouse_syms = larger_vector (mouse_syms, incr, -1);
5680 start_pos_ptr = aref_addr (button_down_location, button);
5681 start_pos = *start_pos_ptr;
5682 *start_pos_ptr = Qnil;
5685 /* On window-system frames, use the value of
5686 double-click-fuzz as is. On other frames, interpret it
5687 as a multiple of 1/8 characters. */
5688 struct frame *f;
5689 int fuzz;
5691 if (WINDOWP (event->frame_or_window))
5692 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
5693 else if (FRAMEP (event->frame_or_window))
5694 f = XFRAME (event->frame_or_window);
5695 else
5696 emacs_abort ();
5698 if (FRAME_WINDOW_P (f))
5699 fuzz = double_click_fuzz;
5700 else
5701 fuzz = double_click_fuzz / 8;
5703 is_double = (button == last_mouse_button
5704 && (eabs (XINT (event->x) - last_mouse_x) <= fuzz)
5705 && (eabs (XINT (event->y) - last_mouse_y) <= fuzz)
5706 && button_down_time != 0
5707 && (EQ (Vdouble_click_time, Qt)
5708 || (NATNUMP (Vdouble_click_time)
5709 && (event->timestamp - button_down_time
5710 < XFASTINT (Vdouble_click_time)))));
5713 last_mouse_button = button;
5714 last_mouse_x = XINT (event->x);
5715 last_mouse_y = XINT (event->y);
5717 /* If this is a button press, squirrel away the location, so
5718 we can decide later whether it was a click or a drag. */
5719 if (event->modifiers & down_modifier)
5721 if (is_double)
5723 double_click_count++;
5724 event->modifiers |= ((double_click_count > 2)
5725 ? triple_modifier
5726 : double_modifier);
5728 else
5729 double_click_count = 1;
5730 button_down_time = event->timestamp;
5731 *start_pos_ptr = Fcopy_alist (position);
5732 ignore_mouse_drag_p = 0;
5735 /* Now we're releasing a button - check the co-ordinates to
5736 see if this was a click or a drag. */
5737 else if (event->modifiers & up_modifier)
5739 /* If we did not see a down before this up, ignore the up.
5740 Probably this happened because the down event chose a
5741 menu item. It would be an annoyance to treat the
5742 release of the button that chose the menu item as a
5743 separate event. */
5745 if (!CONSP (start_pos))
5746 return Qnil;
5748 event->modifiers &= ~up_modifier;
5751 Lisp_Object new_down, down;
5752 EMACS_INT xdiff = double_click_fuzz, ydiff = double_click_fuzz;
5754 /* The third element of every position
5755 should be the (x,y) pair. */
5756 down = Fcar (Fcdr (Fcdr (start_pos)));
5757 new_down = Fcar (Fcdr (Fcdr (position)));
5759 if (CONSP (down)
5760 && INTEGERP (XCAR (down)) && INTEGERP (XCDR (down)))
5762 xdiff = XINT (XCAR (new_down)) - XINT (XCAR (down));
5763 ydiff = XINT (XCDR (new_down)) - XINT (XCDR (down));
5766 if (ignore_mouse_drag_p)
5768 event->modifiers |= click_modifier;
5769 ignore_mouse_drag_p = 0;
5771 else if (xdiff < double_click_fuzz && xdiff > - double_click_fuzz
5772 && ydiff < double_click_fuzz && ydiff > - double_click_fuzz
5773 /* Maybe the mouse has moved a lot, caused scrolling, and
5774 eventually ended up at the same screen position (but
5775 not buffer position) in which case it is a drag, not
5776 a click. */
5777 /* FIXME: OTOH if the buffer position has changed
5778 because of a timer or process filter rather than
5779 because of mouse movement, it should be considered as
5780 a click. But mouse-drag-region completely ignores
5781 this case and it hasn't caused any real problem, so
5782 it's probably OK to ignore it as well. */
5783 && EQ (Fcar (Fcdr (start_pos)), Fcar (Fcdr (position))))
5784 /* Mouse hasn't moved (much). */
5785 event->modifiers |= click_modifier;
5786 else
5788 button_down_time = 0;
5789 event->modifiers |= drag_modifier;
5792 /* Don't check is_double; treat this as multiple
5793 if the down-event was multiple. */
5794 if (double_click_count > 1)
5795 event->modifiers |= ((double_click_count > 2)
5796 ? triple_modifier
5797 : double_modifier);
5800 else
5801 /* Every mouse event should either have the down_modifier or
5802 the up_modifier set. */
5803 emacs_abort ();
5806 /* Get the symbol we should use for the mouse click. */
5807 Lisp_Object head;
5809 head = modify_event_symbol (button,
5810 event->modifiers,
5811 Qmouse_click, Vlispy_mouse_stem,
5812 NULL,
5813 &mouse_syms,
5814 ASIZE (mouse_syms));
5815 if (event->modifiers & drag_modifier)
5816 return list3 (head, start_pos, position);
5817 else if (event->modifiers & (double_modifier | triple_modifier))
5818 return list3 (head, position, make_number (double_click_count));
5819 else
5820 return list2 (head, position);
5824 case WHEEL_EVENT:
5825 case HORIZ_WHEEL_EVENT:
5827 Lisp_Object position;
5828 Lisp_Object head;
5830 /* Build the position as appropriate for this mouse click. */
5831 struct frame *f = XFRAME (event->frame_or_window);
5833 /* Ignore wheel events that were made on frame that have been
5834 deleted. */
5835 if (! FRAME_LIVE_P (f))
5836 return Qnil;
5838 position = make_lispy_position (f, event->x, event->y,
5839 event->timestamp);
5841 /* Set double or triple modifiers to indicate the wheel speed. */
5843 /* On window-system frames, use the value of
5844 double-click-fuzz as is. On other frames, interpret it
5845 as a multiple of 1/8 characters. */
5846 struct frame *fr;
5847 int fuzz;
5848 int symbol_num;
5849 bool is_double;
5851 if (WINDOWP (event->frame_or_window))
5852 fr = XFRAME (XWINDOW (event->frame_or_window)->frame);
5853 else if (FRAMEP (event->frame_or_window))
5854 fr = XFRAME (event->frame_or_window);
5855 else
5856 emacs_abort ();
5858 fuzz = FRAME_WINDOW_P (fr)
5859 ? double_click_fuzz : double_click_fuzz / 8;
5861 if (event->modifiers & up_modifier)
5863 /* Emit a wheel-up event. */
5864 event->modifiers &= ~up_modifier;
5865 symbol_num = 0;
5867 else if (event->modifiers & down_modifier)
5869 /* Emit a wheel-down event. */
5870 event->modifiers &= ~down_modifier;
5871 symbol_num = 1;
5873 else
5874 /* Every wheel event should either have the down_modifier or
5875 the up_modifier set. */
5876 emacs_abort ();
5878 if (event->kind == HORIZ_WHEEL_EVENT)
5879 symbol_num += 2;
5881 is_double = (last_mouse_button == - (1 + symbol_num)
5882 && (eabs (XINT (event->x) - last_mouse_x) <= fuzz)
5883 && (eabs (XINT (event->y) - last_mouse_y) <= fuzz)
5884 && button_down_time != 0
5885 && (EQ (Vdouble_click_time, Qt)
5886 || (NATNUMP (Vdouble_click_time)
5887 && (event->timestamp - button_down_time
5888 < XFASTINT (Vdouble_click_time)))));
5889 if (is_double)
5891 double_click_count++;
5892 event->modifiers |= ((double_click_count > 2)
5893 ? triple_modifier
5894 : double_modifier);
5896 else
5898 double_click_count = 1;
5899 event->modifiers |= click_modifier;
5902 button_down_time = event->timestamp;
5903 /* Use a negative value to distinguish wheel from mouse button. */
5904 last_mouse_button = - (1 + symbol_num);
5905 last_mouse_x = XINT (event->x);
5906 last_mouse_y = XINT (event->y);
5908 /* Get the symbol we should use for the wheel event. */
5909 head = modify_event_symbol (symbol_num,
5910 event->modifiers,
5911 Qmouse_click,
5912 Qnil,
5913 lispy_wheel_names,
5914 &wheel_syms,
5915 ASIZE (wheel_syms));
5918 if (event->modifiers & (double_modifier | triple_modifier))
5919 return list3 (head, position, make_number (double_click_count));
5920 else
5921 return list2 (head, position);
5925 #ifdef USE_TOOLKIT_SCROLL_BARS
5927 /* We don't have down and up events if using toolkit scroll bars,
5928 so make this always a click event. Store in the `part' of
5929 the Lisp event a symbol which maps to the following actions:
5931 `above_handle' page up
5932 `below_handle' page down
5933 `up' line up
5934 `down' line down
5935 `top' top of buffer
5936 `bottom' bottom of buffer
5937 `handle' thumb has been dragged.
5938 `end-scroll' end of interaction with scroll bar
5940 The incoming input_event contains in its `part' member an
5941 index of type `enum scroll_bar_part' which we can use as an
5942 index in scroll_bar_parts to get the appropriate symbol. */
5944 case SCROLL_BAR_CLICK_EVENT:
5946 Lisp_Object position, head;
5948 position = make_scroll_bar_position (event, Qvertical_scroll_bar);
5950 /* Always treat scroll bar events as clicks. */
5951 event->modifiers |= click_modifier;
5952 event->modifiers &= ~up_modifier;
5954 if (event->code >= ASIZE (mouse_syms))
5955 mouse_syms = larger_vector (mouse_syms,
5956 event->code - ASIZE (mouse_syms) + 1,
5957 -1);
5959 /* Get the symbol we should use for the mouse click. */
5960 head = modify_event_symbol (event->code,
5961 event->modifiers,
5962 Qmouse_click,
5963 Vlispy_mouse_stem,
5964 NULL, &mouse_syms,
5965 ASIZE (mouse_syms));
5966 return list2 (head, position);
5969 case HORIZONTAL_SCROLL_BAR_CLICK_EVENT:
5971 Lisp_Object position, head;
5973 position = make_scroll_bar_position (event, Qhorizontal_scroll_bar);
5975 /* Always treat scroll bar events as clicks. */
5976 event->modifiers |= click_modifier;
5977 event->modifiers &= ~up_modifier;
5979 if (event->code >= ASIZE (mouse_syms))
5980 mouse_syms = larger_vector (mouse_syms,
5981 event->code - ASIZE (mouse_syms) + 1,
5982 -1);
5984 /* Get the symbol we should use for the mouse click. */
5985 head = modify_event_symbol (event->code,
5986 event->modifiers,
5987 Qmouse_click,
5988 Vlispy_mouse_stem,
5989 NULL, &mouse_syms,
5990 ASIZE (mouse_syms));
5991 return list2 (head, position);
5994 #endif /* USE_TOOLKIT_SCROLL_BARS */
5996 case DRAG_N_DROP_EVENT:
5998 struct frame *f;
5999 Lisp_Object head, position;
6000 Lisp_Object files;
6002 f = XFRAME (event->frame_or_window);
6003 files = event->arg;
6005 /* Ignore mouse events that were made on frames that
6006 have been deleted. */
6007 if (! FRAME_LIVE_P (f))
6008 return Qnil;
6010 position = make_lispy_position (f, event->x, event->y,
6011 event->timestamp);
6013 head = modify_event_symbol (0, event->modifiers,
6014 Qdrag_n_drop, Qnil,
6015 lispy_drag_n_drop_names,
6016 &drag_n_drop_syms, 1);
6017 return list3 (head, position, files);
6020 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
6021 || defined (HAVE_NS) || defined (USE_GTK)
6022 case MENU_BAR_EVENT:
6023 if (EQ (event->arg, event->frame_or_window))
6024 /* This is the prefix key. We translate this to
6025 `(menu_bar)' because the code in keyboard.c for menu
6026 events, which we use, relies on this. */
6027 return list1 (Qmenu_bar);
6028 return event->arg;
6029 #endif
6031 case SELECT_WINDOW_EVENT:
6032 /* Make an event (select-window (WINDOW)). */
6033 return list2 (Qselect_window, list1 (event->frame_or_window));
6035 case TOOL_BAR_EVENT:
6036 if (EQ (event->arg, event->frame_or_window))
6037 /* This is the prefix key. We translate this to
6038 `(tool_bar)' because the code in keyboard.c for tool bar
6039 events, which we use, relies on this. */
6040 return list1 (Qtool_bar);
6041 else if (SYMBOLP (event->arg))
6042 return apply_modifiers (event->modifiers, event->arg);
6043 return event->arg;
6045 case USER_SIGNAL_EVENT:
6046 /* A user signal. */
6048 char *name = find_user_signal_name (event->code);
6049 if (!name)
6050 emacs_abort ();
6051 return intern (name);
6054 case SAVE_SESSION_EVENT:
6055 return Qsave_session;
6057 #ifdef HAVE_DBUS
6058 case DBUS_EVENT:
6060 return Fcons (Qdbus_event, event->arg);
6062 #endif /* HAVE_DBUS */
6064 #if defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY
6065 case FILE_NOTIFY_EVENT:
6067 return Fcons (Qfile_notify, event->arg);
6069 #endif /* defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY */
6071 case CONFIG_CHANGED_EVENT:
6072 return list3 (Qconfig_changed_event,
6073 event->arg, event->frame_or_window);
6075 /* The 'kind' field of the event is something we don't recognize. */
6076 default:
6077 emacs_abort ();
6081 static Lisp_Object
6082 make_lispy_movement (struct frame *frame, Lisp_Object bar_window, enum scroll_bar_part part,
6083 Lisp_Object x, Lisp_Object y, Time t)
6085 /* Is it a scroll bar movement? */
6086 if (frame && ! NILP (bar_window))
6088 Lisp_Object part_sym;
6090 part_sym = make_lisp_symbol (scroll_bar_parts[part]);
6091 return list2 (Qscroll_bar_movement,
6092 list5 (bar_window,
6093 Qvertical_scroll_bar,
6094 Fcons (x, y),
6095 make_number (t),
6096 part_sym));
6098 /* Or is it an ordinary mouse movement? */
6099 else
6101 Lisp_Object position;
6102 position = make_lispy_position (frame, x, y, t);
6103 return list2 (Qmouse_movement, position);
6107 /* Construct a switch frame event. */
6108 static Lisp_Object
6109 make_lispy_switch_frame (Lisp_Object frame)
6111 return list2 (Qswitch_frame, frame);
6114 static Lisp_Object
6115 make_lispy_focus_in (Lisp_Object frame)
6117 return list2 (Qfocus_in, frame);
6120 #ifdef HAVE_WINDOW_SYSTEM
6122 static Lisp_Object
6123 make_lispy_focus_out (Lisp_Object frame)
6125 return list2 (Qfocus_out, frame);
6128 #endif /* HAVE_WINDOW_SYSTEM */
6130 /* Manipulating modifiers. */
6132 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
6134 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
6135 SYMBOL's name of the end of the modifiers; the string from this
6136 position is the unmodified symbol name.
6138 This doesn't use any caches. */
6140 static int
6141 parse_modifiers_uncached (Lisp_Object symbol, ptrdiff_t *modifier_end)
6143 Lisp_Object name;
6144 ptrdiff_t i;
6145 int modifiers;
6147 CHECK_SYMBOL (symbol);
6149 modifiers = 0;
6150 name = SYMBOL_NAME (symbol);
6152 for (i = 0; i < SBYTES (name) - 1; )
6154 ptrdiff_t this_mod_end = 0;
6155 int this_mod = 0;
6157 /* See if the name continues with a modifier word.
6158 Check that the word appears, but don't check what follows it.
6159 Set this_mod and this_mod_end to record what we find. */
6161 switch (SREF (name, i))
6163 #define SINGLE_LETTER_MOD(BIT) \
6164 (this_mod_end = i + 1, this_mod = BIT)
6166 case 'A':
6167 SINGLE_LETTER_MOD (alt_modifier);
6168 break;
6170 case 'C':
6171 SINGLE_LETTER_MOD (ctrl_modifier);
6172 break;
6174 case 'H':
6175 SINGLE_LETTER_MOD (hyper_modifier);
6176 break;
6178 case 'M':
6179 SINGLE_LETTER_MOD (meta_modifier);
6180 break;
6182 case 'S':
6183 SINGLE_LETTER_MOD (shift_modifier);
6184 break;
6186 case 's':
6187 SINGLE_LETTER_MOD (super_modifier);
6188 break;
6190 #undef SINGLE_LETTER_MOD
6192 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6193 if (i + LEN + 1 <= SBYTES (name) \
6194 && ! memcmp (SDATA (name) + i, NAME, LEN)) \
6196 this_mod_end = i + LEN; \
6197 this_mod = BIT; \
6200 case 'd':
6201 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6202 MULTI_LETTER_MOD (down_modifier, "down", 4);
6203 MULTI_LETTER_MOD (double_modifier, "double", 6);
6204 break;
6206 case 't':
6207 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6208 break;
6209 #undef MULTI_LETTER_MOD
6213 /* If we found no modifier, stop looking for them. */
6214 if (this_mod_end == 0)
6215 break;
6217 /* Check there is a dash after the modifier, so that it
6218 really is a modifier. */
6219 if (this_mod_end >= SBYTES (name)
6220 || SREF (name, this_mod_end) != '-')
6221 break;
6223 /* This modifier is real; look for another. */
6224 modifiers |= this_mod;
6225 i = this_mod_end + 1;
6228 /* Should we include the `click' modifier? */
6229 if (! (modifiers & (down_modifier | drag_modifier
6230 | double_modifier | triple_modifier))
6231 && i + 7 == SBYTES (name)
6232 && memcmp (SDATA (name) + i, "mouse-", 6) == 0
6233 && ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9'))
6234 modifiers |= click_modifier;
6236 if (! (modifiers & (double_modifier | triple_modifier))
6237 && i + 6 < SBYTES (name)
6238 && memcmp (SDATA (name) + i, "wheel-", 6) == 0)
6239 modifiers |= click_modifier;
6241 if (modifier_end)
6242 *modifier_end = i;
6244 return modifiers;
6247 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
6248 prepended to the string BASE[0..BASE_LEN-1].
6249 This doesn't use any caches. */
6250 static Lisp_Object
6251 apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_byte)
6253 /* Since BASE could contain nulls, we can't use intern here; we have
6254 to use Fintern, which expects a genuine Lisp_String, and keeps a
6255 reference to it. */
6256 char new_mods[sizeof "A-C-H-M-S-s-down-drag-double-triple-"];
6257 int mod_len;
6260 char *p = new_mods;
6262 /* Only the event queue may use the `up' modifier; it should always
6263 be turned into a click or drag event before presented to lisp code. */
6264 if (modifiers & up_modifier)
6265 emacs_abort ();
6267 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
6268 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
6269 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
6270 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
6271 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
6272 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
6273 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
6274 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
6275 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
6276 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
6277 /* The click modifier is denoted by the absence of other modifiers. */
6279 *p = '\0';
6281 mod_len = p - new_mods;
6285 Lisp_Object new_name;
6287 new_name = make_uninit_multibyte_string (mod_len + base_len,
6288 mod_len + base_len_byte);
6289 memcpy (SDATA (new_name), new_mods, mod_len);
6290 memcpy (SDATA (new_name) + mod_len, base, base_len_byte);
6292 return Fintern (new_name, Qnil);
6297 static const char *const modifier_names[] =
6299 "up", "down", "drag", "click", "double", "triple", 0, 0,
6300 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
6301 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
6303 #define NUM_MOD_NAMES ARRAYELTS (modifier_names)
6305 static Lisp_Object modifier_symbols;
6307 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
6308 static Lisp_Object
6309 lispy_modifier_list (int modifiers)
6311 Lisp_Object modifier_list;
6312 int i;
6314 modifier_list = Qnil;
6315 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
6316 if (modifiers & (1<<i))
6317 modifier_list = Fcons (AREF (modifier_symbols, i),
6318 modifier_list);
6320 return modifier_list;
6324 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
6325 where UNMODIFIED is the unmodified form of SYMBOL,
6326 MASK is the set of modifiers present in SYMBOL's name.
6327 This is similar to parse_modifiers_uncached, but uses the cache in
6328 SYMBOL's Qevent_symbol_element_mask property, and maintains the
6329 Qevent_symbol_elements property. */
6331 #define KEY_TO_CHAR(k) (XINT (k) & ((1 << CHARACTERBITS) - 1))
6333 Lisp_Object
6334 parse_modifiers (Lisp_Object symbol)
6336 Lisp_Object elements;
6338 if (INTEGERP (symbol))
6339 return list2i (KEY_TO_CHAR (symbol), XINT (symbol) & CHAR_MODIFIER_MASK);
6340 else if (!SYMBOLP (symbol))
6341 return Qnil;
6343 elements = Fget (symbol, Qevent_symbol_element_mask);
6344 if (CONSP (elements))
6345 return elements;
6346 else
6348 ptrdiff_t end;
6349 int modifiers = parse_modifiers_uncached (symbol, &end);
6350 Lisp_Object unmodified;
6351 Lisp_Object mask;
6353 unmodified = Fintern (make_string (SSDATA (SYMBOL_NAME (symbol)) + end,
6354 SBYTES (SYMBOL_NAME (symbol)) - end),
6355 Qnil);
6357 if (modifiers & ~INTMASK)
6358 emacs_abort ();
6359 XSETFASTINT (mask, modifiers);
6360 elements = list2 (unmodified, mask);
6362 /* Cache the parsing results on SYMBOL. */
6363 Fput (symbol, Qevent_symbol_element_mask,
6364 elements);
6365 Fput (symbol, Qevent_symbol_elements,
6366 Fcons (unmodified, lispy_modifier_list (modifiers)));
6368 /* Since we know that SYMBOL is modifiers applied to unmodified,
6369 it would be nice to put that in unmodified's cache.
6370 But we can't, since we're not sure that parse_modifiers is
6371 canonical. */
6373 return elements;
6377 DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,
6378 Sevent_symbol_parse_modifiers, 1, 1, 0,
6379 doc: /* Parse the event symbol. For internal use. */)
6380 (Lisp_Object symbol)
6382 /* Fill the cache if needed. */
6383 parse_modifiers (symbol);
6384 /* Ignore the result (which is stored on Qevent_symbol_element_mask)
6385 and use the Lispier representation stored on Qevent_symbol_elements
6386 instead. */
6387 return Fget (symbol, Qevent_symbol_elements);
6390 /* Apply the modifiers MODIFIERS to the symbol BASE.
6391 BASE must be unmodified.
6393 This is like apply_modifiers_uncached, but uses BASE's
6394 Qmodifier_cache property, if present. It also builds
6395 Qevent_symbol_elements properties, since it has that info anyway.
6397 apply_modifiers copies the value of BASE's Qevent_kind property to
6398 the modified symbol. */
6399 static Lisp_Object
6400 apply_modifiers (int modifiers, Lisp_Object base)
6402 Lisp_Object cache, idx, entry, new_symbol;
6404 /* Mask out upper bits. We don't know where this value's been. */
6405 modifiers &= INTMASK;
6407 if (INTEGERP (base))
6408 return make_number (XINT (base) | modifiers);
6410 /* The click modifier never figures into cache indices. */
6411 cache = Fget (base, Qmodifier_cache);
6412 XSETFASTINT (idx, (modifiers & ~click_modifier));
6413 entry = assq_no_quit (idx, cache);
6415 if (CONSP (entry))
6416 new_symbol = XCDR (entry);
6417 else
6419 /* We have to create the symbol ourselves. */
6420 new_symbol = apply_modifiers_uncached (modifiers,
6421 SSDATA (SYMBOL_NAME (base)),
6422 SCHARS (SYMBOL_NAME (base)),
6423 SBYTES (SYMBOL_NAME (base)));
6425 /* Add the new symbol to the base's cache. */
6426 entry = Fcons (idx, new_symbol);
6427 Fput (base, Qmodifier_cache, Fcons (entry, cache));
6429 /* We have the parsing info now for free, so we could add it to
6430 the caches:
6431 XSETFASTINT (idx, modifiers);
6432 Fput (new_symbol, Qevent_symbol_element_mask,
6433 list2 (base, idx));
6434 Fput (new_symbol, Qevent_symbol_elements,
6435 Fcons (base, lispy_modifier_list (modifiers)));
6436 Sadly, this is only correct if `base' is indeed a base event,
6437 which is not necessarily the case. -stef */
6440 /* Make sure this symbol is of the same kind as BASE.
6442 You'd think we could just set this once and for all when we
6443 intern the symbol above, but reorder_modifiers may call us when
6444 BASE's property isn't set right; we can't assume that just
6445 because it has a Qmodifier_cache property it must have its
6446 Qevent_kind set right as well. */
6447 if (NILP (Fget (new_symbol, Qevent_kind)))
6449 Lisp_Object kind;
6451 kind = Fget (base, Qevent_kind);
6452 if (! NILP (kind))
6453 Fput (new_symbol, Qevent_kind, kind);
6456 return new_symbol;
6460 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
6461 return a symbol with the modifiers placed in the canonical order.
6462 Canonical order is alphabetical, except for down and drag, which
6463 always come last. The 'click' modifier is never written out.
6465 Fdefine_key calls this to make sure that (for example) C-M-foo
6466 and M-C-foo end up being equivalent in the keymap. */
6468 Lisp_Object
6469 reorder_modifiers (Lisp_Object symbol)
6471 /* It's hopefully okay to write the code this way, since everything
6472 will soon be in caches, and no consing will be done at all. */
6473 Lisp_Object parsed;
6475 parsed = parse_modifiers (symbol);
6476 return apply_modifiers (XFASTINT (XCAR (XCDR (parsed))),
6477 XCAR (parsed));
6481 /* For handling events, we often want to produce a symbol whose name
6482 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
6483 to some base, like the name of a function key or mouse button.
6484 modify_event_symbol produces symbols of this sort.
6486 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
6487 is the name of the i'th symbol. TABLE_SIZE is the number of elements
6488 in the table.
6490 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
6491 into symbol names, or a string specifying a name stem used to
6492 construct a symbol name or the form `STEM-N', where N is the decimal
6493 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
6494 non-nil; otherwise NAME_TABLE is used.
6496 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
6497 persist between calls to modify_event_symbol that it can use to
6498 store a cache of the symbols it's generated for this NAME_TABLE
6499 before. The object stored there may be a vector or an alist.
6501 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
6503 MODIFIERS is a set of modifier bits (as given in struct input_events)
6504 whose prefixes should be applied to the symbol name.
6506 SYMBOL_KIND is the value to be placed in the event_kind property of
6507 the returned symbol.
6509 The symbols we create are supposed to have an
6510 `event-symbol-elements' property, which lists the modifiers present
6511 in the symbol's name. */
6513 static Lisp_Object
6514 modify_event_symbol (ptrdiff_t symbol_num, int modifiers, Lisp_Object symbol_kind,
6515 Lisp_Object name_alist_or_stem, const char *const *name_table,
6516 Lisp_Object *symbol_table, ptrdiff_t table_size)
6518 Lisp_Object value;
6519 Lisp_Object symbol_int;
6521 /* Get rid of the "vendor-specific" bit here. */
6522 XSETINT (symbol_int, symbol_num & 0xffffff);
6524 /* Is this a request for a valid symbol? */
6525 if (symbol_num < 0 || symbol_num >= table_size)
6526 return Qnil;
6528 if (CONSP (*symbol_table))
6529 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
6531 /* If *symbol_table doesn't seem to be initialized properly, fix that.
6532 *symbol_table should be a lisp vector TABLE_SIZE elements long,
6533 where the Nth element is the symbol for NAME_TABLE[N], or nil if
6534 we've never used that symbol before. */
6535 else
6537 if (! VECTORP (*symbol_table)
6538 || ASIZE (*symbol_table) != table_size)
6540 Lisp_Object size;
6542 XSETFASTINT (size, table_size);
6543 *symbol_table = Fmake_vector (size, Qnil);
6546 value = AREF (*symbol_table, symbol_num);
6549 /* Have we already used this symbol before? */
6550 if (NILP (value))
6552 /* No; let's create it. */
6553 if (CONSP (name_alist_or_stem))
6554 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
6555 else if (STRINGP (name_alist_or_stem))
6557 char *buf;
6558 ptrdiff_t len = (SBYTES (name_alist_or_stem)
6559 + sizeof "-" + INT_STRLEN_BOUND (EMACS_INT));
6560 USE_SAFE_ALLOCA;
6561 buf = SAFE_ALLOCA (len);
6562 esprintf (buf, "%s-%"pI"d", SDATA (name_alist_or_stem),
6563 XINT (symbol_int) + 1);
6564 value = intern (buf);
6565 SAFE_FREE ();
6567 else if (name_table != 0 && name_table[symbol_num])
6568 value = intern (name_table[symbol_num]);
6570 #ifdef HAVE_WINDOW_SYSTEM
6571 if (NILP (value))
6573 char *name = x_get_keysym_name (symbol_num);
6574 if (name)
6575 value = intern (name);
6577 #endif
6579 if (NILP (value))
6581 char buf[sizeof "key-" + INT_STRLEN_BOUND (EMACS_INT)];
6582 sprintf (buf, "key-%"pD"d", symbol_num);
6583 value = intern (buf);
6586 if (CONSP (*symbol_table))
6587 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
6588 else
6589 ASET (*symbol_table, symbol_num, value);
6591 /* Fill in the cache entries for this symbol; this also
6592 builds the Qevent_symbol_elements property, which the user
6593 cares about. */
6594 apply_modifiers (modifiers & click_modifier, value);
6595 Fput (value, Qevent_kind, symbol_kind);
6598 /* Apply modifiers to that symbol. */
6599 return apply_modifiers (modifiers, value);
6602 /* Convert a list that represents an event type,
6603 such as (ctrl meta backspace), into the usual representation of that
6604 event type as a number or a symbol. */
6606 DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
6607 doc: /* Convert the event description list EVENT-DESC to an event type.
6608 EVENT-DESC should contain one base event type (a character or symbol)
6609 and zero or more modifier names (control, meta, hyper, super, shift, alt,
6610 drag, down, double or triple). The base must be last.
6611 The return value is an event type (a character or symbol) which
6612 has the same base event type and all the specified modifiers. */)
6613 (Lisp_Object event_desc)
6615 Lisp_Object base;
6616 int modifiers = 0;
6617 Lisp_Object rest;
6619 base = Qnil;
6620 rest = event_desc;
6621 while (CONSP (rest))
6623 Lisp_Object elt;
6624 int this = 0;
6626 elt = XCAR (rest);
6627 rest = XCDR (rest);
6629 /* Given a symbol, see if it is a modifier name. */
6630 if (SYMBOLP (elt) && CONSP (rest))
6631 this = parse_solitary_modifier (elt);
6633 if (this != 0)
6634 modifiers |= this;
6635 else if (!NILP (base))
6636 error ("Two bases given in one event");
6637 else
6638 base = elt;
6642 /* Let the symbol A refer to the character A. */
6643 if (SYMBOLP (base) && SCHARS (SYMBOL_NAME (base)) == 1)
6644 XSETINT (base, SREF (SYMBOL_NAME (base), 0));
6646 if (INTEGERP (base))
6648 /* Turn (shift a) into A. */
6649 if ((modifiers & shift_modifier) != 0
6650 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
6652 XSETINT (base, XINT (base) - ('a' - 'A'));
6653 modifiers &= ~shift_modifier;
6656 /* Turn (control a) into C-a. */
6657 if (modifiers & ctrl_modifier)
6658 return make_number ((modifiers & ~ctrl_modifier)
6659 | make_ctrl_char (XINT (base)));
6660 else
6661 return make_number (modifiers | XINT (base));
6663 else if (SYMBOLP (base))
6664 return apply_modifiers (modifiers, base);
6665 else
6666 error ("Invalid base event");
6669 /* Try to recognize SYMBOL as a modifier name.
6670 Return the modifier flag bit, or 0 if not recognized. */
6673 parse_solitary_modifier (Lisp_Object symbol)
6675 Lisp_Object name = SYMBOL_NAME (symbol);
6677 switch (SREF (name, 0))
6679 #define SINGLE_LETTER_MOD(BIT) \
6680 if (SBYTES (name) == 1) \
6681 return BIT;
6683 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6684 if (LEN == SBYTES (name) \
6685 && ! memcmp (SDATA (name), NAME, LEN)) \
6686 return BIT;
6688 case 'A':
6689 SINGLE_LETTER_MOD (alt_modifier);
6690 break;
6692 case 'a':
6693 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
6694 break;
6696 case 'C':
6697 SINGLE_LETTER_MOD (ctrl_modifier);
6698 break;
6700 case 'c':
6701 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
6702 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
6703 break;
6705 case 'H':
6706 SINGLE_LETTER_MOD (hyper_modifier);
6707 break;
6709 case 'h':
6710 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
6711 break;
6713 case 'M':
6714 SINGLE_LETTER_MOD (meta_modifier);
6715 break;
6717 case 'm':
6718 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
6719 break;
6721 case 'S':
6722 SINGLE_LETTER_MOD (shift_modifier);
6723 break;
6725 case 's':
6726 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
6727 MULTI_LETTER_MOD (super_modifier, "super", 5);
6728 SINGLE_LETTER_MOD (super_modifier);
6729 break;
6731 case 'd':
6732 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6733 MULTI_LETTER_MOD (down_modifier, "down", 4);
6734 MULTI_LETTER_MOD (double_modifier, "double", 6);
6735 break;
6737 case 't':
6738 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6739 break;
6741 #undef SINGLE_LETTER_MOD
6742 #undef MULTI_LETTER_MOD
6745 return 0;
6748 /* Return true if EVENT is a list whose elements are all integers or symbols.
6749 Such a list is not valid as an event,
6750 but it can be a Lucid-style event type list. */
6752 bool
6753 lucid_event_type_list_p (Lisp_Object object)
6755 Lisp_Object tail;
6757 if (! CONSP (object))
6758 return 0;
6760 if (EQ (XCAR (object), Qhelp_echo)
6761 || EQ (XCAR (object), Qvertical_line)
6762 || EQ (XCAR (object), Qmode_line)
6763 || EQ (XCAR (object), Qheader_line))
6764 return 0;
6766 for (tail = object; CONSP (tail); tail = XCDR (tail))
6768 Lisp_Object elt;
6769 elt = XCAR (tail);
6770 if (! (INTEGERP (elt) || SYMBOLP (elt)))
6771 return 0;
6774 return NILP (tail);
6777 /* Return true if terminal input chars are available.
6778 Also, store the return value into INPUT_PENDING.
6780 Serves the purpose of ioctl (0, FIONREAD, ...)
6781 but works even if FIONREAD does not exist.
6782 (In fact, this may actually read some input.)
6784 If READABLE_EVENTS_DO_TIMERS_NOW is set in FLAGS, actually run
6785 timer events that are ripe.
6786 If READABLE_EVENTS_FILTER_EVENTS is set in FLAGS, ignore internal
6787 events (FOCUS_IN_EVENT).
6788 If READABLE_EVENTS_IGNORE_SQUEEZABLES is set in FLAGS, ignore mouse
6789 movements and toolkit scroll bar thumb drags. */
6791 static bool
6792 get_input_pending (int flags)
6794 /* First of all, have we already counted some input? */
6795 input_pending = (!NILP (Vquit_flag) || readable_events (flags));
6797 /* If input is being read as it arrives, and we have none, there is none. */
6798 if (!input_pending && (!interrupt_input || interrupts_deferred))
6800 /* Try to read some input and see how much we get. */
6801 gobble_input ();
6802 input_pending = (!NILP (Vquit_flag) || readable_events (flags));
6805 return input_pending;
6808 /* Put a BUFFER_SWITCH_EVENT in the buffer
6809 so that read_key_sequence will notice the new current buffer. */
6811 void
6812 record_asynch_buffer_change (void)
6814 /* We don't need a buffer-switch event unless Emacs is waiting for input.
6815 The purpose of the event is to make read_key_sequence look up the
6816 keymaps again. If we aren't in read_key_sequence, we don't need one,
6817 and the event could cause trouble by messing up (input-pending-p).
6818 Note: Fwaiting_for_user_input_p always returns nil when async
6819 subprocesses aren't supported. */
6820 if (!NILP (Fwaiting_for_user_input_p ()))
6822 struct input_event event;
6824 EVENT_INIT (event);
6825 event.kind = BUFFER_SWITCH_EVENT;
6826 event.frame_or_window = Qnil;
6827 event.arg = Qnil;
6829 /* Make sure no interrupt happens while storing the event. */
6830 #ifdef USABLE_SIGIO
6831 if (interrupt_input)
6832 kbd_buffer_store_event (&event);
6833 else
6834 #endif
6836 stop_polling ();
6837 kbd_buffer_store_event (&event);
6838 start_polling ();
6843 /* Read any terminal input already buffered up by the system
6844 into the kbd_buffer, but do not wait.
6846 Return the number of keyboard chars read, or -1 meaning
6847 this is a bad time to try to read input. */
6850 gobble_input (void)
6852 int nread = 0;
6853 bool err = 0;
6854 struct terminal *t;
6856 /* Store pending user signal events, if any. */
6857 store_user_signal_events ();
6859 /* Loop through the available terminals, and call their input hooks. */
6860 t = terminal_list;
6861 while (t)
6863 struct terminal *next = t->next_terminal;
6865 if (t->read_socket_hook)
6867 int nr;
6868 struct input_event hold_quit;
6870 if (input_blocked_p ())
6872 pending_signals = 1;
6873 break;
6876 EVENT_INIT (hold_quit);
6877 hold_quit.kind = NO_EVENT;
6879 /* No need for FIONREAD or fcntl; just say don't wait. */
6880 while ((nr = (*t->read_socket_hook) (t, &hold_quit)) > 0)
6881 nread += nr;
6883 if (nr == -1) /* Not OK to read input now. */
6885 err = 1;
6887 else if (nr == -2) /* Non-transient error. */
6889 /* The terminal device terminated; it should be closed. */
6891 /* Kill Emacs if this was our last terminal. */
6892 if (!terminal_list->next_terminal)
6893 /* Formerly simply reported no input, but that
6894 sometimes led to a failure of Emacs to terminate.
6895 SIGHUP seems appropriate if we can't reach the
6896 terminal. */
6897 /* ??? Is it really right to send the signal just to
6898 this process rather than to the whole process
6899 group? Perhaps on systems with FIONREAD Emacs is
6900 alone in its group. */
6901 terminate_due_to_signal (SIGHUP, 10);
6903 /* XXX Is calling delete_terminal safe here? It calls delete_frame. */
6905 Lisp_Object tmp;
6906 XSETTERMINAL (tmp, t);
6907 Fdelete_terminal (tmp, Qnoelisp);
6911 /* If there was no error, make sure the pointer
6912 is visible for all frames on this terminal. */
6913 if (nr >= 0)
6915 Lisp_Object tail, frame;
6917 FOR_EACH_FRAME (tail, frame)
6919 struct frame *f = XFRAME (frame);
6920 if (FRAME_TERMINAL (f) == t)
6921 frame_make_pointer_visible (f);
6925 if (hold_quit.kind != NO_EVENT)
6926 kbd_buffer_store_event (&hold_quit);
6929 t = next;
6932 if (err && !nread)
6933 nread = -1;
6935 return nread;
6938 /* This is the tty way of reading available input.
6940 Note that each terminal device has its own `struct terminal' object,
6941 and so this function is called once for each individual termcap
6942 terminal. The first parameter indicates which terminal to read from. */
6945 tty_read_avail_input (struct terminal *terminal,
6946 struct input_event *hold_quit)
6948 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
6949 the kbd_buffer can really hold. That may prevent loss
6950 of characters on some systems when input is stuffed at us. */
6951 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
6952 int n_to_read, i;
6953 struct tty_display_info *tty = terminal->display_info.tty;
6954 int nread = 0;
6955 #ifdef subprocesses
6956 int buffer_free = KBD_BUFFER_SIZE - kbd_buffer_nr_stored () - 1;
6958 if (kbd_on_hold_p () || buffer_free <= 0)
6959 return 0;
6960 #endif /* subprocesses */
6962 if (!terminal->name) /* Don't read from a dead terminal. */
6963 return 0;
6965 if (terminal->type != output_termcap
6966 && terminal->type != output_msdos_raw)
6967 emacs_abort ();
6969 /* XXX I think the following code should be moved to separate hook
6970 functions in system-dependent files. */
6971 #ifdef WINDOWSNT
6972 /* FIXME: AFAIK, tty_read_avail_input is not used under w32 since the non-GUI
6973 code sets read_socket_hook to w32_console_read_socket instead! */
6974 return 0;
6975 #else /* not WINDOWSNT */
6976 if (! tty->term_initted) /* In case we get called during bootstrap. */
6977 return 0;
6979 if (! tty->input)
6980 return 0; /* The terminal is suspended. */
6982 #ifdef MSDOS
6983 n_to_read = dos_keysns ();
6984 if (n_to_read == 0)
6985 return 0;
6987 cbuf[0] = dos_keyread ();
6988 nread = 1;
6990 #else /* not MSDOS */
6991 #ifdef HAVE_GPM
6992 if (gpm_tty == tty)
6994 Gpm_Event event;
6995 struct input_event gpm_hold_quit;
6996 int gpm, fd = gpm_fd;
6998 EVENT_INIT (gpm_hold_quit);
6999 gpm_hold_quit.kind = NO_EVENT;
7001 /* gpm==1 if event received.
7002 gpm==0 if the GPM daemon has closed the connection, in which case
7003 Gpm_GetEvent closes gpm_fd and clears it to -1, which is why
7004 we save it in `fd' so close_gpm can remove it from the
7005 select masks.
7006 gpm==-1 if a protocol error or EWOULDBLOCK; the latter is normal. */
7007 while (gpm = Gpm_GetEvent (&event), gpm == 1) {
7008 nread += handle_one_term_event (tty, &event, &gpm_hold_quit);
7010 if (gpm == 0)
7011 /* Presumably the GPM daemon has closed the connection. */
7012 close_gpm (fd);
7013 if (gpm_hold_quit.kind != NO_EVENT)
7014 kbd_buffer_store_event (&gpm_hold_quit);
7015 if (nread)
7016 return nread;
7018 #endif /* HAVE_GPM */
7020 /* Determine how many characters we should *try* to read. */
7021 #ifdef USABLE_FIONREAD
7022 /* Find out how much input is available. */
7023 if (ioctl (fileno (tty->input), FIONREAD, &n_to_read) < 0)
7025 if (! noninteractive)
7026 return -2; /* Close this terminal. */
7027 else
7028 n_to_read = 0;
7030 if (n_to_read == 0)
7031 return 0;
7032 if (n_to_read > sizeof cbuf)
7033 n_to_read = sizeof cbuf;
7034 #elif defined USG || defined CYGWIN
7035 /* Read some input if available, but don't wait. */
7036 n_to_read = sizeof cbuf;
7037 fcntl (fileno (tty->input), F_SETFL, O_NONBLOCK);
7038 #else
7039 # error "Cannot read without possibly delaying"
7040 #endif
7042 #ifdef subprocesses
7043 /* Don't read more than we can store. */
7044 if (n_to_read > buffer_free)
7045 n_to_read = buffer_free;
7046 #endif /* subprocesses */
7048 /* Now read; for one reason or another, this will not block.
7049 NREAD is set to the number of chars read. */
7052 nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read);
7053 /* POSIX infers that processes which are not in the session leader's
7054 process group won't get SIGHUPs at logout time. BSDI adheres to
7055 this part standard and returns -1 from read (0) with errno==EIO
7056 when the control tty is taken away.
7057 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
7058 if (nread == -1 && errno == EIO)
7059 return -2; /* Close this terminal. */
7060 #if defined (AIX) && defined (_BSD)
7061 /* The kernel sometimes fails to deliver SIGHUP for ptys.
7062 This looks incorrect, but it isn't, because _BSD causes
7063 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
7064 and that causes a value other than 0 when there is no input. */
7065 if (nread == 0)
7066 return -2; /* Close this terminal. */
7067 #endif
7069 while (
7070 /* We used to retry the read if it was interrupted.
7071 But this does the wrong thing when O_NONBLOCK causes
7072 an EAGAIN error. Does anybody know of a situation
7073 where a retry is actually needed? */
7074 #if 0
7075 nread < 0 && (errno == EAGAIN || errno == EFAULT
7076 #ifdef EBADSLT
7077 || errno == EBADSLT
7078 #endif
7080 #else
7082 #endif
7085 #ifndef USABLE_FIONREAD
7086 #if defined (USG) || defined (CYGWIN)
7087 fcntl (fileno (tty->input), F_SETFL, 0);
7088 #endif /* USG or CYGWIN */
7089 #endif /* no FIONREAD */
7091 if (nread <= 0)
7092 return nread;
7094 #endif /* not MSDOS */
7095 #endif /* not WINDOWSNT */
7097 for (i = 0; i < nread; i++)
7099 struct input_event buf;
7100 EVENT_INIT (buf);
7101 buf.kind = ASCII_KEYSTROKE_EVENT;
7102 buf.modifiers = 0;
7103 if (tty->meta_key == 1 && (cbuf[i] & 0x80))
7104 buf.modifiers = meta_modifier;
7105 if (tty->meta_key != 2)
7106 cbuf[i] &= ~0x80;
7108 buf.code = cbuf[i];
7109 /* Set the frame corresponding to the active tty. Note that the
7110 value of selected_frame is not reliable here, redisplay tends
7111 to temporarily change it. */
7112 buf.frame_or_window = tty->top_frame;
7113 buf.arg = Qnil;
7115 kbd_buffer_store_event (&buf);
7116 /* Don't look at input that follows a C-g too closely.
7117 This reduces lossage due to autorepeat on C-g. */
7118 if (buf.kind == ASCII_KEYSTROKE_EVENT
7119 && buf.code == quit_char)
7120 break;
7123 return nread;
7126 static void
7127 handle_async_input (void)
7129 #ifdef USABLE_SIGIO
7130 while (1)
7132 int nread = gobble_input ();
7133 /* -1 means it's not ok to read the input now.
7134 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
7135 0 means there was no keyboard input available. */
7136 if (nread <= 0)
7137 break;
7139 #endif
7142 void
7143 process_pending_signals (void)
7145 pending_signals = 0;
7146 handle_async_input ();
7147 do_pending_atimers ();
7150 /* Undo any number of BLOCK_INPUT calls down to level LEVEL,
7151 and reinvoke any pending signal if the level is now 0 and
7152 a fatal error is not already in progress. */
7154 void
7155 unblock_input_to (int level)
7157 interrupt_input_blocked = level;
7158 if (level == 0)
7160 if (pending_signals && !fatal_error_in_progress)
7161 process_pending_signals ();
7163 else if (level < 0)
7164 emacs_abort ();
7167 /* End critical section.
7169 If doing signal-driven input, and a signal came in when input was
7170 blocked, reinvoke the signal handler now to deal with it.
7172 It will also process queued input, if it was not read before.
7173 When a longer code sequence does not use block/unblock input
7174 at all, the whole input gathered up to the next call to
7175 unblock_input will be processed inside that call. */
7177 void
7178 unblock_input (void)
7180 unblock_input_to (interrupt_input_blocked - 1);
7183 /* Undo any number of BLOCK_INPUT calls,
7184 and also reinvoke any pending signal. */
7186 void
7187 totally_unblock_input (void)
7189 unblock_input_to (0);
7192 #ifdef USABLE_SIGIO
7194 void
7195 handle_input_available_signal (int sig)
7197 pending_signals = 1;
7199 if (input_available_clear_time)
7200 *input_available_clear_time = make_timespec (0, 0);
7203 static void
7204 deliver_input_available_signal (int sig)
7206 deliver_process_signal (sig, handle_input_available_signal);
7208 #endif /* USABLE_SIGIO */
7211 /* User signal events. */
7213 struct user_signal_info
7215 /* Signal number. */
7216 int sig;
7218 /* Name of the signal. */
7219 char *name;
7221 /* Number of pending signals. */
7222 int npending;
7224 struct user_signal_info *next;
7227 /* List of user signals. */
7228 static struct user_signal_info *user_signals = NULL;
7230 void
7231 add_user_signal (int sig, const char *name)
7233 struct sigaction action;
7234 struct user_signal_info *p;
7236 for (p = user_signals; p; p = p->next)
7237 if (p->sig == sig)
7238 /* Already added. */
7239 return;
7241 p = xmalloc (sizeof *p);
7242 p->sig = sig;
7243 p->name = xstrdup (name);
7244 p->npending = 0;
7245 p->next = user_signals;
7246 user_signals = p;
7248 emacs_sigaction_init (&action, deliver_user_signal);
7249 sigaction (sig, &action, 0);
7252 static void
7253 handle_user_signal (int sig)
7255 struct user_signal_info *p;
7256 const char *special_event_name = NULL;
7258 if (SYMBOLP (Vdebug_on_event))
7259 special_event_name = SSDATA (SYMBOL_NAME (Vdebug_on_event));
7261 for (p = user_signals; p; p = p->next)
7262 if (p->sig == sig)
7264 if (special_event_name
7265 && strcmp (special_event_name, p->name) == 0)
7267 /* Enter the debugger in many ways. */
7268 debug_on_next_call = 1;
7269 debug_on_quit = 1;
7270 Vquit_flag = Qt;
7271 Vinhibit_quit = Qnil;
7273 /* Eat the event. */
7274 break;
7277 p->npending++;
7278 #ifdef USABLE_SIGIO
7279 if (interrupt_input)
7280 handle_input_available_signal (sig);
7281 else
7282 #endif
7284 /* Tell wait_reading_process_output that it needs to wake
7285 up and look around. */
7286 if (input_available_clear_time)
7287 *input_available_clear_time = make_timespec (0, 0);
7289 break;
7293 static void
7294 deliver_user_signal (int sig)
7296 deliver_process_signal (sig, handle_user_signal);
7299 static char *
7300 find_user_signal_name (int sig)
7302 struct user_signal_info *p;
7304 for (p = user_signals; p; p = p->next)
7305 if (p->sig == sig)
7306 return p->name;
7308 return NULL;
7311 static void
7312 store_user_signal_events (void)
7314 struct user_signal_info *p;
7315 struct input_event buf;
7316 bool buf_initialized = 0;
7318 for (p = user_signals; p; p = p->next)
7319 if (p->npending > 0)
7321 if (! buf_initialized)
7323 memset (&buf, 0, sizeof buf);
7324 buf.kind = USER_SIGNAL_EVENT;
7325 buf.frame_or_window = selected_frame;
7326 buf_initialized = 1;
7331 buf.code = p->sig;
7332 kbd_buffer_store_event (&buf);
7333 p->npending--;
7335 while (p->npending > 0);
7340 static void menu_bar_item (Lisp_Object, Lisp_Object, Lisp_Object, void *);
7341 static Lisp_Object menu_bar_one_keymap_changed_items;
7343 /* These variables hold the vector under construction within
7344 menu_bar_items and its subroutines, and the current index
7345 for storing into that vector. */
7346 static Lisp_Object menu_bar_items_vector;
7347 static int menu_bar_items_index;
7350 static const char *separator_names[] = {
7351 "space",
7352 "no-line",
7353 "single-line",
7354 "double-line",
7355 "single-dashed-line",
7356 "double-dashed-line",
7357 "shadow-etched-in",
7358 "shadow-etched-out",
7359 "shadow-etched-in-dash",
7360 "shadow-etched-out-dash",
7361 "shadow-double-etched-in",
7362 "shadow-double-etched-out",
7363 "shadow-double-etched-in-dash",
7364 "shadow-double-etched-out-dash",
7368 /* Return true if LABEL specifies a separator. */
7370 bool
7371 menu_separator_name_p (const char *label)
7373 if (!label)
7374 return 0;
7375 else if (strlen (label) > 3
7376 && memcmp (label, "--", 2) == 0
7377 && label[2] != '-')
7379 int i;
7380 label += 2;
7381 for (i = 0; separator_names[i]; ++i)
7382 if (strcmp (label, separator_names[i]) == 0)
7383 return 1;
7385 else
7387 /* It's a separator if it contains only dashes. */
7388 while (*label == '-')
7389 ++label;
7390 return (*label == 0);
7393 return 0;
7397 /* Return a vector of menu items for a menu bar, appropriate
7398 to the current buffer. Each item has three elements in the vector:
7399 KEY STRING MAPLIST.
7401 OLD is an old vector we can optionally reuse, or nil. */
7403 Lisp_Object
7404 menu_bar_items (Lisp_Object old)
7406 /* The number of keymaps we're scanning right now, and the number of
7407 keymaps we have allocated space for. */
7408 ptrdiff_t nmaps;
7410 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
7411 in the current keymaps, or nil where it is not a prefix. */
7412 Lisp_Object *maps;
7414 Lisp_Object mapsbuf[3];
7415 Lisp_Object def, tail;
7417 ptrdiff_t mapno;
7418 Lisp_Object oquit;
7420 USE_SAFE_ALLOCA;
7422 /* In order to build the menus, we need to call the keymap
7423 accessors. They all call QUIT. But this function is called
7424 during redisplay, during which a quit is fatal. So inhibit
7425 quitting while building the menus.
7426 We do this instead of specbind because (1) errors will clear it anyway
7427 and (2) this avoids risk of specpdl overflow. */
7428 oquit = Vinhibit_quit;
7429 Vinhibit_quit = Qt;
7431 if (!NILP (old))
7432 menu_bar_items_vector = old;
7433 else
7434 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
7435 menu_bar_items_index = 0;
7437 /* Build our list of keymaps.
7438 If we recognize a function key and replace its escape sequence in
7439 keybuf with its symbol, or if the sequence starts with a mouse
7440 click and we need to switch buffers, we jump back here to rebuild
7441 the initial keymaps from the current buffer. */
7443 Lisp_Object *tmaps;
7445 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7446 if (!NILP (Voverriding_local_map_menu_flag)
7447 && !NILP (Voverriding_local_map))
7449 /* Yes, use them (if non-nil) as well as the global map. */
7450 maps = mapsbuf;
7451 nmaps = 0;
7452 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
7453 maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
7454 if (!NILP (Voverriding_local_map))
7455 maps[nmaps++] = Voverriding_local_map;
7457 else
7459 /* No, so use major and minor mode keymaps and keymap property.
7460 Note that menu-bar bindings in the local-map and keymap
7461 properties may not work reliable, as they are only
7462 recognized when the menu-bar (or mode-line) is updated,
7463 which does not normally happen after every command. */
7464 Lisp_Object tem;
7465 ptrdiff_t nminor;
7466 nminor = current_minor_maps (NULL, &tmaps);
7467 SAFE_NALLOCA (maps, 1, nminor + 4);
7468 nmaps = 0;
7469 tem = KVAR (current_kboard, Voverriding_terminal_local_map);
7470 if (!NILP (tem) && !NILP (Voverriding_local_map_menu_flag))
7471 maps[nmaps++] = tem;
7472 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
7473 maps[nmaps++] = tem;
7474 memcpy (maps + nmaps, tmaps, nminor * sizeof (maps[0]));
7475 nmaps += nminor;
7476 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
7478 maps[nmaps++] = current_global_map;
7481 /* Look up in each map the dummy prefix key `menu-bar'. */
7483 for (mapno = nmaps - 1; mapno >= 0; mapno--)
7484 if (!NILP (maps[mapno]))
7486 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
7487 0, 1);
7488 if (CONSP (def))
7490 menu_bar_one_keymap_changed_items = Qnil;
7491 map_keymap_canonical (def, menu_bar_item, Qnil, NULL);
7495 /* Move to the end those items that should be at the end. */
7497 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
7499 int i;
7500 int end = menu_bar_items_index;
7502 for (i = 0; i < end; i += 4)
7503 if (EQ (XCAR (tail), AREF (menu_bar_items_vector, i)))
7505 Lisp_Object tem0, tem1, tem2, tem3;
7506 /* Move the item at index I to the end,
7507 shifting all the others forward. */
7508 tem0 = AREF (menu_bar_items_vector, i + 0);
7509 tem1 = AREF (menu_bar_items_vector, i + 1);
7510 tem2 = AREF (menu_bar_items_vector, i + 2);
7511 tem3 = AREF (menu_bar_items_vector, i + 3);
7512 if (end > i + 4)
7513 memmove (aref_addr (menu_bar_items_vector, i),
7514 aref_addr (menu_bar_items_vector, i + 4),
7515 (end - i - 4) * word_size);
7516 ASET (menu_bar_items_vector, end - 4, tem0);
7517 ASET (menu_bar_items_vector, end - 3, tem1);
7518 ASET (menu_bar_items_vector, end - 2, tem2);
7519 ASET (menu_bar_items_vector, end - 1, tem3);
7520 break;
7524 /* Add nil, nil, nil, nil at the end. */
7526 int i = menu_bar_items_index;
7527 if (i + 4 > ASIZE (menu_bar_items_vector))
7528 menu_bar_items_vector
7529 = larger_vector (menu_bar_items_vector, 4, -1);
7530 /* Add this item. */
7531 ASET (menu_bar_items_vector, i, Qnil); i++;
7532 ASET (menu_bar_items_vector, i, Qnil); i++;
7533 ASET (menu_bar_items_vector, i, Qnil); i++;
7534 ASET (menu_bar_items_vector, i, Qnil); i++;
7535 menu_bar_items_index = i;
7538 Vinhibit_quit = oquit;
7539 SAFE_FREE ();
7540 return menu_bar_items_vector;
7543 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
7544 If there's already an item for KEY, add this DEF to it. */
7546 Lisp_Object item_properties;
7548 static void
7549 menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dummy2)
7551 struct gcpro gcpro1;
7552 int i;
7553 bool parsed;
7554 Lisp_Object tem;
7556 if (EQ (item, Qundefined))
7558 /* If a map has an explicit `undefined' as definition,
7559 discard any previously made menu bar item. */
7561 for (i = 0; i < menu_bar_items_index; i += 4)
7562 if (EQ (key, AREF (menu_bar_items_vector, i)))
7564 if (menu_bar_items_index > i + 4)
7565 memmove (aref_addr (menu_bar_items_vector, i),
7566 aref_addr (menu_bar_items_vector, i + 4),
7567 (menu_bar_items_index - i - 4) * word_size);
7568 menu_bar_items_index -= 4;
7572 /* If this keymap has already contributed to this KEY,
7573 don't contribute to it a second time. */
7574 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
7575 if (!NILP (tem) || NILP (item))
7576 return;
7578 menu_bar_one_keymap_changed_items
7579 = Fcons (key, menu_bar_one_keymap_changed_items);
7581 /* We add to menu_bar_one_keymap_changed_items before doing the
7582 parse_menu_item, so that if it turns out it wasn't a menu item,
7583 it still correctly hides any further menu item. */
7584 GCPRO1 (key);
7585 parsed = parse_menu_item (item, 1);
7586 UNGCPRO;
7587 if (!parsed)
7588 return;
7590 item = AREF (item_properties, ITEM_PROPERTY_DEF);
7592 /* Find any existing item for this KEY. */
7593 for (i = 0; i < menu_bar_items_index; i += 4)
7594 if (EQ (key, AREF (menu_bar_items_vector, i)))
7595 break;
7597 /* If we did not find this KEY, add it at the end. */
7598 if (i == menu_bar_items_index)
7600 /* If vector is too small, get a bigger one. */
7601 if (i + 4 > ASIZE (menu_bar_items_vector))
7602 menu_bar_items_vector = larger_vector (menu_bar_items_vector, 4, -1);
7603 /* Add this item. */
7604 ASET (menu_bar_items_vector, i, key); i++;
7605 ASET (menu_bar_items_vector, i,
7606 AREF (item_properties, ITEM_PROPERTY_NAME)); i++;
7607 ASET (menu_bar_items_vector, i, list1 (item)); i++;
7608 ASET (menu_bar_items_vector, i, make_number (0)); i++;
7609 menu_bar_items_index = i;
7611 /* We did find an item for this KEY. Add ITEM to its list of maps. */
7612 else
7614 Lisp_Object old;
7615 old = AREF (menu_bar_items_vector, i + 2);
7616 /* If the new and the old items are not both keymaps,
7617 the lookup will only find `item'. */
7618 item = Fcons (item, KEYMAPP (item) && KEYMAPP (XCAR (old)) ? old : Qnil);
7619 ASET (menu_bar_items_vector, i + 2, item);
7623 /* This is used as the handler when calling menu_item_eval_property. */
7624 static Lisp_Object
7625 menu_item_eval_property_1 (Lisp_Object arg)
7627 /* If we got a quit from within the menu computation,
7628 quit all the way out of it. This takes care of C-] in the debugger. */
7629 if (CONSP (arg) && EQ (XCAR (arg), Qquit))
7630 Fsignal (Qquit, Qnil);
7632 return Qnil;
7635 static Lisp_Object
7636 eval_dyn (Lisp_Object form)
7638 return Feval (form, Qnil);
7641 /* Evaluate an expression and return the result (or nil if something
7642 went wrong). Used to evaluate dynamic parts of menu items. */
7643 Lisp_Object
7644 menu_item_eval_property (Lisp_Object sexpr)
7646 ptrdiff_t count = SPECPDL_INDEX ();
7647 Lisp_Object val;
7648 specbind (Qinhibit_redisplay, Qt);
7649 val = internal_condition_case_1 (eval_dyn, sexpr, Qerror,
7650 menu_item_eval_property_1);
7651 return unbind_to (count, val);
7654 /* This function parses a menu item and leaves the result in the
7655 vector item_properties.
7656 ITEM is a key binding, a possible menu item.
7657 INMENUBAR is > 0 when this is considered for an entry in a menu bar
7658 top level.
7659 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
7660 parse_menu_item returns true if the item is a menu item and false
7661 otherwise. */
7663 bool
7664 parse_menu_item (Lisp_Object item, int inmenubar)
7666 Lisp_Object def, tem, item_string, start;
7667 Lisp_Object filter;
7668 Lisp_Object keyhint;
7669 int i;
7671 filter = Qnil;
7672 keyhint = Qnil;
7674 if (!CONSP (item))
7675 return 0;
7677 /* Create item_properties vector if necessary. */
7678 if (NILP (item_properties))
7679 item_properties
7680 = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
7682 /* Initialize optional entries. */
7683 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
7684 ASET (item_properties, i, Qnil);
7685 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7687 /* Save the item here to protect it from GC. */
7688 ASET (item_properties, ITEM_PROPERTY_ITEM, item);
7690 item_string = XCAR (item);
7692 start = item;
7693 item = XCDR (item);
7694 if (STRINGP (item_string))
7696 /* Old format menu item. */
7697 ASET (item_properties, ITEM_PROPERTY_NAME, item_string);
7699 /* Maybe help string. */
7700 if (CONSP (item) && STRINGP (XCAR (item)))
7702 ASET (item_properties, ITEM_PROPERTY_HELP, XCAR (item));
7703 start = item;
7704 item = XCDR (item);
7707 /* Maybe an obsolete key binding cache. */
7708 if (CONSP (item) && CONSP (XCAR (item))
7709 && (NILP (XCAR (XCAR (item)))
7710 || VECTORP (XCAR (XCAR (item)))))
7711 item = XCDR (item);
7713 /* This is the real definition--the function to run. */
7714 ASET (item_properties, ITEM_PROPERTY_DEF, item);
7716 /* Get enable property, if any. */
7717 if (SYMBOLP (item))
7719 tem = Fget (item, Qmenu_enable);
7720 if (!NILP (Venable_disabled_menus_and_buttons))
7721 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7722 else if (!NILP (tem))
7723 ASET (item_properties, ITEM_PROPERTY_ENABLE, tem);
7726 else if (EQ (item_string, Qmenu_item) && CONSP (item))
7728 /* New format menu item. */
7729 ASET (item_properties, ITEM_PROPERTY_NAME, XCAR (item));
7730 start = XCDR (item);
7731 if (CONSP (start))
7733 /* We have a real binding. */
7734 ASET (item_properties, ITEM_PROPERTY_DEF, XCAR (start));
7736 item = XCDR (start);
7737 /* Is there an obsolete cache list with key equivalences. */
7738 if (CONSP (item) && CONSP (XCAR (item)))
7739 item = XCDR (item);
7741 /* Parse properties. */
7742 while (CONSP (item) && CONSP (XCDR (item)))
7744 tem = XCAR (item);
7745 item = XCDR (item);
7747 if (EQ (tem, QCenable))
7749 if (!NILP (Venable_disabled_menus_and_buttons))
7750 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7751 else
7752 ASET (item_properties, ITEM_PROPERTY_ENABLE, XCAR (item));
7754 else if (EQ (tem, QCvisible))
7756 /* If got a visible property and that evaluates to nil
7757 then ignore this item. */
7758 tem = menu_item_eval_property (XCAR (item));
7759 if (NILP (tem))
7760 return 0;
7762 else if (EQ (tem, QChelp))
7763 ASET (item_properties, ITEM_PROPERTY_HELP, XCAR (item));
7764 else if (EQ (tem, QCfilter))
7765 filter = item;
7766 else if (EQ (tem, QCkey_sequence))
7768 tem = XCAR (item);
7769 if (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem))
7770 /* Be GC protected. Set keyhint to item instead of tem. */
7771 keyhint = item;
7773 else if (EQ (tem, QCkeys))
7775 tem = XCAR (item);
7776 if (CONSP (tem) || STRINGP (tem))
7777 ASET (item_properties, ITEM_PROPERTY_KEYEQ, tem);
7779 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
7781 Lisp_Object type;
7782 tem = XCAR (item);
7783 type = XCAR (tem);
7784 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7786 ASET (item_properties, ITEM_PROPERTY_SELECTED,
7787 XCDR (tem));
7788 ASET (item_properties, ITEM_PROPERTY_TYPE, type);
7791 item = XCDR (item);
7794 else if (inmenubar || !NILP (start))
7795 return 0;
7797 else
7798 return 0; /* not a menu item */
7800 /* If item string is not a string, evaluate it to get string.
7801 If we don't get a string, skip this item. */
7802 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
7803 if (!(STRINGP (item_string)))
7805 item_string = menu_item_eval_property (item_string);
7806 if (!STRINGP (item_string))
7807 return 0;
7808 ASET (item_properties, ITEM_PROPERTY_NAME, item_string);
7811 /* If got a filter apply it on definition. */
7812 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7813 if (!NILP (filter))
7815 def = menu_item_eval_property (list2 (XCAR (filter),
7816 list2 (Qquote, def)));
7818 ASET (item_properties, ITEM_PROPERTY_DEF, def);
7821 /* Enable or disable selection of item. */
7822 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
7823 if (!EQ (tem, Qt))
7825 tem = menu_item_eval_property (tem);
7826 if (inmenubar && NILP (tem))
7827 return 0; /* Ignore disabled items in menu bar. */
7828 ASET (item_properties, ITEM_PROPERTY_ENABLE, tem);
7831 /* If we got no definition, this item is just unselectable text which
7832 is OK in a submenu but not in the menubar. */
7833 if (NILP (def))
7834 return (!inmenubar);
7836 /* See if this is a separate pane or a submenu. */
7837 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7838 tem = get_keymap (def, 0, 1);
7839 /* For a subkeymap, just record its details and exit. */
7840 if (CONSP (tem))
7842 ASET (item_properties, ITEM_PROPERTY_MAP, tem);
7843 ASET (item_properties, ITEM_PROPERTY_DEF, tem);
7844 return 1;
7847 /* At the top level in the menu bar, do likewise for commands also.
7848 The menu bar does not display equivalent key bindings anyway.
7849 ITEM_PROPERTY_DEF is already set up properly. */
7850 if (inmenubar > 0)
7851 return 1;
7853 { /* This is a command. See if there is an equivalent key binding. */
7854 Lisp_Object keyeq = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
7855 AUTO_STRING (space_space, " ");
7857 /* The previous code preferred :key-sequence to :keys, so we
7858 preserve this behavior. */
7859 if (STRINGP (keyeq) && !CONSP (keyhint))
7860 keyeq = concat2 (space_space, Fsubstitute_command_keys (keyeq));
7861 else
7863 Lisp_Object prefix = keyeq;
7864 Lisp_Object keys = Qnil;
7866 if (CONSP (prefix))
7868 def = XCAR (prefix);
7869 prefix = XCDR (prefix);
7871 else
7872 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7874 if (CONSP (keyhint) && !NILP (XCAR (keyhint)))
7876 keys = XCAR (keyhint);
7877 tem = Fkey_binding (keys, Qnil, Qnil, Qnil);
7879 /* We have a suggested key. Is it bound to the command? */
7880 if (NILP (tem)
7881 || (!EQ (tem, def)
7882 /* If the command is an alias for another
7883 (such as lmenu.el set it up), check if the
7884 original command matches the cached command. */
7885 && !(SYMBOLP (def)
7886 && EQ (tem, XSYMBOL (def)->function))))
7887 keys = Qnil;
7890 if (NILP (keys))
7891 keys = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qnil);
7893 if (!NILP (keys))
7895 tem = Fkey_description (keys, Qnil);
7896 if (CONSP (prefix))
7898 if (STRINGP (XCAR (prefix)))
7899 tem = concat2 (XCAR (prefix), tem);
7900 if (STRINGP (XCDR (prefix)))
7901 tem = concat2 (tem, XCDR (prefix));
7903 keyeq = concat2 (space_space, tem);
7905 else
7906 keyeq = Qnil;
7909 /* If we have an equivalent key binding, use that. */
7910 ASET (item_properties, ITEM_PROPERTY_KEYEQ, keyeq);
7913 /* Include this when menu help is implemented.
7914 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
7915 if (!(NILP (tem) || STRINGP (tem)))
7917 tem = menu_item_eval_property (tem);
7918 if (!STRINGP (tem))
7919 tem = Qnil;
7920 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
7924 /* Handle radio buttons or toggle boxes. */
7925 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
7926 if (!NILP (tem))
7927 ASET (item_properties, ITEM_PROPERTY_SELECTED,
7928 menu_item_eval_property (tem));
7930 return 1;
7935 /***********************************************************************
7936 Tool-bars
7937 ***********************************************************************/
7939 /* A vector holding tool bar items while they are parsed in function
7940 tool_bar_items. Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
7941 in the vector. */
7943 static Lisp_Object tool_bar_items_vector;
7945 /* A vector holding the result of parse_tool_bar_item. Layout is like
7946 the one for a single item in tool_bar_items_vector. */
7948 static Lisp_Object tool_bar_item_properties;
7950 /* Next free index in tool_bar_items_vector. */
7952 static int ntool_bar_items;
7954 /* Function prototypes. */
7956 static void init_tool_bar_items (Lisp_Object);
7957 static void process_tool_bar_item (Lisp_Object, Lisp_Object, Lisp_Object,
7958 void *);
7959 static bool parse_tool_bar_item (Lisp_Object, Lisp_Object);
7960 static void append_tool_bar_item (void);
7963 /* Return a vector of tool bar items for keymaps currently in effect.
7964 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
7965 tool bar items found. */
7967 Lisp_Object
7968 tool_bar_items (Lisp_Object reuse, int *nitems)
7970 Lisp_Object *maps;
7971 Lisp_Object mapsbuf[3];
7972 ptrdiff_t nmaps, i;
7973 Lisp_Object oquit;
7974 Lisp_Object *tmaps;
7975 USE_SAFE_ALLOCA;
7977 *nitems = 0;
7979 /* In order to build the menus, we need to call the keymap
7980 accessors. They all call QUIT. But this function is called
7981 during redisplay, during which a quit is fatal. So inhibit
7982 quitting while building the menus. We do this instead of
7983 specbind because (1) errors will clear it anyway and (2) this
7984 avoids risk of specpdl overflow. */
7985 oquit = Vinhibit_quit;
7986 Vinhibit_quit = Qt;
7988 /* Initialize tool_bar_items_vector and protect it from GC. */
7989 init_tool_bar_items (reuse);
7991 /* Build list of keymaps in maps. Set nmaps to the number of maps
7992 to process. */
7994 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7995 if (!NILP (Voverriding_local_map_menu_flag)
7996 && !NILP (Voverriding_local_map))
7998 /* Yes, use them (if non-nil) as well as the global map. */
7999 maps = mapsbuf;
8000 nmaps = 0;
8001 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
8002 maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
8003 if (!NILP (Voverriding_local_map))
8004 maps[nmaps++] = Voverriding_local_map;
8006 else
8008 /* No, so use major and minor mode keymaps and keymap property.
8009 Note that tool-bar bindings in the local-map and keymap
8010 properties may not work reliable, as they are only
8011 recognized when the tool-bar (or mode-line) is updated,
8012 which does not normally happen after every command. */
8013 Lisp_Object tem;
8014 ptrdiff_t nminor;
8015 nminor = current_minor_maps (NULL, &tmaps);
8016 SAFE_NALLOCA (maps, 1, nminor + 4);
8017 nmaps = 0;
8018 tem = KVAR (current_kboard, Voverriding_terminal_local_map);
8019 if (!NILP (tem) && !NILP (Voverriding_local_map_menu_flag))
8020 maps[nmaps++] = tem;
8021 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
8022 maps[nmaps++] = tem;
8023 memcpy (maps + nmaps, tmaps, nminor * sizeof (maps[0]));
8024 nmaps += nminor;
8025 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
8028 /* Add global keymap at the end. */
8029 maps[nmaps++] = current_global_map;
8031 /* Process maps in reverse order and look up in each map the prefix
8032 key `tool-bar'. */
8033 for (i = nmaps - 1; i >= 0; --i)
8034 if (!NILP (maps[i]))
8036 Lisp_Object keymap;
8038 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
8039 if (CONSP (keymap))
8040 map_keymap (keymap, process_tool_bar_item, Qnil, NULL, 1);
8043 Vinhibit_quit = oquit;
8044 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
8045 SAFE_FREE ();
8046 return tool_bar_items_vector;
8050 /* Process the definition of KEY which is DEF. */
8052 static void
8053 process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void *args)
8055 int i;
8056 struct gcpro gcpro1, gcpro2;
8058 /* Protect KEY and DEF from GC because parse_tool_bar_item may call
8059 eval. */
8060 GCPRO2 (key, def);
8062 if (EQ (def, Qundefined))
8064 /* If a map has an explicit `undefined' as definition,
8065 discard any previously made item. */
8066 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
8068 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
8070 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
8072 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
8073 memmove (v, v + TOOL_BAR_ITEM_NSLOTS,
8074 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
8075 * word_size));
8076 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
8077 break;
8081 else if (parse_tool_bar_item (key, def))
8082 /* Append a new tool bar item to tool_bar_items_vector. Accept
8083 more than one definition for the same key. */
8084 append_tool_bar_item ();
8086 UNGCPRO;
8089 /* Access slot with index IDX of vector tool_bar_item_properties. */
8090 #define PROP(IDX) AREF (tool_bar_item_properties, (IDX))
8091 static void
8092 set_prop (ptrdiff_t idx, Lisp_Object val)
8094 ASET (tool_bar_item_properties, idx, val);
8098 /* Parse a tool bar item specification ITEM for key KEY and return the
8099 result in tool_bar_item_properties. Value is false if ITEM is
8100 invalid.
8102 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
8104 CAPTION is the caption of the item, If it's not a string, it is
8105 evaluated to get a string.
8107 BINDING is the tool bar item's binding. Tool-bar items with keymaps
8108 as binding are currently ignored.
8110 The following properties are recognized:
8112 - `:enable FORM'.
8114 FORM is evaluated and specifies whether the tool bar item is
8115 enabled or disabled.
8117 - `:visible FORM'
8119 FORM is evaluated and specifies whether the tool bar item is visible.
8121 - `:filter FUNCTION'
8123 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
8124 result is stored as the new binding.
8126 - `:button (TYPE SELECTED)'
8128 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
8129 and specifies whether the button is selected (pressed) or not.
8131 - `:image IMAGES'
8133 IMAGES is either a single image specification or a vector of four
8134 image specifications. See enum tool_bar_item_images.
8136 - `:help HELP-STRING'.
8138 Gives a help string to display for the tool bar item.
8140 - `:label LABEL-STRING'.
8142 A text label to show with the tool bar button if labels are enabled. */
8144 static bool
8145 parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
8147 Lisp_Object filter = Qnil;
8148 Lisp_Object caption;
8149 int i;
8150 bool have_label = 0;
8152 /* Definition looks like `(menu-item CAPTION BINDING PROPS...)'.
8153 Rule out items that aren't lists, don't start with
8154 `menu-item' or whose rest following `tool-bar-item' is not a
8155 list. */
8156 if (!CONSP (item))
8157 return 0;
8159 /* As an exception, allow old-style menu separators. */
8160 if (STRINGP (XCAR (item)))
8161 item = list1 (XCAR (item));
8162 else if (!EQ (XCAR (item), Qmenu_item)
8163 || (item = XCDR (item), !CONSP (item)))
8164 return 0;
8166 /* Create tool_bar_item_properties vector if necessary. Reset it to
8167 defaults. */
8168 if (VECTORP (tool_bar_item_properties))
8170 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
8171 set_prop (i, Qnil);
8173 else
8174 tool_bar_item_properties
8175 = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
8177 /* Set defaults. */
8178 set_prop (TOOL_BAR_ITEM_KEY, key);
8179 set_prop (TOOL_BAR_ITEM_ENABLED_P, Qt);
8181 /* Get the caption of the item. If the caption is not a string,
8182 evaluate it to get a string. If we don't get a string, skip this
8183 item. */
8184 caption = XCAR (item);
8185 if (!STRINGP (caption))
8187 caption = menu_item_eval_property (caption);
8188 if (!STRINGP (caption))
8189 return 0;
8191 set_prop (TOOL_BAR_ITEM_CAPTION, caption);
8193 /* If the rest following the caption is not a list, the menu item is
8194 either a separator, or invalid. */
8195 item = XCDR (item);
8196 if (!CONSP (item))
8198 if (menu_separator_name_p (SSDATA (caption)))
8200 set_prop (TOOL_BAR_ITEM_TYPE, Qt);
8201 #if !defined (USE_GTK) && !defined (HAVE_NS)
8202 /* If we use build_desired_tool_bar_string to render the
8203 tool bar, the separator is rendered as an image. */
8204 set_prop (TOOL_BAR_ITEM_IMAGES,
8205 (menu_item_eval_property
8206 (Vtool_bar_separator_image_expression)));
8207 set_prop (TOOL_BAR_ITEM_ENABLED_P, Qnil);
8208 set_prop (TOOL_BAR_ITEM_SELECTED_P, Qnil);
8209 set_prop (TOOL_BAR_ITEM_CAPTION, Qnil);
8210 #endif
8211 return 1;
8213 return 0;
8216 /* Store the binding. */
8217 set_prop (TOOL_BAR_ITEM_BINDING, XCAR (item));
8218 item = XCDR (item);
8220 /* Ignore cached key binding, if any. */
8221 if (CONSP (item) && CONSP (XCAR (item)))
8222 item = XCDR (item);
8224 /* Process the rest of the properties. */
8225 for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
8227 Lisp_Object ikey, value;
8229 ikey = XCAR (item);
8230 value = XCAR (XCDR (item));
8232 if (EQ (ikey, QCenable))
8234 /* `:enable FORM'. */
8235 if (!NILP (Venable_disabled_menus_and_buttons))
8236 set_prop (TOOL_BAR_ITEM_ENABLED_P, Qt);
8237 else
8238 set_prop (TOOL_BAR_ITEM_ENABLED_P, value);
8240 else if (EQ (ikey, QCvisible))
8242 /* `:visible FORM'. If got a visible property and that
8243 evaluates to nil then ignore this item. */
8244 if (NILP (menu_item_eval_property (value)))
8245 return 0;
8247 else if (EQ (ikey, QChelp))
8248 /* `:help HELP-STRING'. */
8249 set_prop (TOOL_BAR_ITEM_HELP, value);
8250 else if (EQ (ikey, QCvert_only))
8251 /* `:vert-only t/nil'. */
8252 set_prop (TOOL_BAR_ITEM_VERT_ONLY, value);
8253 else if (EQ (ikey, QClabel))
8255 const char *bad_label = "!!?GARBLED ITEM?!!";
8256 /* `:label LABEL-STRING'. */
8257 set_prop (TOOL_BAR_ITEM_LABEL,
8258 STRINGP (value) ? value : build_string (bad_label));
8259 have_label = 1;
8261 else if (EQ (ikey, QCfilter))
8262 /* ':filter FORM'. */
8263 filter = value;
8264 else if (EQ (ikey, QCbutton) && CONSP (value))
8266 /* `:button (TYPE . SELECTED)'. */
8267 Lisp_Object type, selected;
8269 type = XCAR (value);
8270 selected = XCDR (value);
8271 if (EQ (type, QCtoggle) || EQ (type, QCradio))
8273 set_prop (TOOL_BAR_ITEM_SELECTED_P, selected);
8274 set_prop (TOOL_BAR_ITEM_TYPE, type);
8277 else if (EQ (ikey, QCimage)
8278 && (CONSP (value)
8279 || (VECTORP (value) && ASIZE (value) == 4)))
8280 /* Value is either a single image specification or a vector
8281 of 4 such specifications for the different button states. */
8282 set_prop (TOOL_BAR_ITEM_IMAGES, value);
8283 else if (EQ (ikey, QCrtl))
8284 /* ':rtl STRING' */
8285 set_prop (TOOL_BAR_ITEM_RTL_IMAGE, value);
8289 if (!have_label)
8291 /* Try to make one from caption and key. */
8292 Lisp_Object tkey = PROP (TOOL_BAR_ITEM_KEY);
8293 Lisp_Object tcapt = PROP (TOOL_BAR_ITEM_CAPTION);
8294 const char *label = SYMBOLP (tkey) ? SSDATA (SYMBOL_NAME (tkey)) : "";
8295 const char *capt = STRINGP (tcapt) ? SSDATA (tcapt) : "";
8296 ptrdiff_t max_lbl =
8297 2 * max (0, min (tool_bar_max_label_size, STRING_BYTES_BOUND / 2));
8298 char *buf = xmalloc (max_lbl + 1);
8299 Lisp_Object new_lbl;
8300 ptrdiff_t caption_len = strlen (capt);
8302 if (caption_len <= max_lbl && capt[0] != '\0')
8304 strcpy (buf, capt);
8305 while (caption_len > 0 && buf[caption_len - 1] == '.')
8306 caption_len--;
8307 buf[caption_len] = '\0';
8308 label = capt = buf;
8311 if (strlen (label) <= max_lbl && label[0] != '\0')
8313 ptrdiff_t j;
8314 if (label != buf)
8315 strcpy (buf, label);
8317 for (j = 0; buf[j] != '\0'; ++j)
8318 if (buf[j] == '-')
8319 buf[j] = ' ';
8320 label = buf;
8322 else
8323 label = "";
8325 new_lbl = Fupcase_initials (build_string (label));
8326 if (SCHARS (new_lbl) <= tool_bar_max_label_size)
8327 set_prop (TOOL_BAR_ITEM_LABEL, new_lbl);
8328 else
8329 set_prop (TOOL_BAR_ITEM_LABEL, empty_unibyte_string);
8330 xfree (buf);
8333 /* If got a filter apply it on binding. */
8334 if (!NILP (filter))
8335 set_prop (TOOL_BAR_ITEM_BINDING,
8336 (menu_item_eval_property
8337 (list2 (filter,
8338 list2 (Qquote,
8339 PROP (TOOL_BAR_ITEM_BINDING))))));
8341 /* See if the binding is a keymap. Give up if it is. */
8342 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
8343 return 0;
8345 /* Enable or disable selection of item. */
8346 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
8347 set_prop (TOOL_BAR_ITEM_ENABLED_P,
8348 menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P)));
8350 /* Handle radio buttons or toggle boxes. */
8351 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
8352 set_prop (TOOL_BAR_ITEM_SELECTED_P,
8353 menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P)));
8355 return 1;
8357 #undef PROP
8361 /* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
8362 that can be reused. */
8364 static void
8365 init_tool_bar_items (Lisp_Object reuse)
8367 if (VECTORP (reuse))
8368 tool_bar_items_vector = reuse;
8369 else
8370 tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
8371 ntool_bar_items = 0;
8375 /* Append parsed tool bar item properties from
8376 tool_bar_item_properties */
8378 static void
8379 append_tool_bar_item (void)
8381 ptrdiff_t incr
8382 = (ntool_bar_items
8383 - (ASIZE (tool_bar_items_vector) - TOOL_BAR_ITEM_NSLOTS));
8385 /* Enlarge tool_bar_items_vector if necessary. */
8386 if (incr > 0)
8387 tool_bar_items_vector = larger_vector (tool_bar_items_vector, incr, -1);
8389 /* Append entries from tool_bar_item_properties to the end of
8390 tool_bar_items_vector. */
8391 vcopy (tool_bar_items_vector, ntool_bar_items,
8392 XVECTOR (tool_bar_item_properties)->contents, TOOL_BAR_ITEM_NSLOTS);
8393 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
8400 /* Read a character using menus based on the keymap MAP.
8401 Return nil if there are no menus in the maps.
8402 Return t if we displayed a menu but the user rejected it.
8404 PREV_EVENT is the previous input event, or nil if we are reading
8405 the first event of a key sequence.
8407 If USED_MOUSE_MENU is non-null, set *USED_MOUSE_MENU to true
8408 if we used a mouse menu to read the input, or false otherwise. If
8409 USED_MOUSE_MENU is null, don't dereference it.
8411 The prompting is done based on the prompt-string of the map
8412 and the strings associated with various map elements.
8414 This can be done with X menus or with menus put in the minibuf.
8415 These are done in different ways, depending on how the input will be read.
8416 Menus using X are done after auto-saving in read-char, getting the input
8417 event from Fx_popup_menu; menus using the minibuf use read_char recursively
8418 and do auto-saving in the inner call of read_char. */
8420 static Lisp_Object
8421 read_char_x_menu_prompt (Lisp_Object map,
8422 Lisp_Object prev_event, bool *used_mouse_menu)
8424 if (used_mouse_menu)
8425 *used_mouse_menu = 0;
8427 /* Use local over global Menu maps. */
8429 if (! menu_prompting)
8430 return Qnil;
8432 /* If we got to this point via a mouse click,
8433 use a real menu for mouse selection. */
8434 if (EVENT_HAS_PARAMETERS (prev_event)
8435 && !EQ (XCAR (prev_event), Qmenu_bar)
8436 && !EQ (XCAR (prev_event), Qtool_bar))
8438 /* Display the menu and get the selection. */
8439 Lisp_Object value;
8441 value = Fx_popup_menu (prev_event, get_keymap (map, 0, 1));
8442 if (CONSP (value))
8444 Lisp_Object tem;
8446 record_menu_key (XCAR (value));
8448 /* If we got multiple events, unread all but
8449 the first.
8450 There is no way to prevent those unread events
8451 from showing up later in last_nonmenu_event.
8452 So turn symbol and integer events into lists,
8453 to indicate that they came from a mouse menu,
8454 so that when present in last_nonmenu_event
8455 they won't confuse things. */
8456 for (tem = XCDR (value); CONSP (tem); tem = XCDR (tem))
8458 record_menu_key (XCAR (tem));
8459 if (SYMBOLP (XCAR (tem))
8460 || INTEGERP (XCAR (tem)))
8461 XSETCAR (tem, Fcons (XCAR (tem), Qdisabled));
8464 /* If we got more than one event, put all but the first
8465 onto this list to be read later.
8466 Return just the first event now. */
8467 Vunread_command_events
8468 = nconc2 (XCDR (value), Vunread_command_events);
8469 value = XCAR (value);
8471 else if (NILP (value))
8472 value = Qt;
8473 if (used_mouse_menu)
8474 *used_mouse_menu = 1;
8475 return value;
8477 return Qnil ;
8480 static Lisp_Object
8481 read_char_minibuf_menu_prompt (int commandflag,
8482 Lisp_Object map)
8484 Lisp_Object name;
8485 ptrdiff_t nlength;
8486 /* FIXME: Use the minibuffer's frame width. */
8487 ptrdiff_t width = FRAME_COLS (SELECTED_FRAME ()) - 4;
8488 ptrdiff_t idx = -1;
8489 bool nobindings = 1;
8490 Lisp_Object rest, vector;
8491 Lisp_Object prompt_strings = Qnil;
8493 vector = Qnil;
8495 if (! menu_prompting)
8496 return Qnil;
8498 map = get_keymap (map, 0, 1);
8499 name = Fkeymap_prompt (map);
8501 /* If we don't have any menus, just read a character normally. */
8502 if (!STRINGP (name))
8503 return Qnil;
8505 #define PUSH_C_STR(str, listvar) \
8506 listvar = Fcons (build_unibyte_string (str), listvar)
8508 /* Prompt string always starts with map's prompt, and a space. */
8509 prompt_strings = Fcons (name, prompt_strings);
8510 PUSH_C_STR (": ", prompt_strings);
8511 nlength = SCHARS (name) + 2;
8513 rest = map;
8515 /* Present the documented bindings, a line at a time. */
8516 while (1)
8518 bool notfirst = 0;
8519 Lisp_Object menu_strings = prompt_strings;
8520 ptrdiff_t i = nlength;
8521 Lisp_Object obj;
8522 Lisp_Object orig_defn_macro;
8524 /* Loop over elements of map. */
8525 while (i < width)
8527 Lisp_Object elt;
8529 /* FIXME: Use map_keymap to handle new keymap formats. */
8531 /* At end of map, wrap around if just starting,
8532 or end this line if already have something on it. */
8533 if (NILP (rest))
8535 if (notfirst || nobindings)
8536 break;
8537 else
8538 rest = map;
8541 /* Look at the next element of the map. */
8542 if (idx >= 0)
8543 elt = AREF (vector, idx);
8544 else
8545 elt = Fcar_safe (rest);
8547 if (idx < 0 && VECTORP (elt))
8549 /* If we found a dense table in the keymap,
8550 advanced past it, but start scanning its contents. */
8551 rest = Fcdr_safe (rest);
8552 vector = elt;
8553 idx = 0;
8555 else
8557 /* An ordinary element. */
8558 Lisp_Object event, tem;
8560 if (idx < 0)
8562 event = Fcar_safe (elt); /* alist */
8563 elt = Fcdr_safe (elt);
8565 else
8567 XSETINT (event, idx); /* vector */
8570 /* Ignore the element if it has no prompt string. */
8571 if (INTEGERP (event) && parse_menu_item (elt, -1))
8573 /* True if the char to type matches the string. */
8574 bool char_matches;
8575 Lisp_Object upcased_event, downcased_event;
8576 Lisp_Object desc = Qnil;
8577 Lisp_Object s
8578 = AREF (item_properties, ITEM_PROPERTY_NAME);
8580 upcased_event = Fupcase (event);
8581 downcased_event = Fdowncase (event);
8582 char_matches = (XINT (upcased_event) == SREF (s, 0)
8583 || XINT (downcased_event) == SREF (s, 0));
8584 if (! char_matches)
8585 desc = Fsingle_key_description (event, Qnil);
8587 #if 0 /* It is redundant to list the equivalent key bindings because
8588 the prefix is what the user has already typed. */
8590 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
8591 if (!NILP (tem))
8592 /* Insert equivalent keybinding. */
8593 s = concat2 (s, tem);
8594 #endif
8596 = AREF (item_properties, ITEM_PROPERTY_TYPE);
8597 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
8599 /* Insert button prefix. */
8600 Lisp_Object selected
8601 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
8602 AUTO_STRING (radio_yes, "(*) ");
8603 AUTO_STRING (radio_no , "( ) ");
8604 AUTO_STRING (check_yes, "[X] ");
8605 AUTO_STRING (check_no , "[ ] ");
8606 if (EQ (tem, QCradio))
8607 tem = NILP (selected) ? radio_yes : radio_no;
8608 else
8609 tem = NILP (selected) ? check_yes : check_no;
8610 s = concat2 (tem, s);
8614 /* If we have room for the prompt string, add it to this line.
8615 If this is the first on the line, always add it. */
8616 if ((SCHARS (s) + i + 2
8617 + (char_matches ? 0 : SCHARS (desc) + 3))
8618 < width
8619 || !notfirst)
8621 ptrdiff_t thiswidth;
8623 /* Punctuate between strings. */
8624 if (notfirst)
8626 PUSH_C_STR (", ", menu_strings);
8627 i += 2;
8629 notfirst = 1;
8630 nobindings = 0;
8632 /* If the char to type doesn't match the string's
8633 first char, explicitly show what char to type. */
8634 if (! char_matches)
8636 /* Add as much of string as fits. */
8637 thiswidth = min (SCHARS (desc), width - i);
8638 menu_strings
8639 = Fcons (Fsubstring (desc, make_number (0),
8640 make_number (thiswidth)),
8641 menu_strings);
8642 i += thiswidth;
8643 PUSH_C_STR (" = ", menu_strings);
8644 i += 3;
8647 /* Add as much of string as fits. */
8648 thiswidth = min (SCHARS (s), width - i);
8649 menu_strings
8650 = Fcons (Fsubstring (s, make_number (0),
8651 make_number (thiswidth)),
8652 menu_strings);
8653 i += thiswidth;
8655 else
8657 /* If this element does not fit, end the line now,
8658 and save the element for the next line. */
8659 PUSH_C_STR ("...", menu_strings);
8660 break;
8664 /* Move past this element. */
8665 if (idx >= 0 && idx + 1 >= ASIZE (vector))
8666 /* Handle reaching end of dense table. */
8667 idx = -1;
8668 if (idx >= 0)
8669 idx++;
8670 else
8671 rest = Fcdr_safe (rest);
8675 /* Prompt with that and read response. */
8676 message3_nolog (apply1 (intern ("concat"), Fnreverse (menu_strings)));
8678 /* Make believe it's not a keyboard macro in case the help char
8679 is pressed. Help characters are not recorded because menu prompting
8680 is not used on replay. */
8681 orig_defn_macro = KVAR (current_kboard, defining_kbd_macro);
8682 kset_defining_kbd_macro (current_kboard, Qnil);
8684 obj = read_char (commandflag, Qnil, Qt, 0, NULL);
8685 while (BUFFERP (obj));
8686 kset_defining_kbd_macro (current_kboard, orig_defn_macro);
8688 if (!INTEGERP (obj) || XINT (obj) == -2)
8689 return obj;
8691 if (! EQ (obj, menu_prompt_more_char)
8692 && (!INTEGERP (menu_prompt_more_char)
8693 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
8695 if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
8696 store_kbd_macro_char (obj);
8697 return obj;
8699 /* Help char - go round again. */
8703 /* Reading key sequences. */
8705 static Lisp_Object
8706 follow_key (Lisp_Object keymap, Lisp_Object key)
8708 return access_keymap (get_keymap (keymap, 0, 1),
8709 key, 1, 0, 1);
8712 static Lisp_Object
8713 active_maps (Lisp_Object first_event)
8715 Lisp_Object position
8716 = CONSP (first_event) ? CAR_SAFE (XCDR (first_event)) : Qnil;
8717 return Fcons (Qkeymap, Fcurrent_active_maps (Qt, position));
8720 /* Structure used to keep track of partial application of key remapping
8721 such as Vfunction_key_map and Vkey_translation_map. */
8722 typedef struct keyremap
8724 /* This is the map originally specified for this use. */
8725 Lisp_Object parent;
8726 /* This is a submap reached by looking up, in PARENT,
8727 the events from START to END. */
8728 Lisp_Object map;
8729 /* Positions [START, END) in the key sequence buffer
8730 are the key that we have scanned so far.
8731 Those events are the ones that we will replace
8732 if PARENT maps them into a key sequence. */
8733 int start, end;
8734 } keyremap;
8736 /* Lookup KEY in MAP.
8737 MAP is a keymap mapping keys to key vectors or functions.
8738 If the mapping is a function and DO_FUNCALL is true,
8739 the function is called with PROMPT as parameter and its return
8740 value is used as the return value of this function (after checking
8741 that it is indeed a vector). */
8743 static Lisp_Object
8744 access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
8745 bool do_funcall)
8747 Lisp_Object next;
8749 next = access_keymap (map, key, 1, 0, 1);
8751 /* Handle a symbol whose function definition is a keymap
8752 or an array. */
8753 if (SYMBOLP (next) && !NILP (Ffboundp (next))
8754 && (ARRAYP (XSYMBOL (next)->function)
8755 || KEYMAPP (XSYMBOL (next)->function)))
8756 next = Fautoload_do_load (XSYMBOL (next)->function, next, Qnil);
8758 /* If the keymap gives a function, not an
8759 array, then call the function with one arg and use
8760 its value instead. */
8761 if (do_funcall && FUNCTIONP (next))
8763 Lisp_Object tem;
8764 tem = next;
8766 next = call1 (next, prompt);
8767 /* If the function returned something invalid,
8768 barf--don't ignore it.
8769 (To ignore it safely, we would need to gcpro a bunch of
8770 other variables.) */
8771 if (! (NILP (next) || VECTORP (next) || STRINGP (next)))
8772 error ("Function %s returns invalid key sequence",
8773 SSDATA (SYMBOL_NAME (tem)));
8775 return next;
8778 /* Do one step of the key remapping used for function-key-map and
8779 key-translation-map:
8780 KEYBUF is the buffer holding the input events.
8781 BUFSIZE is its maximum size.
8782 FKEY is a pointer to the keyremap structure to use.
8783 INPUT is the index of the last element in KEYBUF.
8784 DOIT if true says that the remapping can actually take place.
8785 DIFF is used to return the number of keys added/removed by the remapping.
8786 PARENT is the root of the keymap.
8787 PROMPT is the prompt to use if the remapping happens through a function.
8788 Return true if the remapping actually took place. */
8790 static bool
8791 keyremap_step (Lisp_Object *keybuf, int bufsize, volatile keyremap *fkey,
8792 int input, bool doit, int *diff, Lisp_Object prompt)
8794 Lisp_Object next, key;
8796 key = keybuf[fkey->end++];
8798 if (KEYMAPP (fkey->parent))
8799 next = access_keymap_keyremap (fkey->map, key, prompt, doit);
8800 else
8801 next = Qnil;
8803 /* If keybuf[fkey->start..fkey->end] is bound in the
8804 map and we're in a position to do the key remapping, replace it with
8805 the binding and restart with fkey->start at the end. */
8806 if ((VECTORP (next) || STRINGP (next)) && doit)
8808 int len = XFASTINT (Flength (next));
8809 int i;
8811 *diff = len - (fkey->end - fkey->start);
8813 if (bufsize - input <= *diff)
8814 error ("Key sequence too long");
8816 /* Shift the keys that follow fkey->end. */
8817 if (*diff < 0)
8818 for (i = fkey->end; i < input; i++)
8819 keybuf[i + *diff] = keybuf[i];
8820 else if (*diff > 0)
8821 for (i = input - 1; i >= fkey->end; i--)
8822 keybuf[i + *diff] = keybuf[i];
8823 /* Overwrite the old keys with the new ones. */
8824 for (i = 0; i < len; i++)
8825 keybuf[fkey->start + i]
8826 = Faref (next, make_number (i));
8828 fkey->start = fkey->end += *diff;
8829 fkey->map = fkey->parent;
8831 return 1;
8834 fkey->map = get_keymap (next, 0, 1);
8836 /* If we no longer have a bound suffix, try a new position for
8837 fkey->start. */
8838 if (!CONSP (fkey->map))
8840 fkey->end = ++fkey->start;
8841 fkey->map = fkey->parent;
8843 return 0;
8846 static bool
8847 test_undefined (Lisp_Object binding)
8849 return (NILP (binding)
8850 || EQ (binding, Qundefined)
8851 || (SYMBOLP (binding)
8852 && EQ (Fcommand_remapping (binding, Qnil, Qnil), Qundefined)));
8855 /* Read a sequence of keys that ends with a non prefix character,
8856 storing it in KEYBUF, a buffer of size BUFSIZE.
8857 Prompt with PROMPT.
8858 Return the length of the key sequence stored.
8859 Return -1 if the user rejected a command menu.
8861 Echo starting immediately unless `prompt' is 0.
8863 If PREVENT_REDISPLAY is non-zero, avoid redisplay by calling
8864 read_char with a suitable COMMANDFLAG argument.
8866 Where a key sequence ends depends on the currently active keymaps.
8867 These include any minor mode keymaps active in the current buffer,
8868 the current buffer's local map, and the global map.
8870 If a key sequence has no other bindings, we check Vfunction_key_map
8871 to see if some trailing subsequence might be the beginning of a
8872 function key's sequence. If so, we try to read the whole function
8873 key, and substitute its symbolic name into the key sequence.
8875 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
8876 `double-' events into similar click events, if that would make them
8877 bound. We try to turn `triple-' events first into `double-' events,
8878 then into clicks.
8880 If we get a mouse click in a mode line, vertical divider, or other
8881 non-text area, we treat the click as if it were prefixed by the
8882 symbol denoting that area - `mode-line', `vertical-line', or
8883 whatever.
8885 If the sequence starts with a mouse click, we read the key sequence
8886 with respect to the buffer clicked on, not the current buffer.
8888 If the user switches frames in the midst of a key sequence, we put
8889 off the switch-frame event until later; the next call to
8890 read_char will return it.
8892 If FIX_CURRENT_BUFFER, we restore current_buffer
8893 from the selected window's buffer. */
8895 static int
8896 read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
8897 bool dont_downcase_last, bool can_return_switch_frame,
8898 bool fix_current_buffer, bool prevent_redisplay)
8900 ptrdiff_t count = SPECPDL_INDEX ();
8902 /* How many keys there are in the current key sequence. */
8903 int t;
8905 /* The length of the echo buffer when we started reading, and
8906 the length of this_command_keys when we started reading. */
8907 ptrdiff_t echo_start IF_LINT (= 0);
8908 ptrdiff_t keys_start;
8910 Lisp_Object current_binding = Qnil;
8911 Lisp_Object first_event = Qnil;
8913 /* Index of the first key that has no binding.
8914 It is useless to try fkey.start larger than that. */
8915 int first_unbound;
8917 /* If t < mock_input, then KEYBUF[t] should be read as the next
8918 input key.
8920 We use this to recover after recognizing a function key. Once we
8921 realize that a suffix of the current key sequence is actually a
8922 function key's escape sequence, we replace the suffix with the
8923 function key's binding from Vfunction_key_map. Now keybuf
8924 contains a new and different key sequence, so the echo area,
8925 this_command_keys, and the submaps and defs arrays are wrong. In
8926 this situation, we set mock_input to t, set t to 0, and jump to
8927 restart_sequence; the loop will read keys from keybuf up until
8928 mock_input, thus rebuilding the state; and then it will resume
8929 reading characters from the keyboard. */
8930 int mock_input = 0;
8932 /* If the sequence is unbound in submaps[], then
8933 keybuf[fkey.start..fkey.end-1] is a prefix in Vfunction_key_map,
8934 and fkey.map is its binding.
8936 These might be > t, indicating that all function key scanning
8937 should hold off until t reaches them. We do this when we've just
8938 recognized a function key, to avoid searching for the function
8939 key's again in Vfunction_key_map. */
8940 keyremap fkey;
8942 /* Likewise, for key_translation_map and input-decode-map. */
8943 keyremap keytran, indec;
8945 /* True if we are trying to map a key by changing an upper-case
8946 letter to lower case, or a shifted function key to an unshifted
8947 one. */
8948 bool shift_translated = 0;
8950 /* If we receive a `switch-frame' or `select-window' event in the middle of
8951 a key sequence, we put it off for later.
8952 While we're reading, we keep the event here. */
8953 Lisp_Object delayed_switch_frame;
8955 Lisp_Object original_uppercase IF_LINT (= Qnil);
8956 int original_uppercase_position = -1;
8958 /* Gets around Microsoft compiler limitations. */
8959 bool dummyflag = 0;
8961 struct buffer *starting_buffer;
8963 /* List of events for which a fake prefix key has been generated. */
8964 Lisp_Object fake_prefixed_keys = Qnil;
8966 struct gcpro gcpro1;
8968 GCPRO1 (fake_prefixed_keys);
8969 raw_keybuf_count = 0;
8971 last_nonmenu_event = Qnil;
8973 delayed_switch_frame = Qnil;
8975 if (INTERACTIVE)
8977 if (!NILP (prompt))
8979 /* Install the string PROMPT as the beginning of the string
8980 of echoing, so that it serves as a prompt for the next
8981 character. */
8982 kset_echo_string (current_kboard, prompt);
8983 current_kboard->echo_after_prompt = SCHARS (prompt);
8984 echo_now ();
8986 else if (cursor_in_echo_area
8987 && echo_keystrokes_p ())
8988 /* This doesn't put in a dash if the echo buffer is empty, so
8989 you don't always see a dash hanging out in the minibuffer. */
8990 echo_dash ();
8993 /* Record the initial state of the echo area and this_command_keys;
8994 we will need to restore them if we replay a key sequence. */
8995 if (INTERACTIVE)
8996 echo_start = echo_length ();
8997 keys_start = this_command_key_count;
8998 this_single_command_key_start = keys_start;
9000 /* We jump here when we need to reinitialize fkey and keytran; this
9001 happens if we switch keyboards between rescans. */
9002 replay_entire_sequence:
9004 indec.map = indec.parent = KVAR (current_kboard, Vinput_decode_map);
9005 fkey.map = fkey.parent = KVAR (current_kboard, Vlocal_function_key_map);
9006 keytran.map = keytran.parent = Vkey_translation_map;
9007 indec.start = indec.end = 0;
9008 fkey.start = fkey.end = 0;
9009 keytran.start = keytran.end = 0;
9011 /* We jump here when the key sequence has been thoroughly changed, and
9012 we need to rescan it starting from the beginning. When we jump here,
9013 keybuf[0..mock_input] holds the sequence we should reread. */
9014 replay_sequence:
9016 starting_buffer = current_buffer;
9017 first_unbound = bufsize + 1;
9019 /* Build our list of keymaps.
9020 If we recognize a function key and replace its escape sequence in
9021 keybuf with its symbol, or if the sequence starts with a mouse
9022 click and we need to switch buffers, we jump back here to rebuild
9023 the initial keymaps from the current buffer. */
9024 current_binding = active_maps (first_event);
9026 /* Start from the beginning in keybuf. */
9027 t = 0;
9029 /* These are no-ops the first time through, but if we restart, they
9030 revert the echo area and this_command_keys to their original state. */
9031 this_command_key_count = keys_start;
9032 if (INTERACTIVE && t < mock_input)
9033 echo_truncate (echo_start);
9035 /* If the best binding for the current key sequence is a keymap, or
9036 we may be looking at a function key's escape sequence, keep on
9037 reading. */
9038 while (!NILP (current_binding)
9039 /* Keep reading as long as there's a prefix binding. */
9040 ? KEYMAPP (current_binding)
9041 /* Don't return in the middle of a possible function key sequence,
9042 if the only bindings we found were via case conversion.
9043 Thus, if ESC O a has a function-key-map translation
9044 and ESC o has a binding, don't return after ESC O,
9045 so that we can translate ESC O plus the next character. */
9046 : (/* indec.start < t || fkey.start < t || */ keytran.start < t))
9048 Lisp_Object key;
9049 bool used_mouse_menu = 0;
9051 /* Where the last real key started. If we need to throw away a
9052 key that has expanded into more than one element of keybuf
9053 (say, a mouse click on the mode line which is being treated
9054 as [mode-line (mouse-...)], then we backtrack to this point
9055 of keybuf. */
9056 int last_real_key_start;
9058 /* These variables are analogous to echo_start and keys_start;
9059 while those allow us to restart the entire key sequence,
9060 echo_local_start and keys_local_start allow us to throw away
9061 just one key. */
9062 ptrdiff_t echo_local_start IF_LINT (= 0);
9063 int keys_local_start;
9064 Lisp_Object new_binding;
9066 eassert (indec.end == t || (indec.end > t && indec.end <= mock_input));
9067 eassert (indec.start <= indec.end);
9068 eassert (fkey.start <= fkey.end);
9069 eassert (keytran.start <= keytran.end);
9070 /* key-translation-map is applied *after* function-key-map
9071 which is itself applied *after* input-decode-map. */
9072 eassert (fkey.end <= indec.start);
9073 eassert (keytran.end <= fkey.start);
9075 if (/* first_unbound < indec.start && first_unbound < fkey.start && */
9076 first_unbound < keytran.start)
9077 { /* The prefix upto first_unbound has no binding and has
9078 no translation left to do either, so we know it's unbound.
9079 If we don't stop now, we risk staying here indefinitely
9080 (if the user keeps entering fkey or keytran prefixes
9081 like C-c ESC ESC ESC ESC ...) */
9082 int i;
9083 for (i = first_unbound + 1; i < t; i++)
9084 keybuf[i - first_unbound - 1] = keybuf[i];
9085 mock_input = t - first_unbound - 1;
9086 indec.end = indec.start -= first_unbound + 1;
9087 indec.map = indec.parent;
9088 fkey.end = fkey.start -= first_unbound + 1;
9089 fkey.map = fkey.parent;
9090 keytran.end = keytran.start -= first_unbound + 1;
9091 keytran.map = keytran.parent;
9092 goto replay_sequence;
9095 if (t >= bufsize)
9096 error ("Key sequence too long");
9098 if (INTERACTIVE)
9099 echo_local_start = echo_length ();
9100 keys_local_start = this_command_key_count;
9102 replay_key:
9103 /* These are no-ops, unless we throw away a keystroke below and
9104 jumped back up to replay_key; in that case, these restore the
9105 variables to their original state, allowing us to replay the
9106 loop. */
9107 if (INTERACTIVE && t < mock_input)
9108 echo_truncate (echo_local_start);
9109 this_command_key_count = keys_local_start;
9111 /* By default, assume each event is "real". */
9112 last_real_key_start = t;
9114 /* Does mock_input indicate that we are re-reading a key sequence? */
9115 if (t < mock_input)
9117 key = keybuf[t];
9118 add_command_key (key);
9119 if (echo_keystrokes_p ()
9120 && current_kboard->immediate_echo)
9122 echo_add_key (key);
9123 echo_dash ();
9127 /* If not, we should actually read a character. */
9128 else
9131 KBOARD *interrupted_kboard = current_kboard;
9132 struct frame *interrupted_frame = SELECTED_FRAME ();
9133 /* Calling read_char with COMMANDFLAG = -2 avoids
9134 redisplay in read_char and its subroutines. */
9135 key = read_char (prevent_redisplay ? -2 : NILP (prompt),
9136 current_binding, last_nonmenu_event,
9137 &used_mouse_menu, NULL);
9138 if ((INTEGERP (key) && XINT (key) == -2) /* wrong_kboard_jmpbuf */
9139 /* When switching to a new tty (with a new keyboard),
9140 read_char returns the new buffer, rather than -2
9141 (Bug#5095). This is because `terminal-init-xterm'
9142 calls read-char, which eats the wrong_kboard_jmpbuf
9143 return. Any better way to fix this? -- cyd */
9144 || (interrupted_kboard != current_kboard))
9146 bool found = 0;
9147 struct kboard *k;
9149 for (k = all_kboards; k; k = k->next_kboard)
9150 if (k == interrupted_kboard)
9151 found = 1;
9153 if (!found)
9155 /* Don't touch interrupted_kboard when it's been
9156 deleted. */
9157 delayed_switch_frame = Qnil;
9158 goto replay_entire_sequence;
9161 if (!NILP (delayed_switch_frame))
9163 kset_kbd_queue
9164 (interrupted_kboard,
9165 Fcons (delayed_switch_frame,
9166 KVAR (interrupted_kboard, kbd_queue)));
9167 delayed_switch_frame = Qnil;
9170 while (t > 0)
9171 kset_kbd_queue
9172 (interrupted_kboard,
9173 Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue)));
9175 /* If the side queue is non-empty, ensure it begins with a
9176 switch-frame, so we'll replay it in the right context. */
9177 if (CONSP (KVAR (interrupted_kboard, kbd_queue))
9178 && (key = XCAR (KVAR (interrupted_kboard, kbd_queue)),
9179 !(EVENT_HAS_PARAMETERS (key)
9180 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
9181 Qswitch_frame))))
9183 Lisp_Object frame;
9184 XSETFRAME (frame, interrupted_frame);
9185 kset_kbd_queue
9186 (interrupted_kboard,
9187 Fcons (make_lispy_switch_frame (frame),
9188 KVAR (interrupted_kboard, kbd_queue)));
9190 mock_input = 0;
9191 goto replay_entire_sequence;
9195 /* read_char returns t when it shows a menu and the user rejects it.
9196 Just return -1. */
9197 if (EQ (key, Qt))
9199 unbind_to (count, Qnil);
9200 UNGCPRO;
9201 return -1;
9204 /* read_char returns -1 at the end of a macro.
9205 Emacs 18 handles this by returning immediately with a
9206 zero, so that's what we'll do. */
9207 if (INTEGERP (key) && XINT (key) == -1)
9209 t = 0;
9210 /* The Microsoft C compiler can't handle the goto that
9211 would go here. */
9212 dummyflag = 1;
9213 break;
9216 /* If the current buffer has been changed from under us, the
9217 keymap may have changed, so replay the sequence. */
9218 if (BUFFERP (key))
9220 timer_resume_idle ();
9222 mock_input = t;
9223 /* Reset the current buffer from the selected window
9224 in case something changed the former and not the latter.
9225 This is to be more consistent with the behavior
9226 of the command_loop_1. */
9227 if (fix_current_buffer)
9229 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
9230 Fkill_emacs (Qnil);
9231 if (XBUFFER (XWINDOW (selected_window)->contents)
9232 != current_buffer)
9233 Fset_buffer (XWINDOW (selected_window)->contents);
9236 goto replay_sequence;
9239 /* If we have a quit that was typed in another frame, and
9240 quit_throw_to_read_char switched buffers,
9241 replay to get the right keymap. */
9242 if (INTEGERP (key)
9243 && XINT (key) == quit_char
9244 && current_buffer != starting_buffer)
9246 GROW_RAW_KEYBUF;
9247 ASET (raw_keybuf, raw_keybuf_count, key);
9248 raw_keybuf_count++;
9249 keybuf[t++] = key;
9250 mock_input = t;
9251 Vquit_flag = Qnil;
9252 goto replay_sequence;
9255 Vquit_flag = Qnil;
9257 if (EVENT_HAS_PARAMETERS (key)
9258 /* Either a `switch-frame' or a `select-window' event. */
9259 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
9261 /* If we're at the beginning of a key sequence, and the caller
9262 says it's okay, go ahead and return this event. If we're
9263 in the midst of a key sequence, delay it until the end. */
9264 if (t > 0 || !can_return_switch_frame)
9266 delayed_switch_frame = key;
9267 goto replay_key;
9271 if (NILP (first_event))
9273 first_event = key;
9274 /* Even if first_event does not specify a particular
9275 window/position, it's important to recompute the maps here
9276 since a long time might have passed since we entered
9277 read_key_sequence, and a timer (or process-filter or
9278 special-event-map, ...) might have switched the current buffer
9279 or the selected window from under us in the mean time. */
9280 if (fix_current_buffer
9281 && (XBUFFER (XWINDOW (selected_window)->contents)
9282 != current_buffer))
9283 Fset_buffer (XWINDOW (selected_window)->contents);
9284 current_binding = active_maps (first_event);
9287 GROW_RAW_KEYBUF;
9288 ASET (raw_keybuf, raw_keybuf_count, key);
9289 raw_keybuf_count++;
9292 /* Clicks in non-text areas get prefixed by the symbol
9293 in their CHAR-ADDRESS field. For example, a click on
9294 the mode line is prefixed by the symbol `mode-line'.
9296 Furthermore, key sequences beginning with mouse clicks
9297 are read using the keymaps of the buffer clicked on, not
9298 the current buffer. So we may have to switch the buffer
9299 here.
9301 When we turn one event into two events, we must make sure
9302 that neither of the two looks like the original--so that,
9303 if we replay the events, they won't be expanded again.
9304 If not for this, such reexpansion could happen either here
9305 or when user programs play with this-command-keys. */
9306 if (EVENT_HAS_PARAMETERS (key))
9308 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
9309 if (EQ (kind, Qmouse_click))
9311 Lisp_Object window = POSN_WINDOW (EVENT_START (key));
9312 Lisp_Object posn = POSN_POSN (EVENT_START (key));
9314 if (CONSP (posn)
9315 || (!NILP (fake_prefixed_keys)
9316 && !NILP (Fmemq (key, fake_prefixed_keys))))
9318 /* We're looking a second time at an event for which
9319 we generated a fake prefix key. Set
9320 last_real_key_start appropriately. */
9321 if (t > 0)
9322 last_real_key_start = t - 1;
9325 if (last_real_key_start == 0)
9327 /* Key sequences beginning with mouse clicks are
9328 read using the keymaps in the buffer clicked on,
9329 not the current buffer. If we're at the
9330 beginning of a key sequence, switch buffers. */
9331 if (WINDOWP (window)
9332 && BUFFERP (XWINDOW (window)->contents)
9333 && XBUFFER (XWINDOW (window)->contents) != current_buffer)
9335 ASET (raw_keybuf, raw_keybuf_count, key);
9336 raw_keybuf_count++;
9337 keybuf[t] = key;
9338 mock_input = t + 1;
9340 /* Arrange to go back to the original buffer once we're
9341 done reading the key sequence. Note that we can't
9342 use save_excursion_{save,restore} here, because they
9343 save point as well as the current buffer; we don't
9344 want to save point, because redisplay may change it,
9345 to accommodate a Fset_window_start or something. We
9346 don't want to do this at the top of the function,
9347 because we may get input from a subprocess which
9348 wants to change the selected window and stuff (say,
9349 emacsclient). */
9350 record_unwind_current_buffer ();
9352 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
9353 Fkill_emacs (Qnil);
9354 set_buffer_internal (XBUFFER (XWINDOW (window)->contents));
9355 goto replay_sequence;
9359 /* Expand mode-line and scroll-bar events into two events:
9360 use posn as a fake prefix key. */
9361 if (SYMBOLP (posn)
9362 && (NILP (fake_prefixed_keys)
9363 || NILP (Fmemq (key, fake_prefixed_keys))))
9365 if (bufsize - t <= 1)
9366 error ("Key sequence too long");
9368 keybuf[t] = posn;
9369 keybuf[t + 1] = key;
9370 mock_input = t + 2;
9372 /* Record that a fake prefix key has been generated
9373 for KEY. Don't modify the event; this would
9374 prevent proper action when the event is pushed
9375 back into unread-command-events. */
9376 fake_prefixed_keys = Fcons (key, fake_prefixed_keys);
9377 goto replay_key;
9380 else if (CONSP (XCDR (key))
9381 && CONSP (EVENT_START (key))
9382 && CONSP (XCDR (EVENT_START (key))))
9384 Lisp_Object posn;
9386 posn = POSN_POSN (EVENT_START (key));
9387 /* Handle menu-bar events:
9388 insert the dummy prefix event `menu-bar'. */
9389 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
9391 if (bufsize - t <= 1)
9392 error ("Key sequence too long");
9393 keybuf[t] = posn;
9394 keybuf[t + 1] = key;
9396 /* Zap the position in key, so we know that we've
9397 expanded it, and don't try to do so again. */
9398 POSN_SET_POSN (EVENT_START (key), list1 (posn));
9400 mock_input = t + 2;
9401 goto replay_sequence;
9403 else if (CONSP (posn))
9405 /* We're looking at the second event of a
9406 sequence which we expanded before. Set
9407 last_real_key_start appropriately. */
9408 if (last_real_key_start == t && t > 0)
9409 last_real_key_start = t - 1;
9414 /* We have finally decided that KEY is something we might want
9415 to look up. */
9416 new_binding = follow_key (current_binding, key);
9418 /* If KEY wasn't bound, we'll try some fallbacks. */
9419 if (!NILP (new_binding))
9420 /* This is needed for the following scenario:
9421 event 0: a down-event that gets dropped by calling replay_key.
9422 event 1: some normal prefix like C-h.
9423 After event 0, first_unbound is 0, after event 1 indec.start,
9424 fkey.start, and keytran.start are all 1, so when we see that
9425 C-h is bound, we need to update first_unbound. */
9426 first_unbound = max (t + 1, first_unbound);
9427 else
9429 Lisp_Object head;
9431 /* Remember the position to put an upper bound on indec.start. */
9432 first_unbound = min (t, first_unbound);
9434 head = EVENT_HEAD (key);
9436 if (SYMBOLP (head))
9438 Lisp_Object breakdown;
9439 int modifiers;
9441 breakdown = parse_modifiers (head);
9442 modifiers = XINT (XCAR (XCDR (breakdown)));
9443 /* Attempt to reduce an unbound mouse event to a simpler
9444 event that is bound:
9445 Drags reduce to clicks.
9446 Double-clicks reduce to clicks.
9447 Triple-clicks reduce to double-clicks, then to clicks.
9448 Down-clicks are eliminated.
9449 Double-downs reduce to downs, then are eliminated.
9450 Triple-downs reduce to double-downs, then to downs,
9451 then are eliminated. */
9452 if (modifiers & (down_modifier | drag_modifier
9453 | double_modifier | triple_modifier))
9455 while (modifiers & (down_modifier | drag_modifier
9456 | double_modifier | triple_modifier))
9458 Lisp_Object new_head, new_click;
9459 if (modifiers & triple_modifier)
9460 modifiers ^= (double_modifier | triple_modifier);
9461 else if (modifiers & double_modifier)
9462 modifiers &= ~double_modifier;
9463 else if (modifiers & drag_modifier)
9464 modifiers &= ~drag_modifier;
9465 else
9467 /* Dispose of this `down' event by simply jumping
9468 back to replay_key, to get another event.
9470 Note that if this event came from mock input,
9471 then just jumping back to replay_key will just
9472 hand it to us again. So we have to wipe out any
9473 mock input.
9475 We could delete keybuf[t] and shift everything
9476 after that to the left by one spot, but we'd also
9477 have to fix up any variable that points into
9478 keybuf, and shifting isn't really necessary
9479 anyway.
9481 Adding prefixes for non-textual mouse clicks
9482 creates two characters of mock input, and both
9483 must be thrown away. If we're only looking at
9484 the prefix now, we can just jump back to
9485 replay_key. On the other hand, if we've already
9486 processed the prefix, and now the actual click
9487 itself is giving us trouble, then we've lost the
9488 state of the keymaps we want to backtrack to, and
9489 we need to replay the whole sequence to rebuild
9492 Beyond that, only function key expansion could
9493 create more than two keys, but that should never
9494 generate mouse events, so it's okay to zero
9495 mock_input in that case too.
9497 FIXME: The above paragraph seems just plain
9498 wrong, if you consider things like
9499 xterm-mouse-mode. -stef
9501 Isn't this just the most wonderful code ever? */
9503 /* If mock_input > t + 1, the above simplification
9504 will actually end up dropping keys on the floor.
9505 This is probably OK for now, but even
9506 if mock_input <= t + 1, we need to adjust indec,
9507 fkey, and keytran.
9508 Typical case [header-line down-mouse-N]:
9509 mock_input = 2, t = 1, fkey.end = 1,
9510 last_real_key_start = 0. */
9511 if (indec.end > last_real_key_start)
9513 indec.end = indec.start
9514 = min (last_real_key_start, indec.start);
9515 indec.map = indec.parent;
9516 if (fkey.end > last_real_key_start)
9518 fkey.end = fkey.start
9519 = min (last_real_key_start, fkey.start);
9520 fkey.map = fkey.parent;
9521 if (keytran.end > last_real_key_start)
9523 keytran.end = keytran.start
9524 = min (last_real_key_start, keytran.start);
9525 keytran.map = keytran.parent;
9529 if (t == last_real_key_start)
9531 mock_input = 0;
9532 goto replay_key;
9534 else
9536 mock_input = last_real_key_start;
9537 goto replay_sequence;
9541 new_head
9542 = apply_modifiers (modifiers, XCAR (breakdown));
9543 new_click = list2 (new_head, EVENT_START (key));
9545 /* Look for a binding for this new key. */
9546 new_binding = follow_key (current_binding, new_click);
9548 /* If that click is bound, go for it. */
9549 if (!NILP (new_binding))
9551 current_binding = new_binding;
9552 key = new_click;
9553 break;
9555 /* Otherwise, we'll leave key set to the drag event. */
9560 current_binding = new_binding;
9562 keybuf[t++] = key;
9563 /* Normally, last_nonmenu_event gets the previous key we read.
9564 But when a mouse popup menu is being used,
9565 we don't update last_nonmenu_event; it continues to hold the mouse
9566 event that preceded the first level of menu. */
9567 if (!used_mouse_menu)
9568 last_nonmenu_event = key;
9570 /* Record what part of this_command_keys is the current key sequence. */
9571 this_single_command_key_start = this_command_key_count - t;
9573 /* Look for this sequence in input-decode-map.
9574 Scan from indec.end until we find a bound suffix. */
9575 while (indec.end < t)
9577 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9578 bool done;
9579 int diff;
9581 GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
9582 done = keyremap_step (keybuf, bufsize, &indec, max (t, mock_input),
9583 1, &diff, prompt);
9584 UNGCPRO;
9585 if (done)
9587 mock_input = diff + max (t, mock_input);
9588 goto replay_sequence;
9592 if (!KEYMAPP (current_binding)
9593 && !test_undefined (current_binding)
9594 && indec.start >= t)
9595 /* There is a binding and it's not a prefix.
9596 (and it doesn't have any input-decode-map translation pending).
9597 There is thus no function-key in this sequence.
9598 Moving fkey.start is important in this case to allow keytran.start
9599 to go over the sequence before we return (since we keep the
9600 invariant that keytran.end <= fkey.start). */
9602 if (fkey.start < t)
9603 (fkey.start = fkey.end = t, fkey.map = fkey.parent);
9605 else
9606 /* If the sequence is unbound, see if we can hang a function key
9607 off the end of it. */
9608 /* Continue scan from fkey.end until we find a bound suffix. */
9609 while (fkey.end < indec.start)
9611 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9612 bool done;
9613 int diff;
9615 GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
9616 done = keyremap_step (keybuf, bufsize, &fkey,
9617 max (t, mock_input),
9618 /* If there's a binding (i.e.
9619 first_binding >= nmaps) we don't want
9620 to apply this function-key-mapping. */
9621 fkey.end + 1 == t
9622 && (test_undefined (current_binding)),
9623 &diff, prompt);
9624 UNGCPRO;
9625 if (done)
9627 mock_input = diff + max (t, mock_input);
9628 /* Adjust the input-decode-map counters. */
9629 indec.end += diff;
9630 indec.start += diff;
9632 goto replay_sequence;
9636 /* Look for this sequence in key-translation-map.
9637 Scan from keytran.end until we find a bound suffix. */
9638 while (keytran.end < fkey.start)
9640 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9641 bool done;
9642 int diff;
9644 GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
9645 done = keyremap_step (keybuf, bufsize, &keytran, max (t, mock_input),
9646 1, &diff, prompt);
9647 UNGCPRO;
9648 if (done)
9650 mock_input = diff + max (t, mock_input);
9651 /* Adjust the function-key-map and input-decode-map counters. */
9652 indec.end += diff;
9653 indec.start += diff;
9654 fkey.end += diff;
9655 fkey.start += diff;
9657 goto replay_sequence;
9661 /* If KEY is not defined in any of the keymaps,
9662 and cannot be part of a function key or translation,
9663 and is an upper case letter
9664 use the corresponding lower-case letter instead. */
9665 if (NILP (current_binding)
9666 && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t
9667 && INTEGERP (key)
9668 && ((CHARACTERP (make_number (XINT (key) & ~CHAR_MODIFIER_MASK))
9669 && uppercasep (XINT (key) & ~CHAR_MODIFIER_MASK))
9670 || (XINT (key) & shift_modifier)))
9672 Lisp_Object new_key;
9674 original_uppercase = key;
9675 original_uppercase_position = t - 1;
9677 if (XINT (key) & shift_modifier)
9678 XSETINT (new_key, XINT (key) & ~shift_modifier);
9679 else
9680 XSETINT (new_key, (downcase (XINT (key) & ~CHAR_MODIFIER_MASK)
9681 | (XINT (key) & CHAR_MODIFIER_MASK)));
9683 /* We have to do this unconditionally, regardless of whether
9684 the lower-case char is defined in the keymaps, because they
9685 might get translated through function-key-map. */
9686 keybuf[t - 1] = new_key;
9687 mock_input = max (t, mock_input);
9688 shift_translated = 1;
9690 goto replay_sequence;
9693 if (NILP (current_binding)
9694 && help_char_p (EVENT_HEAD (key)) && t > 1)
9696 read_key_sequence_cmd = Vprefix_help_command;
9697 /* The Microsoft C compiler can't handle the goto that
9698 would go here. */
9699 dummyflag = 1;
9700 break;
9703 /* If KEY is not defined in any of the keymaps,
9704 and cannot be part of a function key or translation,
9705 and is a shifted function key,
9706 use the corresponding unshifted function key instead. */
9707 if (NILP (current_binding)
9708 && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t)
9710 Lisp_Object breakdown = parse_modifiers (key);
9711 int modifiers
9712 = CONSP (breakdown) ? (XINT (XCAR (XCDR (breakdown)))) : 0;
9714 if (modifiers & shift_modifier
9715 /* Treat uppercase keys as shifted. */
9716 || (INTEGERP (key)
9717 && (KEY_TO_CHAR (key)
9718 < XCHAR_TABLE (BVAR (current_buffer, downcase_table))->header.size)
9719 && uppercasep (KEY_TO_CHAR (key))))
9721 Lisp_Object new_key
9722 = (modifiers & shift_modifier
9723 ? apply_modifiers (modifiers & ~shift_modifier,
9724 XCAR (breakdown))
9725 : make_number (downcase (KEY_TO_CHAR (key)) | modifiers));
9727 original_uppercase = key;
9728 original_uppercase_position = t - 1;
9730 /* We have to do this unconditionally, regardless of whether
9731 the lower-case char is defined in the keymaps, because they
9732 might get translated through function-key-map. */
9733 keybuf[t - 1] = new_key;
9734 mock_input = max (t, mock_input);
9735 /* Reset fkey (and consequently keytran) to apply
9736 function-key-map on the result, so that S-backspace is
9737 correctly mapped to DEL (via backspace). OTOH,
9738 input-decode-map doesn't need to go through it again. */
9739 fkey.start = fkey.end = 0;
9740 keytran.start = keytran.end = 0;
9741 shift_translated = 1;
9743 goto replay_sequence;
9747 if (!dummyflag)
9748 read_key_sequence_cmd = current_binding;
9749 read_key_sequence_remapped
9750 /* Remap command through active keymaps.
9751 Do the remapping here, before the unbind_to so it uses the keymaps
9752 of the appropriate buffer. */
9753 = SYMBOLP (read_key_sequence_cmd)
9754 ? Fcommand_remapping (read_key_sequence_cmd, Qnil, Qnil)
9755 : Qnil;
9757 unread_switch_frame = delayed_switch_frame;
9758 unbind_to (count, Qnil);
9760 /* Don't downcase the last character if the caller says don't.
9761 Don't downcase it if the result is undefined, either. */
9762 if ((dont_downcase_last || NILP (current_binding))
9763 && t > 0
9764 && t - 1 == original_uppercase_position)
9766 keybuf[t - 1] = original_uppercase;
9767 shift_translated = 0;
9770 if (shift_translated)
9771 Vthis_command_keys_shift_translated = Qt;
9773 /* Occasionally we fabricate events, perhaps by expanding something
9774 according to function-key-map, or by adding a prefix symbol to a
9775 mouse click in the scroll bar or modeline. In this cases, return
9776 the entire generated key sequence, even if we hit an unbound
9777 prefix or a definition before the end. This means that you will
9778 be able to push back the event properly, and also means that
9779 read-key-sequence will always return a logical unit.
9781 Better ideas? */
9782 for (; t < mock_input; t++)
9784 if (echo_keystrokes_p ())
9785 echo_char (keybuf[t]);
9786 add_command_key (keybuf[t]);
9789 UNGCPRO;
9790 return t;
9793 static Lisp_Object
9794 read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
9795 Lisp_Object dont_downcase_last,
9796 Lisp_Object can_return_switch_frame,
9797 Lisp_Object cmd_loop, bool allow_string)
9799 Lisp_Object keybuf[30];
9800 register int i;
9801 struct gcpro gcpro1;
9802 ptrdiff_t count = SPECPDL_INDEX ();
9804 if (!NILP (prompt))
9805 CHECK_STRING (prompt);
9806 QUIT;
9808 specbind (Qinput_method_exit_on_first_char,
9809 (NILP (cmd_loop) ? Qt : Qnil));
9810 specbind (Qinput_method_use_echo_area,
9811 (NILP (cmd_loop) ? Qt : Qnil));
9813 memset (keybuf, 0, sizeof keybuf);
9814 GCPRO1 (keybuf[0]);
9815 gcpro1.nvars = ARRAYELTS (keybuf);
9817 if (NILP (continue_echo))
9819 this_command_key_count = 0;
9820 this_command_key_count_reset = 0;
9821 this_single_command_key_start = 0;
9824 #ifdef HAVE_WINDOW_SYSTEM
9825 if (display_hourglass_p)
9826 cancel_hourglass ();
9827 #endif
9829 i = read_key_sequence (keybuf, ARRAYELTS (keybuf),
9830 prompt, ! NILP (dont_downcase_last),
9831 ! NILP (can_return_switch_frame), 0, 0);
9833 #if 0 /* The following is fine for code reading a key sequence and
9834 then proceeding with a lengthy computation, but it's not good
9835 for code reading keys in a loop, like an input method. */
9836 #ifdef HAVE_WINDOW_SYSTEM
9837 if (display_hourglass_p)
9838 start_hourglass ();
9839 #endif
9840 #endif
9842 if (i == -1)
9844 Vquit_flag = Qt;
9845 QUIT;
9847 UNGCPRO;
9848 return unbind_to (count,
9849 ((allow_string ? make_event_array : Fvector)
9850 (i, keybuf)));
9853 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
9854 doc: /* Read a sequence of keystrokes and return as a string or vector.
9855 The sequence is sufficient to specify a non-prefix command in the
9856 current local and global maps.
9858 First arg PROMPT is a prompt string. If nil, do not prompt specially.
9859 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos
9860 as a continuation of the previous key.
9862 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
9863 convert the last event to lower case. (Normally any upper case event
9864 is converted to lower case if the original event is undefined and the lower
9865 case equivalent is defined.) A non-nil value is appropriate for reading
9866 a key sequence to be defined.
9868 A C-g typed while in this function is treated like any other character,
9869 and `quit-flag' is not set.
9871 If the key sequence starts with a mouse click, then the sequence is read
9872 using the keymaps of the buffer of the window clicked in, not the buffer
9873 of the selected window as normal.
9875 `read-key-sequence' drops unbound button-down events, since you normally
9876 only care about the click or drag events which follow them. If a drag
9877 or multi-click event is unbound, but the corresponding click event would
9878 be bound, `read-key-sequence' turns the event into a click event at the
9879 drag's starting position. This means that you don't have to distinguish
9880 between click and drag, double, or triple events unless you want to.
9882 `read-key-sequence' prefixes mouse events on mode lines, the vertical
9883 lines separating windows, and scroll bars with imaginary keys
9884 `mode-line', `vertical-line', and `vertical-scroll-bar'.
9886 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this
9887 function will process a switch-frame event if the user switches frames
9888 before typing anything. If the user switches frames in the middle of a
9889 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME
9890 is nil, then the event will be put off until after the current key sequence.
9892 `read-key-sequence' checks `function-key-map' for function key
9893 sequences, where they wouldn't conflict with ordinary bindings. See
9894 `function-key-map' for more details.
9896 The optional fifth argument CMD-LOOP, if non-nil, means
9897 that this key sequence is being read by something that will
9898 read commands one after another. It should be nil if the caller
9899 will read just one key sequence. */)
9900 (Lisp_Object prompt, Lisp_Object continue_echo, Lisp_Object dont_downcase_last, Lisp_Object can_return_switch_frame, Lisp_Object cmd_loop)
9902 return read_key_sequence_vs (prompt, continue_echo, dont_downcase_last,
9903 can_return_switch_frame, cmd_loop, true);
9906 DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
9907 Sread_key_sequence_vector, 1, 5, 0,
9908 doc: /* Like `read-key-sequence' but always return a vector. */)
9909 (Lisp_Object prompt, Lisp_Object continue_echo, Lisp_Object dont_downcase_last, Lisp_Object can_return_switch_frame, Lisp_Object cmd_loop)
9911 return read_key_sequence_vs (prompt, continue_echo, dont_downcase_last,
9912 can_return_switch_frame, cmd_loop, false);
9915 /* Return true if input events are pending. */
9917 bool
9918 detect_input_pending (void)
9920 return input_pending || get_input_pending (0);
9923 /* Return true if input events other than mouse movements are
9924 pending. */
9926 bool
9927 detect_input_pending_ignore_squeezables (void)
9929 return input_pending || get_input_pending (READABLE_EVENTS_IGNORE_SQUEEZABLES);
9932 /* Return true if input events are pending, and run any pending timers. */
9934 bool
9935 detect_input_pending_run_timers (bool do_display)
9937 unsigned old_timers_run = timers_run;
9939 if (!input_pending)
9940 get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
9942 if (old_timers_run != timers_run && do_display)
9943 redisplay_preserve_echo_area (8);
9945 return input_pending;
9948 /* This is called in some cases before a possible quit.
9949 It cases the next call to detect_input_pending to recompute input_pending.
9950 So calling this function unnecessarily can't do any harm. */
9952 void
9953 clear_input_pending (void)
9955 input_pending = 0;
9958 /* Return true if there are pending requeued events.
9959 This isn't used yet. The hope is to make wait_reading_process_output
9960 call it, and return if it runs Lisp code that unreads something.
9961 The problem is, kbd_buffer_get_event needs to be fixed to know what
9962 to do in that case. It isn't trivial. */
9964 bool
9965 requeued_events_pending_p (void)
9967 return (!NILP (Vunread_command_events));
9970 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 1, 0,
9971 doc: /* Return t if command input is currently available with no wait.
9972 Actually, the value is nil only if we can be sure that no input is available;
9973 if there is a doubt, the value is t.
9975 If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */)
9976 (Lisp_Object check_timers)
9978 if (!NILP (Vunread_command_events)
9979 || !NILP (Vunread_post_input_method_events)
9980 || !NILP (Vunread_input_method_events))
9981 return (Qt);
9983 /* Process non-user-visible events (Bug#10195). */
9984 process_special_events ();
9986 return (get_input_pending ((NILP (check_timers)
9987 ? 0 : READABLE_EVENTS_DO_TIMERS_NOW)
9988 | READABLE_EVENTS_FILTER_EVENTS)
9989 ? Qt : Qnil);
9992 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 1, 0,
9993 doc: /* Return vector of last few events, not counting those from keyboard macros.
9994 If INCLUDE-CMDS is non-nil, include the commands that were run,
9995 represented as events of the form (nil . COMMAND). */)
9996 (Lisp_Object include_cmds)
9998 bool cmds = !NILP (include_cmds);
10000 if (!total_keys
10001 || (cmds && total_keys < NUM_RECENT_KEYS))
10002 return Fvector (total_keys,
10003 XVECTOR (recent_keys)->contents);
10004 else
10006 Lisp_Object es = Qnil;
10007 int i = (total_keys < NUM_RECENT_KEYS
10008 ? 0 : recent_keys_index);
10009 eassert (recent_keys_index < NUM_RECENT_KEYS);
10012 Lisp_Object e = AREF (recent_keys, i);
10013 if (cmds || !CONSP (e) || !NILP (XCAR (e)))
10014 es = Fcons (e, es);
10015 if (++i >= NUM_RECENT_KEYS)
10016 i = 0;
10017 } while (i != recent_keys_index);
10018 es = Fnreverse (es);
10019 return Fvconcat (1, &es);
10023 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
10024 doc: /* Return the key sequence that invoked this command.
10025 However, if the command has called `read-key-sequence', it returns
10026 the last key sequence that has been read.
10027 The value is a string or a vector.
10029 See also `this-command-keys-vector'. */)
10030 (void)
10032 return make_event_array (this_command_key_count,
10033 XVECTOR (this_command_keys)->contents);
10036 DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
10037 doc: /* Return the key sequence that invoked this command, as a vector.
10038 However, if the command has called `read-key-sequence', it returns
10039 the last key sequence that has been read.
10041 See also `this-command-keys'. */)
10042 (void)
10044 return Fvector (this_command_key_count,
10045 XVECTOR (this_command_keys)->contents);
10048 DEFUN ("this-single-command-keys", Fthis_single_command_keys,
10049 Sthis_single_command_keys, 0, 0, 0,
10050 doc: /* Return the key sequence that invoked this command.
10051 More generally, it returns the last key sequence read, either by
10052 the command loop or by `read-key-sequence'.
10053 Unlike `this-command-keys', this function's value
10054 does not include prefix arguments.
10055 The value is always a vector. */)
10056 (void)
10058 return Fvector (this_command_key_count
10059 - this_single_command_key_start,
10060 (XVECTOR (this_command_keys)->contents
10061 + this_single_command_key_start));
10064 DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
10065 Sthis_single_command_raw_keys, 0, 0, 0,
10066 doc: /* Return the raw events that were read for this command.
10067 More generally, it returns the last key sequence read, either by
10068 the command loop or by `read-key-sequence'.
10069 Unlike `this-single-command-keys', this function's value
10070 shows the events before all translations (except for input methods).
10071 The value is always a vector. */)
10072 (void)
10074 return Fvector (raw_keybuf_count, XVECTOR (raw_keybuf)->contents);
10077 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
10078 Sreset_this_command_lengths, 0, 0, 0,
10079 doc: /* Make the unread events replace the last command and echo.
10080 Used in `universal-argument-other-key'.
10082 `universal-argument-other-key' rereads the event just typed.
10083 It then gets translated through `function-key-map'.
10084 The translated event has to replace the real events,
10085 both in the value of (this-command-keys) and in echoing.
10086 To achieve this, `universal-argument-other-key' calls
10087 `reset-this-command-lengths', which discards the record of reading
10088 these events the first time. */)
10089 (void)
10091 this_command_key_count = before_command_key_count;
10092 if (this_command_key_count < this_single_command_key_start)
10093 this_single_command_key_start = this_command_key_count;
10095 echo_truncate (before_command_echo_length);
10097 /* Cause whatever we put into unread-command-events
10098 to echo as if it were being freshly read from the keyboard. */
10099 this_command_key_count_reset = 1;
10101 return Qnil;
10104 DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
10105 Sclear_this_command_keys, 0, 1, 0,
10106 doc: /* Clear out the vector that `this-command-keys' returns.
10107 Also clear the record of the last 100 events, unless optional arg
10108 KEEP-RECORD is non-nil. */)
10109 (Lisp_Object keep_record)
10111 int i;
10113 this_command_key_count = 0;
10114 this_command_key_count_reset = 0;
10116 if (NILP (keep_record))
10118 for (i = 0; i < ASIZE (recent_keys); ++i)
10119 ASET (recent_keys, i, Qnil);
10120 total_keys = 0;
10121 recent_keys_index = 0;
10123 return Qnil;
10126 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
10127 doc: /* Return the current depth in recursive edits. */)
10128 (void)
10130 Lisp_Object temp;
10131 /* Wrap around reliably on integer overflow. */
10132 EMACS_INT sum = (command_loop_level & INTMASK) + (minibuf_level & INTMASK);
10133 XSETINT (temp, sum);
10134 return temp;
10137 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
10138 "FOpen dribble file: ",
10139 doc: /* Start writing all keyboard characters to a dribble file called FILE.
10140 If FILE is nil, close any open dribble file.
10141 The file will be closed when Emacs exits.
10143 Be aware that this records ALL characters you type!
10144 This may include sensitive information such as passwords. */)
10145 (Lisp_Object file)
10147 if (dribble)
10149 block_input ();
10150 fclose (dribble);
10151 unblock_input ();
10152 dribble = 0;
10154 if (!NILP (file))
10156 int fd;
10157 Lisp_Object encfile;
10159 file = Fexpand_file_name (file, Qnil);
10160 encfile = ENCODE_FILE (file);
10161 fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
10162 if (fd < 0 && errno == EEXIST && unlink (SSDATA (encfile)) == 0)
10163 fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
10164 dribble = fd < 0 ? 0 : fdopen (fd, "w");
10165 if (dribble == 0)
10166 report_file_error ("Opening dribble", file);
10168 return Qnil;
10171 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
10172 doc: /* Discard the contents of the terminal input buffer.
10173 Also end any kbd macro being defined. */)
10174 (void)
10176 if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
10178 /* Discard the last command from the macro. */
10179 Fcancel_kbd_macro_events ();
10180 end_kbd_macro ();
10183 Vunread_command_events = Qnil;
10185 discard_tty_input ();
10187 kbd_fetch_ptr = kbd_store_ptr;
10188 input_pending = 0;
10190 return Qnil;
10193 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
10194 doc: /* Stop Emacs and return to superior process. You can resume later.
10195 If `cannot-suspend' is non-nil, or if the system doesn't support job
10196 control, run a subshell instead.
10198 If optional arg STUFFSTRING is non-nil, its characters are stuffed
10199 to be read as terminal input by Emacs's parent, after suspension.
10201 Before suspending, run the normal hook `suspend-hook'.
10202 After resumption run the normal hook `suspend-resume-hook'.
10204 Some operating systems cannot stop the Emacs process and resume it later.
10205 On such systems, Emacs starts a subshell instead of suspending. */)
10206 (Lisp_Object stuffstring)
10208 ptrdiff_t count = SPECPDL_INDEX ();
10209 int old_height, old_width;
10210 int width, height;
10211 struct gcpro gcpro1;
10213 if (tty_list && tty_list->next)
10214 error ("There are other tty frames open; close them before suspending Emacs");
10216 if (!NILP (stuffstring))
10217 CHECK_STRING (stuffstring);
10219 run_hook (intern ("suspend-hook"));
10221 GCPRO1 (stuffstring);
10222 get_tty_size (fileno (CURTTY ()->input), &old_width, &old_height);
10223 reset_all_sys_modes ();
10224 /* sys_suspend can get an error if it tries to fork a subshell
10225 and the system resources aren't available for that. */
10226 record_unwind_protect_void (init_all_sys_modes);
10227 stuff_buffered_input (stuffstring);
10228 if (cannot_suspend)
10229 sys_subshell ();
10230 else
10231 sys_suspend ();
10232 unbind_to (count, Qnil);
10234 /* Check if terminal/window size has changed.
10235 Note that this is not useful when we are running directly
10236 with a window system; but suspend should be disabled in that case. */
10237 get_tty_size (fileno (CURTTY ()->input), &width, &height);
10238 if (width != old_width || height != old_height)
10239 change_frame_size (SELECTED_FRAME (), width,
10240 height - FRAME_MENU_BAR_LINES (SELECTED_FRAME ()),
10241 0, 0, 0, 0);
10243 run_hook (intern ("suspend-resume-hook"));
10245 UNGCPRO;
10246 return Qnil;
10249 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
10250 Then in any case stuff anything Emacs has read ahead and not used. */
10252 void
10253 stuff_buffered_input (Lisp_Object stuffstring)
10255 #ifdef SIGTSTP /* stuff_char is defined if SIGTSTP. */
10256 register unsigned char *p;
10258 if (STRINGP (stuffstring))
10260 register ptrdiff_t count;
10262 p = SDATA (stuffstring);
10263 count = SBYTES (stuffstring);
10264 while (count-- > 0)
10265 stuff_char (*p++);
10266 stuff_char ('\n');
10269 /* Anything we have read ahead, put back for the shell to read. */
10270 /* ?? What should this do when we have multiple keyboards??
10271 Should we ignore anything that was typed in at the "wrong" kboard?
10273 rms: we should stuff everything back into the kboard
10274 it came from. */
10275 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
10278 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
10279 kbd_fetch_ptr = kbd_buffer;
10280 if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT)
10281 stuff_char (kbd_fetch_ptr->code);
10283 clear_event (kbd_fetch_ptr);
10286 input_pending = 0;
10287 #endif /* SIGTSTP */
10290 void
10291 set_waiting_for_input (struct timespec *time_to_clear)
10293 input_available_clear_time = time_to_clear;
10295 /* Tell handle_interrupt to throw back to read_char, */
10296 waiting_for_input = 1;
10298 /* If handle_interrupt was called before and buffered a C-g,
10299 make it run again now, to avoid timing error. */
10300 if (!NILP (Vquit_flag))
10301 quit_throw_to_read_char (0);
10304 void
10305 clear_waiting_for_input (void)
10307 /* Tell handle_interrupt not to throw back to read_char, */
10308 waiting_for_input = 0;
10309 input_available_clear_time = 0;
10312 /* The SIGINT handler.
10314 If we have a frame on the controlling tty, we assume that the
10315 SIGINT was generated by C-g, so we call handle_interrupt.
10316 Otherwise, tell QUIT to kill Emacs. */
10318 static void
10319 handle_interrupt_signal (int sig)
10321 /* See if we have an active terminal on our controlling tty. */
10322 struct terminal *terminal = get_named_terminal ("/dev/tty");
10323 if (!terminal)
10325 /* If there are no frames there, let's pretend that we are a
10326 well-behaving UN*X program and quit. We must not call Lisp
10327 in a signal handler, so tell QUIT to exit when it is
10328 safe. */
10329 Vquit_flag = Qkill_emacs;
10331 else
10333 /* Otherwise, the SIGINT was probably generated by C-g. */
10335 /* Set internal_last_event_frame to the top frame of the
10336 controlling tty, if we have a frame there. We disable the
10337 interrupt key on secondary ttys, so the SIGINT must have come
10338 from the controlling tty. */
10339 internal_last_event_frame = terminal->display_info.tty->top_frame;
10341 handle_interrupt (1);
10345 static void
10346 deliver_interrupt_signal (int sig)
10348 deliver_process_signal (sig, handle_interrupt_signal);
10352 /* If Emacs is stuck because `inhibit-quit' is true, then keep track
10353 of the number of times C-g has been requested. If C-g is pressed
10354 enough times, then quit anyway. See bug#6585. */
10355 static int volatile force_quit_count;
10357 /* This routine is called at interrupt level in response to C-g.
10359 It is called from the SIGINT handler or kbd_buffer_store_event.
10361 If `waiting_for_input' is non zero, then unless `echoing' is
10362 nonzero, immediately throw back to read_char.
10364 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
10365 eval to throw, when it gets a chance. If quit-flag is already
10366 non-nil, it stops the job right away. */
10368 static void
10369 handle_interrupt (bool in_signal_handler)
10371 char c;
10373 cancel_echoing ();
10375 /* XXX This code needs to be revised for multi-tty support. */
10376 if (!NILP (Vquit_flag) && get_named_terminal ("/dev/tty"))
10378 if (! in_signal_handler)
10380 /* If SIGINT isn't blocked, don't let us be interrupted by
10381 a SIGINT. It might be harmful due to non-reentrancy
10382 in I/O functions. */
10383 sigset_t blocked;
10384 sigemptyset (&blocked);
10385 sigaddset (&blocked, SIGINT);
10386 pthread_sigmask (SIG_BLOCK, &blocked, 0);
10389 fflush (stdout);
10390 reset_all_sys_modes ();
10392 #ifdef SIGTSTP
10394 * On systems which can suspend the current process and return to the original
10395 * shell, this command causes the user to end up back at the shell.
10396 * The "Auto-save" and "Abort" questions are not asked until
10397 * the user elects to return to emacs, at which point he can save the current
10398 * job and either dump core or continue.
10400 sys_suspend ();
10401 #else
10402 /* Perhaps should really fork an inferior shell?
10403 But that would not provide any way to get back
10404 to the original shell, ever. */
10405 printf ("No support for stopping a process on this operating system;\n");
10406 printf ("you can continue or abort.\n");
10407 #endif /* not SIGTSTP */
10408 #ifdef MSDOS
10409 /* We must remain inside the screen area when the internal terminal
10410 is used. Note that [Enter] is not echoed by dos. */
10411 cursor_to (SELECTED_FRAME (), 0, 0);
10412 #endif
10413 /* It doesn't work to autosave while GC is in progress;
10414 the code used for auto-saving doesn't cope with the mark bit. */
10415 if (!gc_in_progress)
10417 printf ("Auto-save? (y or n) ");
10418 fflush (stdout);
10419 if (((c = getchar ()) & ~040) == 'Y')
10421 Fdo_auto_save (Qt, Qnil);
10422 #ifdef MSDOS
10423 printf ("\r\nAuto-save done");
10424 #else /* not MSDOS */
10425 printf ("Auto-save done\n");
10426 #endif /* not MSDOS */
10428 while (c != '\n') c = getchar ();
10430 else
10432 /* During GC, it must be safe to reenable quitting again. */
10433 Vinhibit_quit = Qnil;
10434 #ifdef MSDOS
10435 printf ("\r\n");
10436 #endif /* not MSDOS */
10437 printf ("Garbage collection in progress; cannot auto-save now\r\n");
10438 printf ("but will instead do a real quit after garbage collection ends\r\n");
10439 fflush (stdout);
10442 #ifdef MSDOS
10443 printf ("\r\nAbort? (y or n) ");
10444 #else /* not MSDOS */
10445 printf ("Abort (and dump core)? (y or n) ");
10446 #endif /* not MSDOS */
10447 fflush (stdout);
10448 if (((c = getchar ()) & ~040) == 'Y')
10449 emacs_abort ();
10450 while (c != '\n') c = getchar ();
10451 #ifdef MSDOS
10452 printf ("\r\nContinuing...\r\n");
10453 #else /* not MSDOS */
10454 printf ("Continuing...\n");
10455 #endif /* not MSDOS */
10456 fflush (stdout);
10457 init_all_sys_modes ();
10459 else
10461 /* If executing a function that wants to be interrupted out of
10462 and the user has not deferred quitting by binding `inhibit-quit'
10463 then quit right away. */
10464 if (immediate_quit && NILP (Vinhibit_quit))
10466 struct gl_state_s saved;
10467 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10469 immediate_quit = 0;
10470 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
10471 saved = gl_state;
10472 GCPRO4 (saved.object, saved.global_code,
10473 saved.current_syntax_table, saved.old_prop);
10474 Fsignal (Qquit, Qnil);
10475 gl_state = saved;
10476 UNGCPRO;
10478 else
10479 { /* Else request quit when it's safe. */
10480 int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
10481 force_quit_count = count;
10482 if (count == 3)
10484 immediate_quit = 1;
10485 Vinhibit_quit = Qnil;
10487 Vquit_flag = Qt;
10491 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
10493 /* TODO: The longjmp in this call throws the NS event loop integration off,
10494 and it seems to do fine without this. Probably some attention
10495 needs to be paid to the setting of waiting_for_input in
10496 wait_reading_process_output() under HAVE_NS because of the call
10497 to ns_select there (needed because otherwise events aren't picked up
10498 outside of polling since we don't get SIGIO like X and we don't have a
10499 separate event loop thread like W32. */
10500 #ifndef HAVE_NS
10501 if (waiting_for_input && !echoing)
10502 quit_throw_to_read_char (in_signal_handler);
10503 #endif
10506 /* Handle a C-g by making read_char return C-g. */
10508 static void
10509 quit_throw_to_read_char (bool from_signal)
10511 /* When not called from a signal handler it is safe to call
10512 Lisp. */
10513 if (!from_signal && EQ (Vquit_flag, Qkill_emacs))
10514 Fkill_emacs (Qnil);
10516 /* Prevent another signal from doing this before we finish. */
10517 clear_waiting_for_input ();
10518 input_pending = 0;
10520 Vunread_command_events = Qnil;
10522 if (FRAMEP (internal_last_event_frame)
10523 && !EQ (internal_last_event_frame, selected_frame))
10524 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
10525 0, 0, Qnil);
10527 sys_longjmp (getcjmp, 1);
10530 DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,
10531 Sset_input_interrupt_mode, 1, 1, 0,
10532 doc: /* Set interrupt mode of reading keyboard input.
10533 If INTERRUPT is non-nil, Emacs will use input interrupts;
10534 otherwise Emacs uses CBREAK mode.
10536 See also `current-input-mode'. */)
10537 (Lisp_Object interrupt)
10539 bool new_interrupt_input;
10540 #ifdef USABLE_SIGIO
10541 #ifdef HAVE_X_WINDOWS
10542 if (x_display_list != NULL)
10544 /* When using X, don't give the user a real choice,
10545 because we haven't implemented the mechanisms to support it. */
10546 new_interrupt_input = 1;
10548 else
10549 #endif /* HAVE_X_WINDOWS */
10550 new_interrupt_input = !NILP (interrupt);
10551 #else /* not USABLE_SIGIO */
10552 new_interrupt_input = 0;
10553 #endif /* not USABLE_SIGIO */
10555 if (new_interrupt_input != interrupt_input)
10557 #ifdef POLL_FOR_INPUT
10558 stop_polling ();
10559 #endif
10560 #ifndef DOS_NT
10561 /* this causes startup screen to be restored and messes with the mouse */
10562 reset_all_sys_modes ();
10563 interrupt_input = new_interrupt_input;
10564 init_all_sys_modes ();
10565 #else
10566 interrupt_input = new_interrupt_input;
10567 #endif
10569 #ifdef POLL_FOR_INPUT
10570 poll_suppress_count = 1;
10571 start_polling ();
10572 #endif
10574 return Qnil;
10577 DEFUN ("set-output-flow-control", Fset_output_flow_control, Sset_output_flow_control, 1, 2, 0,
10578 doc: /* Enable or disable ^S/^Q flow control for output to TERMINAL.
10579 If FLOW is non-nil, flow control is enabled and you cannot use C-s or
10580 C-q in key sequences.
10582 This setting only has an effect on tty terminals and only when
10583 Emacs reads input in CBREAK mode; see `set-input-interrupt-mode'.
10585 See also `current-input-mode'. */)
10586 (Lisp_Object flow, Lisp_Object terminal)
10588 struct terminal *t = decode_tty_terminal (terminal);
10589 struct tty_display_info *tty;
10591 if (!t)
10592 return Qnil;
10593 tty = t->display_info.tty;
10595 if (tty->flow_control != !NILP (flow))
10597 #ifndef DOS_NT
10598 /* This causes startup screen to be restored and messes with the mouse. */
10599 reset_sys_modes (tty);
10600 #endif
10602 tty->flow_control = !NILP (flow);
10604 #ifndef DOS_NT
10605 init_sys_modes (tty);
10606 #endif
10608 return Qnil;
10611 DEFUN ("set-input-meta-mode", Fset_input_meta_mode, Sset_input_meta_mode, 1, 2, 0,
10612 doc: /* Enable or disable 8-bit input on TERMINAL.
10613 If META is t, Emacs will accept 8-bit input, and interpret the 8th
10614 bit as the Meta modifier.
10616 If META is nil, Emacs will ignore the top bit, on the assumption it is
10617 parity.
10619 Otherwise, Emacs will accept and pass through 8-bit input without
10620 specially interpreting the top bit.
10622 This setting only has an effect on tty terminal devices.
10624 Optional parameter TERMINAL specifies the tty terminal device to use.
10625 It may be a terminal object, a frame, or nil for the terminal used by
10626 the currently selected frame.
10628 See also `current-input-mode'. */)
10629 (Lisp_Object meta, Lisp_Object terminal)
10631 struct terminal *t = decode_tty_terminal (terminal);
10632 struct tty_display_info *tty;
10633 int new_meta;
10635 if (!t)
10636 return Qnil;
10637 tty = t->display_info.tty;
10639 if (NILP (meta))
10640 new_meta = 0;
10641 else if (EQ (meta, Qt))
10642 new_meta = 1;
10643 else
10644 new_meta = 2;
10646 if (tty->meta_key != new_meta)
10648 #ifndef DOS_NT
10649 /* this causes startup screen to be restored and messes with the mouse */
10650 reset_sys_modes (tty);
10651 #endif
10653 tty->meta_key = new_meta;
10655 #ifndef DOS_NT
10656 init_sys_modes (tty);
10657 #endif
10659 return Qnil;
10662 DEFUN ("set-quit-char", Fset_quit_char, Sset_quit_char, 1, 1, 0,
10663 doc: /* Specify character used for quitting.
10664 QUIT must be an ASCII character.
10666 This function only has an effect on the controlling tty of the Emacs
10667 process.
10669 See also `current-input-mode'. */)
10670 (Lisp_Object quit)
10672 struct terminal *t = get_named_terminal ("/dev/tty");
10673 struct tty_display_info *tty;
10675 if (!t)
10676 return Qnil;
10677 tty = t->display_info.tty;
10679 if (NILP (quit) || !INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400)
10680 error ("QUIT must be an ASCII character");
10682 #ifndef DOS_NT
10683 /* this causes startup screen to be restored and messes with the mouse */
10684 reset_sys_modes (tty);
10685 #endif
10687 /* Don't let this value be out of range. */
10688 quit_char = XINT (quit) & (tty->meta_key == 0 ? 0177 : 0377);
10690 #ifndef DOS_NT
10691 init_sys_modes (tty);
10692 #endif
10694 return Qnil;
10697 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
10698 doc: /* Set mode of reading keyboard input.
10699 First arg INTERRUPT non-nil means use input interrupts;
10700 nil means use CBREAK mode.
10701 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
10702 (no effect except in CBREAK mode).
10703 Third arg META t means accept 8-bit input (for a Meta key).
10704 META nil means ignore the top bit, on the assumption it is parity.
10705 Otherwise, accept 8-bit input and don't use the top bit for Meta.
10706 Optional fourth arg QUIT if non-nil specifies character to use for quitting.
10707 See also `current-input-mode'. */)
10708 (Lisp_Object interrupt, Lisp_Object flow, Lisp_Object meta, Lisp_Object quit)
10710 Fset_input_interrupt_mode (interrupt);
10711 Fset_output_flow_control (flow, Qnil);
10712 Fset_input_meta_mode (meta, Qnil);
10713 if (!NILP (quit))
10714 Fset_quit_char (quit);
10715 return Qnil;
10718 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
10719 doc: /* Return information about the way Emacs currently reads keyboard input.
10720 The value is a list of the form (INTERRUPT FLOW META QUIT), where
10721 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if
10722 nil, Emacs is using CBREAK mode.
10723 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
10724 terminal; this does not apply if Emacs uses interrupt-driven input.
10725 META is t if accepting 8-bit input with 8th bit as Meta flag.
10726 META nil means ignoring the top bit, on the assumption it is parity.
10727 META is neither t nor nil if accepting 8-bit input and using
10728 all 8 bits as the character code.
10729 QUIT is the character Emacs currently uses to quit.
10730 The elements of this list correspond to the arguments of
10731 `set-input-mode'. */)
10732 (void)
10734 Lisp_Object val[4];
10735 struct frame *sf = XFRAME (selected_frame);
10737 val[0] = interrupt_input ? Qt : Qnil;
10738 if (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf))
10740 val[1] = FRAME_TTY (sf)->flow_control ? Qt : Qnil;
10741 val[2] = (FRAME_TTY (sf)->meta_key == 2
10742 ? make_number (0)
10743 : (CURTTY ()->meta_key == 1 ? Qt : Qnil));
10745 else
10747 val[1] = Qnil;
10748 val[2] = Qt;
10750 XSETFASTINT (val[3], quit_char);
10752 return Flist (ARRAYELTS (val), val);
10755 DEFUN ("posn-at-x-y", Fposn_at_x_y, Sposn_at_x_y, 2, 4, 0,
10756 doc: /* Return position information for pixel coordinates X and Y.
10757 By default, X and Y are relative to text area of the selected window.
10758 Optional third arg FRAME-OR-WINDOW non-nil specifies frame or window.
10759 If optional fourth arg WHOLE is non-nil, X is relative to the left
10760 edge of the window.
10762 The return value is similar to a mouse click position:
10763 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
10764 IMAGE (DX . DY) (WIDTH . HEIGHT))
10765 The `posn-' functions access elements of such lists. */)
10766 (Lisp_Object x, Lisp_Object y, Lisp_Object frame_or_window, Lisp_Object whole)
10768 CHECK_NATNUM (x);
10769 CHECK_NATNUM (y);
10771 if (NILP (frame_or_window))
10772 frame_or_window = selected_window;
10774 if (WINDOWP (frame_or_window))
10776 struct window *w = decode_live_window (frame_or_window);
10778 XSETINT (x, (XINT (x)
10779 + WINDOW_LEFT_EDGE_X (w)
10780 + (NILP (whole)
10781 ? window_box_left_offset (w, TEXT_AREA)
10782 : 0)));
10783 XSETINT (y, WINDOW_TO_FRAME_PIXEL_Y (w, XINT (y)));
10784 frame_or_window = w->frame;
10787 CHECK_LIVE_FRAME (frame_or_window);
10789 return make_lispy_position (XFRAME (frame_or_window), x, y, 0);
10792 DEFUN ("posn-at-point", Fposn_at_point, Sposn_at_point, 0, 2, 0,
10793 doc: /* Return position information for buffer POS in WINDOW.
10794 POS defaults to point in WINDOW; WINDOW defaults to the selected window.
10796 Return nil if position is not visible in window. Otherwise,
10797 the return value is similar to that returned by `event-start' for
10798 a mouse click at the upper left corner of the glyph corresponding
10799 to the given buffer position:
10800 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
10801 IMAGE (DX . DY) (WIDTH . HEIGHT))
10802 The `posn-' functions access elements of such lists. */)
10803 (Lisp_Object pos, Lisp_Object window)
10805 Lisp_Object tem;
10807 if (NILP (window))
10808 window = selected_window;
10810 tem = Fpos_visible_in_window_p (pos, window, Qt);
10811 if (!NILP (tem))
10813 Lisp_Object x = XCAR (tem);
10814 Lisp_Object y = XCAR (XCDR (tem));
10816 /* Point invisible due to hscrolling? */
10817 if (XINT (x) < 0)
10818 return Qnil;
10819 tem = Fposn_at_x_y (x, y, window, Qnil);
10822 return tem;
10825 /* Set up a new kboard object with reasonable initial values.
10826 TYPE is a window system for which this keyboard is used. */
10828 static void
10829 init_kboard (KBOARD *kb, Lisp_Object type)
10831 kset_overriding_terminal_local_map (kb, Qnil);
10832 kset_last_command (kb, Qnil);
10833 kset_real_last_command (kb, Qnil);
10834 kset_keyboard_translate_table (kb, Qnil);
10835 kset_last_repeatable_command (kb, Qnil);
10836 kset_prefix_arg (kb, Qnil);
10837 kset_last_prefix_arg (kb, Qnil);
10838 kset_kbd_queue (kb, Qnil);
10839 kb->kbd_queue_has_data = 0;
10840 kb->immediate_echo = 0;
10841 kset_echo_string (kb, Qnil);
10842 kb->echo_after_prompt = -1;
10843 kb->kbd_macro_buffer = 0;
10844 kb->kbd_macro_bufsize = 0;
10845 kset_defining_kbd_macro (kb, Qnil);
10846 kset_last_kbd_macro (kb, Qnil);
10847 kb->reference_count = 0;
10848 kset_system_key_alist (kb, Qnil);
10849 kset_system_key_syms (kb, Qnil);
10850 kset_window_system (kb, type);
10851 kset_input_decode_map (kb, Fmake_sparse_keymap (Qnil));
10852 kset_local_function_key_map (kb, Fmake_sparse_keymap (Qnil));
10853 Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map);
10854 kset_default_minibuffer_frame (kb, Qnil);
10857 /* Allocate and basically initialize keyboard
10858 object to use with window system TYPE. */
10860 KBOARD *
10861 allocate_kboard (Lisp_Object type)
10863 KBOARD *kb = xmalloc (sizeof *kb);
10865 init_kboard (kb, type);
10866 kb->next_kboard = all_kboards;
10867 all_kboards = kb;
10868 return kb;
10872 * Destroy the contents of a kboard object, but not the object itself.
10873 * We use this just before deleting it, or if we're going to initialize
10874 * it a second time.
10876 static void
10877 wipe_kboard (KBOARD *kb)
10879 xfree (kb->kbd_macro_buffer);
10882 /* Free KB and memory referenced from it. */
10884 void
10885 delete_kboard (KBOARD *kb)
10887 KBOARD **kbp;
10889 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
10890 if (*kbp == NULL)
10891 emacs_abort ();
10892 *kbp = kb->next_kboard;
10894 /* Prevent a dangling reference to KB. */
10895 if (kb == current_kboard
10896 && FRAMEP (selected_frame)
10897 && FRAME_LIVE_P (XFRAME (selected_frame)))
10899 current_kboard = FRAME_KBOARD (XFRAME (selected_frame));
10900 single_kboard = 0;
10901 if (current_kboard == kb)
10902 emacs_abort ();
10905 wipe_kboard (kb);
10906 xfree (kb);
10909 void
10910 init_keyboard (void)
10912 /* This is correct before outermost invocation of the editor loop. */
10913 command_loop_level = -1;
10914 immediate_quit = 0;
10915 quit_char = Ctl ('g');
10916 Vunread_command_events = Qnil;
10917 timer_idleness_start_time = invalid_timespec ();
10918 total_keys = 0;
10919 recent_keys_index = 0;
10920 kbd_fetch_ptr = kbd_buffer;
10921 kbd_store_ptr = kbd_buffer;
10922 do_mouse_tracking = Qnil;
10923 input_pending = 0;
10924 interrupt_input_blocked = 0;
10925 pending_signals = 0;
10927 /* This means that command_loop_1 won't try to select anything the first
10928 time through. */
10929 internal_last_event_frame = Qnil;
10930 Vlast_event_frame = internal_last_event_frame;
10932 current_kboard = initial_kboard;
10933 /* Re-initialize the keyboard again. */
10934 wipe_kboard (current_kboard);
10935 /* A value of nil for Vwindow_system normally means a tty, but we also use
10936 it for the initial terminal since there is no window system there. */
10937 init_kboard (current_kboard, Qnil);
10939 if (!noninteractive)
10941 /* Before multi-tty support, these handlers used to be installed
10942 only if the current session was a tty session. Now an Emacs
10943 session may have multiple display types, so we always handle
10944 SIGINT. There is special code in handle_interrupt_signal to exit
10945 Emacs on SIGINT when there are no termcap frames on the
10946 controlling terminal. */
10947 struct sigaction action;
10948 emacs_sigaction_init (&action, deliver_interrupt_signal);
10949 sigaction (SIGINT, &action, 0);
10950 #ifndef DOS_NT
10951 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
10952 SIGQUIT and we can't tell which one it will give us. */
10953 sigaction (SIGQUIT, &action, 0);
10954 #endif /* not DOS_NT */
10956 #ifdef USABLE_SIGIO
10957 if (!noninteractive)
10959 struct sigaction action;
10960 emacs_sigaction_init (&action, deliver_input_available_signal);
10961 sigaction (SIGIO, &action, 0);
10963 #endif
10965 /* Use interrupt input by default, if it works and noninterrupt input
10966 has deficiencies. */
10968 #ifdef INTERRUPT_INPUT
10969 interrupt_input = 1;
10970 #else
10971 interrupt_input = 0;
10972 #endif
10974 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
10975 dribble = 0;
10977 if (keyboard_init_hook)
10978 (*keyboard_init_hook) ();
10980 #ifdef POLL_FOR_INPUT
10981 poll_timer = NULL;
10982 poll_suppress_count = 1;
10983 start_polling ();
10984 #endif
10987 /* This type's only use is in syms_of_keyboard, to put properties on the
10988 event header symbols. */
10989 struct event_head {
10990 struct Lisp_Symbol *var;
10991 struct Lisp_Symbol *kind;
10996 static const struct event_head head_table[] = {
10997 {XSYMBOL_INIT (Qmouse_movement), XSYMBOL_INIT (Qmouse_movement)},
10998 {XSYMBOL_INIT (Qscroll_bar_movement), XSYMBOL_INIT (Qmouse_movement)},
11000 /* Some of the event heads. */
11001 {XSYMBOL_INIT (Qswitch_frame), XSYMBOL_INIT (Qswitch_frame)},
11003 {XSYMBOL_INIT (Qfocus_in), XSYMBOL_INIT (Qfocus_in)},
11004 {XSYMBOL_INIT (Qfocus_out), XSYMBOL_INIT (Qfocus_out)},
11005 {XSYMBOL_INIT (Qdelete_frame), XSYMBOL_INIT (Qdelete_frame)},
11006 {XSYMBOL_INIT (Qiconify_frame), XSYMBOL_INIT (Qiconify_frame)},
11007 {XSYMBOL_INIT (Qmake_frame_visible), XSYMBOL_INIT (Qmake_frame_visible)},
11008 /* `select-window' should be handled just like `switch-frame'
11009 in read_key_sequence. */
11010 {XSYMBOL_INIT (Qselect_window), XSYMBOL_INIT (Qswitch_frame)}
11013 void
11014 syms_of_keyboard (void)
11016 pending_funcalls = Qnil;
11017 staticpro (&pending_funcalls);
11019 Vlispy_mouse_stem = build_pure_c_string ("mouse");
11020 staticpro (&Vlispy_mouse_stem);
11022 regular_top_level_message = build_pure_c_string ("Back to top level");
11023 #ifdef HAVE_STACK_OVERFLOW_HANDLING
11024 recover_top_level_message
11025 = build_pure_c_string ("Re-entering top level after C stack overflow");
11026 #endif
11027 DEFVAR_LISP ("internal--top-level-message", Vinternal__top_level_message,
11028 doc: /* Message displayed by `normal-top-level'. */);
11029 Vinternal__top_level_message = regular_top_level_message;
11031 /* Tool-bars. */
11032 DEFSYM (QCimage, ":image");
11033 DEFSYM (Qhelp_echo, "help-echo");
11034 DEFSYM (QCrtl, ":rtl");
11036 staticpro (&item_properties);
11037 item_properties = Qnil;
11039 staticpro (&tool_bar_item_properties);
11040 tool_bar_item_properties = Qnil;
11041 staticpro (&tool_bar_items_vector);
11042 tool_bar_items_vector = Qnil;
11044 DEFSYM (Qtimer_event_handler, "timer-event-handler");
11045 DEFSYM (Qdisabled_command_function, "disabled-command-function");
11046 DEFSYM (Qself_insert_command, "self-insert-command");
11047 DEFSYM (Qforward_char, "forward-char");
11048 DEFSYM (Qbackward_char, "backward-char");
11050 /* Non-nil disable property on a command means do not execute it;
11051 call disabled-command-function's value instead. */
11052 DEFSYM (Qdisabled, "disabled");
11054 DEFSYM (Qundefined, "undefined");
11056 /* Hooks to run before and after each command. */
11057 DEFSYM (Qpre_command_hook, "pre-command-hook");
11058 DEFSYM (Qpost_command_hook, "post-command-hook");
11060 DEFSYM (Qdeferred_action_function, "deferred-action-function");
11061 DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook");
11062 DEFSYM (Qfunction_key, "function-key");
11064 /* The values of Qevent_kind properties. */
11065 DEFSYM (Qmouse_click, "mouse-click");
11067 DEFSYM (Qdrag_n_drop, "drag-n-drop");
11068 DEFSYM (Qsave_session, "save-session");
11069 DEFSYM (Qconfig_changed_event, "config-changed-event");
11071 /* Menu and tool bar item parts. */
11072 DEFSYM (Qmenu_enable, "menu-enable");
11074 #ifdef HAVE_NTGUI
11075 DEFSYM (Qlanguage_change, "language-change");
11076 #endif
11078 #ifdef HAVE_DBUS
11079 DEFSYM (Qdbus_event, "dbus-event");
11080 #endif
11082 #ifdef USE_FILE_NOTIFY
11083 DEFSYM (Qfile_notify, "file-notify");
11084 #endif /* USE_FILE_NOTIFY */
11086 /* Menu and tool bar item parts. */
11087 DEFSYM (QCenable, ":enable");
11088 DEFSYM (QCvisible, ":visible");
11089 DEFSYM (QChelp, ":help");
11090 DEFSYM (QCfilter, ":filter");
11091 DEFSYM (QCbutton, ":button");
11092 DEFSYM (QCkeys, ":keys");
11093 DEFSYM (QCkey_sequence, ":key-sequence");
11095 /* Non-nil disable property on a command means
11096 do not execute it; call disabled-command-function's value instead. */
11097 DEFSYM (QCtoggle, ":toggle");
11098 DEFSYM (QCradio, ":radio");
11099 DEFSYM (QClabel, ":label");
11100 DEFSYM (QCvert_only, ":vert-only");
11102 /* Symbols to use for parts of windows. */
11103 DEFSYM (Qvertical_line, "vertical-line");
11104 DEFSYM (Qright_divider, "right-divider");
11105 DEFSYM (Qbottom_divider, "bottom-divider");
11107 DEFSYM (Qmouse_fixup_help_message, "mouse-fixup-help-message");
11109 DEFSYM (Qabove_handle, "above-handle");
11110 DEFSYM (Qhandle, "handle");
11111 DEFSYM (Qbelow_handle, "below-handle");
11112 DEFSYM (Qup, "up");
11113 DEFSYM (Qdown, "down");
11114 DEFSYM (Qtop, "top");
11115 DEFSYM (Qbottom, "bottom");
11116 DEFSYM (Qend_scroll, "end-scroll");
11117 DEFSYM (Qratio, "ratio");
11118 DEFSYM (Qbefore_handle, "before-handle");
11119 DEFSYM (Qhorizontal_handle, "horizontal-handle");
11120 DEFSYM (Qafter_handle, "after-handle");
11121 DEFSYM (Qleft, "left");
11122 DEFSYM (Qright, "right");
11123 DEFSYM (Qleftmost, "leftmost");
11124 DEFSYM (Qrightmost, "rightmost");
11126 /* Properties of event headers. */
11127 DEFSYM (Qevent_kind, "event-kind");
11128 DEFSYM (Qevent_symbol_elements, "event-symbol-elements");
11130 /* An event header symbol HEAD may have a property named
11131 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
11132 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
11133 mask of modifiers applied to it. If present, this is used to help
11134 speed up parse_modifiers. */
11135 DEFSYM (Qevent_symbol_element_mask, "event-symbol-element-mask");
11137 /* An unmodified event header BASE may have a property named
11138 Qmodifier_cache, which is an alist mapping modifier masks onto
11139 modified versions of BASE. If present, this helps speed up
11140 apply_modifiers. */
11141 DEFSYM (Qmodifier_cache, "modifier-cache");
11143 DEFSYM (Qrecompute_lucid_menubar, "recompute-lucid-menubar");
11144 DEFSYM (Qactivate_menubar_hook, "activate-menubar-hook");
11146 DEFSYM (Qpolling_period, "polling-period");
11148 DEFSYM (Qgui_set_selection, "gui-set-selection");
11150 /* The primary selection. */
11151 DEFSYM (QPRIMARY, "PRIMARY");
11153 DEFSYM (Qhandle_switch_frame, "handle-switch-frame");
11154 DEFSYM (Qhandle_select_window, "handle-select-window");
11156 DEFSYM (Qinput_method_function, "input-method-function");
11157 DEFSYM (Qinput_method_exit_on_first_char, "input-method-exit-on-first-char");
11158 DEFSYM (Qinput_method_use_echo_area, "input-method-use-echo-area");
11160 DEFSYM (Qhelp_form_show, "help-form-show");
11162 DEFSYM (Qecho_keystrokes, "echo-keystrokes");
11164 Fset (Qinput_method_exit_on_first_char, Qnil);
11165 Fset (Qinput_method_use_echo_area, Qnil);
11167 /* Symbols to head events. */
11168 DEFSYM (Qmouse_movement, "mouse-movement");
11169 DEFSYM (Qscroll_bar_movement, "scroll-bar-movement");
11170 DEFSYM (Qswitch_frame, "switch-frame");
11171 DEFSYM (Qfocus_in, "focus-in");
11172 DEFSYM (Qfocus_out, "focus-out");
11173 DEFSYM (Qdelete_frame, "delete-frame");
11174 DEFSYM (Qiconify_frame, "iconify-frame");
11175 DEFSYM (Qmake_frame_visible, "make-frame-visible");
11176 DEFSYM (Qselect_window, "select-window");
11178 int i;
11180 for (i = 0; i < ARRAYELTS (head_table); i++)
11182 const struct event_head *p = &head_table[i];
11183 Lisp_Object var = make_lisp_symbol (p->var);
11184 Lisp_Object kind = make_lisp_symbol (p->kind);
11185 Fput (var, Qevent_kind, kind);
11186 Fput (var, Qevent_symbol_elements, list1 (var));
11190 button_down_location = Fmake_vector (make_number (5), Qnil);
11191 staticpro (&button_down_location);
11192 mouse_syms = Fmake_vector (make_number (5), Qnil);
11193 staticpro (&mouse_syms);
11194 wheel_syms = Fmake_vector (make_number (ARRAYELTS (lispy_wheel_names)),
11195 Qnil);
11196 staticpro (&wheel_syms);
11199 int i;
11200 int len = ARRAYELTS (modifier_names);
11202 modifier_symbols = Fmake_vector (make_number (len), Qnil);
11203 for (i = 0; i < len; i++)
11204 if (modifier_names[i])
11205 ASET (modifier_symbols, i, intern_c_string (modifier_names[i]));
11206 staticpro (&modifier_symbols);
11209 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
11210 staticpro (&recent_keys);
11212 this_command_keys = Fmake_vector (make_number (40), Qnil);
11213 staticpro (&this_command_keys);
11215 raw_keybuf = Fmake_vector (make_number (30), Qnil);
11216 staticpro (&raw_keybuf);
11218 DEFSYM (Qcommand_execute, "command-execute");
11220 accent_key_syms = Qnil;
11221 staticpro (&accent_key_syms);
11223 func_key_syms = Qnil;
11224 staticpro (&func_key_syms);
11226 drag_n_drop_syms = Qnil;
11227 staticpro (&drag_n_drop_syms);
11229 unread_switch_frame = Qnil;
11230 staticpro (&unread_switch_frame);
11232 internal_last_event_frame = Qnil;
11233 staticpro (&internal_last_event_frame);
11235 read_key_sequence_cmd = Qnil;
11236 staticpro (&read_key_sequence_cmd);
11237 read_key_sequence_remapped = Qnil;
11238 staticpro (&read_key_sequence_remapped);
11240 menu_bar_one_keymap_changed_items = Qnil;
11241 staticpro (&menu_bar_one_keymap_changed_items);
11243 menu_bar_items_vector = Qnil;
11244 staticpro (&menu_bar_items_vector);
11246 help_form_saved_window_configs = Qnil;
11247 staticpro (&help_form_saved_window_configs);
11249 defsubr (&Scurrent_idle_time);
11250 defsubr (&Sevent_symbol_parse_modifiers);
11251 defsubr (&Sevent_convert_list);
11252 defsubr (&Sread_key_sequence);
11253 defsubr (&Sread_key_sequence_vector);
11254 defsubr (&Srecursive_edit);
11255 defsubr (&Strack_mouse);
11256 defsubr (&Sinput_pending_p);
11257 defsubr (&Srecent_keys);
11258 defsubr (&Sthis_command_keys);
11259 defsubr (&Sthis_command_keys_vector);
11260 defsubr (&Sthis_single_command_keys);
11261 defsubr (&Sthis_single_command_raw_keys);
11262 defsubr (&Sreset_this_command_lengths);
11263 defsubr (&Sclear_this_command_keys);
11264 defsubr (&Ssuspend_emacs);
11265 defsubr (&Sabort_recursive_edit);
11266 defsubr (&Sexit_recursive_edit);
11267 defsubr (&Srecursion_depth);
11268 defsubr (&Scommand_error_default_function);
11269 defsubr (&Stop_level);
11270 defsubr (&Sdiscard_input);
11271 defsubr (&Sopen_dribble_file);
11272 defsubr (&Sset_input_interrupt_mode);
11273 defsubr (&Sset_output_flow_control);
11274 defsubr (&Sset_input_meta_mode);
11275 defsubr (&Sset_quit_char);
11276 defsubr (&Sset_input_mode);
11277 defsubr (&Scurrent_input_mode);
11278 defsubr (&Sposn_at_point);
11279 defsubr (&Sposn_at_x_y);
11281 DEFVAR_LISP ("last-command-event", last_command_event,
11282 doc: /* Last input event that was part of a command. */);
11284 DEFVAR_LISP ("last-nonmenu-event", last_nonmenu_event,
11285 doc: /* Last input event in a command, except for mouse menu events.
11286 Mouse menus give back keys that don't look like mouse events;
11287 this variable holds the actual mouse event that led to the menu,
11288 so that you can determine whether the command was run by mouse or not. */);
11290 DEFVAR_LISP ("last-input-event", last_input_event,
11291 doc: /* Last input event. */);
11293 DEFVAR_LISP ("unread-command-events", Vunread_command_events,
11294 doc: /* List of events to be read as the command input.
11295 These events are processed first, before actual keyboard input.
11296 Events read from this list are not normally added to `this-command-keys',
11297 as they will already have been added once as they were read for the first time.
11298 An element of the form (t . EVENT) forces EVENT to be added to that list. */);
11299 Vunread_command_events = Qnil;
11301 DEFVAR_LISP ("unread-post-input-method-events", Vunread_post_input_method_events,
11302 doc: /* List of events to be processed as input by input methods.
11303 These events are processed before `unread-command-events'
11304 and actual keyboard input, but are not given to `input-method-function'. */);
11305 Vunread_post_input_method_events = Qnil;
11307 DEFVAR_LISP ("unread-input-method-events", Vunread_input_method_events,
11308 doc: /* List of events to be processed as input by input methods.
11309 These events are processed after `unread-command-events', but
11310 before actual keyboard input.
11311 If there's an active input method, the events are given to
11312 `input-method-function'. */);
11313 Vunread_input_method_events = Qnil;
11315 DEFVAR_LISP ("meta-prefix-char", meta_prefix_char,
11316 doc: /* Meta-prefix character code.
11317 Meta-foo as command input turns into this character followed by foo. */);
11318 XSETINT (meta_prefix_char, 033);
11320 DEFVAR_KBOARD ("last-command", Vlast_command,
11321 doc: /* The last command executed.
11322 Normally a symbol with a function definition, but can be whatever was found
11323 in the keymap, or whatever the variable `this-command' was set to by that
11324 command.
11326 The value `mode-exit' is special; it means that the previous command
11327 read an event that told it to exit, and it did so and unread that event.
11328 In other words, the present command is the event that made the previous
11329 command exit.
11331 The value `kill-region' is special; it means that the previous command
11332 was a kill command.
11334 `last-command' has a separate binding for each terminal device.
11335 See Info node `(elisp)Multiple Terminals'. */);
11337 DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
11338 doc: /* Same as `last-command', but never altered by Lisp code.
11339 Taken from the previous value of `real-this-command'. */);
11341 DEFVAR_KBOARD ("last-repeatable-command", Vlast_repeatable_command,
11342 doc: /* Last command that may be repeated.
11343 The last command executed that was not bound to an input event.
11344 This is the command `repeat' will try to repeat.
11345 Taken from a previous value of `real-this-command'. */);
11347 DEFVAR_LISP ("this-command", Vthis_command,
11348 doc: /* The command now being executed.
11349 The command can set this variable; whatever is put here
11350 will be in `last-command' during the following command. */);
11351 Vthis_command = Qnil;
11353 DEFVAR_LISP ("real-this-command", Vreal_this_command,
11354 doc: /* This is like `this-command', except that commands should never modify it. */);
11355 Vreal_this_command = Qnil;
11357 DEFVAR_LISP ("this-command-keys-shift-translated",
11358 Vthis_command_keys_shift_translated,
11359 doc: /* Non-nil if the key sequence activating this command was shift-translated.
11360 Shift-translation occurs when there is no binding for the key sequence
11361 as entered, but a binding was found by changing an upper-case letter
11362 to lower-case, or a shifted function key to an unshifted one. */);
11363 Vthis_command_keys_shift_translated = Qnil;
11365 DEFVAR_LISP ("this-original-command", Vthis_original_command,
11366 doc: /* The command bound to the current key sequence before remapping.
11367 It equals `this-command' if the original command was not remapped through
11368 any of the active keymaps. Otherwise, the value of `this-command' is the
11369 result of looking up the original command in the active keymaps. */);
11370 Vthis_original_command = Qnil;
11372 DEFVAR_INT ("auto-save-interval", auto_save_interval,
11373 doc: /* Number of input events between auto-saves.
11374 Zero means disable autosaving due to number of characters typed. */);
11375 auto_save_interval = 300;
11377 DEFVAR_LISP ("auto-save-timeout", Vauto_save_timeout,
11378 doc: /* Number of seconds idle time before auto-save.
11379 Zero or nil means disable auto-saving due to idleness.
11380 After auto-saving due to this many seconds of idle time,
11381 Emacs also does a garbage collection if that seems to be warranted. */);
11382 XSETFASTINT (Vauto_save_timeout, 30);
11384 DEFVAR_LISP ("echo-keystrokes", Vecho_keystrokes,
11385 doc: /* Nonzero means echo unfinished commands after this many seconds of pause.
11386 The value may be integer or floating point.
11387 If the value is zero, don't echo at all. */);
11388 Vecho_keystrokes = make_number (1);
11390 DEFVAR_INT ("polling-period", polling_period,
11391 doc: /* Interval between polling for input during Lisp execution.
11392 The reason for polling is to make C-g work to stop a running program.
11393 Polling is needed only when using X windows and SIGIO does not work.
11394 Polling is automatically disabled in all other cases. */);
11395 polling_period = 2;
11397 DEFVAR_LISP ("double-click-time", Vdouble_click_time,
11398 doc: /* Maximum time between mouse clicks to make a double-click.
11399 Measured in milliseconds. The value nil means disable double-click
11400 recognition; t means double-clicks have no time limit and are detected
11401 by position only. */);
11402 Vdouble_click_time = make_number (500);
11404 DEFVAR_INT ("double-click-fuzz", double_click_fuzz,
11405 doc: /* Maximum mouse movement between clicks to make a double-click.
11406 On window-system frames, value is the number of pixels the mouse may have
11407 moved horizontally or vertically between two clicks to make a double-click.
11408 On non window-system frames, value is interpreted in units of 1/8 characters
11409 instead of pixels.
11411 This variable is also the threshold for motion of the mouse
11412 to count as a drag. */);
11413 double_click_fuzz = 3;
11415 DEFVAR_INT ("num-input-keys", num_input_keys,
11416 doc: /* Number of complete key sequences read as input so far.
11417 This includes key sequences read from keyboard macros.
11418 The number is effectively the number of interactive command invocations. */);
11419 num_input_keys = 0;
11421 DEFVAR_INT ("num-nonmacro-input-events", num_nonmacro_input_events,
11422 doc: /* Number of input events read from the keyboard so far.
11423 This does not include events generated by keyboard macros. */);
11424 num_nonmacro_input_events = 0;
11426 DEFVAR_LISP ("last-event-frame", Vlast_event_frame,
11427 doc: /* The frame in which the most recently read event occurred.
11428 If the last event came from a keyboard macro, this is set to `macro'. */);
11429 Vlast_event_frame = Qnil;
11431 /* This variable is set up in sysdep.c. */
11432 DEFVAR_LISP ("tty-erase-char", Vtty_erase_char,
11433 doc: /* The ERASE character as set by the user with stty. */);
11435 DEFVAR_LISP ("help-char", Vhelp_char,
11436 doc: /* Character to recognize as meaning Help.
11437 When it is read, do `(eval help-form)', and display result if it's a string.
11438 If the value of `help-form' is nil, this char can be read normally. */);
11439 XSETINT (Vhelp_char, Ctl ('H'));
11441 DEFVAR_LISP ("help-event-list", Vhelp_event_list,
11442 doc: /* List of input events to recognize as meaning Help.
11443 These work just like the value of `help-char' (see that). */);
11444 Vhelp_event_list = Qnil;
11446 DEFVAR_LISP ("help-form", Vhelp_form,
11447 doc: /* Form to execute when character `help-char' is read.
11448 If the form returns a string, that string is displayed.
11449 If `help-form' is nil, the help char is not recognized. */);
11450 Vhelp_form = Qnil;
11452 DEFVAR_LISP ("prefix-help-command", Vprefix_help_command,
11453 doc: /* Command to run when `help-char' character follows a prefix key.
11454 This command is used only when there is no actual binding
11455 for that character after that prefix key. */);
11456 Vprefix_help_command = Qnil;
11458 DEFVAR_LISP ("top-level", Vtop_level,
11459 doc: /* Form to evaluate when Emacs starts up.
11460 Useful to set before you dump a modified Emacs. */);
11461 Vtop_level = Qnil;
11463 DEFVAR_KBOARD ("keyboard-translate-table", Vkeyboard_translate_table,
11464 doc: /* Translate table for local keyboard input, or nil.
11465 If non-nil, the value should be a char-table. Each character read
11466 from the keyboard is looked up in this char-table. If the value found
11467 there is non-nil, then it is used instead of the actual input character.
11469 The value can also be a string or vector, but this is considered obsolete.
11470 If it is a string or vector of length N, character codes N and up are left
11471 untranslated. In a vector, an element which is nil means "no translation".
11473 This is applied to the characters supplied to input methods, not their
11474 output. See also `translation-table-for-input'.
11476 This variable has a separate binding for each terminal.
11477 See Info node `(elisp)Multiple Terminals'. */);
11479 DEFVAR_BOOL ("cannot-suspend", cannot_suspend,
11480 doc: /* Non-nil means to always spawn a subshell instead of suspending.
11481 \(Even if the operating system has support for stopping a process.\) */);
11482 cannot_suspend = 0;
11484 DEFVAR_BOOL ("menu-prompting", menu_prompting,
11485 doc: /* Non-nil means prompt with menus when appropriate.
11486 This is done when reading from a keymap that has a prompt string,
11487 for elements that have prompt strings.
11488 The menu is displayed on the screen
11489 if X menus were enabled at configuration
11490 time and the previous event was a mouse click prefix key.
11491 Otherwise, menu prompting uses the echo area. */);
11492 menu_prompting = 1;
11494 DEFVAR_LISP ("menu-prompt-more-char", menu_prompt_more_char,
11495 doc: /* Character to see next line of menu prompt.
11496 Type this character while in a menu prompt to rotate around the lines of it. */);
11497 XSETINT (menu_prompt_more_char, ' ');
11499 DEFVAR_INT ("extra-keyboard-modifiers", extra_keyboard_modifiers,
11500 doc: /* A mask of additional modifier keys to use with every keyboard character.
11501 Emacs applies the modifiers of the character stored here to each keyboard
11502 character it reads. For example, after evaluating the expression
11503 (setq extra-keyboard-modifiers ?\\C-x)
11504 all input characters will have the control modifier applied to them.
11506 Note that the character ?\\C-@, equivalent to the integer zero, does
11507 not count as a control character; rather, it counts as a character
11508 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero
11509 cancels any modification. */);
11510 extra_keyboard_modifiers = 0;
11512 DEFSYM (Qdeactivate_mark, "deactivate-mark");
11513 DEFVAR_LISP ("deactivate-mark", Vdeactivate_mark,
11514 doc: /* If an editing command sets this to t, deactivate the mark afterward.
11515 The command loop sets this to nil before each command,
11516 and tests the value when the command returns.
11517 Buffer modification stores t in this variable. */);
11518 Vdeactivate_mark = Qnil;
11519 Fmake_variable_buffer_local (Qdeactivate_mark);
11521 DEFVAR_LISP ("pre-command-hook", Vpre_command_hook,
11522 doc: /* Normal hook run before each command is executed.
11523 If an unhandled error happens in running this hook,
11524 the function in which the error occurred is unconditionally removed, since
11525 otherwise the error might happen repeatedly and make Emacs nonfunctional. */);
11526 Vpre_command_hook = Qnil;
11528 DEFVAR_LISP ("post-command-hook", Vpost_command_hook,
11529 doc: /* Normal hook run after each command is executed.
11530 If an unhandled error happens in running this hook,
11531 the function in which the error occurred is unconditionally removed, since
11532 otherwise the error might happen repeatedly and make Emacs nonfunctional. */);
11533 Vpost_command_hook = Qnil;
11535 #if 0
11536 DEFVAR_LISP ("echo-area-clear-hook", ...,
11537 doc: /* Normal hook run when clearing the echo area. */);
11538 #endif
11539 DEFSYM (Qecho_area_clear_hook, "echo-area-clear-hook");
11540 Fset (Qecho_area_clear_hook, Qnil);
11542 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", Vlucid_menu_bar_dirty_flag,
11543 doc: /* Non-nil means menu bar, specified Lucid style, needs to be recomputed. */);
11544 Vlucid_menu_bar_dirty_flag = Qnil;
11546 DEFVAR_LISP ("menu-bar-final-items", Vmenu_bar_final_items,
11547 doc: /* List of menu bar items to move to the end of the menu bar.
11548 The elements of the list are event types that may have menu bar bindings. */);
11549 Vmenu_bar_final_items = Qnil;
11551 DEFVAR_LISP ("tool-bar-separator-image-expression", Vtool_bar_separator_image_expression,
11552 doc: /* Expression evaluating to the image spec for a tool-bar separator.
11553 This is used internally by graphical displays that do not render
11554 tool-bar separators natively. Otherwise it is unused (e.g. on GTK). */);
11555 Vtool_bar_separator_image_expression = Qnil;
11557 DEFVAR_KBOARD ("overriding-terminal-local-map",
11558 Voverriding_terminal_local_map,
11559 doc: /* Per-terminal keymap that takes precedence over all other keymaps.
11560 This variable is intended to let commands such as `universal-argument'
11561 set up a different keymap for reading the next command.
11563 `overriding-terminal-local-map' has a separate binding for each
11564 terminal device. See Info node `(elisp)Multiple Terminals'. */);
11566 DEFVAR_LISP ("overriding-local-map", Voverriding_local_map,
11567 doc: /* Keymap that replaces (overrides) local keymaps.
11568 If this variable is non-nil, Emacs looks up key bindings in this
11569 keymap INSTEAD OF the keymap char property, minor mode maps, and the
11570 buffer's local map. Hence, the only active keymaps would be
11571 `overriding-terminal-local-map', this keymap, and `global-keymap', in
11572 order of precedence. */);
11573 Voverriding_local_map = Qnil;
11575 DEFVAR_LISP ("overriding-local-map-menu-flag", Voverriding_local_map_menu_flag,
11576 doc: /* Non-nil means `overriding-local-map' applies to the menu bar.
11577 Otherwise, the menu bar continues to reflect the buffer's local map
11578 and the minor mode maps regardless of `overriding-local-map'. */);
11579 Voverriding_local_map_menu_flag = Qnil;
11581 DEFVAR_LISP ("special-event-map", Vspecial_event_map,
11582 doc: /* Keymap defining bindings for special events to execute at low level. */);
11583 Vspecial_event_map = list1 (intern_c_string ("keymap"));
11585 DEFVAR_LISP ("track-mouse", do_mouse_tracking,
11586 doc: /* Non-nil means generate motion events for mouse motion. */);
11588 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
11589 doc: /* Alist of system-specific X windows key symbols.
11590 Each element should have the form (N . SYMBOL) where N is the
11591 numeric keysym code (sans the \"system-specific\" bit 1<<28)
11592 and SYMBOL is its name.
11594 `system-key-alist' has a separate binding for each terminal device.
11595 See Info node `(elisp)Multiple Terminals'. */);
11597 DEFVAR_KBOARD ("local-function-key-map", Vlocal_function_key_map,
11598 doc: /* Keymap that translates key sequences to key sequences during input.
11599 This is used mainly for mapping key sequences into some preferred
11600 key events (symbols).
11602 The `read-key-sequence' function replaces any subsequence bound by
11603 `local-function-key-map' with its binding. More precisely, when the
11604 active keymaps have no binding for the current key sequence but
11605 `local-function-key-map' binds a suffix of the sequence to a vector or
11606 string, `read-key-sequence' replaces the matching suffix with its
11607 binding, and continues with the new sequence.
11609 If the binding is a function, it is called with one argument (the prompt)
11610 and its return value (a key sequence) is used.
11612 The events that come from bindings in `local-function-key-map' are not
11613 themselves looked up in `local-function-key-map'.
11615 For example, suppose `local-function-key-map' binds `ESC O P' to [f1].
11616 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
11617 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix key,
11618 typing `ESC O P x' would return [f1 x].
11620 `local-function-key-map' has a separate binding for each terminal
11621 device. See Info node `(elisp)Multiple Terminals'. If you need to
11622 define a binding on all terminals, change `function-key-map'
11623 instead. Initially, `local-function-key-map' is an empty keymap that
11624 has `function-key-map' as its parent on all terminal devices. */);
11626 DEFVAR_KBOARD ("input-decode-map", Vinput_decode_map,
11627 doc: /* Keymap that decodes input escape sequences.
11628 This is used mainly for mapping ASCII function key sequences into
11629 real Emacs function key events (symbols).
11631 The `read-key-sequence' function replaces any subsequence bound by
11632 `input-decode-map' with its binding. Contrary to `function-key-map',
11633 this map applies its rebinding regardless of the presence of an ordinary
11634 binding. So it is more like `key-translation-map' except that it applies
11635 before `function-key-map' rather than after.
11637 If the binding is a function, it is called with one argument (the prompt)
11638 and its return value (a key sequence) is used.
11640 The events that come from bindings in `input-decode-map' are not
11641 themselves looked up in `input-decode-map'. */);
11643 DEFVAR_LISP ("function-key-map", Vfunction_key_map,
11644 doc: /* The parent keymap of all `local-function-key-map' instances.
11645 Function key definitions that apply to all terminal devices should go
11646 here. If a mapping is defined in both the current
11647 `local-function-key-map' binding and this variable, then the local
11648 definition will take precedence. */);
11649 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
11651 DEFVAR_LISP ("key-translation-map", Vkey_translation_map,
11652 doc: /* Keymap of key translations that can override keymaps.
11653 This keymap works like `input-decode-map', but comes after `function-key-map'.
11654 Another difference is that it is global rather than terminal-local. */);
11655 Vkey_translation_map = Fmake_sparse_keymap (Qnil);
11657 DEFVAR_LISP ("deferred-action-list", Vdeferred_action_list,
11658 doc: /* List of deferred actions to be performed at a later time.
11659 The precise format isn't relevant here; we just check whether it is nil. */);
11660 Vdeferred_action_list = Qnil;
11662 DEFVAR_LISP ("deferred-action-function", Vdeferred_action_function,
11663 doc: /* Function to call to handle deferred actions, after each command.
11664 This function is called with no arguments after each command
11665 whenever `deferred-action-list' is non-nil. */);
11666 Vdeferred_action_function = Qnil;
11668 DEFVAR_LISP ("delayed-warnings-list", Vdelayed_warnings_list,
11669 doc: /* List of warnings to be displayed after this command.
11670 Each element must be a list (TYPE MESSAGE [LEVEL [BUFFER-NAME]]),
11671 as per the args of `display-warning' (which see).
11672 If this variable is non-nil, `delayed-warnings-hook' will be run
11673 immediately after running `post-command-hook'. */);
11674 Vdelayed_warnings_list = Qnil;
11676 DEFVAR_LISP ("timer-list", Vtimer_list,
11677 doc: /* List of active absolute time timers in order of increasing time. */);
11678 Vtimer_list = Qnil;
11680 DEFVAR_LISP ("timer-idle-list", Vtimer_idle_list,
11681 doc: /* List of active idle-time timers in order of increasing time. */);
11682 Vtimer_idle_list = Qnil;
11684 DEFVAR_LISP ("input-method-function", Vinput_method_function,
11685 doc: /* If non-nil, the function that implements the current input method.
11686 It's called with one argument, a printing character that was just read.
11687 \(That means a character with code 040...0176.)
11688 Typically this function uses `read-event' to read additional events.
11689 When it does so, it should first bind `input-method-function' to nil
11690 so it will not be called recursively.
11692 The function should return a list of zero or more events
11693 to be used as input. If it wants to put back some events
11694 to be reconsidered, separately, by the input method,
11695 it can add them to the beginning of `unread-command-events'.
11697 The input method function can find in `input-method-previous-message'
11698 the previous echo area message.
11700 The input method function should refer to the variables
11701 `input-method-use-echo-area' and `input-method-exit-on-first-char'
11702 for guidance on what to do. */);
11703 Vinput_method_function = Qnil;
11705 DEFVAR_LISP ("input-method-previous-message",
11706 Vinput_method_previous_message,
11707 doc: /* When `input-method-function' is called, hold the previous echo area message.
11708 This variable exists because `read-event' clears the echo area
11709 before running the input method. It is nil if there was no message. */);
11710 Vinput_method_previous_message = Qnil;
11712 DEFVAR_LISP ("show-help-function", Vshow_help_function,
11713 doc: /* If non-nil, the function that implements the display of help.
11714 It's called with one argument, the help string to display. */);
11715 Vshow_help_function = Qnil;
11717 DEFVAR_LISP ("disable-point-adjustment", Vdisable_point_adjustment,
11718 doc: /* If non-nil, suppress point adjustment after executing a command.
11720 After a command is executed, if point is moved into a region that has
11721 special properties (e.g. composition, display), we adjust point to
11722 the boundary of the region. But, when a command sets this variable to
11723 non-nil, we suppress the point adjustment.
11725 This variable is set to nil before reading a command, and is checked
11726 just after executing the command. */);
11727 Vdisable_point_adjustment = Qnil;
11729 DEFVAR_LISP ("global-disable-point-adjustment",
11730 Vglobal_disable_point_adjustment,
11731 doc: /* If non-nil, always suppress point adjustment.
11733 The default value is nil, in which case, point adjustment are
11734 suppressed only after special commands that set
11735 `disable-point-adjustment' (which see) to non-nil. */);
11736 Vglobal_disable_point_adjustment = Qnil;
11738 DEFVAR_LISP ("minibuffer-message-timeout", Vminibuffer_message_timeout,
11739 doc: /* How long to display an echo-area message when the minibuffer is active.
11740 If the value is not a number, such messages don't time out. */);
11741 Vminibuffer_message_timeout = make_number (2);
11743 DEFVAR_LISP ("throw-on-input", Vthrow_on_input,
11744 doc: /* If non-nil, any keyboard input throws to this symbol.
11745 The value of that variable is passed to `quit-flag' and later causes a
11746 peculiar kind of quitting. */);
11747 Vthrow_on_input = Qnil;
11749 DEFVAR_LISP ("command-error-function", Vcommand_error_function,
11750 doc: /* Function to output error messages.
11751 Called with three arguments:
11752 - the error data, a list of the form (SIGNALED-CONDITION . SIGNAL-DATA)
11753 such as what `condition-case' would bind its variable to,
11754 - the context (a string which normally goes at the start of the message),
11755 - the Lisp function within which the error was signaled. */);
11756 Vcommand_error_function = intern ("command-error-default-function");
11758 DEFVAR_LISP ("enable-disabled-menus-and-buttons",
11759 Venable_disabled_menus_and_buttons,
11760 doc: /* If non-nil, don't ignore events produced by disabled menu items and tool-bar.
11762 Help functions bind this to allow help on disabled menu items
11763 and tool-bar buttons. */);
11764 Venable_disabled_menus_and_buttons = Qnil;
11766 DEFVAR_LISP ("select-active-regions",
11767 Vselect_active_regions,
11768 doc: /* If non-nil, an active region automatically sets the primary selection.
11769 If the value is `only', only temporarily active regions (usually made
11770 by mouse-dragging or shift-selection) set the window selection.
11772 This takes effect only when Transient Mark mode is enabled. */);
11773 Vselect_active_regions = Qt;
11775 DEFVAR_LISP ("saved-region-selection",
11776 Vsaved_region_selection,
11777 doc: /* Contents of active region prior to buffer modification.
11778 If `select-active-regions' is non-nil, Emacs sets this to the
11779 text in the region before modifying the buffer. The next call to
11780 the function `deactivate-mark' uses this to set the window selection. */);
11781 Vsaved_region_selection = Qnil;
11783 DEFVAR_LISP ("selection-inhibit-update-commands",
11784 Vselection_inhibit_update_commands,
11785 doc: /* List of commands which should not update the selection.
11786 Normally, if `select-active-regions' is non-nil and the mark remains
11787 active after a command (i.e. the mark was not deactivated), the Emacs
11788 command loop sets the selection to the text in the region. However,
11789 if the command is in this list, the selection is not updated. */);
11790 Vselection_inhibit_update_commands
11791 = list2 (Qhandle_switch_frame, Qhandle_select_window);
11793 DEFVAR_LISP ("debug-on-event",
11794 Vdebug_on_event,
11795 doc: /* Enter debugger on this event. When Emacs
11796 receives the special event specified by this variable, it will try to
11797 break into the debugger as soon as possible instead of processing the
11798 event normally through `special-event-map'.
11800 Currently, the only supported values for this
11801 variable are `sigusr1' and `sigusr2'. */);
11802 Vdebug_on_event = intern_c_string ("sigusr2");
11804 /* Create the initial keyboard. Qt means 'unset'. */
11805 initial_kboard = allocate_kboard (Qt);
11808 void
11809 keys_of_keyboard (void)
11811 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
11812 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
11813 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
11814 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
11815 initial_define_key (meta_map, 'x', "execute-extended-command");
11817 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
11818 "handle-delete-frame");
11819 initial_define_lispy_key (Vspecial_event_map, "ns-put-working-text",
11820 "ns-put-working-text");
11821 initial_define_lispy_key (Vspecial_event_map, "ns-unput-working-text",
11822 "ns-unput-working-text");
11823 /* Here we used to use `ignore-event' which would simple set prefix-arg to
11824 current-prefix-arg, as is done in `handle-switch-frame'.
11825 But `handle-switch-frame is not run from the special-map.
11826 Commands from that map are run in a special way that automatically
11827 preserves the prefix-arg. Restoring the prefix arg here is not just
11828 redundant but harmful:
11829 - C-u C-x v =
11830 - current-prefix-arg is set to non-nil, prefix-arg is set to nil.
11831 - after the first prompt, the exit-minibuffer-hook is run which may
11832 iconify a frame and thus push a `iconify-frame' event.
11833 - after running exit-minibuffer-hook, current-prefix-arg is
11834 restored to the non-nil value it had before the prompt.
11835 - we enter the second prompt.
11836 current-prefix-arg is non-nil, prefix-arg is nil.
11837 - before running the first real event, we run the special iconify-frame
11838 event, but we pass the `special' arg to command-execute so
11839 current-prefix-arg and prefix-arg are left untouched.
11840 - here we foolishly copy the non-nil current-prefix-arg to prefix-arg.
11841 - the next key event will have a spuriously non-nil current-prefix-arg. */
11842 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
11843 "ignore");
11844 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
11845 "ignore");
11846 /* Handling it at such a low-level causes read_key_sequence to get
11847 * confused because it doesn't realize that the current_buffer was
11848 * changed by read_char.
11850 * initial_define_lispy_key (Vspecial_event_map, "select-window",
11851 * "handle-select-window"); */
11852 initial_define_lispy_key (Vspecial_event_map, "save-session",
11853 "handle-save-session");
11855 #ifdef HAVE_DBUS
11856 /* Define a special event which is raised for dbus callback
11857 functions. */
11858 initial_define_lispy_key (Vspecial_event_map, "dbus-event",
11859 "dbus-handle-event");
11860 #endif
11862 #ifdef USE_FILE_NOTIFY
11863 /* Define a special event which is raised for notification callback
11864 functions. */
11865 initial_define_lispy_key (Vspecial_event_map, "file-notify",
11866 "file-notify-handle-event");
11867 #endif /* USE_FILE_NOTIFY */
11869 initial_define_lispy_key (Vspecial_event_map, "config-changed-event",
11870 "ignore");
11871 #if defined (WINDOWSNT)
11872 initial_define_lispy_key (Vspecial_event_map, "language-change",
11873 "ignore");
11874 #endif
11875 initial_define_lispy_key (Vspecial_event_map, "focus-in",
11876 "handle-focus-in");
11877 initial_define_lispy_key (Vspecial_event_map, "focus-out",
11878 "handle-focus-out");
11881 /* Mark the pointers in the kboard objects.
11882 Called by Fgarbage_collect. */
11883 void
11884 mark_kboards (void)
11886 KBOARD *kb;
11887 Lisp_Object *p;
11888 for (kb = all_kboards; kb; kb = kb->next_kboard)
11890 if (kb->kbd_macro_buffer)
11891 for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
11892 mark_object (*p);
11893 mark_object (KVAR (kb, Voverriding_terminal_local_map));
11894 mark_object (KVAR (kb, Vlast_command));
11895 mark_object (KVAR (kb, Vreal_last_command));
11896 mark_object (KVAR (kb, Vkeyboard_translate_table));
11897 mark_object (KVAR (kb, Vlast_repeatable_command));
11898 mark_object (KVAR (kb, Vprefix_arg));
11899 mark_object (KVAR (kb, Vlast_prefix_arg));
11900 mark_object (KVAR (kb, kbd_queue));
11901 mark_object (KVAR (kb, defining_kbd_macro));
11902 mark_object (KVAR (kb, Vlast_kbd_macro));
11903 mark_object (KVAR (kb, Vsystem_key_alist));
11904 mark_object (KVAR (kb, system_key_syms));
11905 mark_object (KVAR (kb, Vwindow_system));
11906 mark_object (KVAR (kb, Vinput_decode_map));
11907 mark_object (KVAR (kb, Vlocal_function_key_map));
11908 mark_object (KVAR (kb, Vdefault_minibuffer_frame));
11909 mark_object (KVAR (kb, echo_string));
11912 struct input_event *event;
11913 for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++)
11915 if (event == kbd_buffer + KBD_BUFFER_SIZE)
11916 event = kbd_buffer;
11917 /* These two special event types has no Lisp_Objects to mark. */
11918 if (event->kind != SELECTION_REQUEST_EVENT
11919 && event->kind != SELECTION_CLEAR_EVENT)
11921 mark_object (event->x);
11922 mark_object (event->y);
11923 mark_object (event->frame_or_window);
11924 mark_object (event->arg);