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