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