Update copyright year to 2015
[emacs.git] / src / keyboard.c
blob43a0dc974040bb45ba341e08123ccaab57f302cf
1 /* Keyboard and mouse input; editor command loop.
3 Copyright (C) 1985-1989, 1993-1997, 1999-2015 Free Software Foundation,
4 Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
23 #include "sysstdio.h"
24 #include <sys/stat.h>
26 #include "lisp.h"
27 #include "termchar.h"
28 #include "termopts.h"
29 #include "frame.h"
30 #include "termhooks.h"
31 #include "macros.h"
32 #include "keyboard.h"
33 #include "window.h"
34 #include "commands.h"
35 #include "character.h"
36 #include "buffer.h"
37 #include "disptab.h"
38 #include "dispextern.h"
39 #include "syntax.h"
40 #include "intervals.h"
41 #include "keymap.h"
42 #include "blockinput.h"
43 #include "puresize.h"
44 #include "systime.h"
45 #include "atimer.h"
46 #include "process.h"
47 #include <errno.h>
49 #ifdef HAVE_PTHREAD
50 #include <pthread.h>
51 #endif
52 #ifdef MSDOS
53 #include "msdos.h"
54 #include <time.h>
55 #else /* not MSDOS */
56 #include <sys/ioctl.h>
57 #endif /* not MSDOS */
59 #if defined USABLE_FIONREAD && defined USG5_4
60 # include <sys/filio.h>
61 #endif
63 #include "syssignal.h"
65 #include <sys/types.h>
66 #include <unistd.h>
67 #include <fcntl.h>
69 #ifdef HAVE_WINDOW_SYSTEM
70 #include TERM_HEADER
71 #endif /* HAVE_WINDOW_SYSTEM */
73 /* Variables for blockinput.h: */
75 /* Positive if interrupt input is blocked right now. */
76 volatile int interrupt_input_blocked;
78 /* True means an input interrupt or alarm signal has arrived.
79 The QUIT macro checks this. */
80 volatile bool pending_signals;
82 #define KBD_BUFFER_SIZE 4096
84 KBOARD *initial_kboard;
85 KBOARD *current_kboard;
86 static KBOARD *all_kboards;
88 /* True in the single-kboard state, false in the any-kboard state. */
89 static bool single_kboard;
91 /* Non-nil disable property on a command means
92 do not execute it; call disabled-command-function's value instead. */
93 Lisp_Object Qdisabled;
94 static Lisp_Object Qdisabled_command_function;
96 #define NUM_RECENT_KEYS (300)
98 /* Index for storing next element into recent_keys. */
99 static int recent_keys_index;
101 /* Total number of elements stored into recent_keys. */
102 static int total_keys;
104 /* This vector holds the last NUM_RECENT_KEYS keystrokes. */
105 static Lisp_Object recent_keys;
107 /* Vector holding the key sequence that invoked the current command.
108 It is reused for each command, and it may be longer than the current
109 sequence; this_command_key_count indicates how many elements
110 actually mean something.
111 It's easier to staticpro a single Lisp_Object than an array. */
112 Lisp_Object this_command_keys;
113 ptrdiff_t this_command_key_count;
115 /* True after calling Freset_this_command_lengths.
116 Usually it is false. */
117 static bool this_command_key_count_reset;
119 /* This vector is used as a buffer to record the events that were actually read
120 by read_key_sequence. */
121 static Lisp_Object raw_keybuf;
122 static int raw_keybuf_count;
124 #define GROW_RAW_KEYBUF \
125 if (raw_keybuf_count == ASIZE (raw_keybuf)) \
126 raw_keybuf = larger_vector (raw_keybuf, 1, -1)
128 /* Number of elements of this_command_keys
129 that precede this key sequence. */
130 static ptrdiff_t this_single_command_key_start;
132 /* Record values of this_command_key_count and echo_length ()
133 before this command was read. */
134 static ptrdiff_t before_command_key_count;
135 static ptrdiff_t before_command_echo_length;
137 #ifdef HAVE_STACK_OVERFLOW_HANDLING
139 /* For longjmp to recover from C stack overflow. */
140 sigjmp_buf return_to_command_loop;
142 /* Message displayed by Vtop_level when recovering from C stack overflow. */
143 static Lisp_Object recover_top_level_message;
145 #endif /* HAVE_STACK_OVERFLOW_HANDLING */
147 /* Message normally displayed by Vtop_level. */
148 static Lisp_Object regular_top_level_message;
150 /* For longjmp to where kbd input is being done. */
152 static sys_jmp_buf getcjmp;
154 /* True while doing kbd input. */
155 bool waiting_for_input;
157 /* True while displaying for echoing. Delays C-g throwing. */
159 static bool echoing;
161 /* Non-null means we can start echoing at the next input pause even
162 though there is something in the echo area. */
164 static struct kboard *ok_to_echo_at_next_pause;
166 /* The kboard last echoing, or null for none. Reset to 0 in
167 cancel_echoing. If non-null, and a current echo area message
168 exists, and echo_message_buffer is eq to the current message
169 buffer, we know that the message comes from echo_kboard. */
171 struct kboard *echo_kboard;
173 /* The buffer used for echoing. Set in echo_now, reset in
174 cancel_echoing. */
176 Lisp_Object echo_message_buffer;
178 /* True means C-g should cause immediate error-signal. */
179 bool immediate_quit;
181 /* Character that causes a quit. Normally C-g.
183 If we are running on an ordinary terminal, this must be an ordinary
184 ASCII char, since we want to make it our interrupt character.
186 If we are not running on an ordinary terminal, it still needs to be
187 an ordinary ASCII char. This character needs to be recognized in
188 the input interrupt handler. At this point, the keystroke is
189 represented as a struct input_event, while the desired quit
190 character is specified as a lispy event. The mapping from struct
191 input_events to lispy events cannot run in an interrupt handler,
192 and the reverse mapping is difficult for anything but ASCII
193 keystrokes.
195 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
196 ASCII character. */
197 int quit_char;
199 /* Current depth in recursive edits. */
200 EMACS_INT command_loop_level;
202 /* If not Qnil, this is a switch-frame event which we decided to put
203 off until the end of a key sequence. This should be read as the
204 next command input, after any unread_command_events.
206 read_key_sequence uses this to delay switch-frame events until the
207 end of the key sequence; Fread_char uses it to put off switch-frame
208 events until a non-ASCII event is acceptable as input. */
209 Lisp_Object unread_switch_frame;
211 /* Last size recorded for a current buffer which is not a minibuffer. */
212 static ptrdiff_t last_non_minibuf_size;
214 /* Total number of times read_char has returned, modulo UINTMAX_MAX + 1. */
215 uintmax_t num_input_events;
217 /* Value of num_nonmacro_input_events as of last auto save. */
219 static EMACS_INT last_auto_save;
221 /* The value of point when the last command was started. */
222 static ptrdiff_t last_point_position;
224 /* The frame in which the last input event occurred, or Qmacro if the
225 last event came from a macro. We use this to determine when to
226 generate switch-frame events. This may be cleared by functions
227 like Fselect_frame, to make sure that a switch-frame event is
228 generated by the next character.
230 FIXME: This is modified by a signal handler so it should be volatile.
231 It's exported to Lisp, though, so it can't simply be marked
232 'volatile' here. */
233 Lisp_Object internal_last_event_frame;
235 static Lisp_Object Qgui_set_selection, Qhandle_switch_frame;
236 static Lisp_Object Qhandle_select_window;
237 Lisp_Object QPRIMARY;
239 static Lisp_Object Qself_insert_command;
240 static Lisp_Object Qforward_char;
241 static Lisp_Object Qbackward_char;
242 Lisp_Object Qundefined;
243 static Lisp_Object Qtimer_event_handler;
245 /* `read_key_sequence' stores here the command definition of the
246 key sequence that it reads. */
247 static Lisp_Object read_key_sequence_cmd;
248 static Lisp_Object read_key_sequence_remapped;
250 static Lisp_Object Qinput_method_function;
252 static Lisp_Object Qdeactivate_mark;
254 Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
256 static Lisp_Object Qecho_area_clear_hook;
258 /* Hooks to run before and after each command. */
259 static Lisp_Object Qpre_command_hook;
260 static Lisp_Object Qpost_command_hook;
262 static Lisp_Object Qdeferred_action_function;
264 static Lisp_Object Qdelayed_warnings_hook;
266 static Lisp_Object Qinput_method_exit_on_first_char;
267 static Lisp_Object Qinput_method_use_echo_area;
269 static Lisp_Object Qhelp_form_show;
271 /* File in which we write all commands we read. */
272 static FILE *dribble;
274 /* True if input is available. */
275 bool input_pending;
277 /* True if more input was available last time we read an event.
279 Since redisplay can take a significant amount of time and is not
280 indispensable to perform the user's commands, when input arrives
281 "too fast", Emacs skips redisplay. More specifically, if the next
282 command has already been input when we finish the previous command,
283 we skip the intermediate redisplay.
285 This is useful to try and make sure Emacs keeps up with fast input
286 rates, such as auto-repeating keys. But in some cases, this proves
287 too conservative: we may end up disabling redisplay for the whole
288 duration of a key repetition, even though we could afford to
289 redisplay every once in a while.
291 So we "sample" the input_pending flag before running a command and
292 use *that* value after running the command to decide whether to
293 skip redisplay or not. This way, we only skip redisplay if we
294 really can't keep up with the repeat rate.
296 This only makes a difference if the next input arrives while running the
297 command, which is very unlikely if the command is executed quickly.
298 IOW this tends to avoid skipping redisplay after a long running command
299 (which is a case where skipping redisplay is not very useful since the
300 redisplay time is small compared to the time it took to run the command).
302 A typical use case is when scrolling. Scrolling time can be split into:
303 - Time to do jit-lock on the newly displayed portion of buffer.
304 - Time to run the actual scroll command.
305 - Time to perform the redisplay.
306 Jit-lock can happen either during the command or during the redisplay.
307 In the most painful cases, the jit-lock time is the one that dominates.
308 Also jit-lock can be tweaked (via jit-lock-defer) to delay its job, at the
309 cost of temporary inaccuracy in display and scrolling.
310 So without input_was_pending, what typically happens is the following:
311 - when the command starts, there's no pending input (yet).
312 - the scroll command triggers jit-lock.
313 - during the long jit-lock time the next input arrives.
314 - at the end of the command, we check input_pending and hence decide to
315 skip redisplay.
316 - we read the next input and start over.
317 End result: all the hard work of jit-locking is "wasted" since redisplay
318 doesn't actually happens (at least not before the input rate slows down).
319 With input_was_pending redisplay is still skipped if Emacs can't keep up
320 with the input rate, but if it can keep up just enough that there's no
321 input_pending when we begin the command, then redisplay is not skipped
322 which results in better feedback to the user. */
323 static bool input_was_pending;
325 /* Circular buffer for pre-read keyboard input. */
327 static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
329 /* Pointer to next available character in kbd_buffer.
330 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
331 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the
332 next available char is in kbd_buffer[0]. */
333 static struct input_event *kbd_fetch_ptr;
335 /* Pointer to next place to store character in kbd_buffer. This
336 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
337 character should go in kbd_buffer[0]. */
338 static struct input_event * volatile kbd_store_ptr;
340 /* The above pair of variables forms a "queue empty" flag. When we
341 enqueue a non-hook event, we increment kbd_store_ptr. When we
342 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
343 there is input available if the two pointers are not equal.
345 Why not just have a flag set and cleared by the enqueuing and
346 dequeuing functions? Such a flag could be screwed up by interrupts
347 at inopportune times. */
349 /* Symbols to head events. */
350 static Lisp_Object Qmouse_movement;
351 static Lisp_Object Qscroll_bar_movement;
352 Lisp_Object Qswitch_frame;
353 static Lisp_Object Qfocus_in, Qfocus_out;
354 static Lisp_Object Qdelete_frame;
355 static Lisp_Object Qiconify_frame;
356 static Lisp_Object Qmake_frame_visible;
357 static Lisp_Object Qselect_window;
358 Lisp_Object Qhelp_echo;
360 static Lisp_Object Qmouse_fixup_help_message;
362 /* Symbols to denote kinds of events. */
363 static Lisp_Object Qfunction_key;
364 Lisp_Object Qmouse_click;
365 #ifdef HAVE_NTGUI
366 Lisp_Object Qlanguage_change;
367 #endif
368 static Lisp_Object Qdrag_n_drop;
369 static Lisp_Object Qsave_session;
370 #ifdef HAVE_DBUS
371 static Lisp_Object Qdbus_event;
372 #endif
373 #ifdef USE_FILE_NOTIFY
374 static Lisp_Object Qfile_notify;
375 #endif /* USE_FILE_NOTIFY */
376 static Lisp_Object Qconfig_changed_event;
378 /* Lisp_Object Qmouse_movement; - also an event header */
380 /* Properties of event headers. */
381 Lisp_Object Qevent_kind;
382 static Lisp_Object Qevent_symbol_elements;
384 /* Menu and tool bar item parts. */
385 static Lisp_Object Qmenu_enable;
386 static Lisp_Object QCenable, QCvisible, QChelp, QCkeys, QCkey_sequence;
387 Lisp_Object QCfilter;
389 /* Non-nil disable property on a command means
390 do not execute it; call disabled-command-function's value instead. */
391 Lisp_Object QCtoggle, QCradio;
392 static Lisp_Object QCbutton, QClabel;
394 static Lisp_Object QCvert_only;
396 /* An event header symbol HEAD may have a property named
397 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
398 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
399 mask of modifiers applied to it. If present, this is used to help
400 speed up parse_modifiers. */
401 Lisp_Object Qevent_symbol_element_mask;
403 /* An unmodified event header BASE may have a property named
404 Qmodifier_cache, which is an alist mapping modifier masks onto
405 modified versions of BASE. If present, this helps speed up
406 apply_modifiers. */
407 static Lisp_Object Qmodifier_cache;
409 /* Symbols to use for parts of windows. */
410 Lisp_Object Qmode_line;
411 Lisp_Object Qvertical_line;
412 Lisp_Object Qright_divider, Qbottom_divider;
413 Lisp_Object Qmenu_bar;
415 static Lisp_Object Qecho_keystrokes;
417 static void recursive_edit_unwind (Lisp_Object buffer);
418 static Lisp_Object command_loop (void);
419 static Lisp_Object Qcommand_execute;
421 static void echo_now (void);
422 static ptrdiff_t echo_length (void);
424 static Lisp_Object Qpolling_period;
426 /* Incremented whenever a timer is run. */
427 unsigned timers_run;
429 /* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt
430 happens. */
431 struct timespec *input_available_clear_time;
433 /* True means use SIGIO interrupts; false means use CBREAK mode.
434 Default is true if INTERRUPT_INPUT is defined. */
435 bool interrupt_input;
437 /* Nonzero while interrupts are temporarily deferred during redisplay. */
438 bool interrupts_deferred;
440 /* The time when Emacs started being idle. */
442 static struct timespec timer_idleness_start_time;
444 /* After Emacs stops being idle, this saves the last value
445 of timer_idleness_start_time from when it was idle. */
447 static struct timespec timer_last_idleness_start_time;
450 /* Global variable declarations. */
452 /* Flags for readable_events. */
453 #define READABLE_EVENTS_DO_TIMERS_NOW (1 << 0)
454 #define READABLE_EVENTS_FILTER_EVENTS (1 << 1)
455 #define READABLE_EVENTS_IGNORE_SQUEEZABLES (1 << 2)
457 /* Function for init_keyboard to call with no args (if nonzero). */
458 static void (*keyboard_init_hook) (void);
460 static bool get_input_pending (int);
461 static bool readable_events (int);
462 static Lisp_Object read_char_x_menu_prompt (Lisp_Object,
463 Lisp_Object, bool *);
464 static Lisp_Object read_char_minibuf_menu_prompt (int, Lisp_Object);
465 static Lisp_Object make_lispy_event (struct input_event *);
466 static Lisp_Object make_lispy_movement (struct frame *, Lisp_Object,
467 enum scroll_bar_part,
468 Lisp_Object, Lisp_Object,
469 Time);
470 static Lisp_Object modify_event_symbol (ptrdiff_t, int, Lisp_Object,
471 Lisp_Object, const char *const *,
472 Lisp_Object *, ptrdiff_t);
473 static Lisp_Object make_lispy_switch_frame (Lisp_Object);
474 static Lisp_Object make_lispy_focus_in (Lisp_Object);
475 #ifdef HAVE_WINDOW_SYSTEM
476 static Lisp_Object make_lispy_focus_out (Lisp_Object);
477 #endif /* HAVE_WINDOW_SYSTEM */
478 static bool help_char_p (Lisp_Object);
479 static void save_getcjmp (sys_jmp_buf);
480 static void restore_getcjmp (sys_jmp_buf);
481 static Lisp_Object apply_modifiers (int, Lisp_Object);
482 static void clear_event (struct input_event *);
483 static void restore_kboard_configuration (int);
484 #ifdef USABLE_SIGIO
485 static void deliver_input_available_signal (int signo);
486 #endif
487 static void handle_interrupt (bool);
488 static _Noreturn void quit_throw_to_read_char (bool);
489 static void process_special_events (void);
490 static void timer_start_idle (void);
491 static void timer_stop_idle (void);
492 static void timer_resume_idle (void);
493 static void deliver_user_signal (int);
494 static char *find_user_signal_name (int);
495 static void store_user_signal_events (void);
497 /* These setters are used only in this file, so they can be private. */
498 static void
499 kset_echo_string (struct kboard *kb, Lisp_Object val)
501 kb->INTERNAL_FIELD (echo_string) = val;
503 static void
504 kset_kbd_queue (struct kboard *kb, Lisp_Object val)
506 kb->INTERNAL_FIELD (kbd_queue) = val;
508 static void
509 kset_keyboard_translate_table (struct kboard *kb, Lisp_Object val)
511 kb->INTERNAL_FIELD (Vkeyboard_translate_table) = val;
513 static void
514 kset_last_prefix_arg (struct kboard *kb, Lisp_Object val)
516 kb->INTERNAL_FIELD (Vlast_prefix_arg) = val;
518 static void
519 kset_last_repeatable_command (struct kboard *kb, Lisp_Object val)
521 kb->INTERNAL_FIELD (Vlast_repeatable_command) = val;
523 static void
524 kset_local_function_key_map (struct kboard *kb, Lisp_Object val)
526 kb->INTERNAL_FIELD (Vlocal_function_key_map) = val;
528 static void
529 kset_overriding_terminal_local_map (struct kboard *kb, Lisp_Object val)
531 kb->INTERNAL_FIELD (Voverriding_terminal_local_map) = val;
533 static void
534 kset_real_last_command (struct kboard *kb, Lisp_Object val)
536 kb->INTERNAL_FIELD (Vreal_last_command) = val;
538 static void
539 kset_system_key_syms (struct kboard *kb, Lisp_Object val)
541 kb->INTERNAL_FIELD (system_key_syms) = val;
545 /* Add C to the echo string, without echoing it immediately. C can be
546 a character, which is pretty-printed, or a symbol, whose name is
547 printed. */
549 static void
550 echo_add_key (Lisp_Object c)
552 char initbuf[KEY_DESCRIPTION_SIZE + 100];
553 ptrdiff_t size = sizeof initbuf;
554 char *buffer = initbuf;
555 char *ptr = buffer;
556 Lisp_Object echo_string;
557 USE_SAFE_ALLOCA;
559 echo_string = KVAR (current_kboard, echo_string);
561 /* If someone has passed us a composite event, use its head symbol. */
562 c = EVENT_HEAD (c);
564 if (INTEGERP (c))
565 ptr = push_key_description (XINT (c), ptr);
566 else if (SYMBOLP (c))
568 Lisp_Object name = SYMBOL_NAME (c);
569 ptrdiff_t nbytes = SBYTES (name);
571 if (size - (ptr - buffer) < nbytes)
573 ptrdiff_t offset = ptr - buffer;
574 size = max (2 * size, size + nbytes);
575 buffer = SAFE_ALLOCA (size);
576 ptr = buffer + offset;
579 ptr += copy_text (SDATA (name), (unsigned char *) ptr, nbytes,
580 STRING_MULTIBYTE (name), 1);
583 if ((NILP (echo_string) || SCHARS (echo_string) == 0)
584 && help_char_p (c))
586 static const char text[] = " (Type ? for further options)";
587 int len = sizeof text - 1;
589 if (size - (ptr - buffer) < len)
591 ptrdiff_t offset = ptr - buffer;
592 size += len;
593 buffer = SAFE_ALLOCA (size);
594 ptr = buffer + offset;
597 memcpy (ptr, text, len);
598 ptr += len;
601 /* Replace a dash from echo_dash with a space, otherwise add a space
602 at the end as a separator between keys. */
603 AUTO_STRING (space, " ");
604 if (STRINGP (echo_string) && SCHARS (echo_string) > 1)
606 Lisp_Object last_char, prev_char, idx;
608 idx = make_number (SCHARS (echo_string) - 2);
609 prev_char = Faref (echo_string, idx);
611 idx = make_number (SCHARS (echo_string) - 1);
612 last_char = Faref (echo_string, idx);
614 /* We test PREV_CHAR to make sure this isn't the echoing of a
615 minus-sign. */
616 if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
617 Faset (echo_string, idx, make_number (' '));
618 else
619 echo_string = concat2 (echo_string, space);
621 else if (STRINGP (echo_string) && SCHARS (echo_string) > 0)
622 echo_string = concat2 (echo_string, space);
624 kset_echo_string
625 (current_kboard,
626 concat2 (echo_string, make_string (buffer, ptr - buffer)));
627 SAFE_FREE ();
630 /* Add C to the echo string, if echoing is going on. C can be a
631 character or a symbol. */
633 static void
634 echo_char (Lisp_Object c)
636 if (current_kboard->immediate_echo)
638 echo_add_key (c);
639 echo_now ();
643 /* Temporarily add a dash to the end of the echo string if it's not
644 empty, so that it serves as a mini-prompt for the very next
645 character. */
647 static void
648 echo_dash (void)
650 /* Do nothing if not echoing at all. */
651 if (NILP (KVAR (current_kboard, echo_string)))
652 return;
654 if (this_command_key_count == 0)
655 return;
657 if (!current_kboard->immediate_echo
658 && SCHARS (KVAR (current_kboard, echo_string)) == 0)
659 return;
661 /* Do nothing if we just printed a prompt. */
662 if (current_kboard->echo_after_prompt
663 == SCHARS (KVAR (current_kboard, echo_string)))
664 return;
666 /* Do nothing if we have already put a dash at the end. */
667 if (SCHARS (KVAR (current_kboard, echo_string)) > 1)
669 Lisp_Object last_char, prev_char, idx;
671 idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 2);
672 prev_char = Faref (KVAR (current_kboard, echo_string), idx);
674 idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 1);
675 last_char = Faref (KVAR (current_kboard, echo_string), idx);
677 if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
678 return;
681 /* Put a dash at the end of the buffer temporarily,
682 but make it go away when the next character is added. */
683 AUTO_STRING (dash, "-");
684 kset_echo_string (current_kboard,
685 concat2 (KVAR (current_kboard, echo_string), dash));
686 echo_now ();
689 /* Display the current echo string, and begin echoing if not already
690 doing so. */
692 static void
693 echo_now (void)
695 if (!current_kboard->immediate_echo)
697 ptrdiff_t i;
698 current_kboard->immediate_echo = 1;
700 for (i = 0; i < this_command_key_count; i++)
702 Lisp_Object c;
704 /* Set before_command_echo_length to the value that would
705 have been saved before the start of this subcommand in
706 command_loop_1, if we had already been echoing then. */
707 if (i == this_single_command_key_start)
708 before_command_echo_length = echo_length ();
710 c = AREF (this_command_keys, i);
711 if (! (EVENT_HAS_PARAMETERS (c)
712 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
713 echo_char (c);
716 /* Set before_command_echo_length to the value that would
717 have been saved before the start of this subcommand in
718 command_loop_1, if we had already been echoing then. */
719 if (this_command_key_count == this_single_command_key_start)
720 before_command_echo_length = echo_length ();
722 /* Put a dash at the end to invite the user to type more. */
723 echo_dash ();
726 echoing = 1;
727 /* FIXME: Use call (Qmessage) so it can be advised (e.g. emacspeak). */
728 message3_nolog (KVAR (current_kboard, echo_string));
729 echoing = 0;
731 /* Record in what buffer we echoed, and from which kboard. */
732 echo_message_buffer = echo_area_buffer[0];
733 echo_kboard = current_kboard;
735 if (waiting_for_input && !NILP (Vquit_flag))
736 quit_throw_to_read_char (0);
739 /* Turn off echoing, for the start of a new command. */
741 void
742 cancel_echoing (void)
744 current_kboard->immediate_echo = 0;
745 current_kboard->echo_after_prompt = -1;
746 kset_echo_string (current_kboard, Qnil);
747 ok_to_echo_at_next_pause = NULL;
748 echo_kboard = NULL;
749 echo_message_buffer = Qnil;
752 /* Return the length of the current echo string. */
754 static ptrdiff_t
755 echo_length (void)
757 return (STRINGP (KVAR (current_kboard, echo_string))
758 ? SCHARS (KVAR (current_kboard, echo_string))
759 : 0);
762 /* Truncate the current echo message to its first LEN chars.
763 This and echo_char get used by read_key_sequence when the user
764 switches frames while entering a key sequence. */
766 static void
767 echo_truncate (ptrdiff_t nchars)
769 if (STRINGP (KVAR (current_kboard, echo_string)))
770 kset_echo_string (current_kboard,
771 Fsubstring (KVAR (current_kboard, echo_string),
772 make_number (0), make_number (nchars)));
773 truncate_echo_area (nchars);
777 /* Functions for manipulating this_command_keys. */
778 static void
779 add_command_key (Lisp_Object key)
781 #if 0 /* Not needed after we made Freset_this_command_lengths
782 do the job immediately. */
783 /* If reset-this-command-length was called recently, obey it now.
784 See the doc string of that function for an explanation of why. */
785 if (before_command_restore_flag)
787 this_command_key_count = before_command_key_count_1;
788 if (this_command_key_count < this_single_command_key_start)
789 this_single_command_key_start = this_command_key_count;
790 echo_truncate (before_command_echo_length_1);
791 before_command_restore_flag = 0;
793 #endif
795 if (this_command_key_count >= ASIZE (this_command_keys))
796 this_command_keys = larger_vector (this_command_keys, 1, -1);
798 ASET (this_command_keys, this_command_key_count, key);
799 ++this_command_key_count;
803 Lisp_Object
804 recursive_edit_1 (void)
806 ptrdiff_t count = SPECPDL_INDEX ();
807 Lisp_Object val;
809 if (command_loop_level > 0)
811 specbind (Qstandard_output, Qt);
812 specbind (Qstandard_input, Qt);
815 #ifdef HAVE_WINDOW_SYSTEM
816 /* The command loop has started an hourglass timer, so we have to
817 cancel it here, otherwise it will fire because the recursive edit
818 can take some time. Do not check for display_hourglass_p here,
819 because it could already be nil. */
820 cancel_hourglass ();
821 #endif
823 /* This function may have been called from a debugger called from
824 within redisplay, for instance by Edebugging a function called
825 from fontification-functions. We want to allow redisplay in
826 the debugging session.
828 The recursive edit is left with a `(throw exit ...)'. The `exit'
829 tag is not caught anywhere in redisplay, i.e. when we leave the
830 recursive edit, the original redisplay leading to the recursive
831 edit will be unwound. The outcome should therefore be safe. */
832 specbind (Qinhibit_redisplay, Qnil);
833 redisplaying_p = 0;
835 val = command_loop ();
836 if (EQ (val, Qt))
837 Fsignal (Qquit, Qnil);
838 /* Handle throw from read_minibuf when using minibuffer
839 while it's active but we're in another window. */
840 if (STRINGP (val))
841 xsignal1 (Qerror, val);
843 return unbind_to (count, Qnil);
846 /* When an auto-save happens, record the "time", and don't do again soon. */
848 void
849 record_auto_save (void)
851 last_auto_save = num_nonmacro_input_events;
854 /* Make an auto save happen as soon as possible at command level. */
856 #ifdef SIGDANGER
857 void
858 force_auto_save_soon (void)
860 last_auto_save = - auto_save_interval - 1;
862 record_asynch_buffer_change ();
864 #endif
866 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
867 doc: /* Invoke the editor command loop recursively.
868 To get out of the recursive edit, a command can throw to `exit' -- for
869 instance `(throw 'exit nil)'.
870 If you throw a value other than t, `recursive-edit' returns normally
871 to the function that called it. Throwing a t value causes
872 `recursive-edit' to quit, so that control returns to the command loop
873 one level up.
875 This function is called by the editor initialization to begin editing. */)
876 (void)
878 ptrdiff_t count = SPECPDL_INDEX ();
879 Lisp_Object buffer;
881 /* If we enter while input is blocked, don't lock up here.
882 This may happen through the debugger during redisplay. */
883 if (input_blocked_p ())
884 return Qnil;
886 if (command_loop_level >= 0
887 && current_buffer != XBUFFER (XWINDOW (selected_window)->contents))
888 buffer = Fcurrent_buffer ();
889 else
890 buffer = Qnil;
892 /* Don't do anything interesting between the increment and the
893 record_unwind_protect! Otherwise, we could get distracted and
894 never decrement the counter again. */
895 command_loop_level++;
896 update_mode_lines = 17;
897 record_unwind_protect (recursive_edit_unwind, buffer);
899 /* If we leave recursive_edit_1 below with a `throw' for instance,
900 like it is done in the splash screen display, we have to
901 make sure that we restore single_kboard as command_loop_1
902 would have done if it were left normally. */
903 if (command_loop_level > 0)
904 temporarily_switch_to_single_kboard (SELECTED_FRAME ());
906 recursive_edit_1 ();
907 return unbind_to (count, Qnil);
910 void
911 recursive_edit_unwind (Lisp_Object buffer)
913 if (BUFFERP (buffer))
914 Fset_buffer (buffer);
916 command_loop_level--;
917 update_mode_lines = 18;
921 #if 0 /* These two functions are now replaced with
922 temporarily_switch_to_single_kboard. */
923 static void
924 any_kboard_state ()
926 #if 0 /* Theory: if there's anything in Vunread_command_events,
927 it will right away be read by read_key_sequence,
928 and then if we do switch KBOARDS, it will go into the side
929 queue then. So we don't need to do anything special here -- rms. */
930 if (CONSP (Vunread_command_events))
932 current_kboard->kbd_queue
933 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
934 current_kboard->kbd_queue_has_data = 1;
936 Vunread_command_events = Qnil;
937 #endif
938 single_kboard = 0;
941 /* Switch to the single-kboard state, making current_kboard
942 the only KBOARD from which further input is accepted. */
944 void
945 single_kboard_state ()
947 single_kboard = 1;
949 #endif
951 /* If we're in single_kboard state for kboard KBOARD,
952 get out of it. */
954 void
955 not_single_kboard_state (KBOARD *kboard)
957 if (kboard == current_kboard)
958 single_kboard = 0;
961 /* Maintain a stack of kboards, so other parts of Emacs
962 can switch temporarily to the kboard of a given frame
963 and then revert to the previous status. */
965 struct kboard_stack
967 KBOARD *kboard;
968 struct kboard_stack *next;
971 static struct kboard_stack *kboard_stack;
973 void
974 push_kboard (struct kboard *k)
976 struct kboard_stack *p = xmalloc (sizeof *p);
978 p->next = kboard_stack;
979 p->kboard = current_kboard;
980 kboard_stack = p;
982 current_kboard = k;
985 void
986 pop_kboard (void)
988 struct terminal *t;
989 struct kboard_stack *p = kboard_stack;
990 bool found = 0;
991 for (t = terminal_list; t; t = t->next_terminal)
993 if (t->kboard == p->kboard)
995 current_kboard = p->kboard;
996 found = 1;
997 break;
1000 if (!found)
1002 /* The terminal we remembered has been deleted. */
1003 current_kboard = FRAME_KBOARD (SELECTED_FRAME ());
1004 single_kboard = 0;
1006 kboard_stack = p->next;
1007 xfree (p);
1010 /* Switch to single_kboard mode, making current_kboard the only KBOARD
1011 from which further input is accepted. If F is non-nil, set its
1012 KBOARD as the current keyboard.
1014 This function uses record_unwind_protect_int to return to the previous
1015 state later.
1017 If Emacs is already in single_kboard mode, and F's keyboard is
1018 locked, then this function will throw an error. */
1020 void
1021 temporarily_switch_to_single_kboard (struct frame *f)
1023 bool was_locked = single_kboard;
1024 if (was_locked)
1026 if (f != NULL && FRAME_KBOARD (f) != current_kboard)
1027 /* We can not switch keyboards while in single_kboard mode.
1028 In rare cases, Lisp code may call `recursive-edit' (or
1029 `read-minibuffer' or `y-or-n-p') after it switched to a
1030 locked frame. For example, this is likely to happen
1031 when server.el connects to a new terminal while Emacs is in
1032 single_kboard mode. It is best to throw an error instead
1033 of presenting the user with a frozen screen. */
1034 error ("Terminal %d is locked, cannot read from it",
1035 FRAME_TERMINAL (f)->id);
1036 else
1037 /* This call is unnecessary, but helps
1038 `restore_kboard_configuration' discover if somebody changed
1039 `current_kboard' behind our back. */
1040 push_kboard (current_kboard);
1042 else if (f != NULL)
1043 current_kboard = FRAME_KBOARD (f);
1044 single_kboard = 1;
1045 record_unwind_protect_int (restore_kboard_configuration, was_locked);
1048 #if 0 /* This function is not needed anymore. */
1049 void
1050 record_single_kboard_state ()
1052 if (single_kboard)
1053 push_kboard (current_kboard);
1054 record_unwind_protect_int (restore_kboard_configuration, single_kboard);
1056 #endif
1058 static void
1059 restore_kboard_configuration (int was_locked)
1061 single_kboard = was_locked;
1062 if (was_locked)
1064 struct kboard *prev = current_kboard;
1065 pop_kboard ();
1066 /* The pop should not change the kboard. */
1067 if (single_kboard && current_kboard != prev)
1068 emacs_abort ();
1073 /* Handle errors that are not handled at inner levels
1074 by printing an error message and returning to the editor command loop. */
1076 static Lisp_Object
1077 cmd_error (Lisp_Object data)
1079 Lisp_Object old_level, old_length;
1080 char macroerror[sizeof "After..kbd macro iterations: "
1081 + INT_STRLEN_BOUND (EMACS_INT)];
1083 #ifdef HAVE_WINDOW_SYSTEM
1084 if (display_hourglass_p)
1085 cancel_hourglass ();
1086 #endif
1088 if (!NILP (executing_kbd_macro))
1090 if (executing_kbd_macro_iterations == 1)
1091 sprintf (macroerror, "After 1 kbd macro iteration: ");
1092 else
1093 sprintf (macroerror, "After %"pI"d kbd macro iterations: ",
1094 executing_kbd_macro_iterations);
1096 else
1097 *macroerror = 0;
1099 Vstandard_output = Qt;
1100 Vstandard_input = Qt;
1101 Vexecuting_kbd_macro = Qnil;
1102 executing_kbd_macro = Qnil;
1103 kset_prefix_arg (current_kboard, Qnil);
1104 kset_last_prefix_arg (current_kboard, Qnil);
1105 cancel_echoing ();
1107 /* Avoid unquittable loop if data contains a circular list. */
1108 old_level = Vprint_level;
1109 old_length = Vprint_length;
1110 XSETFASTINT (Vprint_level, 10);
1111 XSETFASTINT (Vprint_length, 10);
1112 cmd_error_internal (data, macroerror);
1113 Vprint_level = old_level;
1114 Vprint_length = old_length;
1116 Vquit_flag = Qnil;
1117 Vinhibit_quit = Qnil;
1119 return make_number (0);
1122 /* Take actions on handling an error. DATA is the data that describes
1123 the error.
1125 CONTEXT is a C-string containing ASCII characters only which
1126 describes the context in which the error happened. If we need to
1127 generalize CONTEXT to allow multibyte characters, make it a Lisp
1128 string. */
1130 void
1131 cmd_error_internal (Lisp_Object data, const char *context)
1133 /* The immediate context is not interesting for Quits,
1134 since they are asynchronous. */
1135 if (EQ (XCAR (data), Qquit))
1136 Vsignaling_function = Qnil;
1138 Vquit_flag = Qnil;
1139 Vinhibit_quit = Qt;
1141 /* Use user's specified output function if any. */
1142 if (!NILP (Vcommand_error_function))
1143 call3 (Vcommand_error_function, data,
1144 context ? build_string (context) : empty_unibyte_string,
1145 Vsignaling_function);
1147 Vsignaling_function = Qnil;
1150 DEFUN ("command-error-default-function", Fcommand_error_default_function,
1151 Scommand_error_default_function, 3, 3, 0,
1152 doc: /* Produce default output for unhandled error message.
1153 Default value of `command-error-function'. */)
1154 (Lisp_Object data, Lisp_Object context, Lisp_Object signal)
1156 struct frame *sf = SELECTED_FRAME ();
1158 CHECK_STRING (context);
1160 /* If the window system or terminal frame hasn't been initialized
1161 yet, or we're not interactive, write the message to stderr and exit. */
1162 if (!sf->glyphs_initialized_p
1163 /* The initial frame is a special non-displaying frame. It
1164 will be current in daemon mode when there are no frames
1165 to display, and in non-daemon mode before the real frame
1166 has finished initializing. If an error is thrown in the
1167 latter case while creating the frame, then the frame
1168 will never be displayed, so the safest thing to do is
1169 write to stderr and quit. In daemon mode, there are
1170 many other potential errors that do not prevent frames
1171 from being created, so continuing as normal is better in
1172 that case. */
1173 || (!IS_DAEMON && FRAME_INITIAL_P (sf))
1174 || noninteractive)
1176 print_error_message (data, Qexternal_debugging_output,
1177 SSDATA (context), signal);
1178 Fterpri (Qexternal_debugging_output, Qnil);
1179 Fkill_emacs (make_number (-1));
1181 else
1183 clear_message (1, 0);
1184 Fdiscard_input ();
1185 message_log_maybe_newline ();
1186 bitch_at_user ();
1188 print_error_message (data, Qt, SSDATA (context), signal);
1190 return Qnil;
1193 static Lisp_Object command_loop_2 (Lisp_Object);
1194 static Lisp_Object top_level_1 (Lisp_Object);
1196 /* Entry to editor-command-loop.
1197 This level has the catches for exiting/returning to editor command loop.
1198 It returns nil to exit recursive edit, t to abort it. */
1200 Lisp_Object
1201 command_loop (void)
1203 #ifdef HAVE_STACK_OVERFLOW_HANDLING
1204 /* At least on GNU/Linux, saving signal mask is important here. */
1205 if (sigsetjmp (return_to_command_loop, 1) != 0)
1207 /* Comes here from handle_sigsegv, see sysdep.c. */
1208 init_eval ();
1209 Vinternal__top_level_message = recover_top_level_message;
1211 else
1212 Vinternal__top_level_message = regular_top_level_message;
1213 #endif /* HAVE_STACK_OVERFLOW_HANDLING */
1214 if (command_loop_level > 0 || minibuf_level > 0)
1216 Lisp_Object val;
1217 val = internal_catch (Qexit, command_loop_2, Qnil);
1218 executing_kbd_macro = Qnil;
1219 return val;
1221 else
1222 while (1)
1224 internal_catch (Qtop_level, top_level_1, Qnil);
1225 internal_catch (Qtop_level, command_loop_2, Qnil);
1226 executing_kbd_macro = Qnil;
1228 /* End of file in -batch run causes exit here. */
1229 if (noninteractive)
1230 Fkill_emacs (Qt);
1234 /* Here we catch errors in execution of commands within the
1235 editing loop, and reenter the editing loop.
1236 When there is an error, cmd_error runs and returns a non-nil
1237 value to us. A value of nil means that command_loop_1 itself
1238 returned due to end of file (or end of kbd macro). */
1240 static Lisp_Object
1241 command_loop_2 (Lisp_Object ignore)
1243 register Lisp_Object val;
1246 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1247 while (!NILP (val));
1249 return Qnil;
1252 static Lisp_Object
1253 top_level_2 (void)
1255 return Feval (Vtop_level, Qnil);
1258 static Lisp_Object
1259 top_level_1 (Lisp_Object ignore)
1261 /* On entry to the outer level, run the startup file. */
1262 if (!NILP (Vtop_level))
1263 internal_condition_case (top_level_2, Qerror, cmd_error);
1264 else if (!NILP (Vpurify_flag))
1265 message1 ("Bare impure Emacs (standard Lisp code not loaded)");
1266 else
1267 message1 ("Bare Emacs (standard Lisp code not loaded)");
1268 return Qnil;
1271 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1272 doc: /* Exit all recursive editing levels.
1273 This also exits all active minibuffers. */)
1274 (void)
1276 #ifdef HAVE_WINDOW_SYSTEM
1277 if (display_hourglass_p)
1278 cancel_hourglass ();
1279 #endif
1281 /* Unblock input if we enter with input blocked. This may happen if
1282 redisplay traps e.g. during tool-bar update with input blocked. */
1283 totally_unblock_input ();
1285 Fthrow (Qtop_level, Qnil);
1288 static _Noreturn void
1289 user_error (const char *msg)
1291 xsignal1 (Quser_error, build_string (msg));
1294 /* _Noreturn will be added to prototype by make-docfile. */
1295 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1296 doc: /* Exit from the innermost recursive edit or minibuffer. */)
1297 (void)
1299 if (command_loop_level > 0 || minibuf_level > 0)
1300 Fthrow (Qexit, Qnil);
1302 user_error ("No recursive edit is in progress");
1305 /* _Noreturn will be added to prototype by make-docfile. */
1306 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1307 doc: /* Abort the command that requested this recursive edit or minibuffer input. */)
1308 (void)
1310 if (command_loop_level > 0 || minibuf_level > 0)
1311 Fthrow (Qexit, Qt);
1313 user_error ("No recursive edit is in progress");
1316 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
1317 of this function. */
1319 static void
1320 tracking_off (Lisp_Object old_value)
1322 do_mouse_tracking = old_value;
1323 if (NILP (old_value))
1325 /* Redisplay may have been preempted because there was input
1326 available, and it assumes it will be called again after the
1327 input has been processed. If the only input available was
1328 the sort that we have just disabled, then we need to call
1329 redisplay. */
1330 if (!readable_events (READABLE_EVENTS_DO_TIMERS_NOW))
1332 redisplay_preserve_echo_area (6);
1333 get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
1338 DEFUN ("internal--track-mouse", Ftrack_mouse, Strack_mouse, 1, 1, 0,
1339 doc: /* Call BODYFUN with mouse movement events enabled. */)
1340 (Lisp_Object bodyfun)
1342 ptrdiff_t count = SPECPDL_INDEX ();
1343 Lisp_Object val;
1345 record_unwind_protect (tracking_off, do_mouse_tracking);
1347 do_mouse_tracking = Qt;
1349 val = call0 (bodyfun);
1350 return unbind_to (count, val);
1353 /* If mouse has moved on some frame, return one of those frames.
1355 Return 0 otherwise.
1357 If ignore_mouse_drag_p is non-zero, ignore (implicit) mouse movement
1358 after resizing the tool-bar window. */
1360 bool ignore_mouse_drag_p;
1362 static struct frame *
1363 some_mouse_moved (void)
1365 Lisp_Object tail, frame;
1367 if (ignore_mouse_drag_p)
1369 /* ignore_mouse_drag_p = 0; */
1370 return 0;
1373 FOR_EACH_FRAME (tail, frame)
1375 if (XFRAME (frame)->mouse_moved)
1376 return XFRAME (frame);
1379 return 0;
1383 /* This is the actual command reading loop,
1384 sans error-handling encapsulation. */
1386 static int read_key_sequence (Lisp_Object *, int, Lisp_Object,
1387 bool, bool, bool, bool);
1388 static void adjust_point_for_property (ptrdiff_t, bool);
1390 /* The last boundary auto-added to buffer-undo-list. */
1391 Lisp_Object last_undo_boundary;
1393 /* FIXME: This is wrong rather than test window-system, we should call
1394 a new set-selection, which will then dispatch to x-set-selection, or
1395 tty-set-selection, or w32-set-selection, ... */
1397 Lisp_Object
1398 command_loop_1 (void)
1400 Lisp_Object cmd;
1401 Lisp_Object keybuf[30];
1402 int i;
1403 EMACS_INT prev_modiff = 0;
1404 struct buffer *prev_buffer = NULL;
1405 bool already_adjusted = 0;
1407 kset_prefix_arg (current_kboard, Qnil);
1408 kset_last_prefix_arg (current_kboard, Qnil);
1409 Vdeactivate_mark = Qnil;
1410 waiting_for_input = 0;
1411 cancel_echoing ();
1413 this_command_key_count = 0;
1414 this_command_key_count_reset = 0;
1415 this_single_command_key_start = 0;
1417 if (NILP (Vmemory_full))
1419 /* Make sure this hook runs after commands that get errors and
1420 throw to top level. */
1421 /* Note that the value cell will never directly contain nil
1422 if the symbol is a local variable. */
1423 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1424 safe_run_hooks (Qpost_command_hook);
1426 /* If displaying a message, resize the echo area window to fit
1427 that message's size exactly. */
1428 if (!NILP (echo_area_buffer[0]))
1429 resize_echo_area_exactly ();
1431 /* If there are warnings waiting, process them. */
1432 if (!NILP (Vdelayed_warnings_list))
1433 safe_run_hooks (Qdelayed_warnings_hook);
1435 if (!NILP (Vdeferred_action_list))
1436 safe_run_hooks (Qdeferred_action_function);
1439 /* Do this after running Vpost_command_hook, for consistency. */
1440 kset_last_command (current_kboard, Vthis_command);
1441 kset_real_last_command (current_kboard, Vreal_this_command);
1442 if (!CONSP (last_command_event))
1443 kset_last_repeatable_command (current_kboard, Vreal_this_command);
1445 while (1)
1447 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1448 Fkill_emacs (Qnil);
1450 /* Make sure the current window's buffer is selected. */
1451 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents));
1453 /* Display any malloc warning that just came out. Use while because
1454 displaying one warning can cause another. */
1456 while (pending_malloc_warning)
1457 display_malloc_warning ();
1459 Vdeactivate_mark = Qnil;
1461 /* Don't ignore mouse movements for more than a single command
1462 loop. (This flag is set in xdisp.c whenever the tool bar is
1463 resized, because the resize moves text up or down, and would
1464 generate false mouse drag events if we don't ignore them.) */
1465 ignore_mouse_drag_p = 0;
1467 /* If minibuffer on and echo area in use,
1468 wait a short time and redraw minibuffer. */
1470 if (minibuf_level
1471 && !NILP (echo_area_buffer[0])
1472 && EQ (minibuf_window, echo_area_window)
1473 && NUMBERP (Vminibuffer_message_timeout))
1475 /* Bind inhibit-quit to t so that C-g gets read in
1476 rather than quitting back to the minibuffer. */
1477 ptrdiff_t count = SPECPDL_INDEX ();
1478 specbind (Qinhibit_quit, Qt);
1480 sit_for (Vminibuffer_message_timeout, 0, 2);
1482 /* Clear the echo area. */
1483 message1 (0);
1484 safe_run_hooks (Qecho_area_clear_hook);
1486 unbind_to (count, Qnil);
1488 /* If a C-g came in before, treat it as input now. */
1489 if (!NILP (Vquit_flag))
1491 Vquit_flag = Qnil;
1492 Vunread_command_events = list1 (make_number (quit_char));
1496 /* If it has changed current-menubar from previous value,
1497 really recompute the menubar from the value. */
1498 if (! NILP (Vlucid_menu_bar_dirty_flag)
1499 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
1500 call0 (Qrecompute_lucid_menubar);
1502 before_command_key_count = this_command_key_count;
1503 before_command_echo_length = echo_length ();
1505 Vthis_command = Qnil;
1506 Vreal_this_command = Qnil;
1507 Vthis_original_command = Qnil;
1508 Vthis_command_keys_shift_translated = Qnil;
1510 /* Read next key sequence; i gets its length. */
1511 i = read_key_sequence (keybuf, ARRAYELTS (keybuf),
1512 Qnil, 0, 1, 1, 0);
1514 /* A filter may have run while we were reading the input. */
1515 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1516 Fkill_emacs (Qnil);
1517 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents));
1519 ++num_input_keys;
1521 /* Now we have read a key sequence of length I,
1522 or else I is 0 and we found end of file. */
1524 if (i == 0) /* End of file -- happens only in */
1525 return Qnil; /* a kbd macro, at the end. */
1526 /* -1 means read_key_sequence got a menu that was rejected.
1527 Just loop around and read another command. */
1528 if (i == -1)
1530 cancel_echoing ();
1531 this_command_key_count = 0;
1532 this_command_key_count_reset = 0;
1533 this_single_command_key_start = 0;
1534 goto finalize;
1537 last_command_event = keybuf[i - 1];
1539 /* If the previous command tried to force a specific window-start,
1540 forget about that, in case this command moves point far away
1541 from that position. But also throw away beg_unchanged and
1542 end_unchanged information in that case, so that redisplay will
1543 update the whole window properly. */
1544 if (XWINDOW (selected_window)->force_start)
1546 struct buffer *b;
1547 XWINDOW (selected_window)->force_start = 0;
1548 b = XBUFFER (XWINDOW (selected_window)->contents);
1549 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
1552 cmd = read_key_sequence_cmd;
1553 if (!NILP (Vexecuting_kbd_macro))
1555 if (!NILP (Vquit_flag))
1557 Vexecuting_kbd_macro = Qt;
1558 QUIT; /* Make some noise. */
1559 /* Will return since macro now empty. */
1563 /* Do redisplay processing after this command except in special
1564 cases identified below. */
1565 prev_buffer = current_buffer;
1566 prev_modiff = MODIFF;
1567 last_point_position = PT;
1569 /* By default, we adjust point to a boundary of a region that
1570 has such a property that should be treated intangible
1571 (e.g. composition, display). But, some commands will set
1572 this variable differently. */
1573 Vdisable_point_adjustment = Qnil;
1575 /* Process filters and timers may have messed with deactivate-mark.
1576 reset it before we execute the command. */
1577 Vdeactivate_mark = Qnil;
1579 /* Remap command through active keymaps. */
1580 Vthis_original_command = cmd;
1581 if (!NILP (read_key_sequence_remapped))
1582 cmd = read_key_sequence_remapped;
1584 /* Execute the command. */
1587 total_keys += total_keys < NUM_RECENT_KEYS;
1588 ASET (recent_keys, recent_keys_index,
1589 Fcons (Qnil, cmd));
1590 if (++recent_keys_index >= NUM_RECENT_KEYS)
1591 recent_keys_index = 0;
1593 Vthis_command = cmd;
1594 Vreal_this_command = cmd;
1595 safe_run_hooks (Qpre_command_hook);
1597 already_adjusted = 0;
1599 if (NILP (Vthis_command))
1600 /* nil means key is undefined. */
1601 call0 (Qundefined);
1602 else
1604 /* Here for a command that isn't executed directly. */
1606 #ifdef HAVE_WINDOW_SYSTEM
1607 ptrdiff_t scount = SPECPDL_INDEX ();
1609 if (display_hourglass_p
1610 && NILP (Vexecuting_kbd_macro))
1612 record_unwind_protect_void (cancel_hourglass);
1613 start_hourglass ();
1615 #endif
1617 if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */
1619 Lisp_Object undo = BVAR (current_buffer, undo_list);
1620 Fundo_boundary ();
1621 last_undo_boundary
1622 = (EQ (undo, BVAR (current_buffer, undo_list))
1623 ? Qnil : BVAR (current_buffer, undo_list));
1625 call1 (Qcommand_execute, Vthis_command);
1627 #ifdef HAVE_WINDOW_SYSTEM
1628 /* Do not check display_hourglass_p here, because
1629 `command-execute' could change it, but we should cancel
1630 hourglass cursor anyway.
1631 But don't cancel the hourglass within a macro
1632 just because a command in the macro finishes. */
1633 if (NILP (Vexecuting_kbd_macro))
1634 unbind_to (scount, Qnil);
1635 #endif
1637 kset_last_prefix_arg (current_kboard, Vcurrent_prefix_arg);
1639 safe_run_hooks (Qpost_command_hook);
1641 /* If displaying a message, resize the echo area window to fit
1642 that message's size exactly. */
1643 if (!NILP (echo_area_buffer[0]))
1644 resize_echo_area_exactly ();
1646 /* If there are warnings waiting, process them. */
1647 if (!NILP (Vdelayed_warnings_list))
1648 safe_run_hooks (Qdelayed_warnings_hook);
1650 safe_run_hooks (Qdeferred_action_function);
1652 /* If there is a prefix argument,
1653 1) We don't want Vlast_command to be ``universal-argument''
1654 (that would be dumb), so don't set Vlast_command,
1655 2) we want to leave echoing on so that the prefix will be
1656 echoed as part of this key sequence, so don't call
1657 cancel_echoing, and
1658 3) we want to leave this_command_key_count non-zero, so that
1659 read_char will realize that it is re-reading a character, and
1660 not echo it a second time.
1662 If the command didn't actually create a prefix arg,
1663 but is merely a frame event that is transparent to prefix args,
1664 then the above doesn't apply. */
1665 if (NILP (KVAR (current_kboard, Vprefix_arg))
1666 || CONSP (last_command_event))
1668 kset_last_command (current_kboard, Vthis_command);
1669 kset_real_last_command (current_kboard, Vreal_this_command);
1670 if (!CONSP (last_command_event))
1671 kset_last_repeatable_command (current_kboard, Vreal_this_command);
1672 cancel_echoing ();
1673 this_command_key_count = 0;
1674 this_command_key_count_reset = 0;
1675 this_single_command_key_start = 0;
1678 if (!NILP (BVAR (current_buffer, mark_active))
1679 && !NILP (Vrun_hooks))
1681 /* In Emacs 22, setting transient-mark-mode to `only' was a
1682 way of turning it on for just one command. This usage is
1683 obsolete, but support it anyway. */
1684 if (EQ (Vtransient_mark_mode, Qidentity))
1685 Vtransient_mark_mode = Qnil;
1686 else if (EQ (Vtransient_mark_mode, Qonly))
1687 Vtransient_mark_mode = Qidentity;
1689 if (!NILP (Vdeactivate_mark))
1690 /* If `select-active-regions' is non-nil, this call to
1691 `deactivate-mark' also sets the PRIMARY selection. */
1692 call0 (Qdeactivate_mark);
1693 else
1695 /* Even if not deactivating the mark, set PRIMARY if
1696 `select-active-regions' is non-nil. */
1697 if (!NILP (Fwindow_system (Qnil))
1698 /* Even if mark_active is non-nil, the actual buffer
1699 marker may not have been set yet (Bug#7044). */
1700 && XMARKER (BVAR (current_buffer, mark))->buffer
1701 && (EQ (Vselect_active_regions, Qonly)
1702 ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly)
1703 : (!NILP (Vselect_active_regions)
1704 && !NILP (Vtransient_mark_mode)))
1705 && NILP (Fmemq (Vthis_command,
1706 Vselection_inhibit_update_commands)))
1708 Lisp_Object txt
1709 = call1 (Fsymbol_value (Qregion_extract_function), Qnil);
1710 if (XINT (Flength (txt)) > 0)
1711 /* Don't set empty selections. */
1712 call2 (Qgui_set_selection, QPRIMARY, txt);
1715 if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1717 Lisp_Object hook = intern ("activate-mark-hook");
1718 Frun_hooks (1, &hook);
1722 Vsaved_region_selection = Qnil;
1725 finalize:
1727 if (current_buffer == prev_buffer
1728 && last_point_position != PT
1729 && NILP (Vdisable_point_adjustment)
1730 && NILP (Vglobal_disable_point_adjustment))
1732 if (last_point_position > BEGV
1733 && last_point_position < ZV
1734 && (composition_adjust_point (last_point_position,
1735 last_point_position)
1736 != last_point_position))
1737 /* The last point was temporarily set within a grapheme
1738 cluster to prevent automatic composition. To recover
1739 the automatic composition, we must update the
1740 display. */
1741 windows_or_buffers_changed = 21;
1742 if (!already_adjusted)
1743 adjust_point_for_property (last_point_position,
1744 MODIFF != prev_modiff);
1747 /* Install chars successfully executed in kbd macro. */
1749 if (!NILP (KVAR (current_kboard, defining_kbd_macro))
1750 && NILP (KVAR (current_kboard, Vprefix_arg)))
1751 finalize_kbd_macro_chars ();
1755 Lisp_Object
1756 read_menu_command (void)
1758 Lisp_Object keybuf[30];
1759 ptrdiff_t count = SPECPDL_INDEX ();
1760 int i;
1762 /* We don't want to echo the keystrokes while navigating the
1763 menus. */
1764 specbind (Qecho_keystrokes, make_number (0));
1766 i = read_key_sequence (keybuf, ARRAYELTS (keybuf),
1767 Qnil, 0, 1, 1, 1);
1769 unbind_to (count, Qnil);
1771 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1772 Fkill_emacs (Qnil);
1773 if (i == 0 || i == -1)
1774 return Qt;
1776 return read_key_sequence_cmd;
1779 /* Adjust point to a boundary of a region that has such a property
1780 that should be treated intangible. For the moment, we check
1781 `composition', `display' and `invisible' properties.
1782 LAST_PT is the last position of point. */
1784 static void
1785 adjust_point_for_property (ptrdiff_t last_pt, bool modified)
1787 ptrdiff_t beg, end;
1788 Lisp_Object val, overlay, tmp;
1789 /* When called after buffer modification, we should temporarily
1790 suppress the point adjustment for automatic composition so that a
1791 user can keep inserting another character at point or keep
1792 deleting characters around point. */
1793 bool check_composition = ! modified, check_display = 1, check_invisible = 1;
1794 ptrdiff_t orig_pt = PT;
1796 /* FIXME: cycling is probably not necessary because these properties
1797 can't be usefully combined anyway. */
1798 while (check_composition || check_display || check_invisible)
1800 /* FIXME: check `intangible'. */
1801 if (check_composition
1802 && PT > BEGV && PT < ZV
1803 && (beg = composition_adjust_point (last_pt, PT)) != PT)
1805 SET_PT (beg);
1806 check_display = check_invisible = 1;
1808 check_composition = 0;
1809 if (check_display
1810 && PT > BEGV && PT < ZV
1811 && !NILP (val = get_char_property_and_overlay
1812 (make_number (PT), Qdisplay, Qnil, &overlay))
1813 && display_prop_intangible_p (val, overlay, PT, PT_BYTE)
1814 && (!OVERLAYP (overlay)
1815 ? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil)
1816 : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)),
1817 end = OVERLAY_POSITION (OVERLAY_END (overlay))))
1818 && (beg < PT /* && end > PT <- It's always the case. */
1819 || (beg <= PT && STRINGP (val) && SCHARS (val) == 0)))
1821 eassert (end > PT);
1822 SET_PT (PT < last_pt
1823 ? (STRINGP (val) && SCHARS (val) == 0
1824 ? max (beg - 1, BEGV)
1825 : beg)
1826 : end);
1827 check_composition = check_invisible = 1;
1829 check_display = 0;
1830 if (check_invisible && PT > BEGV && PT < ZV)
1832 int inv;
1833 bool ellipsis = 0;
1834 beg = end = PT;
1836 /* Find boundaries `beg' and `end' of the invisible area, if any. */
1837 while (end < ZV
1838 #if 0
1839 /* FIXME: We should stop if we find a spot between
1840 two runs of `invisible' where inserted text would
1841 be visible. This is important when we have two
1842 invisible boundaries that enclose an area: if the
1843 area is empty, we need this test in order to make
1844 it possible to place point in the middle rather
1845 than skip both boundaries. However, this code
1846 also stops anywhere in a non-sticky text-property,
1847 which breaks (e.g.) Org mode. */
1848 && (val = Fget_pos_property (make_number (end),
1849 Qinvisible, Qnil),
1850 TEXT_PROP_MEANS_INVISIBLE (val))
1851 #endif
1852 && !NILP (val = get_char_property_and_overlay
1853 (make_number (end), Qinvisible, Qnil, &overlay))
1854 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1856 ellipsis = ellipsis || inv > 1
1857 || (OVERLAYP (overlay)
1858 && (!NILP (Foverlay_get (overlay, Qafter_string))
1859 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1860 tmp = Fnext_single_char_property_change
1861 (make_number (end), Qinvisible, Qnil, Qnil);
1862 end = NATNUMP (tmp) ? XFASTINT (tmp) : ZV;
1864 while (beg > BEGV
1865 #if 0
1866 && (val = Fget_pos_property (make_number (beg),
1867 Qinvisible, Qnil),
1868 TEXT_PROP_MEANS_INVISIBLE (val))
1869 #endif
1870 && !NILP (val = get_char_property_and_overlay
1871 (make_number (beg - 1), Qinvisible, Qnil, &overlay))
1872 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1874 ellipsis = ellipsis || inv > 1
1875 || (OVERLAYP (overlay)
1876 && (!NILP (Foverlay_get (overlay, Qafter_string))
1877 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1878 tmp = Fprevious_single_char_property_change
1879 (make_number (beg), Qinvisible, Qnil, Qnil);
1880 beg = NATNUMP (tmp) ? XFASTINT (tmp) : BEGV;
1883 /* Move away from the inside area. */
1884 if (beg < PT && end > PT)
1886 SET_PT ((orig_pt == PT && (last_pt < beg || last_pt > end))
1887 /* We haven't moved yet (so we don't need to fear
1888 infinite-looping) and we were outside the range
1889 before (so either end of the range still corresponds
1890 to a move in the right direction): pretend we moved
1891 less than we actually did, so that we still have
1892 more freedom below in choosing which end of the range
1893 to go to. */
1894 ? (orig_pt = -1, PT < last_pt ? end : beg)
1895 /* We either have moved already or the last point
1896 was already in the range: we don't get to choose
1897 which end of the range we have to go to. */
1898 : (PT < last_pt ? beg : end));
1899 check_composition = check_display = 1;
1901 #if 0 /* This assertion isn't correct, because SET_PT may end up setting
1902 the point to something other than its argument, due to
1903 point-motion hooks, intangibility, etc. */
1904 eassert (PT == beg || PT == end);
1905 #endif
1907 /* Pretend the area doesn't exist if the buffer is not
1908 modified. */
1909 if (!modified && !ellipsis && beg < end)
1911 if (last_pt == beg && PT == end && end < ZV)
1912 (check_composition = check_display = 1, SET_PT (end + 1));
1913 else if (last_pt == end && PT == beg && beg > BEGV)
1914 (check_composition = check_display = 1, SET_PT (beg - 1));
1915 else if (PT == ((PT < last_pt) ? beg : end))
1916 /* We've already moved as far as we can. Trying to go
1917 to the other end would mean moving backwards and thus
1918 could lead to an infinite loop. */
1920 else if (val = Fget_pos_property (make_number (PT),
1921 Qinvisible, Qnil),
1922 TEXT_PROP_MEANS_INVISIBLE (val)
1923 && (val = (Fget_pos_property
1924 (make_number (PT == beg ? end : beg),
1925 Qinvisible, Qnil)),
1926 !TEXT_PROP_MEANS_INVISIBLE (val)))
1927 (check_composition = check_display = 1,
1928 SET_PT (PT == beg ? end : beg));
1931 check_invisible = 0;
1935 /* Subroutine for safe_run_hooks: run the hook, which is ARGS[1]. */
1937 static Lisp_Object
1938 safe_run_hooks_1 (ptrdiff_t nargs, Lisp_Object *args)
1940 eassert (nargs == 2);
1941 return call0 (args[1]);
1944 /* Subroutine for safe_run_hooks: handle an error by clearing out the function
1945 from the hook. */
1947 static Lisp_Object
1948 safe_run_hooks_error (Lisp_Object error, ptrdiff_t nargs, Lisp_Object *args)
1950 eassert (nargs == 2);
1951 AUTO_STRING (format, "Error in %s (%S): %S");
1952 Lisp_Object hook = args[0];
1953 Lisp_Object fun = args[1];
1954 Fmessage (4, (Lisp_Object []) {format, hook, fun, error});
1956 if (SYMBOLP (hook))
1958 Lisp_Object val;
1959 bool found = 0;
1960 Lisp_Object newval = Qnil;
1961 for (val = find_symbol_value (hook); CONSP (val); val = XCDR (val))
1962 if (EQ (fun, XCAR (val)))
1963 found = 1;
1964 else
1965 newval = Fcons (XCAR (val), newval);
1966 if (found)
1967 return Fset (hook, Fnreverse (newval));
1968 /* Not found in the local part of the hook. Let's look at the global
1969 part. */
1970 newval = Qnil;
1971 for (val = (NILP (Fdefault_boundp (hook)) ? Qnil
1972 : Fdefault_value (hook));
1973 CONSP (val); val = XCDR (val))
1974 if (EQ (fun, XCAR (val)))
1975 found = 1;
1976 else
1977 newval = Fcons (XCAR (val), newval);
1978 if (found)
1979 return Fset_default (hook, Fnreverse (newval));
1981 return Qnil;
1984 static Lisp_Object
1985 safe_run_hook_funcall (ptrdiff_t nargs, Lisp_Object *args)
1987 Lisp_Object iargs[2];
1989 eassert (nargs == 2);
1990 /* Yes, run_hook_with_args works this way. */
1991 iargs[0] = args[1];
1992 iargs[1] = args[0];
1993 internal_condition_case_n (safe_run_hooks_1, 2, iargs,
1994 Qt, safe_run_hooks_error);
1995 return Qnil;
1998 /* If we get an error while running the hook, cause the hook variable
1999 to be nil. Also inhibit quits, so that C-g won't cause the hook
2000 to mysteriously evaporate. */
2002 void
2003 safe_run_hooks (Lisp_Object hook)
2005 Lisp_Object args[2];
2006 struct gcpro gcpro1;
2007 ptrdiff_t count = SPECPDL_INDEX ();
2009 args[0] = hook;
2010 args[1] = hook;
2012 GCPRO1 (hook);
2013 specbind (Qinhibit_quit, Qt);
2014 run_hook_with_args (2, args, safe_run_hook_funcall);
2015 unbind_to (count, Qnil);
2016 UNGCPRO;
2020 /* Nonzero means polling for input is temporarily suppressed. */
2022 int poll_suppress_count;
2025 #ifdef POLL_FOR_INPUT
2027 /* Asynchronous timer for polling. */
2029 static struct atimer *poll_timer;
2031 /* Poll for input, so that we catch a C-g if it comes in. */
2032 void
2033 poll_for_input_1 (void)
2035 if (! input_blocked_p ()
2036 && !waiting_for_input)
2037 gobble_input ();
2040 /* Timer callback function for poll_timer. TIMER is equal to
2041 poll_timer. */
2043 static void
2044 poll_for_input (struct atimer *timer)
2046 if (poll_suppress_count == 0)
2047 pending_signals = 1;
2050 #endif /* POLL_FOR_INPUT */
2052 /* Begin signals to poll for input, if they are appropriate.
2053 This function is called unconditionally from various places. */
2055 void
2056 start_polling (void)
2058 #ifdef POLL_FOR_INPUT
2059 /* XXX This condition was (read_socket_hook && !interrupt_input),
2060 but read_socket_hook is not global anymore. Let's pretend that
2061 it's always set. */
2062 if (!interrupt_input)
2064 /* Turn alarm handling on unconditionally. It might have
2065 been turned off in process.c. */
2066 turn_on_atimers (1);
2068 /* If poll timer doesn't exist, or we need one with
2069 a different interval, start a new one. */
2070 if (poll_timer == NULL
2071 || poll_timer->interval.tv_sec != polling_period)
2073 time_t period = max (1, min (polling_period, TYPE_MAXIMUM (time_t)));
2074 struct timespec interval = make_timespec (period, 0);
2076 if (poll_timer)
2077 cancel_atimer (poll_timer);
2079 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
2080 poll_for_input, NULL);
2083 /* Let the timer's callback function poll for input
2084 if this becomes zero. */
2085 --poll_suppress_count;
2087 #endif
2090 /* True if we are using polling to handle input asynchronously. */
2092 bool
2093 input_polling_used (void)
2095 #ifdef POLL_FOR_INPUT
2096 /* XXX This condition was (read_socket_hook && !interrupt_input),
2097 but read_socket_hook is not global anymore. Let's pretend that
2098 it's always set. */
2099 return !interrupt_input;
2100 #else
2101 return 0;
2102 #endif
2105 /* Turn off polling. */
2107 void
2108 stop_polling (void)
2110 #ifdef POLL_FOR_INPUT
2111 /* XXX This condition was (read_socket_hook && !interrupt_input),
2112 but read_socket_hook is not global anymore. Let's pretend that
2113 it's always set. */
2114 if (!interrupt_input)
2115 ++poll_suppress_count;
2116 #endif
2119 /* Set the value of poll_suppress_count to COUNT
2120 and start or stop polling accordingly. */
2122 void
2123 set_poll_suppress_count (int count)
2125 #ifdef POLL_FOR_INPUT
2126 if (count == 0 && poll_suppress_count != 0)
2128 poll_suppress_count = 1;
2129 start_polling ();
2131 else if (count != 0 && poll_suppress_count == 0)
2133 stop_polling ();
2135 poll_suppress_count = count;
2136 #endif
2139 /* Bind polling_period to a value at least N.
2140 But don't decrease it. */
2142 void
2143 bind_polling_period (int n)
2145 #ifdef POLL_FOR_INPUT
2146 EMACS_INT new = polling_period;
2148 if (n > new)
2149 new = n;
2151 stop_other_atimers (poll_timer);
2152 stop_polling ();
2153 specbind (Qpolling_period, make_number (new));
2154 /* Start a new alarm with the new period. */
2155 start_polling ();
2156 #endif
2159 /* Apply the control modifier to CHARACTER. */
2162 make_ctrl_char (int c)
2164 /* Save the upper bits here. */
2165 int upper = c & ~0177;
2167 if (! ASCII_CHAR_P (c))
2168 return c |= ctrl_modifier;
2170 c &= 0177;
2172 /* Everything in the columns containing the upper-case letters
2173 denotes a control character. */
2174 if (c >= 0100 && c < 0140)
2176 int oc = c;
2177 c &= ~0140;
2178 /* Set the shift modifier for a control char
2179 made from a shifted letter. But only for letters! */
2180 if (oc >= 'A' && oc <= 'Z')
2181 c |= shift_modifier;
2184 /* The lower-case letters denote control characters too. */
2185 else if (c >= 'a' && c <= 'z')
2186 c &= ~0140;
2188 /* Include the bits for control and shift
2189 only if the basic ASCII code can't indicate them. */
2190 else if (c >= ' ')
2191 c |= ctrl_modifier;
2193 /* Replace the high bits. */
2194 c |= (upper & ~ctrl_modifier);
2196 return c;
2199 /* Display the help-echo property of the character after the mouse pointer.
2200 Either show it in the echo area, or call show-help-function to display
2201 it by other means (maybe in a tooltip).
2203 If HELP is nil, that means clear the previous help echo.
2205 If HELP is a string, display that string. If HELP is a function,
2206 call it with OBJECT and POS as arguments; the function should
2207 return a help string or nil for none. For all other types of HELP,
2208 evaluate it to obtain a string.
2210 WINDOW is the window in which the help was generated, if any.
2211 It is nil if not in a window.
2213 If OBJECT is a buffer, POS is the position in the buffer where the
2214 `help-echo' text property was found.
2216 If OBJECT is an overlay, that overlay has a `help-echo' property,
2217 and POS is the position in the overlay's buffer under the mouse.
2219 If OBJECT is a string (an overlay string or a string displayed with
2220 the `display' property). POS is the position in that string under
2221 the mouse.
2223 Note: this function may only be called with HELP nil or a string
2224 from X code running asynchronously. */
2226 void
2227 show_help_echo (Lisp_Object help, Lisp_Object window, Lisp_Object object,
2228 Lisp_Object pos)
2230 if (!NILP (help) && !STRINGP (help))
2232 if (FUNCTIONP (help))
2233 help = safe_call (4, help, window, object, pos);
2234 else
2235 help = safe_eval (help);
2237 if (!STRINGP (help))
2238 return;
2241 if (!noninteractive && STRINGP (help))
2243 /* The mouse-fixup-help-message Lisp function can call
2244 mouse_position_hook, which resets the mouse_moved flags.
2245 This causes trouble if we are trying to read a mouse motion
2246 event (i.e., if we are inside a `track-mouse' form), so we
2247 restore the mouse_moved flag. */
2248 struct frame *f = NILP (do_mouse_tracking) ? NULL : some_mouse_moved ();
2249 help = call1 (Qmouse_fixup_help_message, help);
2250 if (f)
2251 f->mouse_moved = 1;
2254 if (STRINGP (help) || NILP (help))
2256 if (!NILP (Vshow_help_function))
2257 call1 (Vshow_help_function, help);
2258 help_echo_showing_p = STRINGP (help);
2264 /* Input of single characters from keyboard. */
2266 static Lisp_Object kbd_buffer_get_event (KBOARD **kbp, bool *used_mouse_menu,
2267 struct timespec *end_time);
2268 static void record_char (Lisp_Object c);
2270 static Lisp_Object help_form_saved_window_configs;
2271 static void
2272 read_char_help_form_unwind (void)
2274 Lisp_Object window_config = XCAR (help_form_saved_window_configs);
2275 help_form_saved_window_configs = XCDR (help_form_saved_window_configs);
2276 if (!NILP (window_config))
2277 Fset_window_configuration (window_config);
2280 #define STOP_POLLING \
2281 do { if (! polling_stopped_here) stop_polling (); \
2282 polling_stopped_here = 1; } while (0)
2284 #define RESUME_POLLING \
2285 do { if (polling_stopped_here) start_polling (); \
2286 polling_stopped_here = 0; } while (0)
2288 static Lisp_Object
2289 read_event_from_main_queue (struct timespec *end_time,
2290 sys_jmp_buf local_getcjmp,
2291 bool *used_mouse_menu)
2293 Lisp_Object c = Qnil;
2294 sys_jmp_buf save_jump;
2295 KBOARD *kb IF_LINT (= NULL);
2297 start:
2299 /* Read from the main queue, and if that gives us something we can't use yet,
2300 we put it on the appropriate side queue and try again. */
2302 if (end_time && timespec_cmp (*end_time, current_timespec ()) <= 0)
2303 return c;
2305 /* Actually read a character, waiting if necessary. */
2306 save_getcjmp (save_jump);
2307 restore_getcjmp (local_getcjmp);
2308 if (!end_time)
2309 timer_start_idle ();
2310 c = kbd_buffer_get_event (&kb, used_mouse_menu, end_time);
2311 restore_getcjmp (save_jump);
2313 if (! NILP (c) && (kb != current_kboard))
2315 Lisp_Object last = KVAR (kb, kbd_queue);
2316 if (CONSP (last))
2318 while (CONSP (XCDR (last)))
2319 last = XCDR (last);
2320 if (!NILP (XCDR (last)))
2321 emacs_abort ();
2323 if (!CONSP (last))
2324 kset_kbd_queue (kb, list1 (c));
2325 else
2326 XSETCDR (last, list1 (c));
2327 kb->kbd_queue_has_data = 1;
2328 c = Qnil;
2329 if (single_kboard)
2330 goto start;
2331 current_kboard = kb;
2332 /* This is going to exit from read_char
2333 so we had better get rid of this frame's stuff. */
2334 return make_number (-2);
2337 /* Terminate Emacs in batch mode if at eof. */
2338 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
2339 Fkill_emacs (make_number (1));
2341 if (INTEGERP (c))
2343 /* Add in any extra modifiers, where appropriate. */
2344 if ((extra_keyboard_modifiers & CHAR_CTL)
2345 || ((extra_keyboard_modifiers & 0177) < ' '
2346 && (extra_keyboard_modifiers & 0177) != 0))
2347 XSETINT (c, make_ctrl_char (XINT (c)));
2349 /* Transfer any other modifier bits directly from
2350 extra_keyboard_modifiers to c. Ignore the actual character code
2351 in the low 16 bits of extra_keyboard_modifiers. */
2352 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
2355 return c;
2360 /* Like `read_event_from_main_queue' but applies keyboard-coding-system
2361 to tty input. */
2362 static Lisp_Object
2363 read_decoded_event_from_main_queue (struct timespec *end_time,
2364 sys_jmp_buf local_getcjmp,
2365 Lisp_Object prev_event,
2366 bool *used_mouse_menu)
2368 #define MAX_ENCODED_BYTES 16
2369 #ifndef WINDOWSNT
2370 Lisp_Object events[MAX_ENCODED_BYTES];
2371 int n = 0;
2372 #endif
2373 while (true)
2375 Lisp_Object nextevt
2376 = read_event_from_main_queue (end_time, local_getcjmp,
2377 used_mouse_menu);
2378 #ifdef WINDOWSNT
2379 /* w32_console already returns decoded events. It either reads
2380 Unicode characters from the Windows keyboard input, or
2381 converts characters encoded in the current codepage into
2382 Unicode. See w32inevt.c:key_event, near its end. */
2383 return nextevt;
2384 #else
2385 struct frame *frame = XFRAME (selected_frame);
2386 struct terminal *terminal = frame->terminal;
2387 if (!((FRAME_TERMCAP_P (frame) || FRAME_MSDOS_P (frame))
2388 /* Don't apply decoding if we're just reading a raw event
2389 (e.g. reading bytes sent by the xterm to specify the position
2390 of a mouse click). */
2391 && (!EQ (prev_event, Qt))
2392 && (TERMINAL_KEYBOARD_CODING (terminal)->common_flags
2393 & CODING_REQUIRE_DECODING_MASK)))
2394 return nextevt; /* No decoding needed. */
2395 else
2397 int meta_key = terminal->display_info.tty->meta_key;
2398 eassert (n < MAX_ENCODED_BYTES);
2399 events[n++] = nextevt;
2400 if (NATNUMP (nextevt)
2401 && XINT (nextevt) < (meta_key == 1 ? 0x80 : 0x100))
2402 { /* An encoded byte sequence, let's try to decode it. */
2403 struct coding_system *coding
2404 = TERMINAL_KEYBOARD_CODING (terminal);
2405 unsigned char src[MAX_ENCODED_BYTES];
2406 unsigned char dest[MAX_ENCODED_BYTES * MAX_MULTIBYTE_LENGTH];
2407 int i;
2408 for (i = 0; i < n; i++)
2409 src[i] = XINT (events[i]);
2410 if (meta_key != 2)
2411 for (i = 0; i < n; i++)
2412 src[i] &= ~0x80;
2413 coding->destination = dest;
2414 coding->dst_bytes = sizeof dest;
2415 decode_coding_c_string (coding, src, n, Qnil);
2416 eassert (coding->produced_char <= n);
2417 if (coding->produced_char == 0)
2418 { /* The encoded sequence is incomplete. */
2419 if (n < MAX_ENCODED_BYTES) /* Avoid buffer overflow. */
2420 continue; /* Read on! */
2422 else
2424 const unsigned char *p = coding->destination;
2425 eassert (coding->carryover_bytes == 0);
2426 n = 0;
2427 while (n < coding->produced_char)
2428 events[n++] = make_number (STRING_CHAR_ADVANCE (p));
2431 /* Now `events' should hold decoded events.
2432 Normally, n should be equal to 1, but better not rely on it.
2433 We can only return one event here, so return the first we
2434 had and keep the others (if any) for later. */
2435 while (n > 1)
2436 Vunread_command_events
2437 = Fcons (events[--n], Vunread_command_events);
2438 return events[0];
2440 #endif
2444 static bool
2445 echo_keystrokes_p (void)
2447 return (FLOATP (Vecho_keystrokes) ? XFLOAT_DATA (Vecho_keystrokes) > 0.0
2448 : INTEGERP (Vecho_keystrokes) ? XINT (Vecho_keystrokes) > 0 : false);
2451 /* Read a character from the keyboard; call the redisplay if needed. */
2452 /* commandflag 0 means do not autosave, but do redisplay.
2453 -1 means do not redisplay, but do autosave.
2454 -2 means do neither.
2455 1 means do both.
2457 The argument MAP is a keymap for menu prompting.
2459 PREV_EVENT is the previous input event, or nil if we are reading
2460 the first event of a key sequence (or not reading a key sequence).
2461 If PREV_EVENT is t, that is a "magic" value that says
2462 not to run input methods, but in other respects to act as if
2463 not reading a key sequence.
2465 If USED_MOUSE_MENU is non-null, then set *USED_MOUSE_MENU to true
2466 if we used a mouse menu to read the input, or false otherwise. If
2467 USED_MOUSE_MENU is null, don't dereference it.
2469 Value is -2 when we find input on another keyboard. A second call
2470 to read_char will read it.
2472 If END_TIME is non-null, it is a pointer to a struct timespec
2473 specifying the maximum time to wait until. If no input arrives by
2474 that time, stop waiting and return nil.
2476 Value is t if we showed a menu and the user rejected it. */
2478 Lisp_Object
2479 read_char (int commandflag, Lisp_Object map,
2480 Lisp_Object prev_event,
2481 bool *used_mouse_menu, struct timespec *end_time)
2483 Lisp_Object c;
2484 ptrdiff_t jmpcount;
2485 sys_jmp_buf local_getcjmp;
2486 sys_jmp_buf save_jump;
2487 Lisp_Object tem, save;
2488 volatile Lisp_Object previous_echo_area_message;
2489 volatile Lisp_Object also_record;
2490 volatile bool reread;
2491 struct gcpro gcpro1, gcpro2;
2492 bool volatile polling_stopped_here = 0;
2493 struct kboard *orig_kboard = current_kboard;
2495 also_record = Qnil;
2497 #if 0 /* This was commented out as part of fixing echo for C-u left. */
2498 before_command_key_count = this_command_key_count;
2499 before_command_echo_length = echo_length ();
2500 #endif
2501 c = Qnil;
2502 previous_echo_area_message = Qnil;
2504 GCPRO2 (c, previous_echo_area_message);
2506 retry:
2508 if (CONSP (Vunread_post_input_method_events))
2510 c = XCAR (Vunread_post_input_method_events);
2511 Vunread_post_input_method_events
2512 = XCDR (Vunread_post_input_method_events);
2514 /* Undo what read_char_x_menu_prompt did when it unread
2515 additional keys returned by Fx_popup_menu. */
2516 if (CONSP (c)
2517 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2518 && NILP (XCDR (c)))
2519 c = XCAR (c);
2521 reread = true;
2522 goto reread_first;
2524 else
2525 reread = false;
2528 if (CONSP (Vunread_command_events))
2530 bool was_disabled = 0;
2532 c = XCAR (Vunread_command_events);
2533 Vunread_command_events = XCDR (Vunread_command_events);
2535 /* Undo what sit-for did when it unread additional keys
2536 inside universal-argument. */
2538 if (CONSP (c) && EQ (XCAR (c), Qt))
2539 c = XCDR (c);
2540 else
2541 reread = true;
2543 /* Undo what read_char_x_menu_prompt did when it unread
2544 additional keys returned by Fx_popup_menu. */
2545 if (CONSP (c)
2546 && EQ (XCDR (c), Qdisabled)
2547 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))))
2549 was_disabled = 1;
2550 c = XCAR (c);
2553 /* If the queued event is something that used the mouse,
2554 set used_mouse_menu accordingly. */
2555 if (used_mouse_menu
2556 /* Also check was_disabled so last-nonmenu-event won't return
2557 a bad value when submenus are involved. (Bug#447) */
2558 && (EQ (c, Qtool_bar) || EQ (c, Qmenu_bar) || was_disabled))
2559 *used_mouse_menu = 1;
2561 goto reread_for_input_method;
2564 if (CONSP (Vunread_input_method_events))
2566 c = XCAR (Vunread_input_method_events);
2567 Vunread_input_method_events = XCDR (Vunread_input_method_events);
2569 /* Undo what read_char_x_menu_prompt did when it unread
2570 additional keys returned by Fx_popup_menu. */
2571 if (CONSP (c)
2572 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2573 && NILP (XCDR (c)))
2574 c = XCAR (c);
2575 reread = true;
2576 goto reread_for_input_method;
2579 this_command_key_count_reset = 0;
2581 if (!NILP (Vexecuting_kbd_macro))
2583 /* We set this to Qmacro; since that's not a frame, nobody will
2584 try to switch frames on us, and the selected window will
2585 remain unchanged.
2587 Since this event came from a macro, it would be misleading to
2588 leave internal_last_event_frame set to wherever the last
2589 real event came from. Normally, a switch-frame event selects
2590 internal_last_event_frame after each command is read, but
2591 events read from a macro should never cause a new frame to be
2592 selected. */
2593 Vlast_event_frame = internal_last_event_frame = Qmacro;
2595 /* Exit the macro if we are at the end.
2596 Also, some things replace the macro with t
2597 to force an early exit. */
2598 if (EQ (Vexecuting_kbd_macro, Qt)
2599 || executing_kbd_macro_index >= XFASTINT (Flength (Vexecuting_kbd_macro)))
2601 XSETINT (c, -1);
2602 goto exit;
2605 c = Faref (Vexecuting_kbd_macro, make_number (executing_kbd_macro_index));
2606 if (STRINGP (Vexecuting_kbd_macro)
2607 && (XFASTINT (c) & 0x80) && (XFASTINT (c) <= 0xff))
2608 XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80));
2610 executing_kbd_macro_index++;
2612 goto from_macro;
2615 if (!NILP (unread_switch_frame))
2617 c = unread_switch_frame;
2618 unread_switch_frame = Qnil;
2620 /* This event should make it into this_command_keys, and get echoed
2621 again, so we do not set `reread'. */
2622 goto reread_first;
2625 /* If redisplay was requested. */
2626 if (commandflag >= 0)
2628 bool echo_current = EQ (echo_message_buffer, echo_area_buffer[0]);
2630 /* If there is pending input, process any events which are not
2631 user-visible, such as X selection_request events. */
2632 if (input_pending
2633 || detect_input_pending_run_timers (0))
2634 swallow_events (false); /* May clear input_pending. */
2636 /* Redisplay if no pending input. */
2637 while (!(input_pending
2638 && (input_was_pending || !redisplay_dont_pause)))
2640 input_was_pending = input_pending;
2641 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
2642 redisplay_preserve_echo_area (5);
2643 else
2644 redisplay ();
2646 if (!input_pending)
2647 /* Normal case: no input arrived during redisplay. */
2648 break;
2650 /* Input arrived and pre-empted redisplay.
2651 Process any events which are not user-visible. */
2652 swallow_events (false);
2653 /* If that cleared input_pending, try again to redisplay. */
2656 /* Prevent the redisplay we just did
2657 from messing up echoing of the input after the prompt. */
2658 if (commandflag == 0 && echo_current)
2659 echo_message_buffer = echo_area_buffer[0];
2663 /* Message turns off echoing unless more keystrokes turn it on again.
2665 The code in 20.x for the condition was
2667 1. echo_area_glyphs && *echo_area_glyphs
2668 2. && echo_area_glyphs != current_kboard->echobuf
2669 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2671 (1) means there's a current message displayed
2673 (2) means it's not the message from echoing from the current
2674 kboard.
2676 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2677 is set to a non-null value. This is done in read_char and it is
2678 set to echo_area_glyphs after a call to echo_char. That means
2679 ok_to_echo_at_next_pause is either null or
2680 current_kboard->echobuf with the appropriate current_kboard at
2681 that time.
2683 So, condition (3) means in clear text ok_to_echo_at_next_pause
2684 must be either null, or the current message isn't from echoing at
2685 all, or it's from echoing from a different kboard than the
2686 current one. */
2688 if (/* There currently is something in the echo area. */
2689 !NILP (echo_area_buffer[0])
2690 && (/* It's an echo from a different kboard. */
2691 echo_kboard != current_kboard
2692 /* Or we explicitly allow overwriting whatever there is. */
2693 || ok_to_echo_at_next_pause == NULL))
2694 cancel_echoing ();
2695 else
2696 echo_dash ();
2698 /* Try reading a character via menu prompting in the minibuf.
2699 Try this before the sit-for, because the sit-for
2700 would do the wrong thing if we are supposed to do
2701 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2702 after a mouse event so don't try a minibuf menu. */
2703 c = Qnil;
2704 if (KEYMAPP (map) && INTERACTIVE
2705 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2706 /* Don't bring up a menu if we already have another event. */
2707 && NILP (Vunread_command_events)
2708 && !detect_input_pending_run_timers (0))
2710 c = read_char_minibuf_menu_prompt (commandflag, map);
2712 if (INTEGERP (c) && XINT (c) == -2)
2713 return c; /* wrong_kboard_jmpbuf */
2715 if (! NILP (c))
2716 goto exit;
2719 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2720 We will do that below, temporarily for short sections of code,
2721 when appropriate. local_getcjmp must be in effect
2722 around any call to sit_for or kbd_buffer_get_event;
2723 it *must not* be in effect when we call redisplay. */
2725 jmpcount = SPECPDL_INDEX ();
2726 if (sys_setjmp (local_getcjmp))
2728 /* Handle quits while reading the keyboard. */
2729 /* We must have saved the outer value of getcjmp here,
2730 so restore it now. */
2731 restore_getcjmp (save_jump);
2732 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
2733 unbind_to (jmpcount, Qnil);
2734 XSETINT (c, quit_char);
2735 internal_last_event_frame = selected_frame;
2736 Vlast_event_frame = internal_last_event_frame;
2737 /* If we report the quit char as an event,
2738 don't do so more than once. */
2739 if (!NILP (Vinhibit_quit))
2740 Vquit_flag = Qnil;
2743 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
2744 if (kb != current_kboard)
2746 Lisp_Object last = KVAR (kb, kbd_queue);
2747 /* We shouldn't get here if we were in single-kboard mode! */
2748 if (single_kboard)
2749 emacs_abort ();
2750 if (CONSP (last))
2752 while (CONSP (XCDR (last)))
2753 last = XCDR (last);
2754 if (!NILP (XCDR (last)))
2755 emacs_abort ();
2757 if (!CONSP (last))
2758 kset_kbd_queue (kb, list1 (c));
2759 else
2760 XSETCDR (last, list1 (c));
2761 kb->kbd_queue_has_data = 1;
2762 current_kboard = kb;
2763 /* This is going to exit from read_char
2764 so we had better get rid of this frame's stuff. */
2765 UNGCPRO;
2766 return make_number (-2); /* wrong_kboard_jmpbuf */
2769 goto non_reread;
2772 /* Start idle timers if no time limit is supplied. We don't do it
2773 if a time limit is supplied to avoid an infinite recursion in the
2774 situation where an idle timer calls `sit-for'. */
2776 if (!end_time)
2777 timer_start_idle ();
2779 /* If in middle of key sequence and minibuffer not active,
2780 start echoing if enough time elapses. */
2782 if (minibuf_level == 0
2783 && !end_time
2784 && !current_kboard->immediate_echo
2785 && this_command_key_count > 0
2786 && ! noninteractive
2787 && echo_keystrokes_p ()
2788 && (/* No message. */
2789 NILP (echo_area_buffer[0])
2790 /* Or empty message. */
2791 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2792 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2793 /* Or already echoing from same kboard. */
2794 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2795 /* Or not echoing before and echoing allowed. */
2796 || (!echo_kboard && ok_to_echo_at_next_pause)))
2798 /* After a mouse event, start echoing right away.
2799 This is because we are probably about to display a menu,
2800 and we don't want to delay before doing so. */
2801 if (EVENT_HAS_PARAMETERS (prev_event))
2802 echo_now ();
2803 else
2805 Lisp_Object tem0;
2807 save_getcjmp (save_jump);
2808 restore_getcjmp (local_getcjmp);
2809 tem0 = sit_for (Vecho_keystrokes, 1, 1);
2810 restore_getcjmp (save_jump);
2811 if (EQ (tem0, Qt)
2812 && ! CONSP (Vunread_command_events))
2813 echo_now ();
2817 /* Maybe auto save due to number of keystrokes. */
2819 if (commandflag != 0 && commandflag != -2
2820 && auto_save_interval > 0
2821 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
2822 && !detect_input_pending_run_timers (0))
2824 Fdo_auto_save (Qnil, Qnil);
2825 /* Hooks can actually change some buffers in auto save. */
2826 redisplay ();
2829 /* Try reading using an X menu.
2830 This is never confused with reading using the minibuf
2831 because the recursive call of read_char in read_char_minibuf_menu_prompt
2832 does not pass on any keymaps. */
2834 if (KEYMAPP (map) && INTERACTIVE
2835 && !NILP (prev_event)
2836 && EVENT_HAS_PARAMETERS (prev_event)
2837 && !EQ (XCAR (prev_event), Qmenu_bar)
2838 && !EQ (XCAR (prev_event), Qtool_bar)
2839 /* Don't bring up a menu if we already have another event. */
2840 && NILP (Vunread_command_events))
2842 c = read_char_x_menu_prompt (map, prev_event, used_mouse_menu);
2844 /* Now that we have read an event, Emacs is not idle. */
2845 if (!end_time)
2846 timer_stop_idle ();
2848 goto exit;
2851 /* Maybe autosave and/or garbage collect due to idleness. */
2853 if (INTERACTIVE && NILP (c))
2855 int delay_level;
2856 ptrdiff_t buffer_size;
2858 /* Slow down auto saves logarithmically in size of current buffer,
2859 and garbage collect while we're at it. */
2860 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2861 last_non_minibuf_size = Z - BEG;
2862 buffer_size = (last_non_minibuf_size >> 8) + 1;
2863 delay_level = 0;
2864 while (buffer_size > 64)
2865 delay_level++, buffer_size -= buffer_size >> 2;
2866 if (delay_level < 4) delay_level = 4;
2867 /* delay_level is 4 for files under around 50k, 7 at 100k,
2868 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2870 /* Auto save if enough time goes by without input. */
2871 if (commandflag != 0 && commandflag != -2
2872 && num_nonmacro_input_events > last_auto_save
2873 && INTEGERP (Vauto_save_timeout)
2874 && XINT (Vauto_save_timeout) > 0)
2876 Lisp_Object tem0;
2877 EMACS_INT timeout = XFASTINT (Vauto_save_timeout);
2879 timeout = min (timeout, MOST_POSITIVE_FIXNUM / delay_level * 4);
2880 timeout = delay_level * timeout / 4;
2881 save_getcjmp (save_jump);
2882 restore_getcjmp (local_getcjmp);
2883 tem0 = sit_for (make_number (timeout), 1, 1);
2884 restore_getcjmp (save_jump);
2886 if (EQ (tem0, Qt)
2887 && ! CONSP (Vunread_command_events))
2889 Fdo_auto_save (Qnil, Qnil);
2890 redisplay ();
2894 /* If there is still no input available, ask for GC. */
2895 if (!detect_input_pending_run_timers (0))
2896 maybe_gc ();
2899 /* Notify the caller if an autosave hook, or a timer, sentinel or
2900 filter in the sit_for calls above have changed the current
2901 kboard. This could happen if they use the minibuffer or start a
2902 recursive edit, like the fancy splash screen in server.el's
2903 filter. If this longjmp wasn't here, read_key_sequence would
2904 interpret the next key sequence using the wrong translation
2905 tables and function keymaps. */
2906 if (NILP (c) && current_kboard != orig_kboard)
2908 UNGCPRO;
2909 return make_number (-2); /* wrong_kboard_jmpbuf */
2912 /* If this has become non-nil here, it has been set by a timer
2913 or sentinel or filter. */
2914 if (CONSP (Vunread_command_events))
2916 c = XCAR (Vunread_command_events);
2917 Vunread_command_events = XCDR (Vunread_command_events);
2919 if (CONSP (c) && EQ (XCAR (c), Qt))
2920 c = XCDR (c);
2921 else
2922 reread = true;
2925 /* Read something from current KBOARD's side queue, if possible. */
2927 if (NILP (c))
2929 if (current_kboard->kbd_queue_has_data)
2931 if (!CONSP (KVAR (current_kboard, kbd_queue)))
2932 emacs_abort ();
2933 c = XCAR (KVAR (current_kboard, kbd_queue));
2934 kset_kbd_queue (current_kboard,
2935 XCDR (KVAR (current_kboard, kbd_queue)));
2936 if (NILP (KVAR (current_kboard, kbd_queue)))
2937 current_kboard->kbd_queue_has_data = 0;
2938 input_pending = readable_events (0);
2939 if (EVENT_HAS_PARAMETERS (c)
2940 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
2941 internal_last_event_frame = XCAR (XCDR (c));
2942 Vlast_event_frame = internal_last_event_frame;
2946 /* If current_kboard's side queue is empty check the other kboards.
2947 If one of them has data that we have not yet seen here,
2948 switch to it and process the data waiting for it.
2950 Note: if the events queued up for another kboard
2951 have already been seen here, and therefore are not a complete command,
2952 the kbd_queue_has_data field is 0, so we skip that kboard here.
2953 That's to avoid an infinite loop switching between kboards here. */
2954 if (NILP (c) && !single_kboard)
2956 KBOARD *kb;
2957 for (kb = all_kboards; kb; kb = kb->next_kboard)
2958 if (kb->kbd_queue_has_data)
2960 current_kboard = kb;
2961 /* This is going to exit from read_char
2962 so we had better get rid of this frame's stuff. */
2963 UNGCPRO;
2964 return make_number (-2); /* wrong_kboard_jmpbuf */
2968 wrong_kboard:
2970 STOP_POLLING;
2972 if (NILP (c))
2974 c = read_decoded_event_from_main_queue (end_time, local_getcjmp,
2975 prev_event, used_mouse_menu);
2976 if (NILP (c) && end_time
2977 && timespec_cmp (*end_time, current_timespec ()) <= 0)
2979 goto exit;
2982 if (EQ (c, make_number (-2)))
2984 /* This is going to exit from read_char
2985 so we had better get rid of this frame's stuff. */
2986 UNGCPRO;
2987 return c;
2991 non_reread:
2993 if (!end_time)
2994 timer_stop_idle ();
2995 RESUME_POLLING;
2997 if (NILP (c))
2999 if (commandflag >= 0
3000 && !input_pending && !detect_input_pending_run_timers (0))
3001 redisplay ();
3003 goto wrong_kboard;
3006 /* Buffer switch events are only for internal wakeups
3007 so don't show them to the user.
3008 Also, don't record a key if we already did. */
3009 if (BUFFERP (c))
3010 goto exit;
3012 /* Process special events within read_char
3013 and loop around to read another event. */
3014 save = Vquit_flag;
3015 Vquit_flag = Qnil;
3016 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
3017 Vquit_flag = save;
3019 if (!NILP (tem))
3021 struct buffer *prev_buffer = current_buffer;
3022 last_input_event = c;
3023 call4 (Qcommand_execute, tem, Qnil, Fvector (1, &last_input_event), Qt);
3025 if (CONSP (c) && EQ (XCAR (c), Qselect_window) && !end_time)
3026 /* We stopped being idle for this event; undo that. This
3027 prevents automatic window selection (under
3028 mouse_autoselect_window from acting as a real input event, for
3029 example banishing the mouse under mouse-avoidance-mode. */
3030 timer_resume_idle ();
3032 if (current_buffer != prev_buffer)
3034 /* The command may have changed the keymaps. Pretend there
3035 is input in another keyboard and return. This will
3036 recalculate keymaps. */
3037 c = make_number (-2);
3038 goto exit;
3040 else
3041 goto retry;
3044 /* Handle things that only apply to characters. */
3045 if (INTEGERP (c))
3047 /* If kbd_buffer_get_event gave us an EOF, return that. */
3048 if (XINT (c) == -1)
3049 goto exit;
3051 if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table))
3052 && UNSIGNED_CMP (XFASTINT (c), <,
3053 SCHARS (KVAR (current_kboard,
3054 Vkeyboard_translate_table))))
3055 || (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table))
3056 && UNSIGNED_CMP (XFASTINT (c), <,
3057 ASIZE (KVAR (current_kboard,
3058 Vkeyboard_translate_table))))
3059 || (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table))
3060 && CHARACTERP (c)))
3062 Lisp_Object d;
3063 d = Faref (KVAR (current_kboard, Vkeyboard_translate_table), c);
3064 /* nil in keyboard-translate-table means no translation. */
3065 if (!NILP (d))
3066 c = d;
3070 /* If this event is a mouse click in the menu bar,
3071 return just menu-bar for now. Modify the mouse click event
3072 so we won't do this twice, then queue it up. */
3073 if (EVENT_HAS_PARAMETERS (c)
3074 && CONSP (XCDR (c))
3075 && CONSP (EVENT_START (c))
3076 && CONSP (XCDR (EVENT_START (c))))
3078 Lisp_Object posn;
3080 posn = POSN_POSN (EVENT_START (c));
3081 /* Handle menu-bar events:
3082 insert the dummy prefix event `menu-bar'. */
3083 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
3085 /* Change menu-bar to (menu-bar) as the event "position". */
3086 POSN_SET_POSN (EVENT_START (c), list1 (posn));
3088 also_record = c;
3089 Vunread_command_events = Fcons (c, Vunread_command_events);
3090 c = posn;
3094 /* Store these characters into recent_keys, the dribble file if any,
3095 and the keyboard macro being defined, if any. */
3096 record_char (c);
3097 if (! NILP (also_record))
3098 record_char (also_record);
3100 /* Wipe the echo area.
3101 But first, if we are about to use an input method,
3102 save the echo area contents for it to refer to. */
3103 if (INTEGERP (c)
3104 && ! NILP (Vinput_method_function)
3105 && ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127)
3107 previous_echo_area_message = Fcurrent_message ();
3108 Vinput_method_previous_message = previous_echo_area_message;
3111 /* Now wipe the echo area, except for help events which do their
3112 own stuff with the echo area. */
3113 if (!CONSP (c)
3114 || (!(EQ (Qhelp_echo, XCAR (c)))
3115 && !(EQ (Qswitch_frame, XCAR (c)))
3116 /* Don't wipe echo area for select window events: These might
3117 get delayed via `mouse-autoselect-window' (Bug#11304). */
3118 && !(EQ (Qselect_window, XCAR (c)))))
3120 if (!NILP (echo_area_buffer[0]))
3122 safe_run_hooks (Qecho_area_clear_hook);
3123 clear_message (1, 0);
3127 reread_for_input_method:
3128 from_macro:
3129 /* Pass this to the input method, if appropriate. */
3130 if (INTEGERP (c)
3131 && ! NILP (Vinput_method_function)
3132 /* Don't run the input method within a key sequence,
3133 after the first event of the key sequence. */
3134 && NILP (prev_event)
3135 && ' ' <= XINT (c) && XINT (c) < 256 && XINT (c) != 127)
3137 Lisp_Object keys;
3138 ptrdiff_t key_count;
3139 bool key_count_reset;
3140 struct gcpro gcpro1;
3141 ptrdiff_t count = SPECPDL_INDEX ();
3143 /* Save the echo status. */
3144 bool saved_immediate_echo = current_kboard->immediate_echo;
3145 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
3146 Lisp_Object saved_echo_string = KVAR (current_kboard, echo_string);
3147 ptrdiff_t saved_echo_after_prompt = current_kboard->echo_after_prompt;
3149 #if 0
3150 if (before_command_restore_flag)
3152 this_command_key_count = before_command_key_count_1;
3153 if (this_command_key_count < this_single_command_key_start)
3154 this_single_command_key_start = this_command_key_count;
3155 echo_truncate (before_command_echo_length_1);
3156 before_command_restore_flag = 0;
3158 #endif
3160 /* Save the this_command_keys status. */
3161 key_count = this_command_key_count;
3162 key_count_reset = this_command_key_count_reset;
3164 if (key_count > 0)
3165 keys = Fcopy_sequence (this_command_keys);
3166 else
3167 keys = Qnil;
3168 GCPRO1 (keys);
3170 /* Clear out this_command_keys. */
3171 this_command_key_count = 0;
3172 this_command_key_count_reset = 0;
3174 /* Now wipe the echo area. */
3175 if (!NILP (echo_area_buffer[0]))
3176 safe_run_hooks (Qecho_area_clear_hook);
3177 clear_message (1, 0);
3178 echo_truncate (0);
3180 /* If we are not reading a key sequence,
3181 never use the echo area. */
3182 if (!KEYMAPP (map))
3184 specbind (Qinput_method_use_echo_area, Qt);
3187 /* Call the input method. */
3188 tem = call1 (Vinput_method_function, c);
3190 tem = unbind_to (count, tem);
3192 /* Restore the saved echoing state
3193 and this_command_keys state. */
3194 this_command_key_count = key_count;
3195 this_command_key_count_reset = key_count_reset;
3196 if (key_count > 0)
3197 this_command_keys = keys;
3199 cancel_echoing ();
3200 ok_to_echo_at_next_pause = saved_ok_to_echo;
3201 kset_echo_string (current_kboard, saved_echo_string);
3202 current_kboard->echo_after_prompt = saved_echo_after_prompt;
3203 if (saved_immediate_echo)
3204 echo_now ();
3206 UNGCPRO;
3208 /* The input method can return no events. */
3209 if (! CONSP (tem))
3211 /* Bring back the previous message, if any. */
3212 if (! NILP (previous_echo_area_message))
3213 message_with_string ("%s", previous_echo_area_message, 0);
3214 goto retry;
3216 /* It returned one event or more. */
3217 c = XCAR (tem);
3218 Vunread_post_input_method_events
3219 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
3222 reread_first:
3224 /* Display help if not echoing. */
3225 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
3227 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
3228 Lisp_Object help, object, position, window, htem;
3230 htem = Fcdr (XCDR (c));
3231 help = Fcar (htem);
3232 htem = Fcdr (htem);
3233 window = Fcar (htem);
3234 htem = Fcdr (htem);
3235 object = Fcar (htem);
3236 htem = Fcdr (htem);
3237 position = Fcar (htem);
3239 show_help_echo (help, window, object, position);
3241 /* We stopped being idle for this event; undo that. */
3242 if (!end_time)
3243 timer_resume_idle ();
3244 goto retry;
3247 if ((! reread || this_command_key_count == 0
3248 || this_command_key_count_reset)
3249 && !end_time)
3252 /* Don't echo mouse motion events. */
3253 if (echo_keystrokes_p ()
3254 && ! (EVENT_HAS_PARAMETERS (c)
3255 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
3257 echo_char (c);
3258 if (! NILP (also_record))
3259 echo_char (also_record);
3260 /* Once we reread a character, echoing can happen
3261 the next time we pause to read a new one. */
3262 ok_to_echo_at_next_pause = current_kboard;
3265 /* Record this character as part of the current key. */
3266 add_command_key (c);
3267 if (! NILP (also_record))
3268 add_command_key (also_record);
3271 last_input_event = c;
3272 num_input_events++;
3274 /* Process the help character specially if enabled. */
3275 if (!NILP (Vhelp_form) && help_char_p (c))
3277 ptrdiff_t count = SPECPDL_INDEX ();
3279 help_form_saved_window_configs
3280 = Fcons (Fcurrent_window_configuration (Qnil),
3281 help_form_saved_window_configs);
3282 record_unwind_protect_void (read_char_help_form_unwind);
3283 call0 (Qhelp_form_show);
3285 cancel_echoing ();
3288 c = read_char (0, Qnil, Qnil, 0, NULL);
3289 if (EVENT_HAS_PARAMETERS (c)
3290 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_click))
3291 XSETCAR (help_form_saved_window_configs, Qnil);
3293 while (BUFFERP (c));
3294 /* Remove the help from the frame. */
3295 unbind_to (count, Qnil);
3297 redisplay ();
3298 if (EQ (c, make_number (040)))
3300 cancel_echoing ();
3302 c = read_char (0, Qnil, Qnil, 0, NULL);
3303 while (BUFFERP (c));
3307 exit:
3308 RESUME_POLLING;
3309 input_was_pending = input_pending;
3310 RETURN_UNGCPRO (c);
3313 /* Record a key that came from a mouse menu.
3314 Record it for echoing, for this-command-keys, and so on. */
3316 static void
3317 record_menu_key (Lisp_Object c)
3319 /* Wipe the echo area. */
3320 clear_message (1, 0);
3322 record_char (c);
3324 #if 0
3325 before_command_key_count = this_command_key_count;
3326 before_command_echo_length = echo_length ();
3327 #endif
3329 /* Don't echo mouse motion events. */
3330 if (echo_keystrokes_p ())
3332 echo_char (c);
3334 /* Once we reread a character, echoing can happen
3335 the next time we pause to read a new one. */
3336 ok_to_echo_at_next_pause = 0;
3339 /* Record this character as part of the current key. */
3340 add_command_key (c);
3342 /* Re-reading in the middle of a command. */
3343 last_input_event = c;
3344 num_input_events++;
3347 /* Return true if should recognize C as "the help character". */
3349 static bool
3350 help_char_p (Lisp_Object c)
3352 Lisp_Object tail;
3354 if (EQ (c, Vhelp_char))
3355 return 1;
3356 for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
3357 if (EQ (c, XCAR (tail)))
3358 return 1;
3359 return 0;
3362 /* Record the input event C in various ways. */
3364 static void
3365 record_char (Lisp_Object c)
3367 int recorded = 0;
3369 if (CONSP (c) && (EQ (XCAR (c), Qhelp_echo) || EQ (XCAR (c), Qmouse_movement)))
3371 /* To avoid filling recent_keys with help-echo and mouse-movement
3372 events, we filter out repeated help-echo events, only store the
3373 first and last in a series of mouse-movement events, and don't
3374 store repeated help-echo events which are only separated by
3375 mouse-movement events. */
3377 Lisp_Object ev1, ev2, ev3;
3378 int ix1, ix2, ix3;
3380 if ((ix1 = recent_keys_index - 1) < 0)
3381 ix1 = NUM_RECENT_KEYS - 1;
3382 ev1 = AREF (recent_keys, ix1);
3384 if ((ix2 = ix1 - 1) < 0)
3385 ix2 = NUM_RECENT_KEYS - 1;
3386 ev2 = AREF (recent_keys, ix2);
3388 if ((ix3 = ix2 - 1) < 0)
3389 ix3 = NUM_RECENT_KEYS - 1;
3390 ev3 = AREF (recent_keys, ix3);
3392 if (EQ (XCAR (c), Qhelp_echo))
3394 /* Don't record `help-echo' in recent_keys unless it shows some help
3395 message, and a different help than the previously recorded
3396 event. */
3397 Lisp_Object help, last_help;
3399 help = Fcar_safe (Fcdr_safe (XCDR (c)));
3400 if (!STRINGP (help))
3401 recorded = 1;
3402 else if (CONSP (ev1) && EQ (XCAR (ev1), Qhelp_echo)
3403 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev1))), EQ (last_help, help)))
3404 recorded = 1;
3405 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3406 && CONSP (ev2) && EQ (XCAR (ev2), Qhelp_echo)
3407 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev2))), EQ (last_help, help)))
3408 recorded = -1;
3409 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3410 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3411 && CONSP (ev3) && EQ (XCAR (ev3), Qhelp_echo)
3412 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev3))), EQ (last_help, help)))
3413 recorded = -2;
3415 else if (EQ (XCAR (c), Qmouse_movement))
3417 /* Only record one pair of `mouse-movement' on a window in recent_keys.
3418 So additional mouse movement events replace the last element. */
3419 Lisp_Object last_window, window;
3421 window = Fcar_safe (Fcar_safe (XCDR (c)));
3422 if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3423 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev1))), EQ (last_window, window))
3424 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3425 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev2))), EQ (last_window, window)))
3427 ASET (recent_keys, ix1, c);
3428 recorded = 1;
3432 else
3433 store_kbd_macro_char (c);
3435 if (!recorded)
3437 total_keys += total_keys < NUM_RECENT_KEYS;
3438 ASET (recent_keys, recent_keys_index, c);
3439 if (++recent_keys_index >= NUM_RECENT_KEYS)
3440 recent_keys_index = 0;
3442 else if (recorded < 0)
3444 /* We need to remove one or two events from recent_keys.
3445 To do this, we simply put nil at those events and move the
3446 recent_keys_index backwards over those events. Usually,
3447 users will never see those nil events, as they will be
3448 overwritten by the command keys entered to see recent_keys
3449 (e.g. C-h l). */
3451 while (recorded++ < 0 && total_keys > 0)
3453 if (total_keys < NUM_RECENT_KEYS)
3454 total_keys--;
3455 if (--recent_keys_index < 0)
3456 recent_keys_index = NUM_RECENT_KEYS - 1;
3457 ASET (recent_keys, recent_keys_index, Qnil);
3461 num_nonmacro_input_events++;
3463 /* Write c to the dribble file. If c is a lispy event, write
3464 the event's symbol to the dribble file, in <brackets>. Bleaugh.
3465 If you, dear reader, have a better idea, you've got the source. :-) */
3466 if (dribble)
3468 block_input ();
3469 if (INTEGERP (c))
3471 if (XUINT (c) < 0x100)
3472 putc (XUINT (c), dribble);
3473 else
3474 fprintf (dribble, " 0x%"pI"x", XUINT (c));
3476 else
3478 Lisp_Object dribblee;
3480 /* If it's a structured event, take the event header. */
3481 dribblee = EVENT_HEAD (c);
3483 if (SYMBOLP (dribblee))
3485 putc ('<', dribble);
3486 fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
3487 SBYTES (SYMBOL_NAME (dribblee)),
3488 dribble);
3489 putc ('>', dribble);
3493 fflush (dribble);
3494 unblock_input ();
3498 /* Copy out or in the info on where C-g should throw to.
3499 This is used when running Lisp code from within get_char,
3500 in case get_char is called recursively.
3501 See read_process_output. */
3503 static void
3504 save_getcjmp (sys_jmp_buf temp)
3506 memcpy (temp, getcjmp, sizeof getcjmp);
3509 static void
3510 restore_getcjmp (sys_jmp_buf temp)
3512 memcpy (getcjmp, temp, sizeof getcjmp);
3515 /* Low level keyboard/mouse input.
3516 kbd_buffer_store_event places events in kbd_buffer, and
3517 kbd_buffer_get_event retrieves them. */
3519 /* Return true if there are any events in the queue that read-char
3520 would return. If this returns false, a read-char would block. */
3521 static bool
3522 readable_events (int flags)
3524 if (flags & READABLE_EVENTS_DO_TIMERS_NOW)
3525 timer_check ();
3527 /* If the buffer contains only FOCUS_IN_EVENT events, and
3528 READABLE_EVENTS_FILTER_EVENTS is set, report it as empty. */
3529 if (kbd_fetch_ptr != kbd_store_ptr)
3531 if (flags & (READABLE_EVENTS_FILTER_EVENTS
3532 #ifdef USE_TOOLKIT_SCROLL_BARS
3533 | READABLE_EVENTS_IGNORE_SQUEEZABLES
3534 #endif
3537 struct input_event *event;
3539 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3540 ? kbd_fetch_ptr
3541 : kbd_buffer);
3545 if (!(
3546 #ifdef USE_TOOLKIT_SCROLL_BARS
3547 (flags & READABLE_EVENTS_FILTER_EVENTS) &&
3548 #endif
3549 event->kind == FOCUS_IN_EVENT)
3550 #ifdef USE_TOOLKIT_SCROLL_BARS
3551 && !((flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3552 && (event->kind == SCROLL_BAR_CLICK_EVENT
3553 || event->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT)
3554 && event->part == scroll_bar_handle
3555 && event->modifiers == 0)
3556 #endif
3557 && !((flags & READABLE_EVENTS_FILTER_EVENTS)
3558 && event->kind == BUFFER_SWITCH_EVENT))
3559 return 1;
3560 event++;
3561 if (event == kbd_buffer + KBD_BUFFER_SIZE)
3562 event = kbd_buffer;
3564 while (event != kbd_store_ptr);
3566 else
3567 return 1;
3570 if (!(flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3571 && !NILP (do_mouse_tracking) && some_mouse_moved ())
3572 return 1;
3573 if (single_kboard)
3575 if (current_kboard->kbd_queue_has_data)
3576 return 1;
3578 else
3580 KBOARD *kb;
3581 for (kb = all_kboards; kb; kb = kb->next_kboard)
3582 if (kb->kbd_queue_has_data)
3583 return 1;
3585 return 0;
3588 /* Set this for debugging, to have a way to get out */
3589 int stop_character EXTERNALLY_VISIBLE;
3591 static KBOARD *
3592 event_to_kboard (struct input_event *event)
3594 /* Not applicable for these special events. */
3595 if (event->kind == SELECTION_REQUEST_EVENT
3596 || event->kind == SELECTION_CLEAR_EVENT)
3597 return NULL;
3598 else
3600 Lisp_Object obj = event->frame_or_window;
3601 /* There are some events that set this field to nil or string. */
3602 if (WINDOWP (obj))
3603 obj = WINDOW_FRAME (XWINDOW (obj));
3604 /* Also ignore dead frames here. */
3605 return ((FRAMEP (obj) && FRAME_LIVE_P (XFRAME (obj)))
3606 ? FRAME_KBOARD (XFRAME (obj)) : NULL);
3610 #ifdef subprocesses
3611 /* Return the number of slots occupied in kbd_buffer. */
3613 static int
3614 kbd_buffer_nr_stored (void)
3616 return kbd_fetch_ptr == kbd_store_ptr
3618 : (kbd_fetch_ptr < kbd_store_ptr
3619 ? kbd_store_ptr - kbd_fetch_ptr
3620 : ((kbd_buffer + KBD_BUFFER_SIZE) - kbd_fetch_ptr
3621 + (kbd_store_ptr - kbd_buffer)));
3623 #endif /* Store an event obtained at interrupt level into kbd_buffer, fifo */
3625 void
3626 kbd_buffer_store_event (register struct input_event *event)
3628 kbd_buffer_store_event_hold (event, 0);
3631 /* Store EVENT obtained at interrupt level into kbd_buffer, fifo.
3633 If HOLD_QUIT is 0, just stuff EVENT into the fifo.
3634 Else, if HOLD_QUIT.kind != NO_EVENT, discard EVENT.
3635 Else, if EVENT is a quit event, store the quit event
3636 in HOLD_QUIT, and return (thus ignoring further events).
3638 This is used to postpone the processing of the quit event until all
3639 subsequent input events have been parsed (and discarded). */
3641 void
3642 kbd_buffer_store_event_hold (register struct input_event *event,
3643 struct input_event *hold_quit)
3645 if (event->kind == NO_EVENT)
3646 emacs_abort ();
3648 if (hold_quit && hold_quit->kind != NO_EVENT)
3649 return;
3651 if (event->kind == ASCII_KEYSTROKE_EVENT)
3653 register int c = event->code & 0377;
3655 if (event->modifiers & ctrl_modifier)
3656 c = make_ctrl_char (c);
3658 c |= (event->modifiers
3659 & (meta_modifier | alt_modifier
3660 | hyper_modifier | super_modifier));
3662 if (c == quit_char)
3664 KBOARD *kb = FRAME_KBOARD (XFRAME (event->frame_or_window));
3665 struct input_event *sp;
3667 if (single_kboard && kb != current_kboard)
3669 kset_kbd_queue
3670 (kb, list2 (make_lispy_switch_frame (event->frame_or_window),
3671 make_number (c)));
3672 kb->kbd_queue_has_data = 1;
3673 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3675 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3676 sp = kbd_buffer;
3678 if (event_to_kboard (sp) == kb)
3680 sp->kind = NO_EVENT;
3681 sp->frame_or_window = Qnil;
3682 sp->arg = Qnil;
3685 return;
3688 if (hold_quit)
3690 *hold_quit = *event;
3691 return;
3694 /* If this results in a quit_char being returned to Emacs as
3695 input, set Vlast_event_frame properly. If this doesn't
3696 get returned to Emacs as an event, the next event read
3697 will set Vlast_event_frame again, so this is safe to do. */
3699 Lisp_Object focus;
3701 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
3702 if (NILP (focus))
3703 focus = event->frame_or_window;
3704 internal_last_event_frame = focus;
3705 Vlast_event_frame = focus;
3708 handle_interrupt (0);
3709 return;
3712 if (c && c == stop_character)
3714 sys_suspend ();
3715 return;
3718 /* Don't insert two BUFFER_SWITCH_EVENT's in a row.
3719 Just ignore the second one. */
3720 else if (event->kind == BUFFER_SWITCH_EVENT
3721 && kbd_fetch_ptr != kbd_store_ptr
3722 && ((kbd_store_ptr == kbd_buffer
3723 ? kbd_buffer + KBD_BUFFER_SIZE - 1
3724 : kbd_store_ptr - 1)->kind) == BUFFER_SWITCH_EVENT)
3725 return;
3727 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
3728 kbd_store_ptr = kbd_buffer;
3730 /* Don't let the very last slot in the buffer become full,
3731 since that would make the two pointers equal,
3732 and that is indistinguishable from an empty buffer.
3733 Discard the event if it would fill the last slot. */
3734 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3736 *kbd_store_ptr = *event;
3737 ++kbd_store_ptr;
3738 #ifdef subprocesses
3739 if (kbd_buffer_nr_stored () > KBD_BUFFER_SIZE / 2
3740 && ! kbd_on_hold_p ())
3742 /* Don't read keyboard input until we have processed kbd_buffer.
3743 This happens when pasting text longer than KBD_BUFFER_SIZE/2. */
3744 hold_keyboard_input ();
3745 if (!noninteractive)
3746 ignore_sigio ();
3747 stop_polling ();
3749 #endif /* subprocesses */
3752 /* If we're inside while-no-input, and this event qualifies
3753 as input, set quit-flag to cause an interrupt. */
3754 if (!NILP (Vthrow_on_input)
3755 && event->kind != FOCUS_IN_EVENT
3756 && event->kind != HELP_EVENT
3757 && event->kind != DEICONIFY_EVENT)
3759 Vquit_flag = Vthrow_on_input;
3760 /* If we're inside a function that wants immediate quits,
3761 do it now. */
3762 if (immediate_quit && NILP (Vinhibit_quit))
3764 immediate_quit = 0;
3765 QUIT;
3771 /* Put an input event back in the head of the event queue. */
3773 void
3774 kbd_buffer_unget_event (register struct input_event *event)
3776 if (kbd_fetch_ptr == kbd_buffer)
3777 kbd_fetch_ptr = kbd_buffer + KBD_BUFFER_SIZE;
3779 /* Don't let the very last slot in the buffer become full, */
3780 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3782 --kbd_fetch_ptr;
3783 *kbd_fetch_ptr = *event;
3787 /* Limit help event positions to this range, to avoid overflow problems. */
3788 #define INPUT_EVENT_POS_MAX \
3789 ((ptrdiff_t) min (PTRDIFF_MAX, min (TYPE_MAXIMUM (Time) / 2, \
3790 MOST_POSITIVE_FIXNUM)))
3791 #define INPUT_EVENT_POS_MIN (-1 - INPUT_EVENT_POS_MAX)
3793 /* Return a Time that encodes position POS. POS must be in range. */
3795 static Time
3796 position_to_Time (ptrdiff_t pos)
3798 eassert (INPUT_EVENT_POS_MIN <= pos && pos <= INPUT_EVENT_POS_MAX);
3799 return pos;
3802 /* Return the position that ENCODED_POS encodes.
3803 Avoid signed integer overflow. */
3805 static ptrdiff_t
3806 Time_to_position (Time encoded_pos)
3808 if (encoded_pos <= INPUT_EVENT_POS_MAX)
3809 return encoded_pos;
3810 Time encoded_pos_min = INPUT_EVENT_POS_MIN;
3811 eassert (encoded_pos_min <= encoded_pos);
3812 ptrdiff_t notpos = -1 - encoded_pos;
3813 return -1 - notpos;
3816 /* Generate a HELP_EVENT input_event and store it in the keyboard
3817 buffer.
3819 HELP is the help form.
3821 FRAME and WINDOW are the frame and window where the help is
3822 generated. OBJECT is the Lisp object where the help was found (a
3823 buffer, a string, an overlay, or nil if neither from a string nor
3824 from a buffer). POS is the position within OBJECT where the help
3825 was found. */
3827 void
3828 gen_help_event (Lisp_Object help, Lisp_Object frame, Lisp_Object window,
3829 Lisp_Object object, ptrdiff_t pos)
3831 struct input_event event;
3833 event.kind = HELP_EVENT;
3834 event.frame_or_window = frame;
3835 event.arg = object;
3836 event.x = WINDOWP (window) ? window : frame;
3837 event.y = help;
3838 event.timestamp = position_to_Time (pos);
3839 kbd_buffer_store_event (&event);
3843 /* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3845 void
3846 kbd_buffer_store_help_event (Lisp_Object frame, Lisp_Object help)
3848 struct input_event event;
3850 event.kind = HELP_EVENT;
3851 event.frame_or_window = frame;
3852 event.arg = Qnil;
3853 event.x = Qnil;
3854 event.y = help;
3855 event.timestamp = 0;
3856 kbd_buffer_store_event (&event);
3860 /* Discard any mouse events in the event buffer by setting them to
3861 NO_EVENT. */
3862 void
3863 discard_mouse_events (void)
3865 struct input_event *sp;
3866 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3868 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3869 sp = kbd_buffer;
3871 if (sp->kind == MOUSE_CLICK_EVENT
3872 || sp->kind == WHEEL_EVENT
3873 || sp->kind == HORIZ_WHEEL_EVENT
3874 #ifdef HAVE_GPM
3875 || sp->kind == GPM_CLICK_EVENT
3876 #endif
3877 || sp->kind == SCROLL_BAR_CLICK_EVENT
3878 || sp->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT)
3880 sp->kind = NO_EVENT;
3886 /* Return true if there are any real events waiting in the event
3887 buffer, not counting `NO_EVENT's.
3889 Discard NO_EVENT events at the front of the input queue, possibly
3890 leaving the input queue empty if there are no real input events. */
3892 bool
3893 kbd_buffer_events_waiting (void)
3895 struct input_event *sp;
3897 for (sp = kbd_fetch_ptr;
3898 sp != kbd_store_ptr && sp->kind == NO_EVENT;
3899 ++sp)
3901 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3902 sp = kbd_buffer;
3905 kbd_fetch_ptr = sp;
3906 return sp != kbd_store_ptr && sp->kind != NO_EVENT;
3910 /* Clear input event EVENT. */
3912 static void
3913 clear_event (struct input_event *event)
3915 event->kind = NO_EVENT;
3919 /* Read one event from the event buffer, waiting if necessary.
3920 The value is a Lisp object representing the event.
3921 The value is nil for an event that should be ignored,
3922 or that was handled here.
3923 We always read and discard one event. */
3925 static Lisp_Object
3926 kbd_buffer_get_event (KBOARD **kbp,
3927 bool *used_mouse_menu,
3928 struct timespec *end_time)
3930 Lisp_Object obj;
3932 #ifdef subprocesses
3933 if (kbd_on_hold_p () && kbd_buffer_nr_stored () < KBD_BUFFER_SIZE / 4)
3935 /* Start reading input again because we have processed enough to
3936 be able to accept new events again. */
3937 unhold_keyboard_input ();
3938 start_polling ();
3940 #endif /* subprocesses */
3942 #if !defined HAVE_DBUS && !defined USE_FILE_NOTIFY
3943 if (noninteractive
3944 /* In case we are running as a daemon, only do this before
3945 detaching from the terminal. */
3946 || (IS_DAEMON && daemon_pipe[1] >= 0))
3948 int c = getchar ();
3949 XSETINT (obj, c);
3950 *kbp = current_kboard;
3951 return obj;
3953 #endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY */
3955 /* Wait until there is input available. */
3956 for (;;)
3958 /* Break loop if there's an unread command event. Needed in
3959 moused window autoselection which uses a timer to insert such
3960 events. */
3961 if (CONSP (Vunread_command_events))
3962 break;
3964 if (kbd_fetch_ptr != kbd_store_ptr)
3965 break;
3966 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3967 break;
3969 /* If the quit flag is set, then read_char will return
3970 quit_char, so that counts as "available input." */
3971 if (!NILP (Vquit_flag))
3972 quit_throw_to_read_char (0);
3974 /* One way or another, wait until input is available; then, if
3975 interrupt handlers have not read it, read it now. */
3977 #ifdef USABLE_SIGIO
3978 gobble_input ();
3979 #endif
3980 if (kbd_fetch_ptr != kbd_store_ptr)
3981 break;
3982 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3983 break;
3984 if (end_time)
3986 struct timespec now = current_timespec ();
3987 if (timespec_cmp (*end_time, now) <= 0)
3988 return Qnil; /* Finished waiting. */
3989 else
3991 struct timespec duration = timespec_sub (*end_time, now);
3992 wait_reading_process_output (min (duration.tv_sec,
3993 WAIT_READING_MAX),
3994 duration.tv_nsec,
3995 -1, 1, Qnil, NULL, 0);
3998 else
4000 bool do_display = true;
4002 if (FRAME_TERMCAP_P (SELECTED_FRAME ()))
4004 struct tty_display_info *tty = CURTTY ();
4006 /* When this TTY is displaying a menu, we must prevent
4007 any redisplay, because we modify the frame's glyph
4008 matrix behind the back of the display engine. */
4009 if (tty->showing_menu)
4010 do_display = false;
4013 wait_reading_process_output (0, 0, -1, do_display, Qnil, NULL, 0);
4016 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
4017 gobble_input ();
4020 if (CONSP (Vunread_command_events))
4022 Lisp_Object first;
4023 first = XCAR (Vunread_command_events);
4024 Vunread_command_events = XCDR (Vunread_command_events);
4025 *kbp = current_kboard;
4026 return first;
4029 /* At this point, we know that there is a readable event available
4030 somewhere. If the event queue is empty, then there must be a
4031 mouse movement enabled and available. */
4032 if (kbd_fetch_ptr != kbd_store_ptr)
4034 struct input_event *event;
4036 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
4037 ? kbd_fetch_ptr
4038 : kbd_buffer);
4040 *kbp = event_to_kboard (event);
4041 if (*kbp == 0)
4042 *kbp = current_kboard; /* Better than returning null ptr? */
4044 obj = Qnil;
4046 /* These two kinds of events get special handling
4047 and don't actually appear to the command loop.
4048 We return nil for them. */
4049 if (event->kind == SELECTION_REQUEST_EVENT
4050 || event->kind == SELECTION_CLEAR_EVENT)
4052 #ifdef HAVE_X11
4053 struct input_event copy;
4055 /* Remove it from the buffer before processing it,
4056 since otherwise swallow_events will see it
4057 and process it again. */
4058 copy = *event;
4059 kbd_fetch_ptr = event + 1;
4060 input_pending = readable_events (0);
4061 x_handle_selection_event (&copy);
4062 #else
4063 /* We're getting selection request events, but we don't have
4064 a window system. */
4065 emacs_abort ();
4066 #endif
4069 #if defined (HAVE_NS)
4070 else if (event->kind == NS_TEXT_EVENT)
4072 if (event->code == KEY_NS_PUT_WORKING_TEXT)
4073 obj = list1 (intern ("ns-put-working-text"));
4074 else
4075 obj = list1 (intern ("ns-unput-working-text"));
4076 kbd_fetch_ptr = event + 1;
4077 if (used_mouse_menu)
4078 *used_mouse_menu = 1;
4080 #endif
4082 #if defined (HAVE_X11) || defined (HAVE_NTGUI) \
4083 || defined (HAVE_NS)
4084 else if (event->kind == DELETE_WINDOW_EVENT)
4086 /* Make an event (delete-frame (FRAME)). */
4087 obj = list2 (Qdelete_frame, list1 (event->frame_or_window));
4088 kbd_fetch_ptr = event + 1;
4090 #endif
4091 #if defined (HAVE_X11) || defined (HAVE_NTGUI) \
4092 || defined (HAVE_NS)
4093 else if (event->kind == ICONIFY_EVENT)
4095 /* Make an event (iconify-frame (FRAME)). */
4096 obj = list2 (Qiconify_frame, list1 (event->frame_or_window));
4097 kbd_fetch_ptr = event + 1;
4099 else if (event->kind == DEICONIFY_EVENT)
4101 /* Make an event (make-frame-visible (FRAME)). */
4102 obj = list2 (Qmake_frame_visible, list1 (event->frame_or_window));
4103 kbd_fetch_ptr = event + 1;
4105 #endif
4106 else if (event->kind == BUFFER_SWITCH_EVENT)
4108 /* The value doesn't matter here; only the type is tested. */
4109 XSETBUFFER (obj, current_buffer);
4110 kbd_fetch_ptr = event + 1;
4112 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
4113 || defined (HAVE_NS) || defined (USE_GTK)
4114 else if (event->kind == MENU_BAR_ACTIVATE_EVENT)
4116 kbd_fetch_ptr = event + 1;
4117 input_pending = readable_events (0);
4118 if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
4119 x_activate_menubar (XFRAME (event->frame_or_window));
4121 #endif
4122 #ifdef HAVE_NTGUI
4123 else if (event->kind == LANGUAGE_CHANGE_EVENT)
4125 /* Make an event (language-change FRAME CODEPAGE LANGUAGE-ID). */
4126 obj = list4 (Qlanguage_change,
4127 event->frame_or_window,
4128 make_number (event->code),
4129 make_number (event->modifiers));
4130 kbd_fetch_ptr = event + 1;
4132 #endif
4133 #ifdef USE_FILE_NOTIFY
4134 else if (event->kind == FILE_NOTIFY_EVENT)
4136 #ifdef HAVE_W32NOTIFY
4137 /* Make an event (file-notify (DESCRIPTOR ACTION FILE) CALLBACK). */
4138 obj = list3 (Qfile_notify,
4139 list3 (make_number (event->code),
4140 XCAR (event->arg),
4141 XCDR (event->arg)),
4142 event->frame_or_window);
4143 #else
4144 obj = make_lispy_event (event);
4145 #endif
4146 kbd_fetch_ptr = event + 1;
4148 #endif /* USE_FILE_NOTIFY */
4149 else if (event->kind == SAVE_SESSION_EVENT)
4151 obj = list2 (Qsave_session, event->arg);
4152 kbd_fetch_ptr = event + 1;
4154 /* Just discard these, by returning nil.
4155 With MULTI_KBOARD, these events are used as placeholders
4156 when we need to randomly delete events from the queue.
4157 (They shouldn't otherwise be found in the buffer,
4158 but on some machines it appears they do show up
4159 even without MULTI_KBOARD.) */
4160 /* On Windows NT/9X, NO_EVENT is used to delete extraneous
4161 mouse events during a popup-menu call. */
4162 else if (event->kind == NO_EVENT)
4163 kbd_fetch_ptr = event + 1;
4164 else if (event->kind == HELP_EVENT)
4166 Lisp_Object object, position, help, frame, window;
4168 frame = event->frame_or_window;
4169 object = event->arg;
4170 position = make_number (Time_to_position (event->timestamp));
4171 window = event->x;
4172 help = event->y;
4173 clear_event (event);
4175 kbd_fetch_ptr = event + 1;
4176 if (!WINDOWP (window))
4177 window = Qnil;
4178 obj = Fcons (Qhelp_echo,
4179 list5 (frame, help, window, object, position));
4181 else if (event->kind == FOCUS_IN_EVENT)
4183 /* Notification of a FocusIn event. The frame receiving the
4184 focus is in event->frame_or_window. Generate a
4185 switch-frame event if necessary. */
4186 Lisp_Object frame, focus;
4188 frame = event->frame_or_window;
4189 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4190 if (FRAMEP (focus))
4191 frame = focus;
4193 if (
4194 #ifdef HAVE_X11
4195 ! NILP (event->arg)
4197 #endif
4198 !EQ (frame, internal_last_event_frame)
4199 && !EQ (frame, selected_frame))
4200 obj = make_lispy_switch_frame (frame);
4201 else
4202 obj = make_lispy_focus_in (frame);
4204 internal_last_event_frame = frame;
4205 kbd_fetch_ptr = event + 1;
4207 else if (event->kind == FOCUS_OUT_EVENT)
4209 #ifdef HAVE_WINDOW_SYSTEM
4211 Display_Info *di;
4212 Lisp_Object frame = event->frame_or_window;
4213 bool focused = false;
4215 for (di = x_display_list; di && ! focused; di = di->next)
4216 focused = di->x_highlight_frame != 0;
4218 if (!focused)
4219 obj = make_lispy_focus_out (frame);
4221 #endif /* HAVE_WINDOW_SYSTEM */
4223 kbd_fetch_ptr = event + 1;
4225 #ifdef HAVE_DBUS
4226 else if (event->kind == DBUS_EVENT)
4228 obj = make_lispy_event (event);
4229 kbd_fetch_ptr = event + 1;
4231 #endif
4232 else if (event->kind == CONFIG_CHANGED_EVENT)
4234 obj = make_lispy_event (event);
4235 kbd_fetch_ptr = event + 1;
4237 else
4239 /* If this event is on a different frame, return a switch-frame this
4240 time, and leave the event in the queue for next time. */
4241 Lisp_Object frame;
4242 Lisp_Object focus;
4244 frame = event->frame_or_window;
4245 if (CONSP (frame))
4246 frame = XCAR (frame);
4247 else if (WINDOWP (frame))
4248 frame = WINDOW_FRAME (XWINDOW (frame));
4250 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4251 if (! NILP (focus))
4252 frame = focus;
4254 if (! EQ (frame, internal_last_event_frame)
4255 && !EQ (frame, selected_frame))
4256 obj = make_lispy_switch_frame (frame);
4257 internal_last_event_frame = frame;
4259 /* If we didn't decide to make a switch-frame event, go ahead
4260 and build a real event from the queue entry. */
4262 if (NILP (obj))
4264 obj = make_lispy_event (event);
4266 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
4267 || defined (HAVE_NS) || defined (USE_GTK)
4268 /* If this was a menu selection, then set the flag to inhibit
4269 writing to last_nonmenu_event. Don't do this if the event
4270 we're returning is (menu-bar), though; that indicates the
4271 beginning of the menu sequence, and we might as well leave
4272 that as the `event with parameters' for this selection. */
4273 if (used_mouse_menu
4274 && !EQ (event->frame_or_window, event->arg)
4275 && (event->kind == MENU_BAR_EVENT
4276 || event->kind == TOOL_BAR_EVENT))
4277 *used_mouse_menu = 1;
4278 #endif
4279 #ifdef HAVE_NS
4280 /* Certain system events are non-key events. */
4281 if (used_mouse_menu
4282 && event->kind == NS_NONKEY_EVENT)
4283 *used_mouse_menu = 1;
4284 #endif
4286 /* Wipe out this event, to catch bugs. */
4287 clear_event (event);
4288 kbd_fetch_ptr = event + 1;
4292 /* Try generating a mouse motion event. */
4293 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
4295 struct frame *f = some_mouse_moved ();
4296 Lisp_Object bar_window;
4297 enum scroll_bar_part part;
4298 Lisp_Object x, y;
4299 Time t;
4301 *kbp = current_kboard;
4302 /* Note that this uses F to determine which terminal to look at.
4303 If there is no valid info, it does not store anything
4304 so x remains nil. */
4305 x = Qnil;
4307 /* XXX Can f or mouse_position_hook be NULL here? */
4308 if (f && FRAME_TERMINAL (f)->mouse_position_hook)
4309 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, 0, &bar_window,
4310 &part, &x, &y, &t);
4312 obj = Qnil;
4314 /* Decide if we should generate a switch-frame event. Don't
4315 generate switch-frame events for motion outside of all Emacs
4316 frames. */
4317 if (!NILP (x) && f)
4319 Lisp_Object frame;
4321 frame = FRAME_FOCUS_FRAME (f);
4322 if (NILP (frame))
4323 XSETFRAME (frame, f);
4325 if (! EQ (frame, internal_last_event_frame)
4326 && !EQ (frame, selected_frame))
4327 obj = make_lispy_switch_frame (frame);
4328 internal_last_event_frame = frame;
4331 /* If we didn't decide to make a switch-frame event, go ahead and
4332 return a mouse-motion event. */
4333 if (!NILP (x) && NILP (obj))
4334 obj = make_lispy_movement (f, bar_window, part, x, y, t);
4336 else
4337 /* We were promised by the above while loop that there was
4338 something for us to read! */
4339 emacs_abort ();
4341 input_pending = readable_events (0);
4343 Vlast_event_frame = internal_last_event_frame;
4345 return (obj);
4348 /* Process any non-user-visible events (currently X selection events),
4349 without reading any user-visible events. */
4351 static void
4352 process_special_events (void)
4354 struct input_event *event;
4356 for (event = kbd_fetch_ptr; event != kbd_store_ptr; ++event)
4358 if (event == kbd_buffer + KBD_BUFFER_SIZE)
4360 event = kbd_buffer;
4361 if (event == kbd_store_ptr)
4362 break;
4365 /* If we find a stored X selection request, handle it now. */
4366 if (event->kind == SELECTION_REQUEST_EVENT
4367 || event->kind == SELECTION_CLEAR_EVENT)
4369 #ifdef HAVE_X11
4371 /* Remove the event from the fifo buffer before processing;
4372 otherwise swallow_events called recursively could see it
4373 and process it again. To do this, we move the events
4374 between kbd_fetch_ptr and EVENT one slot to the right,
4375 cyclically. */
4377 struct input_event copy = *event;
4378 struct input_event *beg
4379 = (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
4380 ? kbd_buffer : kbd_fetch_ptr;
4382 if (event > beg)
4383 memmove (beg + 1, beg, (event - beg) * sizeof (struct input_event));
4384 else if (event < beg)
4386 if (event > kbd_buffer)
4387 memmove (kbd_buffer + 1, kbd_buffer,
4388 (event - kbd_buffer) * sizeof (struct input_event));
4389 *kbd_buffer = *(kbd_buffer + KBD_BUFFER_SIZE - 1);
4390 if (beg < kbd_buffer + KBD_BUFFER_SIZE - 1)
4391 memmove (beg + 1, beg,
4392 (kbd_buffer + KBD_BUFFER_SIZE - 1 - beg)
4393 * sizeof (struct input_event));
4396 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
4397 kbd_fetch_ptr = kbd_buffer + 1;
4398 else
4399 kbd_fetch_ptr++;
4401 input_pending = readable_events (0);
4402 x_handle_selection_event (&copy);
4403 #else
4404 /* We're getting selection request events, but we don't have
4405 a window system. */
4406 emacs_abort ();
4407 #endif
4412 /* Process any events that are not user-visible, run timer events that
4413 are ripe, and return, without reading any user-visible events. */
4415 void
4416 swallow_events (bool do_display)
4418 unsigned old_timers_run;
4420 process_special_events ();
4422 old_timers_run = timers_run;
4423 get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
4425 if (!input_pending && timers_run != old_timers_run && do_display)
4426 redisplay_preserve_echo_area (7);
4429 /* Record the start of when Emacs is idle,
4430 for the sake of running idle-time timers. */
4432 static void
4433 timer_start_idle (void)
4435 /* If we are already in the idle state, do nothing. */
4436 if (timespec_valid_p (timer_idleness_start_time))
4437 return;
4439 timer_idleness_start_time = current_timespec ();
4440 timer_last_idleness_start_time = timer_idleness_start_time;
4442 /* Mark all idle-time timers as once again candidates for running. */
4443 call0 (intern ("internal-timer-start-idle"));
4446 /* Record that Emacs is no longer idle, so stop running idle-time timers. */
4448 static void
4449 timer_stop_idle (void)
4451 timer_idleness_start_time = invalid_timespec ();
4454 /* Resume idle timer from last idle start time. */
4456 static void
4457 timer_resume_idle (void)
4459 if (timespec_valid_p (timer_idleness_start_time))
4460 return;
4462 timer_idleness_start_time = timer_last_idleness_start_time;
4465 /* This is only for debugging. */
4466 struct input_event last_timer_event EXTERNALLY_VISIBLE;
4468 /* List of elisp functions to call, delayed because they were generated in
4469 a context where Elisp could not be safely run (e.g. redisplay, signal,
4470 ...). Each element has the form (FUN . ARGS). */
4471 Lisp_Object pending_funcalls;
4473 /* Return true if TIMER is a valid timer, placing its value into *RESULT. */
4474 static bool
4475 decode_timer (Lisp_Object timer, struct timespec *result)
4477 Lisp_Object *vector;
4479 if (! (VECTORP (timer) && ASIZE (timer) == 9))
4480 return 0;
4481 vector = XVECTOR (timer)->contents;
4482 if (! NILP (vector[0]))
4483 return 0;
4484 if (! INTEGERP (vector[2]))
4485 return false;
4487 struct lisp_time t;
4488 if (! decode_time_components (vector[1], vector[2], vector[3], vector[8],
4489 &t, 0))
4490 return false;
4491 *result = lisp_to_timespec (t);
4492 return timespec_valid_p (*result);
4496 /* Check whether a timer has fired. To prevent larger problems we simply
4497 disregard elements that are not proper timers. Do not make a circular
4498 timer list for the time being.
4500 Returns the time to wait until the next timer fires. If a
4501 timer is triggering now, return zero.
4502 If no timer is active, return -1.
4504 If a timer is ripe, we run it, with quitting turned off.
4505 In that case we return 0 to indicate that a new timer_check_2 call
4506 should be done. */
4508 static struct timespec
4509 timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
4511 struct timespec nexttime;
4512 struct timespec now;
4513 struct timespec idleness_now;
4514 Lisp_Object chosen_timer;
4515 struct gcpro gcpro1;
4517 nexttime = invalid_timespec ();
4519 chosen_timer = Qnil;
4520 GCPRO1 (chosen_timer);
4522 /* First run the code that was delayed. */
4523 while (CONSP (pending_funcalls))
4525 Lisp_Object funcall = XCAR (pending_funcalls);
4526 pending_funcalls = XCDR (pending_funcalls);
4527 safe_call2 (Qapply, XCAR (funcall), XCDR (funcall));
4530 if (CONSP (timers) || CONSP (idle_timers))
4532 now = current_timespec ();
4533 idleness_now = (timespec_valid_p (timer_idleness_start_time)
4534 ? timespec_sub (now, timer_idleness_start_time)
4535 : make_timespec (0, 0));
4538 while (CONSP (timers) || CONSP (idle_timers))
4540 Lisp_Object timer = Qnil, idle_timer = Qnil;
4541 struct timespec timer_time, idle_timer_time;
4542 struct timespec difference;
4543 struct timespec timer_difference = invalid_timespec ();
4544 struct timespec idle_timer_difference = invalid_timespec ();
4545 bool ripe, timer_ripe = 0, idle_timer_ripe = 0;
4547 /* Set TIMER and TIMER_DIFFERENCE
4548 based on the next ordinary timer.
4549 TIMER_DIFFERENCE is the distance in time from NOW to when
4550 this timer becomes ripe (negative if it's already ripe).
4551 Skip past invalid timers and timers already handled. */
4552 if (CONSP (timers))
4554 timer = XCAR (timers);
4555 if (! decode_timer (timer, &timer_time))
4557 timers = XCDR (timers);
4558 continue;
4561 timer_ripe = timespec_cmp (timer_time, now) <= 0;
4562 timer_difference = (timer_ripe
4563 ? timespec_sub (now, timer_time)
4564 : timespec_sub (timer_time, now));
4567 /* Likewise for IDLE_TIMER and IDLE_TIMER_DIFFERENCE
4568 based on the next idle timer. */
4569 if (CONSP (idle_timers))
4571 idle_timer = XCAR (idle_timers);
4572 if (! decode_timer (idle_timer, &idle_timer_time))
4574 idle_timers = XCDR (idle_timers);
4575 continue;
4578 idle_timer_ripe = timespec_cmp (idle_timer_time, idleness_now) <= 0;
4579 idle_timer_difference
4580 = (idle_timer_ripe
4581 ? timespec_sub (idleness_now, idle_timer_time)
4582 : timespec_sub (idle_timer_time, idleness_now));
4585 /* Decide which timer is the next timer,
4586 and set CHOSEN_TIMER, DIFFERENCE, and RIPE accordingly.
4587 Also step down the list where we found that timer. */
4589 if (timespec_valid_p (timer_difference)
4590 && (! timespec_valid_p (idle_timer_difference)
4591 || idle_timer_ripe < timer_ripe
4592 || (idle_timer_ripe == timer_ripe
4593 && ((timer_ripe
4594 ? timespec_cmp (idle_timer_difference,
4595 timer_difference)
4596 : timespec_cmp (timer_difference,
4597 idle_timer_difference))
4598 < 0))))
4600 chosen_timer = timer;
4601 timers = XCDR (timers);
4602 difference = timer_difference;
4603 ripe = timer_ripe;
4605 else
4607 chosen_timer = idle_timer;
4608 idle_timers = XCDR (idle_timers);
4609 difference = idle_timer_difference;
4610 ripe = idle_timer_ripe;
4613 /* If timer is ripe, run it if it hasn't been run. */
4614 if (ripe)
4616 if (NILP (AREF (chosen_timer, 0)))
4618 ptrdiff_t count = SPECPDL_INDEX ();
4619 Lisp_Object old_deactivate_mark = Vdeactivate_mark;
4621 /* Mark the timer as triggered to prevent problems if the lisp
4622 code fails to reschedule it right. */
4623 ASET (chosen_timer, 0, Qt);
4625 specbind (Qinhibit_quit, Qt);
4627 call1 (Qtimer_event_handler, chosen_timer);
4628 Vdeactivate_mark = old_deactivate_mark;
4629 timers_run++;
4630 unbind_to (count, Qnil);
4632 /* Since we have handled the event,
4633 we don't need to tell the caller to wake up and do it. */
4634 /* But the caller must still wait for the next timer, so
4635 return 0 to indicate that. */
4638 nexttime = make_timespec (0, 0);
4639 break;
4641 else
4642 /* When we encounter a timer that is still waiting,
4643 return the amount of time to wait before it is ripe. */
4645 UNGCPRO;
4646 return difference;
4650 /* No timers are pending in the future. */
4651 /* Return 0 if we generated an event, and -1 if not. */
4652 UNGCPRO;
4653 return nexttime;
4657 /* Check whether a timer has fired. To prevent larger problems we simply
4658 disregard elements that are not proper timers. Do not make a circular
4659 timer list for the time being.
4661 Returns the time to wait until the next timer fires.
4662 If no timer is active, return an invalid value.
4664 As long as any timer is ripe, we run it. */
4666 struct timespec
4667 timer_check (void)
4669 struct timespec nexttime;
4670 Lisp_Object timers, idle_timers;
4671 struct gcpro gcpro1, gcpro2;
4673 Lisp_Object tem = Vinhibit_quit;
4674 Vinhibit_quit = Qt;
4676 /* We use copies of the timers' lists to allow a timer to add itself
4677 again, without locking up Emacs if the newly added timer is
4678 already ripe when added. */
4680 /* Always consider the ordinary timers. */
4681 timers = Fcopy_sequence (Vtimer_list);
4682 /* Consider the idle timers only if Emacs is idle. */
4683 if (timespec_valid_p (timer_idleness_start_time))
4684 idle_timers = Fcopy_sequence (Vtimer_idle_list);
4685 else
4686 idle_timers = Qnil;
4688 Vinhibit_quit = tem;
4690 GCPRO2 (timers, idle_timers);
4694 nexttime = timer_check_2 (timers, idle_timers);
4696 while (nexttime.tv_sec == 0 && nexttime.tv_nsec == 0);
4698 UNGCPRO;
4699 return nexttime;
4702 DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0,
4703 doc: /* Return the current length of Emacs idleness, or nil.
4704 The value when Emacs is idle is a list of four integers (HIGH LOW USEC PSEC)
4705 in the same style as (current-time).
4707 The value when Emacs is not idle is nil.
4709 PSEC is a multiple of the system clock resolution. */)
4710 (void)
4712 if (timespec_valid_p (timer_idleness_start_time))
4713 return make_lisp_time (timespec_sub (current_timespec (),
4714 timer_idleness_start_time));
4716 return Qnil;
4719 /* Caches for modify_event_symbol. */
4720 static Lisp_Object accent_key_syms;
4721 static Lisp_Object func_key_syms;
4722 static Lisp_Object mouse_syms;
4723 static Lisp_Object wheel_syms;
4724 static Lisp_Object drag_n_drop_syms;
4726 /* This is a list of keysym codes for special "accent" characters.
4727 It parallels lispy_accent_keys. */
4729 static const int lispy_accent_codes[] =
4731 #ifdef XK_dead_circumflex
4732 XK_dead_circumflex,
4733 #else
4735 #endif
4736 #ifdef XK_dead_grave
4737 XK_dead_grave,
4738 #else
4740 #endif
4741 #ifdef XK_dead_tilde
4742 XK_dead_tilde,
4743 #else
4745 #endif
4746 #ifdef XK_dead_diaeresis
4747 XK_dead_diaeresis,
4748 #else
4750 #endif
4751 #ifdef XK_dead_macron
4752 XK_dead_macron,
4753 #else
4755 #endif
4756 #ifdef XK_dead_degree
4757 XK_dead_degree,
4758 #else
4760 #endif
4761 #ifdef XK_dead_acute
4762 XK_dead_acute,
4763 #else
4765 #endif
4766 #ifdef XK_dead_cedilla
4767 XK_dead_cedilla,
4768 #else
4770 #endif
4771 #ifdef XK_dead_breve
4772 XK_dead_breve,
4773 #else
4775 #endif
4776 #ifdef XK_dead_ogonek
4777 XK_dead_ogonek,
4778 #else
4780 #endif
4781 #ifdef XK_dead_caron
4782 XK_dead_caron,
4783 #else
4785 #endif
4786 #ifdef XK_dead_doubleacute
4787 XK_dead_doubleacute,
4788 #else
4790 #endif
4791 #ifdef XK_dead_abovedot
4792 XK_dead_abovedot,
4793 #else
4795 #endif
4796 #ifdef XK_dead_abovering
4797 XK_dead_abovering,
4798 #else
4800 #endif
4801 #ifdef XK_dead_iota
4802 XK_dead_iota,
4803 #else
4805 #endif
4806 #ifdef XK_dead_belowdot
4807 XK_dead_belowdot,
4808 #else
4810 #endif
4811 #ifdef XK_dead_voiced_sound
4812 XK_dead_voiced_sound,
4813 #else
4815 #endif
4816 #ifdef XK_dead_semivoiced_sound
4817 XK_dead_semivoiced_sound,
4818 #else
4820 #endif
4821 #ifdef XK_dead_hook
4822 XK_dead_hook,
4823 #else
4825 #endif
4826 #ifdef XK_dead_horn
4827 XK_dead_horn,
4828 #else
4830 #endif
4833 /* This is a list of Lisp names for special "accent" characters.
4834 It parallels lispy_accent_codes. */
4836 static const char *const lispy_accent_keys[] =
4838 "dead-circumflex",
4839 "dead-grave",
4840 "dead-tilde",
4841 "dead-diaeresis",
4842 "dead-macron",
4843 "dead-degree",
4844 "dead-acute",
4845 "dead-cedilla",
4846 "dead-breve",
4847 "dead-ogonek",
4848 "dead-caron",
4849 "dead-doubleacute",
4850 "dead-abovedot",
4851 "dead-abovering",
4852 "dead-iota",
4853 "dead-belowdot",
4854 "dead-voiced-sound",
4855 "dead-semivoiced-sound",
4856 "dead-hook",
4857 "dead-horn",
4860 #ifdef HAVE_NTGUI
4861 #define FUNCTION_KEY_OFFSET 0x0
4863 const char *const lispy_function_keys[] =
4865 0, /* 0 */
4867 0, /* VK_LBUTTON 0x01 */
4868 0, /* VK_RBUTTON 0x02 */
4869 "cancel", /* VK_CANCEL 0x03 */
4870 0, /* VK_MBUTTON 0x04 */
4872 0, 0, 0, /* 0x05 .. 0x07 */
4874 "backspace", /* VK_BACK 0x08 */
4875 "tab", /* VK_TAB 0x09 */
4877 0, 0, /* 0x0A .. 0x0B */
4879 "clear", /* VK_CLEAR 0x0C */
4880 "return", /* VK_RETURN 0x0D */
4882 0, 0, /* 0x0E .. 0x0F */
4884 0, /* VK_SHIFT 0x10 */
4885 0, /* VK_CONTROL 0x11 */
4886 0, /* VK_MENU 0x12 */
4887 "pause", /* VK_PAUSE 0x13 */
4888 "capslock", /* VK_CAPITAL 0x14 */
4889 "kana", /* VK_KANA/VK_HANGUL 0x15 */
4890 0, /* 0x16 */
4891 "junja", /* VK_JUNJA 0x17 */
4892 "final", /* VK_FINAL 0x18 */
4893 "kanji", /* VK_KANJI/VK_HANJA 0x19 */
4894 0, /* 0x1A */
4895 "escape", /* VK_ESCAPE 0x1B */
4896 "convert", /* VK_CONVERT 0x1C */
4897 "non-convert", /* VK_NONCONVERT 0x1D */
4898 "accept", /* VK_ACCEPT 0x1E */
4899 "mode-change", /* VK_MODECHANGE 0x1F */
4900 0, /* VK_SPACE 0x20 */
4901 "prior", /* VK_PRIOR 0x21 */
4902 "next", /* VK_NEXT 0x22 */
4903 "end", /* VK_END 0x23 */
4904 "home", /* VK_HOME 0x24 */
4905 "left", /* VK_LEFT 0x25 */
4906 "up", /* VK_UP 0x26 */
4907 "right", /* VK_RIGHT 0x27 */
4908 "down", /* VK_DOWN 0x28 */
4909 "select", /* VK_SELECT 0x29 */
4910 "print", /* VK_PRINT 0x2A */
4911 "execute", /* VK_EXECUTE 0x2B */
4912 "snapshot", /* VK_SNAPSHOT 0x2C */
4913 "insert", /* VK_INSERT 0x2D */
4914 "delete", /* VK_DELETE 0x2E */
4915 "help", /* VK_HELP 0x2F */
4917 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
4919 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4921 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
4923 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
4925 0, 0, 0, 0, 0, 0, 0, 0, 0,
4926 0, 0, 0, 0, 0, 0, 0, 0, 0,
4927 0, 0, 0, 0, 0, 0, 0, 0,
4929 "lwindow", /* VK_LWIN 0x5B */
4930 "rwindow", /* VK_RWIN 0x5C */
4931 "apps", /* VK_APPS 0x5D */
4932 0, /* 0x5E */
4933 "sleep",
4934 "kp-0", /* VK_NUMPAD0 0x60 */
4935 "kp-1", /* VK_NUMPAD1 0x61 */
4936 "kp-2", /* VK_NUMPAD2 0x62 */
4937 "kp-3", /* VK_NUMPAD3 0x63 */
4938 "kp-4", /* VK_NUMPAD4 0x64 */
4939 "kp-5", /* VK_NUMPAD5 0x65 */
4940 "kp-6", /* VK_NUMPAD6 0x66 */
4941 "kp-7", /* VK_NUMPAD7 0x67 */
4942 "kp-8", /* VK_NUMPAD8 0x68 */
4943 "kp-9", /* VK_NUMPAD9 0x69 */
4944 "kp-multiply", /* VK_MULTIPLY 0x6A */
4945 "kp-add", /* VK_ADD 0x6B */
4946 "kp-separator", /* VK_SEPARATOR 0x6C */
4947 "kp-subtract", /* VK_SUBTRACT 0x6D */
4948 "kp-decimal", /* VK_DECIMAL 0x6E */
4949 "kp-divide", /* VK_DIVIDE 0x6F */
4950 "f1", /* VK_F1 0x70 */
4951 "f2", /* VK_F2 0x71 */
4952 "f3", /* VK_F3 0x72 */
4953 "f4", /* VK_F4 0x73 */
4954 "f5", /* VK_F5 0x74 */
4955 "f6", /* VK_F6 0x75 */
4956 "f7", /* VK_F7 0x76 */
4957 "f8", /* VK_F8 0x77 */
4958 "f9", /* VK_F9 0x78 */
4959 "f10", /* VK_F10 0x79 */
4960 "f11", /* VK_F11 0x7A */
4961 "f12", /* VK_F12 0x7B */
4962 "f13", /* VK_F13 0x7C */
4963 "f14", /* VK_F14 0x7D */
4964 "f15", /* VK_F15 0x7E */
4965 "f16", /* VK_F16 0x7F */
4966 "f17", /* VK_F17 0x80 */
4967 "f18", /* VK_F18 0x81 */
4968 "f19", /* VK_F19 0x82 */
4969 "f20", /* VK_F20 0x83 */
4970 "f21", /* VK_F21 0x84 */
4971 "f22", /* VK_F22 0x85 */
4972 "f23", /* VK_F23 0x86 */
4973 "f24", /* VK_F24 0x87 */
4975 0, 0, 0, 0, /* 0x88 .. 0x8B */
4976 0, 0, 0, 0, /* 0x8C .. 0x8F */
4978 "kp-numlock", /* VK_NUMLOCK 0x90 */
4979 "scroll", /* VK_SCROLL 0x91 */
4980 /* Not sure where the following block comes from.
4981 Windows headers have NEC and Fujitsu specific keys in
4982 this block, but nothing generic. */
4983 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
4984 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
4985 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
4986 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
4987 "kp-end", /* VK_NUMPAD_END 0x96 */
4988 "kp-home", /* VK_NUMPAD_HOME 0x97 */
4989 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
4990 "kp-up", /* VK_NUMPAD_UP 0x99 */
4991 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
4992 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
4993 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
4994 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
4996 0, 0, /* 0x9E .. 0x9F */
4999 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
5000 * Used only as parameters to GetAsyncKeyState and GetKeyState.
5001 * No other API or message will distinguish left and right keys this way.
5002 * 0xA0 .. 0xA5
5004 0, 0, 0, 0, 0, 0,
5006 /* Multimedia keys. These are handled as WM_APPCOMMAND, which allows us
5007 to enable them selectively, and gives access to a few more functions.
5008 See lispy_multimedia_keys below. */
5009 0, 0, 0, 0, 0, 0, 0, /* 0xA6 .. 0xAC Browser */
5010 0, 0, 0, /* 0xAD .. 0xAF Volume */
5011 0, 0, 0, 0, /* 0xB0 .. 0xB3 Media */
5012 0, 0, 0, 0, /* 0xB4 .. 0xB7 Apps */
5014 /* 0xB8 .. 0xC0 "OEM" keys - all seem to be punctuation. */
5015 0, 0, 0, 0, 0, 0, 0, 0, 0,
5017 /* 0xC1 - 0xDA unallocated, 0xDB-0xDF more OEM keys */
5018 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5019 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5021 0, /* 0xE0 */
5022 "ax", /* VK_OEM_AX 0xE1 */
5023 0, /* VK_OEM_102 0xE2 */
5024 "ico-help", /* VK_ICO_HELP 0xE3 */
5025 "ico-00", /* VK_ICO_00 0xE4 */
5026 0, /* VK_PROCESSKEY 0xE5 - used by IME */
5027 "ico-clear", /* VK_ICO_CLEAR 0xE6 */
5028 0, /* VK_PACKET 0xE7 - used to pass Unicode chars */
5029 0, /* 0xE8 */
5030 "reset", /* VK_OEM_RESET 0xE9 */
5031 "jump", /* VK_OEM_JUMP 0xEA */
5032 "oem-pa1", /* VK_OEM_PA1 0xEB */
5033 "oem-pa2", /* VK_OEM_PA2 0xEC */
5034 "oem-pa3", /* VK_OEM_PA3 0xED */
5035 "wsctrl", /* VK_OEM_WSCTRL 0xEE */
5036 "cusel", /* VK_OEM_CUSEL 0xEF */
5037 "oem-attn", /* VK_OEM_ATTN 0xF0 */
5038 "finish", /* VK_OEM_FINISH 0xF1 */
5039 "copy", /* VK_OEM_COPY 0xF2 */
5040 "auto", /* VK_OEM_AUTO 0xF3 */
5041 "enlw", /* VK_OEM_ENLW 0xF4 */
5042 "backtab", /* VK_OEM_BACKTAB 0xF5 */
5043 "attn", /* VK_ATTN 0xF6 */
5044 "crsel", /* VK_CRSEL 0xF7 */
5045 "exsel", /* VK_EXSEL 0xF8 */
5046 "ereof", /* VK_EREOF 0xF9 */
5047 "play", /* VK_PLAY 0xFA */
5048 "zoom", /* VK_ZOOM 0xFB */
5049 "noname", /* VK_NONAME 0xFC */
5050 "pa1", /* VK_PA1 0xFD */
5051 "oem_clear", /* VK_OEM_CLEAR 0xFE */
5052 0 /* 0xFF */
5055 /* Some of these duplicate the "Media keys" on newer keyboards,
5056 but they are delivered to the application in a different way. */
5057 static const char *const lispy_multimedia_keys[] =
5060 "browser-back",
5061 "browser-forward",
5062 "browser-refresh",
5063 "browser-stop",
5064 "browser-search",
5065 "browser-favorites",
5066 "browser-home",
5067 "volume-mute",
5068 "volume-down",
5069 "volume-up",
5070 "media-next",
5071 "media-previous",
5072 "media-stop",
5073 "media-play-pause",
5074 "mail",
5075 "media-select",
5076 "app-1",
5077 "app-2",
5078 "bass-down",
5079 "bass-boost",
5080 "bass-up",
5081 "treble-down",
5082 "treble-up",
5083 "mic-volume-mute",
5084 "mic-volume-down",
5085 "mic-volume-up",
5086 "help",
5087 "find",
5088 "new",
5089 "open",
5090 "close",
5091 "save",
5092 "print",
5093 "undo",
5094 "redo",
5095 "copy",
5096 "cut",
5097 "paste",
5098 "mail-reply",
5099 "mail-forward",
5100 "mail-send",
5101 "spell-check",
5102 "toggle-dictate-command",
5103 "mic-toggle",
5104 "correction-list",
5105 "media-play",
5106 "media-pause",
5107 "media-record",
5108 "media-fast-forward",
5109 "media-rewind",
5110 "media-channel-up",
5111 "media-channel-down"
5114 #else /* not HAVE_NTGUI */
5116 /* This should be dealt with in XTread_socket now, and that doesn't
5117 depend on the client system having the Kana syms defined. See also
5118 the XK_kana_A case below. */
5119 #if 0
5120 #ifdef XK_kana_A
5121 static const char *const lispy_kana_keys[] =
5123 /* X Keysym value */
5124 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
5125 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
5126 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
5127 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
5128 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
5129 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
5130 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
5131 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
5132 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
5133 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
5134 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
5135 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
5136 "kana-i", "kana-u", "kana-e", "kana-o",
5137 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
5138 "prolongedsound", "kana-A", "kana-I", "kana-U",
5139 "kana-E", "kana-O", "kana-KA", "kana-KI",
5140 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
5141 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
5142 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
5143 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
5144 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
5145 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
5146 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
5147 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
5148 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
5149 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
5150 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
5151 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
5153 #endif /* XK_kana_A */
5154 #endif /* 0 */
5156 #define FUNCTION_KEY_OFFSET 0xff00
5158 /* You'll notice that this table is arranged to be conveniently
5159 indexed by X Windows keysym values. */
5160 static const char *const lispy_function_keys[] =
5162 /* X Keysym value */
5164 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
5165 "backspace", "tab", "linefeed", "clear",
5166 0, "return", 0, 0,
5167 0, 0, 0, "pause", /* 0xff10...1f */
5168 0, 0, 0, 0, 0, 0, 0, "escape",
5169 0, 0, 0, 0,
5170 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
5171 "romaji", "hiragana", "katakana", "hiragana-katakana",
5172 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
5173 "massyo", "kana-lock", "kana-shift", "eisu-shift",
5174 "eisu-toggle", /* 0xff30...3f */
5175 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5176 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
5178 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
5179 "down", "prior", "next", "end",
5180 "begin", 0, 0, 0, 0, 0, 0, 0,
5181 "select", /* 0xff60 */ /* IsMiscFunctionKey */
5182 "print",
5183 "execute",
5184 "insert",
5185 0, /* 0xff64 */
5186 "undo",
5187 "redo",
5188 "menu",
5189 "find",
5190 "cancel",
5191 "help",
5192 "break", /* 0xff6b */
5194 0, 0, 0, 0,
5195 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
5196 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
5197 "kp-space", /* 0xff80 */ /* IsKeypadKey */
5198 0, 0, 0, 0, 0, 0, 0, 0,
5199 "kp-tab", /* 0xff89 */
5200 0, 0, 0,
5201 "kp-enter", /* 0xff8d */
5202 0, 0, 0,
5203 "kp-f1", /* 0xff91 */
5204 "kp-f2",
5205 "kp-f3",
5206 "kp-f4",
5207 "kp-home", /* 0xff95 */
5208 "kp-left",
5209 "kp-up",
5210 "kp-right",
5211 "kp-down",
5212 "kp-prior", /* kp-page-up */
5213 "kp-next", /* kp-page-down */
5214 "kp-end",
5215 "kp-begin",
5216 "kp-insert",
5217 "kp-delete",
5218 0, /* 0xffa0 */
5219 0, 0, 0, 0, 0, 0, 0, 0, 0,
5220 "kp-multiply", /* 0xffaa */
5221 "kp-add",
5222 "kp-separator",
5223 "kp-subtract",
5224 "kp-decimal",
5225 "kp-divide", /* 0xffaf */
5226 "kp-0", /* 0xffb0 */
5227 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
5228 0, /* 0xffba */
5229 0, 0,
5230 "kp-equal", /* 0xffbd */
5231 "f1", /* 0xffbe */ /* IsFunctionKey */
5232 "f2",
5233 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
5234 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
5235 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
5236 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
5237 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
5238 0, 0, 0, 0, 0, 0, 0, 0,
5239 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
5240 0, 0, 0, 0, 0, 0, 0, "delete"
5243 /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
5244 #define ISO_FUNCTION_KEY_OFFSET 0xfe00
5246 static const char *const iso_lispy_function_keys[] =
5248 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
5249 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
5250 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
5251 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
5252 "iso-lefttab", /* 0xfe20 */
5253 "iso-move-line-up", "iso-move-line-down",
5254 "iso-partial-line-up", "iso-partial-line-down",
5255 "iso-partial-space-left", "iso-partial-space-right",
5256 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
5257 "iso-release-margin-left", "iso-release-margin-right",
5258 "iso-release-both-margins",
5259 "iso-fast-cursor-left", "iso-fast-cursor-right",
5260 "iso-fast-cursor-up", "iso-fast-cursor-down",
5261 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
5262 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
5265 #endif /* not HAVE_NTGUI */
5267 static Lisp_Object Vlispy_mouse_stem;
5269 static const char *const lispy_wheel_names[] =
5271 "wheel-up", "wheel-down", "wheel-left", "wheel-right"
5274 /* drag-n-drop events are generated when a set of selected files are
5275 dragged from another application and dropped onto an Emacs window. */
5276 static const char *const lispy_drag_n_drop_names[] =
5278 "drag-n-drop"
5281 /* Scroll bar parts. */
5282 static Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
5283 static Lisp_Object Qbefore_handle, Qhorizontal_handle, Qafter_handle;
5284 Lisp_Object Qup, Qdown, Qtop, Qbottom;
5285 static Lisp_Object Qleftmost, Qrightmost;
5286 static Lisp_Object Qend_scroll;
5287 static Lisp_Object Qratio;
5289 /* An array of scroll bar parts, indexed by an enum scroll_bar_part value.
5290 Note that Qnil corresponds to scroll_bar_nowhere and should not appear
5291 in Lisp events. */
5292 static Lisp_Object *const scroll_bar_parts[] = {
5293 &Qnil, &Qabove_handle, &Qhandle, &Qbelow_handle,
5294 &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio,
5295 &Qbefore_handle, &Qhorizontal_handle, &Qafter_handle,
5296 &Qleft, &Qright, &Qleftmost, &Qrightmost, &Qend_scroll, &Qratio
5299 /* A vector, indexed by button number, giving the down-going location
5300 of currently depressed buttons, both scroll bar and non-scroll bar.
5302 The elements have the form
5303 (BUTTON-NUMBER MODIFIER-MASK . REST)
5304 where REST is the cdr of a position as it would be reported in the event.
5306 The make_lispy_event function stores positions here to tell the
5307 difference between click and drag events, and to store the starting
5308 location to be included in drag events. */
5310 static Lisp_Object button_down_location;
5312 /* Information about the most recent up-going button event: Which
5313 button, what location, and what time. */
5315 static int last_mouse_button;
5316 static int last_mouse_x;
5317 static int last_mouse_y;
5318 static Time button_down_time;
5320 /* The number of clicks in this multiple-click. */
5322 static int double_click_count;
5324 /* X and Y are frame-relative coordinates for a click or wheel event.
5325 Return a Lisp-style event list. */
5327 static Lisp_Object
5328 make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
5329 Time t)
5331 enum window_part part;
5332 Lisp_Object posn = Qnil;
5333 Lisp_Object extra_info = Qnil;
5334 /* Coordinate pixel positions to return. */
5335 int xret = 0, yret = 0;
5336 /* The window under frame pixel coordinates (x,y) */
5337 Lisp_Object window = f
5338 ? window_from_coordinates (f, XINT (x), XINT (y), &part, 0)
5339 : Qnil;
5341 if (WINDOWP (window))
5343 /* It's a click in window WINDOW at frame coordinates (X,Y) */
5344 struct window *w = XWINDOW (window);
5345 Lisp_Object string_info = Qnil;
5346 ptrdiff_t textpos = 0;
5347 int col = -1, row = -1;
5348 int dx = -1, dy = -1;
5349 int width = -1, height = -1;
5350 Lisp_Object object = Qnil;
5352 /* Pixel coordinates relative to the window corner. */
5353 int wx = XINT (x) - WINDOW_LEFT_EDGE_X (w);
5354 int wy = XINT (y) - WINDOW_TOP_EDGE_Y (w);
5356 /* For text area clicks, return X, Y relative to the corner of
5357 this text area. Note that dX, dY etc are set below, by
5358 buffer_posn_from_coords. */
5359 if (part == ON_TEXT)
5361 xret = XINT (x) - window_box_left (w, TEXT_AREA);
5362 yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5364 /* For mode line and header line clicks, return X, Y relative to
5365 the left window edge. Use mode_line_string to look for a
5366 string on the click position. */
5367 else if (part == ON_MODE_LINE || part == ON_HEADER_LINE)
5369 Lisp_Object string;
5370 ptrdiff_t charpos;
5372 posn = (part == ON_MODE_LINE) ? Qmode_line : Qheader_line;
5373 /* Note that mode_line_string takes COL, ROW as pixels and
5374 converts them to characters. */
5375 col = wx;
5376 row = wy;
5377 string = mode_line_string (w, part, &col, &row, &charpos,
5378 &object, &dx, &dy, &width, &height);
5379 if (STRINGP (string))
5380 string_info = Fcons (string, make_number (charpos));
5381 textpos = -1;
5383 xret = wx;
5384 yret = wy;
5386 /* For fringes and margins, Y is relative to the area's (and the
5387 window's) top edge, while X is meaningless. */
5388 else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
5390 Lisp_Object string;
5391 ptrdiff_t charpos;
5393 posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin;
5394 col = wx;
5395 row = wy;
5396 string = marginal_area_string (w, part, &col, &row, &charpos,
5397 &object, &dx, &dy, &width, &height);
5398 if (STRINGP (string))
5399 string_info = Fcons (string, make_number (charpos));
5400 xret = wx;
5401 yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5403 else if (part == ON_LEFT_FRINGE)
5405 posn = Qleft_fringe;
5406 col = 0;
5407 xret = wx;
5408 dx = wx
5409 - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5410 ? 0 : window_box_width (w, LEFT_MARGIN_AREA));
5411 dy = yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5413 else if (part == ON_RIGHT_FRINGE)
5415 posn = Qright_fringe;
5416 col = 0;
5417 xret = wx;
5418 dx = wx
5419 - window_box_width (w, LEFT_MARGIN_AREA)
5420 - window_box_width (w, TEXT_AREA)
5421 - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5422 ? window_box_width (w, RIGHT_MARGIN_AREA)
5423 : 0);
5424 dy = yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5426 else if (part == ON_VERTICAL_BORDER)
5428 posn = Qvertical_line;
5429 width = 1;
5430 dx = 0;
5431 xret = wx;
5432 dy = yret = wy;
5434 else if (part == ON_VERTICAL_SCROLL_BAR)
5436 posn = Qvertical_scroll_bar;
5437 width = WINDOW_SCROLL_BAR_AREA_WIDTH (w);
5438 dx = xret = wx;
5439 dy = yret = wy;
5441 else if (part == ON_HORIZONTAL_SCROLL_BAR)
5443 posn = Qhorizontal_scroll_bar;
5444 width = WINDOW_SCROLL_BAR_AREA_HEIGHT (w);
5445 dx = xret = wx;
5446 dy = yret = wy;
5448 else if (part == ON_RIGHT_DIVIDER)
5450 posn = Qright_divider;
5451 width = WINDOW_RIGHT_DIVIDER_WIDTH (w);
5452 dx = xret = wx;
5453 dy = yret = wy;
5455 else if (part == ON_BOTTOM_DIVIDER)
5457 posn = Qbottom_divider;
5458 width = WINDOW_BOTTOM_DIVIDER_WIDTH (w);
5459 dx = xret = wx;
5460 dy = yret = wy;
5463 /* For clicks in the text area, fringes, or margins, call
5464 buffer_posn_from_coords to extract TEXTPOS, the buffer
5465 position nearest to the click. */
5466 if (!textpos)
5468 Lisp_Object string2, object2 = Qnil;
5469 struct display_pos p;
5470 int dx2, dy2;
5471 int width2, height2;
5472 /* The pixel X coordinate passed to buffer_posn_from_coords
5473 is the X coordinate relative to the text area for
5474 text-area and right-margin clicks, zero otherwise. */
5475 int x2
5476 = (part == ON_TEXT) ? xret
5477 : (part == ON_RIGHT_FRINGE || part == ON_RIGHT_MARGIN)
5478 ? (XINT (x) - window_box_left (w, TEXT_AREA))
5479 : 0;
5480 int y2 = wy;
5482 string2 = buffer_posn_from_coords (w, &x2, &y2, &p,
5483 &object2, &dx2, &dy2,
5484 &width2, &height2);
5485 textpos = CHARPOS (p.pos);
5486 if (col < 0) col = x2;
5487 if (row < 0) row = y2;
5488 if (dx < 0) dx = dx2;
5489 if (dy < 0) dy = dy2;
5490 if (width < 0) width = width2;
5491 if (height < 0) height = height2;
5493 if (NILP (posn))
5495 posn = make_number (textpos);
5496 if (STRINGP (string2))
5497 string_info = Fcons (string2,
5498 make_number (CHARPOS (p.string_pos)));
5500 if (NILP (object))
5501 object = object2;
5504 #ifdef HAVE_WINDOW_SYSTEM
5505 if (IMAGEP (object))
5507 Lisp_Object image_map, hotspot;
5508 if ((image_map = Fplist_get (XCDR (object), QCmap),
5509 !NILP (image_map))
5510 && (hotspot = find_hot_spot (image_map, dx, dy),
5511 CONSP (hotspot))
5512 && (hotspot = XCDR (hotspot), CONSP (hotspot)))
5513 posn = XCAR (hotspot);
5515 #endif
5517 /* Object info. */
5518 extra_info
5519 = list3 (object,
5520 Fcons (make_number (dx), make_number (dy)),
5521 Fcons (make_number (width), make_number (height)));
5523 /* String info. */
5524 extra_info = Fcons (string_info,
5525 Fcons (textpos < 0 ? Qnil : make_number (textpos),
5526 Fcons (Fcons (make_number (col),
5527 make_number (row)),
5528 extra_info)));
5530 else if (f != 0)
5532 /* Return mouse pixel coordinates here. */
5533 XSETFRAME (window, f);
5534 xret = XINT (x);
5535 yret = XINT (y);
5537 else
5538 window = Qnil;
5540 return Fcons (window,
5541 Fcons (posn,
5542 Fcons (Fcons (make_number (xret),
5543 make_number (yret)),
5544 Fcons (make_number (t),
5545 extra_info))));
5548 /* Return non-zero if F is a GUI frame that uses some toolkit-managed
5549 menu bar. This really means that Emacs draws and manages the menu
5550 bar as part of its normal display, and therefore can compute its
5551 geometry. */
5552 static bool
5553 toolkit_menubar_in_use (struct frame *f)
5555 #if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) || defined (HAVE_NTGUI)
5556 return !(!FRAME_WINDOW_P (f));
5557 #else
5558 return false;
5559 #endif
5562 /* Build the part of Lisp event which represents scroll bar state from
5563 EV. TYPE is one of Qvertical_scroll_bar or Qhorizontal_scroll_bar. */
5565 static Lisp_Object
5566 make_scroll_bar_position (struct input_event *ev, Lisp_Object type)
5568 return list5 (ev->frame_or_window, type, Fcons (ev->x, ev->y),
5569 make_number (ev->timestamp), *scroll_bar_parts[ev->part]);
5572 /* Given a struct input_event, build the lisp event which represents
5573 it. If EVENT is 0, build a mouse movement event from the mouse
5574 movement buffer, which should have a movement event in it.
5576 Note that events must be passed to this function in the order they
5577 are received; this function stores the location of button presses
5578 in order to build drag events when the button is released. */
5580 static Lisp_Object
5581 make_lispy_event (struct input_event *event)
5583 int i;
5585 switch (event->kind)
5587 /* A simple keystroke. */
5588 case ASCII_KEYSTROKE_EVENT:
5589 case MULTIBYTE_CHAR_KEYSTROKE_EVENT:
5591 Lisp_Object lispy_c;
5592 EMACS_INT c = event->code;
5593 if (event->kind == ASCII_KEYSTROKE_EVENT)
5595 c &= 0377;
5596 eassert (c == event->code);
5597 /* Turn ASCII characters into control characters
5598 when proper. */
5599 if (event->modifiers & ctrl_modifier)
5601 c = make_ctrl_char (c);
5602 event->modifiers &= ~ctrl_modifier;
5606 /* Add in the other modifier bits. The shift key was taken care
5607 of by the X code. */
5608 c |= (event->modifiers
5609 & (meta_modifier | alt_modifier
5610 | hyper_modifier | super_modifier | ctrl_modifier));
5611 /* Distinguish Shift-SPC from SPC. */
5612 if ((event->code) == 040
5613 && event->modifiers & shift_modifier)
5614 c |= shift_modifier;
5615 button_down_time = 0;
5616 XSETFASTINT (lispy_c, c);
5617 return lispy_c;
5620 #ifdef HAVE_NS
5621 /* NS_NONKEY_EVENTs are just like NON_ASCII_KEYSTROKE_EVENTs,
5622 except that they are non-key events (last-nonmenu-event is nil). */
5623 case NS_NONKEY_EVENT:
5624 #endif
5626 /* A function key. The symbol may need to have modifier prefixes
5627 tacked onto it. */
5628 case NON_ASCII_KEYSTROKE_EVENT:
5629 button_down_time = 0;
5631 for (i = 0; i < ARRAYELTS (lispy_accent_codes); i++)
5632 if (event->code == lispy_accent_codes[i])
5633 return modify_event_symbol (i,
5634 event->modifiers,
5635 Qfunction_key, Qnil,
5636 lispy_accent_keys, &accent_key_syms,
5637 ARRAYELTS (lispy_accent_keys));
5639 #if 0
5640 #ifdef XK_kana_A
5641 if (event->code >= 0x400 && event->code < 0x500)
5642 return modify_event_symbol (event->code - 0x400,
5643 event->modifiers & ~shift_modifier,
5644 Qfunction_key, Qnil,
5645 lispy_kana_keys, &func_key_syms,
5646 ARRAYELTS (lispy_kana_keys));
5647 #endif /* XK_kana_A */
5648 #endif /* 0 */
5650 #ifdef ISO_FUNCTION_KEY_OFFSET
5651 if (event->code < FUNCTION_KEY_OFFSET
5652 && event->code >= ISO_FUNCTION_KEY_OFFSET)
5653 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
5654 event->modifiers,
5655 Qfunction_key, Qnil,
5656 iso_lispy_function_keys, &func_key_syms,
5657 ARRAYELTS (iso_lispy_function_keys));
5658 #endif
5660 if ((FUNCTION_KEY_OFFSET <= event->code
5661 && (event->code
5662 < FUNCTION_KEY_OFFSET + ARRAYELTS (lispy_function_keys)))
5663 && lispy_function_keys[event->code - FUNCTION_KEY_OFFSET])
5664 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
5665 event->modifiers,
5666 Qfunction_key, Qnil,
5667 lispy_function_keys, &func_key_syms,
5668 ARRAYELTS (lispy_function_keys));
5670 /* Handle system-specific or unknown keysyms.
5671 We need to use an alist rather than a vector as the cache
5672 since we can't make a vector long enough. */
5673 if (NILP (KVAR (current_kboard, system_key_syms)))
5674 kset_system_key_syms (current_kboard, Fcons (Qnil, Qnil));
5675 return modify_event_symbol (event->code,
5676 event->modifiers,
5677 Qfunction_key,
5678 KVAR (current_kboard, Vsystem_key_alist),
5679 0, &KVAR (current_kboard, system_key_syms),
5680 PTRDIFF_MAX);
5682 #ifdef HAVE_NTGUI
5683 case MULTIMEDIA_KEY_EVENT:
5684 if (event->code < ARRAYELTS (lispy_multimedia_keys)
5685 && event->code > 0 && lispy_multimedia_keys[event->code])
5687 return modify_event_symbol (event->code, event->modifiers,
5688 Qfunction_key, Qnil,
5689 lispy_multimedia_keys, &func_key_syms,
5690 ARRAYELTS (lispy_multimedia_keys));
5692 return Qnil;
5693 #endif
5695 /* A mouse click. Figure out where it is, decide whether it's
5696 a press, click or drag, and build the appropriate structure. */
5697 case MOUSE_CLICK_EVENT:
5698 #ifdef HAVE_GPM
5699 case GPM_CLICK_EVENT:
5700 #endif
5701 #ifndef USE_TOOLKIT_SCROLL_BARS
5702 case SCROLL_BAR_CLICK_EVENT:
5703 case HORIZONTAL_SCROLL_BAR_CLICK_EVENT:
5704 #endif
5706 int button = event->code;
5707 bool is_double;
5708 Lisp_Object position;
5709 Lisp_Object *start_pos_ptr;
5710 Lisp_Object start_pos;
5712 position = Qnil;
5714 /* Build the position as appropriate for this mouse click. */
5715 if (event->kind == MOUSE_CLICK_EVENT
5716 #ifdef HAVE_GPM
5717 || event->kind == GPM_CLICK_EVENT
5718 #endif
5721 struct frame *f = XFRAME (event->frame_or_window);
5722 int row, column;
5724 /* Ignore mouse events that were made on frame that
5725 have been deleted. */
5726 if (! FRAME_LIVE_P (f))
5727 return Qnil;
5729 /* EVENT->x and EVENT->y are frame-relative pixel
5730 coordinates at this place. Under old redisplay, COLUMN
5731 and ROW are set to frame relative glyph coordinates
5732 which are then used to determine whether this click is
5733 in a menu (non-toolkit version). */
5734 if (!toolkit_menubar_in_use (f))
5736 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
5737 &column, &row, NULL, 1);
5739 /* In the non-toolkit version, clicks on the menu bar
5740 are ordinary button events in the event buffer.
5741 Distinguish them, and invoke the menu.
5743 (In the toolkit version, the toolkit handles the
5744 menu bar and Emacs doesn't know about it until
5745 after the user makes a selection.) */
5746 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
5747 && (event->modifiers & down_modifier))
5749 Lisp_Object items, item;
5751 /* Find the menu bar item under `column'. */
5752 item = Qnil;
5753 items = FRAME_MENU_BAR_ITEMS (f);
5754 for (i = 0; i < ASIZE (items); i += 4)
5756 Lisp_Object pos, string;
5757 string = AREF (items, i + 1);
5758 pos = AREF (items, i + 3);
5759 if (NILP (string))
5760 break;
5761 if (column >= XINT (pos)
5762 && column < XINT (pos) + SCHARS (string))
5764 item = AREF (items, i);
5765 break;
5769 /* ELisp manual 2.4b says (x y) are window
5770 relative but code says they are
5771 frame-relative. */
5772 position = list4 (event->frame_or_window,
5773 Qmenu_bar,
5774 Fcons (event->x, event->y),
5775 make_number (event->timestamp));
5777 return list2 (item, position);
5781 position = make_lispy_position (f, event->x, event->y,
5782 event->timestamp);
5784 #ifndef USE_TOOLKIT_SCROLL_BARS
5785 else
5786 /* It's a scrollbar click. */
5787 position = make_scroll_bar_position (event, Qvertical_scroll_bar);
5788 #endif /* not USE_TOOLKIT_SCROLL_BARS */
5790 if (button >= ASIZE (button_down_location))
5792 ptrdiff_t incr = button - ASIZE (button_down_location) + 1;
5793 button_down_location = larger_vector (button_down_location,
5794 incr, -1);
5795 mouse_syms = larger_vector (mouse_syms, incr, -1);
5798 start_pos_ptr = aref_addr (button_down_location, button);
5799 start_pos = *start_pos_ptr;
5800 *start_pos_ptr = Qnil;
5803 /* On window-system frames, use the value of
5804 double-click-fuzz as is. On other frames, interpret it
5805 as a multiple of 1/8 characters. */
5806 struct frame *f;
5807 int fuzz;
5809 if (WINDOWP (event->frame_or_window))
5810 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
5811 else if (FRAMEP (event->frame_or_window))
5812 f = XFRAME (event->frame_or_window);
5813 else
5814 emacs_abort ();
5816 if (FRAME_WINDOW_P (f))
5817 fuzz = double_click_fuzz;
5818 else
5819 fuzz = double_click_fuzz / 8;
5821 is_double = (button == last_mouse_button
5822 && (eabs (XINT (event->x) - last_mouse_x) <= fuzz)
5823 && (eabs (XINT (event->y) - last_mouse_y) <= fuzz)
5824 && button_down_time != 0
5825 && (EQ (Vdouble_click_time, Qt)
5826 || (NATNUMP (Vdouble_click_time)
5827 && (event->timestamp - button_down_time
5828 < XFASTINT (Vdouble_click_time)))));
5831 last_mouse_button = button;
5832 last_mouse_x = XINT (event->x);
5833 last_mouse_y = XINT (event->y);
5835 /* If this is a button press, squirrel away the location, so
5836 we can decide later whether it was a click or a drag. */
5837 if (event->modifiers & down_modifier)
5839 if (is_double)
5841 double_click_count++;
5842 event->modifiers |= ((double_click_count > 2)
5843 ? triple_modifier
5844 : double_modifier);
5846 else
5847 double_click_count = 1;
5848 button_down_time = event->timestamp;
5849 *start_pos_ptr = Fcopy_alist (position);
5850 ignore_mouse_drag_p = 0;
5853 /* Now we're releasing a button - check the co-ordinates to
5854 see if this was a click or a drag. */
5855 else if (event->modifiers & up_modifier)
5857 /* If we did not see a down before this up, ignore the up.
5858 Probably this happened because the down event chose a
5859 menu item. It would be an annoyance to treat the
5860 release of the button that chose the menu item as a
5861 separate event. */
5863 if (!CONSP (start_pos))
5864 return Qnil;
5866 event->modifiers &= ~up_modifier;
5869 Lisp_Object new_down, down;
5870 EMACS_INT xdiff = double_click_fuzz, ydiff = double_click_fuzz;
5872 /* The third element of every position
5873 should be the (x,y) pair. */
5874 down = Fcar (Fcdr (Fcdr (start_pos)));
5875 new_down = Fcar (Fcdr (Fcdr (position)));
5877 if (CONSP (down)
5878 && INTEGERP (XCAR (down)) && INTEGERP (XCDR (down)))
5880 xdiff = XINT (XCAR (new_down)) - XINT (XCAR (down));
5881 ydiff = XINT (XCDR (new_down)) - XINT (XCDR (down));
5884 if (ignore_mouse_drag_p)
5886 event->modifiers |= click_modifier;
5887 ignore_mouse_drag_p = 0;
5889 else if (xdiff < double_click_fuzz && xdiff > - double_click_fuzz
5890 && ydiff < double_click_fuzz && ydiff > - double_click_fuzz
5891 /* Maybe the mouse has moved a lot, caused scrolling, and
5892 eventually ended up at the same screen position (but
5893 not buffer position) in which case it is a drag, not
5894 a click. */
5895 /* FIXME: OTOH if the buffer position has changed
5896 because of a timer or process filter rather than
5897 because of mouse movement, it should be considered as
5898 a click. But mouse-drag-region completely ignores
5899 this case and it hasn't caused any real problem, so
5900 it's probably OK to ignore it as well. */
5901 && EQ (Fcar (Fcdr (start_pos)), Fcar (Fcdr (position))))
5902 /* Mouse hasn't moved (much). */
5903 event->modifiers |= click_modifier;
5904 else
5906 button_down_time = 0;
5907 event->modifiers |= drag_modifier;
5910 /* Don't check is_double; treat this as multiple
5911 if the down-event was multiple. */
5912 if (double_click_count > 1)
5913 event->modifiers |= ((double_click_count > 2)
5914 ? triple_modifier
5915 : double_modifier);
5918 else
5919 /* Every mouse event should either have the down_modifier or
5920 the up_modifier set. */
5921 emacs_abort ();
5924 /* Get the symbol we should use for the mouse click. */
5925 Lisp_Object head;
5927 head = modify_event_symbol (button,
5928 event->modifiers,
5929 Qmouse_click, Vlispy_mouse_stem,
5930 NULL,
5931 &mouse_syms,
5932 ASIZE (mouse_syms));
5933 if (event->modifiers & drag_modifier)
5934 return list3 (head, start_pos, position);
5935 else if (event->modifiers & (double_modifier | triple_modifier))
5936 return list3 (head, position, make_number (double_click_count));
5937 else
5938 return list2 (head, position);
5942 case WHEEL_EVENT:
5943 case HORIZ_WHEEL_EVENT:
5945 Lisp_Object position;
5946 Lisp_Object head;
5948 /* Build the position as appropriate for this mouse click. */
5949 struct frame *f = XFRAME (event->frame_or_window);
5951 /* Ignore wheel events that were made on frame that have been
5952 deleted. */
5953 if (! FRAME_LIVE_P (f))
5954 return Qnil;
5956 position = make_lispy_position (f, event->x, event->y,
5957 event->timestamp);
5959 /* Set double or triple modifiers to indicate the wheel speed. */
5961 /* On window-system frames, use the value of
5962 double-click-fuzz as is. On other frames, interpret it
5963 as a multiple of 1/8 characters. */
5964 struct frame *fr;
5965 int fuzz;
5966 int symbol_num;
5967 bool is_double;
5969 if (WINDOWP (event->frame_or_window))
5970 fr = XFRAME (XWINDOW (event->frame_or_window)->frame);
5971 else if (FRAMEP (event->frame_or_window))
5972 fr = XFRAME (event->frame_or_window);
5973 else
5974 emacs_abort ();
5976 fuzz = FRAME_WINDOW_P (fr)
5977 ? double_click_fuzz : double_click_fuzz / 8;
5979 if (event->modifiers & up_modifier)
5981 /* Emit a wheel-up event. */
5982 event->modifiers &= ~up_modifier;
5983 symbol_num = 0;
5985 else if (event->modifiers & down_modifier)
5987 /* Emit a wheel-down event. */
5988 event->modifiers &= ~down_modifier;
5989 symbol_num = 1;
5991 else
5992 /* Every wheel event should either have the down_modifier or
5993 the up_modifier set. */
5994 emacs_abort ();
5996 if (event->kind == HORIZ_WHEEL_EVENT)
5997 symbol_num += 2;
5999 is_double = (last_mouse_button == - (1 + symbol_num)
6000 && (eabs (XINT (event->x) - last_mouse_x) <= fuzz)
6001 && (eabs (XINT (event->y) - last_mouse_y) <= fuzz)
6002 && button_down_time != 0
6003 && (EQ (Vdouble_click_time, Qt)
6004 || (NATNUMP (Vdouble_click_time)
6005 && (event->timestamp - button_down_time
6006 < XFASTINT (Vdouble_click_time)))));
6007 if (is_double)
6009 double_click_count++;
6010 event->modifiers |= ((double_click_count > 2)
6011 ? triple_modifier
6012 : double_modifier);
6014 else
6016 double_click_count = 1;
6017 event->modifiers |= click_modifier;
6020 button_down_time = event->timestamp;
6021 /* Use a negative value to distinguish wheel from mouse button. */
6022 last_mouse_button = - (1 + symbol_num);
6023 last_mouse_x = XINT (event->x);
6024 last_mouse_y = XINT (event->y);
6026 /* Get the symbol we should use for the wheel event. */
6027 head = modify_event_symbol (symbol_num,
6028 event->modifiers,
6029 Qmouse_click,
6030 Qnil,
6031 lispy_wheel_names,
6032 &wheel_syms,
6033 ASIZE (wheel_syms));
6036 if (event->modifiers & (double_modifier | triple_modifier))
6037 return list3 (head, position, make_number (double_click_count));
6038 else
6039 return list2 (head, position);
6043 #ifdef USE_TOOLKIT_SCROLL_BARS
6045 /* We don't have down and up events if using toolkit scroll bars,
6046 so make this always a click event. Store in the `part' of
6047 the Lisp event a symbol which maps to the following actions:
6049 `above_handle' page up
6050 `below_handle' page down
6051 `up' line up
6052 `down' line down
6053 `top' top of buffer
6054 `bottom' bottom of buffer
6055 `handle' thumb has been dragged.
6056 `end-scroll' end of interaction with scroll bar
6058 The incoming input_event contains in its `part' member an
6059 index of type `enum scroll_bar_part' which we can use as an
6060 index in scroll_bar_parts to get the appropriate symbol. */
6062 case SCROLL_BAR_CLICK_EVENT:
6064 Lisp_Object position, head;
6066 position = make_scroll_bar_position (event, Qvertical_scroll_bar);
6068 /* Always treat scroll bar events as clicks. */
6069 event->modifiers |= click_modifier;
6070 event->modifiers &= ~up_modifier;
6072 if (event->code >= ASIZE (mouse_syms))
6073 mouse_syms = larger_vector (mouse_syms,
6074 event->code - ASIZE (mouse_syms) + 1,
6075 -1);
6077 /* Get the symbol we should use for the mouse click. */
6078 head = modify_event_symbol (event->code,
6079 event->modifiers,
6080 Qmouse_click,
6081 Vlispy_mouse_stem,
6082 NULL, &mouse_syms,
6083 ASIZE (mouse_syms));
6084 return list2 (head, position);
6087 case HORIZONTAL_SCROLL_BAR_CLICK_EVENT:
6089 Lisp_Object position, head;
6091 position = make_scroll_bar_position (event, Qhorizontal_scroll_bar);
6093 /* Always treat scroll bar events as clicks. */
6094 event->modifiers |= click_modifier;
6095 event->modifiers &= ~up_modifier;
6097 if (event->code >= ASIZE (mouse_syms))
6098 mouse_syms = larger_vector (mouse_syms,
6099 event->code - ASIZE (mouse_syms) + 1,
6100 -1);
6102 /* Get the symbol we should use for the mouse click. */
6103 head = modify_event_symbol (event->code,
6104 event->modifiers,
6105 Qmouse_click,
6106 Vlispy_mouse_stem,
6107 NULL, &mouse_syms,
6108 ASIZE (mouse_syms));
6109 return list2 (head, position);
6112 #endif /* USE_TOOLKIT_SCROLL_BARS */
6114 case DRAG_N_DROP_EVENT:
6116 struct frame *f;
6117 Lisp_Object head, position;
6118 Lisp_Object files;
6120 f = XFRAME (event->frame_or_window);
6121 files = event->arg;
6123 /* Ignore mouse events that were made on frames that
6124 have been deleted. */
6125 if (! FRAME_LIVE_P (f))
6126 return Qnil;
6128 position = make_lispy_position (f, event->x, event->y,
6129 event->timestamp);
6131 head = modify_event_symbol (0, event->modifiers,
6132 Qdrag_n_drop, Qnil,
6133 lispy_drag_n_drop_names,
6134 &drag_n_drop_syms, 1);
6135 return list3 (head, position, files);
6138 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
6139 || defined (HAVE_NS) || defined (USE_GTK)
6140 case MENU_BAR_EVENT:
6141 if (EQ (event->arg, event->frame_or_window))
6142 /* This is the prefix key. We translate this to
6143 `(menu_bar)' because the code in keyboard.c for menu
6144 events, which we use, relies on this. */
6145 return list1 (Qmenu_bar);
6146 return event->arg;
6147 #endif
6149 case SELECT_WINDOW_EVENT:
6150 /* Make an event (select-window (WINDOW)). */
6151 return list2 (Qselect_window, list1 (event->frame_or_window));
6153 case TOOL_BAR_EVENT:
6154 if (EQ (event->arg, event->frame_or_window))
6155 /* This is the prefix key. We translate this to
6156 `(tool_bar)' because the code in keyboard.c for tool bar
6157 events, which we use, relies on this. */
6158 return list1 (Qtool_bar);
6159 else if (SYMBOLP (event->arg))
6160 return apply_modifiers (event->modifiers, event->arg);
6161 return event->arg;
6163 case USER_SIGNAL_EVENT:
6164 /* A user signal. */
6166 char *name = find_user_signal_name (event->code);
6167 if (!name)
6168 emacs_abort ();
6169 return intern (name);
6172 case SAVE_SESSION_EVENT:
6173 return Qsave_session;
6175 #ifdef HAVE_DBUS
6176 case DBUS_EVENT:
6178 return Fcons (Qdbus_event, event->arg);
6180 #endif /* HAVE_DBUS */
6182 #if defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY
6183 case FILE_NOTIFY_EVENT:
6185 return Fcons (Qfile_notify, event->arg);
6187 #endif /* defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY */
6189 case CONFIG_CHANGED_EVENT:
6190 return list3 (Qconfig_changed_event,
6191 event->arg, event->frame_or_window);
6193 /* The 'kind' field of the event is something we don't recognize. */
6194 default:
6195 emacs_abort ();
6199 static Lisp_Object
6200 make_lispy_movement (struct frame *frame, Lisp_Object bar_window, enum scroll_bar_part part,
6201 Lisp_Object x, Lisp_Object y, Time t)
6203 /* Is it a scroll bar movement? */
6204 if (frame && ! NILP (bar_window))
6206 Lisp_Object part_sym;
6208 part_sym = *scroll_bar_parts[(int) part];
6209 return list2 (Qscroll_bar_movement,
6210 list5 (bar_window,
6211 Qvertical_scroll_bar,
6212 Fcons (x, y),
6213 make_number (t),
6214 part_sym));
6216 /* Or is it an ordinary mouse movement? */
6217 else
6219 Lisp_Object position;
6220 position = make_lispy_position (frame, x, y, t);
6221 return list2 (Qmouse_movement, position);
6225 /* Construct a switch frame event. */
6226 static Lisp_Object
6227 make_lispy_switch_frame (Lisp_Object frame)
6229 return list2 (Qswitch_frame, frame);
6232 static Lisp_Object
6233 make_lispy_focus_in (Lisp_Object frame)
6235 return list2 (Qfocus_in, frame);
6238 #ifdef HAVE_WINDOW_SYSTEM
6240 static Lisp_Object
6241 make_lispy_focus_out (Lisp_Object frame)
6243 return list2 (Qfocus_out, frame);
6246 #endif /* HAVE_WINDOW_SYSTEM */
6248 /* Manipulating modifiers. */
6250 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
6252 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
6253 SYMBOL's name of the end of the modifiers; the string from this
6254 position is the unmodified symbol name.
6256 This doesn't use any caches. */
6258 static int
6259 parse_modifiers_uncached (Lisp_Object symbol, ptrdiff_t *modifier_end)
6261 Lisp_Object name;
6262 ptrdiff_t i;
6263 int modifiers;
6265 CHECK_SYMBOL (symbol);
6267 modifiers = 0;
6268 name = SYMBOL_NAME (symbol);
6270 for (i = 0; i < SBYTES (name) - 1; )
6272 ptrdiff_t this_mod_end = 0;
6273 int this_mod = 0;
6275 /* See if the name continues with a modifier word.
6276 Check that the word appears, but don't check what follows it.
6277 Set this_mod and this_mod_end to record what we find. */
6279 switch (SREF (name, i))
6281 #define SINGLE_LETTER_MOD(BIT) \
6282 (this_mod_end = i + 1, this_mod = BIT)
6284 case 'A':
6285 SINGLE_LETTER_MOD (alt_modifier);
6286 break;
6288 case 'C':
6289 SINGLE_LETTER_MOD (ctrl_modifier);
6290 break;
6292 case 'H':
6293 SINGLE_LETTER_MOD (hyper_modifier);
6294 break;
6296 case 'M':
6297 SINGLE_LETTER_MOD (meta_modifier);
6298 break;
6300 case 'S':
6301 SINGLE_LETTER_MOD (shift_modifier);
6302 break;
6304 case 's':
6305 SINGLE_LETTER_MOD (super_modifier);
6306 break;
6308 #undef SINGLE_LETTER_MOD
6310 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6311 if (i + LEN + 1 <= SBYTES (name) \
6312 && ! memcmp (SDATA (name) + i, NAME, LEN)) \
6314 this_mod_end = i + LEN; \
6315 this_mod = BIT; \
6318 case 'd':
6319 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6320 MULTI_LETTER_MOD (down_modifier, "down", 4);
6321 MULTI_LETTER_MOD (double_modifier, "double", 6);
6322 break;
6324 case 't':
6325 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6326 break;
6327 #undef MULTI_LETTER_MOD
6331 /* If we found no modifier, stop looking for them. */
6332 if (this_mod_end == 0)
6333 break;
6335 /* Check there is a dash after the modifier, so that it
6336 really is a modifier. */
6337 if (this_mod_end >= SBYTES (name)
6338 || SREF (name, this_mod_end) != '-')
6339 break;
6341 /* This modifier is real; look for another. */
6342 modifiers |= this_mod;
6343 i = this_mod_end + 1;
6346 /* Should we include the `click' modifier? */
6347 if (! (modifiers & (down_modifier | drag_modifier
6348 | double_modifier | triple_modifier))
6349 && i + 7 == SBYTES (name)
6350 && memcmp (SDATA (name) + i, "mouse-", 6) == 0
6351 && ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9'))
6352 modifiers |= click_modifier;
6354 if (! (modifiers & (double_modifier | triple_modifier))
6355 && i + 6 < SBYTES (name)
6356 && memcmp (SDATA (name) + i, "wheel-", 6) == 0)
6357 modifiers |= click_modifier;
6359 if (modifier_end)
6360 *modifier_end = i;
6362 return modifiers;
6365 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
6366 prepended to the string BASE[0..BASE_LEN-1].
6367 This doesn't use any caches. */
6368 static Lisp_Object
6369 apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_byte)
6371 /* Since BASE could contain nulls, we can't use intern here; we have
6372 to use Fintern, which expects a genuine Lisp_String, and keeps a
6373 reference to it. */
6374 char new_mods[sizeof "A-C-H-M-S-s-down-drag-double-triple-"];
6375 int mod_len;
6378 char *p = new_mods;
6380 /* Only the event queue may use the `up' modifier; it should always
6381 be turned into a click or drag event before presented to lisp code. */
6382 if (modifiers & up_modifier)
6383 emacs_abort ();
6385 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
6386 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
6387 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
6388 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
6389 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
6390 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
6391 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
6392 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
6393 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
6394 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
6395 /* The click modifier is denoted by the absence of other modifiers. */
6397 *p = '\0';
6399 mod_len = p - new_mods;
6403 Lisp_Object new_name;
6405 new_name = make_uninit_multibyte_string (mod_len + base_len,
6406 mod_len + base_len_byte);
6407 memcpy (SDATA (new_name), new_mods, mod_len);
6408 memcpy (SDATA (new_name) + mod_len, base, base_len_byte);
6410 return Fintern (new_name, Qnil);
6415 static const char *const modifier_names[] =
6417 "up", "down", "drag", "click", "double", "triple", 0, 0,
6418 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
6419 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
6421 #define NUM_MOD_NAMES ARRAYELTS (modifier_names)
6423 static Lisp_Object modifier_symbols;
6425 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
6426 static Lisp_Object
6427 lispy_modifier_list (int modifiers)
6429 Lisp_Object modifier_list;
6430 int i;
6432 modifier_list = Qnil;
6433 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
6434 if (modifiers & (1<<i))
6435 modifier_list = Fcons (AREF (modifier_symbols, i),
6436 modifier_list);
6438 return modifier_list;
6442 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
6443 where UNMODIFIED is the unmodified form of SYMBOL,
6444 MASK is the set of modifiers present in SYMBOL's name.
6445 This is similar to parse_modifiers_uncached, but uses the cache in
6446 SYMBOL's Qevent_symbol_element_mask property, and maintains the
6447 Qevent_symbol_elements property. */
6449 #define KEY_TO_CHAR(k) (XINT (k) & ((1 << CHARACTERBITS) - 1))
6451 Lisp_Object
6452 parse_modifiers (Lisp_Object symbol)
6454 Lisp_Object elements;
6456 if (INTEGERP (symbol))
6457 return list2i (KEY_TO_CHAR (symbol), XINT (symbol) & CHAR_MODIFIER_MASK);
6458 else if (!SYMBOLP (symbol))
6459 return Qnil;
6461 elements = Fget (symbol, Qevent_symbol_element_mask);
6462 if (CONSP (elements))
6463 return elements;
6464 else
6466 ptrdiff_t end;
6467 int modifiers = parse_modifiers_uncached (symbol, &end);
6468 Lisp_Object unmodified;
6469 Lisp_Object mask;
6471 unmodified = Fintern (make_string (SSDATA (SYMBOL_NAME (symbol)) + end,
6472 SBYTES (SYMBOL_NAME (symbol)) - end),
6473 Qnil);
6475 if (modifiers & ~INTMASK)
6476 emacs_abort ();
6477 XSETFASTINT (mask, modifiers);
6478 elements = list2 (unmodified, mask);
6480 /* Cache the parsing results on SYMBOL. */
6481 Fput (symbol, Qevent_symbol_element_mask,
6482 elements);
6483 Fput (symbol, Qevent_symbol_elements,
6484 Fcons (unmodified, lispy_modifier_list (modifiers)));
6486 /* Since we know that SYMBOL is modifiers applied to unmodified,
6487 it would be nice to put that in unmodified's cache.
6488 But we can't, since we're not sure that parse_modifiers is
6489 canonical. */
6491 return elements;
6495 DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,
6496 Sevent_symbol_parse_modifiers, 1, 1, 0,
6497 doc: /* Parse the event symbol. For internal use. */)
6498 (Lisp_Object symbol)
6500 /* Fill the cache if needed. */
6501 parse_modifiers (symbol);
6502 /* Ignore the result (which is stored on Qevent_symbol_element_mask)
6503 and use the Lispier representation stored on Qevent_symbol_elements
6504 instead. */
6505 return Fget (symbol, Qevent_symbol_elements);
6508 /* Apply the modifiers MODIFIERS to the symbol BASE.
6509 BASE must be unmodified.
6511 This is like apply_modifiers_uncached, but uses BASE's
6512 Qmodifier_cache property, if present. It also builds
6513 Qevent_symbol_elements properties, since it has that info anyway.
6515 apply_modifiers copies the value of BASE's Qevent_kind property to
6516 the modified symbol. */
6517 static Lisp_Object
6518 apply_modifiers (int modifiers, Lisp_Object base)
6520 Lisp_Object cache, idx, entry, new_symbol;
6522 /* Mask out upper bits. We don't know where this value's been. */
6523 modifiers &= INTMASK;
6525 if (INTEGERP (base))
6526 return make_number (XINT (base) | modifiers);
6528 /* The click modifier never figures into cache indices. */
6529 cache = Fget (base, Qmodifier_cache);
6530 XSETFASTINT (idx, (modifiers & ~click_modifier));
6531 entry = assq_no_quit (idx, cache);
6533 if (CONSP (entry))
6534 new_symbol = XCDR (entry);
6535 else
6537 /* We have to create the symbol ourselves. */
6538 new_symbol = apply_modifiers_uncached (modifiers,
6539 SSDATA (SYMBOL_NAME (base)),
6540 SCHARS (SYMBOL_NAME (base)),
6541 SBYTES (SYMBOL_NAME (base)));
6543 /* Add the new symbol to the base's cache. */
6544 entry = Fcons (idx, new_symbol);
6545 Fput (base, Qmodifier_cache, Fcons (entry, cache));
6547 /* We have the parsing info now for free, so we could add it to
6548 the caches:
6549 XSETFASTINT (idx, modifiers);
6550 Fput (new_symbol, Qevent_symbol_element_mask,
6551 list2 (base, idx));
6552 Fput (new_symbol, Qevent_symbol_elements,
6553 Fcons (base, lispy_modifier_list (modifiers)));
6554 Sadly, this is only correct if `base' is indeed a base event,
6555 which is not necessarily the case. -stef */
6558 /* Make sure this symbol is of the same kind as BASE.
6560 You'd think we could just set this once and for all when we
6561 intern the symbol above, but reorder_modifiers may call us when
6562 BASE's property isn't set right; we can't assume that just
6563 because it has a Qmodifier_cache property it must have its
6564 Qevent_kind set right as well. */
6565 if (NILP (Fget (new_symbol, Qevent_kind)))
6567 Lisp_Object kind;
6569 kind = Fget (base, Qevent_kind);
6570 if (! NILP (kind))
6571 Fput (new_symbol, Qevent_kind, kind);
6574 return new_symbol;
6578 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
6579 return a symbol with the modifiers placed in the canonical order.
6580 Canonical order is alphabetical, except for down and drag, which
6581 always come last. The 'click' modifier is never written out.
6583 Fdefine_key calls this to make sure that (for example) C-M-foo
6584 and M-C-foo end up being equivalent in the keymap. */
6586 Lisp_Object
6587 reorder_modifiers (Lisp_Object symbol)
6589 /* It's hopefully okay to write the code this way, since everything
6590 will soon be in caches, and no consing will be done at all. */
6591 Lisp_Object parsed;
6593 parsed = parse_modifiers (symbol);
6594 return apply_modifiers (XFASTINT (XCAR (XCDR (parsed))),
6595 XCAR (parsed));
6599 /* For handling events, we often want to produce a symbol whose name
6600 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
6601 to some base, like the name of a function key or mouse button.
6602 modify_event_symbol produces symbols of this sort.
6604 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
6605 is the name of the i'th symbol. TABLE_SIZE is the number of elements
6606 in the table.
6608 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
6609 into symbol names, or a string specifying a name stem used to
6610 construct a symbol name or the form `STEM-N', where N is the decimal
6611 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
6612 non-nil; otherwise NAME_TABLE is used.
6614 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
6615 persist between calls to modify_event_symbol that it can use to
6616 store a cache of the symbols it's generated for this NAME_TABLE
6617 before. The object stored there may be a vector or an alist.
6619 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
6621 MODIFIERS is a set of modifier bits (as given in struct input_events)
6622 whose prefixes should be applied to the symbol name.
6624 SYMBOL_KIND is the value to be placed in the event_kind property of
6625 the returned symbol.
6627 The symbols we create are supposed to have an
6628 `event-symbol-elements' property, which lists the modifiers present
6629 in the symbol's name. */
6631 static Lisp_Object
6632 modify_event_symbol (ptrdiff_t symbol_num, int modifiers, Lisp_Object symbol_kind,
6633 Lisp_Object name_alist_or_stem, const char *const *name_table,
6634 Lisp_Object *symbol_table, ptrdiff_t table_size)
6636 Lisp_Object value;
6637 Lisp_Object symbol_int;
6639 /* Get rid of the "vendor-specific" bit here. */
6640 XSETINT (symbol_int, symbol_num & 0xffffff);
6642 /* Is this a request for a valid symbol? */
6643 if (symbol_num < 0 || symbol_num >= table_size)
6644 return Qnil;
6646 if (CONSP (*symbol_table))
6647 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
6649 /* If *symbol_table doesn't seem to be initialized properly, fix that.
6650 *symbol_table should be a lisp vector TABLE_SIZE elements long,
6651 where the Nth element is the symbol for NAME_TABLE[N], or nil if
6652 we've never used that symbol before. */
6653 else
6655 if (! VECTORP (*symbol_table)
6656 || ASIZE (*symbol_table) != table_size)
6658 Lisp_Object size;
6660 XSETFASTINT (size, table_size);
6661 *symbol_table = Fmake_vector (size, Qnil);
6664 value = AREF (*symbol_table, symbol_num);
6667 /* Have we already used this symbol before? */
6668 if (NILP (value))
6670 /* No; let's create it. */
6671 if (CONSP (name_alist_or_stem))
6672 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
6673 else if (STRINGP (name_alist_or_stem))
6675 char *buf;
6676 ptrdiff_t len = (SBYTES (name_alist_or_stem)
6677 + sizeof "-" + INT_STRLEN_BOUND (EMACS_INT));
6678 USE_SAFE_ALLOCA;
6679 buf = SAFE_ALLOCA (len);
6680 esprintf (buf, "%s-%"pI"d", SDATA (name_alist_or_stem),
6681 XINT (symbol_int) + 1);
6682 value = intern (buf);
6683 SAFE_FREE ();
6685 else if (name_table != 0 && name_table[symbol_num])
6686 value = intern (name_table[symbol_num]);
6688 #ifdef HAVE_WINDOW_SYSTEM
6689 if (NILP (value))
6691 char *name = x_get_keysym_name (symbol_num);
6692 if (name)
6693 value = intern (name);
6695 #endif
6697 if (NILP (value))
6699 char buf[sizeof "key-" + INT_STRLEN_BOUND (EMACS_INT)];
6700 sprintf (buf, "key-%"pD"d", symbol_num);
6701 value = intern (buf);
6704 if (CONSP (*symbol_table))
6705 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
6706 else
6707 ASET (*symbol_table, symbol_num, value);
6709 /* Fill in the cache entries for this symbol; this also
6710 builds the Qevent_symbol_elements property, which the user
6711 cares about. */
6712 apply_modifiers (modifiers & click_modifier, value);
6713 Fput (value, Qevent_kind, symbol_kind);
6716 /* Apply modifiers to that symbol. */
6717 return apply_modifiers (modifiers, value);
6720 /* Convert a list that represents an event type,
6721 such as (ctrl meta backspace), into the usual representation of that
6722 event type as a number or a symbol. */
6724 DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
6725 doc: /* Convert the event description list EVENT-DESC to an event type.
6726 EVENT-DESC should contain one base event type (a character or symbol)
6727 and zero or more modifier names (control, meta, hyper, super, shift, alt,
6728 drag, down, double or triple). The base must be last.
6729 The return value is an event type (a character or symbol) which
6730 has the same base event type and all the specified modifiers. */)
6731 (Lisp_Object event_desc)
6733 Lisp_Object base;
6734 int modifiers = 0;
6735 Lisp_Object rest;
6737 base = Qnil;
6738 rest = event_desc;
6739 while (CONSP (rest))
6741 Lisp_Object elt;
6742 int this = 0;
6744 elt = XCAR (rest);
6745 rest = XCDR (rest);
6747 /* Given a symbol, see if it is a modifier name. */
6748 if (SYMBOLP (elt) && CONSP (rest))
6749 this = parse_solitary_modifier (elt);
6751 if (this != 0)
6752 modifiers |= this;
6753 else if (!NILP (base))
6754 error ("Two bases given in one event");
6755 else
6756 base = elt;
6760 /* Let the symbol A refer to the character A. */
6761 if (SYMBOLP (base) && SCHARS (SYMBOL_NAME (base)) == 1)
6762 XSETINT (base, SREF (SYMBOL_NAME (base), 0));
6764 if (INTEGERP (base))
6766 /* Turn (shift a) into A. */
6767 if ((modifiers & shift_modifier) != 0
6768 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
6770 XSETINT (base, XINT (base) - ('a' - 'A'));
6771 modifiers &= ~shift_modifier;
6774 /* Turn (control a) into C-a. */
6775 if (modifiers & ctrl_modifier)
6776 return make_number ((modifiers & ~ctrl_modifier)
6777 | make_ctrl_char (XINT (base)));
6778 else
6779 return make_number (modifiers | XINT (base));
6781 else if (SYMBOLP (base))
6782 return apply_modifiers (modifiers, base);
6783 else
6784 error ("Invalid base event");
6787 /* Try to recognize SYMBOL as a modifier name.
6788 Return the modifier flag bit, or 0 if not recognized. */
6791 parse_solitary_modifier (Lisp_Object symbol)
6793 Lisp_Object name = SYMBOL_NAME (symbol);
6795 switch (SREF (name, 0))
6797 #define SINGLE_LETTER_MOD(BIT) \
6798 if (SBYTES (name) == 1) \
6799 return BIT;
6801 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6802 if (LEN == SBYTES (name) \
6803 && ! memcmp (SDATA (name), NAME, LEN)) \
6804 return BIT;
6806 case 'A':
6807 SINGLE_LETTER_MOD (alt_modifier);
6808 break;
6810 case 'a':
6811 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
6812 break;
6814 case 'C':
6815 SINGLE_LETTER_MOD (ctrl_modifier);
6816 break;
6818 case 'c':
6819 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
6820 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
6821 break;
6823 case 'H':
6824 SINGLE_LETTER_MOD (hyper_modifier);
6825 break;
6827 case 'h':
6828 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
6829 break;
6831 case 'M':
6832 SINGLE_LETTER_MOD (meta_modifier);
6833 break;
6835 case 'm':
6836 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
6837 break;
6839 case 'S':
6840 SINGLE_LETTER_MOD (shift_modifier);
6841 break;
6843 case 's':
6844 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
6845 MULTI_LETTER_MOD (super_modifier, "super", 5);
6846 SINGLE_LETTER_MOD (super_modifier);
6847 break;
6849 case 'd':
6850 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6851 MULTI_LETTER_MOD (down_modifier, "down", 4);
6852 MULTI_LETTER_MOD (double_modifier, "double", 6);
6853 break;
6855 case 't':
6856 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6857 break;
6859 #undef SINGLE_LETTER_MOD
6860 #undef MULTI_LETTER_MOD
6863 return 0;
6866 /* Return true if EVENT is a list whose elements are all integers or symbols.
6867 Such a list is not valid as an event,
6868 but it can be a Lucid-style event type list. */
6870 bool
6871 lucid_event_type_list_p (Lisp_Object object)
6873 Lisp_Object tail;
6875 if (! CONSP (object))
6876 return 0;
6878 if (EQ (XCAR (object), Qhelp_echo)
6879 || EQ (XCAR (object), Qvertical_line)
6880 || EQ (XCAR (object), Qmode_line)
6881 || EQ (XCAR (object), Qheader_line))
6882 return 0;
6884 for (tail = object; CONSP (tail); tail = XCDR (tail))
6886 Lisp_Object elt;
6887 elt = XCAR (tail);
6888 if (! (INTEGERP (elt) || SYMBOLP (elt)))
6889 return 0;
6892 return NILP (tail);
6895 /* Return true if terminal input chars are available.
6896 Also, store the return value into INPUT_PENDING.
6898 Serves the purpose of ioctl (0, FIONREAD, ...)
6899 but works even if FIONREAD does not exist.
6900 (In fact, this may actually read some input.)
6902 If READABLE_EVENTS_DO_TIMERS_NOW is set in FLAGS, actually run
6903 timer events that are ripe.
6904 If READABLE_EVENTS_FILTER_EVENTS is set in FLAGS, ignore internal
6905 events (FOCUS_IN_EVENT).
6906 If READABLE_EVENTS_IGNORE_SQUEEZABLES is set in FLAGS, ignore mouse
6907 movements and toolkit scroll bar thumb drags. */
6909 static bool
6910 get_input_pending (int flags)
6912 /* First of all, have we already counted some input? */
6913 input_pending = (!NILP (Vquit_flag) || readable_events (flags));
6915 /* If input is being read as it arrives, and we have none, there is none. */
6916 if (!input_pending && (!interrupt_input || interrupts_deferred))
6918 /* Try to read some input and see how much we get. */
6919 gobble_input ();
6920 input_pending = (!NILP (Vquit_flag) || readable_events (flags));
6923 return input_pending;
6926 /* Put a BUFFER_SWITCH_EVENT in the buffer
6927 so that read_key_sequence will notice the new current buffer. */
6929 void
6930 record_asynch_buffer_change (void)
6932 /* We don't need a buffer-switch event unless Emacs is waiting for input.
6933 The purpose of the event is to make read_key_sequence look up the
6934 keymaps again. If we aren't in read_key_sequence, we don't need one,
6935 and the event could cause trouble by messing up (input-pending-p).
6936 Note: Fwaiting_for_user_input_p always returns nil when async
6937 subprocesses aren't supported. */
6938 if (!NILP (Fwaiting_for_user_input_p ()))
6940 struct input_event event;
6942 EVENT_INIT (event);
6943 event.kind = BUFFER_SWITCH_EVENT;
6944 event.frame_or_window = Qnil;
6945 event.arg = Qnil;
6947 /* Make sure no interrupt happens while storing the event. */
6948 #ifdef USABLE_SIGIO
6949 if (interrupt_input)
6950 kbd_buffer_store_event (&event);
6951 else
6952 #endif
6954 stop_polling ();
6955 kbd_buffer_store_event (&event);
6956 start_polling ();
6961 /* Read any terminal input already buffered up by the system
6962 into the kbd_buffer, but do not wait.
6964 Return the number of keyboard chars read, or -1 meaning
6965 this is a bad time to try to read input. */
6968 gobble_input (void)
6970 int nread = 0;
6971 bool err = 0;
6972 struct terminal *t;
6974 /* Store pending user signal events, if any. */
6975 store_user_signal_events ();
6977 /* Loop through the available terminals, and call their input hooks. */
6978 t = terminal_list;
6979 while (t)
6981 struct terminal *next = t->next_terminal;
6983 if (t->read_socket_hook)
6985 int nr;
6986 struct input_event hold_quit;
6988 if (input_blocked_p ())
6990 pending_signals = 1;
6991 break;
6994 EVENT_INIT (hold_quit);
6995 hold_quit.kind = NO_EVENT;
6997 /* No need for FIONREAD or fcntl; just say don't wait. */
6998 while ((nr = (*t->read_socket_hook) (t, &hold_quit)) > 0)
6999 nread += nr;
7001 if (nr == -1) /* Not OK to read input now. */
7003 err = 1;
7005 else if (nr == -2) /* Non-transient error. */
7007 /* The terminal device terminated; it should be closed. */
7009 /* Kill Emacs if this was our last terminal. */
7010 if (!terminal_list->next_terminal)
7011 /* Formerly simply reported no input, but that
7012 sometimes led to a failure of Emacs to terminate.
7013 SIGHUP seems appropriate if we can't reach the
7014 terminal. */
7015 /* ??? Is it really right to send the signal just to
7016 this process rather than to the whole process
7017 group? Perhaps on systems with FIONREAD Emacs is
7018 alone in its group. */
7019 terminate_due_to_signal (SIGHUP, 10);
7021 /* XXX Is calling delete_terminal safe here? It calls delete_frame. */
7023 Lisp_Object tmp;
7024 XSETTERMINAL (tmp, t);
7025 Fdelete_terminal (tmp, Qnoelisp);
7029 /* If there was no error, make sure the pointer
7030 is visible for all frames on this terminal. */
7031 if (nr >= 0)
7033 Lisp_Object tail, frame;
7035 FOR_EACH_FRAME (tail, frame)
7037 struct frame *f = XFRAME (frame);
7038 if (FRAME_TERMINAL (f) == t)
7039 frame_make_pointer_visible (f);
7043 if (hold_quit.kind != NO_EVENT)
7044 kbd_buffer_store_event (&hold_quit);
7047 t = next;
7050 if (err && !nread)
7051 nread = -1;
7053 return nread;
7056 /* This is the tty way of reading available input.
7058 Note that each terminal device has its own `struct terminal' object,
7059 and so this function is called once for each individual termcap
7060 terminal. The first parameter indicates which terminal to read from. */
7063 tty_read_avail_input (struct terminal *terminal,
7064 struct input_event *hold_quit)
7066 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
7067 the kbd_buffer can really hold. That may prevent loss
7068 of characters on some systems when input is stuffed at us. */
7069 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
7070 int n_to_read, i;
7071 struct tty_display_info *tty = terminal->display_info.tty;
7072 int nread = 0;
7073 #ifdef subprocesses
7074 int buffer_free = KBD_BUFFER_SIZE - kbd_buffer_nr_stored () - 1;
7076 if (kbd_on_hold_p () || buffer_free <= 0)
7077 return 0;
7078 #endif /* subprocesses */
7080 if (!terminal->name) /* Don't read from a dead terminal. */
7081 return 0;
7083 if (terminal->type != output_termcap
7084 && terminal->type != output_msdos_raw)
7085 emacs_abort ();
7087 /* XXX I think the following code should be moved to separate hook
7088 functions in system-dependent files. */
7089 #ifdef WINDOWSNT
7090 /* FIXME: AFAIK, tty_read_avail_input is not used under w32 since the non-GUI
7091 code sets read_socket_hook to w32_console_read_socket instead! */
7092 return 0;
7093 #else /* not WINDOWSNT */
7094 if (! tty->term_initted) /* In case we get called during bootstrap. */
7095 return 0;
7097 if (! tty->input)
7098 return 0; /* The terminal is suspended. */
7100 #ifdef MSDOS
7101 n_to_read = dos_keysns ();
7102 if (n_to_read == 0)
7103 return 0;
7105 cbuf[0] = dos_keyread ();
7106 nread = 1;
7108 #else /* not MSDOS */
7109 #ifdef HAVE_GPM
7110 if (gpm_tty == tty)
7112 Gpm_Event event;
7113 struct input_event gpm_hold_quit;
7114 int gpm, fd = gpm_fd;
7116 EVENT_INIT (gpm_hold_quit);
7117 gpm_hold_quit.kind = NO_EVENT;
7119 /* gpm==1 if event received.
7120 gpm==0 if the GPM daemon has closed the connection, in which case
7121 Gpm_GetEvent closes gpm_fd and clears it to -1, which is why
7122 we save it in `fd' so close_gpm can remove it from the
7123 select masks.
7124 gpm==-1 if a protocol error or EWOULDBLOCK; the latter is normal. */
7125 while (gpm = Gpm_GetEvent (&event), gpm == 1) {
7126 nread += handle_one_term_event (tty, &event, &gpm_hold_quit);
7128 if (gpm == 0)
7129 /* Presumably the GPM daemon has closed the connection. */
7130 close_gpm (fd);
7131 if (gpm_hold_quit.kind != NO_EVENT)
7132 kbd_buffer_store_event (&gpm_hold_quit);
7133 if (nread)
7134 return nread;
7136 #endif /* HAVE_GPM */
7138 /* Determine how many characters we should *try* to read. */
7139 #ifdef USABLE_FIONREAD
7140 /* Find out how much input is available. */
7141 if (ioctl (fileno (tty->input), FIONREAD, &n_to_read) < 0)
7143 if (! noninteractive)
7144 return -2; /* Close this terminal. */
7145 else
7146 n_to_read = 0;
7148 if (n_to_read == 0)
7149 return 0;
7150 if (n_to_read > sizeof cbuf)
7151 n_to_read = sizeof cbuf;
7152 #elif defined USG || defined CYGWIN
7153 /* Read some input if available, but don't wait. */
7154 n_to_read = sizeof cbuf;
7155 fcntl (fileno (tty->input), F_SETFL, O_NONBLOCK);
7156 #else
7157 # error "Cannot read without possibly delaying"
7158 #endif
7160 #ifdef subprocesses
7161 /* Don't read more than we can store. */
7162 if (n_to_read > buffer_free)
7163 n_to_read = buffer_free;
7164 #endif /* subprocesses */
7166 /* Now read; for one reason or another, this will not block.
7167 NREAD is set to the number of chars read. */
7170 nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read);
7171 /* POSIX infers that processes which are not in the session leader's
7172 process group won't get SIGHUPs at logout time. BSDI adheres to
7173 this part standard and returns -1 from read (0) with errno==EIO
7174 when the control tty is taken away.
7175 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
7176 if (nread == -1 && errno == EIO)
7177 return -2; /* Close this terminal. */
7178 #if defined (AIX) && defined (_BSD)
7179 /* The kernel sometimes fails to deliver SIGHUP for ptys.
7180 This looks incorrect, but it isn't, because _BSD causes
7181 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
7182 and that causes a value other than 0 when there is no input. */
7183 if (nread == 0)
7184 return -2; /* Close this terminal. */
7185 #endif
7187 while (
7188 /* We used to retry the read if it was interrupted.
7189 But this does the wrong thing when O_NONBLOCK causes
7190 an EAGAIN error. Does anybody know of a situation
7191 where a retry is actually needed? */
7192 #if 0
7193 nread < 0 && (errno == EAGAIN || errno == EFAULT
7194 #ifdef EBADSLT
7195 || errno == EBADSLT
7196 #endif
7198 #else
7200 #endif
7203 #ifndef USABLE_FIONREAD
7204 #if defined (USG) || defined (CYGWIN)
7205 fcntl (fileno (tty->input), F_SETFL, 0);
7206 #endif /* USG or CYGWIN */
7207 #endif /* no FIONREAD */
7209 if (nread <= 0)
7210 return nread;
7212 #endif /* not MSDOS */
7213 #endif /* not WINDOWSNT */
7215 for (i = 0; i < nread; i++)
7217 struct input_event buf;
7218 EVENT_INIT (buf);
7219 buf.kind = ASCII_KEYSTROKE_EVENT;
7220 buf.modifiers = 0;
7221 if (tty->meta_key == 1 && (cbuf[i] & 0x80))
7222 buf.modifiers = meta_modifier;
7223 if (tty->meta_key != 2)
7224 cbuf[i] &= ~0x80;
7226 buf.code = cbuf[i];
7227 /* Set the frame corresponding to the active tty. Note that the
7228 value of selected_frame is not reliable here, redisplay tends
7229 to temporarily change it. */
7230 buf.frame_or_window = tty->top_frame;
7231 buf.arg = Qnil;
7233 kbd_buffer_store_event (&buf);
7234 /* Don't look at input that follows a C-g too closely.
7235 This reduces lossage due to autorepeat on C-g. */
7236 if (buf.kind == ASCII_KEYSTROKE_EVENT
7237 && buf.code == quit_char)
7238 break;
7241 return nread;
7244 static void
7245 handle_async_input (void)
7247 #ifdef USABLE_SIGIO
7248 while (1)
7250 int nread = gobble_input ();
7251 /* -1 means it's not ok to read the input now.
7252 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
7253 0 means there was no keyboard input available. */
7254 if (nread <= 0)
7255 break;
7257 #endif
7260 void
7261 process_pending_signals (void)
7263 pending_signals = 0;
7264 handle_async_input ();
7265 do_pending_atimers ();
7268 /* Undo any number of BLOCK_INPUT calls down to level LEVEL,
7269 and reinvoke any pending signal if the level is now 0 and
7270 a fatal error is not already in progress. */
7272 void
7273 unblock_input_to (int level)
7275 interrupt_input_blocked = level;
7276 if (level == 0)
7278 if (pending_signals && !fatal_error_in_progress)
7279 process_pending_signals ();
7281 else if (level < 0)
7282 emacs_abort ();
7285 /* End critical section.
7287 If doing signal-driven input, and a signal came in when input was
7288 blocked, reinvoke the signal handler now to deal with it.
7290 It will also process queued input, if it was not read before.
7291 When a longer code sequence does not use block/unblock input
7292 at all, the whole input gathered up to the next call to
7293 unblock_input will be processed inside that call. */
7295 void
7296 unblock_input (void)
7298 unblock_input_to (interrupt_input_blocked - 1);
7301 /* Undo any number of BLOCK_INPUT calls,
7302 and also reinvoke any pending signal. */
7304 void
7305 totally_unblock_input (void)
7307 unblock_input_to (0);
7310 #ifdef USABLE_SIGIO
7312 void
7313 handle_input_available_signal (int sig)
7315 pending_signals = 1;
7317 if (input_available_clear_time)
7318 *input_available_clear_time = make_timespec (0, 0);
7321 static void
7322 deliver_input_available_signal (int sig)
7324 deliver_process_signal (sig, handle_input_available_signal);
7326 #endif /* USABLE_SIGIO */
7329 /* User signal events. */
7331 struct user_signal_info
7333 /* Signal number. */
7334 int sig;
7336 /* Name of the signal. */
7337 char *name;
7339 /* Number of pending signals. */
7340 int npending;
7342 struct user_signal_info *next;
7345 /* List of user signals. */
7346 static struct user_signal_info *user_signals = NULL;
7348 void
7349 add_user_signal (int sig, const char *name)
7351 struct sigaction action;
7352 struct user_signal_info *p;
7354 for (p = user_signals; p; p = p->next)
7355 if (p->sig == sig)
7356 /* Already added. */
7357 return;
7359 p = xmalloc (sizeof *p);
7360 p->sig = sig;
7361 p->name = xstrdup (name);
7362 p->npending = 0;
7363 p->next = user_signals;
7364 user_signals = p;
7366 emacs_sigaction_init (&action, deliver_user_signal);
7367 sigaction (sig, &action, 0);
7370 static void
7371 handle_user_signal (int sig)
7373 struct user_signal_info *p;
7374 const char *special_event_name = NULL;
7376 if (SYMBOLP (Vdebug_on_event))
7377 special_event_name = SSDATA (SYMBOL_NAME (Vdebug_on_event));
7379 for (p = user_signals; p; p = p->next)
7380 if (p->sig == sig)
7382 if (special_event_name
7383 && strcmp (special_event_name, p->name) == 0)
7385 /* Enter the debugger in many ways. */
7386 debug_on_next_call = 1;
7387 debug_on_quit = 1;
7388 Vquit_flag = Qt;
7389 Vinhibit_quit = Qnil;
7391 /* Eat the event. */
7392 break;
7395 p->npending++;
7396 #ifdef USABLE_SIGIO
7397 if (interrupt_input)
7398 handle_input_available_signal (sig);
7399 else
7400 #endif
7402 /* Tell wait_reading_process_output that it needs to wake
7403 up and look around. */
7404 if (input_available_clear_time)
7405 *input_available_clear_time = make_timespec (0, 0);
7407 break;
7411 static void
7412 deliver_user_signal (int sig)
7414 deliver_process_signal (sig, handle_user_signal);
7417 static char *
7418 find_user_signal_name (int sig)
7420 struct user_signal_info *p;
7422 for (p = user_signals; p; p = p->next)
7423 if (p->sig == sig)
7424 return p->name;
7426 return NULL;
7429 static void
7430 store_user_signal_events (void)
7432 struct user_signal_info *p;
7433 struct input_event buf;
7434 bool buf_initialized = 0;
7436 for (p = user_signals; p; p = p->next)
7437 if (p->npending > 0)
7439 if (! buf_initialized)
7441 memset (&buf, 0, sizeof buf);
7442 buf.kind = USER_SIGNAL_EVENT;
7443 buf.frame_or_window = selected_frame;
7444 buf_initialized = 1;
7449 buf.code = p->sig;
7450 kbd_buffer_store_event (&buf);
7451 p->npending--;
7453 while (p->npending > 0);
7458 static void menu_bar_item (Lisp_Object, Lisp_Object, Lisp_Object, void *);
7459 static Lisp_Object menu_bar_one_keymap_changed_items;
7461 /* These variables hold the vector under construction within
7462 menu_bar_items and its subroutines, and the current index
7463 for storing into that vector. */
7464 static Lisp_Object menu_bar_items_vector;
7465 static int menu_bar_items_index;
7468 static const char *separator_names[] = {
7469 "space",
7470 "no-line",
7471 "single-line",
7472 "double-line",
7473 "single-dashed-line",
7474 "double-dashed-line",
7475 "shadow-etched-in",
7476 "shadow-etched-out",
7477 "shadow-etched-in-dash",
7478 "shadow-etched-out-dash",
7479 "shadow-double-etched-in",
7480 "shadow-double-etched-out",
7481 "shadow-double-etched-in-dash",
7482 "shadow-double-etched-out-dash",
7486 /* Return true if LABEL specifies a separator. */
7488 bool
7489 menu_separator_name_p (const char *label)
7491 if (!label)
7492 return 0;
7493 else if (strlen (label) > 3
7494 && memcmp (label, "--", 2) == 0
7495 && label[2] != '-')
7497 int i;
7498 label += 2;
7499 for (i = 0; separator_names[i]; ++i)
7500 if (strcmp (label, separator_names[i]) == 0)
7501 return 1;
7503 else
7505 /* It's a separator if it contains only dashes. */
7506 while (*label == '-')
7507 ++label;
7508 return (*label == 0);
7511 return 0;
7515 /* Return a vector of menu items for a menu bar, appropriate
7516 to the current buffer. Each item has three elements in the vector:
7517 KEY STRING MAPLIST.
7519 OLD is an old vector we can optionally reuse, or nil. */
7521 Lisp_Object
7522 menu_bar_items (Lisp_Object old)
7524 /* The number of keymaps we're scanning right now, and the number of
7525 keymaps we have allocated space for. */
7526 ptrdiff_t nmaps;
7528 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
7529 in the current keymaps, or nil where it is not a prefix. */
7530 Lisp_Object *maps;
7532 Lisp_Object mapsbuf[3];
7533 Lisp_Object def, tail;
7535 ptrdiff_t mapno;
7536 Lisp_Object oquit;
7538 USE_SAFE_ALLOCA;
7540 /* In order to build the menus, we need to call the keymap
7541 accessors. They all call QUIT. But this function is called
7542 during redisplay, during which a quit is fatal. So inhibit
7543 quitting while building the menus.
7544 We do this instead of specbind because (1) errors will clear it anyway
7545 and (2) this avoids risk of specpdl overflow. */
7546 oquit = Vinhibit_quit;
7547 Vinhibit_quit = Qt;
7549 if (!NILP (old))
7550 menu_bar_items_vector = old;
7551 else
7552 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
7553 menu_bar_items_index = 0;
7555 /* Build our list of keymaps.
7556 If we recognize a function key and replace its escape sequence in
7557 keybuf with its symbol, or if the sequence starts with a mouse
7558 click and we need to switch buffers, we jump back here to rebuild
7559 the initial keymaps from the current buffer. */
7561 Lisp_Object *tmaps;
7563 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7564 if (!NILP (Voverriding_local_map_menu_flag)
7565 && !NILP (Voverriding_local_map))
7567 /* Yes, use them (if non-nil) as well as the global map. */
7568 maps = mapsbuf;
7569 nmaps = 0;
7570 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
7571 maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
7572 if (!NILP (Voverriding_local_map))
7573 maps[nmaps++] = Voverriding_local_map;
7575 else
7577 /* No, so use major and minor mode keymaps and keymap property.
7578 Note that menu-bar bindings in the local-map and keymap
7579 properties may not work reliable, as they are only
7580 recognized when the menu-bar (or mode-line) is updated,
7581 which does not normally happen after every command. */
7582 Lisp_Object tem;
7583 ptrdiff_t nminor;
7584 nminor = current_minor_maps (NULL, &tmaps);
7585 SAFE_NALLOCA (maps, 1, nminor + 4);
7586 nmaps = 0;
7587 tem = KVAR (current_kboard, Voverriding_terminal_local_map);
7588 if (!NILP (tem) && !NILP (Voverriding_local_map_menu_flag))
7589 maps[nmaps++] = tem;
7590 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
7591 maps[nmaps++] = tem;
7592 memcpy (maps + nmaps, tmaps, nminor * sizeof (maps[0]));
7593 nmaps += nminor;
7594 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
7596 maps[nmaps++] = current_global_map;
7599 /* Look up in each map the dummy prefix key `menu-bar'. */
7601 for (mapno = nmaps - 1; mapno >= 0; mapno--)
7602 if (!NILP (maps[mapno]))
7604 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
7605 0, 1);
7606 if (CONSP (def))
7608 menu_bar_one_keymap_changed_items = Qnil;
7609 map_keymap_canonical (def, menu_bar_item, Qnil, NULL);
7613 /* Move to the end those items that should be at the end. */
7615 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
7617 int i;
7618 int end = menu_bar_items_index;
7620 for (i = 0; i < end; i += 4)
7621 if (EQ (XCAR (tail), AREF (menu_bar_items_vector, i)))
7623 Lisp_Object tem0, tem1, tem2, tem3;
7624 /* Move the item at index I to the end,
7625 shifting all the others forward. */
7626 tem0 = AREF (menu_bar_items_vector, i + 0);
7627 tem1 = AREF (menu_bar_items_vector, i + 1);
7628 tem2 = AREF (menu_bar_items_vector, i + 2);
7629 tem3 = AREF (menu_bar_items_vector, i + 3);
7630 if (end > i + 4)
7631 memmove (aref_addr (menu_bar_items_vector, i),
7632 aref_addr (menu_bar_items_vector, i + 4),
7633 (end - i - 4) * word_size);
7634 ASET (menu_bar_items_vector, end - 4, tem0);
7635 ASET (menu_bar_items_vector, end - 3, tem1);
7636 ASET (menu_bar_items_vector, end - 2, tem2);
7637 ASET (menu_bar_items_vector, end - 1, tem3);
7638 break;
7642 /* Add nil, nil, nil, nil at the end. */
7644 int i = menu_bar_items_index;
7645 if (i + 4 > ASIZE (menu_bar_items_vector))
7646 menu_bar_items_vector
7647 = larger_vector (menu_bar_items_vector, 4, -1);
7648 /* Add this item. */
7649 ASET (menu_bar_items_vector, i, Qnil); i++;
7650 ASET (menu_bar_items_vector, i, Qnil); i++;
7651 ASET (menu_bar_items_vector, i, Qnil); i++;
7652 ASET (menu_bar_items_vector, i, Qnil); i++;
7653 menu_bar_items_index = i;
7656 Vinhibit_quit = oquit;
7657 SAFE_FREE ();
7658 return menu_bar_items_vector;
7661 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
7662 If there's already an item for KEY, add this DEF to it. */
7664 Lisp_Object item_properties;
7666 static void
7667 menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dummy2)
7669 struct gcpro gcpro1;
7670 int i;
7671 bool parsed;
7672 Lisp_Object tem;
7674 if (EQ (item, Qundefined))
7676 /* If a map has an explicit `undefined' as definition,
7677 discard any previously made menu bar item. */
7679 for (i = 0; i < menu_bar_items_index; i += 4)
7680 if (EQ (key, AREF (menu_bar_items_vector, i)))
7682 if (menu_bar_items_index > i + 4)
7683 memmove (aref_addr (menu_bar_items_vector, i),
7684 aref_addr (menu_bar_items_vector, i + 4),
7685 (menu_bar_items_index - i - 4) * word_size);
7686 menu_bar_items_index -= 4;
7690 /* If this keymap has already contributed to this KEY,
7691 don't contribute to it a second time. */
7692 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
7693 if (!NILP (tem) || NILP (item))
7694 return;
7696 menu_bar_one_keymap_changed_items
7697 = Fcons (key, menu_bar_one_keymap_changed_items);
7699 /* We add to menu_bar_one_keymap_changed_items before doing the
7700 parse_menu_item, so that if it turns out it wasn't a menu item,
7701 it still correctly hides any further menu item. */
7702 GCPRO1 (key);
7703 parsed = parse_menu_item (item, 1);
7704 UNGCPRO;
7705 if (!parsed)
7706 return;
7708 item = AREF (item_properties, ITEM_PROPERTY_DEF);
7710 /* Find any existing item for this KEY. */
7711 for (i = 0; i < menu_bar_items_index; i += 4)
7712 if (EQ (key, AREF (menu_bar_items_vector, i)))
7713 break;
7715 /* If we did not find this KEY, add it at the end. */
7716 if (i == menu_bar_items_index)
7718 /* If vector is too small, get a bigger one. */
7719 if (i + 4 > ASIZE (menu_bar_items_vector))
7720 menu_bar_items_vector = larger_vector (menu_bar_items_vector, 4, -1);
7721 /* Add this item. */
7722 ASET (menu_bar_items_vector, i, key); i++;
7723 ASET (menu_bar_items_vector, i,
7724 AREF (item_properties, ITEM_PROPERTY_NAME)); i++;
7725 ASET (menu_bar_items_vector, i, list1 (item)); i++;
7726 ASET (menu_bar_items_vector, i, make_number (0)); i++;
7727 menu_bar_items_index = i;
7729 /* We did find an item for this KEY. Add ITEM to its list of maps. */
7730 else
7732 Lisp_Object old;
7733 old = AREF (menu_bar_items_vector, i + 2);
7734 /* If the new and the old items are not both keymaps,
7735 the lookup will only find `item'. */
7736 item = Fcons (item, KEYMAPP (item) && KEYMAPP (XCAR (old)) ? old : Qnil);
7737 ASET (menu_bar_items_vector, i + 2, item);
7741 /* This is used as the handler when calling menu_item_eval_property. */
7742 static Lisp_Object
7743 menu_item_eval_property_1 (Lisp_Object arg)
7745 /* If we got a quit from within the menu computation,
7746 quit all the way out of it. This takes care of C-] in the debugger. */
7747 if (CONSP (arg) && EQ (XCAR (arg), Qquit))
7748 Fsignal (Qquit, Qnil);
7750 return Qnil;
7753 static Lisp_Object
7754 eval_dyn (Lisp_Object form)
7756 return Feval (form, Qnil);
7759 /* Evaluate an expression and return the result (or nil if something
7760 went wrong). Used to evaluate dynamic parts of menu items. */
7761 Lisp_Object
7762 menu_item_eval_property (Lisp_Object sexpr)
7764 ptrdiff_t count = SPECPDL_INDEX ();
7765 Lisp_Object val;
7766 specbind (Qinhibit_redisplay, Qt);
7767 val = internal_condition_case_1 (eval_dyn, sexpr, Qerror,
7768 menu_item_eval_property_1);
7769 return unbind_to (count, val);
7772 /* This function parses a menu item and leaves the result in the
7773 vector item_properties.
7774 ITEM is a key binding, a possible menu item.
7775 INMENUBAR is > 0 when this is considered for an entry in a menu bar
7776 top level.
7777 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
7778 parse_menu_item returns true if the item is a menu item and false
7779 otherwise. */
7781 bool
7782 parse_menu_item (Lisp_Object item, int inmenubar)
7784 Lisp_Object def, tem, item_string, start;
7785 Lisp_Object filter;
7786 Lisp_Object keyhint;
7787 int i;
7789 filter = Qnil;
7790 keyhint = Qnil;
7792 if (!CONSP (item))
7793 return 0;
7795 /* Create item_properties vector if necessary. */
7796 if (NILP (item_properties))
7797 item_properties
7798 = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
7800 /* Initialize optional entries. */
7801 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
7802 ASET (item_properties, i, Qnil);
7803 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7805 /* Save the item here to protect it from GC. */
7806 ASET (item_properties, ITEM_PROPERTY_ITEM, item);
7808 item_string = XCAR (item);
7810 start = item;
7811 item = XCDR (item);
7812 if (STRINGP (item_string))
7814 /* Old format menu item. */
7815 ASET (item_properties, ITEM_PROPERTY_NAME, item_string);
7817 /* Maybe help string. */
7818 if (CONSP (item) && STRINGP (XCAR (item)))
7820 ASET (item_properties, ITEM_PROPERTY_HELP, XCAR (item));
7821 start = item;
7822 item = XCDR (item);
7825 /* Maybe an obsolete key binding cache. */
7826 if (CONSP (item) && CONSP (XCAR (item))
7827 && (NILP (XCAR (XCAR (item)))
7828 || VECTORP (XCAR (XCAR (item)))))
7829 item = XCDR (item);
7831 /* This is the real definition--the function to run. */
7832 ASET (item_properties, ITEM_PROPERTY_DEF, item);
7834 /* Get enable property, if any. */
7835 if (SYMBOLP (item))
7837 tem = Fget (item, Qmenu_enable);
7838 if (!NILP (Venable_disabled_menus_and_buttons))
7839 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7840 else if (!NILP (tem))
7841 ASET (item_properties, ITEM_PROPERTY_ENABLE, tem);
7844 else if (EQ (item_string, Qmenu_item) && CONSP (item))
7846 /* New format menu item. */
7847 ASET (item_properties, ITEM_PROPERTY_NAME, XCAR (item));
7848 start = XCDR (item);
7849 if (CONSP (start))
7851 /* We have a real binding. */
7852 ASET (item_properties, ITEM_PROPERTY_DEF, XCAR (start));
7854 item = XCDR (start);
7855 /* Is there an obsolete cache list with key equivalences. */
7856 if (CONSP (item) && CONSP (XCAR (item)))
7857 item = XCDR (item);
7859 /* Parse properties. */
7860 while (CONSP (item) && CONSP (XCDR (item)))
7862 tem = XCAR (item);
7863 item = XCDR (item);
7865 if (EQ (tem, QCenable))
7867 if (!NILP (Venable_disabled_menus_and_buttons))
7868 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7869 else
7870 ASET (item_properties, ITEM_PROPERTY_ENABLE, XCAR (item));
7872 else if (EQ (tem, QCvisible))
7874 /* If got a visible property and that evaluates to nil
7875 then ignore this item. */
7876 tem = menu_item_eval_property (XCAR (item));
7877 if (NILP (tem))
7878 return 0;
7880 else if (EQ (tem, QChelp))
7881 ASET (item_properties, ITEM_PROPERTY_HELP, XCAR (item));
7882 else if (EQ (tem, QCfilter))
7883 filter = item;
7884 else if (EQ (tem, QCkey_sequence))
7886 tem = XCAR (item);
7887 if (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem))
7888 /* Be GC protected. Set keyhint to item instead of tem. */
7889 keyhint = item;
7891 else if (EQ (tem, QCkeys))
7893 tem = XCAR (item);
7894 if (CONSP (tem) || STRINGP (tem))
7895 ASET (item_properties, ITEM_PROPERTY_KEYEQ, tem);
7897 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
7899 Lisp_Object type;
7900 tem = XCAR (item);
7901 type = XCAR (tem);
7902 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7904 ASET (item_properties, ITEM_PROPERTY_SELECTED,
7905 XCDR (tem));
7906 ASET (item_properties, ITEM_PROPERTY_TYPE, type);
7909 item = XCDR (item);
7912 else if (inmenubar || !NILP (start))
7913 return 0;
7915 else
7916 return 0; /* not a menu item */
7918 /* If item string is not a string, evaluate it to get string.
7919 If we don't get a string, skip this item. */
7920 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
7921 if (!(STRINGP (item_string)))
7923 item_string = menu_item_eval_property (item_string);
7924 if (!STRINGP (item_string))
7925 return 0;
7926 ASET (item_properties, ITEM_PROPERTY_NAME, item_string);
7929 /* If got a filter apply it on definition. */
7930 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7931 if (!NILP (filter))
7933 def = menu_item_eval_property (list2 (XCAR (filter),
7934 list2 (Qquote, def)));
7936 ASET (item_properties, ITEM_PROPERTY_DEF, def);
7939 /* Enable or disable selection of item. */
7940 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
7941 if (!EQ (tem, Qt))
7943 tem = menu_item_eval_property (tem);
7944 if (inmenubar && NILP (tem))
7945 return 0; /* Ignore disabled items in menu bar. */
7946 ASET (item_properties, ITEM_PROPERTY_ENABLE, tem);
7949 /* If we got no definition, this item is just unselectable text which
7950 is OK in a submenu but not in the menubar. */
7951 if (NILP (def))
7952 return (!inmenubar);
7954 /* See if this is a separate pane or a submenu. */
7955 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7956 tem = get_keymap (def, 0, 1);
7957 /* For a subkeymap, just record its details and exit. */
7958 if (CONSP (tem))
7960 ASET (item_properties, ITEM_PROPERTY_MAP, tem);
7961 ASET (item_properties, ITEM_PROPERTY_DEF, tem);
7962 return 1;
7965 /* At the top level in the menu bar, do likewise for commands also.
7966 The menu bar does not display equivalent key bindings anyway.
7967 ITEM_PROPERTY_DEF is already set up properly. */
7968 if (inmenubar > 0)
7969 return 1;
7971 { /* This is a command. See if there is an equivalent key binding. */
7972 Lisp_Object keyeq = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
7973 AUTO_STRING (space_space, " ");
7975 /* The previous code preferred :key-sequence to :keys, so we
7976 preserve this behavior. */
7977 if (STRINGP (keyeq) && !CONSP (keyhint))
7978 keyeq = concat2 (space_space, Fsubstitute_command_keys (keyeq));
7979 else
7981 Lisp_Object prefix = keyeq;
7982 Lisp_Object keys = Qnil;
7984 if (CONSP (prefix))
7986 def = XCAR (prefix);
7987 prefix = XCDR (prefix);
7989 else
7990 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7992 if (CONSP (keyhint) && !NILP (XCAR (keyhint)))
7994 keys = XCAR (keyhint);
7995 tem = Fkey_binding (keys, Qnil, Qnil, Qnil);
7997 /* We have a suggested key. Is it bound to the command? */
7998 if (NILP (tem)
7999 || (!EQ (tem, def)
8000 /* If the command is an alias for another
8001 (such as lmenu.el set it up), check if the
8002 original command matches the cached command. */
8003 && !(SYMBOLP (def)
8004 && EQ (tem, XSYMBOL (def)->function))))
8005 keys = Qnil;
8008 if (NILP (keys))
8009 keys = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qnil);
8011 if (!NILP (keys))
8013 tem = Fkey_description (keys, Qnil);
8014 if (CONSP (prefix))
8016 if (STRINGP (XCAR (prefix)))
8017 tem = concat2 (XCAR (prefix), tem);
8018 if (STRINGP (XCDR (prefix)))
8019 tem = concat2 (tem, XCDR (prefix));
8021 keyeq = concat2 (space_space, tem);
8023 else
8024 keyeq = Qnil;
8027 /* If we have an equivalent key binding, use that. */
8028 ASET (item_properties, ITEM_PROPERTY_KEYEQ, keyeq);
8031 /* Include this when menu help is implemented.
8032 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
8033 if (!(NILP (tem) || STRINGP (tem)))
8035 tem = menu_item_eval_property (tem);
8036 if (!STRINGP (tem))
8037 tem = Qnil;
8038 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
8042 /* Handle radio buttons or toggle boxes. */
8043 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
8044 if (!NILP (tem))
8045 ASET (item_properties, ITEM_PROPERTY_SELECTED,
8046 menu_item_eval_property (tem));
8048 return 1;
8053 /***********************************************************************
8054 Tool-bars
8055 ***********************************************************************/
8057 /* A vector holding tool bar items while they are parsed in function
8058 tool_bar_items. Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
8059 in the vector. */
8061 static Lisp_Object tool_bar_items_vector;
8063 /* A vector holding the result of parse_tool_bar_item. Layout is like
8064 the one for a single item in tool_bar_items_vector. */
8066 static Lisp_Object tool_bar_item_properties;
8068 /* Next free index in tool_bar_items_vector. */
8070 static int ntool_bar_items;
8072 /* The symbols `:image' and `:rtl'. */
8074 static Lisp_Object QCimage;
8075 static Lisp_Object QCrtl;
8077 /* Function prototypes. */
8079 static void init_tool_bar_items (Lisp_Object);
8080 static void process_tool_bar_item (Lisp_Object, Lisp_Object, Lisp_Object,
8081 void *);
8082 static bool parse_tool_bar_item (Lisp_Object, Lisp_Object);
8083 static void append_tool_bar_item (void);
8086 /* Return a vector of tool bar items for keymaps currently in effect.
8087 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
8088 tool bar items found. */
8090 Lisp_Object
8091 tool_bar_items (Lisp_Object reuse, int *nitems)
8093 Lisp_Object *maps;
8094 Lisp_Object mapsbuf[3];
8095 ptrdiff_t nmaps, i;
8096 Lisp_Object oquit;
8097 Lisp_Object *tmaps;
8098 USE_SAFE_ALLOCA;
8100 *nitems = 0;
8102 /* In order to build the menus, we need to call the keymap
8103 accessors. They all call QUIT. But this function is called
8104 during redisplay, during which a quit is fatal. So inhibit
8105 quitting while building the menus. We do this instead of
8106 specbind because (1) errors will clear it anyway and (2) this
8107 avoids risk of specpdl overflow. */
8108 oquit = Vinhibit_quit;
8109 Vinhibit_quit = Qt;
8111 /* Initialize tool_bar_items_vector and protect it from GC. */
8112 init_tool_bar_items (reuse);
8114 /* Build list of keymaps in maps. Set nmaps to the number of maps
8115 to process. */
8117 /* Should overriding-terminal-local-map and overriding-local-map apply? */
8118 if (!NILP (Voverriding_local_map_menu_flag)
8119 && !NILP (Voverriding_local_map))
8121 /* Yes, use them (if non-nil) as well as the global map. */
8122 maps = mapsbuf;
8123 nmaps = 0;
8124 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
8125 maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
8126 if (!NILP (Voverriding_local_map))
8127 maps[nmaps++] = Voverriding_local_map;
8129 else
8131 /* No, so use major and minor mode keymaps and keymap property.
8132 Note that tool-bar bindings in the local-map and keymap
8133 properties may not work reliable, as they are only
8134 recognized when the tool-bar (or mode-line) is updated,
8135 which does not normally happen after every command. */
8136 Lisp_Object tem;
8137 ptrdiff_t nminor;
8138 nminor = current_minor_maps (NULL, &tmaps);
8139 SAFE_NALLOCA (maps, 1, nminor + 4);
8140 nmaps = 0;
8141 tem = KVAR (current_kboard, Voverriding_terminal_local_map);
8142 if (!NILP (tem) && !NILP (Voverriding_local_map_menu_flag))
8143 maps[nmaps++] = tem;
8144 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
8145 maps[nmaps++] = tem;
8146 memcpy (maps + nmaps, tmaps, nminor * sizeof (maps[0]));
8147 nmaps += nminor;
8148 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
8151 /* Add global keymap at the end. */
8152 maps[nmaps++] = current_global_map;
8154 /* Process maps in reverse order and look up in each map the prefix
8155 key `tool-bar'. */
8156 for (i = nmaps - 1; i >= 0; --i)
8157 if (!NILP (maps[i]))
8159 Lisp_Object keymap;
8161 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
8162 if (CONSP (keymap))
8163 map_keymap (keymap, process_tool_bar_item, Qnil, NULL, 1);
8166 Vinhibit_quit = oquit;
8167 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
8168 SAFE_FREE ();
8169 return tool_bar_items_vector;
8173 /* Process the definition of KEY which is DEF. */
8175 static void
8176 process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void *args)
8178 int i;
8179 struct gcpro gcpro1, gcpro2;
8181 /* Protect KEY and DEF from GC because parse_tool_bar_item may call
8182 eval. */
8183 GCPRO2 (key, def);
8185 if (EQ (def, Qundefined))
8187 /* If a map has an explicit `undefined' as definition,
8188 discard any previously made item. */
8189 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
8191 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
8193 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
8195 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
8196 memmove (v, v + TOOL_BAR_ITEM_NSLOTS,
8197 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
8198 * word_size));
8199 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
8200 break;
8204 else if (parse_tool_bar_item (key, def))
8205 /* Append a new tool bar item to tool_bar_items_vector. Accept
8206 more than one definition for the same key. */
8207 append_tool_bar_item ();
8209 UNGCPRO;
8212 /* Access slot with index IDX of vector tool_bar_item_properties. */
8213 #define PROP(IDX) AREF (tool_bar_item_properties, (IDX))
8214 static void
8215 set_prop (ptrdiff_t idx, Lisp_Object val)
8217 ASET (tool_bar_item_properties, idx, val);
8221 /* Parse a tool bar item specification ITEM for key KEY and return the
8222 result in tool_bar_item_properties. Value is false if ITEM is
8223 invalid.
8225 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
8227 CAPTION is the caption of the item, If it's not a string, it is
8228 evaluated to get a string.
8230 BINDING is the tool bar item's binding. Tool-bar items with keymaps
8231 as binding are currently ignored.
8233 The following properties are recognized:
8235 - `:enable FORM'.
8237 FORM is evaluated and specifies whether the tool bar item is
8238 enabled or disabled.
8240 - `:visible FORM'
8242 FORM is evaluated and specifies whether the tool bar item is visible.
8244 - `:filter FUNCTION'
8246 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
8247 result is stored as the new binding.
8249 - `:button (TYPE SELECTED)'
8251 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
8252 and specifies whether the button is selected (pressed) or not.
8254 - `:image IMAGES'
8256 IMAGES is either a single image specification or a vector of four
8257 image specifications. See enum tool_bar_item_images.
8259 - `:help HELP-STRING'.
8261 Gives a help string to display for the tool bar item.
8263 - `:label LABEL-STRING'.
8265 A text label to show with the tool bar button if labels are enabled. */
8267 static bool
8268 parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
8270 Lisp_Object filter = Qnil;
8271 Lisp_Object caption;
8272 int i;
8273 bool have_label = 0;
8275 /* Definition looks like `(menu-item CAPTION BINDING PROPS...)'.
8276 Rule out items that aren't lists, don't start with
8277 `menu-item' or whose rest following `tool-bar-item' is not a
8278 list. */
8279 if (!CONSP (item))
8280 return 0;
8282 /* As an exception, allow old-style menu separators. */
8283 if (STRINGP (XCAR (item)))
8284 item = list1 (XCAR (item));
8285 else if (!EQ (XCAR (item), Qmenu_item)
8286 || (item = XCDR (item), !CONSP (item)))
8287 return 0;
8289 /* Create tool_bar_item_properties vector if necessary. Reset it to
8290 defaults. */
8291 if (VECTORP (tool_bar_item_properties))
8293 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
8294 set_prop (i, Qnil);
8296 else
8297 tool_bar_item_properties
8298 = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
8300 /* Set defaults. */
8301 set_prop (TOOL_BAR_ITEM_KEY, key);
8302 set_prop (TOOL_BAR_ITEM_ENABLED_P, Qt);
8304 /* Get the caption of the item. If the caption is not a string,
8305 evaluate it to get a string. If we don't get a string, skip this
8306 item. */
8307 caption = XCAR (item);
8308 if (!STRINGP (caption))
8310 caption = menu_item_eval_property (caption);
8311 if (!STRINGP (caption))
8312 return 0;
8314 set_prop (TOOL_BAR_ITEM_CAPTION, caption);
8316 /* If the rest following the caption is not a list, the menu item is
8317 either a separator, or invalid. */
8318 item = XCDR (item);
8319 if (!CONSP (item))
8321 if (menu_separator_name_p (SSDATA (caption)))
8323 set_prop (TOOL_BAR_ITEM_TYPE, Qt);
8324 #if !defined (USE_GTK) && !defined (HAVE_NS)
8325 /* If we use build_desired_tool_bar_string to render the
8326 tool bar, the separator is rendered as an image. */
8327 set_prop (TOOL_BAR_ITEM_IMAGES,
8328 (menu_item_eval_property
8329 (Vtool_bar_separator_image_expression)));
8330 set_prop (TOOL_BAR_ITEM_ENABLED_P, Qnil);
8331 set_prop (TOOL_BAR_ITEM_SELECTED_P, Qnil);
8332 set_prop (TOOL_BAR_ITEM_CAPTION, Qnil);
8333 #endif
8334 return 1;
8336 return 0;
8339 /* Store the binding. */
8340 set_prop (TOOL_BAR_ITEM_BINDING, XCAR (item));
8341 item = XCDR (item);
8343 /* Ignore cached key binding, if any. */
8344 if (CONSP (item) && CONSP (XCAR (item)))
8345 item = XCDR (item);
8347 /* Process the rest of the properties. */
8348 for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
8350 Lisp_Object ikey, value;
8352 ikey = XCAR (item);
8353 value = XCAR (XCDR (item));
8355 if (EQ (ikey, QCenable))
8357 /* `:enable FORM'. */
8358 if (!NILP (Venable_disabled_menus_and_buttons))
8359 set_prop (TOOL_BAR_ITEM_ENABLED_P, Qt);
8360 else
8361 set_prop (TOOL_BAR_ITEM_ENABLED_P, value);
8363 else if (EQ (ikey, QCvisible))
8365 /* `:visible FORM'. If got a visible property and that
8366 evaluates to nil then ignore this item. */
8367 if (NILP (menu_item_eval_property (value)))
8368 return 0;
8370 else if (EQ (ikey, QChelp))
8371 /* `:help HELP-STRING'. */
8372 set_prop (TOOL_BAR_ITEM_HELP, value);
8373 else if (EQ (ikey, QCvert_only))
8374 /* `:vert-only t/nil'. */
8375 set_prop (TOOL_BAR_ITEM_VERT_ONLY, value);
8376 else if (EQ (ikey, QClabel))
8378 const char *bad_label = "!!?GARBLED ITEM?!!";
8379 /* `:label LABEL-STRING'. */
8380 set_prop (TOOL_BAR_ITEM_LABEL,
8381 STRINGP (value) ? value : build_string (bad_label));
8382 have_label = 1;
8384 else if (EQ (ikey, QCfilter))
8385 /* ':filter FORM'. */
8386 filter = value;
8387 else if (EQ (ikey, QCbutton) && CONSP (value))
8389 /* `:button (TYPE . SELECTED)'. */
8390 Lisp_Object type, selected;
8392 type = XCAR (value);
8393 selected = XCDR (value);
8394 if (EQ (type, QCtoggle) || EQ (type, QCradio))
8396 set_prop (TOOL_BAR_ITEM_SELECTED_P, selected);
8397 set_prop (TOOL_BAR_ITEM_TYPE, type);
8400 else if (EQ (ikey, QCimage)
8401 && (CONSP (value)
8402 || (VECTORP (value) && ASIZE (value) == 4)))
8403 /* Value is either a single image specification or a vector
8404 of 4 such specifications for the different button states. */
8405 set_prop (TOOL_BAR_ITEM_IMAGES, value);
8406 else if (EQ (ikey, QCrtl))
8407 /* ':rtl STRING' */
8408 set_prop (TOOL_BAR_ITEM_RTL_IMAGE, value);
8412 if (!have_label)
8414 /* Try to make one from caption and key. */
8415 Lisp_Object tkey = PROP (TOOL_BAR_ITEM_KEY);
8416 Lisp_Object tcapt = PROP (TOOL_BAR_ITEM_CAPTION);
8417 const char *label = SYMBOLP (tkey) ? SSDATA (SYMBOL_NAME (tkey)) : "";
8418 const char *capt = STRINGP (tcapt) ? SSDATA (tcapt) : "";
8419 ptrdiff_t max_lbl =
8420 2 * max (0, min (tool_bar_max_label_size, STRING_BYTES_BOUND / 2));
8421 char *buf = xmalloc (max_lbl + 1);
8422 Lisp_Object new_lbl;
8423 ptrdiff_t caption_len = strlen (capt);
8425 if (caption_len <= max_lbl && capt[0] != '\0')
8427 strcpy (buf, capt);
8428 while (caption_len > 0 && buf[caption_len - 1] == '.')
8429 caption_len--;
8430 buf[caption_len] = '\0';
8431 label = capt = buf;
8434 if (strlen (label) <= max_lbl && label[0] != '\0')
8436 ptrdiff_t j;
8437 if (label != buf)
8438 strcpy (buf, label);
8440 for (j = 0; buf[j] != '\0'; ++j)
8441 if (buf[j] == '-')
8442 buf[j] = ' ';
8443 label = buf;
8445 else
8446 label = "";
8448 new_lbl = Fupcase_initials (build_string (label));
8449 if (SCHARS (new_lbl) <= tool_bar_max_label_size)
8450 set_prop (TOOL_BAR_ITEM_LABEL, new_lbl);
8451 else
8452 set_prop (TOOL_BAR_ITEM_LABEL, empty_unibyte_string);
8453 xfree (buf);
8456 /* If got a filter apply it on binding. */
8457 if (!NILP (filter))
8458 set_prop (TOOL_BAR_ITEM_BINDING,
8459 (menu_item_eval_property
8460 (list2 (filter,
8461 list2 (Qquote,
8462 PROP (TOOL_BAR_ITEM_BINDING))))));
8464 /* See if the binding is a keymap. Give up if it is. */
8465 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
8466 return 0;
8468 /* Enable or disable selection of item. */
8469 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
8470 set_prop (TOOL_BAR_ITEM_ENABLED_P,
8471 menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P)));
8473 /* Handle radio buttons or toggle boxes. */
8474 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
8475 set_prop (TOOL_BAR_ITEM_SELECTED_P,
8476 menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P)));
8478 return 1;
8480 #undef PROP
8484 /* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
8485 that can be reused. */
8487 static void
8488 init_tool_bar_items (Lisp_Object reuse)
8490 if (VECTORP (reuse))
8491 tool_bar_items_vector = reuse;
8492 else
8493 tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
8494 ntool_bar_items = 0;
8498 /* Append parsed tool bar item properties from
8499 tool_bar_item_properties */
8501 static void
8502 append_tool_bar_item (void)
8504 ptrdiff_t incr
8505 = (ntool_bar_items
8506 - (ASIZE (tool_bar_items_vector) - TOOL_BAR_ITEM_NSLOTS));
8508 /* Enlarge tool_bar_items_vector if necessary. */
8509 if (incr > 0)
8510 tool_bar_items_vector = larger_vector (tool_bar_items_vector, incr, -1);
8512 /* Append entries from tool_bar_item_properties to the end of
8513 tool_bar_items_vector. */
8514 vcopy (tool_bar_items_vector, ntool_bar_items,
8515 XVECTOR (tool_bar_item_properties)->contents, TOOL_BAR_ITEM_NSLOTS);
8516 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
8523 /* Read a character using menus based on the keymap MAP.
8524 Return nil if there are no menus in the maps.
8525 Return t if we displayed a menu but the user rejected it.
8527 PREV_EVENT is the previous input event, or nil if we are reading
8528 the first event of a key sequence.
8530 If USED_MOUSE_MENU is non-null, set *USED_MOUSE_MENU to true
8531 if we used a mouse menu to read the input, or false otherwise. If
8532 USED_MOUSE_MENU is null, don't dereference it.
8534 The prompting is done based on the prompt-string of the map
8535 and the strings associated with various map elements.
8537 This can be done with X menus or with menus put in the minibuf.
8538 These are done in different ways, depending on how the input will be read.
8539 Menus using X are done after auto-saving in read-char, getting the input
8540 event from Fx_popup_menu; menus using the minibuf use read_char recursively
8541 and do auto-saving in the inner call of read_char. */
8543 static Lisp_Object
8544 read_char_x_menu_prompt (Lisp_Object map,
8545 Lisp_Object prev_event, bool *used_mouse_menu)
8547 if (used_mouse_menu)
8548 *used_mouse_menu = 0;
8550 /* Use local over global Menu maps. */
8552 if (! menu_prompting)
8553 return Qnil;
8555 /* If we got to this point via a mouse click,
8556 use a real menu for mouse selection. */
8557 if (EVENT_HAS_PARAMETERS (prev_event)
8558 && !EQ (XCAR (prev_event), Qmenu_bar)
8559 && !EQ (XCAR (prev_event), Qtool_bar))
8561 /* Display the menu and get the selection. */
8562 Lisp_Object value;
8564 value = Fx_popup_menu (prev_event, get_keymap (map, 0, 1));
8565 if (CONSP (value))
8567 Lisp_Object tem;
8569 record_menu_key (XCAR (value));
8571 /* If we got multiple events, unread all but
8572 the first.
8573 There is no way to prevent those unread events
8574 from showing up later in last_nonmenu_event.
8575 So turn symbol and integer events into lists,
8576 to indicate that they came from a mouse menu,
8577 so that when present in last_nonmenu_event
8578 they won't confuse things. */
8579 for (tem = XCDR (value); CONSP (tem); tem = XCDR (tem))
8581 record_menu_key (XCAR (tem));
8582 if (SYMBOLP (XCAR (tem))
8583 || INTEGERP (XCAR (tem)))
8584 XSETCAR (tem, Fcons (XCAR (tem), Qdisabled));
8587 /* If we got more than one event, put all but the first
8588 onto this list to be read later.
8589 Return just the first event now. */
8590 Vunread_command_events
8591 = nconc2 (XCDR (value), Vunread_command_events);
8592 value = XCAR (value);
8594 else if (NILP (value))
8595 value = Qt;
8596 if (used_mouse_menu)
8597 *used_mouse_menu = 1;
8598 return value;
8600 return Qnil ;
8603 static Lisp_Object
8604 read_char_minibuf_menu_prompt (int commandflag,
8605 Lisp_Object map)
8607 Lisp_Object name;
8608 ptrdiff_t nlength;
8609 /* FIXME: Use the minibuffer's frame width. */
8610 ptrdiff_t width = FRAME_COLS (SELECTED_FRAME ()) - 4;
8611 ptrdiff_t idx = -1;
8612 bool nobindings = 1;
8613 Lisp_Object rest, vector;
8614 Lisp_Object prompt_strings = Qnil;
8616 vector = Qnil;
8618 if (! menu_prompting)
8619 return Qnil;
8621 map = get_keymap (map, 0, 1);
8622 name = Fkeymap_prompt (map);
8624 /* If we don't have any menus, just read a character normally. */
8625 if (!STRINGP (name))
8626 return Qnil;
8628 #define PUSH_C_STR(str, listvar) \
8629 listvar = Fcons (build_unibyte_string (str), listvar)
8631 /* Prompt string always starts with map's prompt, and a space. */
8632 prompt_strings = Fcons (name, prompt_strings);
8633 PUSH_C_STR (": ", prompt_strings);
8634 nlength = SCHARS (name) + 2;
8636 rest = map;
8638 /* Present the documented bindings, a line at a time. */
8639 while (1)
8641 bool notfirst = 0;
8642 Lisp_Object menu_strings = prompt_strings;
8643 ptrdiff_t i = nlength;
8644 Lisp_Object obj;
8645 Lisp_Object orig_defn_macro;
8647 /* Loop over elements of map. */
8648 while (i < width)
8650 Lisp_Object elt;
8652 /* FIXME: Use map_keymap to handle new keymap formats. */
8654 /* At end of map, wrap around if just starting,
8655 or end this line if already have something on it. */
8656 if (NILP (rest))
8658 if (notfirst || nobindings)
8659 break;
8660 else
8661 rest = map;
8664 /* Look at the next element of the map. */
8665 if (idx >= 0)
8666 elt = AREF (vector, idx);
8667 else
8668 elt = Fcar_safe (rest);
8670 if (idx < 0 && VECTORP (elt))
8672 /* If we found a dense table in the keymap,
8673 advanced past it, but start scanning its contents. */
8674 rest = Fcdr_safe (rest);
8675 vector = elt;
8676 idx = 0;
8678 else
8680 /* An ordinary element. */
8681 Lisp_Object event, tem;
8683 if (idx < 0)
8685 event = Fcar_safe (elt); /* alist */
8686 elt = Fcdr_safe (elt);
8688 else
8690 XSETINT (event, idx); /* vector */
8693 /* Ignore the element if it has no prompt string. */
8694 if (INTEGERP (event) && parse_menu_item (elt, -1))
8696 /* True if the char to type matches the string. */
8697 bool char_matches;
8698 Lisp_Object upcased_event, downcased_event;
8699 Lisp_Object desc = Qnil;
8700 Lisp_Object s
8701 = AREF (item_properties, ITEM_PROPERTY_NAME);
8703 upcased_event = Fupcase (event);
8704 downcased_event = Fdowncase (event);
8705 char_matches = (XINT (upcased_event) == SREF (s, 0)
8706 || XINT (downcased_event) == SREF (s, 0));
8707 if (! char_matches)
8708 desc = Fsingle_key_description (event, Qnil);
8710 #if 0 /* It is redundant to list the equivalent key bindings because
8711 the prefix is what the user has already typed. */
8713 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
8714 if (!NILP (tem))
8715 /* Insert equivalent keybinding. */
8716 s = concat2 (s, tem);
8717 #endif
8719 = AREF (item_properties, ITEM_PROPERTY_TYPE);
8720 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
8722 /* Insert button prefix. */
8723 Lisp_Object selected
8724 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
8725 AUTO_STRING (radio_yes, "(*) ");
8726 AUTO_STRING (radio_no , "( ) ");
8727 AUTO_STRING (check_yes, "[X] ");
8728 AUTO_STRING (check_no , "[ ] ");
8729 if (EQ (tem, QCradio))
8730 tem = NILP (selected) ? radio_yes : radio_no;
8731 else
8732 tem = NILP (selected) ? check_yes : check_no;
8733 s = concat2 (tem, s);
8737 /* If we have room for the prompt string, add it to this line.
8738 If this is the first on the line, always add it. */
8739 if ((SCHARS (s) + i + 2
8740 + (char_matches ? 0 : SCHARS (desc) + 3))
8741 < width
8742 || !notfirst)
8744 ptrdiff_t thiswidth;
8746 /* Punctuate between strings. */
8747 if (notfirst)
8749 PUSH_C_STR (", ", menu_strings);
8750 i += 2;
8752 notfirst = 1;
8753 nobindings = 0;
8755 /* If the char to type doesn't match the string's
8756 first char, explicitly show what char to type. */
8757 if (! char_matches)
8759 /* Add as much of string as fits. */
8760 thiswidth = min (SCHARS (desc), width - i);
8761 menu_strings
8762 = Fcons (Fsubstring (desc, make_number (0),
8763 make_number (thiswidth)),
8764 menu_strings);
8765 i += thiswidth;
8766 PUSH_C_STR (" = ", menu_strings);
8767 i += 3;
8770 /* Add as much of string as fits. */
8771 thiswidth = min (SCHARS (s), width - i);
8772 menu_strings
8773 = Fcons (Fsubstring (s, make_number (0),
8774 make_number (thiswidth)),
8775 menu_strings);
8776 i += thiswidth;
8778 else
8780 /* If this element does not fit, end the line now,
8781 and save the element for the next line. */
8782 PUSH_C_STR ("...", menu_strings);
8783 break;
8787 /* Move past this element. */
8788 if (idx >= 0 && idx + 1 >= ASIZE (vector))
8789 /* Handle reaching end of dense table. */
8790 idx = -1;
8791 if (idx >= 0)
8792 idx++;
8793 else
8794 rest = Fcdr_safe (rest);
8798 /* Prompt with that and read response. */
8799 message3_nolog (apply1 (intern ("concat"), Fnreverse (menu_strings)));
8801 /* Make believe it's not a keyboard macro in case the help char
8802 is pressed. Help characters are not recorded because menu prompting
8803 is not used on replay. */
8804 orig_defn_macro = KVAR (current_kboard, defining_kbd_macro);
8805 kset_defining_kbd_macro (current_kboard, Qnil);
8807 obj = read_char (commandflag, Qnil, Qt, 0, NULL);
8808 while (BUFFERP (obj));
8809 kset_defining_kbd_macro (current_kboard, orig_defn_macro);
8811 if (!INTEGERP (obj) || XINT (obj) == -2)
8812 return obj;
8814 if (! EQ (obj, menu_prompt_more_char)
8815 && (!INTEGERP (menu_prompt_more_char)
8816 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
8818 if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
8819 store_kbd_macro_char (obj);
8820 return obj;
8822 /* Help char - go round again. */
8826 /* Reading key sequences. */
8828 static Lisp_Object
8829 follow_key (Lisp_Object keymap, Lisp_Object key)
8831 return access_keymap (get_keymap (keymap, 0, 1),
8832 key, 1, 0, 1);
8835 static Lisp_Object
8836 active_maps (Lisp_Object first_event)
8838 Lisp_Object position
8839 = CONSP (first_event) ? CAR_SAFE (XCDR (first_event)) : Qnil;
8840 return Fcons (Qkeymap, Fcurrent_active_maps (Qt, position));
8843 /* Structure used to keep track of partial application of key remapping
8844 such as Vfunction_key_map and Vkey_translation_map. */
8845 typedef struct keyremap
8847 /* This is the map originally specified for this use. */
8848 Lisp_Object parent;
8849 /* This is a submap reached by looking up, in PARENT,
8850 the events from START to END. */
8851 Lisp_Object map;
8852 /* Positions [START, END) in the key sequence buffer
8853 are the key that we have scanned so far.
8854 Those events are the ones that we will replace
8855 if PARENT maps them into a key sequence. */
8856 int start, end;
8857 } keyremap;
8859 /* Lookup KEY in MAP.
8860 MAP is a keymap mapping keys to key vectors or functions.
8861 If the mapping is a function and DO_FUNCALL is true,
8862 the function is called with PROMPT as parameter and its return
8863 value is used as the return value of this function (after checking
8864 that it is indeed a vector). */
8866 static Lisp_Object
8867 access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
8868 bool do_funcall)
8870 Lisp_Object next;
8872 next = access_keymap (map, key, 1, 0, 1);
8874 /* Handle a symbol whose function definition is a keymap
8875 or an array. */
8876 if (SYMBOLP (next) && !NILP (Ffboundp (next))
8877 && (ARRAYP (XSYMBOL (next)->function)
8878 || KEYMAPP (XSYMBOL (next)->function)))
8879 next = Fautoload_do_load (XSYMBOL (next)->function, next, Qnil);
8881 /* If the keymap gives a function, not an
8882 array, then call the function with one arg and use
8883 its value instead. */
8884 if (do_funcall && FUNCTIONP (next))
8886 Lisp_Object tem;
8887 tem = next;
8889 next = call1 (next, prompt);
8890 /* If the function returned something invalid,
8891 barf--don't ignore it.
8892 (To ignore it safely, we would need to gcpro a bunch of
8893 other variables.) */
8894 if (! (NILP (next) || VECTORP (next) || STRINGP (next)))
8895 error ("Function %s returns invalid key sequence",
8896 SSDATA (SYMBOL_NAME (tem)));
8898 return next;
8901 /* Do one step of the key remapping used for function-key-map and
8902 key-translation-map:
8903 KEYBUF is the buffer holding the input events.
8904 BUFSIZE is its maximum size.
8905 FKEY is a pointer to the keyremap structure to use.
8906 INPUT is the index of the last element in KEYBUF.
8907 DOIT if true says that the remapping can actually take place.
8908 DIFF is used to return the number of keys added/removed by the remapping.
8909 PARENT is the root of the keymap.
8910 PROMPT is the prompt to use if the remapping happens through a function.
8911 Return true if the remapping actually took place. */
8913 static bool
8914 keyremap_step (Lisp_Object *keybuf, int bufsize, volatile keyremap *fkey,
8915 int input, bool doit, int *diff, Lisp_Object prompt)
8917 Lisp_Object next, key;
8919 key = keybuf[fkey->end++];
8921 if (KEYMAPP (fkey->parent))
8922 next = access_keymap_keyremap (fkey->map, key, prompt, doit);
8923 else
8924 next = Qnil;
8926 /* If keybuf[fkey->start..fkey->end] is bound in the
8927 map and we're in a position to do the key remapping, replace it with
8928 the binding and restart with fkey->start at the end. */
8929 if ((VECTORP (next) || STRINGP (next)) && doit)
8931 int len = XFASTINT (Flength (next));
8932 int i;
8934 *diff = len - (fkey->end - fkey->start);
8936 if (bufsize - input <= *diff)
8937 error ("Key sequence too long");
8939 /* Shift the keys that follow fkey->end. */
8940 if (*diff < 0)
8941 for (i = fkey->end; i < input; i++)
8942 keybuf[i + *diff] = keybuf[i];
8943 else if (*diff > 0)
8944 for (i = input - 1; i >= fkey->end; i--)
8945 keybuf[i + *diff] = keybuf[i];
8946 /* Overwrite the old keys with the new ones. */
8947 for (i = 0; i < len; i++)
8948 keybuf[fkey->start + i]
8949 = Faref (next, make_number (i));
8951 fkey->start = fkey->end += *diff;
8952 fkey->map = fkey->parent;
8954 return 1;
8957 fkey->map = get_keymap (next, 0, 1);
8959 /* If we no longer have a bound suffix, try a new position for
8960 fkey->start. */
8961 if (!CONSP (fkey->map))
8963 fkey->end = ++fkey->start;
8964 fkey->map = fkey->parent;
8966 return 0;
8969 static bool
8970 test_undefined (Lisp_Object binding)
8972 return (NILP (binding)
8973 || EQ (binding, Qundefined)
8974 || (SYMBOLP (binding)
8975 && EQ (Fcommand_remapping (binding, Qnil, Qnil), Qundefined)));
8978 /* Read a sequence of keys that ends with a non prefix character,
8979 storing it in KEYBUF, a buffer of size BUFSIZE.
8980 Prompt with PROMPT.
8981 Return the length of the key sequence stored.
8982 Return -1 if the user rejected a command menu.
8984 Echo starting immediately unless `prompt' is 0.
8986 If PREVENT_REDISPLAY is non-zero, avoid redisplay by calling
8987 read_char with a suitable COMMANDFLAG argument.
8989 Where a key sequence ends depends on the currently active keymaps.
8990 These include any minor mode keymaps active in the current buffer,
8991 the current buffer's local map, and the global map.
8993 If a key sequence has no other bindings, we check Vfunction_key_map
8994 to see if some trailing subsequence might be the beginning of a
8995 function key's sequence. If so, we try to read the whole function
8996 key, and substitute its symbolic name into the key sequence.
8998 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
8999 `double-' events into similar click events, if that would make them
9000 bound. We try to turn `triple-' events first into `double-' events,
9001 then into clicks.
9003 If we get a mouse click in a mode line, vertical divider, or other
9004 non-text area, we treat the click as if it were prefixed by the
9005 symbol denoting that area - `mode-line', `vertical-line', or
9006 whatever.
9008 If the sequence starts with a mouse click, we read the key sequence
9009 with respect to the buffer clicked on, not the current buffer.
9011 If the user switches frames in the midst of a key sequence, we put
9012 off the switch-frame event until later; the next call to
9013 read_char will return it.
9015 If FIX_CURRENT_BUFFER, we restore current_buffer
9016 from the selected window's buffer. */
9018 static int
9019 read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
9020 bool dont_downcase_last, bool can_return_switch_frame,
9021 bool fix_current_buffer, bool prevent_redisplay)
9023 ptrdiff_t count = SPECPDL_INDEX ();
9025 /* How many keys there are in the current key sequence. */
9026 int t;
9028 /* The length of the echo buffer when we started reading, and
9029 the length of this_command_keys when we started reading. */
9030 ptrdiff_t echo_start IF_LINT (= 0);
9031 ptrdiff_t keys_start;
9033 Lisp_Object current_binding = Qnil;
9034 Lisp_Object first_event = Qnil;
9036 /* Index of the first key that has no binding.
9037 It is useless to try fkey.start larger than that. */
9038 int first_unbound;
9040 /* If t < mock_input, then KEYBUF[t] should be read as the next
9041 input key.
9043 We use this to recover after recognizing a function key. Once we
9044 realize that a suffix of the current key sequence is actually a
9045 function key's escape sequence, we replace the suffix with the
9046 function key's binding from Vfunction_key_map. Now keybuf
9047 contains a new and different key sequence, so the echo area,
9048 this_command_keys, and the submaps and defs arrays are wrong. In
9049 this situation, we set mock_input to t, set t to 0, and jump to
9050 restart_sequence; the loop will read keys from keybuf up until
9051 mock_input, thus rebuilding the state; and then it will resume
9052 reading characters from the keyboard. */
9053 int mock_input = 0;
9055 /* If the sequence is unbound in submaps[], then
9056 keybuf[fkey.start..fkey.end-1] is a prefix in Vfunction_key_map,
9057 and fkey.map is its binding.
9059 These might be > t, indicating that all function key scanning
9060 should hold off until t reaches them. We do this when we've just
9061 recognized a function key, to avoid searching for the function
9062 key's again in Vfunction_key_map. */
9063 keyremap fkey;
9065 /* Likewise, for key_translation_map and input-decode-map. */
9066 keyremap keytran, indec;
9068 /* True if we are trying to map a key by changing an upper-case
9069 letter to lower case, or a shifted function key to an unshifted
9070 one. */
9071 bool shift_translated = 0;
9073 /* If we receive a `switch-frame' or `select-window' event in the middle of
9074 a key sequence, we put it off for later.
9075 While we're reading, we keep the event here. */
9076 Lisp_Object delayed_switch_frame;
9078 Lisp_Object original_uppercase IF_LINT (= Qnil);
9079 int original_uppercase_position = -1;
9081 /* Gets around Microsoft compiler limitations. */
9082 bool dummyflag = 0;
9084 struct buffer *starting_buffer;
9086 /* List of events for which a fake prefix key has been generated. */
9087 Lisp_Object fake_prefixed_keys = Qnil;
9089 struct gcpro gcpro1;
9091 GCPRO1 (fake_prefixed_keys);
9092 raw_keybuf_count = 0;
9094 last_nonmenu_event = Qnil;
9096 delayed_switch_frame = Qnil;
9098 if (INTERACTIVE)
9100 if (!NILP (prompt))
9102 /* Install the string PROMPT as the beginning of the string
9103 of echoing, so that it serves as a prompt for the next
9104 character. */
9105 kset_echo_string (current_kboard, prompt);
9106 current_kboard->echo_after_prompt = SCHARS (prompt);
9107 echo_now ();
9109 else if (cursor_in_echo_area
9110 && echo_keystrokes_p ())
9111 /* This doesn't put in a dash if the echo buffer is empty, so
9112 you don't always see a dash hanging out in the minibuffer. */
9113 echo_dash ();
9116 /* Record the initial state of the echo area and this_command_keys;
9117 we will need to restore them if we replay a key sequence. */
9118 if (INTERACTIVE)
9119 echo_start = echo_length ();
9120 keys_start = this_command_key_count;
9121 this_single_command_key_start = keys_start;
9123 /* We jump here when we need to reinitialize fkey and keytran; this
9124 happens if we switch keyboards between rescans. */
9125 replay_entire_sequence:
9127 indec.map = indec.parent = KVAR (current_kboard, Vinput_decode_map);
9128 fkey.map = fkey.parent = KVAR (current_kboard, Vlocal_function_key_map);
9129 keytran.map = keytran.parent = Vkey_translation_map;
9130 indec.start = indec.end = 0;
9131 fkey.start = fkey.end = 0;
9132 keytran.start = keytran.end = 0;
9134 /* We jump here when the key sequence has been thoroughly changed, and
9135 we need to rescan it starting from the beginning. When we jump here,
9136 keybuf[0..mock_input] holds the sequence we should reread. */
9137 replay_sequence:
9139 starting_buffer = current_buffer;
9140 first_unbound = bufsize + 1;
9142 /* Build our list of keymaps.
9143 If we recognize a function key and replace its escape sequence in
9144 keybuf with its symbol, or if the sequence starts with a mouse
9145 click and we need to switch buffers, we jump back here to rebuild
9146 the initial keymaps from the current buffer. */
9147 current_binding = active_maps (first_event);
9149 /* Start from the beginning in keybuf. */
9150 t = 0;
9152 /* These are no-ops the first time through, but if we restart, they
9153 revert the echo area and this_command_keys to their original state. */
9154 this_command_key_count = keys_start;
9155 if (INTERACTIVE && t < mock_input)
9156 echo_truncate (echo_start);
9158 /* If the best binding for the current key sequence is a keymap, or
9159 we may be looking at a function key's escape sequence, keep on
9160 reading. */
9161 while (!NILP (current_binding)
9162 /* Keep reading as long as there's a prefix binding. */
9163 ? KEYMAPP (current_binding)
9164 /* Don't return in the middle of a possible function key sequence,
9165 if the only bindings we found were via case conversion.
9166 Thus, if ESC O a has a function-key-map translation
9167 and ESC o has a binding, don't return after ESC O,
9168 so that we can translate ESC O plus the next character. */
9169 : (/* indec.start < t || fkey.start < t || */ keytran.start < t))
9171 Lisp_Object key;
9172 bool used_mouse_menu = 0;
9174 /* Where the last real key started. If we need to throw away a
9175 key that has expanded into more than one element of keybuf
9176 (say, a mouse click on the mode line which is being treated
9177 as [mode-line (mouse-...)], then we backtrack to this point
9178 of keybuf. */
9179 int last_real_key_start;
9181 /* These variables are analogous to echo_start and keys_start;
9182 while those allow us to restart the entire key sequence,
9183 echo_local_start and keys_local_start allow us to throw away
9184 just one key. */
9185 ptrdiff_t echo_local_start IF_LINT (= 0);
9186 int keys_local_start;
9187 Lisp_Object new_binding;
9189 eassert (indec.end == t || (indec.end > t && indec.end <= mock_input));
9190 eassert (indec.start <= indec.end);
9191 eassert (fkey.start <= fkey.end);
9192 eassert (keytran.start <= keytran.end);
9193 /* key-translation-map is applied *after* function-key-map
9194 which is itself applied *after* input-decode-map. */
9195 eassert (fkey.end <= indec.start);
9196 eassert (keytran.end <= fkey.start);
9198 if (/* first_unbound < indec.start && first_unbound < fkey.start && */
9199 first_unbound < keytran.start)
9200 { /* The prefix upto first_unbound has no binding and has
9201 no translation left to do either, so we know it's unbound.
9202 If we don't stop now, we risk staying here indefinitely
9203 (if the user keeps entering fkey or keytran prefixes
9204 like C-c ESC ESC ESC ESC ...) */
9205 int i;
9206 for (i = first_unbound + 1; i < t; i++)
9207 keybuf[i - first_unbound - 1] = keybuf[i];
9208 mock_input = t - first_unbound - 1;
9209 indec.end = indec.start -= first_unbound + 1;
9210 indec.map = indec.parent;
9211 fkey.end = fkey.start -= first_unbound + 1;
9212 fkey.map = fkey.parent;
9213 keytran.end = keytran.start -= first_unbound + 1;
9214 keytran.map = keytran.parent;
9215 goto replay_sequence;
9218 if (t >= bufsize)
9219 error ("Key sequence too long");
9221 if (INTERACTIVE)
9222 echo_local_start = echo_length ();
9223 keys_local_start = this_command_key_count;
9225 replay_key:
9226 /* These are no-ops, unless we throw away a keystroke below and
9227 jumped back up to replay_key; in that case, these restore the
9228 variables to their original state, allowing us to replay the
9229 loop. */
9230 if (INTERACTIVE && t < mock_input)
9231 echo_truncate (echo_local_start);
9232 this_command_key_count = keys_local_start;
9234 /* By default, assume each event is "real". */
9235 last_real_key_start = t;
9237 /* Does mock_input indicate that we are re-reading a key sequence? */
9238 if (t < mock_input)
9240 key = keybuf[t];
9241 add_command_key (key);
9242 if (echo_keystrokes_p ()
9243 && current_kboard->immediate_echo)
9245 echo_add_key (key);
9246 echo_dash ();
9250 /* If not, we should actually read a character. */
9251 else
9254 KBOARD *interrupted_kboard = current_kboard;
9255 struct frame *interrupted_frame = SELECTED_FRAME ();
9256 /* Calling read_char with COMMANDFLAG = -2 avoids
9257 redisplay in read_char and its subroutines. */
9258 key = read_char (prevent_redisplay ? -2 : NILP (prompt),
9259 current_binding, last_nonmenu_event,
9260 &used_mouse_menu, NULL);
9261 if ((INTEGERP (key) && XINT (key) == -2) /* wrong_kboard_jmpbuf */
9262 /* When switching to a new tty (with a new keyboard),
9263 read_char returns the new buffer, rather than -2
9264 (Bug#5095). This is because `terminal-init-xterm'
9265 calls read-char, which eats the wrong_kboard_jmpbuf
9266 return. Any better way to fix this? -- cyd */
9267 || (interrupted_kboard != current_kboard))
9269 bool found = 0;
9270 struct kboard *k;
9272 for (k = all_kboards; k; k = k->next_kboard)
9273 if (k == interrupted_kboard)
9274 found = 1;
9276 if (!found)
9278 /* Don't touch interrupted_kboard when it's been
9279 deleted. */
9280 delayed_switch_frame = Qnil;
9281 goto replay_entire_sequence;
9284 if (!NILP (delayed_switch_frame))
9286 kset_kbd_queue
9287 (interrupted_kboard,
9288 Fcons (delayed_switch_frame,
9289 KVAR (interrupted_kboard, kbd_queue)));
9290 delayed_switch_frame = Qnil;
9293 while (t > 0)
9294 kset_kbd_queue
9295 (interrupted_kboard,
9296 Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue)));
9298 /* If the side queue is non-empty, ensure it begins with a
9299 switch-frame, so we'll replay it in the right context. */
9300 if (CONSP (KVAR (interrupted_kboard, kbd_queue))
9301 && (key = XCAR (KVAR (interrupted_kboard, kbd_queue)),
9302 !(EVENT_HAS_PARAMETERS (key)
9303 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
9304 Qswitch_frame))))
9306 Lisp_Object frame;
9307 XSETFRAME (frame, interrupted_frame);
9308 kset_kbd_queue
9309 (interrupted_kboard,
9310 Fcons (make_lispy_switch_frame (frame),
9311 KVAR (interrupted_kboard, kbd_queue)));
9313 mock_input = 0;
9314 goto replay_entire_sequence;
9318 /* read_char returns t when it shows a menu and the user rejects it.
9319 Just return -1. */
9320 if (EQ (key, Qt))
9322 unbind_to (count, Qnil);
9323 UNGCPRO;
9324 return -1;
9327 /* read_char returns -1 at the end of a macro.
9328 Emacs 18 handles this by returning immediately with a
9329 zero, so that's what we'll do. */
9330 if (INTEGERP (key) && XINT (key) == -1)
9332 t = 0;
9333 /* The Microsoft C compiler can't handle the goto that
9334 would go here. */
9335 dummyflag = 1;
9336 break;
9339 /* If the current buffer has been changed from under us, the
9340 keymap may have changed, so replay the sequence. */
9341 if (BUFFERP (key))
9343 timer_resume_idle ();
9345 mock_input = t;
9346 /* Reset the current buffer from the selected window
9347 in case something changed the former and not the latter.
9348 This is to be more consistent with the behavior
9349 of the command_loop_1. */
9350 if (fix_current_buffer)
9352 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
9353 Fkill_emacs (Qnil);
9354 if (XBUFFER (XWINDOW (selected_window)->contents)
9355 != current_buffer)
9356 Fset_buffer (XWINDOW (selected_window)->contents);
9359 goto replay_sequence;
9362 /* If we have a quit that was typed in another frame, and
9363 quit_throw_to_read_char switched buffers,
9364 replay to get the right keymap. */
9365 if (INTEGERP (key)
9366 && XINT (key) == quit_char
9367 && current_buffer != starting_buffer)
9369 GROW_RAW_KEYBUF;
9370 ASET (raw_keybuf, raw_keybuf_count, key);
9371 raw_keybuf_count++;
9372 keybuf[t++] = key;
9373 mock_input = t;
9374 Vquit_flag = Qnil;
9375 goto replay_sequence;
9378 Vquit_flag = Qnil;
9380 if (EVENT_HAS_PARAMETERS (key)
9381 /* Either a `switch-frame' or a `select-window' event. */
9382 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
9384 /* If we're at the beginning of a key sequence, and the caller
9385 says it's okay, go ahead and return this event. If we're
9386 in the midst of a key sequence, delay it until the end. */
9387 if (t > 0 || !can_return_switch_frame)
9389 delayed_switch_frame = key;
9390 goto replay_key;
9394 if (NILP (first_event))
9396 first_event = key;
9397 /* Even if first_event does not specify a particular
9398 window/position, it's important to recompute the maps here
9399 since a long time might have passed since we entered
9400 read_key_sequence, and a timer (or process-filter or
9401 special-event-map, ...) might have switched the current buffer
9402 or the selected window from under us in the mean time. */
9403 if (fix_current_buffer
9404 && (XBUFFER (XWINDOW (selected_window)->contents)
9405 != current_buffer))
9406 Fset_buffer (XWINDOW (selected_window)->contents);
9407 current_binding = active_maps (first_event);
9410 GROW_RAW_KEYBUF;
9411 ASET (raw_keybuf, raw_keybuf_count, key);
9412 raw_keybuf_count++;
9415 /* Clicks in non-text areas get prefixed by the symbol
9416 in their CHAR-ADDRESS field. For example, a click on
9417 the mode line is prefixed by the symbol `mode-line'.
9419 Furthermore, key sequences beginning with mouse clicks
9420 are read using the keymaps of the buffer clicked on, not
9421 the current buffer. So we may have to switch the buffer
9422 here.
9424 When we turn one event into two events, we must make sure
9425 that neither of the two looks like the original--so that,
9426 if we replay the events, they won't be expanded again.
9427 If not for this, such reexpansion could happen either here
9428 or when user programs play with this-command-keys. */
9429 if (EVENT_HAS_PARAMETERS (key))
9431 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
9432 if (EQ (kind, Qmouse_click))
9434 Lisp_Object window = POSN_WINDOW (EVENT_START (key));
9435 Lisp_Object posn = POSN_POSN (EVENT_START (key));
9437 if (CONSP (posn)
9438 || (!NILP (fake_prefixed_keys)
9439 && !NILP (Fmemq (key, fake_prefixed_keys))))
9441 /* We're looking a second time at an event for which
9442 we generated a fake prefix key. Set
9443 last_real_key_start appropriately. */
9444 if (t > 0)
9445 last_real_key_start = t - 1;
9448 if (last_real_key_start == 0)
9450 /* Key sequences beginning with mouse clicks are
9451 read using the keymaps in the buffer clicked on,
9452 not the current buffer. If we're at the
9453 beginning of a key sequence, switch buffers. */
9454 if (WINDOWP (window)
9455 && BUFFERP (XWINDOW (window)->contents)
9456 && XBUFFER (XWINDOW (window)->contents) != current_buffer)
9458 ASET (raw_keybuf, raw_keybuf_count, key);
9459 raw_keybuf_count++;
9460 keybuf[t] = key;
9461 mock_input = t + 1;
9463 /* Arrange to go back to the original buffer once we're
9464 done reading the key sequence. Note that we can't
9465 use save_excursion_{save,restore} here, because they
9466 save point as well as the current buffer; we don't
9467 want to save point, because redisplay may change it,
9468 to accommodate a Fset_window_start or something. We
9469 don't want to do this at the top of the function,
9470 because we may get input from a subprocess which
9471 wants to change the selected window and stuff (say,
9472 emacsclient). */
9473 record_unwind_current_buffer ();
9475 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
9476 Fkill_emacs (Qnil);
9477 set_buffer_internal (XBUFFER (XWINDOW (window)->contents));
9478 goto replay_sequence;
9482 /* Expand mode-line and scroll-bar events into two events:
9483 use posn as a fake prefix key. */
9484 if (SYMBOLP (posn)
9485 && (NILP (fake_prefixed_keys)
9486 || NILP (Fmemq (key, fake_prefixed_keys))))
9488 if (bufsize - t <= 1)
9489 error ("Key sequence too long");
9491 keybuf[t] = posn;
9492 keybuf[t + 1] = key;
9493 mock_input = t + 2;
9495 /* Record that a fake prefix key has been generated
9496 for KEY. Don't modify the event; this would
9497 prevent proper action when the event is pushed
9498 back into unread-command-events. */
9499 fake_prefixed_keys = Fcons (key, fake_prefixed_keys);
9500 goto replay_key;
9503 else if (CONSP (XCDR (key))
9504 && CONSP (EVENT_START (key))
9505 && CONSP (XCDR (EVENT_START (key))))
9507 Lisp_Object posn;
9509 posn = POSN_POSN (EVENT_START (key));
9510 /* Handle menu-bar events:
9511 insert the dummy prefix event `menu-bar'. */
9512 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
9514 if (bufsize - t <= 1)
9515 error ("Key sequence too long");
9516 keybuf[t] = posn;
9517 keybuf[t + 1] = key;
9519 /* Zap the position in key, so we know that we've
9520 expanded it, and don't try to do so again. */
9521 POSN_SET_POSN (EVENT_START (key), list1 (posn));
9523 mock_input = t + 2;
9524 goto replay_sequence;
9526 else if (CONSP (posn))
9528 /* We're looking at the second event of a
9529 sequence which we expanded before. Set
9530 last_real_key_start appropriately. */
9531 if (last_real_key_start == t && t > 0)
9532 last_real_key_start = t - 1;
9537 /* We have finally decided that KEY is something we might want
9538 to look up. */
9539 new_binding = follow_key (current_binding, key);
9541 /* If KEY wasn't bound, we'll try some fallbacks. */
9542 if (!NILP (new_binding))
9543 /* This is needed for the following scenario:
9544 event 0: a down-event that gets dropped by calling replay_key.
9545 event 1: some normal prefix like C-h.
9546 After event 0, first_unbound is 0, after event 1 indec.start,
9547 fkey.start, and keytran.start are all 1, so when we see that
9548 C-h is bound, we need to update first_unbound. */
9549 first_unbound = max (t + 1, first_unbound);
9550 else
9552 Lisp_Object head;
9554 /* Remember the position to put an upper bound on indec.start. */
9555 first_unbound = min (t, first_unbound);
9557 head = EVENT_HEAD (key);
9559 if (SYMBOLP (head))
9561 Lisp_Object breakdown;
9562 int modifiers;
9564 breakdown = parse_modifiers (head);
9565 modifiers = XINT (XCAR (XCDR (breakdown)));
9566 /* Attempt to reduce an unbound mouse event to a simpler
9567 event that is bound:
9568 Drags reduce to clicks.
9569 Double-clicks reduce to clicks.
9570 Triple-clicks reduce to double-clicks, then to clicks.
9571 Down-clicks are eliminated.
9572 Double-downs reduce to downs, then are eliminated.
9573 Triple-downs reduce to double-downs, then to downs,
9574 then are eliminated. */
9575 if (modifiers & (down_modifier | drag_modifier
9576 | double_modifier | triple_modifier))
9578 while (modifiers & (down_modifier | drag_modifier
9579 | double_modifier | triple_modifier))
9581 Lisp_Object new_head, new_click;
9582 if (modifiers & triple_modifier)
9583 modifiers ^= (double_modifier | triple_modifier);
9584 else if (modifiers & double_modifier)
9585 modifiers &= ~double_modifier;
9586 else if (modifiers & drag_modifier)
9587 modifiers &= ~drag_modifier;
9588 else
9590 /* Dispose of this `down' event by simply jumping
9591 back to replay_key, to get another event.
9593 Note that if this event came from mock input,
9594 then just jumping back to replay_key will just
9595 hand it to us again. So we have to wipe out any
9596 mock input.
9598 We could delete keybuf[t] and shift everything
9599 after that to the left by one spot, but we'd also
9600 have to fix up any variable that points into
9601 keybuf, and shifting isn't really necessary
9602 anyway.
9604 Adding prefixes for non-textual mouse clicks
9605 creates two characters of mock input, and both
9606 must be thrown away. If we're only looking at
9607 the prefix now, we can just jump back to
9608 replay_key. On the other hand, if we've already
9609 processed the prefix, and now the actual click
9610 itself is giving us trouble, then we've lost the
9611 state of the keymaps we want to backtrack to, and
9612 we need to replay the whole sequence to rebuild
9615 Beyond that, only function key expansion could
9616 create more than two keys, but that should never
9617 generate mouse events, so it's okay to zero
9618 mock_input in that case too.
9620 FIXME: The above paragraph seems just plain
9621 wrong, if you consider things like
9622 xterm-mouse-mode. -stef
9624 Isn't this just the most wonderful code ever? */
9626 /* If mock_input > t + 1, the above simplification
9627 will actually end up dropping keys on the floor.
9628 This is probably OK for now, but even
9629 if mock_input <= t + 1, we need to adjust indec,
9630 fkey, and keytran.
9631 Typical case [header-line down-mouse-N]:
9632 mock_input = 2, t = 1, fkey.end = 1,
9633 last_real_key_start = 0. */
9634 if (indec.end > last_real_key_start)
9636 indec.end = indec.start
9637 = min (last_real_key_start, indec.start);
9638 indec.map = indec.parent;
9639 if (fkey.end > last_real_key_start)
9641 fkey.end = fkey.start
9642 = min (last_real_key_start, fkey.start);
9643 fkey.map = fkey.parent;
9644 if (keytran.end > last_real_key_start)
9646 keytran.end = keytran.start
9647 = min (last_real_key_start, keytran.start);
9648 keytran.map = keytran.parent;
9652 if (t == last_real_key_start)
9654 mock_input = 0;
9655 goto replay_key;
9657 else
9659 mock_input = last_real_key_start;
9660 goto replay_sequence;
9664 new_head
9665 = apply_modifiers (modifiers, XCAR (breakdown));
9666 new_click = list2 (new_head, EVENT_START (key));
9668 /* Look for a binding for this new key. */
9669 new_binding = follow_key (current_binding, new_click);
9671 /* If that click is bound, go for it. */
9672 if (!NILP (new_binding))
9674 current_binding = new_binding;
9675 key = new_click;
9676 break;
9678 /* Otherwise, we'll leave key set to the drag event. */
9683 current_binding = new_binding;
9685 keybuf[t++] = key;
9686 /* Normally, last_nonmenu_event gets the previous key we read.
9687 But when a mouse popup menu is being used,
9688 we don't update last_nonmenu_event; it continues to hold the mouse
9689 event that preceded the first level of menu. */
9690 if (!used_mouse_menu)
9691 last_nonmenu_event = key;
9693 /* Record what part of this_command_keys is the current key sequence. */
9694 this_single_command_key_start = this_command_key_count - t;
9696 /* Look for this sequence in input-decode-map.
9697 Scan from indec.end until we find a bound suffix. */
9698 while (indec.end < t)
9700 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9701 bool done;
9702 int diff;
9704 GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
9705 done = keyremap_step (keybuf, bufsize, &indec, max (t, mock_input),
9706 1, &diff, prompt);
9707 UNGCPRO;
9708 if (done)
9710 mock_input = diff + max (t, mock_input);
9711 goto replay_sequence;
9715 if (!KEYMAPP (current_binding)
9716 && !test_undefined (current_binding)
9717 && indec.start >= t)
9718 /* There is a binding and it's not a prefix.
9719 (and it doesn't have any input-decode-map translation pending).
9720 There is thus no function-key in this sequence.
9721 Moving fkey.start is important in this case to allow keytran.start
9722 to go over the sequence before we return (since we keep the
9723 invariant that keytran.end <= fkey.start). */
9725 if (fkey.start < t)
9726 (fkey.start = fkey.end = t, fkey.map = fkey.parent);
9728 else
9729 /* If the sequence is unbound, see if we can hang a function key
9730 off the end of it. */
9731 /* Continue scan from fkey.end until we find a bound suffix. */
9732 while (fkey.end < indec.start)
9734 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9735 bool done;
9736 int diff;
9738 GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
9739 done = keyremap_step (keybuf, bufsize, &fkey,
9740 max (t, mock_input),
9741 /* If there's a binding (i.e.
9742 first_binding >= nmaps) we don't want
9743 to apply this function-key-mapping. */
9744 fkey.end + 1 == t
9745 && (test_undefined (current_binding)),
9746 &diff, prompt);
9747 UNGCPRO;
9748 if (done)
9750 mock_input = diff + max (t, mock_input);
9751 /* Adjust the input-decode-map counters. */
9752 indec.end += diff;
9753 indec.start += diff;
9755 goto replay_sequence;
9759 /* Look for this sequence in key-translation-map.
9760 Scan from keytran.end until we find a bound suffix. */
9761 while (keytran.end < fkey.start)
9763 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9764 bool done;
9765 int diff;
9767 GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
9768 done = keyremap_step (keybuf, bufsize, &keytran, max (t, mock_input),
9769 1, &diff, prompt);
9770 UNGCPRO;
9771 if (done)
9773 mock_input = diff + max (t, mock_input);
9774 /* Adjust the function-key-map and input-decode-map counters. */
9775 indec.end += diff;
9776 indec.start += diff;
9777 fkey.end += diff;
9778 fkey.start += diff;
9780 goto replay_sequence;
9784 /* If KEY is not defined in any of the keymaps,
9785 and cannot be part of a function key or translation,
9786 and is an upper case letter
9787 use the corresponding lower-case letter instead. */
9788 if (NILP (current_binding)
9789 && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t
9790 && INTEGERP (key)
9791 && ((CHARACTERP (make_number (XINT (key) & ~CHAR_MODIFIER_MASK))
9792 && uppercasep (XINT (key) & ~CHAR_MODIFIER_MASK))
9793 || (XINT (key) & shift_modifier)))
9795 Lisp_Object new_key;
9797 original_uppercase = key;
9798 original_uppercase_position = t - 1;
9800 if (XINT (key) & shift_modifier)
9801 XSETINT (new_key, XINT (key) & ~shift_modifier);
9802 else
9803 XSETINT (new_key, (downcase (XINT (key) & ~CHAR_MODIFIER_MASK)
9804 | (XINT (key) & CHAR_MODIFIER_MASK)));
9806 /* We have to do this unconditionally, regardless of whether
9807 the lower-case char is defined in the keymaps, because they
9808 might get translated through function-key-map. */
9809 keybuf[t - 1] = new_key;
9810 mock_input = max (t, mock_input);
9811 shift_translated = 1;
9813 goto replay_sequence;
9816 if (NILP (current_binding)
9817 && help_char_p (EVENT_HEAD (key)) && t > 1)
9819 read_key_sequence_cmd = Vprefix_help_command;
9820 /* The Microsoft C compiler can't handle the goto that
9821 would go here. */
9822 dummyflag = 1;
9823 break;
9826 /* If KEY is not defined in any of the keymaps,
9827 and cannot be part of a function key or translation,
9828 and is a shifted function key,
9829 use the corresponding unshifted function key instead. */
9830 if (NILP (current_binding)
9831 && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t)
9833 Lisp_Object breakdown = parse_modifiers (key);
9834 int modifiers
9835 = CONSP (breakdown) ? (XINT (XCAR (XCDR (breakdown)))) : 0;
9837 if (modifiers & shift_modifier
9838 /* Treat uppercase keys as shifted. */
9839 || (INTEGERP (key)
9840 && (KEY_TO_CHAR (key)
9841 < XCHAR_TABLE (BVAR (current_buffer, downcase_table))->header.size)
9842 && uppercasep (KEY_TO_CHAR (key))))
9844 Lisp_Object new_key
9845 = (modifiers & shift_modifier
9846 ? apply_modifiers (modifiers & ~shift_modifier,
9847 XCAR (breakdown))
9848 : make_number (downcase (KEY_TO_CHAR (key)) | modifiers));
9850 original_uppercase = key;
9851 original_uppercase_position = t - 1;
9853 /* We have to do this unconditionally, regardless of whether
9854 the lower-case char is defined in the keymaps, because they
9855 might get translated through function-key-map. */
9856 keybuf[t - 1] = new_key;
9857 mock_input = max (t, mock_input);
9858 /* Reset fkey (and consequently keytran) to apply
9859 function-key-map on the result, so that S-backspace is
9860 correctly mapped to DEL (via backspace). OTOH,
9861 input-decode-map doesn't need to go through it again. */
9862 fkey.start = fkey.end = 0;
9863 keytran.start = keytran.end = 0;
9864 shift_translated = 1;
9866 goto replay_sequence;
9870 if (!dummyflag)
9871 read_key_sequence_cmd = current_binding;
9872 read_key_sequence_remapped
9873 /* Remap command through active keymaps.
9874 Do the remapping here, before the unbind_to so it uses the keymaps
9875 of the appropriate buffer. */
9876 = SYMBOLP (read_key_sequence_cmd)
9877 ? Fcommand_remapping (read_key_sequence_cmd, Qnil, Qnil)
9878 : Qnil;
9880 unread_switch_frame = delayed_switch_frame;
9881 unbind_to (count, Qnil);
9883 /* Don't downcase the last character if the caller says don't.
9884 Don't downcase it if the result is undefined, either. */
9885 if ((dont_downcase_last || NILP (current_binding))
9886 && t > 0
9887 && t - 1 == original_uppercase_position)
9889 keybuf[t - 1] = original_uppercase;
9890 shift_translated = 0;
9893 if (shift_translated)
9894 Vthis_command_keys_shift_translated = Qt;
9896 /* Occasionally we fabricate events, perhaps by expanding something
9897 according to function-key-map, or by adding a prefix symbol to a
9898 mouse click in the scroll bar or modeline. In this cases, return
9899 the entire generated key sequence, even if we hit an unbound
9900 prefix or a definition before the end. This means that you will
9901 be able to push back the event properly, and also means that
9902 read-key-sequence will always return a logical unit.
9904 Better ideas? */
9905 for (; t < mock_input; t++)
9907 if (echo_keystrokes_p ())
9908 echo_char (keybuf[t]);
9909 add_command_key (keybuf[t]);
9912 UNGCPRO;
9913 return t;
9916 static Lisp_Object
9917 read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
9918 Lisp_Object dont_downcase_last,
9919 Lisp_Object can_return_switch_frame,
9920 Lisp_Object cmd_loop, bool allow_string)
9922 Lisp_Object keybuf[30];
9923 register int i;
9924 struct gcpro gcpro1;
9925 ptrdiff_t count = SPECPDL_INDEX ();
9927 if (!NILP (prompt))
9928 CHECK_STRING (prompt);
9929 QUIT;
9931 specbind (Qinput_method_exit_on_first_char,
9932 (NILP (cmd_loop) ? Qt : Qnil));
9933 specbind (Qinput_method_use_echo_area,
9934 (NILP (cmd_loop) ? Qt : Qnil));
9936 memset (keybuf, 0, sizeof keybuf);
9937 GCPRO1 (keybuf[0]);
9938 gcpro1.nvars = ARRAYELTS (keybuf);
9940 if (NILP (continue_echo))
9942 this_command_key_count = 0;
9943 this_command_key_count_reset = 0;
9944 this_single_command_key_start = 0;
9947 #ifdef HAVE_WINDOW_SYSTEM
9948 if (display_hourglass_p)
9949 cancel_hourglass ();
9950 #endif
9952 i = read_key_sequence (keybuf, ARRAYELTS (keybuf),
9953 prompt, ! NILP (dont_downcase_last),
9954 ! NILP (can_return_switch_frame), 0, 0);
9956 #if 0 /* The following is fine for code reading a key sequence and
9957 then proceeding with a lengthy computation, but it's not good
9958 for code reading keys in a loop, like an input method. */
9959 #ifdef HAVE_WINDOW_SYSTEM
9960 if (display_hourglass_p)
9961 start_hourglass ();
9962 #endif
9963 #endif
9965 if (i == -1)
9967 Vquit_flag = Qt;
9968 QUIT;
9970 UNGCPRO;
9971 return unbind_to (count,
9972 ((allow_string ? make_event_array : Fvector)
9973 (i, keybuf)));
9976 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
9977 doc: /* Read a sequence of keystrokes and return as a string or vector.
9978 The sequence is sufficient to specify a non-prefix command in the
9979 current local and global maps.
9981 First arg PROMPT is a prompt string. If nil, do not prompt specially.
9982 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos
9983 as a continuation of the previous key.
9985 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
9986 convert the last event to lower case. (Normally any upper case event
9987 is converted to lower case if the original event is undefined and the lower
9988 case equivalent is defined.) A non-nil value is appropriate for reading
9989 a key sequence to be defined.
9991 A C-g typed while in this function is treated like any other character,
9992 and `quit-flag' is not set.
9994 If the key sequence starts with a mouse click, then the sequence is read
9995 using the keymaps of the buffer of the window clicked in, not the buffer
9996 of the selected window as normal.
9998 `read-key-sequence' drops unbound button-down events, since you normally
9999 only care about the click or drag events which follow them. If a drag
10000 or multi-click event is unbound, but the corresponding click event would
10001 be bound, `read-key-sequence' turns the event into a click event at the
10002 drag's starting position. This means that you don't have to distinguish
10003 between click and drag, double, or triple events unless you want to.
10005 `read-key-sequence' prefixes mouse events on mode lines, the vertical
10006 lines separating windows, and scroll bars with imaginary keys
10007 `mode-line', `vertical-line', and `vertical-scroll-bar'.
10009 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this
10010 function will process a switch-frame event if the user switches frames
10011 before typing anything. If the user switches frames in the middle of a
10012 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME
10013 is nil, then the event will be put off until after the current key sequence.
10015 `read-key-sequence' checks `function-key-map' for function key
10016 sequences, where they wouldn't conflict with ordinary bindings. See
10017 `function-key-map' for more details.
10019 The optional fifth argument CMD-LOOP, if non-nil, means
10020 that this key sequence is being read by something that will
10021 read commands one after another. It should be nil if the caller
10022 will read just one key sequence. */)
10023 (Lisp_Object prompt, Lisp_Object continue_echo, Lisp_Object dont_downcase_last, Lisp_Object can_return_switch_frame, Lisp_Object cmd_loop)
10025 return read_key_sequence_vs (prompt, continue_echo, dont_downcase_last,
10026 can_return_switch_frame, cmd_loop, true);
10029 DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
10030 Sread_key_sequence_vector, 1, 5, 0,
10031 doc: /* Like `read-key-sequence' but always return a vector. */)
10032 (Lisp_Object prompt, Lisp_Object continue_echo, Lisp_Object dont_downcase_last, Lisp_Object can_return_switch_frame, Lisp_Object cmd_loop)
10034 return read_key_sequence_vs (prompt, continue_echo, dont_downcase_last,
10035 can_return_switch_frame, cmd_loop, false);
10038 /* Return true if input events are pending. */
10040 bool
10041 detect_input_pending (void)
10043 return input_pending || get_input_pending (0);
10046 /* Return true if input events other than mouse movements are
10047 pending. */
10049 bool
10050 detect_input_pending_ignore_squeezables (void)
10052 return input_pending || get_input_pending (READABLE_EVENTS_IGNORE_SQUEEZABLES);
10055 /* Return true if input events are pending, and run any pending timers. */
10057 bool
10058 detect_input_pending_run_timers (bool do_display)
10060 unsigned old_timers_run = timers_run;
10062 if (!input_pending)
10063 get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
10065 if (old_timers_run != timers_run && do_display)
10066 redisplay_preserve_echo_area (8);
10068 return input_pending;
10071 /* This is called in some cases before a possible quit.
10072 It cases the next call to detect_input_pending to recompute input_pending.
10073 So calling this function unnecessarily can't do any harm. */
10075 void
10076 clear_input_pending (void)
10078 input_pending = 0;
10081 /* Return true if there are pending requeued events.
10082 This isn't used yet. The hope is to make wait_reading_process_output
10083 call it, and return if it runs Lisp code that unreads something.
10084 The problem is, kbd_buffer_get_event needs to be fixed to know what
10085 to do in that case. It isn't trivial. */
10087 bool
10088 requeued_events_pending_p (void)
10090 return (!NILP (Vunread_command_events));
10093 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 1, 0,
10094 doc: /* Return t if command input is currently available with no wait.
10095 Actually, the value is nil only if we can be sure that no input is available;
10096 if there is a doubt, the value is t.
10098 If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */)
10099 (Lisp_Object check_timers)
10101 if (!NILP (Vunread_command_events)
10102 || !NILP (Vunread_post_input_method_events)
10103 || !NILP (Vunread_input_method_events))
10104 return (Qt);
10106 /* Process non-user-visible events (Bug#10195). */
10107 process_special_events ();
10109 return (get_input_pending ((NILP (check_timers)
10110 ? 0 : READABLE_EVENTS_DO_TIMERS_NOW)
10111 | READABLE_EVENTS_FILTER_EVENTS)
10112 ? Qt : Qnil);
10115 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 1, 0,
10116 doc: /* Return vector of last few events, not counting those from keyboard macros.
10117 If INCLUDE-CMDS is non-nil, include the commands that were run,
10118 represented as events of the form (nil . COMMAND). */)
10119 (Lisp_Object include_cmds)
10121 bool cmds = !NILP (include_cmds);
10123 if (!total_keys
10124 || (cmds && total_keys < NUM_RECENT_KEYS))
10125 return Fvector (total_keys,
10126 XVECTOR (recent_keys)->contents);
10127 else
10129 Lisp_Object es = Qnil;
10130 int i = (total_keys < NUM_RECENT_KEYS
10131 ? 0 : recent_keys_index);
10132 eassert (recent_keys_index < NUM_RECENT_KEYS);
10135 Lisp_Object e = AREF (recent_keys, i);
10136 if (cmds || !CONSP (e) || !NILP (XCAR (e)))
10137 es = Fcons (e, es);
10138 if (++i >= NUM_RECENT_KEYS)
10139 i = 0;
10140 } while (i != recent_keys_index);
10141 es = Fnreverse (es);
10142 return Fvconcat (1, &es);
10146 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
10147 doc: /* Return the key sequence that invoked this command.
10148 However, if the command has called `read-key-sequence', it returns
10149 the last key sequence that has been read.
10150 The value is a string or a vector.
10152 See also `this-command-keys-vector'. */)
10153 (void)
10155 return make_event_array (this_command_key_count,
10156 XVECTOR (this_command_keys)->contents);
10159 DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
10160 doc: /* Return the key sequence that invoked this command, as a vector.
10161 However, if the command has called `read-key-sequence', it returns
10162 the last key sequence that has been read.
10164 See also `this-command-keys'. */)
10165 (void)
10167 return Fvector (this_command_key_count,
10168 XVECTOR (this_command_keys)->contents);
10171 DEFUN ("this-single-command-keys", Fthis_single_command_keys,
10172 Sthis_single_command_keys, 0, 0, 0,
10173 doc: /* Return the key sequence that invoked this command.
10174 More generally, it returns the last key sequence read, either by
10175 the command loop or by `read-key-sequence'.
10176 Unlike `this-command-keys', this function's value
10177 does not include prefix arguments.
10178 The value is always a vector. */)
10179 (void)
10181 return Fvector (this_command_key_count
10182 - this_single_command_key_start,
10183 (XVECTOR (this_command_keys)->contents
10184 + this_single_command_key_start));
10187 DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
10188 Sthis_single_command_raw_keys, 0, 0, 0,
10189 doc: /* Return the raw events that were read for this command.
10190 More generally, it returns the last key sequence read, either by
10191 the command loop or by `read-key-sequence'.
10192 Unlike `this-single-command-keys', this function's value
10193 shows the events before all translations (except for input methods).
10194 The value is always a vector. */)
10195 (void)
10197 return Fvector (raw_keybuf_count, XVECTOR (raw_keybuf)->contents);
10200 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
10201 Sreset_this_command_lengths, 0, 0, 0,
10202 doc: /* Make the unread events replace the last command and echo.
10203 Used in `universal-argument-other-key'.
10205 `universal-argument-other-key' rereads the event just typed.
10206 It then gets translated through `function-key-map'.
10207 The translated event has to replace the real events,
10208 both in the value of (this-command-keys) and in echoing.
10209 To achieve this, `universal-argument-other-key' calls
10210 `reset-this-command-lengths', which discards the record of reading
10211 these events the first time. */)
10212 (void)
10214 this_command_key_count = before_command_key_count;
10215 if (this_command_key_count < this_single_command_key_start)
10216 this_single_command_key_start = this_command_key_count;
10218 echo_truncate (before_command_echo_length);
10220 /* Cause whatever we put into unread-command-events
10221 to echo as if it were being freshly read from the keyboard. */
10222 this_command_key_count_reset = 1;
10224 return Qnil;
10227 DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
10228 Sclear_this_command_keys, 0, 1, 0,
10229 doc: /* Clear out the vector that `this-command-keys' returns.
10230 Also clear the record of the last 100 events, unless optional arg
10231 KEEP-RECORD is non-nil. */)
10232 (Lisp_Object keep_record)
10234 int i;
10236 this_command_key_count = 0;
10237 this_command_key_count_reset = 0;
10239 if (NILP (keep_record))
10241 for (i = 0; i < ASIZE (recent_keys); ++i)
10242 ASET (recent_keys, i, Qnil);
10243 total_keys = 0;
10244 recent_keys_index = 0;
10246 return Qnil;
10249 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
10250 doc: /* Return the current depth in recursive edits. */)
10251 (void)
10253 Lisp_Object temp;
10254 /* Wrap around reliably on integer overflow. */
10255 EMACS_INT sum = (command_loop_level & INTMASK) + (minibuf_level & INTMASK);
10256 XSETINT (temp, sum);
10257 return temp;
10260 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
10261 "FOpen dribble file: ",
10262 doc: /* Start writing all keyboard characters to a dribble file called FILE.
10263 If FILE is nil, close any open dribble file.
10264 The file will be closed when Emacs exits.
10266 Be aware that this records ALL characters you type!
10267 This may include sensitive information such as passwords. */)
10268 (Lisp_Object file)
10270 if (dribble)
10272 block_input ();
10273 fclose (dribble);
10274 unblock_input ();
10275 dribble = 0;
10277 if (!NILP (file))
10279 int fd;
10280 Lisp_Object encfile;
10282 file = Fexpand_file_name (file, Qnil);
10283 encfile = ENCODE_FILE (file);
10284 fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
10285 if (fd < 0 && errno == EEXIST && unlink (SSDATA (encfile)) == 0)
10286 fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
10287 dribble = fd < 0 ? 0 : fdopen (fd, "w");
10288 if (dribble == 0)
10289 report_file_error ("Opening dribble", file);
10291 return Qnil;
10294 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
10295 doc: /* Discard the contents of the terminal input buffer.
10296 Also end any kbd macro being defined. */)
10297 (void)
10299 if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
10301 /* Discard the last command from the macro. */
10302 Fcancel_kbd_macro_events ();
10303 end_kbd_macro ();
10306 Vunread_command_events = Qnil;
10308 discard_tty_input ();
10310 kbd_fetch_ptr = kbd_store_ptr;
10311 input_pending = 0;
10313 return Qnil;
10316 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
10317 doc: /* Stop Emacs and return to superior process. You can resume later.
10318 If `cannot-suspend' is non-nil, or if the system doesn't support job
10319 control, run a subshell instead.
10321 If optional arg STUFFSTRING is non-nil, its characters are stuffed
10322 to be read as terminal input by Emacs's parent, after suspension.
10324 Before suspending, run the normal hook `suspend-hook'.
10325 After resumption run the normal hook `suspend-resume-hook'.
10327 Some operating systems cannot stop the Emacs process and resume it later.
10328 On such systems, Emacs starts a subshell instead of suspending. */)
10329 (Lisp_Object stuffstring)
10331 ptrdiff_t count = SPECPDL_INDEX ();
10332 int old_height, old_width;
10333 int width, height;
10334 struct gcpro gcpro1;
10335 Lisp_Object hook;
10337 if (tty_list && tty_list->next)
10338 error ("There are other tty frames open; close them before suspending Emacs");
10340 if (!NILP (stuffstring))
10341 CHECK_STRING (stuffstring);
10343 /* Run the functions in suspend-hook. */
10344 hook = intern ("suspend-hook");
10345 Frun_hooks (1, &hook);
10347 GCPRO1 (stuffstring);
10348 get_tty_size (fileno (CURTTY ()->input), &old_width, &old_height);
10349 reset_all_sys_modes ();
10350 /* sys_suspend can get an error if it tries to fork a subshell
10351 and the system resources aren't available for that. */
10352 record_unwind_protect_void (init_all_sys_modes);
10353 stuff_buffered_input (stuffstring);
10354 if (cannot_suspend)
10355 sys_subshell ();
10356 else
10357 sys_suspend ();
10358 unbind_to (count, Qnil);
10360 /* Check if terminal/window size has changed.
10361 Note that this is not useful when we are running directly
10362 with a window system; but suspend should be disabled in that case. */
10363 get_tty_size (fileno (CURTTY ()->input), &width, &height);
10364 if (width != old_width || height != old_height)
10365 change_frame_size (SELECTED_FRAME (), width,
10366 height - FRAME_MENU_BAR_LINES (SELECTED_FRAME ()),
10367 0, 0, 0, 0);
10369 /* Run suspend-resume-hook. */
10370 hook = intern ("suspend-resume-hook");
10371 Frun_hooks (1, &hook);
10373 UNGCPRO;
10374 return Qnil;
10377 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
10378 Then in any case stuff anything Emacs has read ahead and not used. */
10380 void
10381 stuff_buffered_input (Lisp_Object stuffstring)
10383 #ifdef SIGTSTP /* stuff_char is defined if SIGTSTP. */
10384 register unsigned char *p;
10386 if (STRINGP (stuffstring))
10388 register ptrdiff_t count;
10390 p = SDATA (stuffstring);
10391 count = SBYTES (stuffstring);
10392 while (count-- > 0)
10393 stuff_char (*p++);
10394 stuff_char ('\n');
10397 /* Anything we have read ahead, put back for the shell to read. */
10398 /* ?? What should this do when we have multiple keyboards??
10399 Should we ignore anything that was typed in at the "wrong" kboard?
10401 rms: we should stuff everything back into the kboard
10402 it came from. */
10403 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
10406 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
10407 kbd_fetch_ptr = kbd_buffer;
10408 if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT)
10409 stuff_char (kbd_fetch_ptr->code);
10411 clear_event (kbd_fetch_ptr);
10414 input_pending = 0;
10415 #endif /* SIGTSTP */
10418 void
10419 set_waiting_for_input (struct timespec *time_to_clear)
10421 input_available_clear_time = time_to_clear;
10423 /* Tell handle_interrupt to throw back to read_char, */
10424 waiting_for_input = 1;
10426 /* If handle_interrupt was called before and buffered a C-g,
10427 make it run again now, to avoid timing error. */
10428 if (!NILP (Vquit_flag))
10429 quit_throw_to_read_char (0);
10432 void
10433 clear_waiting_for_input (void)
10435 /* Tell handle_interrupt not to throw back to read_char, */
10436 waiting_for_input = 0;
10437 input_available_clear_time = 0;
10440 /* The SIGINT handler.
10442 If we have a frame on the controlling tty, we assume that the
10443 SIGINT was generated by C-g, so we call handle_interrupt.
10444 Otherwise, tell QUIT to kill Emacs. */
10446 static void
10447 handle_interrupt_signal (int sig)
10449 /* See if we have an active terminal on our controlling tty. */
10450 struct terminal *terminal = get_named_terminal ("/dev/tty");
10451 if (!terminal)
10453 /* If there are no frames there, let's pretend that we are a
10454 well-behaving UN*X program and quit. We must not call Lisp
10455 in a signal handler, so tell QUIT to exit when it is
10456 safe. */
10457 Vquit_flag = Qkill_emacs;
10459 else
10461 /* Otherwise, the SIGINT was probably generated by C-g. */
10463 /* Set internal_last_event_frame to the top frame of the
10464 controlling tty, if we have a frame there. We disable the
10465 interrupt key on secondary ttys, so the SIGINT must have come
10466 from the controlling tty. */
10467 internal_last_event_frame = terminal->display_info.tty->top_frame;
10469 handle_interrupt (1);
10473 static void
10474 deliver_interrupt_signal (int sig)
10476 deliver_process_signal (sig, handle_interrupt_signal);
10480 /* If Emacs is stuck because `inhibit-quit' is true, then keep track
10481 of the number of times C-g has been requested. If C-g is pressed
10482 enough times, then quit anyway. See bug#6585. */
10483 static int volatile force_quit_count;
10485 /* This routine is called at interrupt level in response to C-g.
10487 It is called from the SIGINT handler or kbd_buffer_store_event.
10489 If `waiting_for_input' is non zero, then unless `echoing' is
10490 nonzero, immediately throw back to read_char.
10492 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
10493 eval to throw, when it gets a chance. If quit-flag is already
10494 non-nil, it stops the job right away. */
10496 static void
10497 handle_interrupt (bool in_signal_handler)
10499 char c;
10501 cancel_echoing ();
10503 /* XXX This code needs to be revised for multi-tty support. */
10504 if (!NILP (Vquit_flag) && get_named_terminal ("/dev/tty"))
10506 if (! in_signal_handler)
10508 /* If SIGINT isn't blocked, don't let us be interrupted by
10509 a SIGINT. It might be harmful due to non-reentrancy
10510 in I/O functions. */
10511 sigset_t blocked;
10512 sigemptyset (&blocked);
10513 sigaddset (&blocked, SIGINT);
10514 pthread_sigmask (SIG_BLOCK, &blocked, 0);
10517 fflush (stdout);
10518 reset_all_sys_modes ();
10520 #ifdef SIGTSTP
10522 * On systems which can suspend the current process and return to the original
10523 * shell, this command causes the user to end up back at the shell.
10524 * The "Auto-save" and "Abort" questions are not asked until
10525 * the user elects to return to emacs, at which point he can save the current
10526 * job and either dump core or continue.
10528 sys_suspend ();
10529 #else
10530 /* Perhaps should really fork an inferior shell?
10531 But that would not provide any way to get back
10532 to the original shell, ever. */
10533 printf ("No support for stopping a process on this operating system;\n");
10534 printf ("you can continue or abort.\n");
10535 #endif /* not SIGTSTP */
10536 #ifdef MSDOS
10537 /* We must remain inside the screen area when the internal terminal
10538 is used. Note that [Enter] is not echoed by dos. */
10539 cursor_to (SELECTED_FRAME (), 0, 0);
10540 #endif
10541 /* It doesn't work to autosave while GC is in progress;
10542 the code used for auto-saving doesn't cope with the mark bit. */
10543 if (!gc_in_progress)
10545 printf ("Auto-save? (y or n) ");
10546 fflush (stdout);
10547 if (((c = getchar ()) & ~040) == 'Y')
10549 Fdo_auto_save (Qt, Qnil);
10550 #ifdef MSDOS
10551 printf ("\r\nAuto-save done");
10552 #else /* not MSDOS */
10553 printf ("Auto-save done\n");
10554 #endif /* not MSDOS */
10556 while (c != '\n') c = getchar ();
10558 else
10560 /* During GC, it must be safe to reenable quitting again. */
10561 Vinhibit_quit = Qnil;
10562 #ifdef MSDOS
10563 printf ("\r\n");
10564 #endif /* not MSDOS */
10565 printf ("Garbage collection in progress; cannot auto-save now\r\n");
10566 printf ("but will instead do a real quit after garbage collection ends\r\n");
10567 fflush (stdout);
10570 #ifdef MSDOS
10571 printf ("\r\nAbort? (y or n) ");
10572 #else /* not MSDOS */
10573 printf ("Abort (and dump core)? (y or n) ");
10574 #endif /* not MSDOS */
10575 fflush (stdout);
10576 if (((c = getchar ()) & ~040) == 'Y')
10577 emacs_abort ();
10578 while (c != '\n') c = getchar ();
10579 #ifdef MSDOS
10580 printf ("\r\nContinuing...\r\n");
10581 #else /* not MSDOS */
10582 printf ("Continuing...\n");
10583 #endif /* not MSDOS */
10584 fflush (stdout);
10585 init_all_sys_modes ();
10587 else
10589 /* If executing a function that wants to be interrupted out of
10590 and the user has not deferred quitting by binding `inhibit-quit'
10591 then quit right away. */
10592 if (immediate_quit && NILP (Vinhibit_quit))
10594 struct gl_state_s saved;
10595 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10597 immediate_quit = 0;
10598 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
10599 saved = gl_state;
10600 GCPRO4 (saved.object, saved.global_code,
10601 saved.current_syntax_table, saved.old_prop);
10602 Fsignal (Qquit, Qnil);
10603 gl_state = saved;
10604 UNGCPRO;
10606 else
10607 { /* Else request quit when it's safe. */
10608 int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
10609 force_quit_count = count;
10610 if (count == 3)
10612 immediate_quit = 1;
10613 Vinhibit_quit = Qnil;
10615 Vquit_flag = Qt;
10619 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
10621 /* TODO: The longjmp in this call throws the NS event loop integration off,
10622 and it seems to do fine without this. Probably some attention
10623 needs to be paid to the setting of waiting_for_input in
10624 wait_reading_process_output() under HAVE_NS because of the call
10625 to ns_select there (needed because otherwise events aren't picked up
10626 outside of polling since we don't get SIGIO like X and we don't have a
10627 separate event loop thread like W32. */
10628 #ifndef HAVE_NS
10629 if (waiting_for_input && !echoing)
10630 quit_throw_to_read_char (in_signal_handler);
10631 #endif
10634 /* Handle a C-g by making read_char return C-g. */
10636 static void
10637 quit_throw_to_read_char (bool from_signal)
10639 /* When not called from a signal handler it is safe to call
10640 Lisp. */
10641 if (!from_signal && EQ (Vquit_flag, Qkill_emacs))
10642 Fkill_emacs (Qnil);
10644 /* Prevent another signal from doing this before we finish. */
10645 clear_waiting_for_input ();
10646 input_pending = 0;
10648 Vunread_command_events = Qnil;
10650 if (FRAMEP (internal_last_event_frame)
10651 && !EQ (internal_last_event_frame, selected_frame))
10652 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
10653 0, 0, Qnil);
10655 sys_longjmp (getcjmp, 1);
10658 DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,
10659 Sset_input_interrupt_mode, 1, 1, 0,
10660 doc: /* Set interrupt mode of reading keyboard input.
10661 If INTERRUPT is non-nil, Emacs will use input interrupts;
10662 otherwise Emacs uses CBREAK mode.
10664 See also `current-input-mode'. */)
10665 (Lisp_Object interrupt)
10667 bool new_interrupt_input;
10668 #ifdef USABLE_SIGIO
10669 #ifdef HAVE_X_WINDOWS
10670 if (x_display_list != NULL)
10672 /* When using X, don't give the user a real choice,
10673 because we haven't implemented the mechanisms to support it. */
10674 new_interrupt_input = 1;
10676 else
10677 #endif /* HAVE_X_WINDOWS */
10678 new_interrupt_input = !NILP (interrupt);
10679 #else /* not USABLE_SIGIO */
10680 new_interrupt_input = 0;
10681 #endif /* not USABLE_SIGIO */
10683 if (new_interrupt_input != interrupt_input)
10685 #ifdef POLL_FOR_INPUT
10686 stop_polling ();
10687 #endif
10688 #ifndef DOS_NT
10689 /* this causes startup screen to be restored and messes with the mouse */
10690 reset_all_sys_modes ();
10691 interrupt_input = new_interrupt_input;
10692 init_all_sys_modes ();
10693 #else
10694 interrupt_input = new_interrupt_input;
10695 #endif
10697 #ifdef POLL_FOR_INPUT
10698 poll_suppress_count = 1;
10699 start_polling ();
10700 #endif
10702 return Qnil;
10705 DEFUN ("set-output-flow-control", Fset_output_flow_control, Sset_output_flow_control, 1, 2, 0,
10706 doc: /* Enable or disable ^S/^Q flow control for output to TERMINAL.
10707 If FLOW is non-nil, flow control is enabled and you cannot use C-s or
10708 C-q in key sequences.
10710 This setting only has an effect on tty terminals and only when
10711 Emacs reads input in CBREAK mode; see `set-input-interrupt-mode'.
10713 See also `current-input-mode'. */)
10714 (Lisp_Object flow, Lisp_Object terminal)
10716 struct terminal *t = decode_tty_terminal (terminal);
10717 struct tty_display_info *tty;
10719 if (!t)
10720 return Qnil;
10721 tty = t->display_info.tty;
10723 if (tty->flow_control != !NILP (flow))
10725 #ifndef DOS_NT
10726 /* This causes startup screen to be restored and messes with the mouse. */
10727 reset_sys_modes (tty);
10728 #endif
10730 tty->flow_control = !NILP (flow);
10732 #ifndef DOS_NT
10733 init_sys_modes (tty);
10734 #endif
10736 return Qnil;
10739 DEFUN ("set-input-meta-mode", Fset_input_meta_mode, Sset_input_meta_mode, 1, 2, 0,
10740 doc: /* Enable or disable 8-bit input on TERMINAL.
10741 If META is t, Emacs will accept 8-bit input, and interpret the 8th
10742 bit as the Meta modifier.
10744 If META is nil, Emacs will ignore the top bit, on the assumption it is
10745 parity.
10747 Otherwise, Emacs will accept and pass through 8-bit input without
10748 specially interpreting the top bit.
10750 This setting only has an effect on tty terminal devices.
10752 Optional parameter TERMINAL specifies the tty terminal device to use.
10753 It may be a terminal object, a frame, or nil for the terminal used by
10754 the currently selected frame.
10756 See also `current-input-mode'. */)
10757 (Lisp_Object meta, Lisp_Object terminal)
10759 struct terminal *t = decode_tty_terminal (terminal);
10760 struct tty_display_info *tty;
10761 int new_meta;
10763 if (!t)
10764 return Qnil;
10765 tty = t->display_info.tty;
10767 if (NILP (meta))
10768 new_meta = 0;
10769 else if (EQ (meta, Qt))
10770 new_meta = 1;
10771 else
10772 new_meta = 2;
10774 if (tty->meta_key != new_meta)
10776 #ifndef DOS_NT
10777 /* this causes startup screen to be restored and messes with the mouse */
10778 reset_sys_modes (tty);
10779 #endif
10781 tty->meta_key = new_meta;
10783 #ifndef DOS_NT
10784 init_sys_modes (tty);
10785 #endif
10787 return Qnil;
10790 DEFUN ("set-quit-char", Fset_quit_char, Sset_quit_char, 1, 1, 0,
10791 doc: /* Specify character used for quitting.
10792 QUIT must be an ASCII character.
10794 This function only has an effect on the controlling tty of the Emacs
10795 process.
10797 See also `current-input-mode'. */)
10798 (Lisp_Object quit)
10800 struct terminal *t = get_named_terminal ("/dev/tty");
10801 struct tty_display_info *tty;
10803 if (!t)
10804 return Qnil;
10805 tty = t->display_info.tty;
10807 if (NILP (quit) || !INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400)
10808 error ("QUIT must be an ASCII character");
10810 #ifndef DOS_NT
10811 /* this causes startup screen to be restored and messes with the mouse */
10812 reset_sys_modes (tty);
10813 #endif
10815 /* Don't let this value be out of range. */
10816 quit_char = XINT (quit) & (tty->meta_key == 0 ? 0177 : 0377);
10818 #ifndef DOS_NT
10819 init_sys_modes (tty);
10820 #endif
10822 return Qnil;
10825 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
10826 doc: /* Set mode of reading keyboard input.
10827 First arg INTERRUPT non-nil means use input interrupts;
10828 nil means use CBREAK mode.
10829 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
10830 (no effect except in CBREAK mode).
10831 Third arg META t means accept 8-bit input (for a Meta key).
10832 META nil means ignore the top bit, on the assumption it is parity.
10833 Otherwise, accept 8-bit input and don't use the top bit for Meta.
10834 Optional fourth arg QUIT if non-nil specifies character to use for quitting.
10835 See also `current-input-mode'. */)
10836 (Lisp_Object interrupt, Lisp_Object flow, Lisp_Object meta, Lisp_Object quit)
10838 Fset_input_interrupt_mode (interrupt);
10839 Fset_output_flow_control (flow, Qnil);
10840 Fset_input_meta_mode (meta, Qnil);
10841 if (!NILP (quit))
10842 Fset_quit_char (quit);
10843 return Qnil;
10846 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
10847 doc: /* Return information about the way Emacs currently reads keyboard input.
10848 The value is a list of the form (INTERRUPT FLOW META QUIT), where
10849 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if
10850 nil, Emacs is using CBREAK mode.
10851 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
10852 terminal; this does not apply if Emacs uses interrupt-driven input.
10853 META is t if accepting 8-bit input with 8th bit as Meta flag.
10854 META nil means ignoring the top bit, on the assumption it is parity.
10855 META is neither t nor nil if accepting 8-bit input and using
10856 all 8 bits as the character code.
10857 QUIT is the character Emacs currently uses to quit.
10858 The elements of this list correspond to the arguments of
10859 `set-input-mode'. */)
10860 (void)
10862 Lisp_Object val[4];
10863 struct frame *sf = XFRAME (selected_frame);
10865 val[0] = interrupt_input ? Qt : Qnil;
10866 if (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf))
10868 val[1] = FRAME_TTY (sf)->flow_control ? Qt : Qnil;
10869 val[2] = (FRAME_TTY (sf)->meta_key == 2
10870 ? make_number (0)
10871 : (CURTTY ()->meta_key == 1 ? Qt : Qnil));
10873 else
10875 val[1] = Qnil;
10876 val[2] = Qt;
10878 XSETFASTINT (val[3], quit_char);
10880 return Flist (ARRAYELTS (val), val);
10883 DEFUN ("posn-at-x-y", Fposn_at_x_y, Sposn_at_x_y, 2, 4, 0,
10884 doc: /* Return position information for pixel coordinates X and Y.
10885 By default, X and Y are relative to text area of the selected window.
10886 Optional third arg FRAME-OR-WINDOW non-nil specifies frame or window.
10887 If optional fourth arg WHOLE is non-nil, X is relative to the left
10888 edge of the window.
10890 The return value is similar to a mouse click position:
10891 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
10892 IMAGE (DX . DY) (WIDTH . HEIGHT))
10893 The `posn-' functions access elements of such lists. */)
10894 (Lisp_Object x, Lisp_Object y, Lisp_Object frame_or_window, Lisp_Object whole)
10896 CHECK_NATNUM (x);
10897 CHECK_NATNUM (y);
10899 if (NILP (frame_or_window))
10900 frame_or_window = selected_window;
10902 if (WINDOWP (frame_or_window))
10904 struct window *w = decode_live_window (frame_or_window);
10906 XSETINT (x, (XINT (x)
10907 + WINDOW_LEFT_EDGE_X (w)
10908 + (NILP (whole)
10909 ? window_box_left_offset (w, TEXT_AREA)
10910 : 0)));
10911 XSETINT (y, WINDOW_TO_FRAME_PIXEL_Y (w, XINT (y)));
10912 frame_or_window = w->frame;
10915 CHECK_LIVE_FRAME (frame_or_window);
10917 return make_lispy_position (XFRAME (frame_or_window), x, y, 0);
10920 DEFUN ("posn-at-point", Fposn_at_point, Sposn_at_point, 0, 2, 0,
10921 doc: /* Return position information for buffer POS in WINDOW.
10922 POS defaults to point in WINDOW; WINDOW defaults to the selected window.
10924 Return nil if position is not visible in window. Otherwise,
10925 the return value is similar to that returned by `event-start' for
10926 a mouse click at the upper left corner of the glyph corresponding
10927 to the given buffer position:
10928 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
10929 IMAGE (DX . DY) (WIDTH . HEIGHT))
10930 The `posn-' functions access elements of such lists. */)
10931 (Lisp_Object pos, Lisp_Object window)
10933 Lisp_Object tem;
10935 if (NILP (window))
10936 window = selected_window;
10938 tem = Fpos_visible_in_window_p (pos, window, Qt);
10939 if (!NILP (tem))
10941 Lisp_Object x = XCAR (tem);
10942 Lisp_Object y = XCAR (XCDR (tem));
10944 /* Point invisible due to hscrolling? */
10945 if (XINT (x) < 0)
10946 return Qnil;
10947 tem = Fposn_at_x_y (x, y, window, Qnil);
10950 return tem;
10953 /* Set up a new kboard object with reasonable initial values.
10954 TYPE is a window system for which this keyboard is used. */
10956 static void
10957 init_kboard (KBOARD *kb, Lisp_Object type)
10959 kset_overriding_terminal_local_map (kb, Qnil);
10960 kset_last_command (kb, Qnil);
10961 kset_real_last_command (kb, Qnil);
10962 kset_keyboard_translate_table (kb, Qnil);
10963 kset_last_repeatable_command (kb, Qnil);
10964 kset_prefix_arg (kb, Qnil);
10965 kset_last_prefix_arg (kb, Qnil);
10966 kset_kbd_queue (kb, Qnil);
10967 kb->kbd_queue_has_data = 0;
10968 kb->immediate_echo = 0;
10969 kset_echo_string (kb, Qnil);
10970 kb->echo_after_prompt = -1;
10971 kb->kbd_macro_buffer = 0;
10972 kb->kbd_macro_bufsize = 0;
10973 kset_defining_kbd_macro (kb, Qnil);
10974 kset_last_kbd_macro (kb, Qnil);
10975 kb->reference_count = 0;
10976 kset_system_key_alist (kb, Qnil);
10977 kset_system_key_syms (kb, Qnil);
10978 kset_window_system (kb, type);
10979 kset_input_decode_map (kb, Fmake_sparse_keymap (Qnil));
10980 kset_local_function_key_map (kb, Fmake_sparse_keymap (Qnil));
10981 Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map);
10982 kset_default_minibuffer_frame (kb, Qnil);
10985 /* Allocate and basically initialize keyboard
10986 object to use with window system TYPE. */
10988 KBOARD *
10989 allocate_kboard (Lisp_Object type)
10991 KBOARD *kb = xmalloc (sizeof *kb);
10993 init_kboard (kb, type);
10994 kb->next_kboard = all_kboards;
10995 all_kboards = kb;
10996 return kb;
11000 * Destroy the contents of a kboard object, but not the object itself.
11001 * We use this just before deleting it, or if we're going to initialize
11002 * it a second time.
11004 static void
11005 wipe_kboard (KBOARD *kb)
11007 xfree (kb->kbd_macro_buffer);
11010 /* Free KB and memory referenced from it. */
11012 void
11013 delete_kboard (KBOARD *kb)
11015 KBOARD **kbp;
11017 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
11018 if (*kbp == NULL)
11019 emacs_abort ();
11020 *kbp = kb->next_kboard;
11022 /* Prevent a dangling reference to KB. */
11023 if (kb == current_kboard
11024 && FRAMEP (selected_frame)
11025 && FRAME_LIVE_P (XFRAME (selected_frame)))
11027 current_kboard = FRAME_KBOARD (XFRAME (selected_frame));
11028 single_kboard = 0;
11029 if (current_kboard == kb)
11030 emacs_abort ();
11033 wipe_kboard (kb);
11034 xfree (kb);
11037 void
11038 init_keyboard (void)
11040 /* This is correct before outermost invocation of the editor loop. */
11041 command_loop_level = -1;
11042 immediate_quit = 0;
11043 quit_char = Ctl ('g');
11044 Vunread_command_events = Qnil;
11045 timer_idleness_start_time = invalid_timespec ();
11046 total_keys = 0;
11047 recent_keys_index = 0;
11048 kbd_fetch_ptr = kbd_buffer;
11049 kbd_store_ptr = kbd_buffer;
11050 do_mouse_tracking = Qnil;
11051 input_pending = 0;
11052 interrupt_input_blocked = 0;
11053 pending_signals = 0;
11055 /* This means that command_loop_1 won't try to select anything the first
11056 time through. */
11057 internal_last_event_frame = Qnil;
11058 Vlast_event_frame = internal_last_event_frame;
11060 current_kboard = initial_kboard;
11061 /* Re-initialize the keyboard again. */
11062 wipe_kboard (current_kboard);
11063 /* A value of nil for Vwindow_system normally means a tty, but we also use
11064 it for the initial terminal since there is no window system there. */
11065 init_kboard (current_kboard, Qnil);
11067 if (!noninteractive)
11069 /* Before multi-tty support, these handlers used to be installed
11070 only if the current session was a tty session. Now an Emacs
11071 session may have multiple display types, so we always handle
11072 SIGINT. There is special code in handle_interrupt_signal to exit
11073 Emacs on SIGINT when there are no termcap frames on the
11074 controlling terminal. */
11075 struct sigaction action;
11076 emacs_sigaction_init (&action, deliver_interrupt_signal);
11077 sigaction (SIGINT, &action, 0);
11078 #ifndef DOS_NT
11079 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
11080 SIGQUIT and we can't tell which one it will give us. */
11081 sigaction (SIGQUIT, &action, 0);
11082 #endif /* not DOS_NT */
11084 #ifdef USABLE_SIGIO
11085 if (!noninteractive)
11087 struct sigaction action;
11088 emacs_sigaction_init (&action, deliver_input_available_signal);
11089 sigaction (SIGIO, &action, 0);
11091 #endif
11093 /* Use interrupt input by default, if it works and noninterrupt input
11094 has deficiencies. */
11096 #ifdef INTERRUPT_INPUT
11097 interrupt_input = 1;
11098 #else
11099 interrupt_input = 0;
11100 #endif
11102 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
11103 dribble = 0;
11105 if (keyboard_init_hook)
11106 (*keyboard_init_hook) ();
11108 #ifdef POLL_FOR_INPUT
11109 poll_timer = NULL;
11110 poll_suppress_count = 1;
11111 start_polling ();
11112 #endif
11115 /* This type's only use is in syms_of_keyboard, to initialize the
11116 event header symbols and put properties on them. */
11117 struct event_head {
11118 Lisp_Object *var;
11119 const char *name;
11120 Lisp_Object *kind;
11123 static const struct event_head head_table[] = {
11124 {&Qmouse_movement, "mouse-movement", &Qmouse_movement},
11125 {&Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement},
11126 {&Qswitch_frame, "switch-frame", &Qswitch_frame},
11127 {&Qfocus_in, "focus-in", &Qfocus_in},
11128 {&Qfocus_out, "focus-out", &Qfocus_out},
11129 {&Qdelete_frame, "delete-frame", &Qdelete_frame},
11130 {&Qiconify_frame, "iconify-frame", &Qiconify_frame},
11131 {&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible},
11132 /* `select-window' should be handled just like `switch-frame'
11133 in read_key_sequence. */
11134 {&Qselect_window, "select-window", &Qswitch_frame}
11137 void
11138 syms_of_keyboard (void)
11140 pending_funcalls = Qnil;
11141 staticpro (&pending_funcalls);
11143 Vlispy_mouse_stem = build_pure_c_string ("mouse");
11144 staticpro (&Vlispy_mouse_stem);
11146 regular_top_level_message = build_pure_c_string ("Back to top level");
11147 #ifdef HAVE_STACK_OVERFLOW_HANDLING
11148 recover_top_level_message
11149 = build_pure_c_string ("Re-entering top level after C stack overflow");
11150 #endif
11151 DEFVAR_LISP ("internal--top-level-message", Vinternal__top_level_message,
11152 doc: /* Message displayed by `normal-top-level'. */);
11153 Vinternal__top_level_message = regular_top_level_message;
11155 /* Tool-bars. */
11156 DEFSYM (QCimage, ":image");
11157 DEFSYM (Qhelp_echo, "help-echo");
11158 DEFSYM (QCrtl, ":rtl");
11160 staticpro (&item_properties);
11161 item_properties = Qnil;
11163 staticpro (&tool_bar_item_properties);
11164 tool_bar_item_properties = Qnil;
11165 staticpro (&tool_bar_items_vector);
11166 tool_bar_items_vector = Qnil;
11168 DEFSYM (Qtimer_event_handler, "timer-event-handler");
11169 DEFSYM (Qdisabled_command_function, "disabled-command-function");
11170 DEFSYM (Qself_insert_command, "self-insert-command");
11171 DEFSYM (Qforward_char, "forward-char");
11172 DEFSYM (Qbackward_char, "backward-char");
11173 DEFSYM (Qdisabled, "disabled");
11174 DEFSYM (Qundefined, "undefined");
11175 DEFSYM (Qpre_command_hook, "pre-command-hook");
11176 DEFSYM (Qpost_command_hook, "post-command-hook");
11177 DEFSYM (Qdeferred_action_function, "deferred-action-function");
11178 DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook");
11179 DEFSYM (Qfunction_key, "function-key");
11180 DEFSYM (Qmouse_click, "mouse-click");
11181 DEFSYM (Qdrag_n_drop, "drag-n-drop");
11182 DEFSYM (Qsave_session, "save-session");
11183 DEFSYM (Qconfig_changed_event, "config-changed-event");
11184 DEFSYM (Qmenu_enable, "menu-enable");
11186 #ifdef HAVE_NTGUI
11187 DEFSYM (Qlanguage_change, "language-change");
11188 #endif
11190 #ifdef HAVE_DBUS
11191 DEFSYM (Qdbus_event, "dbus-event");
11192 #endif
11194 #ifdef USE_FILE_NOTIFY
11195 DEFSYM (Qfile_notify, "file-notify");
11196 #endif /* USE_FILE_NOTIFY */
11198 DEFSYM (QCenable, ":enable");
11199 DEFSYM (QCvisible, ":visible");
11200 DEFSYM (QChelp, ":help");
11201 DEFSYM (QCfilter, ":filter");
11202 DEFSYM (QCbutton, ":button");
11203 DEFSYM (QCkeys, ":keys");
11204 DEFSYM (QCkey_sequence, ":key-sequence");
11205 DEFSYM (QCtoggle, ":toggle");
11206 DEFSYM (QCradio, ":radio");
11207 DEFSYM (QClabel, ":label");
11208 DEFSYM (QCvert_only, ":vert-only");
11210 DEFSYM (Qmode_line, "mode-line");
11211 DEFSYM (Qvertical_line, "vertical-line");
11212 DEFSYM (Qmenu_bar, "menu-bar");
11213 DEFSYM (Qright_divider, "right-divider");
11214 DEFSYM (Qbottom_divider, "bottom-divider");
11216 DEFSYM (Qmouse_fixup_help_message, "mouse-fixup-help-message");
11218 DEFSYM (Qabove_handle, "above-handle");
11219 DEFSYM (Qhandle, "handle");
11220 DEFSYM (Qbelow_handle, "below-handle");
11221 DEFSYM (Qup, "up");
11222 DEFSYM (Qdown, "down");
11223 DEFSYM (Qtop, "top");
11224 DEFSYM (Qbottom, "bottom");
11225 DEFSYM (Qend_scroll, "end-scroll");
11226 DEFSYM (Qratio, "ratio");
11227 DEFSYM (Qbefore_handle, "before-handle");
11228 DEFSYM (Qhorizontal_handle, "horizontal-handle");
11229 DEFSYM (Qafter_handle, "after-handle");
11230 DEFSYM (Qleft, "left");
11231 DEFSYM (Qright, "right");
11232 DEFSYM (Qleftmost, "leftmost");
11233 DEFSYM (Qrightmost, "rightmost");
11235 DEFSYM (Qevent_kind, "event-kind");
11236 DEFSYM (Qevent_symbol_elements, "event-symbol-elements");
11237 DEFSYM (Qevent_symbol_element_mask, "event-symbol-element-mask");
11238 DEFSYM (Qmodifier_cache, "modifier-cache");
11240 DEFSYM (Qrecompute_lucid_menubar, "recompute-lucid-menubar");
11241 DEFSYM (Qactivate_menubar_hook, "activate-menubar-hook");
11243 DEFSYM (Qpolling_period, "polling-period");
11245 DEFSYM (Qgui_set_selection, "gui-set-selection");
11246 DEFSYM (QPRIMARY, "PRIMARY");
11247 DEFSYM (Qhandle_switch_frame, "handle-switch-frame");
11248 DEFSYM (Qhandle_select_window, "handle-select-window");
11250 DEFSYM (Qinput_method_function, "input-method-function");
11251 DEFSYM (Qinput_method_exit_on_first_char, "input-method-exit-on-first-char");
11252 DEFSYM (Qinput_method_use_echo_area, "input-method-use-echo-area");
11254 DEFSYM (Qhelp_form_show, "help-form-show");
11256 DEFSYM (Qecho_keystrokes, "echo-keystrokes");
11258 Fset (Qinput_method_exit_on_first_char, Qnil);
11259 Fset (Qinput_method_use_echo_area, Qnil);
11262 int i;
11263 int len = ARRAYELTS (head_table);
11265 for (i = 0; i < len; i++)
11267 const struct event_head *p = &head_table[i];
11268 *p->var = intern_c_string (p->name);
11269 staticpro (p->var);
11270 Fput (*p->var, Qevent_kind, *p->kind);
11271 Fput (*p->var, Qevent_symbol_elements, list1 (*p->var));
11275 button_down_location = Fmake_vector (make_number (5), Qnil);
11276 staticpro (&button_down_location);
11277 mouse_syms = Fmake_vector (make_number (5), Qnil);
11278 staticpro (&mouse_syms);
11279 wheel_syms = Fmake_vector (make_number (ARRAYELTS (lispy_wheel_names)),
11280 Qnil);
11281 staticpro (&wheel_syms);
11284 int i;
11285 int len = ARRAYELTS (modifier_names);
11287 modifier_symbols = Fmake_vector (make_number (len), Qnil);
11288 for (i = 0; i < len; i++)
11289 if (modifier_names[i])
11290 ASET (modifier_symbols, i, intern_c_string (modifier_names[i]));
11291 staticpro (&modifier_symbols);
11294 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
11295 staticpro (&recent_keys);
11297 this_command_keys = Fmake_vector (make_number (40), Qnil);
11298 staticpro (&this_command_keys);
11300 raw_keybuf = Fmake_vector (make_number (30), Qnil);
11301 staticpro (&raw_keybuf);
11303 DEFSYM (Qcommand_execute, "command-execute");
11305 accent_key_syms = Qnil;
11306 staticpro (&accent_key_syms);
11308 func_key_syms = Qnil;
11309 staticpro (&func_key_syms);
11311 drag_n_drop_syms = Qnil;
11312 staticpro (&drag_n_drop_syms);
11314 unread_switch_frame = Qnil;
11315 staticpro (&unread_switch_frame);
11317 internal_last_event_frame = Qnil;
11318 staticpro (&internal_last_event_frame);
11320 read_key_sequence_cmd = Qnil;
11321 staticpro (&read_key_sequence_cmd);
11322 read_key_sequence_remapped = Qnil;
11323 staticpro (&read_key_sequence_remapped);
11325 menu_bar_one_keymap_changed_items = Qnil;
11326 staticpro (&menu_bar_one_keymap_changed_items);
11328 menu_bar_items_vector = Qnil;
11329 staticpro (&menu_bar_items_vector);
11331 help_form_saved_window_configs = Qnil;
11332 staticpro (&help_form_saved_window_configs);
11334 defsubr (&Scurrent_idle_time);
11335 defsubr (&Sevent_symbol_parse_modifiers);
11336 defsubr (&Sevent_convert_list);
11337 defsubr (&Sread_key_sequence);
11338 defsubr (&Sread_key_sequence_vector);
11339 defsubr (&Srecursive_edit);
11340 defsubr (&Strack_mouse);
11341 defsubr (&Sinput_pending_p);
11342 defsubr (&Srecent_keys);
11343 defsubr (&Sthis_command_keys);
11344 defsubr (&Sthis_command_keys_vector);
11345 defsubr (&Sthis_single_command_keys);
11346 defsubr (&Sthis_single_command_raw_keys);
11347 defsubr (&Sreset_this_command_lengths);
11348 defsubr (&Sclear_this_command_keys);
11349 defsubr (&Ssuspend_emacs);
11350 defsubr (&Sabort_recursive_edit);
11351 defsubr (&Sexit_recursive_edit);
11352 defsubr (&Srecursion_depth);
11353 defsubr (&Scommand_error_default_function);
11354 defsubr (&Stop_level);
11355 defsubr (&Sdiscard_input);
11356 defsubr (&Sopen_dribble_file);
11357 defsubr (&Sset_input_interrupt_mode);
11358 defsubr (&Sset_output_flow_control);
11359 defsubr (&Sset_input_meta_mode);
11360 defsubr (&Sset_quit_char);
11361 defsubr (&Sset_input_mode);
11362 defsubr (&Scurrent_input_mode);
11363 defsubr (&Sposn_at_point);
11364 defsubr (&Sposn_at_x_y);
11366 DEFVAR_LISP ("last-command-event", last_command_event,
11367 doc: /* Last input event that was part of a command. */);
11369 DEFVAR_LISP ("last-nonmenu-event", last_nonmenu_event,
11370 doc: /* Last input event in a command, except for mouse menu events.
11371 Mouse menus give back keys that don't look like mouse events;
11372 this variable holds the actual mouse event that led to the menu,
11373 so that you can determine whether the command was run by mouse or not. */);
11375 DEFVAR_LISP ("last-input-event", last_input_event,
11376 doc: /* Last input event. */);
11378 DEFVAR_LISP ("unread-command-events", Vunread_command_events,
11379 doc: /* List of events to be read as the command input.
11380 These events are processed first, before actual keyboard input.
11381 Events read from this list are not normally added to `this-command-keys',
11382 as they will already have been added once as they were read for the first time.
11383 An element of the form (t . EVENT) forces EVENT to be added to that list. */);
11384 Vunread_command_events = Qnil;
11386 DEFVAR_LISP ("unread-post-input-method-events", Vunread_post_input_method_events,
11387 doc: /* List of events to be processed as input by input methods.
11388 These events are processed before `unread-command-events'
11389 and actual keyboard input, but are not given to `input-method-function'. */);
11390 Vunread_post_input_method_events = Qnil;
11392 DEFVAR_LISP ("unread-input-method-events", Vunread_input_method_events,
11393 doc: /* List of events to be processed as input by input methods.
11394 These events are processed after `unread-command-events', but
11395 before actual keyboard input.
11396 If there's an active input method, the events are given to
11397 `input-method-function'. */);
11398 Vunread_input_method_events = Qnil;
11400 DEFVAR_LISP ("meta-prefix-char", meta_prefix_char,
11401 doc: /* Meta-prefix character code.
11402 Meta-foo as command input turns into this character followed by foo. */);
11403 XSETINT (meta_prefix_char, 033);
11405 DEFVAR_KBOARD ("last-command", Vlast_command,
11406 doc: /* The last command executed.
11407 Normally a symbol with a function definition, but can be whatever was found
11408 in the keymap, or whatever the variable `this-command' was set to by that
11409 command.
11411 The value `mode-exit' is special; it means that the previous command
11412 read an event that told it to exit, and it did so and unread that event.
11413 In other words, the present command is the event that made the previous
11414 command exit.
11416 The value `kill-region' is special; it means that the previous command
11417 was a kill command.
11419 `last-command' has a separate binding for each terminal device.
11420 See Info node `(elisp)Multiple Terminals'. */);
11422 DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
11423 doc: /* Same as `last-command', but never altered by Lisp code.
11424 Taken from the previous value of `real-this-command'. */);
11426 DEFVAR_KBOARD ("last-repeatable-command", Vlast_repeatable_command,
11427 doc: /* Last command that may be repeated.
11428 The last command executed that was not bound to an input event.
11429 This is the command `repeat' will try to repeat.
11430 Taken from a previous value of `real-this-command'. */);
11432 DEFVAR_LISP ("this-command", Vthis_command,
11433 doc: /* The command now being executed.
11434 The command can set this variable; whatever is put here
11435 will be in `last-command' during the following command. */);
11436 Vthis_command = Qnil;
11438 DEFVAR_LISP ("real-this-command", Vreal_this_command,
11439 doc: /* This is like `this-command', except that commands should never modify it. */);
11440 Vreal_this_command = Qnil;
11442 DEFVAR_LISP ("this-command-keys-shift-translated",
11443 Vthis_command_keys_shift_translated,
11444 doc: /* Non-nil if the key sequence activating this command was shift-translated.
11445 Shift-translation occurs when there is no binding for the key sequence
11446 as entered, but a binding was found by changing an upper-case letter
11447 to lower-case, or a shifted function key to an unshifted one. */);
11448 Vthis_command_keys_shift_translated = Qnil;
11450 DEFVAR_LISP ("this-original-command", Vthis_original_command,
11451 doc: /* The command bound to the current key sequence before remapping.
11452 It equals `this-command' if the original command was not remapped through
11453 any of the active keymaps. Otherwise, the value of `this-command' is the
11454 result of looking up the original command in the active keymaps. */);
11455 Vthis_original_command = Qnil;
11457 DEFVAR_INT ("auto-save-interval", auto_save_interval,
11458 doc: /* Number of input events between auto-saves.
11459 Zero means disable autosaving due to number of characters typed. */);
11460 auto_save_interval = 300;
11462 DEFVAR_LISP ("auto-save-timeout", Vauto_save_timeout,
11463 doc: /* Number of seconds idle time before auto-save.
11464 Zero or nil means disable auto-saving due to idleness.
11465 After auto-saving due to this many seconds of idle time,
11466 Emacs also does a garbage collection if that seems to be warranted. */);
11467 XSETFASTINT (Vauto_save_timeout, 30);
11469 DEFVAR_LISP ("echo-keystrokes", Vecho_keystrokes,
11470 doc: /* Nonzero means echo unfinished commands after this many seconds of pause.
11471 The value may be integer or floating point.
11472 If the value is zero, don't echo at all. */);
11473 Vecho_keystrokes = make_number (1);
11475 DEFVAR_INT ("polling-period", polling_period,
11476 doc: /* Interval between polling for input during Lisp execution.
11477 The reason for polling is to make C-g work to stop a running program.
11478 Polling is needed only when using X windows and SIGIO does not work.
11479 Polling is automatically disabled in all other cases. */);
11480 polling_period = 2;
11482 DEFVAR_LISP ("double-click-time", Vdouble_click_time,
11483 doc: /* Maximum time between mouse clicks to make a double-click.
11484 Measured in milliseconds. The value nil means disable double-click
11485 recognition; t means double-clicks have no time limit and are detected
11486 by position only. */);
11487 Vdouble_click_time = make_number (500);
11489 DEFVAR_INT ("double-click-fuzz", double_click_fuzz,
11490 doc: /* Maximum mouse movement between clicks to make a double-click.
11491 On window-system frames, value is the number of pixels the mouse may have
11492 moved horizontally or vertically between two clicks to make a double-click.
11493 On non window-system frames, value is interpreted in units of 1/8 characters
11494 instead of pixels.
11496 This variable is also the threshold for motion of the mouse
11497 to count as a drag. */);
11498 double_click_fuzz = 3;
11500 DEFVAR_INT ("num-input-keys", num_input_keys,
11501 doc: /* Number of complete key sequences read as input so far.
11502 This includes key sequences read from keyboard macros.
11503 The number is effectively the number of interactive command invocations. */);
11504 num_input_keys = 0;
11506 DEFVAR_INT ("num-nonmacro-input-events", num_nonmacro_input_events,
11507 doc: /* Number of input events read from the keyboard so far.
11508 This does not include events generated by keyboard macros. */);
11509 num_nonmacro_input_events = 0;
11511 DEFVAR_LISP ("last-event-frame", Vlast_event_frame,
11512 doc: /* The frame in which the most recently read event occurred.
11513 If the last event came from a keyboard macro, this is set to `macro'. */);
11514 Vlast_event_frame = Qnil;
11516 /* This variable is set up in sysdep.c. */
11517 DEFVAR_LISP ("tty-erase-char", Vtty_erase_char,
11518 doc: /* The ERASE character as set by the user with stty. */);
11520 DEFVAR_LISP ("help-char", Vhelp_char,
11521 doc: /* Character to recognize as meaning Help.
11522 When it is read, do `(eval help-form)', and display result if it's a string.
11523 If the value of `help-form' is nil, this char can be read normally. */);
11524 XSETINT (Vhelp_char, Ctl ('H'));
11526 DEFVAR_LISP ("help-event-list", Vhelp_event_list,
11527 doc: /* List of input events to recognize as meaning Help.
11528 These work just like the value of `help-char' (see that). */);
11529 Vhelp_event_list = Qnil;
11531 DEFVAR_LISP ("help-form", Vhelp_form,
11532 doc: /* Form to execute when character `help-char' is read.
11533 If the form returns a string, that string is displayed.
11534 If `help-form' is nil, the help char is not recognized. */);
11535 Vhelp_form = Qnil;
11537 DEFVAR_LISP ("prefix-help-command", Vprefix_help_command,
11538 doc: /* Command to run when `help-char' character follows a prefix key.
11539 This command is used only when there is no actual binding
11540 for that character after that prefix key. */);
11541 Vprefix_help_command = Qnil;
11543 DEFVAR_LISP ("top-level", Vtop_level,
11544 doc: /* Form to evaluate when Emacs starts up.
11545 Useful to set before you dump a modified Emacs. */);
11546 Vtop_level = Qnil;
11548 DEFVAR_KBOARD ("keyboard-translate-table", Vkeyboard_translate_table,
11549 doc: /* Translate table for local keyboard input, or nil.
11550 If non-nil, the value should be a char-table. Each character read
11551 from the keyboard is looked up in this char-table. If the value found
11552 there is non-nil, then it is used instead of the actual input character.
11554 The value can also be a string or vector, but this is considered obsolete.
11555 If it is a string or vector of length N, character codes N and up are left
11556 untranslated. In a vector, an element which is nil means "no translation".
11558 This is applied to the characters supplied to input methods, not their
11559 output. See also `translation-table-for-input'.
11561 This variable has a separate binding for each terminal.
11562 See Info node `(elisp)Multiple Terminals'. */);
11564 DEFVAR_BOOL ("cannot-suspend", cannot_suspend,
11565 doc: /* Non-nil means to always spawn a subshell instead of suspending.
11566 \(Even if the operating system has support for stopping a process.\) */);
11567 cannot_suspend = 0;
11569 DEFVAR_BOOL ("menu-prompting", menu_prompting,
11570 doc: /* Non-nil means prompt with menus when appropriate.
11571 This is done when reading from a keymap that has a prompt string,
11572 for elements that have prompt strings.
11573 The menu is displayed on the screen
11574 if X menus were enabled at configuration
11575 time and the previous event was a mouse click prefix key.
11576 Otherwise, menu prompting uses the echo area. */);
11577 menu_prompting = 1;
11579 DEFVAR_LISP ("menu-prompt-more-char", menu_prompt_more_char,
11580 doc: /* Character to see next line of menu prompt.
11581 Type this character while in a menu prompt to rotate around the lines of it. */);
11582 XSETINT (menu_prompt_more_char, ' ');
11584 DEFVAR_INT ("extra-keyboard-modifiers", extra_keyboard_modifiers,
11585 doc: /* A mask of additional modifier keys to use with every keyboard character.
11586 Emacs applies the modifiers of the character stored here to each keyboard
11587 character it reads. For example, after evaluating the expression
11588 (setq extra-keyboard-modifiers ?\\C-x)
11589 all input characters will have the control modifier applied to them.
11591 Note that the character ?\\C-@, equivalent to the integer zero, does
11592 not count as a control character; rather, it counts as a character
11593 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero
11594 cancels any modification. */);
11595 extra_keyboard_modifiers = 0;
11597 DEFVAR_LISP ("deactivate-mark", Vdeactivate_mark,
11598 doc: /* If an editing command sets this to t, deactivate the mark afterward.
11599 The command loop sets this to nil before each command,
11600 and tests the value when the command returns.
11601 Buffer modification stores t in this variable. */);
11602 Vdeactivate_mark = Qnil;
11603 DEFSYM (Qdeactivate_mark, "deactivate-mark");
11604 Fmake_variable_buffer_local (Qdeactivate_mark);
11606 DEFVAR_LISP ("pre-command-hook", Vpre_command_hook,
11607 doc: /* Normal hook run before each command is executed.
11608 If an unhandled error happens in running this hook,
11609 the function in which the error occurred is unconditionally removed, since
11610 otherwise the error might happen repeatedly and make Emacs nonfunctional. */);
11611 Vpre_command_hook = Qnil;
11613 DEFVAR_LISP ("post-command-hook", Vpost_command_hook,
11614 doc: /* Normal hook run after each command is executed.
11615 If an unhandled error happens in running this hook,
11616 the function in which the error occurred is unconditionally removed, since
11617 otherwise the error might happen repeatedly and make Emacs nonfunctional. */);
11618 Vpost_command_hook = Qnil;
11620 #if 0
11621 DEFVAR_LISP ("echo-area-clear-hook", ...,
11622 doc: /* Normal hook run when clearing the echo area. */);
11623 #endif
11624 DEFSYM (Qecho_area_clear_hook, "echo-area-clear-hook");
11625 Fset (Qecho_area_clear_hook, Qnil);
11627 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", Vlucid_menu_bar_dirty_flag,
11628 doc: /* Non-nil means menu bar, specified Lucid style, needs to be recomputed. */);
11629 Vlucid_menu_bar_dirty_flag = Qnil;
11631 DEFVAR_LISP ("menu-bar-final-items", Vmenu_bar_final_items,
11632 doc: /* List of menu bar items to move to the end of the menu bar.
11633 The elements of the list are event types that may have menu bar bindings. */);
11634 Vmenu_bar_final_items = Qnil;
11636 DEFVAR_LISP ("tool-bar-separator-image-expression", Vtool_bar_separator_image_expression,
11637 doc: /* Expression evaluating to the image spec for a tool-bar separator.
11638 This is used internally by graphical displays that do not render
11639 tool-bar separators natively. Otherwise it is unused (e.g. on GTK). */);
11640 Vtool_bar_separator_image_expression = Qnil;
11642 DEFVAR_KBOARD ("overriding-terminal-local-map",
11643 Voverriding_terminal_local_map,
11644 doc: /* Per-terminal keymap that takes precedence over all other keymaps.
11645 This variable is intended to let commands such as `universal-argument'
11646 set up a different keymap for reading the next command.
11648 `overriding-terminal-local-map' has a separate binding for each
11649 terminal device. See Info node `(elisp)Multiple Terminals'. */);
11651 DEFVAR_LISP ("overriding-local-map", Voverriding_local_map,
11652 doc: /* Keymap that replaces (overrides) local keymaps.
11653 If this variable is non-nil, Emacs looks up key bindings in this
11654 keymap INSTEAD OF the keymap char property, minor mode maps, and the
11655 buffer's local map. Hence, the only active keymaps would be
11656 `overriding-terminal-local-map', this keymap, and `global-keymap', in
11657 order of precedence. */);
11658 Voverriding_local_map = Qnil;
11660 DEFVAR_LISP ("overriding-local-map-menu-flag", Voverriding_local_map_menu_flag,
11661 doc: /* Non-nil means `overriding-local-map' applies to the menu bar.
11662 Otherwise, the menu bar continues to reflect the buffer's local map
11663 and the minor mode maps regardless of `overriding-local-map'. */);
11664 Voverriding_local_map_menu_flag = Qnil;
11666 DEFVAR_LISP ("special-event-map", Vspecial_event_map,
11667 doc: /* Keymap defining bindings for special events to execute at low level. */);
11668 Vspecial_event_map = list1 (intern_c_string ("keymap"));
11670 DEFVAR_LISP ("track-mouse", do_mouse_tracking,
11671 doc: /* Non-nil means generate motion events for mouse motion. */);
11673 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
11674 doc: /* Alist of system-specific X windows key symbols.
11675 Each element should have the form (N . SYMBOL) where N is the
11676 numeric keysym code (sans the \"system-specific\" bit 1<<28)
11677 and SYMBOL is its name.
11679 `system-key-alist' has a separate binding for each terminal device.
11680 See Info node `(elisp)Multiple Terminals'. */);
11682 DEFVAR_KBOARD ("local-function-key-map", Vlocal_function_key_map,
11683 doc: /* Keymap that translates key sequences to key sequences during input.
11684 This is used mainly for mapping key sequences into some preferred
11685 key events (symbols).
11687 The `read-key-sequence' function replaces any subsequence bound by
11688 `local-function-key-map' with its binding. More precisely, when the
11689 active keymaps have no binding for the current key sequence but
11690 `local-function-key-map' binds a suffix of the sequence to a vector or
11691 string, `read-key-sequence' replaces the matching suffix with its
11692 binding, and continues with the new sequence.
11694 If the binding is a function, it is called with one argument (the prompt)
11695 and its return value (a key sequence) is used.
11697 The events that come from bindings in `local-function-key-map' are not
11698 themselves looked up in `local-function-key-map'.
11700 For example, suppose `local-function-key-map' binds `ESC O P' to [f1].
11701 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
11702 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix key,
11703 typing `ESC O P x' would return [f1 x].
11705 `local-function-key-map' has a separate binding for each terminal
11706 device. See Info node `(elisp)Multiple Terminals'. If you need to
11707 define a binding on all terminals, change `function-key-map'
11708 instead. Initially, `local-function-key-map' is an empty keymap that
11709 has `function-key-map' as its parent on all terminal devices. */);
11711 DEFVAR_KBOARD ("input-decode-map", Vinput_decode_map,
11712 doc: /* Keymap that decodes input escape sequences.
11713 This is used mainly for mapping ASCII function key sequences into
11714 real Emacs function key events (symbols).
11716 The `read-key-sequence' function replaces any subsequence bound by
11717 `input-decode-map' with its binding. Contrary to `function-key-map',
11718 this map applies its rebinding regardless of the presence of an ordinary
11719 binding. So it is more like `key-translation-map' except that it applies
11720 before `function-key-map' rather than after.
11722 If the binding is a function, it is called with one argument (the prompt)
11723 and its return value (a key sequence) is used.
11725 The events that come from bindings in `input-decode-map' are not
11726 themselves looked up in `input-decode-map'. */);
11728 DEFVAR_LISP ("function-key-map", Vfunction_key_map,
11729 doc: /* The parent keymap of all `local-function-key-map' instances.
11730 Function key definitions that apply to all terminal devices should go
11731 here. If a mapping is defined in both the current
11732 `local-function-key-map' binding and this variable, then the local
11733 definition will take precedence. */);
11734 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
11736 DEFVAR_LISP ("key-translation-map", Vkey_translation_map,
11737 doc: /* Keymap of key translations that can override keymaps.
11738 This keymap works like `input-decode-map', but comes after `function-key-map'.
11739 Another difference is that it is global rather than terminal-local. */);
11740 Vkey_translation_map = Fmake_sparse_keymap (Qnil);
11742 DEFVAR_LISP ("deferred-action-list", Vdeferred_action_list,
11743 doc: /* List of deferred actions to be performed at a later time.
11744 The precise format isn't relevant here; we just check whether it is nil. */);
11745 Vdeferred_action_list = Qnil;
11747 DEFVAR_LISP ("deferred-action-function", Vdeferred_action_function,
11748 doc: /* Function to call to handle deferred actions, after each command.
11749 This function is called with no arguments after each command
11750 whenever `deferred-action-list' is non-nil. */);
11751 Vdeferred_action_function = Qnil;
11753 DEFVAR_LISP ("delayed-warnings-list", Vdelayed_warnings_list,
11754 doc: /* List of warnings to be displayed after this command.
11755 Each element must be a list (TYPE MESSAGE [LEVEL [BUFFER-NAME]]),
11756 as per the args of `display-warning' (which see).
11757 If this variable is non-nil, `delayed-warnings-hook' will be run
11758 immediately after running `post-command-hook'. */);
11759 Vdelayed_warnings_list = Qnil;
11761 DEFVAR_LISP ("timer-list", Vtimer_list,
11762 doc: /* List of active absolute time timers in order of increasing time. */);
11763 Vtimer_list = Qnil;
11765 DEFVAR_LISP ("timer-idle-list", Vtimer_idle_list,
11766 doc: /* List of active idle-time timers in order of increasing time. */);
11767 Vtimer_idle_list = Qnil;
11769 DEFVAR_LISP ("input-method-function", Vinput_method_function,
11770 doc: /* If non-nil, the function that implements the current input method.
11771 It's called with one argument, a printing character that was just read.
11772 \(That means a character with code 040...0176.)
11773 Typically this function uses `read-event' to read additional events.
11774 When it does so, it should first bind `input-method-function' to nil
11775 so it will not be called recursively.
11777 The function should return a list of zero or more events
11778 to be used as input. If it wants to put back some events
11779 to be reconsidered, separately, by the input method,
11780 it can add them to the beginning of `unread-command-events'.
11782 The input method function can find in `input-method-previous-message'
11783 the previous echo area message.
11785 The input method function should refer to the variables
11786 `input-method-use-echo-area' and `input-method-exit-on-first-char'
11787 for guidance on what to do. */);
11788 Vinput_method_function = Qnil;
11790 DEFVAR_LISP ("input-method-previous-message",
11791 Vinput_method_previous_message,
11792 doc: /* When `input-method-function' is called, hold the previous echo area message.
11793 This variable exists because `read-event' clears the echo area
11794 before running the input method. It is nil if there was no message. */);
11795 Vinput_method_previous_message = Qnil;
11797 DEFVAR_LISP ("show-help-function", Vshow_help_function,
11798 doc: /* If non-nil, the function that implements the display of help.
11799 It's called with one argument, the help string to display. */);
11800 Vshow_help_function = Qnil;
11802 DEFVAR_LISP ("disable-point-adjustment", Vdisable_point_adjustment,
11803 doc: /* If non-nil, suppress point adjustment after executing a command.
11805 After a command is executed, if point is moved into a region that has
11806 special properties (e.g. composition, display), we adjust point to
11807 the boundary of the region. But, when a command sets this variable to
11808 non-nil, we suppress the point adjustment.
11810 This variable is set to nil before reading a command, and is checked
11811 just after executing the command. */);
11812 Vdisable_point_adjustment = Qnil;
11814 DEFVAR_LISP ("global-disable-point-adjustment",
11815 Vglobal_disable_point_adjustment,
11816 doc: /* If non-nil, always suppress point adjustment.
11818 The default value is nil, in which case, point adjustment are
11819 suppressed only after special commands that set
11820 `disable-point-adjustment' (which see) to non-nil. */);
11821 Vglobal_disable_point_adjustment = Qnil;
11823 DEFVAR_LISP ("minibuffer-message-timeout", Vminibuffer_message_timeout,
11824 doc: /* How long to display an echo-area message when the minibuffer is active.
11825 If the value is not a number, such messages don't time out. */);
11826 Vminibuffer_message_timeout = make_number (2);
11828 DEFVAR_LISP ("throw-on-input", Vthrow_on_input,
11829 doc: /* If non-nil, any keyboard input throws to this symbol.
11830 The value of that variable is passed to `quit-flag' and later causes a
11831 peculiar kind of quitting. */);
11832 Vthrow_on_input = Qnil;
11834 DEFVAR_LISP ("command-error-function", Vcommand_error_function,
11835 doc: /* Function to output error messages.
11836 Called with three arguments:
11837 - the error data, a list of the form (SIGNALED-CONDITION . SIGNAL-DATA)
11838 such as what `condition-case' would bind its variable to,
11839 - the context (a string which normally goes at the start of the message),
11840 - the Lisp function within which the error was signaled. */);
11841 Vcommand_error_function = intern ("command-error-default-function");
11843 DEFVAR_LISP ("enable-disabled-menus-and-buttons",
11844 Venable_disabled_menus_and_buttons,
11845 doc: /* If non-nil, don't ignore events produced by disabled menu items and tool-bar.
11847 Help functions bind this to allow help on disabled menu items
11848 and tool-bar buttons. */);
11849 Venable_disabled_menus_and_buttons = Qnil;
11851 DEFVAR_LISP ("select-active-regions",
11852 Vselect_active_regions,
11853 doc: /* If non-nil, an active region automatically sets the primary selection.
11854 If the value is `only', only temporarily active regions (usually made
11855 by mouse-dragging or shift-selection) set the window selection.
11857 This takes effect only when Transient Mark mode is enabled. */);
11858 Vselect_active_regions = Qt;
11860 DEFVAR_LISP ("saved-region-selection",
11861 Vsaved_region_selection,
11862 doc: /* Contents of active region prior to buffer modification.
11863 If `select-active-regions' is non-nil, Emacs sets this to the
11864 text in the region before modifying the buffer. The next call to
11865 the function `deactivate-mark' uses this to set the window selection. */);
11866 Vsaved_region_selection = Qnil;
11868 DEFVAR_LISP ("selection-inhibit-update-commands",
11869 Vselection_inhibit_update_commands,
11870 doc: /* List of commands which should not update the selection.
11871 Normally, if `select-active-regions' is non-nil and the mark remains
11872 active after a command (i.e. the mark was not deactivated), the Emacs
11873 command loop sets the selection to the text in the region. However,
11874 if the command is in this list, the selection is not updated. */);
11875 Vselection_inhibit_update_commands
11876 = list2 (Qhandle_switch_frame, Qhandle_select_window);
11878 DEFVAR_LISP ("debug-on-event",
11879 Vdebug_on_event,
11880 doc: /* Enter debugger on this event. When Emacs
11881 receives the special event specified by this variable, it will try to
11882 break into the debugger as soon as possible instead of processing the
11883 event normally through `special-event-map'.
11885 Currently, the only supported values for this
11886 variable are `sigusr1' and `sigusr2'. */);
11887 Vdebug_on_event = intern_c_string ("sigusr2");
11889 /* Create the initial keyboard. Qt means 'unset'. */
11890 initial_kboard = allocate_kboard (Qt);
11893 void
11894 keys_of_keyboard (void)
11896 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
11897 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
11898 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
11899 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
11900 initial_define_key (meta_map, 'x', "execute-extended-command");
11902 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
11903 "handle-delete-frame");
11904 initial_define_lispy_key (Vspecial_event_map, "ns-put-working-text",
11905 "ns-put-working-text");
11906 initial_define_lispy_key (Vspecial_event_map, "ns-unput-working-text",
11907 "ns-unput-working-text");
11908 /* Here we used to use `ignore-event' which would simple set prefix-arg to
11909 current-prefix-arg, as is done in `handle-switch-frame'.
11910 But `handle-switch-frame is not run from the special-map.
11911 Commands from that map are run in a special way that automatically
11912 preserves the prefix-arg. Restoring the prefix arg here is not just
11913 redundant but harmful:
11914 - C-u C-x v =
11915 - current-prefix-arg is set to non-nil, prefix-arg is set to nil.
11916 - after the first prompt, the exit-minibuffer-hook is run which may
11917 iconify a frame and thus push a `iconify-frame' event.
11918 - after running exit-minibuffer-hook, current-prefix-arg is
11919 restored to the non-nil value it had before the prompt.
11920 - we enter the second prompt.
11921 current-prefix-arg is non-nil, prefix-arg is nil.
11922 - before running the first real event, we run the special iconify-frame
11923 event, but we pass the `special' arg to command-execute so
11924 current-prefix-arg and prefix-arg are left untouched.
11925 - here we foolishly copy the non-nil current-prefix-arg to prefix-arg.
11926 - the next key event will have a spuriously non-nil current-prefix-arg. */
11927 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
11928 "ignore");
11929 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
11930 "ignore");
11931 /* Handling it at such a low-level causes read_key_sequence to get
11932 * confused because it doesn't realize that the current_buffer was
11933 * changed by read_char.
11935 * initial_define_lispy_key (Vspecial_event_map, "select-window",
11936 * "handle-select-window"); */
11937 initial_define_lispy_key (Vspecial_event_map, "save-session",
11938 "handle-save-session");
11940 #ifdef HAVE_DBUS
11941 /* Define a special event which is raised for dbus callback
11942 functions. */
11943 initial_define_lispy_key (Vspecial_event_map, "dbus-event",
11944 "dbus-handle-event");
11945 #endif
11947 #ifdef USE_FILE_NOTIFY
11948 /* Define a special event which is raised for notification callback
11949 functions. */
11950 initial_define_lispy_key (Vspecial_event_map, "file-notify",
11951 "file-notify-handle-event");
11952 #endif /* USE_FILE_NOTIFY */
11954 initial_define_lispy_key (Vspecial_event_map, "config-changed-event",
11955 "ignore");
11956 #if defined (WINDOWSNT)
11957 initial_define_lispy_key (Vspecial_event_map, "language-change",
11958 "ignore");
11959 #endif
11960 initial_define_lispy_key (Vspecial_event_map, "focus-in",
11961 "handle-focus-in");
11962 initial_define_lispy_key (Vspecial_event_map, "focus-out",
11963 "handle-focus-out");
11966 /* Mark the pointers in the kboard objects.
11967 Called by Fgarbage_collect. */
11968 void
11969 mark_kboards (void)
11971 KBOARD *kb;
11972 Lisp_Object *p;
11973 for (kb = all_kboards; kb; kb = kb->next_kboard)
11975 if (kb->kbd_macro_buffer)
11976 for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
11977 mark_object (*p);
11978 mark_object (KVAR (kb, Voverriding_terminal_local_map));
11979 mark_object (KVAR (kb, Vlast_command));
11980 mark_object (KVAR (kb, Vreal_last_command));
11981 mark_object (KVAR (kb, Vkeyboard_translate_table));
11982 mark_object (KVAR (kb, Vlast_repeatable_command));
11983 mark_object (KVAR (kb, Vprefix_arg));
11984 mark_object (KVAR (kb, Vlast_prefix_arg));
11985 mark_object (KVAR (kb, kbd_queue));
11986 mark_object (KVAR (kb, defining_kbd_macro));
11987 mark_object (KVAR (kb, Vlast_kbd_macro));
11988 mark_object (KVAR (kb, Vsystem_key_alist));
11989 mark_object (KVAR (kb, system_key_syms));
11990 mark_object (KVAR (kb, Vwindow_system));
11991 mark_object (KVAR (kb, Vinput_decode_map));
11992 mark_object (KVAR (kb, Vlocal_function_key_map));
11993 mark_object (KVAR (kb, Vdefault_minibuffer_frame));
11994 mark_object (KVAR (kb, echo_string));
11997 struct input_event *event;
11998 for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++)
12000 if (event == kbd_buffer + KBD_BUFFER_SIZE)
12001 event = kbd_buffer;
12002 /* These two special event types has no Lisp_Objects to mark. */
12003 if (event->kind != SELECTION_REQUEST_EVENT
12004 && event->kind != SELECTION_CLEAR_EVENT)
12006 mark_object (event->x);
12007 mark_object (event->y);
12008 mark_object (event->frame_or_window);
12009 mark_object (event->arg);