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