Subject: Restore correct Gnus newsgroup name after sending message
[emacs.git] / src / keyboard.c
blobd41603b2e50aee9dbd7d017cdf989651e0e48377
1 /* Keyboard and mouse input; editor command loop.
3 Copyright (C) 1985-1989, 1993-1997, 1999-2017 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 (at
11 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 <sys/stat.h>
25 #include "lisp.h"
26 #include "coding.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 "dispextern.h"
38 #include "syntax.h"
39 #include "intervals.h"
40 #include "keymap.h"
41 #include "blockinput.h"
42 #include "systime.h"
43 #include "atimer.h"
44 #include "process.h"
45 #include <errno.h>
47 #ifdef HAVE_PTHREAD
48 #include <pthread.h>
49 #endif
50 #ifdef MSDOS
51 #include "msdos.h"
52 #include <time.h>
53 #else /* not MSDOS */
54 #include <sys/ioctl.h>
55 #endif /* not MSDOS */
57 #if defined USABLE_FIONREAD && defined USG5_4
58 # include <sys/filio.h>
59 #endif
61 #include "syssignal.h"
63 #include <sys/types.h>
64 #include <unistd.h>
65 #include <fcntl.h>
67 #include <ignore-value.h>
69 #ifdef HAVE_WINDOW_SYSTEM
70 #include TERM_HEADER
71 #endif /* HAVE_WINDOW_SYSTEM */
73 /* Work around GCC bug 54561. */
74 #if GNUC_PREREQ (4, 3, 0)
75 # pragma GCC diagnostic ignored "-Wclobbered"
76 #endif
78 #ifdef WINDOWSNT
79 char const DEV_TTY[] = "CONOUT$";
80 #else
81 char const DEV_TTY[] = "/dev/tty";
82 #endif
84 /* Variables for blockinput.h: */
86 /* Positive if interrupt input is blocked right now. */
87 volatile int interrupt_input_blocked;
89 /* True means an input interrupt or alarm signal has arrived.
90 The maybe_quit function checks this. */
91 volatile bool pending_signals;
93 #define KBD_BUFFER_SIZE 4096
95 KBOARD *initial_kboard;
96 KBOARD *current_kboard;
97 static KBOARD *all_kboards;
99 /* True in the single-kboard state, false in the any-kboard state. */
100 static bool single_kboard;
102 #define NUM_RECENT_KEYS (300)
104 /* Index for storing next element into recent_keys. */
105 static int recent_keys_index;
107 /* Total number of elements stored into recent_keys. */
108 static int total_keys;
110 /* This vector holds the last NUM_RECENT_KEYS keystrokes. */
111 static Lisp_Object recent_keys;
113 /* Vector holding the key sequence that invoked the current command.
114 It is reused for each command, and it may be longer than the current
115 sequence; this_command_key_count indicates how many elements
116 actually mean something.
117 It's easier to staticpro a single Lisp_Object than an array. */
118 Lisp_Object this_command_keys;
119 ptrdiff_t this_command_key_count;
121 /* This vector is used as a buffer to record the events that were actually read
122 by read_key_sequence. */
123 static Lisp_Object raw_keybuf;
124 static int raw_keybuf_count;
126 #define GROW_RAW_KEYBUF \
127 if (raw_keybuf_count == ASIZE (raw_keybuf)) \
128 raw_keybuf = larger_vector (raw_keybuf, 1, -1)
130 /* Number of elements of this_command_keys
131 that precede this key sequence. */
132 static ptrdiff_t this_single_command_key_start;
134 #ifdef HAVE_STACK_OVERFLOW_HANDLING
136 /* For longjmp to recover from C stack overflow. */
137 sigjmp_buf return_to_command_loop;
139 /* Message displayed by Vtop_level when recovering from C stack overflow. */
140 static Lisp_Object recover_top_level_message;
142 #endif /* HAVE_STACK_OVERFLOW_HANDLING */
144 /* Message normally displayed by Vtop_level. */
145 static Lisp_Object regular_top_level_message;
147 /* For longjmp to where kbd input is being done. */
149 static sys_jmp_buf getcjmp;
151 /* True while displaying for echoing. Delays C-g throwing. */
153 static bool echoing;
155 /* Non-null means we can start echoing at the next input pause even
156 though there is something in the echo area. */
158 static struct kboard *ok_to_echo_at_next_pause;
160 /* The kboard last echoing, or null for none. Reset to 0 in
161 cancel_echoing. If non-null, and a current echo area message
162 exists, and echo_message_buffer is eq to the current message
163 buffer, we know that the message comes from echo_kboard. */
165 struct kboard *echo_kboard;
167 /* The buffer used for echoing. Set in echo_now, reset in
168 cancel_echoing. */
170 Lisp_Object echo_message_buffer;
172 /* True means C-g should cause immediate error-signal. */
173 bool immediate_quit;
175 /* Character that causes a quit. Normally C-g.
177 If we are running on an ordinary terminal, this must be an ordinary
178 ASCII char, since we want to make it our interrupt character.
180 If we are not running on an ordinary terminal, it still needs to be
181 an ordinary ASCII char. This character needs to be recognized in
182 the input interrupt handler. At this point, the keystroke is
183 represented as a struct input_event, while the desired quit
184 character is specified as a lispy event. The mapping from struct
185 input_events to lispy events cannot run in an interrupt handler,
186 and the reverse mapping is difficult for anything but ASCII
187 keystrokes.
189 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
190 ASCII character. */
191 int quit_char;
193 /* Current depth in recursive edits. */
194 EMACS_INT command_loop_level;
196 /* If not Qnil, this is a switch-frame event which we decided to put
197 off until the end of a key sequence. This should be read as the
198 next command input, after any unread_command_events.
200 read_key_sequence uses this to delay switch-frame events until the
201 end of the key sequence; Fread_char uses it to put off switch-frame
202 events until a non-ASCII event is acceptable as input. */
203 Lisp_Object unread_switch_frame;
205 /* Last size recorded for a current buffer which is not a minibuffer. */
206 static ptrdiff_t last_non_minibuf_size;
208 uintmax_t num_input_events;
209 ptrdiff_t point_before_last_command_or_undo;
210 struct buffer *buffer_before_last_command_or_undo;
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 union buffered_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 union buffered_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 union buffered_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 restore_kboard_configuration (int);
376 static void handle_interrupt (bool);
377 static _Noreturn void quit_throw_to_read_char (bool);
378 static void timer_start_idle (void);
379 static void timer_stop_idle (void);
380 static void timer_resume_idle (void);
381 static void deliver_user_signal (int);
382 static char *find_user_signal_name (int);
383 static void store_user_signal_events (void);
385 /* These setters are used only in this file, so they can be private. */
386 static void
387 kset_echo_string (struct kboard *kb, Lisp_Object val)
389 kb->echo_string_ = val;
391 static void
392 kset_echo_prompt (struct kboard *kb, Lisp_Object val)
394 kb->echo_prompt_ = val;
396 static void
397 kset_kbd_queue (struct kboard *kb, Lisp_Object val)
399 kb->kbd_queue_ = val;
401 static void
402 kset_keyboard_translate_table (struct kboard *kb, Lisp_Object val)
404 kb->Vkeyboard_translate_table_ = val;
406 static void
407 kset_last_prefix_arg (struct kboard *kb, Lisp_Object val)
409 kb->Vlast_prefix_arg_ = val;
411 static void
412 kset_last_repeatable_command (struct kboard *kb, Lisp_Object val)
414 kb->Vlast_repeatable_command_ = val;
416 static void
417 kset_local_function_key_map (struct kboard *kb, Lisp_Object val)
419 kb->Vlocal_function_key_map_ = val;
421 static void
422 kset_overriding_terminal_local_map (struct kboard *kb, Lisp_Object val)
424 kb->Voverriding_terminal_local_map_ = val;
426 static void
427 kset_real_last_command (struct kboard *kb, Lisp_Object val)
429 kb->Vreal_last_command_ = val;
431 static void
432 kset_system_key_syms (struct kboard *kb, Lisp_Object val)
434 kb->system_key_syms_ = val;
438 static bool
439 echo_keystrokes_p (void)
441 return (FLOATP (Vecho_keystrokes) ? XFLOAT_DATA (Vecho_keystrokes) > 0.0
442 : INTEGERP (Vecho_keystrokes) ? XINT (Vecho_keystrokes) > 0
443 : false);
446 /* Add C to the echo string, without echoing it immediately. C can be
447 a character, which is pretty-printed, or a symbol, whose name is
448 printed. */
450 static void
451 echo_add_key (Lisp_Object c)
453 char initbuf[KEY_DESCRIPTION_SIZE + 100];
454 ptrdiff_t size = sizeof initbuf;
455 char *buffer = initbuf;
456 char *ptr = buffer;
457 Lisp_Object echo_string = KVAR (current_kboard, echo_string);
458 USE_SAFE_ALLOCA;
460 if (STRINGP (echo_string) && SCHARS (echo_string) > 0)
461 /* Add a space at the end as a separator between keys. */
462 ptr++[0] = ' ';
464 /* If someone has passed us a composite event, use its head symbol. */
465 c = EVENT_HEAD (c);
467 if (INTEGERP (c))
468 ptr = push_key_description (XINT (c), ptr);
469 else if (SYMBOLP (c))
471 Lisp_Object name = SYMBOL_NAME (c);
472 ptrdiff_t nbytes = SBYTES (name);
474 if (size - (ptr - buffer) < nbytes)
476 ptrdiff_t offset = ptr - buffer;
477 size = max (2 * size, size + nbytes);
478 buffer = SAFE_ALLOCA (size);
479 ptr = buffer + offset;
482 ptr += copy_text (SDATA (name), (unsigned char *) ptr, nbytes,
483 STRING_MULTIBYTE (name), 1);
486 if ((NILP (echo_string) || SCHARS (echo_string) == 0)
487 && help_char_p (c))
489 static const char text[] = " (Type ? for further options)";
490 int len = sizeof text - 1;
492 if (size - (ptr - buffer) < len)
494 ptrdiff_t offset = ptr - buffer;
495 size += len;
496 buffer = SAFE_ALLOCA (size);
497 ptr = buffer + offset;
500 memcpy (ptr, text, len);
501 ptr += len;
504 kset_echo_string
505 (current_kboard,
506 concat2 (echo_string, make_string (buffer, ptr - buffer)));
507 SAFE_FREE ();
510 /* Temporarily add a dash to the end of the echo string if it's not
511 empty, so that it serves as a mini-prompt for the very next
512 character. */
514 static void
515 echo_dash (void)
517 /* Do nothing if not echoing at all. */
518 if (NILP (KVAR (current_kboard, echo_string)))
519 return;
521 if (!current_kboard->immediate_echo
522 && SCHARS (KVAR (current_kboard, echo_string)) == 0)
523 return;
525 /* Do nothing if we just printed a prompt. */
526 if (STRINGP (KVAR (current_kboard, echo_prompt))
527 && (SCHARS (KVAR (current_kboard, echo_prompt))
528 == SCHARS (KVAR (current_kboard, echo_string))))
529 return;
531 /* Do nothing if we have already put a dash at the end. */
532 if (SCHARS (KVAR (current_kboard, echo_string)) > 1)
534 Lisp_Object last_char, prev_char, idx;
536 idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 2);
537 prev_char = Faref (KVAR (current_kboard, echo_string), idx);
539 idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 1);
540 last_char = Faref (KVAR (current_kboard, echo_string), idx);
542 if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
543 return;
546 /* Put a dash at the end of the buffer temporarily,
547 but make it go away when the next character is added. */
548 AUTO_STRING (dash, "-");
549 kset_echo_string (current_kboard,
550 concat2 (KVAR (current_kboard, echo_string), dash));
551 echo_now ();
554 static void
555 echo_update (void)
557 if (current_kboard->immediate_echo)
559 ptrdiff_t i;
560 Lisp_Object prompt = KVAR (current_kboard, echo_prompt);
561 Lisp_Object prefix = call0 (Qinternal_echo_keystrokes_prefix);
562 kset_echo_string (current_kboard,
563 NILP (prompt) ? prefix
564 : NILP (prefix) ? prompt
565 : concat2 (prompt, prefix));
567 for (i = 0; i < this_command_key_count; i++)
569 Lisp_Object c;
571 c = AREF (this_command_keys, i);
572 if (! (EVENT_HAS_PARAMETERS (c)
573 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
574 echo_add_key (c);
577 echo_now ();
581 /* Display the current echo string, and begin echoing if not already
582 doing so. */
584 static void
585 echo_now (void)
587 if (!current_kboard->immediate_echo
588 /* This test breaks calls that use `echo_now' to display the echo_prompt.
589 && echo_keystrokes_p () */)
591 current_kboard->immediate_echo = true;
592 echo_update ();
593 /* Put a dash at the end to invite the user to type more. */
594 echo_dash ();
597 echoing = true;
598 /* FIXME: Use call (Qmessage) so it can be advised (e.g. emacspeak). */
599 message3_nolog (KVAR (current_kboard, echo_string));
600 echoing = false;
602 /* Record in what buffer we echoed, and from which kboard. */
603 echo_message_buffer = echo_area_buffer[0];
604 echo_kboard = current_kboard;
606 if (waiting_for_input && !NILP (Vquit_flag))
607 quit_throw_to_read_char (0);
610 /* Turn off echoing, for the start of a new command. */
612 void
613 cancel_echoing (void)
615 current_kboard->immediate_echo = false;
616 kset_echo_prompt (current_kboard, Qnil);
617 kset_echo_string (current_kboard, Qnil);
618 ok_to_echo_at_next_pause = NULL;
619 echo_kboard = NULL;
620 echo_message_buffer = Qnil;
623 /* Return the length of the current echo string. */
625 static ptrdiff_t
626 echo_length (void)
628 return (STRINGP (KVAR (current_kboard, echo_string))
629 ? SCHARS (KVAR (current_kboard, echo_string))
630 : 0);
633 /* Truncate the current echo message to its first LEN chars.
634 This and echo_char get used by read_key_sequence when the user
635 switches frames while entering a key sequence. */
637 static void
638 echo_truncate (ptrdiff_t nchars)
640 if (STRINGP (KVAR (current_kboard, echo_string)))
641 kset_echo_string (current_kboard,
642 Fsubstring (KVAR (current_kboard, echo_string),
643 make_number (0), make_number (nchars)));
644 truncate_echo_area (nchars);
648 /* Functions for manipulating this_command_keys. */
649 static void
650 add_command_key (Lisp_Object key)
652 if (this_command_key_count >= ASIZE (this_command_keys))
653 this_command_keys = larger_vector (this_command_keys, 1, -1);
655 ASET (this_command_keys, this_command_key_count, key);
656 ++this_command_key_count;
660 Lisp_Object
661 recursive_edit_1 (void)
663 ptrdiff_t count = SPECPDL_INDEX ();
664 Lisp_Object val;
666 if (command_loop_level > 0)
668 specbind (Qstandard_output, Qt);
669 specbind (Qstandard_input, Qt);
672 #ifdef HAVE_WINDOW_SYSTEM
673 /* The command loop has started an hourglass timer, so we have to
674 cancel it here, otherwise it will fire because the recursive edit
675 can take some time. Do not check for display_hourglass_p here,
676 because it could already be nil. */
677 cancel_hourglass ();
678 #endif
680 /* This function may have been called from a debugger called from
681 within redisplay, for instance by Edebugging a function called
682 from fontification-functions. We want to allow redisplay in
683 the debugging session.
685 The recursive edit is left with a `(throw exit ...)'. The `exit'
686 tag is not caught anywhere in redisplay, i.e. when we leave the
687 recursive edit, the original redisplay leading to the recursive
688 edit will be unwound. The outcome should therefore be safe. */
689 specbind (Qinhibit_redisplay, Qnil);
690 redisplaying_p = 0;
692 /* This variable stores buffers that have changed so that an undo
693 boundary can be added. specbind this so that changes in the
694 recursive edit will not result in undo boundaries in buffers
695 changed before we entered there recursive edit.
696 See Bug #23632.
698 specbind (Qundo_auto__undoably_changed_buffers, Qnil);
700 val = command_loop ();
701 if (EQ (val, Qt))
702 quit ();
703 /* Handle throw from read_minibuf when using minibuffer
704 while it's active but we're in another window. */
705 if (STRINGP (val))
706 xsignal1 (Qerror, val);
708 return unbind_to (count, Qnil);
711 /* When an auto-save happens, record the "time", and don't do again soon. */
713 void
714 record_auto_save (void)
716 last_auto_save = num_nonmacro_input_events;
719 /* Make an auto save happen as soon as possible at command level. */
721 #ifdef SIGDANGER
722 void
723 force_auto_save_soon (void)
725 last_auto_save = - auto_save_interval - 1;
727 record_asynch_buffer_change ();
729 #endif
731 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
732 doc: /* Invoke the editor command loop recursively.
733 To get out of the recursive edit, a command can throw to `exit' -- for
734 instance (throw \\='exit nil).
735 If you throw a value other than t, `recursive-edit' returns normally
736 to the function that called it. Throwing a t value causes
737 `recursive-edit' to quit, so that control returns to the command loop
738 one level up.
740 This function is called by the editor initialization to begin editing. */)
741 (void)
743 ptrdiff_t count = SPECPDL_INDEX ();
744 Lisp_Object buffer;
746 /* If we enter while input is blocked, don't lock up here.
747 This may happen through the debugger during redisplay. */
748 if (input_blocked_p ())
749 return Qnil;
751 if (command_loop_level >= 0
752 && current_buffer != XBUFFER (XWINDOW (selected_window)->contents))
753 buffer = Fcurrent_buffer ();
754 else
755 buffer = Qnil;
757 /* Don't do anything interesting between the increment and the
758 record_unwind_protect! Otherwise, we could get distracted and
759 never decrement the counter again. */
760 command_loop_level++;
761 update_mode_lines = 17;
762 record_unwind_protect (recursive_edit_unwind, buffer);
764 /* If we leave recursive_edit_1 below with a `throw' for instance,
765 like it is done in the splash screen display, we have to
766 make sure that we restore single_kboard as command_loop_1
767 would have done if it were left normally. */
768 if (command_loop_level > 0)
769 temporarily_switch_to_single_kboard (SELECTED_FRAME ());
771 recursive_edit_1 ();
772 return unbind_to (count, Qnil);
775 void
776 recursive_edit_unwind (Lisp_Object buffer)
778 if (BUFFERP (buffer))
779 Fset_buffer (buffer);
781 command_loop_level--;
782 update_mode_lines = 18;
786 #if 0 /* These two functions are now replaced with
787 temporarily_switch_to_single_kboard. */
788 static void
789 any_kboard_state ()
791 #if 0 /* Theory: if there's anything in Vunread_command_events,
792 it will right away be read by read_key_sequence,
793 and then if we do switch KBOARDS, it will go into the side
794 queue then. So we don't need to do anything special here -- rms. */
795 if (CONSP (Vunread_command_events))
797 current_kboard->kbd_queue
798 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
799 current_kboard->kbd_queue_has_data = true;
801 Vunread_command_events = Qnil;
802 #endif
803 single_kboard = false;
806 /* Switch to the single-kboard state, making current_kboard
807 the only KBOARD from which further input is accepted. */
809 void
810 single_kboard_state ()
812 single_kboard = true;
814 #endif
816 /* If we're in single_kboard state for kboard KBOARD,
817 get out of it. */
819 void
820 not_single_kboard_state (KBOARD *kboard)
822 if (kboard == current_kboard)
823 single_kboard = false;
826 /* Maintain a stack of kboards, so other parts of Emacs
827 can switch temporarily to the kboard of a given frame
828 and then revert to the previous status. */
830 struct kboard_stack
832 KBOARD *kboard;
833 struct kboard_stack *next;
836 static struct kboard_stack *kboard_stack;
838 void
839 push_kboard (struct kboard *k)
841 struct kboard_stack *p = xmalloc (sizeof *p);
843 p->next = kboard_stack;
844 p->kboard = current_kboard;
845 kboard_stack = p;
847 current_kboard = k;
850 void
851 pop_kboard (void)
853 struct terminal *t;
854 struct kboard_stack *p = kboard_stack;
855 bool found = false;
856 for (t = terminal_list; t; t = t->next_terminal)
858 if (t->kboard == p->kboard)
860 current_kboard = p->kboard;
861 found = true;
862 break;
865 if (!found)
867 /* The terminal we remembered has been deleted. */
868 current_kboard = FRAME_KBOARD (SELECTED_FRAME ());
869 single_kboard = false;
871 kboard_stack = p->next;
872 xfree (p);
875 /* Switch to single_kboard mode, making current_kboard the only KBOARD
876 from which further input is accepted. If F is non-nil, set its
877 KBOARD as the current keyboard.
879 This function uses record_unwind_protect_int to return to the previous
880 state later.
882 If Emacs is already in single_kboard mode, and F's keyboard is
883 locked, then this function will throw an error. */
885 void
886 temporarily_switch_to_single_kboard (struct frame *f)
888 bool was_locked = single_kboard;
889 if (was_locked)
891 if (f != NULL && FRAME_KBOARD (f) != current_kboard)
892 /* We can not switch keyboards while in single_kboard mode.
893 In rare cases, Lisp code may call `recursive-edit' (or
894 `read-minibuffer' or `y-or-n-p') after it switched to a
895 locked frame. For example, this is likely to happen
896 when server.el connects to a new terminal while Emacs is in
897 single_kboard mode. It is best to throw an error instead
898 of presenting the user with a frozen screen. */
899 error ("Terminal %d is locked, cannot read from it",
900 FRAME_TERMINAL (f)->id);
901 else
902 /* This call is unnecessary, but helps
903 `restore_kboard_configuration' discover if somebody changed
904 `current_kboard' behind our back. */
905 push_kboard (current_kboard);
907 else if (f != NULL)
908 current_kboard = FRAME_KBOARD (f);
909 single_kboard = true;
910 record_unwind_protect_int (restore_kboard_configuration, was_locked);
913 #if 0 /* This function is not needed anymore. */
914 void
915 record_single_kboard_state ()
917 if (single_kboard)
918 push_kboard (current_kboard);
919 record_unwind_protect_int (restore_kboard_configuration, single_kboard);
921 #endif
923 static void
924 restore_kboard_configuration (int was_locked)
926 single_kboard = was_locked;
927 if (was_locked)
929 struct kboard *prev = current_kboard;
930 pop_kboard ();
931 /* The pop should not change the kboard. */
932 if (single_kboard && current_kboard != prev)
933 emacs_abort ();
938 /* Handle errors that are not handled at inner levels
939 by printing an error message and returning to the editor command loop. */
941 static Lisp_Object
942 cmd_error (Lisp_Object data)
944 Lisp_Object old_level, old_length;
945 char macroerror[sizeof "After..kbd macro iterations: "
946 + INT_STRLEN_BOUND (EMACS_INT)];
948 #ifdef HAVE_WINDOW_SYSTEM
949 if (display_hourglass_p)
950 cancel_hourglass ();
951 #endif
953 if (!NILP (executing_kbd_macro))
955 if (executing_kbd_macro_iterations == 1)
956 sprintf (macroerror, "After 1 kbd macro iteration: ");
957 else
958 sprintf (macroerror, "After %"pI"d kbd macro iterations: ",
959 executing_kbd_macro_iterations);
961 else
962 *macroerror = 0;
964 Vstandard_output = Qt;
965 Vstandard_input = Qt;
966 Vexecuting_kbd_macro = Qnil;
967 executing_kbd_macro = Qnil;
968 kset_prefix_arg (current_kboard, Qnil);
969 kset_last_prefix_arg (current_kboard, Qnil);
970 cancel_echoing ();
972 /* Avoid unquittable loop if data contains a circular list. */
973 old_level = Vprint_level;
974 old_length = Vprint_length;
975 XSETFASTINT (Vprint_level, 10);
976 XSETFASTINT (Vprint_length, 10);
977 cmd_error_internal (data, macroerror);
978 Vprint_level = old_level;
979 Vprint_length = old_length;
981 Vquit_flag = Qnil;
982 Vinhibit_quit = Qnil;
984 return make_number (0);
987 /* Take actions on handling an error. DATA is the data that describes
988 the error.
990 CONTEXT is a C-string containing ASCII characters only which
991 describes the context in which the error happened. If we need to
992 generalize CONTEXT to allow multibyte characters, make it a Lisp
993 string. */
995 void
996 cmd_error_internal (Lisp_Object data, const char *context)
998 /* The immediate context is not interesting for Quits,
999 since they are asynchronous. */
1000 if (EQ (XCAR (data), Qquit))
1001 Vsignaling_function = Qnil;
1003 Vquit_flag = Qnil;
1004 Vinhibit_quit = Qt;
1006 /* Use user's specified output function if any. */
1007 if (!NILP (Vcommand_error_function))
1008 call3 (Vcommand_error_function, data,
1009 context ? build_string (context) : empty_unibyte_string,
1010 Vsignaling_function);
1012 Vsignaling_function = Qnil;
1015 DEFUN ("command-error-default-function", Fcommand_error_default_function,
1016 Scommand_error_default_function, 3, 3, 0,
1017 doc: /* Produce default output for unhandled error message.
1018 Default value of `command-error-function'. */)
1019 (Lisp_Object data, Lisp_Object context, Lisp_Object signal)
1021 struct frame *sf = SELECTED_FRAME ();
1023 CHECK_STRING (context);
1025 /* If the window system or terminal frame hasn't been initialized
1026 yet, or we're not interactive, write the message to stderr and exit. */
1027 if (!sf->glyphs_initialized_p
1028 /* The initial frame is a special non-displaying frame. It
1029 will be current in daemon mode when there are no frames
1030 to display, and in non-daemon mode before the real frame
1031 has finished initializing. If an error is thrown in the
1032 latter case while creating the frame, then the frame
1033 will never be displayed, so the safest thing to do is
1034 write to stderr and quit. In daemon mode, there are
1035 many other potential errors that do not prevent frames
1036 from being created, so continuing as normal is better in
1037 that case. */
1038 || (!IS_DAEMON && FRAME_INITIAL_P (sf))
1039 || noninteractive)
1041 print_error_message (data, Qexternal_debugging_output,
1042 SSDATA (context), signal);
1043 Fterpri (Qexternal_debugging_output, Qnil);
1044 Fkill_emacs (make_number (-1));
1046 else
1048 clear_message (1, 0);
1049 Fdiscard_input ();
1050 message_log_maybe_newline ();
1051 bitch_at_user ();
1053 print_error_message (data, Qt, SSDATA (context), signal);
1055 return Qnil;
1058 static Lisp_Object command_loop_2 (Lisp_Object);
1059 static Lisp_Object top_level_1 (Lisp_Object);
1061 /* Entry to editor-command-loop.
1062 This level has the catches for exiting/returning to editor command loop.
1063 It returns nil to exit recursive edit, t to abort it. */
1065 Lisp_Object
1066 command_loop (void)
1068 #ifdef HAVE_STACK_OVERFLOW_HANDLING
1069 /* At least on GNU/Linux, saving signal mask is important here. */
1070 if (sigsetjmp (return_to_command_loop, 1) != 0)
1072 /* Comes here from handle_sigsegv (see sysdep.c) and
1073 stack_overflow_handler (see w32fns.c). */
1074 #ifdef WINDOWSNT
1075 w32_reset_stack_overflow_guard ();
1076 #endif
1077 init_eval ();
1078 Vinternal__top_level_message = recover_top_level_message;
1080 else
1081 Vinternal__top_level_message = regular_top_level_message;
1082 #endif /* HAVE_STACK_OVERFLOW_HANDLING */
1083 if (command_loop_level > 0 || minibuf_level > 0)
1085 Lisp_Object val;
1086 val = internal_catch (Qexit, command_loop_2, Qnil);
1087 executing_kbd_macro = Qnil;
1088 return val;
1090 else
1091 while (1)
1093 internal_catch (Qtop_level, top_level_1, Qnil);
1094 internal_catch (Qtop_level, command_loop_2, Qnil);
1095 executing_kbd_macro = Qnil;
1097 /* End of file in -batch run causes exit here. */
1098 if (noninteractive)
1099 Fkill_emacs (Qt);
1103 /* Here we catch errors in execution of commands within the
1104 editing loop, and reenter the editing loop.
1105 When there is an error, cmd_error runs and returns a non-nil
1106 value to us. A value of nil means that command_loop_1 itself
1107 returned due to end of file (or end of kbd macro). */
1109 static Lisp_Object
1110 command_loop_2 (Lisp_Object ignore)
1112 register Lisp_Object val;
1115 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1116 while (!NILP (val));
1118 return Qnil;
1121 static Lisp_Object
1122 top_level_2 (void)
1124 return Feval (Vtop_level, Qnil);
1127 static Lisp_Object
1128 top_level_1 (Lisp_Object ignore)
1130 /* On entry to the outer level, run the startup file. */
1131 if (!NILP (Vtop_level))
1132 internal_condition_case (top_level_2, Qerror, cmd_error);
1133 else if (!NILP (Vpurify_flag))
1134 message1 ("Bare impure Emacs (standard Lisp code not loaded)");
1135 else
1136 message1 ("Bare Emacs (standard Lisp code not loaded)");
1137 return Qnil;
1140 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1141 doc: /* Exit all recursive editing levels.
1142 This also exits all active minibuffers. */
1143 attributes: noreturn)
1144 (void)
1146 #ifdef HAVE_WINDOW_SYSTEM
1147 if (display_hourglass_p)
1148 cancel_hourglass ();
1149 #endif
1151 /* Unblock input if we enter with input blocked. This may happen if
1152 redisplay traps e.g. during tool-bar update with input blocked. */
1153 totally_unblock_input ();
1155 Fthrow (Qtop_level, Qnil);
1158 static _Noreturn void
1159 user_error (const char *msg)
1161 xsignal1 (Quser_error, build_string (msg));
1164 /* _Noreturn will be added to prototype by make-docfile. */
1165 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1166 doc: /* Exit from the innermost recursive edit or minibuffer. */
1167 attributes: noreturn)
1168 (void)
1170 if (command_loop_level > 0 || minibuf_level > 0)
1171 Fthrow (Qexit, Qnil);
1173 user_error ("No recursive edit is in progress");
1176 /* _Noreturn will be added to prototype by make-docfile. */
1177 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1178 doc: /* Abort the command that requested this recursive edit or minibuffer input. */
1179 attributes: noreturn)
1180 (void)
1182 if (command_loop_level > 0 || minibuf_level > 0)
1183 Fthrow (Qexit, Qt);
1185 user_error ("No recursive edit is in progress");
1188 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
1189 of this function. */
1191 static void
1192 tracking_off (Lisp_Object old_value)
1194 do_mouse_tracking = old_value;
1195 if (NILP (old_value))
1197 /* Redisplay may have been preempted because there was input
1198 available, and it assumes it will be called again after the
1199 input has been processed. If the only input available was
1200 the sort that we have just disabled, then we need to call
1201 redisplay. */
1202 if (!readable_events (READABLE_EVENTS_DO_TIMERS_NOW))
1204 redisplay_preserve_echo_area (6);
1205 get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
1210 DEFUN ("internal--track-mouse", Ftrack_mouse, Strack_mouse, 1, 1, 0,
1211 doc: /* Call BODYFUN with mouse movement events enabled. */)
1212 (Lisp_Object bodyfun)
1214 ptrdiff_t count = SPECPDL_INDEX ();
1215 Lisp_Object val;
1217 record_unwind_protect (tracking_off, do_mouse_tracking);
1219 do_mouse_tracking = Qt;
1221 val = call0 (bodyfun);
1222 return unbind_to (count, val);
1225 /* If mouse has moved on some frame, return one of those frames.
1227 Return 0 otherwise.
1229 If ignore_mouse_drag_p is non-zero, ignore (implicit) mouse movement
1230 after resizing the tool-bar window. */
1232 bool ignore_mouse_drag_p;
1234 static struct frame *
1235 some_mouse_moved (void)
1237 Lisp_Object tail, frame;
1239 if (ignore_mouse_drag_p)
1241 /* ignore_mouse_drag_p = 0; */
1242 return 0;
1245 FOR_EACH_FRAME (tail, frame)
1247 if (XFRAME (frame)->mouse_moved)
1248 return XFRAME (frame);
1251 return 0;
1255 /* This is the actual command reading loop,
1256 sans error-handling encapsulation. */
1258 static int read_key_sequence (Lisp_Object *, int, Lisp_Object,
1259 bool, bool, bool, bool);
1260 static void adjust_point_for_property (ptrdiff_t, bool);
1262 Lisp_Object
1263 command_loop_1 (void)
1265 EMACS_INT prev_modiff = 0;
1266 struct buffer *prev_buffer = NULL;
1267 bool already_adjusted = 0;
1269 kset_prefix_arg (current_kboard, Qnil);
1270 kset_last_prefix_arg (current_kboard, Qnil);
1271 Vdeactivate_mark = Qnil;
1272 waiting_for_input = false;
1273 cancel_echoing ();
1275 this_command_key_count = 0;
1276 this_single_command_key_start = 0;
1278 if (NILP (Vmemory_full))
1280 /* Make sure this hook runs after commands that get errors and
1281 throw to top level. */
1282 /* Note that the value cell will never directly contain nil
1283 if the symbol is a local variable. */
1284 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1285 safe_run_hooks (Qpost_command_hook);
1287 /* If displaying a message, resize the echo area window to fit
1288 that message's size exactly. */
1289 if (!NILP (echo_area_buffer[0]))
1290 resize_echo_area_exactly ();
1292 /* If there are warnings waiting, process them. */
1293 if (!NILP (Vdelayed_warnings_list))
1294 safe_run_hooks (Qdelayed_warnings_hook);
1296 if (!NILP (Vdeferred_action_list))
1297 safe_run_hooks (Qdeferred_action_function);
1300 /* Do this after running Vpost_command_hook, for consistency. */
1301 kset_last_command (current_kboard, Vthis_command);
1302 kset_real_last_command (current_kboard, Vreal_this_command);
1303 if (!CONSP (last_command_event))
1304 kset_last_repeatable_command (current_kboard, Vreal_this_command);
1306 while (1)
1308 Lisp_Object cmd;
1309 Lisp_Object keybuf[30];
1310 int i;
1312 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1313 Fkill_emacs (Qnil);
1315 /* Make sure the current window's buffer is selected. */
1316 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents));
1318 /* Display any malloc warning that just came out. Use while because
1319 displaying one warning can cause another. */
1321 while (pending_malloc_warning)
1322 display_malloc_warning ();
1324 Vdeactivate_mark = Qnil;
1326 /* Don't ignore mouse movements for more than a single command
1327 loop. (This flag is set in xdisp.c whenever the tool bar is
1328 resized, because the resize moves text up or down, and would
1329 generate false mouse drag events if we don't ignore them.) */
1330 ignore_mouse_drag_p = 0;
1332 /* If minibuffer on and echo area in use,
1333 wait a short time and redraw minibuffer. */
1335 if (minibuf_level
1336 && !NILP (echo_area_buffer[0])
1337 && EQ (minibuf_window, echo_area_window)
1338 && NUMBERP (Vminibuffer_message_timeout))
1340 /* Bind inhibit-quit to t so that C-g gets read in
1341 rather than quitting back to the minibuffer. */
1342 ptrdiff_t count = SPECPDL_INDEX ();
1343 specbind (Qinhibit_quit, Qt);
1345 sit_for (Vminibuffer_message_timeout, 0, 2);
1347 /* Clear the echo area. */
1348 message1 (0);
1349 safe_run_hooks (Qecho_area_clear_hook);
1351 unbind_to (count, Qnil);
1353 /* If a C-g came in before, treat it as input now. */
1354 if (!NILP (Vquit_flag))
1356 Vquit_flag = Qnil;
1357 Vunread_command_events = list1 (make_number (quit_char));
1361 /* If it has changed current-menubar from previous value,
1362 really recompute the menubar from the value. */
1363 if (! NILP (Vlucid_menu_bar_dirty_flag)
1364 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
1365 call0 (Qrecompute_lucid_menubar);
1367 Vthis_command = Qnil;
1368 Vreal_this_command = Qnil;
1369 Vthis_original_command = Qnil;
1370 Vthis_command_keys_shift_translated = Qnil;
1372 /* Read next key sequence; i gets its length. */
1373 i = read_key_sequence (keybuf, ARRAYELTS (keybuf),
1374 Qnil, 0, 1, 1, 0);
1376 /* A filter may have run while we were reading the input. */
1377 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1378 Fkill_emacs (Qnil);
1379 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents));
1381 ++num_input_keys;
1383 /* Now we have read a key sequence of length I,
1384 or else I is 0 and we found end of file. */
1386 if (i == 0) /* End of file -- happens only in */
1387 return Qnil; /* a kbd macro, at the end. */
1388 /* -1 means read_key_sequence got a menu that was rejected.
1389 Just loop around and read another command. */
1390 if (i == -1)
1392 cancel_echoing ();
1393 this_command_key_count = 0;
1394 this_single_command_key_start = 0;
1395 goto finalize;
1398 last_command_event = keybuf[i - 1];
1400 /* If the previous command tried to force a specific window-start,
1401 forget about that, in case this command moves point far away
1402 from that position. But also throw away beg_unchanged and
1403 end_unchanged information in that case, so that redisplay will
1404 update the whole window properly. */
1405 if (XWINDOW (selected_window)->force_start)
1407 struct buffer *b;
1408 XWINDOW (selected_window)->force_start = 0;
1409 b = XBUFFER (XWINDOW (selected_window)->contents);
1410 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
1413 cmd = read_key_sequence_cmd;
1414 if (!NILP (Vexecuting_kbd_macro))
1416 if (!NILP (Vquit_flag))
1418 Vexecuting_kbd_macro = Qt;
1419 maybe_quit (); /* Make some noise. */
1420 /* Will return since macro now empty. */
1424 /* Do redisplay processing after this command except in special
1425 cases identified below. */
1426 prev_buffer = current_buffer;
1427 prev_modiff = MODIFF;
1428 last_point_position = PT;
1430 /* By default, we adjust point to a boundary of a region that
1431 has such a property that should be treated intangible
1432 (e.g. composition, display). But, some commands will set
1433 this variable differently. */
1434 Vdisable_point_adjustment = Qnil;
1436 /* Process filters and timers may have messed with deactivate-mark.
1437 reset it before we execute the command. */
1438 Vdeactivate_mark = Qnil;
1440 /* Remap command through active keymaps. */
1441 Vthis_original_command = cmd;
1442 if (!NILP (read_key_sequence_remapped))
1443 cmd = read_key_sequence_remapped;
1445 /* Execute the command. */
1448 total_keys += total_keys < NUM_RECENT_KEYS;
1449 ASET (recent_keys, recent_keys_index,
1450 Fcons (Qnil, cmd));
1451 if (++recent_keys_index >= NUM_RECENT_KEYS)
1452 recent_keys_index = 0;
1454 Vthis_command = cmd;
1455 Vreal_this_command = cmd;
1456 safe_run_hooks (Qpre_command_hook);
1458 already_adjusted = 0;
1460 if (NILP (Vthis_command))
1461 /* nil means key is undefined. */
1462 call0 (Qundefined);
1463 else
1465 /* Here for a command that isn't executed directly. */
1467 #ifdef HAVE_WINDOW_SYSTEM
1468 ptrdiff_t scount = SPECPDL_INDEX ();
1470 if (display_hourglass_p
1471 && NILP (Vexecuting_kbd_macro))
1473 record_unwind_protect_void (cancel_hourglass);
1474 start_hourglass ();
1476 #endif
1478 /* Ensure that we have added appropriate undo-boundaries as a
1479 result of changes from the last command. */
1480 call0 (Qundo_auto__add_boundary);
1482 /* Record point and buffer, so we can put point into the undo
1483 information if necessary. */
1484 point_before_last_command_or_undo = PT;
1485 buffer_before_last_command_or_undo = current_buffer;
1487 call1 (Qcommand_execute, Vthis_command);
1489 #ifdef HAVE_WINDOW_SYSTEM
1490 /* Do not check display_hourglass_p here, because
1491 `command-execute' could change it, but we should cancel
1492 hourglass cursor anyway.
1493 But don't cancel the hourglass within a macro
1494 just because a command in the macro finishes. */
1495 if (NILP (Vexecuting_kbd_macro))
1496 unbind_to (scount, Qnil);
1497 #endif
1499 kset_last_prefix_arg (current_kboard, Vcurrent_prefix_arg);
1501 safe_run_hooks (Qpost_command_hook);
1503 /* If displaying a message, resize the echo area window to fit
1504 that message's size exactly. */
1505 if (!NILP (echo_area_buffer[0]))
1506 resize_echo_area_exactly ();
1508 /* If there are warnings waiting, process them. */
1509 if (!NILP (Vdelayed_warnings_list))
1510 safe_run_hooks (Qdelayed_warnings_hook);
1512 safe_run_hooks (Qdeferred_action_function);
1514 kset_last_command (current_kboard, Vthis_command);
1515 kset_real_last_command (current_kboard, Vreal_this_command);
1516 if (!CONSP (last_command_event))
1517 kset_last_repeatable_command (current_kboard, Vreal_this_command);
1519 this_command_key_count = 0;
1520 this_single_command_key_start = 0;
1522 if (current_kboard->immediate_echo
1523 && !NILP (call0 (Qinternal_echo_keystrokes_prefix)))
1525 current_kboard->immediate_echo = false;
1526 /* Refresh the echo message. */
1527 echo_now ();
1529 else
1530 cancel_echoing ();
1532 if (!NILP (BVAR (current_buffer, mark_active))
1533 && !NILP (Vrun_hooks))
1535 /* In Emacs 22, setting transient-mark-mode to `only' was a
1536 way of turning it on for just one command. This usage is
1537 obsolete, but support it anyway. */
1538 if (EQ (Vtransient_mark_mode, Qidentity))
1539 Vtransient_mark_mode = Qnil;
1540 else if (EQ (Vtransient_mark_mode, Qonly))
1541 Vtransient_mark_mode = Qidentity;
1543 if (!NILP (Vdeactivate_mark))
1544 /* If `select-active-regions' is non-nil, this call to
1545 `deactivate-mark' also sets the PRIMARY selection. */
1546 call0 (Qdeactivate_mark);
1547 else
1549 /* Even if not deactivating the mark, set PRIMARY if
1550 `select-active-regions' is non-nil. */
1551 if (!NILP (Fwindow_system (Qnil))
1552 /* Even if mark_active is non-nil, the actual buffer
1553 marker may not have been set yet (Bug#7044). */
1554 && XMARKER (BVAR (current_buffer, mark))->buffer
1555 && (EQ (Vselect_active_regions, Qonly)
1556 ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly)
1557 : (!NILP (Vselect_active_regions)
1558 && !NILP (Vtransient_mark_mode)))
1559 && NILP (Fmemq (Vthis_command,
1560 Vselection_inhibit_update_commands)))
1562 Lisp_Object txt
1563 = call1 (Fsymbol_value (Qregion_extract_function), Qnil);
1564 if (XINT (Flength (txt)) > 0)
1565 /* Don't set empty selections. */
1566 call2 (Qgui_set_selection, QPRIMARY, txt);
1569 if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1570 run_hook (intern ("activate-mark-hook"));
1573 Vsaved_region_selection = Qnil;
1576 finalize:
1578 if (current_buffer == prev_buffer
1579 && XBUFFER (XWINDOW (selected_window)->contents) == current_buffer
1580 && last_point_position != PT
1581 && NILP (Vdisable_point_adjustment)
1582 && NILP (Vglobal_disable_point_adjustment))
1584 if (last_point_position > BEGV
1585 && last_point_position < ZV
1586 && (composition_adjust_point (last_point_position,
1587 last_point_position)
1588 != last_point_position))
1589 /* The last point was temporarily set within a grapheme
1590 cluster to prevent automatic composition. To recover
1591 the automatic composition, we must update the
1592 display. */
1593 windows_or_buffers_changed = 21;
1594 if (!already_adjusted)
1595 adjust_point_for_property (last_point_position,
1596 MODIFF != prev_modiff);
1599 /* Install chars successfully executed in kbd macro. */
1601 if (!NILP (KVAR (current_kboard, defining_kbd_macro))
1602 && NILP (KVAR (current_kboard, Vprefix_arg)))
1603 finalize_kbd_macro_chars ();
1607 Lisp_Object
1608 read_menu_command (void)
1610 Lisp_Object keybuf[30];
1611 ptrdiff_t count = SPECPDL_INDEX ();
1612 int i;
1614 /* We don't want to echo the keystrokes while navigating the
1615 menus. */
1616 specbind (Qecho_keystrokes, make_number (0));
1618 i = read_key_sequence (keybuf, ARRAYELTS (keybuf),
1619 Qnil, 0, 1, 1, 1);
1621 unbind_to (count, Qnil);
1623 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1624 Fkill_emacs (Qnil);
1625 if (i == 0 || i == -1)
1626 return Qt;
1628 return read_key_sequence_cmd;
1631 /* Adjust point to a boundary of a region that has such a property
1632 that should be treated intangible. For the moment, we check
1633 `composition', `display' and `invisible' properties.
1634 LAST_PT is the last position of point. */
1636 static void
1637 adjust_point_for_property (ptrdiff_t last_pt, bool modified)
1639 ptrdiff_t beg, end;
1640 Lisp_Object val, overlay, tmp;
1641 /* When called after buffer modification, we should temporarily
1642 suppress the point adjustment for automatic composition so that a
1643 user can keep inserting another character at point or keep
1644 deleting characters around point. */
1645 bool check_composition = ! modified;
1646 bool check_display = true, check_invisible = true;
1647 ptrdiff_t orig_pt = PT;
1649 eassert (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer);
1651 /* FIXME: cycling is probably not necessary because these properties
1652 can't be usefully combined anyway. */
1653 while (check_composition || check_display || check_invisible)
1655 /* FIXME: check `intangible'. */
1656 if (check_composition
1657 && PT > BEGV && PT < ZV
1658 && (beg = composition_adjust_point (last_pt, PT)) != PT)
1660 SET_PT (beg);
1661 check_display = check_invisible = true;
1663 check_composition = false;
1664 if (check_display
1665 && PT > BEGV && PT < ZV
1666 && !NILP (val = get_char_property_and_overlay
1667 (make_number (PT), Qdisplay, selected_window,
1668 &overlay))
1669 && display_prop_intangible_p (val, overlay, PT, PT_BYTE)
1670 && (!OVERLAYP (overlay)
1671 ? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil)
1672 : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)),
1673 end = OVERLAY_POSITION (OVERLAY_END (overlay))))
1674 && (beg < PT /* && end > PT <- It's always the case. */
1675 || (beg <= PT && STRINGP (val) && SCHARS (val) == 0)))
1677 eassert (end > PT);
1678 SET_PT (PT < last_pt
1679 ? (STRINGP (val) && SCHARS (val) == 0
1680 ? max (beg - 1, BEGV)
1681 : beg)
1682 : end);
1683 check_composition = check_invisible = true;
1685 check_display = false;
1686 if (check_invisible && PT > BEGV && PT < ZV)
1688 int inv;
1689 bool ellipsis = false;
1690 beg = end = PT;
1692 /* Find boundaries `beg' and `end' of the invisible area, if any. */
1693 while (end < ZV
1694 #if 0
1695 /* FIXME: We should stop if we find a spot between
1696 two runs of `invisible' where inserted text would
1697 be visible. This is important when we have two
1698 invisible boundaries that enclose an area: if the
1699 area is empty, we need this test in order to make
1700 it possible to place point in the middle rather
1701 than skip both boundaries. However, this code
1702 also stops anywhere in a non-sticky text-property,
1703 which breaks (e.g.) Org mode. */
1704 && (val = Fget_pos_property (make_number (end),
1705 Qinvisible, Qnil),
1706 TEXT_PROP_MEANS_INVISIBLE (val))
1707 #endif
1708 && !NILP (val = get_char_property_and_overlay
1709 (make_number (end), Qinvisible, Qnil, &overlay))
1710 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1712 ellipsis = ellipsis || inv > 1
1713 || (OVERLAYP (overlay)
1714 && (!NILP (Foverlay_get (overlay, Qafter_string))
1715 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1716 tmp = Fnext_single_char_property_change
1717 (make_number (end), Qinvisible, Qnil, Qnil);
1718 end = NATNUMP (tmp) ? XFASTINT (tmp) : ZV;
1720 while (beg > BEGV
1721 #if 0
1722 && (val = Fget_pos_property (make_number (beg),
1723 Qinvisible, Qnil),
1724 TEXT_PROP_MEANS_INVISIBLE (val))
1725 #endif
1726 && !NILP (val = get_char_property_and_overlay
1727 (make_number (beg - 1), Qinvisible, Qnil, &overlay))
1728 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1730 ellipsis = ellipsis || inv > 1
1731 || (OVERLAYP (overlay)
1732 && (!NILP (Foverlay_get (overlay, Qafter_string))
1733 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1734 tmp = Fprevious_single_char_property_change
1735 (make_number (beg), Qinvisible, Qnil, Qnil);
1736 beg = NATNUMP (tmp) ? XFASTINT (tmp) : BEGV;
1739 /* Move away from the inside area. */
1740 if (beg < PT && end > PT)
1742 SET_PT ((orig_pt == PT && (last_pt < beg || last_pt > end))
1743 /* We haven't moved yet (so we don't need to fear
1744 infinite-looping) and we were outside the range
1745 before (so either end of the range still corresponds
1746 to a move in the right direction): pretend we moved
1747 less than we actually did, so that we still have
1748 more freedom below in choosing which end of the range
1749 to go to. */
1750 ? (orig_pt = -1, PT < last_pt ? end : beg)
1751 /* We either have moved already or the last point
1752 was already in the range: we don't get to choose
1753 which end of the range we have to go to. */
1754 : (PT < last_pt ? beg : end));
1755 check_composition = check_display = true;
1757 #if 0 /* This assertion isn't correct, because SET_PT may end up setting
1758 the point to something other than its argument, due to
1759 point-motion hooks, intangibility, etc. */
1760 eassert (PT == beg || PT == end);
1761 #endif
1763 /* Pretend the area doesn't exist if the buffer is not
1764 modified. */
1765 if (!modified && !ellipsis && beg < end)
1767 if (last_pt == beg && PT == end && end < ZV)
1768 (check_composition = check_display = true, SET_PT (end + 1));
1769 else if (last_pt == end && PT == beg && beg > BEGV)
1770 (check_composition = check_display = true, SET_PT (beg - 1));
1771 else if (PT == ((PT < last_pt) ? beg : end))
1772 /* We've already moved as far as we can. Trying to go
1773 to the other end would mean moving backwards and thus
1774 could lead to an infinite loop. */
1776 else if (val = Fget_pos_property (make_number (PT),
1777 Qinvisible, Qnil),
1778 TEXT_PROP_MEANS_INVISIBLE (val)
1779 && (val = (Fget_pos_property
1780 (make_number (PT == beg ? end : beg),
1781 Qinvisible, Qnil)),
1782 !TEXT_PROP_MEANS_INVISIBLE (val)))
1783 (check_composition = check_display = true,
1784 SET_PT (PT == beg ? end : beg));
1787 check_invisible = false;
1791 /* Subroutine for safe_run_hooks: run the hook, which is ARGS[1]. */
1793 static Lisp_Object
1794 safe_run_hooks_1 (ptrdiff_t nargs, Lisp_Object *args)
1796 eassert (nargs == 2);
1797 return call0 (args[1]);
1800 /* Subroutine for safe_run_hooks: handle an error by clearing out the function
1801 from the hook. */
1803 static Lisp_Object
1804 safe_run_hooks_error (Lisp_Object error, ptrdiff_t nargs, Lisp_Object *args)
1806 eassert (nargs == 2);
1807 AUTO_STRING (format, "Error in %s (%S): %S");
1808 Lisp_Object hook = args[0];
1809 Lisp_Object fun = args[1];
1810 CALLN (Fmessage, format, hook, fun, error);
1812 if (SYMBOLP (hook))
1814 Lisp_Object val;
1815 bool found = false;
1816 Lisp_Object newval = Qnil;
1817 for (val = find_symbol_value (hook); CONSP (val); val = XCDR (val))
1818 if (EQ (fun, XCAR (val)))
1819 found = true;
1820 else
1821 newval = Fcons (XCAR (val), newval);
1822 if (found)
1823 return Fset (hook, Fnreverse (newval));
1824 /* Not found in the local part of the hook. Let's look at the global
1825 part. */
1826 newval = Qnil;
1827 for (val = (NILP (Fdefault_boundp (hook)) ? Qnil
1828 : Fdefault_value (hook));
1829 CONSP (val); val = XCDR (val))
1830 if (EQ (fun, XCAR (val)))
1831 found = true;
1832 else
1833 newval = Fcons (XCAR (val), newval);
1834 if (found)
1835 return Fset_default (hook, Fnreverse (newval));
1837 return Qnil;
1840 static Lisp_Object
1841 safe_run_hook_funcall (ptrdiff_t nargs, Lisp_Object *args)
1843 eassert (nargs == 2);
1844 /* Yes, run_hook_with_args works with args in the other order. */
1845 internal_condition_case_n (safe_run_hooks_1,
1846 2, ((Lisp_Object []) {args[1], args[0]}),
1847 Qt, safe_run_hooks_error);
1848 return Qnil;
1851 /* If we get an error while running the hook, cause the hook variable
1852 to be nil. Also inhibit quits, so that C-g won't cause the hook
1853 to mysteriously evaporate. */
1855 void
1856 safe_run_hooks (Lisp_Object hook)
1858 ptrdiff_t count = SPECPDL_INDEX ();
1860 specbind (Qinhibit_quit, Qt);
1861 run_hook_with_args (2, ((Lisp_Object []) {hook, hook}), safe_run_hook_funcall);
1862 unbind_to (count, Qnil);
1866 /* Nonzero means polling for input is temporarily suppressed. */
1868 int poll_suppress_count;
1871 #ifdef POLL_FOR_INPUT
1873 /* Asynchronous timer for polling. */
1875 static struct atimer *poll_timer;
1877 /* Poll for input, so that we catch a C-g if it comes in. */
1878 void
1879 poll_for_input_1 (void)
1881 if (! input_blocked_p ()
1882 && !waiting_for_input)
1883 gobble_input ();
1886 /* Timer callback function for poll_timer. TIMER is equal to
1887 poll_timer. */
1889 static void
1890 poll_for_input (struct atimer *timer)
1892 if (poll_suppress_count == 0)
1893 pending_signals = true;
1896 #endif /* POLL_FOR_INPUT */
1898 /* Begin signals to poll for input, if they are appropriate.
1899 This function is called unconditionally from various places. */
1901 void
1902 start_polling (void)
1904 #ifdef POLL_FOR_INPUT
1905 /* XXX This condition was (read_socket_hook && !interrupt_input),
1906 but read_socket_hook is not global anymore. Let's pretend that
1907 it's always set. */
1908 if (!interrupt_input)
1910 /* Turn alarm handling on unconditionally. It might have
1911 been turned off in process.c. */
1912 turn_on_atimers (1);
1914 /* If poll timer doesn't exist, or we need one with
1915 a different interval, start a new one. */
1916 if (poll_timer == NULL
1917 || poll_timer->interval.tv_sec != polling_period)
1919 time_t period = max (1, min (polling_period, TYPE_MAXIMUM (time_t)));
1920 struct timespec interval = make_timespec (period, 0);
1922 if (poll_timer)
1923 cancel_atimer (poll_timer);
1925 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
1926 poll_for_input, NULL);
1929 /* Let the timer's callback function poll for input
1930 if this becomes zero. */
1931 --poll_suppress_count;
1933 #endif
1936 /* True if we are using polling to handle input asynchronously. */
1938 bool
1939 input_polling_used (void)
1941 #ifdef POLL_FOR_INPUT
1942 /* XXX This condition was (read_socket_hook && !interrupt_input),
1943 but read_socket_hook is not global anymore. Let's pretend that
1944 it's always set. */
1945 return !interrupt_input;
1946 #else
1947 return 0;
1948 #endif
1951 /* Turn off polling. */
1953 void
1954 stop_polling (void)
1956 #ifdef POLL_FOR_INPUT
1957 /* XXX This condition was (read_socket_hook && !interrupt_input),
1958 but read_socket_hook is not global anymore. Let's pretend that
1959 it's always set. */
1960 if (!interrupt_input)
1961 ++poll_suppress_count;
1962 #endif
1965 /* Set the value of poll_suppress_count to COUNT
1966 and start or stop polling accordingly. */
1968 void
1969 set_poll_suppress_count (int count)
1971 #ifdef POLL_FOR_INPUT
1972 if (count == 0 && poll_suppress_count != 0)
1974 poll_suppress_count = 1;
1975 start_polling ();
1977 else if (count != 0 && poll_suppress_count == 0)
1979 stop_polling ();
1981 poll_suppress_count = count;
1982 #endif
1985 /* Bind polling_period to a value at least N.
1986 But don't decrease it. */
1988 void
1989 bind_polling_period (int n)
1991 #ifdef POLL_FOR_INPUT
1992 EMACS_INT new = polling_period;
1994 if (n > new)
1995 new = n;
1997 stop_other_atimers (poll_timer);
1998 stop_polling ();
1999 specbind (Qpolling_period, make_number (new));
2000 /* Start a new alarm with the new period. */
2001 start_polling ();
2002 #endif
2005 /* Apply the control modifier to CHARACTER. */
2008 make_ctrl_char (int c)
2010 /* Save the upper bits here. */
2011 int upper = c & ~0177;
2013 if (! ASCII_CHAR_P (c))
2014 return c |= ctrl_modifier;
2016 c &= 0177;
2018 /* Everything in the columns containing the upper-case letters
2019 denotes a control character. */
2020 if (c >= 0100 && c < 0140)
2022 int oc = c;
2023 c &= ~0140;
2024 /* Set the shift modifier for a control char
2025 made from a shifted letter. But only for letters! */
2026 if (oc >= 'A' && oc <= 'Z')
2027 c |= shift_modifier;
2030 /* The lower-case letters denote control characters too. */
2031 else if (c >= 'a' && c <= 'z')
2032 c &= ~0140;
2034 /* Include the bits for control and shift
2035 only if the basic ASCII code can't indicate them. */
2036 else if (c >= ' ')
2037 c |= ctrl_modifier;
2039 /* Replace the high bits. */
2040 c |= (upper & ~ctrl_modifier);
2042 return c;
2045 /* Display the help-echo property of the character after the mouse pointer.
2046 Either show it in the echo area, or call show-help-function to display
2047 it by other means (maybe in a tooltip).
2049 If HELP is nil, that means clear the previous help echo.
2051 If HELP is a string, display that string. If HELP is a function,
2052 call it with OBJECT and POS as arguments; the function should
2053 return a help string or nil for none. For all other types of HELP,
2054 evaluate it to obtain a string.
2056 WINDOW is the window in which the help was generated, if any.
2057 It is nil if not in a window.
2059 If OBJECT is a buffer, POS is the position in the buffer where the
2060 `help-echo' text property was found.
2062 If OBJECT is an overlay, that overlay has a `help-echo' property,
2063 and POS is the position in the overlay's buffer under the mouse.
2065 If OBJECT is a string (an overlay string or a string displayed with
2066 the `display' property). POS is the position in that string under
2067 the mouse.
2069 Note: this function may only be called with HELP nil or a string
2070 from X code running asynchronously. */
2072 void
2073 show_help_echo (Lisp_Object help, Lisp_Object window, Lisp_Object object,
2074 Lisp_Object pos)
2076 if (!NILP (help) && !STRINGP (help))
2078 if (FUNCTIONP (help))
2079 help = safe_call (4, help, window, object, pos);
2080 else
2081 help = safe_eval (help);
2083 if (!STRINGP (help))
2084 return;
2087 if (!noninteractive && STRINGP (help))
2089 /* The mouse-fixup-help-message Lisp function can call
2090 mouse_position_hook, which resets the mouse_moved flags.
2091 This causes trouble if we are trying to read a mouse motion
2092 event (i.e., if we are inside a `track-mouse' form), so we
2093 restore the mouse_moved flag. */
2094 struct frame *f = NILP (do_mouse_tracking) ? NULL : some_mouse_moved ();
2095 help = call1 (Qmouse_fixup_help_message, help);
2096 if (f)
2097 f->mouse_moved = true;
2100 if (STRINGP (help) || NILP (help))
2102 if (!NILP (Vshow_help_function))
2103 call1 (Vshow_help_function, Fsubstitute_command_keys (help));
2104 help_echo_showing_p = STRINGP (help);
2110 /* Input of single characters from keyboard. */
2112 static Lisp_Object kbd_buffer_get_event (KBOARD **kbp, bool *used_mouse_menu,
2113 struct timespec *end_time);
2114 static void record_char (Lisp_Object c);
2116 static Lisp_Object help_form_saved_window_configs;
2117 static void
2118 read_char_help_form_unwind (void)
2120 Lisp_Object window_config = XCAR (help_form_saved_window_configs);
2121 help_form_saved_window_configs = XCDR (help_form_saved_window_configs);
2122 if (!NILP (window_config))
2123 Fset_window_configuration (window_config);
2126 #define STOP_POLLING \
2127 do { if (! polling_stopped_here) stop_polling (); \
2128 polling_stopped_here = true; } while (0)
2130 #define RESUME_POLLING \
2131 do { if (polling_stopped_here) start_polling (); \
2132 polling_stopped_here = false; } while (0)
2134 static Lisp_Object
2135 read_event_from_main_queue (struct timespec *end_time,
2136 sys_jmp_buf local_getcjmp,
2137 bool *used_mouse_menu)
2139 Lisp_Object c = Qnil;
2140 sys_jmp_buf save_jump;
2141 KBOARD *kb;
2143 start:
2145 /* Read from the main queue, and if that gives us something we can't use yet,
2146 we put it on the appropriate side queue and try again. */
2148 if (end_time && timespec_cmp (*end_time, current_timespec ()) <= 0)
2149 return c;
2151 /* Actually read a character, waiting if necessary. */
2152 save_getcjmp (save_jump);
2153 restore_getcjmp (local_getcjmp);
2154 if (!end_time)
2155 timer_start_idle ();
2156 c = kbd_buffer_get_event (&kb, used_mouse_menu, end_time);
2157 restore_getcjmp (save_jump);
2159 if (! NILP (c) && (kb != current_kboard))
2161 Lisp_Object last = KVAR (kb, kbd_queue);
2162 if (CONSP (last))
2164 while (CONSP (XCDR (last)))
2165 last = XCDR (last);
2166 if (!NILP (XCDR (last)))
2167 emacs_abort ();
2169 if (!CONSP (last))
2170 kset_kbd_queue (kb, list1 (c));
2171 else
2172 XSETCDR (last, list1 (c));
2173 kb->kbd_queue_has_data = true;
2174 c = Qnil;
2175 if (single_kboard)
2176 goto start;
2177 current_kboard = kb;
2178 return make_number (-2);
2181 /* Terminate Emacs in batch mode if at eof. */
2182 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
2183 Fkill_emacs (make_number (1));
2185 if (INTEGERP (c))
2187 /* Add in any extra modifiers, where appropriate. */
2188 if ((extra_keyboard_modifiers & CHAR_CTL)
2189 || ((extra_keyboard_modifiers & 0177) < ' '
2190 && (extra_keyboard_modifiers & 0177) != 0))
2191 XSETINT (c, make_ctrl_char (XINT (c)));
2193 /* Transfer any other modifier bits directly from
2194 extra_keyboard_modifiers to c. Ignore the actual character code
2195 in the low 16 bits of extra_keyboard_modifiers. */
2196 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
2199 return c;
2204 /* Like `read_event_from_main_queue' but applies keyboard-coding-system
2205 to tty input. */
2206 static Lisp_Object
2207 read_decoded_event_from_main_queue (struct timespec *end_time,
2208 sys_jmp_buf local_getcjmp,
2209 Lisp_Object prev_event,
2210 bool *used_mouse_menu)
2212 #ifndef WINDOWSNT
2213 #define MAX_ENCODED_BYTES 16
2214 Lisp_Object events[MAX_ENCODED_BYTES];
2215 int n = 0;
2216 #endif
2217 while (true)
2219 Lisp_Object nextevt
2220 = read_event_from_main_queue (end_time, local_getcjmp,
2221 used_mouse_menu);
2222 #ifdef WINDOWSNT
2223 /* w32_console already returns decoded events. It either reads
2224 Unicode characters from the Windows keyboard input, or
2225 converts characters encoded in the current codepage into
2226 Unicode. See w32inevt.c:key_event, near its end. */
2227 return nextevt;
2228 #else
2229 struct frame *frame = XFRAME (selected_frame);
2230 struct terminal *terminal = frame->terminal;
2231 if (!((FRAME_TERMCAP_P (frame) || FRAME_MSDOS_P (frame))
2232 /* Don't apply decoding if we're just reading a raw event
2233 (e.g. reading bytes sent by the xterm to specify the position
2234 of a mouse click). */
2235 && (!EQ (prev_event, Qt))
2236 && (TERMINAL_KEYBOARD_CODING (terminal)->common_flags
2237 & CODING_REQUIRE_DECODING_MASK)))
2238 return nextevt; /* No decoding needed. */
2239 else
2241 int meta_key = terminal->display_info.tty->meta_key;
2242 eassert (n < MAX_ENCODED_BYTES);
2243 events[n++] = nextevt;
2244 if (NATNUMP (nextevt)
2245 && XINT (nextevt) < (meta_key == 1 ? 0x80 : 0x100))
2246 { /* An encoded byte sequence, let's try to decode it. */
2247 struct coding_system *coding
2248 = TERMINAL_KEYBOARD_CODING (terminal);
2250 if (raw_text_coding_system_p (coding))
2252 int i;
2253 if (meta_key != 2)
2254 for (i = 0; i < n; i++)
2255 events[i] = make_number (XINT (events[i]) & ~0x80);
2257 else
2259 unsigned char src[MAX_ENCODED_BYTES];
2260 unsigned char dest[MAX_ENCODED_BYTES * MAX_MULTIBYTE_LENGTH];
2261 int i;
2262 for (i = 0; i < n; i++)
2263 src[i] = XINT (events[i]);
2264 if (meta_key != 2)
2265 for (i = 0; i < n; i++)
2266 src[i] &= ~0x80;
2267 coding->destination = dest;
2268 coding->dst_bytes = sizeof dest;
2269 decode_coding_c_string (coding, src, n, Qnil);
2270 eassert (coding->produced_char <= n);
2271 if (coding->produced_char == 0)
2272 { /* The encoded sequence is incomplete. */
2273 if (n < MAX_ENCODED_BYTES) /* Avoid buffer overflow. */
2274 continue; /* Read on! */
2276 else
2278 const unsigned char *p = coding->destination;
2279 eassert (coding->carryover_bytes == 0);
2280 n = 0;
2281 while (n < coding->produced_char)
2282 events[n++] = make_number (STRING_CHAR_ADVANCE (p));
2286 /* Now `events' should hold decoded events.
2287 Normally, n should be equal to 1, but better not rely on it.
2288 We can only return one event here, so return the first we
2289 had and keep the others (if any) for later. */
2290 while (n > 1)
2291 Vunread_command_events
2292 = Fcons (events[--n], Vunread_command_events);
2293 return events[0];
2295 #endif
2299 /* Read a character from the keyboard; call the redisplay if needed. */
2300 /* commandflag 0 means do not autosave, but do redisplay.
2301 -1 means do not redisplay, but do autosave.
2302 -2 means do neither.
2303 1 means do both.
2305 The argument MAP is a keymap for menu prompting.
2307 PREV_EVENT is the previous input event, or nil if we are reading
2308 the first event of a key sequence (or not reading a key sequence).
2309 If PREV_EVENT is t, that is a "magic" value that says
2310 not to run input methods, but in other respects to act as if
2311 not reading a key sequence.
2313 If USED_MOUSE_MENU is non-null, then set *USED_MOUSE_MENU to true
2314 if we used a mouse menu to read the input, or false otherwise. If
2315 USED_MOUSE_MENU is null, don't dereference it.
2317 Value is -2 when we find input on another keyboard. A second call
2318 to read_char will read it.
2320 If END_TIME is non-null, it is a pointer to a struct timespec
2321 specifying the maximum time to wait until. If no input arrives by
2322 that time, stop waiting and return nil.
2324 Value is t if we showed a menu and the user rejected it. */
2326 Lisp_Object
2327 read_char (int commandflag, Lisp_Object map,
2328 Lisp_Object prev_event,
2329 bool *used_mouse_menu, struct timespec *end_time)
2331 Lisp_Object c;
2332 ptrdiff_t jmpcount;
2333 sys_jmp_buf local_getcjmp;
2334 sys_jmp_buf save_jump;
2335 Lisp_Object tem, save;
2336 volatile Lisp_Object previous_echo_area_message;
2337 volatile Lisp_Object also_record;
2338 volatile bool reread, recorded;
2339 bool volatile polling_stopped_here = false;
2340 struct kboard *orig_kboard = current_kboard;
2342 also_record = Qnil;
2344 c = Qnil;
2345 previous_echo_area_message = Qnil;
2347 retry:
2349 recorded = false;
2351 if (CONSP (Vunread_post_input_method_events))
2353 c = XCAR (Vunread_post_input_method_events);
2354 Vunread_post_input_method_events
2355 = XCDR (Vunread_post_input_method_events);
2357 /* Undo what read_char_x_menu_prompt did when it unread
2358 additional keys returned by Fx_popup_menu. */
2359 if (CONSP (c)
2360 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2361 && NILP (XCDR (c)))
2362 c = XCAR (c);
2364 reread = true;
2365 goto reread_first;
2367 else
2368 reread = false;
2371 if (CONSP (Vunread_command_events))
2373 bool was_disabled = false;
2375 c = XCAR (Vunread_command_events);
2376 Vunread_command_events = XCDR (Vunread_command_events);
2378 /* Undo what sit-for did when it unread additional keys
2379 inside universal-argument. */
2381 if (CONSP (c) && EQ (XCAR (c), Qt))
2382 c = XCDR (c);
2383 else
2384 reread = true;
2386 /* Undo what read_char_x_menu_prompt did when it unread
2387 additional keys returned by Fx_popup_menu. */
2388 if (CONSP (c)
2389 && EQ (XCDR (c), Qdisabled)
2390 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))))
2392 was_disabled = true;
2393 c = XCAR (c);
2396 /* If the queued event is something that used the mouse,
2397 set used_mouse_menu accordingly. */
2398 if (used_mouse_menu
2399 /* Also check was_disabled so last-nonmenu-event won't return
2400 a bad value when submenus are involved. (Bug#447) */
2401 && (EQ (c, Qtool_bar) || EQ (c, Qmenu_bar) || was_disabled))
2402 *used_mouse_menu = true;
2404 goto reread_for_input_method;
2407 if (CONSP (Vunread_input_method_events))
2409 c = XCAR (Vunread_input_method_events);
2410 Vunread_input_method_events = XCDR (Vunread_input_method_events);
2412 /* Undo what read_char_x_menu_prompt did when it unread
2413 additional keys returned by Fx_popup_menu. */
2414 if (CONSP (c)
2415 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2416 && NILP (XCDR (c)))
2417 c = XCAR (c);
2418 reread = true;
2419 goto reread_for_input_method;
2422 if (!NILP (Vexecuting_kbd_macro))
2424 /* We set this to Qmacro; since that's not a frame, nobody will
2425 try to switch frames on us, and the selected window will
2426 remain unchanged.
2428 Since this event came from a macro, it would be misleading to
2429 leave internal_last_event_frame set to wherever the last
2430 real event came from. Normally, a switch-frame event selects
2431 internal_last_event_frame after each command is read, but
2432 events read from a macro should never cause a new frame to be
2433 selected. */
2434 Vlast_event_frame = internal_last_event_frame = Qmacro;
2436 /* Exit the macro if we are at the end.
2437 Also, some things replace the macro with t
2438 to force an early exit. */
2439 if (EQ (Vexecuting_kbd_macro, Qt)
2440 || executing_kbd_macro_index >= XFASTINT (Flength (Vexecuting_kbd_macro)))
2442 XSETINT (c, -1);
2443 goto exit;
2446 c = Faref (Vexecuting_kbd_macro, make_number (executing_kbd_macro_index));
2447 if (STRINGP (Vexecuting_kbd_macro)
2448 && (XFASTINT (c) & 0x80) && (XFASTINT (c) <= 0xff))
2449 XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80));
2451 executing_kbd_macro_index++;
2453 goto from_macro;
2456 if (!NILP (unread_switch_frame))
2458 c = unread_switch_frame;
2459 unread_switch_frame = Qnil;
2461 /* This event should make it into this_command_keys, and get echoed
2462 again, so we do not set `reread'. */
2463 goto reread_first;
2466 /* If redisplay was requested. */
2467 if (commandflag >= 0)
2469 bool echo_current = EQ (echo_message_buffer, echo_area_buffer[0]);
2471 /* If there is pending input, process any events which are not
2472 user-visible, such as X selection_request events. */
2473 if (input_pending
2474 || detect_input_pending_run_timers (0))
2475 swallow_events (false); /* May clear input_pending. */
2477 /* Redisplay if no pending input. */
2478 while (!(input_pending
2479 && (input_was_pending || !redisplay_dont_pause)))
2481 input_was_pending = input_pending;
2482 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
2483 redisplay_preserve_echo_area (5);
2484 else
2485 redisplay ();
2487 if (!input_pending)
2488 /* Normal case: no input arrived during redisplay. */
2489 break;
2491 /* Input arrived and pre-empted redisplay.
2492 Process any events which are not user-visible. */
2493 swallow_events (false);
2494 /* If that cleared input_pending, try again to redisplay. */
2497 /* Prevent the redisplay we just did
2498 from messing up echoing of the input after the prompt. */
2499 if (commandflag == 0 && echo_current)
2500 echo_message_buffer = echo_area_buffer[0];
2504 /* Message turns off echoing unless more keystrokes turn it on again.
2506 The code in 20.x for the condition was
2508 1. echo_area_glyphs && *echo_area_glyphs
2509 2. && echo_area_glyphs != current_kboard->echobuf
2510 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2512 (1) means there's a current message displayed
2514 (2) means it's not the message from echoing from the current
2515 kboard.
2517 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2518 is set to a non-null value. This is done in read_char and it is
2519 set to echo_area_glyphs. That means
2520 ok_to_echo_at_next_pause is either null or
2521 current_kboard->echobuf with the appropriate current_kboard at
2522 that time.
2524 So, condition (3) means in clear text ok_to_echo_at_next_pause
2525 must be either null, or the current message isn't from echoing at
2526 all, or it's from echoing from a different kboard than the
2527 current one. */
2529 if (/* There currently is something in the echo area. */
2530 !NILP (echo_area_buffer[0])
2531 && (/* It's an echo from a different kboard. */
2532 echo_kboard != current_kboard
2533 /* Or we explicitly allow overwriting whatever there is. */
2534 || ok_to_echo_at_next_pause == NULL))
2535 cancel_echoing ();
2536 else
2537 echo_dash ();
2539 /* Try reading a character via menu prompting in the minibuf.
2540 Try this before the sit-for, because the sit-for
2541 would do the wrong thing if we are supposed to do
2542 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2543 after a mouse event so don't try a minibuf menu. */
2544 c = Qnil;
2545 if (KEYMAPP (map) && INTERACTIVE
2546 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2547 /* Don't bring up a menu if we already have another event. */
2548 && !CONSP (Vunread_command_events)
2549 && !detect_input_pending_run_timers (0))
2551 c = read_char_minibuf_menu_prompt (commandflag, map);
2553 if (INTEGERP (c) && XINT (c) == -2)
2554 return c; /* wrong_kboard_jmpbuf */
2556 if (! NILP (c))
2557 goto exit;
2560 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2561 We will do that below, temporarily for short sections of code,
2562 when appropriate. local_getcjmp must be in effect
2563 around any call to sit_for or kbd_buffer_get_event;
2564 it *must not* be in effect when we call redisplay. */
2566 jmpcount = SPECPDL_INDEX ();
2567 if (sys_setjmp (local_getcjmp))
2569 /* Handle quits while reading the keyboard. */
2570 /* We must have saved the outer value of getcjmp here,
2571 so restore it now. */
2572 restore_getcjmp (save_jump);
2573 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
2574 #if THREADS_ENABLED
2575 maybe_reacquire_global_lock ();
2576 #endif
2577 unbind_to (jmpcount, Qnil);
2578 XSETINT (c, quit_char);
2579 internal_last_event_frame = selected_frame;
2580 Vlast_event_frame = internal_last_event_frame;
2581 /* If we report the quit char as an event,
2582 don't do so more than once. */
2583 if (!NILP (Vinhibit_quit))
2584 Vquit_flag = Qnil;
2587 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
2588 if (kb != current_kboard)
2590 Lisp_Object last = KVAR (kb, kbd_queue);
2591 /* We shouldn't get here if we were in single-kboard mode! */
2592 if (single_kboard)
2593 emacs_abort ();
2594 if (CONSP (last))
2596 while (CONSP (XCDR (last)))
2597 last = XCDR (last);
2598 if (!NILP (XCDR (last)))
2599 emacs_abort ();
2601 if (!CONSP (last))
2602 kset_kbd_queue (kb, list1 (c));
2603 else
2604 XSETCDR (last, list1 (c));
2605 kb->kbd_queue_has_data = true;
2606 current_kboard = kb;
2607 return make_number (-2); /* wrong_kboard_jmpbuf */
2610 goto non_reread;
2613 /* Start idle timers if no time limit is supplied. We don't do it
2614 if a time limit is supplied to avoid an infinite recursion in the
2615 situation where an idle timer calls `sit-for'. */
2617 if (!end_time)
2618 timer_start_idle ();
2620 /* If in middle of key sequence and minibuffer not active,
2621 start echoing if enough time elapses. */
2623 if (minibuf_level == 0
2624 && !end_time
2625 && !current_kboard->immediate_echo
2626 && (this_command_key_count > 0
2627 || !NILP (call0 (Qinternal_echo_keystrokes_prefix)))
2628 && ! noninteractive
2629 && echo_keystrokes_p ()
2630 && (/* No message. */
2631 NILP (echo_area_buffer[0])
2632 /* Or empty message. */
2633 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2634 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2635 /* Or already echoing from same kboard. */
2636 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2637 /* Or not echoing before and echoing allowed. */
2638 || (!echo_kboard && ok_to_echo_at_next_pause)))
2640 /* After a mouse event, start echoing right away.
2641 This is because we are probably about to display a menu,
2642 and we don't want to delay before doing so. */
2643 if (EVENT_HAS_PARAMETERS (prev_event))
2644 echo_now ();
2645 else
2647 Lisp_Object tem0;
2649 save_getcjmp (save_jump);
2650 restore_getcjmp (local_getcjmp);
2651 tem0 = sit_for (Vecho_keystrokes, 1, 1);
2652 restore_getcjmp (save_jump);
2653 if (EQ (tem0, Qt)
2654 && ! CONSP (Vunread_command_events))
2655 echo_now ();
2659 /* Maybe auto save due to number of keystrokes. */
2661 if (commandflag != 0 && commandflag != -2
2662 && auto_save_interval > 0
2663 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
2664 && !detect_input_pending_run_timers (0))
2666 Fdo_auto_save (Qnil, Qnil);
2667 /* Hooks can actually change some buffers in auto save. */
2668 redisplay ();
2671 /* Try reading using an X menu.
2672 This is never confused with reading using the minibuf
2673 because the recursive call of read_char in read_char_minibuf_menu_prompt
2674 does not pass on any keymaps. */
2676 if (KEYMAPP (map) && INTERACTIVE
2677 && !NILP (prev_event)
2678 && EVENT_HAS_PARAMETERS (prev_event)
2679 && !EQ (XCAR (prev_event), Qmenu_bar)
2680 && !EQ (XCAR (prev_event), Qtool_bar)
2681 /* Don't bring up a menu if we already have another event. */
2682 && !CONSP (Vunread_command_events))
2684 c = read_char_x_menu_prompt (map, prev_event, used_mouse_menu);
2686 /* Now that we have read an event, Emacs is not idle. */
2687 if (!end_time)
2688 timer_stop_idle ();
2690 goto exit;
2693 /* Maybe autosave and/or garbage collect due to idleness. */
2695 if (INTERACTIVE && NILP (c))
2697 int delay_level;
2698 ptrdiff_t buffer_size;
2700 /* Slow down auto saves logarithmically in size of current buffer,
2701 and garbage collect while we're at it. */
2702 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2703 last_non_minibuf_size = Z - BEG;
2704 buffer_size = (last_non_minibuf_size >> 8) + 1;
2705 delay_level = 0;
2706 while (buffer_size > 64)
2707 delay_level++, buffer_size -= buffer_size >> 2;
2708 if (delay_level < 4) delay_level = 4;
2709 /* delay_level is 4 for files under around 50k, 7 at 100k,
2710 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2712 /* Auto save if enough time goes by without input. */
2713 if (commandflag != 0 && commandflag != -2
2714 && num_nonmacro_input_events > last_auto_save
2715 && INTEGERP (Vauto_save_timeout)
2716 && XINT (Vauto_save_timeout) > 0)
2718 Lisp_Object tem0;
2719 EMACS_INT timeout = XFASTINT (Vauto_save_timeout);
2721 timeout = min (timeout, MOST_POSITIVE_FIXNUM / delay_level * 4);
2722 timeout = delay_level * timeout / 4;
2723 save_getcjmp (save_jump);
2724 restore_getcjmp (local_getcjmp);
2725 tem0 = sit_for (make_number (timeout), 1, 1);
2726 restore_getcjmp (save_jump);
2728 if (EQ (tem0, Qt)
2729 && ! CONSP (Vunread_command_events))
2731 Fdo_auto_save (Qnil, Qnil);
2732 redisplay ();
2736 /* If there is still no input available, ask for GC. */
2737 if (!detect_input_pending_run_timers (0))
2738 maybe_gc ();
2741 /* Notify the caller if an autosave hook, or a timer, sentinel or
2742 filter in the sit_for calls above have changed the current
2743 kboard. This could happen if they use the minibuffer or start a
2744 recursive edit, like the fancy splash screen in server.el's
2745 filter. If this longjmp wasn't here, read_key_sequence would
2746 interpret the next key sequence using the wrong translation
2747 tables and function keymaps. */
2748 if (NILP (c) && current_kboard != orig_kboard)
2749 return make_number (-2); /* wrong_kboard_jmpbuf */
2751 /* If this has become non-nil here, it has been set by a timer
2752 or sentinel or filter. */
2753 if (CONSP (Vunread_command_events))
2755 c = XCAR (Vunread_command_events);
2756 Vunread_command_events = XCDR (Vunread_command_events);
2758 if (CONSP (c) && EQ (XCAR (c), Qt))
2759 c = XCDR (c);
2760 else
2761 reread = true;
2764 /* Read something from current KBOARD's side queue, if possible. */
2766 if (NILP (c))
2768 if (current_kboard->kbd_queue_has_data)
2770 if (!CONSP (KVAR (current_kboard, kbd_queue)))
2771 emacs_abort ();
2772 c = XCAR (KVAR (current_kboard, kbd_queue));
2773 kset_kbd_queue (current_kboard,
2774 XCDR (KVAR (current_kboard, kbd_queue)));
2775 if (NILP (KVAR (current_kboard, kbd_queue)))
2776 current_kboard->kbd_queue_has_data = false;
2777 input_pending = readable_events (0);
2778 if (EVENT_HAS_PARAMETERS (c)
2779 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
2780 internal_last_event_frame = XCAR (XCDR (c));
2781 Vlast_event_frame = internal_last_event_frame;
2785 /* If current_kboard's side queue is empty check the other kboards.
2786 If one of them has data that we have not yet seen here,
2787 switch to it and process the data waiting for it.
2789 Note: if the events queued up for another kboard
2790 have already been seen here, and therefore are not a complete command,
2791 the kbd_queue_has_data field is 0, so we skip that kboard here.
2792 That's to avoid an infinite loop switching between kboards here. */
2793 if (NILP (c) && !single_kboard)
2795 KBOARD *kb;
2796 for (kb = all_kboards; kb; kb = kb->next_kboard)
2797 if (kb->kbd_queue_has_data)
2799 current_kboard = kb;
2800 return make_number (-2); /* wrong_kboard_jmpbuf */
2804 wrong_kboard:
2806 STOP_POLLING;
2808 if (NILP (c))
2810 c = read_decoded_event_from_main_queue (end_time, local_getcjmp,
2811 prev_event, used_mouse_menu);
2812 if (NILP (c) && end_time
2813 && timespec_cmp (*end_time, current_timespec ()) <= 0)
2815 goto exit;
2818 if (EQ (c, make_number (-2)))
2819 return c;
2822 non_reread:
2824 if (!end_time)
2825 timer_stop_idle ();
2826 RESUME_POLLING;
2828 if (NILP (c))
2830 if (commandflag >= 0
2831 && !input_pending && !detect_input_pending_run_timers (0))
2832 redisplay ();
2834 goto wrong_kboard;
2837 /* Buffer switch events are only for internal wakeups
2838 so don't show them to the user.
2839 Also, don't record a key if we already did. */
2840 if (BUFFERP (c))
2841 goto exit;
2843 /* Process special events within read_char
2844 and loop around to read another event. */
2845 save = Vquit_flag;
2846 Vquit_flag = Qnil;
2847 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
2848 Vquit_flag = save;
2850 if (!NILP (tem))
2852 struct buffer *prev_buffer = current_buffer;
2853 last_input_event = c;
2854 call4 (Qcommand_execute, tem, Qnil, Fvector (1, &last_input_event), Qt);
2856 if (CONSP (c)
2857 && (EQ (XCAR (c), Qselect_window)
2858 #ifdef HAVE_DBUS
2859 || EQ (XCAR (c), Qdbus_event)
2860 #endif
2861 #ifdef USE_FILE_NOTIFY
2862 || EQ (XCAR (c), Qfile_notify)
2863 #endif
2864 || EQ (XCAR (c), Qconfig_changed_event))
2865 && !end_time)
2866 /* We stopped being idle for this event; undo that. This
2867 prevents automatic window selection (under
2868 mouse-autoselect-window) from acting as a real input event, for
2869 example banishing the mouse under mouse-avoidance-mode. */
2870 timer_resume_idle ();
2872 if (current_buffer != prev_buffer)
2874 /* The command may have changed the keymaps. Pretend there
2875 is input in another keyboard and return. This will
2876 recalculate keymaps. */
2877 c = make_number (-2);
2878 goto exit;
2880 else
2881 goto retry;
2884 /* Handle things that only apply to characters. */
2885 if (INTEGERP (c))
2887 /* If kbd_buffer_get_event gave us an EOF, return that. */
2888 if (XINT (c) == -1)
2889 goto exit;
2891 if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table))
2892 && UNSIGNED_CMP (XFASTINT (c), <,
2893 SCHARS (KVAR (current_kboard,
2894 Vkeyboard_translate_table))))
2895 || (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table))
2896 && UNSIGNED_CMP (XFASTINT (c), <,
2897 ASIZE (KVAR (current_kboard,
2898 Vkeyboard_translate_table))))
2899 || (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table))
2900 && CHARACTERP (c)))
2902 Lisp_Object d;
2903 d = Faref (KVAR (current_kboard, Vkeyboard_translate_table), c);
2904 /* nil in keyboard-translate-table means no translation. */
2905 if (!NILP (d))
2906 c = d;
2910 /* If this event is a mouse click in the menu bar,
2911 return just menu-bar for now. Modify the mouse click event
2912 so we won't do this twice, then queue it up. */
2913 if (EVENT_HAS_PARAMETERS (c)
2914 && CONSP (XCDR (c))
2915 && CONSP (EVENT_START (c))
2916 && CONSP (XCDR (EVENT_START (c))))
2918 Lisp_Object posn;
2920 posn = POSN_POSN (EVENT_START (c));
2921 /* Handle menu-bar events:
2922 insert the dummy prefix event `menu-bar'. */
2923 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
2925 /* Change menu-bar to (menu-bar) as the event "position". */
2926 POSN_SET_POSN (EVENT_START (c), list1 (posn));
2928 also_record = c;
2929 Vunread_command_events = Fcons (c, Vunread_command_events);
2930 c = posn;
2934 /* Store these characters into recent_keys, the dribble file if any,
2935 and the keyboard macro being defined, if any. */
2936 record_char (c);
2937 recorded = true;
2938 if (! NILP (also_record))
2939 record_char (also_record);
2941 /* Wipe the echo area.
2942 But first, if we are about to use an input method,
2943 save the echo area contents for it to refer to. */
2944 if (INTEGERP (c)
2945 && ! NILP (Vinput_method_function)
2946 && ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127)
2948 previous_echo_area_message = Fcurrent_message ();
2949 Vinput_method_previous_message = previous_echo_area_message;
2952 /* Now wipe the echo area, except for help events which do their
2953 own stuff with the echo area. */
2954 if (!CONSP (c)
2955 || (!(EQ (Qhelp_echo, XCAR (c)))
2956 && !(EQ (Qswitch_frame, XCAR (c)))
2957 /* Don't wipe echo area for select window events: These might
2958 get delayed via `mouse-autoselect-window' (Bug#11304). */
2959 && !(EQ (Qselect_window, XCAR (c)))))
2961 if (!NILP (echo_area_buffer[0]))
2963 safe_run_hooks (Qecho_area_clear_hook);
2964 clear_message (1, 0);
2968 reread_for_input_method:
2969 from_macro:
2970 /* Pass this to the input method, if appropriate. */
2971 if (INTEGERP (c)
2972 && ! NILP (Vinput_method_function)
2973 /* Don't run the input method within a key sequence,
2974 after the first event of the key sequence. */
2975 && NILP (prev_event)
2976 && ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127)
2978 Lisp_Object keys;
2979 ptrdiff_t key_count;
2980 ptrdiff_t command_key_start;
2981 ptrdiff_t count = SPECPDL_INDEX ();
2983 /* Save the echo status. */
2984 bool saved_immediate_echo = current_kboard->immediate_echo;
2985 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
2986 Lisp_Object saved_echo_string = KVAR (current_kboard, echo_string);
2987 Lisp_Object saved_echo_prompt = KVAR (current_kboard, echo_prompt);
2989 /* Save the this_command_keys status. */
2990 key_count = this_command_key_count;
2991 command_key_start = this_single_command_key_start;
2993 if (key_count > 0)
2994 keys = Fcopy_sequence (this_command_keys);
2995 else
2996 keys = Qnil;
2998 /* Clear out this_command_keys. */
2999 this_command_key_count = 0;
3000 this_single_command_key_start = 0;
3002 /* Now wipe the echo area. */
3003 if (!NILP (echo_area_buffer[0]))
3004 safe_run_hooks (Qecho_area_clear_hook);
3005 clear_message (1, 0);
3006 echo_truncate (0);
3008 /* If we are not reading a key sequence,
3009 never use the echo area. */
3010 if (!KEYMAPP (map))
3012 specbind (Qinput_method_use_echo_area, Qt);
3015 /* Call the input method. */
3016 tem = call1 (Vinput_method_function, c);
3018 tem = unbind_to (count, tem);
3020 /* Restore the saved echoing state
3021 and this_command_keys state. */
3022 this_command_key_count = key_count;
3023 this_single_command_key_start = command_key_start;
3024 if (key_count > 0)
3025 this_command_keys = keys;
3027 cancel_echoing ();
3028 ok_to_echo_at_next_pause = saved_ok_to_echo;
3029 kset_echo_string (current_kboard, saved_echo_string);
3030 kset_echo_prompt (current_kboard, saved_echo_prompt);
3031 if (saved_immediate_echo)
3032 echo_now ();
3034 /* The input method can return no events. */
3035 if (! CONSP (tem))
3037 /* Bring back the previous message, if any. */
3038 if (! NILP (previous_echo_area_message))
3039 message_with_string ("%s", previous_echo_area_message, 0);
3040 goto retry;
3042 /* It returned one event or more. */
3043 c = XCAR (tem);
3044 Vunread_post_input_method_events
3045 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
3047 /* When we consume events from the various unread-*-events lists, we
3048 bypass the code that records input, so record these events now if
3049 they were not recorded already. */
3050 if (!recorded)
3052 record_char (c);
3053 recorded = true;
3056 reread_first:
3058 /* Display help if not echoing. */
3059 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
3061 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
3062 Lisp_Object help, object, position, window, htem;
3064 htem = Fcdr (XCDR (c));
3065 help = Fcar (htem);
3066 htem = Fcdr (htem);
3067 window = Fcar (htem);
3068 htem = Fcdr (htem);
3069 object = Fcar (htem);
3070 htem = Fcdr (htem);
3071 position = Fcar (htem);
3073 show_help_echo (help, window, object, position);
3075 /* We stopped being idle for this event; undo that. */
3076 if (!end_time)
3077 timer_resume_idle ();
3078 goto retry;
3081 if ((! reread || this_command_key_count == 0)
3082 && !end_time)
3085 /* Don't echo mouse motion events. */
3086 if (! (EVENT_HAS_PARAMETERS (c)
3087 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
3088 /* Once we reread a character, echoing can happen
3089 the next time we pause to read a new one. */
3090 ok_to_echo_at_next_pause = current_kboard;
3092 /* Record this character as part of the current key. */
3093 add_command_key (c);
3094 if (! NILP (also_record))
3095 add_command_key (also_record);
3097 echo_update ();
3100 last_input_event = c;
3101 num_input_events++;
3103 /* Process the help character specially if enabled. */
3104 if (!NILP (Vhelp_form) && help_char_p (c))
3106 ptrdiff_t count = SPECPDL_INDEX ();
3108 help_form_saved_window_configs
3109 = Fcons (Fcurrent_window_configuration (Qnil),
3110 help_form_saved_window_configs);
3111 record_unwind_protect_void (read_char_help_form_unwind);
3112 call0 (Qhelp_form_show);
3114 cancel_echoing ();
3117 c = read_char (0, Qnil, Qnil, 0, NULL);
3118 if (EVENT_HAS_PARAMETERS (c)
3119 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_click))
3120 XSETCAR (help_form_saved_window_configs, Qnil);
3122 while (BUFFERP (c));
3123 /* Remove the help from the frame. */
3124 unbind_to (count, Qnil);
3126 redisplay ();
3127 if (EQ (c, make_number (040)))
3129 cancel_echoing ();
3131 c = read_char (0, Qnil, Qnil, 0, NULL);
3132 while (BUFFERP (c));
3136 exit:
3137 RESUME_POLLING;
3138 input_was_pending = input_pending;
3139 return c;
3142 /* Record a key that came from a mouse menu.
3143 Record it for echoing, for this-command-keys, and so on. */
3145 static void
3146 record_menu_key (Lisp_Object c)
3148 /* Wipe the echo area. */
3149 clear_message (1, 0);
3151 record_char (c);
3153 /* Once we reread a character, echoing can happen
3154 the next time we pause to read a new one. */
3155 ok_to_echo_at_next_pause = NULL;
3157 /* Record this character as part of the current key. */
3158 add_command_key (c);
3159 echo_update ();
3161 /* Re-reading in the middle of a command. */
3162 last_input_event = c;
3163 num_input_events++;
3166 /* Return true if should recognize C as "the help character". */
3168 static bool
3169 help_char_p (Lisp_Object c)
3171 Lisp_Object tail;
3173 if (EQ (c, Vhelp_char))
3174 return 1;
3175 for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
3176 if (EQ (c, XCAR (tail)))
3177 return 1;
3178 return 0;
3181 /* Record the input event C in various ways. */
3183 static void
3184 record_char (Lisp_Object c)
3186 int recorded = 0;
3188 if (CONSP (c) && (EQ (XCAR (c), Qhelp_echo) || EQ (XCAR (c), Qmouse_movement)))
3190 /* To avoid filling recent_keys with help-echo and mouse-movement
3191 events, we filter out repeated help-echo events, only store the
3192 first and last in a series of mouse-movement events, and don't
3193 store repeated help-echo events which are only separated by
3194 mouse-movement events. */
3196 Lisp_Object ev1, ev2, ev3;
3197 int ix1, ix2, ix3;
3199 if ((ix1 = recent_keys_index - 1) < 0)
3200 ix1 = NUM_RECENT_KEYS - 1;
3201 ev1 = AREF (recent_keys, ix1);
3203 if ((ix2 = ix1 - 1) < 0)
3204 ix2 = NUM_RECENT_KEYS - 1;
3205 ev2 = AREF (recent_keys, ix2);
3207 if ((ix3 = ix2 - 1) < 0)
3208 ix3 = NUM_RECENT_KEYS - 1;
3209 ev3 = AREF (recent_keys, ix3);
3211 if (EQ (XCAR (c), Qhelp_echo))
3213 /* Don't record `help-echo' in recent_keys unless it shows some help
3214 message, and a different help than the previously recorded
3215 event. */
3216 Lisp_Object help, last_help;
3218 help = Fcar_safe (Fcdr_safe (XCDR (c)));
3219 if (!STRINGP (help))
3220 recorded = 1;
3221 else if (CONSP (ev1) && EQ (XCAR (ev1), Qhelp_echo)
3222 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev1))), EQ (last_help, help)))
3223 recorded = 1;
3224 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3225 && CONSP (ev2) && EQ (XCAR (ev2), Qhelp_echo)
3226 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev2))), EQ (last_help, help)))
3227 recorded = -1;
3228 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3229 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3230 && CONSP (ev3) && EQ (XCAR (ev3), Qhelp_echo)
3231 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev3))), EQ (last_help, help)))
3232 recorded = -2;
3234 else if (EQ (XCAR (c), Qmouse_movement))
3236 /* Only record one pair of `mouse-movement' on a window in recent_keys.
3237 So additional mouse movement events replace the last element. */
3238 Lisp_Object last_window, window;
3240 window = Fcar_safe (Fcar_safe (XCDR (c)));
3241 if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3242 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev1))), EQ (last_window, window))
3243 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3244 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev2))), EQ (last_window, window)))
3246 ASET (recent_keys, ix1, c);
3247 recorded = 1;
3251 else
3252 store_kbd_macro_char (c);
3254 /* recent_keys should not include events from keyboard macros. */
3255 if (NILP (Vexecuting_kbd_macro))
3257 if (!recorded)
3259 total_keys += total_keys < NUM_RECENT_KEYS;
3260 ASET (recent_keys, recent_keys_index, c);
3261 if (++recent_keys_index >= NUM_RECENT_KEYS)
3262 recent_keys_index = 0;
3264 else if (recorded < 0)
3266 /* We need to remove one or two events from recent_keys.
3267 To do this, we simply put nil at those events and move the
3268 recent_keys_index backwards over those events. Usually,
3269 users will never see those nil events, as they will be
3270 overwritten by the command keys entered to see recent_keys
3271 (e.g. C-h l). */
3273 while (recorded++ < 0 && total_keys > 0)
3275 if (total_keys < NUM_RECENT_KEYS)
3276 total_keys--;
3277 if (--recent_keys_index < 0)
3278 recent_keys_index = NUM_RECENT_KEYS - 1;
3279 ASET (recent_keys, recent_keys_index, Qnil);
3283 num_nonmacro_input_events++;
3286 /* Write c to the dribble file. If c is a lispy event, write
3287 the event's symbol to the dribble file, in <brackets>. Bleaugh.
3288 If you, dear reader, have a better idea, you've got the source. :-) */
3289 if (dribble)
3291 block_input ();
3292 if (INTEGERP (c))
3294 if (XUINT (c) < 0x100)
3295 putc (XUINT (c), dribble);
3296 else
3297 fprintf (dribble, " 0x%"pI"x", XUINT (c));
3299 else
3301 Lisp_Object dribblee;
3303 /* If it's a structured event, take the event header. */
3304 dribblee = EVENT_HEAD (c);
3306 if (SYMBOLP (dribblee))
3308 putc ('<', dribble);
3309 fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
3310 SBYTES (SYMBOL_NAME (dribblee)),
3311 dribble);
3312 putc ('>', dribble);
3316 fflush (dribble);
3317 unblock_input ();
3321 /* Copy out or in the info on where C-g should throw to.
3322 This is used when running Lisp code from within get_char,
3323 in case get_char is called recursively.
3324 See read_process_output. */
3326 static void
3327 save_getcjmp (sys_jmp_buf temp)
3329 memcpy (temp, getcjmp, sizeof getcjmp);
3332 static void
3333 restore_getcjmp (sys_jmp_buf temp)
3335 memcpy (getcjmp, temp, sizeof getcjmp);
3338 /* Low level keyboard/mouse input.
3339 kbd_buffer_store_event places events in kbd_buffer, and
3340 kbd_buffer_get_event retrieves them. */
3342 /* Return true if there are any events in the queue that read-char
3343 would return. If this returns false, a read-char would block. */
3344 static bool
3345 readable_events (int flags)
3347 if (flags & READABLE_EVENTS_DO_TIMERS_NOW)
3348 timer_check ();
3350 /* If the buffer contains only FOCUS_IN_EVENT events, and
3351 READABLE_EVENTS_FILTER_EVENTS is set, report it as empty. */
3352 if (kbd_fetch_ptr != kbd_store_ptr)
3354 if (flags & (READABLE_EVENTS_FILTER_EVENTS
3355 #ifdef USE_TOOLKIT_SCROLL_BARS
3356 | READABLE_EVENTS_IGNORE_SQUEEZABLES
3357 #endif
3360 union buffered_input_event *event = kbd_fetch_ptr;
3364 if (event == kbd_buffer + KBD_BUFFER_SIZE)
3365 event = kbd_buffer;
3366 if (!(
3367 #ifdef USE_TOOLKIT_SCROLL_BARS
3368 (flags & READABLE_EVENTS_FILTER_EVENTS) &&
3369 #endif
3370 event->kind == FOCUS_IN_EVENT)
3371 #ifdef USE_TOOLKIT_SCROLL_BARS
3372 && !((flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3373 && (event->kind == SCROLL_BAR_CLICK_EVENT
3374 || event->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT)
3375 && event->ie.part == scroll_bar_handle
3376 && event->ie.modifiers == 0)
3377 #endif
3378 && !((flags & READABLE_EVENTS_FILTER_EVENTS)
3379 && event->kind == BUFFER_SWITCH_EVENT))
3380 return 1;
3381 event++;
3383 while (event != kbd_store_ptr);
3385 else
3386 return 1;
3389 if (!(flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3390 && !NILP (do_mouse_tracking) && some_mouse_moved ())
3391 return 1;
3392 if (single_kboard)
3394 if (current_kboard->kbd_queue_has_data)
3395 return 1;
3397 else
3399 KBOARD *kb;
3400 for (kb = all_kboards; kb; kb = kb->next_kboard)
3401 if (kb->kbd_queue_has_data)
3402 return 1;
3404 return 0;
3407 /* Set this for debugging, to have a way to get out */
3408 int stop_character EXTERNALLY_VISIBLE;
3410 static KBOARD *
3411 event_to_kboard (struct input_event *event)
3413 /* Not applicable for these special events. */
3414 if (event->kind == SELECTION_REQUEST_EVENT
3415 || event->kind == SELECTION_CLEAR_EVENT)
3416 return NULL;
3417 else
3419 Lisp_Object obj = event->frame_or_window;
3420 /* There are some events that set this field to nil or string. */
3421 if (WINDOWP (obj))
3422 obj = WINDOW_FRAME (XWINDOW (obj));
3423 /* Also ignore dead frames here. */
3424 return ((FRAMEP (obj) && FRAME_LIVE_P (XFRAME (obj)))
3425 ? FRAME_KBOARD (XFRAME (obj)) : NULL);
3429 #ifdef subprocesses
3430 /* Return the number of slots occupied in kbd_buffer. */
3432 static int
3433 kbd_buffer_nr_stored (void)
3435 return kbd_fetch_ptr == kbd_store_ptr
3437 : (kbd_fetch_ptr < kbd_store_ptr
3438 ? kbd_store_ptr - kbd_fetch_ptr
3439 : ((kbd_buffer + KBD_BUFFER_SIZE) - kbd_fetch_ptr
3440 + (kbd_store_ptr - kbd_buffer)));
3442 #endif /* Store an event obtained at interrupt level into kbd_buffer, fifo */
3444 void
3445 kbd_buffer_store_event (register struct input_event *event)
3447 kbd_buffer_store_event_hold (event, 0);
3450 /* Store EVENT obtained at interrupt level into kbd_buffer, fifo.
3452 If HOLD_QUIT is 0, just stuff EVENT into the fifo.
3453 Else, if HOLD_QUIT.kind != NO_EVENT, discard EVENT.
3454 Else, if EVENT is a quit event, store the quit event
3455 in HOLD_QUIT, and return (thus ignoring further events).
3457 This is used to postpone the processing of the quit event until all
3458 subsequent input events have been parsed (and discarded). */
3460 void
3461 kbd_buffer_store_buffered_event (union buffered_input_event *event,
3462 struct input_event *hold_quit)
3464 if (event->kind == NO_EVENT)
3465 emacs_abort ();
3467 if (hold_quit && hold_quit->kind != NO_EVENT)
3468 return;
3470 if (event->kind == ASCII_KEYSTROKE_EVENT)
3472 int c = event->ie.code & 0377;
3474 if (event->ie.modifiers & ctrl_modifier)
3475 c = make_ctrl_char (c);
3477 c |= (event->ie.modifiers
3478 & (meta_modifier | alt_modifier
3479 | hyper_modifier | super_modifier));
3481 if (c == quit_char)
3483 KBOARD *kb = FRAME_KBOARD (XFRAME (event->ie.frame_or_window));
3485 if (single_kboard && kb != current_kboard)
3487 kset_kbd_queue
3488 (kb, list2 (make_lispy_switch_frame (event->ie.frame_or_window),
3489 make_number (c)));
3490 kb->kbd_queue_has_data = true;
3491 union buffered_input_event *sp;
3492 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3494 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3495 sp = kbd_buffer;
3497 if (event_to_kboard (&sp->ie) == kb)
3499 sp->ie.kind = NO_EVENT;
3500 sp->ie.frame_or_window = Qnil;
3501 sp->ie.arg = Qnil;
3504 return;
3507 if (hold_quit)
3509 *hold_quit = event->ie;
3510 return;
3513 /* If this results in a quit_char being returned to Emacs as
3514 input, set Vlast_event_frame properly. If this doesn't
3515 get returned to Emacs as an event, the next event read
3516 will set Vlast_event_frame again, so this is safe to do. */
3518 Lisp_Object focus;
3520 focus = FRAME_FOCUS_FRAME (XFRAME (event->ie.frame_or_window));
3521 if (NILP (focus))
3522 focus = event->ie.frame_or_window;
3523 internal_last_event_frame = focus;
3524 Vlast_event_frame = focus;
3527 handle_interrupt (0);
3528 return;
3531 if (c && c == stop_character)
3533 sys_suspend ();
3534 return;
3537 /* Don't insert two BUFFER_SWITCH_EVENT's in a row.
3538 Just ignore the second one. */
3539 else if (event->kind == BUFFER_SWITCH_EVENT
3540 && kbd_fetch_ptr != kbd_store_ptr
3541 && ((kbd_store_ptr == kbd_buffer
3542 ? kbd_buffer + KBD_BUFFER_SIZE - 1
3543 : kbd_store_ptr - 1)->kind) == BUFFER_SWITCH_EVENT)
3544 return;
3546 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
3547 kbd_store_ptr = kbd_buffer;
3549 /* Don't let the very last slot in the buffer become full,
3550 since that would make the two pointers equal,
3551 and that is indistinguishable from an empty buffer.
3552 Discard the event if it would fill the last slot. */
3553 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3555 *kbd_store_ptr = *event;
3556 ++kbd_store_ptr;
3557 #ifdef subprocesses
3558 if (kbd_buffer_nr_stored () > KBD_BUFFER_SIZE / 2
3559 && ! kbd_on_hold_p ())
3561 /* Don't read keyboard input until we have processed kbd_buffer.
3562 This happens when pasting text longer than KBD_BUFFER_SIZE/2. */
3563 hold_keyboard_input ();
3564 unrequest_sigio ();
3565 stop_polling ();
3567 #endif /* subprocesses */
3570 Lisp_Object ignore_event;
3572 switch (event->kind)
3574 case FOCUS_IN_EVENT: ignore_event = Qfocus_in; break;
3575 case FOCUS_OUT_EVENT: ignore_event = Qfocus_out; break;
3576 case HELP_EVENT: ignore_event = Qhelp_echo; break;
3577 case ICONIFY_EVENT: ignore_event = Qiconify_frame; break;
3578 case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break;
3579 case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break;
3580 default: ignore_event = Qnil; break;
3583 /* If we're inside while-no-input, and this event qualifies
3584 as input, set quit-flag to cause an interrupt. */
3585 if (!NILP (Vthrow_on_input)
3586 && NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events)))
3588 Vquit_flag = Vthrow_on_input;
3589 /* If we're inside a function that wants immediate quits,
3590 do it now. */
3591 if (immediate_quit && NILP (Vinhibit_quit))
3593 immediate_quit = false;
3594 maybe_quit ();
3600 #ifdef HAVE_X11
3602 /* Put a selection input event back in the head of the event queue. */
3604 void
3605 kbd_buffer_unget_event (struct selection_input_event *event)
3607 if (kbd_fetch_ptr == kbd_buffer)
3608 kbd_fetch_ptr = kbd_buffer + KBD_BUFFER_SIZE;
3610 /* Don't let the very last slot in the buffer become full, */
3611 union buffered_input_event *kp = kbd_fetch_ptr - 1;
3612 if (kp != kbd_store_ptr)
3614 kp->sie = *event;
3615 kbd_fetch_ptr = kp;
3619 #endif
3621 /* Limit help event positions to this range, to avoid overflow problems. */
3622 #define INPUT_EVENT_POS_MAX \
3623 ((ptrdiff_t) min (PTRDIFF_MAX, min (TYPE_MAXIMUM (Time) / 2, \
3624 MOST_POSITIVE_FIXNUM)))
3625 #define INPUT_EVENT_POS_MIN (-1 - INPUT_EVENT_POS_MAX)
3627 /* Return a Time that encodes position POS. POS must be in range. */
3629 static Time
3630 position_to_Time (ptrdiff_t pos)
3632 eassert (INPUT_EVENT_POS_MIN <= pos && pos <= INPUT_EVENT_POS_MAX);
3633 return pos;
3636 /* Return the position that ENCODED_POS encodes.
3637 Avoid signed integer overflow. */
3639 static ptrdiff_t
3640 Time_to_position (Time encoded_pos)
3642 if (encoded_pos <= INPUT_EVENT_POS_MAX)
3643 return encoded_pos;
3644 Time encoded_pos_min = INPUT_EVENT_POS_MIN;
3645 eassert (encoded_pos_min <= encoded_pos);
3646 ptrdiff_t notpos = -1 - encoded_pos;
3647 return -1 - notpos;
3650 /* Generate a HELP_EVENT input_event and store it in the keyboard
3651 buffer.
3653 HELP is the help form.
3655 FRAME and WINDOW are the frame and window where the help is
3656 generated. OBJECT is the Lisp object where the help was found (a
3657 buffer, a string, an overlay, or nil if neither from a string nor
3658 from a buffer). POS is the position within OBJECT where the help
3659 was found. */
3661 void
3662 gen_help_event (Lisp_Object help, Lisp_Object frame, Lisp_Object window,
3663 Lisp_Object object, ptrdiff_t pos)
3665 struct input_event event;
3667 event.kind = HELP_EVENT;
3668 event.frame_or_window = frame;
3669 event.arg = object;
3670 event.x = WINDOWP (window) ? window : frame;
3671 event.y = help;
3672 event.timestamp = position_to_Time (pos);
3673 kbd_buffer_store_event (&event);
3677 /* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3679 void
3680 kbd_buffer_store_help_event (Lisp_Object frame, Lisp_Object help)
3682 struct input_event event;
3684 event.kind = HELP_EVENT;
3685 event.frame_or_window = frame;
3686 event.arg = Qnil;
3687 event.x = Qnil;
3688 event.y = help;
3689 event.timestamp = 0;
3690 kbd_buffer_store_event (&event);
3694 /* Discard any mouse events in the event buffer by setting them to
3695 NO_EVENT. */
3696 void
3697 discard_mouse_events (void)
3699 union buffered_input_event *sp;
3700 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3702 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3703 sp = kbd_buffer;
3705 if (sp->kind == MOUSE_CLICK_EVENT
3706 || sp->kind == WHEEL_EVENT
3707 || sp->kind == HORIZ_WHEEL_EVENT
3708 #ifdef HAVE_GPM
3709 || sp->kind == GPM_CLICK_EVENT
3710 #endif
3711 || sp->kind == SCROLL_BAR_CLICK_EVENT
3712 || sp->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT)
3714 sp->kind = NO_EVENT;
3720 /* Return true if there are any real events waiting in the event
3721 buffer, not counting `NO_EVENT's.
3723 Discard NO_EVENT events at the front of the input queue, possibly
3724 leaving the input queue empty if there are no real input events. */
3726 bool
3727 kbd_buffer_events_waiting (void)
3729 union buffered_input_event *sp;
3731 for (sp = kbd_fetch_ptr;
3732 sp != kbd_store_ptr && sp->kind == NO_EVENT;
3733 ++sp)
3735 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3736 sp = kbd_buffer;
3739 kbd_fetch_ptr = sp;
3740 return sp != kbd_store_ptr && sp->kind != NO_EVENT;
3744 /* Clear input event EVENT. */
3746 static void
3747 clear_event (union buffered_input_event *event)
3749 event->kind = NO_EVENT;
3753 /* Read one event from the event buffer, waiting if necessary.
3754 The value is a Lisp object representing the event.
3755 The value is nil for an event that should be ignored,
3756 or that was handled here.
3757 We always read and discard one event. */
3759 static Lisp_Object
3760 kbd_buffer_get_event (KBOARD **kbp,
3761 bool *used_mouse_menu,
3762 struct timespec *end_time)
3764 Lisp_Object obj;
3766 #ifdef subprocesses
3767 if (kbd_on_hold_p () && kbd_buffer_nr_stored () < KBD_BUFFER_SIZE / 4)
3769 /* Start reading input again because we have processed enough to
3770 be able to accept new events again. */
3771 unhold_keyboard_input ();
3772 request_sigio ();
3773 start_polling ();
3775 #endif /* subprocesses */
3777 #if !defined HAVE_DBUS && !defined USE_FILE_NOTIFY
3778 if (noninteractive
3779 /* In case we are running as a daemon, only do this before
3780 detaching from the terminal. */
3781 || (IS_DAEMON && DAEMON_RUNNING))
3783 int c = getchar ();
3784 XSETINT (obj, c);
3785 *kbp = current_kboard;
3786 return obj;
3788 #endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY */
3790 /* Wait until there is input available. */
3791 for (;;)
3793 /* Break loop if there's an unread command event. Needed in
3794 moused window autoselection which uses a timer to insert such
3795 events. */
3796 if (CONSP (Vunread_command_events))
3797 break;
3799 if (kbd_fetch_ptr != kbd_store_ptr)
3800 break;
3801 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3802 break;
3804 /* If the quit flag is set, then read_char will return
3805 quit_char, so that counts as "available input." */
3806 if (!NILP (Vquit_flag))
3807 quit_throw_to_read_char (0);
3809 /* One way or another, wait until input is available; then, if
3810 interrupt handlers have not read it, read it now. */
3812 #ifdef USABLE_SIGIO
3813 gobble_input ();
3814 #endif
3815 if (kbd_fetch_ptr != kbd_store_ptr)
3816 break;
3817 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3818 break;
3819 if (end_time)
3821 struct timespec now = current_timespec ();
3822 if (timespec_cmp (*end_time, now) <= 0)
3823 return Qnil; /* Finished waiting. */
3824 else
3826 struct timespec duration = timespec_sub (*end_time, now);
3827 wait_reading_process_output (min (duration.tv_sec,
3828 WAIT_READING_MAX),
3829 duration.tv_nsec,
3830 -1, 1, Qnil, NULL, 0);
3833 else
3835 bool do_display = true;
3837 if (FRAME_TERMCAP_P (SELECTED_FRAME ()))
3839 struct tty_display_info *tty = CURTTY ();
3841 /* When this TTY is displaying a menu, we must prevent
3842 any redisplay, because we modify the frame's glyph
3843 matrix behind the back of the display engine. */
3844 if (tty->showing_menu)
3845 do_display = false;
3848 wait_reading_process_output (0, 0, -1, do_display, Qnil, NULL, 0);
3851 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
3852 gobble_input ();
3855 if (CONSP (Vunread_command_events))
3857 Lisp_Object first;
3858 first = XCAR (Vunread_command_events);
3859 Vunread_command_events = XCDR (Vunread_command_events);
3860 *kbp = current_kboard;
3861 return first;
3864 /* At this point, we know that there is a readable event available
3865 somewhere. If the event queue is empty, then there must be a
3866 mouse movement enabled and available. */
3867 if (kbd_fetch_ptr != kbd_store_ptr)
3869 union buffered_input_event *event;
3871 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3872 ? kbd_fetch_ptr
3873 : kbd_buffer);
3875 *kbp = event_to_kboard (&event->ie);
3876 if (*kbp == 0)
3877 *kbp = current_kboard; /* Better than returning null ptr? */
3879 obj = Qnil;
3881 /* These two kinds of events get special handling
3882 and don't actually appear to the command loop.
3883 We return nil for them. */
3884 if (event->kind == SELECTION_REQUEST_EVENT
3885 || event->kind == SELECTION_CLEAR_EVENT)
3887 #ifdef HAVE_X11
3888 /* Remove it from the buffer before processing it,
3889 since otherwise swallow_events will see it
3890 and process it again. */
3891 struct selection_input_event copy = event->sie;
3892 kbd_fetch_ptr = event + 1;
3893 input_pending = readable_events (0);
3894 x_handle_selection_event (&copy);
3895 #else
3896 /* We're getting selection request events, but we don't have
3897 a window system. */
3898 emacs_abort ();
3899 #endif
3902 #if defined (HAVE_NS)
3903 else if (event->kind == NS_TEXT_EVENT)
3905 if (event->ie.code == KEY_NS_PUT_WORKING_TEXT)
3906 obj = list1 (intern ("ns-put-working-text"));
3907 else
3908 obj = list1 (intern ("ns-unput-working-text"));
3909 kbd_fetch_ptr = event + 1;
3910 if (used_mouse_menu)
3911 *used_mouse_menu = true;
3913 #endif
3915 #if defined (HAVE_X11) || defined (HAVE_NTGUI) \
3916 || defined (HAVE_NS)
3917 else if (event->kind == DELETE_WINDOW_EVENT)
3919 /* Make an event (delete-frame (FRAME)). */
3920 obj = list2 (Qdelete_frame, list1 (event->ie.frame_or_window));
3921 kbd_fetch_ptr = event + 1;
3923 #endif
3925 #ifdef HAVE_NTGUI
3926 else if (event->kind == END_SESSION_EVENT)
3928 /* Make an event (end-session). */
3929 obj = list1 (Qend_session);
3930 kbd_fetch_ptr = event + 1;
3932 #endif
3934 #if defined (HAVE_X11) || defined (HAVE_NTGUI) \
3935 || defined (HAVE_NS)
3936 else if (event->kind == ICONIFY_EVENT)
3938 /* Make an event (iconify-frame (FRAME)). */
3939 obj = list2 (Qiconify_frame, list1 (event->ie.frame_or_window));
3940 kbd_fetch_ptr = event + 1;
3942 else if (event->kind == DEICONIFY_EVENT)
3944 /* Make an event (make-frame-visible (FRAME)). */
3945 obj = list2 (Qmake_frame_visible, list1 (event->ie.frame_or_window));
3946 kbd_fetch_ptr = event + 1;
3948 #endif
3949 else if (event->kind == BUFFER_SWITCH_EVENT)
3951 /* The value doesn't matter here; only the type is tested. */
3952 XSETBUFFER (obj, current_buffer);
3953 kbd_fetch_ptr = event + 1;
3955 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
3956 || defined (HAVE_NS) || defined (USE_GTK)
3957 else if (event->kind == MENU_BAR_ACTIVATE_EVENT)
3959 kbd_fetch_ptr = event + 1;
3960 input_pending = readable_events (0);
3961 if (FRAME_LIVE_P (XFRAME (event->ie.frame_or_window)))
3962 x_activate_menubar (XFRAME (event->ie.frame_or_window));
3964 #endif
3965 #ifdef HAVE_NTGUI
3966 else if (event->kind == LANGUAGE_CHANGE_EVENT)
3968 /* Make an event (language-change FRAME CODEPAGE LANGUAGE-ID). */
3969 obj = list4 (Qlanguage_change,
3970 event->ie.frame_or_window,
3971 make_number (event->ie.code),
3972 make_number (event->ie.modifiers));
3973 kbd_fetch_ptr = event + 1;
3975 #endif
3976 #ifdef USE_FILE_NOTIFY
3977 else if (event->kind == FILE_NOTIFY_EVENT)
3979 #ifdef HAVE_W32NOTIFY
3980 /* Make an event (file-notify (DESCRIPTOR ACTION FILE) CALLBACK). */
3981 obj = list3 (Qfile_notify, event->ie.arg, event->ie.frame_or_window);
3982 #else
3983 obj = make_lispy_event (&event->ie);
3984 #endif
3985 kbd_fetch_ptr = event + 1;
3987 #endif /* USE_FILE_NOTIFY */
3988 else if (event->kind == SAVE_SESSION_EVENT)
3990 obj = list2 (Qsave_session, event->ie.arg);
3991 kbd_fetch_ptr = event + 1;
3993 /* Just discard these, by returning nil.
3994 With MULTI_KBOARD, these events are used as placeholders
3995 when we need to randomly delete events from the queue.
3996 (They shouldn't otherwise be found in the buffer,
3997 but on some machines it appears they do show up
3998 even without MULTI_KBOARD.) */
3999 /* On Windows NT/9X, NO_EVENT is used to delete extraneous
4000 mouse events during a popup-menu call. */
4001 else if (event->kind == NO_EVENT)
4002 kbd_fetch_ptr = event + 1;
4003 else if (event->kind == HELP_EVENT)
4005 Lisp_Object object, position, help, frame, window;
4007 frame = event->ie.frame_or_window;
4008 object = event->ie.arg;
4009 position = make_number (Time_to_position (event->ie.timestamp));
4010 window = event->ie.x;
4011 help = event->ie.y;
4012 clear_event (event);
4014 kbd_fetch_ptr = event + 1;
4015 if (!WINDOWP (window))
4016 window = Qnil;
4017 obj = Fcons (Qhelp_echo,
4018 list5 (frame, help, window, object, position));
4020 else if (event->kind == FOCUS_IN_EVENT)
4022 /* Notification of a FocusIn event. The frame receiving the
4023 focus is in event->frame_or_window. Generate a
4024 switch-frame event if necessary. */
4025 Lisp_Object frame, focus;
4027 frame = event->ie.frame_or_window;
4028 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4029 if (FRAMEP (focus))
4030 frame = focus;
4032 if (
4033 #ifdef HAVE_X11
4034 ! NILP (event->ie.arg)
4036 #endif
4037 !EQ (frame, internal_last_event_frame)
4038 && !EQ (frame, selected_frame))
4039 obj = make_lispy_switch_frame (frame);
4040 else
4041 obj = make_lispy_focus_in (frame);
4043 internal_last_event_frame = frame;
4044 kbd_fetch_ptr = event + 1;
4046 else if (event->kind == FOCUS_OUT_EVENT)
4048 #ifdef HAVE_WINDOW_SYSTEM
4050 Display_Info *di;
4051 Lisp_Object frame = event->ie.frame_or_window;
4052 bool focused = false;
4054 for (di = x_display_list; di && ! focused; di = di->next)
4055 focused = di->x_highlight_frame != 0;
4057 if (!focused)
4058 obj = make_lispy_focus_out (frame);
4060 #endif /* HAVE_WINDOW_SYSTEM */
4062 kbd_fetch_ptr = event + 1;
4064 #ifdef HAVE_DBUS
4065 else if (event->kind == DBUS_EVENT)
4067 obj = make_lispy_event (&event->ie);
4068 kbd_fetch_ptr = event + 1;
4070 #endif
4071 #ifdef HAVE_XWIDGETS
4072 else if (event->kind == XWIDGET_EVENT)
4074 obj = make_lispy_event (&event->ie);
4075 kbd_fetch_ptr = event + 1;
4077 #endif
4078 else if (event->kind == CONFIG_CHANGED_EVENT)
4080 obj = make_lispy_event (&event->ie);
4081 kbd_fetch_ptr = event + 1;
4083 else
4085 /* If this event is on a different frame, return a switch-frame this
4086 time, and leave the event in the queue for next time. */
4087 Lisp_Object frame;
4088 Lisp_Object focus;
4090 frame = event->ie.frame_or_window;
4091 if (CONSP (frame))
4092 frame = XCAR (frame);
4093 else if (WINDOWP (frame))
4094 frame = WINDOW_FRAME (XWINDOW (frame));
4096 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4097 if (! NILP (focus))
4098 frame = focus;
4100 if (! EQ (frame, internal_last_event_frame)
4101 && !EQ (frame, selected_frame))
4102 obj = make_lispy_switch_frame (frame);
4103 internal_last_event_frame = frame;
4105 /* If we didn't decide to make a switch-frame event, go ahead
4106 and build a real event from the queue entry. */
4108 if (NILP (obj))
4110 obj = make_lispy_event (&event->ie);
4112 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
4113 || defined (HAVE_NS) || defined (USE_GTK)
4114 /* If this was a menu selection, then set the flag to inhibit
4115 writing to last_nonmenu_event. Don't do this if the event
4116 we're returning is (menu-bar), though; that indicates the
4117 beginning of the menu sequence, and we might as well leave
4118 that as the `event with parameters' for this selection. */
4119 if (used_mouse_menu
4120 && !EQ (event->ie.frame_or_window, event->ie.arg)
4121 && (event->kind == MENU_BAR_EVENT
4122 || event->kind == TOOL_BAR_EVENT))
4123 *used_mouse_menu = true;
4124 #endif
4125 #ifdef HAVE_NS
4126 /* Certain system events are non-key events. */
4127 if (used_mouse_menu
4128 && event->kind == NS_NONKEY_EVENT)
4129 *used_mouse_menu = true;
4130 #endif
4132 /* Wipe out this event, to catch bugs. */
4133 clear_event (event);
4134 kbd_fetch_ptr = event + 1;
4138 /* Try generating a mouse motion event. */
4139 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
4141 struct frame *f = some_mouse_moved ();
4142 Lisp_Object bar_window;
4143 enum scroll_bar_part part;
4144 Lisp_Object x, y;
4145 Time t;
4147 *kbp = current_kboard;
4148 /* Note that this uses F to determine which terminal to look at.
4149 If there is no valid info, it does not store anything
4150 so x remains nil. */
4151 x = Qnil;
4153 /* XXX Can f or mouse_position_hook be NULL here? */
4154 if (f && FRAME_TERMINAL (f)->mouse_position_hook)
4155 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, 0, &bar_window,
4156 &part, &x, &y, &t);
4158 obj = Qnil;
4160 /* Decide if we should generate a switch-frame event. Don't
4161 generate switch-frame events for motion outside of all Emacs
4162 frames. */
4163 if (!NILP (x) && f)
4165 Lisp_Object frame;
4167 frame = FRAME_FOCUS_FRAME (f);
4168 if (NILP (frame))
4169 XSETFRAME (frame, f);
4171 if (! EQ (frame, internal_last_event_frame)
4172 && !EQ (frame, selected_frame))
4173 obj = make_lispy_switch_frame (frame);
4174 internal_last_event_frame = frame;
4177 /* If we didn't decide to make a switch-frame event, go ahead and
4178 return a mouse-motion event. */
4179 if (!NILP (x) && NILP (obj))
4180 obj = make_lispy_movement (f, bar_window, part, x, y, t);
4182 else
4183 /* We were promised by the above while loop that there was
4184 something for us to read! */
4185 emacs_abort ();
4187 input_pending = readable_events (0);
4189 Vlast_event_frame = internal_last_event_frame;
4191 return (obj);
4194 /* Process any non-user-visible events (currently X selection events),
4195 without reading any user-visible events. */
4197 static void
4198 process_special_events (void)
4200 union buffered_input_event *event;
4202 for (event = kbd_fetch_ptr; event != kbd_store_ptr; ++event)
4204 if (event == kbd_buffer + KBD_BUFFER_SIZE)
4206 event = kbd_buffer;
4207 if (event == kbd_store_ptr)
4208 break;
4211 /* If we find a stored X selection request, handle it now. */
4212 if (event->kind == SELECTION_REQUEST_EVENT
4213 || event->kind == SELECTION_CLEAR_EVENT)
4215 #ifdef HAVE_X11
4217 /* Remove the event from the fifo buffer before processing;
4218 otherwise swallow_events called recursively could see it
4219 and process it again. To do this, we move the events
4220 between kbd_fetch_ptr and EVENT one slot to the right,
4221 cyclically. */
4223 struct selection_input_event copy = event->sie;
4224 union buffered_input_event *beg
4225 = (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
4226 ? kbd_buffer : kbd_fetch_ptr;
4228 if (event > beg)
4229 memmove (beg + 1, beg, (event - beg) * sizeof *beg);
4230 else if (event < beg)
4232 if (event > kbd_buffer)
4233 memmove (kbd_buffer + 1, kbd_buffer,
4234 (event - kbd_buffer) * sizeof *kbd_buffer);
4235 *kbd_buffer = *(kbd_buffer + KBD_BUFFER_SIZE - 1);
4236 if (beg < kbd_buffer + KBD_BUFFER_SIZE - 1)
4237 memmove (beg + 1, beg,
4238 (kbd_buffer + KBD_BUFFER_SIZE - 1 - beg) * sizeof *beg);
4241 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
4242 kbd_fetch_ptr = kbd_buffer + 1;
4243 else
4244 kbd_fetch_ptr++;
4246 input_pending = readable_events (0);
4247 x_handle_selection_event (&copy);
4248 #else
4249 /* We're getting selection request events, but we don't have
4250 a window system. */
4251 emacs_abort ();
4252 #endif
4257 /* Process any events that are not user-visible, run timer events that
4258 are ripe, and return, without reading any user-visible events. */
4260 void
4261 swallow_events (bool do_display)
4263 unsigned old_timers_run;
4265 process_special_events ();
4267 old_timers_run = timers_run;
4268 get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
4270 if (!input_pending && timers_run != old_timers_run && do_display)
4271 redisplay_preserve_echo_area (7);
4274 /* Record the start of when Emacs is idle,
4275 for the sake of running idle-time timers. */
4277 static void
4278 timer_start_idle (void)
4280 /* If we are already in the idle state, do nothing. */
4281 if (timespec_valid_p (timer_idleness_start_time))
4282 return;
4284 timer_idleness_start_time = current_timespec ();
4285 timer_last_idleness_start_time = timer_idleness_start_time;
4287 /* Mark all idle-time timers as once again candidates for running. */
4288 call0 (intern ("internal-timer-start-idle"));
4291 /* Record that Emacs is no longer idle, so stop running idle-time timers. */
4293 static void
4294 timer_stop_idle (void)
4296 timer_idleness_start_time = invalid_timespec ();
4299 /* Resume idle timer from last idle start time. */
4301 static void
4302 timer_resume_idle (void)
4304 if (timespec_valid_p (timer_idleness_start_time))
4305 return;
4307 timer_idleness_start_time = timer_last_idleness_start_time;
4310 /* List of elisp functions to call, delayed because they were generated in
4311 a context where Elisp could not be safely run (e.g. redisplay, signal,
4312 ...). Each element has the form (FUN . ARGS). */
4313 Lisp_Object pending_funcalls;
4315 /* Return true if TIMER is a valid timer, placing its value into *RESULT. */
4316 static bool
4317 decode_timer (Lisp_Object timer, struct timespec *result)
4319 Lisp_Object *vec;
4321 if (! (VECTORP (timer) && ASIZE (timer) == 9))
4322 return 0;
4323 vec = XVECTOR (timer)->contents;
4324 if (! NILP (vec[0]))
4325 return 0;
4326 if (! INTEGERP (vec[2]))
4327 return false;
4329 struct lisp_time t;
4330 if (decode_time_components (vec[1], vec[2], vec[3], vec[8], &t, 0) <= 0)
4331 return false;
4332 *result = lisp_to_timespec (t);
4333 return timespec_valid_p (*result);
4337 /* Check whether a timer has fired. To prevent larger problems we simply
4338 disregard elements that are not proper timers. Do not make a circular
4339 timer list for the time being.
4341 Returns the time to wait until the next timer fires. If a
4342 timer is triggering now, return zero.
4343 If no timer is active, return -1.
4345 If a timer is ripe, we run it, with quitting turned off.
4346 In that case we return 0 to indicate that a new timer_check_2 call
4347 should be done. */
4349 static struct timespec
4350 timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
4352 struct timespec nexttime;
4353 struct timespec now;
4354 struct timespec idleness_now;
4355 Lisp_Object chosen_timer;
4357 nexttime = invalid_timespec ();
4359 chosen_timer = Qnil;
4361 /* First run the code that was delayed. */
4362 while (CONSP (pending_funcalls))
4364 Lisp_Object funcall = XCAR (pending_funcalls);
4365 pending_funcalls = XCDR (pending_funcalls);
4366 safe_call2 (Qapply, XCAR (funcall), XCDR (funcall));
4369 if (CONSP (timers) || CONSP (idle_timers))
4371 now = current_timespec ();
4372 idleness_now = (timespec_valid_p (timer_idleness_start_time)
4373 ? timespec_sub (now, timer_idleness_start_time)
4374 : make_timespec (0, 0));
4377 while (CONSP (timers) || CONSP (idle_timers))
4379 Lisp_Object timer = Qnil, idle_timer = Qnil;
4380 struct timespec timer_time, idle_timer_time;
4381 struct timespec difference;
4382 struct timespec timer_difference = invalid_timespec ();
4383 struct timespec idle_timer_difference = invalid_timespec ();
4384 bool ripe, timer_ripe = 0, idle_timer_ripe = 0;
4386 /* Set TIMER and TIMER_DIFFERENCE
4387 based on the next ordinary timer.
4388 TIMER_DIFFERENCE is the distance in time from NOW to when
4389 this timer becomes ripe.
4390 Skip past invalid timers and timers already handled. */
4391 if (CONSP (timers))
4393 timer = XCAR (timers);
4394 if (! decode_timer (timer, &timer_time))
4396 timers = XCDR (timers);
4397 continue;
4400 timer_ripe = timespec_cmp (timer_time, now) <= 0;
4401 timer_difference = (timer_ripe
4402 ? timespec_sub (now, timer_time)
4403 : timespec_sub (timer_time, now));
4406 /* Likewise for IDLE_TIMER and IDLE_TIMER_DIFFERENCE
4407 based on the next idle timer. */
4408 if (CONSP (idle_timers))
4410 idle_timer = XCAR (idle_timers);
4411 if (! decode_timer (idle_timer, &idle_timer_time))
4413 idle_timers = XCDR (idle_timers);
4414 continue;
4417 idle_timer_ripe = timespec_cmp (idle_timer_time, idleness_now) <= 0;
4418 idle_timer_difference
4419 = (idle_timer_ripe
4420 ? timespec_sub (idleness_now, idle_timer_time)
4421 : timespec_sub (idle_timer_time, idleness_now));
4424 /* Decide which timer is the next timer,
4425 and set CHOSEN_TIMER, DIFFERENCE, and RIPE accordingly.
4426 Also step down the list where we found that timer. */
4428 if (timespec_valid_p (timer_difference)
4429 && (! timespec_valid_p (idle_timer_difference)
4430 || idle_timer_ripe < timer_ripe
4431 || (idle_timer_ripe == timer_ripe
4432 && ((timer_ripe
4433 ? timespec_cmp (idle_timer_difference,
4434 timer_difference)
4435 : timespec_cmp (timer_difference,
4436 idle_timer_difference))
4437 < 0))))
4439 chosen_timer = timer;
4440 timers = XCDR (timers);
4441 difference = timer_difference;
4442 ripe = timer_ripe;
4444 else
4446 chosen_timer = idle_timer;
4447 idle_timers = XCDR (idle_timers);
4448 difference = idle_timer_difference;
4449 ripe = idle_timer_ripe;
4452 /* If timer is ripe, run it if it hasn't been run. */
4453 if (ripe)
4455 if (NILP (AREF (chosen_timer, 0)))
4457 ptrdiff_t count = SPECPDL_INDEX ();
4458 Lisp_Object old_deactivate_mark = Vdeactivate_mark;
4460 /* Mark the timer as triggered to prevent problems if the lisp
4461 code fails to reschedule it right. */
4462 ASET (chosen_timer, 0, Qt);
4464 specbind (Qinhibit_quit, Qt);
4466 call1 (Qtimer_event_handler, chosen_timer);
4467 Vdeactivate_mark = old_deactivate_mark;
4468 timers_run++;
4469 unbind_to (count, Qnil);
4471 /* Since we have handled the event,
4472 we don't need to tell the caller to wake up and do it. */
4473 /* But the caller must still wait for the next timer, so
4474 return 0 to indicate that. */
4477 nexttime = make_timespec (0, 0);
4478 break;
4480 else
4481 /* When we encounter a timer that is still waiting,
4482 return the amount of time to wait before it is ripe. */
4484 return difference;
4488 /* No timers are pending in the future. */
4489 /* Return 0 if we generated an event, and -1 if not. */
4490 return nexttime;
4494 /* Check whether a timer has fired. To prevent larger problems we simply
4495 disregard elements that are not proper timers. Do not make a circular
4496 timer list for the time being.
4498 Returns the time to wait until the next timer fires.
4499 If no timer is active, return an invalid value.
4501 As long as any timer is ripe, we run it. */
4503 struct timespec
4504 timer_check (void)
4506 struct timespec nexttime;
4507 Lisp_Object timers, idle_timers;
4509 Lisp_Object tem = Vinhibit_quit;
4510 Vinhibit_quit = Qt;
4512 /* We use copies of the timers' lists to allow a timer to add itself
4513 again, without locking up Emacs if the newly added timer is
4514 already ripe when added. */
4516 /* Always consider the ordinary timers. */
4517 timers = Fcopy_sequence (Vtimer_list);
4518 /* Consider the idle timers only if Emacs is idle. */
4519 if (timespec_valid_p (timer_idleness_start_time))
4520 idle_timers = Fcopy_sequence (Vtimer_idle_list);
4521 else
4522 idle_timers = Qnil;
4524 Vinhibit_quit = tem;
4528 nexttime = timer_check_2 (timers, idle_timers);
4530 while (nexttime.tv_sec == 0 && nexttime.tv_nsec == 0);
4532 return nexttime;
4535 DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0,
4536 doc: /* Return the current length of Emacs idleness, or nil.
4537 The value when Emacs is idle is a list of four integers (HIGH LOW USEC PSEC)
4538 in the same style as (current-time).
4540 The value when Emacs is not idle is nil.
4542 PSEC is a multiple of the system clock resolution. */)
4543 (void)
4545 if (timespec_valid_p (timer_idleness_start_time))
4546 return make_lisp_time (timespec_sub (current_timespec (),
4547 timer_idleness_start_time));
4549 return Qnil;
4552 /* Caches for modify_event_symbol. */
4553 static Lisp_Object accent_key_syms;
4554 static Lisp_Object func_key_syms;
4555 static Lisp_Object mouse_syms;
4556 static Lisp_Object wheel_syms;
4557 static Lisp_Object drag_n_drop_syms;
4559 /* This is a list of keysym codes for special "accent" characters.
4560 It parallels lispy_accent_keys. */
4562 static const int lispy_accent_codes[] =
4564 #ifdef XK_dead_circumflex
4565 XK_dead_circumflex,
4566 #else
4568 #endif
4569 #ifdef XK_dead_grave
4570 XK_dead_grave,
4571 #else
4573 #endif
4574 #ifdef XK_dead_tilde
4575 XK_dead_tilde,
4576 #else
4578 #endif
4579 #ifdef XK_dead_diaeresis
4580 XK_dead_diaeresis,
4581 #else
4583 #endif
4584 #ifdef XK_dead_macron
4585 XK_dead_macron,
4586 #else
4588 #endif
4589 #ifdef XK_dead_degree
4590 XK_dead_degree,
4591 #else
4593 #endif
4594 #ifdef XK_dead_acute
4595 XK_dead_acute,
4596 #else
4598 #endif
4599 #ifdef XK_dead_cedilla
4600 XK_dead_cedilla,
4601 #else
4603 #endif
4604 #ifdef XK_dead_breve
4605 XK_dead_breve,
4606 #else
4608 #endif
4609 #ifdef XK_dead_ogonek
4610 XK_dead_ogonek,
4611 #else
4613 #endif
4614 #ifdef XK_dead_caron
4615 XK_dead_caron,
4616 #else
4618 #endif
4619 #ifdef XK_dead_doubleacute
4620 XK_dead_doubleacute,
4621 #else
4623 #endif
4624 #ifdef XK_dead_abovedot
4625 XK_dead_abovedot,
4626 #else
4628 #endif
4629 #ifdef XK_dead_abovering
4630 XK_dead_abovering,
4631 #else
4633 #endif
4634 #ifdef XK_dead_iota
4635 XK_dead_iota,
4636 #else
4638 #endif
4639 #ifdef XK_dead_belowdot
4640 XK_dead_belowdot,
4641 #else
4643 #endif
4644 #ifdef XK_dead_voiced_sound
4645 XK_dead_voiced_sound,
4646 #else
4648 #endif
4649 #ifdef XK_dead_semivoiced_sound
4650 XK_dead_semivoiced_sound,
4651 #else
4653 #endif
4654 #ifdef XK_dead_hook
4655 XK_dead_hook,
4656 #else
4658 #endif
4659 #ifdef XK_dead_horn
4660 XK_dead_horn,
4661 #else
4663 #endif
4666 /* This is a list of Lisp names for special "accent" characters.
4667 It parallels lispy_accent_codes. */
4669 static const char *const lispy_accent_keys[] =
4671 "dead-circumflex",
4672 "dead-grave",
4673 "dead-tilde",
4674 "dead-diaeresis",
4675 "dead-macron",
4676 "dead-degree",
4677 "dead-acute",
4678 "dead-cedilla",
4679 "dead-breve",
4680 "dead-ogonek",
4681 "dead-caron",
4682 "dead-doubleacute",
4683 "dead-abovedot",
4684 "dead-abovering",
4685 "dead-iota",
4686 "dead-belowdot",
4687 "dead-voiced-sound",
4688 "dead-semivoiced-sound",
4689 "dead-hook",
4690 "dead-horn",
4693 #ifdef HAVE_NTGUI
4694 #define FUNCTION_KEY_OFFSET 0x0
4696 const char *const lispy_function_keys[] =
4698 0, /* 0 */
4700 0, /* VK_LBUTTON 0x01 */
4701 0, /* VK_RBUTTON 0x02 */
4702 "cancel", /* VK_CANCEL 0x03 */
4703 0, /* VK_MBUTTON 0x04 */
4705 0, 0, 0, /* 0x05 .. 0x07 */
4707 "backspace", /* VK_BACK 0x08 */
4708 "tab", /* VK_TAB 0x09 */
4710 0, 0, /* 0x0A .. 0x0B */
4712 "clear", /* VK_CLEAR 0x0C */
4713 "return", /* VK_RETURN 0x0D */
4715 0, 0, /* 0x0E .. 0x0F */
4717 0, /* VK_SHIFT 0x10 */
4718 0, /* VK_CONTROL 0x11 */
4719 0, /* VK_MENU 0x12 */
4720 "pause", /* VK_PAUSE 0x13 */
4721 "capslock", /* VK_CAPITAL 0x14 */
4722 "kana", /* VK_KANA/VK_HANGUL 0x15 */
4723 0, /* 0x16 */
4724 "junja", /* VK_JUNJA 0x17 */
4725 "final", /* VK_FINAL 0x18 */
4726 "kanji", /* VK_KANJI/VK_HANJA 0x19 */
4727 0, /* 0x1A */
4728 "escape", /* VK_ESCAPE 0x1B */
4729 "convert", /* VK_CONVERT 0x1C */
4730 "non-convert", /* VK_NONCONVERT 0x1D */
4731 "accept", /* VK_ACCEPT 0x1E */
4732 "mode-change", /* VK_MODECHANGE 0x1F */
4733 0, /* VK_SPACE 0x20 */
4734 "prior", /* VK_PRIOR 0x21 */
4735 "next", /* VK_NEXT 0x22 */
4736 "end", /* VK_END 0x23 */
4737 "home", /* VK_HOME 0x24 */
4738 "left", /* VK_LEFT 0x25 */
4739 "up", /* VK_UP 0x26 */
4740 "right", /* VK_RIGHT 0x27 */
4741 "down", /* VK_DOWN 0x28 */
4742 "select", /* VK_SELECT 0x29 */
4743 "print", /* VK_PRINT 0x2A */
4744 "execute", /* VK_EXECUTE 0x2B */
4745 "snapshot", /* VK_SNAPSHOT 0x2C */
4746 "insert", /* VK_INSERT 0x2D */
4747 "delete", /* VK_DELETE 0x2E */
4748 "help", /* VK_HELP 0x2F */
4750 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
4752 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4754 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
4756 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
4758 0, 0, 0, 0, 0, 0, 0, 0, 0,
4759 0, 0, 0, 0, 0, 0, 0, 0, 0,
4760 0, 0, 0, 0, 0, 0, 0, 0,
4762 "lwindow", /* VK_LWIN 0x5B */
4763 "rwindow", /* VK_RWIN 0x5C */
4764 "apps", /* VK_APPS 0x5D */
4765 0, /* 0x5E */
4766 "sleep",
4767 "kp-0", /* VK_NUMPAD0 0x60 */
4768 "kp-1", /* VK_NUMPAD1 0x61 */
4769 "kp-2", /* VK_NUMPAD2 0x62 */
4770 "kp-3", /* VK_NUMPAD3 0x63 */
4771 "kp-4", /* VK_NUMPAD4 0x64 */
4772 "kp-5", /* VK_NUMPAD5 0x65 */
4773 "kp-6", /* VK_NUMPAD6 0x66 */
4774 "kp-7", /* VK_NUMPAD7 0x67 */
4775 "kp-8", /* VK_NUMPAD8 0x68 */
4776 "kp-9", /* VK_NUMPAD9 0x69 */
4777 "kp-multiply", /* VK_MULTIPLY 0x6A */
4778 "kp-add", /* VK_ADD 0x6B */
4779 "kp-separator", /* VK_SEPARATOR 0x6C */
4780 "kp-subtract", /* VK_SUBTRACT 0x6D */
4781 "kp-decimal", /* VK_DECIMAL 0x6E */
4782 "kp-divide", /* VK_DIVIDE 0x6F */
4783 "f1", /* VK_F1 0x70 */
4784 "f2", /* VK_F2 0x71 */
4785 "f3", /* VK_F3 0x72 */
4786 "f4", /* VK_F4 0x73 */
4787 "f5", /* VK_F5 0x74 */
4788 "f6", /* VK_F6 0x75 */
4789 "f7", /* VK_F7 0x76 */
4790 "f8", /* VK_F8 0x77 */
4791 "f9", /* VK_F9 0x78 */
4792 "f10", /* VK_F10 0x79 */
4793 "f11", /* VK_F11 0x7A */
4794 "f12", /* VK_F12 0x7B */
4795 "f13", /* VK_F13 0x7C */
4796 "f14", /* VK_F14 0x7D */
4797 "f15", /* VK_F15 0x7E */
4798 "f16", /* VK_F16 0x7F */
4799 "f17", /* VK_F17 0x80 */
4800 "f18", /* VK_F18 0x81 */
4801 "f19", /* VK_F19 0x82 */
4802 "f20", /* VK_F20 0x83 */
4803 "f21", /* VK_F21 0x84 */
4804 "f22", /* VK_F22 0x85 */
4805 "f23", /* VK_F23 0x86 */
4806 "f24", /* VK_F24 0x87 */
4808 0, 0, 0, 0, /* 0x88 .. 0x8B */
4809 0, 0, 0, 0, /* 0x8C .. 0x8F */
4811 "kp-numlock", /* VK_NUMLOCK 0x90 */
4812 "scroll", /* VK_SCROLL 0x91 */
4813 /* Not sure where the following block comes from.
4814 Windows headers have NEC and Fujitsu specific keys in
4815 this block, but nothing generic. */
4816 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
4817 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
4818 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
4819 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
4820 "kp-end", /* VK_NUMPAD_END 0x96 */
4821 "kp-home", /* VK_NUMPAD_HOME 0x97 */
4822 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
4823 "kp-up", /* VK_NUMPAD_UP 0x99 */
4824 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
4825 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
4826 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
4827 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
4829 0, 0, /* 0x9E .. 0x9F */
4832 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
4833 * Used only as parameters to GetAsyncKeyState and GetKeyState.
4834 * No other API or message will distinguish left and right keys this way.
4835 * 0xA0 .. 0xA5
4837 0, 0, 0, 0, 0, 0,
4839 /* Multimedia keys. These are handled as WM_APPCOMMAND, which allows us
4840 to enable them selectively, and gives access to a few more functions.
4841 See lispy_multimedia_keys below. */
4842 0, 0, 0, 0, 0, 0, 0, /* 0xA6 .. 0xAC Browser */
4843 0, 0, 0, /* 0xAD .. 0xAF Volume */
4844 0, 0, 0, 0, /* 0xB0 .. 0xB3 Media */
4845 0, 0, 0, 0, /* 0xB4 .. 0xB7 Apps */
4847 /* 0xB8 .. 0xC0 "OEM" keys - all seem to be punctuation. */
4848 0, 0, 0, 0, 0, 0, 0, 0, 0,
4850 /* 0xC1 - 0xDA unallocated, 0xDB-0xDF more OEM keys */
4851 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4852 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4854 0, /* 0xE0 */
4855 "ax", /* VK_OEM_AX 0xE1 */
4856 0, /* VK_OEM_102 0xE2 */
4857 "ico-help", /* VK_ICO_HELP 0xE3 */
4858 "ico-00", /* VK_ICO_00 0xE4 */
4859 0, /* VK_PROCESSKEY 0xE5 - used by IME */
4860 "ico-clear", /* VK_ICO_CLEAR 0xE6 */
4861 0, /* VK_PACKET 0xE7 - used to pass Unicode chars */
4862 0, /* 0xE8 */
4863 "reset", /* VK_OEM_RESET 0xE9 */
4864 "jump", /* VK_OEM_JUMP 0xEA */
4865 "oem-pa1", /* VK_OEM_PA1 0xEB */
4866 "oem-pa2", /* VK_OEM_PA2 0xEC */
4867 "oem-pa3", /* VK_OEM_PA3 0xED */
4868 "wsctrl", /* VK_OEM_WSCTRL 0xEE */
4869 "cusel", /* VK_OEM_CUSEL 0xEF */
4870 "oem-attn", /* VK_OEM_ATTN 0xF0 */
4871 "finish", /* VK_OEM_FINISH 0xF1 */
4872 "copy", /* VK_OEM_COPY 0xF2 */
4873 "auto", /* VK_OEM_AUTO 0xF3 */
4874 "enlw", /* VK_OEM_ENLW 0xF4 */
4875 "backtab", /* VK_OEM_BACKTAB 0xF5 */
4876 "attn", /* VK_ATTN 0xF6 */
4877 "crsel", /* VK_CRSEL 0xF7 */
4878 "exsel", /* VK_EXSEL 0xF8 */
4879 "ereof", /* VK_EREOF 0xF9 */
4880 "play", /* VK_PLAY 0xFA */
4881 "zoom", /* VK_ZOOM 0xFB */
4882 "noname", /* VK_NONAME 0xFC */
4883 "pa1", /* VK_PA1 0xFD */
4884 "oem_clear", /* VK_OEM_CLEAR 0xFE */
4885 0 /* 0xFF */
4888 /* Some of these duplicate the "Media keys" on newer keyboards,
4889 but they are delivered to the application in a different way. */
4890 static const char *const lispy_multimedia_keys[] =
4893 "browser-back",
4894 "browser-forward",
4895 "browser-refresh",
4896 "browser-stop",
4897 "browser-search",
4898 "browser-favorites",
4899 "browser-home",
4900 "volume-mute",
4901 "volume-down",
4902 "volume-up",
4903 "media-next",
4904 "media-previous",
4905 "media-stop",
4906 "media-play-pause",
4907 "mail",
4908 "media-select",
4909 "app-1",
4910 "app-2",
4911 "bass-down",
4912 "bass-boost",
4913 "bass-up",
4914 "treble-down",
4915 "treble-up",
4916 "mic-volume-mute",
4917 "mic-volume-down",
4918 "mic-volume-up",
4919 "help",
4920 "find",
4921 "new",
4922 "open",
4923 "close",
4924 "save",
4925 "print",
4926 "undo",
4927 "redo",
4928 "copy",
4929 "cut",
4930 "paste",
4931 "mail-reply",
4932 "mail-forward",
4933 "mail-send",
4934 "spell-check",
4935 "toggle-dictate-command",
4936 "mic-toggle",
4937 "correction-list",
4938 "media-play",
4939 "media-pause",
4940 "media-record",
4941 "media-fast-forward",
4942 "media-rewind",
4943 "media-channel-up",
4944 "media-channel-down"
4947 #else /* not HAVE_NTGUI */
4949 /* This should be dealt with in XTread_socket now, and that doesn't
4950 depend on the client system having the Kana syms defined. See also
4951 the XK_kana_A case below. */
4952 #if 0
4953 #ifdef XK_kana_A
4954 static const char *const lispy_kana_keys[] =
4956 /* X Keysym value */
4957 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
4958 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
4959 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
4960 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
4961 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
4962 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
4963 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
4964 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
4965 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
4966 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
4967 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
4968 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
4969 "kana-i", "kana-u", "kana-e", "kana-o",
4970 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
4971 "prolongedsound", "kana-A", "kana-I", "kana-U",
4972 "kana-E", "kana-O", "kana-KA", "kana-KI",
4973 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
4974 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
4975 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
4976 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
4977 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
4978 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
4979 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
4980 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
4981 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
4982 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
4983 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
4984 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
4986 #endif /* XK_kana_A */
4987 #endif /* 0 */
4989 #define FUNCTION_KEY_OFFSET 0xff00
4991 /* You'll notice that this table is arranged to be conveniently
4992 indexed by X Windows keysym values. */
4993 static const char *const lispy_function_keys[] =
4995 /* X Keysym value */
4997 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
4998 "backspace", "tab", "linefeed", "clear",
4999 0, "return", 0, 0,
5000 0, 0, 0, "pause", /* 0xff10...1f */
5001 0, 0, 0, 0, 0, 0, 0, "escape",
5002 0, 0, 0, 0,
5003 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
5004 "romaji", "hiragana", "katakana", "hiragana-katakana",
5005 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
5006 "massyo", "kana-lock", "kana-shift", "eisu-shift",
5007 "eisu-toggle", /* 0xff30...3f */
5008 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5009 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
5011 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
5012 "down", "prior", "next", "end",
5013 "begin", 0, 0, 0, 0, 0, 0, 0,
5014 "select", /* 0xff60 */ /* IsMiscFunctionKey */
5015 "print",
5016 "execute",
5017 "insert",
5018 0, /* 0xff64 */
5019 "undo",
5020 "redo",
5021 "menu",
5022 "find",
5023 "cancel",
5024 "help",
5025 "break", /* 0xff6b */
5027 0, 0, 0, 0,
5028 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
5029 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
5030 "kp-space", /* 0xff80 */ /* IsKeypadKey */
5031 0, 0, 0, 0, 0, 0, 0, 0,
5032 "kp-tab", /* 0xff89 */
5033 0, 0, 0,
5034 "kp-enter", /* 0xff8d */
5035 0, 0, 0,
5036 "kp-f1", /* 0xff91 */
5037 "kp-f2",
5038 "kp-f3",
5039 "kp-f4",
5040 "kp-home", /* 0xff95 */
5041 "kp-left",
5042 "kp-up",
5043 "kp-right",
5044 "kp-down",
5045 "kp-prior", /* kp-page-up */
5046 "kp-next", /* kp-page-down */
5047 "kp-end",
5048 "kp-begin",
5049 "kp-insert",
5050 "kp-delete",
5051 0, /* 0xffa0 */
5052 0, 0, 0, 0, 0, 0, 0, 0, 0,
5053 "kp-multiply", /* 0xffaa */
5054 "kp-add",
5055 "kp-separator",
5056 "kp-subtract",
5057 "kp-decimal",
5058 "kp-divide", /* 0xffaf */
5059 "kp-0", /* 0xffb0 */
5060 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
5061 0, /* 0xffba */
5062 0, 0,
5063 "kp-equal", /* 0xffbd */
5064 "f1", /* 0xffbe */ /* IsFunctionKey */
5065 "f2",
5066 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
5067 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
5068 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
5069 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
5070 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
5071 0, 0, 0, 0, 0, 0, 0, 0,
5072 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
5073 0, 0, 0, 0, 0, 0, 0, "delete"
5076 /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
5077 #define ISO_FUNCTION_KEY_OFFSET 0xfe00
5079 static const char *const iso_lispy_function_keys[] =
5081 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
5082 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
5083 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
5084 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
5085 "iso-lefttab", /* 0xfe20 */
5086 "iso-move-line-up", "iso-move-line-down",
5087 "iso-partial-line-up", "iso-partial-line-down",
5088 "iso-partial-space-left", "iso-partial-space-right",
5089 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
5090 "iso-release-margin-left", "iso-release-margin-right",
5091 "iso-release-both-margins",
5092 "iso-fast-cursor-left", "iso-fast-cursor-right",
5093 "iso-fast-cursor-up", "iso-fast-cursor-down",
5094 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
5095 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
5098 #endif /* not HAVE_NTGUI */
5100 static Lisp_Object Vlispy_mouse_stem;
5102 static const char *const lispy_wheel_names[] =
5104 "wheel-up", "wheel-down", "wheel-left", "wheel-right"
5107 /* drag-n-drop events are generated when a set of selected files are
5108 dragged from another application and dropped onto an Emacs window. */
5109 static const char *const lispy_drag_n_drop_names[] =
5111 "drag-n-drop"
5114 /* An array of symbol indexes of scroll bar parts, indexed by an enum
5115 scroll_bar_part value. Note that Qnil corresponds to
5116 scroll_bar_nowhere and should not appear in Lisp events. */
5117 static short const scroll_bar_parts[] = {
5118 SYMBOL_INDEX (Qnil), SYMBOL_INDEX (Qabove_handle), SYMBOL_INDEX (Qhandle),
5119 SYMBOL_INDEX (Qbelow_handle), SYMBOL_INDEX (Qup), SYMBOL_INDEX (Qdown),
5120 SYMBOL_INDEX (Qtop), SYMBOL_INDEX (Qbottom), SYMBOL_INDEX (Qend_scroll),
5121 SYMBOL_INDEX (Qratio), SYMBOL_INDEX (Qbefore_handle),
5122 SYMBOL_INDEX (Qhorizontal_handle), SYMBOL_INDEX (Qafter_handle),
5123 SYMBOL_INDEX (Qleft), SYMBOL_INDEX (Qright), SYMBOL_INDEX (Qleftmost),
5124 SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio)
5127 /* A vector, indexed by button number, giving the down-going location
5128 of currently depressed buttons, both scroll bar and non-scroll bar.
5130 The elements have the form
5131 (BUTTON-NUMBER MODIFIER-MASK . REST)
5132 where REST is the cdr of a position as it would be reported in the event.
5134 The make_lispy_event function stores positions here to tell the
5135 difference between click and drag events, and to store the starting
5136 location to be included in drag events. */
5138 static Lisp_Object button_down_location;
5140 /* Information about the most recent up-going button event: Which
5141 button, what location, and what time. */
5143 static int last_mouse_button;
5144 static int last_mouse_x;
5145 static int last_mouse_y;
5146 static Time button_down_time;
5148 /* The number of clicks in this multiple-click. */
5150 static int double_click_count;
5152 /* X and Y are frame-relative coordinates for a click or wheel event.
5153 Return a Lisp-style event list. */
5155 static Lisp_Object
5156 make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
5157 Time t)
5159 enum window_part part;
5160 Lisp_Object posn = Qnil;
5161 Lisp_Object extra_info = Qnil;
5162 /* Coordinate pixel positions to return. */
5163 int xret = 0, yret = 0;
5164 /* The window under frame pixel coordinates (x,y) */
5165 Lisp_Object window = f
5166 ? window_from_coordinates (f, XINT (x), XINT (y), &part, 0)
5167 : Qnil;
5169 if (WINDOWP (window))
5171 /* It's a click in window WINDOW at frame coordinates (X,Y) */
5172 struct window *w = XWINDOW (window);
5173 Lisp_Object string_info = Qnil;
5174 ptrdiff_t textpos = 0;
5175 int col = -1, row = -1;
5176 int dx = -1, dy = -1;
5177 int width = -1, height = -1;
5178 Lisp_Object object = Qnil;
5180 /* Pixel coordinates relative to the window corner. */
5181 int wx = XINT (x) - WINDOW_LEFT_EDGE_X (w);
5182 int wy = XINT (y) - WINDOW_TOP_EDGE_Y (w);
5184 /* For text area clicks, return X, Y relative to the corner of
5185 this text area. Note that dX, dY etc are set below, by
5186 buffer_posn_from_coords. */
5187 if (part == ON_TEXT)
5189 xret = XINT (x) - window_box_left (w, TEXT_AREA);
5190 yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5192 /* For mode line and header line clicks, return X, Y relative to
5193 the left window edge. Use mode_line_string to look for a
5194 string on the click position. */
5195 else if (part == ON_MODE_LINE || part == ON_HEADER_LINE)
5197 Lisp_Object string;
5198 ptrdiff_t charpos;
5200 posn = (part == ON_MODE_LINE) ? Qmode_line : Qheader_line;
5201 /* Note that mode_line_string takes COL, ROW as pixels and
5202 converts them to characters. */
5203 col = wx;
5204 row = wy;
5205 string = mode_line_string (w, part, &col, &row, &charpos,
5206 &object, &dx, &dy, &width, &height);
5207 if (STRINGP (string))
5208 string_info = Fcons (string, make_number (charpos));
5209 textpos = -1;
5211 xret = wx;
5212 yret = wy;
5214 /* For fringes and margins, Y is relative to the area's (and the
5215 window's) top edge, while X is meaningless. */
5216 else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
5218 Lisp_Object string;
5219 ptrdiff_t charpos;
5221 posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin;
5222 col = wx;
5223 row = wy;
5224 string = marginal_area_string (w, part, &col, &row, &charpos,
5225 &object, &dx, &dy, &width, &height);
5226 if (STRINGP (string))
5227 string_info = Fcons (string, make_number (charpos));
5228 xret = wx;
5229 yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5231 else if (part == ON_LEFT_FRINGE)
5233 posn = Qleft_fringe;
5234 col = 0;
5235 xret = wx;
5236 dx = wx
5237 - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5238 ? 0 : window_box_width (w, LEFT_MARGIN_AREA));
5239 dy = yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5241 else if (part == ON_RIGHT_FRINGE)
5243 posn = Qright_fringe;
5244 col = 0;
5245 xret = wx;
5246 dx = wx
5247 - window_box_width (w, LEFT_MARGIN_AREA)
5248 - window_box_width (w, TEXT_AREA)
5249 - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5250 ? window_box_width (w, RIGHT_MARGIN_AREA)
5251 : 0);
5252 dy = yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5254 else if (part == ON_VERTICAL_BORDER)
5256 posn = Qvertical_line;
5257 width = 1;
5258 dx = 0;
5259 xret = wx;
5260 dy = yret = wy;
5262 else if (part == ON_VERTICAL_SCROLL_BAR)
5264 posn = Qvertical_scroll_bar;
5265 width = WINDOW_SCROLL_BAR_AREA_WIDTH (w);
5266 dx = xret = wx;
5267 dy = yret = wy;
5269 else if (part == ON_HORIZONTAL_SCROLL_BAR)
5271 posn = Qhorizontal_scroll_bar;
5272 width = WINDOW_SCROLL_BAR_AREA_HEIGHT (w);
5273 dx = xret = wx;
5274 dy = yret = wy;
5276 else if (part == ON_RIGHT_DIVIDER)
5278 posn = Qright_divider;
5279 width = WINDOW_RIGHT_DIVIDER_WIDTH (w);
5280 dx = xret = wx;
5281 dy = yret = wy;
5283 else if (part == ON_BOTTOM_DIVIDER)
5285 posn = Qbottom_divider;
5286 width = WINDOW_BOTTOM_DIVIDER_WIDTH (w);
5287 dx = xret = wx;
5288 dy = yret = wy;
5291 /* For clicks in the text area, fringes, margins, or vertical
5292 scroll bar, call buffer_posn_from_coords to extract TEXTPOS,
5293 the buffer position nearest to the click. */
5294 if (!textpos)
5296 Lisp_Object string2, object2 = Qnil;
5297 struct display_pos p;
5298 int dx2, dy2;
5299 int width2, height2;
5300 /* The pixel X coordinate passed to buffer_posn_from_coords
5301 is the X coordinate relative to the text area for clicks
5302 in text-area, right-margin/fringe and right-side vertical
5303 scroll bar, zero otherwise. */
5304 int x2
5305 = (part == ON_TEXT) ? xret
5306 : (part == ON_RIGHT_FRINGE || part == ON_RIGHT_MARGIN
5307 || (part == ON_VERTICAL_SCROLL_BAR
5308 && WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w)))
5309 ? (XINT (x) - window_box_left (w, TEXT_AREA))
5310 : 0;
5311 int y2 = wy;
5313 string2 = buffer_posn_from_coords (w, &x2, &y2, &p,
5314 &object2, &dx2, &dy2,
5315 &width2, &height2);
5316 textpos = CHARPOS (p.pos);
5317 if (col < 0) col = x2;
5318 if (row < 0) row = y2;
5319 if (dx < 0) dx = dx2;
5320 if (dy < 0) dy = dy2;
5321 if (width < 0) width = width2;
5322 if (height < 0) height = height2;
5324 if (NILP (posn))
5326 posn = make_number (textpos);
5327 if (STRINGP (string2))
5328 string_info = Fcons (string2,
5329 make_number (CHARPOS (p.string_pos)));
5331 if (NILP (object))
5332 object = object2;
5335 #ifdef HAVE_WINDOW_SYSTEM
5336 if (IMAGEP (object))
5338 Lisp_Object image_map, hotspot;
5339 if ((image_map = Fplist_get (XCDR (object), QCmap),
5340 !NILP (image_map))
5341 && (hotspot = find_hot_spot (image_map, dx, dy),
5342 CONSP (hotspot))
5343 && (hotspot = XCDR (hotspot), CONSP (hotspot)))
5344 posn = XCAR (hotspot);
5346 #endif
5348 /* Object info. */
5349 extra_info
5350 = list3 (object,
5351 Fcons (make_number (dx), make_number (dy)),
5352 Fcons (make_number (width), make_number (height)));
5354 /* String info. */
5355 extra_info = Fcons (string_info,
5356 Fcons (textpos < 0 ? Qnil : make_number (textpos),
5357 Fcons (Fcons (make_number (col),
5358 make_number (row)),
5359 extra_info)));
5361 else if (f != 0)
5363 /* Return mouse pixel coordinates here. */
5364 XSETFRAME (window, f);
5365 xret = XINT (x);
5366 yret = XINT (y);
5368 else
5369 window = Qnil;
5371 return Fcons (window,
5372 Fcons (posn,
5373 Fcons (Fcons (make_number (xret),
5374 make_number (yret)),
5375 Fcons (make_number (t),
5376 extra_info))));
5379 /* Return non-zero if F is a GUI frame that uses some toolkit-managed
5380 menu bar. This really means that Emacs draws and manages the menu
5381 bar as part of its normal display, and therefore can compute its
5382 geometry. */
5383 static bool
5384 toolkit_menubar_in_use (struct frame *f)
5386 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
5387 return !(!FRAME_WINDOW_P (f));
5388 #else
5389 return false;
5390 #endif
5393 /* Build the part of Lisp event which represents scroll bar state from
5394 EV. TYPE is one of Qvertical_scroll_bar or Qhorizontal_scroll_bar. */
5396 static Lisp_Object
5397 make_scroll_bar_position (struct input_event *ev, Lisp_Object type)
5399 return list5 (ev->frame_or_window, type, Fcons (ev->x, ev->y),
5400 make_number (ev->timestamp),
5401 builtin_lisp_symbol (scroll_bar_parts[ev->part]));
5404 /* Given a struct input_event, build the lisp event which represents
5405 it. If EVENT is 0, build a mouse movement event from the mouse
5406 movement buffer, which should have a movement event in it.
5408 Note that events must be passed to this function in the order they
5409 are received; this function stores the location of button presses
5410 in order to build drag events when the button is released. */
5412 static Lisp_Object
5413 make_lispy_event (struct input_event *event)
5415 int i;
5417 switch (event->kind)
5419 /* A simple keystroke. */
5420 case ASCII_KEYSTROKE_EVENT:
5421 case MULTIBYTE_CHAR_KEYSTROKE_EVENT:
5423 Lisp_Object lispy_c;
5424 EMACS_INT c = event->code;
5425 if (event->kind == ASCII_KEYSTROKE_EVENT)
5427 c &= 0377;
5428 eassert (c == event->code);
5431 /* Caps-lock shouldn't affect interpretation of key chords:
5432 Control+s should produce C-s whether caps-lock is on or
5433 not. And Control+Shift+s should produce C-S-s whether
5434 caps-lock is on or not. */
5435 if (event->modifiers & ~shift_modifier)
5437 /* This is a key chord: some non-shift modifier is
5438 depressed. */
5440 if (uppercasep (c) &&
5441 !(event->modifiers & shift_modifier))
5443 /* Got a capital letter without a shift. The caps
5444 lock is on. Un-capitalize the letter. */
5445 c = downcase (c);
5447 else if (lowercasep (c) &&
5448 (event->modifiers & shift_modifier))
5450 /* Got a lower-case letter even though shift is
5451 depressed. The caps lock is on. Capitalize the
5452 letter. */
5453 c = upcase (c);
5457 if (event->kind == ASCII_KEYSTROKE_EVENT)
5459 /* Turn ASCII characters into control characters
5460 when proper. */
5461 if (event->modifiers & ctrl_modifier)
5463 c = make_ctrl_char (c);
5464 event->modifiers &= ~ctrl_modifier;
5468 /* Add in the other modifier bits. The shift key was taken care
5469 of by the X code. */
5470 c |= (event->modifiers
5471 & (meta_modifier | alt_modifier
5472 | hyper_modifier | super_modifier | ctrl_modifier));
5473 /* Distinguish Shift-SPC from SPC. */
5474 if ((event->code) == 040
5475 && event->modifiers & shift_modifier)
5476 c |= shift_modifier;
5477 button_down_time = 0;
5478 XSETFASTINT (lispy_c, c);
5479 return lispy_c;
5482 #ifdef HAVE_NS
5483 /* NS_NONKEY_EVENTs are just like NON_ASCII_KEYSTROKE_EVENTs,
5484 except that they are non-key events (last-nonmenu-event is nil). */
5485 case NS_NONKEY_EVENT:
5486 #endif
5488 /* A function key. The symbol may need to have modifier prefixes
5489 tacked onto it. */
5490 case NON_ASCII_KEYSTROKE_EVENT:
5491 button_down_time = 0;
5493 for (i = 0; i < ARRAYELTS (lispy_accent_codes); i++)
5494 if (event->code == lispy_accent_codes[i])
5495 return modify_event_symbol (i,
5496 event->modifiers,
5497 Qfunction_key, Qnil,
5498 lispy_accent_keys, &accent_key_syms,
5499 ARRAYELTS (lispy_accent_keys));
5501 #if 0
5502 #ifdef XK_kana_A
5503 if (event->code >= 0x400 && event->code < 0x500)
5504 return modify_event_symbol (event->code - 0x400,
5505 event->modifiers & ~shift_modifier,
5506 Qfunction_key, Qnil,
5507 lispy_kana_keys, &func_key_syms,
5508 ARRAYELTS (lispy_kana_keys));
5509 #endif /* XK_kana_A */
5510 #endif /* 0 */
5512 #ifdef ISO_FUNCTION_KEY_OFFSET
5513 if (event->code < FUNCTION_KEY_OFFSET
5514 && event->code >= ISO_FUNCTION_KEY_OFFSET)
5515 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
5516 event->modifiers,
5517 Qfunction_key, Qnil,
5518 iso_lispy_function_keys, &func_key_syms,
5519 ARRAYELTS (iso_lispy_function_keys));
5520 #endif
5522 if ((FUNCTION_KEY_OFFSET <= event->code
5523 && (event->code
5524 < FUNCTION_KEY_OFFSET + ARRAYELTS (lispy_function_keys)))
5525 && lispy_function_keys[event->code - FUNCTION_KEY_OFFSET])
5526 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
5527 event->modifiers,
5528 Qfunction_key, Qnil,
5529 lispy_function_keys, &func_key_syms,
5530 ARRAYELTS (lispy_function_keys));
5532 /* Handle system-specific or unknown keysyms.
5533 We need to use an alist rather than a vector as the cache
5534 since we can't make a vector long enough. */
5535 if (NILP (KVAR (current_kboard, system_key_syms)))
5536 kset_system_key_syms (current_kboard, Fcons (Qnil, Qnil));
5537 return modify_event_symbol (event->code,
5538 event->modifiers,
5539 Qfunction_key,
5540 KVAR (current_kboard, Vsystem_key_alist),
5541 0, &KVAR (current_kboard, system_key_syms),
5542 PTRDIFF_MAX);
5544 #ifdef HAVE_NTGUI
5545 case MULTIMEDIA_KEY_EVENT:
5546 if (event->code < ARRAYELTS (lispy_multimedia_keys)
5547 && event->code > 0 && lispy_multimedia_keys[event->code])
5549 return modify_event_symbol (event->code, event->modifiers,
5550 Qfunction_key, Qnil,
5551 lispy_multimedia_keys, &func_key_syms,
5552 ARRAYELTS (lispy_multimedia_keys));
5554 return Qnil;
5555 #endif
5557 /* A mouse click. Figure out where it is, decide whether it's
5558 a press, click or drag, and build the appropriate structure. */
5559 case MOUSE_CLICK_EVENT:
5560 #ifdef HAVE_GPM
5561 case GPM_CLICK_EVENT:
5562 #endif
5563 #ifndef USE_TOOLKIT_SCROLL_BARS
5564 case SCROLL_BAR_CLICK_EVENT:
5565 case HORIZONTAL_SCROLL_BAR_CLICK_EVENT:
5566 #endif
5568 int button = event->code;
5569 bool is_double;
5570 Lisp_Object position;
5571 Lisp_Object *start_pos_ptr;
5572 Lisp_Object start_pos;
5574 position = Qnil;
5576 /* Build the position as appropriate for this mouse click. */
5577 if (event->kind == MOUSE_CLICK_EVENT
5578 #ifdef HAVE_GPM
5579 || event->kind == GPM_CLICK_EVENT
5580 #endif
5583 struct frame *f = XFRAME (event->frame_or_window);
5584 int row, column;
5586 /* Ignore mouse events that were made on frame that
5587 have been deleted. */
5588 if (! FRAME_LIVE_P (f))
5589 return Qnil;
5591 /* EVENT->x and EVENT->y are frame-relative pixel
5592 coordinates at this place. Under old redisplay, COLUMN
5593 and ROW are set to frame relative glyph coordinates
5594 which are then used to determine whether this click is
5595 in a menu (non-toolkit version). */
5596 if (!toolkit_menubar_in_use (f))
5598 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
5599 &column, &row, NULL, 1);
5601 /* In the non-toolkit version, clicks on the menu bar
5602 are ordinary button events in the event buffer.
5603 Distinguish them, and invoke the menu.
5605 (In the toolkit version, the toolkit handles the
5606 menu bar and Emacs doesn't know about it until
5607 after the user makes a selection.) */
5608 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
5609 && (event->modifiers & down_modifier))
5611 Lisp_Object items, item;
5613 /* Find the menu bar item under `column'. */
5614 item = Qnil;
5615 items = FRAME_MENU_BAR_ITEMS (f);
5616 for (i = 0; i < ASIZE (items); i += 4)
5618 Lisp_Object pos, string;
5619 string = AREF (items, i + 1);
5620 pos = AREF (items, i + 3);
5621 if (NILP (string))
5622 break;
5623 if (column >= XINT (pos)
5624 && column < XINT (pos) + SCHARS (string))
5626 item = AREF (items, i);
5627 break;
5631 /* ELisp manual 2.4b says (x y) are window
5632 relative but code says they are
5633 frame-relative. */
5634 position = list4 (event->frame_or_window,
5635 Qmenu_bar,
5636 Fcons (event->x, event->y),
5637 make_number (event->timestamp));
5639 return list2 (item, position);
5643 position = make_lispy_position (f, event->x, event->y,
5644 event->timestamp);
5646 #ifndef USE_TOOLKIT_SCROLL_BARS
5647 else
5648 /* It's a scrollbar click. */
5649 position = make_scroll_bar_position (event, Qvertical_scroll_bar);
5650 #endif /* not USE_TOOLKIT_SCROLL_BARS */
5652 if (button >= ASIZE (button_down_location))
5654 ptrdiff_t incr = button - ASIZE (button_down_location) + 1;
5655 button_down_location = larger_vector (button_down_location,
5656 incr, -1);
5657 mouse_syms = larger_vector (mouse_syms, incr, -1);
5660 start_pos_ptr = aref_addr (button_down_location, button);
5661 start_pos = *start_pos_ptr;
5662 *start_pos_ptr = Qnil;
5665 /* On window-system frames, use the value of
5666 double-click-fuzz as is. On other frames, interpret it
5667 as a multiple of 1/8 characters. */
5668 struct frame *f;
5669 int fuzz;
5671 if (WINDOWP (event->frame_or_window))
5672 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
5673 else if (FRAMEP (event->frame_or_window))
5674 f = XFRAME (event->frame_or_window);
5675 else
5676 emacs_abort ();
5678 if (FRAME_WINDOW_P (f))
5679 fuzz = double_click_fuzz;
5680 else
5681 fuzz = double_click_fuzz / 8;
5683 is_double = (button == last_mouse_button
5684 && (eabs (XINT (event->x) - last_mouse_x) <= fuzz)
5685 && (eabs (XINT (event->y) - last_mouse_y) <= fuzz)
5686 && button_down_time != 0
5687 && (EQ (Vdouble_click_time, Qt)
5688 || (NATNUMP (Vdouble_click_time)
5689 && (event->timestamp - button_down_time
5690 < XFASTINT (Vdouble_click_time)))));
5693 last_mouse_button = button;
5694 last_mouse_x = XINT (event->x);
5695 last_mouse_y = XINT (event->y);
5697 /* If this is a button press, squirrel away the location, so
5698 we can decide later whether it was a click or a drag. */
5699 if (event->modifiers & down_modifier)
5701 if (is_double)
5703 double_click_count++;
5704 event->modifiers |= ((double_click_count > 2)
5705 ? triple_modifier
5706 : double_modifier);
5708 else
5709 double_click_count = 1;
5710 button_down_time = event->timestamp;
5711 *start_pos_ptr = Fcopy_alist (position);
5712 ignore_mouse_drag_p = 0;
5715 /* Now we're releasing a button - check the co-ordinates to
5716 see if this was a click or a drag. */
5717 else if (event->modifiers & up_modifier)
5719 /* If we did not see a down before this up, ignore the up.
5720 Probably this happened because the down event chose a
5721 menu item. It would be an annoyance to treat the
5722 release of the button that chose the menu item as a
5723 separate event. */
5725 if (!CONSP (start_pos))
5726 return Qnil;
5728 event->modifiers &= ~up_modifier;
5731 Lisp_Object new_down, down;
5732 EMACS_INT xdiff = double_click_fuzz, ydiff = double_click_fuzz;
5734 /* The third element of every position
5735 should be the (x,y) pair. */
5736 down = Fcar (Fcdr (Fcdr (start_pos)));
5737 new_down = Fcar (Fcdr (Fcdr (position)));
5739 if (CONSP (down)
5740 && INTEGERP (XCAR (down)) && INTEGERP (XCDR (down)))
5742 xdiff = XINT (XCAR (new_down)) - XINT (XCAR (down));
5743 ydiff = XINT (XCDR (new_down)) - XINT (XCDR (down));
5746 if (ignore_mouse_drag_p)
5748 event->modifiers |= click_modifier;
5749 ignore_mouse_drag_p = 0;
5751 else if (xdiff < double_click_fuzz && xdiff > - double_click_fuzz
5752 && ydiff < double_click_fuzz && ydiff > - double_click_fuzz
5753 /* Maybe the mouse has moved a lot, caused scrolling, and
5754 eventually ended up at the same screen position (but
5755 not buffer position) in which case it is a drag, not
5756 a click. */
5757 /* FIXME: OTOH if the buffer position has changed
5758 because of a timer or process filter rather than
5759 because of mouse movement, it should be considered as
5760 a click. But mouse-drag-region completely ignores
5761 this case and it hasn't caused any real problem, so
5762 it's probably OK to ignore it as well. */
5763 && EQ (Fcar (Fcdr (start_pos)), Fcar (Fcdr (position))))
5764 /* Mouse hasn't moved (much). */
5765 event->modifiers |= click_modifier;
5766 else
5768 button_down_time = 0;
5769 event->modifiers |= drag_modifier;
5772 /* Don't check is_double; treat this as multiple
5773 if the down-event was multiple. */
5774 if (double_click_count > 1)
5775 event->modifiers |= ((double_click_count > 2)
5776 ? triple_modifier
5777 : double_modifier);
5780 else
5781 /* Every mouse event should either have the down_modifier or
5782 the up_modifier set. */
5783 emacs_abort ();
5786 /* Get the symbol we should use for the mouse click. */
5787 Lisp_Object head;
5789 head = modify_event_symbol (button,
5790 event->modifiers,
5791 Qmouse_click, Vlispy_mouse_stem,
5792 NULL,
5793 &mouse_syms,
5794 ASIZE (mouse_syms));
5795 if (event->modifiers & drag_modifier)
5796 return list3 (head, start_pos, position);
5797 else if (event->modifiers & (double_modifier | triple_modifier))
5798 return list3 (head, position, make_number (double_click_count));
5799 else
5800 return list2 (head, position);
5804 case WHEEL_EVENT:
5805 case HORIZ_WHEEL_EVENT:
5807 Lisp_Object position;
5808 Lisp_Object head;
5810 /* Build the position as appropriate for this mouse click. */
5811 struct frame *f = XFRAME (event->frame_or_window);
5813 /* Ignore wheel events that were made on frame that have been
5814 deleted. */
5815 if (! FRAME_LIVE_P (f))
5816 return Qnil;
5818 position = make_lispy_position (f, event->x, event->y,
5819 event->timestamp);
5821 /* Set double or triple modifiers to indicate the wheel speed. */
5823 /* On window-system frames, use the value of
5824 double-click-fuzz as is. On other frames, interpret it
5825 as a multiple of 1/8 characters. */
5826 struct frame *fr;
5827 int fuzz;
5828 int symbol_num;
5829 bool is_double;
5831 if (WINDOWP (event->frame_or_window))
5832 fr = XFRAME (XWINDOW (event->frame_or_window)->frame);
5833 else if (FRAMEP (event->frame_or_window))
5834 fr = XFRAME (event->frame_or_window);
5835 else
5836 emacs_abort ();
5838 fuzz = FRAME_WINDOW_P (fr)
5839 ? double_click_fuzz : double_click_fuzz / 8;
5841 if (event->modifiers & up_modifier)
5843 /* Emit a wheel-up event. */
5844 event->modifiers &= ~up_modifier;
5845 symbol_num = 0;
5847 else if (event->modifiers & down_modifier)
5849 /* Emit a wheel-down event. */
5850 event->modifiers &= ~down_modifier;
5851 symbol_num = 1;
5853 else
5854 /* Every wheel event should either have the down_modifier or
5855 the up_modifier set. */
5856 emacs_abort ();
5858 if (event->kind == HORIZ_WHEEL_EVENT)
5859 symbol_num += 2;
5861 is_double = (last_mouse_button == - (1 + symbol_num)
5862 && (eabs (XINT (event->x) - last_mouse_x) <= fuzz)
5863 && (eabs (XINT (event->y) - last_mouse_y) <= fuzz)
5864 && button_down_time != 0
5865 && (EQ (Vdouble_click_time, Qt)
5866 || (NATNUMP (Vdouble_click_time)
5867 && (event->timestamp - button_down_time
5868 < XFASTINT (Vdouble_click_time)))));
5869 if (is_double)
5871 double_click_count++;
5872 event->modifiers |= ((double_click_count > 2)
5873 ? triple_modifier
5874 : double_modifier);
5876 else
5878 double_click_count = 1;
5879 event->modifiers |= click_modifier;
5882 button_down_time = event->timestamp;
5883 /* Use a negative value to distinguish wheel from mouse button. */
5884 last_mouse_button = - (1 + symbol_num);
5885 last_mouse_x = XINT (event->x);
5886 last_mouse_y = XINT (event->y);
5888 /* Get the symbol we should use for the wheel event. */
5889 head = modify_event_symbol (symbol_num,
5890 event->modifiers,
5891 Qmouse_click,
5892 Qnil,
5893 lispy_wheel_names,
5894 &wheel_syms,
5895 ASIZE (wheel_syms));
5898 if (event->modifiers & (double_modifier | triple_modifier))
5899 return list3 (head, position, make_number (double_click_count));
5900 else
5901 return list2 (head, position);
5905 #ifdef USE_TOOLKIT_SCROLL_BARS
5907 /* We don't have down and up events if using toolkit scroll bars,
5908 so make this always a click event. Store in the `part' of
5909 the Lisp event a symbol which maps to the following actions:
5911 `above_handle' page up
5912 `below_handle' page down
5913 `up' line up
5914 `down' line down
5915 `top' top of buffer
5916 `bottom' bottom of buffer
5917 `handle' thumb has been dragged.
5918 `end-scroll' end of interaction with scroll bar
5920 The incoming input_event contains in its `part' member an
5921 index of type `enum scroll_bar_part' which we can use as an
5922 index in scroll_bar_parts to get the appropriate symbol. */
5924 case SCROLL_BAR_CLICK_EVENT:
5926 Lisp_Object position, head;
5928 position = make_scroll_bar_position (event, Qvertical_scroll_bar);
5930 /* Always treat scroll bar events as clicks. */
5931 event->modifiers |= click_modifier;
5932 event->modifiers &= ~up_modifier;
5934 if (event->code >= ASIZE (mouse_syms))
5935 mouse_syms = larger_vector (mouse_syms,
5936 event->code - ASIZE (mouse_syms) + 1,
5937 -1);
5939 /* Get the symbol we should use for the mouse click. */
5940 head = modify_event_symbol (event->code,
5941 event->modifiers,
5942 Qmouse_click,
5943 Vlispy_mouse_stem,
5944 NULL, &mouse_syms,
5945 ASIZE (mouse_syms));
5946 return list2 (head, position);
5949 case HORIZONTAL_SCROLL_BAR_CLICK_EVENT:
5951 Lisp_Object position, head;
5953 position = make_scroll_bar_position (event, Qhorizontal_scroll_bar);
5955 /* Always treat scroll bar events as clicks. */
5956 event->modifiers |= click_modifier;
5957 event->modifiers &= ~up_modifier;
5959 if (event->code >= ASIZE (mouse_syms))
5960 mouse_syms = larger_vector (mouse_syms,
5961 event->code - ASIZE (mouse_syms) + 1,
5962 -1);
5964 /* Get the symbol we should use for the mouse click. */
5965 head = modify_event_symbol (event->code,
5966 event->modifiers,
5967 Qmouse_click,
5968 Vlispy_mouse_stem,
5969 NULL, &mouse_syms,
5970 ASIZE (mouse_syms));
5971 return list2 (head, position);
5974 #endif /* USE_TOOLKIT_SCROLL_BARS */
5976 case DRAG_N_DROP_EVENT:
5978 struct frame *f;
5979 Lisp_Object head, position;
5980 Lisp_Object files;
5982 f = XFRAME (event->frame_or_window);
5983 files = event->arg;
5985 /* Ignore mouse events that were made on frames that
5986 have been deleted. */
5987 if (! FRAME_LIVE_P (f))
5988 return Qnil;
5990 position = make_lispy_position (f, event->x, event->y,
5991 event->timestamp);
5993 head = modify_event_symbol (0, event->modifiers,
5994 Qdrag_n_drop, Qnil,
5995 lispy_drag_n_drop_names,
5996 &drag_n_drop_syms, 1);
5997 return list3 (head, position, files);
6000 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
6001 || defined (HAVE_NS) || defined (USE_GTK)
6002 case MENU_BAR_EVENT:
6003 if (EQ (event->arg, event->frame_or_window))
6004 /* This is the prefix key. We translate this to
6005 `(menu_bar)' because the code in keyboard.c for menu
6006 events, which we use, relies on this. */
6007 return list1 (Qmenu_bar);
6008 return event->arg;
6009 #endif
6011 case SELECT_WINDOW_EVENT:
6012 /* Make an event (select-window (WINDOW)). */
6013 return list2 (Qselect_window, list1 (event->frame_or_window));
6015 case TOOL_BAR_EVENT:
6016 if (EQ (event->arg, event->frame_or_window))
6017 /* This is the prefix key. We translate this to
6018 `(tool_bar)' because the code in keyboard.c for tool bar
6019 events, which we use, relies on this. */
6020 return list1 (Qtool_bar);
6021 else if (SYMBOLP (event->arg))
6022 return apply_modifiers (event->modifiers, event->arg);
6023 return event->arg;
6025 case USER_SIGNAL_EVENT:
6026 /* A user signal. */
6028 char *name = find_user_signal_name (event->code);
6029 if (!name)
6030 emacs_abort ();
6031 return intern (name);
6034 case SAVE_SESSION_EVENT:
6035 return Qsave_session;
6037 #ifdef HAVE_DBUS
6038 case DBUS_EVENT:
6040 return Fcons (Qdbus_event, event->arg);
6042 #endif /* HAVE_DBUS */
6044 #ifdef HAVE_XWIDGETS
6045 case XWIDGET_EVENT:
6047 return Fcons (Qxwidget_event, event->arg);
6049 #endif
6051 #if defined HAVE_INOTIFY || defined HAVE_KQUEUE || defined HAVE_GFILENOTIFY
6052 case FILE_NOTIFY_EVENT:
6054 return Fcons (Qfile_notify, event->arg);
6056 #endif /* HAVE_INOTIFY || HAVE_KQUEUE || HAVE_GFILENOTIFY */
6058 case CONFIG_CHANGED_EVENT:
6059 return list3 (Qconfig_changed_event,
6060 event->arg, event->frame_or_window);
6062 /* The 'kind' field of the event is something we don't recognize. */
6063 default:
6064 emacs_abort ();
6068 static Lisp_Object
6069 make_lispy_movement (struct frame *frame, Lisp_Object bar_window, enum scroll_bar_part part,
6070 Lisp_Object x, Lisp_Object y, Time t)
6072 /* Is it a scroll bar movement? */
6073 if (frame && ! NILP (bar_window))
6075 Lisp_Object part_sym;
6077 part_sym = builtin_lisp_symbol (scroll_bar_parts[part]);
6078 return list2 (Qscroll_bar_movement,
6079 list5 (bar_window,
6080 Qvertical_scroll_bar,
6081 Fcons (x, y),
6082 make_number (t),
6083 part_sym));
6085 /* Or is it an ordinary mouse movement? */
6086 else
6088 Lisp_Object position;
6089 position = make_lispy_position (frame, x, y, t);
6090 return list2 (Qmouse_movement, position);
6094 /* Construct a switch frame event. */
6095 static Lisp_Object
6096 make_lispy_switch_frame (Lisp_Object frame)
6098 return list2 (Qswitch_frame, frame);
6101 static Lisp_Object
6102 make_lispy_focus_in (Lisp_Object frame)
6104 return list2 (Qfocus_in, frame);
6107 #ifdef HAVE_WINDOW_SYSTEM
6109 static Lisp_Object
6110 make_lispy_focus_out (Lisp_Object frame)
6112 return list2 (Qfocus_out, frame);
6115 #endif /* HAVE_WINDOW_SYSTEM */
6117 /* Manipulating modifiers. */
6119 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
6121 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
6122 SYMBOL's name of the end of the modifiers; the string from this
6123 position is the unmodified symbol name.
6125 This doesn't use any caches. */
6127 static int
6128 parse_modifiers_uncached (Lisp_Object symbol, ptrdiff_t *modifier_end)
6130 Lisp_Object name;
6131 ptrdiff_t i;
6132 int modifiers;
6134 CHECK_SYMBOL (symbol);
6136 modifiers = 0;
6137 name = SYMBOL_NAME (symbol);
6139 for (i = 0; i < SBYTES (name) - 1; )
6141 ptrdiff_t this_mod_end = 0;
6142 int this_mod = 0;
6144 /* See if the name continues with a modifier word.
6145 Check that the word appears, but don't check what follows it.
6146 Set this_mod and this_mod_end to record what we find. */
6148 switch (SREF (name, i))
6150 #define SINGLE_LETTER_MOD(BIT) \
6151 (this_mod_end = i + 1, this_mod = BIT)
6153 case 'A':
6154 SINGLE_LETTER_MOD (alt_modifier);
6155 break;
6157 case 'C':
6158 SINGLE_LETTER_MOD (ctrl_modifier);
6159 break;
6161 case 'H':
6162 SINGLE_LETTER_MOD (hyper_modifier);
6163 break;
6165 case 'M':
6166 SINGLE_LETTER_MOD (meta_modifier);
6167 break;
6169 case 'S':
6170 SINGLE_LETTER_MOD (shift_modifier);
6171 break;
6173 case 's':
6174 SINGLE_LETTER_MOD (super_modifier);
6175 break;
6177 #undef SINGLE_LETTER_MOD
6179 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6180 if (i + LEN + 1 <= SBYTES (name) \
6181 && ! memcmp (SDATA (name) + i, NAME, LEN)) \
6183 this_mod_end = i + LEN; \
6184 this_mod = BIT; \
6187 case 'd':
6188 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6189 MULTI_LETTER_MOD (down_modifier, "down", 4);
6190 MULTI_LETTER_MOD (double_modifier, "double", 6);
6191 break;
6193 case 't':
6194 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6195 break;
6197 case 'u':
6198 MULTI_LETTER_MOD (up_modifier, "up", 2);
6199 break;
6200 #undef MULTI_LETTER_MOD
6204 /* If we found no modifier, stop looking for them. */
6205 if (this_mod_end == 0)
6206 break;
6208 /* Check there is a dash after the modifier, so that it
6209 really is a modifier. */
6210 if (this_mod_end >= SBYTES (name)
6211 || SREF (name, this_mod_end) != '-')
6212 break;
6214 /* This modifier is real; look for another. */
6215 modifiers |= this_mod;
6216 i = this_mod_end + 1;
6219 /* Should we include the `click' modifier? */
6220 if (! (modifiers & (down_modifier | drag_modifier
6221 | double_modifier | triple_modifier))
6222 && i + 7 == SBYTES (name)
6223 && memcmp (SDATA (name) + i, "mouse-", 6) == 0
6224 && ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9'))
6225 modifiers |= click_modifier;
6227 if (! (modifiers & (double_modifier | triple_modifier))
6228 && i + 6 < SBYTES (name)
6229 && memcmp (SDATA (name) + i, "wheel-", 6) == 0)
6230 modifiers |= click_modifier;
6232 if (modifier_end)
6233 *modifier_end = i;
6235 return modifiers;
6238 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
6239 prepended to the string BASE[0..BASE_LEN-1].
6240 This doesn't use any caches. */
6241 static Lisp_Object
6242 apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_byte)
6244 /* Since BASE could contain nulls, we can't use intern here; we have
6245 to use Fintern, which expects a genuine Lisp_String, and keeps a
6246 reference to it. */
6247 char new_mods[sizeof "A-C-H-M-S-s-up-down-drag-double-triple-"];
6248 int mod_len;
6251 char *p = new_mods;
6253 /* Mouse events should not exhibit the `up' modifier once they
6254 leave the event queue only accessible to C code; `up' will
6255 always be turned into a click or drag event before being
6256 presented to lisp code. But since lisp events can be
6257 synthesized bypassing the event queue and pushed into
6258 `unread-command-events' or its companions, it's better to just
6259 deal with unexpected modifier combinations. */
6261 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
6262 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
6263 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
6264 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
6265 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
6266 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
6267 if (modifiers & double_modifier) p = stpcpy (p, "double-");
6268 if (modifiers & triple_modifier) p = stpcpy (p, "triple-");
6269 if (modifiers & up_modifier) p = stpcpy (p, "up-");
6270 if (modifiers & down_modifier) p = stpcpy (p, "down-");
6271 if (modifiers & drag_modifier) p = stpcpy (p, "drag-");
6272 /* The click modifier is denoted by the absence of other modifiers. */
6274 *p = '\0';
6276 mod_len = p - new_mods;
6280 Lisp_Object new_name;
6282 new_name = make_uninit_multibyte_string (mod_len + base_len,
6283 mod_len + base_len_byte);
6284 memcpy (SDATA (new_name), new_mods, mod_len);
6285 memcpy (SDATA (new_name) + mod_len, base, base_len_byte);
6287 return Fintern (new_name, Qnil);
6292 static const char *const modifier_names[] =
6294 "up", "down", "drag", "click", "double", "triple", 0, 0,
6295 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
6296 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
6298 #define NUM_MOD_NAMES ARRAYELTS (modifier_names)
6300 static Lisp_Object modifier_symbols;
6302 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
6303 static Lisp_Object
6304 lispy_modifier_list (int modifiers)
6306 Lisp_Object modifier_list;
6307 int i;
6309 modifier_list = Qnil;
6310 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
6311 if (modifiers & (1<<i))
6312 modifier_list = Fcons (AREF (modifier_symbols, i),
6313 modifier_list);
6315 return modifier_list;
6319 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
6320 where UNMODIFIED is the unmodified form of SYMBOL,
6321 MASK is the set of modifiers present in SYMBOL's name.
6322 This is similar to parse_modifiers_uncached, but uses the cache in
6323 SYMBOL's Qevent_symbol_element_mask property, and maintains the
6324 Qevent_symbol_elements property. */
6326 #define KEY_TO_CHAR(k) (XINT (k) & ((1 << CHARACTERBITS) - 1))
6328 Lisp_Object
6329 parse_modifiers (Lisp_Object symbol)
6331 Lisp_Object elements;
6333 if (INTEGERP (symbol))
6334 return list2i (KEY_TO_CHAR (symbol), XINT (symbol) & CHAR_MODIFIER_MASK);
6335 else if (!SYMBOLP (symbol))
6336 return Qnil;
6338 elements = Fget (symbol, Qevent_symbol_element_mask);
6339 if (CONSP (elements))
6340 return elements;
6341 else
6343 ptrdiff_t end;
6344 int modifiers = parse_modifiers_uncached (symbol, &end);
6345 Lisp_Object unmodified;
6346 Lisp_Object mask;
6348 unmodified = Fintern (make_string (SSDATA (SYMBOL_NAME (symbol)) + end,
6349 SBYTES (SYMBOL_NAME (symbol)) - end),
6350 Qnil);
6352 if (modifiers & ~INTMASK)
6353 emacs_abort ();
6354 XSETFASTINT (mask, modifiers);
6355 elements = list2 (unmodified, mask);
6357 /* Cache the parsing results on SYMBOL. */
6358 Fput (symbol, Qevent_symbol_element_mask,
6359 elements);
6360 Fput (symbol, Qevent_symbol_elements,
6361 Fcons (unmodified, lispy_modifier_list (modifiers)));
6363 /* Since we know that SYMBOL is modifiers applied to unmodified,
6364 it would be nice to put that in unmodified's cache.
6365 But we can't, since we're not sure that parse_modifiers is
6366 canonical. */
6368 return elements;
6372 DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,
6373 Sevent_symbol_parse_modifiers, 1, 1, 0,
6374 doc: /* Parse the event symbol. For internal use. */)
6375 (Lisp_Object symbol)
6377 /* Fill the cache if needed. */
6378 parse_modifiers (symbol);
6379 /* Ignore the result (which is stored on Qevent_symbol_element_mask)
6380 and use the Lispier representation stored on Qevent_symbol_elements
6381 instead. */
6382 return Fget (symbol, Qevent_symbol_elements);
6385 /* Apply the modifiers MODIFIERS to the symbol BASE.
6386 BASE must be unmodified.
6388 This is like apply_modifiers_uncached, but uses BASE's
6389 Qmodifier_cache property, if present.
6391 apply_modifiers copies the value of BASE's Qevent_kind property to
6392 the modified symbol. */
6393 static Lisp_Object
6394 apply_modifiers (int modifiers, Lisp_Object base)
6396 Lisp_Object cache, idx, entry, new_symbol;
6398 /* Mask out upper bits. We don't know where this value's been. */
6399 modifiers &= INTMASK;
6401 if (INTEGERP (base))
6402 return make_number (XINT (base) | modifiers);
6404 /* The click modifier never figures into cache indices. */
6405 cache = Fget (base, Qmodifier_cache);
6406 XSETFASTINT (idx, (modifiers & ~click_modifier));
6407 entry = assq_no_quit (idx, cache);
6409 if (CONSP (entry))
6410 new_symbol = XCDR (entry);
6411 else
6413 /* We have to create the symbol ourselves. */
6414 new_symbol = apply_modifiers_uncached (modifiers,
6415 SSDATA (SYMBOL_NAME (base)),
6416 SCHARS (SYMBOL_NAME (base)),
6417 SBYTES (SYMBOL_NAME (base)));
6419 /* Add the new symbol to the base's cache. */
6420 entry = Fcons (idx, new_symbol);
6421 Fput (base, Qmodifier_cache, Fcons (entry, cache));
6423 /* We have the parsing info now for free, so we could add it to
6424 the caches:
6425 XSETFASTINT (idx, modifiers);
6426 Fput (new_symbol, Qevent_symbol_element_mask,
6427 list2 (base, idx));
6428 Fput (new_symbol, Qevent_symbol_elements,
6429 Fcons (base, lispy_modifier_list (modifiers)));
6430 Sadly, this is only correct if `base' is indeed a base event,
6431 which is not necessarily the case. -stef */
6434 /* Make sure this symbol is of the same kind as BASE.
6436 You'd think we could just set this once and for all when we
6437 intern the symbol above, but reorder_modifiers may call us when
6438 BASE's property isn't set right; we can't assume that just
6439 because it has a Qmodifier_cache property it must have its
6440 Qevent_kind set right as well. */
6441 if (NILP (Fget (new_symbol, Qevent_kind)))
6443 Lisp_Object kind;
6445 kind = Fget (base, Qevent_kind);
6446 if (! NILP (kind))
6447 Fput (new_symbol, Qevent_kind, kind);
6450 return new_symbol;
6454 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
6455 return a symbol with the modifiers placed in the canonical order.
6456 Canonical order is alphabetical, except for down and drag, which
6457 always come last. The 'click' modifier is never written out.
6459 Fdefine_key calls this to make sure that (for example) C-M-foo
6460 and M-C-foo end up being equivalent in the keymap. */
6462 Lisp_Object
6463 reorder_modifiers (Lisp_Object symbol)
6465 /* It's hopefully okay to write the code this way, since everything
6466 will soon be in caches, and no consing will be done at all. */
6467 Lisp_Object parsed;
6469 parsed = parse_modifiers (symbol);
6470 return apply_modifiers (XFASTINT (XCAR (XCDR (parsed))),
6471 XCAR (parsed));
6475 /* For handling events, we often want to produce a symbol whose name
6476 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
6477 to some base, like the name of a function key or mouse button.
6478 modify_event_symbol produces symbols of this sort.
6480 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
6481 is the name of the i'th symbol. TABLE_SIZE is the number of elements
6482 in the table.
6484 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
6485 into symbol names, or a string specifying a name stem used to
6486 construct a symbol name or the form `STEM-N', where N is the decimal
6487 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
6488 non-nil; otherwise NAME_TABLE is used.
6490 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
6491 persist between calls to modify_event_symbol that it can use to
6492 store a cache of the symbols it's generated for this NAME_TABLE
6493 before. The object stored there may be a vector or an alist.
6495 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
6497 MODIFIERS is a set of modifier bits (as given in struct input_events)
6498 whose prefixes should be applied to the symbol name.
6500 SYMBOL_KIND is the value to be placed in the event_kind property of
6501 the returned symbol.
6503 The symbols we create are supposed to have an
6504 `event-symbol-elements' property, which lists the modifiers present
6505 in the symbol's name. */
6507 static Lisp_Object
6508 modify_event_symbol (ptrdiff_t symbol_num, int modifiers, Lisp_Object symbol_kind,
6509 Lisp_Object name_alist_or_stem, const char *const *name_table,
6510 Lisp_Object *symbol_table, ptrdiff_t table_size)
6512 Lisp_Object value;
6513 Lisp_Object symbol_int;
6515 /* Get rid of the "vendor-specific" bit here. */
6516 XSETINT (symbol_int, symbol_num & 0xffffff);
6518 /* Is this a request for a valid symbol? */
6519 if (symbol_num < 0 || symbol_num >= table_size)
6520 return Qnil;
6522 if (CONSP (*symbol_table))
6523 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
6525 /* If *symbol_table doesn't seem to be initialized properly, fix that.
6526 *symbol_table should be a lisp vector TABLE_SIZE elements long,
6527 where the Nth element is the symbol for NAME_TABLE[N], or nil if
6528 we've never used that symbol before. */
6529 else
6531 if (! VECTORP (*symbol_table)
6532 || ASIZE (*symbol_table) != table_size)
6534 Lisp_Object size;
6536 XSETFASTINT (size, table_size);
6537 *symbol_table = Fmake_vector (size, Qnil);
6540 value = AREF (*symbol_table, symbol_num);
6543 /* Have we already used this symbol before? */
6544 if (NILP (value))
6546 /* No; let's create it. */
6547 if (CONSP (name_alist_or_stem))
6548 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
6549 else if (STRINGP (name_alist_or_stem))
6551 char *buf;
6552 ptrdiff_t len = (SBYTES (name_alist_or_stem)
6553 + sizeof "-" + INT_STRLEN_BOUND (EMACS_INT));
6554 USE_SAFE_ALLOCA;
6555 buf = SAFE_ALLOCA (len);
6556 esprintf (buf, "%s-%"pI"d", SDATA (name_alist_or_stem),
6557 XINT (symbol_int) + 1);
6558 value = intern (buf);
6559 SAFE_FREE ();
6561 else if (name_table != 0 && name_table[symbol_num])
6562 value = intern (name_table[symbol_num]);
6564 #ifdef HAVE_WINDOW_SYSTEM
6565 if (NILP (value))
6567 char *name = x_get_keysym_name (symbol_num);
6568 if (name)
6569 value = intern (name);
6571 #endif
6573 if (NILP (value))
6575 char buf[sizeof "key-" + INT_STRLEN_BOUND (EMACS_INT)];
6576 sprintf (buf, "key-%"pD"d", symbol_num);
6577 value = intern (buf);
6580 if (CONSP (*symbol_table))
6581 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
6582 else
6583 ASET (*symbol_table, symbol_num, value);
6585 /* Fill in the cache entries for this symbol; this also
6586 builds the Qevent_symbol_elements property, which the user
6587 cares about. */
6588 apply_modifiers (modifiers & click_modifier, value);
6589 Fput (value, Qevent_kind, symbol_kind);
6592 /* Apply modifiers to that symbol. */
6593 return apply_modifiers (modifiers, value);
6596 /* Convert a list that represents an event type,
6597 such as (ctrl meta backspace), into the usual representation of that
6598 event type as a number or a symbol. */
6600 DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
6601 doc: /* Convert the event description list EVENT-DESC to an event type.
6602 EVENT-DESC should contain one base event type (a character or symbol)
6603 and zero or more modifier names (control, meta, hyper, super, shift, alt,
6604 drag, down, double or triple). The base must be last.
6605 The return value is an event type (a character or symbol) which
6606 has the same base event type and all the specified modifiers. */)
6607 (Lisp_Object event_desc)
6609 Lisp_Object base;
6610 int modifiers = 0;
6611 Lisp_Object rest;
6613 base = Qnil;
6614 rest = event_desc;
6615 while (CONSP (rest))
6617 Lisp_Object elt;
6618 int this = 0;
6620 elt = XCAR (rest);
6621 rest = XCDR (rest);
6623 /* Given a symbol, see if it is a modifier name. */
6624 if (SYMBOLP (elt) && CONSP (rest))
6625 this = parse_solitary_modifier (elt);
6627 if (this != 0)
6628 modifiers |= this;
6629 else if (!NILP (base))
6630 error ("Two bases given in one event");
6631 else
6632 base = elt;
6636 /* Let the symbol A refer to the character A. */
6637 if (SYMBOLP (base) && SCHARS (SYMBOL_NAME (base)) == 1)
6638 XSETINT (base, SREF (SYMBOL_NAME (base), 0));
6640 if (INTEGERP (base))
6642 /* Turn (shift a) into A. */
6643 if ((modifiers & shift_modifier) != 0
6644 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
6646 XSETINT (base, XINT (base) - ('a' - 'A'));
6647 modifiers &= ~shift_modifier;
6650 /* Turn (control a) into C-a. */
6651 if (modifiers & ctrl_modifier)
6652 return make_number ((modifiers & ~ctrl_modifier)
6653 | make_ctrl_char (XINT (base)));
6654 else
6655 return make_number (modifiers | XINT (base));
6657 else if (SYMBOLP (base))
6658 return apply_modifiers (modifiers, base);
6659 else
6660 error ("Invalid base event");
6663 /* Try to recognize SYMBOL as a modifier name.
6664 Return the modifier flag bit, or 0 if not recognized. */
6667 parse_solitary_modifier (Lisp_Object symbol)
6669 Lisp_Object name;
6671 if (!SYMBOLP (symbol))
6672 return 0;
6674 name = SYMBOL_NAME (symbol);
6676 switch (SREF (name, 0))
6678 #define SINGLE_LETTER_MOD(BIT) \
6679 if (SBYTES (name) == 1) \
6680 return BIT;
6682 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6683 if (LEN == SBYTES (name) \
6684 && ! memcmp (SDATA (name), NAME, LEN)) \
6685 return BIT;
6687 case 'A':
6688 SINGLE_LETTER_MOD (alt_modifier);
6689 break;
6691 case 'a':
6692 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
6693 break;
6695 case 'C':
6696 SINGLE_LETTER_MOD (ctrl_modifier);
6697 break;
6699 case 'c':
6700 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
6701 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
6702 break;
6704 case 'H':
6705 SINGLE_LETTER_MOD (hyper_modifier);
6706 break;
6708 case 'h':
6709 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
6710 break;
6712 case 'M':
6713 SINGLE_LETTER_MOD (meta_modifier);
6714 break;
6716 case 'm':
6717 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
6718 break;
6720 case 'S':
6721 SINGLE_LETTER_MOD (shift_modifier);
6722 break;
6724 case 's':
6725 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
6726 MULTI_LETTER_MOD (super_modifier, "super", 5);
6727 SINGLE_LETTER_MOD (super_modifier);
6728 break;
6730 case 'd':
6731 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6732 MULTI_LETTER_MOD (down_modifier, "down", 4);
6733 MULTI_LETTER_MOD (double_modifier, "double", 6);
6734 break;
6736 case 't':
6737 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6738 break;
6740 case 'u':
6741 MULTI_LETTER_MOD (up_modifier, "up", 2);
6742 break;
6744 #undef SINGLE_LETTER_MOD
6745 #undef MULTI_LETTER_MOD
6748 return 0;
6751 /* Return true if EVENT is a list whose elements are all integers or symbols.
6752 Such a list is not valid as an event,
6753 but it can be a Lucid-style event type list. */
6755 bool
6756 lucid_event_type_list_p (Lisp_Object object)
6758 Lisp_Object tail;
6760 if (! CONSP (object))
6761 return 0;
6763 if (EQ (XCAR (object), Qhelp_echo)
6764 || EQ (XCAR (object), Qvertical_line)
6765 || EQ (XCAR (object), Qmode_line)
6766 || EQ (XCAR (object), Qheader_line))
6767 return 0;
6769 for (tail = object; CONSP (tail); tail = XCDR (tail))
6771 Lisp_Object elt;
6772 elt = XCAR (tail);
6773 if (! (INTEGERP (elt) || SYMBOLP (elt)))
6774 return 0;
6777 return NILP (tail);
6780 /* Return true if terminal input chars are available.
6781 Also, store the return value into INPUT_PENDING.
6783 Serves the purpose of ioctl (0, FIONREAD, ...)
6784 but works even if FIONREAD does not exist.
6785 (In fact, this may actually read some input.)
6787 If READABLE_EVENTS_DO_TIMERS_NOW is set in FLAGS, actually run
6788 timer events that are ripe.
6789 If READABLE_EVENTS_FILTER_EVENTS is set in FLAGS, ignore internal
6790 events (FOCUS_IN_EVENT).
6791 If READABLE_EVENTS_IGNORE_SQUEEZABLES is set in FLAGS, ignore mouse
6792 movements and toolkit scroll bar thumb drags. */
6794 static bool
6795 get_input_pending (int flags)
6797 /* First of all, have we already counted some input? */
6798 input_pending = (!NILP (Vquit_flag) || readable_events (flags));
6800 /* If input is being read as it arrives, and we have none, there is none. */
6801 if (!input_pending && (!interrupt_input || interrupts_deferred))
6803 /* Try to read some input and see how much we get. */
6804 gobble_input ();
6805 input_pending = (!NILP (Vquit_flag) || readable_events (flags));
6808 return input_pending;
6811 /* Put a BUFFER_SWITCH_EVENT in the buffer
6812 so that read_key_sequence will notice the new current buffer. */
6814 void
6815 record_asynch_buffer_change (void)
6817 /* We don't need a buffer-switch event unless Emacs is waiting for input.
6818 The purpose of the event is to make read_key_sequence look up the
6819 keymaps again. If we aren't in read_key_sequence, we don't need one,
6820 and the event could cause trouble by messing up (input-pending-p).
6821 Note: Fwaiting_for_user_input_p always returns nil when async
6822 subprocesses aren't supported. */
6823 if (!NILP (Fwaiting_for_user_input_p ()))
6825 struct input_event event;
6827 EVENT_INIT (event);
6828 event.kind = BUFFER_SWITCH_EVENT;
6829 event.frame_or_window = Qnil;
6830 event.arg = Qnil;
6832 /* Make sure no interrupt happens while storing the event. */
6833 #ifdef USABLE_SIGIO
6834 if (interrupt_input)
6835 kbd_buffer_store_event (&event);
6836 else
6837 #endif
6839 stop_polling ();
6840 kbd_buffer_store_event (&event);
6841 start_polling ();
6846 /* Read any terminal input already buffered up by the system
6847 into the kbd_buffer, but do not wait.
6849 Return the number of keyboard chars read, or -1 meaning
6850 this is a bad time to try to read input. */
6853 gobble_input (void)
6855 int nread = 0;
6856 bool err = false;
6857 struct terminal *t;
6859 /* Store pending user signal events, if any. */
6860 store_user_signal_events ();
6862 /* Loop through the available terminals, and call their input hooks. */
6863 t = terminal_list;
6864 while (t)
6866 struct terminal *next = t->next_terminal;
6868 if (t->read_socket_hook)
6870 int nr;
6871 struct input_event hold_quit;
6873 if (input_blocked_p ())
6875 pending_signals = true;
6876 break;
6879 EVENT_INIT (hold_quit);
6880 hold_quit.kind = NO_EVENT;
6882 /* No need for FIONREAD or fcntl; just say don't wait. */
6883 while ((nr = (*t->read_socket_hook) (t, &hold_quit)) > 0)
6884 nread += nr;
6886 if (nr == -1) /* Not OK to read input now. */
6888 err = true;
6890 else if (nr == -2) /* Non-transient error. */
6892 /* The terminal device terminated; it should be closed. */
6894 /* Kill Emacs if this was our last terminal. */
6895 if (!terminal_list->next_terminal)
6896 /* Formerly simply reported no input, but that
6897 sometimes led to a failure of Emacs to terminate.
6898 SIGHUP seems appropriate if we can't reach the
6899 terminal. */
6900 /* ??? Is it really right to send the signal just to
6901 this process rather than to the whole process
6902 group? Perhaps on systems with FIONREAD Emacs is
6903 alone in its group. */
6904 terminate_due_to_signal (SIGHUP, 10);
6906 /* XXX Is calling delete_terminal safe here? It calls delete_frame. */
6908 Lisp_Object tmp;
6909 XSETTERMINAL (tmp, t);
6910 Fdelete_terminal (tmp, Qnoelisp);
6914 /* If there was no error, make sure the pointer
6915 is visible for all frames on this terminal. */
6916 if (nr >= 0)
6918 Lisp_Object tail, frame;
6920 FOR_EACH_FRAME (tail, frame)
6922 struct frame *f = XFRAME (frame);
6923 if (FRAME_TERMINAL (f) == t)
6924 frame_make_pointer_visible (f);
6928 if (hold_quit.kind != NO_EVENT)
6929 kbd_buffer_store_event (&hold_quit);
6932 t = next;
6935 if (err && !nread)
6936 nread = -1;
6938 return nread;
6941 /* This is the tty way of reading available input.
6943 Note that each terminal device has its own `struct terminal' object,
6944 and so this function is called once for each individual termcap
6945 terminal. The first parameter indicates which terminal to read from. */
6948 tty_read_avail_input (struct terminal *terminal,
6949 struct input_event *hold_quit)
6951 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
6952 the kbd_buffer can really hold. That may prevent loss
6953 of characters on some systems when input is stuffed at us. */
6954 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
6955 #ifndef WINDOWSNT
6956 int n_to_read;
6957 #endif
6958 int i;
6959 struct tty_display_info *tty = terminal->display_info.tty;
6960 int nread = 0;
6961 #ifdef subprocesses
6962 int buffer_free = KBD_BUFFER_SIZE - kbd_buffer_nr_stored () - 1;
6964 if (kbd_on_hold_p () || buffer_free <= 0)
6965 return 0;
6966 #endif /* subprocesses */
6968 if (!terminal->name) /* Don't read from a dead terminal. */
6969 return 0;
6971 if (terminal->type != output_termcap
6972 && terminal->type != output_msdos_raw)
6973 emacs_abort ();
6975 /* XXX I think the following code should be moved to separate hook
6976 functions in system-dependent files. */
6977 #ifdef WINDOWSNT
6978 /* FIXME: AFAIK, tty_read_avail_input is not used under w32 since the non-GUI
6979 code sets read_socket_hook to w32_console_read_socket instead! */
6980 return 0;
6981 #else /* not WINDOWSNT */
6982 if (! tty->term_initted) /* In case we get called during bootstrap. */
6983 return 0;
6985 if (! tty->input)
6986 return 0; /* The terminal is suspended. */
6988 #ifdef MSDOS
6989 n_to_read = dos_keysns ();
6990 if (n_to_read == 0)
6991 return 0;
6993 cbuf[0] = dos_keyread ();
6994 nread = 1;
6996 #else /* not MSDOS */
6997 #ifdef HAVE_GPM
6998 if (gpm_tty == tty)
7000 Gpm_Event event;
7001 struct input_event gpm_hold_quit;
7002 int gpm, fd = gpm_fd;
7004 EVENT_INIT (gpm_hold_quit);
7005 gpm_hold_quit.kind = NO_EVENT;
7007 /* gpm==1 if event received.
7008 gpm==0 if the GPM daemon has closed the connection, in which case
7009 Gpm_GetEvent closes gpm_fd and clears it to -1, which is why
7010 we save it in `fd' so close_gpm can remove it from the
7011 select masks.
7012 gpm==-1 if a protocol error or EWOULDBLOCK; the latter is normal. */
7013 while (gpm = Gpm_GetEvent (&event), gpm == 1) {
7014 nread += handle_one_term_event (tty, &event, &gpm_hold_quit);
7016 if (gpm == 0)
7017 /* Presumably the GPM daemon has closed the connection. */
7018 close_gpm (fd);
7019 if (gpm_hold_quit.kind != NO_EVENT)
7020 kbd_buffer_store_event (&gpm_hold_quit);
7021 if (nread)
7022 return nread;
7024 #endif /* HAVE_GPM */
7026 /* Determine how many characters we should *try* to read. */
7027 #ifdef USABLE_FIONREAD
7028 /* Find out how much input is available. */
7029 if (ioctl (fileno (tty->input), FIONREAD, &n_to_read) < 0)
7031 if (! noninteractive)
7032 return -2; /* Close this terminal. */
7033 else
7034 n_to_read = 0;
7036 if (n_to_read == 0)
7037 return 0;
7038 if (n_to_read > sizeof cbuf)
7039 n_to_read = sizeof cbuf;
7040 #elif defined USG || defined CYGWIN
7041 /* Read some input if available, but don't wait. */
7042 n_to_read = sizeof cbuf;
7043 fcntl (fileno (tty->input), F_SETFL, O_NONBLOCK);
7044 #else
7045 # error "Cannot read without possibly delaying"
7046 #endif
7048 #ifdef subprocesses
7049 /* Don't read more than we can store. */
7050 if (n_to_read > buffer_free)
7051 n_to_read = buffer_free;
7052 #endif /* subprocesses */
7054 /* Now read; for one reason or another, this will not block.
7055 NREAD is set to the number of chars read. */
7058 nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read);
7059 /* POSIX infers that processes which are not in the session leader's
7060 process group won't get SIGHUPs at logout time. BSDI adheres to
7061 this part standard and returns -1 from read (0) with errno==EIO
7062 when the control tty is taken away.
7063 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
7064 if (nread == -1 && errno == EIO)
7065 return -2; /* Close this terminal. */
7066 #if defined (AIX) && defined (_BSD)
7067 /* The kernel sometimes fails to deliver SIGHUP for ptys.
7068 This looks incorrect, but it isn't, because _BSD causes
7069 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
7070 and that causes a value other than 0 when there is no input. */
7071 if (nread == 0)
7072 return -2; /* Close this terminal. */
7073 #endif
7075 while (
7076 /* We used to retry the read if it was interrupted.
7077 But this does the wrong thing when O_NONBLOCK causes
7078 an EAGAIN error. Does anybody know of a situation
7079 where a retry is actually needed? */
7080 #if 0
7081 nread < 0 && (errno == EAGAIN || errno == EFAULT
7082 #ifdef EBADSLT
7083 || errno == EBADSLT
7084 #endif
7086 #else
7088 #endif
7091 #ifndef USABLE_FIONREAD
7092 #if defined (USG) || defined (CYGWIN)
7093 fcntl (fileno (tty->input), F_SETFL, 0);
7094 #endif /* USG or CYGWIN */
7095 #endif /* no FIONREAD */
7097 if (nread <= 0)
7098 return nread;
7100 #endif /* not MSDOS */
7101 #endif /* not WINDOWSNT */
7103 for (i = 0; i < nread; i++)
7105 struct input_event buf;
7106 EVENT_INIT (buf);
7107 buf.kind = ASCII_KEYSTROKE_EVENT;
7108 buf.modifiers = 0;
7109 if (tty->meta_key == 1 && (cbuf[i] & 0x80))
7110 buf.modifiers = meta_modifier;
7111 if (tty->meta_key != 2)
7112 cbuf[i] &= ~0x80;
7114 buf.code = cbuf[i];
7115 /* Set the frame corresponding to the active tty. Note that the
7116 value of selected_frame is not reliable here, redisplay tends
7117 to temporarily change it. */
7118 buf.frame_or_window = tty->top_frame;
7119 buf.arg = Qnil;
7121 kbd_buffer_store_event (&buf);
7122 /* Don't look at input that follows a C-g too closely.
7123 This reduces lossage due to autorepeat on C-g. */
7124 if (buf.kind == ASCII_KEYSTROKE_EVENT
7125 && buf.code == quit_char)
7126 break;
7129 return nread;
7132 static void
7133 handle_async_input (void)
7135 #ifdef USABLE_SIGIO
7136 while (1)
7138 int nread = gobble_input ();
7139 /* -1 means it's not ok to read the input now.
7140 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
7141 0 means there was no keyboard input available. */
7142 if (nread <= 0)
7143 break;
7145 #endif
7148 void
7149 process_pending_signals (void)
7151 pending_signals = false;
7152 handle_async_input ();
7153 do_pending_atimers ();
7156 /* Undo any number of BLOCK_INPUT calls down to level LEVEL,
7157 and reinvoke any pending signal if the level is now 0 and
7158 a fatal error is not already in progress. */
7160 void
7161 unblock_input_to (int level)
7163 interrupt_input_blocked = level;
7164 if (level == 0)
7166 if (pending_signals && !fatal_error_in_progress)
7167 process_pending_signals ();
7169 else if (level < 0)
7170 emacs_abort ();
7173 /* End critical section.
7175 If doing signal-driven input, and a signal came in when input was
7176 blocked, reinvoke the signal handler now to deal with it.
7178 It will also process queued input, if it was not read before.
7179 When a longer code sequence does not use block/unblock input
7180 at all, the whole input gathered up to the next call to
7181 unblock_input will be processed inside that call. */
7183 void
7184 unblock_input (void)
7186 unblock_input_to (interrupt_input_blocked - 1);
7189 /* Undo any number of BLOCK_INPUT calls,
7190 and also reinvoke any pending signal. */
7192 void
7193 totally_unblock_input (void)
7195 unblock_input_to (0);
7198 #ifdef USABLE_SIGIO
7200 void
7201 handle_input_available_signal (int sig)
7203 pending_signals = true;
7205 if (input_available_clear_time)
7206 *input_available_clear_time = make_timespec (0, 0);
7209 static void
7210 deliver_input_available_signal (int sig)
7212 deliver_process_signal (sig, handle_input_available_signal);
7214 #endif /* USABLE_SIGIO */
7217 /* User signal events. */
7219 struct user_signal_info
7221 /* Signal number. */
7222 int sig;
7224 /* Name of the signal. */
7225 char *name;
7227 /* Number of pending signals. */
7228 int npending;
7230 struct user_signal_info *next;
7233 /* List of user signals. */
7234 static struct user_signal_info *user_signals = NULL;
7236 void
7237 add_user_signal (int sig, const char *name)
7239 struct sigaction action;
7240 struct user_signal_info *p;
7242 for (p = user_signals; p; p = p->next)
7243 if (p->sig == sig)
7244 /* Already added. */
7245 return;
7247 p = xmalloc (sizeof *p);
7248 p->sig = sig;
7249 p->name = xstrdup (name);
7250 p->npending = 0;
7251 p->next = user_signals;
7252 user_signals = p;
7254 emacs_sigaction_init (&action, deliver_user_signal);
7255 sigaction (sig, &action, 0);
7258 static void
7259 handle_user_signal (int sig)
7261 struct user_signal_info *p;
7262 const char *special_event_name = NULL;
7264 if (SYMBOLP (Vdebug_on_event))
7265 special_event_name = SSDATA (SYMBOL_NAME (Vdebug_on_event));
7267 for (p = user_signals; p; p = p->next)
7268 if (p->sig == sig)
7270 if (special_event_name
7271 && strcmp (special_event_name, p->name) == 0)
7273 /* Enter the debugger in many ways. */
7274 debug_on_next_call = true;
7275 debug_on_quit = true;
7276 Vquit_flag = Qt;
7277 Vinhibit_quit = Qnil;
7279 /* Eat the event. */
7280 break;
7283 p->npending++;
7284 #ifdef USABLE_SIGIO
7285 if (interrupt_input)
7286 handle_input_available_signal (sig);
7287 else
7288 #endif
7290 /* Tell wait_reading_process_output that it needs to wake
7291 up and look around. */
7292 if (input_available_clear_time)
7293 *input_available_clear_time = make_timespec (0, 0);
7295 break;
7299 static void
7300 deliver_user_signal (int sig)
7302 deliver_process_signal (sig, handle_user_signal);
7305 static char *
7306 find_user_signal_name (int sig)
7308 struct user_signal_info *p;
7310 for (p = user_signals; p; p = p->next)
7311 if (p->sig == sig)
7312 return p->name;
7314 return NULL;
7317 static void
7318 store_user_signal_events (void)
7320 struct user_signal_info *p;
7321 struct input_event buf;
7322 bool buf_initialized = false;
7324 for (p = user_signals; p; p = p->next)
7325 if (p->npending > 0)
7327 if (! buf_initialized)
7329 memset (&buf, 0, sizeof buf);
7330 buf.kind = USER_SIGNAL_EVENT;
7331 buf.frame_or_window = selected_frame;
7332 buf_initialized = true;
7337 buf.code = p->sig;
7338 kbd_buffer_store_event (&buf);
7339 p->npending--;
7341 while (p->npending > 0);
7346 static void menu_bar_item (Lisp_Object, Lisp_Object, Lisp_Object, void *);
7347 static Lisp_Object menu_bar_one_keymap_changed_items;
7349 /* These variables hold the vector under construction within
7350 menu_bar_items and its subroutines, and the current index
7351 for storing into that vector. */
7352 static Lisp_Object menu_bar_items_vector;
7353 static int menu_bar_items_index;
7356 static const char *separator_names[] = {
7357 "space",
7358 "no-line",
7359 "single-line",
7360 "double-line",
7361 "single-dashed-line",
7362 "double-dashed-line",
7363 "shadow-etched-in",
7364 "shadow-etched-out",
7365 "shadow-etched-in-dash",
7366 "shadow-etched-out-dash",
7367 "shadow-double-etched-in",
7368 "shadow-double-etched-out",
7369 "shadow-double-etched-in-dash",
7370 "shadow-double-etched-out-dash",
7374 /* Return true if LABEL specifies a separator. */
7376 bool
7377 menu_separator_name_p (const char *label)
7379 if (!label)
7380 return 0;
7381 else if (strlen (label) > 3
7382 && memcmp (label, "--", 2) == 0
7383 && label[2] != '-')
7385 int i;
7386 label += 2;
7387 for (i = 0; separator_names[i]; ++i)
7388 if (strcmp (label, separator_names[i]) == 0)
7389 return 1;
7391 else
7393 /* It's a separator if it contains only dashes. */
7394 while (*label == '-')
7395 ++label;
7396 return (*label == 0);
7399 return 0;
7403 /* Return a vector of menu items for a menu bar, appropriate
7404 to the current buffer. Each item has three elements in the vector:
7405 KEY STRING MAPLIST.
7407 OLD is an old vector we can optionally reuse, or nil. */
7409 Lisp_Object
7410 menu_bar_items (Lisp_Object old)
7412 /* The number of keymaps we're scanning right now, and the number of
7413 keymaps we have allocated space for. */
7414 ptrdiff_t nmaps;
7416 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
7417 in the current keymaps, or nil where it is not a prefix. */
7418 Lisp_Object *maps;
7420 Lisp_Object mapsbuf[3];
7421 Lisp_Object def, tail;
7423 ptrdiff_t mapno;
7424 Lisp_Object oquit;
7426 USE_SAFE_ALLOCA;
7428 /* In order to build the menus, we need to call the keymap
7429 accessors. They all call maybe_quit. But this function is called
7430 during redisplay, during which a quit is fatal. So inhibit
7431 quitting while building the menus.
7432 We do this instead of specbind because (1) errors will clear it anyway
7433 and (2) this avoids risk of specpdl overflow. */
7434 oquit = Vinhibit_quit;
7435 Vinhibit_quit = Qt;
7437 if (!NILP (old))
7438 menu_bar_items_vector = old;
7439 else
7440 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
7441 menu_bar_items_index = 0;
7443 /* Build our list of keymaps.
7444 If we recognize a function key and replace its escape sequence in
7445 keybuf with its symbol, or if the sequence starts with a mouse
7446 click and we need to switch buffers, we jump back here to rebuild
7447 the initial keymaps from the current buffer. */
7449 Lisp_Object *tmaps;
7451 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7452 if (!NILP (Voverriding_local_map_menu_flag)
7453 && !NILP (Voverriding_local_map))
7455 /* Yes, use them (if non-nil) as well as the global map. */
7456 maps = mapsbuf;
7457 nmaps = 0;
7458 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
7459 maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
7460 if (!NILP (Voverriding_local_map))
7461 maps[nmaps++] = Voverriding_local_map;
7463 else
7465 /* No, so use major and minor mode keymaps and keymap property.
7466 Note that menu-bar bindings in the local-map and keymap
7467 properties may not work reliable, as they are only
7468 recognized when the menu-bar (or mode-line) is updated,
7469 which does not normally happen after every command. */
7470 ptrdiff_t nminor = current_minor_maps (NULL, &tmaps);
7471 SAFE_NALLOCA (maps, 1, nminor + 4);
7472 nmaps = 0;
7473 Lisp_Object tem = KVAR (current_kboard, Voverriding_terminal_local_map);
7474 if (!NILP (tem) && !NILP (Voverriding_local_map_menu_flag))
7475 maps[nmaps++] = tem;
7476 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
7477 maps[nmaps++] = tem;
7478 if (nminor != 0)
7480 memcpy (maps + nmaps, tmaps, nminor * sizeof (maps[0]));
7481 nmaps += nminor;
7483 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
7485 maps[nmaps++] = current_global_map;
7488 /* Look up in each map the dummy prefix key `menu-bar'. */
7490 for (mapno = nmaps - 1; mapno >= 0; mapno--)
7491 if (!NILP (maps[mapno]))
7493 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
7494 0, 1);
7495 if (CONSP (def))
7497 menu_bar_one_keymap_changed_items = Qnil;
7498 map_keymap_canonical (def, menu_bar_item, Qnil, NULL);
7502 /* Move to the end those items that should be at the end. */
7504 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
7506 int i;
7507 int end = menu_bar_items_index;
7509 for (i = 0; i < end; i += 4)
7510 if (EQ (XCAR (tail), AREF (menu_bar_items_vector, i)))
7512 Lisp_Object tem0, tem1, tem2, tem3;
7513 /* Move the item at index I to the end,
7514 shifting all the others forward. */
7515 tem0 = AREF (menu_bar_items_vector, i + 0);
7516 tem1 = AREF (menu_bar_items_vector, i + 1);
7517 tem2 = AREF (menu_bar_items_vector, i + 2);
7518 tem3 = AREF (menu_bar_items_vector, i + 3);
7519 if (end > i + 4)
7520 memmove (aref_addr (menu_bar_items_vector, i),
7521 aref_addr (menu_bar_items_vector, i + 4),
7522 (end - i - 4) * word_size);
7523 ASET (menu_bar_items_vector, end - 4, tem0);
7524 ASET (menu_bar_items_vector, end - 3, tem1);
7525 ASET (menu_bar_items_vector, end - 2, tem2);
7526 ASET (menu_bar_items_vector, end - 1, tem3);
7527 break;
7531 /* Add nil, nil, nil, nil at the end. */
7533 int i = menu_bar_items_index;
7534 if (i + 4 > ASIZE (menu_bar_items_vector))
7535 menu_bar_items_vector
7536 = larger_vector (menu_bar_items_vector, 4, -1);
7537 /* Add this item. */
7538 ASET (menu_bar_items_vector, i, Qnil); i++;
7539 ASET (menu_bar_items_vector, i, Qnil); i++;
7540 ASET (menu_bar_items_vector, i, Qnil); i++;
7541 ASET (menu_bar_items_vector, i, Qnil); i++;
7542 menu_bar_items_index = i;
7545 Vinhibit_quit = oquit;
7546 SAFE_FREE ();
7547 return menu_bar_items_vector;
7550 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
7551 If there's already an item for KEY, add this DEF to it. */
7553 Lisp_Object item_properties;
7555 static void
7556 menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dummy2)
7558 int i;
7559 bool parsed;
7560 Lisp_Object tem;
7562 if (EQ (item, Qundefined))
7564 /* If a map has an explicit `undefined' as definition,
7565 discard any previously made menu bar item. */
7567 for (i = 0; i < menu_bar_items_index; i += 4)
7568 if (EQ (key, AREF (menu_bar_items_vector, i)))
7570 if (menu_bar_items_index > i + 4)
7571 memmove (aref_addr (menu_bar_items_vector, i),
7572 aref_addr (menu_bar_items_vector, i + 4),
7573 (menu_bar_items_index - i - 4) * word_size);
7574 menu_bar_items_index -= 4;
7578 /* If this keymap has already contributed to this KEY,
7579 don't contribute to it a second time. */
7580 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
7581 if (!NILP (tem) || NILP (item))
7582 return;
7584 menu_bar_one_keymap_changed_items
7585 = Fcons (key, menu_bar_one_keymap_changed_items);
7587 /* We add to menu_bar_one_keymap_changed_items before doing the
7588 parse_menu_item, so that if it turns out it wasn't a menu item,
7589 it still correctly hides any further menu item. */
7590 parsed = parse_menu_item (item, 1);
7591 if (!parsed)
7592 return;
7594 item = AREF (item_properties, ITEM_PROPERTY_DEF);
7596 /* Find any existing item for this KEY. */
7597 for (i = 0; i < menu_bar_items_index; i += 4)
7598 if (EQ (key, AREF (menu_bar_items_vector, i)))
7599 break;
7601 /* If we did not find this KEY, add it at the end. */
7602 if (i == menu_bar_items_index)
7604 /* If vector is too small, get a bigger one. */
7605 if (i + 4 > ASIZE (menu_bar_items_vector))
7606 menu_bar_items_vector = larger_vector (menu_bar_items_vector, 4, -1);
7607 /* Add this item. */
7608 ASET (menu_bar_items_vector, i, key); i++;
7609 ASET (menu_bar_items_vector, i,
7610 AREF (item_properties, ITEM_PROPERTY_NAME)); i++;
7611 ASET (menu_bar_items_vector, i, list1 (item)); i++;
7612 ASET (menu_bar_items_vector, i, make_number (0)); i++;
7613 menu_bar_items_index = i;
7615 /* We did find an item for this KEY. Add ITEM to its list of maps. */
7616 else
7618 Lisp_Object old;
7619 old = AREF (menu_bar_items_vector, i + 2);
7620 /* If the new and the old items are not both keymaps,
7621 the lookup will only find `item'. */
7622 item = Fcons (item, KEYMAPP (item) && KEYMAPP (XCAR (old)) ? old : Qnil);
7623 ASET (menu_bar_items_vector, i + 2, item);
7627 /* This is used as the handler when calling menu_item_eval_property. */
7628 static Lisp_Object
7629 menu_item_eval_property_1 (Lisp_Object arg)
7631 /* If we got a quit from within the menu computation,
7632 quit all the way out of it. This takes care of C-] in the debugger. */
7633 if (CONSP (arg) && EQ (XCAR (arg), Qquit))
7634 quit ();
7636 return Qnil;
7639 static Lisp_Object
7640 eval_dyn (Lisp_Object form)
7642 return Feval (form, Qnil);
7645 /* Evaluate an expression and return the result (or nil if something
7646 went wrong). Used to evaluate dynamic parts of menu items. */
7647 Lisp_Object
7648 menu_item_eval_property (Lisp_Object sexpr)
7650 ptrdiff_t count = SPECPDL_INDEX ();
7651 Lisp_Object val;
7652 specbind (Qinhibit_redisplay, Qt);
7653 val = internal_condition_case_1 (eval_dyn, sexpr, Qerror,
7654 menu_item_eval_property_1);
7655 return unbind_to (count, val);
7658 /* This function parses a menu item and leaves the result in the
7659 vector item_properties.
7660 ITEM is a key binding, a possible menu item.
7661 INMENUBAR is > 0 when this is considered for an entry in a menu bar
7662 top level.
7663 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
7664 parse_menu_item returns true if the item is a menu item and false
7665 otherwise. */
7667 bool
7668 parse_menu_item (Lisp_Object item, int inmenubar)
7670 Lisp_Object def, tem, item_string, start;
7671 Lisp_Object filter;
7672 Lisp_Object keyhint;
7673 int i;
7675 filter = Qnil;
7676 keyhint = Qnil;
7678 if (!CONSP (item))
7679 return 0;
7681 /* Create item_properties vector if necessary. */
7682 if (NILP (item_properties))
7683 item_properties
7684 = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
7686 /* Initialize optional entries. */
7687 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
7688 ASET (item_properties, i, Qnil);
7689 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7691 /* Save the item here to protect it from GC. */
7692 ASET (item_properties, ITEM_PROPERTY_ITEM, item);
7694 item_string = XCAR (item);
7696 start = item;
7697 item = XCDR (item);
7698 if (STRINGP (item_string))
7700 /* Old format menu item. */
7701 ASET (item_properties, ITEM_PROPERTY_NAME, item_string);
7703 /* Maybe help string. */
7704 if (CONSP (item) && STRINGP (XCAR (item)))
7706 ASET (item_properties, ITEM_PROPERTY_HELP,
7707 Fsubstitute_command_keys (XCAR (item)));
7708 start = item;
7709 item = XCDR (item);
7712 /* Maybe an obsolete key binding cache. */
7713 if (CONSP (item) && CONSP (XCAR (item))
7714 && (NILP (XCAR (XCAR (item)))
7715 || VECTORP (XCAR (XCAR (item)))))
7716 item = XCDR (item);
7718 /* This is the real definition--the function to run. */
7719 ASET (item_properties, ITEM_PROPERTY_DEF, item);
7721 /* Get enable property, if any. */
7722 if (SYMBOLP (item))
7724 tem = Fget (item, Qmenu_enable);
7725 if (!NILP (Venable_disabled_menus_and_buttons))
7726 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7727 else if (!NILP (tem))
7728 ASET (item_properties, ITEM_PROPERTY_ENABLE, tem);
7731 else if (EQ (item_string, Qmenu_item) && CONSP (item))
7733 /* New format menu item. */
7734 ASET (item_properties, ITEM_PROPERTY_NAME, XCAR (item));
7735 start = XCDR (item);
7736 if (CONSP (start))
7738 /* We have a real binding. */
7739 ASET (item_properties, ITEM_PROPERTY_DEF, XCAR (start));
7741 item = XCDR (start);
7742 /* Is there an obsolete cache list with key equivalences. */
7743 if (CONSP (item) && CONSP (XCAR (item)))
7744 item = XCDR (item);
7746 /* Parse properties. */
7747 while (CONSP (item) && CONSP (XCDR (item)))
7749 tem = XCAR (item);
7750 item = XCDR (item);
7752 if (EQ (tem, QCenable))
7754 if (!NILP (Venable_disabled_menus_and_buttons))
7755 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7756 else
7757 ASET (item_properties, ITEM_PROPERTY_ENABLE, XCAR (item));
7759 else if (EQ (tem, QCvisible))
7761 /* If got a visible property and that evaluates to nil
7762 then ignore this item. */
7763 tem = menu_item_eval_property (XCAR (item));
7764 if (NILP (tem))
7765 return 0;
7767 else if (EQ (tem, QChelp))
7769 Lisp_Object help = XCAR (item);
7770 if (STRINGP (help))
7771 help = Fsubstitute_command_keys (help);
7772 ASET (item_properties, ITEM_PROPERTY_HELP, help);
7774 else if (EQ (tem, QCfilter))
7775 filter = item;
7776 else if (EQ (tem, QCkey_sequence))
7778 tem = XCAR (item);
7779 if (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem))
7780 /* Be GC protected. Set keyhint to item instead of tem. */
7781 keyhint = item;
7783 else if (EQ (tem, QCkeys))
7785 tem = XCAR (item);
7786 if (CONSP (tem) || STRINGP (tem))
7787 ASET (item_properties, ITEM_PROPERTY_KEYEQ, tem);
7789 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
7791 Lisp_Object type;
7792 tem = XCAR (item);
7793 type = XCAR (tem);
7794 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7796 ASET (item_properties, ITEM_PROPERTY_SELECTED,
7797 XCDR (tem));
7798 ASET (item_properties, ITEM_PROPERTY_TYPE, type);
7801 item = XCDR (item);
7804 else if (inmenubar || !NILP (start))
7805 return 0;
7807 else
7808 return 0; /* not a menu item */
7810 /* If item string is not a string, evaluate it to get string.
7811 If we don't get a string, skip this item. */
7812 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
7813 if (!(STRINGP (item_string)))
7815 item_string = menu_item_eval_property (item_string);
7816 if (!STRINGP (item_string))
7817 return 0;
7818 ASET (item_properties, ITEM_PROPERTY_NAME, item_string);
7821 /* If got a filter apply it on definition. */
7822 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7823 if (!NILP (filter))
7825 def = menu_item_eval_property (list2 (XCAR (filter),
7826 list2 (Qquote, def)));
7828 ASET (item_properties, ITEM_PROPERTY_DEF, def);
7831 /* Enable or disable selection of item. */
7832 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
7833 if (!EQ (tem, Qt))
7835 tem = menu_item_eval_property (tem);
7836 if (inmenubar && NILP (tem))
7837 return 0; /* Ignore disabled items in menu bar. */
7838 ASET (item_properties, ITEM_PROPERTY_ENABLE, tem);
7841 /* If we got no definition, this item is just unselectable text which
7842 is OK in a submenu but not in the menubar. */
7843 if (NILP (def))
7844 return (!inmenubar);
7846 /* See if this is a separate pane or a submenu. */
7847 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7848 tem = get_keymap (def, 0, 1);
7849 /* For a subkeymap, just record its details and exit. */
7850 if (CONSP (tem))
7852 ASET (item_properties, ITEM_PROPERTY_MAP, tem);
7853 ASET (item_properties, ITEM_PROPERTY_DEF, tem);
7854 return 1;
7857 /* At the top level in the menu bar, do likewise for commands also.
7858 The menu bar does not display equivalent key bindings anyway.
7859 ITEM_PROPERTY_DEF is already set up properly. */
7860 if (inmenubar > 0)
7861 return 1;
7863 { /* This is a command. See if there is an equivalent key binding. */
7864 Lisp_Object keyeq = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
7865 AUTO_STRING (space_space, " ");
7867 /* The previous code preferred :key-sequence to :keys, so we
7868 preserve this behavior. */
7869 if (STRINGP (keyeq) && !CONSP (keyhint))
7870 keyeq = concat2 (space_space, Fsubstitute_command_keys (keyeq));
7871 else
7873 Lisp_Object prefix = keyeq;
7874 Lisp_Object keys = Qnil;
7876 if (CONSP (prefix))
7878 def = XCAR (prefix);
7879 prefix = XCDR (prefix);
7881 else
7882 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7884 if (CONSP (keyhint) && !NILP (XCAR (keyhint)))
7886 keys = XCAR (keyhint);
7887 tem = Fkey_binding (keys, Qnil, Qnil, Qnil);
7889 /* We have a suggested key. Is it bound to the command? */
7890 if (NILP (tem)
7891 || (!EQ (tem, def)
7892 /* If the command is an alias for another
7893 (such as lmenu.el set it up), check if the
7894 original command matches the cached command. */
7895 && !(SYMBOLP (def)
7896 && EQ (tem, XSYMBOL (def)->function))))
7897 keys = Qnil;
7900 if (NILP (keys))
7901 keys = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qnil);
7903 if (!NILP (keys))
7905 tem = Fkey_description (keys, Qnil);
7906 if (CONSP (prefix))
7908 if (STRINGP (XCAR (prefix)))
7909 tem = concat2 (XCAR (prefix), tem);
7910 if (STRINGP (XCDR (prefix)))
7911 tem = concat2 (tem, XCDR (prefix));
7913 keyeq = concat2 (space_space, tem);
7915 else
7916 keyeq = Qnil;
7919 /* If we have an equivalent key binding, use that. */
7920 ASET (item_properties, ITEM_PROPERTY_KEYEQ, keyeq);
7923 /* Include this when menu help is implemented.
7924 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
7925 if (!(NILP (tem) || STRINGP (tem)))
7927 tem = menu_item_eval_property (tem);
7928 if (!STRINGP (tem))
7929 tem = Qnil;
7930 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
7934 /* Handle radio buttons or toggle boxes. */
7935 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
7936 if (!NILP (tem))
7937 ASET (item_properties, ITEM_PROPERTY_SELECTED,
7938 menu_item_eval_property (tem));
7940 return 1;
7945 /***********************************************************************
7946 Tool-bars
7947 ***********************************************************************/
7949 /* A vector holding tool bar items while they are parsed in function
7950 tool_bar_items. Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
7951 in the vector. */
7953 static Lisp_Object tool_bar_items_vector;
7955 /* A vector holding the result of parse_tool_bar_item. Layout is like
7956 the one for a single item in tool_bar_items_vector. */
7958 static Lisp_Object tool_bar_item_properties;
7960 /* Next free index in tool_bar_items_vector. */
7962 static int ntool_bar_items;
7964 /* Function prototypes. */
7966 static void init_tool_bar_items (Lisp_Object);
7967 static void process_tool_bar_item (Lisp_Object, Lisp_Object, Lisp_Object,
7968 void *);
7969 static bool parse_tool_bar_item (Lisp_Object, Lisp_Object);
7970 static void append_tool_bar_item (void);
7973 /* Return a vector of tool bar items for keymaps currently in effect.
7974 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
7975 tool bar items found. */
7977 Lisp_Object
7978 tool_bar_items (Lisp_Object reuse, int *nitems)
7980 Lisp_Object *maps;
7981 Lisp_Object mapsbuf[3];
7982 ptrdiff_t nmaps, i;
7983 Lisp_Object oquit;
7984 Lisp_Object *tmaps;
7985 USE_SAFE_ALLOCA;
7987 *nitems = 0;
7989 /* In order to build the menus, we need to call the keymap
7990 accessors. They all call maybe_quit. But this function is called
7991 during redisplay, during which a quit is fatal. So inhibit
7992 quitting while building the menus. We do this instead of
7993 specbind because (1) errors will clear it anyway and (2) this
7994 avoids risk of specpdl overflow. */
7995 oquit = Vinhibit_quit;
7996 Vinhibit_quit = Qt;
7998 /* Initialize tool_bar_items_vector and protect it from GC. */
7999 init_tool_bar_items (reuse);
8001 /* Build list of keymaps in maps. Set nmaps to the number of maps
8002 to process. */
8004 /* Should overriding-terminal-local-map and overriding-local-map apply? */
8005 if (!NILP (Voverriding_local_map_menu_flag)
8006 && !NILP (Voverriding_local_map))
8008 /* Yes, use them (if non-nil) as well as the global map. */
8009 maps = mapsbuf;
8010 nmaps = 0;
8011 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
8012 maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
8013 if (!NILP (Voverriding_local_map))
8014 maps[nmaps++] = Voverriding_local_map;
8016 else
8018 /* No, so use major and minor mode keymaps and keymap property.
8019 Note that tool-bar bindings in the local-map and keymap
8020 properties may not work reliable, as they are only
8021 recognized when the tool-bar (or mode-line) is updated,
8022 which does not normally happen after every command. */
8023 ptrdiff_t nminor = current_minor_maps (NULL, &tmaps);
8024 SAFE_NALLOCA (maps, 1, nminor + 4);
8025 nmaps = 0;
8026 Lisp_Object tem = KVAR (current_kboard, Voverriding_terminal_local_map);
8027 if (!NILP (tem) && !NILP (Voverriding_local_map_menu_flag))
8028 maps[nmaps++] = tem;
8029 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
8030 maps[nmaps++] = tem;
8031 if (nminor != 0)
8033 memcpy (maps + nmaps, tmaps, nminor * sizeof (maps[0]));
8034 nmaps += nminor;
8036 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
8039 /* Add global keymap at the end. */
8040 maps[nmaps++] = current_global_map;
8042 /* Process maps in reverse order and look up in each map the prefix
8043 key `tool-bar'. */
8044 for (i = nmaps - 1; i >= 0; --i)
8045 if (!NILP (maps[i]))
8047 Lisp_Object keymap;
8049 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
8050 if (CONSP (keymap))
8051 map_keymap (keymap, process_tool_bar_item, Qnil, NULL, 1);
8054 Vinhibit_quit = oquit;
8055 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
8056 SAFE_FREE ();
8057 return tool_bar_items_vector;
8061 /* Process the definition of KEY which is DEF. */
8063 static void
8064 process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void *args)
8066 int i;
8068 if (EQ (def, Qundefined))
8070 /* If a map has an explicit `undefined' as definition,
8071 discard any previously made item. */
8072 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
8074 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
8076 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
8078 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
8079 memmove (v, v + TOOL_BAR_ITEM_NSLOTS,
8080 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
8081 * word_size));
8082 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
8083 break;
8087 else if (parse_tool_bar_item (key, def))
8088 /* Append a new tool bar item to tool_bar_items_vector. Accept
8089 more than one definition for the same key. */
8090 append_tool_bar_item ();
8093 /* Access slot with index IDX of vector tool_bar_item_properties. */
8094 #define PROP(IDX) AREF (tool_bar_item_properties, (IDX))
8095 static void
8096 set_prop (ptrdiff_t idx, Lisp_Object val)
8098 ASET (tool_bar_item_properties, idx, val);
8102 /* Parse a tool bar item specification ITEM for key KEY and return the
8103 result in tool_bar_item_properties. Value is false if ITEM is
8104 invalid.
8106 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
8108 CAPTION is the caption of the item, If it's not a string, it is
8109 evaluated to get a string.
8111 BINDING is the tool bar item's binding. Tool-bar items with keymaps
8112 as binding are currently ignored.
8114 The following properties are recognized:
8116 - `:enable FORM'.
8118 FORM is evaluated and specifies whether the tool bar item is
8119 enabled or disabled.
8121 - `:visible FORM'
8123 FORM is evaluated and specifies whether the tool bar item is visible.
8125 - `:filter FUNCTION'
8127 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
8128 result is stored as the new binding.
8130 - `:button (TYPE SELECTED)'
8132 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
8133 and specifies whether the button is selected (pressed) or not.
8135 - `:image IMAGES'
8137 IMAGES is either a single image specification or a vector of four
8138 image specifications. See enum tool_bar_item_images.
8140 - `:help HELP-STRING'.
8142 Gives a help string to display for the tool bar item.
8144 - `:label LABEL-STRING'.
8146 A text label to show with the tool bar button if labels are enabled. */
8148 static bool
8149 parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
8151 Lisp_Object filter = Qnil;
8152 Lisp_Object caption;
8153 int i;
8154 bool have_label = false;
8156 /* Definition looks like `(menu-item CAPTION BINDING PROPS...)'.
8157 Rule out items that aren't lists, don't start with
8158 `menu-item' or whose rest following `tool-bar-item' is not a
8159 list. */
8160 if (!CONSP (item))
8161 return 0;
8163 /* As an exception, allow old-style menu separators. */
8164 if (STRINGP (XCAR (item)))
8165 item = list1 (XCAR (item));
8166 else if (!EQ (XCAR (item), Qmenu_item)
8167 || (item = XCDR (item), !CONSP (item)))
8168 return 0;
8170 /* Create tool_bar_item_properties vector if necessary. Reset it to
8171 defaults. */
8172 if (VECTORP (tool_bar_item_properties))
8174 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
8175 set_prop (i, Qnil);
8177 else
8178 tool_bar_item_properties
8179 = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
8181 /* Set defaults. */
8182 set_prop (TOOL_BAR_ITEM_KEY, key);
8183 set_prop (TOOL_BAR_ITEM_ENABLED_P, Qt);
8185 /* Get the caption of the item. If the caption is not a string,
8186 evaluate it to get a string. If we don't get a string, skip this
8187 item. */
8188 caption = XCAR (item);
8189 if (!STRINGP (caption))
8191 caption = menu_item_eval_property (caption);
8192 if (!STRINGP (caption))
8193 return 0;
8195 set_prop (TOOL_BAR_ITEM_CAPTION, caption);
8197 /* If the rest following the caption is not a list, the menu item is
8198 either a separator, or invalid. */
8199 item = XCDR (item);
8200 if (!CONSP (item))
8202 if (menu_separator_name_p (SSDATA (caption)))
8204 set_prop (TOOL_BAR_ITEM_TYPE, Qt);
8205 #if !defined (USE_GTK) && !defined (HAVE_NS)
8206 /* If we use build_desired_tool_bar_string to render the
8207 tool bar, the separator is rendered as an image. */
8208 set_prop (TOOL_BAR_ITEM_IMAGES,
8209 (menu_item_eval_property
8210 (Vtool_bar_separator_image_expression)));
8211 set_prop (TOOL_BAR_ITEM_ENABLED_P, Qnil);
8212 set_prop (TOOL_BAR_ITEM_SELECTED_P, Qnil);
8213 set_prop (TOOL_BAR_ITEM_CAPTION, Qnil);
8214 #endif
8215 return 1;
8217 return 0;
8220 /* Store the binding. */
8221 set_prop (TOOL_BAR_ITEM_BINDING, XCAR (item));
8222 item = XCDR (item);
8224 /* Ignore cached key binding, if any. */
8225 if (CONSP (item) && CONSP (XCAR (item)))
8226 item = XCDR (item);
8228 /* Process the rest of the properties. */
8229 for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
8231 Lisp_Object ikey, value;
8233 ikey = XCAR (item);
8234 value = XCAR (XCDR (item));
8236 if (EQ (ikey, QCenable))
8238 /* `:enable FORM'. */
8239 if (!NILP (Venable_disabled_menus_and_buttons))
8240 set_prop (TOOL_BAR_ITEM_ENABLED_P, Qt);
8241 else
8242 set_prop (TOOL_BAR_ITEM_ENABLED_P, value);
8244 else if (EQ (ikey, QCvisible))
8246 /* `:visible FORM'. If got a visible property and that
8247 evaluates to nil then ignore this item. */
8248 if (NILP (menu_item_eval_property (value)))
8249 return 0;
8251 else if (EQ (ikey, QChelp))
8252 /* `:help HELP-STRING'. */
8253 set_prop (TOOL_BAR_ITEM_HELP, value);
8254 else if (EQ (ikey, QCvert_only))
8255 /* `:vert-only t/nil'. */
8256 set_prop (TOOL_BAR_ITEM_VERT_ONLY, value);
8257 else if (EQ (ikey, QClabel))
8259 const char *bad_label = "!!?GARBLED ITEM?!!";
8260 /* `:label LABEL-STRING'. */
8261 set_prop (TOOL_BAR_ITEM_LABEL,
8262 STRINGP (value) ? value : build_string (bad_label));
8263 have_label = true;
8265 else if (EQ (ikey, QCfilter))
8266 /* ':filter FORM'. */
8267 filter = value;
8268 else if (EQ (ikey, QCbutton) && CONSP (value))
8270 /* `:button (TYPE . SELECTED)'. */
8271 Lisp_Object type, selected;
8273 type = XCAR (value);
8274 selected = XCDR (value);
8275 if (EQ (type, QCtoggle) || EQ (type, QCradio))
8277 set_prop (TOOL_BAR_ITEM_SELECTED_P, selected);
8278 set_prop (TOOL_BAR_ITEM_TYPE, type);
8281 else if (EQ (ikey, QCimage)
8282 && (CONSP (value)
8283 || (VECTORP (value) && ASIZE (value) == 4)))
8284 /* Value is either a single image specification or a vector
8285 of 4 such specifications for the different button states. */
8286 set_prop (TOOL_BAR_ITEM_IMAGES, value);
8287 else if (EQ (ikey, QCrtl))
8288 /* ':rtl STRING' */
8289 set_prop (TOOL_BAR_ITEM_RTL_IMAGE, value);
8293 if (!have_label)
8295 /* Try to make one from caption and key. */
8296 Lisp_Object tkey = PROP (TOOL_BAR_ITEM_KEY);
8297 Lisp_Object tcapt = PROP (TOOL_BAR_ITEM_CAPTION);
8298 const char *label = SYMBOLP (tkey) ? SSDATA (SYMBOL_NAME (tkey)) : "";
8299 const char *capt = STRINGP (tcapt) ? SSDATA (tcapt) : "";
8300 ptrdiff_t max_lbl =
8301 2 * max (0, min (tool_bar_max_label_size, STRING_BYTES_BOUND / 2));
8302 char *buf = xmalloc (max_lbl + 1);
8303 Lisp_Object new_lbl;
8304 ptrdiff_t caption_len = strlen (capt);
8306 if (caption_len <= max_lbl && capt[0] != '\0')
8308 strcpy (buf, capt);
8309 while (caption_len > 0 && buf[caption_len - 1] == '.')
8310 caption_len--;
8311 buf[caption_len] = '\0';
8312 label = capt = buf;
8315 if (strlen (label) <= max_lbl && label[0] != '\0')
8317 ptrdiff_t j;
8318 if (label != buf)
8319 strcpy (buf, label);
8321 for (j = 0; buf[j] != '\0'; ++j)
8322 if (buf[j] == '-')
8323 buf[j] = ' ';
8324 label = buf;
8326 else
8327 label = "";
8329 new_lbl = Fupcase_initials (build_string (label));
8330 if (SCHARS (new_lbl) <= tool_bar_max_label_size)
8331 set_prop (TOOL_BAR_ITEM_LABEL, new_lbl);
8332 else
8333 set_prop (TOOL_BAR_ITEM_LABEL, empty_unibyte_string);
8334 xfree (buf);
8337 /* If got a filter apply it on binding. */
8338 if (!NILP (filter))
8339 set_prop (TOOL_BAR_ITEM_BINDING,
8340 (menu_item_eval_property
8341 (list2 (filter,
8342 list2 (Qquote,
8343 PROP (TOOL_BAR_ITEM_BINDING))))));
8345 /* See if the binding is a keymap. Give up if it is. */
8346 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
8347 return 0;
8349 /* Enable or disable selection of item. */
8350 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
8351 set_prop (TOOL_BAR_ITEM_ENABLED_P,
8352 menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P)));
8354 /* Handle radio buttons or toggle boxes. */
8355 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
8356 set_prop (TOOL_BAR_ITEM_SELECTED_P,
8357 menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P)));
8359 return 1;
8361 #undef PROP
8365 /* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
8366 that can be reused. */
8368 static void
8369 init_tool_bar_items (Lisp_Object reuse)
8371 if (VECTORP (reuse))
8372 tool_bar_items_vector = reuse;
8373 else
8374 tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
8375 ntool_bar_items = 0;
8379 /* Append parsed tool bar item properties from
8380 tool_bar_item_properties */
8382 static void
8383 append_tool_bar_item (void)
8385 ptrdiff_t incr
8386 = (ntool_bar_items
8387 - (ASIZE (tool_bar_items_vector) - TOOL_BAR_ITEM_NSLOTS));
8389 /* Enlarge tool_bar_items_vector if necessary. */
8390 if (incr > 0)
8391 tool_bar_items_vector = larger_vector (tool_bar_items_vector, incr, -1);
8393 /* Append entries from tool_bar_item_properties to the end of
8394 tool_bar_items_vector. */
8395 vcopy (tool_bar_items_vector, ntool_bar_items,
8396 XVECTOR (tool_bar_item_properties)->contents, TOOL_BAR_ITEM_NSLOTS);
8397 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
8404 /* Read a character using menus based on the keymap MAP.
8405 Return nil if there are no menus in the maps.
8406 Return t if we displayed a menu but the user rejected it.
8408 PREV_EVENT is the previous input event, or nil if we are reading
8409 the first event of a key sequence.
8411 If USED_MOUSE_MENU is non-null, set *USED_MOUSE_MENU to true
8412 if we used a mouse menu to read the input, or false otherwise. If
8413 USED_MOUSE_MENU is null, don't dereference it.
8415 The prompting is done based on the prompt-string of the map
8416 and the strings associated with various map elements.
8418 This can be done with X menus or with menus put in the minibuf.
8419 These are done in different ways, depending on how the input will be read.
8420 Menus using X are done after auto-saving in read-char, getting the input
8421 event from Fx_popup_menu; menus using the minibuf use read_char recursively
8422 and do auto-saving in the inner call of read_char. */
8424 static Lisp_Object
8425 read_char_x_menu_prompt (Lisp_Object map,
8426 Lisp_Object prev_event, bool *used_mouse_menu)
8428 if (used_mouse_menu)
8429 *used_mouse_menu = false;
8431 /* Use local over global Menu maps. */
8433 if (! menu_prompting)
8434 return Qnil;
8436 /* If we got to this point via a mouse click,
8437 use a real menu for mouse selection. */
8438 if (EVENT_HAS_PARAMETERS (prev_event)
8439 && !EQ (XCAR (prev_event), Qmenu_bar)
8440 && !EQ (XCAR (prev_event), Qtool_bar))
8442 /* Display the menu and get the selection. */
8443 Lisp_Object value;
8445 value = Fx_popup_menu (prev_event, get_keymap (map, 0, 1));
8446 if (CONSP (value))
8448 Lisp_Object tem;
8450 record_menu_key (XCAR (value));
8452 /* If we got multiple events, unread all but
8453 the first.
8454 There is no way to prevent those unread events
8455 from showing up later in last_nonmenu_event.
8456 So turn symbol and integer events into lists,
8457 to indicate that they came from a mouse menu,
8458 so that when present in last_nonmenu_event
8459 they won't confuse things. */
8460 for (tem = XCDR (value); CONSP (tem); tem = XCDR (tem))
8462 record_menu_key (XCAR (tem));
8463 if (SYMBOLP (XCAR (tem))
8464 || INTEGERP (XCAR (tem)))
8465 XSETCAR (tem, Fcons (XCAR (tem), Qdisabled));
8468 /* If we got more than one event, put all but the first
8469 onto this list to be read later.
8470 Return just the first event now. */
8471 Vunread_command_events
8472 = nconc2 (XCDR (value), Vunread_command_events);
8473 value = XCAR (value);
8475 else if (NILP (value))
8476 value = Qt;
8477 if (used_mouse_menu)
8478 *used_mouse_menu = true;
8479 return value;
8481 return Qnil ;
8484 static Lisp_Object
8485 read_char_minibuf_menu_prompt (int commandflag,
8486 Lisp_Object map)
8488 Lisp_Object name;
8489 ptrdiff_t nlength;
8490 /* FIXME: Use the minibuffer's frame width. */
8491 ptrdiff_t width = FRAME_COLS (SELECTED_FRAME ()) - 4;
8492 ptrdiff_t idx = -1;
8493 bool nobindings = true;
8494 Lisp_Object rest, vector;
8495 Lisp_Object prompt_strings = Qnil;
8497 vector = Qnil;
8499 if (! menu_prompting)
8500 return Qnil;
8502 map = get_keymap (map, 0, 1);
8503 name = Fkeymap_prompt (map);
8505 /* If we don't have any menus, just read a character normally. */
8506 if (!STRINGP (name))
8507 return Qnil;
8509 #define PUSH_C_STR(str, listvar) \
8510 listvar = Fcons (build_unibyte_string (str), listvar)
8512 /* Prompt string always starts with map's prompt, and a space. */
8513 prompt_strings = Fcons (name, prompt_strings);
8514 PUSH_C_STR (": ", prompt_strings);
8515 nlength = SCHARS (name) + 2;
8517 rest = map;
8519 /* Present the documented bindings, a line at a time. */
8520 while (1)
8522 bool notfirst = false;
8523 Lisp_Object menu_strings = prompt_strings;
8524 ptrdiff_t i = nlength;
8525 Lisp_Object obj;
8526 Lisp_Object orig_defn_macro;
8528 /* Loop over elements of map. */
8529 while (i < width)
8531 Lisp_Object elt;
8533 /* FIXME: Use map_keymap to handle new keymap formats. */
8535 /* At end of map, wrap around if just starting,
8536 or end this line if already have something on it. */
8537 if (NILP (rest))
8539 if (notfirst || nobindings)
8540 break;
8541 else
8542 rest = map;
8545 /* Look at the next element of the map. */
8546 if (idx >= 0)
8547 elt = AREF (vector, idx);
8548 else
8549 elt = Fcar_safe (rest);
8551 if (idx < 0 && VECTORP (elt))
8553 /* If we found a dense table in the keymap,
8554 advanced past it, but start scanning its contents. */
8555 rest = Fcdr_safe (rest);
8556 vector = elt;
8557 idx = 0;
8559 else
8561 /* An ordinary element. */
8562 Lisp_Object event, tem;
8564 if (idx < 0)
8566 event = Fcar_safe (elt); /* alist */
8567 elt = Fcdr_safe (elt);
8569 else
8571 XSETINT (event, idx); /* vector */
8574 /* Ignore the element if it has no prompt string. */
8575 if (INTEGERP (event) && parse_menu_item (elt, -1))
8577 /* True if the char to type matches the string. */
8578 bool char_matches;
8579 Lisp_Object upcased_event, downcased_event;
8580 Lisp_Object desc = Qnil;
8581 Lisp_Object s
8582 = AREF (item_properties, ITEM_PROPERTY_NAME);
8584 upcased_event = Fupcase (event);
8585 downcased_event = Fdowncase (event);
8586 char_matches = (XINT (upcased_event) == SREF (s, 0)
8587 || XINT (downcased_event) == SREF (s, 0));
8588 if (! char_matches)
8589 desc = Fsingle_key_description (event, Qnil);
8591 #if 0 /* It is redundant to list the equivalent key bindings because
8592 the prefix is what the user has already typed. */
8594 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
8595 if (!NILP (tem))
8596 /* Insert equivalent keybinding. */
8597 s = concat2 (s, tem);
8598 #endif
8600 = AREF (item_properties, ITEM_PROPERTY_TYPE);
8601 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
8603 /* Insert button prefix. */
8604 Lisp_Object selected
8605 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
8606 AUTO_STRING (radio_yes, "(*) ");
8607 AUTO_STRING (radio_no , "( ) ");
8608 AUTO_STRING (check_yes, "[X] ");
8609 AUTO_STRING (check_no , "[ ] ");
8610 if (EQ (tem, QCradio))
8611 tem = NILP (selected) ? radio_yes : radio_no;
8612 else
8613 tem = NILP (selected) ? check_yes : check_no;
8614 s = concat2 (tem, s);
8618 /* If we have room for the prompt string, add it to this line.
8619 If this is the first on the line, always add it. */
8620 if ((SCHARS (s) + i + 2
8621 + (char_matches ? 0 : SCHARS (desc) + 3))
8622 < width
8623 || !notfirst)
8625 ptrdiff_t thiswidth;
8627 /* Punctuate between strings. */
8628 if (notfirst)
8630 PUSH_C_STR (", ", menu_strings);
8631 i += 2;
8633 notfirst = true;
8634 nobindings = false;
8636 /* If the char to type doesn't match the string's
8637 first char, explicitly show what char to type. */
8638 if (! char_matches)
8640 /* Add as much of string as fits. */
8641 thiswidth = min (SCHARS (desc), width - i);
8642 menu_strings
8643 = Fcons (Fsubstring (desc, make_number (0),
8644 make_number (thiswidth)),
8645 menu_strings);
8646 i += thiswidth;
8647 PUSH_C_STR (" = ", menu_strings);
8648 i += 3;
8651 /* Add as much of string as fits. */
8652 thiswidth = min (SCHARS (s), width - i);
8653 menu_strings
8654 = Fcons (Fsubstring (s, make_number (0),
8655 make_number (thiswidth)),
8656 menu_strings);
8657 i += thiswidth;
8659 else
8661 /* If this element does not fit, end the line now,
8662 and save the element for the next line. */
8663 PUSH_C_STR ("...", menu_strings);
8664 break;
8668 /* Move past this element. */
8669 if (idx >= 0 && idx + 1 >= ASIZE (vector))
8670 /* Handle reaching end of dense table. */
8671 idx = -1;
8672 if (idx >= 0)
8673 idx++;
8674 else
8675 rest = Fcdr_safe (rest);
8679 /* Prompt with that and read response. */
8680 message3_nolog (apply1 (intern ("concat"), Fnreverse (menu_strings)));
8682 /* Make believe it's not a keyboard macro in case the help char
8683 is pressed. Help characters are not recorded because menu prompting
8684 is not used on replay. */
8685 orig_defn_macro = KVAR (current_kboard, defining_kbd_macro);
8686 kset_defining_kbd_macro (current_kboard, Qnil);
8688 obj = read_char (commandflag, Qnil, Qt, 0, NULL);
8689 while (BUFFERP (obj));
8690 kset_defining_kbd_macro (current_kboard, orig_defn_macro);
8692 if (!INTEGERP (obj) || XINT (obj) == -2
8693 || (! EQ (obj, menu_prompt_more_char)
8694 && (!INTEGERP (menu_prompt_more_char)
8695 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char)))))))
8697 if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
8698 store_kbd_macro_char (obj);
8699 return obj;
8701 /* Help char - go round again. */
8705 /* Reading key sequences. */
8707 static Lisp_Object
8708 follow_key (Lisp_Object keymap, Lisp_Object key)
8710 return access_keymap (get_keymap (keymap, 0, 1),
8711 key, 1, 0, 1);
8714 static Lisp_Object
8715 active_maps (Lisp_Object first_event)
8717 Lisp_Object position
8718 = CONSP (first_event) ? CAR_SAFE (XCDR (first_event)) : Qnil;
8719 return Fcons (Qkeymap, Fcurrent_active_maps (Qt, position));
8722 /* Structure used to keep track of partial application of key remapping
8723 such as Vfunction_key_map and Vkey_translation_map. */
8724 typedef struct keyremap
8726 /* This is the map originally specified for this use. */
8727 Lisp_Object parent;
8728 /* This is a submap reached by looking up, in PARENT,
8729 the events from START to END. */
8730 Lisp_Object map;
8731 /* Positions [START, END) in the key sequence buffer
8732 are the key that we have scanned so far.
8733 Those events are the ones that we will replace
8734 if PARENT maps them into a key sequence. */
8735 int start, end;
8736 } keyremap;
8738 /* Lookup KEY in MAP.
8739 MAP is a keymap mapping keys to key vectors or functions.
8740 If the mapping is a function and DO_FUNCALL is true,
8741 the function is called with PROMPT as parameter and its return
8742 value is used as the return value of this function (after checking
8743 that it is indeed a vector). */
8745 static Lisp_Object
8746 access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
8747 bool do_funcall)
8749 Lisp_Object next;
8751 next = access_keymap (map, key, 1, 0, 1);
8753 /* Handle a symbol whose function definition is a keymap
8754 or an array. */
8755 if (SYMBOLP (next) && !NILP (Ffboundp (next))
8756 && (ARRAYP (XSYMBOL (next)->function)
8757 || KEYMAPP (XSYMBOL (next)->function)))
8758 next = Fautoload_do_load (XSYMBOL (next)->function, next, Qnil);
8760 /* If the keymap gives a function, not an
8761 array, then call the function with one arg and use
8762 its value instead. */
8763 if (do_funcall && FUNCTIONP (next))
8765 Lisp_Object tem;
8766 tem = next;
8768 next = call1 (next, prompt);
8769 /* If the function returned something invalid,
8770 barf--don't ignore it. */
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 UNINIT;
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 = false;
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 UNINIT;
8956 int original_uppercase_position = -1;
8958 /* Gets around Microsoft compiler limitations. */
8959 bool dummyflag = false;
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 raw_keybuf_count = 0;
8968 last_nonmenu_event = Qnil;
8970 delayed_switch_frame = Qnil;
8972 if (INTERACTIVE)
8974 if (!NILP (prompt))
8976 /* Install the string PROMPT as the beginning of the string
8977 of echoing, so that it serves as a prompt for the next
8978 character. */
8979 kset_echo_prompt (current_kboard, prompt);
8980 /* FIXME: This use of echo_now doesn't look quite right and is ugly
8981 since it forces us to fiddle with current_kboard->immediate_echo
8982 before and after. */
8983 current_kboard->immediate_echo = false;
8984 echo_now ();
8985 if (!echo_keystrokes_p ())
8986 current_kboard->immediate_echo = false;
8988 else if (cursor_in_echo_area /* FIXME: Not sure why we test this here,
8989 maybe we should just drop this test. */
8990 && echo_keystrokes_p ())
8991 /* This doesn't put in a dash if the echo buffer is empty, so
8992 you don't always see a dash hanging out in the minibuffer. */
8993 echo_dash ();
8996 /* Record the initial state of the echo area and this_command_keys;
8997 we will need to restore them if we replay a key sequence. */
8998 if (INTERACTIVE)
8999 echo_start = echo_length ();
9000 keys_start = this_command_key_count;
9001 this_single_command_key_start = keys_start;
9003 /* We jump here when we need to reinitialize fkey and keytran; this
9004 happens if we switch keyboards between rescans. */
9005 replay_entire_sequence:
9007 indec.map = indec.parent = KVAR (current_kboard, Vinput_decode_map);
9008 fkey.map = fkey.parent = KVAR (current_kboard, Vlocal_function_key_map);
9009 keytran.map = keytran.parent = Vkey_translation_map;
9010 indec.start = indec.end = 0;
9011 fkey.start = fkey.end = 0;
9012 keytran.start = keytran.end = 0;
9014 /* We jump here when the key sequence has been thoroughly changed, and
9015 we need to rescan it starting from the beginning. When we jump here,
9016 keybuf[0..mock_input] holds the sequence we should reread. */
9017 replay_sequence:
9019 starting_buffer = current_buffer;
9020 first_unbound = bufsize + 1;
9022 /* Build our list of keymaps.
9023 If we recognize a function key and replace its escape sequence in
9024 keybuf with its symbol, or if the sequence starts with a mouse
9025 click and we need to switch buffers, we jump back here to rebuild
9026 the initial keymaps from the current buffer. */
9027 current_binding = active_maps (first_event);
9029 /* Start from the beginning in keybuf. */
9030 t = 0;
9032 /* These are no-ops the first time through, but if we restart, they
9033 revert the echo area and this_command_keys to their original state. */
9034 this_command_key_count = keys_start;
9035 if (INTERACTIVE && t < mock_input)
9036 echo_truncate (echo_start);
9038 /* If the best binding for the current key sequence is a keymap, or
9039 we may be looking at a function key's escape sequence, keep on
9040 reading. */
9041 while (!NILP (current_binding)
9042 /* Keep reading as long as there's a prefix binding. */
9043 ? KEYMAPP (current_binding)
9044 /* Don't return in the middle of a possible function key sequence,
9045 if the only bindings we found were via case conversion.
9046 Thus, if ESC O a has a function-key-map translation
9047 and ESC o has a binding, don't return after ESC O,
9048 so that we can translate ESC O plus the next character. */
9049 : (/* indec.start < t || fkey.start < t || */ keytran.start < t))
9051 Lisp_Object key;
9052 bool used_mouse_menu = false;
9054 /* Where the last real key started. If we need to throw away a
9055 key that has expanded into more than one element of keybuf
9056 (say, a mouse click on the mode line which is being treated
9057 as [mode-line (mouse-...)], then we backtrack to this point
9058 of keybuf. */
9059 int last_real_key_start;
9061 /* These variables are analogous to echo_start and keys_start;
9062 while those allow us to restart the entire key sequence,
9063 echo_local_start and keys_local_start allow us to throw away
9064 just one key. */
9065 ptrdiff_t echo_local_start UNINIT;
9066 int keys_local_start;
9067 Lisp_Object new_binding;
9069 eassert (indec.end == t || (indec.end > t && indec.end <= mock_input));
9070 eassert (indec.start <= indec.end);
9071 eassert (fkey.start <= fkey.end);
9072 eassert (keytran.start <= keytran.end);
9073 /* key-translation-map is applied *after* function-key-map
9074 which is itself applied *after* input-decode-map. */
9075 eassert (fkey.end <= indec.start);
9076 eassert (keytran.end <= fkey.start);
9078 if (/* first_unbound < indec.start && first_unbound < fkey.start && */
9079 first_unbound < keytran.start)
9080 { /* The prefix upto first_unbound has no binding and has
9081 no translation left to do either, so we know it's unbound.
9082 If we don't stop now, we risk staying here indefinitely
9083 (if the user keeps entering fkey or keytran prefixes
9084 like C-c ESC ESC ESC ESC ...) */
9085 int i;
9086 for (i = first_unbound + 1; i < t; i++)
9087 keybuf[i - first_unbound - 1] = keybuf[i];
9088 mock_input = t - first_unbound - 1;
9089 indec.end = indec.start -= first_unbound + 1;
9090 indec.map = indec.parent;
9091 fkey.end = fkey.start -= first_unbound + 1;
9092 fkey.map = fkey.parent;
9093 keytran.end = keytran.start -= first_unbound + 1;
9094 keytran.map = keytran.parent;
9095 goto replay_sequence;
9098 if (t >= bufsize)
9099 error ("Key sequence too long");
9101 if (INTERACTIVE)
9102 echo_local_start = echo_length ();
9103 keys_local_start = this_command_key_count;
9105 replay_key:
9106 /* These are no-ops, unless we throw away a keystroke below and
9107 jumped back up to replay_key; in that case, these restore the
9108 variables to their original state, allowing us to replay the
9109 loop. */
9110 if (INTERACTIVE && t < mock_input)
9111 echo_truncate (echo_local_start);
9112 this_command_key_count = keys_local_start;
9114 /* By default, assume each event is "real". */
9115 last_real_key_start = t;
9117 /* Does mock_input indicate that we are re-reading a key sequence? */
9118 if (t < mock_input)
9120 key = keybuf[t];
9121 add_command_key (key);
9122 if (current_kboard->immediate_echo)
9124 /* Set immediate_echo to false so as to force echo_now to
9125 redisplay (it will set immediate_echo right back to true). */
9126 current_kboard->immediate_echo = false;
9127 echo_now ();
9131 /* If not, we should actually read a character. */
9132 else
9135 KBOARD *interrupted_kboard = current_kboard;
9136 struct frame *interrupted_frame = SELECTED_FRAME ();
9137 /* Calling read_char with COMMANDFLAG = -2 avoids
9138 redisplay in read_char and its subroutines. */
9139 key = read_char (prevent_redisplay ? -2 : NILP (prompt),
9140 current_binding, last_nonmenu_event,
9141 &used_mouse_menu, NULL);
9142 if ((INTEGERP (key) && XINT (key) == -2) /* wrong_kboard_jmpbuf */
9143 /* When switching to a new tty (with a new keyboard),
9144 read_char returns the new buffer, rather than -2
9145 (Bug#5095). This is because `terminal-init-xterm'
9146 calls read-char, which eats the wrong_kboard_jmpbuf
9147 return. Any better way to fix this? -- cyd */
9148 || (interrupted_kboard != current_kboard))
9150 bool found = false;
9151 struct kboard *k;
9153 for (k = all_kboards; k; k = k->next_kboard)
9154 if (k == interrupted_kboard)
9155 found = true;
9157 if (!found)
9159 /* Don't touch interrupted_kboard when it's been
9160 deleted. */
9161 delayed_switch_frame = Qnil;
9162 goto replay_entire_sequence;
9165 if (!NILP (delayed_switch_frame))
9167 kset_kbd_queue
9168 (interrupted_kboard,
9169 Fcons (delayed_switch_frame,
9170 KVAR (interrupted_kboard, kbd_queue)));
9171 delayed_switch_frame = Qnil;
9174 while (t > 0)
9175 kset_kbd_queue
9176 (interrupted_kboard,
9177 Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue)));
9179 /* If the side queue is non-empty, ensure it begins with a
9180 switch-frame, so we'll replay it in the right context. */
9181 if (CONSP (KVAR (interrupted_kboard, kbd_queue))
9182 && (key = XCAR (KVAR (interrupted_kboard, kbd_queue)),
9183 !(EVENT_HAS_PARAMETERS (key)
9184 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
9185 Qswitch_frame))))
9187 Lisp_Object frame;
9188 XSETFRAME (frame, interrupted_frame);
9189 kset_kbd_queue
9190 (interrupted_kboard,
9191 Fcons (make_lispy_switch_frame (frame),
9192 KVAR (interrupted_kboard, kbd_queue)));
9194 mock_input = 0;
9195 goto replay_entire_sequence;
9199 /* read_char returns t when it shows a menu and the user rejects it.
9200 Just return -1. */
9201 if (EQ (key, Qt))
9203 unbind_to (count, Qnil);
9204 return -1;
9207 /* read_char returns -1 at the end of a macro.
9208 Emacs 18 handles this by returning immediately with a
9209 zero, so that's what we'll do. */
9210 if (INTEGERP (key) && XINT (key) == -1)
9212 t = 0;
9213 /* The Microsoft C compiler can't handle the goto that
9214 would go here. */
9215 dummyflag = true;
9216 break;
9219 /* If the current buffer has been changed from under us, the
9220 keymap may have changed, so replay the sequence. */
9221 if (BUFFERP (key))
9223 timer_resume_idle ();
9225 mock_input = t;
9226 /* Reset the current buffer from the selected window
9227 in case something changed the former and not the latter.
9228 This is to be more consistent with the behavior
9229 of the command_loop_1. */
9230 if (fix_current_buffer)
9232 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
9233 Fkill_emacs (Qnil);
9234 if (XBUFFER (XWINDOW (selected_window)->contents)
9235 != current_buffer)
9236 Fset_buffer (XWINDOW (selected_window)->contents);
9239 goto replay_sequence;
9242 /* If we have a quit that was typed in another frame, and
9243 quit_throw_to_read_char switched buffers,
9244 replay to get the right keymap. */
9245 if (INTEGERP (key)
9246 && XINT (key) == quit_char
9247 && current_buffer != starting_buffer)
9249 GROW_RAW_KEYBUF;
9250 ASET (raw_keybuf, raw_keybuf_count, key);
9251 raw_keybuf_count++;
9252 keybuf[t++] = key;
9253 mock_input = t;
9254 Vquit_flag = Qnil;
9255 goto replay_sequence;
9258 Vquit_flag = Qnil;
9260 if (EVENT_HAS_PARAMETERS (key)
9261 /* Either a `switch-frame' or a `select-window' event. */
9262 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
9264 /* If we're at the beginning of a key sequence, and the caller
9265 says it's okay, go ahead and return this event. If we're
9266 in the midst of a key sequence, delay it until the end. */
9267 if (t > 0 || !can_return_switch_frame)
9269 delayed_switch_frame = key;
9270 goto replay_key;
9274 if (NILP (first_event))
9276 first_event = key;
9277 /* Even if first_event does not specify a particular
9278 window/position, it's important to recompute the maps here
9279 since a long time might have passed since we entered
9280 read_key_sequence, and a timer (or process-filter or
9281 special-event-map, ...) might have switched the current buffer
9282 or the selected window from under us in the mean time. */
9283 if (fix_current_buffer
9284 && (XBUFFER (XWINDOW (selected_window)->contents)
9285 != current_buffer))
9286 Fset_buffer (XWINDOW (selected_window)->contents);
9287 current_binding = active_maps (first_event);
9290 GROW_RAW_KEYBUF;
9291 ASET (raw_keybuf, raw_keybuf_count, key);
9292 raw_keybuf_count++;
9295 /* Clicks in non-text areas get prefixed by the symbol
9296 in their CHAR-ADDRESS field. For example, a click on
9297 the mode line is prefixed by the symbol `mode-line'.
9299 Furthermore, key sequences beginning with mouse clicks
9300 are read using the keymaps of the buffer clicked on, not
9301 the current buffer. So we may have to switch the buffer
9302 here.
9304 When we turn one event into two events, we must make sure
9305 that neither of the two looks like the original--so that,
9306 if we replay the events, they won't be expanded again.
9307 If not for this, such reexpansion could happen either here
9308 or when user programs play with this-command-keys. */
9309 if (EVENT_HAS_PARAMETERS (key))
9311 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
9312 if (EQ (kind, Qmouse_click))
9314 Lisp_Object window = POSN_WINDOW (EVENT_START (key));
9315 Lisp_Object posn = POSN_POSN (EVENT_START (key));
9317 if (CONSP (posn)
9318 || (!NILP (fake_prefixed_keys)
9319 && !NILP (Fmemq (key, fake_prefixed_keys))))
9321 /* We're looking a second time at an event for which
9322 we generated a fake prefix key. Set
9323 last_real_key_start appropriately. */
9324 if (t > 0)
9325 last_real_key_start = t - 1;
9328 if (last_real_key_start == 0)
9330 /* Key sequences beginning with mouse clicks are
9331 read using the keymaps in the buffer clicked on,
9332 not the current buffer. If we're at the
9333 beginning of a key sequence, switch buffers. */
9334 if (WINDOWP (window)
9335 && BUFFERP (XWINDOW (window)->contents)
9336 && XBUFFER (XWINDOW (window)->contents) != current_buffer)
9338 ASET (raw_keybuf, raw_keybuf_count, key);
9339 raw_keybuf_count++;
9340 keybuf[t] = key;
9341 mock_input = t + 1;
9343 /* Arrange to go back to the original buffer once we're
9344 done reading the key sequence. Note that we can't
9345 use save_excursion_{save,restore} here, because they
9346 save point as well as the current buffer; we don't
9347 want to save point, because redisplay may change it,
9348 to accommodate a Fset_window_start or something. We
9349 don't want to do this at the top of the function,
9350 because we may get input from a subprocess which
9351 wants to change the selected window and stuff (say,
9352 emacsclient). */
9353 record_unwind_current_buffer ();
9355 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
9356 Fkill_emacs (Qnil);
9357 set_buffer_internal (XBUFFER (XWINDOW (window)->contents));
9358 goto replay_sequence;
9362 /* Expand mode-line and scroll-bar events into two events:
9363 use posn as a fake prefix key. */
9364 if (SYMBOLP (posn)
9365 && (NILP (fake_prefixed_keys)
9366 || NILP (Fmemq (key, fake_prefixed_keys))))
9368 if (bufsize - t <= 1)
9369 error ("Key sequence too long");
9371 keybuf[t] = posn;
9372 keybuf[t + 1] = key;
9373 mock_input = t + 2;
9375 /* Record that a fake prefix key has been generated
9376 for KEY. Don't modify the event; this would
9377 prevent proper action when the event is pushed
9378 back into unread-command-events. */
9379 fake_prefixed_keys = Fcons (key, fake_prefixed_keys);
9380 goto replay_key;
9383 else if (CONSP (XCDR (key))
9384 && CONSP (EVENT_START (key))
9385 && CONSP (XCDR (EVENT_START (key))))
9387 Lisp_Object posn;
9389 posn = POSN_POSN (EVENT_START (key));
9390 /* Handle menu-bar events:
9391 insert the dummy prefix event `menu-bar'. */
9392 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
9394 if (bufsize - t <= 1)
9395 error ("Key sequence too long");
9396 keybuf[t] = posn;
9397 keybuf[t + 1] = key;
9399 /* Zap the position in key, so we know that we've
9400 expanded it, and don't try to do so again. */
9401 POSN_SET_POSN (EVENT_START (key), list1 (posn));
9403 mock_input = t + 2;
9404 goto replay_sequence;
9406 else if (CONSP (posn))
9408 /* We're looking at the second event of a
9409 sequence which we expanded before. Set
9410 last_real_key_start appropriately. */
9411 if (last_real_key_start == t && t > 0)
9412 last_real_key_start = t - 1;
9417 /* We have finally decided that KEY is something we might want
9418 to look up. */
9419 new_binding = follow_key (current_binding, key);
9421 /* If KEY wasn't bound, we'll try some fallbacks. */
9422 if (!NILP (new_binding))
9423 /* This is needed for the following scenario:
9424 event 0: a down-event that gets dropped by calling replay_key.
9425 event 1: some normal prefix like C-h.
9426 After event 0, first_unbound is 0, after event 1 indec.start,
9427 fkey.start, and keytran.start are all 1, so when we see that
9428 C-h is bound, we need to update first_unbound. */
9429 first_unbound = max (t + 1, first_unbound);
9430 else
9432 Lisp_Object head;
9434 /* Remember the position to put an upper bound on indec.start. */
9435 first_unbound = min (t, first_unbound);
9437 head = EVENT_HEAD (key);
9439 if (SYMBOLP (head))
9441 Lisp_Object breakdown;
9442 int modifiers;
9444 breakdown = parse_modifiers (head);
9445 modifiers = XINT (XCAR (XCDR (breakdown)));
9446 /* Attempt to reduce an unbound mouse event to a simpler
9447 event that is bound:
9448 Drags reduce to clicks.
9449 Double-clicks reduce to clicks.
9450 Triple-clicks reduce to double-clicks, then to clicks.
9451 Up/Down-clicks are eliminated.
9452 Double-downs reduce to downs, then are eliminated.
9453 Triple-downs reduce to double-downs, then to downs,
9454 then are eliminated. */
9455 if (modifiers & (up_modifier | down_modifier
9456 | drag_modifier
9457 | double_modifier | triple_modifier))
9459 while (modifiers & (up_modifier | down_modifier
9460 | drag_modifier
9461 | double_modifier | triple_modifier))
9463 Lisp_Object new_head, new_click;
9464 if (modifiers & triple_modifier)
9465 modifiers ^= (double_modifier | triple_modifier);
9466 else if (modifiers & double_modifier)
9467 modifiers &= ~double_modifier;
9468 else if (modifiers & drag_modifier)
9469 modifiers &= ~drag_modifier;
9470 else
9472 /* Dispose of this `up/down' event by simply jumping
9473 back to replay_key, to get another event.
9475 Note that if this event came from mock input,
9476 then just jumping back to replay_key will just
9477 hand it to us again. So we have to wipe out any
9478 mock input.
9480 We could delete keybuf[t] and shift everything
9481 after that to the left by one spot, but we'd also
9482 have to fix up any variable that points into
9483 keybuf, and shifting isn't really necessary
9484 anyway.
9486 Adding prefixes for non-textual mouse clicks
9487 creates two characters of mock input, and both
9488 must be thrown away. If we're only looking at
9489 the prefix now, we can just jump back to
9490 replay_key. On the other hand, if we've already
9491 processed the prefix, and now the actual click
9492 itself is giving us trouble, then we've lost the
9493 state of the keymaps we want to backtrack to, and
9494 we need to replay the whole sequence to rebuild
9497 Beyond that, only function key expansion could
9498 create more than two keys, but that should never
9499 generate mouse events, so it's okay to zero
9500 mock_input in that case too.
9502 FIXME: The above paragraph seems just plain
9503 wrong, if you consider things like
9504 xterm-mouse-mode. -stef
9506 Isn't this just the most wonderful code ever? */
9508 /* If mock_input > t + 1, the above simplification
9509 will actually end up dropping keys on the floor.
9510 This is probably OK for now, but even
9511 if mock_input <= t + 1, we need to adjust indec,
9512 fkey, and keytran.
9513 Typical case [header-line down-mouse-N]:
9514 mock_input = 2, t = 1, fkey.end = 1,
9515 last_real_key_start = 0. */
9516 if (indec.end > last_real_key_start)
9518 indec.end = indec.start
9519 = min (last_real_key_start, indec.start);
9520 indec.map = indec.parent;
9521 if (fkey.end > last_real_key_start)
9523 fkey.end = fkey.start
9524 = min (last_real_key_start, fkey.start);
9525 fkey.map = fkey.parent;
9526 if (keytran.end > last_real_key_start)
9528 keytran.end = keytran.start
9529 = min (last_real_key_start, keytran.start);
9530 keytran.map = keytran.parent;
9534 if (t == last_real_key_start)
9536 mock_input = 0;
9537 goto replay_key;
9539 else
9541 mock_input = last_real_key_start;
9542 goto replay_sequence;
9546 new_head
9547 = apply_modifiers (modifiers, XCAR (breakdown));
9548 new_click = list2 (new_head, EVENT_START (key));
9550 /* Look for a binding for this new key. */
9551 new_binding = follow_key (current_binding, new_click);
9553 /* If that click is bound, go for it. */
9554 if (!NILP (new_binding))
9556 current_binding = new_binding;
9557 key = new_click;
9558 break;
9560 /* Otherwise, we'll leave key set to the drag event. */
9565 current_binding = new_binding;
9567 keybuf[t++] = key;
9568 /* Normally, last_nonmenu_event gets the previous key we read.
9569 But when a mouse popup menu is being used,
9570 we don't update last_nonmenu_event; it continues to hold the mouse
9571 event that preceded the first level of menu. */
9572 if (!used_mouse_menu)
9573 last_nonmenu_event = key;
9575 /* Record what part of this_command_keys is the current key sequence. */
9576 this_single_command_key_start = this_command_key_count - t;
9577 /* When 'input-method-function' called above causes events to be
9578 put on 'unread-post-input-method-events', and as result
9579 'reread' is set to 'true', the value of 't' can become larger
9580 than 'this_command_key_count', because 'add_command_key' is
9581 not called to update 'this_command_key_count'. If this
9582 happens, 'this_single_command_key_start' will become negative
9583 above, and any call to 'this-single-command-keys' will return
9584 a garbled vector. See bug #20223 for one such situation.
9585 Here we force 'this_single_command_key_start' to never become
9586 negative, to avoid that. */
9587 if (this_single_command_key_start < 0)
9588 this_single_command_key_start = 0;
9590 /* Look for this sequence in input-decode-map.
9591 Scan from indec.end until we find a bound suffix. */
9592 while (indec.end < t)
9594 bool done;
9595 int diff;
9597 done = keyremap_step (keybuf, bufsize, &indec, max (t, mock_input),
9598 1, &diff, prompt);
9599 if (done)
9601 mock_input = diff + max (t, mock_input);
9602 goto replay_sequence;
9606 if (!KEYMAPP (current_binding)
9607 && !test_undefined (current_binding)
9608 && indec.start >= t)
9609 /* There is a binding and it's not a prefix.
9610 (and it doesn't have any input-decode-map translation pending).
9611 There is thus no function-key in this sequence.
9612 Moving fkey.start is important in this case to allow keytran.start
9613 to go over the sequence before we return (since we keep the
9614 invariant that keytran.end <= fkey.start). */
9616 if (fkey.start < t)
9617 (fkey.start = fkey.end = t, fkey.map = fkey.parent);
9619 else
9620 /* If the sequence is unbound, see if we can hang a function key
9621 off the end of it. */
9622 /* Continue scan from fkey.end until we find a bound suffix. */
9623 while (fkey.end < indec.start)
9625 bool done;
9626 int diff;
9628 done = keyremap_step (keybuf, bufsize, &fkey,
9629 max (t, mock_input),
9630 /* If there's a binding (i.e.
9631 first_binding >= nmaps) we don't want
9632 to apply this function-key-mapping. */
9633 fkey.end + 1 == t
9634 && (test_undefined (current_binding)),
9635 &diff, prompt);
9636 if (done)
9638 mock_input = diff + max (t, mock_input);
9639 /* Adjust the input-decode-map counters. */
9640 indec.end += diff;
9641 indec.start += diff;
9643 goto replay_sequence;
9647 /* Look for this sequence in key-translation-map.
9648 Scan from keytran.end until we find a bound suffix. */
9649 while (keytran.end < fkey.start)
9651 bool done;
9652 int diff;
9654 done = keyremap_step (keybuf, bufsize, &keytran, max (t, mock_input),
9655 1, &diff, prompt);
9656 if (done)
9658 mock_input = diff + max (t, mock_input);
9659 /* Adjust the function-key-map and input-decode-map counters. */
9660 indec.end += diff;
9661 indec.start += diff;
9662 fkey.end += diff;
9663 fkey.start += diff;
9665 goto replay_sequence;
9669 /* If KEY is not defined in any of the keymaps,
9670 and cannot be part of a function key or translation,
9671 and is an upper case letter
9672 use the corresponding lower-case letter instead. */
9673 if (NILP (current_binding)
9674 && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t
9675 && INTEGERP (key)
9676 && ((CHARACTERP (make_number (XINT (key) & ~CHAR_MODIFIER_MASK))
9677 && uppercasep (XINT (key) & ~CHAR_MODIFIER_MASK))
9678 || (XINT (key) & shift_modifier)))
9680 Lisp_Object new_key;
9682 original_uppercase = key;
9683 original_uppercase_position = t - 1;
9685 if (XINT (key) & shift_modifier)
9686 XSETINT (new_key, XINT (key) & ~shift_modifier);
9687 else
9688 XSETINT (new_key, (downcase (XINT (key) & ~CHAR_MODIFIER_MASK)
9689 | (XINT (key) & CHAR_MODIFIER_MASK)));
9691 /* We have to do this unconditionally, regardless of whether
9692 the lower-case char is defined in the keymaps, because they
9693 might get translated through function-key-map. */
9694 keybuf[t - 1] = new_key;
9695 mock_input = max (t, mock_input);
9696 shift_translated = true;
9698 goto replay_sequence;
9701 if (NILP (current_binding)
9702 && help_char_p (EVENT_HEAD (key)) && t > 1)
9704 read_key_sequence_cmd = Vprefix_help_command;
9705 /* The Microsoft C compiler can't handle the goto that
9706 would go here. */
9707 dummyflag = true;
9708 break;
9711 /* If KEY is not defined in any of the keymaps,
9712 and cannot be part of a function key or translation,
9713 and is a shifted function key,
9714 use the corresponding unshifted function key instead. */
9715 if (NILP (current_binding)
9716 && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t)
9718 Lisp_Object breakdown = parse_modifiers (key);
9719 int modifiers
9720 = CONSP (breakdown) ? (XINT (XCAR (XCDR (breakdown)))) : 0;
9722 if (modifiers & shift_modifier
9723 /* Treat uppercase keys as shifted. */
9724 || (INTEGERP (key)
9725 && (KEY_TO_CHAR (key)
9726 < XCHAR_TABLE (BVAR (current_buffer, downcase_table))->header.size)
9727 && uppercasep (KEY_TO_CHAR (key))))
9729 Lisp_Object new_key
9730 = (modifiers & shift_modifier
9731 ? apply_modifiers (modifiers & ~shift_modifier,
9732 XCAR (breakdown))
9733 : make_number (downcase (KEY_TO_CHAR (key)) | modifiers));
9735 original_uppercase = key;
9736 original_uppercase_position = t - 1;
9738 /* We have to do this unconditionally, regardless of whether
9739 the lower-case char is defined in the keymaps, because they
9740 might get translated through function-key-map. */
9741 keybuf[t - 1] = new_key;
9742 mock_input = max (t, mock_input);
9743 /* Reset fkey (and consequently keytran) to apply
9744 function-key-map on the result, so that S-backspace is
9745 correctly mapped to DEL (via backspace). OTOH,
9746 input-decode-map doesn't need to go through it again. */
9747 fkey.start = fkey.end = 0;
9748 keytran.start = keytran.end = 0;
9749 shift_translated = true;
9751 goto replay_sequence;
9755 if (!dummyflag)
9756 read_key_sequence_cmd = current_binding;
9757 read_key_sequence_remapped
9758 /* Remap command through active keymaps.
9759 Do the remapping here, before the unbind_to so it uses the keymaps
9760 of the appropriate buffer. */
9761 = SYMBOLP (read_key_sequence_cmd)
9762 ? Fcommand_remapping (read_key_sequence_cmd, Qnil, Qnil)
9763 : Qnil;
9765 unread_switch_frame = delayed_switch_frame;
9766 unbind_to (count, Qnil);
9768 /* Don't downcase the last character if the caller says don't.
9769 Don't downcase it if the result is undefined, either. */
9770 if ((dont_downcase_last || NILP (current_binding))
9771 && t > 0
9772 && t - 1 == original_uppercase_position)
9774 keybuf[t - 1] = original_uppercase;
9775 shift_translated = false;
9778 if (shift_translated)
9779 Vthis_command_keys_shift_translated = Qt;
9781 /* Occasionally we fabricate events, perhaps by expanding something
9782 according to function-key-map, or by adding a prefix symbol to a
9783 mouse click in the scroll bar or modeline. In this cases, return
9784 the entire generated key sequence, even if we hit an unbound
9785 prefix or a definition before the end. This means that you will
9786 be able to push back the event properly, and also means that
9787 read-key-sequence will always return a logical unit.
9789 Better ideas? */
9790 for (; t < mock_input; t++)
9791 add_command_key (keybuf[t]);
9792 echo_update ();
9794 return t;
9797 static Lisp_Object
9798 read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
9799 Lisp_Object dont_downcase_last,
9800 Lisp_Object can_return_switch_frame,
9801 Lisp_Object cmd_loop, bool allow_string)
9803 Lisp_Object keybuf[30];
9804 int i;
9805 ptrdiff_t count = SPECPDL_INDEX ();
9807 if (!NILP (prompt))
9808 CHECK_STRING (prompt);
9809 maybe_quit ();
9811 specbind (Qinput_method_exit_on_first_char,
9812 (NILP (cmd_loop) ? Qt : Qnil));
9813 specbind (Qinput_method_use_echo_area,
9814 (NILP (cmd_loop) ? Qt : Qnil));
9816 if (NILP (continue_echo))
9818 this_command_key_count = 0;
9819 this_single_command_key_start = 0;
9822 #ifdef HAVE_WINDOW_SYSTEM
9823 if (display_hourglass_p)
9824 cancel_hourglass ();
9825 #endif
9827 i = read_key_sequence (keybuf, ARRAYELTS (keybuf),
9828 prompt, ! NILP (dont_downcase_last),
9829 ! NILP (can_return_switch_frame), 0, 0);
9831 #if 0 /* The following is fine for code reading a key sequence and
9832 then proceeding with a lengthy computation, but it's not good
9833 for code reading keys in a loop, like an input method. */
9834 #ifdef HAVE_WINDOW_SYSTEM
9835 if (display_hourglass_p)
9836 start_hourglass ();
9837 #endif
9838 #endif
9840 if (i == -1)
9842 Vquit_flag = Qt;
9843 maybe_quit ();
9846 return unbind_to (count,
9847 ((allow_string ? make_event_array : Fvector)
9848 (i, keybuf)));
9851 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
9852 doc: /* Read a sequence of keystrokes and return as a string or vector.
9853 The sequence is sufficient to specify a non-prefix command in the
9854 current local and global maps.
9856 First arg PROMPT is a prompt string. If nil, do not prompt specially.
9857 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos
9858 as a continuation of the previous key.
9860 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
9861 convert the last event to lower case. (Normally any upper case event
9862 is converted to lower case if the original event is undefined and the lower
9863 case equivalent is defined.) A non-nil value is appropriate for reading
9864 a key sequence to be defined.
9866 A C-g typed while in this function is treated like any other character,
9867 and `quit-flag' is not set.
9869 If the key sequence starts with a mouse click, then the sequence is read
9870 using the keymaps of the buffer of the window clicked in, not the buffer
9871 of the selected window as normal.
9873 `read-key-sequence' drops unbound button-down events, since you normally
9874 only care about the click or drag events which follow them. If a drag
9875 or multi-click event is unbound, but the corresponding click event would
9876 be bound, `read-key-sequence' turns the event into a click event at the
9877 drag's starting position. This means that you don't have to distinguish
9878 between click and drag, double, or triple events unless you want to.
9880 `read-key-sequence' prefixes mouse events on mode lines, the vertical
9881 lines separating windows, and scroll bars with imaginary keys
9882 `mode-line', `vertical-line', and `vertical-scroll-bar'.
9884 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this
9885 function will process a switch-frame event if the user switches frames
9886 before typing anything. If the user switches frames in the middle of a
9887 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME
9888 is nil, then the event will be put off until after the current key sequence.
9890 `read-key-sequence' checks `function-key-map' for function key
9891 sequences, where they wouldn't conflict with ordinary bindings. See
9892 `function-key-map' for more details.
9894 The optional fifth argument CMD-LOOP, if non-nil, means
9895 that this key sequence is being read by something that will
9896 read commands one after another. It should be nil if the caller
9897 will read just one key sequence. */)
9898 (Lisp_Object prompt, Lisp_Object continue_echo, Lisp_Object dont_downcase_last, Lisp_Object can_return_switch_frame, Lisp_Object cmd_loop)
9900 return read_key_sequence_vs (prompt, continue_echo, dont_downcase_last,
9901 can_return_switch_frame, cmd_loop, true);
9904 DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
9905 Sread_key_sequence_vector, 1, 5, 0,
9906 doc: /* Like `read-key-sequence' but always return a vector. */)
9907 (Lisp_Object prompt, Lisp_Object continue_echo, Lisp_Object dont_downcase_last, Lisp_Object can_return_switch_frame, Lisp_Object cmd_loop)
9909 return read_key_sequence_vs (prompt, continue_echo, dont_downcase_last,
9910 can_return_switch_frame, cmd_loop, false);
9913 /* Return true if input events are pending. */
9915 bool
9916 detect_input_pending (void)
9918 return input_pending || get_input_pending (0);
9921 /* Return true if input events other than mouse movements are
9922 pending. */
9924 bool
9925 detect_input_pending_ignore_squeezables (void)
9927 return input_pending || get_input_pending (READABLE_EVENTS_IGNORE_SQUEEZABLES);
9930 /* Return true if input events are pending, and run any pending timers. */
9932 bool
9933 detect_input_pending_run_timers (bool do_display)
9935 unsigned old_timers_run = timers_run;
9937 if (!input_pending)
9938 get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
9940 if (old_timers_run != timers_run && do_display)
9941 redisplay_preserve_echo_area (8);
9943 return input_pending;
9946 /* This is called in some cases before a possible quit.
9947 It cases the next call to detect_input_pending to recompute input_pending.
9948 So calling this function unnecessarily can't do any harm. */
9950 void
9951 clear_input_pending (void)
9953 input_pending = false;
9956 /* Return true if there are pending requeued events.
9957 This isn't used yet. The hope is to make wait_reading_process_output
9958 call it, and return if it runs Lisp code that unreads something.
9959 The problem is, kbd_buffer_get_event needs to be fixed to know what
9960 to do in that case. It isn't trivial. */
9962 bool
9963 requeued_events_pending_p (void)
9965 return (CONSP (Vunread_command_events));
9968 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 1, 0,
9969 doc: /* Return t if command input is currently available with no wait.
9970 Actually, the value is nil only if we can be sure that no input is available;
9971 if there is a doubt, the value is t.
9973 If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */)
9974 (Lisp_Object check_timers)
9976 if (CONSP (Vunread_command_events)
9977 || !NILP (Vunread_post_input_method_events)
9978 || !NILP (Vunread_input_method_events))
9979 return (Qt);
9981 /* Process non-user-visible events (Bug#10195). */
9982 process_special_events ();
9984 return (get_input_pending ((NILP (check_timers)
9985 ? 0 : READABLE_EVENTS_DO_TIMERS_NOW)
9986 | READABLE_EVENTS_FILTER_EVENTS)
9987 ? Qt : Qnil);
9990 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 1, 0,
9991 doc: /* Return vector of last few events, not counting those from keyboard macros.
9992 If INCLUDE-CMDS is non-nil, include the commands that were run,
9993 represented as events of the form (nil . COMMAND). */)
9994 (Lisp_Object include_cmds)
9996 bool cmds = !NILP (include_cmds);
9998 if (!total_keys
9999 || (cmds && total_keys < NUM_RECENT_KEYS))
10000 return Fvector (total_keys,
10001 XVECTOR (recent_keys)->contents);
10002 else
10004 Lisp_Object es = Qnil;
10005 int i = (total_keys < NUM_RECENT_KEYS
10006 ? 0 : recent_keys_index);
10007 eassert (recent_keys_index < NUM_RECENT_KEYS);
10010 Lisp_Object e = AREF (recent_keys, i);
10011 if (cmds || !CONSP (e) || !NILP (XCAR (e)))
10012 es = Fcons (e, es);
10013 if (++i >= NUM_RECENT_KEYS)
10014 i = 0;
10015 } while (i != recent_keys_index);
10016 es = Fnreverse (es);
10017 return Fvconcat (1, &es);
10021 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
10022 doc: /* Return the key sequence that invoked this command.
10023 However, if the command has called `read-key-sequence', it returns
10024 the last key sequence that has been read.
10025 The value is a string or a vector.
10027 See also `this-command-keys-vector'. */)
10028 (void)
10030 return make_event_array (this_command_key_count,
10031 XVECTOR (this_command_keys)->contents);
10034 DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
10035 doc: /* Return the key sequence that invoked this command, as a vector.
10036 However, if the command has called `read-key-sequence', it returns
10037 the last key sequence that has been read.
10039 See also `this-command-keys'. */)
10040 (void)
10042 return Fvector (this_command_key_count,
10043 XVECTOR (this_command_keys)->contents);
10046 DEFUN ("this-single-command-keys", Fthis_single_command_keys,
10047 Sthis_single_command_keys, 0, 0, 0,
10048 doc: /* Return the key sequence that invoked this command.
10049 More generally, it returns the last key sequence read, either by
10050 the command loop or by `read-key-sequence'.
10051 Unlike `this-command-keys', this function's value
10052 does not include prefix arguments.
10053 The value is always a vector. */)
10054 (void)
10056 return Fvector (this_command_key_count
10057 - this_single_command_key_start,
10058 (XVECTOR (this_command_keys)->contents
10059 + this_single_command_key_start));
10062 DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
10063 Sthis_single_command_raw_keys, 0, 0, 0,
10064 doc: /* Return the raw events that were read for this command.
10065 More generally, it returns the last key sequence read, either by
10066 the command loop or by `read-key-sequence'.
10067 Unlike `this-single-command-keys', this function's value
10068 shows the events before all translations (except for input methods).
10069 The value is always a vector. */)
10070 (void)
10072 return Fvector (raw_keybuf_count, XVECTOR (raw_keybuf)->contents);
10075 DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
10076 Sclear_this_command_keys, 0, 1, 0,
10077 doc: /* Clear out the vector that `this-command-keys' returns.
10078 Also clear the record of the last 100 events, unless optional arg
10079 KEEP-RECORD is non-nil. */)
10080 (Lisp_Object keep_record)
10082 int i;
10084 this_command_key_count = 0;
10086 if (NILP (keep_record))
10088 for (i = 0; i < ASIZE (recent_keys); ++i)
10089 ASET (recent_keys, i, Qnil);
10090 total_keys = 0;
10091 recent_keys_index = 0;
10093 return Qnil;
10096 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
10097 doc: /* Return the current depth in recursive edits. */)
10098 (void)
10100 EMACS_INT sum;
10101 INT_ADD_WRAPV (command_loop_level, minibuf_level, &sum);
10102 return make_number (sum);
10105 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
10106 "FOpen dribble file: ",
10107 doc: /* Start writing all keyboard characters to a dribble file called FILE.
10108 If FILE is nil, close any open dribble file.
10109 The file will be closed when Emacs exits.
10111 Be aware that this records ALL characters you type!
10112 This may include sensitive information such as passwords. */)
10113 (Lisp_Object file)
10115 if (dribble)
10117 block_input ();
10118 fclose (dribble);
10119 unblock_input ();
10120 dribble = 0;
10122 if (!NILP (file))
10124 int fd;
10125 Lisp_Object encfile;
10127 file = Fexpand_file_name (file, Qnil);
10128 encfile = ENCODE_FILE (file);
10129 fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
10130 if (fd < 0 && errno == EEXIST && unlink (SSDATA (encfile)) == 0)
10131 fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
10132 dribble = fd < 0 ? 0 : fdopen (fd, "w");
10133 if (dribble == 0)
10134 report_file_error ("Opening dribble", file);
10136 return Qnil;
10139 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
10140 doc: /* Discard the contents of the terminal input buffer.
10141 Also end any kbd macro being defined. */)
10142 (void)
10144 if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
10146 /* Discard the last command from the macro. */
10147 Fcancel_kbd_macro_events ();
10148 end_kbd_macro ();
10151 Vunread_command_events = Qnil;
10153 discard_tty_input ();
10155 kbd_fetch_ptr = kbd_store_ptr;
10156 input_pending = false;
10158 return Qnil;
10161 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
10162 doc: /* Stop Emacs and return to superior process. You can resume later.
10163 If `cannot-suspend' is non-nil, or if the system doesn't support job
10164 control, run a subshell instead.
10166 If optional arg STUFFSTRING is non-nil, its characters are stuffed
10167 to be read as terminal input by Emacs's parent, after suspension.
10169 Before suspending, run the normal hook `suspend-hook'.
10170 After resumption run the normal hook `suspend-resume-hook'.
10172 Some operating systems cannot stop the Emacs process and resume it later.
10173 On such systems, Emacs starts a subshell instead of suspending. */)
10174 (Lisp_Object stuffstring)
10176 ptrdiff_t count = SPECPDL_INDEX ();
10177 int old_height, old_width;
10178 int width, height;
10180 if (tty_list && tty_list->next)
10181 error ("There are other tty frames open; close them before suspending Emacs");
10183 if (!NILP (stuffstring))
10184 CHECK_STRING (stuffstring);
10186 run_hook (intern ("suspend-hook"));
10188 get_tty_size (fileno (CURTTY ()->input), &old_width, &old_height);
10189 reset_all_sys_modes ();
10190 /* sys_suspend can get an error if it tries to fork a subshell
10191 and the system resources aren't available for that. */
10192 record_unwind_protect_void (init_all_sys_modes);
10193 stuff_buffered_input (stuffstring);
10194 if (cannot_suspend)
10195 sys_subshell ();
10196 else
10197 sys_suspend ();
10198 unbind_to (count, Qnil);
10200 /* Check if terminal/window size has changed.
10201 Note that this is not useful when we are running directly
10202 with a window system; but suspend should be disabled in that case. */
10203 get_tty_size (fileno (CURTTY ()->input), &width, &height);
10204 if (width != old_width || height != old_height)
10205 change_frame_size (SELECTED_FRAME (), width,
10206 height - FRAME_MENU_BAR_LINES (SELECTED_FRAME ()),
10207 0, 0, 0, 0);
10209 run_hook (intern ("suspend-resume-hook"));
10211 return Qnil;
10214 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
10215 Then in any case stuff anything Emacs has read ahead and not used. */
10217 void
10218 stuff_buffered_input (Lisp_Object stuffstring)
10220 #ifdef SIGTSTP /* stuff_char is defined if SIGTSTP. */
10221 register unsigned char *p;
10223 if (STRINGP (stuffstring))
10225 register ptrdiff_t count;
10227 p = SDATA (stuffstring);
10228 count = SBYTES (stuffstring);
10229 while (count-- > 0)
10230 stuff_char (*p++);
10231 stuff_char ('\n');
10234 /* Anything we have read ahead, put back for the shell to read. */
10235 /* ?? What should this do when we have multiple keyboards??
10236 Should we ignore anything that was typed in at the "wrong" kboard?
10238 rms: we should stuff everything back into the kboard
10239 it came from. */
10240 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
10243 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
10244 kbd_fetch_ptr = kbd_buffer;
10245 if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT)
10246 stuff_char (kbd_fetch_ptr->ie.code);
10248 clear_event (kbd_fetch_ptr);
10251 input_pending = false;
10252 #endif /* SIGTSTP */
10255 void
10256 set_waiting_for_input (struct timespec *time_to_clear)
10258 input_available_clear_time = time_to_clear;
10260 /* Tell handle_interrupt to throw back to read_char, */
10261 waiting_for_input = true;
10263 /* If handle_interrupt was called before and buffered a C-g,
10264 make it run again now, to avoid timing error. */
10265 if (!NILP (Vquit_flag))
10266 quit_throw_to_read_char (0);
10269 void
10270 clear_waiting_for_input (void)
10272 /* Tell handle_interrupt not to throw back to read_char, */
10273 waiting_for_input = false;
10274 input_available_clear_time = 0;
10277 /* The SIGINT handler.
10279 If we have a frame on the controlling tty, we assume that the
10280 SIGINT was generated by C-g, so we call handle_interrupt.
10281 Otherwise, tell maybe_quit to kill Emacs. */
10283 static void
10284 handle_interrupt_signal (int sig)
10286 /* See if we have an active terminal on our controlling tty. */
10287 struct terminal *terminal = get_named_terminal (DEV_TTY);
10288 if (!terminal)
10290 /* If there are no frames there, let's pretend that we are a
10291 well-behaving UN*X program and quit. We must not call Lisp
10292 in a signal handler, so tell maybe_quit to exit when it is
10293 safe. */
10294 Vquit_flag = Qkill_emacs;
10296 else
10298 /* Otherwise, the SIGINT was probably generated by C-g. */
10300 /* Set internal_last_event_frame to the top frame of the
10301 controlling tty, if we have a frame there. We disable the
10302 interrupt key on secondary ttys, so the SIGINT must have come
10303 from the controlling tty. */
10304 internal_last_event_frame = terminal->display_info.tty->top_frame;
10306 handle_interrupt (1);
10310 static void
10311 deliver_interrupt_signal (int sig)
10313 deliver_process_signal (sig, handle_interrupt_signal);
10316 /* Output MSG directly to standard output, without buffering. Ignore
10317 failures. This is safe in a signal handler. */
10318 static void
10319 write_stdout (char const *msg)
10321 ignore_value (write (STDOUT_FILENO, msg, strlen (msg)));
10324 /* Read a byte from stdin, without buffering. Safe in signal handlers. */
10325 static int
10326 read_stdin (void)
10328 char c;
10329 return read (STDIN_FILENO, &c, 1) == 1 ? c : EOF;
10332 /* If Emacs is stuck because `inhibit-quit' is true, then keep track
10333 of the number of times C-g has been requested. If C-g is pressed
10334 enough times, then quit anyway. See bug#6585. */
10335 static int volatile force_quit_count;
10337 /* This routine is called at interrupt level in response to C-g.
10339 It is called from the SIGINT handler or kbd_buffer_store_event.
10341 If `waiting_for_input' is non zero, then unless `echoing' is
10342 nonzero, immediately throw back to read_char.
10344 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
10345 eval to throw, when it gets a chance. If quit-flag is already
10346 non-nil, it stops the job right away. */
10348 static void
10349 handle_interrupt (bool in_signal_handler)
10351 char c;
10353 cancel_echoing ();
10355 /* XXX This code needs to be revised for multi-tty support. */
10356 if (!NILP (Vquit_flag) && get_named_terminal (DEV_TTY))
10358 if (! in_signal_handler)
10360 /* If SIGINT isn't blocked, don't let us be interrupted by
10361 a SIGINT. It might be harmful due to non-reentrancy
10362 in I/O functions. */
10363 sigset_t blocked;
10364 sigemptyset (&blocked);
10365 sigaddset (&blocked, SIGINT);
10366 pthread_sigmask (SIG_BLOCK, &blocked, 0);
10367 fflush (stdout);
10370 reset_all_sys_modes ();
10372 #ifdef SIGTSTP
10374 * On systems which can suspend the current process and return to the original
10375 * shell, this command causes the user to end up back at the shell.
10376 * The "Auto-save" and "Abort" questions are not asked until
10377 * the user elects to return to emacs, at which point he can save the current
10378 * job and either dump core or continue.
10380 sys_suspend ();
10381 #else
10382 /* Perhaps should really fork an inferior shell?
10383 But that would not provide any way to get back
10384 to the original shell, ever. */
10385 write_stdout ("No support for stopping a process"
10386 " on this operating system;\n"
10387 "you can continue or abort.\n");
10388 #endif /* not SIGTSTP */
10389 #ifdef MSDOS
10390 /* We must remain inside the screen area when the internal terminal
10391 is used. Note that [Enter] is not echoed by dos. */
10392 cursor_to (SELECTED_FRAME (), 0, 0);
10393 #endif
10395 write_stdout ("Emacs is resuming after an emergency escape.\n");
10397 /* It doesn't work to autosave while GC is in progress;
10398 the code used for auto-saving doesn't cope with the mark bit. */
10399 if (!gc_in_progress)
10401 write_stdout ("Auto-save? (y or n) ");
10402 c = read_stdin ();
10403 if (c == 'y' || c == 'Y')
10405 Fdo_auto_save (Qt, Qnil);
10406 #ifdef MSDOS
10407 write_stdout ("\r\nAuto-save done");
10408 #else
10409 write_stdout ("Auto-save done\n");
10410 #endif
10412 while (c != '\n')
10413 c = read_stdin ();
10415 else
10417 /* During GC, it must be safe to reenable quitting again. */
10418 Vinhibit_quit = Qnil;
10419 write_stdout
10421 #ifdef MSDOS
10422 "\r\n"
10423 #endif
10424 "Garbage collection in progress; cannot auto-save now\r\n"
10425 "but will instead do a real quit"
10426 " after garbage collection ends\r\n");
10429 #ifdef MSDOS
10430 write_stdout ("\r\nAbort? (y or n) ");
10431 #else
10432 write_stdout ("Abort (and dump core)? (y or n) ");
10433 #endif
10434 c = read_stdin ();
10435 if (c == 'y' || c == 'Y')
10436 emacs_abort ();
10437 while (c != '\n')
10438 c = read_stdin ();
10439 #ifdef MSDOS
10440 write_stdout ("\r\nContinuing...\r\n");
10441 #else /* not MSDOS */
10442 write_stdout ("Continuing...\n");
10443 #endif /* not MSDOS */
10444 init_all_sys_modes ();
10446 else
10448 /* If executing a function that wants to be interrupted out of
10449 and the user has not deferred quitting by binding `inhibit-quit'
10450 then quit right away. */
10451 if (immediate_quit && NILP (Vinhibit_quit))
10453 struct gl_state_s saved;
10455 immediate_quit = false;
10456 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
10457 saved = gl_state;
10458 quit ();
10459 gl_state = saved;
10461 else
10462 { /* Else request quit when it's safe. */
10463 int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
10464 force_quit_count = count;
10465 if (count == 3)
10467 immediate_quit = true;
10468 Vinhibit_quit = Qnil;
10470 Vquit_flag = Qt;
10474 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
10476 /* TODO: The longjmp in this call throws the NS event loop integration off,
10477 and it seems to do fine without this. Probably some attention
10478 needs to be paid to the setting of waiting_for_input in
10479 wait_reading_process_output() under HAVE_NS because of the call
10480 to ns_select there (needed because otherwise events aren't picked up
10481 outside of polling since we don't get SIGIO like X and we don't have a
10482 separate event loop thread like W32. */
10483 #ifndef HAVE_NS
10484 if (waiting_for_input && !echoing)
10485 quit_throw_to_read_char (in_signal_handler);
10486 #endif
10489 /* Handle a C-g by making read_char return C-g. */
10491 static void
10492 quit_throw_to_read_char (bool from_signal)
10494 /* When not called from a signal handler it is safe to call
10495 Lisp. */
10496 if (!from_signal && EQ (Vquit_flag, Qkill_emacs))
10497 Fkill_emacs (Qnil);
10499 /* Prevent another signal from doing this before we finish. */
10500 clear_waiting_for_input ();
10501 input_pending = false;
10503 Vunread_command_events = Qnil;
10505 if (FRAMEP (internal_last_event_frame)
10506 && !EQ (internal_last_event_frame, selected_frame))
10507 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
10508 0, 0, Qnil);
10510 sys_longjmp (getcjmp, 1);
10513 DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,
10514 Sset_input_interrupt_mode, 1, 1, 0,
10515 doc: /* Set interrupt mode of reading keyboard input.
10516 If INTERRUPT is non-nil, Emacs will use input interrupts;
10517 otherwise Emacs uses CBREAK mode.
10519 See also `current-input-mode'. */)
10520 (Lisp_Object interrupt)
10522 bool new_interrupt_input;
10523 #ifdef USABLE_SIGIO
10524 #ifdef HAVE_X_WINDOWS
10525 if (x_display_list != NULL)
10527 /* When using X, don't give the user a real choice,
10528 because we haven't implemented the mechanisms to support it. */
10529 new_interrupt_input = true;
10531 else
10532 #endif /* HAVE_X_WINDOWS */
10533 new_interrupt_input = !NILP (interrupt);
10534 #else /* not USABLE_SIGIO */
10535 new_interrupt_input = false;
10536 #endif /* not USABLE_SIGIO */
10538 if (new_interrupt_input != interrupt_input)
10540 #ifdef POLL_FOR_INPUT
10541 stop_polling ();
10542 #endif
10543 #ifndef DOS_NT
10544 /* this causes startup screen to be restored and messes with the mouse */
10545 reset_all_sys_modes ();
10546 interrupt_input = new_interrupt_input;
10547 init_all_sys_modes ();
10548 #else
10549 interrupt_input = new_interrupt_input;
10550 #endif
10552 #ifdef POLL_FOR_INPUT
10553 poll_suppress_count = 1;
10554 start_polling ();
10555 #endif
10557 return Qnil;
10560 DEFUN ("set-output-flow-control", Fset_output_flow_control, Sset_output_flow_control, 1, 2, 0,
10561 doc: /* Enable or disable ^S/^Q flow control for output to TERMINAL.
10562 If FLOW is non-nil, flow control is enabled and you cannot use C-s or
10563 C-q in key sequences.
10565 This setting only has an effect on tty terminals and only when
10566 Emacs reads input in CBREAK mode; see `set-input-interrupt-mode'.
10568 See also `current-input-mode'. */)
10569 (Lisp_Object flow, Lisp_Object terminal)
10571 struct terminal *t = decode_tty_terminal (terminal);
10572 struct tty_display_info *tty;
10574 if (!t)
10575 return Qnil;
10576 tty = t->display_info.tty;
10578 if (tty->flow_control != !NILP (flow))
10580 #ifndef DOS_NT
10581 /* This causes startup screen to be restored and messes with the mouse. */
10582 reset_sys_modes (tty);
10583 #endif
10585 tty->flow_control = !NILP (flow);
10587 #ifndef DOS_NT
10588 init_sys_modes (tty);
10589 #endif
10591 return Qnil;
10594 DEFUN ("set-input-meta-mode", Fset_input_meta_mode, Sset_input_meta_mode, 1, 2, 0,
10595 doc: /* Enable or disable 8-bit input on TERMINAL.
10596 If META is t, Emacs will accept 8-bit input, and interpret the 8th
10597 bit as the Meta modifier.
10599 If META is nil, Emacs will ignore the top bit, on the assumption it is
10600 parity.
10602 Otherwise, Emacs will accept and pass through 8-bit input without
10603 specially interpreting the top bit.
10605 This setting only has an effect on tty terminal devices.
10607 Optional parameter TERMINAL specifies the tty terminal device to use.
10608 It may be a terminal object, a frame, or nil for the terminal used by
10609 the currently selected frame.
10611 See also `current-input-mode'. */)
10612 (Lisp_Object meta, Lisp_Object terminal)
10614 struct terminal *t = decode_tty_terminal (terminal);
10615 struct tty_display_info *tty;
10616 int new_meta;
10618 if (!t)
10619 return Qnil;
10620 tty = t->display_info.tty;
10622 if (NILP (meta))
10623 new_meta = 0;
10624 else if (EQ (meta, Qt))
10625 new_meta = 1;
10626 else
10627 new_meta = 2;
10629 if (tty->meta_key != new_meta)
10631 #ifndef DOS_NT
10632 /* this causes startup screen to be restored and messes with the mouse */
10633 reset_sys_modes (tty);
10634 #endif
10636 tty->meta_key = new_meta;
10638 #ifndef DOS_NT
10639 init_sys_modes (tty);
10640 #endif
10642 return Qnil;
10645 DEFUN ("set-quit-char", Fset_quit_char, Sset_quit_char, 1, 1, 0,
10646 doc: /* Specify character used for quitting.
10647 QUIT must be an ASCII character.
10649 This function only has an effect on the controlling tty of the Emacs
10650 process.
10652 See also `current-input-mode'. */)
10653 (Lisp_Object quit)
10655 struct terminal *t = get_named_terminal (DEV_TTY);
10656 struct tty_display_info *tty;
10658 if (!t)
10659 return Qnil;
10660 tty = t->display_info.tty;
10662 if (NILP (quit) || !INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400)
10663 error ("QUIT must be an ASCII character");
10665 #ifndef DOS_NT
10666 /* this causes startup screen to be restored and messes with the mouse */
10667 reset_sys_modes (tty);
10668 #endif
10670 /* Don't let this value be out of range. */
10671 quit_char = XINT (quit) & (tty->meta_key == 0 ? 0177 : 0377);
10673 #ifndef DOS_NT
10674 init_sys_modes (tty);
10675 #endif
10677 return Qnil;
10680 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
10681 doc: /* Set mode of reading keyboard input.
10682 First arg INTERRUPT non-nil means use input interrupts;
10683 nil means use CBREAK mode.
10684 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
10685 (no effect except in CBREAK mode).
10686 Third arg META t means accept 8-bit input (for a Meta key).
10687 META nil means ignore the top bit, on the assumption it is parity.
10688 Otherwise, accept 8-bit input and don't use the top bit for Meta.
10689 Optional fourth arg QUIT if non-nil specifies character to use for quitting.
10690 See also `current-input-mode'. */)
10691 (Lisp_Object interrupt, Lisp_Object flow, Lisp_Object meta, Lisp_Object quit)
10693 Fset_input_interrupt_mode (interrupt);
10694 Fset_output_flow_control (flow, Qnil);
10695 Fset_input_meta_mode (meta, Qnil);
10696 if (!NILP (quit))
10697 Fset_quit_char (quit);
10698 return Qnil;
10701 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
10702 doc: /* Return information about the way Emacs currently reads keyboard input.
10703 The value is a list of the form (INTERRUPT FLOW META QUIT), where
10704 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if
10705 nil, Emacs is using CBREAK mode.
10706 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
10707 terminal; this does not apply if Emacs uses interrupt-driven input.
10708 META is t if accepting 8-bit input with 8th bit as Meta flag.
10709 META nil means ignoring the top bit, on the assumption it is parity.
10710 META is neither t nor nil if accepting 8-bit input and using
10711 all 8 bits as the character code.
10712 QUIT is the character Emacs currently uses to quit.
10713 The elements of this list correspond to the arguments of
10714 `set-input-mode'. */)
10715 (void)
10717 struct frame *sf = XFRAME (selected_frame);
10719 Lisp_Object interrupt = interrupt_input ? Qt : Qnil;
10720 Lisp_Object flow, meta;
10721 if (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf))
10723 flow = FRAME_TTY (sf)->flow_control ? Qt : Qnil;
10724 meta = (FRAME_TTY (sf)->meta_key == 2
10725 ? make_number (0)
10726 : (CURTTY ()->meta_key == 1 ? Qt : Qnil));
10728 else
10730 flow = Qnil;
10731 meta = Qt;
10733 Lisp_Object quit = make_number (quit_char);
10735 return list4 (interrupt, flow, meta, quit);
10738 DEFUN ("posn-at-x-y", Fposn_at_x_y, Sposn_at_x_y, 2, 4, 0,
10739 doc: /* Return position information for pixel coordinates X and Y.
10740 By default, X and Y are relative to text area of the selected window.
10741 Optional third arg FRAME-OR-WINDOW non-nil specifies frame or window.
10742 If optional fourth arg WHOLE is non-nil, X is relative to the left
10743 edge of the window.
10745 The return value is similar to a mouse click position:
10746 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
10747 IMAGE (DX . DY) (WIDTH . HEIGHT))
10748 The `posn-' functions access elements of such lists. */)
10749 (Lisp_Object x, Lisp_Object y, Lisp_Object frame_or_window, Lisp_Object whole)
10751 CHECK_NUMBER (x);
10752 /* We allow X of -1, for the newline in a R2L line that overflowed
10753 into the left fringe. */
10754 if (XINT (x) != -1)
10755 CHECK_NATNUM (x);
10756 CHECK_NATNUM (y);
10758 if (NILP (frame_or_window))
10759 frame_or_window = selected_window;
10761 if (WINDOWP (frame_or_window))
10763 struct window *w = decode_live_window (frame_or_window);
10765 XSETINT (x, (XINT (x)
10766 + WINDOW_LEFT_EDGE_X (w)
10767 + (NILP (whole)
10768 ? window_box_left_offset (w, TEXT_AREA)
10769 : 0)));
10770 XSETINT (y, WINDOW_TO_FRAME_PIXEL_Y (w, XINT (y)));
10771 frame_or_window = w->frame;
10774 CHECK_LIVE_FRAME (frame_or_window);
10776 return make_lispy_position (XFRAME (frame_or_window), x, y, 0);
10779 DEFUN ("posn-at-point", Fposn_at_point, Sposn_at_point, 0, 2, 0,
10780 doc: /* Return position information for buffer POS in WINDOW.
10781 POS defaults to point in WINDOW; WINDOW defaults to the selected window.
10783 Return nil if position is not visible in window. Otherwise,
10784 the return value is similar to that returned by `event-start' for
10785 a mouse click at the upper left corner of the glyph corresponding
10786 to the given buffer position:
10787 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
10788 IMAGE (DX . DY) (WIDTH . HEIGHT))
10789 The `posn-' functions access elements of such lists. */)
10790 (Lisp_Object pos, Lisp_Object window)
10792 Lisp_Object tem;
10794 if (NILP (window))
10795 window = selected_window;
10797 tem = Fpos_visible_in_window_p (pos, window, Qt);
10798 if (!NILP (tem))
10800 Lisp_Object x = XCAR (tem);
10801 Lisp_Object y = XCAR (XCDR (tem));
10802 Lisp_Object aux_info = XCDR (XCDR (tem));
10803 int y_coord = XINT (y);
10805 /* Point invisible due to hscrolling? X can be -1 when a
10806 newline in a R2L line overflows into the left fringe. */
10807 if (XINT (x) < -1)
10808 return Qnil;
10809 if (!NILP (aux_info) && y_coord < 0)
10811 int rtop = XINT (XCAR (aux_info));
10813 y = make_number (y_coord + rtop);
10815 tem = Fposn_at_x_y (x, y, window, Qnil);
10818 return tem;
10821 /* Set up a new kboard object with reasonable initial values.
10822 TYPE is a window system for which this keyboard is used. */
10824 static void
10825 init_kboard (KBOARD *kb, Lisp_Object type)
10827 kset_overriding_terminal_local_map (kb, Qnil);
10828 kset_last_command (kb, Qnil);
10829 kset_real_last_command (kb, Qnil);
10830 kset_keyboard_translate_table (kb, Qnil);
10831 kset_last_repeatable_command (kb, Qnil);
10832 kset_prefix_arg (kb, Qnil);
10833 kset_last_prefix_arg (kb, Qnil);
10834 kset_kbd_queue (kb, Qnil);
10835 kb->kbd_queue_has_data = false;
10836 kb->immediate_echo = false;
10837 kset_echo_string (kb, Qnil);
10838 kset_echo_prompt (kb, Qnil);
10839 kb->kbd_macro_buffer = 0;
10840 kb->kbd_macro_bufsize = 0;
10841 kset_defining_kbd_macro (kb, Qnil);
10842 kset_last_kbd_macro (kb, Qnil);
10843 kb->reference_count = 0;
10844 kset_system_key_alist (kb, Qnil);
10845 kset_system_key_syms (kb, Qnil);
10846 kset_window_system (kb, type);
10847 kset_input_decode_map (kb, Fmake_sparse_keymap (Qnil));
10848 kset_local_function_key_map (kb, Fmake_sparse_keymap (Qnil));
10849 Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map);
10850 kset_default_minibuffer_frame (kb, Qnil);
10853 /* Allocate and basically initialize keyboard
10854 object to use with window system TYPE. */
10856 KBOARD *
10857 allocate_kboard (Lisp_Object type)
10859 KBOARD *kb = xmalloc (sizeof *kb);
10861 init_kboard (kb, type);
10862 kb->next_kboard = all_kboards;
10863 all_kboards = kb;
10864 return kb;
10868 * Destroy the contents of a kboard object, but not the object itself.
10869 * We use this just before deleting it, or if we're going to initialize
10870 * it a second time.
10872 static void
10873 wipe_kboard (KBOARD *kb)
10875 xfree (kb->kbd_macro_buffer);
10878 /* Free KB and memory referenced from it. */
10880 void
10881 delete_kboard (KBOARD *kb)
10883 KBOARD **kbp;
10885 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
10886 if (*kbp == NULL)
10887 emacs_abort ();
10888 *kbp = kb->next_kboard;
10890 /* Prevent a dangling reference to KB. */
10891 if (kb == current_kboard
10892 && FRAMEP (selected_frame)
10893 && FRAME_LIVE_P (XFRAME (selected_frame)))
10895 current_kboard = FRAME_KBOARD (XFRAME (selected_frame));
10896 single_kboard = false;
10897 if (current_kboard == kb)
10898 emacs_abort ();
10901 wipe_kboard (kb);
10902 xfree (kb);
10905 void
10906 init_keyboard (void)
10908 /* This is correct before outermost invocation of the editor loop. */
10909 command_loop_level = -1;
10910 immediate_quit = false;
10911 quit_char = Ctl ('g');
10912 Vunread_command_events = Qnil;
10913 timer_idleness_start_time = invalid_timespec ();
10914 total_keys = 0;
10915 recent_keys_index = 0;
10916 kbd_fetch_ptr = kbd_buffer;
10917 kbd_store_ptr = kbd_buffer;
10918 do_mouse_tracking = Qnil;
10919 input_pending = false;
10920 interrupt_input_blocked = 0;
10921 pending_signals = false;
10923 /* This means that command_loop_1 won't try to select anything the first
10924 time through. */
10925 internal_last_event_frame = Qnil;
10926 Vlast_event_frame = internal_last_event_frame;
10928 current_kboard = initial_kboard;
10929 /* Re-initialize the keyboard again. */
10930 wipe_kboard (current_kboard);
10931 /* A value of nil for Vwindow_system normally means a tty, but we also use
10932 it for the initial terminal since there is no window system there. */
10933 init_kboard (current_kboard, Qnil);
10935 if (!noninteractive)
10937 /* Before multi-tty support, these handlers used to be installed
10938 only if the current session was a tty session. Now an Emacs
10939 session may have multiple display types, so we always handle
10940 SIGINT. There is special code in handle_interrupt_signal to exit
10941 Emacs on SIGINT when there are no termcap frames on the
10942 controlling terminal. */
10943 struct sigaction action;
10944 emacs_sigaction_init (&action, deliver_interrupt_signal);
10945 sigaction (SIGINT, &action, 0);
10946 #ifndef DOS_NT
10947 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
10948 SIGQUIT and we can't tell which one it will give us. */
10949 sigaction (SIGQUIT, &action, 0);
10950 #endif /* not DOS_NT */
10952 #ifdef USABLE_SIGIO
10953 if (!noninteractive)
10955 struct sigaction action;
10956 emacs_sigaction_init (&action, deliver_input_available_signal);
10957 sigaction (SIGIO, &action, 0);
10959 #endif
10961 /* Use interrupt input by default, if it works and noninterrupt input
10962 has deficiencies. */
10964 #ifdef INTERRUPT_INPUT
10965 interrupt_input = 1;
10966 #else
10967 interrupt_input = 0;
10968 #endif
10970 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
10971 dribble = 0;
10973 if (keyboard_init_hook)
10974 (*keyboard_init_hook) ();
10976 #ifdef POLL_FOR_INPUT
10977 poll_timer = NULL;
10978 poll_suppress_count = 1;
10979 start_polling ();
10980 #endif
10983 /* This type's only use is in syms_of_keyboard, to put properties on the
10984 event header symbols. */
10985 struct event_head
10987 short var;
10988 short kind;
10991 static const struct event_head head_table[] = {
10992 {SYMBOL_INDEX (Qmouse_movement), SYMBOL_INDEX (Qmouse_movement)},
10993 {SYMBOL_INDEX (Qscroll_bar_movement), SYMBOL_INDEX (Qmouse_movement)},
10995 /* Some of the event heads. */
10996 {SYMBOL_INDEX (Qswitch_frame), SYMBOL_INDEX (Qswitch_frame)},
10998 {SYMBOL_INDEX (Qfocus_in), SYMBOL_INDEX (Qfocus_in)},
10999 {SYMBOL_INDEX (Qfocus_out), SYMBOL_INDEX (Qfocus_out)},
11000 {SYMBOL_INDEX (Qdelete_frame), SYMBOL_INDEX (Qdelete_frame)},
11001 {SYMBOL_INDEX (Qiconify_frame), SYMBOL_INDEX (Qiconify_frame)},
11002 {SYMBOL_INDEX (Qmake_frame_visible), SYMBOL_INDEX (Qmake_frame_visible)},
11003 /* `select-window' should be handled just like `switch-frame'
11004 in read_key_sequence. */
11005 {SYMBOL_INDEX (Qselect_window), SYMBOL_INDEX (Qswitch_frame)}
11008 void
11009 syms_of_keyboard (void)
11011 pending_funcalls = Qnil;
11012 staticpro (&pending_funcalls);
11014 Vlispy_mouse_stem = build_pure_c_string ("mouse");
11015 staticpro (&Vlispy_mouse_stem);
11017 regular_top_level_message = build_pure_c_string ("Back to top level");
11018 #ifdef HAVE_STACK_OVERFLOW_HANDLING
11019 recover_top_level_message
11020 = build_pure_c_string ("Re-entering top level after C stack overflow");
11021 #endif
11022 DEFVAR_LISP ("internal--top-level-message", Vinternal__top_level_message,
11023 doc: /* Message displayed by `normal-top-level'. */);
11024 Vinternal__top_level_message = regular_top_level_message;
11026 /* Tool-bars. */
11027 DEFSYM (QCimage, ":image");
11028 DEFSYM (Qhelp_echo, "help-echo");
11029 DEFSYM (QCrtl, ":rtl");
11031 staticpro (&item_properties);
11032 item_properties = Qnil;
11034 staticpro (&tool_bar_item_properties);
11035 tool_bar_item_properties = Qnil;
11036 staticpro (&tool_bar_items_vector);
11037 tool_bar_items_vector = Qnil;
11039 DEFSYM (Qtimer_event_handler, "timer-event-handler");
11041 /* Non-nil disable property on a command means do not execute it;
11042 call disabled-command-function's value instead. */
11043 DEFSYM (Qdisabled, "disabled");
11045 DEFSYM (Qundefined, "undefined");
11047 /* Hooks to run before and after each command. */
11048 DEFSYM (Qpre_command_hook, "pre-command-hook");
11049 DEFSYM (Qpost_command_hook, "post-command-hook");
11051 DEFSYM (Qundo_auto__add_boundary, "undo-auto--add-boundary");
11052 DEFSYM (Qundo_auto__undoably_changed_buffers,
11053 "undo-auto--undoably-changed-buffers");
11055 DEFSYM (Qdeferred_action_function, "deferred-action-function");
11056 DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook");
11057 DEFSYM (Qfunction_key, "function-key");
11059 /* The values of Qevent_kind properties. */
11060 DEFSYM (Qmouse_click, "mouse-click");
11062 DEFSYM (Qdrag_n_drop, "drag-n-drop");
11063 DEFSYM (Qsave_session, "save-session");
11064 DEFSYM (Qconfig_changed_event, "config-changed-event");
11066 /* Menu and tool bar item parts. */
11067 DEFSYM (Qmenu_enable, "menu-enable");
11069 #ifdef HAVE_NTGUI
11070 DEFSYM (Qlanguage_change, "language-change");
11071 DEFSYM (Qend_session, "end-session");
11072 #endif
11074 #ifdef HAVE_DBUS
11075 DEFSYM (Qdbus_event, "dbus-event");
11076 #endif
11078 #ifdef HAVE_XWIDGETS
11079 DEFSYM (Qxwidget_event, "xwidget-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_exit_on_first_char, "input-method-exit-on-first-char");
11157 DEFSYM (Qinput_method_use_echo_area, "input-method-use-echo-area");
11159 DEFSYM (Qhelp_form_show, "help-form-show");
11161 DEFSYM (Qecho_keystrokes, "echo-keystrokes");
11163 Fset (Qinput_method_exit_on_first_char, Qnil);
11164 Fset (Qinput_method_use_echo_area, Qnil);
11166 /* Symbols to head events. */
11167 DEFSYM (Qmouse_movement, "mouse-movement");
11168 DEFSYM (Qscroll_bar_movement, "scroll-bar-movement");
11169 DEFSYM (Qswitch_frame, "switch-frame");
11170 DEFSYM (Qfocus_in, "focus-in");
11171 DEFSYM (Qfocus_out, "focus-out");
11172 DEFSYM (Qdelete_frame, "delete-frame");
11173 DEFSYM (Qiconify_frame, "iconify-frame");
11174 DEFSYM (Qmake_frame_visible, "make-frame-visible");
11175 DEFSYM (Qselect_window, "select-window");
11176 DEFSYM (Qselection_request, "selection-request");
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 = builtin_lisp_symbol (p->var);
11184 Lisp_Object kind = builtin_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");
11219 DEFSYM (Qinternal_echo_keystrokes_prefix, "internal-echo-keystrokes-prefix");
11221 accent_key_syms = Qnil;
11222 staticpro (&accent_key_syms);
11224 func_key_syms = Qnil;
11225 staticpro (&func_key_syms);
11227 drag_n_drop_syms = Qnil;
11228 staticpro (&drag_n_drop_syms);
11230 unread_switch_frame = Qnil;
11231 staticpro (&unread_switch_frame);
11233 internal_last_event_frame = Qnil;
11234 staticpro (&internal_last_event_frame);
11236 read_key_sequence_cmd = Qnil;
11237 staticpro (&read_key_sequence_cmd);
11238 read_key_sequence_remapped = Qnil;
11239 staticpro (&read_key_sequence_remapped);
11241 menu_bar_one_keymap_changed_items = Qnil;
11242 staticpro (&menu_bar_one_keymap_changed_items);
11244 menu_bar_items_vector = Qnil;
11245 staticpro (&menu_bar_items_vector);
11247 help_form_saved_window_configs = Qnil;
11248 staticpro (&help_form_saved_window_configs);
11250 defsubr (&Scurrent_idle_time);
11251 defsubr (&Sevent_symbol_parse_modifiers);
11252 defsubr (&Sevent_convert_list);
11253 defsubr (&Sread_key_sequence);
11254 defsubr (&Sread_key_sequence_vector);
11255 defsubr (&Srecursive_edit);
11256 defsubr (&Strack_mouse);
11257 defsubr (&Sinput_pending_p);
11258 defsubr (&Srecent_keys);
11259 defsubr (&Sthis_command_keys);
11260 defsubr (&Sthis_command_keys_vector);
11261 defsubr (&Sthis_single_command_keys);
11262 defsubr (&Sthis_single_command_raw_keys);
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;
11462 XSYMBOL (Qtop_level)->declared_special = false;
11464 DEFVAR_KBOARD ("keyboard-translate-table", Vkeyboard_translate_table,
11465 doc: /* Translate table for local keyboard input, or nil.
11466 If non-nil, the value should be a char-table. Each character read
11467 from the keyboard is looked up in this char-table. If the value found
11468 there is non-nil, then it is used instead of the actual input character.
11470 The value can also be a string or vector, but this is considered obsolete.
11471 If it is a string or vector of length N, character codes N and up are left
11472 untranslated. In a vector, an element which is nil means "no translation".
11474 This is applied to the characters supplied to input methods, not their
11475 output. See also `translation-table-for-input'.
11477 This variable has a separate binding for each terminal.
11478 See Info node `(elisp)Multiple Terminals'. */);
11480 DEFVAR_BOOL ("cannot-suspend", cannot_suspend,
11481 doc: /* Non-nil means to always spawn a subshell instead of suspending.
11482 \(Even if the operating system has support for stopping a process.) */);
11483 cannot_suspend = false;
11485 DEFVAR_BOOL ("menu-prompting", menu_prompting,
11486 doc: /* Non-nil means prompt with menus when appropriate.
11487 This is done when reading from a keymap that has a prompt string,
11488 for elements that have prompt strings.
11489 The menu is displayed on the screen
11490 if X menus were enabled at configuration
11491 time and the previous event was a mouse click prefix key.
11492 Otherwise, menu prompting uses the echo area. */);
11493 menu_prompting = true;
11495 DEFVAR_LISP ("menu-prompt-more-char", menu_prompt_more_char,
11496 doc: /* Character to see next line of menu prompt.
11497 Type this character while in a menu prompt to rotate around the lines of it. */);
11498 XSETINT (menu_prompt_more_char, ' ');
11500 DEFVAR_INT ("extra-keyboard-modifiers", extra_keyboard_modifiers,
11501 doc: /* A mask of additional modifier keys to use with every keyboard character.
11502 Emacs applies the modifiers of the character stored here to each keyboard
11503 character it reads. For example, after evaluating the expression
11504 (setq extra-keyboard-modifiers ?\\C-x)
11505 all input characters will have the control modifier applied to them.
11507 Note that the character ?\\C-@, equivalent to the integer zero, does
11508 not count as a control character; rather, it counts as a character
11509 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero
11510 cancels any modification. */);
11511 extra_keyboard_modifiers = 0;
11513 DEFSYM (Qdeactivate_mark, "deactivate-mark");
11514 DEFVAR_LISP ("deactivate-mark", Vdeactivate_mark,
11515 doc: /* If an editing command sets this to t, deactivate the mark afterward.
11516 The command loop sets this to nil before each command,
11517 and tests the value when the command returns.
11518 Buffer modification stores t in this variable. */);
11519 Vdeactivate_mark = Qnil;
11520 Fmake_variable_buffer_local (Qdeactivate_mark);
11522 DEFVAR_LISP ("pre-command-hook", Vpre_command_hook,
11523 doc: /* Normal hook run before each command is executed.
11524 If an unhandled error happens in running this hook,
11525 the function in which the error occurred is unconditionally removed, since
11526 otherwise the error might happen repeatedly and make Emacs nonfunctional.
11528 See also `post-command-hook'. */);
11529 Vpre_command_hook = Qnil;
11531 DEFVAR_LISP ("post-command-hook", Vpost_command_hook,
11532 doc: /* Normal hook run after each command is executed.
11533 If an unhandled error happens in running this hook,
11534 the function in which the error occurred is unconditionally removed, since
11535 otherwise the error might happen repeatedly and make Emacs nonfunctional.
11537 It is a bad idea to use this hook for expensive processing. If
11538 unavoidable, wrap your code in `(while-no-input (redisplay) CODE)' to
11539 avoid making Emacs unresponsive while the user types.
11541 See also `pre-command-hook'. */);
11542 Vpost_command_hook = Qnil;
11544 #if 0
11545 DEFVAR_LISP ("echo-area-clear-hook", ...,
11546 doc: /* Normal hook run when clearing the echo area. */);
11547 #endif
11548 DEFSYM (Qecho_area_clear_hook, "echo-area-clear-hook");
11549 Fset (Qecho_area_clear_hook, Qnil);
11551 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", Vlucid_menu_bar_dirty_flag,
11552 doc: /* Non-nil means menu bar, specified Lucid style, needs to be recomputed. */);
11553 Vlucid_menu_bar_dirty_flag = Qnil;
11555 DEFVAR_LISP ("menu-bar-final-items", Vmenu_bar_final_items,
11556 doc: /* List of menu bar items to move to the end of the menu bar.
11557 The elements of the list are event types that may have menu bar bindings. */);
11558 Vmenu_bar_final_items = Qnil;
11560 DEFVAR_LISP ("tool-bar-separator-image-expression", Vtool_bar_separator_image_expression,
11561 doc: /* Expression evaluating to the image spec for a tool-bar separator.
11562 This is used internally by graphical displays that do not render
11563 tool-bar separators natively. Otherwise it is unused (e.g. on GTK). */);
11564 Vtool_bar_separator_image_expression = Qnil;
11566 DEFVAR_KBOARD ("overriding-terminal-local-map",
11567 Voverriding_terminal_local_map,
11568 doc: /* Per-terminal keymap that takes precedence over all other keymaps.
11569 This variable is intended to let commands such as `universal-argument'
11570 set up a different keymap for reading the next command.
11572 `overriding-terminal-local-map' has a separate binding for each
11573 terminal device. See Info node `(elisp)Multiple Terminals'. */);
11575 DEFVAR_LISP ("overriding-local-map", Voverriding_local_map,
11576 doc: /* Keymap that replaces (overrides) local keymaps.
11577 If this variable is non-nil, Emacs looks up key bindings in this
11578 keymap INSTEAD OF the keymap char property, minor mode maps, and the
11579 buffer's local map. Hence, the only active keymaps would be
11580 `overriding-terminal-local-map', this keymap, and `global-keymap', in
11581 order of precedence. */);
11582 Voverriding_local_map = Qnil;
11584 DEFVAR_LISP ("overriding-local-map-menu-flag", Voverriding_local_map_menu_flag,
11585 doc: /* Non-nil means `overriding-local-map' applies to the menu bar.
11586 Otherwise, the menu bar continues to reflect the buffer's local map
11587 and the minor mode maps regardless of `overriding-local-map'. */);
11588 Voverriding_local_map_menu_flag = Qnil;
11590 DEFVAR_LISP ("special-event-map", Vspecial_event_map,
11591 doc: /* Keymap defining bindings for special events to execute at low level. */);
11592 Vspecial_event_map = list1 (Qkeymap);
11594 DEFVAR_LISP ("track-mouse", do_mouse_tracking,
11595 doc: /* Non-nil means generate motion events for mouse motion. */);
11597 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
11598 doc: /* Alist of system-specific X windows key symbols.
11599 Each element should have the form (N . SYMBOL) where N is the
11600 numeric keysym code (sans the \"system-specific\" bit 1<<28)
11601 and SYMBOL is its name.
11603 `system-key-alist' has a separate binding for each terminal device.
11604 See Info node `(elisp)Multiple Terminals'. */);
11606 DEFVAR_KBOARD ("local-function-key-map", Vlocal_function_key_map,
11607 doc: /* Keymap that translates key sequences to key sequences during input.
11608 This is used mainly for mapping key sequences into some preferred
11609 key events (symbols).
11611 The `read-key-sequence' function replaces any subsequence bound by
11612 `local-function-key-map' with its binding. More precisely, when the
11613 active keymaps have no binding for the current key sequence but
11614 `local-function-key-map' binds a suffix of the sequence to a vector or
11615 string, `read-key-sequence' replaces the matching suffix with its
11616 binding, and continues with the new sequence.
11618 If the binding is a function, it is called with one argument (the prompt)
11619 and its return value (a key sequence) is used.
11621 The events that come from bindings in `local-function-key-map' are not
11622 themselves looked up in `local-function-key-map'.
11624 For example, suppose `local-function-key-map' binds `ESC O P' to [f1].
11625 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
11626 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix key,
11627 typing `ESC O P x' would return [f1 x].
11629 `local-function-key-map' has a separate binding for each terminal
11630 device. See Info node `(elisp)Multiple Terminals'. If you need to
11631 define a binding on all terminals, change `function-key-map'
11632 instead. Initially, `local-function-key-map' is an empty keymap that
11633 has `function-key-map' as its parent on all terminal devices. */);
11635 DEFVAR_KBOARD ("input-decode-map", Vinput_decode_map,
11636 doc: /* Keymap that decodes input escape sequences.
11637 This is used mainly for mapping ASCII function key sequences into
11638 real Emacs function key events (symbols).
11640 The `read-key-sequence' function replaces any subsequence bound by
11641 `input-decode-map' with its binding. Contrary to `function-key-map',
11642 this map applies its rebinding regardless of the presence of an ordinary
11643 binding. So it is more like `key-translation-map' except that it applies
11644 before `function-key-map' rather than after.
11646 If the binding is a function, it is called with one argument (the prompt)
11647 and its return value (a key sequence) is used.
11649 The events that come from bindings in `input-decode-map' are not
11650 themselves looked up in `input-decode-map'. */);
11652 DEFVAR_LISP ("function-key-map", Vfunction_key_map,
11653 doc: /* The parent keymap of all `local-function-key-map' instances.
11654 Function key definitions that apply to all terminal devices should go
11655 here. If a mapping is defined in both the current
11656 `local-function-key-map' binding and this variable, then the local
11657 definition will take precedence. */);
11658 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
11660 DEFVAR_LISP ("key-translation-map", Vkey_translation_map,
11661 doc: /* Keymap of key translations that can override keymaps.
11662 This keymap works like `input-decode-map', but comes after `function-key-map'.
11663 Another difference is that it is global rather than terminal-local. */);
11664 Vkey_translation_map = Fmake_sparse_keymap (Qnil);
11666 DEFVAR_LISP ("deferred-action-list", Vdeferred_action_list,
11667 doc: /* List of deferred actions to be performed at a later time.
11668 The precise format isn't relevant here; we just check whether it is nil. */);
11669 Vdeferred_action_list = Qnil;
11671 DEFVAR_LISP ("deferred-action-function", Vdeferred_action_function,
11672 doc: /* Function to call to handle deferred actions, after each command.
11673 This function is called with no arguments after each command
11674 whenever `deferred-action-list' is non-nil. */);
11675 Vdeferred_action_function = Qnil;
11677 DEFVAR_LISP ("delayed-warnings-list", Vdelayed_warnings_list,
11678 doc: /* List of warnings to be displayed after this command.
11679 Each element must be a list (TYPE MESSAGE [LEVEL [BUFFER-NAME]]),
11680 as per the args of `display-warning' (which see).
11681 If this variable is non-nil, `delayed-warnings-hook' will be run
11682 immediately after running `post-command-hook'. */);
11683 Vdelayed_warnings_list = Qnil;
11685 DEFVAR_LISP ("timer-list", Vtimer_list,
11686 doc: /* List of active absolute time timers in order of increasing time. */);
11687 Vtimer_list = Qnil;
11689 DEFVAR_LISP ("timer-idle-list", Vtimer_idle_list,
11690 doc: /* List of active idle-time timers in order of increasing time. */);
11691 Vtimer_idle_list = Qnil;
11693 DEFVAR_LISP ("input-method-function", Vinput_method_function,
11694 doc: /* If non-nil, the function that implements the current input method.
11695 It's called with one argument, a printing character that was just read.
11696 \(That means a character with code 040...0176.)
11697 Typically this function uses `read-event' to read additional events.
11698 When it does so, it should first bind `input-method-function' to nil
11699 so it will not be called recursively.
11701 The function should return a list of zero or more events
11702 to be used as input. If it wants to put back some events
11703 to be reconsidered, separately, by the input method,
11704 it can add them to the beginning of `unread-command-events'.
11706 The input method function can find in `input-method-previous-message'
11707 the previous echo area message.
11709 The input method function should refer to the variables
11710 `input-method-use-echo-area' and `input-method-exit-on-first-char'
11711 for guidance on what to do. */);
11712 Vinput_method_function = Qlist;
11714 DEFVAR_LISP ("input-method-previous-message",
11715 Vinput_method_previous_message,
11716 doc: /* When `input-method-function' is called, hold the previous echo area message.
11717 This variable exists because `read-event' clears the echo area
11718 before running the input method. It is nil if there was no message. */);
11719 Vinput_method_previous_message = Qnil;
11721 DEFVAR_LISP ("show-help-function", Vshow_help_function,
11722 doc: /* If non-nil, the function that implements the display of help.
11723 It's called with one argument, the help string to display. */);
11724 Vshow_help_function = Qnil;
11726 DEFVAR_LISP ("disable-point-adjustment", Vdisable_point_adjustment,
11727 doc: /* If non-nil, suppress point adjustment after executing a command.
11729 After a command is executed, if point moved into a region that has
11730 special properties (e.g. composition, display), Emacs adjusts point to
11731 the boundary of the region. But when a command leaves this variable at
11732 a non-nil value (e.g., with a setq), this point adjustment is suppressed.
11734 This variable is set to nil before reading a command, and is checked
11735 just after executing the command. */);
11736 Vdisable_point_adjustment = Qnil;
11738 DEFVAR_LISP ("global-disable-point-adjustment",
11739 Vglobal_disable_point_adjustment,
11740 doc: /* If non-nil, always suppress point adjustments.
11742 The default value is nil, in which case point adjustments are
11743 suppressed only after special commands that leave
11744 `disable-point-adjustment' (which see) at a non-nil value. */);
11745 Vglobal_disable_point_adjustment = Qnil;
11747 DEFVAR_LISP ("minibuffer-message-timeout", Vminibuffer_message_timeout,
11748 doc: /* How long to display an echo-area message when the minibuffer is active.
11749 If the value is a number, it should be specified in seconds.
11750 If the value is not a number, such messages never time out. */);
11751 Vminibuffer_message_timeout = make_number (2);
11753 DEFVAR_LISP ("throw-on-input", Vthrow_on_input,
11754 doc: /* If non-nil, any keyboard input throws to this symbol.
11755 The value of that variable is passed to `quit-flag' and later causes a
11756 peculiar kind of quitting. */);
11757 Vthrow_on_input = Qnil;
11759 DEFVAR_LISP ("command-error-function", Vcommand_error_function,
11760 doc: /* Function to output error messages.
11761 Called with three arguments:
11762 - the error data, a list of the form (SIGNALED-CONDITION . SIGNAL-DATA)
11763 such as what `condition-case' would bind its variable to,
11764 - the context (a string which normally goes at the start of the message),
11765 - the Lisp function within which the error was signaled. */);
11766 Vcommand_error_function = intern ("command-error-default-function");
11768 DEFVAR_LISP ("enable-disabled-menus-and-buttons",
11769 Venable_disabled_menus_and_buttons,
11770 doc: /* If non-nil, don't ignore events produced by disabled menu items and tool-bar.
11772 Help functions bind this to allow help on disabled menu items
11773 and tool-bar buttons. */);
11774 Venable_disabled_menus_and_buttons = Qnil;
11776 DEFVAR_LISP ("select-active-regions",
11777 Vselect_active_regions,
11778 doc: /* If non-nil, an active region automatically sets the primary selection.
11779 If the value is `only', only temporarily active regions (usually made
11780 by mouse-dragging or shift-selection) set the window selection.
11782 This takes effect only when Transient Mark mode is enabled. */);
11783 Vselect_active_regions = Qt;
11785 DEFVAR_LISP ("saved-region-selection",
11786 Vsaved_region_selection,
11787 doc: /* Contents of active region prior to buffer modification.
11788 If `select-active-regions' is non-nil, Emacs sets this to the
11789 text in the region before modifying the buffer. The next call to
11790 the function `deactivate-mark' uses this to set the window selection. */);
11791 Vsaved_region_selection = Qnil;
11793 DEFVAR_LISP ("selection-inhibit-update-commands",
11794 Vselection_inhibit_update_commands,
11795 doc: /* List of commands which should not update the selection.
11796 Normally, if `select-active-regions' is non-nil and the mark remains
11797 active after a command (i.e. the mark was not deactivated), the Emacs
11798 command loop sets the selection to the text in the region. However,
11799 if the command is in this list, the selection is not updated. */);
11800 Vselection_inhibit_update_commands
11801 = list2 (Qhandle_switch_frame, Qhandle_select_window);
11803 DEFVAR_LISP ("debug-on-event",
11804 Vdebug_on_event,
11805 doc: /* Enter debugger on this event. When Emacs
11806 receives the special event specified by this variable, it will try to
11807 break into the debugger as soon as possible instead of processing the
11808 event normally through `special-event-map'.
11810 Currently, the only supported values for this
11811 variable are `sigusr1' and `sigusr2'. */);
11812 Vdebug_on_event = intern_c_string ("sigusr2");
11814 DEFVAR_BOOL ("attempt-stack-overflow-recovery",
11815 attempt_stack_overflow_recovery,
11816 doc: /* If non-nil, attempt to recover from C stack
11817 overflow. This recovery is unsafe and may lead to deadlocks or data
11818 corruption, but it usually works and may preserve modified buffers
11819 that would otherwise be lost. If nil, treat stack overflow like any
11820 other kind of crash. */);
11821 attempt_stack_overflow_recovery = true;
11823 DEFVAR_BOOL ("attempt-orderly-shutdown-on-fatal-signal",
11824 attempt_orderly_shutdown_on_fatal_signal,
11825 doc: /* If non-nil, attempt to perform an orderly
11826 shutdown when Emacs receives a fatal signal (e.g., a crash).
11827 This cleanup is unsafe and may lead to deadlocks or data corruption,
11828 but it usually works and may preserve modified buffers that would
11829 otherwise be lost. If nil, crash immediately in response to fatal
11830 signals. */);
11831 attempt_orderly_shutdown_on_fatal_signal = true;
11833 /* Create the initial keyboard. Qt means 'unset'. */
11834 initial_kboard = allocate_kboard (Qt);
11836 DEFVAR_LISP ("while-no-input-ignore-events",
11837 Vwhile_no_input_ignore_events,
11838 doc: /* Ignored events from while-no-input. */);
11839 Vwhile_no_input_ignore_events = Qnil;
11842 void
11843 keys_of_keyboard (void)
11845 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
11846 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
11847 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
11848 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
11849 initial_define_key (meta_map, 'x', "execute-extended-command");
11851 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
11852 "handle-delete-frame");
11853 #ifdef HAVE_NTGUI
11854 initial_define_lispy_key (Vspecial_event_map, "end-session",
11855 "kill-emacs");
11856 #endif
11857 initial_define_lispy_key (Vspecial_event_map, "ns-put-working-text",
11858 "ns-put-working-text");
11859 initial_define_lispy_key (Vspecial_event_map, "ns-unput-working-text",
11860 "ns-unput-working-text");
11861 /* Here we used to use `ignore-event' which would simple set prefix-arg to
11862 current-prefix-arg, as is done in `handle-switch-frame'.
11863 But `handle-switch-frame is not run from the special-map.
11864 Commands from that map are run in a special way that automatically
11865 preserves the prefix-arg. Restoring the prefix arg here is not just
11866 redundant but harmful:
11867 - C-u C-x v =
11868 - current-prefix-arg is set to non-nil, prefix-arg is set to nil.
11869 - after the first prompt, the exit-minibuffer-hook is run which may
11870 iconify a frame and thus push a `iconify-frame' event.
11871 - after running exit-minibuffer-hook, current-prefix-arg is
11872 restored to the non-nil value it had before the prompt.
11873 - we enter the second prompt.
11874 current-prefix-arg is non-nil, prefix-arg is nil.
11875 - before running the first real event, we run the special iconify-frame
11876 event, but we pass the `special' arg to command-execute so
11877 current-prefix-arg and prefix-arg are left untouched.
11878 - here we foolishly copy the non-nil current-prefix-arg to prefix-arg.
11879 - the next key event will have a spuriously non-nil current-prefix-arg. */
11880 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
11881 "ignore");
11882 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
11883 "ignore");
11884 /* Handling it at such a low-level causes read_key_sequence to get
11885 * confused because it doesn't realize that the current_buffer was
11886 * changed by read_char.
11888 * initial_define_lispy_key (Vspecial_event_map, "select-window",
11889 * "handle-select-window"); */
11890 initial_define_lispy_key (Vspecial_event_map, "save-session",
11891 "handle-save-session");
11893 #ifdef HAVE_DBUS
11894 /* Define a special event which is raised for dbus callback
11895 functions. */
11896 initial_define_lispy_key (Vspecial_event_map, "dbus-event",
11897 "dbus-handle-event");
11898 #endif
11900 #ifdef USE_FILE_NOTIFY
11901 /* Define a special event which is raised for notification callback
11902 functions. */
11903 initial_define_lispy_key (Vspecial_event_map, "file-notify",
11904 "file-notify-handle-event");
11905 #endif /* USE_FILE_NOTIFY */
11907 initial_define_lispy_key (Vspecial_event_map, "config-changed-event",
11908 "ignore");
11909 #if defined (WINDOWSNT)
11910 initial_define_lispy_key (Vspecial_event_map, "language-change",
11911 "ignore");
11912 #endif
11913 initial_define_lispy_key (Vspecial_event_map, "focus-in",
11914 "handle-focus-in");
11915 initial_define_lispy_key (Vspecial_event_map, "focus-out",
11916 "handle-focus-out");
11919 /* Mark the pointers in the kboard objects.
11920 Called by Fgarbage_collect. */
11921 void
11922 mark_kboards (void)
11924 KBOARD *kb;
11925 Lisp_Object *p;
11926 for (kb = all_kboards; kb; kb = kb->next_kboard)
11928 if (kb->kbd_macro_buffer)
11929 for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
11930 mark_object (*p);
11931 mark_object (KVAR (kb, Voverriding_terminal_local_map));
11932 mark_object (KVAR (kb, Vlast_command));
11933 mark_object (KVAR (kb, Vreal_last_command));
11934 mark_object (KVAR (kb, Vkeyboard_translate_table));
11935 mark_object (KVAR (kb, Vlast_repeatable_command));
11936 mark_object (KVAR (kb, Vprefix_arg));
11937 mark_object (KVAR (kb, Vlast_prefix_arg));
11938 mark_object (KVAR (kb, kbd_queue));
11939 mark_object (KVAR (kb, defining_kbd_macro));
11940 mark_object (KVAR (kb, Vlast_kbd_macro));
11941 mark_object (KVAR (kb, Vsystem_key_alist));
11942 mark_object (KVAR (kb, system_key_syms));
11943 mark_object (KVAR (kb, Vwindow_system));
11944 mark_object (KVAR (kb, Vinput_decode_map));
11945 mark_object (KVAR (kb, Vlocal_function_key_map));
11946 mark_object (KVAR (kb, Vdefault_minibuffer_frame));
11947 mark_object (KVAR (kb, echo_string));
11948 mark_object (KVAR (kb, echo_prompt));
11951 union buffered_input_event *event;
11952 for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++)
11954 if (event == kbd_buffer + KBD_BUFFER_SIZE)
11955 event = kbd_buffer;
11956 /* These two special event types has no Lisp_Objects to mark. */
11957 if (event->kind != SELECTION_REQUEST_EVENT
11958 && event->kind != SELECTION_CLEAR_EVENT)
11960 mark_object (event->ie.x);
11961 mark_object (event->ie.y);
11962 mark_object (event->ie.frame_or_window);
11963 mark_object (event->ie.arg);