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