1 /* Keyboard and mouse input; editor command loop.
2
3 Copyright (C) 1985-1989, 1993-1997, 1999-2021 Free Software Foundation,
4 Inc.
5
6 This file is part of GNU Emacs.
7
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
12
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.
17
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
20
21 #include <config.h>
22
23 #include <sys/stat.h>
24
25 #include "lisp.h"
26 #include "coding.h"
27 #include "termchar.h"
28 #include "termopts.h"
29 #include "frame.h"
30 #include "termhooks.h"
31 #include "macros.h"
32 #include "keyboard.h"
33 #include "window.h"
34 #include "commands.h"
35 #include "character.h"
36 #include "buffer.h"
37 #include "dispextern.h"
38 #include "syntax.h"
39 #include "intervals.h"
40 #include "keymap.h"
41 #include "blockinput.h"
42 #include "sysstdio.h"
43 #include "systime.h"
44 #include "atimer.h"
45 #include "process.h"
46 #include "menu.h"
47 #include <errno.h>
48
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 */
58
59 #if defined USABLE_FIONREAD && defined USG5_4
60 # include <sys/filio.h>
61 #endif
62
63 #include "syssignal.h"
64
65 #include <sys/types.h>
66 #include <unistd.h>
67 #include <fcntl.h>
68 #include <math.h>
69
70 #include <ignore-value.h>
71
72 #include "pdumper.h"
73
74 #ifdef HAVE_WINDOW_SYSTEM
75 #include TERM_HEADER
76 #endif /* HAVE_WINDOW_SYSTEM */
77
78 /* Work around GCC bug 54561. */
79 #if GNUC_PREREQ (4, 3, 0)
80 # pragma GCC diagnostic ignored "-Wclobbered"
81 #endif
82
83 #ifdef WINDOWSNT
84 char const DEV_TTY[] = "CONOUT$";
85 #else
86 char const DEV_TTY[] = "/dev/tty";
87 #endif
88
89 /* Variables for blockinput.h: */
90
91 /* Positive if interrupt input is blocked right now. */
92 volatile int interrupt_input_blocked;
93
94 /* True means an input interrupt or alarm signal has arrived.
95 The maybe_quit function checks this. */
96 volatile bool pending_signals;
97
98 enum { KBD_BUFFER_SIZE = 4096 };
99
100 KBOARD *initial_kboard;
101 KBOARD *current_kboard;
102 static KBOARD *all_kboards;
103
104 /* True in the single-kboard state, false in the any-kboard state. */
105 static bool single_kboard;
106
107 /* Minimum allowed size of the recent_keys vector. */
108 #define MIN_NUM_RECENT_KEYS (100)
109
110 /* Index for storing next element into recent_keys. */
111 static int recent_keys_index;
112
113 /* Total number of elements stored into recent_keys. */
114 static int total_keys;
115
116 /* Size of the recent_keys vector. */
117 static int lossage_limit = 3 * MIN_NUM_RECENT_KEYS;
118
119 /* This vector holds the last lossage_limit keystrokes. */
120 static Lisp_Object recent_keys;
121
122 /* Vector holding the key sequence that invoked the current command.
123 It is reused for each command, and it may be longer than the current
124 sequence; this_command_key_count indicates how many elements
125 actually mean something.
126 It's easier to staticpro a single Lisp_Object than an array. */
127 Lisp_Object this_command_keys;
128 ptrdiff_t this_command_key_count;
129
130 /* This vector is used as a buffer to record the events that were actually read
131 by read_key_sequence. */
132 static Lisp_Object raw_keybuf;
133 static int raw_keybuf_count;
134
135 #define GROW_RAW_KEYBUF \
136 if (raw_keybuf_count == ASIZE (raw_keybuf)) \
137 raw_keybuf = larger_vector (raw_keybuf, 1, -1)
138
139 /* Number of elements of this_command_keys
140 that precede this key sequence. */
141 static ptrdiff_t this_single_command_key_start;
142
143 #ifdef HAVE_STACK_OVERFLOW_HANDLING
144
145 /* For longjmp to recover from C stack overflow. */
146 sigjmp_buf return_to_command_loop;
147
148 /* Message displayed by Vtop_level when recovering from C stack overflow. */
149 static Lisp_Object recover_top_level_message;
150
151 #endif /* HAVE_STACK_OVERFLOW_HANDLING */
152
153 /* Message normally displayed by Vtop_level. */
154 static Lisp_Object regular_top_level_message;
155
156 /* True while displaying for echoing. Delays C-g throwing. */
157
158 static bool echoing;
159
160 /* Non-null means we can start echoing at the next input pause even
161 though there is something in the echo area. */
162
163 static struct kboard *ok_to_echo_at_next_pause;
164
165 /* The kboard last echoing, or null for none. Reset to 0 in
166 cancel_echoing. If non-null, and a current echo area message
167 exists, and echo_message_buffer is eq to the current message
168 buffer, we know that the message comes from echo_kboard. */
169
170 struct kboard *echo_kboard;
171
172 /* The buffer used for echoing. Set in echo_now, reset in
173 cancel_echoing. */
174
175 Lisp_Object echo_message_buffer;
176
177 /* Character that causes a quit. Normally C-g.
178
179 If we are running on an ordinary terminal, this must be an ordinary
180 ASCII char, since we want to make it our interrupt character.
181
182 If we are not running on an ordinary terminal, it still needs to be
183 an ordinary ASCII char. This character needs to be recognized in
184 the input interrupt handler. At this point, the keystroke is
185 represented as a struct input_event, while the desired quit
186 character is specified as a lispy event. The mapping from struct
187 input_events to lispy events cannot run in an interrupt handler,
188 and the reverse mapping is difficult for anything but ASCII
189 keystrokes.
190
191 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
192 ASCII character. */
193 int quit_char;
194
195 /* Current depth in recursive edits. */
196 EMACS_INT command_loop_level;
197
198 /* If not Qnil, this is a switch-frame event which we decided to put
199 off until the end of a key sequence. This should be read as the
200 next command input, after any unread_command_events.
201
202 read_key_sequence uses this to delay switch-frame events until the
203 end of the key sequence; Fread_char uses it to put off switch-frame
204 events until a non-ASCII event is acceptable as input. */
205 Lisp_Object unread_switch_frame;
206
207 /* Last size recorded for a current buffer which is not a minibuffer. */
208 static ptrdiff_t last_non_minibuf_size;
209
210 uintmax_t num_input_events;
211 ptrdiff_t point_before_last_command_or_undo;
212 struct buffer *buffer_before_last_command_or_undo;
213
214 /* Value of num_nonmacro_input_events as of last auto save. */
215
216 static intmax_t last_auto_save;
217
218 /* The value of point when the last command was started. */
219 static ptrdiff_t last_point_position;
220
221 /* The frame in which the last input event occurred, or Qmacro if the
222 last event came from a macro. We use this to determine when to
223 generate switch-frame events. This may be cleared by functions
224 like Fselect_frame, to make sure that a switch-frame event is
225 generated by the next character.
226
227 FIXME: This is modified by a signal handler so it should be volatile.
228 It's exported to Lisp, though, so it can't simply be marked
229 'volatile' here. */
230 Lisp_Object internal_last_event_frame;
231
232 /* `read_key_sequence' stores here the command definition of the
233 key sequence that it reads. */
234 static Lisp_Object read_key_sequence_cmd;
235 static Lisp_Object read_key_sequence_remapped;
236
237 /* File in which we write all commands we read. */
238 static FILE *dribble;
239
240 /* True if input is available. */
241 bool input_pending;
242
243 /* True if more input was available last time we read an event.
244
245 Since redisplay can take a significant amount of time and is not
246 indispensable to perform the user's commands, when input arrives
247 "too fast", Emacs skips redisplay. More specifically, if the next
248 command has already been input when we finish the previous command,
249 we skip the intermediate redisplay.
250
251 This is useful to try and make sure Emacs keeps up with fast input
252 rates, such as auto-repeating keys. But in some cases, this proves
253 too conservative: we may end up disabling redisplay for the whole
254 duration of a key repetition, even though we could afford to
255 redisplay every once in a while.
256
257 So we "sample" the input_pending flag before running a command and
258 use *that* value after running the command to decide whether to
259 skip redisplay or not. This way, we only skip redisplay if we
260 really can't keep up with the repeat rate.
261
262 This only makes a difference if the next input arrives while running the
263 command, which is very unlikely if the command is executed quickly.
264 IOW this tends to avoid skipping redisplay after a long running command
265 (which is a case where skipping redisplay is not very useful since the
266 redisplay time is small compared to the time it took to run the command).
267
268 A typical use case is when scrolling. Scrolling time can be split into:
269 - Time to do jit-lock on the newly displayed portion of buffer.
270 - Time to run the actual scroll command.
271 - Time to perform the redisplay.
272 Jit-lock can happen either during the command or during the redisplay.
273 In the most painful cases, the jit-lock time is the one that dominates.
274 Also jit-lock can be tweaked (via jit-lock-defer) to delay its job, at the
275 cost of temporary inaccuracy in display and scrolling.
276 So without input_was_pending, what typically happens is the following:
277 - when the command starts, there's no pending input (yet).
278 - the scroll command triggers jit-lock.
279 - during the long jit-lock time the next input arrives.
280 - at the end of the command, we check input_pending and hence decide to
281 skip redisplay.
282 - we read the next input and start over.
283 End result: all the hard work of jit-locking is "wasted" since redisplay
284 doesn't actually happens (at least not before the input rate slows down).
285 With input_was_pending redisplay is still skipped if Emacs can't keep up
286 with the input rate, but if it can keep up just enough that there's no
287 input_pending when we begin the command, then redisplay is not skipped
288 which results in better feedback to the user. */
289 bool input_was_pending;
290
291 /* Circular buffer for pre-read keyboard input. */
292
293 static union buffered_input_event kbd_buffer[KBD_BUFFER_SIZE];
294
295 /* Pointer to next available character in kbd_buffer.
296 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty. */
297 static union buffered_input_event *kbd_fetch_ptr;
298
299 /* Pointer to next place to store character in kbd_buffer. */
300 static union buffered_input_event *kbd_store_ptr;
301
302 /* The above pair of variables forms a "queue empty" flag. When we
303 enqueue a non-hook event, we increment kbd_store_ptr. When we
304 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
305 there is input available if the two pointers are not equal.
306
307 Why not just have a flag set and cleared by the enqueuing and
308 dequeuing functions? The code is a bit simpler this way. */
309
310 static void recursive_edit_unwind (Lisp_Object buffer);
311 static Lisp_Object command_loop (void);
312
313 static void echo_now (void);
314 static ptrdiff_t echo_length (void);
315
316 /* Incremented whenever a timer is run. */
317 unsigned timers_run;
318
319 /* Address (if not 0) of struct timespec to zero out if a SIGIO interrupt
320 happens. */
321 struct timespec *input_available_clear_time;
322
323 /* True means use SIGIO interrupts; false means use CBREAK mode.
324 Default is true if INTERRUPT_INPUT is defined. */
325 bool interrupt_input;
326
327 /* Nonzero while interrupts are temporarily deferred during redisplay. */
328 bool interrupts_deferred;
329
330 /* The time when Emacs started being idle. */
331
332 static struct timespec timer_idleness_start_time;
333
334 /* After Emacs stops being idle, this saves the last value
335 of timer_idleness_start_time from when it was idle. */
336
337 static struct timespec timer_last_idleness_start_time;
338
339
340 /* Global variable declarations. */
341
342 /* Flags for readable_events. */
343 #define READABLE_EVENTS_DO_TIMERS_NOW (1 << 0)
344 #define READABLE_EVENTS_FILTER_EVENTS (1 << 1)
345 #define READABLE_EVENTS_IGNORE_SQUEEZABLES (1 << 2)
346
347 /* Function for init_keyboard to call with no args (if nonzero). */
348 static void (*keyboard_init_hook) (void);
349
350 static bool get_input_pending (int);
351 static bool readable_events (int);
352 static Lisp_Object read_char_x_menu_prompt (Lisp_Object,
353 Lisp_Object, bool *);
354 static Lisp_Object read_char_minibuf_menu_prompt (int, Lisp_Object);
355 static Lisp_Object make_lispy_event (struct input_event *);
356 static Lisp_Object make_lispy_movement (struct frame *, Lisp_Object,
357 enum scroll_bar_part,
358 Lisp_Object, Lisp_Object,
359 Time);
360 static Lisp_Object modify_event_symbol (ptrdiff_t, int, Lisp_Object,
361 Lisp_Object, const char *const *,
362 Lisp_Object *, ptrdiff_t);
363 static Lisp_Object make_lispy_switch_frame (Lisp_Object);
364 static Lisp_Object make_lispy_focus_in (Lisp_Object);
365 static Lisp_Object make_lispy_focus_out (Lisp_Object);
366 static bool help_char_p (Lisp_Object);
367 static void save_getcjmp (sys_jmp_buf);
368 static void restore_getcjmp (void *);
369 static Lisp_Object apply_modifiers (int, Lisp_Object);
370 static void restore_kboard_configuration (int);
371 static void handle_interrupt (bool);
372 static AVOID quit_throw_to_read_char (bool);
373 static void timer_start_idle (void);
374 static void timer_stop_idle (void);
375 static void timer_resume_idle (void);
376 static void deliver_user_signal (int);
377 static char *find_user_signal_name (int);
378 static void store_user_signal_events (void);
379 static bool is_ignored_event (union buffered_input_event *);
380
381 /* Advance or retreat a buffered input event pointer. */
382
383 static union buffered_input_event *
next_kbd_event(union buffered_input_event * ptr)384 next_kbd_event (union buffered_input_event *ptr)
385 {
386 return ptr == kbd_buffer + KBD_BUFFER_SIZE - 1 ? kbd_buffer : ptr + 1;
387 }
388
389 #ifdef HAVE_X11
390 static union buffered_input_event *
prev_kbd_event(union buffered_input_event * ptr)391 prev_kbd_event (union buffered_input_event *ptr)
392 {
393 return ptr == kbd_buffer ? kbd_buffer + KBD_BUFFER_SIZE - 1 : ptr - 1;
394 }
395 #endif
396
397 /* Like EVENT_START, but assume EVENT is an event.
398 This pacifies gcc -Wnull-dereference, which might otherwise
399 complain about earlier checks that EVENT is indeed an event. */
400 static Lisp_Object
xevent_start(Lisp_Object event)401 xevent_start (Lisp_Object event)
402 {
403 return XCAR (XCDR (event));
404 }
405
406 /* These setters are used only in this file, so they can be private. */
407 static void
kset_echo_string(struct kboard * kb,Lisp_Object val)408 kset_echo_string (struct kboard *kb, Lisp_Object val)
409 {
410 kb->echo_string_ = val;
411 }
412 static void
kset_echo_prompt(struct kboard * kb,Lisp_Object val)413 kset_echo_prompt (struct kboard *kb, Lisp_Object val)
414 {
415 kb->echo_prompt_ = val;
416 }
417 static void
kset_kbd_queue(struct kboard * kb,Lisp_Object val)418 kset_kbd_queue (struct kboard *kb, Lisp_Object val)
419 {
420 kb->kbd_queue_ = val;
421 }
422 static void
kset_keyboard_translate_table(struct kboard * kb,Lisp_Object val)423 kset_keyboard_translate_table (struct kboard *kb, Lisp_Object val)
424 {
425 kb->Vkeyboard_translate_table_ = val;
426 }
427 static void
kset_last_prefix_arg(struct kboard * kb,Lisp_Object val)428 kset_last_prefix_arg (struct kboard *kb, Lisp_Object val)
429 {
430 kb->Vlast_prefix_arg_ = val;
431 }
432 static void
kset_last_repeatable_command(struct kboard * kb,Lisp_Object val)433 kset_last_repeatable_command (struct kboard *kb, Lisp_Object val)
434 {
435 kb->Vlast_repeatable_command_ = val;
436 }
437 static void
kset_local_function_key_map(struct kboard * kb,Lisp_Object val)438 kset_local_function_key_map (struct kboard *kb, Lisp_Object val)
439 {
440 kb->Vlocal_function_key_map_ = val;
441 }
442 static void
kset_overriding_terminal_local_map(struct kboard * kb,Lisp_Object val)443 kset_overriding_terminal_local_map (struct kboard *kb, Lisp_Object val)
444 {
445 kb->Voverriding_terminal_local_map_ = val;
446 }
447 static void
kset_real_last_command(struct kboard * kb,Lisp_Object val)448 kset_real_last_command (struct kboard *kb, Lisp_Object val)
449 {
450 kb->Vreal_last_command_ = val;
451 }
452 static void
kset_system_key_syms(struct kboard * kb,Lisp_Object val)453 kset_system_key_syms (struct kboard *kb, Lisp_Object val)
454 {
455 kb->system_key_syms_ = val;
456 }
457
458
459 static bool
echo_keystrokes_p(void)460 echo_keystrokes_p (void)
461 {
462 return (FLOATP (Vecho_keystrokes) ? XFLOAT_DATA (Vecho_keystrokes) > 0.0
463 : FIXNUMP (Vecho_keystrokes) ? XFIXNUM (Vecho_keystrokes) > 0
464 : false);
465 }
466
467 /* Add C to the echo string, without echoing it immediately. C can be
468 a character, which is pretty-printed, or a symbol, whose name is
469 printed. */
470
471 static void
echo_add_key(Lisp_Object c)472 echo_add_key (Lisp_Object c)
473 {
474 char initbuf[KEY_DESCRIPTION_SIZE + 100];
475 ptrdiff_t size = sizeof initbuf;
476 char *buffer = initbuf;
477 char *ptr = buffer;
478 Lisp_Object echo_string = KVAR (current_kboard, echo_string);
479 USE_SAFE_ALLOCA;
480
481 if (STRINGP (echo_string) && SCHARS (echo_string) > 0)
482 /* Add a space at the end as a separator between keys. */
483 ptr++[0] = ' ';
484
485 /* If someone has passed us a composite event, use its head symbol. */
486 c = EVENT_HEAD (c);
487
488 if (FIXNUMP (c))
489 ptr = push_key_description (XFIXNUM (c), ptr);
490 else if (SYMBOLP (c))
491 {
492 Lisp_Object name = SYMBOL_NAME (c);
493 ptrdiff_t nbytes = SBYTES (name);
494
495 if (size - (ptr - buffer) < nbytes)
496 {
497 ptrdiff_t offset = ptr - buffer;
498 size = max (2 * size, size + nbytes);
499 buffer = SAFE_ALLOCA (size);
500 ptr = buffer + offset;
501 }
502
503 ptr += copy_text (SDATA (name), (unsigned char *) ptr, nbytes,
504 STRING_MULTIBYTE (name), 1);
505 }
506
507 if ((NILP (echo_string) || SCHARS (echo_string) == 0)
508 && help_char_p (c))
509 {
510 static const char text[] = " (Type ? for further options)";
511 int len = sizeof text - 1;
512
513 if (size - (ptr - buffer) < len)
514 {
515 ptrdiff_t offset = ptr - buffer;
516 size += len;
517 buffer = SAFE_ALLOCA (size);
518 ptr = buffer + offset;
519 }
520
521 memcpy (ptr, text, len);
522 ptr += len;
523 }
524
525 kset_echo_string
526 (current_kboard,
527 concat2 (echo_string, make_string (buffer, ptr - buffer)));
528 SAFE_FREE ();
529 }
530
531 /* Temporarily add a dash to the end of the echo string if it's not
532 empty, so that it serves as a mini-prompt for the very next
533 character. */
534
535 static void
echo_dash(void)536 echo_dash (void)
537 {
538 /* Do nothing if not echoing at all. */
539 if (NILP (KVAR (current_kboard, echo_string)))
540 return;
541
542 if (!current_kboard->immediate_echo
543 && SCHARS (KVAR (current_kboard, echo_string)) == 0)
544 return;
545
546 /* Do nothing if we just printed a prompt. */
547 if (STRINGP (KVAR (current_kboard, echo_prompt))
548 && (SCHARS (KVAR (current_kboard, echo_prompt))
549 == SCHARS (KVAR (current_kboard, echo_string))))
550 return;
551
552 /* Do nothing if we have already put a dash at the end. */
553 if (SCHARS (KVAR (current_kboard, echo_string)) > 1)
554 {
555 Lisp_Object last_char, prev_char, idx;
556
557 idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 2);
558 prev_char = Faref (KVAR (current_kboard, echo_string), idx);
559
560 idx = make_fixnum (SCHARS (KVAR (current_kboard, echo_string)) - 1);
561 last_char = Faref (KVAR (current_kboard, echo_string), idx);
562
563 if (XFIXNUM (last_char) == '-' && XFIXNUM (prev_char) != ' ')
564 return;
565 }
566
567 /* Put a dash at the end of the buffer temporarily,
568 but make it go away when the next character is added. */
569 AUTO_STRING (dash, "-");
570 kset_echo_string (current_kboard,
571 concat2 (KVAR (current_kboard, echo_string), dash));
572 echo_now ();
573 }
574
575 static void
echo_update(void)576 echo_update (void)
577 {
578 if (current_kboard->immediate_echo)
579 {
580 ptrdiff_t i;
581 Lisp_Object prompt = KVAR (current_kboard, echo_prompt);
582 Lisp_Object prefix = call0 (Qinternal_echo_keystrokes_prefix);
583 kset_echo_string (current_kboard,
584 NILP (prompt) ? prefix
585 : NILP (prefix) ? prompt
586 : concat2 (prompt, prefix));
587
588 for (i = 0; i < this_command_key_count; i++)
589 {
590 Lisp_Object c;
591
592 c = AREF (this_command_keys, i);
593 if (! (EVENT_HAS_PARAMETERS (c)
594 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
595 echo_add_key (c);
596 }
597
598 echo_now ();
599 }
600 }
601
602 /* Display the current echo string, and begin echoing if not already
603 doing so. */
604
605 static void
echo_now(void)606 echo_now (void)
607 {
608 if (!current_kboard->immediate_echo
609 /* This test breaks calls that use `echo_now' to display the echo_prompt.
610 && echo_keystrokes_p () */)
611 {
612 current_kboard->immediate_echo = true;
613 echo_update ();
614 /* Put a dash at the end to invite the user to type more. */
615 echo_dash ();
616 }
617
618 echoing = true;
619 /* FIXME: Use call (Qmessage) so it can be advised (e.g. emacspeak). */
620 message3_nolog (KVAR (current_kboard, echo_string));
621 echoing = false;
622
623 /* Record in what buffer we echoed, and from which kboard. */
624 echo_message_buffer = echo_area_buffer[0];
625 echo_kboard = current_kboard;
626
627 if (waiting_for_input && !NILP (Vquit_flag))
628 quit_throw_to_read_char (0);
629 }
630
631 /* Turn off echoing, for the start of a new command. */
632
633 void
cancel_echoing(void)634 cancel_echoing (void)
635 {
636 current_kboard->immediate_echo = false;
637 kset_echo_prompt (current_kboard, Qnil);
638 kset_echo_string (current_kboard, Qnil);
639 ok_to_echo_at_next_pause = NULL;
640 echo_kboard = NULL;
641 echo_message_buffer = Qnil;
642 }
643
644 /* Return the length of the current echo string. */
645
646 static ptrdiff_t
echo_length(void)647 echo_length (void)
648 {
649 return (STRINGP (KVAR (current_kboard, echo_string))
650 ? SCHARS (KVAR (current_kboard, echo_string))
651 : 0);
652 }
653
654 /* Truncate the current echo message to its first LEN chars.
655 This and echo_char get used by read_key_sequence when the user
656 switches frames while entering a key sequence. */
657
658 static void
echo_truncate(ptrdiff_t nchars)659 echo_truncate (ptrdiff_t nchars)
660 {
661 Lisp_Object es = KVAR (current_kboard, echo_string);
662 if (STRINGP (es) && SCHARS (es) > nchars)
663 kset_echo_string (current_kboard,
664 Fsubstring (KVAR (current_kboard, echo_string),
665 make_fixnum (0), make_fixnum (nchars)));
666 truncate_echo_area (nchars);
667 }
668
669
670 /* Functions for manipulating this_command_keys. */
671 static void
add_command_key(Lisp_Object key)672 add_command_key (Lisp_Object key)
673 {
674 if (this_command_key_count >= ASIZE (this_command_keys))
675 this_command_keys = larger_vector (this_command_keys, 1, -1);
676
677 ASET (this_command_keys, this_command_key_count, key);
678 ++this_command_key_count;
679 }
680
681
682 Lisp_Object
recursive_edit_1(void)683 recursive_edit_1 (void)
684 {
685 ptrdiff_t count = SPECPDL_INDEX ();
686 Lisp_Object val;
687
688 if (command_loop_level > 0)
689 {
690 specbind (Qstandard_output, Qt);
691 specbind (Qstandard_input, Qt);
692 }
693
694 #ifdef HAVE_WINDOW_SYSTEM
695 /* The command loop has started an hourglass timer, so we have to
696 cancel it here, otherwise it will fire because the recursive edit
697 can take some time. Do not check for display_hourglass_p here,
698 because it could already be nil. */
699 cancel_hourglass ();
700 #endif
701
702 /* This function may have been called from a debugger called from
703 within redisplay, for instance by Edebugging a function called
704 from fontification-functions. We want to allow redisplay in
705 the debugging session.
706
707 The recursive edit is left with a `(throw exit ...)'. The `exit'
708 tag is not caught anywhere in redisplay, i.e. when we leave the
709 recursive edit, the original redisplay leading to the recursive
710 edit will be unwound. The outcome should therefore be safe. */
711 specbind (Qinhibit_redisplay, Qnil);
712 redisplaying_p = 0;
713
714 /* This variable stores buffers that have changed so that an undo
715 boundary can be added. specbind this so that changes in the
716 recursive edit will not result in undo boundaries in buffers
717 changed before we entered there recursive edit.
718 See Bug #23632.
719 */
720 specbind (Qundo_auto__undoably_changed_buffers, Qnil);
721
722 val = command_loop ();
723 if (EQ (val, Qt))
724 quit ();
725 /* Handle throw from read_minibuf when using minibuffer
726 while it's active but we're in another window. */
727 if (STRINGP (val))
728 xsignal1 (Qerror, val);
729
730 if (FUNCTIONP (val))
731 call0 (val);
732
733 return unbind_to (count, Qnil);
734 }
735
736 /* When an auto-save happens, record the "time", and don't do again soon. */
737
738 void
record_auto_save(void)739 record_auto_save (void)
740 {
741 last_auto_save = num_nonmacro_input_events;
742 }
743
744 /* Make an auto save happen as soon as possible at command level. */
745
746 #ifdef SIGDANGER
747 void
force_auto_save_soon(void)748 force_auto_save_soon (void)
749 {
750 last_auto_save = - auto_save_interval - 1;
751 }
752 #endif
753
754 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
755 doc: /* Invoke the editor command loop recursively.
756 To get out of the recursive edit, a command can throw to `exit' -- for
757 instance (throw \\='exit nil).
758
759 The following values (last argument to `throw') can be used when
760 throwing to \\='exit:
761
762 - t causes `recursive-edit' to quit, so that control returns to the
763 command loop one level up.
764
765 - A string causes `recursive-edit' to signal an error, printing that
766 string as the error message.
767
768 - A function causes `recursive-edit' to call that function with no
769 arguments, and then return normally.
770
771 - Any other value causes `recursive-edit' to return normally to the
772 function that called it.
773
774 This function is called by the editor initialization to begin editing. */)
775 (void)
776 {
777 ptrdiff_t count = SPECPDL_INDEX ();
778 Lisp_Object buffer;
779
780 /* If we enter while input is blocked, don't lock up here.
781 This may happen through the debugger during redisplay. */
782 if (input_blocked_p ())
783 return Qnil;
784
785 if (command_loop_level >= 0
786 && current_buffer != XBUFFER (XWINDOW (selected_window)->contents))
787 buffer = Fcurrent_buffer ();
788 else
789 buffer = Qnil;
790
791 /* Don't do anything interesting between the increment and the
792 record_unwind_protect! Otherwise, we could get distracted and
793 never decrement the counter again. */
794 command_loop_level++;
795 update_mode_lines = 17;
796 record_unwind_protect (recursive_edit_unwind, buffer);
797
798 /* If we leave recursive_edit_1 below with a `throw' for instance,
799 like it is done in the splash screen display, we have to
800 make sure that we restore single_kboard as command_loop_1
801 would have done if it were left normally. */
802 if (command_loop_level > 0)
803 temporarily_switch_to_single_kboard (SELECTED_FRAME ());
804
805 recursive_edit_1 ();
806 return unbind_to (count, Qnil);
807 }
808
809 void
recursive_edit_unwind(Lisp_Object buffer)810 recursive_edit_unwind (Lisp_Object buffer)
811 {
812 if (BUFFERP (buffer))
813 Fset_buffer (buffer);
814
815 command_loop_level--;
816 update_mode_lines = 18;
817 }
818
819
820
821 /* If we're in single_kboard state for kboard KBOARD,
822 get out of it. */
823
824 void
not_single_kboard_state(KBOARD * kboard)825 not_single_kboard_state (KBOARD *kboard)
826 {
827 if (kboard == current_kboard)
828 single_kboard = false;
829 }
830
831 /* Maintain a stack of kboards, so other parts of Emacs
832 can switch temporarily to the kboard of a given frame
833 and then revert to the previous status. */
834
835 struct kboard_stack
836 {
837 KBOARD *kboard;
838 struct kboard_stack *next;
839 };
840
841 static struct kboard_stack *kboard_stack;
842
843 void
push_kboard(struct kboard * k)844 push_kboard (struct kboard *k)
845 {
846 struct kboard_stack *p = xmalloc (sizeof *p);
847
848 p->next = kboard_stack;
849 p->kboard = current_kboard;
850 kboard_stack = p;
851
852 current_kboard = k;
853 }
854
855 void
pop_kboard(void)856 pop_kboard (void)
857 {
858 struct terminal *t;
859 struct kboard_stack *p = kboard_stack;
860 bool found = false;
861 for (t = terminal_list; t; t = t->next_terminal)
862 {
863 if (t->kboard == p->kboard)
864 {
865 current_kboard = p->kboard;
866 found = true;
867 break;
868 }
869 }
870 if (!found)
871 {
872 /* The terminal we remembered has been deleted. */
873 current_kboard = FRAME_KBOARD (SELECTED_FRAME ());
874 single_kboard = false;
875 }
876 kboard_stack = p->next;
877 xfree (p);
878 }
879
880 /* Switch to single_kboard mode, making current_kboard the only KBOARD
881 from which further input is accepted. If F is non-nil, set its
882 KBOARD as the current keyboard.
883
884 This function uses record_unwind_protect_int to return to the previous
885 state later.
886
887 If Emacs is already in single_kboard mode, and F's keyboard is
888 locked, then this function will throw an error. */
889
890 void
temporarily_switch_to_single_kboard(struct frame * f)891 temporarily_switch_to_single_kboard (struct frame *f)
892 {
893 bool was_locked = single_kboard;
894 if (was_locked)
895 {
896 if (f != NULL && FRAME_KBOARD (f) != current_kboard)
897 /* We can not switch keyboards while in single_kboard mode.
898 In rare cases, Lisp code may call `recursive-edit' (or
899 `read-minibuffer' or `y-or-n-p') after it switched to a
900 locked frame. For example, this is likely to happen
901 when server.el connects to a new terminal while Emacs is in
902 single_kboard mode. It is best to throw an error instead
903 of presenting the user with a frozen screen. */
904 error ("Terminal %d is locked, cannot read from it",
905 FRAME_TERMINAL (f)->id);
906 else
907 /* This call is unnecessary, but helps
908 `restore_kboard_configuration' discover if somebody changed
909 `current_kboard' behind our back. */
910 push_kboard (current_kboard);
911 }
912 else if (f != NULL)
913 current_kboard = FRAME_KBOARD (f);
914 single_kboard = true;
915 record_unwind_protect_int (restore_kboard_configuration, was_locked);
916 }
917
918 static void
restore_kboard_configuration(int was_locked)919 restore_kboard_configuration (int was_locked)
920 {
921 single_kboard = was_locked;
922 if (was_locked)
923 {
924 struct kboard *prev = current_kboard;
925 pop_kboard ();
926 /* The pop should not change the kboard. */
927 if (single_kboard && current_kboard != prev)
928 emacs_abort ();
929 }
930 }
931
932
933 /* Handle errors that are not handled at inner levels
934 by printing an error message and returning to the editor command loop. */
935
936 static Lisp_Object
cmd_error(Lisp_Object data)937 cmd_error (Lisp_Object data)
938 {
939 Lisp_Object old_level, old_length;
940 ptrdiff_t count = SPECPDL_INDEX ();
941 Lisp_Object conditions;
942 char macroerror[sizeof "After..kbd macro iterations: "
943 + INT_STRLEN_BOUND (EMACS_INT)];
944
945 #ifdef HAVE_WINDOW_SYSTEM
946 if (display_hourglass_p)
947 cancel_hourglass ();
948 #endif
949
950 if (!NILP (executing_kbd_macro))
951 {
952 if (executing_kbd_macro_iterations == 1)
953 sprintf (macroerror, "After 1 kbd macro iteration: ");
954 else
955 sprintf (macroerror, "After %"pI"d kbd macro iterations: ",
956 executing_kbd_macro_iterations);
957 }
958 else
959 *macroerror = 0;
960
961 conditions = Fget (XCAR (data), Qerror_conditions);
962 if (NILP (Fmemq (Qminibuffer_quit, conditions)))
963 {
964 Vexecuting_kbd_macro = Qnil;
965 executing_kbd_macro = Qnil;
966 }
967 else if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
968 /* An `M-x' command that signals a `minibuffer-quit' condition
969 that's part of a kbd macro. */
970 finalize_kbd_macro_chars ();
971
972 specbind (Qstandard_output, Qt);
973 specbind (Qstandard_input, Qt);
974 kset_prefix_arg (current_kboard, Qnil);
975 kset_last_prefix_arg (current_kboard, Qnil);
976 cancel_echoing ();
977
978 /* Avoid unquittable loop if data contains a circular list. */
979 old_level = Vprint_level;
980 old_length = Vprint_length;
981 XSETFASTINT (Vprint_level, 10);
982 XSETFASTINT (Vprint_length, 10);
983 cmd_error_internal (data, macroerror);
984 Vprint_level = old_level;
985 Vprint_length = old_length;
986
987 Vquit_flag = Qnil;
988 Vinhibit_quit = Qnil;
989
990 unbind_to (count, Qnil);
991 return make_fixnum (0);
992 }
993
994 /* Take actions on handling an error. DATA is the data that describes
995 the error.
996
997 CONTEXT is a C-string containing ASCII characters only which
998 describes the context in which the error happened. If we need to
999 generalize CONTEXT to allow multibyte characters, make it a Lisp
1000 string. */
1001
1002 void
cmd_error_internal(Lisp_Object data,const char * context)1003 cmd_error_internal (Lisp_Object data, const char *context)
1004 {
1005 /* The immediate context is not interesting for Quits,
1006 since they are asynchronous. */
1007 if (signal_quit_p (XCAR (data)))
1008 Vsignaling_function = Qnil;
1009
1010 Vquit_flag = Qnil;
1011 Vinhibit_quit = Qt;
1012
1013 /* Use user's specified output function if any. */
1014 if (!NILP (Vcommand_error_function))
1015 call3 (Vcommand_error_function, data,
1016 context ? build_string (context) : empty_unibyte_string,
1017 Vsignaling_function);
1018
1019 Vsignaling_function = Qnil;
1020 }
1021
1022 DEFUN ("command-error-default-function", Fcommand_error_default_function,
1023 Scommand_error_default_function, 3, 3, 0,
1024 doc: /* Produce default output for unhandled error message.
1025 Default value of `command-error-function'. */)
1026 (Lisp_Object data, Lisp_Object context, Lisp_Object signal)
1027 {
1028 struct frame *sf = SELECTED_FRAME ();
1029 Lisp_Object conditions = Fget (XCAR (data), Qerror_conditions);
1030 int is_minibuffer_quit = !NILP (Fmemq (Qminibuffer_quit, conditions));
1031
1032 CHECK_STRING (context);
1033
1034 /* If the window system or terminal frame hasn't been initialized
1035 yet, or we're not interactive, write the message to stderr and exit.
1036 Don't do this for the minibuffer-quit condition. */
1037 if (!is_minibuffer_quit
1038 && (!sf->glyphs_initialized_p
1039 /* The initial frame is a special non-displaying frame. It
1040 will be current in daemon mode when there are no frames
1041 to display, and in non-daemon mode before the real frame
1042 has finished initializing. If an error is thrown in the
1043 latter case while creating the frame, then the frame
1044 will never be displayed, so the safest thing to do is
1045 write to stderr and quit. In daemon mode, there are
1046 many other potential errors that do not prevent frames
1047 from being created, so continuing as normal is better in
1048 that case. */
1049 || (!IS_DAEMON && FRAME_INITIAL_P (sf))
1050 || noninteractive))
1051 {
1052 print_error_message (data, Qexternal_debugging_output,
1053 SSDATA (context), signal);
1054 Fterpri (Qexternal_debugging_output, Qnil);
1055 Fkill_emacs (make_fixnum (-1));
1056 }
1057 else
1058 {
1059 clear_message (1, 0);
1060 message_log_maybe_newline ();
1061
1062 if (is_minibuffer_quit)
1063 {
1064 Fding (Qt);
1065 }
1066 else
1067 {
1068 Fdiscard_input ();
1069 bitch_at_user ();
1070 }
1071
1072 print_error_message (data, Qt, SSDATA (context), signal);
1073 }
1074 return Qnil;
1075 }
1076
1077 static Lisp_Object command_loop_1 (void);
1078 static Lisp_Object top_level_1 (Lisp_Object);
1079
1080 /* Entry to editor-command-loop.
1081 This level has the catches for exiting/returning to editor command loop.
1082 It returns nil to exit recursive edit, t to abort it. */
1083
1084 Lisp_Object
command_loop(void)1085 command_loop (void)
1086 {
1087 #ifdef HAVE_STACK_OVERFLOW_HANDLING
1088 /* At least on GNU/Linux, saving signal mask is important here. */
1089 if (sigsetjmp (return_to_command_loop, 1) != 0)
1090 {
1091 /* Comes here from handle_sigsegv (see sysdep.c) and
1092 stack_overflow_handler (see w32fns.c). */
1093 #ifdef WINDOWSNT
1094 w32_reset_stack_overflow_guard ();
1095 #endif
1096 init_eval ();
1097 Vinternal__top_level_message = recover_top_level_message;
1098 }
1099 else
1100 Vinternal__top_level_message = regular_top_level_message;
1101 #endif /* HAVE_STACK_OVERFLOW_HANDLING */
1102 if (command_loop_level > 0 || minibuf_level > 0)
1103 {
1104 Lisp_Object val;
1105 val = internal_catch (Qexit, command_loop_2, Qerror);
1106 executing_kbd_macro = Qnil;
1107 return val;
1108 }
1109 else
1110 while (1)
1111 {
1112 internal_catch (Qtop_level, top_level_1, Qnil);
1113 internal_catch (Qtop_level, command_loop_2, Qerror);
1114 executing_kbd_macro = Qnil;
1115
1116 /* End of file in -batch run causes exit here. */
1117 if (noninteractive)
1118 Fkill_emacs (Qt);
1119 }
1120 }
1121
1122 /* Here we catch errors in execution of commands within the
1123 editing loop, and reenter the editing loop.
1124 When there is an error, cmd_error runs and returns a non-nil
1125 value to us. A value of nil means that command_loop_1 itself
1126 returned due to end of file (or end of kbd macro). HANDLERS is a
1127 list of condition names, passed to internal_condition_case. */
1128
1129 Lisp_Object
command_loop_2(Lisp_Object handlers)1130 command_loop_2 (Lisp_Object handlers)
1131 {
1132 register Lisp_Object val;
1133
1134 do
1135 val = internal_condition_case (command_loop_1, handlers, cmd_error);
1136 while (!NILP (val));
1137
1138 return Qnil;
1139 }
1140
1141 static Lisp_Object
top_level_2(void)1142 top_level_2 (void)
1143 {
1144 return Feval (Vtop_level, Qnil);
1145 }
1146
1147 static Lisp_Object
top_level_1(Lisp_Object ignore)1148 top_level_1 (Lisp_Object ignore)
1149 {
1150 /* On entry to the outer level, run the startup file. */
1151 if (!NILP (Vtop_level))
1152 internal_condition_case (top_level_2, Qerror, cmd_error);
1153 else if (!NILP (Vpurify_flag))
1154 message1 ("Bare impure Emacs (standard Lisp code not loaded)");
1155 else
1156 message1 ("Bare Emacs (standard Lisp code not loaded)");
1157 return Qnil;
1158 }
1159
1160 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1161 doc: /* Exit all recursive editing levels.
1162 This also exits all active minibuffers. */
1163 attributes: noreturn)
1164 (void)
1165 {
1166 #ifdef HAVE_WINDOW_SYSTEM
1167 if (display_hourglass_p)
1168 cancel_hourglass ();
1169 #endif
1170
1171 /* Unblock input if we enter with input blocked. This may happen if
1172 redisplay traps e.g. during tool-bar update with input blocked. */
1173 totally_unblock_input ();
1174
1175 Fthrow (Qtop_level, Qnil);
1176 }
1177
1178 static AVOID
user_error(const char * msg)1179 user_error (const char *msg)
1180 {
1181 xsignal1 (Quser_error, build_string (msg));
1182 }
1183
1184 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1185 doc: /* Exit from the innermost recursive edit or minibuffer. */
1186 attributes: noreturn)
1187 (void)
1188 {
1189 if (command_loop_level > 0 || minibuf_level > 0)
1190 Fthrow (Qexit, Qnil);
1191
1192 user_error ("No recursive edit is in progress");
1193 }
1194
1195 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1196 doc: /* Abort the command that requested this recursive edit or minibuffer input. */
1197 attributes: noreturn)
1198 (void)
1199 {
1200 if (command_loop_level > 0 || minibuf_level > 0)
1201 Fthrow (Qexit, Qt);
1202
1203 user_error ("No recursive edit is in progress");
1204 }
1205
1206 /* Restore mouse tracking enablement. See Finternal_track_mouse for
1207 the only use of this function. */
1208
1209 static void
tracking_off(Lisp_Object old_track_mouse)1210 tracking_off (Lisp_Object old_track_mouse)
1211 {
1212 track_mouse = old_track_mouse;
1213 if (NILP (old_track_mouse))
1214 {
1215 /* Redisplay may have been preempted because there was input
1216 available, and it assumes it will be called again after the
1217 input has been processed. If the only input available was
1218 the sort that we have just disabled, then we need to call
1219 redisplay. */
1220 if (!readable_events (READABLE_EVENTS_DO_TIMERS_NOW))
1221 {
1222 redisplay_preserve_echo_area (6);
1223 get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
1224 }
1225 }
1226 }
1227
1228 DEFUN ("internal--track-mouse", Finternal_track_mouse, Sinternal_track_mouse,
1229 1, 1, 0,
1230 doc: /* Call BODYFUN with mouse movement events enabled. */)
1231 (Lisp_Object bodyfun)
1232 {
1233 ptrdiff_t count = SPECPDL_INDEX ();
1234 Lisp_Object val;
1235
1236 record_unwind_protect (tracking_off, track_mouse);
1237
1238 track_mouse = Qt;
1239
1240 val = call0 (bodyfun);
1241 return unbind_to (count, val);
1242 }
1243
1244 /* If mouse has moved on some frame and we are tracking the mouse,
1245 return one of those frames. Return NULL otherwise.
1246
1247 If ignore_mouse_drag_p is non-zero, ignore (implicit) mouse movement
1248 after resizing the tool-bar window. */
1249
1250 bool ignore_mouse_drag_p;
1251
1252 static struct frame *
some_mouse_moved(void)1253 some_mouse_moved (void)
1254 {
1255 Lisp_Object tail, frame;
1256
1257 if (NILP (track_mouse) || ignore_mouse_drag_p)
1258 return NULL;
1259
1260 FOR_EACH_FRAME (tail, frame)
1261 {
1262 if (XFRAME (frame)->mouse_moved)
1263 return XFRAME (frame);
1264 }
1265
1266 return NULL;
1267 }
1268
1269
1270 /* This is the actual command reading loop,
1271 sans error-handling encapsulation. */
1272
1273 enum { READ_KEY_ELTS = 30 };
1274 static int read_key_sequence (Lisp_Object *, Lisp_Object,
1275 bool, bool, bool, bool);
1276 static void adjust_point_for_property (ptrdiff_t, bool);
1277
1278 static Lisp_Object
command_loop_1(void)1279 command_loop_1 (void)
1280 {
1281 modiff_count prev_modiff = 0;
1282 struct buffer *prev_buffer = NULL;
1283 bool already_adjusted = 0;
1284
1285 kset_prefix_arg (current_kboard, Qnil);
1286 kset_last_prefix_arg (current_kboard, Qnil);
1287 Vdeactivate_mark = Qnil;
1288 waiting_for_input = false;
1289 cancel_echoing ();
1290
1291 this_command_key_count = 0;
1292 this_single_command_key_start = 0;
1293
1294 if (NILP (Vmemory_full))
1295 {
1296 /* Make sure this hook runs after commands that get errors and
1297 throw to top level. */
1298 /* Note that the value cell will never directly contain nil
1299 if the symbol is a local variable. */
1300 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1301 safe_run_hooks (Qpost_command_hook);
1302
1303 /* If displaying a message, resize the echo area window to fit
1304 that message's size exactly. */
1305 if (!NILP (echo_area_buffer[0]))
1306 resize_echo_area_exactly ();
1307
1308 /* If there are warnings waiting, process them. */
1309 if (!NILP (Vdelayed_warnings_list))
1310 safe_run_hooks (Qdelayed_warnings_hook);
1311
1312 if (!NILP (Vdeferred_action_list))
1313 safe_run_hooks (Qdeferred_action_function);
1314 }
1315
1316 /* Do this after running Vpost_command_hook, for consistency. */
1317 kset_last_command (current_kboard, Vthis_command);
1318 kset_real_last_command (current_kboard, Vreal_this_command);
1319 if (!CONSP (last_command_event))
1320 kset_last_repeatable_command (current_kboard, Vreal_this_command);
1321
1322 while (true)
1323 {
1324 Lisp_Object cmd;
1325
1326 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1327 Fkill_emacs (Qnil);
1328
1329 /* Make sure the current window's buffer is selected. */
1330 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents));
1331
1332 /* Display any malloc warning that just came out. Use while because
1333 displaying one warning can cause another. */
1334
1335 while (pending_malloc_warning)
1336 display_malloc_warning ();
1337
1338 Vdeactivate_mark = Qnil;
1339
1340 /* Don't ignore mouse movements for more than a single command
1341 loop. (This flag is set in xdisp.c whenever the tool bar is
1342 resized, because the resize moves text up or down, and would
1343 generate false mouse drag events if we don't ignore them.) */
1344 ignore_mouse_drag_p = false;
1345
1346 /* If minibuffer on and echo area in use,
1347 wait a short time and redraw minibuffer. */
1348
1349 if (minibuf_level
1350 && !NILP (echo_area_buffer[0])
1351 && EQ (minibuf_window, echo_area_window)
1352 && NUMBERP (Vminibuffer_message_timeout))
1353 {
1354 /* Bind inhibit-quit to t so that C-g gets read in
1355 rather than quitting back to the minibuffer. */
1356 ptrdiff_t count = SPECPDL_INDEX ();
1357 specbind (Qinhibit_quit, Qt);
1358
1359 sit_for (Vminibuffer_message_timeout, 0, 2);
1360
1361 /* Clear the echo area. */
1362 message1 (0);
1363 safe_run_hooks (Qecho_area_clear_hook);
1364
1365 /* We cleared the echo area, and the minibuffer will now
1366 show, so resize the mini-window in case the minibuffer
1367 needs more or less space than the echo area. */
1368 resize_mini_window (XWINDOW (minibuf_window), false);
1369
1370 unbind_to (count, Qnil);
1371
1372 /* If a C-g came in before, treat it as input now. */
1373 if (!NILP (Vquit_flag))
1374 {
1375 Vquit_flag = Qnil;
1376 Vunread_command_events = list1i (quit_char);
1377 }
1378 }
1379
1380 /* If it has changed current-menubar from previous value,
1381 really recompute the menubar from the value. */
1382 if (! NILP (Vlucid_menu_bar_dirty_flag)
1383 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
1384 call0 (Qrecompute_lucid_menubar);
1385
1386 Vthis_command = Qnil;
1387 Vreal_this_command = Qnil;
1388 Vthis_original_command = Qnil;
1389 Vthis_command_keys_shift_translated = Qnil;
1390
1391 /* Read next key sequence; i gets its length. */
1392 raw_keybuf_count = 0;
1393 Lisp_Object keybuf[READ_KEY_ELTS];
1394 int i = read_key_sequence (keybuf, Qnil, false, true, true, false);
1395
1396 /* A filter may have run while we were reading the input. */
1397 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1398 Fkill_emacs (Qnil);
1399 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents));
1400
1401 ++num_input_keys;
1402
1403 /* Now we have read a key sequence of length I,
1404 or else I is 0 and we found end of file. */
1405
1406 if (i == 0) /* End of file -- happens only in */
1407 return Qnil; /* a kbd macro, at the end. */
1408 /* -1 means read_key_sequence got a menu that was rejected.
1409 Just loop around and read another command. */
1410 if (i == -1)
1411 {
1412 cancel_echoing ();
1413 this_command_key_count = 0;
1414 this_single_command_key_start = 0;
1415 goto finalize;
1416 }
1417
1418 last_command_event = keybuf[i - 1];
1419
1420 /* If the previous command tried to force a specific window-start,
1421 forget about that, in case this command moves point far away
1422 from that position. But also throw away beg_unchanged and
1423 end_unchanged information in that case, so that redisplay will
1424 update the whole window properly. */
1425 if (XWINDOW (selected_window)->force_start)
1426 {
1427 struct buffer *b;
1428 XWINDOW (selected_window)->force_start = 0;
1429 b = XBUFFER (XWINDOW (selected_window)->contents);
1430 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
1431 }
1432
1433 cmd = read_key_sequence_cmd;
1434 if (!NILP (Vexecuting_kbd_macro))
1435 {
1436 if (!NILP (Vquit_flag))
1437 {
1438 Vexecuting_kbd_macro = Qt;
1439 maybe_quit (); /* Make some noise. */
1440 /* Will return since macro now empty. */
1441 }
1442 }
1443
1444 /* Do redisplay processing after this command except in special
1445 cases identified below. */
1446 prev_buffer = current_buffer;
1447 prev_modiff = MODIFF;
1448 last_point_position = PT;
1449
1450 /* By default, we adjust point to a boundary of a region that
1451 has such a property that should be treated intangible
1452 (e.g. composition, display). But, some commands will set
1453 this variable differently. */
1454 Vdisable_point_adjustment = Qnil;
1455
1456 /* Process filters and timers may have messed with deactivate-mark.
1457 reset it before we execute the command. */
1458 Vdeactivate_mark = Qnil;
1459
1460 /* Remap command through active keymaps. */
1461 Vthis_original_command = cmd;
1462 if (!NILP (read_key_sequence_remapped))
1463 cmd = read_key_sequence_remapped;
1464
1465 /* Execute the command. */
1466
1467 {
1468 total_keys += total_keys < lossage_limit;
1469 ASET (recent_keys, recent_keys_index,
1470 Fcons (Qnil, cmd));
1471 if (++recent_keys_index >= lossage_limit)
1472 recent_keys_index = 0;
1473 }
1474 Vthis_command = cmd;
1475 Vreal_this_command = cmd;
1476 safe_run_hooks (Qpre_command_hook);
1477
1478 already_adjusted = 0;
1479
1480 if (NILP (Vthis_command))
1481 /* nil means key is undefined. */
1482 call0 (Qundefined);
1483 else
1484 {
1485 /* Here for a command that isn't executed directly. */
1486
1487 #ifdef HAVE_WINDOW_SYSTEM
1488 ptrdiff_t scount = SPECPDL_INDEX ();
1489
1490 if (display_hourglass_p
1491 && NILP (Vexecuting_kbd_macro))
1492 {
1493 record_unwind_protect_void (cancel_hourglass);
1494 start_hourglass ();
1495 }
1496 #endif
1497
1498 /* Ensure that we have added appropriate undo-boundaries as a
1499 result of changes from the last command. */
1500 call0 (Qundo_auto__add_boundary);
1501
1502 /* Record point and buffer, so we can put point into the undo
1503 information if necessary. */
1504 point_before_last_command_or_undo = PT;
1505 buffer_before_last_command_or_undo = current_buffer;
1506
1507 call1 (Qcommand_execute, Vthis_command);
1508
1509 #ifdef HAVE_WINDOW_SYSTEM
1510 /* Do not check display_hourglass_p here, because
1511 `command-execute' could change it, but we should cancel
1512 hourglass cursor anyway.
1513 But don't cancel the hourglass within a macro
1514 just because a command in the macro finishes. */
1515 if (NILP (Vexecuting_kbd_macro))
1516 unbind_to (scount, Qnil);
1517 #endif
1518 }
1519 kset_last_prefix_arg (current_kboard, Vcurrent_prefix_arg);
1520
1521 safe_run_hooks (Qpost_command_hook);
1522
1523 /* If displaying a message, resize the echo area window to fit
1524 that message's size exactly. Do this only if the echo area
1525 window is the minibuffer window of the selected frame. See
1526 Bug#34317. */
1527 if (!NILP (echo_area_buffer[0])
1528 && (EQ (echo_area_window,
1529 FRAME_MINIBUF_WINDOW (XFRAME (selected_frame)))))
1530 resize_echo_area_exactly ();
1531
1532 /* If there are warnings waiting, process them. */
1533 if (!NILP (Vdelayed_warnings_list))
1534 safe_run_hooks (Qdelayed_warnings_hook);
1535
1536 safe_run_hooks (Qdeferred_action_function);
1537
1538 kset_last_command (current_kboard, Vthis_command);
1539 kset_real_last_command (current_kboard, Vreal_this_command);
1540 if (!CONSP (last_command_event))
1541 kset_last_repeatable_command (current_kboard, Vreal_this_command);
1542
1543 this_command_key_count = 0;
1544 this_single_command_key_start = 0;
1545
1546 if (current_kboard->immediate_echo
1547 && !NILP (call0 (Qinternal_echo_keystrokes_prefix)))
1548 {
1549 current_kboard->immediate_echo = false;
1550 /* Refresh the echo message. */
1551 echo_now ();
1552 }
1553 else
1554 cancel_echoing ();
1555
1556 if (!NILP (BVAR (current_buffer, mark_active))
1557 && !NILP (Vrun_hooks))
1558 {
1559 /* In Emacs 22, setting transient-mark-mode to `only' was a
1560 way of turning it on for just one command. This usage is
1561 obsolete, but support it anyway. */
1562 if (EQ (Vtransient_mark_mode, Qidentity))
1563 Vtransient_mark_mode = Qnil;
1564 else if (EQ (Vtransient_mark_mode, Qonly))
1565 Vtransient_mark_mode = Qidentity;
1566
1567 if (!NILP (Vdeactivate_mark))
1568 /* If `select-active-regions' is non-nil, this call to
1569 `deactivate-mark' also sets the PRIMARY selection. */
1570 call0 (Qdeactivate_mark);
1571 else
1572 {
1573 /* Even if not deactivating the mark, set PRIMARY if
1574 `select-active-regions' is non-nil. */
1575 if (!NILP (Fwindow_system (Qnil))
1576 /* Even if mark_active is non-nil, the actual buffer
1577 marker may not have been set yet (Bug#7044). */
1578 && XMARKER (BVAR (current_buffer, mark))->buffer
1579 && (EQ (Vselect_active_regions, Qonly)
1580 ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly)
1581 : (!NILP (Vselect_active_regions)
1582 && !NILP (Vtransient_mark_mode)))
1583 && NILP (Fmemq (Vthis_command,
1584 Vselection_inhibit_update_commands)))
1585 {
1586 Lisp_Object txt
1587 = call1 (Vregion_extract_function, Qnil);
1588 if (XFIXNUM (Flength (txt)) > 0)
1589 /* Don't set empty selections. */
1590 call2 (Qgui_set_selection, QPRIMARY, txt);
1591 }
1592
1593 if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1594 run_hook (intern ("activate-mark-hook"));
1595 }
1596
1597 Vsaved_region_selection = Qnil;
1598 }
1599
1600 finalize:
1601
1602 if (current_buffer == prev_buffer
1603 && XBUFFER (XWINDOW (selected_window)->contents) == current_buffer
1604 && last_point_position != PT
1605 && NILP (Vdisable_point_adjustment)
1606 && NILP (Vglobal_disable_point_adjustment))
1607 {
1608 if (last_point_position > BEGV
1609 && last_point_position < ZV
1610 && (composition_adjust_point (last_point_position,
1611 last_point_position)
1612 != last_point_position))
1613 /* The last point was temporarily set within a grapheme
1614 cluster to prevent automatic composition. To recover
1615 the automatic composition, we must update the
1616 display. */
1617 windows_or_buffers_changed = 21;
1618 if (!already_adjusted)
1619 adjust_point_for_property (last_point_position,
1620 MODIFF != prev_modiff);
1621 }
1622
1623 /* Install chars successfully executed in kbd macro. */
1624
1625 if (!NILP (KVAR (current_kboard, defining_kbd_macro))
1626 && NILP (KVAR (current_kboard, Vprefix_arg)))
1627 finalize_kbd_macro_chars ();
1628 }
1629 }
1630
1631 Lisp_Object
read_menu_command(void)1632 read_menu_command (void)
1633 {
1634 ptrdiff_t count = SPECPDL_INDEX ();
1635
1636 /* We don't want to echo the keystrokes while navigating the
1637 menus. */
1638 specbind (Qecho_keystrokes, make_fixnum (0));
1639
1640 Lisp_Object keybuf[READ_KEY_ELTS];
1641 int i = read_key_sequence (keybuf, Qnil, false, true, true, true);
1642
1643 unbind_to (count, Qnil);
1644
1645 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1646 Fkill_emacs (Qnil);
1647 if (i == 0 || i == -1)
1648 return Qt;
1649
1650 return read_key_sequence_cmd;
1651 }
1652
1653 /* Adjust point to a boundary of a region that has such a property
1654 that should be treated intangible. For the moment, we check
1655 `composition', `display' and `invisible' properties.
1656 LAST_PT is the last position of point. */
1657
1658 static void
adjust_point_for_property(ptrdiff_t last_pt,bool modified)1659 adjust_point_for_property (ptrdiff_t last_pt, bool modified)
1660 {
1661 ptrdiff_t beg, end;
1662 Lisp_Object val, overlay, tmp;
1663 /* When called after buffer modification, we should temporarily
1664 suppress the point adjustment for automatic composition so that a
1665 user can keep inserting another character at point or keep
1666 deleting characters around point. */
1667 bool check_composition = ! modified;
1668 bool check_display = true, check_invisible = true;
1669 ptrdiff_t orig_pt = PT;
1670
1671 eassert (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer);
1672
1673 /* FIXME: cycling is probably not necessary because these properties
1674 can't be usefully combined anyway. */
1675 while (check_composition || check_display || check_invisible)
1676 {
1677 /* FIXME: check `intangible'. */
1678 if (check_composition
1679 && PT > BEGV && PT < ZV
1680 && (beg = composition_adjust_point (last_pt, PT)) != PT)
1681 {
1682 SET_PT (beg);
1683 check_display = check_invisible = true;
1684 }
1685 check_composition = false;
1686 if (check_display
1687 && PT > BEGV && PT < ZV
1688 && !NILP (val = get_char_property_and_overlay
1689 (make_fixnum (PT), Qdisplay, selected_window,
1690 &overlay))
1691 && display_prop_intangible_p (val, overlay, PT, PT_BYTE)
1692 && (!OVERLAYP (overlay)
1693 ? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil)
1694 : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)),
1695 end = OVERLAY_POSITION (OVERLAY_END (overlay))))
1696 && (beg < PT /* && end > PT <- It's always the case. */
1697 || (beg <= PT && STRINGP (val) && SCHARS (val) == 0)))
1698 {
1699 eassert (end > PT);
1700 SET_PT (PT < last_pt
1701 ? (STRINGP (val) && SCHARS (val) == 0
1702 ? max (beg - 1, BEGV)
1703 : beg)
1704 : end);
1705 check_composition = check_invisible = true;
1706 }
1707 check_display = false;
1708 if (check_invisible && PT > BEGV && PT < ZV)
1709 {
1710 int inv;
1711 bool ellipsis = false;
1712 beg = end = PT;
1713
1714 /* Find boundaries `beg' and `end' of the invisible area, if any. */
1715 while (end < ZV
1716 #if 0
1717 /* FIXME: We should stop if we find a spot between
1718 two runs of `invisible' where inserted text would
1719 be visible. This is important when we have two
1720 invisible boundaries that enclose an area: if the
1721 area is empty, we need this test in order to make
1722 it possible to place point in the middle rather
1723 than skip both boundaries. However, this code
1724 also stops anywhere in a non-sticky text-property,
1725 which breaks (e.g.) Org mode. */
1726 && (val = Fget_pos_property (make_fixnum (end),
1727 Qinvisible, Qnil),
1728 TEXT_PROP_MEANS_INVISIBLE (val))
1729 #endif
1730 && !NILP (val = get_char_property_and_overlay
1731 (make_fixnum (end), Qinvisible, Qnil, &overlay))
1732 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1733 {
1734 ellipsis = ellipsis || inv > 1
1735 || (OVERLAYP (overlay)
1736 && (!NILP (Foverlay_get (overlay, Qafter_string))
1737 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1738 tmp = Fnext_single_char_property_change
1739 (make_fixnum (end), Qinvisible, Qnil, Qnil);
1740 end = FIXNATP (tmp) ? XFIXNAT (tmp) : ZV;
1741 }
1742 while (beg > BEGV
1743 #if 0
1744 && (val = Fget_pos_property (make_fixnum (beg),
1745 Qinvisible, Qnil),
1746 TEXT_PROP_MEANS_INVISIBLE (val))
1747 #endif
1748 && !NILP (val = get_char_property_and_overlay
1749 (make_fixnum (beg - 1), Qinvisible, Qnil, &overlay))
1750 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1751 {
1752 ellipsis = ellipsis || inv > 1
1753 || (OVERLAYP (overlay)
1754 && (!NILP (Foverlay_get (overlay, Qafter_string))
1755 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1756 tmp = Fprevious_single_char_property_change
1757 (make_fixnum (beg), Qinvisible, Qnil, Qnil);
1758 beg = FIXNATP (tmp) ? XFIXNAT (tmp) : BEGV;
1759 }
1760
1761 /* Move away from the inside area. */
1762 if (beg < PT && end > PT)
1763 {
1764 SET_PT ((orig_pt == PT && (last_pt < beg || last_pt > end))
1765 /* We haven't moved yet (so we don't need to fear
1766 infinite-looping) and we were outside the range
1767 before (so either end of the range still corresponds
1768 to a move in the right direction): pretend we moved
1769 less than we actually did, so that we still have
1770 more freedom below in choosing which end of the range
1771 to go to. */
1772 ? (orig_pt = -1, PT < last_pt ? end : beg)
1773 /* We either have moved already or the last point
1774 was already in the range: we don't get to choose
1775 which end of the range we have to go to. */
1776 : (PT < last_pt ? beg : end));
1777 check_composition = check_display = true;
1778 }
1779 #if 0 /* This assertion isn't correct, because SET_PT may end up setting
1780 the point to something other than its argument, due to
1781 point-motion hooks, intangibility, etc. */
1782 eassert (PT == beg || PT == end);
1783 #endif
1784
1785 /* Pretend the area doesn't exist if the buffer is not
1786 modified. */
1787 if (!modified && !ellipsis && beg < end)
1788 {
1789 if (last_pt == beg && PT == end && end < ZV)
1790 (check_composition = check_display = true, SET_PT (end + 1));
1791 else if (last_pt == end && PT == beg && beg > BEGV)
1792 (check_composition = check_display = true, SET_PT (beg - 1));
1793 else if (PT == ((PT < last_pt) ? beg : end))
1794 /* We've already moved as far as we can. Trying to go
1795 to the other end would mean moving backwards and thus
1796 could lead to an infinite loop. */
1797 ;
1798 else if (val = Fget_pos_property (make_fixnum (PT),
1799 Qinvisible, Qnil),
1800 TEXT_PROP_MEANS_INVISIBLE (val)
1801 && (val = (Fget_pos_property
1802 (make_fixnum (PT == beg ? end : beg),
1803 Qinvisible, Qnil)),
1804 !TEXT_PROP_MEANS_INVISIBLE (val)))
1805 (check_composition = check_display = true,
1806 SET_PT (PT == beg ? end : beg));
1807 }
1808 }
1809 check_invisible = false;
1810 }
1811 }
1812
1813 /* Subroutine for safe_run_hooks: run the hook, which is ARGS[1]. */
1814
1815 static Lisp_Object
safe_run_hooks_1(ptrdiff_t nargs,Lisp_Object * args)1816 safe_run_hooks_1 (ptrdiff_t nargs, Lisp_Object *args)
1817 {
1818 eassert (nargs == 2);
1819 return call0 (args[1]);
1820 }
1821
1822 /* Subroutine for safe_run_hooks: handle an error by clearing out the function
1823 from the hook. */
1824
1825 static Lisp_Object
safe_run_hooks_error(Lisp_Object error,ptrdiff_t nargs,Lisp_Object * args)1826 safe_run_hooks_error (Lisp_Object error, ptrdiff_t nargs, Lisp_Object *args)
1827 {
1828 eassert (nargs == 2);
1829 AUTO_STRING (format, "Error in %s (%S): %S");
1830 Lisp_Object hook = args[0];
1831 Lisp_Object fun = args[1];
1832 CALLN (Fmessage, format, hook, fun, error);
1833
1834 if (SYMBOLP (hook))
1835 {
1836 bool found = false;
1837 Lisp_Object newval = Qnil;
1838 Lisp_Object val = find_symbol_value (hook);
1839 FOR_EACH_TAIL (val)
1840 if (EQ (fun, XCAR (val)))
1841 found = true;
1842 else
1843 newval = Fcons (XCAR (val), newval);
1844 if (found)
1845 return Fset (hook, Fnreverse (newval));
1846 /* Not found in the local part of the hook. Let's look at the global
1847 part. */
1848 newval = Qnil;
1849 val = NILP (Fdefault_boundp (hook)) ? Qnil : Fdefault_value (hook);
1850 FOR_EACH_TAIL (val)
1851 if (EQ (fun, XCAR (val)))
1852 found = true;
1853 else
1854 newval = Fcons (XCAR (val), newval);
1855 if (found)
1856 return Fset_default (hook, Fnreverse (newval));
1857 }
1858 return Qnil;
1859 }
1860
1861 static Lisp_Object
safe_run_hook_funcall(ptrdiff_t nargs,Lisp_Object * args)1862 safe_run_hook_funcall (ptrdiff_t nargs, Lisp_Object *args)
1863 {
1864 eassert (nargs == 2);
1865 /* Yes, run_hook_with_args works with args in the other order. */
1866 internal_condition_case_n (safe_run_hooks_1,
1867 2, ((Lisp_Object []) {args[1], args[0]}),
1868 Qt, safe_run_hooks_error);
1869 return Qnil;
1870 }
1871
1872 /* If we get an error while running the hook, cause the hook variable
1873 to be nil. Also inhibit quits, so that C-g won't cause the hook
1874 to mysteriously evaporate. */
1875
1876 void
safe_run_hooks(Lisp_Object hook)1877 safe_run_hooks (Lisp_Object hook)
1878 {
1879 ptrdiff_t count = SPECPDL_INDEX ();
1880
1881 specbind (Qinhibit_quit, Qt);
1882 run_hook_with_args (2, ((Lisp_Object []) {hook, hook}), safe_run_hook_funcall);
1883 unbind_to (count, Qnil);
1884 }
1885
1886
1887 /* Nonzero means polling for input is temporarily suppressed. */
1888
1889 int poll_suppress_count;
1890
1891
1892 #ifdef POLL_FOR_INPUT
1893
1894 /* Asynchronous timer for polling. */
1895
1896 static struct atimer *poll_timer;
1897
1898 #if defined CYGWIN || defined DOS_NT
1899 /* Poll for input, so that we catch a C-g if it comes in. */
1900 void
poll_for_input_1(void)1901 poll_for_input_1 (void)
1902 {
1903 if (! input_blocked_p ()
1904 && !waiting_for_input)
1905 gobble_input ();
1906 }
1907 #endif
1908
1909 /* Timer callback function for poll_timer. TIMER is equal to
1910 poll_timer. */
1911
1912 static void
poll_for_input(struct atimer * timer)1913 poll_for_input (struct atimer *timer)
1914 {
1915 if (poll_suppress_count == 0)
1916 pending_signals = true;
1917 }
1918
1919 #endif /* POLL_FOR_INPUT */
1920
1921 /* Begin signals to poll for input, if they are appropriate.
1922 This function is called unconditionally from various places. */
1923
1924 void
start_polling(void)1925 start_polling (void)
1926 {
1927 #ifdef POLL_FOR_INPUT
1928 /* XXX This condition was (read_socket_hook && !interrupt_input),
1929 but read_socket_hook is not global anymore. Let's pretend that
1930 it's always set. */
1931 if (!interrupt_input)
1932 {
1933 /* Turn alarm handling on unconditionally. It might have
1934 been turned off in process.c. */
1935 turn_on_atimers (1);
1936
1937 /* If poll timer doesn't exist, or we need one with
1938 a different interval, start a new one. */
1939 if (poll_timer == NULL
1940 || poll_timer->interval.tv_sec != polling_period)
1941 {
1942 time_t period = max (1, min (polling_period, TYPE_MAXIMUM (time_t)));
1943 struct timespec interval = make_timespec (period, 0);
1944
1945 if (poll_timer)
1946 cancel_atimer (poll_timer);
1947
1948 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
1949 poll_for_input, NULL);
1950 }
1951
1952 /* Let the timer's callback function poll for input
1953 if this becomes zero. */
1954 --poll_suppress_count;
1955 }
1956 #endif
1957 }
1958
1959 #if defined CYGWIN || defined DOS_NT
1960 /* True if we are using polling to handle input asynchronously. */
1961
1962 bool
input_polling_used(void)1963 input_polling_used (void)
1964 {
1965 # ifdef POLL_FOR_INPUT
1966 /* XXX This condition was (read_socket_hook && !interrupt_input),
1967 but read_socket_hook is not global anymore. Let's pretend that
1968 it's always set. */
1969 return !interrupt_input;
1970 # else
1971 return false;
1972 # endif
1973 }
1974 #endif
1975
1976 /* Turn off polling. */
1977
1978 void
stop_polling(void)1979 stop_polling (void)
1980 {
1981 #ifdef POLL_FOR_INPUT
1982 /* XXX This condition was (read_socket_hook && !interrupt_input),
1983 but read_socket_hook is not global anymore. Let's pretend that
1984 it's always set. */
1985 if (!interrupt_input)
1986 ++poll_suppress_count;
1987 #endif
1988 }
1989
1990 /* Set the value of poll_suppress_count to COUNT
1991 and start or stop polling accordingly. */
1992
1993 void
set_poll_suppress_count(int count)1994 set_poll_suppress_count (int count)
1995 {
1996 #ifdef POLL_FOR_INPUT
1997 if (count == 0 && poll_suppress_count != 0)
1998 {
1999 poll_suppress_count = 1;
2000 start_polling ();
2001 }
2002 else if (count != 0 && poll_suppress_count == 0)
2003 {
2004 stop_polling ();
2005 }
2006 poll_suppress_count = count;
2007 #endif
2008 }
2009
2010 /* Bind polling_period to a value at least N.
2011 But don't decrease it. */
2012
2013 void
bind_polling_period(int n)2014 bind_polling_period (int n)
2015 {
2016 #ifdef POLL_FOR_INPUT
2017 intmax_t new = polling_period;
2018
2019 if (n > new)
2020 new = n;
2021
2022 stop_other_atimers (poll_timer);
2023 stop_polling ();
2024 specbind (Qpolling_period, make_int (new));
2025 /* Start a new alarm with the new period. */
2026 start_polling ();
2027 #endif
2028 }
2029
2030 /* Apply the control modifier to CHARACTER. */
2031
2032 int
make_ctrl_char(int c)2033 make_ctrl_char (int c)
2034 {
2035 /* Save the upper bits here. */
2036 int upper = c & ~0177;
2037
2038 if (! ASCII_CHAR_P (c))
2039 return c |= ctrl_modifier;
2040
2041 c &= 0177;
2042
2043 /* Everything in the columns containing the upper-case letters
2044 denotes a control character. */
2045 if (c >= 0100 && c < 0140)
2046 {
2047 int oc = c;
2048 c &= ~0140;
2049 /* Set the shift modifier for a control char
2050 made from a shifted letter. But only for letters! */
2051 if (oc >= 'A' && oc <= 'Z')
2052 c |= shift_modifier;
2053 }
2054
2055 /* The lower-case letters denote control characters too. */
2056 else if (c >= 'a' && c <= 'z')
2057 c &= ~0140;
2058
2059 /* Include the bits for control and shift
2060 only if the basic ASCII code can't indicate them. */
2061 else if (c >= ' ')
2062 c |= ctrl_modifier;
2063
2064 /* Replace the high bits. */
2065 c |= (upper & ~ctrl_modifier);
2066
2067 return c;
2068 }
2069
2070 /* Substitute key descriptions and quotes in HELP, unless its first
2071 character has a non-nil help-echo-inhibit-substitution property. */
2072
2073 static Lisp_Object
help_echo_substitute_command_keys(Lisp_Object help)2074 help_echo_substitute_command_keys (Lisp_Object help)
2075 {
2076 if (STRINGP (help)
2077 && SCHARS (help) > 0
2078 && !NILP (Fget_text_property (make_fixnum (0),
2079 Qhelp_echo_inhibit_substitution,
2080 help)))
2081 return help;
2082
2083 return call1 (Qsubstitute_command_keys, help);
2084 }
2085
2086 /* Display the help-echo property of the character after the mouse pointer.
2087 Either show it in the echo area, or call show-help-function to display
2088 it by other means (maybe in a tooltip).
2089
2090 If HELP is nil, that means clear the previous help echo.
2091
2092 If HELP is a string, display that string. If HELP is a function,
2093 call it with OBJECT and POS as arguments; the function should
2094 return a help string or nil for none. For all other types of HELP,
2095 evaluate it to obtain a string.
2096
2097 WINDOW is the window in which the help was generated, if any.
2098 It is nil if not in a window.
2099
2100 If OBJECT is a buffer, POS is the position in the buffer where the
2101 `help-echo' text property was found.
2102
2103 If OBJECT is an overlay, that overlay has a `help-echo' property,
2104 and POS is the position in the overlay's buffer under the mouse.
2105
2106 If OBJECT is a string (an overlay string or a string displayed with
2107 the `display' property). POS is the position in that string under
2108 the mouse.
2109
2110 Note: this function may only be called with HELP nil or a string
2111 from X code running asynchronously. */
2112
2113 void
show_help_echo(Lisp_Object help,Lisp_Object window,Lisp_Object object,Lisp_Object pos)2114 show_help_echo (Lisp_Object help, Lisp_Object window, Lisp_Object object,
2115 Lisp_Object pos)
2116 {
2117 if (!NILP (help) && !STRINGP (help))
2118 {
2119 if (FUNCTIONP (help))
2120 help = safe_call (4, help, window, object, pos);
2121 else
2122 help = safe_eval (help);
2123
2124 if (!STRINGP (help))
2125 return;
2126 }
2127
2128 if (!noninteractive && STRINGP (help))
2129 {
2130 /* The mouse-fixup-help-message Lisp function can call
2131 mouse_position_hook, which resets the mouse_moved flags.
2132 This causes trouble if we are trying to read a mouse motion
2133 event (i.e., if we are inside a `track-mouse' form), so we
2134 restore the mouse_moved flag. */
2135 struct frame *f = some_mouse_moved ();
2136
2137 help = call1 (Qmouse_fixup_help_message, help);
2138 if (f)
2139 f->mouse_moved = true;
2140 }
2141
2142 if (STRINGP (help) || NILP (help))
2143 {
2144 if (!NILP (Vshow_help_function))
2145 call1 (Vshow_help_function, help_echo_substitute_command_keys (help));
2146 help_echo_showing_p = STRINGP (help);
2147 }
2148 }
2149
2150
2151
2152 /* Input of single characters from keyboard. */
2153
2154 static Lisp_Object kbd_buffer_get_event (KBOARD **kbp, bool *used_mouse_menu,
2155 struct timespec *end_time);
2156 static void record_char (Lisp_Object c);
2157
2158 static Lisp_Object help_form_saved_window_configs;
2159 static void
read_char_help_form_unwind(void)2160 read_char_help_form_unwind (void)
2161 {
2162 Lisp_Object window_config = XCAR (help_form_saved_window_configs);
2163 help_form_saved_window_configs = XCDR (help_form_saved_window_configs);
2164 if (!NILP (window_config))
2165 Fset_window_configuration (window_config, Qnil, Qnil);
2166 }
2167
2168 #define STOP_POLLING \
2169 do { if (! polling_stopped_here) stop_polling (); \
2170 polling_stopped_here = true; } while (0)
2171
2172 #define RESUME_POLLING \
2173 do { if (polling_stopped_here) start_polling (); \
2174 polling_stopped_here = false; } while (0)
2175
2176 static Lisp_Object
read_event_from_main_queue(struct timespec * end_time,sys_jmp_buf local_getcjmp,bool * used_mouse_menu)2177 read_event_from_main_queue (struct timespec *end_time,
2178 sys_jmp_buf local_getcjmp,
2179 bool *used_mouse_menu)
2180 {
2181 Lisp_Object c = Qnil;
2182 sys_jmp_buf save_jump;
2183 KBOARD *kb;
2184
2185 start:
2186
2187 /* Read from the main queue, and if that gives us something we can't use yet,
2188 we put it on the appropriate side queue and try again. */
2189
2190 if (end_time && timespec_cmp (*end_time, current_timespec ()) <= 0)
2191 return c;
2192
2193 /* Actually read a character, waiting if necessary. */
2194 ptrdiff_t count = SPECPDL_INDEX ();
2195 save_getcjmp (save_jump);
2196 record_unwind_protect_ptr (restore_getcjmp, save_jump);
2197 restore_getcjmp (local_getcjmp);
2198 if (!end_time)
2199 timer_start_idle ();
2200 c = kbd_buffer_get_event (&kb, used_mouse_menu, end_time);
2201 unbind_to (count, Qnil);
2202
2203 if (! NILP (c) && (kb != current_kboard))
2204 {
2205 Lisp_Object last = KVAR (kb, kbd_queue);
2206 if (CONSP (last))
2207 {
2208 while (CONSP (XCDR (last)))
2209 last = XCDR (last);
2210 if (!NILP (XCDR (last)))
2211 emacs_abort ();
2212 }
2213 if (!CONSP (last))
2214 kset_kbd_queue (kb, list1 (c));
2215 else
2216 XSETCDR (last, list1 (c));
2217 kb->kbd_queue_has_data = true;
2218 c = Qnil;
2219 if (single_kboard)
2220 goto start;
2221 current_kboard = kb;
2222 return make_fixnum (-2);
2223 }
2224
2225 /* Terminate Emacs in batch mode if at eof. */
2226 if (noninteractive && FIXNUMP (c) && XFIXNUM (c) < 0)
2227 Fkill_emacs (make_fixnum (1));
2228
2229 if (FIXNUMP (c))
2230 {
2231 /* Add in any extra modifiers, where appropriate. */
2232 if ((extra_keyboard_modifiers & CHAR_CTL)
2233 || ((extra_keyboard_modifiers & 0177) < ' '
2234 && (extra_keyboard_modifiers & 0177) != 0))
2235 XSETINT (c, make_ctrl_char (XFIXNUM (c)));
2236
2237 /* Transfer any other modifier bits directly from
2238 extra_keyboard_modifiers to c. Ignore the actual character code
2239 in the low 16 bits of extra_keyboard_modifiers. */
2240 XSETINT (c, XFIXNUM (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
2241 }
2242
2243 return c;
2244 }
2245
2246
2247
2248 /* Like `read_event_from_main_queue' but applies keyboard-coding-system
2249 to tty input. */
2250 static Lisp_Object
read_decoded_event_from_main_queue(struct timespec * end_time,sys_jmp_buf local_getcjmp,Lisp_Object prev_event,bool * used_mouse_menu)2251 read_decoded_event_from_main_queue (struct timespec *end_time,
2252 sys_jmp_buf local_getcjmp,
2253 Lisp_Object prev_event,
2254 bool *used_mouse_menu)
2255 {
2256 #ifndef WINDOWSNT
2257 #define MAX_ENCODED_BYTES 16
2258 Lisp_Object events[MAX_ENCODED_BYTES];
2259 int n = 0;
2260 #endif
2261 while (true)
2262 {
2263 Lisp_Object nextevt
2264 = read_event_from_main_queue (end_time, local_getcjmp,
2265 used_mouse_menu);
2266 #ifdef WINDOWSNT
2267 /* w32_console already returns decoded events. It either reads
2268 Unicode characters from the Windows keyboard input, or
2269 converts characters encoded in the current codepage into
2270 Unicode. See w32inevt.c:key_event, near its end. */
2271 return nextevt;
2272 #else
2273 struct frame *frame = XFRAME (selected_frame);
2274 struct terminal *terminal = frame->terminal;
2275 if (!((FRAME_TERMCAP_P (frame) || FRAME_MSDOS_P (frame))
2276 /* Don't apply decoding if we're just reading a raw event
2277 (e.g. reading bytes sent by the xterm to specify the position
2278 of a mouse click). */
2279 && (!EQ (prev_event, Qt))
2280 && (TERMINAL_KEYBOARD_CODING (terminal)->common_flags
2281 & CODING_REQUIRE_DECODING_MASK)))
2282 return nextevt; /* No decoding needed. */
2283 else
2284 {
2285 int meta_key = terminal->display_info.tty->meta_key;
2286 eassert (n < MAX_ENCODED_BYTES);
2287 events[n++] = nextevt;
2288 if (FIXNATP (nextevt)
2289 && XFIXNUM (nextevt) < (meta_key == 1 ? 0x80 : 0x100))
2290 { /* An encoded byte sequence, let's try to decode it. */
2291 struct coding_system *coding
2292 = TERMINAL_KEYBOARD_CODING (terminal);
2293
2294 if (raw_text_coding_system_p (coding))
2295 {
2296 int i;
2297 if (meta_key != 2)
2298 {
2299 for (i = 0; i < n; i++)
2300 {
2301 int c = XFIXNUM (events[i]);
2302 int modifier =
2303 (meta_key == 3 && c < 0x100 && (c & 0x80))
2304 ? meta_modifier
2305 : 0;
2306 events[i] = make_fixnum ((c & ~0x80) | modifier);
2307 }
2308 }
2309 }
2310 else
2311 {
2312 unsigned char src[MAX_ENCODED_BYTES];
2313 unsigned char dest[MAX_ENCODED_BYTES * MAX_MULTIBYTE_LENGTH];
2314 int i;
2315 for (i = 0; i < n; i++)
2316 src[i] = XFIXNUM (events[i]);
2317 if (meta_key < 2) /* input-meta-mode is t or nil */
2318 for (i = 0; i < n; i++)
2319 src[i] &= ~0x80;
2320 coding->destination = dest;
2321 coding->dst_bytes = sizeof dest;
2322 decode_coding_c_string (coding, src, n, Qnil);
2323 eassert (coding->produced_char <= n);
2324 if (coding->produced_char == 0)
2325 { /* The encoded sequence is incomplete. */
2326 if (n < MAX_ENCODED_BYTES) /* Avoid buffer overflow. */
2327 continue; /* Read on! */
2328 }
2329 else
2330 {
2331 const unsigned char *p = coding->destination;
2332 eassert (coding->carryover_bytes == 0);
2333 n = 0;
2334 while (n < coding->produced_char)
2335 {
2336 int c = string_char_advance (&p);
2337 if (meta_key == 3)
2338 {
2339 int modifier
2340 = (c < 0x100 && (c & 0x80)
2341 ? meta_modifier
2342 : 0);
2343 c = (c & ~0x80) | modifier;
2344 }
2345 events[n++] = make_fixnum (c);
2346 }
2347 }
2348 }
2349 }
2350 /* Now `events' should hold decoded events.
2351 Normally, n should be equal to 1, but better not rely on it.
2352 We can only return one event here, so return the first we
2353 had and keep the others (if any) for later. */
2354 while (n > 1)
2355 Vunread_command_events
2356 = Fcons (events[--n], Vunread_command_events);
2357 return events[0];
2358 }
2359 #endif
2360 }
2361 }
2362
2363 /* Read a character from the keyboard; call the redisplay if needed. */
2364 /* commandflag 0 means do not autosave, but do redisplay.
2365 -1 means do not redisplay, but do autosave.
2366 -2 means do neither.
2367 1 means do both.
2368
2369 The argument MAP is a keymap for menu prompting.
2370
2371 PREV_EVENT is the previous input event, or nil if we are reading
2372 the first event of a key sequence (or not reading a key sequence).
2373 If PREV_EVENT is t, that is a "magic" value that says
2374 not to run input methods, but in other respects to act as if
2375 not reading a key sequence.
2376
2377 If USED_MOUSE_MENU is non-null, then set *USED_MOUSE_MENU to true
2378 if we used a mouse menu to read the input, or false otherwise. If
2379 USED_MOUSE_MENU is null, don't dereference it.
2380
2381 Value is -2 when we find input on another keyboard. A second call
2382 to read_char will read it.
2383
2384 If END_TIME is non-null, it is a pointer to a struct timespec
2385 specifying the maximum time to wait until. If no input arrives by
2386 that time, stop waiting and return nil.
2387
2388 Value is t if we showed a menu and the user rejected it. */
2389
2390 Lisp_Object
read_char(int commandflag,Lisp_Object map,Lisp_Object prev_event,bool * used_mouse_menu,struct timespec * end_time)2391 read_char (int commandflag, Lisp_Object map,
2392 Lisp_Object prev_event,
2393 bool *used_mouse_menu, struct timespec *end_time)
2394 {
2395 Lisp_Object c;
2396 ptrdiff_t jmpcount;
2397 sys_jmp_buf local_getcjmp;
2398 sys_jmp_buf save_jump;
2399 Lisp_Object tem, save;
2400 volatile Lisp_Object previous_echo_area_message;
2401 volatile Lisp_Object also_record;
2402 volatile bool reread, recorded;
2403 bool volatile polling_stopped_here = false;
2404 struct kboard *orig_kboard = current_kboard;
2405
2406 also_record = Qnil;
2407
2408 c = Qnil;
2409 previous_echo_area_message = Qnil;
2410
2411 retry:
2412
2413 recorded = false;
2414
2415 if (CONSP (Vunread_post_input_method_events))
2416 {
2417 c = XCAR (Vunread_post_input_method_events);
2418 Vunread_post_input_method_events
2419 = XCDR (Vunread_post_input_method_events);
2420
2421 /* Undo what read_char_x_menu_prompt did when it unread
2422 additional keys returned by Fx_popup_menu. */
2423 if (CONSP (c)
2424 && (SYMBOLP (XCAR (c)) || FIXNUMP (XCAR (c)))
2425 && NILP (XCDR (c)))
2426 c = XCAR (c);
2427
2428 reread = true;
2429 goto reread_first;
2430 }
2431 else
2432 reread = false;
2433
2434
2435 if (CONSP (Vunread_command_events))
2436 {
2437 bool was_disabled = false;
2438
2439 c = XCAR (Vunread_command_events);
2440 Vunread_command_events = XCDR (Vunread_command_events);
2441
2442 /* Undo what sit-for did when it unread additional keys
2443 inside universal-argument. */
2444
2445 if (CONSP (c) && EQ (XCAR (c), Qt))
2446 c = XCDR (c);
2447 else
2448 {
2449 if (CONSP (c) && EQ (XCAR (c), Qno_record))
2450 {
2451 c = XCDR (c);
2452 recorded = true;
2453 }
2454 reread = true;
2455 }
2456
2457 /* Undo what read_char_x_menu_prompt did when it unread
2458 additional keys returned by Fx_popup_menu. */
2459 if (CONSP (c)
2460 && EQ (XCDR (c), Qdisabled)
2461 && (SYMBOLP (XCAR (c)) || FIXNUMP (XCAR (c))))
2462 {
2463 was_disabled = true;
2464 c = XCAR (c);
2465 }
2466
2467 /* If the queued event is something that used the mouse,
2468 set used_mouse_menu accordingly. */
2469 if (used_mouse_menu
2470 /* Also check was_disabled so last-nonmenu-event won't return
2471 a bad value when submenus are involved. (Bug#447) */
2472 && (EQ (c, Qtool_bar) || EQ (c, Qtab_bar) || EQ (c, Qmenu_bar)
2473 || was_disabled))
2474 *used_mouse_menu = true;
2475
2476 goto reread_for_input_method;
2477 }
2478
2479 if (CONSP (Vunread_input_method_events))
2480 {
2481 c = XCAR (Vunread_input_method_events);
2482 Vunread_input_method_events = XCDR (Vunread_input_method_events);
2483
2484 /* Undo what read_char_x_menu_prompt did when it unread
2485 additional keys returned by Fx_popup_menu. */
2486 if (CONSP (c)
2487 && (SYMBOLP (XCAR (c)) || FIXNUMP (XCAR (c)))
2488 && NILP (XCDR (c)))
2489 c = XCAR (c);
2490 reread = true;
2491 goto reread_for_input_method;
2492 }
2493
2494 if (!NILP (Vexecuting_kbd_macro))
2495 {
2496 /* We set this to Qmacro; since that's not a frame, nobody will
2497 try to switch frames on us, and the selected window will
2498 remain unchanged.
2499
2500 Since this event came from a macro, it would be misleading to
2501 leave internal_last_event_frame set to wherever the last
2502 real event came from. Normally, a switch-frame event selects
2503 internal_last_event_frame after each command is read, but
2504 events read from a macro should never cause a new frame to be
2505 selected. */
2506 Vlast_event_frame = internal_last_event_frame = Qmacro;
2507
2508 /* Exit the macro if we are at the end.
2509 Also, some things replace the macro with t
2510 to force an early exit. */
2511 if (EQ (Vexecuting_kbd_macro, Qt)
2512 || executing_kbd_macro_index >= XFIXNAT (Flength (Vexecuting_kbd_macro)))
2513 {
2514 XSETINT (c, -1);
2515 goto exit;
2516 }
2517
2518 c = Faref (Vexecuting_kbd_macro, make_int (executing_kbd_macro_index));
2519 if (STRINGP (Vexecuting_kbd_macro)
2520 && (XFIXNAT (c) & 0x80) && (XFIXNAT (c) <= 0xff))
2521 XSETFASTINT (c, CHAR_META | (XFIXNAT (c) & ~0x80));
2522
2523 executing_kbd_macro_index++;
2524
2525 goto from_macro;
2526 }
2527
2528 if (!NILP (unread_switch_frame))
2529 {
2530 c = unread_switch_frame;
2531 unread_switch_frame = Qnil;
2532
2533 /* This event should make it into this_command_keys, and get echoed
2534 again, so we do not set `reread'. */
2535 goto reread_first;
2536 }
2537
2538 /* If redisplay was requested. */
2539 if (commandflag >= 0)
2540 {
2541 bool echo_current = EQ (echo_message_buffer, echo_area_buffer[0]);
2542
2543 /* If there is pending input, process any events which are not
2544 user-visible, such as X selection_request events. */
2545 if (input_pending
2546 || detect_input_pending_run_timers (0))
2547 swallow_events (false); /* May clear input_pending. */
2548
2549 /* Redisplay if no pending input. */
2550 while (!(input_pending
2551 && (input_was_pending || !redisplay_dont_pause)))
2552 {
2553 input_was_pending = input_pending;
2554 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
2555 redisplay_preserve_echo_area (5);
2556 else
2557 redisplay ();
2558
2559 if (!input_pending)
2560 /* Normal case: no input arrived during redisplay. */
2561 break;
2562
2563 /* Input arrived and pre-empted redisplay.
2564 Process any events which are not user-visible. */
2565 swallow_events (false);
2566 /* If that cleared input_pending, try again to redisplay. */
2567 }
2568
2569 /* Prevent the redisplay we just did
2570 from messing up echoing of the input after the prompt. */
2571 if (commandflag == 0 && echo_current)
2572 echo_message_buffer = echo_area_buffer[0];
2573
2574 }
2575
2576 /* Message turns off echoing unless more keystrokes turn it on again.
2577
2578 The code in 20.x for the condition was
2579
2580 1. echo_area_glyphs && *echo_area_glyphs
2581 2. && echo_area_glyphs != current_kboard->echobuf
2582 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2583
2584 (1) means there's a current message displayed
2585
2586 (2) means it's not the message from echoing from the current
2587 kboard.
2588
2589 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2590 is set to a non-null value. This is done in read_char and it is
2591 set to echo_area_glyphs. That means
2592 ok_to_echo_at_next_pause is either null or
2593 current_kboard->echobuf with the appropriate current_kboard at
2594 that time.
2595
2596 So, condition (3) means in clear text ok_to_echo_at_next_pause
2597 must be either null, or the current message isn't from echoing at
2598 all, or it's from echoing from a different kboard than the
2599 current one. */
2600
2601 if (/* There currently is something in the echo area. */
2602 !NILP (echo_area_buffer[0])
2603 && (/* It's an echo from a different kboard. */
2604 echo_kboard != current_kboard
2605 /* Or we explicitly allow overwriting whatever there is. */
2606 || ok_to_echo_at_next_pause == NULL))
2607 cancel_echoing ();
2608 else
2609 echo_dash ();
2610
2611 /* Try reading a character via menu prompting in the minibuf.
2612 Try this before the sit-for, because the sit-for
2613 would do the wrong thing if we are supposed to do
2614 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2615 after a mouse event so don't try a minibuf menu. */
2616 c = Qnil;
2617 if (KEYMAPP (map) && INTERACTIVE
2618 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2619 /* Don't bring up a menu if we already have another event. */
2620 && !CONSP (Vunread_command_events)
2621 && !detect_input_pending_run_timers (0))
2622 {
2623 c = read_char_minibuf_menu_prompt (commandflag, map);
2624
2625 if (FIXNUMP (c) && XFIXNUM (c) == -2)
2626 return c; /* wrong_kboard_jmpbuf */
2627
2628 if (! NILP (c))
2629 goto exit;
2630 }
2631
2632 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2633 We will do that below, temporarily for short sections of code,
2634 when appropriate. local_getcjmp must be in effect
2635 around any call to sit_for or kbd_buffer_get_event;
2636 it *must not* be in effect when we call redisplay. */
2637
2638 jmpcount = SPECPDL_INDEX ();
2639 if (sys_setjmp (local_getcjmp))
2640 {
2641 /* Handle quits while reading the keyboard. */
2642 /* We must have saved the outer value of getcjmp here,
2643 so restore it now. */
2644 restore_getcjmp (save_jump);
2645 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
2646 unbind_to (jmpcount, Qnil);
2647 /* If we are in while-no-input, don't trigger C-g, as that will
2648 quit instead of letting while-no-input do its thing. */
2649 if (!EQ (Vquit_flag, Vthrow_on_input))
2650 XSETINT (c, quit_char);
2651 internal_last_event_frame = selected_frame;
2652 Vlast_event_frame = internal_last_event_frame;
2653 /* If we report the quit char as an event,
2654 don't do so more than once. */
2655 if (!NILP (Vinhibit_quit))
2656 Vquit_flag = Qnil;
2657
2658 {
2659 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
2660 if (kb != current_kboard)
2661 {
2662 Lisp_Object last = KVAR (kb, kbd_queue);
2663 /* We shouldn't get here if we were in single-kboard mode! */
2664 if (single_kboard)
2665 emacs_abort ();
2666 if (CONSP (last))
2667 {
2668 while (CONSP (XCDR (last)))
2669 last = XCDR (last);
2670 if (!NILP (XCDR (last)))
2671 emacs_abort ();
2672 }
2673 if (!CONSP (last))
2674 kset_kbd_queue (kb, list1 (c));
2675 else
2676 XSETCDR (last, list1 (c));
2677 kb->kbd_queue_has_data = true;
2678 current_kboard = kb;
2679 return make_fixnum (-2); /* wrong_kboard_jmpbuf */
2680 }
2681 }
2682 goto non_reread;
2683 }
2684
2685 /* Start idle timers if no time limit is supplied. We don't do it
2686 if a time limit is supplied to avoid an infinite recursion in the
2687 situation where an idle timer calls `sit-for'. */
2688
2689 if (!end_time)
2690 timer_start_idle ();
2691
2692 /* If in middle of key sequence and minibuffer not active,
2693 start echoing if enough time elapses. */
2694
2695 if (minibuf_level == 0
2696 && !end_time
2697 && !current_kboard->immediate_echo
2698 && (this_command_key_count > 0
2699 || !NILP (call0 (Qinternal_echo_keystrokes_prefix)))
2700 && ! noninteractive
2701 && echo_keystrokes_p ()
2702 && (/* No message. */
2703 NILP (echo_area_buffer[0])
2704 /* Or empty message. */
2705 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2706 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2707 /* Or already echoing from same kboard. */
2708 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2709 /* Or not echoing before and echoing allowed. */
2710 || (!echo_kboard && ok_to_echo_at_next_pause)))
2711 {
2712 /* After a mouse event, start echoing right away.
2713 This is because we are probably about to display a menu,
2714 and we don't want to delay before doing so. */
2715 if (EVENT_HAS_PARAMETERS (prev_event))
2716 echo_now ();
2717 else
2718 {
2719 Lisp_Object tem0;
2720
2721 ptrdiff_t count = SPECPDL_INDEX ();
2722 save_getcjmp (save_jump);
2723 record_unwind_protect_ptr (restore_getcjmp, save_jump);
2724 restore_getcjmp (local_getcjmp);
2725 tem0 = sit_for (Vecho_keystrokes, 1, 1);
2726 unbind_to (count, Qnil);
2727 if (EQ (tem0, Qt)
2728 && ! CONSP (Vunread_command_events))
2729 echo_now ();
2730 }
2731 }
2732
2733 /* Maybe auto save due to number of keystrokes. */
2734
2735 if (commandflag != 0 && commandflag != -2
2736 && auto_save_interval > 0
2737 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
2738 && !detect_input_pending_run_timers (0))
2739 {
2740 Fdo_auto_save (auto_save_no_message ? Qt : Qnil, Qnil);
2741 /* Hooks can actually change some buffers in auto save. */
2742 redisplay ();
2743 }
2744
2745 /* Try reading using an X menu.
2746 This is never confused with reading using the minibuf
2747 because the recursive call of read_char in read_char_minibuf_menu_prompt
2748 does not pass on any keymaps. */
2749
2750 if (KEYMAPP (map) && INTERACTIVE
2751 && !NILP (prev_event)
2752 && EVENT_HAS_PARAMETERS (prev_event)
2753 && !EQ (XCAR (prev_event), Qmenu_bar)
2754 && !EQ (XCAR (prev_event), Qtab_bar)
2755 && !EQ (XCAR (prev_event), Qtool_bar)
2756 /* Don't bring up a menu if we already have another event. */
2757 && !CONSP (Vunread_command_events))
2758 {
2759 c = read_char_x_menu_prompt (map, prev_event, used_mouse_menu);
2760
2761 /* Now that we have read an event, Emacs is not idle. */
2762 if (!end_time)
2763 timer_stop_idle ();
2764
2765 goto exit;
2766 }
2767
2768 /* Maybe autosave and/or garbage collect due to idleness. */
2769
2770 if (INTERACTIVE && NILP (c))
2771 {
2772 int delay_level;
2773 ptrdiff_t buffer_size;
2774
2775 /* Slow down auto saves logarithmically in size of current buffer,
2776 and garbage collect while we're at it. */
2777 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2778 last_non_minibuf_size = Z - BEG;
2779 buffer_size = (last_non_minibuf_size >> 8) + 1;
2780 delay_level = 0;
2781 while (buffer_size > 64)
2782 delay_level++, buffer_size -= buffer_size >> 2;
2783 if (delay_level < 4) delay_level = 4;
2784 /* delay_level is 4 for files under around 50k, 7 at 100k,
2785 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2786
2787 /* Auto save if enough time goes by without input. */
2788 if (commandflag != 0 && commandflag != -2
2789 && num_nonmacro_input_events > last_auto_save
2790 && FIXNUMP (Vauto_save_timeout)
2791 && XFIXNUM (Vauto_save_timeout) > 0)
2792 {
2793 Lisp_Object tem0;
2794 EMACS_INT timeout = XFIXNAT (Vauto_save_timeout);
2795
2796 timeout = min (timeout, MOST_POSITIVE_FIXNUM / delay_level * 4);
2797 timeout = delay_level * timeout / 4;
2798 ptrdiff_t count1 = SPECPDL_INDEX ();
2799 save_getcjmp (save_jump);
2800 record_unwind_protect_ptr (restore_getcjmp, save_jump);
2801 restore_getcjmp (local_getcjmp);
2802 tem0 = sit_for (make_fixnum (timeout), 1, 1);
2803 unbind_to (count1, Qnil);
2804
2805 if (EQ (tem0, Qt)
2806 && ! CONSP (Vunread_command_events))
2807 {
2808 Fdo_auto_save (auto_save_no_message ? Qt : Qnil, Qnil);
2809 redisplay ();
2810 }
2811 }
2812
2813 /* If there is still no input available, ask for GC. */
2814 if (!detect_input_pending_run_timers (0))
2815 maybe_gc ();
2816 }
2817
2818 /* Notify the caller if an autosave hook, or a timer, sentinel or
2819 filter in the sit_for calls above have changed the current
2820 kboard. This could happen if they use the minibuffer or start a
2821 recursive edit, like the fancy splash screen in server.el's
2822 filter. If this longjmp wasn't here, read_key_sequence would
2823 interpret the next key sequence using the wrong translation
2824 tables and function keymaps. */
2825 if (NILP (c) && current_kboard != orig_kboard)
2826 return make_fixnum (-2); /* wrong_kboard_jmpbuf */
2827
2828 /* If this has become non-nil here, it has been set by a timer
2829 or sentinel or filter. */
2830 if (CONSP (Vunread_command_events))
2831 {
2832 c = XCAR (Vunread_command_events);
2833 Vunread_command_events = XCDR (Vunread_command_events);
2834
2835 if (CONSP (c) && EQ (XCAR (c), Qt))
2836 c = XCDR (c);
2837 else
2838 {
2839 if (CONSP (c) && EQ (XCAR (c), Qno_record))
2840 {
2841 c = XCDR (c);
2842 recorded = true;
2843 }
2844 reread = true;
2845 }
2846 }
2847
2848 /* Read something from current KBOARD's side queue, if possible. */
2849
2850 if (NILP (c))
2851 {
2852 if (current_kboard->kbd_queue_has_data)
2853 {
2854 if (!CONSP (KVAR (current_kboard, kbd_queue)))
2855 emacs_abort ();
2856 c = XCAR (KVAR (current_kboard, kbd_queue));
2857 kset_kbd_queue (current_kboard,
2858 XCDR (KVAR (current_kboard, kbd_queue)));
2859 if (NILP (KVAR (current_kboard, kbd_queue)))
2860 current_kboard->kbd_queue_has_data = false;
2861 input_pending = readable_events (0);
2862 if (EVENT_HAS_PARAMETERS (c)
2863 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
2864 internal_last_event_frame = XCAR (XCDR (c));
2865 Vlast_event_frame = internal_last_event_frame;
2866 }
2867 }
2868
2869 /* If current_kboard's side queue is empty check the other kboards.
2870 If one of them has data that we have not yet seen here,
2871 switch to it and process the data waiting for it.
2872
2873 Note: if the events queued up for another kboard
2874 have already been seen here, and therefore are not a complete command,
2875 the kbd_queue_has_data field is 0, so we skip that kboard here.
2876 That's to avoid an infinite loop switching between kboards here. */
2877 if (NILP (c) && !single_kboard)
2878 {
2879 KBOARD *kb;
2880 for (kb = all_kboards; kb; kb = kb->next_kboard)
2881 if (kb->kbd_queue_has_data)
2882 {
2883 current_kboard = kb;
2884 return make_fixnum (-2); /* wrong_kboard_jmpbuf */
2885 }
2886 }
2887
2888 wrong_kboard:
2889
2890 STOP_POLLING;
2891
2892 if (NILP (c))
2893 {
2894 c = read_decoded_event_from_main_queue (end_time, local_getcjmp,
2895 prev_event, used_mouse_menu);
2896 if (NILP (c) && end_time
2897 && timespec_cmp (*end_time, current_timespec ()) <= 0)
2898 {
2899 goto exit;
2900 }
2901
2902 if (EQ (c, make_fixnum (-2)))
2903 return c;
2904
2905 if (CONSP (c) && EQ (XCAR (c), Qt))
2906 c = XCDR (c);
2907 else if (CONSP (c) && EQ (XCAR (c), Qno_record))
2908 {
2909 c = XCDR (c);
2910 recorded = true;
2911 }
2912 }
2913
2914 non_reread:
2915
2916 if (!end_time)
2917 timer_stop_idle ();
2918 RESUME_POLLING;
2919
2920 if (NILP (c))
2921 {
2922 if (commandflag >= 0
2923 && !input_pending && !detect_input_pending_run_timers (0))
2924 redisplay ();
2925
2926 goto wrong_kboard;
2927 }
2928
2929 /* Buffer switch events are only for internal wakeups
2930 so don't show them to the user.
2931 Also, don't record a key if we already did. */
2932 if (BUFFERP (c))
2933 goto exit;
2934
2935 /* Process special events within read_char
2936 and loop around to read another event. */
2937 save = Vquit_flag;
2938 Vquit_flag = Qnil;
2939 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
2940 Vquit_flag = save;
2941
2942 if (!NILP (tem))
2943 {
2944 struct buffer *prev_buffer = current_buffer;
2945 last_input_event = c;
2946 call4 (Qcommand_execute, tem, Qnil, Fvector (1, &last_input_event), Qt);
2947
2948 if (CONSP (c) && !NILP (Fmemq (XCAR (c), Vwhile_no_input_ignore_events))
2949 && !end_time)
2950 /* We stopped being idle for this event; undo that. This
2951 prevents automatic window selection (under
2952 mouse-autoselect-window) from acting as a real input event, for
2953 example banishing the mouse under mouse-avoidance-mode. */
2954 timer_resume_idle ();
2955
2956 #ifdef HAVE_NS
2957 if (CONSP (c)
2958 && (EQ (XCAR (c), intern ("ns-unput-working-text"))))
2959 input_was_pending = input_pending;
2960 #endif
2961
2962 if (current_buffer != prev_buffer)
2963 {
2964 /* The command may have changed the keymaps. Pretend there
2965 is input in another keyboard and return. This will
2966 recalculate keymaps. */
2967 c = make_fixnum (-2);
2968 goto exit;
2969 }
2970 else
2971 goto retry;
2972 }
2973
2974 /* Handle things that only apply to characters. */
2975 if (FIXNUMP (c))
2976 {
2977 /* If kbd_buffer_get_event gave us an EOF, return that. */
2978 if (XFIXNUM (c) == -1)
2979 goto exit;
2980
2981 if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table))
2982 && XFIXNAT (c) < SCHARS (KVAR (current_kboard,
2983 Vkeyboard_translate_table)))
2984 || (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table))
2985 && XFIXNAT (c) < ASIZE (KVAR (current_kboard,
2986 Vkeyboard_translate_table)))
2987 || (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table))
2988 && CHARACTERP (c)))
2989 {
2990 Lisp_Object d;
2991 d = Faref (KVAR (current_kboard, Vkeyboard_translate_table), c);
2992 /* nil in keyboard-translate-table means no translation. */
2993 if (!NILP (d))
2994 c = d;
2995 }
2996 }
2997
2998 /* If this event is a mouse click in the menu bar,
2999 return just menu-bar for now. Modify the mouse click event
3000 so we won't do this twice, then queue it up. */
3001 if (EVENT_HAS_PARAMETERS (c)
3002 && CONSP (XCDR (c))
3003 && CONSP (xevent_start (c))
3004 && CONSP (XCDR (xevent_start (c))))
3005 {
3006 Lisp_Object posn;
3007
3008 posn = POSN_POSN (xevent_start (c));
3009 /* Handle menu-bar events:
3010 insert the dummy prefix event `menu-bar'. */
3011 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtab_bar) || EQ (posn, Qtool_bar))
3012 {
3013 /* Change menu-bar to (menu-bar) as the event "position". */
3014 POSN_SET_POSN (xevent_start (c), list1 (posn));
3015
3016 also_record = c;
3017 Vunread_command_events = Fcons (c, Vunread_command_events);
3018 c = posn;
3019 }
3020 }
3021
3022 /* Store these characters into recent_keys, the dribble file if any,
3023 and the keyboard macro being defined, if any. */
3024 record_char (c);
3025 recorded = true;
3026 if (! NILP (also_record))
3027 record_char (also_record);
3028
3029 /* Wipe the echo area.
3030 But first, if we are about to use an input method,
3031 save the echo area contents for it to refer to. */
3032 if (FIXNUMP (c)
3033 && ! NILP (Vinput_method_function)
3034 && ' ' <= XFIXNUM (c) && XFIXNUM (c) < 256 && XFIXNUM (c) != 127)
3035 {
3036 previous_echo_area_message = Fcurrent_message ();
3037 Vinput_method_previous_message = previous_echo_area_message;
3038 }
3039
3040 /* Now wipe the echo area, except for help events which do their
3041 own stuff with the echo area. */
3042 if (!CONSP (c)
3043 || (!(EQ (Qhelp_echo, XCAR (c)))
3044 && !(EQ (Qswitch_frame, XCAR (c)))
3045 /* Don't wipe echo area for select window events: These might
3046 get delayed via `mouse-autoselect-window' (Bug#11304). */
3047 && !(EQ (Qselect_window, XCAR (c)))))
3048 {
3049 if (!NILP (echo_area_buffer[0]))
3050 {
3051 safe_run_hooks (Qecho_area_clear_hook);
3052 clear_message (1, 0);
3053 /* If we were showing the echo-area message on top of an
3054 active minibuffer, resize the mini-window, since the
3055 minibuffer may need more or less space than the echo area
3056 we've just wiped. */
3057 if (minibuf_level
3058 && EQ (minibuf_window, echo_area_window)
3059 /* The case where minibuffer-message-timeout is a number
3060 was already handled near the beginning of command_loop_1. */
3061 && !NUMBERP (Vminibuffer_message_timeout))
3062 resize_mini_window (XWINDOW (minibuf_window), false);
3063 }
3064 else if (FUNCTIONP (Vclear_message_function))
3065 clear_message (1, 0);
3066 }
3067
3068 reread_for_input_method:
3069 from_macro:
3070 /* Pass this to the input method, if appropriate. */
3071 if (FIXNUMP (c)
3072 && ! NILP (Vinput_method_function)
3073 /* Don't run the input method within a key sequence,
3074 after the first event of the key sequence. */
3075 && NILP (prev_event)
3076 && ' ' <= XFIXNUM (c) && XFIXNUM (c) < 256 && XFIXNUM (c) != 127)
3077 {
3078 Lisp_Object keys;
3079 ptrdiff_t key_count;
3080 ptrdiff_t command_key_start;
3081 ptrdiff_t count = SPECPDL_INDEX ();
3082
3083 /* Save the echo status. */
3084 bool saved_immediate_echo = current_kboard->immediate_echo;
3085 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
3086 Lisp_Object saved_echo_string = KVAR (current_kboard, echo_string);
3087 Lisp_Object saved_echo_prompt = KVAR (current_kboard, echo_prompt);
3088
3089 /* Save the this_command_keys status. */
3090 key_count = this_command_key_count;
3091 command_key_start = this_single_command_key_start;
3092
3093 if (key_count > 0)
3094 keys = Fcopy_sequence (this_command_keys);
3095 else
3096 keys = Qnil;
3097
3098 /* Clear out this_command_keys. */
3099 this_command_key_count = 0;
3100 this_single_command_key_start = 0;
3101
3102 /* Now wipe the echo area. */
3103 if (!NILP (echo_area_buffer[0]))
3104 safe_run_hooks (Qecho_area_clear_hook);
3105 clear_message (1, 0);
3106 echo_truncate (0);
3107
3108 /* If we are not reading a key sequence,
3109 never use the echo area. */
3110 if (!KEYMAPP (map))
3111 {
3112 specbind (Qinput_method_use_echo_area, Qt);
3113 }
3114
3115 /* Call the input method. */
3116 tem = call1 (Vinput_method_function, c);
3117
3118 tem = unbind_to (count, tem);
3119
3120 /* Restore the saved echoing state
3121 and this_command_keys state. */
3122 this_command_key_count = key_count;
3123 this_single_command_key_start = command_key_start;
3124 if (key_count > 0)
3125 this_command_keys = keys;
3126
3127 cancel_echoing ();
3128 ok_to_echo_at_next_pause = saved_ok_to_echo;
3129 kset_echo_string (current_kboard, saved_echo_string);
3130 kset_echo_prompt (current_kboard, saved_echo_prompt);
3131 if (saved_immediate_echo)
3132 echo_now ();
3133
3134 /* The input method can return no events. */
3135 if (! CONSP (tem))
3136 {
3137 /* Bring back the previous message, if any. */
3138 if (! NILP (previous_echo_area_message))
3139 message_with_string ("%s", previous_echo_area_message, 0);
3140 goto retry;
3141 }
3142 /* It returned one event or more. */
3143 c = XCAR (tem);
3144 Vunread_post_input_method_events
3145 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
3146 }
3147 /* When we consume events from the various unread-*-events lists, we
3148 bypass the code that records input, so record these events now if
3149 they were not recorded already. */
3150 if (!recorded)
3151 {
3152 record_char (c);
3153 recorded = true;
3154 }
3155
3156 reread_first:
3157
3158 /* Display help if not echoing. */
3159 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
3160 {
3161 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
3162 Lisp_Object help, object, position, window, htem;
3163
3164 htem = Fcdr (XCDR (c));
3165 help = Fcar (htem);
3166 htem = Fcdr (htem);
3167 window = Fcar (htem);
3168 htem = Fcdr (htem);
3169 object = Fcar (htem);
3170 htem = Fcdr (htem);
3171 position = Fcar (htem);
3172
3173 show_help_echo (help, window, object, position);
3174
3175 /* We stopped being idle for this event; undo that. */
3176 if (!end_time)
3177 timer_resume_idle ();
3178 goto retry;
3179 }
3180
3181 if ((! reread || this_command_key_count == 0)
3182 && !end_time)
3183 {
3184
3185 /* Don't echo mouse motion events. */
3186 if (! (EVENT_HAS_PARAMETERS (c)
3187 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
3188 /* Once we reread a character, echoing can happen
3189 the next time we pause to read a new one. */
3190 ok_to_echo_at_next_pause = current_kboard;
3191
3192 /* Record this character as part of the current key. */
3193 add_command_key (c);
3194 if (! NILP (also_record))
3195 add_command_key (also_record);
3196
3197 echo_update ();
3198 }
3199
3200 last_input_event = c;
3201 num_input_events++;
3202
3203 /* Process the help character specially if enabled. */
3204 if (!NILP (Vhelp_form) && help_char_p (c))
3205 {
3206 ptrdiff_t count = SPECPDL_INDEX ();
3207
3208 help_form_saved_window_configs
3209 = Fcons (Fcurrent_window_configuration (Qnil),
3210 help_form_saved_window_configs);
3211 record_unwind_protect_void (read_char_help_form_unwind);
3212 call0 (Qhelp_form_show);
3213
3214 cancel_echoing ();
3215 do
3216 {
3217 c = read_char (0, Qnil, Qnil, 0, NULL);
3218 if (EVENT_HAS_PARAMETERS (c)
3219 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_click))
3220 XSETCAR (help_form_saved_window_configs, Qnil);
3221 }
3222 while (BUFFERP (c));
3223 /* Remove the help from the frame. */
3224 unbind_to (count, Qnil);
3225
3226 redisplay ();
3227 if (EQ (c, make_fixnum (040)))
3228 {
3229 cancel_echoing ();
3230 do
3231 c = read_char (0, Qnil, Qnil, 0, NULL);
3232 while (BUFFERP (c));
3233 }
3234 }
3235
3236 exit:
3237 RESUME_POLLING;
3238 input_was_pending = input_pending;
3239 return c;
3240 }
3241
3242 /* Record a key that came from a mouse menu.
3243 Record it for echoing, for this-command-keys, and so on. */
3244
3245 static void
record_menu_key(Lisp_Object c)3246 record_menu_key (Lisp_Object c)
3247 {
3248 /* Wipe the echo area. */
3249 clear_message (1, 0);
3250
3251 record_char (c);
3252
3253 /* Once we reread a character, echoing can happen
3254 the next time we pause to read a new one. */
3255 ok_to_echo_at_next_pause = NULL;
3256
3257 /* Record this character as part of the current key. */
3258 add_command_key (c);
3259 echo_update ();
3260
3261 /* Re-reading in the middle of a command. */
3262 last_input_event = c;
3263 num_input_events++;
3264 }
3265
3266 /* Return true if should recognize C as "the help character". */
3267
3268 static bool
help_char_p(Lisp_Object c)3269 help_char_p (Lisp_Object c)
3270 {
3271 if (EQ (c, Vhelp_char))
3272 return true;
3273 Lisp_Object tail = Vhelp_event_list;
3274 FOR_EACH_TAIL_SAFE (tail)
3275 if (EQ (c, XCAR (tail)))
3276 return true;
3277 return false;
3278 }
3279
3280 /* Record the input event C in various ways. */
3281
3282 static void
record_char(Lisp_Object c)3283 record_char (Lisp_Object c)
3284 {
3285 int recorded = 0;
3286
3287 if (CONSP (c) && (EQ (XCAR (c), Qhelp_echo) || EQ (XCAR (c), Qmouse_movement)))
3288 {
3289 /* To avoid filling recent_keys with help-echo and mouse-movement
3290 events, we filter out repeated help-echo events, only store the
3291 first and last in a series of mouse-movement events, and don't
3292 store repeated help-echo events which are only separated by
3293 mouse-movement events. */
3294
3295 Lisp_Object ev1, ev2, ev3;
3296 int ix1, ix2, ix3;
3297
3298 if ((ix1 = recent_keys_index - 1) < 0)
3299 ix1 = lossage_limit - 1;
3300 ev1 = AREF (recent_keys, ix1);
3301
3302 if ((ix2 = ix1 - 1) < 0)
3303 ix2 = lossage_limit - 1;
3304 ev2 = AREF (recent_keys, ix2);
3305
3306 if ((ix3 = ix2 - 1) < 0)
3307 ix3 = lossage_limit - 1;
3308 ev3 = AREF (recent_keys, ix3);
3309
3310 if (EQ (XCAR (c), Qhelp_echo))
3311 {
3312 /* Don't record `help-echo' in recent_keys unless it shows some help
3313 message, and a different help than the previously recorded
3314 event. */
3315 Lisp_Object help, last_help;
3316
3317 help = Fcar_safe (Fcdr_safe (XCDR (c)));
3318 if (!STRINGP (help))
3319 recorded = 1;
3320 else if (CONSP (ev1) && EQ (XCAR (ev1), Qhelp_echo)
3321 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev1))), EQ (last_help, help)))
3322 recorded = 1;
3323 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3324 && CONSP (ev2) && EQ (XCAR (ev2), Qhelp_echo)
3325 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev2))), EQ (last_help, help)))
3326 recorded = -1;
3327 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3328 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3329 && CONSP (ev3) && EQ (XCAR (ev3), Qhelp_echo)
3330 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev3))), EQ (last_help, help)))
3331 recorded = -2;
3332 }
3333 else if (EQ (XCAR (c), Qmouse_movement))
3334 {
3335 /* Only record one pair of `mouse-movement' on a window in recent_keys.
3336 So additional mouse movement events replace the last element. */
3337 Lisp_Object last_window, window;
3338
3339 window = Fcar_safe (Fcar_safe (XCDR (c)));
3340 if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3341 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev1))), EQ (last_window, window))
3342 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3343 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev2))), EQ (last_window, window)))
3344 {
3345 ASET (recent_keys, ix1, c);
3346 recorded = 1;
3347 }
3348 }
3349 }
3350 else if (NILP (Vexecuting_kbd_macro))
3351 store_kbd_macro_char (c);
3352
3353 /* recent_keys should not include events from keyboard macros. */
3354 if (NILP (Vexecuting_kbd_macro))
3355 {
3356 if (!recorded)
3357 {
3358 total_keys += total_keys < lossage_limit;
3359 ASET (recent_keys, recent_keys_index,
3360 /* Copy the event, in case it gets modified by side-effect
3361 by some remapping function (bug#30955). */
3362 CONSP (c) ? Fcopy_sequence (c) : c);
3363 if (++recent_keys_index >= lossage_limit)
3364 recent_keys_index = 0;
3365 }
3366 else if (recorded < 0)
3367 {
3368 /* We need to remove one or two events from recent_keys.
3369 To do this, we simply put nil at those events and move the
3370 recent_keys_index backwards over those events. Usually,
3371 users will never see those nil events, as they will be
3372 overwritten by the command keys entered to see recent_keys
3373 (e.g. C-h l). */
3374
3375 while (recorded++ < 0 && total_keys > 0)
3376 {
3377 if (total_keys < lossage_limit)
3378 total_keys--;
3379 if (--recent_keys_index < 0)
3380 recent_keys_index = lossage_limit - 1;
3381 ASET (recent_keys, recent_keys_index, Qnil);
3382 }
3383 }
3384
3385 num_nonmacro_input_events++;
3386 }
3387
3388 /* Write c to the dribble file. If c is a lispy event, write
3389 the event's symbol to the dribble file, in <brackets>. Bleaugh.
3390 If you, dear reader, have a better idea, you've got the source. :-) */
3391 if (dribble && NILP (Vexecuting_kbd_macro))
3392 {
3393 block_input ();
3394 if (FIXNUMP (c))
3395 {
3396 if (XUFIXNUM (c) < 0x100)
3397 putc (XUFIXNUM (c), dribble);
3398 else
3399 fprintf (dribble, " 0x%"pI"x", XUFIXNUM (c));
3400 }
3401 else
3402 {
3403 Lisp_Object dribblee;
3404
3405 /* If it's a structured event, take the event header. */
3406 dribblee = EVENT_HEAD (c);
3407
3408 if (SYMBOLP (dribblee))
3409 {
3410 putc ('<', dribble);
3411 fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
3412 SBYTES (SYMBOL_NAME (dribblee)), dribble);
3413 putc ('>', dribble);
3414 }
3415 }
3416
3417 fflush (dribble);
3418 unblock_input ();
3419 }
3420 }
3421
3422 /* Copy out or in the info on where C-g should throw to.
3423 This is used when running Lisp code from within get_char,
3424 in case get_char is called recursively.
3425 See read_process_output. */
3426
3427 static void
save_getcjmp(sys_jmp_buf temp)3428 save_getcjmp (sys_jmp_buf temp)
3429 {
3430 memcpy (temp, getcjmp, sizeof getcjmp);
3431 }
3432
3433 static void
restore_getcjmp(void * temp)3434 restore_getcjmp (void *temp)
3435 {
3436 memcpy (getcjmp, temp, sizeof getcjmp);
3437 }
3438
3439 /* Low level keyboard/mouse input.
3440 kbd_buffer_store_event places events in kbd_buffer, and
3441 kbd_buffer_get_event retrieves them. */
3442
3443 /* Return true if there are any events in the queue that read-char
3444 would return. If this returns false, a read-char would block. */
3445 static bool
readable_events(int flags)3446 readable_events (int flags)
3447 {
3448 if (flags & READABLE_EVENTS_DO_TIMERS_NOW)
3449 timer_check ();
3450
3451 /* READABLE_EVENTS_FILTER_EVENTS is meant to be used only by
3452 input-pending-p and similar callers, which aren't interested in
3453 some input events. If this flag is set, and
3454 input-pending-p-filter-events is non-nil, ignore events in
3455 while-no-input-ignore-events. If the flag is set and
3456 input-pending-p-filter-events is nil, ignore only
3457 FOCUS_IN/OUT_EVENT events. */
3458 if (kbd_fetch_ptr != kbd_store_ptr)
3459 {
3460 /* See https://lists.gnu.org/r/emacs-devel/2005-05/msg00297.html
3461 for why we treat toolkit scroll-bar events specially here. */
3462 if (flags & (READABLE_EVENTS_FILTER_EVENTS
3463 #ifdef USE_TOOLKIT_SCROLL_BARS
3464 | READABLE_EVENTS_IGNORE_SQUEEZABLES
3465 #endif
3466 ))
3467 {
3468 union buffered_input_event *event = kbd_fetch_ptr;
3469
3470 do
3471 {
3472 if (!(
3473 #ifdef USE_TOOLKIT_SCROLL_BARS
3474 (flags & READABLE_EVENTS_FILTER_EVENTS) &&
3475 #endif
3476 ((!input_pending_p_filter_events
3477 && (event->kind == FOCUS_IN_EVENT
3478 || event->kind == FOCUS_OUT_EVENT))
3479 || (input_pending_p_filter_events
3480 && is_ignored_event (event))))
3481 #ifdef USE_TOOLKIT_SCROLL_BARS
3482 && !((flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3483 && (event->kind == SCROLL_BAR_CLICK_EVENT
3484 || event->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT)
3485 && event->ie.part == scroll_bar_handle
3486 && event->ie.modifiers == 0)
3487 #endif
3488 )
3489 return 1;
3490 event = next_kbd_event (event);
3491 }
3492 while (event != kbd_store_ptr);
3493 }
3494 else
3495 return 1;
3496 }
3497
3498 if (!(flags & READABLE_EVENTS_IGNORE_SQUEEZABLES) && some_mouse_moved ())
3499 return 1;
3500 if (single_kboard)
3501 {
3502 if (current_kboard->kbd_queue_has_data)
3503 return 1;
3504 }
3505 else
3506 {
3507 KBOARD *kb;
3508 for (kb = all_kboards; kb; kb = kb->next_kboard)
3509 if (kb->kbd_queue_has_data)
3510 return 1;
3511 }
3512 return 0;
3513 }
3514
3515 /* Set this for debugging, to have a way to get out */
3516 int stop_character EXTERNALLY_VISIBLE;
3517
3518 static KBOARD *
event_to_kboard(struct input_event * event)3519 event_to_kboard (struct input_event *event)
3520 {
3521 /* Not applicable for these special events. */
3522 if (event->kind == SELECTION_REQUEST_EVENT
3523 || event->kind == SELECTION_CLEAR_EVENT)
3524 return NULL;
3525 else
3526 {
3527 Lisp_Object obj = event->frame_or_window;
3528 /* There are some events that set this field to nil or string. */
3529 if (WINDOWP (obj))
3530 obj = WINDOW_FRAME (XWINDOW (obj));
3531 /* Also ignore dead frames here. */
3532 return ((FRAMEP (obj) && FRAME_LIVE_P (XFRAME (obj)))
3533 ? FRAME_KBOARD (XFRAME (obj)) : NULL);
3534 }
3535 }
3536
3537 #ifdef subprocesses
3538 /* Return the number of slots occupied in kbd_buffer. */
3539
3540 static int
kbd_buffer_nr_stored(void)3541 kbd_buffer_nr_stored (void)
3542 {
3543 int n = kbd_store_ptr - kbd_fetch_ptr;
3544 return n + (n < 0 ? KBD_BUFFER_SIZE : 0);
3545 }
3546 #endif /* Store an event obtained at interrupt level into kbd_buffer, fifo */
3547
3548 void
kbd_buffer_store_event(register struct input_event * event)3549 kbd_buffer_store_event (register struct input_event *event)
3550 {
3551 kbd_buffer_store_event_hold (event, 0);
3552 }
3553
3554 /* Store EVENT obtained at interrupt level into kbd_buffer, fifo.
3555
3556 If HOLD_QUIT is 0, just stuff EVENT into the fifo.
3557 Else, if HOLD_QUIT.kind != NO_EVENT, discard EVENT.
3558 Else, if EVENT is a quit event, store the quit event
3559 in HOLD_QUIT, and return (thus ignoring further events).
3560
3561 This is used to postpone the processing of the quit event until all
3562 subsequent input events have been parsed (and discarded). */
3563
3564 void
kbd_buffer_store_buffered_event(union buffered_input_event * event,struct input_event * hold_quit)3565 kbd_buffer_store_buffered_event (union buffered_input_event *event,
3566 struct input_event *hold_quit)
3567 {
3568 if (event->kind == NO_EVENT)
3569 emacs_abort ();
3570
3571 if (hold_quit && hold_quit->kind != NO_EVENT)
3572 return;
3573
3574 if (event->kind == ASCII_KEYSTROKE_EVENT)
3575 {
3576 int c = event->ie.code & 0377;
3577
3578 if (event->ie.modifiers & ctrl_modifier)
3579 c = make_ctrl_char (c);
3580
3581 c |= (event->ie.modifiers
3582 & (meta_modifier | alt_modifier
3583 | hyper_modifier | super_modifier));
3584
3585 if (c == quit_char)
3586 {
3587 KBOARD *kb = FRAME_KBOARD (XFRAME (event->ie.frame_or_window));
3588
3589 if (single_kboard && kb != current_kboard)
3590 {
3591 kset_kbd_queue
3592 (kb, list2 (make_lispy_switch_frame (event->ie.frame_or_window),
3593 make_fixnum (c)));
3594 kb->kbd_queue_has_data = true;
3595
3596 for (union buffered_input_event *sp = kbd_fetch_ptr;
3597 sp != kbd_store_ptr; sp = next_kbd_event (sp))
3598 {
3599 if (event_to_kboard (&sp->ie) == kb)
3600 {
3601 sp->ie.kind = NO_EVENT;
3602 sp->ie.frame_or_window = Qnil;
3603 sp->ie.arg = Qnil;
3604 }
3605 }
3606 return;
3607 }
3608
3609 if (hold_quit)
3610 {
3611 *hold_quit = event->ie;
3612 return;
3613 }
3614
3615 /* If this results in a quit_char being returned to Emacs as
3616 input, set Vlast_event_frame properly. If this doesn't
3617 get returned to Emacs as an event, the next event read
3618 will set Vlast_event_frame again, so this is safe to do. */
3619 {
3620 Lisp_Object focus;
3621
3622 focus = FRAME_FOCUS_FRAME (XFRAME (event->ie.frame_or_window));
3623 if (NILP (focus))
3624 focus = event->ie.frame_or_window;
3625 internal_last_event_frame = focus;
3626 Vlast_event_frame = focus;
3627 }
3628
3629 handle_interrupt (0);
3630 return;
3631 }
3632
3633 if (c && c == stop_character)
3634 {
3635 sys_suspend ();
3636 return;
3637 }
3638 }
3639
3640 /* Don't let the very last slot in the buffer become full,
3641 since that would make the two pointers equal,
3642 and that is indistinguishable from an empty buffer.
3643 Discard the event if it would fill the last slot. */
3644 union buffered_input_event *next_slot = next_kbd_event (kbd_store_ptr);
3645 if (kbd_fetch_ptr != next_slot)
3646 {
3647 *kbd_store_ptr = *event;
3648 kbd_store_ptr = next_slot;
3649 #ifdef subprocesses
3650 if (kbd_buffer_nr_stored () > KBD_BUFFER_SIZE / 2
3651 && ! kbd_on_hold_p ())
3652 {
3653 /* Don't read keyboard input until we have processed kbd_buffer.
3654 This happens when pasting text longer than KBD_BUFFER_SIZE/2. */
3655 hold_keyboard_input ();
3656 unrequest_sigio ();
3657 stop_polling ();
3658 }
3659 #endif /* subprocesses */
3660 }
3661
3662 /* If we're inside while-no-input, and this event qualifies
3663 as input, set quit-flag to cause an interrupt. */
3664 if (!NILP (Vthrow_on_input)
3665 && !is_ignored_event (event))
3666 Vquit_flag = Vthrow_on_input;
3667 }
3668
3669
3670 #ifdef HAVE_X11
3671
3672 /* Put a selection input event back in the head of the event queue. */
3673
3674 void
kbd_buffer_unget_event(struct selection_input_event * event)3675 kbd_buffer_unget_event (struct selection_input_event *event)
3676 {
3677 /* Don't let the very last slot in the buffer become full, */
3678 union buffered_input_event *kp = prev_kbd_event (kbd_fetch_ptr);
3679 if (kp != kbd_store_ptr)
3680 {
3681 kp->sie = *event;
3682 kbd_fetch_ptr = kp;
3683 }
3684 }
3685
3686 #endif
3687
3688 /* Limit help event positions to this range, to avoid overflow problems. */
3689 #define INPUT_EVENT_POS_MAX \
3690 ((ptrdiff_t) min (PTRDIFF_MAX, min (TYPE_MAXIMUM (Time) / 2, \
3691 MOST_POSITIVE_FIXNUM)))
3692 #define INPUT_EVENT_POS_MIN (PTRDIFF_MIN < -INPUT_EVENT_POS_MAX \
3693 ? -1 - INPUT_EVENT_POS_MAX : PTRDIFF_MIN)
3694
3695 /* Return a Time that encodes position POS. POS must be in range. */
3696
3697 static Time
position_to_Time(ptrdiff_t pos)3698 position_to_Time (ptrdiff_t pos)
3699 {
3700 eassert (INPUT_EVENT_POS_MIN <= pos && pos <= INPUT_EVENT_POS_MAX);
3701 return pos;
3702 }
3703
3704 /* Return the position that ENCODED_POS encodes.
3705 Avoid signed integer overflow. */
3706
3707 static ptrdiff_t
Time_to_position(Time encoded_pos)3708 Time_to_position (Time encoded_pos)
3709 {
3710 if (encoded_pos <= INPUT_EVENT_POS_MAX)
3711 return encoded_pos;
3712 Time encoded_pos_min = INPUT_EVENT_POS_MIN;
3713 eassert (encoded_pos_min <= encoded_pos);
3714 ptrdiff_t notpos = -1 - encoded_pos;
3715 return -1 - notpos;
3716 }
3717
3718 /* Generate a HELP_EVENT input_event and store it in the keyboard
3719 buffer.
3720
3721 HELP is the help form.
3722
3723 FRAME and WINDOW are the frame and window where the help is
3724 generated. OBJECT is the Lisp object where the help was found (a
3725 buffer, a string, an overlay, or nil if neither from a string nor
3726 from a buffer). POS is the position within OBJECT where the help
3727 was found. */
3728
3729 void
gen_help_event(Lisp_Object help,Lisp_Object frame,Lisp_Object window,Lisp_Object object,ptrdiff_t pos)3730 gen_help_event (Lisp_Object help, Lisp_Object frame, Lisp_Object window,
3731 Lisp_Object object, ptrdiff_t pos)
3732 {
3733 struct input_event event;
3734
3735 event.kind = HELP_EVENT;
3736 event.frame_or_window = frame;
3737 event.arg = object;
3738 event.x = WINDOWP (window) ? window : frame;
3739 event.y = help;
3740 event.timestamp = position_to_Time (pos);
3741 kbd_buffer_store_event (&event);
3742 }
3743
3744
3745 /* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3746
3747 void
kbd_buffer_store_help_event(Lisp_Object frame,Lisp_Object help)3748 kbd_buffer_store_help_event (Lisp_Object frame, Lisp_Object help)
3749 {
3750 struct input_event event;
3751
3752 event.kind = HELP_EVENT;
3753 event.frame_or_window = frame;
3754 event.arg = Qnil;
3755 event.x = Qnil;
3756 event.y = help;
3757 event.timestamp = 0;
3758 kbd_buffer_store_event (&event);
3759 }
3760
3761
3762 /* Discard any mouse events in the event buffer by setting them to
3763 NO_EVENT. */
3764 void
discard_mouse_events(void)3765 discard_mouse_events (void)
3766 {
3767 for (union buffered_input_event *sp = kbd_fetch_ptr;
3768 sp != kbd_store_ptr; sp = next_kbd_event (sp))
3769 {
3770 if (sp->kind == MOUSE_CLICK_EVENT
3771 || sp->kind == WHEEL_EVENT
3772 || sp->kind == HORIZ_WHEEL_EVENT
3773 || sp->kind == SCROLL_BAR_CLICK_EVENT
3774 || sp->kind == HORIZONTAL_SCROLL_BAR_CLICK_EVENT)
3775 {
3776 sp->kind = NO_EVENT;
3777 }
3778 }
3779 }
3780
3781
3782 /* Return true if there are any real events waiting in the event
3783 buffer, not counting `NO_EVENT's.
3784
3785 Discard NO_EVENT events at the front of the input queue, possibly
3786 leaving the input queue empty if there are no real input events. */
3787
3788 bool
kbd_buffer_events_waiting(void)3789 kbd_buffer_events_waiting (void)
3790 {
3791 for (union buffered_input_event *sp = kbd_fetch_ptr;
3792 ; sp = next_kbd_event (sp))
3793 if (sp == kbd_store_ptr || sp->kind != NO_EVENT)
3794 {
3795 kbd_fetch_ptr = sp;
3796 return sp != kbd_store_ptr && sp->kind != NO_EVENT;
3797 }
3798 }
3799
3800
3801 /* Clear input event EVENT. */
3802
3803 static void
clear_event(struct input_event * event)3804 clear_event (struct input_event *event)
3805 {
3806 event->kind = NO_EVENT;
3807 }
3808
3809
3810 /* Read one event from the event buffer, waiting if necessary.
3811 The value is a Lisp object representing the event.
3812 The value is nil for an event that should be ignored,
3813 or that was handled here.
3814 We always read and discard one event. */
3815
3816 static Lisp_Object
kbd_buffer_get_event(KBOARD ** kbp,bool * used_mouse_menu,struct timespec * end_time)3817 kbd_buffer_get_event (KBOARD **kbp,
3818 bool *used_mouse_menu,
3819 struct timespec *end_time)
3820 {
3821 Lisp_Object obj;
3822
3823 #ifdef subprocesses
3824 if (kbd_on_hold_p () && kbd_buffer_nr_stored () < KBD_BUFFER_SIZE / 4)
3825 {
3826 /* Start reading input again because we have processed enough to
3827 be able to accept new events again. */
3828 unhold_keyboard_input ();
3829 request_sigio ();
3830 start_polling ();
3831 }
3832 #endif /* subprocesses */
3833
3834 #if !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined THREADS_ENABLED
3835 if (noninteractive
3836 /* In case we are running as a daemon, only do this before
3837 detaching from the terminal. */
3838 || (IS_DAEMON && DAEMON_RUNNING))
3839 {
3840 int c = getchar ();
3841 XSETINT (obj, c);
3842 *kbp = current_kboard;
3843 return obj;
3844 }
3845 #endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined THREADS_ENABLED */
3846
3847 /* Wait until there is input available. */
3848 for (;;)
3849 {
3850 /* Break loop if there's an unread command event. Needed in
3851 moused window autoselection which uses a timer to insert such
3852 events. */
3853 if (CONSP (Vunread_command_events))
3854 break;
3855
3856 if (kbd_fetch_ptr != kbd_store_ptr)
3857 break;
3858 if (some_mouse_moved ())
3859 break;
3860
3861 /* If the quit flag is set, then read_char will return
3862 quit_char, so that counts as "available input." */
3863 if (!NILP (Vquit_flag))
3864 quit_throw_to_read_char (0);
3865
3866 /* One way or another, wait until input is available; then, if
3867 interrupt handlers have not read it, read it now. */
3868
3869 #if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
3870 gobble_input ();
3871 #endif
3872 if (kbd_fetch_ptr != kbd_store_ptr)
3873 break;
3874 if (some_mouse_moved ())
3875 break;
3876 if (end_time)
3877 {
3878 struct timespec now = current_timespec ();
3879 if (timespec_cmp (*end_time, now) <= 0)
3880 return Qnil; /* Finished waiting. */
3881 else
3882 {
3883 struct timespec duration = timespec_sub (*end_time, now);
3884 wait_reading_process_output (min (duration.tv_sec,
3885 WAIT_READING_MAX),
3886 duration.tv_nsec,
3887 -1, 1, Qnil, NULL, 0);
3888 }
3889 }
3890 else
3891 {
3892 bool do_display = true;
3893
3894 if (FRAME_TERMCAP_P (SELECTED_FRAME ()))
3895 {
3896 struct tty_display_info *tty = CURTTY ();
3897
3898 /* When this TTY is displaying a menu, we must prevent
3899 any redisplay, because we modify the frame's glyph
3900 matrix behind the back of the display engine. */
3901 if (tty->showing_menu)
3902 do_display = false;
3903 }
3904
3905 wait_reading_process_output (0, 0, -1, do_display, Qnil, NULL, 0);
3906 }
3907
3908 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
3909 gobble_input ();
3910 }
3911
3912 if (CONSP (Vunread_command_events))
3913 {
3914 Lisp_Object first;
3915 first = XCAR (Vunread_command_events);
3916 Vunread_command_events = XCDR (Vunread_command_events);
3917 *kbp = current_kboard;
3918 return first;
3919 }
3920
3921 /* At this point, we know that there is a readable event available
3922 somewhere. If the event queue is empty, then there must be a
3923 mouse movement enabled and available. */
3924 if (kbd_fetch_ptr != kbd_store_ptr)
3925 {
3926 union buffered_input_event *event = kbd_fetch_ptr;
3927
3928 *kbp = event_to_kboard (&event->ie);
3929 if (*kbp == 0)
3930 *kbp = current_kboard; /* Better than returning null ptr? */
3931
3932 obj = Qnil;
3933
3934 /* These two kinds of events get special handling
3935 and don't actually appear to the command loop.
3936 We return nil for them. */
3937 switch (event->kind)
3938 {
3939 case SELECTION_REQUEST_EVENT:
3940 case SELECTION_CLEAR_EVENT:
3941 {
3942 #ifdef HAVE_X11
3943 /* Remove it from the buffer before processing it,
3944 since otherwise swallow_events will see it
3945 and process it again. */
3946 struct selection_input_event copy = event->sie;
3947 kbd_fetch_ptr = next_kbd_event (event);
3948 input_pending = readable_events (0);
3949 x_handle_selection_event (©);
3950 #else
3951 /* We're getting selection request events, but we don't have
3952 a window system. */
3953 emacs_abort ();
3954 #endif
3955 }
3956 break;
3957
3958 #ifdef HAVE_EXT_MENU_BAR
3959 case MENU_BAR_ACTIVATE_EVENT:
3960 {
3961 struct frame *f;
3962 kbd_fetch_ptr = next_kbd_event (event);
3963 input_pending = readable_events (0);
3964 f = (XFRAME (event->ie.frame_or_window));
3965 if (FRAME_LIVE_P (f) && FRAME_TERMINAL (f)->activate_menubar_hook)
3966 FRAME_TERMINAL (f)->activate_menubar_hook (f);
3967 }
3968 break;
3969 #endif
3970 #if defined (HAVE_NS)
3971 case NS_TEXT_EVENT:
3972 if (used_mouse_menu)
3973 *used_mouse_menu = true;
3974 FALLTHROUGH;
3975 #endif
3976 #ifdef HAVE_PGTK
3977 case PGTK_PREEDIT_TEXT_EVENT:
3978 #endif
3979 #ifdef HAVE_NTGUI
3980 case END_SESSION_EVENT:
3981 case LANGUAGE_CHANGE_EVENT:
3982 #endif
3983 #ifdef HAVE_WINDOW_SYSTEM
3984 case DELETE_WINDOW_EVENT:
3985 case ICONIFY_EVENT:
3986 case DEICONIFY_EVENT:
3987 case MOVE_FRAME_EVENT:
3988 #endif
3989 #ifdef USE_FILE_NOTIFY
3990 case FILE_NOTIFY_EVENT:
3991 #endif
3992 #ifdef HAVE_DBUS
3993 case DBUS_EVENT:
3994 #endif
3995 #ifdef THREADS_ENABLED
3996 case THREAD_EVENT:
3997 #endif
3998 #ifdef HAVE_XWIDGETS
3999 case XWIDGET_EVENT:
4000 case XWIDGET_DISPLAY_EVENT:
4001 #endif
4002 case SAVE_SESSION_EVENT:
4003 case NO_EVENT:
4004 case HELP_EVENT:
4005 case FOCUS_IN_EVENT:
4006 case CONFIG_CHANGED_EVENT:
4007 case FOCUS_OUT_EVENT:
4008 case SELECT_WINDOW_EVENT:
4009 {
4010 obj = make_lispy_event (&event->ie);
4011 kbd_fetch_ptr = next_kbd_event (event);
4012 }
4013 break;
4014 default:
4015 {
4016 /* If this event is on a different frame, return a
4017 switch-frame this time, and leave the event in the queue
4018 for next time. */
4019 Lisp_Object frame;
4020 Lisp_Object focus;
4021
4022 frame = event->ie.frame_or_window;
4023 if (CONSP (frame))
4024 frame = XCAR (frame);
4025 else if (WINDOWP (frame))
4026 frame = WINDOW_FRAME (XWINDOW (frame));
4027
4028 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4029 if (! NILP (focus))
4030 frame = focus;
4031
4032 if (!EQ (frame, internal_last_event_frame)
4033 && !EQ (frame, selected_frame))
4034 obj = make_lispy_switch_frame (frame);
4035 internal_last_event_frame = frame;
4036
4037 /* If we didn't decide to make a switch-frame event, go ahead
4038 and build a real event from the queue entry. */
4039 if (NILP (obj))
4040 {
4041 double pinch_dx, pinch_dy, pinch_angle;
4042
4043 /* Pinch events are often sent in rapid succession, so
4044 large amounts of such events have the potential to
4045 queue up inside the keyboard buffer. In that case,
4046 find the last pinch event in succession on the same
4047 frame with the same modifiers, and send that instead. */
4048
4049 if (event->ie.kind == PINCH_EVENT
4050 /* Ignore if this is the start of a pinch sequence.
4051 These events should always be sent so that we
4052 never miss a sequence starting, and they don't
4053 have the potential to queue up. */
4054 && ((pinch_dx
4055 = XFLOAT_DATA (XCAR (event->ie.arg))) != 0.0
4056 || XFLOAT_DATA (XCAR (XCDR (event->ie.arg))) != 0.0
4057 || XFLOAT_DATA (Fnth (make_fixnum (3), event->ie.arg)) != 0.0))
4058 {
4059 union buffered_input_event *maybe_event = next_kbd_event (event);
4060
4061 pinch_dy = XFLOAT_DATA (XCAR (XCDR (event->ie.arg)));
4062 pinch_angle = XFLOAT_DATA (Fnth (make_fixnum (3), event->ie.arg));
4063
4064 while (maybe_event != kbd_store_ptr
4065 && maybe_event->ie.kind == PINCH_EVENT
4066 /* Make sure we never miss an event that has
4067 different modifiers. */
4068 && maybe_event->ie.modifiers == event->ie.modifiers
4069 /* Make sure that the event is for the same
4070 frame. */
4071 && EQ (maybe_event->ie.frame_or_window,
4072 event->ie.frame_or_window)
4073 /* Make sure that the event isn't the start
4074 of a new pinch gesture sequence. */
4075 && (XFLOAT_DATA (XCAR (maybe_event->ie.arg)) != 0.0
4076 || XFLOAT_DATA (XCAR (XCDR (maybe_event->ie.arg))) != 0.0
4077 || XFLOAT_DATA (Fnth (make_fixnum (3),
4078 maybe_event->ie.arg)) != 0.0))
4079 {
4080 event = maybe_event;
4081 /* Add up relative deltas inside events we skip. */
4082 pinch_dx += XFLOAT_DATA (XCAR (maybe_event->ie.arg));
4083 pinch_dy += XFLOAT_DATA (XCAR (XCDR (maybe_event->ie.arg)));
4084 pinch_angle += XFLOAT_DATA (Fnth (make_fixnum (3),
4085 maybe_event->ie.arg));
4086
4087 XSETCAR (maybe_event->ie.arg, make_float (pinch_dx));
4088 XSETCAR (XCDR (maybe_event->ie.arg), make_float (pinch_dy));
4089 XSETCAR (Fnthcdr (make_fixnum (3),
4090 maybe_event->ie.arg),
4091 make_float (fmod (pinch_angle, 360.0)));
4092 maybe_event = next_kbd_event (event);
4093 }
4094 }
4095
4096 obj = make_lispy_event (&event->ie);
4097
4098 #ifdef HAVE_EXT_MENU_BAR
4099 /* If this was a menu selection, then set the flag to inhibit
4100 writing to last_nonmenu_event. Don't do this if the event
4101 we're returning is (menu-bar), though; that indicates the
4102 beginning of the menu sequence, and we might as well leave
4103 that as the `event with parameters' for this selection. */
4104 if (used_mouse_menu
4105 && !EQ (event->ie.frame_or_window, event->ie.arg)
4106 && (event->kind == MENU_BAR_EVENT
4107 || event->kind == TAB_BAR_EVENT
4108 || event->kind == TOOL_BAR_EVENT))
4109 *used_mouse_menu = true;
4110 #endif
4111 #ifdef HAVE_NS
4112 /* Certain system events are non-key events. */
4113 if (used_mouse_menu
4114 && event->kind == NS_NONKEY_EVENT)
4115 *used_mouse_menu = true;
4116 #endif
4117
4118 /* Wipe out this event, to catch bugs. */
4119 clear_event (&event->ie);
4120 kbd_fetch_ptr = next_kbd_event (event);
4121 }
4122 }
4123 }
4124 }
4125 /* Try generating a mouse motion event. */
4126 else if (some_mouse_moved ())
4127 {
4128 struct frame *f = some_mouse_moved ();
4129 Lisp_Object bar_window;
4130 enum scroll_bar_part part;
4131 Lisp_Object x, y;
4132 Time t;
4133
4134 *kbp = current_kboard;
4135 /* Note that this uses F to determine which terminal to look at.
4136 If there is no valid info, it does not store anything
4137 so x remains nil. */
4138 x = Qnil;
4139
4140 /* XXX Can f or mouse_position_hook be NULL here? */
4141 if (f && FRAME_TERMINAL (f)->mouse_position_hook)
4142 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, 0, &bar_window,
4143 &part, &x, &y, &t);
4144
4145 obj = Qnil;
4146
4147 /* Decide if we should generate a switch-frame event. Don't
4148 generate switch-frame events for motion outside of all Emacs
4149 frames. */
4150 if (!NILP (x) && f)
4151 {
4152 Lisp_Object frame;
4153
4154 frame = FRAME_FOCUS_FRAME (f);
4155 if (NILP (frame))
4156 XSETFRAME (frame, f);
4157
4158 if (!EQ (frame, internal_last_event_frame)
4159 && !EQ (frame, selected_frame))
4160 obj = make_lispy_switch_frame (frame);
4161 internal_last_event_frame = frame;
4162 }
4163
4164 /* If we didn't decide to make a switch-frame event, go ahead and
4165 return a mouse-motion event. */
4166 if (!NILP (x) && NILP (obj))
4167 obj = make_lispy_movement (f, bar_window, part, x, y, t);
4168 }
4169 else
4170 /* We were promised by the above while loop that there was
4171 something for us to read! */
4172 emacs_abort ();
4173
4174 input_pending = readable_events (0);
4175
4176 Vlast_event_frame = internal_last_event_frame;
4177
4178 return (obj);
4179 }
4180
4181 /* Process any non-user-visible events (currently X selection events),
4182 without reading any user-visible events. */
4183
4184 static void
process_special_events(void)4185 process_special_events (void)
4186 {
4187 for (union buffered_input_event *event = kbd_fetch_ptr;
4188 event != kbd_store_ptr; event = next_kbd_event (event))
4189 {
4190 /* If we find a stored X selection request, handle it now. */
4191 if (event->kind == SELECTION_REQUEST_EVENT
4192 || event->kind == SELECTION_CLEAR_EVENT)
4193 {
4194 #ifdef HAVE_X11
4195
4196 /* Remove the event from the fifo buffer before processing;
4197 otherwise swallow_events called recursively could see it
4198 and process it again. To do this, we move the events
4199 between kbd_fetch_ptr and EVENT one slot to the right,
4200 cyclically. */
4201
4202 struct selection_input_event copy = event->sie;
4203 int moved_events;
4204
4205 if (event < kbd_fetch_ptr)
4206 {
4207 memmove (kbd_buffer + 1, kbd_buffer,
4208 (event - kbd_buffer) * sizeof *kbd_buffer);
4209 kbd_buffer[0] = kbd_buffer[KBD_BUFFER_SIZE - 1];
4210 moved_events = kbd_buffer + KBD_BUFFER_SIZE - 1 - kbd_fetch_ptr;
4211 }
4212 else
4213 moved_events = event - kbd_fetch_ptr;
4214
4215 memmove (kbd_fetch_ptr + 1, kbd_fetch_ptr,
4216 moved_events * sizeof *kbd_fetch_ptr);
4217 kbd_fetch_ptr = next_kbd_event (kbd_fetch_ptr);
4218 input_pending = readable_events (0);
4219 x_handle_selection_event (©);
4220 #else
4221 /* We're getting selection request events, but we don't have
4222 a window system. */
4223 emacs_abort ();
4224 #endif
4225 }
4226 }
4227 }
4228
4229 /* Process any events that are not user-visible, run timer events that
4230 are ripe, and return, without reading any user-visible events. */
4231
4232 void
swallow_events(bool do_display)4233 swallow_events (bool do_display)
4234 {
4235 unsigned old_timers_run;
4236
4237 process_special_events ();
4238
4239 old_timers_run = timers_run;
4240 get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
4241
4242 if (!input_pending && timers_run != old_timers_run && do_display)
4243 redisplay_preserve_echo_area (7);
4244 }
4245
4246 /* Record the start of when Emacs is idle,
4247 for the sake of running idle-time timers. */
4248
4249 static void
timer_start_idle(void)4250 timer_start_idle (void)
4251 {
4252 /* If we are already in the idle state, do nothing. */
4253 if (timespec_valid_p (timer_idleness_start_time))
4254 return;
4255
4256 timer_idleness_start_time = current_timespec ();
4257 timer_last_idleness_start_time = timer_idleness_start_time;
4258
4259 /* Mark all idle-time timers as once again candidates for running. */
4260 call0 (intern ("internal-timer-start-idle"));
4261 }
4262
4263 /* Record that Emacs is no longer idle, so stop running idle-time timers. */
4264
4265 static void
timer_stop_idle(void)4266 timer_stop_idle (void)
4267 {
4268 timer_idleness_start_time = invalid_timespec ();
4269 }
4270
4271 /* Resume idle timer from last idle start time. */
4272
4273 static void
timer_resume_idle(void)4274 timer_resume_idle (void)
4275 {
4276 if (timespec_valid_p (timer_idleness_start_time))
4277 return;
4278
4279 timer_idleness_start_time = timer_last_idleness_start_time;
4280 }
4281
4282 /* List of elisp functions to call, delayed because they were generated in
4283 a context where Elisp could not be safely run (e.g. redisplay, signal,
4284 ...). Each element has the form (FUN . ARGS). */
4285 Lisp_Object pending_funcalls;
4286
4287 /* Return true if TIMER is a valid timer, placing its value into *RESULT. */
4288 static bool
decode_timer(Lisp_Object timer,struct timespec * result)4289 decode_timer (Lisp_Object timer, struct timespec *result)
4290 {
4291 Lisp_Object *vec;
4292
4293 if (! (VECTORP (timer) && ASIZE (timer) == 10))
4294 return false;
4295 vec = XVECTOR (timer)->contents;
4296 if (! NILP (vec[0]))
4297 return false;
4298 if (! FIXNUMP (vec[2]))
4299 return false;
4300 return list4_to_timespec (vec[1], vec[2], vec[3], vec[8], result);
4301 }
4302
4303
4304 /* Check whether a timer has fired. To prevent larger problems we simply
4305 disregard elements that are not proper timers. Do not make a circular
4306 timer list for the time being.
4307
4308 Returns the time to wait until the next timer fires. If a
4309 timer is triggering now, return zero.
4310 If no timer is active, return -1.
4311
4312 If a timer is ripe, we run it, with quitting turned off.
4313 In that case we return 0 to indicate that a new timer_check_2 call
4314 should be done. */
4315
4316 static struct timespec
timer_check_2(Lisp_Object timers,Lisp_Object idle_timers)4317 timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers)
4318 {
4319 struct timespec nexttime;
4320 struct timespec now;
4321 struct timespec idleness_now;
4322 Lisp_Object chosen_timer;
4323
4324 nexttime = invalid_timespec ();
4325
4326 chosen_timer = Qnil;
4327
4328 /* First run the code that was delayed. */
4329 while (CONSP (pending_funcalls))
4330 {
4331 Lisp_Object funcall = XCAR (pending_funcalls);
4332 pending_funcalls = XCDR (pending_funcalls);
4333 safe_call2 (Qapply, XCAR (funcall), XCDR (funcall));
4334 }
4335
4336 if (CONSP (timers) || CONSP (idle_timers))
4337 {
4338 now = current_timespec ();
4339 idleness_now = (timespec_valid_p (timer_idleness_start_time)
4340 ? timespec_sub (now, timer_idleness_start_time)
4341 : make_timespec (0, 0));
4342 }
4343
4344 while (CONSP (timers) || CONSP (idle_timers))
4345 {
4346 Lisp_Object timer = Qnil, idle_timer = Qnil;
4347 struct timespec timer_time, idle_timer_time;
4348 struct timespec difference;
4349 struct timespec timer_difference = invalid_timespec ();
4350 struct timespec idle_timer_difference = invalid_timespec ();
4351 bool ripe, timer_ripe = 0, idle_timer_ripe = 0;
4352
4353 /* Set TIMER and TIMER_DIFFERENCE
4354 based on the next ordinary timer.
4355 TIMER_DIFFERENCE is the distance in time from NOW to when
4356 this timer becomes ripe.
4357 Skip past invalid timers and timers already handled. */
4358 if (CONSP (timers))
4359 {
4360 timer = XCAR (timers);
4361 if (! decode_timer (timer, &timer_time))
4362 {
4363 timers = XCDR (timers);
4364 continue;
4365 }
4366
4367 timer_ripe = timespec_cmp (timer_time, now) <= 0;
4368 timer_difference = (timer_ripe
4369 ? timespec_sub (now, timer_time)
4370 : timespec_sub (timer_time, now));
4371 }
4372
4373 /* Likewise for IDLE_TIMER and IDLE_TIMER_DIFFERENCE
4374 based on the next idle timer. */
4375 if (CONSP (idle_timers))
4376 {
4377 idle_timer = XCAR (idle_timers);
4378 if (! decode_timer (idle_timer, &idle_timer_time))
4379 {
4380 idle_timers = XCDR (idle_timers);
4381 continue;
4382 }
4383
4384 idle_timer_ripe = timespec_cmp (idle_timer_time, idleness_now) <= 0;
4385 idle_timer_difference
4386 = (idle_timer_ripe
4387 ? timespec_sub (idleness_now, idle_timer_time)
4388 : timespec_sub (idle_timer_time, idleness_now));
4389 }
4390
4391 /* Decide which timer is the next timer,
4392 and set CHOSEN_TIMER, DIFFERENCE, and RIPE accordingly.
4393 Also step down the list where we found that timer. */
4394
4395 if (timespec_valid_p (timer_difference)
4396 && (! timespec_valid_p (idle_timer_difference)
4397 || idle_timer_ripe < timer_ripe
4398 || (idle_timer_ripe == timer_ripe
4399 && ((timer_ripe
4400 ? timespec_cmp (idle_timer_difference,
4401 timer_difference)
4402 : timespec_cmp (timer_difference,
4403 idle_timer_difference))
4404 < 0))))
4405 {
4406 chosen_timer = timer;
4407 timers = XCDR (timers);
4408 difference = timer_difference;
4409 ripe = timer_ripe;
4410 }
4411 else
4412 {
4413 chosen_timer = idle_timer;
4414 idle_timers = XCDR (idle_timers);
4415 difference = idle_timer_difference;
4416 ripe = idle_timer_ripe;
4417 }
4418
4419 /* If timer is ripe, run it if it hasn't been run. */
4420 if (ripe)
4421 {
4422 if (NILP (AREF (chosen_timer, 0)))
4423 {
4424 ptrdiff_t count = SPECPDL_INDEX ();
4425 Lisp_Object old_deactivate_mark = Vdeactivate_mark;
4426
4427 /* Mark the timer as triggered to prevent problems if the lisp
4428 code fails to reschedule it right. */
4429 ASET (chosen_timer, 0, Qt);
4430
4431 specbind (Qinhibit_quit, Qt);
4432
4433 call1 (Qtimer_event_handler, chosen_timer);
4434 Vdeactivate_mark = old_deactivate_mark;
4435 timers_run++;
4436 unbind_to (count, Qnil);
4437
4438 /* Since we have handled the event,
4439 we don't need to tell the caller to wake up and do it. */
4440 /* But the caller must still wait for the next timer, so
4441 return 0 to indicate that. */
4442 }
4443
4444 nexttime = make_timespec (0, 0);
4445 break;
4446 }
4447 else
4448 /* When we encounter a timer that is still waiting,
4449 return the amount of time to wait before it is ripe. */
4450 {
4451 return difference;
4452 }
4453 }
4454
4455 /* No timers are pending in the future. */
4456 /* Return 0 if we generated an event, and -1 if not. */
4457 return nexttime;
4458 }
4459
4460
4461 /* Check whether a timer has fired. To prevent larger problems we simply
4462 disregard elements that are not proper timers. Do not make a circular
4463 timer list for the time being.
4464
4465 Returns the time to wait until the next timer fires.
4466 If no timer is active, return an invalid value.
4467
4468 As long as any timer is ripe, we run it. */
4469
4470 struct timespec
timer_check(void)4471 timer_check (void)
4472 {
4473 struct timespec nexttime;
4474 Lisp_Object timers, idle_timers;
4475
4476 Lisp_Object tem = Vinhibit_quit;
4477 Vinhibit_quit = Qt;
4478
4479 /* We use copies of the timers' lists to allow a timer to add itself
4480 again, without locking up Emacs if the newly added timer is
4481 already ripe when added. */
4482
4483 /* Always consider the ordinary timers. */
4484 timers = Fcopy_sequence (Vtimer_list);
4485 /* Consider the idle timers only if Emacs is idle. */
4486 if (timespec_valid_p (timer_idleness_start_time))
4487 idle_timers = Fcopy_sequence (Vtimer_idle_list);
4488 else
4489 idle_timers = Qnil;
4490
4491 Vinhibit_quit = tem;
4492
4493 do
4494 {
4495 nexttime = timer_check_2 (timers, idle_timers);
4496 }
4497 while (nexttime.tv_sec == 0 && nexttime.tv_nsec == 0);
4498
4499 return nexttime;
4500 }
4501
4502 DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0,
4503 doc: /* Return the current length of Emacs idleness, or nil.
4504 The value when Emacs is idle is a Lisp timestamp in the style of
4505 `current-time'.
4506
4507 The value when Emacs is not idle is nil.
4508
4509 PSEC is a multiple of the system clock resolution. */)
4510 (void)
4511 {
4512 if (timespec_valid_p (timer_idleness_start_time))
4513 return make_lisp_time (timespec_sub (current_timespec (),
4514 timer_idleness_start_time));
4515
4516 return Qnil;
4517 }
4518
4519 /* Caches for modify_event_symbol. */
4520 static Lisp_Object accent_key_syms;
4521 static Lisp_Object func_key_syms;
4522 static Lisp_Object mouse_syms;
4523 static Lisp_Object wheel_syms;
4524 static Lisp_Object drag_n_drop_syms;
4525 static Lisp_Object pinch_syms;
4526
4527 /* This is a list of keysym codes for special "accent" characters.
4528 It parallels lispy_accent_keys. */
4529
4530 static const int lispy_accent_codes[] =
4531 {
4532 #ifdef XK_dead_circumflex
4533 XK_dead_circumflex,
4534 #else
4535 0,
4536 #endif
4537 #ifdef XK_dead_grave
4538 XK_dead_grave,
4539 #else
4540 0,
4541 #endif
4542 #ifdef XK_dead_tilde
4543 XK_dead_tilde,
4544 #else
4545 0,
4546 #endif
4547 #ifdef XK_dead_diaeresis
4548 XK_dead_diaeresis,
4549 #else
4550 0,
4551 #endif
4552 #ifdef XK_dead_macron
4553 XK_dead_macron,
4554 #else
4555 0,
4556 #endif
4557 #ifdef XK_dead_degree
4558 XK_dead_degree,
4559 #else
4560 0,
4561 #endif
4562 #ifdef XK_dead_acute
4563 XK_dead_acute,
4564 #else
4565 0,
4566 #endif
4567 #ifdef XK_dead_cedilla
4568 XK_dead_cedilla,
4569 #else
4570 0,
4571 #endif
4572 #ifdef XK_dead_breve
4573 XK_dead_breve,
4574 #else
4575 0,
4576 #endif
4577 #ifdef XK_dead_ogonek
4578 XK_dead_ogonek,
4579 #else
4580 0,
4581 #endif
4582 #ifdef XK_dead_caron
4583 XK_dead_caron,
4584 #else
4585 0,
4586 #endif
4587 #ifdef XK_dead_doubleacute
4588 XK_dead_doubleacute,
4589 #else
4590 0,
4591 #endif
4592 #ifdef XK_dead_abovedot
4593 XK_dead_abovedot,
4594 #else
4595 0,
4596 #endif
4597 #ifdef XK_dead_abovering
4598 XK_dead_abovering,
4599 #else
4600 0,
4601 #endif
4602 #ifdef XK_dead_iota
4603 XK_dead_iota,
4604 #else
4605 0,
4606 #endif
4607 #ifdef XK_dead_belowdot
4608 XK_dead_belowdot,
4609 #else
4610 0,
4611 #endif
4612 #ifdef XK_dead_voiced_sound
4613 XK_dead_voiced_sound,
4614 #else
4615 0,
4616 #endif
4617 #ifdef XK_dead_semivoiced_sound
4618 XK_dead_semivoiced_sound,
4619 #else
4620 0,
4621 #endif
4622 #ifdef XK_dead_hook
4623 XK_dead_hook,
4624 #else
4625 0,
4626 #endif
4627 #ifdef XK_dead_horn
4628 XK_dead_horn,
4629 #else
4630 0,
4631 #endif
4632 };
4633
4634 /* This is a list of Lisp names for special "accent" characters.
4635 It parallels lispy_accent_codes. */
4636
4637 static const char *const lispy_accent_keys[] =
4638 {
4639 "dead-circumflex",
4640 "dead-grave",
4641 "dead-tilde",
4642 "dead-diaeresis",
4643 "dead-macron",
4644 "dead-degree",
4645 "dead-acute",
4646 "dead-cedilla",
4647 "dead-breve",
4648 "dead-ogonek",
4649 "dead-caron",
4650 "dead-doubleacute",
4651 "dead-abovedot",
4652 "dead-abovering",
4653 "dead-iota",
4654 "dead-belowdot",
4655 "dead-voiced-sound",
4656 "dead-semivoiced-sound",
4657 "dead-hook",
4658 "dead-horn",
4659 };
4660
4661 #ifdef HAVE_NTGUI
4662 #define FUNCTION_KEY_OFFSET 0x0
4663
4664 const char *const lispy_function_keys[] =
4665 {
4666 0, /* 0 */
4667
4668 0, /* VK_LBUTTON 0x01 */
4669 0, /* VK_RBUTTON 0x02 */
4670 "cancel", /* VK_CANCEL 0x03 */
4671 0, /* VK_MBUTTON 0x04 */
4672
4673 0, 0, 0, /* 0x05 .. 0x07 */
4674
4675 "backspace", /* VK_BACK 0x08 */
4676 "tab", /* VK_TAB 0x09 */
4677
4678 0, 0, /* 0x0A .. 0x0B */
4679
4680 "clear", /* VK_CLEAR 0x0C */
4681 "return", /* VK_RETURN 0x0D */
4682
4683 0, 0, /* 0x0E .. 0x0F */
4684
4685 0, /* VK_SHIFT 0x10 */
4686 0, /* VK_CONTROL 0x11 */
4687 0, /* VK_MENU 0x12 */
4688 "pause", /* VK_PAUSE 0x13 */
4689 "capslock", /* VK_CAPITAL 0x14 */
4690 "kana", /* VK_KANA/VK_HANGUL 0x15 */
4691 0, /* 0x16 */
4692 "junja", /* VK_JUNJA 0x17 */
4693 "final", /* VK_FINAL 0x18 */
4694 "kanji", /* VK_KANJI/VK_HANJA 0x19 */
4695 0, /* 0x1A */
4696 "escape", /* VK_ESCAPE 0x1B */
4697 "convert", /* VK_CONVERT 0x1C */
4698 "non-convert", /* VK_NONCONVERT 0x1D */
4699 "accept", /* VK_ACCEPT 0x1E */
4700 "mode-change", /* VK_MODECHANGE 0x1F */
4701 0, /* VK_SPACE 0x20 */
4702 "prior", /* VK_PRIOR 0x21 */
4703 "next", /* VK_NEXT 0x22 */
4704 "end", /* VK_END 0x23 */
4705 "home", /* VK_HOME 0x24 */
4706 "left", /* VK_LEFT 0x25 */
4707 "up", /* VK_UP 0x26 */
4708 "right", /* VK_RIGHT 0x27 */
4709 "down", /* VK_DOWN 0x28 */
4710 "select", /* VK_SELECT 0x29 */
4711 "print", /* VK_PRINT 0x2A */
4712 "execute", /* VK_EXECUTE 0x2B */
4713 "snapshot", /* VK_SNAPSHOT 0x2C */
4714 "insert", /* VK_INSERT 0x2D */
4715 "delete", /* VK_DELETE 0x2E */
4716 "help", /* VK_HELP 0x2F */
4717
4718 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
4719
4720 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4721
4722 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
4723
4724 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
4725
4726 0, 0, 0, 0, 0, 0, 0, 0, 0,
4727 0, 0, 0, 0, 0, 0, 0, 0, 0,
4728 0, 0, 0, 0, 0, 0, 0, 0,
4729
4730 "lwindow", /* VK_LWIN 0x5B */
4731 "rwindow", /* VK_RWIN 0x5C */
4732 "apps", /* VK_APPS 0x5D */
4733 0, /* 0x5E */
4734 "sleep",
4735 "kp-0", /* VK_NUMPAD0 0x60 */
4736 "kp-1", /* VK_NUMPAD1 0x61 */
4737 "kp-2", /* VK_NUMPAD2 0x62 */
4738 "kp-3", /* VK_NUMPAD3 0x63 */
4739 "kp-4", /* VK_NUMPAD4 0x64 */
4740 "kp-5", /* VK_NUMPAD5 0x65 */
4741 "kp-6", /* VK_NUMPAD6 0x66 */
4742 "kp-7", /* VK_NUMPAD7 0x67 */
4743 "kp-8", /* VK_NUMPAD8 0x68 */
4744 "kp-9", /* VK_NUMPAD9 0x69 */
4745 "kp-multiply", /* VK_MULTIPLY 0x6A */
4746 "kp-add", /* VK_ADD 0x6B */
4747 "kp-separator", /* VK_SEPARATOR 0x6C */
4748 "kp-subtract", /* VK_SUBTRACT 0x6D */
4749 "kp-decimal", /* VK_DECIMAL 0x6E */
4750 "kp-divide", /* VK_DIVIDE 0x6F */
4751 "f1", /* VK_F1 0x70 */
4752 "f2", /* VK_F2 0x71 */
4753 "f3", /* VK_F3 0x72 */
4754 "f4", /* VK_F4 0x73 */
4755 "f5", /* VK_F5 0x74 */
4756 "f6", /* VK_F6 0x75 */
4757 "f7", /* VK_F7 0x76 */
4758 "f8", /* VK_F8 0x77 */
4759 "f9", /* VK_F9 0x78 */
4760 "f10", /* VK_F10 0x79 */
4761 "f11", /* VK_F11 0x7A */
4762 "f12", /* VK_F12 0x7B */
4763 "f13", /* VK_F13 0x7C */
4764 "f14", /* VK_F14 0x7D */
4765 "f15", /* VK_F15 0x7E */
4766 "f16", /* VK_F16 0x7F */
4767 "f17", /* VK_F17 0x80 */
4768 "f18", /* VK_F18 0x81 */
4769 "f19", /* VK_F19 0x82 */
4770 "f20", /* VK_F20 0x83 */
4771 "f21", /* VK_F21 0x84 */
4772 "f22", /* VK_F22 0x85 */
4773 "f23", /* VK_F23 0x86 */
4774 "f24", /* VK_F24 0x87 */
4775
4776 0, 0, 0, 0, /* 0x88 .. 0x8B */
4777 0, 0, 0, 0, /* 0x8C .. 0x8F */
4778
4779 "kp-numlock", /* VK_NUMLOCK 0x90 */
4780 "scroll", /* VK_SCROLL 0x91 */
4781 /* Not sure where the following block comes from.
4782 Windows headers have NEC and Fujitsu specific keys in
4783 this block, but nothing generic. */
4784 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
4785 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
4786 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
4787 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
4788 "kp-end", /* VK_NUMPAD_END 0x96 */
4789 "kp-home", /* VK_NUMPAD_HOME 0x97 */
4790 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
4791 "kp-up", /* VK_NUMPAD_UP 0x99 */
4792 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
4793 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
4794 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
4795 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
4796
4797 0, 0, /* 0x9E .. 0x9F */
4798
4799 /*
4800 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
4801 * Used only as parameters to GetAsyncKeyState and GetKeyState.
4802 * No other API or message will distinguish left and right keys this way.
4803 * 0xA0 .. 0xA5
4804 */
4805 0, 0, 0, 0, 0, 0,
4806
4807 /* Multimedia keys. These are handled as WM_APPCOMMAND, which allows us
4808 to enable them selectively, and gives access to a few more functions.
4809 See lispy_multimedia_keys below. */
4810 0, 0, 0, 0, 0, 0, 0, /* 0xA6 .. 0xAC Browser */
4811 0, 0, 0, /* 0xAD .. 0xAF Volume */
4812 0, 0, 0, 0, /* 0xB0 .. 0xB3 Media */
4813 0, 0, 0, 0, /* 0xB4 .. 0xB7 Apps */
4814
4815 /* 0xB8 .. 0xC0 "OEM" keys - all seem to be punctuation. */
4816 0, 0, 0, 0, 0, 0, 0, 0, 0,
4817
4818 /* 0xC1 - 0xDA unallocated, 0xDB-0xDF more OEM keys */
4819 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4820 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4821
4822 0, /* 0xE0 */
4823 "ax", /* VK_OEM_AX 0xE1 */
4824 0, /* VK_OEM_102 0xE2 */
4825 "ico-help", /* VK_ICO_HELP 0xE3 */
4826 "ico-00", /* VK_ICO_00 0xE4 */
4827 0, /* VK_PROCESSKEY 0xE5 - used by IME */
4828 "ico-clear", /* VK_ICO_CLEAR 0xE6 */
4829 0, /* VK_PACKET 0xE7 - used to pass Unicode chars */
4830 0, /* 0xE8 */
4831 "reset", /* VK_OEM_RESET 0xE9 */
4832 "jump", /* VK_OEM_JUMP 0xEA */
4833 "oem-pa1", /* VK_OEM_PA1 0xEB */
4834 "oem-pa2", /* VK_OEM_PA2 0xEC */
4835 "oem-pa3", /* VK_OEM_PA3 0xED */
4836 "wsctrl", /* VK_OEM_WSCTRL 0xEE */
4837 "cusel", /* VK_OEM_CUSEL 0xEF */
4838 "oem-attn", /* VK_OEM_ATTN 0xF0 */
4839 "finish", /* VK_OEM_FINISH 0xF1 */
4840 "copy", /* VK_OEM_COPY 0xF2 */
4841 "auto", /* VK_OEM_AUTO 0xF3 */
4842 "enlw", /* VK_OEM_ENLW 0xF4 */
4843 "backtab", /* VK_OEM_BACKTAB 0xF5 */
4844 "attn", /* VK_ATTN 0xF6 */
4845 "crsel", /* VK_CRSEL 0xF7 */
4846 "exsel", /* VK_EXSEL 0xF8 */
4847 "ereof", /* VK_EREOF 0xF9 */
4848 "play", /* VK_PLAY 0xFA */
4849 "zoom", /* VK_ZOOM 0xFB */
4850 "noname", /* VK_NONAME 0xFC */
4851 "pa1", /* VK_PA1 0xFD */
4852 "oem_clear", /* VK_OEM_CLEAR 0xFE */
4853 0 /* 0xFF */
4854 };
4855
4856 /* Some of these duplicate the "Media keys" on newer keyboards,
4857 but they are delivered to the application in a different way. */
4858 static const char *const lispy_multimedia_keys[] =
4859 {
4860 0,
4861 "browser-back",
4862 "browser-forward",
4863 "browser-refresh",
4864 "browser-stop",
4865 "browser-search",
4866 "browser-favorites",
4867 "browser-home",
4868 "volume-mute",
4869 "volume-down",
4870 "volume-up",
4871 "media-next",
4872 "media-previous",
4873 "media-stop",
4874 "media-play-pause",
4875 "mail",
4876 "media-select",
4877 "app-1",
4878 "app-2",
4879 "bass-down",
4880 "bass-boost",
4881 "bass-up",
4882 "treble-down",
4883 "treble-up",
4884 "mic-volume-mute",
4885 "mic-volume-down",
4886 "mic-volume-up",
4887 "help",
4888 "find",
4889 "new",
4890 "open",
4891 "close",
4892 "save",
4893 "print",
4894 "undo",
4895 "redo",
4896 "copy",
4897 "cut",
4898 "paste",
4899 "mail-reply",
4900 "mail-forward",
4901 "mail-send",
4902 "spell-check",
4903 "toggle-dictate-command",
4904 "mic-toggle",
4905 "correction-list",
4906 "media-play",
4907 "media-pause",
4908 "media-record",
4909 "media-fast-forward",
4910 "media-rewind",
4911 "media-channel-up",
4912 "media-channel-down"
4913 };
4914
4915 #else /* not HAVE_NTGUI */
4916
4917 /* This should be dealt with in XTread_socket now, and that doesn't
4918 depend on the client system having the Kana syms defined. See also
4919 the XK_kana_A case below. */
4920 #if 0
4921 #ifdef XK_kana_A
4922 static const char *const lispy_kana_keys[] =
4923 {
4924 /* X Keysym value */
4925 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
4926 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
4927 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
4928 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
4929 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
4930 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
4931 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
4932 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
4933 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
4934 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
4935 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
4936 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
4937 "kana-i", "kana-u", "kana-e", "kana-o",
4938 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
4939 "prolongedsound", "kana-A", "kana-I", "kana-U",
4940 "kana-E", "kana-O", "kana-KA", "kana-KI",
4941 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
4942 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
4943 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
4944 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
4945 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
4946 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
4947 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
4948 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
4949 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
4950 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
4951 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
4952 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
4953 };
4954 #endif /* XK_kana_A */
4955 #endif /* 0 */
4956
4957 #define FUNCTION_KEY_OFFSET 0xff00
4958
4959 /* You'll notice that this table is arranged to be conveniently
4960 indexed by X Windows keysym values. */
4961 const char *const lispy_function_keys[] =
4962 {
4963 /* X Keysym value */
4964
4965 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
4966 "backspace", "tab", "linefeed", "clear",
4967 0, "return", 0, 0,
4968 0, 0, 0, "pause", /* 0xff10...1f */
4969 0, 0, 0, 0, 0, 0, 0, "escape",
4970 0, 0, 0, 0,
4971 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
4972 "romaji", "hiragana", "katakana", "hiragana-katakana",
4973 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
4974 "massyo", "kana-lock", "kana-shift", "eisu-shift",
4975 "eisu-toggle", /* 0xff30...3f */
4976 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4977 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
4978
4979 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
4980 "down", "prior", "next", "end",
4981 "begin", 0, 0, 0, 0, 0, 0, 0,
4982 "select", /* 0xff60 */ /* IsMiscFunctionKey */
4983 "print",
4984 "execute",
4985 "insert",
4986 0, /* 0xff64 */
4987 "undo",
4988 "redo",
4989 "menu",
4990 "find",
4991 "cancel",
4992 "help",
4993 "break", /* 0xff6b */
4994
4995 0, 0, 0, 0,
4996 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
4997 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
4998 "kp-space", /* 0xff80 */ /* IsKeypadKey */
4999 0, 0, 0, 0, 0, 0, 0, 0,
5000 "kp-tab", /* 0xff89 */
5001 0, 0, 0,
5002 "kp-enter", /* 0xff8d */
5003 0, 0, 0,
5004 "kp-f1", /* 0xff91 */
5005 "kp-f2",
5006 "kp-f3",
5007 "kp-f4",
5008 "kp-home", /* 0xff95 */
5009 "kp-left",
5010 "kp-up",
5011 "kp-right",
5012 "kp-down",
5013 "kp-prior", /* kp-page-up */
5014 "kp-next", /* kp-page-down */
5015 "kp-end",
5016 "kp-begin",
5017 "kp-insert",
5018 "kp-delete",
5019 0, /* 0xffa0 */
5020 0, 0, 0, 0, 0, 0, 0, 0, 0,
5021 "kp-multiply", /* 0xffaa */
5022 "kp-add",
5023 "kp-separator",
5024 "kp-subtract",
5025 "kp-decimal",
5026 "kp-divide", /* 0xffaf */
5027 "kp-0", /* 0xffb0 */
5028 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
5029 0, /* 0xffba */
5030 0, 0,
5031 "kp-equal", /* 0xffbd */
5032 "f1", /* 0xffbe */ /* IsFunctionKey */
5033 "f2",
5034 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
5035 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
5036 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
5037 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
5038 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
5039 0, 0, 0, 0, 0, 0, 0, 0,
5040 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
5041 0, 0, 0, 0, 0, 0, 0, "delete"
5042 };
5043
5044 /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
5045 #define ISO_FUNCTION_KEY_OFFSET 0xfe00
5046
5047 static const char *const iso_lispy_function_keys[] =
5048 {
5049 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
5050 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
5051 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
5052 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
5053 "iso-lefttab", /* 0xfe20 */
5054 "iso-move-line-up", "iso-move-line-down",
5055 "iso-partial-line-up", "iso-partial-line-down",
5056 "iso-partial-space-left", "iso-partial-space-right",
5057 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
5058 "iso-release-margin-left", "iso-release-margin-right",
5059 "iso-release-both-margins",
5060 "iso-fast-cursor-left", "iso-fast-cursor-right",
5061 "iso-fast-cursor-up", "iso-fast-cursor-down",
5062 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
5063 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
5064 };
5065
5066 #endif /* not HAVE_NTGUI */
5067
5068 static Lisp_Object Vlispy_mouse_stem;
5069
5070 static const char *const lispy_wheel_names[] =
5071 {
5072 "wheel-up", "wheel-down", "wheel-left", "wheel-right"
5073 };
5074
5075 /* drag-n-drop events are generated when a set of selected files are
5076 dragged from another application and dropped onto an Emacs window. */
5077 static const char *const lispy_drag_n_drop_names[] =
5078 {
5079 "drag-n-drop"
5080 };
5081
5082 /* An array of symbol indexes of scroll bar parts, indexed by an enum
5083 scroll_bar_part value. Note that Qnil corresponds to
5084 scroll_bar_nowhere and should not appear in Lisp events. */
5085 static short const scroll_bar_parts[] = {
5086 SYMBOL_INDEX (Qnil), SYMBOL_INDEX (Qabove_handle), SYMBOL_INDEX (Qhandle),
5087 SYMBOL_INDEX (Qbelow_handle), SYMBOL_INDEX (Qup), SYMBOL_INDEX (Qdown),
5088 SYMBOL_INDEX (Qtop), SYMBOL_INDEX (Qbottom), SYMBOL_INDEX (Qend_scroll),
5089 SYMBOL_INDEX (Qratio), SYMBOL_INDEX (Qbefore_handle),
5090 SYMBOL_INDEX (Qhorizontal_handle), SYMBOL_INDEX (Qafter_handle),
5091 SYMBOL_INDEX (Qleft), SYMBOL_INDEX (Qright), SYMBOL_INDEX (Qleftmost),
5092 SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio)
5093 };
5094
5095 #ifdef HAVE_WINDOW_SYSTEM
5096 /* An array of symbol indexes of internal border parts, indexed by an enum
5097 internal_border_part value. Note that Qnil corresponds to
5098 internal_border_part_none and should not appear in Lisp events. */
5099 static short const internal_border_parts[] = {
5100 SYMBOL_INDEX (Qnil), SYMBOL_INDEX (Qleft_edge),
5101 SYMBOL_INDEX (Qtop_left_corner), SYMBOL_INDEX (Qtop_edge),
5102 SYMBOL_INDEX (Qtop_right_corner), SYMBOL_INDEX (Qright_edge),
5103 SYMBOL_INDEX (Qbottom_right_corner), SYMBOL_INDEX (Qbottom_edge),
5104 SYMBOL_INDEX (Qbottom_left_corner)
5105 };
5106 #endif
5107
5108 /* A vector, indexed by button number, giving the down-going location
5109 of currently depressed buttons, both scroll bar and non-scroll bar.
5110
5111 The elements have the form
5112 (BUTTON-NUMBER MODIFIER-MASK . REST)
5113 where REST is the cdr of a position as it would be reported in the event.
5114
5115 The make_lispy_event function stores positions here to tell the
5116 difference between click and drag events, and to store the starting
5117 location to be included in drag events. */
5118
5119 static Lisp_Object button_down_location;
5120
5121 /* A cons recording the original frame-relative x and y coordinates of
5122 the down mouse event. */
5123 static Lisp_Object frame_relative_event_pos;
5124
5125 /* Information about the most recent up-going button event: Which
5126 button, what location, and what time. */
5127
5128 static int last_mouse_button;
5129 static int last_mouse_x;
5130 static int last_mouse_y;
5131 static Time button_down_time;
5132
5133 /* The number of clicks in this multiple-click. */
5134
5135 static int double_click_count;
5136
5137 /* X and Y are frame-relative coordinates for a click or wheel event.
5138 Return a Lisp-style event list. */
5139
5140 static Lisp_Object
make_lispy_position(struct frame * f,Lisp_Object x,Lisp_Object y,Time t)5141 make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
5142 Time t)
5143 {
5144 enum window_part part;
5145 Lisp_Object posn = Qnil;
5146 Lisp_Object extra_info = Qnil;
5147 int mx = XFIXNUM (x), my = XFIXNUM (y);
5148 /* Coordinate pixel positions to return. */
5149 int xret = 0, yret = 0;
5150 /* The window or frame under frame pixel coordinates (x,y) */
5151 Lisp_Object window_or_frame = f
5152 ? window_from_coordinates (f, mx, my, &part, true, true)
5153 : Qnil;
5154
5155 /* Report mouse events on the tab bar and (on GUI frames) on the
5156 tool bar. */
5157 #ifdef HAVE_WINDOW_SYSTEM
5158 if ((WINDOWP (f->tab_bar_window)
5159 && EQ (window_or_frame, f->tab_bar_window))
5160 #ifndef HAVE_EXT_TOOL_BAR
5161 || (WINDOWP (f->tool_bar_window)
5162 && EQ (window_or_frame, f->tool_bar_window))
5163 #endif
5164 )
5165 {
5166 /* While 'track-mouse' is neither nil nor t, do not report this
5167 event as something that happened on the tool or tab bar since
5168 that would break mouse drag operations that originate from an
5169 ordinary window beneath that bar and expect the window to
5170 auto-scroll as soon as the mouse cursor appears above or
5171 beneath it (Bug#50993). We do allow reports for t, because
5172 applications may have set 'track-mouse' to t and still expect a
5173 click on the tool or tab bar to get through (Bug#51794).
5174
5175 FIXME: This is a preliminary fix for the bugs cited above and
5176 awaits a solution that includes a convention for all special
5177 values of 'track-mouse' and their documentation in the Elisp
5178 manual. */
5179 if (NILP (track_mouse) || EQ (track_mouse, Qt))
5180 posn = EQ (window_or_frame, f->tab_bar_window) ? Qtab_bar : Qtool_bar;
5181 /* Kludge alert: for mouse events on the tab bar and tool bar,
5182 keyboard.c wants the frame, not the special-purpose window
5183 we use to display those, and it wants frame-relative
5184 coordinates. FIXME! */
5185 window_or_frame = Qnil;
5186 }
5187 #endif
5188 if (f
5189 && !FRAME_WINDOW_P (f)
5190 && FRAME_TAB_BAR_LINES (f) > 0
5191 && my >= FRAME_MENU_BAR_LINES (f)
5192 && my < FRAME_MENU_BAR_LINES (f) + FRAME_TAB_BAR_LINES (f))
5193 {
5194 posn = Qtab_bar;
5195 window_or_frame = Qnil; /* see above */
5196 }
5197
5198 if (WINDOWP (window_or_frame))
5199 {
5200 /* It's a click in window WINDOW at frame coordinates (X,Y) */
5201 struct window *w = XWINDOW (window_or_frame);
5202 Lisp_Object string_info = Qnil;
5203 ptrdiff_t textpos = 0;
5204 int col = -1, row = -1;
5205 int dx = -1, dy = -1;
5206 int width = -1, height = -1;
5207 Lisp_Object object = Qnil;
5208
5209 /* Pixel coordinates relative to the window corner. */
5210 int wx = mx - WINDOW_LEFT_EDGE_X (w);
5211 int wy = my - WINDOW_TOP_EDGE_Y (w);
5212
5213 /* For text area clicks, return X, Y relative to the corner of
5214 this text area. Note that dX, dY etc are set below, by
5215 buffer_posn_from_coords. */
5216 if (part == ON_TEXT)
5217 {
5218 xret = mx - window_box_left (w, TEXT_AREA);
5219 yret = wy - WINDOW_TAB_LINE_HEIGHT (w) - WINDOW_HEADER_LINE_HEIGHT (w);
5220 }
5221 /* For mode line and header line clicks, return X, Y relative to
5222 the left window edge. Use mode_line_string to look for a
5223 string on the click position. */
5224 else if (part == ON_MODE_LINE || part == ON_TAB_LINE
5225 || part == ON_HEADER_LINE)
5226 {
5227 Lisp_Object string;
5228 ptrdiff_t charpos;
5229
5230 posn = (part == ON_MODE_LINE ? Qmode_line
5231 : (part == ON_TAB_LINE ? Qtab_line
5232 : Qheader_line));
5233
5234 /* Note that mode_line_string takes COL, ROW as pixels and
5235 converts them to characters. */
5236 col = wx;
5237 row = wy;
5238 string = mode_line_string (w, part, &col, &row, &charpos,
5239 &object, &dx, &dy, &width, &height);
5240 if (STRINGP (string))
5241 string_info = Fcons (string, make_fixnum (charpos));
5242 textpos = -1;
5243
5244 xret = wx;
5245 yret = wy;
5246 }
5247 /* For fringes and margins, Y is relative to the area's (and the
5248 window's) top edge, while X is meaningless. */
5249 else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
5250 {
5251 Lisp_Object string;
5252 ptrdiff_t charpos;
5253
5254 posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin;
5255 col = wx;
5256 row = wy;
5257 string = marginal_area_string (w, part, &col, &row, &charpos,
5258 &object, &dx, &dy, &width, &height);
5259 if (STRINGP (string))
5260 string_info = Fcons (string, make_fixnum (charpos));
5261 xret = wx;
5262 yret = wy - WINDOW_TAB_LINE_HEIGHT (w) - WINDOW_HEADER_LINE_HEIGHT (w);
5263 }
5264 else if (part == ON_LEFT_FRINGE)
5265 {
5266 posn = Qleft_fringe;
5267 col = 0;
5268 xret = wx;
5269 dx = wx
5270 - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5271 ? 0 : window_box_width (w, LEFT_MARGIN_AREA));
5272 dy = yret = wy - WINDOW_TAB_LINE_HEIGHT (w) - WINDOW_HEADER_LINE_HEIGHT (w);
5273 }
5274 else if (part == ON_RIGHT_FRINGE)
5275 {
5276 posn = Qright_fringe;
5277 col = 0;
5278 xret = wx;
5279 dx = wx
5280 - window_box_width (w, LEFT_MARGIN_AREA)
5281 - window_box_width (w, TEXT_AREA)
5282 - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5283 ? window_box_width (w, RIGHT_MARGIN_AREA)
5284 : 0);
5285 dy = yret = wy - WINDOW_TAB_LINE_HEIGHT (w) - WINDOW_HEADER_LINE_HEIGHT (w);
5286 }
5287 else if (part == ON_VERTICAL_BORDER)
5288 {
5289 posn = Qvertical_line;
5290 width = 1;
5291 dx = 0;
5292 xret = wx;
5293 dy = yret = wy;
5294 }
5295 else if (part == ON_VERTICAL_SCROLL_BAR)
5296 {
5297 posn = Qvertical_scroll_bar;
5298 width = WINDOW_SCROLL_BAR_AREA_WIDTH (w);
5299 dx = xret = wx;
5300 dy = yret = wy;
5301 }
5302 else if (part == ON_HORIZONTAL_SCROLL_BAR)
5303 {
5304 posn = Qhorizontal_scroll_bar;
5305 width = WINDOW_SCROLL_BAR_AREA_HEIGHT (w);
5306 dx = xret = wx;
5307 dy = yret = wy;
5308 }
5309 else if (part == ON_RIGHT_DIVIDER)
5310 {
5311 posn = Qright_divider;
5312 width = WINDOW_RIGHT_DIVIDER_WIDTH (w);
5313 dx = xret = wx;
5314 dy = yret = wy;
5315 }
5316 else if (part == ON_BOTTOM_DIVIDER)
5317 {
5318 posn = Qbottom_divider;
5319 width = WINDOW_BOTTOM_DIVIDER_WIDTH (w);
5320 dx = xret = wx;
5321 dy = yret = wy;
5322 }
5323
5324 /* For clicks in the text area, fringes, margins, or vertical
5325 scroll bar, call buffer_posn_from_coords to extract TEXTPOS,
5326 the buffer position nearest to the click. */
5327 if (!textpos)
5328 {
5329 Lisp_Object string2, object2 = Qnil;
5330 struct display_pos p;
5331 int dx2, dy2;
5332 int width2, height2;
5333 /* The pixel X coordinate passed to buffer_posn_from_coords
5334 is the X coordinate relative to the text area for clicks
5335 in text-area, right-margin/fringe and right-side vertical
5336 scroll bar, zero otherwise. */
5337 int x2
5338 = (part == ON_TEXT) ? xret
5339 : (part == ON_RIGHT_FRINGE || part == ON_RIGHT_MARGIN
5340 || (part == ON_VERTICAL_SCROLL_BAR
5341 && WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w)))
5342 ? (mx - window_box_left (w, TEXT_AREA))
5343 : 0;
5344 int y2 = wy;
5345
5346 string2 = buffer_posn_from_coords (w, &x2, &y2, &p,
5347 &object2, &dx2, &dy2,
5348 &width2, &height2);
5349 textpos = CHARPOS (p.pos);
5350 if (col < 0) col = x2;
5351 if (row < 0) row = y2;
5352 if (dx < 0) dx = dx2;
5353 if (dy < 0) dy = dy2;
5354 if (width < 0) width = width2;
5355 if (height < 0) height = height2;
5356
5357 if (NILP (posn))
5358 {
5359 posn = make_fixnum (textpos);
5360 if (STRINGP (string2))
5361 string_info = Fcons (string2,
5362 make_fixnum (CHARPOS (p.string_pos)));
5363 }
5364 if (NILP (object))
5365 object = object2;
5366 }
5367
5368 #ifdef HAVE_WINDOW_SYSTEM
5369 if (IMAGEP (object))
5370 {
5371 Lisp_Object image_map, hotspot;
5372 if ((image_map = Fplist_get (XCDR (object), QCmap),
5373 !NILP (image_map))
5374 && (hotspot = find_hot_spot (image_map, dx, dy),
5375 CONSP (hotspot))
5376 && (hotspot = XCDR (hotspot), CONSP (hotspot)))
5377 posn = XCAR (hotspot);
5378 }
5379 #endif
5380
5381 /* Object info. */
5382 extra_info
5383 = list3 (object,
5384 Fcons (make_fixnum (dx), make_fixnum (dy)),
5385 Fcons (make_fixnum (width), make_fixnum (height)));
5386
5387 /* String info. */
5388 extra_info = Fcons (string_info,
5389 Fcons (textpos < 0 ? Qnil : make_fixnum (textpos),
5390 Fcons (Fcons (make_fixnum (col),
5391 make_fixnum (row)),
5392 extra_info)));
5393 }
5394 else if (f)
5395 {
5396 /* Return mouse pixel coordinates here. */
5397 XSETFRAME (window_or_frame, f);
5398 xret = mx;
5399 yret = my;
5400
5401 #ifdef HAVE_WINDOW_SYSTEM
5402 if (FRAME_WINDOW_P (f)
5403 && FRAME_LIVE_P (f)
5404 && NILP (posn)
5405 && FRAME_INTERNAL_BORDER_WIDTH (f) > 0
5406 && !NILP (get_frame_param (f, Qdrag_internal_border)))
5407 {
5408 enum internal_border_part part
5409 = frame_internal_border_part (f, xret, yret);
5410
5411 posn = builtin_lisp_symbol (internal_border_parts[part]);
5412 }
5413 #endif
5414 }
5415
5416 else
5417 window_or_frame = Qnil;
5418
5419 return Fcons (window_or_frame,
5420 Fcons (posn,
5421 Fcons (Fcons (make_fixnum (xret),
5422 make_fixnum (yret)),
5423 Fcons (INT_TO_INTEGER (t),
5424 extra_info))));
5425 }
5426
5427 /* Return non-zero if F is a GUI frame that uses some toolkit-managed
5428 menu bar. This really means that Emacs draws and manages the menu
5429 bar as part of its normal display, and therefore can compute its
5430 geometry. */
5431 static bool
toolkit_menubar_in_use(struct frame * f)5432 toolkit_menubar_in_use (struct frame *f)
5433 {
5434 #ifdef HAVE_EXT_MENU_BAR
5435 return !(!FRAME_WINDOW_P (f));
5436 #else
5437 return false;
5438 #endif
5439 }
5440
5441 /* Build the part of Lisp event which represents scroll bar state from
5442 EV. TYPE is one of Qvertical_scroll_bar or Qhorizontal_scroll_bar. */
5443
5444 static Lisp_Object
make_scroll_bar_position(struct input_event * ev,Lisp_Object type)5445 make_scroll_bar_position (struct input_event *ev, Lisp_Object type)
5446 {
5447 return list5 (ev->frame_or_window, type, Fcons (ev->x, ev->y),
5448 INT_TO_INTEGER (ev->timestamp),
5449 builtin_lisp_symbol (scroll_bar_parts[ev->part]));
5450 }
5451
5452 /* Given a struct input_event, build the lisp event which represents
5453 it. If EVENT is 0, build a mouse movement event from the mouse
5454 movement buffer, which should have a movement event in it.
5455
5456 Note that events must be passed to this function in the order they
5457 are received; this function stores the location of button presses
5458 in order to build drag events when the button is released. */
5459
5460 static Lisp_Object
make_lispy_event(struct input_event * event)5461 make_lispy_event (struct input_event *event)
5462 {
5463 int i;
5464
5465 switch (event->kind)
5466 {
5467 #ifdef HAVE_WINDOW_SYSTEM
5468 case DELETE_WINDOW_EVENT:
5469 /* Make an event (delete-frame (FRAME)). */
5470 return list2 (Qdelete_frame, list1 (event->frame_or_window));
5471
5472 case ICONIFY_EVENT:
5473 /* Make an event (iconify-frame (FRAME)). */
5474 return list2 (Qiconify_frame, list1 (event->frame_or_window));
5475
5476 case DEICONIFY_EVENT:
5477 /* Make an event (make-frame-visible (FRAME)). */
5478 return list2 (Qmake_frame_visible, list1 (event->frame_or_window));
5479
5480 case MOVE_FRAME_EVENT:
5481 /* Make an event (move-frame (FRAME)). */
5482 return list2 (Qmove_frame, list1 (event->frame_or_window));
5483 #endif
5484
5485 /* Just discard these, by returning nil.
5486 With MULTI_KBOARD, these events are used as placeholders
5487 when we need to randomly delete events from the queue.
5488 (They shouldn't otherwise be found in the buffer,
5489 but on some machines it appears they do show up
5490 even without MULTI_KBOARD.) */
5491 /* On Windows NT/9X, NO_EVENT is used to delete extraneous
5492 mouse events during a popup-menu call. */
5493 case NO_EVENT:
5494 return Qnil;
5495
5496 case HELP_EVENT:
5497 {
5498 Lisp_Object frame = event->frame_or_window;
5499 Lisp_Object object = event->arg;
5500 Lisp_Object position
5501 = make_fixnum (Time_to_position (event->timestamp));
5502 Lisp_Object window = event->x;
5503 Lisp_Object help = event->y;
5504 clear_event (event);
5505
5506 if (!WINDOWP (window))
5507 window = Qnil;
5508 return Fcons (Qhelp_echo,
5509 list5 (frame, help, window, object, position));
5510 }
5511
5512 case FOCUS_IN_EVENT:
5513 return make_lispy_focus_in (event->frame_or_window);
5514
5515 case FOCUS_OUT_EVENT:
5516 return make_lispy_focus_out (event->frame_or_window);
5517
5518 /* A simple keystroke. */
5519 case ASCII_KEYSTROKE_EVENT:
5520 case MULTIBYTE_CHAR_KEYSTROKE_EVENT:
5521 {
5522 Lisp_Object lispy_c;
5523 EMACS_INT c = event->code;
5524 if (event->kind == ASCII_KEYSTROKE_EVENT)
5525 {
5526 c &= 0377;
5527 eassert (c == event->code);
5528 }
5529
5530 /* Caps-lock shouldn't affect interpretation of key chords:
5531 Control+s should produce C-s whether caps-lock is on or
5532 not. And Control+Shift+s should produce C-S-s whether
5533 caps-lock is on or not. */
5534 if (event->modifiers & ~shift_modifier)
5535 {
5536 /* This is a key chord: some non-shift modifier is
5537 depressed. */
5538
5539 if (uppercasep (c) &&
5540 !(event->modifiers & shift_modifier))
5541 {
5542 /* Got a capital letter without a shift. The caps
5543 lock is on. Un-capitalize the letter. */
5544 c = downcase (c);
5545 }
5546 else if (lowercasep (c) &&
5547 (event->modifiers & shift_modifier))
5548 {
5549 /* Got a lower-case letter even though shift is
5550 depressed. The caps lock is on. Capitalize the
5551 letter. */
5552 c = upcase (c);
5553 }
5554 }
5555
5556 if (event->kind == ASCII_KEYSTROKE_EVENT)
5557 {
5558 /* Turn ASCII characters into control characters
5559 when proper. */
5560 if (event->modifiers & ctrl_modifier)
5561 {
5562 c = make_ctrl_char (c);
5563 event->modifiers &= ~ctrl_modifier;
5564 }
5565 }
5566
5567 /* Add in the other modifier bits. The shift key was taken care
5568 of by the X code. */
5569 c |= (event->modifiers
5570 & (meta_modifier | alt_modifier
5571 | hyper_modifier | super_modifier | ctrl_modifier));
5572 /* Distinguish Shift-SPC from SPC. */
5573 if ((event->code) == 040
5574 && event->modifiers & shift_modifier)
5575 c |= shift_modifier;
5576 button_down_time = 0;
5577 XSETFASTINT (lispy_c, c);
5578 return lispy_c;
5579 }
5580
5581 #ifdef HAVE_NS
5582 case NS_TEXT_EVENT:
5583 return list1 (intern (event->code == KEY_NS_PUT_WORKING_TEXT
5584 ? "ns-put-working-text"
5585 : "ns-unput-working-text"));
5586
5587 /* NS_NONKEY_EVENTs are just like NON_ASCII_KEYSTROKE_EVENTs,
5588 except that they are non-key events (last-nonmenu-event is nil). */
5589 case NS_NONKEY_EVENT:
5590 #endif
5591
5592 /* A function key. The symbol may need to have modifier prefixes
5593 tacked onto it. */
5594 case NON_ASCII_KEYSTROKE_EVENT:
5595 button_down_time = 0;
5596
5597 for (i = 0; i < ARRAYELTS (lispy_accent_codes); i++)
5598 if (event->code == lispy_accent_codes[i])
5599 return modify_event_symbol (i,
5600 event->modifiers,
5601 Qfunction_key, Qnil,
5602 lispy_accent_keys, &accent_key_syms,
5603 ARRAYELTS (lispy_accent_keys));
5604
5605 #if 0
5606 #ifdef XK_kana_A
5607 if (event->code >= 0x400 && event->code < 0x500)
5608 return modify_event_symbol (event->code - 0x400,
5609 event->modifiers & ~shift_modifier,
5610 Qfunction_key, Qnil,
5611 lispy_kana_keys, &func_key_syms,
5612 ARRAYELTS (lispy_kana_keys));
5613 #endif /* XK_kana_A */
5614 #endif /* 0 */
5615
5616 #ifdef ISO_FUNCTION_KEY_OFFSET
5617 if (event->code < FUNCTION_KEY_OFFSET
5618 && event->code >= ISO_FUNCTION_KEY_OFFSET)
5619 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
5620 event->modifiers,
5621 Qfunction_key, Qnil,
5622 iso_lispy_function_keys, &func_key_syms,
5623 ARRAYELTS (iso_lispy_function_keys));
5624 #endif
5625
5626 if ((FUNCTION_KEY_OFFSET <= event->code
5627 && (event->code
5628 < FUNCTION_KEY_OFFSET + ARRAYELTS (lispy_function_keys)))
5629 && lispy_function_keys[event->code - FUNCTION_KEY_OFFSET])
5630 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
5631 event->modifiers,
5632 Qfunction_key, Qnil,
5633 lispy_function_keys, &func_key_syms,
5634 ARRAYELTS (lispy_function_keys));
5635
5636 /* Handle system-specific or unknown keysyms.
5637 We need to use an alist rather than a vector as the cache
5638 since we can't make a vector long enough. */
5639 if (NILP (KVAR (current_kboard, system_key_syms)))
5640 kset_system_key_syms (current_kboard, Fcons (Qnil, Qnil));
5641 return modify_event_symbol (event->code,
5642 event->modifiers,
5643 Qfunction_key,
5644 KVAR (current_kboard, Vsystem_key_alist),
5645 0, &KVAR (current_kboard, system_key_syms),
5646 PTRDIFF_MAX);
5647
5648 #ifdef HAVE_NTGUI
5649 case END_SESSION_EVENT:
5650 /* Make an event (end-session). */
5651 return list1 (Qend_session);
5652
5653 case LANGUAGE_CHANGE_EVENT:
5654 /* Make an event (language-change FRAME CODEPAGE LANGUAGE-ID). */
5655 return list4 (Qlanguage_change,
5656 event->frame_or_window,
5657 make_fixnum (event->code),
5658 make_fixnum (event->modifiers));
5659
5660 case MULTIMEDIA_KEY_EVENT:
5661 if (event->code < ARRAYELTS (lispy_multimedia_keys)
5662 && event->code > 0 && lispy_multimedia_keys[event->code])
5663 {
5664 return modify_event_symbol (event->code, event->modifiers,
5665 Qfunction_key, Qnil,
5666 lispy_multimedia_keys, &func_key_syms,
5667 ARRAYELTS (lispy_multimedia_keys));
5668 }
5669 return Qnil;
5670 #endif
5671
5672 /* A mouse click. Figure out where it is, decide whether it's
5673 a press, click or drag, and build the appropriate structure. */
5674 case MOUSE_CLICK_EVENT:
5675 #ifndef USE_TOOLKIT_SCROLL_BARS
5676 case SCROLL_BAR_CLICK_EVENT:
5677 case HORIZONTAL_SCROLL_BAR_CLICK_EVENT:
5678 #endif
5679 {
5680 int button = event->code;
5681 bool is_double;
5682 Lisp_Object position;
5683 Lisp_Object *start_pos_ptr;
5684 Lisp_Object start_pos;
5685
5686 position = Qnil;
5687
5688 /* Build the position as appropriate for this mouse click. */
5689 if (event->kind == MOUSE_CLICK_EVENT)
5690 {
5691 struct frame *f = XFRAME (event->frame_or_window);
5692 int row, column;
5693
5694 /* Ignore mouse events that were made on frame that
5695 have been deleted. */
5696 if (! FRAME_LIVE_P (f))
5697 return Qnil;
5698
5699 /* EVENT->x and EVENT->y are frame-relative pixel
5700 coordinates at this place. Under old redisplay, COLUMN
5701 and ROW are set to frame relative glyph coordinates
5702 which are then used to determine whether this click is
5703 in a menu (non-toolkit version). */
5704 if (!toolkit_menubar_in_use (f))
5705 {
5706 pixel_to_glyph_coords (f, XFIXNUM (event->x), XFIXNUM (event->y),
5707 &column, &row, NULL, 1);
5708
5709 /* In the non-toolkit version, clicks on the menu bar
5710 are ordinary button events in the event buffer.
5711 Distinguish them, and invoke the menu.
5712
5713 (In the toolkit version, the toolkit handles the
5714 menu bar and Emacs doesn't know about it until
5715 after the user makes a selection.) */
5716 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
5717 && (event->modifiers & down_modifier))
5718 {
5719 Lisp_Object items, item;
5720
5721 /* Find the menu bar item under `column'. */
5722 item = Qnil;
5723 items = FRAME_MENU_BAR_ITEMS (f);
5724 for (i = 0; i < ASIZE (items); i += 4)
5725 {
5726 Lisp_Object pos, string;
5727 string = AREF (items, i + 1);
5728 pos = AREF (items, i + 3);
5729 if (NILP (string))
5730 break;
5731 if (column >= XFIXNUM (pos)
5732 && column < XFIXNUM (pos) + SCHARS (string))
5733 {
5734 item = AREF (items, i);
5735 break;
5736 }
5737 }
5738
5739 /* ELisp manual 2.4b says (x y) are window
5740 relative but code says they are
5741 frame-relative. */
5742 position = list4 (event->frame_or_window,
5743 Qmenu_bar,
5744 Fcons (event->x, event->y),
5745 INT_TO_INTEGER (event->timestamp));
5746
5747 return list2 (item, position);
5748 }
5749 }
5750
5751 position = make_lispy_position (f, event->x, event->y,
5752 event->timestamp);
5753
5754 /* For tab-bar clicks, add the propertized string with
5755 button information as OBJECT member of POSITION. */
5756 if (CONSP (event->arg) && EQ (XCAR (event->arg), Qtab_bar))
5757 position = nconc2 (position, Fcons (XCDR (event->arg), Qnil));
5758 }
5759 #ifndef USE_TOOLKIT_SCROLL_BARS
5760 else
5761 /* It's a scrollbar click. */
5762 position = make_scroll_bar_position (event, Qvertical_scroll_bar);
5763 #endif /* not USE_TOOLKIT_SCROLL_BARS */
5764
5765 if (button >= ASIZE (button_down_location))
5766 {
5767 ptrdiff_t incr = button - ASIZE (button_down_location) + 1;
5768 button_down_location = larger_vector (button_down_location,
5769 incr, -1);
5770 mouse_syms = larger_vector (mouse_syms, incr, -1);
5771 }
5772
5773 start_pos_ptr = aref_addr (button_down_location, button);
5774 start_pos = *start_pos_ptr;
5775 *start_pos_ptr = Qnil;
5776
5777 {
5778 /* On window-system frames, use the value of
5779 double-click-fuzz as is. On other frames, interpret it
5780 as a multiple of 1/8 characters. */
5781 struct frame *f;
5782 intmax_t fuzz;
5783
5784 if (WINDOWP (event->frame_or_window))
5785 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
5786 else if (FRAMEP (event->frame_or_window))
5787 f = XFRAME (event->frame_or_window);
5788 else
5789 emacs_abort ();
5790
5791 if (FRAME_WINDOW_P (f))
5792 fuzz = double_click_fuzz;
5793 else
5794 fuzz = double_click_fuzz / 8;
5795
5796 is_double = (button == last_mouse_button
5797 && (eabs (XFIXNUM (event->x) - last_mouse_x) <= fuzz)
5798 && (eabs (XFIXNUM (event->y) - last_mouse_y) <= fuzz)
5799 && button_down_time != 0
5800 && (EQ (Vdouble_click_time, Qt)
5801 || (FIXNATP (Vdouble_click_time)
5802 && (event->timestamp - button_down_time
5803 < XFIXNAT (Vdouble_click_time)))));
5804 }
5805
5806 last_mouse_button = button;
5807 last_mouse_x = XFIXNUM (event->x);
5808 last_mouse_y = XFIXNUM (event->y);
5809
5810 /* If this is a button press, squirrel away the location, so
5811 we can decide later whether it was a click or a drag. */
5812 if (event->modifiers & down_modifier)
5813 {
5814 if (is_double)
5815 {
5816 double_click_count++;
5817 event->modifiers |= ((double_click_count > 2)
5818 ? triple_modifier
5819 : double_modifier);
5820 }
5821 else
5822 double_click_count = 1;
5823 button_down_time = event->timestamp;
5824 *start_pos_ptr = Fcopy_alist (position);
5825 frame_relative_event_pos = Fcons (event->x, event->y);
5826 ignore_mouse_drag_p = false;
5827 }
5828
5829 /* Now we're releasing a button - check the coordinates to
5830 see if this was a click or a drag. */
5831 else if (event->modifiers & up_modifier)
5832 {
5833 /* If we did not see a down before this up, ignore the up.
5834 Probably this happened because the down event chose a
5835 menu item. It would be an annoyance to treat the
5836 release of the button that chose the menu item as a
5837 separate event. */
5838
5839 if (!CONSP (start_pos))
5840 return Qnil;
5841
5842 unsigned click_or_drag_modifier = click_modifier;
5843
5844 if (ignore_mouse_drag_p)
5845 ignore_mouse_drag_p = false;
5846 else
5847 {
5848 intmax_t xdiff = double_click_fuzz, ydiff = double_click_fuzz;
5849
5850 xdiff = XFIXNUM (event->x)
5851 - XFIXNUM (XCAR (frame_relative_event_pos));
5852 ydiff = XFIXNUM (event->y)
5853 - XFIXNUM (XCDR (frame_relative_event_pos));
5854
5855 if (! (0 < double_click_fuzz
5856 && - double_click_fuzz < xdiff
5857 && xdiff < double_click_fuzz
5858 && - double_click_fuzz < ydiff
5859 && ydiff < double_click_fuzz
5860 /* Maybe the mouse has moved a lot, caused scrolling, and
5861 eventually ended up at the same screen position (but
5862 not buffer position) in which case it is a drag, not
5863 a click. */
5864 /* FIXME: OTOH if the buffer position has changed
5865 because of a timer or process filter rather than
5866 because of mouse movement, it should be considered as
5867 a click. But mouse-drag-region completely ignores
5868 this case and it hasn't caused any real problem, so
5869 it's probably OK to ignore it as well. */
5870 && (EQ (Fcar (Fcdr (start_pos)),
5871 Fcar (Fcdr (position))) /* Same buffer pos */
5872 || !EQ (Fcar (start_pos),
5873 Fcar (position))))) /* Different window */
5874 {
5875 /* Mouse has moved enough. */
5876 button_down_time = 0;
5877 click_or_drag_modifier = drag_modifier;
5878 }
5879 else if (((!EQ (Fcar (start_pos), Fcar (position)))
5880 || (!EQ (Fcar (Fcdr (start_pos)),
5881 Fcar (Fcdr (position)))))
5882 /* Was the down event in a window body? */
5883 && FIXNUMP (Fcar (Fcdr (start_pos)))
5884 && WINDOW_LIVE_P (Fcar (start_pos))
5885 && !NILP (Ffboundp (Qwindow_edges)))
5886 /* If the window (etc.) at the mouse position has
5887 changed between the down event and the up event,
5888 we assume there's been a redisplay between the
5889 two events, and we pretend the mouse is still in
5890 the old window to prevent a spurious drag event
5891 being generated. */
5892 {
5893 Lisp_Object edges
5894 = call4 (Qwindow_edges, Fcar (start_pos), Qt, Qnil, Qt);
5895 int new_x = XFIXNUM (Fcar (frame_relative_event_pos));
5896 int new_y = XFIXNUM (Fcdr (frame_relative_event_pos));
5897
5898 /* If the up-event is outside the down-event's
5899 window, use coordinates that are within it. */
5900 if (new_x < XFIXNUM (Fcar (edges)))
5901 new_x = XFIXNUM (Fcar (edges));
5902 else if (new_x >= XFIXNUM (Fcar (Fcdr (Fcdr (edges)))))
5903 new_x = XFIXNUM (Fcar (Fcdr (Fcdr (edges)))) - 1;
5904 if (new_y < XFIXNUM (Fcar (Fcdr (edges))))
5905 new_y = XFIXNUM (Fcar (Fcdr (edges)));
5906 else if (new_y
5907 >= XFIXNUM (Fcar (Fcdr (Fcdr (Fcdr (edges))))))
5908 new_y = XFIXNUM (Fcar (Fcdr (Fcdr (Fcdr (edges))))) - 1;
5909
5910 position = make_lispy_position
5911 (XFRAME (event->frame_or_window),
5912 make_fixnum (new_x), make_fixnum (new_y),
5913 event->timestamp);
5914 }
5915 }
5916
5917 /* Don't check is_double; treat this as multiple if the
5918 down-event was multiple. */
5919 event->modifiers
5920 = ((event->modifiers & ~up_modifier)
5921 | click_or_drag_modifier
5922 | (double_click_count < 2 ? 0
5923 : double_click_count == 2 ? double_modifier
5924 : triple_modifier));
5925 }
5926 else
5927 /* Every mouse event should either have the down_modifier or
5928 the up_modifier set. */
5929 emacs_abort ();
5930
5931 {
5932 /* Get the symbol we should use for the mouse click. */
5933 Lisp_Object head;
5934
5935 head = modify_event_symbol (button,
5936 event->modifiers,
5937 Qmouse_click, Vlispy_mouse_stem,
5938 NULL,
5939 &mouse_syms,
5940 ASIZE (mouse_syms));
5941 if (event->modifiers & drag_modifier)
5942 return list3 (head, start_pos, position);
5943 else if (event->modifiers & (double_modifier | triple_modifier))
5944 return list3 (head, position, make_fixnum (double_click_count));
5945 else
5946 return list2 (head, position);
5947 }
5948 }
5949
5950 case WHEEL_EVENT:
5951 case HORIZ_WHEEL_EVENT:
5952 {
5953 Lisp_Object position;
5954 Lisp_Object head;
5955
5956 /* Build the position as appropriate for this mouse click. */
5957 struct frame *f = XFRAME (event->frame_or_window);
5958
5959 /* Ignore wheel events that were made on frame that have been
5960 deleted. */
5961 if (! FRAME_LIVE_P (f))
5962 return Qnil;
5963
5964 position = make_lispy_position (f, event->x, event->y,
5965 event->timestamp);
5966
5967 /* Set double or triple modifiers to indicate the wheel speed. */
5968 {
5969 /* On window-system frames, use the value of
5970 double-click-fuzz as is. On other frames, interpret it
5971 as a multiple of 1/8 characters. */
5972 struct frame *fr;
5973 intmax_t fuzz;
5974 int symbol_num;
5975 bool is_double;
5976
5977 if (WINDOWP (event->frame_or_window))
5978 fr = XFRAME (XWINDOW (event->frame_or_window)->frame);
5979 else if (FRAMEP (event->frame_or_window))
5980 fr = XFRAME (event->frame_or_window);
5981 else
5982 emacs_abort ();
5983
5984 fuzz = FRAME_WINDOW_P (fr)
5985 ? double_click_fuzz : double_click_fuzz / 8;
5986
5987 if (event->modifiers & up_modifier)
5988 {
5989 /* Emit a wheel-up event. */
5990 event->modifiers &= ~up_modifier;
5991 symbol_num = 0;
5992 }
5993 else if (event->modifiers & down_modifier)
5994 {
5995 /* Emit a wheel-down event. */
5996 event->modifiers &= ~down_modifier;
5997 symbol_num = 1;
5998 }
5999 else
6000 /* Every wheel event should either have the down_modifier or
6001 the up_modifier set. */
6002 emacs_abort ();
6003
6004 if (event->kind == HORIZ_WHEEL_EVENT)
6005 symbol_num += 2;
6006
6007 is_double = (last_mouse_button == - (1 + symbol_num)
6008 && (eabs (XFIXNUM (event->x) - last_mouse_x) <= fuzz)
6009 && (eabs (XFIXNUM (event->y) - last_mouse_y) <= fuzz)
6010 && button_down_time != 0
6011 && (EQ (Vdouble_click_time, Qt)
6012 || (FIXNATP (Vdouble_click_time)
6013 && (event->timestamp - button_down_time
6014 < XFIXNAT (Vdouble_click_time)))));
6015 if (is_double)
6016 {
6017 double_click_count++;
6018 event->modifiers |= ((double_click_count > 2)
6019 ? triple_modifier
6020 : double_modifier);
6021 }
6022 else
6023 {
6024 double_click_count = 1;
6025 event->modifiers |= click_modifier;
6026 }
6027
6028 button_down_time = event->timestamp;
6029 /* Use a negative value to distinguish wheel from mouse button. */
6030 last_mouse_button = - (1 + symbol_num);
6031 last_mouse_x = XFIXNUM (event->x);
6032 last_mouse_y = XFIXNUM (event->y);
6033
6034 /* Get the symbol we should use for the wheel event. */
6035 head = modify_event_symbol (symbol_num,
6036 event->modifiers,
6037 Qmouse_click,
6038 Qnil,
6039 lispy_wheel_names,
6040 &wheel_syms,
6041 ASIZE (wheel_syms));
6042 }
6043
6044 if (CONSP (event->arg))
6045 return list5 (head, position, make_fixnum (double_click_count),
6046 XCAR (event->arg), Fcons (XCAR (XCDR (event->arg)),
6047 XCAR (XCDR (XCDR (event->arg)))));
6048 else if (NUMBERP (event->arg))
6049 return list4 (head, position, make_fixnum (double_click_count),
6050 event->arg);
6051 else if (event->modifiers & (double_modifier | triple_modifier))
6052 return list3 (head, position, make_fixnum (double_click_count));
6053 else
6054 return list2 (head, position);
6055 }
6056
6057 case TOUCH_END_EVENT:
6058 {
6059 Lisp_Object position;
6060
6061 /* Build the position as appropriate for this mouse click. */
6062 struct frame *f = XFRAME (event->frame_or_window);
6063
6064 if (! FRAME_LIVE_P (f))
6065 return Qnil;
6066
6067 position = make_lispy_position (f, event->x, event->y,
6068 event->timestamp);
6069
6070 return list2 (Qtouch_end, position);
6071 }
6072
6073 case TOUCHSCREEN_BEGIN_EVENT:
6074 case TOUCHSCREEN_END_EVENT:
6075 {
6076 Lisp_Object x, y, id, position;
6077 struct frame *f = XFRAME (event->frame_or_window);
6078
6079 id = event->arg;
6080 x = event->x;
6081 y = event->y;
6082
6083 position = make_lispy_position (f, x, y, event->timestamp);
6084
6085 return list2 (((event->kind
6086 == TOUCHSCREEN_BEGIN_EVENT)
6087 ? Qtouchscreen_begin
6088 : Qtouchscreen_end),
6089 Fcons (id, position));
6090 }
6091
6092 case PINCH_EVENT:
6093 {
6094 Lisp_Object x, y, position;
6095 struct frame *f = XFRAME (event->frame_or_window);
6096
6097 x = event->x;
6098 y = event->y;
6099
6100 position = make_lispy_position (f, x, y, event->timestamp);
6101
6102 return Fcons (modify_event_symbol (0, event->modifiers, Qpinch,
6103 Qnil, (const char *[]) {"pinch"},
6104 &pinch_syms, 1),
6105 Fcons (position, event->arg));
6106 }
6107
6108 case TOUCHSCREEN_UPDATE_EVENT:
6109 {
6110 Lisp_Object x, y, id, position, tem, it, evt;
6111 struct frame *f = XFRAME (event->frame_or_window);
6112 evt = Qnil;
6113
6114 for (tem = event->arg; CONSP (tem); tem = XCDR (tem))
6115 {
6116 it = XCAR (tem);
6117
6118 x = XCAR (it);
6119 y = XCAR (XCDR (it));
6120 id = XCAR (XCDR (XCDR (it)));
6121
6122 position = make_lispy_position (f, x, y, event->timestamp);
6123 evt = Fcons (Fcons (id, position), evt);
6124 }
6125
6126 return list2 (Qtouchscreen_update, evt);
6127 }
6128
6129 #ifdef USE_TOOLKIT_SCROLL_BARS
6130
6131 /* We don't have down and up events if using toolkit scroll bars,
6132 so make this always a click event. Store in the `part' of
6133 the Lisp event a symbol which maps to the following actions:
6134
6135 `above_handle' page up
6136 `below_handle' page down
6137 `up' line up
6138 `down' line down
6139 `top' top of buffer
6140 `bottom' bottom of buffer
6141 `handle' thumb has been dragged.
6142 `end-scroll' end of interaction with scroll bar
6143
6144 The incoming input_event contains in its `part' member an
6145 index of type `enum scroll_bar_part' which we can use as an
6146 index in scroll_bar_parts to get the appropriate symbol. */
6147
6148 case SCROLL_BAR_CLICK_EVENT:
6149 {
6150 Lisp_Object position, head;
6151
6152 position = make_scroll_bar_position (event, Qvertical_scroll_bar);
6153
6154 /* Always treat scroll bar events as clicks. */
6155 event->modifiers |= click_modifier;
6156 event->modifiers &= ~up_modifier;
6157
6158 if (event->code >= ASIZE (mouse_syms))
6159 mouse_syms = larger_vector (mouse_syms,
6160 event->code - ASIZE (mouse_syms) + 1,
6161 -1);
6162
6163 /* Get the symbol we should use for the mouse click. */
6164 head = modify_event_symbol (event->code,
6165 event->modifiers,
6166 Qmouse_click,
6167 Vlispy_mouse_stem,
6168 NULL, &mouse_syms,
6169 ASIZE (mouse_syms));
6170 return list2 (head, position);
6171 }
6172
6173 case HORIZONTAL_SCROLL_BAR_CLICK_EVENT:
6174 {
6175 Lisp_Object position, head;
6176
6177 position = make_scroll_bar_position (event, Qhorizontal_scroll_bar);
6178
6179 /* Always treat scroll bar events as clicks. */
6180 event->modifiers |= click_modifier;
6181 event->modifiers &= ~up_modifier;
6182
6183 if (event->code >= ASIZE (mouse_syms))
6184 mouse_syms = larger_vector (mouse_syms,
6185 event->code - ASIZE (mouse_syms) + 1,
6186 -1);
6187
6188 /* Get the symbol we should use for the mouse click. */
6189 head = modify_event_symbol (event->code,
6190 event->modifiers,
6191 Qmouse_click,
6192 Vlispy_mouse_stem,
6193 NULL, &mouse_syms,
6194 ASIZE (mouse_syms));
6195 return list2 (head, position);
6196 }
6197
6198 #endif /* USE_TOOLKIT_SCROLL_BARS */
6199
6200 case DRAG_N_DROP_EVENT:
6201 {
6202 struct frame *f;
6203 Lisp_Object head, position;
6204 Lisp_Object files;
6205
6206 f = XFRAME (event->frame_or_window);
6207 files = event->arg;
6208
6209 /* Ignore mouse events that were made on frames that
6210 have been deleted. */
6211 if (! FRAME_LIVE_P (f))
6212 return Qnil;
6213
6214 position = make_lispy_position (f, event->x, event->y,
6215 event->timestamp);
6216
6217 head = modify_event_symbol (0, event->modifiers,
6218 Qdrag_n_drop, Qnil,
6219 lispy_drag_n_drop_names,
6220 &drag_n_drop_syms, 1);
6221 return list3 (head, position, files);
6222 }
6223
6224 #ifdef HAVE_EXT_MENU_BAR
6225 case MENU_BAR_EVENT:
6226 if (EQ (event->arg, event->frame_or_window))
6227 /* This is the prefix key. We translate this to
6228 `(menu_bar)' because the code in keyboard.c for menu
6229 events, which we use, relies on this. */
6230 return list1 (Qmenu_bar);
6231 return event->arg;
6232 #endif
6233
6234 case SELECT_WINDOW_EVENT:
6235 /* Make an event (select-window (WINDOW)). */
6236 return list2 (Qselect_window, list1 (event->frame_or_window));
6237
6238 case TAB_BAR_EVENT:
6239 case TOOL_BAR_EVENT:
6240 {
6241 Lisp_Object res = event->arg;
6242 Lisp_Object location
6243 = event->kind == TAB_BAR_EVENT ? Qtab_bar : Qtool_bar;
6244 if (SYMBOLP (res)) res = apply_modifiers (event->modifiers, res);
6245 return list2 (res, list2 (event->frame_or_window, location));
6246 }
6247
6248 case USER_SIGNAL_EVENT:
6249 /* A user signal. */
6250 {
6251 char *name = find_user_signal_name (event->code);
6252 if (!name)
6253 emacs_abort ();
6254 return intern (name);
6255 }
6256
6257 case SAVE_SESSION_EVENT:
6258 return list2 (Qsave_session, event->arg);
6259
6260 #ifdef HAVE_DBUS
6261 case DBUS_EVENT:
6262 return Fcons (Qdbus_event, event->arg);
6263 #endif /* HAVE_DBUS */
6264
6265 #ifdef THREADS_ENABLED
6266 case THREAD_EVENT:
6267 return Fcons (Qthread_event, event->arg);
6268 #endif /* THREADS_ENABLED */
6269
6270 #ifdef HAVE_XWIDGETS
6271 case XWIDGET_EVENT:
6272 return Fcons (Qxwidget_event, event->arg);
6273
6274 case XWIDGET_DISPLAY_EVENT:
6275 return Fcons (Qxwidget_display_event, event->arg);
6276 #endif
6277
6278 #ifdef USE_FILE_NOTIFY
6279 case FILE_NOTIFY_EVENT:
6280 #ifdef HAVE_W32NOTIFY
6281 /* Make an event (file-notify (DESCRIPTOR ACTION FILE) CALLBACK). */
6282 return list3 (Qfile_notify, event->arg, event->frame_or_window);
6283 #else
6284 return Fcons (Qfile_notify, event->arg);
6285 #endif
6286 #endif /* USE_FILE_NOTIFY */
6287
6288 case CONFIG_CHANGED_EVENT:
6289 return list3 (Qconfig_changed_event,
6290 event->arg, event->frame_or_window);
6291
6292 #ifdef HAVE_PGTK
6293 case PGTK_PREEDIT_TEXT_EVENT:
6294 return list2 (intern ("pgtk-preedit-text"), event->arg);
6295 #endif
6296
6297 /* The 'kind' field of the event is something we don't recognize. */
6298 default:
6299 emacs_abort ();
6300 }
6301 }
6302
6303 static Lisp_Object
make_lispy_movement(struct frame * frame,Lisp_Object bar_window,enum scroll_bar_part part,Lisp_Object x,Lisp_Object y,Time t)6304 make_lispy_movement (struct frame *frame, Lisp_Object bar_window, enum scroll_bar_part part,
6305 Lisp_Object x, Lisp_Object y, Time t)
6306 {
6307 /* Is it a scroll bar movement? */
6308 if (frame && ! NILP (bar_window))
6309 {
6310 Lisp_Object part_sym;
6311
6312 part_sym = builtin_lisp_symbol (scroll_bar_parts[part]);
6313 return list2 (Qscroll_bar_movement,
6314 list5 (bar_window,
6315 Qvertical_scroll_bar,
6316 Fcons (x, y),
6317 make_fixnum (t),
6318 part_sym));
6319 }
6320 /* Or is it an ordinary mouse movement? */
6321 else
6322 {
6323 Lisp_Object position;
6324 position = make_lispy_position (frame, x, y, t);
6325 return list2 (Qmouse_movement, position);
6326 }
6327 }
6328
6329 /* Construct a switch frame event. */
6330 static Lisp_Object
make_lispy_switch_frame(Lisp_Object frame)6331 make_lispy_switch_frame (Lisp_Object frame)
6332 {
6333 return list2 (Qswitch_frame, frame);
6334 }
6335
6336 static Lisp_Object
make_lispy_focus_in(Lisp_Object frame)6337 make_lispy_focus_in (Lisp_Object frame)
6338 {
6339 return list2 (Qfocus_in, frame);
6340 }
6341
6342 static Lisp_Object
make_lispy_focus_out(Lisp_Object frame)6343 make_lispy_focus_out (Lisp_Object frame)
6344 {
6345 return list2 (Qfocus_out, frame);
6346 }
6347
6348 /* Manipulating modifiers. */
6349
6350 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
6351
6352 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
6353 SYMBOL's name of the end of the modifiers; the string from this
6354 position is the unmodified symbol name.
6355
6356 This doesn't use any caches. */
6357
6358 static int
parse_modifiers_uncached(Lisp_Object symbol,ptrdiff_t * modifier_end)6359 parse_modifiers_uncached (Lisp_Object symbol, ptrdiff_t *modifier_end)
6360 {
6361 Lisp_Object name;
6362 ptrdiff_t i;
6363 int modifiers;
6364
6365 CHECK_SYMBOL (symbol);
6366
6367 modifiers = 0;
6368 name = SYMBOL_NAME (symbol);
6369
6370 for (i = 0; i < SBYTES (name) - 1; )
6371 {
6372 ptrdiff_t this_mod_end = 0;
6373 int this_mod = 0;
6374
6375 /* See if the name continues with a modifier word.
6376 Check that the word appears, but don't check what follows it.
6377 Set this_mod and this_mod_end to record what we find. */
6378
6379 switch (SREF (name, i))
6380 {
6381 #define SINGLE_LETTER_MOD(BIT) \
6382 (this_mod_end = i + 1, this_mod = BIT)
6383
6384 case 'A':
6385 SINGLE_LETTER_MOD (alt_modifier);
6386 break;
6387
6388 case 'C':
6389 SINGLE_LETTER_MOD (ctrl_modifier);
6390 break;
6391
6392 case 'H':
6393 SINGLE_LETTER_MOD (hyper_modifier);
6394 break;
6395
6396 case 'M':
6397 SINGLE_LETTER_MOD (meta_modifier);
6398 break;
6399
6400 case 'S':
6401 SINGLE_LETTER_MOD (shift_modifier);
6402 break;
6403
6404 case 's':
6405 SINGLE_LETTER_MOD (super_modifier);
6406 break;
6407
6408 #undef SINGLE_LETTER_MOD
6409
6410 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6411 if (i + LEN + 1 <= SBYTES (name) \
6412 && ! memcmp (SDATA (name) + i, NAME, LEN)) \
6413 { \
6414 this_mod_end = i + LEN; \
6415 this_mod = BIT; \
6416 }
6417
6418 case 'd':
6419 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6420 MULTI_LETTER_MOD (down_modifier, "down", 4);
6421 MULTI_LETTER_MOD (double_modifier, "double", 6);
6422 break;
6423
6424 case 't':
6425 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6426 break;
6427
6428 case 'u':
6429 MULTI_LETTER_MOD (up_modifier, "up", 2);
6430 break;
6431 #undef MULTI_LETTER_MOD
6432
6433 }
6434
6435 /* If we found no modifier, stop looking for them. */
6436 if (this_mod_end == 0)
6437 break;
6438
6439 /* Check there is a dash after the modifier, so that it
6440 really is a modifier. */
6441 if (this_mod_end >= SBYTES (name)
6442 || SREF (name, this_mod_end) != '-')
6443 break;
6444
6445 /* This modifier is real; look for another. */
6446 modifiers |= this_mod;
6447 i = this_mod_end + 1;
6448 }
6449
6450 /* Should we include the `click' modifier? */
6451 if (! (modifiers & (down_modifier | drag_modifier
6452 | double_modifier | triple_modifier))
6453 && i + 7 == SBYTES (name)
6454 && memcmp (SDATA (name) + i, "mouse-", 6) == 0
6455 && ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9'))
6456 modifiers |= click_modifier;
6457
6458 if (! (modifiers & (double_modifier | triple_modifier))
6459 && i + 6 < SBYTES (name)
6460 && memcmp (SDATA (name) + i, "wheel-", 6) == 0)
6461 modifiers |= click_modifier;
6462
6463 if (modifier_end)
6464 *modifier_end = i;
6465
6466 return modifiers;
6467 }
6468
6469 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
6470 prepended to the string BASE[0..BASE_LEN-1].
6471 This doesn't use any caches. */
6472 static Lisp_Object
apply_modifiers_uncached(int modifiers,char * base,int base_len,int base_len_byte)6473 apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_byte)
6474 {
6475 /* Since BASE could contain nulls, we can't use intern here; we have
6476 to use Fintern, which expects a genuine Lisp_String, and keeps a
6477 reference to it. */
6478 char new_mods[sizeof "A-C-H-M-S-s-up-down-drag-double-triple-"];
6479 int mod_len;
6480
6481 {
6482 char *p = new_mods;
6483
6484 /* Mouse events should not exhibit the `up' modifier once they
6485 leave the event queue only accessible to C code; `up' will
6486 always be turned into a click or drag event before being
6487 presented to lisp code. But since lisp events can be
6488 synthesized bypassing the event queue and pushed into
6489 `unread-command-events' or its companions, it's better to just
6490 deal with unexpected modifier combinations. */
6491
6492 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
6493 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
6494 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
6495 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
6496 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
6497 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
6498 if (modifiers & double_modifier) p = stpcpy (p, "double-");
6499 if (modifiers & triple_modifier) p = stpcpy (p, "triple-");
6500 if (modifiers & up_modifier) p = stpcpy (p, "up-");
6501 if (modifiers & down_modifier) p = stpcpy (p, "down-");
6502 if (modifiers & drag_modifier) p = stpcpy (p, "drag-");
6503 /* The click modifier is denoted by the absence of other modifiers. */
6504
6505 *p = '\0';
6506
6507 mod_len = p - new_mods;
6508 }
6509
6510 {
6511 Lisp_Object new_name;
6512
6513 new_name = make_uninit_multibyte_string (mod_len + base_len,
6514 mod_len + base_len_byte);
6515 memcpy (SDATA (new_name), new_mods, mod_len);
6516 memcpy (SDATA (new_name) + mod_len, base, base_len_byte);
6517
6518 return Fintern (new_name, Qnil);
6519 }
6520 }
6521
6522
6523 static const char *const modifier_names[] =
6524 {
6525 "up", "down", "drag", "click", "double", "triple", 0, 0,
6526 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
6527 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
6528 };
6529 #define NUM_MOD_NAMES ARRAYELTS (modifier_names)
6530
6531 static Lisp_Object modifier_symbols;
6532
6533 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
6534 static Lisp_Object
lispy_modifier_list(int modifiers)6535 lispy_modifier_list (int modifiers)
6536 {
6537 Lisp_Object modifier_list;
6538 int i;
6539
6540 modifier_list = Qnil;
6541 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
6542 if (modifiers & (1<<i))
6543 modifier_list = Fcons (AREF (modifier_symbols, i),
6544 modifier_list);
6545
6546 return modifier_list;
6547 }
6548
6549
6550 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
6551 where UNMODIFIED is the unmodified form of SYMBOL,
6552 MASK is the set of modifiers present in SYMBOL's name.
6553 This is similar to parse_modifiers_uncached, but uses the cache in
6554 SYMBOL's Qevent_symbol_element_mask property, and maintains the
6555 Qevent_symbol_elements property. */
6556
6557 #define KEY_TO_CHAR(k) (XFIXNUM (k) & ((1 << CHARACTERBITS) - 1))
6558
6559 Lisp_Object
parse_modifiers(Lisp_Object symbol)6560 parse_modifiers (Lisp_Object symbol)
6561 {
6562 Lisp_Object elements;
6563
6564 if (FIXNUMP (symbol))
6565 return list2i (KEY_TO_CHAR (symbol), XFIXNUM (symbol) & CHAR_MODIFIER_MASK);
6566 else if (!SYMBOLP (symbol))
6567 return Qnil;
6568
6569 elements = Fget (symbol, Qevent_symbol_element_mask);
6570 if (CONSP (elements))
6571 return elements;
6572 else
6573 {
6574 ptrdiff_t end;
6575 int modifiers = parse_modifiers_uncached (symbol, &end);
6576 Lisp_Object unmodified;
6577 Lisp_Object mask;
6578
6579 unmodified = Fintern (make_string (SSDATA (SYMBOL_NAME (symbol)) + end,
6580 SBYTES (SYMBOL_NAME (symbol)) - end),
6581 Qnil);
6582
6583 if (modifiers & ~INTMASK)
6584 emacs_abort ();
6585 XSETFASTINT (mask, modifiers);
6586 elements = list2 (unmodified, mask);
6587
6588 /* Cache the parsing results on SYMBOL. */
6589 Fput (symbol, Qevent_symbol_element_mask,
6590 elements);
6591 Fput (symbol, Qevent_symbol_elements,
6592 Fcons (unmodified, lispy_modifier_list (modifiers)));
6593
6594 /* Since we know that SYMBOL is modifiers applied to unmodified,
6595 it would be nice to put that in unmodified's cache.
6596 But we can't, since we're not sure that parse_modifiers is
6597 canonical. */
6598
6599 return elements;
6600 }
6601 }
6602
6603 DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,
6604 Sevent_symbol_parse_modifiers, 1, 1, 0,
6605 doc: /* Parse the event symbol. For internal use. */)
6606 (Lisp_Object symbol)
6607 {
6608 /* Fill the cache if needed. */
6609 parse_modifiers (symbol);
6610 /* Ignore the result (which is stored on Qevent_symbol_element_mask)
6611 and use the Lispier representation stored on Qevent_symbol_elements
6612 instead. */
6613 return Fget (symbol, Qevent_symbol_elements);
6614 }
6615
6616 /* Apply the modifiers MODIFIERS to the symbol BASE.
6617 BASE must be unmodified.
6618
6619 This is like apply_modifiers_uncached, but uses BASE's
6620 Qmodifier_cache property, if present.
6621
6622 apply_modifiers copies the value of BASE's Qevent_kind property to
6623 the modified symbol. */
6624 static Lisp_Object
apply_modifiers(int modifiers,Lisp_Object base)6625 apply_modifiers (int modifiers, Lisp_Object base)
6626 {
6627 Lisp_Object cache, idx, entry, new_symbol;
6628
6629 /* Mask out upper bits. We don't know where this value's been. */
6630 modifiers &= INTMASK;
6631
6632 if (FIXNUMP (base))
6633 return make_fixnum (XFIXNUM (base) | modifiers);
6634
6635 /* The click modifier never figures into cache indices. */
6636 cache = Fget (base, Qmodifier_cache);
6637 XSETFASTINT (idx, (modifiers & ~click_modifier));
6638 entry = assq_no_quit (idx, cache);
6639
6640 if (CONSP (entry))
6641 new_symbol = XCDR (entry);
6642 else
6643 {
6644 /* We have to create the symbol ourselves. */
6645 new_symbol = apply_modifiers_uncached (modifiers,
6646 SSDATA (SYMBOL_NAME (base)),
6647 SCHARS (SYMBOL_NAME (base)),
6648 SBYTES (SYMBOL_NAME (base)));
6649
6650 /* Add the new symbol to the base's cache. */
6651 entry = Fcons (idx, new_symbol);
6652 Fput (base, Qmodifier_cache, Fcons (entry, cache));
6653
6654 /* We have the parsing info now for free, so we could add it to
6655 the caches:
6656 XSETFASTINT (idx, modifiers);
6657 Fput (new_symbol, Qevent_symbol_element_mask,
6658 list2 (base, idx));
6659 Fput (new_symbol, Qevent_symbol_elements,
6660 Fcons (base, lispy_modifier_list (modifiers)));
6661 Sadly, this is only correct if `base' is indeed a base event,
6662 which is not necessarily the case. -stef */
6663 }
6664
6665 /* Make sure this symbol is of the same kind as BASE.
6666
6667 You'd think we could just set this once and for all when we
6668 intern the symbol above, but reorder_modifiers may call us when
6669 BASE's property isn't set right; we can't assume that just
6670 because it has a Qmodifier_cache property it must have its
6671 Qevent_kind set right as well. */
6672 if (NILP (Fget (new_symbol, Qevent_kind)))
6673 {
6674 Lisp_Object kind;
6675
6676 kind = Fget (base, Qevent_kind);
6677 if (! NILP (kind))
6678 Fput (new_symbol, Qevent_kind, kind);
6679 }
6680
6681 return new_symbol;
6682 }
6683
6684
6685 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
6686 return a symbol with the modifiers placed in the canonical order.
6687 Canonical order is alphabetical, except for down and drag, which
6688 always come last. The 'click' modifier is never written out.
6689
6690 Fdefine_key calls this to make sure that (for example) C-M-foo
6691 and M-C-foo end up being equivalent in the keymap. */
6692
6693 Lisp_Object
reorder_modifiers(Lisp_Object symbol)6694 reorder_modifiers (Lisp_Object symbol)
6695 {
6696 /* It's hopefully okay to write the code this way, since everything
6697 will soon be in caches, and no consing will be done at all. */
6698 Lisp_Object parsed;
6699
6700 parsed = parse_modifiers (symbol);
6701 return apply_modifiers (XFIXNAT (XCAR (XCDR (parsed))),
6702 XCAR (parsed));
6703 }
6704
6705
6706 /* For handling events, we often want to produce a symbol whose name
6707 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
6708 to some base, like the name of a function key or mouse button.
6709 modify_event_symbol produces symbols of this sort.
6710
6711 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
6712 is the name of the i'th symbol. TABLE_SIZE is the number of elements
6713 in the table.
6714
6715 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
6716 into symbol names, or a string specifying a name stem used to
6717 construct a symbol name or the form `STEM-N', where N is the decimal
6718 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
6719 non-nil; otherwise NAME_TABLE is used.
6720
6721 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
6722 persist between calls to modify_event_symbol that it can use to
6723 store a cache of the symbols it's generated for this NAME_TABLE
6724 before. The object stored there may be a vector or an alist.
6725
6726 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
6727
6728 MODIFIERS is a set of modifier bits (as given in struct input_events)
6729 whose prefixes should be applied to the symbol name.
6730
6731 SYMBOL_KIND is the value to be placed in the event_kind property of
6732 the returned symbol.
6733
6734 The symbols we create are supposed to have an
6735 `event-symbol-elements' property, which lists the modifiers present
6736 in the symbol's name. */
6737
6738 static Lisp_Object
modify_event_symbol(ptrdiff_t symbol_num,int modifiers,Lisp_Object symbol_kind,Lisp_Object name_alist_or_stem,const char * const * name_table,Lisp_Object * symbol_table,ptrdiff_t table_size)6739 modify_event_symbol (ptrdiff_t symbol_num, int modifiers, Lisp_Object symbol_kind,
6740 Lisp_Object name_alist_or_stem, const char *const *name_table,
6741 Lisp_Object *symbol_table, ptrdiff_t table_size)
6742 {
6743 Lisp_Object value;
6744 Lisp_Object symbol_int;
6745
6746 /* Get rid of the "vendor-specific" bit here. */
6747 XSETINT (symbol_int, symbol_num & 0xffffff);
6748
6749 /* Is this a request for a valid symbol? */
6750 if (symbol_num < 0 || symbol_num >= table_size)
6751 return Qnil;
6752
6753 if (CONSP (*symbol_table))
6754 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
6755
6756 /* If *symbol_table doesn't seem to be initialized properly, fix that.
6757 *symbol_table should be a lisp vector TABLE_SIZE elements long,
6758 where the Nth element is the symbol for NAME_TABLE[N], or nil if
6759 we've never used that symbol before. */
6760 else
6761 {
6762 if (! VECTORP (*symbol_table)
6763 || ASIZE (*symbol_table) != table_size)
6764 *symbol_table = make_nil_vector (table_size);
6765
6766 value = AREF (*symbol_table, symbol_num);
6767 }
6768
6769 /* Have we already used this symbol before? */
6770 if (NILP (value))
6771 {
6772 /* No; let's create it. */
6773 if (CONSP (name_alist_or_stem))
6774 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
6775 else if (STRINGP (name_alist_or_stem))
6776 {
6777 char *buf;
6778 ptrdiff_t len = (SBYTES (name_alist_or_stem)
6779 + sizeof "-" + INT_STRLEN_BOUND (EMACS_INT));
6780 USE_SAFE_ALLOCA;
6781 buf = SAFE_ALLOCA (len);
6782 esprintf (buf, "%s-%"pI"d", SDATA (name_alist_or_stem),
6783 XFIXNUM (symbol_int) + 1);
6784 value = intern (buf);
6785 SAFE_FREE ();
6786 }
6787 else if (name_table != 0 && name_table[symbol_num])
6788 value = intern (name_table[symbol_num]);
6789
6790 #ifdef HAVE_WINDOW_SYSTEM
6791 if (NILP (value))
6792 {
6793 char *name = get_keysym_name (symbol_num);
6794 if (name)
6795 value = intern (name);
6796 }
6797 #endif
6798
6799 if (NILP (value))
6800 {
6801 char buf[sizeof "key-" + INT_STRLEN_BOUND (EMACS_INT)];
6802 sprintf (buf, "key-%"pD"d", symbol_num);
6803 value = intern (buf);
6804 }
6805
6806 if (CONSP (*symbol_table))
6807 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
6808 else
6809 ASET (*symbol_table, symbol_num, value);
6810
6811 /* Fill in the cache entries for this symbol; this also
6812 builds the Qevent_symbol_elements property, which the user
6813 cares about. */
6814 apply_modifiers (modifiers & click_modifier, value);
6815 Fput (value, Qevent_kind, symbol_kind);
6816 }
6817
6818 /* Apply modifiers to that symbol. */
6819 return apply_modifiers (modifiers, value);
6820 }
6821
6822 /* Convert a list that represents an event type,
6823 such as (ctrl meta backspace), into the usual representation of that
6824 event type as a number or a symbol. */
6825
6826 DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
6827 doc: /* Convert the event description list EVENT-DESC to an event type.
6828 EVENT-DESC should contain one base event type (a character or symbol)
6829 and zero or more modifier names (control, meta, hyper, super, shift, alt,
6830 drag, down, double or triple). The base must be last.
6831
6832 The return value is an event type (a character or symbol) which has
6833 essentially the same base event type and all the specified modifiers.
6834 (Some compatibility base types, like symbols that represent a
6835 character, are not returned verbatim.) */)
6836 (Lisp_Object event_desc)
6837 {
6838 Lisp_Object base = Qnil;
6839 int modifiers = 0;
6840
FOR_EACH_TAIL_SAFE(event_desc)6841 FOR_EACH_TAIL_SAFE (event_desc)
6842 {
6843 Lisp_Object elt = XCAR (event_desc);
6844 int this = 0;
6845
6846 /* Given a symbol, see if it is a modifier name. */
6847 if (SYMBOLP (elt) && CONSP (XCDR (event_desc)))
6848 this = parse_solitary_modifier (elt);
6849
6850 if (this != 0)
6851 modifiers |= this;
6852 else if (!NILP (base))
6853 error ("Two bases given in one event");
6854 else
6855 base = elt;
6856 }
6857
6858 /* Let the symbol A refer to the character A. */
6859 if (SYMBOLP (base) && SCHARS (SYMBOL_NAME (base)) == 1)
6860 XSETINT (base, SREF (SYMBOL_NAME (base), 0));
6861
6862 if (FIXNUMP (base))
6863 {
6864 /* Turn (shift a) into A. */
6865 if ((modifiers & shift_modifier) != 0
6866 && (XFIXNUM (base) >= 'a' && XFIXNUM (base) <= 'z'))
6867 {
6868 XSETINT (base, XFIXNUM (base) - ('a' - 'A'));
6869 modifiers &= ~shift_modifier;
6870 }
6871
6872 /* Turn (control a) into C-a. */
6873 if (modifiers & ctrl_modifier)
6874 return make_fixnum ((modifiers & ~ctrl_modifier)
6875 | make_ctrl_char (XFIXNUM (base)));
6876 else
6877 return make_fixnum (modifiers | XFIXNUM (base));
6878 }
6879 else if (SYMBOLP (base))
6880 return apply_modifiers (modifiers, base);
6881 else
6882 error ("Invalid base event");
6883 }
6884
6885 DEFUN ("internal-handle-focus-in", Finternal_handle_focus_in,
6886 Sinternal_handle_focus_in, 1, 1, 0,
6887 doc: /* Internally handle focus-in events.
6888 This function potentially generates an artificial switch-frame event. */)
6889 (Lisp_Object event)
6890 {
6891 Lisp_Object frame;
6892 if (!EQ (CAR_SAFE (event), Qfocus_in) ||
6893 !CONSP (XCDR (event)) ||
6894 !FRAMEP ((frame = XCAR (XCDR (event)))))
6895 error ("invalid focus-in event");
6896
6897 /* Conceptually, the concept of window manager focus on a particular
6898 frame and the Emacs selected frame shouldn't be related, but for
6899 a long time, we automatically switched the selected frame in
6900 response to focus events, so let's keep doing that. */
6901 bool switching = (!EQ (frame, internal_last_event_frame)
6902 && !EQ (frame, selected_frame));
6903 internal_last_event_frame = frame;
6904 if (switching || !NILP (unread_switch_frame))
6905 unread_switch_frame = make_lispy_switch_frame (frame);
6906
6907 return Qnil;
6908 }
6909
6910 /* Try to recognize SYMBOL as a modifier name.
6911 Return the modifier flag bit, or 0 if not recognized. */
6912
6913 int
parse_solitary_modifier(Lisp_Object symbol)6914 parse_solitary_modifier (Lisp_Object symbol)
6915 {
6916 Lisp_Object name;
6917
6918 if (!SYMBOLP (symbol))
6919 return 0;
6920
6921 name = SYMBOL_NAME (symbol);
6922
6923 switch (SREF (name, 0))
6924 {
6925 #define SINGLE_LETTER_MOD(BIT) \
6926 if (SBYTES (name) == 1) \
6927 return BIT;
6928
6929 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6930 if (LEN == SBYTES (name) \
6931 && ! memcmp (SDATA (name), NAME, LEN)) \
6932 return BIT;
6933
6934 case 'A':
6935 SINGLE_LETTER_MOD (alt_modifier);
6936 break;
6937
6938 case 'a':
6939 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
6940 break;
6941
6942 case 'C':
6943 SINGLE_LETTER_MOD (ctrl_modifier);
6944 break;
6945
6946 case 'c':
6947 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
6948 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
6949 MULTI_LETTER_MOD (click_modifier, "click", 5);
6950 break;
6951
6952 case 'H':
6953 SINGLE_LETTER_MOD (hyper_modifier);
6954 break;
6955
6956 case 'h':
6957 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
6958 break;
6959
6960 case 'M':
6961 SINGLE_LETTER_MOD (meta_modifier);
6962 break;
6963
6964 case 'm':
6965 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
6966 break;
6967
6968 case 'S':
6969 SINGLE_LETTER_MOD (shift_modifier);
6970 break;
6971
6972 case 's':
6973 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
6974 MULTI_LETTER_MOD (super_modifier, "super", 5);
6975 SINGLE_LETTER_MOD (super_modifier);
6976 break;
6977
6978 case 'd':
6979 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6980 MULTI_LETTER_MOD (down_modifier, "down", 4);
6981 MULTI_LETTER_MOD (double_modifier, "double", 6);
6982 break;
6983
6984 case 't':
6985 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6986 break;
6987
6988 case 'u':
6989 MULTI_LETTER_MOD (up_modifier, "up", 2);
6990 break;
6991
6992 #undef SINGLE_LETTER_MOD
6993 #undef MULTI_LETTER_MOD
6994 }
6995
6996 return 0;
6997 }
6998
6999 /* Return true if EVENT is a list whose elements are all integers or symbols.
7000 Such a list is not valid as an event,
7001 but it can be a Lucid-style event type list. */
7002
7003 bool
lucid_event_type_list_p(Lisp_Object object)7004 lucid_event_type_list_p (Lisp_Object object)
7005 {
7006 if (! CONSP (object))
7007 return false;
7008
7009 if (EQ (XCAR (object), Qhelp_echo)
7010 || EQ (XCAR (object), Qvertical_line)
7011 || EQ (XCAR (object), Qmode_line)
7012 || EQ (XCAR (object), Qtab_line)
7013 || EQ (XCAR (object), Qheader_line))
7014 return false;
7015
7016 Lisp_Object tail = object;
7017 FOR_EACH_TAIL_SAFE (object)
7018 {
7019 Lisp_Object elt = XCAR (object);
7020 if (! (FIXNUMP (elt) || SYMBOLP (elt)))
7021 return false;
7022 tail = XCDR (object);
7023 }
7024
7025 return NILP (tail);
7026 }
7027
7028 /* Return true if terminal input chars are available.
7029 Also, store the return value into INPUT_PENDING.
7030
7031 Serves the purpose of ioctl (0, FIONREAD, ...)
7032 but works even if FIONREAD does not exist.
7033 (In fact, this may actually read some input.)
7034
7035 If READABLE_EVENTS_DO_TIMERS_NOW is set in FLAGS, actually run
7036 timer events that are ripe.
7037 If READABLE_EVENTS_FILTER_EVENTS is set in FLAGS, ignore internal
7038 events (FOCUS_IN_EVENT).
7039 If READABLE_EVENTS_IGNORE_SQUEEZABLES is set in FLAGS, ignore mouse
7040 movements and toolkit scroll bar thumb drags. */
7041
7042 static bool
get_input_pending(int flags)7043 get_input_pending (int flags)
7044 {
7045 /* First of all, have we already counted some input? */
7046 input_pending = (!NILP (Vquit_flag) || readable_events (flags));
7047
7048 /* If input is being read as it arrives, and we have none, there is none. */
7049 if (!input_pending && (!interrupt_input || interrupts_deferred))
7050 {
7051 /* Try to read some input and see how much we get. */
7052 gobble_input ();
7053 input_pending = (!NILP (Vquit_flag) || readable_events (flags));
7054 }
7055
7056 return input_pending;
7057 }
7058
7059 /* Read any terminal input already buffered up by the system
7060 into the kbd_buffer, but do not wait.
7061
7062 Return the number of keyboard chars read, or -1 meaning
7063 this is a bad time to try to read input. */
7064
7065 int
gobble_input(void)7066 gobble_input (void)
7067 {
7068 int nread = 0;
7069 bool err = false;
7070 struct terminal *t;
7071
7072 /* Store pending user signal events, if any. */
7073 store_user_signal_events ();
7074
7075 /* Loop through the available terminals, and call their input hooks. */
7076 t = terminal_list;
7077 while (t)
7078 {
7079 struct terminal *next = t->next_terminal;
7080
7081 if (t->read_socket_hook)
7082 {
7083 int nr;
7084 struct input_event hold_quit;
7085
7086 if (input_blocked_p ())
7087 {
7088 pending_signals = true;
7089 break;
7090 }
7091
7092 EVENT_INIT (hold_quit);
7093 hold_quit.kind = NO_EVENT;
7094
7095 /* No need for FIONREAD or fcntl; just say don't wait. */
7096 while ((nr = (*t->read_socket_hook) (t, &hold_quit)) > 0)
7097 nread += nr;
7098
7099 if (nr == -1) /* Not OK to read input now. */
7100 {
7101 err = true;
7102 }
7103 else if (nr == -2) /* Non-transient error. */
7104 {
7105 /* The terminal device terminated; it should be closed. */
7106
7107 /* Kill Emacs if this was our last terminal. */
7108 if (!terminal_list->next_terminal)
7109 /* Formerly simply reported no input, but that
7110 sometimes led to a failure of Emacs to terminate.
7111 SIGHUP seems appropriate if we can't reach the
7112 terminal. */
7113 /* ??? Is it really right to send the signal just to
7114 this process rather than to the whole process
7115 group? Perhaps on systems with FIONREAD Emacs is
7116 alone in its group. */
7117 terminate_due_to_signal (SIGHUP, 10);
7118
7119 /* XXX Is calling delete_terminal safe here? It calls delete_frame. */
7120 {
7121 Lisp_Object tmp;
7122 XSETTERMINAL (tmp, t);
7123 Fdelete_terminal (tmp, Qnoelisp);
7124 }
7125 }
7126
7127 /* If there was no error, make sure the pointer
7128 is visible for all frames on this terminal. */
7129 if (nr >= 0)
7130 {
7131 Lisp_Object tail, frame;
7132
7133 FOR_EACH_FRAME (tail, frame)
7134 {
7135 struct frame *f = XFRAME (frame);
7136 if (FRAME_TERMINAL (f) == t)
7137 frame_make_pointer_visible (f);
7138 }
7139 }
7140
7141 if (hold_quit.kind != NO_EVENT)
7142 kbd_buffer_store_event (&hold_quit);
7143 }
7144
7145 t = next;
7146 }
7147
7148 if (err && !nread)
7149 nread = -1;
7150
7151 return nread;
7152 }
7153
7154 /* This is the tty way of reading available input.
7155
7156 Note that each terminal device has its own `struct terminal' object,
7157 and so this function is called once for each individual termcap
7158 terminal. The first parameter indicates which terminal to read from. */
7159
7160 int
tty_read_avail_input(struct terminal * terminal,struct input_event * hold_quit)7161 tty_read_avail_input (struct terminal *terminal,
7162 struct input_event *hold_quit)
7163 {
7164 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
7165 the kbd_buffer can really hold. That may prevent loss
7166 of characters on some systems when input is stuffed at us. */
7167 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
7168 #ifndef WINDOWSNT
7169 int n_to_read;
7170 #endif
7171 int i;
7172 struct tty_display_info *tty = terminal->display_info.tty;
7173 int nread = 0;
7174 #ifdef subprocesses
7175 int buffer_free = KBD_BUFFER_SIZE - kbd_buffer_nr_stored () - 1;
7176
7177 if (kbd_on_hold_p () || buffer_free <= 0)
7178 return 0;
7179 #endif /* subprocesses */
7180
7181 if (!terminal->name) /* Don't read from a dead terminal. */
7182 return 0;
7183
7184 if (terminal->type != output_termcap
7185 && terminal->type != output_msdos_raw)
7186 emacs_abort ();
7187
7188 /* XXX I think the following code should be moved to separate hook
7189 functions in system-dependent files. */
7190 #ifdef WINDOWSNT
7191 /* FIXME: AFAIK, tty_read_avail_input is not used under w32 since the non-GUI
7192 code sets read_socket_hook to w32_console_read_socket instead! */
7193 return 0;
7194 #else /* not WINDOWSNT */
7195 if (! tty->term_initted) /* In case we get called during bootstrap. */
7196 return 0;
7197
7198 if (! tty->input)
7199 return 0; /* The terminal is suspended. */
7200
7201 #ifdef MSDOS
7202 n_to_read = dos_keysns ();
7203 if (n_to_read == 0)
7204 return 0;
7205
7206 cbuf[0] = dos_keyread ();
7207 nread = 1;
7208
7209 #else /* not MSDOS */
7210 #ifdef HAVE_GPM
7211 if (gpm_tty == tty)
7212 {
7213 Gpm_Event event;
7214 int gpm, fd = gpm_fd;
7215
7216 /* gpm==1 if event received.
7217 gpm==0 if the GPM daemon has closed the connection, in which case
7218 Gpm_GetEvent closes gpm_fd and clears it to -1, which is why
7219 we save it in `fd' so close_gpm can remove it from the
7220 select masks.
7221 gpm==-1 if a protocol error or EWOULDBLOCK; the latter is normal. */
7222 while (gpm = Gpm_GetEvent (&event), gpm == 1) {
7223 nread += handle_one_term_event (tty, &event);
7224 }
7225 if (gpm == 0)
7226 /* Presumably the GPM daemon has closed the connection. */
7227 close_gpm (fd);
7228 if (nread)
7229 return nread;
7230 }
7231 #endif /* HAVE_GPM */
7232
7233 /* Determine how many characters we should *try* to read. */
7234 #ifdef USABLE_FIONREAD
7235 /* Find out how much input is available. */
7236 if (ioctl (fileno (tty->input), FIONREAD, &n_to_read) < 0)
7237 {
7238 if (! noninteractive)
7239 return -2; /* Close this terminal. */
7240 else
7241 n_to_read = 0;
7242 }
7243 if (n_to_read == 0)
7244 return 0;
7245 if (n_to_read > sizeof cbuf)
7246 n_to_read = sizeof cbuf;
7247 #elif defined USG || defined CYGWIN
7248 /* Read some input if available, but don't wait. */
7249 n_to_read = sizeof cbuf;
7250 fcntl (fileno (tty->input), F_SETFL, O_NONBLOCK);
7251 #else
7252 # error "Cannot read without possibly delaying"
7253 #endif
7254
7255 #ifdef subprocesses
7256 /* Don't read more than we can store. */
7257 if (n_to_read > buffer_free)
7258 n_to_read = buffer_free;
7259 #endif /* subprocesses */
7260
7261 /* Now read; for one reason or another, this will not block.
7262 NREAD is set to the number of chars read. */
7263 nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read);
7264 /* POSIX infers that processes which are not in the session leader's
7265 process group won't get SIGHUPs at logout time. BSDI adheres to
7266 this part standard and returns -1 from read (0) with errno==EIO
7267 when the control tty is taken away.
7268 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
7269 if (nread == -1 && errno == EIO)
7270 return -2; /* Close this terminal. */
7271 #if defined AIX && defined _BSD
7272 /* The kernel sometimes fails to deliver SIGHUP for ptys.
7273 This looks incorrect, but it isn't, because _BSD causes
7274 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
7275 and that causes a value other than 0 when there is no input. */
7276 if (nread == 0)
7277 return -2; /* Close this terminal. */
7278 #endif
7279
7280 #ifndef USABLE_FIONREAD
7281 #if defined (USG) || defined (CYGWIN)
7282 fcntl (fileno (tty->input), F_SETFL, 0);
7283 #endif /* USG or CYGWIN */
7284 #endif /* no FIONREAD */
7285
7286 if (nread <= 0)
7287 return nread;
7288
7289 #endif /* not MSDOS */
7290 #endif /* not WINDOWSNT */
7291
7292 for (i = 0; i < nread; i++)
7293 {
7294 struct input_event buf;
7295 EVENT_INIT (buf);
7296 buf.kind = ASCII_KEYSTROKE_EVENT;
7297 buf.modifiers = 0;
7298 if (tty->meta_key == 1 && (cbuf[i] & 0x80))
7299 buf.modifiers = meta_modifier;
7300 if (tty->meta_key < 2)
7301 cbuf[i] &= ~0x80;
7302
7303 buf.code = cbuf[i];
7304 /* Set the frame corresponding to the active tty. Note that the
7305 value of selected_frame is not reliable here, redisplay tends
7306 to temporarily change it. */
7307 buf.frame_or_window = tty->top_frame;
7308 buf.arg = Qnil;
7309
7310 kbd_buffer_store_event (&buf);
7311 /* Don't look at input that follows a C-g too closely.
7312 This reduces lossage due to autorepeat on C-g. */
7313 if (buf.kind == ASCII_KEYSTROKE_EVENT
7314 && buf.code == quit_char)
7315 break;
7316 }
7317
7318 return nread;
7319 }
7320
7321 static void
handle_async_input(void)7322 handle_async_input (void)
7323 {
7324 #ifndef DOS_NT
7325 while (1)
7326 {
7327 int nread = gobble_input ();
7328 /* -1 means it's not ok to read the input now.
7329 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
7330 0 means there was no keyboard input available. */
7331 if (nread <= 0)
7332 break;
7333 }
7334 #endif
7335 }
7336
7337 void
process_pending_signals(void)7338 process_pending_signals (void)
7339 {
7340 pending_signals = false;
7341 handle_async_input ();
7342 do_pending_atimers ();
7343 }
7344
7345 /* Undo any number of BLOCK_INPUT calls down to level LEVEL,
7346 and reinvoke any pending signal if the level is now 0 and
7347 a fatal error is not already in progress. */
7348
7349 void
unblock_input_to(int level)7350 unblock_input_to (int level)
7351 {
7352 interrupt_input_blocked = level;
7353 if (level == 0)
7354 {
7355 if (pending_signals && !fatal_error_in_progress)
7356 process_pending_signals ();
7357 }
7358 else if (level < 0)
7359 emacs_abort ();
7360 }
7361
7362 /* End critical section.
7363
7364 If doing signal-driven input, and a signal came in when input was
7365 blocked, reinvoke the signal handler now to deal with it.
7366
7367 It will also process queued input, if it was not read before.
7368 When a longer code sequence does not use block/unblock input
7369 at all, the whole input gathered up to the next call to
7370 unblock_input will be processed inside that call. */
7371
7372 void
unblock_input(void)7373 unblock_input (void)
7374 {
7375 unblock_input_to (interrupt_input_blocked - 1);
7376 }
7377
7378 /* Undo any number of BLOCK_INPUT calls,
7379 and also reinvoke any pending signal. */
7380
7381 void
totally_unblock_input(void)7382 totally_unblock_input (void)
7383 {
7384 unblock_input_to (0);
7385 }
7386
7387 #if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
7388
7389 void
handle_input_available_signal(int sig)7390 handle_input_available_signal (int sig)
7391 {
7392 pending_signals = true;
7393
7394 if (input_available_clear_time)
7395 *input_available_clear_time = make_timespec (0, 0);
7396 }
7397
7398 static void
deliver_input_available_signal(int sig)7399 deliver_input_available_signal (int sig)
7400 {
7401 deliver_process_signal (sig, handle_input_available_signal);
7402 }
7403 #endif /* defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL) */
7404
7405
7406 /* User signal events. */
7407
7408 struct user_signal_info
7409 {
7410 /* Signal number. */
7411 int sig;
7412
7413 /* Name of the signal. */
7414 char *name;
7415
7416 /* Number of pending signals. */
7417 int npending;
7418
7419 struct user_signal_info *next;
7420 };
7421
7422 /* List of user signals. */
7423 static struct user_signal_info *user_signals = NULL;
7424
7425 void
add_user_signal(int sig,const char * name)7426 add_user_signal (int sig, const char *name)
7427 {
7428 struct sigaction action;
7429 struct user_signal_info *p;
7430
7431 for (p = user_signals; p; p = p->next)
7432 if (p->sig == sig)
7433 /* Already added. */
7434 return;
7435
7436 p = xmalloc (sizeof *p);
7437 p->sig = sig;
7438 p->name = xstrdup (name);
7439 p->npending = 0;
7440 p->next = user_signals;
7441 user_signals = p;
7442
7443 emacs_sigaction_init (&action, deliver_user_signal);
7444 sigaction (sig, &action, 0);
7445 }
7446
7447 static void
handle_user_signal(int sig)7448 handle_user_signal (int sig)
7449 {
7450 struct user_signal_info *p;
7451 const char *special_event_name = NULL;
7452
7453 if (SYMBOLP (Vdebug_on_event))
7454 special_event_name = SSDATA (SYMBOL_NAME (Vdebug_on_event));
7455
7456 for (p = user_signals; p; p = p->next)
7457 if (p->sig == sig)
7458 {
7459 if (special_event_name
7460 && strcmp (special_event_name, p->name) == 0)
7461 {
7462 /* Enter the debugger in many ways. */
7463 debug_on_next_call = true;
7464 debug_on_quit = true;
7465 Vquit_flag = Qt;
7466 Vinhibit_quit = Qnil;
7467
7468 /* Eat the event. */
7469 break;
7470 }
7471
7472 p->npending++;
7473 #if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
7474 if (interrupt_input)
7475 handle_input_available_signal (sig);
7476 else
7477 #endif
7478 {
7479 /* Tell wait_reading_process_output that it needs to wake
7480 up and look around. */
7481 if (input_available_clear_time)
7482 *input_available_clear_time = make_timespec (0, 0);
7483 }
7484 break;
7485 }
7486 }
7487
7488 static void
deliver_user_signal(int sig)7489 deliver_user_signal (int sig)
7490 {
7491 deliver_process_signal (sig, handle_user_signal);
7492 }
7493
7494 static char *
find_user_signal_name(int sig)7495 find_user_signal_name (int sig)
7496 {
7497 struct user_signal_info *p;
7498
7499 for (p = user_signals; p; p = p->next)
7500 if (p->sig == sig)
7501 return p->name;
7502
7503 return NULL;
7504 }
7505
7506 static void
store_user_signal_events(void)7507 store_user_signal_events (void)
7508 {
7509 struct user_signal_info *p;
7510 struct input_event buf;
7511 bool buf_initialized = false;
7512
7513 for (p = user_signals; p; p = p->next)
7514 if (p->npending > 0)
7515 {
7516 if (! buf_initialized)
7517 {
7518 memset (&buf, 0, sizeof buf);
7519 buf.kind = USER_SIGNAL_EVENT;
7520 buf.frame_or_window = selected_frame;
7521 buf_initialized = true;
7522 }
7523
7524 do
7525 {
7526 buf.code = p->sig;
7527 kbd_buffer_store_event (&buf);
7528 p->npending--;
7529 }
7530 while (p->npending > 0);
7531 }
7532 }
7533
7534
7535 static void menu_bar_item (Lisp_Object, Lisp_Object, Lisp_Object, void *);
7536 static Lisp_Object menu_bar_one_keymap_changed_items;
7537
7538 /* These variables hold the vector under construction within
7539 menu_bar_items and its subroutines, and the current index
7540 for storing into that vector. */
7541 static Lisp_Object menu_bar_items_vector;
7542 static int menu_bar_items_index;
7543
7544
7545 static const char *separator_names[] = {
7546 "space",
7547 "no-line",
7548 "single-line",
7549 "double-line",
7550 "single-dashed-line",
7551 "double-dashed-line",
7552 "shadow-etched-in",
7553 "shadow-etched-out",
7554 "shadow-etched-in-dash",
7555 "shadow-etched-out-dash",
7556 "shadow-double-etched-in",
7557 "shadow-double-etched-out",
7558 "shadow-double-etched-in-dash",
7559 "shadow-double-etched-out-dash",
7560 0,
7561 };
7562
7563 /* Return true if LABEL specifies a separator. */
7564
7565 bool
menu_separator_name_p(const char * label)7566 menu_separator_name_p (const char *label)
7567 {
7568 if (!label)
7569 return 0;
7570 else if (strnlen (label, 4) == 4
7571 && memcmp (label, "--", 2) == 0
7572 && label[2] != '-')
7573 {
7574 int i;
7575 label += 2;
7576 for (i = 0; separator_names[i]; ++i)
7577 if (strcmp (label, separator_names[i]) == 0)
7578 return 1;
7579 }
7580 else
7581 {
7582 /* It's a separator if it contains only dashes. */
7583 while (*label == '-')
7584 ++label;
7585 return (*label == 0);
7586 }
7587
7588 return 0;
7589 }
7590
7591
7592 /* Return a vector of menu items for a menu bar, appropriate
7593 to the current buffer. Each item has three elements in the vector:
7594 KEY STRING MAPLIST.
7595
7596 OLD is an old vector we can optionally reuse, or nil. */
7597
7598 Lisp_Object
menu_bar_items(Lisp_Object old)7599 menu_bar_items (Lisp_Object old)
7600 {
7601 /* The number of keymaps we're scanning right now, and the number of
7602 keymaps we have allocated space for. */
7603 ptrdiff_t nmaps;
7604
7605 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
7606 in the current keymaps, or nil where it is not a prefix. */
7607 Lisp_Object *maps;
7608
7609 Lisp_Object mapsbuf[3];
7610 Lisp_Object def;
7611
7612 ptrdiff_t mapno;
7613 Lisp_Object oquit;
7614
7615 USE_SAFE_ALLOCA;
7616
7617 /* In order to build the menus, we need to call the keymap
7618 accessors. They all call maybe_quit. But this function is called
7619 during redisplay, during which a quit is fatal. So inhibit
7620 quitting while building the menus.
7621 We do this instead of specbind because (1) errors will clear it anyway
7622 and (2) this avoids risk of specpdl overflow. */
7623 oquit = Vinhibit_quit;
7624 Vinhibit_quit = Qt;
7625
7626 if (!NILP (old))
7627 menu_bar_items_vector = old;
7628 else
7629 menu_bar_items_vector = make_nil_vector (24);
7630 menu_bar_items_index = 0;
7631
7632 /* Build our list of keymaps.
7633 If we recognize a function key and replace its escape sequence in
7634 keybuf with its symbol, or if the sequence starts with a mouse
7635 click and we need to switch buffers, we jump back here to rebuild
7636 the initial keymaps from the current buffer. */
7637 {
7638 Lisp_Object *tmaps;
7639
7640 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7641 if (!NILP (Voverriding_local_map_menu_flag)
7642 && !NILP (Voverriding_local_map))
7643 {
7644 /* Yes, use them (if non-nil) as well as the global map. */
7645 maps = mapsbuf;
7646 nmaps = 0;
7647 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
7648 maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
7649 if (!NILP (Voverriding_local_map))
7650 maps[nmaps++] = Voverriding_local_map;
7651 }
7652 else
7653 {
7654 /* No, so use major and minor mode keymaps and keymap property.
7655 Note that menu-bar bindings in the local-map and keymap
7656 properties may not work reliable, as they are only
7657 recognized when the menu-bar (or mode-line) is updated,
7658 which does not normally happen after every command. */
7659 ptrdiff_t nminor = current_minor_maps (NULL, &tmaps);
7660 SAFE_NALLOCA (maps, 1, nminor + 4);
7661 nmaps = 0;
7662 Lisp_Object tem = KVAR (current_kboard, Voverriding_terminal_local_map);
7663 if (!NILP (tem) && !NILP (Voverriding_local_map_menu_flag))
7664 maps[nmaps++] = tem;
7665 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
7666 maps[nmaps++] = tem;
7667 if (nminor != 0)
7668 {
7669 memcpy (maps + nmaps, tmaps, nminor * sizeof (maps[0]));
7670 nmaps += nminor;
7671 }
7672 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
7673 }
7674 maps[nmaps++] = current_global_map;
7675 }
7676
7677 /* Look up in each map the dummy prefix key `menu-bar'. */
7678
7679 for (mapno = nmaps - 1; mapno >= 0; mapno--)
7680 if (!NILP (maps[mapno]))
7681 {
7682 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
7683 0, 1);
7684 if (CONSP (def))
7685 {
7686 menu_bar_one_keymap_changed_items = Qnil;
7687 map_keymap_canonical (def, menu_bar_item, Qnil, NULL);
7688 }
7689 }
7690
7691 /* Move to the end those items that should be at the end. */
7692
7693 Lisp_Object tail = Vmenu_bar_final_items;
7694 FOR_EACH_TAIL (tail)
7695 {
7696 int end = menu_bar_items_index;
7697
7698 for (int i = 0; i < end; i += 4)
7699 if (EQ (XCAR (tail), AREF (menu_bar_items_vector, i)))
7700 {
7701 Lisp_Object tem0, tem1, tem2, tem3;
7702 /* Move the item at index I to the end,
7703 shifting all the others forward. */
7704 tem0 = AREF (menu_bar_items_vector, i + 0);
7705 tem1 = AREF (menu_bar_items_vector, i + 1);
7706 tem2 = AREF (menu_bar_items_vector, i + 2);
7707 tem3 = AREF (menu_bar_items_vector, i + 3);
7708 if (end > i + 4)
7709 memmove (aref_addr (menu_bar_items_vector, i),
7710 aref_addr (menu_bar_items_vector, i + 4),
7711 (end - i - 4) * word_size);
7712 ASET (menu_bar_items_vector, end - 4, tem0);
7713 ASET (menu_bar_items_vector, end - 3, tem1);
7714 ASET (menu_bar_items_vector, end - 2, tem2);
7715 ASET (menu_bar_items_vector, end - 1, tem3);
7716 break;
7717 }
7718 }
7719
7720 /* Add nil, nil, nil, nil at the end. */
7721 {
7722 int i = menu_bar_items_index;
7723 if (i + 4 > ASIZE (menu_bar_items_vector))
7724 menu_bar_items_vector
7725 = larger_vector (menu_bar_items_vector, 4, -1);
7726 /* Add this item. */
7727 ASET (menu_bar_items_vector, i, Qnil); i++;
7728 ASET (menu_bar_items_vector, i, Qnil); i++;
7729 ASET (menu_bar_items_vector, i, Qnil); i++;
7730 ASET (menu_bar_items_vector, i, Qnil); i++;
7731 menu_bar_items_index = i;
7732 }
7733
7734 Vinhibit_quit = oquit;
7735 SAFE_FREE ();
7736 return menu_bar_items_vector;
7737 }
7738
7739 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
7740 If there's already an item for KEY, add this DEF to it. */
7741
7742 Lisp_Object item_properties;
7743
7744 static void
menu_bar_item(Lisp_Object key,Lisp_Object item,Lisp_Object dummy1,void * dummy2)7745 menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dummy2)
7746 {
7747 int i;
7748 bool parsed;
7749 Lisp_Object tem;
7750
7751 if (EQ (item, Qundefined))
7752 {
7753 /* If a map has an explicit `undefined' as definition,
7754 discard any previously made menu bar item. */
7755
7756 for (i = 0; i < menu_bar_items_index; i += 4)
7757 if (EQ (key, AREF (menu_bar_items_vector, i)))
7758 {
7759 if (menu_bar_items_index > i + 4)
7760 memmove (aref_addr (menu_bar_items_vector, i),
7761 aref_addr (menu_bar_items_vector, i + 4),
7762 (menu_bar_items_index - i - 4) * word_size);
7763 menu_bar_items_index -= 4;
7764 }
7765 }
7766
7767 /* If this keymap has already contributed to this KEY,
7768 don't contribute to it a second time. */
7769 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
7770 if (!NILP (tem) || NILP (item))
7771 return;
7772
7773 menu_bar_one_keymap_changed_items
7774 = Fcons (key, menu_bar_one_keymap_changed_items);
7775
7776 /* We add to menu_bar_one_keymap_changed_items before doing the
7777 parse_menu_item, so that if it turns out it wasn't a menu item,
7778 it still correctly hides any further menu item. */
7779 parsed = parse_menu_item (item, 1);
7780 if (!parsed)
7781 return;
7782
7783 item = AREF (item_properties, ITEM_PROPERTY_DEF);
7784
7785 /* Find any existing item for this KEY. */
7786 for (i = 0; i < menu_bar_items_index; i += 4)
7787 if (EQ (key, AREF (menu_bar_items_vector, i)))
7788 break;
7789
7790 /* If we did not find this KEY, add it at the end. */
7791 if (i == menu_bar_items_index)
7792 {
7793 /* If vector is too small, get a bigger one. */
7794 if (i + 4 > ASIZE (menu_bar_items_vector))
7795 menu_bar_items_vector = larger_vector (menu_bar_items_vector, 4, -1);
7796 /* Add this item. */
7797 ASET (menu_bar_items_vector, i, key); i++;
7798 ASET (menu_bar_items_vector, i,
7799 AREF (item_properties, ITEM_PROPERTY_NAME)); i++;
7800 ASET (menu_bar_items_vector, i, list1 (item)); i++;
7801 ASET (menu_bar_items_vector, i, make_fixnum (0)); i++;
7802 menu_bar_items_index = i;
7803 }
7804 /* We did find an item for this KEY. Add ITEM to its list of maps. */
7805 else
7806 {
7807 Lisp_Object old;
7808 old = AREF (menu_bar_items_vector, i + 2);
7809 /* If the new and the old items are not both keymaps,
7810 the lookup will only find `item'. */
7811 item = Fcons (item, KEYMAPP (item) && KEYMAPP (XCAR (old)) ? old : Qnil);
7812 ASET (menu_bar_items_vector, i + 2, item);
7813 }
7814 }
7815
7816 /* This is used as the handler when calling menu_item_eval_property. */
7817 static Lisp_Object
menu_item_eval_property_1(Lisp_Object arg)7818 menu_item_eval_property_1 (Lisp_Object arg)
7819 {
7820 /* If we got a quit from within the menu computation,
7821 quit all the way out of it. This takes care of C-] in the debugger. */
7822 if (CONSP (arg) && signal_quit_p (XCAR (arg)))
7823 quit ();
7824
7825 return Qnil;
7826 }
7827
7828 static Lisp_Object
eval_dyn(Lisp_Object form)7829 eval_dyn (Lisp_Object form)
7830 {
7831 return Feval (form, Qnil);
7832 }
7833
7834 /* Evaluate an expression and return the result (or nil if something
7835 went wrong). Used to evaluate dynamic parts of menu items. */
7836 Lisp_Object
menu_item_eval_property(Lisp_Object sexpr)7837 menu_item_eval_property (Lisp_Object sexpr)
7838 {
7839 ptrdiff_t count = SPECPDL_INDEX ();
7840 Lisp_Object val;
7841 specbind (Qinhibit_redisplay, Qt);
7842 val = internal_condition_case_1 (eval_dyn, sexpr, Qerror,
7843 menu_item_eval_property_1);
7844 return unbind_to (count, val);
7845 }
7846
7847 /* This function parses a menu item and leaves the result in the
7848 vector item_properties.
7849 ITEM is a key binding, a possible menu item.
7850 INMENUBAR is > 0 when this is considered for an entry in a menu bar
7851 top level.
7852 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
7853 parse_menu_item returns true if the item is a menu item and false
7854 otherwise. */
7855
7856 bool
parse_menu_item(Lisp_Object item,int inmenubar)7857 parse_menu_item (Lisp_Object item, int inmenubar)
7858 {
7859 Lisp_Object def, tem, item_string, start;
7860 Lisp_Object filter;
7861 Lisp_Object keyhint;
7862 int i;
7863
7864 filter = Qnil;
7865 keyhint = Qnil;
7866
7867 if (!CONSP (item))
7868 return 0;
7869
7870 /* Create item_properties vector if necessary. */
7871 if (NILP (item_properties))
7872 item_properties = make_nil_vector (ITEM_PROPERTY_ENABLE + 1);
7873
7874 /* Initialize optional entries. */
7875 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
7876 ASET (item_properties, i, Qnil);
7877 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7878
7879 /* Save the item here to protect it from GC. */
7880 ASET (item_properties, ITEM_PROPERTY_ITEM, item);
7881
7882 item_string = XCAR (item);
7883
7884 start = item;
7885 item = XCDR (item);
7886 if (STRINGP (item_string))
7887 {
7888 /* Old format menu item. */
7889 ASET (item_properties, ITEM_PROPERTY_NAME, item_string);
7890
7891 /* Maybe help string. */
7892 if (CONSP (item) && STRINGP (XCAR (item)))
7893 {
7894 ASET (item_properties, ITEM_PROPERTY_HELP,
7895 help_echo_substitute_command_keys (XCAR (item)));
7896 start = item;
7897 item = XCDR (item);
7898 }
7899
7900 /* Maybe an obsolete key binding cache. */
7901 if (CONSP (item) && CONSP (XCAR (item))
7902 && (NILP (XCAR (XCAR (item)))
7903 || VECTORP (XCAR (XCAR (item)))))
7904 item = XCDR (item);
7905
7906 /* This is the real definition--the function to run. */
7907 ASET (item_properties, ITEM_PROPERTY_DEF, item);
7908
7909 /* Get enable property, if any. */
7910 if (SYMBOLP (item))
7911 {
7912 tem = Fget (item, Qmenu_enable);
7913 if (!NILP (Venable_disabled_menus_and_buttons))
7914 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7915 else if (!NILP (tem))
7916 ASET (item_properties, ITEM_PROPERTY_ENABLE, tem);
7917 }
7918 }
7919 else if (EQ (item_string, Qmenu_item) && CONSP (item))
7920 {
7921 /* New format menu item. */
7922 ASET (item_properties, ITEM_PROPERTY_NAME, XCAR (item));
7923 start = XCDR (item);
7924 if (CONSP (start))
7925 {
7926 /* We have a real binding. */
7927 ASET (item_properties, ITEM_PROPERTY_DEF, XCAR (start));
7928
7929 item = XCDR (start);
7930 /* Is there an obsolete cache list with key equivalences. */
7931 if (CONSP (item) && CONSP (XCAR (item)))
7932 item = XCDR (item);
7933
7934 /* Parse properties. */
7935 FOR_EACH_TAIL (item)
7936 {
7937 tem = XCAR (item);
7938 item = XCDR (item);
7939 if (!CONSP (item))
7940 break;
7941
7942 if (EQ (tem, QCenable))
7943 {
7944 if (!NILP (Venable_disabled_menus_and_buttons))
7945 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7946 else
7947 ASET (item_properties, ITEM_PROPERTY_ENABLE, XCAR (item));
7948 }
7949 else if (EQ (tem, QCvisible))
7950 {
7951 /* If got a visible property and that evaluates to nil
7952 then ignore this item. */
7953 tem = menu_item_eval_property (XCAR (item));
7954 if (NILP (tem))
7955 return 0;
7956 }
7957 else if (EQ (tem, QChelp))
7958 {
7959 Lisp_Object help = XCAR (item);
7960 if (STRINGP (help))
7961 help = help_echo_substitute_command_keys (help);
7962 ASET (item_properties, ITEM_PROPERTY_HELP, help);
7963 }
7964 else if (EQ (tem, QCfilter))
7965 filter = item;
7966 else if (EQ (tem, QCkey_sequence))
7967 {
7968 tem = XCAR (item);
7969 if (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem))
7970 /* Be GC protected. Set keyhint to item instead of tem. */
7971 keyhint = item;
7972 }
7973 else if (EQ (tem, QCkeys))
7974 {
7975 tem = XCAR (item);
7976 if (FUNCTIONP (tem))
7977 ASET (item_properties, ITEM_PROPERTY_KEYEQ, call0 (tem));
7978 else if (CONSP (tem) || STRINGP (tem))
7979 ASET (item_properties, ITEM_PROPERTY_KEYEQ, tem);
7980 }
7981 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
7982 {
7983 Lisp_Object type;
7984 tem = XCAR (item);
7985 type = XCAR (tem);
7986 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7987 {
7988 ASET (item_properties, ITEM_PROPERTY_SELECTED,
7989 XCDR (tem));
7990 ASET (item_properties, ITEM_PROPERTY_TYPE, type);
7991 }
7992 }
7993 }
7994 }
7995 else if (inmenubar || !NILP (start))
7996 return 0;
7997 }
7998 else
7999 return 0; /* not a menu item */
8000
8001 /* If item string is not a string, evaluate it to get string.
8002 If we don't get a string, skip this item. */
8003 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
8004 if (!(STRINGP (item_string)))
8005 {
8006 item_string = menu_item_eval_property (item_string);
8007 if (!STRINGP (item_string))
8008 return 0;
8009 ASET (item_properties, ITEM_PROPERTY_NAME, item_string);
8010 }
8011
8012 /* If got a filter apply it on definition. */
8013 def = AREF (item_properties, ITEM_PROPERTY_DEF);
8014 if (!NILP (filter))
8015 {
8016 def = menu_item_eval_property (list2 (XCAR (filter),
8017 list2 (Qquote, def)));
8018
8019 ASET (item_properties, ITEM_PROPERTY_DEF, def);
8020 }
8021
8022 /* Enable or disable selection of item. */
8023 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
8024 if (!EQ (tem, Qt))
8025 {
8026 tem = menu_item_eval_property (tem);
8027 if (inmenubar && NILP (tem))
8028 return 0; /* Ignore disabled items in menu bar. */
8029 ASET (item_properties, ITEM_PROPERTY_ENABLE, tem);
8030 }
8031
8032 /* If we got no definition, this item is just unselectable text which
8033 is OK in a submenu but not in the menubar. */
8034 if (NILP (def))
8035 return (!inmenubar);
8036
8037 /* See if this is a separate pane or a submenu. */
8038 def = AREF (item_properties, ITEM_PROPERTY_DEF);
8039 tem = get_keymap (def, 0, 1);
8040 /* For a subkeymap, just record its details and exit. */
8041 if (CONSP (tem))
8042 {
8043 ASET (item_properties, ITEM_PROPERTY_MAP, tem);
8044 ASET (item_properties, ITEM_PROPERTY_DEF, tem);
8045 return 1;
8046 }
8047
8048 /* At the top level in the menu bar, do likewise for commands also.
8049 The menu bar does not display equivalent key bindings anyway.
8050 ITEM_PROPERTY_DEF is already set up properly. */
8051 if (inmenubar > 0)
8052 return 1;
8053
8054 { /* This is a command. See if there is an equivalent key binding. */
8055 Lisp_Object keyeq = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
8056 AUTO_STRING (space_space, " ");
8057
8058 /* The previous code preferred :key-sequence to :keys, so we
8059 preserve this behavior. */
8060 if (STRINGP (keyeq) && !CONSP (keyhint))
8061 keyeq = concat2 (space_space, call1 (Qsubstitute_command_keys, keyeq));
8062 else
8063 {
8064 Lisp_Object prefix = keyeq;
8065 Lisp_Object keys = Qnil;
8066
8067 if (CONSP (prefix))
8068 {
8069 def = XCAR (prefix);
8070 prefix = XCDR (prefix);
8071 }
8072 else
8073 def = AREF (item_properties, ITEM_PROPERTY_DEF);
8074
8075 if (CONSP (keyhint) && !NILP (XCAR (keyhint)))
8076 {
8077 keys = XCAR (keyhint);
8078 tem = Fkey_binding (keys, Qnil, Qnil, Qnil);
8079
8080 /* We have a suggested key. Is it bound to the command? */
8081 if (NILP (tem)
8082 || (!EQ (tem, def)
8083 /* If the command is an alias for another
8084 (such as lmenu.el set it up), check if the
8085 original command matches the cached command. */
8086 && !(SYMBOLP (def)
8087 && EQ (tem, XSYMBOL (def)->u.s.function))))
8088 keys = Qnil;
8089 }
8090
8091 if (NILP (keys))
8092 keys = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qnil);
8093
8094 if (!NILP (keys))
8095 {
8096 tem = Fkey_description (keys, Qnil);
8097 if (CONSP (prefix))
8098 {
8099 if (STRINGP (XCAR (prefix)))
8100 tem = concat2 (XCAR (prefix), tem);
8101 if (STRINGP (XCDR (prefix)))
8102 tem = concat2 (tem, XCDR (prefix));
8103 }
8104 keyeq = concat2 (space_space, tem);
8105 }
8106 else
8107 keyeq = Qnil;
8108 }
8109
8110 /* If we have an equivalent key binding, use that. */
8111 ASET (item_properties, ITEM_PROPERTY_KEYEQ, keyeq);
8112 }
8113
8114 /* Include this when menu help is implemented.
8115 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
8116 if (!(NILP (tem) || STRINGP (tem)))
8117 {
8118 tem = menu_item_eval_property (tem);
8119 if (!STRINGP (tem))
8120 tem = Qnil;
8121 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
8122 }
8123 */
8124
8125 /* Handle radio buttons or toggle boxes. */
8126 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
8127 if (!NILP (tem))
8128 ASET (item_properties, ITEM_PROPERTY_SELECTED,
8129 menu_item_eval_property (tem));
8130
8131 return 1;
8132 }
8133
8134
8135
8136 /***********************************************************************
8137 Tab-bars
8138 ***********************************************************************/
8139
8140 /* A vector holding tab bar items while they are parsed in function
8141 tab_bar_items. Each item occupies TAB_BAR_ITEM_NSCLOTS elements
8142 in the vector. */
8143
8144 static Lisp_Object tab_bar_items_vector;
8145
8146 /* A vector holding the result of parse_tab_bar_item. Layout is like
8147 the one for a single item in tab_bar_items_vector. */
8148
8149 static Lisp_Object tab_bar_item_properties;
8150
8151 /* Next free index in tab_bar_items_vector. */
8152
8153 static int ntab_bar_items;
8154
8155 /* Function prototypes. */
8156
8157 static void init_tab_bar_items (Lisp_Object);
8158 static void process_tab_bar_item (Lisp_Object, Lisp_Object, Lisp_Object,
8159 void *);
8160 static bool parse_tab_bar_item (Lisp_Object, Lisp_Object);
8161 static void append_tab_bar_item (void);
8162
8163
8164 /* Return a vector of tab bar items for keymaps currently in effect.
8165 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
8166 tab bar items found. */
8167
8168 Lisp_Object
tab_bar_items(Lisp_Object reuse,int * nitems)8169 tab_bar_items (Lisp_Object reuse, int *nitems)
8170 {
8171 Lisp_Object *maps;
8172 Lisp_Object mapsbuf[3];
8173 ptrdiff_t nmaps, i;
8174 Lisp_Object oquit;
8175 Lisp_Object *tmaps;
8176 USE_SAFE_ALLOCA;
8177
8178 *nitems = 0;
8179
8180 /* In order to build the menus, we need to call the keymap
8181 accessors. They all call maybe_quit. But this function is called
8182 during redisplay, during which a quit is fatal. So inhibit
8183 quitting while building the menus. We do this instead of
8184 specbind because (1) errors will clear it anyway and (2) this
8185 avoids risk of specpdl overflow. */
8186 oquit = Vinhibit_quit;
8187 Vinhibit_quit = Qt;
8188
8189 /* Initialize tab_bar_items_vector and protect it from GC. */
8190 init_tab_bar_items (reuse);
8191
8192 /* Build list of keymaps in maps. Set nmaps to the number of maps
8193 to process. */
8194
8195 /* Should overriding-terminal-local-map and overriding-local-map apply? */
8196 if (!NILP (Voverriding_local_map_menu_flag)
8197 && !NILP (Voverriding_local_map))
8198 {
8199 /* Yes, use them (if non-nil) as well as the global map. */
8200 maps = mapsbuf;
8201 nmaps = 0;
8202 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
8203 maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
8204 if (!NILP (Voverriding_local_map))
8205 maps[nmaps++] = Voverriding_local_map;
8206 }
8207 else
8208 {
8209 /* No, so use major and minor mode keymaps and keymap property.
8210 Note that tab-bar bindings in the local-map and keymap
8211 properties may not work reliably, as they are only
8212 recognized when the tab-bar (or mode-line) is updated,
8213 which does not normally happen after every command. */
8214 ptrdiff_t nminor = current_minor_maps (NULL, &tmaps);
8215 SAFE_NALLOCA (maps, 1, nminor + 4);
8216 nmaps = 0;
8217 Lisp_Object tem = KVAR (current_kboard, Voverriding_terminal_local_map);
8218 if (!NILP (tem) && !NILP (Voverriding_local_map_menu_flag))
8219 maps[nmaps++] = tem;
8220 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
8221 maps[nmaps++] = tem;
8222 if (nminor != 0)
8223 {
8224 memcpy (maps + nmaps, tmaps, nminor * sizeof (maps[0]));
8225 nmaps += nminor;
8226 }
8227 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
8228 }
8229
8230 /* Add global keymap at the end. */
8231 maps[nmaps++] = current_global_map;
8232
8233 /* Process maps in reverse order and look up in each map the prefix
8234 key `tab-bar'. */
8235 for (i = nmaps - 1; i >= 0; --i)
8236 if (!NILP (maps[i]))
8237 {
8238 Lisp_Object keymap;
8239
8240 keymap = get_keymap (access_keymap (maps[i], Qtab_bar, 1, 0, 1), 0, 1);
8241 if (CONSP (keymap))
8242 map_keymap (keymap, process_tab_bar_item, Qnil, NULL, 1);
8243 }
8244
8245 Vinhibit_quit = oquit;
8246 *nitems = ntab_bar_items / TAB_BAR_ITEM_NSLOTS;
8247 SAFE_FREE ();
8248 return tab_bar_items_vector;
8249 }
8250
8251
8252 /* Process the definition of KEY which is DEF. */
8253
8254 static void
process_tab_bar_item(Lisp_Object key,Lisp_Object def,Lisp_Object data,void * args)8255 process_tab_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void *args)
8256 {
8257 int i;
8258
8259 if (EQ (def, Qundefined))
8260 {
8261 /* If a map has an explicit `undefined' as definition,
8262 discard any previously made item. */
8263 for (i = 0; i < ntab_bar_items; i += TAB_BAR_ITEM_NSLOTS)
8264 {
8265 Lisp_Object *v = XVECTOR (tab_bar_items_vector)->contents + i;
8266
8267 if (EQ (key, v[TAB_BAR_ITEM_KEY]))
8268 {
8269 if (ntab_bar_items > i + TAB_BAR_ITEM_NSLOTS)
8270 memmove (v, v + TAB_BAR_ITEM_NSLOTS,
8271 ((ntab_bar_items - i - TAB_BAR_ITEM_NSLOTS)
8272 * word_size));
8273 ntab_bar_items -= TAB_BAR_ITEM_NSLOTS;
8274 break;
8275 }
8276 }
8277 }
8278 else if (parse_tab_bar_item (key, def))
8279 /* Append a new tab bar item to tab_bar_items_vector. Accept
8280 more than one definition for the same key. */
8281 append_tab_bar_item ();
8282 }
8283
8284 /* Access slot with index IDX of vector tab_bar_item_properties. */
8285 #define PROP(IDX) AREF (tab_bar_item_properties, (IDX))
8286 static void
set_prop_tab_bar(ptrdiff_t idx,Lisp_Object val)8287 set_prop_tab_bar (ptrdiff_t idx, Lisp_Object val)
8288 {
8289 ASET (tab_bar_item_properties, idx, val);
8290 }
8291
8292
8293 /* Parse a tab bar item specification ITEM for key KEY and return the
8294 result in tab_bar_item_properties. Value is false if ITEM is
8295 invalid.
8296
8297 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
8298
8299 CAPTION is the caption of the item, If it's not a string, it is
8300 evaluated to get a string.
8301
8302 BINDING is the tab bar item's binding. Tab-bar items with keymaps
8303 as binding are currently ignored.
8304
8305 The following properties are recognized:
8306
8307 - `:enable FORM'.
8308
8309 FORM is evaluated and specifies whether the tab bar item is
8310 enabled or disabled.
8311
8312 - `:visible FORM'
8313
8314 FORM is evaluated and specifies whether the tab bar item is visible.
8315
8316 - `:filter FUNCTION'
8317
8318 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
8319 result is stored as the new binding.
8320
8321 - `:button (TYPE SELECTED)'
8322
8323 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
8324 and specifies whether the button is selected (pressed) or not.
8325
8326 - `:image IMAGES'
8327
8328 IMAGES is either a single image specification or a vector of four
8329 image specifications. See enum tab_bar_item_images.
8330
8331 - `:help HELP-STRING'.
8332
8333 Gives a help string to display for the tab bar item.
8334
8335 - `:label LABEL-STRING'.
8336
8337 A text label to show with the tab bar button if labels are enabled. */
8338
8339 static bool
parse_tab_bar_item(Lisp_Object key,Lisp_Object item)8340 parse_tab_bar_item (Lisp_Object key, Lisp_Object item)
8341 {
8342 Lisp_Object filter = Qnil;
8343 Lisp_Object caption;
8344 int i;
8345
8346 /* Definition looks like `(menu-item CAPTION BINDING PROPS...)'.
8347 Rule out items that aren't lists, don't start with
8348 `menu-item' or whose rest following `tab-bar-item' is not a
8349 list. */
8350 if (!CONSP (item))
8351 return 0;
8352
8353 /* As an exception, allow old-style menu separators. */
8354 if (STRINGP (XCAR (item)))
8355 item = list1 (XCAR (item));
8356 else if (!EQ (XCAR (item), Qmenu_item)
8357 || (item = XCDR (item), !CONSP (item)))
8358 return 0;
8359
8360 /* Create tab_bar_item_properties vector if necessary. Reset it to
8361 defaults. */
8362 if (VECTORP (tab_bar_item_properties))
8363 {
8364 for (i = 0; i < TAB_BAR_ITEM_NSLOTS; ++i)
8365 set_prop_tab_bar (i, Qnil);
8366 }
8367 else
8368 tab_bar_item_properties = make_nil_vector (TAB_BAR_ITEM_NSLOTS);
8369
8370 /* Set defaults. */
8371 set_prop_tab_bar (TAB_BAR_ITEM_KEY, key);
8372 set_prop_tab_bar (TAB_BAR_ITEM_ENABLED_P, Qt);
8373
8374 /* Get the caption of the item. If the caption is not a string,
8375 evaluate it to get a string. If we don't get a string, skip this
8376 item. */
8377 caption = XCAR (item);
8378 if (!STRINGP (caption))
8379 {
8380 caption = menu_item_eval_property (caption);
8381 if (!STRINGP (caption))
8382 return 0;
8383 }
8384 set_prop_tab_bar (TAB_BAR_ITEM_CAPTION, caption);
8385
8386 /* If the rest following the caption is not a list, the menu item is
8387 either a separator, or invalid. */
8388 item = XCDR (item);
8389 if (!CONSP (item))
8390 {
8391 if (menu_separator_name_p (SSDATA (caption)))
8392 {
8393 set_prop_tab_bar (TAB_BAR_ITEM_ENABLED_P, Qnil);
8394 set_prop_tab_bar (TAB_BAR_ITEM_SELECTED_P, Qnil);
8395 set_prop_tab_bar (TAB_BAR_ITEM_CAPTION, Qnil);
8396 return 1;
8397 }
8398 return 0;
8399 }
8400
8401 /* Store the binding. */
8402 set_prop_tab_bar (TAB_BAR_ITEM_BINDING, XCAR (item));
8403 item = XCDR (item);
8404
8405 /* Ignore cached key binding, if any. */
8406 if (CONSP (item) && CONSP (XCAR (item)))
8407 item = XCDR (item);
8408
8409 /* Process the rest of the properties. */
8410 FOR_EACH_TAIL (item)
8411 {
8412 Lisp_Object ikey = XCAR (item);
8413 item = XCDR (item);
8414 if (!CONSP (item))
8415 break;
8416 Lisp_Object value = XCAR (item);
8417
8418 if (EQ (ikey, QCenable))
8419 {
8420 /* `:enable FORM'. */
8421 if (!NILP (Venable_disabled_menus_and_buttons))
8422 set_prop_tab_bar (TAB_BAR_ITEM_ENABLED_P, Qt);
8423 else
8424 set_prop_tab_bar (TAB_BAR_ITEM_ENABLED_P, value);
8425 }
8426 else if (EQ (ikey, QCvisible))
8427 {
8428 /* `:visible FORM'. If got a visible property and that
8429 evaluates to nil then ignore this item. */
8430 if (NILP (menu_item_eval_property (value)))
8431 return 0;
8432 }
8433 else if (EQ (ikey, QChelp))
8434 /* `:help HELP-STRING'. */
8435 set_prop_tab_bar (TAB_BAR_ITEM_HELP, value);
8436 else if (EQ (ikey, QCfilter))
8437 /* ':filter FORM'. */
8438 filter = value;
8439 else if (EQ (ikey, QCbutton) && CONSP (value))
8440 {
8441 /* `:button (TYPE . SELECTED)'. */
8442 Lisp_Object type, selected;
8443
8444 type = XCAR (value);
8445 selected = XCDR (value);
8446 if (EQ (type, QCtoggle) || EQ (type, QCradio))
8447 {
8448 set_prop_tab_bar (TAB_BAR_ITEM_SELECTED_P, selected);
8449 }
8450 }
8451 }
8452
8453 /* If got a filter apply it on binding. */
8454 if (!NILP (filter))
8455 set_prop_tab_bar (TAB_BAR_ITEM_BINDING,
8456 (menu_item_eval_property
8457 (list2 (filter,
8458 list2 (Qquote,
8459 PROP (TAB_BAR_ITEM_BINDING))))));
8460
8461 /* See if the binding is a keymap. Give up if it is. */
8462 if (CONSP (get_keymap (PROP (TAB_BAR_ITEM_BINDING), 0, 1)))
8463 return 0;
8464
8465 /* Enable or disable selection of item. */
8466 if (!EQ (PROP (TAB_BAR_ITEM_ENABLED_P), Qt))
8467 set_prop_tab_bar (TAB_BAR_ITEM_ENABLED_P,
8468 menu_item_eval_property (PROP (TAB_BAR_ITEM_ENABLED_P)));
8469
8470 /* Handle radio buttons or toggle boxes. */
8471 if (!NILP (PROP (TAB_BAR_ITEM_SELECTED_P)))
8472 set_prop_tab_bar (TAB_BAR_ITEM_SELECTED_P,
8473 menu_item_eval_property (PROP (TAB_BAR_ITEM_SELECTED_P)));
8474
8475 return 1;
8476
8477 #undef PROP
8478 }
8479
8480
8481 /* Initialize tab_bar_items_vector. REUSE, if non-nil, is a vector
8482 that can be reused. */
8483
8484 static void
init_tab_bar_items(Lisp_Object reuse)8485 init_tab_bar_items (Lisp_Object reuse)
8486 {
8487 if (VECTORP (reuse))
8488 tab_bar_items_vector = reuse;
8489 else
8490 tab_bar_items_vector = make_nil_vector (64);
8491 ntab_bar_items = 0;
8492 }
8493
8494
8495 /* Append parsed tab bar item properties from
8496 tab_bar_item_properties */
8497
8498 static void
append_tab_bar_item(void)8499 append_tab_bar_item (void)
8500 {
8501 ptrdiff_t incr
8502 = (ntab_bar_items
8503 - (ASIZE (tab_bar_items_vector) - TAB_BAR_ITEM_NSLOTS));
8504
8505 /* Enlarge tab_bar_items_vector if necessary. */
8506 if (incr > 0)
8507 tab_bar_items_vector = larger_vector (tab_bar_items_vector, incr, -1);
8508
8509 /* Append entries from tab_bar_item_properties to the end of
8510 tab_bar_items_vector. */
8511 vcopy (tab_bar_items_vector, ntab_bar_items,
8512 xvector_contents (tab_bar_item_properties), TAB_BAR_ITEM_NSLOTS);
8513 ntab_bar_items += TAB_BAR_ITEM_NSLOTS;
8514 }
8515
8516
8517
8518
8519
8520 /***********************************************************************
8521 Tool-bars
8522 ***********************************************************************/
8523
8524 /* A vector holding tool bar items while they are parsed in function
8525 tool_bar_items. Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
8526 in the vector. */
8527
8528 static Lisp_Object tool_bar_items_vector;
8529
8530 /* A vector holding the result of parse_tool_bar_item. Layout is like
8531 the one for a single item in tool_bar_items_vector. */
8532
8533 static Lisp_Object tool_bar_item_properties;
8534
8535 /* Next free index in tool_bar_items_vector. */
8536
8537 static int ntool_bar_items;
8538
8539 /* Function prototypes. */
8540
8541 static void init_tool_bar_items (Lisp_Object);
8542 static void process_tool_bar_item (Lisp_Object, Lisp_Object, Lisp_Object,
8543 void *);
8544 static bool parse_tool_bar_item (Lisp_Object, Lisp_Object);
8545 static void append_tool_bar_item (void);
8546
8547
8548 /* Return a vector of tool bar items for keymaps currently in effect.
8549 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
8550 tool bar items found. */
8551
8552 Lisp_Object
tool_bar_items(Lisp_Object reuse,int * nitems)8553 tool_bar_items (Lisp_Object reuse, int *nitems)
8554 {
8555 Lisp_Object *maps;
8556 Lisp_Object mapsbuf[3];
8557 ptrdiff_t nmaps, i;
8558 Lisp_Object oquit;
8559 Lisp_Object *tmaps;
8560 USE_SAFE_ALLOCA;
8561
8562 *nitems = 0;
8563
8564 /* In order to build the menus, we need to call the keymap
8565 accessors. They all call maybe_quit. But this function is called
8566 during redisplay, during which a quit is fatal. So inhibit
8567 quitting while building the menus. We do this instead of
8568 specbind because (1) errors will clear it anyway and (2) this
8569 avoids risk of specpdl overflow. */
8570 oquit = Vinhibit_quit;
8571 Vinhibit_quit = Qt;
8572
8573 /* Initialize tool_bar_items_vector and protect it from GC. */
8574 init_tool_bar_items (reuse);
8575
8576 /* Build list of keymaps in maps. Set nmaps to the number of maps
8577 to process. */
8578
8579 /* Should overriding-terminal-local-map and overriding-local-map apply? */
8580 if (!NILP (Voverriding_local_map_menu_flag)
8581 && !NILP (Voverriding_local_map))
8582 {
8583 /* Yes, use them (if non-nil) as well as the global map. */
8584 maps = mapsbuf;
8585 nmaps = 0;
8586 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
8587 maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
8588 if (!NILP (Voverriding_local_map))
8589 maps[nmaps++] = Voverriding_local_map;
8590 }
8591 else
8592 {
8593 /* No, so use major and minor mode keymaps and keymap property.
8594 Note that tool-bar bindings in the local-map and keymap
8595 properties may not work reliably, as they are only
8596 recognized when the tool-bar (or mode-line) is updated,
8597 which does not normally happen after every command. */
8598 ptrdiff_t nminor = current_minor_maps (NULL, &tmaps);
8599 SAFE_NALLOCA (maps, 1, nminor + 4);
8600 nmaps = 0;
8601 Lisp_Object tem = KVAR (current_kboard, Voverriding_terminal_local_map);
8602 if (!NILP (tem) && !NILP (Voverriding_local_map_menu_flag))
8603 maps[nmaps++] = tem;
8604 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
8605 maps[nmaps++] = tem;
8606 if (nminor != 0)
8607 {
8608 memcpy (maps + nmaps, tmaps, nminor * sizeof (maps[0]));
8609 nmaps += nminor;
8610 }
8611 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
8612 }
8613
8614 /* Add global keymap at the end. */
8615 maps[nmaps++] = current_global_map;
8616
8617 /* Process maps in reverse order and look up in each map the prefix
8618 key `tool-bar'. */
8619 for (i = nmaps - 1; i >= 0; --i)
8620 if (!NILP (maps[i]))
8621 {
8622 Lisp_Object keymap;
8623
8624 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
8625 if (CONSP (keymap))
8626 map_keymap (keymap, process_tool_bar_item, Qnil, NULL, 1);
8627 }
8628
8629 Vinhibit_quit = oquit;
8630 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
8631 SAFE_FREE ();
8632 return tool_bar_items_vector;
8633 }
8634
8635
8636 /* Process the definition of KEY which is DEF. */
8637
8638 static void
process_tool_bar_item(Lisp_Object key,Lisp_Object def,Lisp_Object data,void * args)8639 process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void *args)
8640 {
8641 int i;
8642
8643 if (EQ (def, Qundefined))
8644 {
8645 /* If a map has an explicit `undefined' as definition,
8646 discard any previously made item. */
8647 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
8648 {
8649 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
8650
8651 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
8652 {
8653 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
8654 memmove (v, v + TOOL_BAR_ITEM_NSLOTS,
8655 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
8656 * word_size));
8657 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
8658 break;
8659 }
8660 }
8661 }
8662 else if (parse_tool_bar_item (key, def))
8663 /* Append a new tool bar item to tool_bar_items_vector. Accept
8664 more than one definition for the same key. */
8665 append_tool_bar_item ();
8666 }
8667
8668 /* Access slot with index IDX of vector tool_bar_item_properties. */
8669 #define PROP(IDX) AREF (tool_bar_item_properties, (IDX))
8670 static void
set_prop(ptrdiff_t idx,Lisp_Object val)8671 set_prop (ptrdiff_t idx, Lisp_Object val)
8672 {
8673 ASET (tool_bar_item_properties, idx, val);
8674 }
8675
8676
8677 /* Parse a tool bar item specification ITEM for key KEY and return the
8678 result in tool_bar_item_properties. Value is false if ITEM is
8679 invalid.
8680
8681 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
8682
8683 CAPTION is the caption of the item, If it's not a string, it is
8684 evaluated to get a string.
8685
8686 BINDING is the tool bar item's binding. Tool-bar items with keymaps
8687 as binding are currently ignored.
8688
8689 The following properties are recognized:
8690
8691 - `:enable FORM'.
8692
8693 FORM is evaluated and specifies whether the tool bar item is
8694 enabled or disabled.
8695
8696 - `:visible FORM'
8697
8698 FORM is evaluated and specifies whether the tool bar item is visible.
8699
8700 - `:filter FUNCTION'
8701
8702 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
8703 result is stored as the new binding.
8704
8705 - `:button (TYPE SELECTED)'
8706
8707 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
8708 and specifies whether the button is selected (pressed) or not.
8709
8710 - `:image IMAGES'
8711
8712 IMAGES is either a single image specification or a vector of four
8713 image specifications. See enum tool_bar_item_images.
8714
8715 - `:help HELP-STRING'.
8716
8717 Gives a help string to display for the tool bar item.
8718
8719 - `:label LABEL-STRING'.
8720
8721 A text label to show with the tool bar button if labels are enabled. */
8722
8723 static bool
parse_tool_bar_item(Lisp_Object key,Lisp_Object item)8724 parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
8725 {
8726 Lisp_Object filter = Qnil;
8727 Lisp_Object caption;
8728 int i;
8729 bool have_label = false;
8730
8731 /* Definition looks like `(menu-item CAPTION BINDING PROPS...)'.
8732 Rule out items that aren't lists, don't start with
8733 `menu-item' or whose rest following `tool-bar-item' is not a
8734 list. */
8735 if (!CONSP (item))
8736 return 0;
8737
8738 /* As an exception, allow old-style menu separators. */
8739 if (STRINGP (XCAR (item)))
8740 item = list1 (XCAR (item));
8741 else if (!EQ (XCAR (item), Qmenu_item)
8742 || (item = XCDR (item), !CONSP (item)))
8743 return 0;
8744
8745 /* Create tool_bar_item_properties vector if necessary. Reset it to
8746 defaults. */
8747 if (VECTORP (tool_bar_item_properties))
8748 {
8749 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
8750 set_prop (i, Qnil);
8751 }
8752 else
8753 tool_bar_item_properties = make_nil_vector (TOOL_BAR_ITEM_NSLOTS);
8754
8755 /* Set defaults. */
8756 set_prop (TOOL_BAR_ITEM_KEY, key);
8757 set_prop (TOOL_BAR_ITEM_ENABLED_P, Qt);
8758
8759 /* Get the caption of the item. If the caption is not a string,
8760 evaluate it to get a string. If we don't get a string, skip this
8761 item. */
8762 caption = XCAR (item);
8763 if (!STRINGP (caption))
8764 {
8765 caption = menu_item_eval_property (caption);
8766 if (!STRINGP (caption))
8767 return 0;
8768 }
8769 set_prop (TOOL_BAR_ITEM_CAPTION, caption);
8770
8771 /* If the rest following the caption is not a list, the menu item is
8772 either a separator, or invalid. */
8773 item = XCDR (item);
8774 if (!CONSP (item))
8775 {
8776 if (menu_separator_name_p (SSDATA (caption)))
8777 {
8778 set_prop (TOOL_BAR_ITEM_TYPE, Qt);
8779 #ifndef HAVE_EXT_TOOL_BAR
8780 /* If we use build_desired_tool_bar_string to render the
8781 tool bar, the separator is rendered as an image. */
8782 set_prop (TOOL_BAR_ITEM_IMAGES,
8783 (menu_item_eval_property
8784 (Vtool_bar_separator_image_expression)));
8785 set_prop (TOOL_BAR_ITEM_ENABLED_P, Qnil);
8786 set_prop (TOOL_BAR_ITEM_SELECTED_P, Qnil);
8787 set_prop (TOOL_BAR_ITEM_CAPTION, Qnil);
8788 #endif
8789 return 1;
8790 }
8791 return 0;
8792 }
8793
8794 /* Store the binding. */
8795 set_prop (TOOL_BAR_ITEM_BINDING, XCAR (item));
8796 item = XCDR (item);
8797
8798 /* Ignore cached key binding, if any. */
8799 if (CONSP (item) && CONSP (XCAR (item)))
8800 item = XCDR (item);
8801
8802 /* Process the rest of the properties. */
8803 FOR_EACH_TAIL (item)
8804 {
8805 Lisp_Object ikey = XCAR (item);
8806 item = XCDR (item);
8807 if (!CONSP (item))
8808 break;
8809 Lisp_Object value = XCAR (item);
8810
8811 if (EQ (ikey, QCenable))
8812 {
8813 /* `:enable FORM'. */
8814 if (!NILP (Venable_disabled_menus_and_buttons))
8815 set_prop (TOOL_BAR_ITEM_ENABLED_P, Qt);
8816 else
8817 set_prop (TOOL_BAR_ITEM_ENABLED_P, value);
8818 }
8819 else if (EQ (ikey, QCvisible))
8820 {
8821 /* `:visible FORM'. If got a visible property and that
8822 evaluates to nil then ignore this item. */
8823 if (NILP (menu_item_eval_property (value)))
8824 return 0;
8825 }
8826 else if (EQ (ikey, QChelp))
8827 /* `:help HELP-STRING'. */
8828 set_prop (TOOL_BAR_ITEM_HELP, value);
8829 else if (EQ (ikey, QCvert_only))
8830 /* `:vert-only t/nil'. */
8831 set_prop (TOOL_BAR_ITEM_VERT_ONLY, value);
8832 else if (EQ (ikey, QClabel))
8833 {
8834 const char *bad_label = "!!?GARBLED ITEM?!!";
8835 /* `:label LABEL-STRING'. */
8836 set_prop (TOOL_BAR_ITEM_LABEL,
8837 STRINGP (value) ? value : build_string (bad_label));
8838 have_label = true;
8839 }
8840 else if (EQ (ikey, QCfilter))
8841 /* ':filter FORM'. */
8842 filter = value;
8843 else if (EQ (ikey, QCbutton) && CONSP (value))
8844 {
8845 /* `:button (TYPE . SELECTED)'. */
8846 Lisp_Object type, selected;
8847
8848 type = XCAR (value);
8849 selected = XCDR (value);
8850 if (EQ (type, QCtoggle) || EQ (type, QCradio))
8851 {
8852 set_prop (TOOL_BAR_ITEM_SELECTED_P, selected);
8853 set_prop (TOOL_BAR_ITEM_TYPE, type);
8854 }
8855 }
8856 else if (EQ (ikey, QCimage)
8857 && (CONSP (value)
8858 || (VECTORP (value) && ASIZE (value) == 4)))
8859 /* Value is either a single image specification or a vector
8860 of 4 such specifications for the different button states. */
8861 set_prop (TOOL_BAR_ITEM_IMAGES, value);
8862 else if (EQ (ikey, QCrtl))
8863 /* ':rtl STRING' */
8864 set_prop (TOOL_BAR_ITEM_RTL_IMAGE, value);
8865 }
8866
8867
8868 if (!have_label)
8869 {
8870 /* Try to make one from caption and key. */
8871 Lisp_Object tkey = PROP (TOOL_BAR_ITEM_KEY);
8872 Lisp_Object tcapt = PROP (TOOL_BAR_ITEM_CAPTION);
8873 const char *label = SYMBOLP (tkey) ? SSDATA (SYMBOL_NAME (tkey)) : "";
8874 const char *capt = STRINGP (tcapt) ? SSDATA (tcapt) : "";
8875 ptrdiff_t max_lbl_size =
8876 2 * max (0, min (tool_bar_max_label_size, STRING_BYTES_BOUND / 2)) + 1;
8877 char *buf = xmalloc (max_lbl_size);
8878 Lisp_Object new_lbl;
8879 ptrdiff_t caption_len = strnlen (capt, max_lbl_size);
8880
8881 if (0 < caption_len && caption_len < max_lbl_size)
8882 {
8883 strcpy (buf, capt);
8884 while (caption_len > 0 && buf[caption_len - 1] == '.')
8885 caption_len--;
8886 buf[caption_len] = '\0';
8887 label = capt = buf;
8888 }
8889
8890 ptrdiff_t label_len = strnlen (label, max_lbl_size);
8891 if (0 < label_len && label_len < max_lbl_size)
8892 {
8893 ptrdiff_t j;
8894 if (label != buf)
8895 strcpy (buf, label);
8896
8897 for (j = 0; buf[j] != '\0'; ++j)
8898 if (buf[j] == '-')
8899 buf[j] = ' ';
8900 label = buf;
8901 }
8902 else
8903 label = "";
8904
8905 new_lbl = Fupcase_initials (build_string (label));
8906 if (SCHARS (new_lbl) <= tool_bar_max_label_size)
8907 set_prop (TOOL_BAR_ITEM_LABEL, new_lbl);
8908 else
8909 set_prop (TOOL_BAR_ITEM_LABEL, empty_unibyte_string);
8910 xfree (buf);
8911 }
8912
8913 /* If got a filter apply it on binding. */
8914 if (!NILP (filter))
8915 set_prop (TOOL_BAR_ITEM_BINDING,
8916 (menu_item_eval_property
8917 (list2 (filter,
8918 list2 (Qquote,
8919 PROP (TOOL_BAR_ITEM_BINDING))))));
8920
8921 /* See if the binding is a keymap. Give up if it is. */
8922 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
8923 return 0;
8924
8925 /* If there is a key binding, add it to the help, which will be
8926 displayed as a tooltip for this entry. */
8927 Lisp_Object binding = PROP (TOOL_BAR_ITEM_BINDING);
8928 Lisp_Object keys = Fwhere_is_internal (binding, Qnil, Qt, Qnil, Qnil);
8929 if (!NILP (keys))
8930 {
8931 AUTO_STRING (beg, " (");
8932 AUTO_STRING (end, ")");
8933 Lisp_Object orig = PROP (TOOL_BAR_ITEM_HELP);
8934 Lisp_Object desc = Fkey_description (keys, Qnil);
8935
8936 if (NILP (orig))
8937 orig = PROP (TOOL_BAR_ITEM_CAPTION);
8938
8939 set_prop (TOOL_BAR_ITEM_HELP, CALLN (Fconcat, orig, beg, desc, end));
8940 }
8941
8942 /* Enable or disable selection of item. */
8943 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
8944 set_prop (TOOL_BAR_ITEM_ENABLED_P,
8945 menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P)));
8946
8947 /* Handle radio buttons or toggle boxes. */
8948 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
8949 set_prop (TOOL_BAR_ITEM_SELECTED_P,
8950 menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P)));
8951
8952 return 1;
8953
8954 #undef PROP
8955 }
8956
8957
8958 /* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
8959 that can be reused. */
8960
8961 static void
init_tool_bar_items(Lisp_Object reuse)8962 init_tool_bar_items (Lisp_Object reuse)
8963 {
8964 if (VECTORP (reuse))
8965 tool_bar_items_vector = reuse;
8966 else
8967 tool_bar_items_vector = make_nil_vector (64);
8968 ntool_bar_items = 0;
8969 }
8970
8971
8972 /* Append parsed tool bar item properties from
8973 tool_bar_item_properties */
8974
8975 static void
append_tool_bar_item(void)8976 append_tool_bar_item (void)
8977 {
8978 ptrdiff_t incr
8979 = (ntool_bar_items
8980 - (ASIZE (tool_bar_items_vector) - TOOL_BAR_ITEM_NSLOTS));
8981
8982 /* Enlarge tool_bar_items_vector if necessary. */
8983 if (incr > 0)
8984 tool_bar_items_vector = larger_vector (tool_bar_items_vector, incr, -1);
8985
8986 /* Append entries from tool_bar_item_properties to the end of
8987 tool_bar_items_vector. */
8988 vcopy (tool_bar_items_vector, ntool_bar_items,
8989 xvector_contents (tool_bar_item_properties), TOOL_BAR_ITEM_NSLOTS);
8990 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
8991 }
8992
8993
8994
8995
8996
8997 /* Read a character using menus based on the keymap MAP.
8998 Return nil if there are no menus in the maps.
8999 Return t if we displayed a menu but the user rejected it.
9000
9001 PREV_EVENT is the previous input event, or nil if we are reading
9002 the first event of a key sequence.
9003
9004 If USED_MOUSE_MENU is non-null, set *USED_MOUSE_MENU to true
9005 if we used a mouse menu to read the input, or false otherwise. If
9006 USED_MOUSE_MENU is null, don't dereference it.
9007
9008 The prompting is done based on the prompt-string of the map
9009 and the strings associated with various map elements.
9010
9011 This can be done with X menus or with menus put in the minibuf.
9012 These are done in different ways, depending on how the input will be read.
9013 Menus using X are done after auto-saving in read-char, getting the input
9014 event from Fx_popup_menu; menus using the minibuf use read_char recursively
9015 and do auto-saving in the inner call of read_char. */
9016
9017 static Lisp_Object
read_char_x_menu_prompt(Lisp_Object map,Lisp_Object prev_event,bool * used_mouse_menu)9018 read_char_x_menu_prompt (Lisp_Object map,
9019 Lisp_Object prev_event, bool *used_mouse_menu)
9020 {
9021 if (used_mouse_menu)
9022 *used_mouse_menu = false;
9023
9024 /* Use local over global Menu maps. */
9025
9026 if (! menu_prompting)
9027 return Qnil;
9028
9029 /* If we got to this point via a mouse click,
9030 use a real menu for mouse selection. */
9031 if (EVENT_HAS_PARAMETERS (prev_event)
9032 && !EQ (XCAR (prev_event), Qmenu_bar)
9033 && !EQ (XCAR (prev_event), Qtab_bar)
9034 && !EQ (XCAR (prev_event), Qtool_bar))
9035 {
9036 /* Display the menu and get the selection. */
9037 Lisp_Object value;
9038
9039 value = x_popup_menu_1 (prev_event, get_keymap (map, 0, 1));
9040 if (CONSP (value))
9041 {
9042 Lisp_Object tem;
9043
9044 record_menu_key (XCAR (value));
9045
9046 /* If we got multiple events, unread all but
9047 the first.
9048 There is no way to prevent those unread events
9049 from showing up later in last_nonmenu_event.
9050 So turn symbol and integer events into lists,
9051 to indicate that they came from a mouse menu,
9052 so that when present in last_nonmenu_event
9053 they won't confuse things. */
9054 for (tem = XCDR (value); CONSP (tem); tem = XCDR (tem))
9055 {
9056 record_menu_key (XCAR (tem));
9057 if (SYMBOLP (XCAR (tem))
9058 || FIXNUMP (XCAR (tem)))
9059 XSETCAR (tem, Fcons (XCAR (tem), Qdisabled));
9060 }
9061
9062 /* If we got more than one event, put all but the first
9063 onto this list to be read later.
9064 Return just the first event now. */
9065 Vunread_command_events
9066 = nconc2 (XCDR (value), Vunread_command_events);
9067 value = XCAR (value);
9068 }
9069 else if (NILP (value))
9070 value = Qt;
9071 if (used_mouse_menu)
9072 *used_mouse_menu = true;
9073 return value;
9074 }
9075 return Qnil ;
9076 }
9077
9078 static Lisp_Object
read_char_minibuf_menu_prompt(int commandflag,Lisp_Object map)9079 read_char_minibuf_menu_prompt (int commandflag,
9080 Lisp_Object map)
9081 {
9082 Lisp_Object name;
9083 ptrdiff_t nlength;
9084 /* FIXME: Use the minibuffer's frame width. */
9085 ptrdiff_t width = FRAME_COLS (SELECTED_FRAME ()) - 4;
9086 ptrdiff_t idx = -1;
9087 bool nobindings = true;
9088 Lisp_Object rest, vector;
9089 Lisp_Object prompt_strings = Qnil;
9090
9091 vector = Qnil;
9092
9093 if (! menu_prompting)
9094 return Qnil;
9095
9096 map = get_keymap (map, 0, 1);
9097 name = Fkeymap_prompt (map);
9098
9099 /* If we don't have any menus, just read a character normally. */
9100 if (!STRINGP (name))
9101 return Qnil;
9102
9103 #define PUSH_C_STR(str, listvar) \
9104 listvar = Fcons (build_unibyte_string (str), listvar)
9105
9106 /* Prompt string always starts with map's prompt, and a space. */
9107 prompt_strings = Fcons (name, prompt_strings);
9108 PUSH_C_STR (": ", prompt_strings);
9109 nlength = SCHARS (name) + 2;
9110
9111 rest = map;
9112
9113 /* Present the documented bindings, a line at a time. */
9114 while (1)
9115 {
9116 bool notfirst = false;
9117 Lisp_Object menu_strings = prompt_strings;
9118 ptrdiff_t i = nlength;
9119 Lisp_Object obj;
9120 Lisp_Object orig_defn_macro;
9121
9122 /* Loop over elements of map. */
9123 while (i < width)
9124 {
9125 Lisp_Object elt;
9126
9127 /* FIXME: Use map_keymap to handle new keymap formats. */
9128
9129 /* At end of map, wrap around if just starting,
9130 or end this line if already have something on it. */
9131 if (NILP (rest))
9132 {
9133 if (notfirst || nobindings)
9134 break;
9135 else
9136 rest = map;
9137 }
9138
9139 /* Look at the next element of the map. */
9140 if (idx >= 0)
9141 elt = AREF (vector, idx);
9142 else
9143 elt = Fcar_safe (rest);
9144
9145 if (idx < 0 && VECTORP (elt))
9146 {
9147 /* If we found a dense table in the keymap,
9148 advanced past it, but start scanning its contents. */
9149 rest = Fcdr_safe (rest);
9150 vector = elt;
9151 idx = 0;
9152 }
9153 else
9154 {
9155 /* An ordinary element. */
9156 Lisp_Object event, tem;
9157
9158 if (idx < 0)
9159 {
9160 event = Fcar_safe (elt); /* alist */
9161 elt = Fcdr_safe (elt);
9162 }
9163 else
9164 {
9165 XSETINT (event, idx); /* vector */
9166 }
9167
9168 /* Ignore the element if it has no prompt string. */
9169 if (FIXNUMP (event) && parse_menu_item (elt, -1))
9170 {
9171 /* True if the char to type matches the string. */
9172 bool char_matches;
9173 Lisp_Object upcased_event, downcased_event;
9174 Lisp_Object desc = Qnil;
9175 Lisp_Object s
9176 = AREF (item_properties, ITEM_PROPERTY_NAME);
9177
9178 upcased_event = Fupcase (event);
9179 downcased_event = Fdowncase (event);
9180 char_matches = (XFIXNUM (upcased_event) == SREF (s, 0)
9181 || XFIXNUM (downcased_event) == SREF (s, 0));
9182 if (! char_matches)
9183 desc = Fsingle_key_description (event, Qnil);
9184
9185 #if 0 /* It is redundant to list the equivalent key bindings because
9186 the prefix is what the user has already typed. */
9187 tem
9188 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
9189 if (!NILP (tem))
9190 /* Insert equivalent keybinding. */
9191 s = concat2 (s, tem);
9192 #endif
9193 tem
9194 = AREF (item_properties, ITEM_PROPERTY_TYPE);
9195 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
9196 {
9197 /* Insert button prefix. */
9198 Lisp_Object selected
9199 = AREF (item_properties, ITEM_PROPERTY_SELECTED);
9200 AUTO_STRING (radio_yes, "(*) ");
9201 AUTO_STRING (radio_no , "( ) ");
9202 AUTO_STRING (check_yes, "[X] ");
9203 AUTO_STRING (check_no , "[ ] ");
9204 if (EQ (tem, QCradio))
9205 tem = NILP (selected) ? radio_yes : radio_no;
9206 else
9207 tem = NILP (selected) ? check_yes : check_no;
9208 s = concat2 (tem, s);
9209 }
9210
9211
9212 /* If we have room for the prompt string, add it to this line.
9213 If this is the first on the line, always add it. */
9214 if ((SCHARS (s) + i + 2
9215 + (char_matches ? 0 : SCHARS (desc) + 3))
9216 < width
9217 || !notfirst)
9218 {
9219 ptrdiff_t thiswidth;
9220
9221 /* Punctuate between strings. */
9222 if (notfirst)
9223 {
9224 PUSH_C_STR (", ", menu_strings);
9225 i += 2;
9226 }
9227 notfirst = true;
9228 nobindings = false;
9229
9230 /* If the char to type doesn't match the string's
9231 first char, explicitly show what char to type. */
9232 if (! char_matches)
9233 {
9234 /* Add as much of string as fits. */
9235 thiswidth = min (SCHARS (desc), width - i);
9236 menu_strings
9237 = Fcons (Fsubstring (desc, make_fixnum (0),
9238 make_fixnum (thiswidth)),
9239 menu_strings);
9240 i += thiswidth;
9241 PUSH_C_STR (" = ", menu_strings);
9242 i += 3;
9243 }
9244
9245 /* Add as much of string as fits. */
9246 thiswidth = min (SCHARS (s), width - i);
9247 menu_strings
9248 = Fcons (Fsubstring (s, make_fixnum (0),
9249 make_fixnum (thiswidth)),
9250 menu_strings);
9251 i += thiswidth;
9252 }
9253 else
9254 {
9255 /* If this element does not fit, end the line now,
9256 and save the element for the next line. */
9257 PUSH_C_STR ("...", menu_strings);
9258 break;
9259 }
9260 }
9261
9262 /* Move past this element. */
9263 if (idx >= 0 && idx + 1 >= ASIZE (vector))
9264 /* Handle reaching end of dense table. */
9265 idx = -1;
9266 if (idx >= 0)
9267 idx++;
9268 else
9269 rest = Fcdr_safe (rest);
9270 }
9271 }
9272
9273 /* Prompt with that and read response. */
9274 message3_nolog (apply1 (intern ("concat"), Fnreverse (menu_strings)));
9275
9276 /* Make believe it's not a keyboard macro in case the help char
9277 is pressed. Help characters are not recorded because menu prompting
9278 is not used on replay. */
9279 orig_defn_macro = KVAR (current_kboard, defining_kbd_macro);
9280 kset_defining_kbd_macro (current_kboard, Qnil);
9281 do
9282 obj = read_char (commandflag, Qnil, Qt, 0, NULL);
9283 while (BUFFERP (obj));
9284 kset_defining_kbd_macro (current_kboard, orig_defn_macro);
9285
9286 if (!FIXNUMP (obj) || XFIXNUM (obj) == -2
9287 || (! EQ (obj, menu_prompt_more_char)
9288 && (!FIXNUMP (menu_prompt_more_char)
9289 || ! EQ (obj, make_fixnum (Ctl (XFIXNUM (menu_prompt_more_char)))))))
9290 {
9291 if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
9292 store_kbd_macro_char (obj);
9293 return obj;
9294 }
9295 /* Help char - go round again. */
9296 }
9297 }
9298
9299 /* Reading key sequences. */
9300
9301 static Lisp_Object
follow_key(Lisp_Object keymap,Lisp_Object key)9302 follow_key (Lisp_Object keymap, Lisp_Object key)
9303 {
9304 return access_keymap (get_keymap (keymap, 0, 1),
9305 key, 1, 0, 1);
9306 }
9307
9308 static Lisp_Object
active_maps(Lisp_Object first_event,Lisp_Object second_event)9309 active_maps (Lisp_Object first_event, Lisp_Object second_event)
9310 {
9311 Lisp_Object position
9312 = EVENT_HAS_PARAMETERS (first_event) ? EVENT_START (first_event) : Qnil;
9313 /* The position of a click can be in the second event if the first event
9314 is a fake_prefixed_key like `header-line` or `mode-line`. */
9315 if (SYMBOLP (first_event)
9316 && EVENT_HAS_PARAMETERS (second_event)
9317 && EQ (first_event, POSN_POSN (EVENT_START (second_event))))
9318 {
9319 eassert (NILP (position));
9320 position = EVENT_START (second_event);
9321 }
9322 return Fcons (Qkeymap, Fcurrent_active_maps (Qt, position));
9323 }
9324
9325 /* Structure used to keep track of partial application of key remapping
9326 such as Vfunction_key_map and Vkey_translation_map. */
9327 typedef struct keyremap
9328 {
9329 /* This is the map originally specified for this use. */
9330 Lisp_Object parent;
9331 /* This is a submap reached by looking up, in PARENT,
9332 the events from START to END. */
9333 Lisp_Object map;
9334 /* Positions [START, END) in the key sequence buffer
9335 are the key that we have scanned so far.
9336 Those events are the ones that we will replace
9337 if PARENT maps them into a key sequence. */
9338 int start, end;
9339 } keyremap;
9340
9341 /* Lookup KEY in MAP.
9342 MAP is a keymap mapping keys to key vectors or functions.
9343 If the mapping is a function and DO_FUNCALL is true,
9344 the function is called with PROMPT as parameter and its return
9345 value is used as the return value of this function (after checking
9346 that it is indeed a vector). */
9347
9348 static Lisp_Object
access_keymap_keyremap(Lisp_Object map,Lisp_Object key,Lisp_Object prompt,bool do_funcall)9349 access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
9350 bool do_funcall)
9351 {
9352 Lisp_Object next;
9353
9354 next = access_keymap (map, key, 1, 0, 1);
9355
9356 /* Handle a symbol whose function definition is a keymap
9357 or an array. */
9358 if (SYMBOLP (next) && !NILP (Ffboundp (next))
9359 && (ARRAYP (XSYMBOL (next)->u.s.function)
9360 || KEYMAPP (XSYMBOL (next)->u.s.function)))
9361 next = Fautoload_do_load (XSYMBOL (next)->u.s.function, next, Qnil);
9362
9363 /* If the keymap gives a function, not an
9364 array, then call the function with one arg and use
9365 its value instead. */
9366 if (do_funcall && FUNCTIONP (next))
9367 {
9368 Lisp_Object tem;
9369 tem = next;
9370
9371 next = call1 (next, prompt);
9372 /* If the function returned something invalid,
9373 barf--don't ignore it. */
9374 if (! (NILP (next) || VECTORP (next) || STRINGP (next)))
9375 signal_error ("Function returns invalid key sequence", tem);
9376 }
9377 return next;
9378 }
9379
9380 /* Do one step of the key remapping used for function-key-map and
9381 key-translation-map:
9382 KEYBUF is the READ_KEY_ELTS-size buffer holding the input events.
9383 FKEY is a pointer to the keyremap structure to use.
9384 INPUT is the index of the last element in KEYBUF.
9385 DOIT if true says that the remapping can actually take place.
9386 DIFF is used to return the number of keys added/removed by the remapping.
9387 PARENT is the root of the keymap.
9388 PROMPT is the prompt to use if the remapping happens through a function.
9389 Return true if the remapping actually took place. */
9390
9391 static bool
keyremap_step(Lisp_Object * keybuf,volatile keyremap * fkey,int input,bool doit,int * diff,Lisp_Object prompt)9392 keyremap_step (Lisp_Object *keybuf, volatile keyremap *fkey,
9393 int input, bool doit, int *diff, Lisp_Object prompt)
9394 {
9395 Lisp_Object next, key;
9396
9397 key = keybuf[fkey->end++];
9398
9399 if (KEYMAPP (fkey->parent))
9400 next = access_keymap_keyremap (fkey->map, key, prompt, doit);
9401 else
9402 next = Qnil;
9403
9404 /* If keybuf[fkey->start..fkey->end] is bound in the
9405 map and we're in a position to do the key remapping, replace it with
9406 the binding and restart with fkey->start at the end. */
9407 if ((VECTORP (next) || STRINGP (next)) && doit)
9408 {
9409 int len = XFIXNAT (Flength (next));
9410 int i;
9411
9412 *diff = len - (fkey->end - fkey->start);
9413
9414 if (READ_KEY_ELTS - input <= *diff)
9415 error ("Key sequence too long");
9416
9417 /* Shift the keys that follow fkey->end. */
9418 if (*diff < 0)
9419 for (i = fkey->end; i < input; i++)
9420 keybuf[i + *diff] = keybuf[i];
9421 else if (*diff > 0)
9422 for (i = input - 1; i >= fkey->end; i--)
9423 keybuf[i + *diff] = keybuf[i];
9424 /* Overwrite the old keys with the new ones. */
9425 for (i = 0; i < len; i++)
9426 keybuf[fkey->start + i]
9427 = Faref (next, make_fixnum (i));
9428
9429 fkey->start = fkey->end += *diff;
9430 fkey->map = fkey->parent;
9431
9432 return 1;
9433 }
9434
9435 fkey->map = get_keymap (next, 0, 1);
9436
9437 /* If we no longer have a bound suffix, try a new position for
9438 fkey->start. */
9439 if (!CONSP (fkey->map))
9440 {
9441 fkey->end = ++fkey->start;
9442 fkey->map = fkey->parent;
9443 }
9444 return 0;
9445 }
9446
9447 static bool
test_undefined(Lisp_Object binding)9448 test_undefined (Lisp_Object binding)
9449 {
9450 return (NILP (binding)
9451 || EQ (binding, Qundefined)
9452 || (SYMBOLP (binding)
9453 && EQ (Fcommand_remapping (binding, Qnil, Qnil), Qundefined)));
9454 }
9455
init_raw_keybuf_count(void)9456 void init_raw_keybuf_count (void)
9457 {
9458 raw_keybuf_count = 0;
9459 }
9460
9461 /* Read a sequence of keys that ends with a non prefix character,
9462 storing it in KEYBUF, a buffer of size READ_KEY_ELTS.
9463 Prompt with PROMPT.
9464 Return the length of the key sequence stored.
9465 Return -1 if the user rejected a command menu.
9466
9467 Echo starting immediately unless `prompt' is 0.
9468
9469 If PREVENT_REDISPLAY is non-zero, avoid redisplay by calling
9470 read_char with a suitable COMMANDFLAG argument.
9471
9472 Where a key sequence ends depends on the currently active keymaps.
9473 These include any minor mode keymaps active in the current buffer,
9474 the current buffer's local map, and the global map.
9475
9476 If a key sequence has no other bindings, we check Vfunction_key_map
9477 to see if some trailing subsequence might be the beginning of a
9478 function key's sequence. If so, we try to read the whole function
9479 key, and substitute its symbolic name into the key sequence.
9480
9481 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
9482 `double-' events into similar click events, if that would make them
9483 bound. We try to turn `triple-' events first into `double-' events,
9484 then into clicks.
9485
9486 If we get a mouse click in a mode line, vertical divider, or other
9487 non-text area, we treat the click as if it were prefixed by the
9488 symbol denoting that area - `mode-line', `vertical-line', or
9489 whatever.
9490
9491 If the sequence starts with a mouse click, we read the key sequence
9492 with respect to the buffer clicked on, not the current buffer.
9493
9494 If the user switches frames in the midst of a key sequence, we put
9495 off the switch-frame event until later; the next call to
9496 read_char will return it.
9497
9498 If FIX_CURRENT_BUFFER, we restore current_buffer
9499 from the selected window's buffer. */
9500
9501 static int
read_key_sequence(Lisp_Object * keybuf,Lisp_Object prompt,bool dont_downcase_last,bool can_return_switch_frame,bool fix_current_buffer,bool prevent_redisplay)9502 read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt,
9503 bool dont_downcase_last, bool can_return_switch_frame,
9504 bool fix_current_buffer, bool prevent_redisplay)
9505 {
9506 ptrdiff_t count = SPECPDL_INDEX ();
9507
9508 /* How many keys there are in the current key sequence. */
9509 int t;
9510
9511 /* The length of the echo buffer when we started reading, and
9512 the length of this_command_keys when we started reading. */
9513 ptrdiff_t echo_start UNINIT;
9514 ptrdiff_t keys_start;
9515
9516 Lisp_Object current_binding = Qnil;
9517
9518 /* Index of the first key that has no binding.
9519 It is useless to try fkey.start larger than that. */
9520 int first_unbound;
9521
9522 /* If t < mock_input, then KEYBUF[t] should be read as the next
9523 input key.
9524
9525 We use this to recover after recognizing a function key. Once we
9526 realize that a suffix of the current key sequence is actually a
9527 function key's escape sequence, we replace the suffix with the
9528 function key's binding from Vfunction_key_map. Now keybuf
9529 contains a new and different key sequence, so the echo area,
9530 this_command_keys, and the submaps and defs arrays are wrong. In
9531 this situation, we set mock_input to t, set t to 0, and jump to
9532 restart_sequence; the loop will read keys from keybuf up until
9533 mock_input, thus rebuilding the state; and then it will resume
9534 reading characters from the keyboard. */
9535 int mock_input = 0;
9536
9537 /* Whether each event in the mocked input came from a mouse menu. */
9538 bool used_mouse_menu_history[READ_KEY_ELTS] = {0};
9539
9540 /* If the sequence is unbound in submaps[], then
9541 keybuf[fkey.start..fkey.end-1] is a prefix in Vfunction_key_map,
9542 and fkey.map is its binding.
9543
9544 These might be > t, indicating that all function key scanning
9545 should hold off until t reaches them. We do this when we've just
9546 recognized a function key, to avoid searching for the function
9547 key's again in Vfunction_key_map. */
9548 keyremap fkey;
9549
9550 /* Likewise, for key_translation_map and input-decode-map. */
9551 keyremap keytran, indec;
9552
9553 /* True if we are trying to map a key by changing an upper-case
9554 letter to lower case, or a shifted function key to an unshifted
9555 one. */
9556 bool shift_translated = false;
9557
9558 /* If we receive a `switch-frame' or `select-window' event in the middle of
9559 a key sequence, we put it off for later.
9560 While we're reading, we keep the event here. */
9561 Lisp_Object delayed_switch_frame;
9562
9563 Lisp_Object original_uppercase UNINIT;
9564 int original_uppercase_position = -1;
9565
9566 /* Gets around Microsoft compiler limitations. */
9567 bool dummyflag = false;
9568
9569 struct buffer *starting_buffer;
9570
9571 /* List of events for which a fake prefix key has been generated. */
9572 Lisp_Object fake_prefixed_keys = Qnil;
9573
9574 /* raw_keybuf_count is now initialized in (most of) the callers of
9575 read_key_sequence. This is so that in a recursive call (for
9576 mouse menus) a spurious initialization doesn't erase the contents
9577 of raw_keybuf created by the outer call. */
9578 /* raw_keybuf_count = 0; */
9579
9580 delayed_switch_frame = Qnil;
9581
9582 if (INTERACTIVE)
9583 {
9584 if (!NILP (prompt))
9585 {
9586 /* Install the string PROMPT as the beginning of the string
9587 of echoing, so that it serves as a prompt for the next
9588 character. */
9589 kset_echo_prompt (current_kboard, prompt);
9590 /* FIXME: This use of echo_now doesn't look quite right and is ugly
9591 since it forces us to fiddle with current_kboard->immediate_echo
9592 before and after. */
9593 current_kboard->immediate_echo = false;
9594 echo_now ();
9595 if (!echo_keystrokes_p ())
9596 current_kboard->immediate_echo = false;
9597 }
9598 else if (cursor_in_echo_area /* FIXME: Not sure why we test this here,
9599 maybe we should just drop this test. */
9600 && echo_keystrokes_p ())
9601 /* This doesn't put in a dash if the echo buffer is empty, so
9602 you don't always see a dash hanging out in the minibuffer. */
9603 echo_dash ();
9604 }
9605
9606 /* Record the initial state of the echo area and this_command_keys;
9607 we will need to restore them if we replay a key sequence. */
9608 if (INTERACTIVE)
9609 echo_start = echo_length ();
9610 keys_start = this_command_key_count;
9611 this_single_command_key_start = keys_start;
9612
9613 /* We jump here when we need to reinitialize fkey and keytran; this
9614 happens if we switch keyboards between rescans. */
9615 replay_entire_sequence:
9616
9617 indec.map = indec.parent = KVAR (current_kboard, Vinput_decode_map);
9618 fkey.map = fkey.parent = KVAR (current_kboard, Vlocal_function_key_map);
9619 keytran.map = keytran.parent = Vkey_translation_map;
9620 indec.start = indec.end = 0;
9621 fkey.start = fkey.end = 0;
9622 keytran.start = keytran.end = 0;
9623
9624 /* We jump here when the key sequence has been thoroughly changed, and
9625 we need to rescan it starting from the beginning. When we jump here,
9626 keybuf[0..mock_input] holds the sequence we should reread. */
9627 replay_sequence:
9628
9629 starting_buffer = current_buffer;
9630 first_unbound = READ_KEY_ELTS + 1;
9631 Lisp_Object first_event = mock_input > 0 ? keybuf[0] : Qnil;
9632 Lisp_Object second_event = mock_input > 1 ? keybuf[1] : Qnil;
9633
9634 /* Build our list of keymaps.
9635 If we recognize a function key and replace its escape sequence in
9636 keybuf with its symbol, or if the sequence starts with a mouse
9637 click and we need to switch buffers, we jump back here to rebuild
9638 the initial keymaps from the current buffer. */
9639 current_binding = active_maps (first_event, second_event);
9640
9641 /* Start from the beginning in keybuf. */
9642 t = 0;
9643 last_nonmenu_event = Qnil;
9644
9645 /* These are no-ops the first time through, but if we restart, they
9646 revert the echo area and this_command_keys to their original state. */
9647 this_command_key_count = keys_start;
9648 if (INTERACTIVE && t < mock_input)
9649 echo_truncate (echo_start);
9650
9651 /* If the best binding for the current key sequence is a keymap, or
9652 we may be looking at a function key's escape sequence, keep on
9653 reading. */
9654 while (!NILP (current_binding)
9655 /* Keep reading as long as there's a prefix binding. */
9656 ? KEYMAPP (current_binding)
9657 /* Don't return in the middle of a possible function key sequence,
9658 if the only bindings we found were via case conversion.
9659 Thus, if ESC O a has a function-key-map translation
9660 and ESC o has a binding, don't return after ESC O,
9661 so that we can translate ESC O plus the next character. */
9662 : (/* indec.start < t || fkey.start < t || */ keytran.start < t))
9663 {
9664 Lisp_Object key;
9665 bool used_mouse_menu = false;
9666
9667 /* Where the last real key started. If we need to throw away a
9668 key that has expanded into more than one element of keybuf
9669 (say, a mouse click on the mode line which is being treated
9670 as [mode-line (mouse-...)], then we backtrack to this point
9671 of keybuf. */
9672 int last_real_key_start;
9673
9674 /* These variables are analogous to echo_start and keys_start;
9675 while those allow us to restart the entire key sequence,
9676 echo_local_start and keys_local_start allow us to throw away
9677 just one key. */
9678 ptrdiff_t echo_local_start UNINIT;
9679 int keys_local_start;
9680 Lisp_Object new_binding;
9681
9682 eassert (indec.end == t || (indec.end > t && indec.end <= mock_input));
9683 eassert (indec.start <= indec.end);
9684 eassert (fkey.start <= fkey.end);
9685 eassert (keytran.start <= keytran.end);
9686 /* key-translation-map is applied *after* function-key-map
9687 which is itself applied *after* input-decode-map. */
9688 eassert (fkey.end <= indec.start);
9689 eassert (keytran.end <= fkey.start);
9690
9691 if (/* first_unbound < indec.start && first_unbound < fkey.start && */
9692 first_unbound < keytran.start)
9693 { /* The prefix upto first_unbound has no binding and has
9694 no translation left to do either, so we know it's unbound.
9695 If we don't stop now, we risk staying here indefinitely
9696 (if the user keeps entering fkey or keytran prefixes
9697 like C-c ESC ESC ESC ESC ...) */
9698 int i;
9699 for (i = first_unbound + 1; i < t; i++)
9700 keybuf[i - first_unbound - 1] = keybuf[i];
9701 mock_input = t - first_unbound - 1;
9702 indec.end = indec.start -= first_unbound + 1;
9703 indec.map = indec.parent;
9704 fkey.end = fkey.start -= first_unbound + 1;
9705 fkey.map = fkey.parent;
9706 keytran.end = keytran.start -= first_unbound + 1;
9707 keytran.map = keytran.parent;
9708 goto replay_sequence;
9709 }
9710
9711 if (t >= READ_KEY_ELTS)
9712 error ("Key sequence too long");
9713
9714 if (INTERACTIVE)
9715 echo_local_start = echo_length ();
9716 keys_local_start = this_command_key_count;
9717
9718 replay_key:
9719 /* These are no-ops, unless we throw away a keystroke below and
9720 jumped back up to replay_key; in that case, these restore the
9721 variables to their original state, allowing us to replay the
9722 loop. */
9723 if (INTERACTIVE && t < mock_input)
9724 echo_truncate (echo_local_start);
9725 this_command_key_count = keys_local_start;
9726
9727 /* By default, assume each event is "real". */
9728 last_real_key_start = t;
9729
9730 /* Does mock_input indicate that we are re-reading a key sequence? */
9731 if (t < mock_input)
9732 {
9733 key = keybuf[t];
9734 add_command_key (key);
9735 if (current_kboard->immediate_echo)
9736 {
9737 /* Set immediate_echo to false so as to force echo_now to
9738 redisplay (it will set immediate_echo right back to true). */
9739 current_kboard->immediate_echo = false;
9740 echo_now ();
9741 }
9742 used_mouse_menu = used_mouse_menu_history[t];
9743 }
9744
9745 /* If not, we should actually read a character. */
9746 else
9747 {
9748 {
9749 KBOARD *interrupted_kboard = current_kboard;
9750 struct frame *interrupted_frame = SELECTED_FRAME ();
9751 /* Calling read_char with COMMANDFLAG = -2 avoids
9752 redisplay in read_char and its subroutines. */
9753 key = read_char (prevent_redisplay ? -2 : NILP (prompt),
9754 current_binding, last_nonmenu_event,
9755 &used_mouse_menu, NULL);
9756 used_mouse_menu_history[t] = used_mouse_menu;
9757 if ((FIXNUMP (key) && XFIXNUM (key) == -2) /* wrong_kboard_jmpbuf */
9758 /* When switching to a new tty (with a new keyboard),
9759 read_char returns the new buffer, rather than -2
9760 (Bug#5095). This is because `terminal-init-xterm'
9761 calls read-char, which eats the wrong_kboard_jmpbuf
9762 return. Any better way to fix this? -- cyd */
9763 || (interrupted_kboard != current_kboard))
9764 {
9765 bool found = false;
9766 struct kboard *k;
9767
9768 for (k = all_kboards; k; k = k->next_kboard)
9769 if (k == interrupted_kboard)
9770 found = true;
9771
9772 if (!found)
9773 {
9774 /* Don't touch interrupted_kboard when it's been
9775 deleted. */
9776 delayed_switch_frame = Qnil;
9777 goto replay_entire_sequence;
9778 }
9779
9780 if (!NILP (delayed_switch_frame))
9781 {
9782 kset_kbd_queue
9783 (interrupted_kboard,
9784 Fcons (delayed_switch_frame,
9785 KVAR (interrupted_kboard, kbd_queue)));
9786 delayed_switch_frame = Qnil;
9787 }
9788
9789 while (t > 0)
9790 kset_kbd_queue
9791 (interrupted_kboard,
9792 Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue)));
9793
9794 /* If the side queue is non-empty, ensure it begins with a
9795 switch-frame, so we'll replay it in the right context. */
9796 if (CONSP (KVAR (interrupted_kboard, kbd_queue))
9797 && (key = XCAR (KVAR (interrupted_kboard, kbd_queue)),
9798 !(EVENT_HAS_PARAMETERS (key)
9799 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
9800 Qswitch_frame))))
9801 {
9802 Lisp_Object frame;
9803 XSETFRAME (frame, interrupted_frame);
9804 kset_kbd_queue
9805 (interrupted_kboard,
9806 Fcons (make_lispy_switch_frame (frame),
9807 KVAR (interrupted_kboard, kbd_queue)));
9808 mock_input = 0;
9809 }
9810 else
9811 {
9812 if (FIXNUMP (key) && XFIXNUM (key) != -2)
9813 {
9814 /* If interrupted while initializing terminal, we
9815 need to replay the interrupting key. See
9816 Bug#5095 and Bug#37782. */
9817 mock_input = 1;
9818 keybuf[0] = key;
9819 }
9820 else
9821 {
9822 mock_input = 0;
9823 }
9824 }
9825 goto replay_entire_sequence;
9826 }
9827 }
9828
9829 /* read_char returns t when it shows a menu and the user rejects it.
9830 Just return -1. */
9831 if (EQ (key, Qt))
9832 {
9833 unbind_to (count, Qnil);
9834 return -1;
9835 }
9836
9837 /* read_char returns -1 at the end of a macro.
9838 Emacs 18 handles this by returning immediately with a
9839 zero, so that's what we'll do. */
9840 if (FIXNUMP (key) && XFIXNUM (key) == -1)
9841 {
9842 t = 0;
9843 /* The Microsoft C compiler can't handle the goto that
9844 would go here. */
9845 dummyflag = true;
9846 break;
9847 }
9848
9849 /* If the current buffer has been changed from under us, the
9850 keymap may have changed, so replay the sequence. */
9851 if (BUFFERP (key))
9852 {
9853 timer_resume_idle ();
9854
9855 mock_input = t;
9856 /* Reset the current buffer from the selected window
9857 in case something changed the former and not the latter.
9858 This is to be more consistent with the behavior
9859 of the command_loop_1. */
9860 if (fix_current_buffer)
9861 {
9862 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
9863 Fkill_emacs (Qnil);
9864 if (XBUFFER (XWINDOW (selected_window)->contents)
9865 != current_buffer)
9866 Fset_buffer (XWINDOW (selected_window)->contents);
9867 }
9868
9869 goto replay_sequence;
9870 }
9871
9872 /* If we have a quit that was typed in another frame, and
9873 quit_throw_to_read_char switched buffers,
9874 replay to get the right keymap. */
9875 if (FIXNUMP (key)
9876 && XFIXNUM (key) == quit_char
9877 && current_buffer != starting_buffer)
9878 {
9879 GROW_RAW_KEYBUF;
9880 ASET (raw_keybuf, raw_keybuf_count, key);
9881 raw_keybuf_count++;
9882 keybuf[t++] = key;
9883 mock_input = t;
9884 Vquit_flag = Qnil;
9885 goto replay_sequence;
9886 }
9887
9888 Vquit_flag = Qnil;
9889
9890 if (EVENT_HAS_PARAMETERS (key)
9891 /* Either a `switch-frame' or a `select-window' event. */
9892 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
9893 {
9894 /* If we're at the beginning of a key sequence, and the caller
9895 says it's okay, go ahead and return this event. If we're
9896 in the midst of a key sequence, delay it until the end. */
9897 if (t > 0 || !can_return_switch_frame)
9898 {
9899 delayed_switch_frame = key;
9900 goto replay_key;
9901 }
9902 }
9903
9904 if (NILP (first_event))
9905 {
9906 first_event = key;
9907 /* Even if first_event does not specify a particular
9908 window/position, it's important to recompute the maps here
9909 since a long time might have passed since we entered
9910 read_key_sequence, and a timer (or process-filter or
9911 special-event-map, ...) might have switched the current buffer
9912 or the selected window from under us in the mean time. */
9913 if (fix_current_buffer
9914 && (XBUFFER (XWINDOW (selected_window)->contents)
9915 != current_buffer))
9916 Fset_buffer (XWINDOW (selected_window)->contents);
9917 current_binding = active_maps (first_event, Qnil);
9918 }
9919
9920 GROW_RAW_KEYBUF;
9921 ASET (raw_keybuf, raw_keybuf_count,
9922 /* Copy the event, in case it gets modified by side-effect
9923 by some remapping function (bug#30955). */
9924 CONSP (key) ? Fcopy_sequence (key) : key);
9925 raw_keybuf_count++;
9926 }
9927
9928 /* Clicks in non-text areas get prefixed by the symbol
9929 in their CHAR-ADDRESS field. For example, a click on
9930 the mode line is prefixed by the symbol `mode-line'.
9931
9932 Furthermore, key sequences beginning with mouse clicks
9933 are read using the keymaps of the buffer clicked on, not
9934 the current buffer. So we may have to switch the buffer
9935 here.
9936
9937 When we turn one event into two events, we must make sure
9938 that neither of the two looks like the original--so that,
9939 if we replay the events, they won't be expanded again.
9940 If not for this, such reexpansion could happen either here
9941 or when user programs play with this-command-keys. */
9942 if (EVENT_HAS_PARAMETERS (key))
9943 {
9944 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
9945 if (EQ (kind, Qmouse_click))
9946 {
9947 Lisp_Object window = POSN_WINDOW (EVENT_START (key));
9948 Lisp_Object posn = POSN_POSN (EVENT_START (key));
9949
9950 if (CONSP (posn)
9951 || (!NILP (fake_prefixed_keys)
9952 && !NILP (Fmemq (key, fake_prefixed_keys))))
9953 {
9954 /* We're looking a second time at an event for which
9955 we generated a fake prefix key. Set
9956 last_real_key_start appropriately. */
9957 if (t > 0)
9958 last_real_key_start = t - 1;
9959 }
9960
9961 if (last_real_key_start == 0)
9962 {
9963 /* Key sequences beginning with mouse clicks are
9964 read using the keymaps in the buffer clicked on,
9965 not the current buffer. If we're at the
9966 beginning of a key sequence, switch buffers. */
9967 if (WINDOWP (window)
9968 && BUFFERP (XWINDOW (window)->contents)
9969 && XBUFFER (XWINDOW (window)->contents) != current_buffer)
9970 {
9971 keybuf[t] = key;
9972 mock_input = t + 1;
9973
9974 /* Arrange to go back to the original buffer once we're
9975 done reading the key sequence. Note that we can't
9976 use save_excursion_{save,restore} here, because they
9977 save point as well as the current buffer; we don't
9978 want to save point, because redisplay may change it,
9979 to accommodate a Fset_window_start or something. We
9980 don't want to do this at the top of the function,
9981 because we may get input from a subprocess which
9982 wants to change the selected window and stuff (say,
9983 emacsclient). */
9984 record_unwind_current_buffer ();
9985
9986 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
9987 Fkill_emacs (Qnil);
9988 set_buffer_internal (XBUFFER (XWINDOW (window)->contents));
9989 goto replay_sequence;
9990 }
9991 }
9992
9993 /* Expand mode-line and scroll-bar events into two events:
9994 use posn as a fake prefix key. */
9995 if (SYMBOLP (posn)
9996 && (NILP (fake_prefixed_keys)
9997 || NILP (Fmemq (key, fake_prefixed_keys))))
9998 {
9999 if (READ_KEY_ELTS - t <= 1)
10000 error ("Key sequence too long");
10001
10002 keybuf[t] = posn;
10003 keybuf[t + 1] = key;
10004 mock_input = t + 2;
10005
10006 /* Record that a fake prefix key has been generated
10007 for KEY. Don't modify the event; this would
10008 prevent proper action when the event is pushed
10009 back into unread-command-events. */
10010 fake_prefixed_keys = Fcons (key, fake_prefixed_keys);
10011 goto replay_key;
10012 }
10013 }
10014 else if (CONSP (XCDR (key))
10015 && CONSP (xevent_start (key))
10016 && CONSP (XCDR (xevent_start (key))))
10017 {
10018 Lisp_Object posn;
10019
10020 posn = POSN_POSN (xevent_start (key));
10021 /* Handle menu-bar events:
10022 insert the dummy prefix event `menu-bar'. */
10023 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtab_bar) || EQ (posn, Qtool_bar))
10024 {
10025 if (READ_KEY_ELTS - t <= 1)
10026 error ("Key sequence too long");
10027 keybuf[t] = posn;
10028 keybuf[t + 1] = key;
10029
10030 /* Zap the position in key, so we know that we've
10031 expanded it, and don't try to do so again. */
10032 POSN_SET_POSN (xevent_start (key), list1 (posn));
10033
10034 mock_input = t + 2;
10035 goto replay_sequence;
10036 }
10037 else if (CONSP (posn))
10038 {
10039 /* We're looking at the second event of a
10040 sequence which we expanded before. Set
10041 last_real_key_start appropriately. */
10042 if (last_real_key_start == t && t > 0)
10043 last_real_key_start = t - 1;
10044 }
10045 }
10046 }
10047
10048 /* We have finally decided that KEY is something we might want
10049 to look up. */
10050 new_binding = follow_key (current_binding, key);
10051
10052 /* If KEY wasn't bound, we'll try some fallbacks. */
10053 if (!NILP (new_binding))
10054 /* This is needed for the following scenario:
10055 event 0: a down-event that gets dropped by calling replay_key.
10056 event 1: some normal prefix like C-h.
10057 After event 0, first_unbound is 0, after event 1 indec.start,
10058 fkey.start, and keytran.start are all 1, so when we see that
10059 C-h is bound, we need to update first_unbound. */
10060 first_unbound = max (t + 1, first_unbound);
10061 else
10062 {
10063 Lisp_Object head;
10064
10065 /* Remember the position to put an upper bound on indec.start. */
10066 first_unbound = min (t, first_unbound);
10067
10068 head = EVENT_HEAD (key);
10069
10070 if (SYMBOLP (head))
10071 {
10072 Lisp_Object breakdown;
10073 int modifiers;
10074
10075 breakdown = parse_modifiers (head);
10076 modifiers = XFIXNUM (XCAR (XCDR (breakdown)));
10077 /* Attempt to reduce an unbound mouse event to a simpler
10078 event that is bound:
10079 Drags reduce to clicks.
10080 Double-clicks reduce to clicks.
10081 Triple-clicks reduce to double-clicks, then to clicks.
10082 Up/Down-clicks are eliminated.
10083 Double-downs reduce to downs, then are eliminated.
10084 Triple-downs reduce to double-downs, then to downs,
10085 then are eliminated. */
10086 if (modifiers & (up_modifier | down_modifier
10087 | drag_modifier
10088 | double_modifier | triple_modifier))
10089 {
10090 while (modifiers & (up_modifier | down_modifier
10091 | drag_modifier
10092 | double_modifier | triple_modifier))
10093 {
10094 Lisp_Object new_head, new_click;
10095 if (modifiers & triple_modifier)
10096 modifiers ^= (double_modifier | triple_modifier);
10097 else if (modifiers & double_modifier)
10098 modifiers &= ~double_modifier;
10099 else if (modifiers & drag_modifier)
10100 modifiers &= ~drag_modifier;
10101 else
10102 {
10103 /* Dispose of this `up/down' event by simply jumping
10104 back to replay_key, to get another event.
10105
10106 Note that if this event came from mock input,
10107 then just jumping back to replay_key will just
10108 hand it to us again. So we have to wipe out any
10109 mock input.
10110
10111 We could delete keybuf[t] and shift everything
10112 after that to the left by one spot, but we'd also
10113 have to fix up any variable that points into
10114 keybuf, and shifting isn't really necessary
10115 anyway.
10116
10117 Adding prefixes for non-textual mouse clicks
10118 creates two characters of mock input, and both
10119 must be thrown away. If we're only looking at
10120 the prefix now, we can just jump back to
10121 replay_key. On the other hand, if we've already
10122 processed the prefix, and now the actual click
10123 itself is giving us trouble, then we've lost the
10124 state of the keymaps we want to backtrack to, and
10125 we need to replay the whole sequence to rebuild
10126 it.
10127
10128 Beyond that, only function key expansion could
10129 create more than two keys, but that should never
10130 generate mouse events, so it's okay to zero
10131 mock_input in that case too.
10132
10133 FIXME: The above paragraph seems just plain
10134 wrong, if you consider things like
10135 xterm-mouse-mode. -stef
10136
10137 Isn't this just the most wonderful code ever? */
10138
10139 /* If mock_input > t + 1, the above simplification
10140 will actually end up dropping keys on the floor.
10141 This is probably OK for now, but even
10142 if mock_input <= t + 1, we need to adjust indec,
10143 fkey, and keytran.
10144 Typical case [header-line down-mouse-N]:
10145 mock_input = 2, t = 1, fkey.end = 1,
10146 last_real_key_start = 0. */
10147 if (indec.end > last_real_key_start)
10148 {
10149 indec.end = indec.start
10150 = min (last_real_key_start, indec.start);
10151 indec.map = indec.parent;
10152 if (fkey.end > last_real_key_start)
10153 {
10154 fkey.end = fkey.start
10155 = min (last_real_key_start, fkey.start);
10156 fkey.map = fkey.parent;
10157 if (keytran.end > last_real_key_start)
10158 {
10159 keytran.end = keytran.start
10160 = min (last_real_key_start, keytran.start);
10161 keytran.map = keytran.parent;
10162 }
10163 }
10164 }
10165 if (t == last_real_key_start)
10166 {
10167 mock_input = 0;
10168 goto replay_key;
10169 }
10170 else
10171 {
10172 mock_input = last_real_key_start;
10173 goto replay_sequence;
10174 }
10175 }
10176
10177 new_head
10178 = apply_modifiers (modifiers, XCAR (breakdown));
10179 new_click = list2 (new_head, EVENT_START (key));
10180
10181 /* Look for a binding for this new key. */
10182 new_binding = follow_key (current_binding, new_click);
10183
10184 /* If that click is bound, go for it. */
10185 if (!NILP (new_binding))
10186 {
10187 current_binding = new_binding;
10188 key = new_click;
10189 break;
10190 }
10191 /* Otherwise, we'll leave key set to the drag event. */
10192 }
10193 }
10194 }
10195 }
10196 current_binding = new_binding;
10197
10198 keybuf[t++] = key;
10199 /* Normally, last_nonmenu_event gets the previous key we read.
10200 But when a mouse popup menu is being used,
10201 we don't update last_nonmenu_event; it continues to hold the mouse
10202 event that preceded the first level of menu. */
10203 if (!used_mouse_menu)
10204 last_nonmenu_event = key;
10205
10206 /* Record what part of this_command_keys is the current key sequence. */
10207 this_single_command_key_start = this_command_key_count - t;
10208 /* When 'input-method-function' called above causes events to be
10209 put on 'unread-post-input-method-events', and as result
10210 'reread' is set to 'true', the value of 't' can become larger
10211 than 'this_command_key_count', because 'add_command_key' is
10212 not called to update 'this_command_key_count'. If this
10213 happens, 'this_single_command_key_start' will become negative
10214 above, and any call to 'this-single-command-keys' will return
10215 a garbled vector. See bug #20223 for one such situation.
10216 Here we force 'this_single_command_key_start' to never become
10217 negative, to avoid that. */
10218 if (this_single_command_key_start < 0)
10219 this_single_command_key_start = 0;
10220
10221 /* Look for this sequence in input-decode-map.
10222 Scan from indec.end until we find a bound suffix. */
10223 while (indec.end < t)
10224 {
10225 bool done;
10226 int diff;
10227
10228 done = keyremap_step (keybuf, &indec, max (t, mock_input),
10229 true, &diff, prompt);
10230 if (done)
10231 {
10232 mock_input = diff + max (t, mock_input);
10233 goto replay_sequence;
10234 }
10235 }
10236
10237 if (!KEYMAPP (current_binding)
10238 && !test_undefined (current_binding)
10239 && indec.start >= t)
10240 /* There is a binding and it's not a prefix.
10241 (and it doesn't have any input-decode-map translation pending).
10242 There is thus no function-key in this sequence.
10243 Moving fkey.start is important in this case to allow keytran.start
10244 to go over the sequence before we return (since we keep the
10245 invariant that keytran.end <= fkey.start). */
10246 {
10247 if (fkey.start < t)
10248 (fkey.start = fkey.end = t, fkey.map = fkey.parent);
10249 }
10250 else
10251 /* If the sequence is unbound, see if we can hang a function key
10252 off the end of it. */
10253 /* Continue scan from fkey.end until we find a bound suffix. */
10254 while (fkey.end < indec.start)
10255 {
10256 bool done;
10257 int diff;
10258
10259 done = keyremap_step (keybuf, &fkey,
10260 max (t, mock_input),
10261 /* If there's a binding (i.e.
10262 first_binding >= nmaps) we don't want
10263 to apply this function-key-mapping. */
10264 (fkey.end + 1 == t
10265 && test_undefined (current_binding)),
10266 &diff, prompt);
10267 if (done)
10268 {
10269 mock_input = diff + max (t, mock_input);
10270 /* Adjust the input-decode-map counters. */
10271 indec.end += diff;
10272 indec.start += diff;
10273
10274 goto replay_sequence;
10275 }
10276 }
10277
10278 /* Look for this sequence in key-translation-map.
10279 Scan from keytran.end until we find a bound suffix. */
10280 while (keytran.end < fkey.start)
10281 {
10282 bool done;
10283 int diff;
10284
10285 done = keyremap_step (keybuf, &keytran, max (t, mock_input),
10286 true, &diff, prompt);
10287 if (done)
10288 {
10289 mock_input = diff + max (t, mock_input);
10290 /* Adjust the function-key-map and input-decode-map counters. */
10291 indec.end += diff;
10292 indec.start += diff;
10293 fkey.end += diff;
10294 fkey.start += diff;
10295
10296 goto replay_sequence;
10297 }
10298 }
10299
10300 /* If KEY is not defined in any of the keymaps,
10301 and cannot be part of a function key or translation,
10302 and is an upper case letter
10303 use the corresponding lower-case letter instead. */
10304 if (NILP (current_binding)
10305 && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t
10306 && FIXNUMP (key)
10307 && translate_upper_case_key_bindings)
10308 {
10309 Lisp_Object new_key;
10310 EMACS_INT k = XFIXNUM (key);
10311
10312 if (k & shift_modifier)
10313 XSETINT (new_key, k & ~shift_modifier);
10314 else if (CHARACTERP (make_fixnum (k & ~CHAR_MODIFIER_MASK)))
10315 {
10316 int dc = downcase (k & ~CHAR_MODIFIER_MASK);
10317 if (dc == (k & ~CHAR_MODIFIER_MASK))
10318 goto not_upcase;
10319 XSETINT (new_key, dc | (k & CHAR_MODIFIER_MASK));
10320 }
10321 else
10322 goto not_upcase;
10323
10324 original_uppercase = key;
10325 original_uppercase_position = t - 1;
10326
10327 /* We have to do this unconditionally, regardless of whether
10328 the lower-case char is defined in the keymaps, because they
10329 might get translated through function-key-map. */
10330 keybuf[t - 1] = new_key;
10331 mock_input = max (t, mock_input);
10332 shift_translated = true;
10333
10334 goto replay_sequence;
10335 }
10336
10337 not_upcase:
10338 if (NILP (current_binding)
10339 && help_char_p (EVENT_HEAD (key)) && t > 1)
10340 {
10341 read_key_sequence_cmd = Vprefix_help_command;
10342 /* The Microsoft C compiler can't handle the goto that
10343 would go here. */
10344 dummyflag = true;
10345 break;
10346 }
10347
10348 /* If KEY is not defined in any of the keymaps,
10349 and cannot be part of a function key or translation,
10350 and is a shifted function key,
10351 use the corresponding unshifted function key instead. */
10352 if (NILP (current_binding)
10353 && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t)
10354 {
10355 Lisp_Object breakdown = parse_modifiers (key);
10356 int modifiers
10357 = CONSP (breakdown) ? (XFIXNUM (XCAR (XCDR (breakdown)))) : 0;
10358
10359 if (translate_upper_case_key_bindings
10360 && (modifiers & shift_modifier
10361 /* Treat uppercase keys as shifted. */
10362 || (FIXNUMP (key)
10363 && (KEY_TO_CHAR (key)
10364 < XCHAR_TABLE (BVAR (current_buffer,
10365 downcase_table))->header.size)
10366 && uppercasep (KEY_TO_CHAR (key)))))
10367 {
10368 Lisp_Object new_key
10369 = (modifiers & shift_modifier
10370 ? apply_modifiers (modifiers & ~shift_modifier,
10371 XCAR (breakdown))
10372 : make_fixnum (downcase (KEY_TO_CHAR (key)) | modifiers));
10373
10374 original_uppercase = key;
10375 original_uppercase_position = t - 1;
10376
10377 /* We have to do this unconditionally, regardless of whether
10378 the lower-case char is defined in the keymaps, because they
10379 might get translated through function-key-map. */
10380 keybuf[t - 1] = new_key;
10381 mock_input = max (t, mock_input);
10382 /* Reset fkey (and consequently keytran) to apply
10383 function-key-map on the result, so that S-backspace is
10384 correctly mapped to DEL (via backspace). OTOH,
10385 input-decode-map doesn't need to go through it again. */
10386 fkey.start = fkey.end = 0;
10387 keytran.start = keytran.end = 0;
10388 shift_translated = true;
10389
10390 goto replay_sequence;
10391 }
10392 }
10393 }
10394 if (!dummyflag)
10395 read_key_sequence_cmd = current_binding;
10396 read_key_sequence_remapped
10397 /* Remap command through active keymaps.
10398 Do the remapping here, before the unbind_to so it uses the keymaps
10399 of the appropriate buffer. */
10400 = SYMBOLP (read_key_sequence_cmd)
10401 ? Fcommand_remapping (read_key_sequence_cmd, Qnil, Qnil)
10402 : Qnil;
10403
10404 unread_switch_frame = delayed_switch_frame;
10405 unbind_to (count, Qnil);
10406
10407 /* Don't downcase the last character if the caller says don't.
10408 Don't downcase it if the result is undefined, either. */
10409 if ((dont_downcase_last || NILP (current_binding))
10410 && t > 0
10411 && t - 1 == original_uppercase_position)
10412 {
10413 keybuf[t - 1] = original_uppercase;
10414 shift_translated = false;
10415 }
10416
10417 if (shift_translated)
10418 Vthis_command_keys_shift_translated = Qt;
10419
10420 /* Occasionally we fabricate events, perhaps by expanding something
10421 according to function-key-map, or by adding a prefix symbol to a
10422 mouse click in the scroll bar or modeline. In this cases, return
10423 the entire generated key sequence, even if we hit an unbound
10424 prefix or a definition before the end. This means that you will
10425 be able to push back the event properly, and also means that
10426 read-key-sequence will always return a logical unit.
10427
10428 Better ideas? */
10429 for (; t < mock_input; t++)
10430 add_command_key (keybuf[t]);
10431 echo_update ();
10432
10433 return t;
10434 }
10435
10436 static Lisp_Object
read_key_sequence_vs(Lisp_Object prompt,Lisp_Object continue_echo,Lisp_Object dont_downcase_last,Lisp_Object can_return_switch_frame,Lisp_Object cmd_loop,bool allow_string)10437 read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
10438 Lisp_Object dont_downcase_last,
10439 Lisp_Object can_return_switch_frame,
10440 Lisp_Object cmd_loop, bool allow_string)
10441 {
10442 ptrdiff_t count = SPECPDL_INDEX ();
10443
10444 if (!NILP (prompt))
10445 CHECK_STRING (prompt);
10446 maybe_quit ();
10447
10448 specbind (Qinput_method_exit_on_first_char,
10449 (NILP (cmd_loop) ? Qt : Qnil));
10450 specbind (Qinput_method_use_echo_area,
10451 (NILP (cmd_loop) ? Qt : Qnil));
10452
10453 if (NILP (continue_echo))
10454 {
10455 this_command_key_count = 0;
10456 this_single_command_key_start = 0;
10457 }
10458
10459 #ifdef HAVE_WINDOW_SYSTEM
10460 if (display_hourglass_p)
10461 cancel_hourglass ();
10462 #endif
10463
10464 raw_keybuf_count = 0;
10465 Lisp_Object keybuf[READ_KEY_ELTS];
10466 int i = read_key_sequence (keybuf, prompt, ! NILP (dont_downcase_last),
10467 ! NILP (can_return_switch_frame), false, false);
10468
10469 #if 0 /* The following is fine for code reading a key sequence and
10470 then proceeding with a lengthy computation, but it's not good
10471 for code reading keys in a loop, like an input method. */
10472 #ifdef HAVE_WINDOW_SYSTEM
10473 if (display_hourglass_p)
10474 start_hourglass ();
10475 #endif
10476 #endif
10477
10478 if (i == -1)
10479 {
10480 Vquit_flag = Qt;
10481 maybe_quit ();
10482 }
10483
10484 return unbind_to (count,
10485 ((allow_string ? make_event_array : Fvector)
10486 (i, keybuf)));
10487 }
10488
10489 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
10490 doc: /* Read a sequence of keystrokes and return as a string or vector.
10491 The sequence is sufficient to specify a non-prefix command in the
10492 current local and global maps.
10493
10494 First arg PROMPT is a prompt string. If nil, do not prompt specially.
10495 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos
10496 as a continuation of the previous key.
10497
10498 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
10499 convert the last event to lower case. (Normally any upper case event
10500 is converted to lower case if the original event is undefined and the lower
10501 case equivalent is defined.) A non-nil value is appropriate for reading
10502 a key sequence to be defined.
10503
10504 A C-g typed while in this function is treated like any other character,
10505 and `quit-flag' is not set.
10506
10507 If the key sequence starts with a mouse click, then the sequence is read
10508 using the keymaps of the buffer of the window clicked in, not the buffer
10509 of the selected window as normal.
10510
10511 `read-key-sequence' drops unbound button-down events, since you normally
10512 only care about the click or drag events which follow them. If a drag
10513 or multi-click event is unbound, but the corresponding click event would
10514 be bound, `read-key-sequence' turns the event into a click event at the
10515 drag's starting position. This means that you don't have to distinguish
10516 between click and drag, double, or triple events unless you want to.
10517
10518 `read-key-sequence' prefixes mouse events on mode lines, the vertical
10519 lines separating windows, and scroll bars with imaginary keys
10520 `mode-line', `vertical-line', and `vertical-scroll-bar'.
10521
10522 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this
10523 function will process a switch-frame event if the user switches frames
10524 before typing anything. If the user switches frames in the middle of a
10525 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME
10526 is nil, then the event will be put off until after the current key sequence.
10527
10528 `read-key-sequence' checks `function-key-map' for function key
10529 sequences, where they wouldn't conflict with ordinary bindings. See
10530 `function-key-map' for more details.
10531
10532 The optional fifth argument CMD-LOOP, if non-nil, means
10533 that this key sequence is being read by something that will
10534 read commands one after another. It should be nil if the caller
10535 will read just one key sequence. */)
10536 (Lisp_Object prompt, Lisp_Object continue_echo, Lisp_Object dont_downcase_last, Lisp_Object can_return_switch_frame, Lisp_Object cmd_loop)
10537 {
10538 return read_key_sequence_vs (prompt, continue_echo, dont_downcase_last,
10539 can_return_switch_frame, cmd_loop, true);
10540 }
10541
10542 DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
10543 Sread_key_sequence_vector, 1, 5, 0,
10544 doc: /* Like `read-key-sequence' but always return a vector. */)
10545 (Lisp_Object prompt, Lisp_Object continue_echo, Lisp_Object dont_downcase_last, Lisp_Object can_return_switch_frame, Lisp_Object cmd_loop)
10546 {
10547 return read_key_sequence_vs (prompt, continue_echo, dont_downcase_last,
10548 can_return_switch_frame, cmd_loop, false);
10549 }
10550
10551 /* Return true if input events are pending. */
10552
10553 bool
detect_input_pending(void)10554 detect_input_pending (void)
10555 {
10556 return input_pending || get_input_pending (0);
10557 }
10558
10559 /* Return true if input events other than mouse movements are
10560 pending. */
10561
10562 bool
detect_input_pending_ignore_squeezables(void)10563 detect_input_pending_ignore_squeezables (void)
10564 {
10565 return input_pending || get_input_pending (READABLE_EVENTS_IGNORE_SQUEEZABLES);
10566 }
10567
10568 /* Return true if input events are pending, and run any pending timers. */
10569
10570 bool
detect_input_pending_run_timers(bool do_display)10571 detect_input_pending_run_timers (bool do_display)
10572 {
10573 unsigned old_timers_run = timers_run;
10574
10575 if (!input_pending)
10576 get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW);
10577
10578 if (old_timers_run != timers_run && do_display)
10579 redisplay_preserve_echo_area (8);
10580
10581 return input_pending;
10582 }
10583
10584 /* This is called in some cases before a possible quit.
10585 It cases the next call to detect_input_pending to recompute input_pending.
10586 So calling this function unnecessarily can't do any harm. */
10587
10588 void
clear_input_pending(void)10589 clear_input_pending (void)
10590 {
10591 input_pending = false;
10592 }
10593
10594 /* Return true if there are pending requeued events.
10595 This isn't used yet. The hope is to make wait_reading_process_output
10596 call it, and return if it runs Lisp code that unreads something.
10597 The problem is, kbd_buffer_get_event needs to be fixed to know what
10598 to do in that case. It isn't trivial. */
10599
10600 bool
requeued_events_pending_p(void)10601 requeued_events_pending_p (void)
10602 {
10603 return (CONSP (Vunread_command_events));
10604 }
10605
10606 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 1, 0,
10607 doc: /* Return t if command input is currently available with no wait.
10608 Actually, the value is nil only if we can be sure that no input is available;
10609 if there is a doubt, the value is t.
10610
10611 If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */)
10612 (Lisp_Object check_timers)
10613 {
10614 if (CONSP (Vunread_command_events)
10615 || !NILP (Vunread_post_input_method_events)
10616 || !NILP (Vunread_input_method_events))
10617 return (Qt);
10618
10619 /* Process non-user-visible events (Bug#10195). */
10620 process_special_events ();
10621
10622 return (get_input_pending ((NILP (check_timers)
10623 ? 0 : READABLE_EVENTS_DO_TIMERS_NOW)
10624 | READABLE_EVENTS_FILTER_EVENTS)
10625 ? Qt : Qnil);
10626 }
10627
10628 /* Reallocate recent_keys copying the recorded keystrokes
10629 in the right order. */
10630 static void
update_recent_keys(int new_size,int kept_keys)10631 update_recent_keys (int new_size, int kept_keys)
10632 {
10633 int osize = ASIZE (recent_keys);
10634 eassert (recent_keys_index < osize);
10635 eassert (kept_keys <= min (osize, new_size));
10636 Lisp_Object v = make_nil_vector (new_size);
10637 int i, idx;
10638 for (i = 0; i < kept_keys; ++i)
10639 {
10640 idx = recent_keys_index - kept_keys + i;
10641 while (idx < 0)
10642 idx += osize;
10643 ASET (v, i, AREF (recent_keys, idx));
10644 }
10645 recent_keys = v;
10646 total_keys = kept_keys;
10647 recent_keys_index = total_keys % new_size;
10648 lossage_limit = new_size;
10649
10650 }
10651
10652 DEFUN ("lossage-size", Flossage_size, Slossage_size, 0, 1,
10653 "(list (read-number \"Set maximum keystrokes to: \" (lossage-size)))",
10654 doc: /* Return or set the maximum number of keystrokes to save.
10655 If called with a non-nil ARG, set the limit to ARG and return it.
10656 Otherwise, return the current limit.
10657
10658 The saved keystrokes are shown by `view-lossage'. */)
10659 (Lisp_Object arg)
10660 {
10661 if (NILP(arg))
10662 return make_fixnum (lossage_limit);
10663
10664 if (!FIXNATP (arg))
10665 user_error ("Value must be a positive integer");
10666 int osize = ASIZE (recent_keys);
10667 eassert (lossage_limit == osize);
10668 int min_size = MIN_NUM_RECENT_KEYS;
10669 int new_size = XFIXNAT (arg);
10670
10671 if (new_size == osize)
10672 return make_fixnum (lossage_limit);
10673
10674 if (new_size < min_size)
10675 {
10676 AUTO_STRING (fmt, "Value must be >= %d");
10677 Fsignal (Quser_error, list1 (CALLN (Fformat, fmt, make_fixnum (min_size))));
10678 }
10679
10680 int kept_keys = new_size > osize ? total_keys : min (new_size, total_keys);
10681 update_recent_keys (new_size, kept_keys);
10682
10683 return make_fixnum (lossage_limit);
10684 }
10685
10686 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 1, 0,
10687 doc: /* Return vector of last few events, not counting those from keyboard macros.
10688 If INCLUDE-CMDS is non-nil, include the commands that were run,
10689 represented as pseudo-events of the form (nil . COMMAND). */)
10690 (Lisp_Object include_cmds)
10691 {
10692 bool cmds = !NILP (include_cmds);
10693
10694 if (!total_keys
10695 || (cmds && total_keys < lossage_limit))
10696 return Fvector (total_keys,
10697 XVECTOR (recent_keys)->contents);
10698 else
10699 {
10700 Lisp_Object es = Qnil;
10701 int i = (total_keys < lossage_limit
10702 ? 0 : recent_keys_index);
10703 eassert (recent_keys_index < lossage_limit);
10704 do
10705 {
10706 Lisp_Object e = AREF (recent_keys, i);
10707 if (cmds || !CONSP (e) || !NILP (XCAR (e)))
10708 es = Fcons (e, es);
10709 if (++i >= lossage_limit)
10710 i = 0;
10711 } while (i != recent_keys_index);
10712 es = Fnreverse (es);
10713 return Fvconcat (1, &es);
10714 }
10715 }
10716
10717 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
10718 doc: /* Return the key sequence that invoked this command.
10719 However, if the command has called `read-key-sequence', it returns
10720 the last key sequence that has been read.
10721 The value is a string or a vector.
10722
10723 See also `this-command-keys-vector'. */)
10724 (void)
10725 {
10726 return make_event_array (this_command_key_count,
10727 XVECTOR (this_command_keys)->contents);
10728 }
10729
10730 DEFUN ("set--this-command-keys", Fset__this_command_keys,
10731 Sset__this_command_keys, 1, 1, 0,
10732 doc: /* Set the vector to be returned by `this-command-keys'.
10733 The argument KEYS must be a string.
10734 Internal use only. */)
10735 (Lisp_Object keys)
10736 {
10737 CHECK_STRING (keys);
10738
10739 this_command_key_count = 0;
10740 this_single_command_key_start = 0;
10741
10742 ptrdiff_t charidx = 0, byteidx = 0;
10743 int key0 = fetch_string_char_advance (keys, &charidx, &byteidx);
10744 if (CHAR_BYTE8_P (key0))
10745 key0 = CHAR_TO_BYTE8 (key0);
10746
10747 /* Kludge alert: this makes M-x be in the form expected by
10748 novice.el. (248 is \370, a.k.a. "Meta-x".) Any better ideas? */
10749 if (key0 == 248)
10750 add_command_key (make_fixnum ('x' | meta_modifier));
10751 else
10752 add_command_key (make_fixnum (key0));
10753 for (ptrdiff_t i = 1; i < SCHARS (keys); i++)
10754 {
10755 int key_i = fetch_string_char_advance (keys, &charidx, &byteidx);
10756 if (CHAR_BYTE8_P (key_i))
10757 key_i = CHAR_TO_BYTE8 (key_i);
10758 add_command_key (make_fixnum (key_i));
10759 }
10760 return Qnil;
10761 }
10762
10763 DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
10764 doc: /* Return the key sequence that invoked this command, as a vector.
10765 However, if the command has called `read-key-sequence', it returns
10766 the last key sequence that has been read.
10767
10768 See also `this-command-keys'. */)
10769 (void)
10770 {
10771 return Fvector (this_command_key_count,
10772 XVECTOR (this_command_keys)->contents);
10773 }
10774
10775 DEFUN ("this-single-command-keys", Fthis_single_command_keys,
10776 Sthis_single_command_keys, 0, 0, 0,
10777 doc: /* Return the key sequence that invoked this command.
10778 More generally, it returns the last key sequence read, either by
10779 the command loop or by `read-key-sequence'.
10780 The value is always a vector. */)
10781 (void)
10782 {
10783 return Fvector (this_command_key_count
10784 - this_single_command_key_start,
10785 (XVECTOR (this_command_keys)->contents
10786 + this_single_command_key_start));
10787 }
10788
10789 DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
10790 Sthis_single_command_raw_keys, 0, 0, 0,
10791 doc: /* Return the raw events that were read for this command.
10792 More generally, it returns the last key sequence read, either by
10793 the command loop or by `read-key-sequence'.
10794 Unlike `this-single-command-keys', this function's value
10795 shows the events before all translations (except for input methods).
10796 The value is always a vector. */)
10797 (void)
10798 {
10799 return Fvector (raw_keybuf_count, XVECTOR (raw_keybuf)->contents);
10800 }
10801
10802 DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
10803 Sclear_this_command_keys, 0, 1, 0,
10804 doc: /* Clear out the vector that `this-command-keys' returns.
10805 Also clear the record of the last 300 input events, unless optional arg
10806 KEEP-RECORD is non-nil. */)
10807 (Lisp_Object keep_record)
10808 {
10809 int i;
10810
10811 this_command_key_count = 0;
10812
10813 if (NILP (keep_record))
10814 {
10815 for (i = 0; i < ASIZE (recent_keys); ++i)
10816 ASET (recent_keys, i, Qnil);
10817 total_keys = 0;
10818 recent_keys_index = 0;
10819 }
10820 return Qnil;
10821 }
10822
10823 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
10824 doc: /* Return the current depth in recursive edits. */)
10825 (void)
10826 {
10827 EMACS_INT sum;
10828 INT_ADD_WRAPV (command_loop_level, minibuf_level, &sum);
10829 return make_fixnum (sum);
10830 }
10831
10832 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
10833 "FOpen dribble file: ",
10834 doc: /* Start writing input events to a dribble file called FILE.
10835 Any previously open dribble file will be closed first. If FILE is
10836 nil, just close the dribble file, if any.
10837
10838 If the file is still open when Emacs exits, it will be closed then.
10839
10840 The events written to the file include keyboard and mouse input
10841 events, but not events from executing keyboard macros. The events are
10842 written to the dribble file immediately without line buffering.
10843
10844 Be aware that this records ALL characters you type!
10845 This may include sensitive information such as passwords. */)
10846 (Lisp_Object file)
10847 {
10848 if (dribble)
10849 {
10850 block_input ();
10851 fclose (dribble);
10852 unblock_input ();
10853 dribble = 0;
10854 }
10855 if (!NILP (file))
10856 {
10857 int fd;
10858 Lisp_Object encfile;
10859
10860 file = Fexpand_file_name (file, Qnil);
10861 encfile = ENCODE_FILE (file);
10862 fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
10863 if (fd < 0 && errno == EEXIST
10864 && (unlink (SSDATA (encfile)) == 0 || errno == ENOENT))
10865 fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
10866 dribble = fd < 0 ? 0 : fdopen (fd, "w");
10867 if (dribble == 0)
10868 report_file_error ("Opening dribble", file);
10869 }
10870 return Qnil;
10871 }
10872
10873 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
10874 doc: /* Discard the contents of the terminal input buffer.
10875 Also end any kbd macro being defined. */)
10876 (void)
10877 {
10878 if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
10879 {
10880 /* Discard the last command from the macro. */
10881 Fcancel_kbd_macro_events ();
10882 end_kbd_macro ();
10883 }
10884
10885 Vunread_command_events = Qnil;
10886
10887 discard_tty_input ();
10888
10889 kbd_fetch_ptr = kbd_store_ptr;
10890 input_pending = false;
10891
10892 return Qnil;
10893 }
10894
10895 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
10896 doc: /* Stop Emacs and return to superior process. You can resume later.
10897 If `cannot-suspend' is non-nil, or if the system doesn't support job
10898 control, run a subshell instead.
10899
10900 If optional arg STUFFSTRING is non-nil, its characters are stuffed
10901 to be read as terminal input by Emacs's parent, after suspension.
10902
10903 Before suspending, run the normal hook `suspend-hook'.
10904 After resumption run the normal hook `suspend-resume-hook'.
10905
10906 Some operating systems cannot stop the Emacs process and resume it later.
10907 On such systems, Emacs starts a subshell instead of suspending. */)
10908 (Lisp_Object stuffstring)
10909 {
10910 ptrdiff_t count = SPECPDL_INDEX ();
10911 int old_height, old_width;
10912 int width, height;
10913
10914 if (tty_list && tty_list->next)
10915 error ("There are other tty frames open; close them before suspending Emacs");
10916
10917 if (!NILP (stuffstring))
10918 CHECK_STRING (stuffstring);
10919
10920 run_hook (intern ("suspend-hook"));
10921
10922 get_tty_size (fileno (CURTTY ()->input), &old_width, &old_height);
10923 reset_all_sys_modes ();
10924 /* sys_suspend can get an error if it tries to fork a subshell
10925 and the system resources aren't available for that. */
10926 record_unwind_protect_void (init_all_sys_modes);
10927 stuff_buffered_input (stuffstring);
10928 if (cannot_suspend)
10929 sys_subshell ();
10930 else
10931 sys_suspend ();
10932 unbind_to (count, Qnil);
10933
10934 /* Check if terminal/window size has changed.
10935 Note that this is not useful when we are running directly
10936 with a window system; but suspend should be disabled in that case. */
10937 get_tty_size (fileno (CURTTY ()->input), &width, &height);
10938 if (width != old_width || height != old_height)
10939 change_frame_size (SELECTED_FRAME (), width, height, false, false, false);
10940
10941 run_hook (intern ("suspend-resume-hook"));
10942
10943 return Qnil;
10944 }
10945
10946 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
10947 Then in any case stuff anything Emacs has read ahead and not used. */
10948
10949 void
stuff_buffered_input(Lisp_Object stuffstring)10950 stuff_buffered_input (Lisp_Object stuffstring)
10951 {
10952 #ifdef SIGTSTP /* stuff_char is defined if SIGTSTP. */
10953 register unsigned char *p;
10954
10955 if (STRINGP (stuffstring))
10956 {
10957 register ptrdiff_t count;
10958
10959 p = SDATA (stuffstring);
10960 count = SBYTES (stuffstring);
10961 while (count-- > 0)
10962 stuff_char (*p++);
10963 stuff_char ('\n');
10964 }
10965
10966 /* Anything we have read ahead, put back for the shell to read. */
10967 /* ?? What should this do when we have multiple keyboards??
10968 Should we ignore anything that was typed in at the "wrong" kboard?
10969
10970 rms: we should stuff everything back into the kboard
10971 it came from. */
10972 for (; kbd_fetch_ptr != kbd_store_ptr;
10973 kbd_fetch_ptr = next_kbd_event (kbd_fetch_ptr))
10974 {
10975
10976 if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT)
10977 stuff_char (kbd_fetch_ptr->ie.code);
10978
10979 clear_event (&kbd_fetch_ptr->ie);
10980 }
10981
10982 input_pending = false;
10983 #endif /* SIGTSTP */
10984 }
10985
10986 void
set_waiting_for_input(struct timespec * time_to_clear)10987 set_waiting_for_input (struct timespec *time_to_clear)
10988 {
10989 input_available_clear_time = time_to_clear;
10990
10991 /* Tell handle_interrupt to throw back to read_char, */
10992 waiting_for_input = true;
10993
10994 /* If handle_interrupt was called before and buffered a C-g,
10995 make it run again now, to avoid timing error. */
10996 if (!NILP (Vquit_flag))
10997 quit_throw_to_read_char (0);
10998 }
10999
11000 void
clear_waiting_for_input(void)11001 clear_waiting_for_input (void)
11002 {
11003 /* Tell handle_interrupt not to throw back to read_char, */
11004 waiting_for_input = false;
11005 input_available_clear_time = 0;
11006 }
11007
11008 /* The SIGINT handler.
11009
11010 If we have a frame on the controlling tty, we assume that the
11011 SIGINT was generated by C-g, so we call handle_interrupt.
11012 Otherwise, tell maybe_quit to kill Emacs. */
11013
11014 static void
handle_interrupt_signal(int sig)11015 handle_interrupt_signal (int sig)
11016 {
11017 /* See if we have an active terminal on our controlling tty. */
11018 struct terminal *terminal = get_named_terminal (DEV_TTY);
11019 if (!terminal)
11020 {
11021 /* If there are no frames there, let's pretend that we are a
11022 well-behaving UN*X program and quit. We must not call Lisp
11023 in a signal handler, so tell maybe_quit to exit when it is
11024 safe. */
11025 Vquit_flag = Qkill_emacs;
11026 }
11027 else
11028 {
11029 /* Otherwise, the SIGINT was probably generated by C-g. */
11030
11031 /* Set internal_last_event_frame to the top frame of the
11032 controlling tty, if we have a frame there. We disable the
11033 interrupt key on secondary ttys, so the SIGINT must have come
11034 from the controlling tty. */
11035 internal_last_event_frame = terminal->display_info.tty->top_frame;
11036
11037 handle_interrupt (1);
11038 }
11039 }
11040
11041 static void
deliver_interrupt_signal(int sig)11042 deliver_interrupt_signal (int sig)
11043 {
11044 deliver_process_signal (sig, handle_interrupt_signal);
11045 }
11046
11047 /* Output MSG directly to standard output, without buffering. Ignore
11048 failures. This is safe in a signal handler. */
11049 static void
write_stdout(char const * msg)11050 write_stdout (char const *msg)
11051 {
11052 ignore_value (write (STDOUT_FILENO, msg, strlen (msg)));
11053 }
11054
11055 /* Read a byte from stdin, without buffering. Safe in signal handlers. */
11056 static int
read_stdin(void)11057 read_stdin (void)
11058 {
11059 char c;
11060 return read (STDIN_FILENO, &c, 1) == 1 ? c : EOF;
11061 }
11062
11063 /* If Emacs is stuck because `inhibit-quit' is true, then keep track
11064 of the number of times C-g has been requested. If C-g is pressed
11065 enough times, then quit anyway. See bug#6585. */
11066 static int volatile force_quit_count;
11067
11068 /* This routine is called at interrupt level in response to C-g.
11069
11070 It is called from the SIGINT handler or kbd_buffer_store_event.
11071
11072 If `waiting_for_input' is non zero, then unless `echoing' is
11073 nonzero, immediately throw back to read_char.
11074
11075 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
11076 eval to throw, when it gets a chance. If quit-flag is already
11077 non-nil, it stops the job right away. */
11078
11079 static void
handle_interrupt(bool in_signal_handler)11080 handle_interrupt (bool in_signal_handler)
11081 {
11082 char c;
11083
11084 cancel_echoing ();
11085
11086 /* XXX This code needs to be revised for multi-tty support. */
11087 if (!NILP (Vquit_flag) && get_named_terminal (DEV_TTY))
11088 {
11089 if (! in_signal_handler)
11090 {
11091 /* If SIGINT isn't blocked, don't let us be interrupted by
11092 a SIGINT. It might be harmful due to non-reentrancy
11093 in I/O functions. */
11094 sigset_t blocked;
11095 sigemptyset (&blocked);
11096 sigaddset (&blocked, SIGINT);
11097 pthread_sigmask (SIG_BLOCK, &blocked, 0);
11098 fflush (stdout);
11099 }
11100
11101 reset_all_sys_modes ();
11102
11103 #ifdef SIGTSTP
11104 /*
11105 * On systems which can suspend the current process and return to the original
11106 * shell, this command causes the user to end up back at the shell.
11107 * The "Auto-save" and "Abort" questions are not asked until
11108 * the user elects to return to emacs, at which point he can save the current
11109 * job and either dump core or continue.
11110 */
11111 sys_suspend ();
11112 #else
11113 /* Perhaps should really fork an inferior shell?
11114 But that would not provide any way to get back
11115 to the original shell, ever. */
11116 write_stdout ("No support for stopping a process"
11117 " on this operating system;\n"
11118 "you can continue or abort.\n");
11119 #endif /* not SIGTSTP */
11120 #ifdef MSDOS
11121 /* We must remain inside the screen area when the internal terminal
11122 is used. Note that [Enter] is not echoed by dos. */
11123 cursor_to (SELECTED_FRAME (), 0, 0);
11124 #endif
11125
11126 write_stdout ("Emacs is resuming after an emergency escape.\n");
11127
11128 /* It doesn't work to autosave while GC is in progress;
11129 the code used for auto-saving doesn't cope with the mark bit. */
11130 if (!gc_in_progress)
11131 {
11132 write_stdout ("Auto-save? (y or n) ");
11133 c = read_stdin ();
11134 if (c == 'y' || c == 'Y')
11135 {
11136 Fdo_auto_save (Qt, Qnil);
11137 #ifdef MSDOS
11138 write_stdout ("\r\nAuto-save done");
11139 #else
11140 write_stdout ("Auto-save done\n");
11141 #endif
11142 }
11143 while (c != '\n')
11144 c = read_stdin ();
11145 }
11146 else
11147 {
11148 /* During GC, it must be safe to reenable quitting again. */
11149 Vinhibit_quit = Qnil;
11150 write_stdout
11151 (
11152 #ifdef MSDOS
11153 "\r\n"
11154 #endif
11155 "Garbage collection in progress; cannot auto-save now\r\n"
11156 "but will instead do a real quit"
11157 " after garbage collection ends\r\n");
11158 }
11159
11160 #ifdef MSDOS
11161 write_stdout ("\r\nAbort? (y or n) ");
11162 #else
11163 write_stdout ("Abort (and dump core)? (y or n) ");
11164 #endif
11165 c = read_stdin ();
11166 if (c == 'y' || c == 'Y')
11167 emacs_abort ();
11168 while (c != '\n')
11169 c = read_stdin ();
11170 #ifdef MSDOS
11171 write_stdout ("\r\nContinuing...\r\n");
11172 #else /* not MSDOS */
11173 write_stdout ("Continuing...\n");
11174 #endif /* not MSDOS */
11175 init_all_sys_modes ();
11176 }
11177 else
11178 {
11179 /* Request quit when it's safe. */
11180 int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1;
11181 force_quit_count = count;
11182 if (count == 3)
11183 Vinhibit_quit = Qnil;
11184 Vquit_flag = Qt;
11185 }
11186
11187 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
11188
11189 /* TODO: The longjmp in this call throws the NS event loop integration off,
11190 and it seems to do fine without this. Probably some attention
11191 needs to be paid to the setting of waiting_for_input in
11192 wait_reading_process_output() under HAVE_NS because of the call
11193 to ns_select there (needed because otherwise events aren't picked up
11194 outside of polling since we don't get SIGIO like X and we don't have a
11195 separate event loop thread like W32. */
11196 #ifndef HAVE_NS
11197 #ifdef THREADS_ENABLED
11198 /* If we were called from a signal handler, we must be in the main
11199 thread, see deliver_process_signal. So we must make sure the
11200 main thread holds the global lock. */
11201 if (in_signal_handler)
11202 maybe_reacquire_global_lock ();
11203 #endif
11204 if (waiting_for_input && !echoing)
11205 quit_throw_to_read_char (in_signal_handler);
11206 #endif
11207 }
11208
11209 /* Handle a C-g by making read_char return C-g. */
11210
11211 static void
quit_throw_to_read_char(bool from_signal)11212 quit_throw_to_read_char (bool from_signal)
11213 {
11214 /* When not called from a signal handler it is safe to call
11215 Lisp. */
11216 if (!from_signal && EQ (Vquit_flag, Qkill_emacs))
11217 Fkill_emacs (Qnil);
11218
11219 /* Prevent another signal from doing this before we finish. */
11220 clear_waiting_for_input ();
11221 input_pending = false;
11222
11223 Vunread_command_events = Qnil;
11224
11225 if (FRAMEP (internal_last_event_frame)
11226 && !EQ (internal_last_event_frame, selected_frame))
11227 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
11228 0, 0, Qnil);
11229
11230 sys_longjmp (getcjmp, 1);
11231 }
11232
11233 DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,
11234 Sset_input_interrupt_mode, 1, 1, 0,
11235 doc: /* Set interrupt mode of reading keyboard input.
11236 If INTERRUPT is non-nil, Emacs will use input interrupts;
11237 otherwise Emacs uses CBREAK mode.
11238
11239 See also `current-input-mode'. */)
11240 (Lisp_Object interrupt)
11241 {
11242 bool new_interrupt_input;
11243 #if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
11244 #ifdef HAVE_X_WINDOWS
11245 if (x_display_list != NULL)
11246 {
11247 /* When using X, don't give the user a real choice,
11248 because we haven't implemented the mechanisms to support it. */
11249 new_interrupt_input = true;
11250 }
11251 else
11252 #endif /* HAVE_X_WINDOWS */
11253 new_interrupt_input = !NILP (interrupt);
11254 #else /* not USABLE_SIGIO || USABLE_SIGPOLL */
11255 new_interrupt_input = false;
11256 #endif /* not USABLE_SIGIO || USABLE_SIGPOLL */
11257
11258 if (new_interrupt_input != interrupt_input)
11259 {
11260 #ifdef POLL_FOR_INPUT
11261 stop_polling ();
11262 #endif
11263 #ifndef DOS_NT
11264 /* this causes startup screen to be restored and messes with the mouse */
11265 reset_all_sys_modes ();
11266 interrupt_input = new_interrupt_input;
11267 init_all_sys_modes ();
11268 #else
11269 interrupt_input = new_interrupt_input;
11270 #endif
11271
11272 #ifdef POLL_FOR_INPUT
11273 poll_suppress_count = 1;
11274 start_polling ();
11275 #endif
11276 }
11277 return Qnil;
11278 }
11279
11280 DEFUN ("set-output-flow-control", Fset_output_flow_control, Sset_output_flow_control, 1, 2, 0,
11281 doc: /* Enable or disable ^S/^Q flow control for output to TERMINAL.
11282 If FLOW is non-nil, flow control is enabled and you cannot use C-s or
11283 C-q in key sequences.
11284
11285 This setting only has an effect on tty terminals and only when
11286 Emacs reads input in CBREAK mode; see `set-input-interrupt-mode'.
11287
11288 See also `current-input-mode'. */)
11289 (Lisp_Object flow, Lisp_Object terminal)
11290 {
11291 struct terminal *t = decode_tty_terminal (terminal);
11292 struct tty_display_info *tty;
11293
11294 if (!t)
11295 return Qnil;
11296 tty = t->display_info.tty;
11297
11298 if (tty->flow_control != !NILP (flow))
11299 {
11300 #ifndef DOS_NT
11301 /* This causes startup screen to be restored and messes with the mouse. */
11302 reset_sys_modes (tty);
11303 #endif
11304
11305 tty->flow_control = !NILP (flow);
11306
11307 #ifndef DOS_NT
11308 init_sys_modes (tty);
11309 #endif
11310 }
11311 return Qnil;
11312 }
11313
11314 DEFUN ("set-input-meta-mode", Fset_input_meta_mode, Sset_input_meta_mode, 1, 2, 0,
11315 doc: /* Enable or disable 8-bit input on TERMINAL.
11316 If META is t, Emacs will accept 8-bit input, and interpret the 8th
11317 bit as the Meta modifier before it decodes the characters.
11318
11319 If META is `encoded', Emacs will interpret the 8th bit of single-byte
11320 characters after decoding the characters.
11321
11322 If META is nil, Emacs will ignore the top bit, on the assumption it is
11323 parity.
11324
11325 Otherwise, Emacs will accept and pass through 8-bit input without
11326 specially interpreting the top bit.
11327
11328 This setting only has an effect on tty terminal devices.
11329
11330 Optional parameter TERMINAL specifies the tty terminal device to use.
11331 It may be a terminal object, a frame, or nil for the terminal used by
11332 the currently selected frame.
11333
11334 See also `current-input-mode'. */)
11335 (Lisp_Object meta, Lisp_Object terminal)
11336 {
11337 struct terminal *t = decode_tty_terminal (terminal);
11338 struct tty_display_info *tty;
11339 int new_meta;
11340
11341 if (!t)
11342 return Qnil;
11343 tty = t->display_info.tty;
11344
11345 if (NILP (meta))
11346 new_meta = 0;
11347 else if (EQ (meta, Qt))
11348 new_meta = 1;
11349 else if (EQ (meta, Qencoded))
11350 new_meta = 3;
11351 else
11352 new_meta = 2;
11353
11354 if (tty->meta_key != new_meta)
11355 {
11356 #ifndef DOS_NT
11357 /* this causes startup screen to be restored and messes with the mouse */
11358 reset_sys_modes (tty);
11359 #endif
11360
11361 tty->meta_key = new_meta;
11362
11363 #ifndef DOS_NT
11364 init_sys_modes (tty);
11365 #endif
11366 }
11367 return Qnil;
11368 }
11369
11370 DEFUN ("set-quit-char", Fset_quit_char, Sset_quit_char, 1, 1, 0,
11371 doc: /* Specify character used for quitting.
11372 QUIT must be an ASCII character.
11373
11374 This function only has an effect on the controlling tty of the Emacs
11375 process.
11376
11377 See also `current-input-mode'. */)
11378 (Lisp_Object quit)
11379 {
11380 struct terminal *t = get_named_terminal (DEV_TTY);
11381 struct tty_display_info *tty;
11382
11383 if (!t)
11384 return Qnil;
11385 tty = t->display_info.tty;
11386
11387 if (NILP (quit) || !FIXNUMP (quit) || XFIXNUM (quit) < 0 || XFIXNUM (quit) > 0400)
11388 error ("QUIT must be an ASCII character");
11389
11390 #ifndef DOS_NT
11391 /* this causes startup screen to be restored and messes with the mouse */
11392 reset_sys_modes (tty);
11393 #endif
11394
11395 /* Don't let this value be out of range. */
11396 quit_char = XFIXNUM (quit) & (tty->meta_key == 0 ? 0177 : 0377);
11397
11398 #ifndef DOS_NT
11399 init_sys_modes (tty);
11400 #endif
11401
11402 return Qnil;
11403 }
11404
11405 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
11406 doc: /* Set mode of reading keyboard input.
11407 First arg INTERRUPT non-nil means use input interrupts;
11408 nil means use CBREAK mode.
11409 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
11410 (no effect except in CBREAK mode).
11411 Third arg META t means accept 8-bit input (for a Meta key).
11412 META nil means ignore the top bit, on the assumption it is parity.
11413 META `encoded' means accept 8-bit input and interpret Meta after
11414 decoding the input characters.
11415 Otherwise, accept 8-bit input and don't use the top bit for Meta.
11416 Optional fourth arg QUIT if non-nil specifies character to use for quitting.
11417 See also `current-input-mode'. */)
11418 (Lisp_Object interrupt, Lisp_Object flow, Lisp_Object meta, Lisp_Object quit)
11419 {
11420 Fset_input_interrupt_mode (interrupt);
11421 Fset_output_flow_control (flow, Qnil);
11422 Fset_input_meta_mode (meta, Qnil);
11423 if (!NILP (quit))
11424 Fset_quit_char (quit);
11425 return Qnil;
11426 }
11427
11428 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
11429 doc: /* Return information about the way Emacs currently reads keyboard input.
11430 The value is a list of the form (INTERRUPT FLOW META QUIT), where
11431 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if
11432 nil, Emacs is using CBREAK mode.
11433 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
11434 terminal; this does not apply if Emacs uses interrupt-driven input.
11435 META is t if accepting 8-bit unencoded input with 8th bit as Meta flag.
11436 META is `encoded' if accepting 8-bit encoded input with 8th bit as
11437 Meta flag which has to be interpreted after decoding the input.
11438 META is nil if ignoring the top bit of input, on the assumption that
11439 it is a parity bit.
11440 META is neither t nor nil if accepting 8-bit input and using
11441 all 8 bits as the character code.
11442 QUIT is the character Emacs currently uses to quit.
11443 The elements of this list correspond to the arguments of
11444 `set-input-mode'. */)
11445 (void)
11446 {
11447 struct frame *sf = XFRAME (selected_frame);
11448
11449 Lisp_Object interrupt = interrupt_input ? Qt : Qnil;
11450 Lisp_Object flow, meta;
11451 if (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf))
11452 {
11453 flow = FRAME_TTY (sf)->flow_control ? Qt : Qnil;
11454 meta = (FRAME_TTY (sf)->meta_key == 2
11455 ? make_fixnum (0)
11456 : (CURTTY ()->meta_key == 1
11457 ? Qt
11458 : (CURTTY ()->meta_key == 3 ? Qencoded : Qnil)));
11459 }
11460 else
11461 {
11462 flow = Qnil;
11463 meta = Qt;
11464 }
11465 Lisp_Object quit = make_fixnum (quit_char);
11466
11467 return list4 (interrupt, flow, meta, quit);
11468 }
11469
11470 DEFUN ("posn-at-x-y", Fposn_at_x_y, Sposn_at_x_y, 2, 4, 0,
11471 doc: /* Return position information for pixel coordinates X and Y.
11472 By default, X and Y are relative to text area of the selected window.
11473 Note that the text area includes the header-line and the tab-line of
11474 the window, if any of them are present.
11475 Optional third arg FRAME-OR-WINDOW non-nil specifies frame or window.
11476 If optional fourth arg WHOLE is non-nil, X is relative to the left
11477 edge of the window.
11478
11479 The return value is similar to a mouse click position:
11480 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
11481 IMAGE (DX . DY) (WIDTH . HEIGHT))
11482 The `posn-' functions access elements of such lists. */)
11483 (Lisp_Object x, Lisp_Object y, Lisp_Object frame_or_window, Lisp_Object whole)
11484 {
11485 CHECK_FIXNUM (x);
11486 /* We allow X of -1, for the newline in a R2L line that overflowed
11487 into the left fringe. */
11488 if (XFIXNUM (x) != -1)
11489 CHECK_FIXNAT (x);
11490 CHECK_FIXNAT (y);
11491
11492 if (NILP (frame_or_window))
11493 frame_or_window = selected_window;
11494
11495 if (WINDOWP (frame_or_window))
11496 {
11497 struct window *w = decode_live_window (frame_or_window);
11498
11499 XSETINT (x, (XFIXNUM (x)
11500 + WINDOW_LEFT_EDGE_X (w)
11501 + (NILP (whole)
11502 ? window_box_left_offset (w, TEXT_AREA)
11503 : 0)));
11504 XSETINT (y, WINDOW_TO_FRAME_PIXEL_Y (w, XFIXNUM (y)));
11505 frame_or_window = w->frame;
11506 }
11507
11508 CHECK_LIVE_FRAME (frame_or_window);
11509
11510 return make_lispy_position (XFRAME (frame_or_window), x, y, 0);
11511 }
11512
11513 DEFUN ("posn-at-point", Fposn_at_point, Sposn_at_point, 0, 2, 0,
11514 doc: /* Return position information for buffer position POS in WINDOW.
11515 POS defaults to point in WINDOW; WINDOW defaults to the selected window.
11516
11517 Return nil if POS is not visible in WINDOW. Otherwise,
11518 the return value is similar to that returned by `event-start' for
11519 a mouse click at the upper left corner of the glyph corresponding
11520 to POS:
11521 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
11522 IMAGE (DX . DY) (WIDTH . HEIGHT))
11523 The `posn-' functions access elements of such lists. */)
11524 (Lisp_Object pos, Lisp_Object window)
11525 {
11526 Lisp_Object tem;
11527
11528 if (NILP (window))
11529 window = selected_window;
11530
11531 tem = Fpos_visible_in_window_p (pos, window, Qt);
11532 if (!NILP (tem))
11533 {
11534 Lisp_Object x = XCAR (tem);
11535 Lisp_Object y = XCAR (XCDR (tem));
11536 Lisp_Object aux_info = XCDR (XCDR (tem));
11537 int y_coord = XFIXNUM (y);
11538
11539 /* Point invisible due to hscrolling? X can be -1 when a
11540 newline in a R2L line overflows into the left fringe. */
11541 if (XFIXNUM (x) < -1)
11542 return Qnil;
11543 if (!NILP (aux_info) && y_coord < 0)
11544 {
11545 int rtop = XFIXNUM (XCAR (aux_info));
11546
11547 y = make_fixnum (y_coord + rtop);
11548 }
11549 tem = Fposn_at_x_y (x, y, window, Qnil);
11550 }
11551
11552 return tem;
11553 }
11554
11555 /* Set up a new kboard object with reasonable initial values.
11556 TYPE is a window system for which this keyboard is used. */
11557
11558 static void
init_kboard(KBOARD * kb,Lisp_Object type)11559 init_kboard (KBOARD *kb, Lisp_Object type)
11560 {
11561 kset_overriding_terminal_local_map (kb, Qnil);
11562 kset_last_command (kb, Qnil);
11563 kset_real_last_command (kb, Qnil);
11564 kset_keyboard_translate_table (kb, Qnil);
11565 kset_last_repeatable_command (kb, Qnil);
11566 kset_prefix_arg (kb, Qnil);
11567 kset_last_prefix_arg (kb, Qnil);
11568 kset_kbd_queue (kb, Qnil);
11569 kb->kbd_queue_has_data = false;
11570 kb->immediate_echo = false;
11571 kset_echo_string (kb, Qnil);
11572 kset_echo_prompt (kb, Qnil);
11573 kb->kbd_macro_buffer = 0;
11574 kb->kbd_macro_bufsize = 0;
11575 kset_defining_kbd_macro (kb, Qnil);
11576 kset_last_kbd_macro (kb, Qnil);
11577 kb->reference_count = 0;
11578 kset_system_key_alist (kb, Qnil);
11579 kset_system_key_syms (kb, Qnil);
11580 kset_window_system (kb, type);
11581 kset_input_decode_map (kb, Fmake_sparse_keymap (Qnil));
11582 kset_local_function_key_map (kb, Fmake_sparse_keymap (Qnil));
11583 Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map);
11584 kset_default_minibuffer_frame (kb, Qnil);
11585 }
11586
11587 /* Allocate and basically initialize keyboard
11588 object to use with window system TYPE. */
11589
11590 KBOARD *
allocate_kboard(Lisp_Object type)11591 allocate_kboard (Lisp_Object type)
11592 {
11593 KBOARD *kb = xmalloc (sizeof *kb);
11594
11595 init_kboard (kb, type);
11596 kb->next_kboard = all_kboards;
11597 all_kboards = kb;
11598 return kb;
11599 }
11600
11601 /*
11602 * Destroy the contents of a kboard object, but not the object itself.
11603 * We use this just before deleting it, or if we're going to initialize
11604 * it a second time.
11605 */
11606 static void
wipe_kboard(KBOARD * kb)11607 wipe_kboard (KBOARD *kb)
11608 {
11609 xfree (kb->kbd_macro_buffer);
11610 }
11611
11612 /* Free KB and memory referenced from it. */
11613
11614 void
delete_kboard(KBOARD * kb)11615 delete_kboard (KBOARD *kb)
11616 {
11617 KBOARD **kbp;
11618
11619 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
11620 if (*kbp == NULL)
11621 emacs_abort ();
11622 *kbp = kb->next_kboard;
11623
11624 /* Prevent a dangling reference to KB. */
11625 if (kb == current_kboard
11626 && FRAMEP (selected_frame)
11627 && FRAME_LIVE_P (XFRAME (selected_frame)))
11628 {
11629 current_kboard = FRAME_KBOARD (XFRAME (selected_frame));
11630 single_kboard = false;
11631 if (current_kboard == kb)
11632 emacs_abort ();
11633 }
11634
11635 wipe_kboard (kb);
11636 xfree (kb);
11637 }
11638
11639 void
init_keyboard(void)11640 init_keyboard (void)
11641 {
11642 /* This is correct before outermost invocation of the editor loop. */
11643 command_loop_level = -1;
11644 quit_char = Ctl ('g');
11645 Vunread_command_events = Qnil;
11646 timer_idleness_start_time = invalid_timespec ();
11647 total_keys = 0;
11648 recent_keys_index = 0;
11649 kbd_fetch_ptr = kbd_buffer;
11650 kbd_store_ptr = kbd_buffer;
11651 track_mouse = Qnil;
11652 input_pending = false;
11653 interrupt_input_blocked = 0;
11654 pending_signals = false;
11655
11656 /* This means that command_loop_1 won't try to select anything the first
11657 time through. */
11658 internal_last_event_frame = Qnil;
11659 Vlast_event_frame = internal_last_event_frame;
11660
11661 current_kboard = initial_kboard;
11662 /* Re-initialize the keyboard again. */
11663 wipe_kboard (current_kboard);
11664 /* A value of nil for Vwindow_system normally means a tty, but we also use
11665 it for the initial terminal since there is no window system there. */
11666 init_kboard (current_kboard, Qnil);
11667
11668 if (!noninteractive)
11669 {
11670 /* Before multi-tty support, these handlers used to be installed
11671 only if the current session was a tty session. Now an Emacs
11672 session may have multiple display types, so we always handle
11673 SIGINT. There is special code in handle_interrupt_signal to exit
11674 Emacs on SIGINT when there are no termcap frames on the
11675 controlling terminal. */
11676 struct sigaction action;
11677 emacs_sigaction_init (&action, deliver_interrupt_signal);
11678 sigaction (SIGINT, &action, 0);
11679 #ifndef DOS_NT
11680 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
11681 SIGQUIT and we can't tell which one it will give us. */
11682 sigaction (SIGQUIT, &action, 0);
11683 #endif /* not DOS_NT */
11684 }
11685 #if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
11686 if (!noninteractive)
11687 {
11688 struct sigaction action;
11689 emacs_sigaction_init (&action, deliver_input_available_signal);
11690 #ifdef USABLE_SIGIO
11691 sigaction (SIGIO, &action, 0);
11692 #else
11693 sigaction (SIGPOLL, &action, 0);
11694 #endif
11695 }
11696 #endif
11697
11698 /* Use interrupt input by default, if it works and noninterrupt input
11699 has deficiencies. */
11700
11701 #ifdef INTERRUPT_INPUT
11702 interrupt_input = 1;
11703 #else
11704 interrupt_input = 0;
11705 #endif
11706
11707 pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
11708 dribble = 0;
11709
11710 if (keyboard_init_hook)
11711 (*keyboard_init_hook) ();
11712
11713 #ifdef POLL_FOR_INPUT
11714 poll_timer = NULL;
11715 poll_suppress_count = 1;
11716 start_polling ();
11717 #endif
11718 }
11719
11720 /* This type's only use is in syms_of_keyboard, to put properties on the
11721 event header symbols. */
11722 struct event_head
11723 {
11724 short var;
11725 short kind;
11726 };
11727
11728 static const struct event_head head_table[] = {
11729 {SYMBOL_INDEX (Qmouse_movement), SYMBOL_INDEX (Qmouse_movement)},
11730 {SYMBOL_INDEX (Qscroll_bar_movement), SYMBOL_INDEX (Qmouse_movement)},
11731
11732 /* Some of the event heads. */
11733 {SYMBOL_INDEX (Qswitch_frame), SYMBOL_INDEX (Qswitch_frame)},
11734
11735 {SYMBOL_INDEX (Qfocus_in), SYMBOL_INDEX (Qfocus_in)},
11736 {SYMBOL_INDEX (Qfocus_out), SYMBOL_INDEX (Qfocus_out)},
11737 {SYMBOL_INDEX (Qmove_frame), SYMBOL_INDEX (Qmove_frame)},
11738 {SYMBOL_INDEX (Qdelete_frame), SYMBOL_INDEX (Qdelete_frame)},
11739 {SYMBOL_INDEX (Qiconify_frame), SYMBOL_INDEX (Qiconify_frame)},
11740 {SYMBOL_INDEX (Qmake_frame_visible), SYMBOL_INDEX (Qmake_frame_visible)},
11741 /* `select-window' should be handled just like `switch-frame'
11742 in read_key_sequence. */
11743 {SYMBOL_INDEX (Qselect_window), SYMBOL_INDEX (Qswitch_frame)}
11744 };
11745
11746 static Lisp_Object
init_while_no_input_ignore_events(void)11747 init_while_no_input_ignore_events (void)
11748 {
11749 Lisp_Object events = listn (9, Qselect_window, Qhelp_echo, Qmove_frame,
11750 Qiconify_frame, Qmake_frame_visible,
11751 Qfocus_in, Qfocus_out, Qconfig_changed_event,
11752 Qselection_request);
11753
11754 #ifdef HAVE_DBUS
11755 events = Fcons (Qdbus_event, events);
11756 #endif
11757 #ifdef USE_FILE_NOTIFY
11758 events = Fcons (Qfile_notify, events);
11759 #endif
11760 #ifdef THREADS_ENABLED
11761 events = Fcons (Qthread_event, events);
11762 #endif
11763
11764 return events;
11765 }
11766
11767 static bool
is_ignored_event(union buffered_input_event * event)11768 is_ignored_event (union buffered_input_event *event)
11769 {
11770 Lisp_Object ignore_event;
11771
11772 switch (event->kind)
11773 {
11774 case FOCUS_IN_EVENT: ignore_event = Qfocus_in; break;
11775 case FOCUS_OUT_EVENT: ignore_event = Qfocus_out; break;
11776 case HELP_EVENT: ignore_event = Qhelp_echo; break;
11777 case ICONIFY_EVENT: ignore_event = Qiconify_frame; break;
11778 case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break;
11779 case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break;
11780 #ifdef USE_FILE_NOTIFY
11781 case FILE_NOTIFY_EVENT: ignore_event = Qfile_notify; break;
11782 #endif
11783 #ifdef HAVE_DBUS
11784 case DBUS_EVENT: ignore_event = Qdbus_event; break;
11785 #endif
11786 default: ignore_event = Qnil; break;
11787 }
11788
11789 return !NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events));
11790 }
11791
11792 static void syms_of_keyboard_for_pdumper (void);
11793
11794 void
syms_of_keyboard(void)11795 syms_of_keyboard (void)
11796 {
11797 pending_funcalls = Qnil;
11798 staticpro (&pending_funcalls);
11799
11800 Vlispy_mouse_stem = build_pure_c_string ("mouse");
11801 staticpro (&Vlispy_mouse_stem);
11802
11803 regular_top_level_message = build_pure_c_string ("Back to top level");
11804 staticpro (®ular_top_level_message);
11805 #ifdef HAVE_STACK_OVERFLOW_HANDLING
11806 recover_top_level_message
11807 = build_pure_c_string ("Re-entering top level after C stack overflow");
11808 staticpro (&recover_top_level_message);
11809 #endif
11810 DEFVAR_LISP ("internal--top-level-message", Vinternal__top_level_message,
11811 doc: /* Message displayed by `normal-top-level'. */);
11812 Vinternal__top_level_message = regular_top_level_message;
11813
11814 /* Tool-bars. */
11815 DEFSYM (QCimage, ":image");
11816 DEFSYM (Qhelp_echo, "help-echo");
11817 DEFSYM (Qhelp_echo_inhibit_substitution, "help-echo-inhibit-substitution");
11818 DEFSYM (QCrtl, ":rtl");
11819
11820 staticpro (&item_properties);
11821 item_properties = Qnil;
11822
11823 staticpro (&tab_bar_item_properties);
11824 tab_bar_item_properties = Qnil;
11825 staticpro (&tab_bar_items_vector);
11826 tab_bar_items_vector = Qnil;
11827
11828 staticpro (&tool_bar_item_properties);
11829 tool_bar_item_properties = Qnil;
11830 staticpro (&tool_bar_items_vector);
11831 tool_bar_items_vector = Qnil;
11832
11833 DEFSYM (Qtimer_event_handler, "timer-event-handler");
11834
11835 /* Non-nil disable property on a command means do not execute it;
11836 call disabled-command-function's value instead. */
11837 DEFSYM (Qdisabled, "disabled");
11838
11839 DEFSYM (Qundefined, "undefined");
11840
11841 /* Hooks to run before and after each command. */
11842 DEFSYM (Qpre_command_hook, "pre-command-hook");
11843 DEFSYM (Qpost_command_hook, "post-command-hook");
11844
11845 DEFSYM (Qundo_auto__add_boundary, "undo-auto--add-boundary");
11846 DEFSYM (Qundo_auto__undoably_changed_buffers,
11847 "undo-auto--undoably-changed-buffers");
11848
11849 DEFSYM (Qdeferred_action_function, "deferred-action-function");
11850 DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook");
11851 DEFSYM (Qfunction_key, "function-key");
11852
11853 /* The values of Qevent_kind properties. */
11854 DEFSYM (Qmouse_click, "mouse-click");
11855
11856 DEFSYM (Qdrag_n_drop, "drag-n-drop");
11857 DEFSYM (Qsave_session, "save-session");
11858 DEFSYM (Qconfig_changed_event, "config-changed-event");
11859
11860 /* Menu and tool bar item parts. */
11861 DEFSYM (Qmenu_enable, "menu-enable");
11862
11863 #ifdef HAVE_NTGUI
11864 DEFSYM (Qlanguage_change, "language-change");
11865 DEFSYM (Qend_session, "end-session");
11866 #endif
11867
11868 #ifdef HAVE_DBUS
11869 DEFSYM (Qdbus_event, "dbus-event");
11870 #endif
11871
11872 #ifdef THREADS_ENABLED
11873 DEFSYM (Qthread_event, "thread-event");
11874 #endif
11875
11876 #ifdef HAVE_XWIDGETS
11877 DEFSYM (Qxwidget_event, "xwidget-event");
11878 DEFSYM (Qxwidget_display_event, "xwidget-display-event");
11879 #endif
11880
11881 #ifdef USE_FILE_NOTIFY
11882 DEFSYM (Qfile_notify, "file-notify");
11883 #endif /* USE_FILE_NOTIFY */
11884
11885 DEFSYM (Qtouch_end, "touch-end");
11886
11887 /* Menu and tool bar item parts. */
11888 DEFSYM (QCenable, ":enable");
11889 DEFSYM (QCvisible, ":visible");
11890 DEFSYM (QChelp, ":help");
11891 DEFSYM (QCfilter, ":filter");
11892 DEFSYM (QCbutton, ":button");
11893 DEFSYM (QCkeys, ":keys");
11894 DEFSYM (QCkey_sequence, ":key-sequence");
11895
11896 /* Non-nil disable property on a command means
11897 do not execute it; call disabled-command-function's value instead. */
11898 DEFSYM (QCtoggle, ":toggle");
11899 DEFSYM (QCradio, ":radio");
11900 DEFSYM (QClabel, ":label");
11901 DEFSYM (QCvert_only, ":vert-only");
11902
11903 /* Symbols to use for parts of windows. */
11904 DEFSYM (Qvertical_line, "vertical-line");
11905 DEFSYM (Qright_divider, "right-divider");
11906 DEFSYM (Qbottom_divider, "bottom-divider");
11907
11908 DEFSYM (Qmouse_fixup_help_message, "mouse-fixup-help-message");
11909
11910 DEFSYM (Qabove_handle, "above-handle");
11911 DEFSYM (Qhandle, "handle");
11912 DEFSYM (Qbelow_handle, "below-handle");
11913 DEFSYM (Qup, "up");
11914 DEFSYM (Qdown, "down");
11915 DEFSYM (Qtop, "top");
11916 DEFSYM (Qbottom, "bottom");
11917 DEFSYM (Qend_scroll, "end-scroll");
11918 DEFSYM (Qratio, "ratio");
11919 DEFSYM (Qbefore_handle, "before-handle");
11920 DEFSYM (Qhorizontal_handle, "horizontal-handle");
11921 DEFSYM (Qafter_handle, "after-handle");
11922 DEFSYM (Qleft, "left");
11923 DEFSYM (Qright, "right");
11924 DEFSYM (Qleftmost, "leftmost");
11925 DEFSYM (Qrightmost, "rightmost");
11926
11927 /* Properties of event headers. */
11928 DEFSYM (Qevent_kind, "event-kind");
11929 DEFSYM (Qevent_symbol_elements, "event-symbol-elements");
11930
11931 /* An event header symbol HEAD may have a property named
11932 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
11933 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
11934 mask of modifiers applied to it. If present, this is used to help
11935 speed up parse_modifiers. */
11936 DEFSYM (Qevent_symbol_element_mask, "event-symbol-element-mask");
11937
11938 /* An unmodified event header BASE may have a property named
11939 Qmodifier_cache, which is an alist mapping modifier masks onto
11940 modified versions of BASE. If present, this helps speed up
11941 apply_modifiers. */
11942 DEFSYM (Qmodifier_cache, "modifier-cache");
11943
11944 DEFSYM (Qrecompute_lucid_menubar, "recompute-lucid-menubar");
11945 DEFSYM (Qactivate_menubar_hook, "activate-menubar-hook");
11946
11947 DEFSYM (Qpolling_period, "polling-period");
11948
11949 DEFSYM (Qgui_set_selection, "gui-set-selection");
11950
11951 /* The primary selection. */
11952 DEFSYM (QPRIMARY, "PRIMARY");
11953
11954 DEFSYM (Qhandle_switch_frame, "handle-switch-frame");
11955 DEFSYM (Qhandle_select_window, "handle-select-window");
11956
11957 DEFSYM (Qinput_method_exit_on_first_char, "input-method-exit-on-first-char");
11958 DEFSYM (Qinput_method_use_echo_area, "input-method-use-echo-area");
11959
11960 DEFSYM (Qhelp_form_show, "help-form-show");
11961
11962 DEFSYM (Qecho_keystrokes, "echo-keystrokes");
11963
11964 Fset (Qinput_method_exit_on_first_char, Qnil);
11965 Fset (Qinput_method_use_echo_area, Qnil);
11966
11967 /* Symbols for dragging internal borders. */
11968 DEFSYM (Qdrag_internal_border, "drag-internal-border");
11969 DEFSYM (Qleft_edge, "left-edge");
11970 DEFSYM (Qtop_left_corner, "top-left-corner");
11971 DEFSYM (Qtop_edge, "top-edge");
11972 DEFSYM (Qtop_right_corner, "top-right-corner");
11973 DEFSYM (Qright_edge, "right-edge");
11974 DEFSYM (Qbottom_right_corner, "bottom-right-corner");
11975 DEFSYM (Qbottom_edge, "bottom-edge");
11976 DEFSYM (Qbottom_left_corner, "bottom-left-corner");
11977
11978 /* Symbols to head events. */
11979 DEFSYM (Qmouse_movement, "mouse-movement");
11980 DEFSYM (Qscroll_bar_movement, "scroll-bar-movement");
11981 DEFSYM (Qswitch_frame, "switch-frame");
11982 DEFSYM (Qfocus_in, "focus-in");
11983 DEFSYM (Qfocus_out, "focus-out");
11984 DEFSYM (Qmove_frame, "move-frame");
11985 DEFSYM (Qdelete_frame, "delete-frame");
11986 DEFSYM (Qiconify_frame, "iconify-frame");
11987 DEFSYM (Qmake_frame_visible, "make-frame-visible");
11988 DEFSYM (Qselect_window, "select-window");
11989 DEFSYM (Qselection_request, "selection-request");
11990 DEFSYM (Qwindow_edges, "window-edges");
11991 {
11992 int i;
11993
11994 for (i = 0; i < ARRAYELTS (head_table); i++)
11995 {
11996 const struct event_head *p = &head_table[i];
11997 Lisp_Object var = builtin_lisp_symbol (p->var);
11998 Lisp_Object kind = builtin_lisp_symbol (p->kind);
11999 Fput (var, Qevent_kind, kind);
12000 Fput (var, Qevent_symbol_elements, list1 (var));
12001 }
12002 }
12003 DEFSYM (Qno_record, "no-record");
12004 DEFSYM (Qencoded, "encoded");
12005
12006 button_down_location = make_nil_vector (5);
12007 staticpro (&button_down_location);
12008 staticpro (&frame_relative_event_pos);
12009 mouse_syms = make_nil_vector (5);
12010 staticpro (&mouse_syms);
12011 wheel_syms = make_nil_vector (ARRAYELTS (lispy_wheel_names));
12012 staticpro (&wheel_syms);
12013
12014 {
12015 int i;
12016 int len = ARRAYELTS (modifier_names);
12017
12018 modifier_symbols = make_nil_vector (len);
12019 for (i = 0; i < len; i++)
12020 if (modifier_names[i])
12021 ASET (modifier_symbols, i, intern_c_string (modifier_names[i]));
12022 staticpro (&modifier_symbols);
12023 }
12024
12025 recent_keys = make_nil_vector (lossage_limit);
12026 staticpro (&recent_keys);
12027
12028 this_command_keys = make_nil_vector (40);
12029 staticpro (&this_command_keys);
12030
12031 raw_keybuf = make_nil_vector (30);
12032 staticpro (&raw_keybuf);
12033
12034 DEFSYM (Qcommand_execute, "command-execute");
12035 DEFSYM (Qinternal_echo_keystrokes_prefix, "internal-echo-keystrokes-prefix");
12036
12037 accent_key_syms = Qnil;
12038 staticpro (&accent_key_syms);
12039
12040 func_key_syms = Qnil;
12041 staticpro (&func_key_syms);
12042
12043 drag_n_drop_syms = Qnil;
12044 staticpro (&drag_n_drop_syms);
12045
12046 pinch_syms = Qnil;
12047 staticpro (&pinch_syms);
12048
12049 unread_switch_frame = Qnil;
12050 staticpro (&unread_switch_frame);
12051
12052 internal_last_event_frame = Qnil;
12053 staticpro (&internal_last_event_frame);
12054
12055 read_key_sequence_cmd = Qnil;
12056 staticpro (&read_key_sequence_cmd);
12057 read_key_sequence_remapped = Qnil;
12058 staticpro (&read_key_sequence_remapped);
12059
12060 menu_bar_one_keymap_changed_items = Qnil;
12061 staticpro (&menu_bar_one_keymap_changed_items);
12062
12063 menu_bar_items_vector = Qnil;
12064 staticpro (&menu_bar_items_vector);
12065
12066 help_form_saved_window_configs = Qnil;
12067 staticpro (&help_form_saved_window_configs);
12068
12069 defsubr (&Scurrent_idle_time);
12070 defsubr (&Sevent_symbol_parse_modifiers);
12071 defsubr (&Sevent_convert_list);
12072 defsubr (&Sinternal_handle_focus_in);
12073 defsubr (&Sread_key_sequence);
12074 defsubr (&Sread_key_sequence_vector);
12075 defsubr (&Srecursive_edit);
12076 defsubr (&Sinternal_track_mouse);
12077 defsubr (&Sinput_pending_p);
12078 defsubr (&Slossage_size);
12079 defsubr (&Srecent_keys);
12080 defsubr (&Sthis_command_keys);
12081 defsubr (&Sthis_command_keys_vector);
12082 defsubr (&Sthis_single_command_keys);
12083 defsubr (&Sthis_single_command_raw_keys);
12084 defsubr (&Sset__this_command_keys);
12085 defsubr (&Sclear_this_command_keys);
12086 defsubr (&Ssuspend_emacs);
12087 defsubr (&Sabort_recursive_edit);
12088 defsubr (&Sexit_recursive_edit);
12089 defsubr (&Srecursion_depth);
12090 defsubr (&Scommand_error_default_function);
12091 defsubr (&Stop_level);
12092 defsubr (&Sdiscard_input);
12093 defsubr (&Sopen_dribble_file);
12094 defsubr (&Sset_input_interrupt_mode);
12095 defsubr (&Sset_output_flow_control);
12096 defsubr (&Sset_input_meta_mode);
12097 defsubr (&Sset_quit_char);
12098 defsubr (&Sset_input_mode);
12099 defsubr (&Scurrent_input_mode);
12100 defsubr (&Sposn_at_point);
12101 defsubr (&Sposn_at_x_y);
12102
12103 DEFVAR_LISP ("last-command-event", last_command_event,
12104 doc: /* Last input event of a key sequence that called a command.
12105 See Info node `(elisp)Command Loop Info'.*/);
12106
12107 DEFVAR_LISP ("last-nonmenu-event", last_nonmenu_event,
12108 doc: /* Last input event in a command, except for mouse menu events.
12109 Mouse menus give back keys that don't look like mouse events;
12110 this variable holds the actual mouse event that led to the menu,
12111 so that you can determine whether the command was run by mouse or not. */);
12112
12113 DEFVAR_LISP ("last-input-event", last_input_event,
12114 doc: /* Last input event. */);
12115
12116 DEFVAR_LISP ("unread-command-events", Vunread_command_events,
12117 doc: /* List of events to be read as the command input.
12118 These events are processed first, before actual keyboard input.
12119 Events read from this list are not normally added to `this-command-keys',
12120 as they will already have been added once as they were read for the first time.
12121 An element of the form (t . EVENT) forces EVENT to be added to that list.
12122 An element of the form (no-record . EVENT) means process EVENT, but do not
12123 record it in the keyboard macros, recent-keys, and the dribble file. */);
12124 Vunread_command_events = Qnil;
12125
12126 DEFVAR_LISP ("unread-post-input-method-events", Vunread_post_input_method_events,
12127 doc: /* List of events to be processed as input by input methods.
12128 These events are processed before `unread-command-events'
12129 and actual keyboard input, but are not given to `input-method-function'. */);
12130 Vunread_post_input_method_events = Qnil;
12131
12132 DEFVAR_LISP ("unread-input-method-events", Vunread_input_method_events,
12133 doc: /* List of events to be processed as input by input methods.
12134 These events are processed after `unread-command-events', but
12135 before actual keyboard input.
12136 If there's an active input method, the events are given to
12137 `input-method-function'. */);
12138 Vunread_input_method_events = Qnil;
12139
12140 DEFVAR_LISP ("meta-prefix-char", meta_prefix_char,
12141 doc: /* Meta-prefix character code.
12142 Meta-foo as command input turns into this character followed by foo. */);
12143 XSETINT (meta_prefix_char, 033);
12144
12145 DEFVAR_KBOARD ("last-command", Vlast_command,
12146 doc: /* The last command executed.
12147 Normally a symbol with a function definition, but can be whatever was found
12148 in the keymap, or whatever the variable `this-command' was set to by that
12149 command.
12150
12151 The value `mode-exit' is special; it means that the previous command
12152 read an event that told it to exit, and it did so and unread that event.
12153 In other words, the present command is the event that made the previous
12154 command exit.
12155
12156 The value `kill-region' is special; it means that the previous command
12157 was a kill command.
12158
12159 `last-command' has a separate binding for each terminal device.
12160 See Info node `(elisp)Multiple Terminals'. */);
12161
12162 DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
12163 doc: /* Same as `last-command', but never altered by Lisp code.
12164 Taken from the previous value of `real-this-command'. */);
12165
12166 DEFVAR_KBOARD ("last-repeatable-command", Vlast_repeatable_command,
12167 doc: /* Last command that may be repeated.
12168 The last command executed that was not bound to an input event.
12169 This is the command `repeat' will try to repeat.
12170 Taken from a previous value of `real-this-command'. */);
12171
12172 DEFVAR_LISP ("this-command", Vthis_command,
12173 doc: /* The command now being executed.
12174 The command can set this variable; whatever is put here
12175 will be in `last-command' during the following command. */);
12176 Vthis_command = Qnil;
12177
12178 DEFVAR_LISP ("real-this-command", Vreal_this_command,
12179 doc: /* This is like `this-command', except that commands should never modify it. */);
12180 Vreal_this_command = Qnil;
12181
12182 DEFSYM (Qcurrent_minibuffer_command, "current-minibuffer-command");
12183 DEFVAR_LISP ("current-minibuffer-command", Vcurrent_minibuffer_command,
12184 doc: /* This is like `this-command', but bound recursively.
12185 Code running from (for instance) a minibuffer hook can check this variable
12186 to see what command invoked the current minibuffer. */);
12187 Vcurrent_minibuffer_command = Qnil;
12188
12189 DEFVAR_LISP ("this-command-keys-shift-translated",
12190 Vthis_command_keys_shift_translated,
12191 doc: /* Non-nil if the key sequence activating this command was shift-translated.
12192 Shift-translation occurs when there is no binding for the key sequence
12193 as entered, but a binding was found by changing an upper-case letter
12194 to lower-case, or a shifted function key to an unshifted one. */);
12195 Vthis_command_keys_shift_translated = Qnil;
12196
12197 DEFVAR_LISP ("this-original-command", Vthis_original_command,
12198 doc: /* The command bound to the current key sequence before remapping.
12199 It equals `this-command' if the original command was not remapped through
12200 any of the active keymaps. Otherwise, the value of `this-command' is the
12201 result of looking up the original command in the active keymaps. */);
12202 Vthis_original_command = Qnil;
12203
12204 DEFVAR_INT ("auto-save-interval", auto_save_interval,
12205 doc: /* Number of input events between auto-saves.
12206 Zero means disable autosaving due to number of characters typed. */);
12207 auto_save_interval = 300;
12208
12209 DEFVAR_BOOL ("auto-save-no-message", auto_save_no_message,
12210 doc: /* Non-nil means do not print any message when auto-saving. */);
12211 auto_save_no_message = false;
12212
12213 DEFVAR_LISP ("auto-save-timeout", Vauto_save_timeout,
12214 doc: /* Number of seconds idle time before auto-save.
12215 Zero or nil means disable auto-saving due to idleness.
12216 After auto-saving due to this many seconds of idle time,
12217 Emacs also does a garbage collection if that seems to be warranted. */);
12218 XSETFASTINT (Vauto_save_timeout, 30);
12219
12220 DEFVAR_LISP ("echo-keystrokes", Vecho_keystrokes,
12221 doc: /* Nonzero means echo unfinished commands after this many seconds of pause.
12222 The value may be integer or floating point.
12223 If the value is zero, don't echo at all. */);
12224 Vecho_keystrokes = make_fixnum (1);
12225
12226 DEFVAR_INT ("polling-period", polling_period,
12227 doc: /* Interval between polling for input during Lisp execution.
12228 The reason for polling is to make C-g work to stop a running program.
12229 Polling is needed only when using X windows and SIGIO does not work.
12230 Polling is automatically disabled in all other cases. */);
12231 polling_period = 2;
12232
12233 DEFVAR_LISP ("double-click-time", Vdouble_click_time,
12234 doc: /* Maximum time between mouse clicks to make a double-click.
12235 Measured in milliseconds. The value nil means disable double-click
12236 recognition; t means double-clicks have no time limit and are detected
12237 by position only. */);
12238 Vdouble_click_time = make_fixnum (500);
12239
12240 DEFVAR_INT ("double-click-fuzz", double_click_fuzz,
12241 doc: /* Maximum mouse movement between clicks to make a double-click.
12242 On window-system frames, value is the number of pixels the mouse may have
12243 moved horizontally or vertically between two clicks to make a double-click.
12244 On non window-system frames, value is interpreted in units of 1/8 characters
12245 instead of pixels.
12246
12247 This variable is also the threshold for motion of the mouse
12248 to count as a drag. */);
12249 double_click_fuzz = 3;
12250
12251 DEFVAR_INT ("num-input-keys", num_input_keys,
12252 doc: /* Number of complete key sequences read as input so far.
12253 This includes key sequences read from keyboard macros.
12254 The number is effectively the number of interactive command invocations. */);
12255 num_input_keys = 0;
12256
12257 DEFVAR_INT ("num-nonmacro-input-events", num_nonmacro_input_events,
12258 doc: /* Number of input events read from the keyboard so far.
12259 This does not include events generated by keyboard macros. */);
12260 num_nonmacro_input_events = 0;
12261
12262 DEFVAR_LISP ("last-event-frame", Vlast_event_frame,
12263 doc: /* The frame in which the most recently read event occurred.
12264 If the last event came from a keyboard macro, this is set to `macro'. */);
12265 Vlast_event_frame = Qnil;
12266
12267 /* This variable is set up in sysdep.c. */
12268 DEFVAR_LISP ("tty-erase-char", Vtty_erase_char,
12269 doc: /* The ERASE character as set by the user with stty. */);
12270
12271 DEFVAR_LISP ("help-char", Vhelp_char,
12272 doc: /* Character to recognize as meaning Help.
12273 When it is read, do `(eval help-form)', and display result if it's a string.
12274 If the value of `help-form' is nil, this char can be read normally. */);
12275 XSETINT (Vhelp_char, Ctl ('H'));
12276
12277 DEFVAR_LISP ("help-event-list", Vhelp_event_list,
12278 doc: /* List of input events to recognize as meaning Help.
12279 These work just like the value of `help-char' (see that). */);
12280 Vhelp_event_list = Qnil;
12281
12282 DEFVAR_LISP ("help-form", Vhelp_form,
12283 doc: /* Form to execute when character `help-char' is read.
12284 If the form returns a string, that string is displayed.
12285 If `help-form' is nil, the help char is not recognized. */);
12286 Vhelp_form = Qnil;
12287
12288 DEFVAR_LISP ("prefix-help-command", Vprefix_help_command,
12289 doc: /* Command to run when `help-char' character follows a prefix key.
12290 This command is used only when there is no actual binding
12291 for that character after that prefix key. */);
12292 Vprefix_help_command = Qnil;
12293
12294 DEFVAR_LISP ("top-level", Vtop_level,
12295 doc: /* Form to evaluate when Emacs starts up.
12296 Useful to set before you dump a modified Emacs. */);
12297 Vtop_level = Qnil;
12298 XSYMBOL (Qtop_level)->u.s.declared_special = false;
12299
12300 DEFVAR_KBOARD ("keyboard-translate-table", Vkeyboard_translate_table,
12301 doc: /* Translate table for local keyboard input, or nil.
12302 If non-nil, the value should be a char-table. Each character read
12303 from the keyboard is looked up in this char-table. If the value found
12304 there is non-nil, then it is used instead of the actual input character.
12305
12306 The value can also be a string or vector, but this is considered obsolete.
12307 If it is a string or vector of length N, character codes N and up are left
12308 untranslated. In a vector, an element which is nil means "no translation".
12309
12310 This is applied to the characters supplied to input methods, not their
12311 output. See also `translation-table-for-input'.
12312
12313 This variable has a separate binding for each terminal.
12314 See Info node `(elisp)Multiple Terminals'. */);
12315
12316 DEFVAR_BOOL ("cannot-suspend", cannot_suspend,
12317 doc: /* Non-nil means to always spawn a subshell instead of suspending.
12318 \(Even if the operating system has support for stopping a process.) */);
12319 cannot_suspend = false;
12320
12321 DEFVAR_BOOL ("menu-prompting", menu_prompting,
12322 doc: /* Non-nil means prompt with menus when appropriate.
12323 This is done when reading from a keymap that has a prompt string,
12324 for elements that have prompt strings.
12325 The menu is displayed on the screen
12326 if X menus were enabled at configuration
12327 time and the previous event was a mouse click prefix key.
12328 Otherwise, menu prompting uses the echo area. */);
12329 menu_prompting = true;
12330
12331 DEFVAR_LISP ("menu-prompt-more-char", menu_prompt_more_char,
12332 doc: /* Character to see next line of menu prompt.
12333 Type this character while in a menu prompt to rotate around the lines of it. */);
12334 XSETINT (menu_prompt_more_char, ' ');
12335
12336 DEFVAR_INT ("extra-keyboard-modifiers", extra_keyboard_modifiers,
12337 doc: /* A mask of additional modifier keys to use with every keyboard character.
12338 Emacs applies the modifiers of the character stored here to each keyboard
12339 character it reads. For example, after evaluating the expression
12340 (setq extra-keyboard-modifiers ?\\C-x)
12341 all input characters will have the control modifier applied to them.
12342
12343 Note that the character ?\\C-@, equivalent to the integer zero, does
12344 not count as a control character; rather, it counts as a character
12345 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero
12346 cancels any modification. */);
12347 extra_keyboard_modifiers = 0;
12348
12349 DEFSYM (Qdeactivate_mark, "deactivate-mark");
12350 DEFVAR_LISP ("deactivate-mark", Vdeactivate_mark,
12351 doc: /* If an editing command sets this to t, deactivate the mark afterward.
12352 The command loop sets this to nil before each command,
12353 and tests the value when the command returns.
12354 Buffer modification stores t in this variable. */);
12355 Vdeactivate_mark = Qnil;
12356 Fmake_variable_buffer_local (Qdeactivate_mark);
12357
12358 DEFVAR_LISP ("pre-command-hook", Vpre_command_hook,
12359 doc: /* Normal hook run before each command is executed.
12360 If an unhandled error happens in running this hook,
12361 the function in which the error occurred is unconditionally removed, since
12362 otherwise the error might happen repeatedly and make Emacs nonfunctional.
12363
12364 See also `post-command-hook'. */);
12365 Vpre_command_hook = Qnil;
12366
12367 DEFVAR_LISP ("post-command-hook", Vpost_command_hook,
12368 doc: /* Normal hook run after each command is executed.
12369 If an unhandled error happens in running this hook,
12370 the function in which the error occurred is unconditionally removed, since
12371 otherwise the error might happen repeatedly and make Emacs nonfunctional.
12372
12373 It is a bad idea to use this hook for expensive processing. If
12374 unavoidable, wrap your code in `(while-no-input (redisplay) CODE)' to
12375 avoid making Emacs unresponsive while the user types.
12376
12377 See also `pre-command-hook'. */);
12378 Vpost_command_hook = Qnil;
12379
12380 #if 0
12381 DEFVAR_LISP ("echo-area-clear-hook", ...,
12382 doc: /* Normal hook run when clearing the echo area. */);
12383 #endif
12384 DEFSYM (Qecho_area_clear_hook, "echo-area-clear-hook");
12385 DEFSYM (Qtouchscreen_begin, "touchscreen-begin");
12386 DEFSYM (Qtouchscreen_end, "touchscreen-end");
12387 DEFSYM (Qtouchscreen_update, "touchscreen-update");
12388 DEFSYM (Qpinch, "pinch");
12389 Fset (Qecho_area_clear_hook, Qnil);
12390
12391 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", Vlucid_menu_bar_dirty_flag,
12392 doc: /* Non-nil means menu bar, specified Lucid style, needs to be recomputed. */);
12393 Vlucid_menu_bar_dirty_flag = Qnil;
12394
12395 DEFVAR_LISP ("menu-bar-final-items", Vmenu_bar_final_items,
12396 doc: /* List of menu bar items to move to the end of the menu bar.
12397 The elements of the list are event types that may have menu bar
12398 bindings. The order of this list controls the order of the items. */);
12399 Vmenu_bar_final_items = Qnil;
12400
12401 DEFVAR_LISP ("tab-bar-separator-image-expression", Vtab_bar_separator_image_expression,
12402 doc: /* Expression evaluating to the image spec for a tab-bar separator.
12403 This is used internally by graphical displays that do not render
12404 tab-bar separators natively. Otherwise it is unused (e.g. on GTK). */);
12405 Vtab_bar_separator_image_expression = Qnil;
12406
12407 DEFVAR_LISP ("tool-bar-separator-image-expression", Vtool_bar_separator_image_expression,
12408 doc: /* Expression evaluating to the image spec for a tool-bar separator.
12409 This is used internally by graphical displays that do not render
12410 tool-bar separators natively. Otherwise it is unused (e.g. on GTK). */);
12411 Vtool_bar_separator_image_expression = Qnil;
12412
12413 DEFVAR_KBOARD ("overriding-terminal-local-map",
12414 Voverriding_terminal_local_map,
12415 doc: /* Per-terminal keymap that takes precedence over all other keymaps.
12416 This variable is intended to let commands such as `universal-argument'
12417 set up a different keymap for reading the next command.
12418
12419 `overriding-terminal-local-map' has a separate binding for each
12420 terminal device. See Info node `(elisp)Multiple Terminals'. */);
12421
12422 DEFVAR_LISP ("overriding-local-map", Voverriding_local_map,
12423 doc: /* Keymap that replaces (overrides) local keymaps.
12424 If this variable is non-nil, Emacs looks up key bindings in this
12425 keymap INSTEAD OF `keymap' text properties, `local-map' and `keymap'
12426 overlay properties, minor mode maps, and the buffer's local map.
12427
12428 Hence, the only active keymaps would be `overriding-terminal-local-map',
12429 this keymap, and `global-keymap', in order of precedence. */);
12430 Voverriding_local_map = Qnil;
12431
12432 DEFVAR_LISP ("overriding-local-map-menu-flag", Voverriding_local_map_menu_flag,
12433 doc: /* Non-nil means `overriding-local-map' applies to the menu bar.
12434 Otherwise, the menu bar continues to reflect the buffer's local map
12435 and the minor mode maps regardless of `overriding-local-map'. */);
12436 Voverriding_local_map_menu_flag = Qnil;
12437
12438 DEFVAR_LISP ("special-event-map", Vspecial_event_map,
12439 doc: /* Keymap defining bindings for special events to execute at low level. */);
12440 Vspecial_event_map = list1 (Qkeymap);
12441
12442 DEFVAR_LISP ("track-mouse", track_mouse,
12443 doc: /* Non-nil means generate motion events for mouse motion.
12444 The special values `dragging' and `dropping' assert that the mouse
12445 cursor retains its appearance during mouse motion. Any non-nil value
12446 but `dropping' asserts that motion events always relate to the frame
12447 where the mouse movement started. The value `dropping' asserts
12448 that motion events relate to the frame where the mouse cursor is seen
12449 when generating the event. If there's no such frame, such motion
12450 events relate to the frame where the mouse movement started. */);
12451
12452 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
12453 doc: /* Alist of system-specific X windows key symbols.
12454 Each element should have the form (N . SYMBOL) where N is the
12455 numeric keysym code (sans the \"system-specific\" bit 1<<28)
12456 and SYMBOL is its name.
12457
12458 `system-key-alist' has a separate binding for each terminal device.
12459 See Info node `(elisp)Multiple Terminals'. */);
12460
12461 DEFVAR_KBOARD ("local-function-key-map", Vlocal_function_key_map,
12462 doc: /* Keymap that translates key sequences to key sequences during input.
12463 This is used mainly for mapping key sequences into some preferred
12464 key events (symbols).
12465
12466 The `read-key-sequence' function replaces any subsequence bound by
12467 `local-function-key-map' with its binding. More precisely, when the
12468 active keymaps have no binding for the current key sequence but
12469 `local-function-key-map' binds a suffix of the sequence to a vector or
12470 string, `read-key-sequence' replaces the matching suffix with its
12471 binding, and continues with the new sequence.
12472
12473 If the binding is a function, it is called with one argument (the prompt)
12474 and its return value (a key sequence) is used.
12475
12476 The events that come from bindings in `local-function-key-map' are not
12477 themselves looked up in `local-function-key-map'.
12478
12479 For example, suppose `local-function-key-map' binds `ESC O P' to [f1].
12480 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
12481 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix key,
12482 typing `ESC O P x' would return [f1 x].
12483
12484 `local-function-key-map' has a separate binding for each terminal
12485 device. See Info node `(elisp)Multiple Terminals'. If you need to
12486 define a binding on all terminals, change `function-key-map'
12487 instead. Initially, `local-function-key-map' is an empty keymap that
12488 has `function-key-map' as its parent on all terminal devices. */);
12489
12490 DEFVAR_KBOARD ("input-decode-map", Vinput_decode_map,
12491 doc: /* Keymap that decodes input escape sequences.
12492 This is used mainly for mapping ASCII function key sequences into
12493 real Emacs function key events (symbols).
12494
12495 The `read-key-sequence' function replaces any subsequence bound by
12496 `input-decode-map' with its binding. Contrary to `function-key-map',
12497 this map applies its rebinding regardless of the presence of an ordinary
12498 binding. So it is more like `key-translation-map' except that it applies
12499 before `function-key-map' rather than after.
12500
12501 If the binding is a function, it is called with one argument (the prompt)
12502 and its return value (a key sequence) is used.
12503
12504 The events that come from bindings in `input-decode-map' are not
12505 themselves looked up in `input-decode-map'. */);
12506
12507 DEFVAR_LISP ("function-key-map", Vfunction_key_map,
12508 doc: /* The parent keymap of all `local-function-key-map' instances.
12509 Function key definitions that apply to all terminal devices should go
12510 here. If a mapping is defined in both the current
12511 `local-function-key-map' binding and this variable, then the local
12512 definition will take precedence. */);
12513 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
12514
12515 DEFVAR_LISP ("key-translation-map", Vkey_translation_map,
12516 doc: /* Keymap of key translations that can override keymaps.
12517 This keymap works like `input-decode-map', but comes after `function-key-map'.
12518 Another difference is that it is global rather than terminal-local. */);
12519 Vkey_translation_map = Fmake_sparse_keymap (Qnil);
12520
12521 DEFVAR_LISP ("deferred-action-list", Vdeferred_action_list,
12522 doc: /* List of deferred actions to be performed at a later time.
12523 The precise format isn't relevant here; we just check whether it is nil. */);
12524 Vdeferred_action_list = Qnil;
12525
12526 DEFVAR_LISP ("deferred-action-function", Vdeferred_action_function,
12527 doc: /* Function to call to handle deferred actions, after each command.
12528 This function is called with no arguments after each command
12529 whenever `deferred-action-list' is non-nil. */);
12530 Vdeferred_action_function = Qnil;
12531
12532 DEFVAR_LISP ("delayed-warnings-list", Vdelayed_warnings_list,
12533 doc: /* List of warnings to be displayed after this command.
12534 Each element must be a list (TYPE MESSAGE [LEVEL [BUFFER-NAME]]),
12535 as per the args of `display-warning' (which see).
12536 If this variable is non-nil, `delayed-warnings-hook' will be run
12537 immediately after running `post-command-hook'. */);
12538 Vdelayed_warnings_list = Qnil;
12539
12540 DEFVAR_LISP ("timer-list", Vtimer_list,
12541 doc: /* List of active absolute time timers in order of increasing time. */);
12542 Vtimer_list = Qnil;
12543
12544 DEFVAR_LISP ("timer-idle-list", Vtimer_idle_list,
12545 doc: /* List of active idle-time timers in order of increasing time. */);
12546 Vtimer_idle_list = Qnil;
12547
12548 DEFVAR_LISP ("input-method-function", Vinput_method_function,
12549 doc: /* If non-nil, the function that implements the current input method.
12550 It's called with one argument, which must be a single-byte
12551 character that was just read. Any single-byte character is
12552 acceptable, except the DEL character, codepoint 127 decimal, 177 octal.
12553 Typically this function uses `read-event' to read additional events.
12554 When it does so, it should first bind `input-method-function' to nil
12555 so it will not be called recursively.
12556
12557 The function should return a list of zero or more events
12558 to be used as input. If it wants to put back some events
12559 to be reconsidered, separately, by the input method,
12560 it can add them to the beginning of `unread-command-events'.
12561
12562 The input method function can find in `input-method-previous-message'
12563 the previous echo area message.
12564
12565 The input method function should refer to the variables
12566 `input-method-use-echo-area' and `input-method-exit-on-first-char'
12567 for guidance on what to do. */);
12568 Vinput_method_function = Qlist;
12569
12570 DEFVAR_LISP ("input-method-previous-message",
12571 Vinput_method_previous_message,
12572 doc: /* When `input-method-function' is called, hold the previous echo area message.
12573 This variable exists because `read-event' clears the echo area
12574 before running the input method. It is nil if there was no message. */);
12575 Vinput_method_previous_message = Qnil;
12576
12577 DEFVAR_LISP ("show-help-function", Vshow_help_function,
12578 doc: /* If non-nil, the function that implements the display of help.
12579 It's called with one argument, the help string to display. */);
12580 Vshow_help_function = Qnil;
12581
12582 DEFVAR_LISP ("disable-point-adjustment", Vdisable_point_adjustment,
12583 doc: /* If non-nil, suppress point adjustment after executing a command.
12584
12585 After a command is executed, if point moved into a region that has
12586 special properties (e.g. composition, display), Emacs adjusts point to
12587 the boundary of the region. But when a command leaves this variable at
12588 a non-nil value (e.g., with a setq), this point adjustment is suppressed.
12589
12590 This variable is set to nil before reading a command, and is checked
12591 just after executing the command. */);
12592 Vdisable_point_adjustment = Qnil;
12593
12594 DEFVAR_LISP ("global-disable-point-adjustment",
12595 Vglobal_disable_point_adjustment,
12596 doc: /* If non-nil, always suppress point adjustments.
12597
12598 The default value is nil, in which case point adjustments are
12599 suppressed only after special commands that leave
12600 `disable-point-adjustment' (which see) at a non-nil value. */);
12601 Vglobal_disable_point_adjustment = Qnil;
12602
12603 DEFVAR_LISP ("minibuffer-message-timeout", Vminibuffer_message_timeout,
12604 doc: /* How long to display an echo-area message when the minibuffer is active.
12605 If the value is a number, it should be specified in seconds.
12606 If the value is not a number, such messages never time out. */);
12607 Vminibuffer_message_timeout = make_fixnum (2);
12608
12609 DEFVAR_LISP ("throw-on-input", Vthrow_on_input,
12610 doc: /* If non-nil, any keyboard input throws to this symbol.
12611 The value of that variable is passed to `quit-flag' and later causes a
12612 peculiar kind of quitting. */);
12613 Vthrow_on_input = Qnil;
12614
12615 DEFVAR_LISP ("command-error-function", Vcommand_error_function,
12616 doc: /* Function to output error messages.
12617 Called with three arguments:
12618 - the error data, a list of the form (SIGNALED-CONDITION . SIGNAL-DATA)
12619 such as what `condition-case' would bind its variable to,
12620 - the context (a string which normally goes at the start of the message),
12621 - the Lisp function within which the error was signaled.
12622
12623 Also see `set-message-function' (which controls how non-error messages
12624 are displayed). */);
12625 Vcommand_error_function = intern ("command-error-default-function");
12626
12627 DEFVAR_LISP ("enable-disabled-menus-and-buttons",
12628 Venable_disabled_menus_and_buttons,
12629 doc: /* If non-nil, don't ignore events produced by disabled menu items and tool-bar.
12630
12631 Help functions bind this to allow help on disabled menu items
12632 and tool-bar buttons. */);
12633 Venable_disabled_menus_and_buttons = Qnil;
12634
12635 DEFVAR_LISP ("select-active-regions",
12636 Vselect_active_regions,
12637 doc: /* If non-nil, an active region automatically sets the primary selection.
12638 If the value is `only', only temporarily active regions (usually made
12639 by mouse-dragging or shift-selection) set the window selection.
12640
12641 This takes effect only when Transient Mark mode is enabled. */);
12642 Vselect_active_regions = Qt;
12643
12644 DEFVAR_LISP ("saved-region-selection",
12645 Vsaved_region_selection,
12646 doc: /* Contents of active region prior to buffer modification.
12647 If `select-active-regions' is non-nil, Emacs sets this to the
12648 text in the region before modifying the buffer. The next call to
12649 the function `deactivate-mark' uses this to set the window selection. */);
12650 Vsaved_region_selection = Qnil;
12651
12652 DEFVAR_LISP ("selection-inhibit-update-commands",
12653 Vselection_inhibit_update_commands,
12654 doc: /* List of commands which should not update the selection.
12655 Normally, if `select-active-regions' is non-nil and the mark remains
12656 active after a command (i.e. the mark was not deactivated), the Emacs
12657 command loop sets the selection to the text in the region. However,
12658 if the command is in this list, the selection is not updated. */);
12659 Vselection_inhibit_update_commands
12660 = list2 (Qhandle_switch_frame, Qhandle_select_window);
12661
12662 DEFVAR_LISP ("debug-on-event",
12663 Vdebug_on_event,
12664 doc: /* Enter debugger on this event.
12665 When Emacs receives the special event specified by this variable,
12666 it will try to break into the debugger as soon as possible instead
12667 of processing the event normally through `special-event-map'.
12668
12669 Currently, the only supported values for this
12670 variable are `sigusr1' and `sigusr2'. */);
12671 Vdebug_on_event = intern_c_string ("sigusr2");
12672
12673 DEFVAR_BOOL ("attempt-stack-overflow-recovery",
12674 attempt_stack_overflow_recovery,
12675 doc: /* If non-nil, attempt to recover from C stack overflows.
12676 This recovery is potentially unsafe and may lead to deadlocks or data
12677 corruption, but it usually works and may preserve modified buffers
12678 that would otherwise be lost. If nil, treat stack overflow like any
12679 other kind of crash or fatal error. */);
12680 attempt_stack_overflow_recovery = true;
12681
12682 DEFVAR_BOOL ("attempt-orderly-shutdown-on-fatal-signal",
12683 attempt_orderly_shutdown_on_fatal_signal,
12684 doc: /* If non-nil, attempt orderly shutdown on fatal signals.
12685 By default this variable is non-nil, and Emacs attempts to perform
12686 an orderly shutdown when it catches a fatal signal (e.g., a crash).
12687 The orderly shutdown includes an attempt to auto-save your unsaved edits
12688 and other useful cleanups. These cleanups are potentially unsafe and may
12689 lead to deadlocks or data corruption, but it usually works and may
12690 preserve data in modified buffers that would otherwise be lost.
12691 If nil, Emacs crashes immediately in response to fatal signals. */);
12692 attempt_orderly_shutdown_on_fatal_signal = true;
12693
12694 DEFVAR_LISP ("while-no-input-ignore-events",
12695 Vwhile_no_input_ignore_events,
12696 doc: /* Ignored events from `while-no-input'.
12697 Events in this list do not count as pending input while running
12698 `while-no-input' and do not cause any idle timers to get reset when they
12699 occur. */);
12700 Vwhile_no_input_ignore_events = init_while_no_input_ignore_events ();
12701
12702 DEFVAR_BOOL ("translate-upper-case-key-bindings",
12703 translate_upper_case_key_bindings,
12704 doc: /* If non-nil, interpret upper case keys as lower case (when applicable).
12705 Emacs allows binding both upper and lower case key sequences to
12706 commands. However, if there is a lower case key sequence bound to a
12707 command, and the user enters an upper case key sequence that is not
12708 bound to a command, Emacs will use the lower case binding. Setting
12709 this variable to nil inhibits this behaviour. */);
12710 translate_upper_case_key_bindings = true;
12711
12712 DEFVAR_BOOL ("input-pending-p-filter-events",
12713 input_pending_p_filter_events,
12714 doc: /* If non-nil, `input-pending-p' ignores some input events.
12715 If this variable is non-nil (the default), `input-pending-p' and
12716 other similar functions ignore input events in `while-no-input-ignore-events'.
12717 This flag may eventually be removed once this behavior is deemed safe. */);
12718 input_pending_p_filter_events = true;
12719
12720 DEFVAR_BOOL ("mwheel-coalesce-scroll-events", mwheel_coalesce_scroll_events,
12721 doc: /* Non-nil means send a wheel event only for scrolling at least one screen line.
12722 Otherwise, a wheel event will be sent every time the mouse wheel is
12723 moved. */);
12724 mwheel_coalesce_scroll_events = true;
12725
12726 pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper);
12727 }
12728
12729 static void
syms_of_keyboard_for_pdumper(void)12730 syms_of_keyboard_for_pdumper (void)
12731 {
12732 /* Make sure input state is pristine when restoring from a dump.
12733 init_keyboard() also resets some of these, but the duplication
12734 doesn't hurt and makes sure that allocate_kboard and subsequent
12735 early init functions see the environment they expect. */
12736
12737 PDUMPER_RESET_LV (pending_funcalls, Qnil);
12738 PDUMPER_RESET_LV (unread_switch_frame, Qnil);
12739 PDUMPER_RESET_LV (internal_last_event_frame, Qnil);
12740 PDUMPER_RESET_LV (last_command_event, Qnil);
12741 PDUMPER_RESET_LV (last_nonmenu_event, Qnil);
12742 PDUMPER_RESET_LV (last_input_event, Qnil);
12743 PDUMPER_RESET_LV (Vunread_command_events, Qnil);
12744 PDUMPER_RESET_LV (Vunread_post_input_method_events, Qnil);
12745 PDUMPER_RESET_LV (Vunread_input_method_events, Qnil);
12746 PDUMPER_RESET_LV (Vthis_command, Qnil);
12747 PDUMPER_RESET_LV (Vreal_this_command, Qnil);
12748 PDUMPER_RESET_LV (Vthis_command_keys_shift_translated, Qnil);
12749 PDUMPER_RESET_LV (Vthis_original_command, Qnil);
12750 PDUMPER_RESET (num_input_keys, 0);
12751 PDUMPER_RESET (num_nonmacro_input_events, 0);
12752 PDUMPER_RESET_LV (Vlast_event_frame, Qnil);
12753 PDUMPER_RESET_LV (Vdeferred_action_list, Qnil);
12754 PDUMPER_RESET_LV (Vdelayed_warnings_list, Qnil);
12755
12756 /* Create the initial keyboard. Qt means 'unset'. */
12757 eassert (initial_kboard == NULL);
12758 initial_kboard = allocate_kboard (Qt);
12759 }
12760
12761 void
keys_of_keyboard(void)12762 keys_of_keyboard (void)
12763 {
12764 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
12765 "handle-delete-frame");
12766 #ifdef HAVE_NTGUI
12767 initial_define_lispy_key (Vspecial_event_map, "end-session",
12768 "kill-emacs");
12769 #endif
12770 initial_define_lispy_key (Vspecial_event_map, "ns-put-working-text",
12771 "ns-put-working-text");
12772 initial_define_lispy_key (Vspecial_event_map, "ns-unput-working-text",
12773 "ns-unput-working-text");
12774 initial_define_lispy_key (Vspecial_event_map, "pgtk-preedit-text",
12775 "pgtk-preedit-text");
12776 /* Here we used to use `ignore-event' which would simple set prefix-arg to
12777 current-prefix-arg, as is done in `handle-switch-frame'.
12778 But `handle-switch-frame is not run from the special-map.
12779 Commands from that map are run in a special way that automatically
12780 preserves the prefix-arg. Restoring the prefix arg here is not just
12781 redundant but harmful:
12782 - C-u C-x v =
12783 - current-prefix-arg is set to non-nil, prefix-arg is set to nil.
12784 - after the first prompt, the exit-minibuffer-hook is run which may
12785 iconify a frame and thus push a `iconify-frame' event.
12786 - after running exit-minibuffer-hook, current-prefix-arg is
12787 restored to the non-nil value it had before the prompt.
12788 - we enter the second prompt.
12789 current-prefix-arg is non-nil, prefix-arg is nil.
12790 - before running the first real event, we run the special iconify-frame
12791 event, but we pass the `special' arg to command-execute so
12792 current-prefix-arg and prefix-arg are left untouched.
12793 - here we foolishly copy the non-nil current-prefix-arg to prefix-arg.
12794 - the next key event will have a spuriously non-nil current-prefix-arg. */
12795 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
12796 "ignore");
12797 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
12798 "ignore");
12799 /* Handling it at such a low-level causes read_key_sequence to get
12800 * confused because it doesn't realize that the current_buffer was
12801 * changed by read_char.
12802 *
12803 * initial_define_lispy_key (Vspecial_event_map, "select-window",
12804 * "handle-select-window"); */
12805 initial_define_lispy_key (Vspecial_event_map, "save-session",
12806 "handle-save-session");
12807
12808 #ifdef HAVE_DBUS
12809 /* Define a special event which is raised for dbus callback
12810 functions. */
12811 initial_define_lispy_key (Vspecial_event_map, "dbus-event",
12812 "dbus-handle-event");
12813 #endif
12814
12815 #ifdef THREADS_ENABLED
12816 /* Define a special event which is raised for thread signals. */
12817 initial_define_lispy_key (Vspecial_event_map, "thread-event",
12818 "thread-handle-event");
12819 #endif
12820
12821 #ifdef USE_FILE_NOTIFY
12822 /* Define a special event which is raised for notification callback
12823 functions. */
12824 initial_define_lispy_key (Vspecial_event_map, "file-notify",
12825 "file-notify-handle-event");
12826 #endif /* USE_FILE_NOTIFY */
12827
12828 initial_define_lispy_key (Vspecial_event_map, "config-changed-event",
12829 "ignore");
12830 #if defined (WINDOWSNT)
12831 initial_define_lispy_key (Vspecial_event_map, "language-change",
12832 "ignore");
12833 #endif
12834 initial_define_lispy_key (Vspecial_event_map, "focus-in",
12835 "handle-focus-in");
12836 initial_define_lispy_key (Vspecial_event_map, "focus-out",
12837 "handle-focus-out");
12838 initial_define_lispy_key (Vspecial_event_map, "move-frame",
12839 "handle-move-frame");
12840 }
12841
12842 /* Mark the pointers in the kboard objects.
12843 Called by Fgarbage_collect. */
12844 void
mark_kboards(void)12845 mark_kboards (void)
12846 {
12847 for (KBOARD *kb = all_kboards; kb; kb = kb->next_kboard)
12848 {
12849 if (kb->kbd_macro_buffer)
12850 mark_objects (kb->kbd_macro_buffer,
12851 kb->kbd_macro_ptr - kb->kbd_macro_buffer);
12852 mark_object (KVAR (kb, Voverriding_terminal_local_map));
12853 mark_object (KVAR (kb, Vlast_command));
12854 mark_object (KVAR (kb, Vreal_last_command));
12855 mark_object (KVAR (kb, Vkeyboard_translate_table));
12856 mark_object (KVAR (kb, Vlast_repeatable_command));
12857 mark_object (KVAR (kb, Vprefix_arg));
12858 mark_object (KVAR (kb, Vlast_prefix_arg));
12859 mark_object (KVAR (kb, kbd_queue));
12860 mark_object (KVAR (kb, defining_kbd_macro));
12861 mark_object (KVAR (kb, Vlast_kbd_macro));
12862 mark_object (KVAR (kb, Vsystem_key_alist));
12863 mark_object (KVAR (kb, system_key_syms));
12864 mark_object (KVAR (kb, Vwindow_system));
12865 mark_object (KVAR (kb, Vinput_decode_map));
12866 mark_object (KVAR (kb, Vlocal_function_key_map));
12867 mark_object (KVAR (kb, Vdefault_minibuffer_frame));
12868 mark_object (KVAR (kb, echo_string));
12869 mark_object (KVAR (kb, echo_prompt));
12870 }
12871
12872 for (union buffered_input_event *event = kbd_fetch_ptr;
12873 event != kbd_store_ptr; event = next_kbd_event (event))
12874 {
12875 /* These two special event types have no Lisp_Objects to mark. */
12876 if (event->kind != SELECTION_REQUEST_EVENT
12877 && event->kind != SELECTION_CLEAR_EVENT)
12878 {
12879 mark_object (event->ie.x);
12880 mark_object (event->ie.y);
12881 mark_object (event->ie.frame_or_window);
12882 mark_object (event->ie.arg);
12883 }
12884 }
12885 }
12886