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 (&copy);
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 (&copy);
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 (&regular_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