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