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