Fix problems caused by the last rebase.
[emacs.git] / src / keyboard.c
blob696e3f6d4f9d2e7a959a106839560e5c2b887478
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 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
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.
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.
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/>. */
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 <setjmp.h>
46 #include <errno.h>
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 */
58 #include "syssignal.h"
60 #include <sys/types.h>
61 #ifdef HAVE_UNISTD_H
62 #include <unistd.h>
63 #endif
65 #ifdef HAVE_FCNTL_H
66 #include <fcntl.h>
67 #endif
69 /* This is to get the definitions of the XK_ symbols. */
70 #ifdef HAVE_X_WINDOWS
71 #include "xterm.h"
72 #endif
74 #ifdef HAVE_NTGUI
75 #include "w32term.h"
76 #endif /* HAVE_NTGUI */
78 #ifdef HAVE_NS
79 #include "nsterm.h"
80 #endif
82 #ifndef USE_CRT_DLL
83 extern int errno;
84 #endif
86 /* Variables for blockinput.h: */
88 /* Non-zero if interrupt input is blocked right now. */
89 volatile int interrupt_input_blocked;
91 /* Nonzero means an input interrupt has arrived
92 during the current critical section. */
93 int interrupt_input_pending;
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
104 #define KBD_BUFFER_SIZE 4096
106 KBOARD *initial_kboard;
107 KBOARD *current_kboard;
108 KBOARD *all_kboards;
109 int single_kboard;
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;
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 */
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;
128 /* 1 after calling Freset_this_command_lengths.
129 Usually it is 0. */
130 int this_command_key_count_reset;
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;
137 /* Non-nil if the present key sequence was obtained by shift translation. */
138 Lisp_Object impl_Vthis_command_keys_shift_translated;
140 #define GROW_RAW_KEYBUF \
141 if (raw_keybuf_count == XVECTOR (raw_keybuf)->size) \
142 raw_keybuf = larger_vector (raw_keybuf, raw_keybuf_count * 2, Qnil) \
144 /* Number of elements of this_command_keys
145 that precede this key sequence. */
146 int this_single_command_key_start;
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;
153 extern int minbuf_level;
155 extern int message_enable_multibyte;
157 /* If non-nil, the function that implements the display of help.
158 It's called with one argument, the help string to display. */
160 Lisp_Object impl_Vshow_help_function;
162 /* Nonzero means do menu prompting. */
164 static int menu_prompting;
166 /* Character to see next line of menu prompt. */
168 static Lisp_Object impl_menu_prompt_more_char;
170 /* For longjmp to where kbd input is being done. */
172 static jmp_buf getcjmp;
174 /* True while doing kbd input. */
175 int waiting_for_input;
177 /* True while displaying for echoing. Delays C-g throwing. */
179 int echoing;
181 /* Non-null means we can start echoing at the next input pause even
182 though there is something in the echo area. */
184 static struct kboard *ok_to_echo_at_next_pause;
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. */
191 struct kboard *echo_kboard;
193 /* The buffer used for echoing. Set in echo_now, reset in
194 cancel_echoing. */
196 Lisp_Object echo_message_buffer;
198 /* Nonzero means disregard local maps for the menu bar. */
199 static int inhibit_local_menu_bar_menus;
201 /* Nonzero means C-g should cause immediate error-signal. */
202 int immediate_quit;
204 /* The user's hook function for outputting an error message. */
205 Lisp_Object impl_Vcommand_error_function;
207 /* The user's ERASE setting. */
208 Lisp_Object impl_Vtty_erase_char;
210 /* Character to recognize as the help char. */
211 Lisp_Object impl_Vhelp_char;
213 /* List of other event types to recognize as meaning "help". */
214 Lisp_Object impl_Vhelp_event_list;
216 /* Form to execute when help char is typed. */
217 Lisp_Object impl_Vhelp_form;
219 /* Command to run when the help character follows a prefix key. */
220 Lisp_Object impl_Vprefix_help_command;
222 /* List of items that should move to the end of the menu bar. */
223 Lisp_Object impl_Vmenu_bar_final_items;
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 impl_Vsuggest_key_bindings;
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 impl_Vminibuffer_message_timeout;
235 /* Character that causes a quit. Normally C-g.
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.
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.
249 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
250 ASCII character. */
251 int quit_char;
253 extern Lisp_Object current_global_map;
254 extern int minibuf_level;
256 /* If non-nil, this is a map that overrides all other local maps. */
257 Lisp_Object impl_Voverriding_local_map;
259 /* If non-nil, Voverriding_local_map applies to the menu bar. */
260 Lisp_Object impl_Voverriding_local_map_menu_flag;
262 /* Keymap that defines special misc events that should
263 be processed immediately at a low level. */
264 Lisp_Object impl_Vspecial_event_map;
266 /* Current depth in recursive edits. */
267 int command_loop_level;
269 /* Total number of times command_loop has read a key sequence. */
270 EMACS_INT num_input_keys;
272 /* Last input event read as a command. */
273 Lisp_Object impl_last_command_event;
275 /* Last input character read as a command, not counting menus
276 reached by the mouse. */
277 Lisp_Object impl_last_nonmenu_event;
279 /* Last input event read for any purpose. */
280 Lisp_Object impl_last_input_event;
282 /* If not Qnil, a list of objects to be read as subsequent command input. */
283 Lisp_Object impl_Vunread_command_events;
285 /* If not Qnil, a list of objects to be read as subsequent command input
286 including input method processing. */
287 Lisp_Object impl_Vunread_input_method_events;
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 impl_Vunread_post_input_method_events;
293 /* If not -1, an event to be read as subsequent command input. */
294 EMACS_INT unread_command_char;
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.
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;
305 /* A mask of extra modifier bits to put into every keyboard char. */
306 EMACS_INT extra_keyboard_modifiers;
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. */
311 Lisp_Object impl_meta_prefix_char;
313 /* Last size recorded for a current buffer which is not a minibuffer. */
314 static int last_non_minibuf_size;
316 /* Number of idle seconds before an auto-save and garbage collection. */
317 static Lisp_Object impl_Vauto_save_timeout;
319 /* Total number of times read_char has returned. */
320 int num_input_events;
322 /* Total number of times read_char has returned, outside of macros. */
323 EMACS_INT num_nonmacro_input_events;
325 /* Auto-save automatically when this many characters have been typed
326 since the last time. */
328 static EMACS_INT auto_save_interval;
330 /* Value of num_nonmacro_input_events as of last auto save. */
332 int last_auto_save;
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 impl_Vthis_command;
339 /* This is like Vthis_command, except that commands never set it. */
340 Lisp_Object real_this_command;
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 impl_Vthis_original_command;
346 /* The value of point when the last command was started. */
347 int last_point_position;
349 /* The buffer that was current when the last command was started. */
350 Lisp_Object last_point_position_buffer;
352 /* The window that was selected when the last command was started. */
353 Lisp_Object last_point_position_window;
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;
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 impl_Vlast_event_frame;
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;
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;
377 /* read_key_sequence stores here the command definition of the
378 key sequence that it reads. */
379 Lisp_Object read_key_sequence_cmd;
381 /* Echo unfinished commands after this many seconds of pause. */
382 Lisp_Object impl_Vecho_keystrokes;
384 /* Form to evaluate (if non-nil) when Emacs is started. */
385 Lisp_Object impl_Vtop_level;
387 /* If non-nil, this implements the current input method. */
388 Lisp_Object impl_Vinput_method_function;
389 Lisp_Object Qinput_method_function;
391 /* When we call Vinput_method_function,
392 this holds the echo area message that was just erased. */
393 Lisp_Object impl_Vinput_method_previous_message;
395 /* Non-nil means deactivate the mark at end of this command. */
396 Lisp_Object impl_Vdeactivate_mark;
397 Lisp_Object Qdeactivate_mark;
399 /* Menu bar specified in Lucid Emacs fashion. */
401 Lisp_Object impl_Vlucid_menu_bar_dirty_flag;
402 Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
404 Lisp_Object Qecho_area_clear_hook;
406 /* Hooks to run before and after each command. */
407 Lisp_Object Qpre_command_hook, impl_Vpre_command_hook;
408 Lisp_Object Qpost_command_hook, impl_Vpost_command_hook;
409 Lisp_Object Qcommand_hook_internal, impl_Vcommand_hook_internal;
411 /* Parent keymap of terminal-local function-key-map instances. */
412 Lisp_Object impl_Vfunction_key_map;
414 /* Keymap of key translations that can override keymaps. */
415 Lisp_Object impl_Vkey_translation_map;
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 impl_Vdeferred_action_list;
421 /* Function to call to handle deferred actions, when there are any. */
422 Lisp_Object impl_Vdeferred_action_function;
423 Lisp_Object Qdeferred_action_function;
425 Lisp_Object Qinput_method_exit_on_first_char;
426 Lisp_Object Qinput_method_use_echo_area;
428 /* File in which we write all commands we read. */
429 FILE *dribble;
431 /* Nonzero if input is available. */
432 int input_pending;
434 extern char *pending_malloc_warning;
436 /* Circular buffer for pre-read keyboard input. */
438 static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
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;
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;
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.
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. */
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 impl_do_mouse_tracking;
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;
475 extern Lisp_Object Qremap;
477 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
478 Lisp_Object Qmouse_fixup_help_message;
479 #endif
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;
494 /* Lisp_Object Qmouse_movement; - also an event header */
496 /* Properties of event headers. */
497 Lisp_Object Qevent_kind;
498 Lisp_Object Qevent_symbol_elements;
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 impl_Vdefine_key_rebound_commands;
505 extern Lisp_Object Qmenu_item;
507 /* An event header symbol HEAD may have a property named
508 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
509 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
510 mask of modifiers applied to it. If present, this is used to help
511 speed up parse_modifiers. */
512 Lisp_Object Qevent_symbol_element_mask;
514 /* An unmodified event header BASE may have a property named
515 Qmodifier_cache, which is an alist mapping modifier masks onto
516 modified versions of BASE. If present, this helps speed up
517 apply_modifiers. */
518 Lisp_Object Qmodifier_cache;
520 /* Symbols to use for parts of windows. */
521 Lisp_Object Qmode_line;
522 Lisp_Object Qvertical_line;
523 Lisp_Object Qvertical_scroll_bar;
524 Lisp_Object Qmenu_bar;
525 extern Lisp_Object Qleft_margin, Qright_margin;
526 extern Lisp_Object Qleft_fringe, Qright_fringe;
527 extern Lisp_Object QCmap;
529 Lisp_Object recursive_edit_unwind (), command_loop ();
530 Lisp_Object Fthis_command_keys ();
531 Lisp_Object Qextended_command_history;
532 EMACS_TIME timer_check ();
534 extern Lisp_Object impl_Vhistory_length, impl_Vtranslation_table_for_input;
536 extern char *x_get_keysym_name ();
538 static void record_menu_key ();
539 static int echo_length ();
541 Lisp_Object Qpolling_period;
543 /* List of absolute timers. Appears in order of next scheduled event. */
544 Lisp_Object impl_Vtimer_list;
546 /* List of idle time timers. Appears in order of next scheduled event. */
547 Lisp_Object impl_Vtimer_idle_list;
549 /* Incremented whenever a timer is run. */
550 int timers_run;
552 extern Lisp_Object impl_Vprint_level, impl_Vprint_length;
554 /* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
555 happens. */
556 EMACS_TIME *input_available_clear_time;
558 /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
559 Default is 1 if INTERRUPT_INPUT is defined. */
560 int interrupt_input;
562 /* Nonzero while interrupts are temporarily deferred during redisplay. */
563 int interrupts_deferred;
565 /* Allow m- file to inhibit use of FIONREAD. */
566 #ifdef BROKEN_FIONREAD
567 #undef FIONREAD
568 #endif
570 /* We are unable to use interrupts if FIONREAD is not available,
571 so flush SIGIO so we won't try. */
572 #if !defined (FIONREAD)
573 #ifdef SIGIO
574 #undef SIGIO
575 #endif
576 #endif
578 /* If we support a window system, turn on the code to poll periodically
579 to detect C-g. It isn't actually used when doing interrupt input. */
580 #if defined(HAVE_WINDOW_SYSTEM) && !defined(USE_ASYNC_EVENTS)
581 #define POLL_FOR_INPUT
582 #endif
584 /* After a command is executed, if point is moved into a region that
585 has specific properties (e.g. composition, display), we adjust
586 point to the boundary of the region. But, if a command sets this
587 variable to non-nil, we suppress this point adjustment. This
588 variable is set to nil before reading a command. */
590 Lisp_Object impl_Vdisable_point_adjustment;
592 /* If non-nil, always disable point adjustment. */
594 Lisp_Object impl_Vglobal_disable_point_adjustment;
596 /* The time when Emacs started being idle. */
598 static EMACS_TIME timer_idleness_start_time;
600 /* After Emacs stops being idle, this saves the last value
601 of timer_idleness_start_time from when it was idle. */
603 static EMACS_TIME timer_last_idleness_start_time;
605 /* If non-nil, events produced by disabled menu items and tool-bar
606 buttons are not ignored. Help functions bind this to allow help on
607 those items and buttons. */
608 Lisp_Object impl_Venable_disabled_menus_and_buttons;
611 /* Global variable declarations. */
613 /* Flags for readable_events. */
614 #define READABLE_EVENTS_DO_TIMERS_NOW (1 << 0)
615 #define READABLE_EVENTS_FILTER_EVENTS (1 << 1)
616 #define READABLE_EVENTS_IGNORE_SQUEEZABLES (1 << 2)
618 /* Function for init_keyboard to call with no args (if nonzero). */
619 void (*keyboard_init_hook) ();
621 static int read_avail_input P_ ((int));
622 static void get_input_pending P_ ((int *, int));
623 static int readable_events P_ ((int));
624 static Lisp_Object read_char_x_menu_prompt P_ ((int, Lisp_Object *,
625 Lisp_Object, int *));
626 static Lisp_Object read_char_x_menu_prompt ();
627 static Lisp_Object read_char_minibuf_menu_prompt P_ ((int, int,
628 Lisp_Object *));
629 static Lisp_Object make_lispy_event P_ ((struct input_event *));
630 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
631 static Lisp_Object make_lispy_movement P_ ((struct frame *, Lisp_Object,
632 enum scroll_bar_part,
633 Lisp_Object, Lisp_Object,
634 unsigned long));
635 #endif
636 static Lisp_Object modify_event_symbol P_ ((int, unsigned, Lisp_Object,
637 Lisp_Object, char **,
638 Lisp_Object *, unsigned));
639 static Lisp_Object make_lispy_switch_frame P_ ((Lisp_Object));
640 static void save_getcjmp P_ ((jmp_buf));
641 static void save_getcjmp ();
642 static void restore_getcjmp P_ ((jmp_buf));
643 static Lisp_Object apply_modifiers P_ ((int, Lisp_Object));
644 static void clear_event P_ ((struct input_event *));
645 static Lisp_Object restore_kboard_configuration P_ ((Lisp_Object));
646 static SIGTYPE interrupt_signal P_ ((int signalnum));
647 static void handle_interrupt P_ ((void));
648 static void timer_start_idle P_ ((void));
649 static void timer_stop_idle P_ ((void));
650 static void timer_resume_idle P_ ((void));
651 static SIGTYPE handle_user_signal P_ ((int));
652 static char *find_user_signal_name P_ ((int));
653 static int store_user_signal_events P_ ((void));
655 /* Nonzero means don't try to suspend even if the operating system seems
656 to support it. */
657 static int cannot_suspend;
659 extern Lisp_Object Qidentity, Qonly;
661 /* Install the string STR as the beginning of the string of echoing,
662 so that it serves as a prompt for the next character.
663 Also start echoing. */
665 void
666 echo_prompt (str)
667 Lisp_Object str;
669 current_kboard->echo_string = str;
670 current_kboard->echo_after_prompt = SCHARS (str);
671 echo_now ();
674 /* Add C to the echo string, if echoing is going on.
675 C can be a character, which is printed prettily ("M-C-x" and all that
676 jazz), or a symbol, whose name is printed. */
678 void
679 echo_char (c)
680 Lisp_Object c;
682 if (current_kboard->immediate_echo)
684 int size = KEY_DESCRIPTION_SIZE + 100;
685 char *buffer = (char *) alloca (size);
686 char *ptr = buffer;
687 Lisp_Object echo_string;
689 echo_string = current_kboard->echo_string;
691 /* If someone has passed us a composite event, use its head symbol. */
692 c = EVENT_HEAD (c);
694 if (INTEGERP (c))
696 ptr = push_key_description (XINT (c), ptr, 1);
698 else if (SYMBOLP (c))
700 Lisp_Object name = SYMBOL_NAME (c);
701 int nbytes = SBYTES (name);
703 if (size - (ptr - buffer) < nbytes)
705 int offset = ptr - buffer;
706 size = max (2 * size, size + nbytes);
707 buffer = (char *) alloca (size);
708 ptr = buffer + offset;
711 ptr += copy_text (SDATA (name), ptr, nbytes,
712 STRING_MULTIBYTE (name), 1);
715 if ((NILP (echo_string) || SCHARS (echo_string) == 0)
716 && help_char_p (c))
718 const char *text = " (Type ? for further options)";
719 int len = strlen (text);
721 if (size - (ptr - buffer) < len)
723 int offset = ptr - buffer;
724 size += len;
725 buffer = (char *) alloca (size);
726 ptr = buffer + offset;
729 bcopy (text, ptr, len);
730 ptr += len;
733 /* Replace a dash from echo_dash with a space, otherwise
734 add a space at the end as a separator between keys. */
735 if (STRINGP (echo_string)
736 && SCHARS (echo_string) > 1)
738 Lisp_Object last_char, prev_char, idx;
740 idx = make_number (SCHARS (echo_string) - 2);
741 prev_char = Faref (echo_string, idx);
743 idx = make_number (SCHARS (echo_string) - 1);
744 last_char = Faref (echo_string, idx);
746 /* We test PREV_CHAR to make sure this isn't the echoing
747 of a minus-sign. */
748 if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
749 Faset (echo_string, idx, make_number (' '));
750 else
751 echo_string = concat2 (echo_string, build_string (" "));
753 else if (STRINGP (echo_string))
754 echo_string = concat2 (echo_string, build_string (" "));
756 current_kboard->echo_string
757 = concat2 (echo_string, make_string (buffer, ptr - buffer));
759 echo_now ();
763 /* Temporarily add a dash to the end of the echo string if it's not
764 empty, so that it serves as a mini-prompt for the very next character. */
766 void
767 echo_dash ()
769 /* Do nothing if not echoing at all. */
770 if (NILP (current_kboard->echo_string))
771 return;
773 if (!current_kboard->immediate_echo
774 && SCHARS (current_kboard->echo_string) == 0)
775 return;
777 /* Do nothing if we just printed a prompt. */
778 if (current_kboard->echo_after_prompt
779 == SCHARS (current_kboard->echo_string))
780 return;
782 /* Do nothing if we have already put a dash at the end. */
783 if (SCHARS (current_kboard->echo_string) > 1)
785 Lisp_Object last_char, prev_char, idx;
787 idx = make_number (SCHARS (current_kboard->echo_string) - 2);
788 prev_char = Faref (current_kboard->echo_string, idx);
790 idx = make_number (SCHARS (current_kboard->echo_string) - 1);
791 last_char = Faref (current_kboard->echo_string, idx);
793 if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
794 return;
797 /* Put a dash at the end of the buffer temporarily,
798 but make it go away when the next character is added. */
799 current_kboard->echo_string = concat2 (current_kboard->echo_string,
800 build_string ("-"));
801 echo_now ();
804 /* Display the current echo string, and begin echoing if not already
805 doing so. */
807 void
808 echo_now ()
810 if (!current_kboard->immediate_echo)
812 int i;
813 current_kboard->immediate_echo = 1;
815 for (i = 0; i < this_command_key_count; i++)
817 Lisp_Object c;
819 /* Set before_command_echo_length to the value that would
820 have been saved before the start of this subcommand in
821 command_loop_1, if we had already been echoing then. */
822 if (i == this_single_command_key_start)
823 before_command_echo_length = echo_length ();
825 c = XVECTOR (this_command_keys)->contents[i];
826 if (! (EVENT_HAS_PARAMETERS (c)
827 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
828 echo_char (c);
831 /* Set before_command_echo_length to the value that would
832 have been saved before the start of this subcommand in
833 command_loop_1, if we had already been echoing then. */
834 if (this_command_key_count == this_single_command_key_start)
835 before_command_echo_length = echo_length ();
837 /* Put a dash at the end to invite the user to type more. */
838 echo_dash ();
841 echoing = 1;
842 message3_nolog (current_kboard->echo_string,
843 SBYTES (current_kboard->echo_string),
844 STRING_MULTIBYTE (current_kboard->echo_string));
845 echoing = 0;
847 /* Record in what buffer we echoed, and from which kboard. */
848 echo_message_buffer = echo_area_buffer[0];
849 echo_kboard = current_kboard;
851 if (waiting_for_input && !NILP (Vquit_flag))
852 quit_throw_to_read_char ();
855 /* Turn off echoing, for the start of a new command. */
857 void
858 cancel_echoing ()
860 current_kboard->immediate_echo = 0;
861 current_kboard->echo_after_prompt = -1;
862 current_kboard->echo_string = Qnil;
863 ok_to_echo_at_next_pause = NULL;
864 echo_kboard = NULL;
865 echo_message_buffer = Qnil;
868 /* Return the length of the current echo string. */
870 static int
871 echo_length ()
873 return (STRINGP (current_kboard->echo_string)
874 ? SCHARS (current_kboard->echo_string)
875 : 0);
878 /* Truncate the current echo message to its first LEN chars.
879 This and echo_char get used by read_key_sequence when the user
880 switches frames while entering a key sequence. */
882 static void
883 echo_truncate (nchars)
884 int nchars;
886 if (STRINGP (current_kboard->echo_string))
887 current_kboard->echo_string
888 = Fsubstring (current_kboard->echo_string,
889 make_number (0), make_number (nchars));
890 truncate_echo_area (nchars);
894 /* Functions for manipulating this_command_keys. */
895 static void
896 add_command_key (key)
897 Lisp_Object key;
899 #if 0 /* Not needed after we made Freset_this_command_lengths
900 do the job immediately. */
901 /* If reset-this-command-length was called recently, obey it now.
902 See the doc string of that function for an explanation of why. */
903 if (before_command_restore_flag)
905 this_command_key_count = before_command_key_count_1;
906 if (this_command_key_count < this_single_command_key_start)
907 this_single_command_key_start = this_command_key_count;
908 echo_truncate (before_command_echo_length_1);
909 before_command_restore_flag = 0;
911 #endif
913 if (this_command_key_count >= ASIZE (this_command_keys))
914 this_command_keys = larger_vector (this_command_keys,
915 2 * ASIZE (this_command_keys),
916 Qnil);
918 ASET (this_command_keys, this_command_key_count, key);
919 ++this_command_key_count;
923 Lisp_Object
924 recursive_edit_1 ()
926 int count = SPECPDL_INDEX ();
927 Lisp_Object val;
929 if (command_loop_level > 0)
931 specbind (Qstandard_output, Qt);
932 specbind (Qstandard_input, Qt);
935 #ifdef HAVE_WINDOW_SYSTEM
936 /* The command loop has started an hourglass timer, so we have to
937 cancel it here, otherwise it will fire because the recursive edit
938 can take some time. Do not check for display_hourglass_p here,
939 because it could already be nil. */
940 cancel_hourglass ();
941 #endif
943 /* This function may have been called from a debugger called from
944 within redisplay, for instance by Edebugging a function called
945 from fontification-functions. We want to allow redisplay in
946 the debugging session.
948 The recursive edit is left with a `(throw exit ...)'. The `exit'
949 tag is not caught anywhere in redisplay, i.e. when we leave the
950 recursive edit, the original redisplay leading to the recursive
951 edit will be unwound. The outcome should therefore be safe. */
952 specbind (Qinhibit_redisplay, Qnil);
953 redisplaying_p = 0;
955 val = command_loop ();
956 if (EQ (val, Qt))
957 Fsignal (Qquit, Qnil);
958 /* Handle throw from read_minibuf when using minibuffer
959 while it's active but we're in another window. */
960 if (STRINGP (val))
961 xsignal1 (Qerror, val);
963 return unbind_to (count, Qnil);
966 /* When an auto-save happens, record the "time", and don't do again soon. */
968 void
969 record_auto_save ()
971 last_auto_save = num_nonmacro_input_events;
974 /* Make an auto save happen as soon as possible at command level. */
976 void
977 force_auto_save_soon ()
979 last_auto_save = - auto_save_interval - 1;
981 record_asynch_buffer_change ();
984 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
985 doc: /* Invoke the editor command loop recursively.
986 To get out of the recursive edit, a command can do `(throw 'exit nil)';
987 that tells this function to return.
988 Alternatively, `(throw 'exit t)' makes this function signal an error.
989 This function is called by the editor initialization to begin editing. */)
992 int count = SPECPDL_INDEX ();
993 Lisp_Object buffer;
995 /* If we enter while input is blocked, don't lock up here.
996 This may happen through the debugger during redisplay. */
997 if (INPUT_BLOCKED_P)
998 return Qnil;
1000 command_loop_level++;
1001 update_mode_lines = 1;
1003 if (command_loop_level
1004 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
1005 buffer = Fcurrent_buffer ();
1006 else
1007 buffer = Qnil;
1009 /* If we leave recursive_edit_1 below with a `throw' for instance,
1010 like it is done in the splash screen display, we have to
1011 make sure that we restore single_kboard as command_loop_1
1012 would have done if it were left normally. */
1013 if (command_loop_level > 0)
1014 temporarily_switch_to_single_kboard (SELECTED_FRAME ());
1015 record_unwind_protect (recursive_edit_unwind, buffer);
1017 recursive_edit_1 ();
1018 return unbind_to (count, Qnil);
1021 Lisp_Object
1022 recursive_edit_unwind (buffer)
1023 Lisp_Object buffer;
1025 if (BUFFERP (buffer))
1026 Fset_buffer (buffer);
1028 command_loop_level--;
1029 update_mode_lines = 1;
1030 return Qnil;
1034 #if 0 /* These two functions are now replaced with
1035 temporarily_switch_to_single_kboard. */
1036 static void
1037 any_kboard_state ()
1039 #if 0 /* Theory: if there's anything in Vunread_command_events,
1040 it will right away be read by read_key_sequence,
1041 and then if we do switch KBOARDS, it will go into the side
1042 queue then. So we don't need to do anything special here -- rms. */
1043 if (CONSP (Vunread_command_events))
1045 current_kboard->kbd_queue
1046 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
1047 current_kboard->kbd_queue_has_data = 1;
1049 Vunread_command_events = Qnil;
1050 #endif
1051 single_kboard = 0;
1054 /* Switch to the single-kboard state, making current_kboard
1055 the only KBOARD from which further input is accepted. */
1057 void
1058 single_kboard_state ()
1060 single_kboard = 1;
1062 #endif
1064 /* If we're in single_kboard state for kboard KBOARD,
1065 get out of it. */
1067 void
1068 not_single_kboard_state (kboard)
1069 KBOARD *kboard;
1071 if (kboard == current_kboard)
1072 single_kboard = 0;
1075 /* Maintain a stack of kboards, so other parts of Emacs
1076 can switch temporarily to the kboard of a given frame
1077 and then revert to the previous status. */
1079 struct kboard_stack
1081 KBOARD *kboard;
1082 struct kboard_stack *next;
1085 static struct kboard_stack *kboard_stack;
1087 void
1088 push_kboard (k)
1089 struct kboard *k;
1091 struct kboard_stack *p
1092 = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
1094 p->next = kboard_stack;
1095 p->kboard = current_kboard;
1096 kboard_stack = p;
1098 current_kboard = k;
1101 void
1102 pop_kboard ()
1104 struct terminal *t;
1105 struct kboard_stack *p = kboard_stack;
1106 int found = 0;
1107 for (t = terminal_list; t; t = t->next_terminal)
1109 if (t->kboard == p->kboard)
1111 current_kboard = p->kboard;
1112 found = 1;
1113 break;
1116 if (!found)
1118 /* The terminal we remembered has been deleted. */
1119 current_kboard = FRAME_KBOARD (SELECTED_FRAME ());
1120 single_kboard = 0;
1122 kboard_stack = p->next;
1123 xfree (p);
1126 /* Switch to single_kboard mode, making current_kboard the only KBOARD
1127 from which further input is accepted. If F is non-nil, set its
1128 KBOARD as the current keyboard.
1130 This function uses record_unwind_protect to return to the previous
1131 state later.
1133 If Emacs is already in single_kboard mode, and F's keyboard is
1134 locked, then this function will throw an errow. */
1136 void
1137 temporarily_switch_to_single_kboard (f)
1138 struct frame *f;
1140 int was_locked = single_kboard;
1141 if (was_locked)
1143 if (f != NULL && FRAME_KBOARD (f) != current_kboard)
1144 /* We can not switch keyboards while in single_kboard mode.
1145 In rare cases, Lisp code may call `recursive-edit' (or
1146 `read-minibuffer' or `y-or-n-p') after it switched to a
1147 locked frame. For example, this is likely to happen
1148 when server.el connects to a new terminal while Emacs is in
1149 single_kboard mode. It is best to throw an error instead
1150 of presenting the user with a frozen screen. */
1151 error ("Terminal %d is locked, cannot read from it",
1152 FRAME_TERMINAL (f)->id);
1153 else
1154 /* This call is unnecessary, but helps
1155 `restore_kboard_configuration' discover if somebody changed
1156 `current_kboard' behind our back. */
1157 push_kboard (current_kboard);
1159 else if (f != NULL)
1160 current_kboard = FRAME_KBOARD (f);
1161 single_kboard = 1;
1162 record_unwind_protect (restore_kboard_configuration,
1163 (was_locked ? Qt : Qnil));
1166 #if 0 /* This function is not needed anymore. */
1167 void
1168 record_single_kboard_state ()
1170 if (single_kboard)
1171 push_kboard (current_kboard);
1172 record_unwind_protect (restore_kboard_configuration,
1173 (single_kboard ? Qt : Qnil));
1175 #endif
1177 static Lisp_Object
1178 restore_kboard_configuration (was_locked)
1179 Lisp_Object was_locked;
1181 if (NILP (was_locked))
1182 single_kboard = 0;
1183 else
1185 struct kboard *prev = current_kboard;
1186 single_kboard = 1;
1187 pop_kboard ();
1188 /* The pop should not change the kboard. */
1189 if (single_kboard && current_kboard != prev)
1190 abort ();
1192 return Qnil;
1196 /* Handle errors that are not handled at inner levels
1197 by printing an error message and returning to the editor command loop. */
1199 Lisp_Object
1200 cmd_error (data)
1201 Lisp_Object data;
1203 Lisp_Object old_level, old_length;
1204 char macroerror[50];
1206 #ifdef HAVE_WINDOW_SYSTEM
1207 if (display_hourglass_p)
1208 cancel_hourglass ();
1209 #endif
1211 if (!NILP (executing_kbd_macro))
1213 if (executing_kbd_macro_iterations == 1)
1214 sprintf (macroerror, "After 1 kbd macro iteration: ");
1215 else
1216 sprintf (macroerror, "After %d kbd macro iterations: ",
1217 executing_kbd_macro_iterations);
1219 else
1220 *macroerror = 0;
1222 Vstandard_output = Qt;
1223 Vstandard_input = Qt;
1224 Vexecuting_kbd_macro = Qnil;
1225 executing_kbd_macro = Qnil;
1226 current_kboard->Vprefix_arg = Qnil;
1227 current_kboard->Vlast_prefix_arg = Qnil;
1228 cancel_echoing ();
1230 /* Avoid unquittable loop if data contains a circular list. */
1231 old_level = Vprint_level;
1232 old_length = Vprint_length;
1233 XSETFASTINT (Vprint_level, 10);
1234 XSETFASTINT (Vprint_length, 10);
1235 cmd_error_internal (data, macroerror);
1236 Vprint_level = old_level;
1237 Vprint_length = old_length;
1239 Vquit_flag = Qnil;
1241 Vinhibit_quit = Qnil;
1242 #if 0 /* This shouldn't be necessary anymore. --lorentey */
1243 if (command_loop_level == 0 && minibuf_level == 0)
1244 any_kboard_state ();
1245 #endif
1247 return make_number (0);
1250 /* Take actions on handling an error. DATA is the data that describes
1251 the error.
1253 CONTEXT is a C-string containing ASCII characters only which
1254 describes the context in which the error happened. If we need to
1255 generalize CONTEXT to allow multibyte characters, make it a Lisp
1256 string. */
1258 void
1259 cmd_error_internal (data, context)
1260 Lisp_Object data;
1261 char *context;
1263 struct frame *sf = SELECTED_FRAME ();
1265 /* The immediate context is not interesting for Quits,
1266 since they are asyncronous. */
1267 if (EQ (XCAR (data), Qquit))
1268 Vsignaling_function = Qnil;
1270 Vquit_flag = Qnil;
1271 Vinhibit_quit = Qt;
1273 /* Use user's specified output function if any. */
1274 if (!NILP (Vcommand_error_function))
1275 call3 (Vcommand_error_function, data,
1276 context ? build_string (context) : empty_unibyte_string,
1277 Vsignaling_function);
1278 /* If the window system or terminal frame hasn't been initialized
1279 yet, or we're not interactive, write the message to stderr and exit. */
1280 else if (!sf->glyphs_initialized_p
1281 /* The initial frame is a special non-displaying frame. It
1282 will be current in daemon mode when there are no frames
1283 to display, and in non-daemon mode before the real frame
1284 has finished initializing. If an error is thrown in the
1285 latter case while creating the frame, then the frame
1286 will never be displayed, so the safest thing to do is
1287 write to stderr and quit. In daemon mode, there are
1288 many other potential errors that do not prevent frames
1289 from being created, so continuing as normal is better in
1290 that case. */
1291 || (!IS_DAEMON && FRAME_INITIAL_P (sf))
1292 || noninteractive)
1294 print_error_message (data, Qexternal_debugging_output,
1295 context, Vsignaling_function);
1296 Fterpri (Qexternal_debugging_output);
1297 Fkill_emacs (make_number (-1));
1299 else
1301 clear_message (1, 0);
1302 Fdiscard_input ();
1303 message_log_maybe_newline ();
1304 bitch_at_user ();
1306 print_error_message (data, Qt, context, Vsignaling_function);
1309 Vsignaling_function = Qnil;
1312 Lisp_Object command_loop_1 ();
1313 Lisp_Object command_loop_2 ();
1314 Lisp_Object top_level_1 ();
1316 /* Entry to editor-command-loop.
1317 This level has the catches for exiting/returning to editor command loop.
1318 It returns nil to exit recursive edit, t to abort it. */
1320 Lisp_Object
1321 command_loop ()
1323 if (command_loop_level > 0 || minibuf_level > 0)
1325 Lisp_Object val;
1326 val = internal_catch (Qexit, command_loop_2, Qnil);
1327 executing_kbd_macro = Qnil;
1328 return val;
1330 else
1331 while (1)
1333 internal_catch (Qtop_level, top_level_1, Qnil);
1334 #if 0 /* This shouldn't be necessary anymore. --lorentey */
1335 /* Reset single_kboard in case top-level set it while
1336 evaluating an -f option, or we are stuck there for some
1337 other reason. */
1338 any_kboard_state ();
1339 #endif
1340 internal_catch (Qtop_level, command_loop_2, Qnil);
1341 executing_kbd_macro = Qnil;
1343 /* End of file in -batch run causes exit here. */
1344 if (noninteractive)
1345 Fkill_emacs (Qt);
1349 /* Here we catch errors in execution of commands within the
1350 editing loop, and reenter the editing loop.
1351 When there is an error, cmd_error runs and returns a non-nil
1352 value to us. A value of nil means that command_loop_1 itself
1353 returned due to end of file (or end of kbd macro). */
1355 Lisp_Object
1356 command_loop_2 ()
1358 register Lisp_Object val;
1361 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1362 while (!NILP (val));
1364 return Qnil;
1367 Lisp_Object
1368 top_level_2 ()
1370 return Feval (Vtop_level);
1373 Lisp_Object
1374 top_level_1 ()
1376 /* On entry to the outer level, run the startup file */
1377 if (!NILP (Vtop_level))
1378 internal_condition_case (top_level_2, Qerror, cmd_error);
1379 else if (!NILP (Vpurify_flag))
1380 message ("Bare impure Emacs (standard Lisp code not loaded)");
1381 else
1382 message ("Bare Emacs (standard Lisp code not loaded)");
1383 return Qnil;
1386 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1387 doc: /* Exit all recursive editing levels.
1388 This also exits all active minibuffers. */)
1391 #ifdef HAVE_WINDOW_SYSTEM
1392 if (display_hourglass_p)
1393 cancel_hourglass ();
1394 #endif
1396 /* Unblock input if we enter with input blocked. This may happen if
1397 redisplay traps e.g. during tool-bar update with input blocked. */
1398 while (INPUT_BLOCKED_P)
1399 UNBLOCK_INPUT;
1401 return Fthrow (Qtop_level, Qnil);
1404 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1405 doc: /* Exit from the innermost recursive edit or minibuffer. */)
1408 if (command_loop_level > 0 || minibuf_level > 0)
1409 Fthrow (Qexit, Qnil);
1411 error ("No recursive edit is in progress");
1412 return Qnil;
1415 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1416 doc: /* Abort the command that requested this recursive edit or minibuffer input. */)
1419 if (command_loop_level > 0 || minibuf_level > 0)
1420 Fthrow (Qexit, Qt);
1422 error ("No recursive edit is in progress");
1423 return Qnil;
1426 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1428 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
1429 of this function. */
1431 static Lisp_Object
1432 tracking_off (old_value)
1433 Lisp_Object old_value;
1435 do_mouse_tracking = old_value;
1436 if (NILP (old_value))
1438 /* Redisplay may have been preempted because there was input
1439 available, and it assumes it will be called again after the
1440 input has been processed. If the only input available was
1441 the sort that we have just disabled, then we need to call
1442 redisplay. */
1443 if (!readable_events (READABLE_EVENTS_DO_TIMERS_NOW))
1445 redisplay_preserve_echo_area (6);
1446 get_input_pending (&input_pending,
1447 READABLE_EVENTS_DO_TIMERS_NOW);
1450 return Qnil;
1453 DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
1454 doc: /* Evaluate BODY with mouse movement events enabled.
1455 Within a `track-mouse' form, mouse motion generates input events that
1456 you can read with `read-event'.
1457 Normally, mouse motion is ignored.
1458 usage: (track-mouse BODY...) */)
1459 (args)
1460 Lisp_Object args;
1462 int count = SPECPDL_INDEX ();
1463 Lisp_Object val;
1465 record_unwind_protect (tracking_off, do_mouse_tracking);
1467 do_mouse_tracking = Qt;
1469 val = Fprogn (args);
1470 return unbind_to (count, val);
1473 /* If mouse has moved on some frame, return one of those frames.
1475 Return 0 otherwise.
1477 If ignore_mouse_drag_p is non-zero, ignore (implicit) mouse movement
1478 after resizing the tool-bar window. */
1480 int ignore_mouse_drag_p;
1482 static FRAME_PTR
1483 some_mouse_moved ()
1485 Lisp_Object tail, frame;
1487 if (ignore_mouse_drag_p)
1489 /* ignore_mouse_drag_p = 0; */
1490 return 0;
1493 FOR_EACH_FRAME (tail, frame)
1495 if (XFRAME (frame)->mouse_moved)
1496 return XFRAME (frame);
1499 return 0;
1502 #endif /* HAVE_MOUSE || HAVE_GPM */
1504 /* This is the actual command reading loop,
1505 sans error-handling encapsulation. */
1507 static int read_key_sequence P_ ((Lisp_Object *, int, Lisp_Object,
1508 int, int, int));
1509 void safe_run_hooks P_ ((Lisp_Object));
1510 static void adjust_point_for_property P_ ((int, int));
1512 /* Cancel hourglass from protect_unwind.
1513 ARG is not used. */
1514 #ifdef HAVE_WINDOW_SYSTEM
1515 static Lisp_Object
1516 cancel_hourglass_unwind (arg)
1517 Lisp_Object arg;
1519 cancel_hourglass ();
1520 return Qnil;
1522 #endif
1524 extern int nonundocount; /* Declared in cmds.c. */
1526 Lisp_Object
1527 command_loop_1 ()
1529 Lisp_Object cmd;
1530 int lose;
1531 Lisp_Object keybuf[30];
1532 int i;
1533 int prev_modiff = 0;
1534 struct buffer *prev_buffer = NULL;
1535 #if 0 /* This shouldn't be necessary anymore. --lorentey */
1536 int was_locked = single_kboard;
1537 #endif
1538 int already_adjusted = 0;
1540 current_kboard->Vprefix_arg = Qnil;
1541 current_kboard->Vlast_prefix_arg = Qnil;
1542 Vdeactivate_mark = Qnil;
1543 waiting_for_input = 0;
1544 cancel_echoing ();
1546 this_command_key_count = 0;
1547 this_command_key_count_reset = 0;
1548 this_single_command_key_start = 0;
1550 if (NILP (Vmemory_full))
1552 /* Make sure this hook runs after commands that get errors and
1553 throw to top level. */
1554 /* Note that the value cell will never directly contain nil
1555 if the symbol is a local variable. */
1556 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1557 safe_run_hooks (Qpost_command_hook);
1559 /* If displaying a message, resize the echo area window to fit
1560 that message's size exactly. */
1561 if (!NILP (echo_area_buffer[0]))
1562 resize_echo_area_exactly ();
1564 if (!NILP (Vdeferred_action_list))
1565 safe_run_hooks (Qdeferred_action_function);
1568 /* Do this after running Vpost_command_hook, for consistency. */
1569 current_kboard->Vlast_command = Vthis_command;
1570 current_kboard->Vreal_last_command = real_this_command;
1571 if (!CONSP (last_command_event))
1572 current_kboard->Vlast_repeatable_command = real_this_command;
1574 while (1)
1576 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1577 Fkill_emacs (Qnil);
1579 /* Make sure the current window's buffer is selected. */
1580 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1581 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1583 /* Display any malloc warning that just came out. Use while because
1584 displaying one warning can cause another. */
1586 while (pending_malloc_warning)
1587 display_malloc_warning ();
1589 Vdeactivate_mark = Qnil;
1591 /* If minibuffer on and echo area in use,
1592 wait a short time and redraw minibuffer. */
1594 if (minibuf_level
1595 && !NILP (echo_area_buffer[0])
1596 && EQ (minibuf_window, echo_area_window)
1597 && NUMBERP (Vminibuffer_message_timeout))
1599 /* Bind inhibit-quit to t so that C-g gets read in
1600 rather than quitting back to the minibuffer. */
1601 int count = SPECPDL_INDEX ();
1602 specbind (Qinhibit_quit, Qt);
1604 sit_for (Vminibuffer_message_timeout, 0, 2);
1606 /* Clear the echo area. */
1607 message2 (0, 0, 0);
1608 safe_run_hooks (Qecho_area_clear_hook);
1610 unbind_to (count, Qnil);
1612 /* If a C-g came in before, treat it as input now. */
1613 if (!NILP (Vquit_flag))
1615 Vquit_flag = Qnil;
1616 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
1620 #if 0
1621 /* Select the frame that the last event came from. Usually,
1622 switch-frame events will take care of this, but if some lisp
1623 code swallows a switch-frame event, we'll fix things up here.
1624 Is this a good idea? */
1625 if (FRAMEP (internal_last_event_frame)
1626 && !EQ (internal_last_event_frame, selected_frame))
1627 Fselect_frame (internal_last_event_frame, Qnil);
1628 #endif
1629 /* If it has changed current-menubar from previous value,
1630 really recompute the menubar from the value. */
1631 if (! NILP (Vlucid_menu_bar_dirty_flag)
1632 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
1633 call0 (Qrecompute_lucid_menubar);
1635 before_command_key_count = this_command_key_count;
1636 before_command_echo_length = echo_length ();
1638 Vthis_command = Qnil;
1639 real_this_command = Qnil;
1640 Vthis_original_command = Qnil;
1641 Vthis_command_keys_shift_translated = Qnil;
1643 /* Read next key sequence; i gets its length. */
1644 i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
1645 Qnil, 0, 1, 1);
1647 /* A filter may have run while we were reading the input. */
1648 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1649 Fkill_emacs (Qnil);
1650 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1651 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1653 ++num_input_keys;
1655 /* Now we have read a key sequence of length I,
1656 or else I is 0 and we found end of file. */
1658 if (i == 0) /* End of file -- happens only in */
1659 return Qnil; /* a kbd macro, at the end. */
1660 /* -1 means read_key_sequence got a menu that was rejected.
1661 Just loop around and read another command. */
1662 if (i == -1)
1664 cancel_echoing ();
1665 this_command_key_count = 0;
1666 this_command_key_count_reset = 0;
1667 this_single_command_key_start = 0;
1668 goto finalize;
1671 last_command_event = keybuf[i - 1];
1673 /* If the previous command tried to force a specific window-start,
1674 forget about that, in case this command moves point far away
1675 from that position. But also throw away beg_unchanged and
1676 end_unchanged information in that case, so that redisplay will
1677 update the whole window properly. */
1678 if (!NILP (XWINDOW (selected_window)->force_start))
1680 struct buffer *b;
1681 XWINDOW (selected_window)->force_start = Qnil;
1682 b = XBUFFER (XWINDOW (selected_window)->buffer);
1683 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
1686 cmd = read_key_sequence_cmd;
1687 if (!NILP (Vexecuting_kbd_macro))
1689 if (!NILP (Vquit_flag))
1691 Vexecuting_kbd_macro = Qt;
1692 QUIT; /* Make some noise. */
1693 /* Will return since macro now empty. */
1697 /* Do redisplay processing after this command except in special
1698 cases identified below. */
1699 prev_buffer = current_buffer;
1700 prev_modiff = MODIFF;
1701 last_point_position = PT;
1702 last_point_position_window = selected_window;
1703 XSETBUFFER (last_point_position_buffer, prev_buffer);
1705 /* By default, we adjust point to a boundary of a region that
1706 has such a property that should be treated intangible
1707 (e.g. composition, display). But, some commands will set
1708 this variable differently. */
1709 Vdisable_point_adjustment = Qnil;
1711 /* Process filters and timers may have messed with deactivate-mark.
1712 reset it before we execute the command. */
1713 Vdeactivate_mark = Qnil;
1715 /* Remap command through active keymaps */
1716 Vthis_original_command = cmd;
1717 if (SYMBOLP (cmd))
1719 Lisp_Object cmd1;
1720 if (cmd1 = Fcommand_remapping (cmd, Qnil, Qnil), !NILP (cmd1))
1721 cmd = cmd1;
1724 /* Execute the command. */
1726 Vthis_command = cmd;
1727 real_this_command = cmd;
1728 /* Note that the value cell will never directly contain nil
1729 if the symbol is a local variable. */
1730 if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks))
1731 safe_run_hooks (Qpre_command_hook);
1733 already_adjusted = 0;
1735 if (NILP (Vthis_command))
1737 /* nil means key is undefined. */
1738 Lisp_Object keys = Fvector (i, keybuf);
1739 keys = Fkey_description (keys, Qnil);
1740 bitch_at_user ();
1741 message_with_string ("%s is undefined", keys, 0);
1742 current_kboard->defining_kbd_macro = Qnil;
1743 update_mode_lines = 1;
1744 current_kboard->Vprefix_arg = Qnil;
1746 else
1748 if (NILP (current_kboard->Vprefix_arg))
1750 /* In case we jump to directly_done. */
1751 Vcurrent_prefix_arg = current_kboard->Vprefix_arg;
1753 /* Recognize some common commands in common situations and
1754 do them directly. */
1755 if (EQ (Vthis_command, Qforward_char) && PT < ZV
1756 && NILP (Vthis_command_keys_shift_translated)
1757 && !CONSP (Vtransient_mark_mode))
1759 struct Lisp_Char_Table *dp
1760 = window_display_table (XWINDOW (selected_window));
1761 lose = FETCH_CHAR (PT_BYTE);
1762 SET_PT (PT + 1);
1763 if (! NILP (Vpost_command_hook))
1764 /* Put this before calling adjust_point_for_property
1765 so it will only get called once in any case. */
1766 goto directly_done;
1767 if (current_buffer == prev_buffer
1768 && last_point_position != PT
1769 && NILP (Vdisable_point_adjustment)
1770 && NILP (Vglobal_disable_point_adjustment))
1771 adjust_point_for_property (last_point_position, 0);
1772 already_adjusted = 1;
1773 if (PT == last_point_position + 1
1774 && (dp
1775 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1776 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1777 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1778 && (lose >= 0x20 && lose < 0x7f)))
1779 : (lose >= 0x20 && lose < 0x7f))
1780 /* To extract the case of continuation on
1781 wide-column characters. */
1782 && ASCII_BYTE_P (lose)
1783 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1784 >= MODIFF)
1785 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1786 >= OVERLAY_MODIFF)
1787 && (XFASTINT (XWINDOW (selected_window)->last_point)
1788 == PT - 1)
1789 && !windows_or_buffers_changed
1790 && EQ (BUF_SELECTIVE_DISPLAY (current_buffer), Qnil)
1791 && !detect_input_pending ()
1792 && NILP (XWINDOW (selected_window)->column_number_displayed)
1793 && NILP (Vexecuting_kbd_macro))
1794 direct_output_forward_char (1);
1795 goto directly_done;
1797 else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV
1798 && NILP (Vthis_command_keys_shift_translated)
1799 && !CONSP (Vtransient_mark_mode))
1801 struct Lisp_Char_Table *dp
1802 = window_display_table (XWINDOW (selected_window));
1803 SET_PT (PT - 1);
1804 lose = FETCH_CHAR (PT_BYTE);
1805 if (! NILP (Vpost_command_hook))
1806 goto directly_done;
1807 if (current_buffer == prev_buffer
1808 && last_point_position != PT
1809 && NILP (Vdisable_point_adjustment)
1810 && NILP (Vglobal_disable_point_adjustment))
1811 adjust_point_for_property (last_point_position, 0);
1812 already_adjusted = 1;
1813 if (PT == last_point_position - 1
1814 && (dp
1815 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1816 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1817 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1818 && (lose >= 0x20 && lose < 0x7f)))
1819 : (lose >= 0x20 && lose < 0x7f))
1820 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1821 >= MODIFF)
1822 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1823 >= OVERLAY_MODIFF)
1824 && (XFASTINT (XWINDOW (selected_window)->last_point)
1825 == PT + 1)
1826 && !windows_or_buffers_changed
1827 && EQ (BUF_SELECTIVE_DISPLAY (current_buffer), Qnil)
1828 && !detect_input_pending ()
1829 && NILP (XWINDOW (selected_window)->column_number_displayed)
1830 && NILP (Vexecuting_kbd_macro))
1831 direct_output_forward_char (-1);
1832 goto directly_done;
1834 else if (EQ (Vthis_command, Qself_insert_command)
1835 /* Try this optimization only on char keystrokes. */
1836 && NATNUMP (last_command_event)
1837 && CHAR_VALID_P (XFASTINT (last_command_event), 0))
1839 unsigned int c
1840 = translate_char (Vtranslation_table_for_input,
1841 XFASTINT (last_command_event));
1842 int value;
1843 if (NILP (Vexecuting_kbd_macro)
1844 && !EQ (minibuf_window, selected_window))
1846 if (!nonundocount || nonundocount >= 20)
1848 Fundo_boundary ();
1849 nonundocount = 0;
1851 nonundocount++;
1854 lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
1855 < MODIFF)
1856 || (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1857 < OVERLAY_MODIFF)
1858 || (XFASTINT (XWINDOW (selected_window)->last_point)
1859 != PT)
1860 || MODIFF <= SAVE_MODIFF
1861 || windows_or_buffers_changed
1862 || !EQ (BUF_SELECTIVE_DISPLAY (current_buffer), Qnil)
1863 || detect_input_pending ()
1864 || !NILP (XWINDOW (selected_window)->column_number_displayed)
1865 || !NILP (Vexecuting_kbd_macro));
1867 value = internal_self_insert (c, 0);
1869 if (value == 2)
1870 nonundocount = 0;
1872 frame_make_pointer_invisible ();
1874 if (! NILP (Vpost_command_hook))
1875 /* Put this before calling adjust_point_for_property
1876 so it will only get called once in any case. */
1877 goto directly_done;
1879 /* VALUE == 1 when AFTER-CHANGE functions are
1880 installed which is the case most of the time
1881 because FONT-LOCK installs one. */
1882 if (!lose && !value)
1883 direct_output_for_insert (c);
1884 goto directly_done;
1888 /* Here for a command that isn't executed directly */
1891 #ifdef HAVE_WINDOW_SYSTEM
1892 int scount = SPECPDL_INDEX ();
1894 if (display_hourglass_p
1895 && NILP (Vexecuting_kbd_macro))
1897 record_unwind_protect (cancel_hourglass_unwind, Qnil);
1898 start_hourglass ();
1900 #endif
1902 nonundocount = 0;
1903 if (NILP (current_kboard->Vprefix_arg)) /* FIXME: Why? --Stef */
1904 Fundo_boundary ();
1905 Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
1907 #ifdef HAVE_WINDOW_SYSTEM
1908 /* Do not check display_hourglass_p here, because
1909 Fcommand_execute could change it, but we should cancel
1910 hourglass cursor anyway.
1911 But don't cancel the hourglass within a macro
1912 just because a command in the macro finishes. */
1913 if (NILP (Vexecuting_kbd_macro))
1914 unbind_to (scount, Qnil);
1915 #endif
1918 directly_done: ;
1919 current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg;
1921 /* Note that the value cell will never directly contain nil
1922 if the symbol is a local variable. */
1923 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1924 safe_run_hooks (Qpost_command_hook);
1926 /* If displaying a message, resize the echo area window to fit
1927 that message's size exactly. */
1928 if (!NILP (echo_area_buffer[0]))
1929 resize_echo_area_exactly ();
1931 if (!NILP (Vdeferred_action_list))
1932 safe_run_hooks (Qdeferred_action_function);
1934 /* If there is a prefix argument,
1935 1) We don't want Vlast_command to be ``universal-argument''
1936 (that would be dumb), so don't set Vlast_command,
1937 2) we want to leave echoing on so that the prefix will be
1938 echoed as part of this key sequence, so don't call
1939 cancel_echoing, and
1940 3) we want to leave this_command_key_count non-zero, so that
1941 read_char will realize that it is re-reading a character, and
1942 not echo it a second time.
1944 If the command didn't actually create a prefix arg,
1945 but is merely a frame event that is transparent to prefix args,
1946 then the above doesn't apply. */
1947 if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_event))
1949 current_kboard->Vlast_command = Vthis_command;
1950 current_kboard->Vreal_last_command = real_this_command;
1951 if (!CONSP (last_command_event))
1952 current_kboard->Vlast_repeatable_command = real_this_command;
1953 cancel_echoing ();
1954 this_command_key_count = 0;
1955 this_command_key_count_reset = 0;
1956 this_single_command_key_start = 0;
1959 if (!NILP (BUF_MARK_ACTIVE (current_buffer)) && !NILP (Vrun_hooks))
1961 /* In Emacs 22, setting transient-mark-mode to `only' was a
1962 way of turning it on for just one command. This usage is
1963 obsolete, but support it anyway. */
1964 if (EQ (Vtransient_mark_mode, Qidentity))
1965 Vtransient_mark_mode = Qnil;
1966 else if (EQ (Vtransient_mark_mode, Qonly))
1967 Vtransient_mark_mode = Qidentity;
1969 if (!NILP (Vdeactivate_mark))
1970 call0 (Qdeactivate_mark);
1971 else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1972 call1 (Vrun_hooks, intern ("activate-mark-hook"));
1975 finalize:
1977 if (current_buffer == prev_buffer
1978 && last_point_position != PT
1979 && NILP (Vdisable_point_adjustment)
1980 && NILP (Vglobal_disable_point_adjustment))
1982 if (last_point_position > BEGV
1983 && last_point_position < ZV
1984 && (composition_adjust_point (last_point_position,
1985 last_point_position)
1986 != last_point_position))
1987 /* The last point was temporarily set within a grapheme
1988 cluster to prevent automatic composition. To recover
1989 the automatic composition, we must update the
1990 display. */
1991 windows_or_buffers_changed++;
1992 if (!already_adjusted)
1993 adjust_point_for_property (last_point_position,
1994 MODIFF != prev_modiff);
1997 /* Install chars successfully executed in kbd macro. */
1999 if (!NILP (current_kboard->defining_kbd_macro)
2000 && NILP (current_kboard->Vprefix_arg))
2001 finalize_kbd_macro_chars ();
2002 #if 0 /* This shouldn't be necessary anymore. --lorentey */
2003 if (!was_locked)
2004 any_kboard_state ();
2005 #endif
2009 extern Lisp_Object Qcomposition, Qdisplay;
2011 /* Adjust point to a boundary of a region that has such a property
2012 that should be treated intangible. For the moment, we check
2013 `composition', `display' and `invisible' properties.
2014 LAST_PT is the last position of point. */
2016 extern Lisp_Object Qafter_string, Qbefore_string;
2017 extern Lisp_Object get_pos_property P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
2019 static void
2020 adjust_point_for_property (last_pt, modified)
2021 int last_pt;
2022 int modified;
2024 EMACS_INT beg, end;
2025 Lisp_Object val, overlay, tmp;
2026 /* When called after buffer modification, we should temporarily
2027 suppress the point adjustment for automatic composition so that a
2028 user can keep inserting another character at point or keep
2029 deleting characters around point. */
2030 int check_composition = ! modified, check_display = 1, check_invisible = 1;
2031 int orig_pt = PT;
2033 /* FIXME: cycling is probably not necessary because these properties
2034 can't be usefully combined anyway. */
2035 while (check_composition || check_display || check_invisible)
2037 /* FIXME: check `intangible'. */
2038 if (check_composition
2039 && PT > BEGV && PT < ZV
2040 && (beg = composition_adjust_point (last_pt, PT)) != PT)
2042 SET_PT (beg);
2043 check_display = check_invisible = 1;
2045 check_composition = 0;
2046 if (check_display
2047 && PT > BEGV && PT < ZV
2048 && !NILP (val = get_char_property_and_overlay
2049 (make_number (PT), Qdisplay, Qnil, &overlay))
2050 && display_prop_intangible_p (val)
2051 && (!OVERLAYP (overlay)
2052 ? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil)
2053 : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)),
2054 end = OVERLAY_POSITION (OVERLAY_END (overlay))))
2055 && (beg < PT /* && end > PT <- It's always the case. */
2056 || (beg <= PT && STRINGP (val) && SCHARS (val) == 0)))
2058 xassert (end > PT);
2059 SET_PT (PT < last_pt
2060 ? (STRINGP (val) && SCHARS (val) == 0 ? beg - 1 : beg)
2061 : end);
2062 check_composition = check_invisible = 1;
2064 check_display = 0;
2065 if (check_invisible && PT > BEGV && PT < ZV)
2067 int inv, ellipsis = 0;
2068 beg = end = PT;
2070 /* Find boundaries `beg' and `end' of the invisible area, if any. */
2071 while (end < ZV
2072 #if 0
2073 /* FIXME: We should stop if we find a spot between
2074 two runs of `invisible' where inserted text would
2075 be visible. This is important when we have two
2076 invisible boundaries that enclose an area: if the
2077 area is empty, we need this test in order to make
2078 it possible to place point in the middle rather
2079 than skip both boundaries. However, this code
2080 also stops anywhere in a non-sticky text-property,
2081 which breaks (e.g.) Org mode. */
2082 && (val = get_pos_property (make_number (end),
2083 Qinvisible, Qnil),
2084 TEXT_PROP_MEANS_INVISIBLE (val))
2085 #endif
2086 && !NILP (val = get_char_property_and_overlay
2087 (make_number (end), Qinvisible, Qnil, &overlay))
2088 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
2090 ellipsis = ellipsis || inv > 1
2091 || (OVERLAYP (overlay)
2092 && (!NILP (Foverlay_get (overlay, Qafter_string))
2093 || !NILP (Foverlay_get (overlay, Qbefore_string))));
2094 tmp = Fnext_single_char_property_change
2095 (make_number (end), Qinvisible, Qnil, Qnil);
2096 end = NATNUMP (tmp) ? XFASTINT (tmp) : ZV;
2098 while (beg > BEGV
2099 #if 0
2100 && (val = get_pos_property (make_number (beg),
2101 Qinvisible, Qnil),
2102 TEXT_PROP_MEANS_INVISIBLE (val))
2103 #endif
2104 && !NILP (val = get_char_property_and_overlay
2105 (make_number (beg - 1), Qinvisible, Qnil, &overlay))
2106 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
2108 ellipsis = ellipsis || inv > 1
2109 || (OVERLAYP (overlay)
2110 && (!NILP (Foverlay_get (overlay, Qafter_string))
2111 || !NILP (Foverlay_get (overlay, Qbefore_string))));
2112 tmp = Fprevious_single_char_property_change
2113 (make_number (beg), Qinvisible, Qnil, Qnil);
2114 beg = NATNUMP (tmp) ? XFASTINT (tmp) : BEGV;
2117 /* Move away from the inside area. */
2118 if (beg < PT && end > PT)
2120 SET_PT ((orig_pt == PT && (last_pt < beg || last_pt > end))
2121 /* We haven't moved yet (so we don't need to fear
2122 infinite-looping) and we were outside the range
2123 before (so either end of the range still corresponds
2124 to a move in the right direction): pretend we moved
2125 less than we actually did, so that we still have
2126 more freedom below in choosing which end of the range
2127 to go to. */
2128 ? (orig_pt = -1, PT < last_pt ? end : beg)
2129 /* We either have moved already or the last point
2130 was already in the range: we don't get to choose
2131 which end of the range we have to go to. */
2132 : (PT < last_pt ? beg : end));
2133 check_composition = check_display = 1;
2135 #if 0 /* This assertion isn't correct, because SET_PT may end up setting
2136 the point to something other than its argument, due to
2137 point-motion hooks, intangibility, etc. */
2138 xassert (PT == beg || PT == end);
2139 #endif
2141 /* Pretend the area doesn't exist if the buffer is not
2142 modified. */
2143 if (!modified && !ellipsis && beg < end)
2145 if (last_pt == beg && PT == end && end < ZV)
2146 (check_composition = check_display = 1, SET_PT (end + 1));
2147 else if (last_pt == end && PT == beg && beg > BEGV)
2148 (check_composition = check_display = 1, SET_PT (beg - 1));
2149 else if (PT == ((PT < last_pt) ? beg : end))
2150 /* We've already moved as far as we can. Trying to go
2151 to the other end would mean moving backwards and thus
2152 could lead to an infinite loop. */
2154 else if (val = get_pos_property (make_number (PT),
2155 Qinvisible, Qnil),
2156 TEXT_PROP_MEANS_INVISIBLE (val)
2157 && (val = get_pos_property
2158 (make_number (PT == beg ? end : beg),
2159 Qinvisible, Qnil),
2160 !TEXT_PROP_MEANS_INVISIBLE (val)))
2161 (check_composition = check_display = 1,
2162 SET_PT (PT == beg ? end : beg));
2165 check_invisible = 0;
2169 /* Subroutine for safe_run_hooks: run the hook HOOK. */
2171 static Lisp_Object
2172 safe_run_hooks_1 (hook)
2173 Lisp_Object hook;
2175 if (NILP (Vrun_hooks))
2176 return Qnil;
2177 return call1 (Vrun_hooks, Vinhibit_quit);
2180 /* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */
2182 static Lisp_Object
2183 safe_run_hooks_error (data)
2184 Lisp_Object data;
2186 Lisp_Object args[3];
2187 args[0] = build_string ("Error in %s: %s");
2188 args[1] = Vinhibit_quit;
2189 args[2] = data;
2190 Fmessage (3, args);
2191 return Fset (Vinhibit_quit, Qnil);
2194 /* If we get an error while running the hook, cause the hook variable
2195 to be nil. Also inhibit quits, so that C-g won't cause the hook
2196 to mysteriously evaporate. */
2198 void
2199 safe_run_hooks (hook)
2200 Lisp_Object hook;
2202 int count = SPECPDL_INDEX ();
2203 specbind (Qinhibit_quit, hook);
2205 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
2207 unbind_to (count, Qnil);
2211 /* Number of seconds between polling for input. This is a Lisp
2212 variable that can be bound. */
2214 EMACS_INT polling_period;
2216 /* Nonzero means polling for input is temporarily suppressed. */
2218 int poll_suppress_count;
2220 /* Asynchronous timer for polling. */
2222 struct atimer *poll_timer;
2225 #ifdef POLL_FOR_INPUT
2227 /* Poll for input, so that we catch a C-g if it comes in. This
2228 function is called from x_make_frame_visible, see comment
2229 there. */
2231 void
2232 poll_for_input_1 ()
2234 /* Tell ns_read_socket() it is being called asynchronously so it can avoid
2235 doing anything dangerous. */
2236 #ifdef HAVE_NS
2237 ++handling_signal;
2238 #endif
2239 if (interrupt_input_blocked == 0
2240 && !waiting_for_input)
2241 read_avail_input (0);
2242 #ifdef HAVE_NS
2243 --handling_signal;
2244 #endif
2247 /* Timer callback function for poll_timer. TIMER is equal to
2248 poll_timer. */
2250 void
2251 poll_for_input (timer)
2252 struct atimer *timer;
2254 if (poll_suppress_count == 0)
2256 #ifdef SYNC_INPUT
2257 interrupt_input_pending = 1;
2258 pending_signals = 1;
2259 #else
2260 poll_for_input_1 ();
2261 #endif
2265 #endif /* POLL_FOR_INPUT */
2267 /* Begin signals to poll for input, if they are appropriate.
2268 This function is called unconditionally from various places. */
2270 void
2271 start_polling ()
2273 #ifdef POLL_FOR_INPUT
2274 /* XXX This condition was (read_socket_hook && !interrupt_input),
2275 but read_socket_hook is not global anymore. Let's pretend that
2276 it's always set. */
2277 if (!interrupt_input)
2279 /* Turn alarm handling on unconditionally. It might have
2280 been turned off in process.c. */
2281 turn_on_atimers (1);
2283 /* If poll timer doesn't exist, are we need one with
2284 a different interval, start a new one. */
2285 if (poll_timer == NULL
2286 || EMACS_SECS (poll_timer->interval) != polling_period)
2288 EMACS_TIME interval;
2290 if (poll_timer)
2291 cancel_atimer (poll_timer);
2293 EMACS_SET_SECS_USECS (interval, polling_period, 0);
2294 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
2295 poll_for_input, NULL);
2298 /* Let the timer's callback function poll for input
2299 if this becomes zero. */
2300 --poll_suppress_count;
2302 #endif
2305 /* Nonzero if we are using polling to handle input asynchronously. */
2308 input_polling_used ()
2310 #ifdef POLL_FOR_INPUT
2311 /* XXX This condition was (read_socket_hook && !interrupt_input),
2312 but read_socket_hook is not global anymore. Let's pretend that
2313 it's always set. */
2314 return !interrupt_input;
2315 #else
2316 return 0;
2317 #endif
2320 /* Turn off polling. */
2322 void
2323 stop_polling ()
2325 #ifdef POLL_FOR_INPUT
2326 /* XXX This condition was (read_socket_hook && !interrupt_input),
2327 but read_socket_hook is not global anymore. Let's pretend that
2328 it's always set. */
2329 if (!interrupt_input)
2330 ++poll_suppress_count;
2331 #endif
2334 /* Set the value of poll_suppress_count to COUNT
2335 and start or stop polling accordingly. */
2337 void
2338 set_poll_suppress_count (count)
2339 int count;
2341 #ifdef POLL_FOR_INPUT
2342 if (count == 0 && poll_suppress_count != 0)
2344 poll_suppress_count = 1;
2345 start_polling ();
2347 else if (count != 0 && poll_suppress_count == 0)
2349 stop_polling ();
2351 poll_suppress_count = count;
2352 #endif
2355 /* Bind polling_period to a value at least N.
2356 But don't decrease it. */
2358 void
2359 bind_polling_period (n)
2360 int n;
2362 #ifdef POLL_FOR_INPUT
2363 int new = polling_period;
2365 if (n > new)
2366 new = n;
2368 stop_other_atimers (poll_timer);
2369 stop_polling ();
2370 specbind (Qpolling_period, make_number (new));
2371 /* Start a new alarm with the new period. */
2372 start_polling ();
2373 #endif
2376 /* Apply the control modifier to CHARACTER. */
2379 make_ctrl_char (c)
2380 int c;
2382 /* Save the upper bits here. */
2383 int upper = c & ~0177;
2385 if (! ASCII_BYTE_P (c))
2386 return c |= ctrl_modifier;
2388 c &= 0177;
2390 /* Everything in the columns containing the upper-case letters
2391 denotes a control character. */
2392 if (c >= 0100 && c < 0140)
2394 int oc = c;
2395 c &= ~0140;
2396 /* Set the shift modifier for a control char
2397 made from a shifted letter. But only for letters! */
2398 if (oc >= 'A' && oc <= 'Z')
2399 c |= shift_modifier;
2402 /* The lower-case letters denote control characters too. */
2403 else if (c >= 'a' && c <= 'z')
2404 c &= ~0140;
2406 /* Include the bits for control and shift
2407 only if the basic ASCII code can't indicate them. */
2408 else if (c >= ' ')
2409 c |= ctrl_modifier;
2411 /* Replace the high bits. */
2412 c |= (upper & ~ctrl_modifier);
2414 return c;
2417 /* Display the help-echo property of the character after the mouse pointer.
2418 Either show it in the echo area, or call show-help-function to display
2419 it by other means (maybe in a tooltip).
2421 If HELP is nil, that means clear the previous help echo.
2423 If HELP is a string, display that string. If HELP is a function,
2424 call it with OBJECT and POS as arguments; the function should
2425 return a help string or nil for none. For all other types of HELP,
2426 evaluate it to obtain a string.
2428 WINDOW is the window in which the help was generated, if any.
2429 It is nil if not in a window.
2431 If OBJECT is a buffer, POS is the position in the buffer where the
2432 `help-echo' text property was found.
2434 If OBJECT is an overlay, that overlay has a `help-echo' property,
2435 and POS is the position in the overlay's buffer under the mouse.
2437 If OBJECT is a string (an overlay string or a string displayed with
2438 the `display' property). POS is the position in that string under
2439 the mouse.
2441 OK_TO_OVERWRITE_KEYSTROKE_ECHO non-zero means it's okay if the help
2442 echo overwrites a keystroke echo currently displayed in the echo
2443 area.
2445 Note: this function may only be called with HELP nil or a string
2446 from X code running asynchronously. */
2448 void
2449 show_help_echo (help, window, object, pos, ok_to_overwrite_keystroke_echo)
2450 Lisp_Object help, window, object, pos;
2451 int ok_to_overwrite_keystroke_echo;
2453 if (!NILP (help) && !STRINGP (help))
2455 if (FUNCTIONP (help))
2457 Lisp_Object args[4];
2458 args[0] = help;
2459 args[1] = window;
2460 args[2] = object;
2461 args[3] = pos;
2462 help = safe_call (4, args);
2464 else
2465 help = safe_eval (help);
2467 if (!STRINGP (help))
2468 return;
2471 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
2472 if (!noninteractive && STRINGP (help))
2474 /* The mouse-fixup-help-message Lisp function can call
2475 mouse_position_hook, which resets the mouse_moved flags.
2476 This causes trouble if we are trying to read a mouse motion
2477 event (i.e., if we are inside a `track-mouse' form), so we
2478 restore the mouse_moved flag. */
2479 FRAME_PTR f = NILP (do_mouse_tracking) ? NULL : some_mouse_moved ();
2480 help = call1 (Qmouse_fixup_help_message, help);
2481 if (f)
2482 f->mouse_moved = 1;
2484 #endif
2486 if (STRINGP (help) || NILP (help))
2488 if (!NILP (Vshow_help_function))
2489 call1 (Vshow_help_function, help);
2490 help_echo_showing_p = STRINGP (help);
2496 /* Input of single characters from keyboard */
2498 Lisp_Object print_help ();
2499 static Lisp_Object kbd_buffer_get_event ();
2500 static void record_char ();
2502 static Lisp_Object help_form_saved_window_configs;
2503 static Lisp_Object
2504 read_char_help_form_unwind (Lisp_Object arg)
2506 Lisp_Object window_config = XCAR (help_form_saved_window_configs);
2507 help_form_saved_window_configs = XCDR (help_form_saved_window_configs);
2508 if (!NILP (window_config))
2509 Fset_window_configuration (window_config);
2510 return Qnil;
2513 #define STOP_POLLING \
2514 do { if (! polling_stopped_here) stop_polling (); \
2515 polling_stopped_here = 1; } while (0)
2517 #define RESUME_POLLING \
2518 do { if (polling_stopped_here) start_polling (); \
2519 polling_stopped_here = 0; } while (0)
2521 /* read a character from the keyboard; call the redisplay if needed */
2522 /* commandflag 0 means do not do auto-saving, but do do redisplay.
2523 -1 means do not do redisplay, but do do autosaving.
2524 1 means do both. */
2526 /* The arguments MAPS and NMAPS are for menu prompting.
2527 MAPS is an array of keymaps; NMAPS is the length of MAPS.
2529 PREV_EVENT is the previous input event, or nil if we are reading
2530 the first event of a key sequence (or not reading a key sequence).
2531 If PREV_EVENT is t, that is a "magic" value that says
2532 not to run input methods, but in other respects to act as if
2533 not reading a key sequence.
2535 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
2536 if we used a mouse menu to read the input, or zero otherwise. If
2537 USED_MOUSE_MENU is null, we don't dereference it.
2539 Value is -2 when we find input on another keyboard. A second call
2540 to read_char will read it.
2542 If END_TIME is non-null, it is a pointer to an EMACS_TIME
2543 specifying the maximum time to wait until. If no input arrives by
2544 that time, stop waiting and return nil.
2546 Value is t if we showed a menu and the user rejected it. */
2548 Lisp_Object
2549 read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu, end_time)
2550 int commandflag;
2551 int nmaps;
2552 Lisp_Object *maps;
2553 Lisp_Object prev_event;
2554 int *used_mouse_menu;
2555 EMACS_TIME *end_time;
2557 volatile Lisp_Object c;
2558 int count, jmpcount;
2559 jmp_buf local_getcjmp;
2560 jmp_buf save_jump;
2561 volatile int key_already_recorded = 0;
2562 Lisp_Object tem, save;
2563 volatile Lisp_Object previous_echo_area_message;
2564 volatile Lisp_Object also_record;
2565 volatile int reread;
2566 struct gcpro gcpro1, gcpro2;
2567 int polling_stopped_here = 0;
2568 struct kboard *orig_kboard = current_kboard;
2570 also_record = Qnil;
2572 #if 0 /* This was commented out as part of fixing echo for C-u left. */
2573 before_command_key_count = this_command_key_count;
2574 before_command_echo_length = echo_length ();
2575 #endif
2576 c = Qnil;
2577 previous_echo_area_message = Qnil;
2579 GCPRO2 (c, previous_echo_area_message);
2581 retry:
2583 reread = 0;
2584 if (CONSP (Vunread_post_input_method_events))
2586 c = XCAR (Vunread_post_input_method_events);
2587 Vunread_post_input_method_events
2588 = XCDR (Vunread_post_input_method_events);
2590 /* Undo what read_char_x_menu_prompt did when it unread
2591 additional keys returned by Fx_popup_menu. */
2592 if (CONSP (c)
2593 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2594 && NILP (XCDR (c)))
2595 c = XCAR (c);
2597 reread = 1;
2598 goto reread_first;
2601 if (unread_command_char != -1)
2603 XSETINT (c, unread_command_char);
2604 unread_command_char = -1;
2606 reread = 1;
2607 goto reread_first;
2610 if (CONSP (Vunread_command_events))
2612 int was_disabled = 0;
2614 c = XCAR (Vunread_command_events);
2615 Vunread_command_events = XCDR (Vunread_command_events);
2617 reread = 1;
2619 /* Undo what sit-for did when it unread additional keys
2620 inside universal-argument. */
2622 if (CONSP (c)
2623 && EQ (XCAR (c), Qt))
2625 reread = 0;
2626 c = XCDR (c);
2629 /* Undo what read_char_x_menu_prompt did when it unread
2630 additional keys returned by Fx_popup_menu. */
2631 if (CONSP (c)
2632 && EQ (XCDR (c), Qdisabled)
2633 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))))
2635 was_disabled = 1;
2636 c = XCAR (c);
2639 /* If the queued event is something that used the mouse,
2640 set used_mouse_menu accordingly. */
2641 if (used_mouse_menu
2642 /* Also check was_disabled so last-nonmenu-event won't return
2643 a bad value when submenus are involved. (Bug#447) */
2644 && (EQ (c, Qtool_bar) || EQ (c, Qmenu_bar) || was_disabled))
2645 *used_mouse_menu = 1;
2647 goto reread_for_input_method;
2650 if (CONSP (Vunread_input_method_events))
2652 c = XCAR (Vunread_input_method_events);
2653 Vunread_input_method_events = XCDR (Vunread_input_method_events);
2655 /* Undo what read_char_x_menu_prompt did when it unread
2656 additional keys returned by Fx_popup_menu. */
2657 if (CONSP (c)
2658 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2659 && NILP (XCDR (c)))
2660 c = XCAR (c);
2661 reread = 1;
2662 goto reread_for_input_method;
2665 this_command_key_count_reset = 0;
2667 if (!NILP (Vexecuting_kbd_macro))
2669 /* We set this to Qmacro; since that's not a frame, nobody will
2670 try to switch frames on us, and the selected window will
2671 remain unchanged.
2673 Since this event came from a macro, it would be misleading to
2674 leave internal_last_event_frame set to wherever the last
2675 real event came from. Normally, a switch-frame event selects
2676 internal_last_event_frame after each command is read, but
2677 events read from a macro should never cause a new frame to be
2678 selected. */
2679 Vlast_event_frame = internal_last_event_frame = Qmacro;
2681 /* Exit the macro if we are at the end.
2682 Also, some things replace the macro with t
2683 to force an early exit. */
2684 if (EQ (Vexecuting_kbd_macro, Qt)
2685 || executing_kbd_macro_index >= XFASTINT (Flength (Vexecuting_kbd_macro)))
2687 XSETINT (c, -1);
2688 goto exit;
2691 c = Faref (Vexecuting_kbd_macro, make_number (executing_kbd_macro_index));
2692 if (STRINGP (Vexecuting_kbd_macro)
2693 && (XINT (c) & 0x80) && (XUINT (c) <= 0xff))
2694 XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
2696 executing_kbd_macro_index++;
2698 goto from_macro;
2701 if (!NILP (unread_switch_frame))
2703 c = unread_switch_frame;
2704 unread_switch_frame = Qnil;
2706 /* This event should make it into this_command_keys, and get echoed
2707 again, so we do not set `reread'. */
2708 goto reread_first;
2711 /* if redisplay was requested */
2712 if (commandflag >= 0)
2714 int echo_current = EQ (echo_message_buffer, echo_area_buffer[0]);
2716 /* If there is pending input, process any events which are not
2717 user-visible, such as X selection_request events. */
2718 if (input_pending
2719 || detect_input_pending_run_timers (0))
2720 swallow_events (0); /* may clear input_pending */
2722 /* Redisplay if no pending input. */
2723 while (!input_pending)
2725 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
2726 redisplay_preserve_echo_area (5);
2727 else
2728 redisplay ();
2730 if (!input_pending)
2731 /* Normal case: no input arrived during redisplay. */
2732 break;
2734 /* Input arrived and pre-empted redisplay.
2735 Process any events which are not user-visible. */
2736 swallow_events (0);
2737 /* If that cleared input_pending, try again to redisplay. */
2740 /* Prevent the redisplay we just did
2741 from messing up echoing of the input after the prompt. */
2742 if (commandflag == 0 && echo_current)
2743 echo_message_buffer = echo_area_buffer[0];
2747 /* Message turns off echoing unless more keystrokes turn it on again.
2749 The code in 20.x for the condition was
2751 1. echo_area_glyphs && *echo_area_glyphs
2752 2. && echo_area_glyphs != current_kboard->echobuf
2753 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2755 (1) means there's a current message displayed
2757 (2) means it's not the message from echoing from the current
2758 kboard.
2760 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2761 is set to a non-null value. This is done in read_char and it is
2762 set to echo_area_glyphs after a call to echo_char. That means
2763 ok_to_echo_at_next_pause is either null or
2764 current_kboard->echobuf with the appropriate current_kboard at
2765 that time.
2767 So, condition (3) means in clear text ok_to_echo_at_next_pause
2768 must be either null, or the current message isn't from echoing at
2769 all, or it's from echoing from a different kboard than the
2770 current one. */
2772 if (/* There currently is something in the echo area. */
2773 !NILP (echo_area_buffer[0])
2774 && (/* And it's either not from echoing. */
2775 !EQ (echo_area_buffer[0], echo_message_buffer)
2776 /* Or it's an echo from a different kboard. */
2777 || echo_kboard != current_kboard
2778 /* Or we explicitly allow overwriting whatever there is. */
2779 || ok_to_echo_at_next_pause == NULL))
2780 cancel_echoing ();
2781 else
2782 echo_dash ();
2784 /* Try reading a character via menu prompting in the minibuf.
2785 Try this before the sit-for, because the sit-for
2786 would do the wrong thing if we are supposed to do
2787 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2788 after a mouse event so don't try a minibuf menu. */
2789 c = Qnil;
2790 if (nmaps > 0 && INTERACTIVE
2791 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2792 /* Don't bring up a menu if we already have another event. */
2793 && NILP (Vunread_command_events)
2794 && unread_command_char < 0
2795 && !detect_input_pending_run_timers (0))
2797 c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
2799 if (INTEGERP (c) && XINT (c) == -2)
2800 return c; /* wrong_kboard_jmpbuf */
2802 if (! NILP (c))
2804 key_already_recorded = 1;
2805 goto non_reread_1;
2809 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2810 We will do that below, temporarily for short sections of code,
2811 when appropriate. local_getcjmp must be in effect
2812 around any call to sit_for or kbd_buffer_get_event;
2813 it *must not* be in effect when we call redisplay. */
2815 jmpcount = SPECPDL_INDEX ();
2816 if (_setjmp (local_getcjmp))
2818 /* Handle quits while reading the keyboard. */
2819 /* We must have saved the outer value of getcjmp here,
2820 so restore it now. */
2821 restore_getcjmp (save_jump);
2822 unbind_to (jmpcount, Qnil);
2823 XSETINT (c, quit_char);
2824 internal_last_event_frame = selected_frame;
2825 Vlast_event_frame = internal_last_event_frame;
2826 /* If we report the quit char as an event,
2827 don't do so more than once. */
2828 if (!NILP (Vinhibit_quit))
2829 Vquit_flag = Qnil;
2832 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
2833 if (kb != current_kboard)
2835 Lisp_Object link = kb->kbd_queue;
2836 /* We shouldn't get here if we were in single-kboard mode! */
2837 if (single_kboard)
2838 abort ();
2839 if (CONSP (link))
2841 while (CONSP (XCDR (link)))
2842 link = XCDR (link);
2843 if (!NILP (XCDR (link)))
2844 abort ();
2846 if (!CONSP (link))
2847 kb->kbd_queue = Fcons (c, Qnil);
2848 else
2849 XSETCDR (link, Fcons (c, Qnil));
2850 kb->kbd_queue_has_data = 1;
2851 current_kboard = kb;
2852 /* This is going to exit from read_char
2853 so we had better get rid of this frame's stuff. */
2854 UNGCPRO;
2855 return make_number (-2); /* wrong_kboard_jmpbuf */
2858 goto non_reread;
2861 /* Start idle timers if no time limit is supplied. We don't do it
2862 if a time limit is supplied to avoid an infinite recursion in the
2863 situation where an idle timer calls `sit-for'. */
2865 if (!end_time)
2866 timer_start_idle ();
2868 /* If in middle of key sequence and minibuffer not active,
2869 start echoing if enough time elapses. */
2871 if (minibuf_level == 0
2872 && !end_time
2873 && !current_kboard->immediate_echo
2874 && this_command_key_count > 0
2875 && ! noninteractive
2876 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2877 && NILP (Fzerop (Vecho_keystrokes))
2878 && (/* No message. */
2879 NILP (echo_area_buffer[0])
2880 /* Or empty message. */
2881 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2882 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2883 /* Or already echoing from same kboard. */
2884 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2885 /* Or not echoing before and echoing allowed. */
2886 || (!echo_kboard && ok_to_echo_at_next_pause)))
2888 /* After a mouse event, start echoing right away.
2889 This is because we are probably about to display a menu,
2890 and we don't want to delay before doing so. */
2891 if (EVENT_HAS_PARAMETERS (prev_event))
2892 echo_now ();
2893 else
2895 Lisp_Object tem0;
2897 save_getcjmp (save_jump);
2898 restore_getcjmp (local_getcjmp);
2899 tem0 = sit_for (Vecho_keystrokes, 1, 1);
2900 restore_getcjmp (save_jump);
2901 if (EQ (tem0, Qt)
2902 && ! CONSP (Vunread_command_events))
2903 echo_now ();
2907 /* Maybe auto save due to number of keystrokes. */
2909 if (commandflag != 0
2910 && auto_save_interval > 0
2911 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
2912 && !detect_input_pending_run_timers (0))
2914 Fdo_auto_save (Qnil, Qnil);
2915 /* Hooks can actually change some buffers in auto save. */
2916 redisplay ();
2919 /* Try reading using an X menu.
2920 This is never confused with reading using the minibuf
2921 because the recursive call of read_char in read_char_minibuf_menu_prompt
2922 does not pass on any keymaps. */
2924 if (nmaps > 0 && INTERACTIVE
2925 && !NILP (prev_event)
2926 && EVENT_HAS_PARAMETERS (prev_event)
2927 && !EQ (XCAR (prev_event), Qmenu_bar)
2928 && !EQ (XCAR (prev_event), Qtool_bar)
2929 /* Don't bring up a menu if we already have another event. */
2930 && NILP (Vunread_command_events)
2931 && unread_command_char < 0)
2933 c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
2935 /* Now that we have read an event, Emacs is not idle. */
2936 if (!end_time)
2937 timer_stop_idle ();
2939 goto exit;
2942 /* Maybe autosave and/or garbage collect due to idleness. */
2944 if (INTERACTIVE && NILP (c))
2946 int delay_level, buffer_size;
2948 /* Slow down auto saves logarithmically in size of current buffer,
2949 and garbage collect while we're at it. */
2950 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2951 last_non_minibuf_size = Z - BEG;
2952 buffer_size = (last_non_minibuf_size >> 8) + 1;
2953 delay_level = 0;
2954 while (buffer_size > 64)
2955 delay_level++, buffer_size -= buffer_size >> 2;
2956 if (delay_level < 4) delay_level = 4;
2957 /* delay_level is 4 for files under around 50k, 7 at 100k,
2958 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2960 /* Auto save if enough time goes by without input. */
2961 if (commandflag != 0
2962 && num_nonmacro_input_events > last_auto_save
2963 && INTEGERP (Vauto_save_timeout)
2964 && XINT (Vauto_save_timeout) > 0)
2966 Lisp_Object tem0;
2967 int timeout = delay_level * XFASTINT (Vauto_save_timeout) / 4;
2969 save_getcjmp (save_jump);
2970 restore_getcjmp (local_getcjmp);
2971 tem0 = sit_for (make_number (timeout), 1, 1);
2972 restore_getcjmp (save_jump);
2974 if (EQ (tem0, Qt)
2975 && ! CONSP (Vunread_command_events))
2977 Fdo_auto_save (Qnil, Qnil);
2979 /* If we have auto-saved and there is still no input
2980 available, garbage collect if there has been enough
2981 consing going on to make it worthwhile. */
2982 if (!detect_input_pending_run_timers (0)
2983 && consing_since_gc > gc_cons_threshold / 2)
2984 Fgarbage_collect ();
2986 redisplay ();
2991 /* Notify the caller if an autosave hook, or a timer, sentinel or
2992 filter in the sit_for calls above have changed the current
2993 kboard. This could happen if they use the minibuffer or start a
2994 recursive edit, like the fancy splash screen in server.el's
2995 filter. If this longjmp wasn't here, read_key_sequence would
2996 interpret the next key sequence using the wrong translation
2997 tables and function keymaps. */
2998 if (NILP (c) && current_kboard != orig_kboard)
3000 UNGCPRO;
3001 return make_number (-2); /* wrong_kboard_jmpbuf */
3004 /* If this has become non-nil here, it has been set by a timer
3005 or sentinel or filter. */
3006 if (CONSP (Vunread_command_events))
3008 c = XCAR (Vunread_command_events);
3009 Vunread_command_events = XCDR (Vunread_command_events);
3012 /* Read something from current KBOARD's side queue, if possible. */
3014 if (NILP (c))
3016 if (current_kboard->kbd_queue_has_data)
3018 if (!CONSP (current_kboard->kbd_queue))
3019 abort ();
3020 c = XCAR (current_kboard->kbd_queue);
3021 current_kboard->kbd_queue
3022 = XCDR (current_kboard->kbd_queue);
3023 if (NILP (current_kboard->kbd_queue))
3024 current_kboard->kbd_queue_has_data = 0;
3025 input_pending = readable_events (0);
3026 if (EVENT_HAS_PARAMETERS (c)
3027 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
3028 internal_last_event_frame = XCAR (XCDR (c));
3029 Vlast_event_frame = internal_last_event_frame;
3033 /* If current_kboard's side queue is empty check the other kboards.
3034 If one of them has data that we have not yet seen here,
3035 switch to it and process the data waiting for it.
3037 Note: if the events queued up for another kboard
3038 have already been seen here, and therefore are not a complete command,
3039 the kbd_queue_has_data field is 0, so we skip that kboard here.
3040 That's to avoid an infinite loop switching between kboards here. */
3041 if (NILP (c) && !single_kboard)
3043 KBOARD *kb;
3044 for (kb = all_kboards; kb; kb = kb->next_kboard)
3045 if (kb->kbd_queue_has_data)
3047 current_kboard = kb;
3048 /* This is going to exit from read_char
3049 so we had better get rid of this frame's stuff. */
3050 UNGCPRO;
3051 return make_number (-2); /* wrong_kboard_jmpbuf */
3055 wrong_kboard:
3057 STOP_POLLING;
3059 /* Finally, we read from the main queue,
3060 and if that gives us something we can't use yet, we put it on the
3061 appropriate side queue and try again. */
3063 if (NILP (c))
3065 KBOARD *kb;
3067 if (end_time)
3069 EMACS_TIME now;
3070 EMACS_GET_TIME (now);
3071 if (EMACS_TIME_GE (now, *end_time))
3072 goto exit;
3075 /* Actually read a character, waiting if necessary. */
3076 save_getcjmp (save_jump);
3077 restore_getcjmp (local_getcjmp);
3078 if (!end_time)
3079 timer_start_idle ();
3080 c = kbd_buffer_get_event (&kb, used_mouse_menu, end_time);
3081 restore_getcjmp (save_jump);
3083 if (! NILP (c) && (kb != current_kboard))
3085 Lisp_Object link = kb->kbd_queue;
3086 if (CONSP (link))
3088 while (CONSP (XCDR (link)))
3089 link = XCDR (link);
3090 if (!NILP (XCDR (link)))
3091 abort ();
3093 if (!CONSP (link))
3094 kb->kbd_queue = Fcons (c, Qnil);
3095 else
3096 XSETCDR (link, Fcons (c, Qnil));
3097 kb->kbd_queue_has_data = 1;
3098 c = Qnil;
3099 if (single_kboard)
3100 goto wrong_kboard;
3101 current_kboard = kb;
3102 /* This is going to exit from read_char
3103 so we had better get rid of this frame's stuff. */
3104 UNGCPRO;
3105 return make_number (-2);
3109 /* Terminate Emacs in batch mode if at eof. */
3110 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
3111 Fkill_emacs (make_number (1));
3113 if (INTEGERP (c))
3115 /* Add in any extra modifiers, where appropriate. */
3116 if ((extra_keyboard_modifiers & CHAR_CTL)
3117 || ((extra_keyboard_modifiers & 0177) < ' '
3118 && (extra_keyboard_modifiers & 0177) != 0))
3119 XSETINT (c, make_ctrl_char (XINT (c)));
3121 /* Transfer any other modifier bits directly from
3122 extra_keyboard_modifiers to c. Ignore the actual character code
3123 in the low 16 bits of extra_keyboard_modifiers. */
3124 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
3127 non_reread:
3129 if (!end_time)
3130 timer_stop_idle ();
3131 RESUME_POLLING;
3133 if (NILP (c))
3135 if (commandflag >= 0
3136 && !input_pending && !detect_input_pending_run_timers (0))
3137 redisplay ();
3139 goto wrong_kboard;
3142 non_reread_1:
3144 /* Buffer switch events are only for internal wakeups
3145 so don't show them to the user.
3146 Also, don't record a key if we already did. */
3147 if (BUFFERP (c) || key_already_recorded)
3148 goto exit;
3150 /* Process special events within read_char
3151 and loop around to read another event. */
3152 save = Vquit_flag;
3153 Vquit_flag = Qnil;
3154 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
3155 Vquit_flag = save;
3157 if (!NILP (tem))
3159 struct buffer *prev_buffer = current_buffer;
3160 #if 0 /* This shouldn't be necessary anymore. --lorentey */
3161 int was_locked = single_kboard;
3162 int count = SPECPDL_INDEX ();
3163 record_single_kboard_state ();
3164 #endif
3166 last_input_event = c;
3167 Fcommand_execute (tem, Qnil, Fvector (1, &last_input_event), Qt);
3169 if (CONSP (c) && EQ (XCAR (c), Qselect_window) && !end_time)
3170 /* We stopped being idle for this event; undo that. This
3171 prevents automatic window selection (under
3172 mouse_autoselect_window from acting as a real input event, for
3173 example banishing the mouse under mouse-avoidance-mode. */
3174 timer_resume_idle ();
3176 #if 0 /* This shouldn't be necessary anymore. --lorentey */
3177 /* Resume allowing input from any kboard, if that was true before. */
3178 if (!was_locked)
3179 any_kboard_state ();
3180 unbind_to (count, Qnil);
3181 #endif
3183 if (current_buffer != prev_buffer)
3185 /* The command may have changed the keymaps. Pretend there
3186 is input in another keyboard and return. This will
3187 recalculate keymaps. */
3188 c = make_number (-2);
3189 goto exit;
3191 else
3192 goto retry;
3195 /* Handle things that only apply to characters. */
3196 if (INTEGERP (c))
3198 /* If kbd_buffer_get_event gave us an EOF, return that. */
3199 if (XINT (c) == -1)
3200 goto exit;
3202 if ((STRINGP (current_kboard->Vkeyboard_translate_table)
3203 && SCHARS (current_kboard->Vkeyboard_translate_table) > (unsigned) XFASTINT (c))
3204 || (VECTORP (current_kboard->Vkeyboard_translate_table)
3205 && XVECTOR (current_kboard->Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
3206 || (CHAR_TABLE_P (current_kboard->Vkeyboard_translate_table)
3207 && CHARACTERP (c)))
3209 Lisp_Object d;
3210 d = Faref (current_kboard->Vkeyboard_translate_table, c);
3211 /* nil in keyboard-translate-table means no translation. */
3212 if (!NILP (d))
3213 c = d;
3217 /* If this event is a mouse click in the menu bar,
3218 return just menu-bar for now. Modify the mouse click event
3219 so we won't do this twice, then queue it up. */
3220 if (EVENT_HAS_PARAMETERS (c)
3221 && CONSP (XCDR (c))
3222 && CONSP (EVENT_START (c))
3223 && CONSP (XCDR (EVENT_START (c))))
3225 Lisp_Object posn;
3227 posn = POSN_POSN (EVENT_START (c));
3228 /* Handle menu-bar events:
3229 insert the dummy prefix event `menu-bar'. */
3230 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
3232 /* Change menu-bar to (menu-bar) as the event "position". */
3233 POSN_SET_POSN (EVENT_START (c), Fcons (posn, Qnil));
3235 also_record = c;
3236 Vunread_command_events = Fcons (c, Vunread_command_events);
3237 c = posn;
3241 /* Store these characters into recent_keys, the dribble file if any,
3242 and the keyboard macro being defined, if any. */
3243 record_char (c);
3244 if (! NILP (also_record))
3245 record_char (also_record);
3247 /* Wipe the echo area.
3248 But first, if we are about to use an input method,
3249 save the echo area contents for it to refer to. */
3250 if (INTEGERP (c)
3251 && ! NILP (Vinput_method_function)
3252 && (unsigned) XINT (c) >= ' '
3253 && (unsigned) XINT (c) != 127
3254 && (unsigned) XINT (c) < 256)
3256 previous_echo_area_message = Fcurrent_message ();
3257 Vinput_method_previous_message = previous_echo_area_message;
3260 /* Now wipe the echo area, except for help events which do their
3261 own stuff with the echo area. */
3262 if (!CONSP (c)
3263 || (!(EQ (Qhelp_echo, XCAR (c)))
3264 && !(EQ (Qswitch_frame, XCAR (c)))))
3266 if (!NILP (echo_area_buffer[0]))
3267 safe_run_hooks (Qecho_area_clear_hook);
3268 clear_message (1, 0);
3271 reread_for_input_method:
3272 from_macro:
3273 /* Pass this to the input method, if appropriate. */
3274 if (INTEGERP (c)
3275 && ! NILP (Vinput_method_function)
3276 /* Don't run the input method within a key sequence,
3277 after the first event of the key sequence. */
3278 && NILP (prev_event)
3279 && (unsigned) XINT (c) >= ' '
3280 && (unsigned) XINT (c) != 127
3281 && (unsigned) XINT (c) < 256)
3283 Lisp_Object keys;
3284 int key_count, key_count_reset;
3285 struct gcpro gcpro1;
3286 int count = SPECPDL_INDEX ();
3288 /* Save the echo status. */
3289 int saved_immediate_echo = current_kboard->immediate_echo;
3290 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
3291 Lisp_Object saved_echo_string = current_kboard->echo_string;
3292 int saved_echo_after_prompt = current_kboard->echo_after_prompt;
3294 #if 0
3295 if (before_command_restore_flag)
3297 this_command_key_count = before_command_key_count_1;
3298 if (this_command_key_count < this_single_command_key_start)
3299 this_single_command_key_start = this_command_key_count;
3300 echo_truncate (before_command_echo_length_1);
3301 before_command_restore_flag = 0;
3303 #endif
3305 /* Save the this_command_keys status. */
3306 key_count = this_command_key_count;
3307 key_count_reset = this_command_key_count_reset;
3309 if (key_count > 0)
3310 keys = Fcopy_sequence (this_command_keys);
3311 else
3312 keys = Qnil;
3313 GCPRO1 (keys);
3315 /* Clear out this_command_keys. */
3316 this_command_key_count = 0;
3317 this_command_key_count_reset = 0;
3319 /* Now wipe the echo area. */
3320 if (!NILP (echo_area_buffer[0]))
3321 safe_run_hooks (Qecho_area_clear_hook);
3322 clear_message (1, 0);
3323 echo_truncate (0);
3325 /* If we are not reading a key sequence,
3326 never use the echo area. */
3327 if (maps == 0)
3329 specbind (Qinput_method_use_echo_area, Qt);
3332 /* Call the input method. */
3333 tem = call1 (Vinput_method_function, c);
3335 tem = unbind_to (count, tem);
3337 /* Restore the saved echoing state
3338 and this_command_keys state. */
3339 this_command_key_count = key_count;
3340 this_command_key_count_reset = key_count_reset;
3341 if (key_count > 0)
3342 this_command_keys = keys;
3344 cancel_echoing ();
3345 ok_to_echo_at_next_pause = saved_ok_to_echo;
3346 current_kboard->echo_string = saved_echo_string;
3347 current_kboard->echo_after_prompt = saved_echo_after_prompt;
3348 if (saved_immediate_echo)
3349 echo_now ();
3351 UNGCPRO;
3353 /* The input method can return no events. */
3354 if (! CONSP (tem))
3356 /* Bring back the previous message, if any. */
3357 if (! NILP (previous_echo_area_message))
3358 message_with_string ("%s", previous_echo_area_message, 0);
3359 goto retry;
3361 /* It returned one event or more. */
3362 c = XCAR (tem);
3363 Vunread_post_input_method_events
3364 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
3367 reread_first:
3369 /* Display help if not echoing. */
3370 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
3372 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
3373 Lisp_Object help, object, position, window, tem;
3375 tem = Fcdr (XCDR (c));
3376 help = Fcar (tem);
3377 tem = Fcdr (tem);
3378 window = Fcar (tem);
3379 tem = Fcdr (tem);
3380 object = Fcar (tem);
3381 tem = Fcdr (tem);
3382 position = Fcar (tem);
3384 show_help_echo (help, window, object, position, 0);
3386 /* We stopped being idle for this event; undo that. */
3387 if (!end_time)
3388 timer_resume_idle ();
3389 goto retry;
3392 if ((! reread || this_command_key_count == 0
3393 || this_command_key_count_reset)
3394 && !end_time)
3397 /* Don't echo mouse motion events. */
3398 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
3399 && NILP (Fzerop (Vecho_keystrokes))
3400 && ! (EVENT_HAS_PARAMETERS (c)
3401 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
3403 echo_char (c);
3404 if (! NILP (also_record))
3405 echo_char (also_record);
3406 /* Once we reread a character, echoing can happen
3407 the next time we pause to read a new one. */
3408 ok_to_echo_at_next_pause = current_kboard;
3411 /* Record this character as part of the current key. */
3412 add_command_key (c);
3413 if (! NILP (also_record))
3414 add_command_key (also_record);
3417 last_input_event = c;
3418 num_input_events++;
3420 /* Process the help character specially if enabled */
3421 if (!NILP (Vhelp_form) && help_char_p (c))
3423 Lisp_Object tem0;
3424 count = SPECPDL_INDEX ();
3426 help_form_saved_window_configs
3427 = Fcons (Fcurrent_window_configuration (Qnil),
3428 help_form_saved_window_configs);
3429 record_unwind_protect (read_char_help_form_unwind, Qnil);
3431 tem0 = Feval (Vhelp_form);
3432 if (STRINGP (tem0))
3433 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
3435 cancel_echoing ();
3438 c = read_char (0, 0, 0, Qnil, 0, NULL);
3439 if (EVENT_HAS_PARAMETERS (c)
3440 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_click))
3441 XSETCAR (help_form_saved_window_configs, Qnil);
3443 while (BUFFERP (c));
3444 /* Remove the help from the frame */
3445 unbind_to (count, Qnil);
3447 redisplay ();
3448 if (EQ (c, make_number (040)))
3450 cancel_echoing ();
3452 c = read_char (0, 0, 0, Qnil, 0, NULL);
3453 while (BUFFERP (c));
3457 exit:
3458 RESUME_POLLING;
3459 RETURN_UNGCPRO (c);
3462 /* Record a key that came from a mouse menu.
3463 Record it for echoing, for this-command-keys, and so on. */
3465 static void
3466 record_menu_key (c)
3467 Lisp_Object c;
3469 /* Wipe the echo area. */
3470 clear_message (1, 0);
3472 record_char (c);
3474 #if 0
3475 before_command_key_count = this_command_key_count;
3476 before_command_echo_length = echo_length ();
3477 #endif
3479 /* Don't echo mouse motion events. */
3480 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
3481 && NILP (Fzerop (Vecho_keystrokes)))
3483 echo_char (c);
3485 /* Once we reread a character, echoing can happen
3486 the next time we pause to read a new one. */
3487 ok_to_echo_at_next_pause = 0;
3490 /* Record this character as part of the current key. */
3491 add_command_key (c);
3493 /* Re-reading in the middle of a command */
3494 last_input_event = c;
3495 num_input_events++;
3498 /* Return 1 if should recognize C as "the help character". */
3501 help_char_p (c)
3502 Lisp_Object c;
3504 Lisp_Object tail;
3506 if (EQ (c, Vhelp_char))
3507 return 1;
3508 for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
3509 if (EQ (c, XCAR (tail)))
3510 return 1;
3511 return 0;
3514 /* Record the input event C in various ways. */
3516 static void
3517 record_char (c)
3518 Lisp_Object c;
3520 int recorded = 0;
3522 if (CONSP (c) && (EQ (XCAR (c), Qhelp_echo) || EQ (XCAR (c), Qmouse_movement)))
3524 /* To avoid filling recent_keys with help-echo and mouse-movement
3525 events, we filter out repeated help-echo events, only store the
3526 first and last in a series of mouse-movement events, and don't
3527 store repeated help-echo events which are only separated by
3528 mouse-movement events. */
3530 Lisp_Object ev1, ev2, ev3;
3531 int ix1, ix2, ix3;
3533 if ((ix1 = recent_keys_index - 1) < 0)
3534 ix1 = NUM_RECENT_KEYS - 1;
3535 ev1 = AREF (recent_keys, ix1);
3537 if ((ix2 = ix1 - 1) < 0)
3538 ix2 = NUM_RECENT_KEYS - 1;
3539 ev2 = AREF (recent_keys, ix2);
3541 if ((ix3 = ix2 - 1) < 0)
3542 ix3 = NUM_RECENT_KEYS - 1;
3543 ev3 = AREF (recent_keys, ix3);
3545 if (EQ (XCAR (c), Qhelp_echo))
3547 /* Don't record `help-echo' in recent_keys unless it shows some help
3548 message, and a different help than the previously recorded
3549 event. */
3550 Lisp_Object help, last_help;
3552 help = Fcar_safe (Fcdr_safe (XCDR (c)));
3553 if (!STRINGP (help))
3554 recorded = 1;
3555 else if (CONSP (ev1) && EQ (XCAR (ev1), Qhelp_echo)
3556 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev1))), EQ (last_help, help)))
3557 recorded = 1;
3558 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3559 && CONSP (ev2) && EQ (XCAR (ev2), Qhelp_echo)
3560 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev2))), EQ (last_help, help)))
3561 recorded = -1;
3562 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3563 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3564 && CONSP (ev3) && EQ (XCAR (ev3), Qhelp_echo)
3565 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev3))), EQ (last_help, help)))
3566 recorded = -2;
3568 else if (EQ (XCAR (c), Qmouse_movement))
3570 /* Only record one pair of `mouse-movement' on a window in recent_keys.
3571 So additional mouse movement events replace the last element. */
3572 Lisp_Object last_window, window;
3574 window = Fcar_safe (Fcar_safe (XCDR (c)));
3575 if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3576 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev1))), EQ (last_window, window))
3577 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3578 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev2))), EQ (last_window, window)))
3580 ASET (recent_keys, ix1, c);
3581 recorded = 1;
3585 else
3586 store_kbd_macro_char (c);
3588 if (!recorded)
3590 total_keys++;
3591 ASET (recent_keys, recent_keys_index, c);
3592 if (++recent_keys_index >= NUM_RECENT_KEYS)
3593 recent_keys_index = 0;
3595 else if (recorded < 0)
3597 /* We need to remove one or two events from recent_keys.
3598 To do this, we simply put nil at those events and move the
3599 recent_keys_index backwards over those events. Usually,
3600 users will never see those nil events, as they will be
3601 overwritten by the command keys entered to see recent_keys
3602 (e.g. C-h l). */
3604 while (recorded++ < 0 && total_keys > 0)
3606 if (total_keys < NUM_RECENT_KEYS)
3607 total_keys--;
3608 if (--recent_keys_index < 0)
3609 recent_keys_index = NUM_RECENT_KEYS - 1;
3610 ASET (recent_keys, recent_keys_index, Qnil);
3614 num_nonmacro_input_events++;
3616 /* Write c to the dribble file. If c is a lispy event, write
3617 the event's symbol to the dribble file, in <brackets>. Bleaugh.
3618 If you, dear reader, have a better idea, you've got the source. :-) */
3619 if (dribble)
3621 BLOCK_INPUT;
3622 if (INTEGERP (c))
3624 if (XUINT (c) < 0x100)
3625 putc (XINT (c), dribble);
3626 else
3627 fprintf (dribble, " 0x%x", (int) XUINT (c));
3629 else
3631 Lisp_Object dribblee;
3633 /* If it's a structured event, take the event header. */
3634 dribblee = EVENT_HEAD (c);
3636 if (SYMBOLP (dribblee))
3638 putc ('<', dribble);
3639 fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
3640 SBYTES (SYMBOL_NAME (dribblee)),
3641 dribble);
3642 putc ('>', dribble);
3646 fflush (dribble);
3647 UNBLOCK_INPUT;
3651 Lisp_Object
3652 print_help (object)
3653 Lisp_Object object;
3655 struct buffer *old = current_buffer;
3656 Fprinc (object, Qnil);
3657 set_buffer_internal (XBUFFER (Vstandard_output));
3658 call0 (intern ("help-mode"));
3659 set_buffer_internal (old);
3660 return Qnil;
3663 /* Copy out or in the info on where C-g should throw to.
3664 This is used when running Lisp code from within get_char,
3665 in case get_char is called recursively.
3666 See read_process_output. */
3668 static void
3669 save_getcjmp (temp)
3670 jmp_buf temp;
3672 bcopy (getcjmp, temp, sizeof getcjmp);
3675 static void
3676 restore_getcjmp (temp)
3677 jmp_buf temp;
3679 bcopy (temp, getcjmp, sizeof getcjmp);
3682 /* Low level keyboard/mouse input.
3683 kbd_buffer_store_event places events in kbd_buffer, and
3684 kbd_buffer_get_event retrieves them. */
3686 /* Return true if there are any events in the queue that read-char
3687 would return. If this returns false, a read-char would block. */
3688 static int
3689 readable_events (flags)
3690 int flags;
3692 #ifdef HAVE_DBUS
3693 /* Check whether a D-Bus message has arrived. */
3694 if (xd_pending_messages () > 0)
3695 return 1;
3696 #endif /* HAVE_DBUS */
3698 if (flags & READABLE_EVENTS_DO_TIMERS_NOW)
3699 timer_check (1);
3701 /* If the buffer contains only FOCUS_IN_EVENT events, and
3702 READABLE_EVENTS_FILTER_EVENTS is set, report it as empty. */
3703 if (kbd_fetch_ptr != kbd_store_ptr)
3705 if (flags & (READABLE_EVENTS_FILTER_EVENTS
3706 #ifdef USE_TOOLKIT_SCROLL_BARS
3707 | READABLE_EVENTS_IGNORE_SQUEEZABLES
3708 #endif
3711 struct input_event *event;
3713 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3714 ? kbd_fetch_ptr
3715 : kbd_buffer);
3719 if (!(
3720 #ifdef USE_TOOLKIT_SCROLL_BARS
3721 (flags & READABLE_EVENTS_FILTER_EVENTS) &&
3722 #endif
3723 event->kind == FOCUS_IN_EVENT)
3724 #ifdef USE_TOOLKIT_SCROLL_BARS
3725 && !((flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3726 && event->kind == SCROLL_BAR_CLICK_EVENT
3727 && event->part == scroll_bar_handle
3728 && event->modifiers == 0)
3729 #endif
3731 return 1;
3732 event++;
3733 if (event == kbd_buffer + KBD_BUFFER_SIZE)
3734 event = kbd_buffer;
3736 while (event != kbd_store_ptr);
3738 else
3739 return 1;
3742 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
3743 if (!(flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3744 && !NILP (do_mouse_tracking) && some_mouse_moved ())
3745 return 1;
3746 #endif
3747 if (single_kboard)
3749 if (current_kboard->kbd_queue_has_data)
3750 return 1;
3752 else
3754 KBOARD *kb;
3755 for (kb = all_kboards; kb; kb = kb->next_kboard)
3756 if (kb->kbd_queue_has_data)
3757 return 1;
3759 return 0;
3762 /* Set this for debugging, to have a way to get out */
3763 int stop_character;
3765 static KBOARD *
3766 event_to_kboard (event)
3767 struct input_event *event;
3769 Lisp_Object frame;
3770 frame = event->frame_or_window;
3771 if (CONSP (frame))
3772 frame = XCAR (frame);
3773 else if (WINDOWP (frame))
3774 frame = WINDOW_FRAME (XWINDOW (frame));
3776 /* There are still some events that don't set this field.
3777 For now, just ignore the problem.
3778 Also ignore dead frames here. */
3779 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
3780 return 0;
3781 else
3782 return FRAME_KBOARD (XFRAME (frame));
3786 Lisp_Object impl_Vthrow_on_input;
3788 /* Store an event obtained at interrupt level into kbd_buffer, fifo */
3790 void
3791 kbd_buffer_store_event (event)
3792 register struct input_event *event;
3794 kbd_buffer_store_event_hold (event, 0);
3797 /* Store EVENT obtained at interrupt level into kbd_buffer, fifo.
3799 If HOLD_QUIT is 0, just stuff EVENT into the fifo.
3800 Else, if HOLD_QUIT.kind != NO_EVENT, discard EVENT.
3801 Else, if EVENT is a quit event, store the quit event
3802 in HOLD_QUIT, and return (thus ignoring further events).
3804 This is used in read_avail_input to postpone the processing
3805 of the quit event until all subsequent input events have been
3806 parsed (and discarded).
3809 void
3810 kbd_buffer_store_event_hold (event, hold_quit)
3811 register struct input_event *event;
3812 struct input_event *hold_quit;
3814 if (event->kind == NO_EVENT)
3815 abort ();
3817 if (hold_quit && hold_quit->kind != NO_EVENT)
3818 return;
3820 if (event->kind == ASCII_KEYSTROKE_EVENT)
3822 register int c = event->code & 0377;
3824 if (event->modifiers & ctrl_modifier)
3825 c = make_ctrl_char (c);
3827 c |= (event->modifiers
3828 & (meta_modifier | alt_modifier
3829 | hyper_modifier | super_modifier));
3831 if (c == quit_char)
3833 KBOARD *kb = FRAME_KBOARD (XFRAME (event->frame_or_window));
3834 struct input_event *sp;
3836 if (single_kboard && kb != current_kboard)
3838 kb->kbd_queue
3839 = Fcons (make_lispy_switch_frame (event->frame_or_window),
3840 Fcons (make_number (c), Qnil));
3841 kb->kbd_queue_has_data = 1;
3842 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3844 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3845 sp = kbd_buffer;
3847 if (event_to_kboard (sp) == kb)
3849 sp->kind = NO_EVENT;
3850 sp->frame_or_window = Qnil;
3851 sp->arg = Qnil;
3854 return;
3857 if (hold_quit)
3859 bcopy (event, (char *) hold_quit, sizeof (*event));
3860 return;
3863 /* If this results in a quit_char being returned to Emacs as
3864 input, set Vlast_event_frame properly. If this doesn't
3865 get returned to Emacs as an event, the next event read
3866 will set Vlast_event_frame again, so this is safe to do. */
3868 Lisp_Object focus;
3870 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
3871 if (NILP (focus))
3872 focus = event->frame_or_window;
3873 internal_last_event_frame = focus;
3874 Vlast_event_frame = focus;
3877 last_event_timestamp = event->timestamp;
3878 handle_interrupt ();
3879 return;
3882 if (c && c == stop_character)
3884 sys_suspend ();
3885 return;
3888 /* Don't insert two BUFFER_SWITCH_EVENT's in a row.
3889 Just ignore the second one. */
3890 else if (event->kind == BUFFER_SWITCH_EVENT
3891 && kbd_fetch_ptr != kbd_store_ptr
3892 && ((kbd_store_ptr == kbd_buffer
3893 ? kbd_buffer + KBD_BUFFER_SIZE - 1
3894 : kbd_store_ptr - 1)->kind) == BUFFER_SWITCH_EVENT)
3895 return;
3897 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
3898 kbd_store_ptr = kbd_buffer;
3900 /* Don't let the very last slot in the buffer become full,
3901 since that would make the two pointers equal,
3902 and that is indistinguishable from an empty buffer.
3903 Discard the event if it would fill the last slot. */
3904 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3906 *kbd_store_ptr = *event;
3907 ++kbd_store_ptr;
3910 /* If we're inside while-no-input, and this event qualifies
3911 as input, set quit-flag to cause an interrupt. */
3912 if (!NILP (Vthrow_on_input)
3913 && event->kind != FOCUS_IN_EVENT
3914 && event->kind != HELP_EVENT
3915 && event->kind != DEICONIFY_EVENT)
3917 Vquit_flag = Vthrow_on_input;
3918 /* If we're inside a function that wants immediate quits,
3919 do it now. */
3920 if (immediate_quit && NILP (Vinhibit_quit))
3922 immediate_quit = 0;
3923 sigfree ();
3924 QUIT;
3930 /* Put an input event back in the head of the event queue. */
3932 void
3933 kbd_buffer_unget_event (event)
3934 register struct input_event *event;
3936 if (kbd_fetch_ptr == kbd_buffer)
3937 kbd_fetch_ptr = kbd_buffer + KBD_BUFFER_SIZE;
3939 /* Don't let the very last slot in the buffer become full, */
3940 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3942 --kbd_fetch_ptr;
3943 *kbd_fetch_ptr = *event;
3948 /* Generate HELP_EVENT input_events in BUFP which has room for
3949 SIZE events. If there's not enough room in BUFP, ignore this
3950 event.
3952 HELP is the help form.
3954 FRAME is the frame on which the help is generated. OBJECT is the
3955 Lisp object where the help was found (a buffer, a string, an
3956 overlay, or nil if neither from a string nor from a buffer. POS is
3957 the position within OBJECT where the help was found.
3959 Value is the number of input_events generated. */
3961 void
3962 gen_help_event (help, frame, window, object, pos)
3963 Lisp_Object help, frame, object, window;
3964 int pos;
3966 struct input_event event;
3968 EVENT_INIT (event);
3970 event.kind = HELP_EVENT;
3971 event.frame_or_window = frame;
3972 event.arg = object;
3973 event.x = WINDOWP (window) ? window : frame;
3974 event.y = help;
3975 event.code = pos;
3976 kbd_buffer_store_event (&event);
3980 /* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3982 void
3983 kbd_buffer_store_help_event (frame, help)
3984 Lisp_Object frame, help;
3986 struct input_event event;
3988 event.kind = HELP_EVENT;
3989 event.frame_or_window = frame;
3990 event.arg = Qnil;
3991 event.x = Qnil;
3992 event.y = help;
3993 event.code = 0;
3994 kbd_buffer_store_event (&event);
3998 /* Discard any mouse events in the event buffer by setting them to
3999 NO_EVENT. */
4000 void
4001 discard_mouse_events ()
4003 struct input_event *sp;
4004 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
4006 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
4007 sp = kbd_buffer;
4009 if (sp->kind == MOUSE_CLICK_EVENT
4010 || sp->kind == WHEEL_EVENT
4011 || sp->kind == HORIZ_WHEEL_EVENT
4012 #ifdef HAVE_GPM
4013 || sp->kind == GPM_CLICK_EVENT
4014 #endif
4015 || sp->kind == SCROLL_BAR_CLICK_EVENT)
4017 sp->kind = NO_EVENT;
4023 /* Return non-zero if there are any real events waiting in the event
4024 buffer, not counting `NO_EVENT's.
4026 If DISCARD is non-zero, discard NO_EVENT events at the front of
4027 the input queue, possibly leaving the input queue empty if there
4028 are no real input events. */
4031 kbd_buffer_events_waiting (discard)
4032 int discard;
4034 struct input_event *sp;
4036 for (sp = kbd_fetch_ptr;
4037 sp != kbd_store_ptr && sp->kind == NO_EVENT;
4038 ++sp)
4040 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
4041 sp = kbd_buffer;
4044 if (discard)
4045 kbd_fetch_ptr = sp;
4047 return sp != kbd_store_ptr && sp->kind != NO_EVENT;
4051 /* Clear input event EVENT. */
4053 static INLINE void
4054 clear_event (event)
4055 struct input_event *event;
4057 event->kind = NO_EVENT;
4061 /* Read one event from the event buffer, waiting if necessary.
4062 The value is a Lisp object representing the event.
4063 The value is nil for an event that should be ignored,
4064 or that was handled here.
4065 We always read and discard one event. */
4067 static Lisp_Object
4068 kbd_buffer_get_event (kbp, used_mouse_menu, end_time)
4069 KBOARD **kbp;
4070 int *used_mouse_menu;
4071 EMACS_TIME *end_time;
4073 register int c;
4074 Lisp_Object obj;
4076 if (noninteractive
4077 /* In case we are running as a daemon, only do this before
4078 detaching from the terminal. */
4079 || (IS_DAEMON && daemon_pipe[1] >= 0))
4081 c = getchar ();
4082 XSETINT (obj, c);
4083 *kbp = current_kboard;
4084 return obj;
4087 /* Wait until there is input available. */
4088 for (;;)
4090 /* Break loop if there's an unread command event. Needed in
4091 moused window autoselection which uses a timer to insert such
4092 events. */
4093 if (CONSP (Vunread_command_events))
4094 break;
4096 if (kbd_fetch_ptr != kbd_store_ptr)
4097 break;
4098 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
4099 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
4100 break;
4101 #endif
4103 /* If the quit flag is set, then read_char will return
4104 quit_char, so that counts as "available input." */
4105 if (!NILP (Vquit_flag))
4106 quit_throw_to_read_char ();
4108 /* One way or another, wait until input is available; then, if
4109 interrupt handlers have not read it, read it now. */
4111 /* Note SIGIO has been undef'd if FIONREAD is missing. */
4112 #ifdef SIGIO
4113 gobble_input (0);
4114 #endif /* SIGIO */
4115 if (kbd_fetch_ptr != kbd_store_ptr)
4116 break;
4117 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
4118 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
4119 break;
4120 #endif
4121 if (end_time)
4123 EMACS_TIME duration;
4124 EMACS_GET_TIME (duration);
4125 if (EMACS_TIME_GE (duration, *end_time))
4126 return Qnil; /* finished waiting */
4127 else
4129 EMACS_SUB_TIME (duration, *end_time, duration);
4130 wait_reading_process_output (EMACS_SECS (duration),
4131 EMACS_USECS (duration),
4132 -1, 1, Qnil, NULL, 0);
4135 else
4136 wait_reading_process_output (0, 0, -1, 1, Qnil, NULL, 0);
4138 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
4139 /* Pass 1 for EXPECT since we just waited to have input. */
4140 read_avail_input (1);
4143 if (CONSP (Vunread_command_events))
4145 Lisp_Object first;
4146 first = XCAR (Vunread_command_events);
4147 Vunread_command_events = XCDR (Vunread_command_events);
4148 *kbp = current_kboard;
4149 return first;
4152 /* At this point, we know that there is a readable event available
4153 somewhere. If the event queue is empty, then there must be a
4154 mouse movement enabled and available. */
4155 if (kbd_fetch_ptr != kbd_store_ptr)
4157 struct input_event *event;
4159 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
4160 ? kbd_fetch_ptr
4161 : kbd_buffer);
4163 last_event_timestamp = event->timestamp;
4165 *kbp = event_to_kboard (event);
4166 if (*kbp == 0)
4167 *kbp = current_kboard; /* Better than returning null ptr? */
4169 obj = Qnil;
4171 /* These two kinds of events get special handling
4172 and don't actually appear to the command loop.
4173 We return nil for them. */
4174 if (event->kind == SELECTION_REQUEST_EVENT
4175 || event->kind == SELECTION_CLEAR_EVENT)
4177 #ifdef HAVE_X11
4178 struct input_event copy;
4180 /* Remove it from the buffer before processing it,
4181 since otherwise swallow_events will see it
4182 and process it again. */
4183 copy = *event;
4184 kbd_fetch_ptr = event + 1;
4185 input_pending = readable_events (0);
4186 x_handle_selection_event (&copy);
4187 #else
4188 /* We're getting selection request events, but we don't have
4189 a window system. */
4190 abort ();
4191 #endif
4194 #if defined (HAVE_NS)
4195 else if (event->kind == NS_TEXT_EVENT)
4197 if (event->code == KEY_NS_PUT_WORKING_TEXT)
4198 obj = Fcons (intern ("ns-put-working-text"), Qnil);
4199 else
4200 obj = Fcons (intern ("ns-unput-working-text"), Qnil);
4201 kbd_fetch_ptr = event + 1;
4202 if (used_mouse_menu)
4203 *used_mouse_menu = 1;
4205 #endif
4207 #if defined (HAVE_X11) || defined (HAVE_NTGUI) \
4208 || defined (HAVE_NS)
4209 else if (event->kind == DELETE_WINDOW_EVENT)
4211 /* Make an event (delete-frame (FRAME)). */
4212 obj = Fcons (event->frame_or_window, Qnil);
4213 obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
4214 kbd_fetch_ptr = event + 1;
4216 #endif
4217 #if defined (HAVE_X11) || defined (HAVE_NTGUI) \
4218 || defined (HAVE_NS)
4219 else if (event->kind == ICONIFY_EVENT)
4221 /* Make an event (iconify-frame (FRAME)). */
4222 obj = Fcons (event->frame_or_window, Qnil);
4223 obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
4224 kbd_fetch_ptr = event + 1;
4226 else if (event->kind == DEICONIFY_EVENT)
4228 /* Make an event (make-frame-visible (FRAME)). */
4229 obj = Fcons (event->frame_or_window, Qnil);
4230 obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
4231 kbd_fetch_ptr = event + 1;
4233 #endif
4234 else if (event->kind == BUFFER_SWITCH_EVENT)
4236 /* The value doesn't matter here; only the type is tested. */
4237 XSETBUFFER (obj, current_buffer);
4238 kbd_fetch_ptr = event + 1;
4240 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
4241 || defined(HAVE_NS) || defined (USE_GTK)
4242 else if (event->kind == MENU_BAR_ACTIVATE_EVENT)
4244 kbd_fetch_ptr = event + 1;
4245 input_pending = readable_events (0);
4246 if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
4247 x_activate_menubar (XFRAME (event->frame_or_window));
4249 #endif
4250 #if defined (WINDOWSNT)
4251 else if (event->kind == LANGUAGE_CHANGE_EVENT)
4253 /* Make an event (language-change (FRAME CHARSET LCID)). */
4254 obj = Fcons (event->frame_or_window, Qnil);
4255 obj = Fcons (Qlanguage_change, Fcons (obj, Qnil));
4256 kbd_fetch_ptr = event + 1;
4258 #endif
4259 else if (event->kind == SAVE_SESSION_EVENT)
4261 obj = Fcons (Qsave_session, Qnil);
4262 kbd_fetch_ptr = event + 1;
4264 /* Just discard these, by returning nil.
4265 With MULTI_KBOARD, these events are used as placeholders
4266 when we need to randomly delete events from the queue.
4267 (They shouldn't otherwise be found in the buffer,
4268 but on some machines it appears they do show up
4269 even without MULTI_KBOARD.) */
4270 /* On Windows NT/9X, NO_EVENT is used to delete extraneous
4271 mouse events during a popup-menu call. */
4272 else if (event->kind == NO_EVENT)
4273 kbd_fetch_ptr = event + 1;
4274 else if (event->kind == HELP_EVENT)
4276 Lisp_Object object, position, help, frame, window;
4278 frame = event->frame_or_window;
4279 object = event->arg;
4280 position = make_number (event->code);
4281 window = event->x;
4282 help = event->y;
4283 clear_event (event);
4285 kbd_fetch_ptr = event + 1;
4286 if (!WINDOWP (window))
4287 window = Qnil;
4288 obj = Fcons (Qhelp_echo,
4289 list5 (frame, help, window, object, position));
4291 else if (event->kind == FOCUS_IN_EVENT)
4293 /* Notification of a FocusIn event. The frame receiving the
4294 focus is in event->frame_or_window. Generate a
4295 switch-frame event if necessary. */
4296 Lisp_Object frame, focus;
4298 frame = event->frame_or_window;
4299 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4300 if (FRAMEP (focus))
4301 frame = focus;
4303 if (!EQ (frame, internal_last_event_frame)
4304 && !EQ (frame, selected_frame))
4305 obj = make_lispy_switch_frame (frame);
4306 internal_last_event_frame = frame;
4307 kbd_fetch_ptr = event + 1;
4309 #ifdef HAVE_DBUS
4310 else if (event->kind == DBUS_EVENT)
4312 obj = make_lispy_event (event);
4313 kbd_fetch_ptr = event + 1;
4315 #endif
4316 else if (event->kind == CONFIG_CHANGED_EVENT)
4318 obj = make_lispy_event (event);
4319 kbd_fetch_ptr = event + 1;
4321 else
4323 /* If this event is on a different frame, return a switch-frame this
4324 time, and leave the event in the queue for next time. */
4325 Lisp_Object frame;
4326 Lisp_Object focus;
4328 frame = event->frame_or_window;
4329 if (CONSP (frame))
4330 frame = XCAR (frame);
4331 else if (WINDOWP (frame))
4332 frame = WINDOW_FRAME (XWINDOW (frame));
4334 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
4335 if (! NILP (focus))
4336 frame = focus;
4338 if (! EQ (frame, internal_last_event_frame)
4339 && !EQ (frame, selected_frame))
4340 obj = make_lispy_switch_frame (frame);
4341 internal_last_event_frame = frame;
4343 /* If we didn't decide to make a switch-frame event, go ahead
4344 and build a real event from the queue entry. */
4346 if (NILP (obj))
4348 obj = make_lispy_event (event);
4350 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
4351 || defined(HAVE_NS) || defined (USE_GTK)
4352 /* If this was a menu selection, then set the flag to inhibit
4353 writing to last_nonmenu_event. Don't do this if the event
4354 we're returning is (menu-bar), though; that indicates the
4355 beginning of the menu sequence, and we might as well leave
4356 that as the `event with parameters' for this selection. */
4357 if (used_mouse_menu
4358 && !EQ (event->frame_or_window, event->arg)
4359 && (event->kind == MENU_BAR_EVENT
4360 || event->kind == TOOL_BAR_EVENT))
4361 *used_mouse_menu = 1;
4362 #endif
4363 #ifdef HAVE_NS
4364 /* certain system events are non-key events */
4365 if (used_mouse_menu
4366 && event->kind == NS_NONKEY_EVENT)
4367 *used_mouse_menu = 1;
4368 #endif
4370 /* Wipe out this event, to catch bugs. */
4371 clear_event (event);
4372 kbd_fetch_ptr = event + 1;
4376 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
4377 /* Try generating a mouse motion event. */
4378 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
4380 FRAME_PTR f = some_mouse_moved ();
4381 Lisp_Object bar_window;
4382 enum scroll_bar_part part;
4383 Lisp_Object x, y;
4384 unsigned long time;
4386 *kbp = current_kboard;
4387 /* Note that this uses F to determine which terminal to look at.
4388 If there is no valid info, it does not store anything
4389 so x remains nil. */
4390 x = Qnil;
4392 /* XXX Can f or mouse_position_hook be NULL here? */
4393 if (f && FRAME_TERMINAL (f)->mouse_position_hook)
4394 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, 0, &bar_window,
4395 &part, &x, &y, &time);
4397 obj = Qnil;
4399 /* Decide if we should generate a switch-frame event. Don't
4400 generate switch-frame events for motion outside of all Emacs
4401 frames. */
4402 if (!NILP (x) && f)
4404 Lisp_Object frame;
4406 frame = FRAME_FOCUS_FRAME (f);
4407 if (NILP (frame))
4408 XSETFRAME (frame, f);
4410 if (! EQ (frame, internal_last_event_frame)
4411 && !EQ (frame, selected_frame))
4412 obj = make_lispy_switch_frame (frame);
4413 internal_last_event_frame = frame;
4416 /* If we didn't decide to make a switch-frame event, go ahead and
4417 return a mouse-motion event. */
4418 if (!NILP (x) && NILP (obj))
4419 obj = make_lispy_movement (f, bar_window, part, x, y, time);
4421 #endif /* HAVE_MOUSE || HAVE GPM */
4422 else
4423 /* We were promised by the above while loop that there was
4424 something for us to read! */
4425 abort ();
4427 input_pending = readable_events (0);
4429 Vlast_event_frame = internal_last_event_frame;
4431 return (obj);
4434 /* Process any events that are not user-visible,
4435 then return, without reading any user-visible events. */
4437 void
4438 swallow_events (do_display)
4439 int do_display;
4441 int old_timers_run;
4443 while (kbd_fetch_ptr != kbd_store_ptr)
4445 struct input_event *event;
4447 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
4448 ? kbd_fetch_ptr
4449 : kbd_buffer);
4451 last_event_timestamp = event->timestamp;
4453 /* These two kinds of events get special handling
4454 and don't actually appear to the command loop. */
4455 if (event->kind == SELECTION_REQUEST_EVENT
4456 || event->kind == SELECTION_CLEAR_EVENT)
4458 #ifdef HAVE_X11
4459 struct input_event copy;
4461 /* Remove it from the buffer before processing it,
4462 since otherwise swallow_events called recursively could see it
4463 and process it again. */
4464 copy = *event;
4465 kbd_fetch_ptr = event + 1;
4466 input_pending = readable_events (0);
4467 x_handle_selection_event (&copy);
4468 #else
4469 /* We're getting selection request events, but we don't have
4470 a window system. */
4471 abort ();
4472 #endif
4474 else
4475 break;
4478 old_timers_run = timers_run;
4479 get_input_pending (&input_pending, READABLE_EVENTS_DO_TIMERS_NOW);
4481 if (timers_run != old_timers_run && do_display)
4482 redisplay_preserve_echo_area (7);
4485 /* Record the start of when Emacs is idle,
4486 for the sake of running idle-time timers. */
4488 static void
4489 timer_start_idle ()
4491 Lisp_Object timers;
4493 /* If we are already in the idle state, do nothing. */
4494 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4495 return;
4497 EMACS_GET_TIME (timer_idleness_start_time);
4499 timer_last_idleness_start_time = timer_idleness_start_time;
4501 /* Mark all idle-time timers as once again candidates for running. */
4502 for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers))
4504 Lisp_Object timer;
4506 timer = XCAR (timers);
4508 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4509 continue;
4510 XVECTOR (timer)->contents[0] = Qnil;
4514 /* Record that Emacs is no longer idle, so stop running idle-time timers. */
4516 static void
4517 timer_stop_idle ()
4519 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
4522 /* Resume idle timer from last idle start time. */
4524 static void
4525 timer_resume_idle ()
4527 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4528 return;
4530 timer_idleness_start_time = timer_last_idleness_start_time;
4533 /* This is only for debugging. */
4534 struct input_event last_timer_event;
4536 /* List of elisp functions to call, delayed because they were generated in
4537 a context where Elisp could not be safely run (e.g. redisplay, signal,
4538 ...). Each element has the form (FUN . ARGS). */
4539 Lisp_Object pending_funcalls;
4541 extern Lisp_Object Qapply;
4543 /* Check whether a timer has fired. To prevent larger problems we simply
4544 disregard elements that are not proper timers. Do not make a circular
4545 timer list for the time being.
4547 Returns the time to wait until the next timer fires. If a
4548 timer is triggering now, return zero.
4549 If no timer is active, return -1.
4551 If a timer is ripe, we run it, with quitting turned off.
4552 In that case we return 0 to indicate that a new timer_check_2 call
4553 should be done. */
4555 static EMACS_TIME
4556 timer_check_2 ()
4558 EMACS_TIME nexttime;
4559 EMACS_TIME now, idleness_now;
4560 Lisp_Object timers, idle_timers, chosen_timer;
4561 struct gcpro gcpro1, gcpro2, gcpro3;
4563 EMACS_SET_SECS (nexttime, -1);
4564 EMACS_SET_USECS (nexttime, -1);
4566 /* Always consider the ordinary timers. */
4567 timers = Vtimer_list;
4568 /* Consider the idle timers only if Emacs is idle. */
4569 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4570 idle_timers = Vtimer_idle_list;
4571 else
4572 idle_timers = Qnil;
4573 chosen_timer = Qnil;
4574 GCPRO3 (timers, idle_timers, chosen_timer);
4576 /* First run the code that was delayed. */
4577 while (CONSP (pending_funcalls))
4579 Lisp_Object funcall = XCAR (pending_funcalls);
4580 pending_funcalls = XCDR (pending_funcalls);
4581 safe_call2 (Qapply, XCAR (funcall), XCDR (funcall));
4584 if (CONSP (timers) || CONSP (idle_timers))
4586 EMACS_GET_TIME (now);
4587 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4588 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
4591 while (CONSP (timers) || CONSP (idle_timers))
4593 Lisp_Object *vector;
4594 Lisp_Object timer = Qnil, idle_timer = Qnil;
4595 EMACS_TIME timer_time, idle_timer_time;
4596 EMACS_TIME difference, timer_difference, idle_timer_difference;
4598 /* Skip past invalid timers and timers already handled. */
4599 if (!NILP (timers))
4601 timer = XCAR (timers);
4602 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4604 timers = XCDR (timers);
4605 continue;
4607 vector = XVECTOR (timer)->contents;
4609 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
4610 || !INTEGERP (vector[3])
4611 || ! NILP (vector[0]))
4613 timers = XCDR (timers);
4614 continue;
4617 if (!NILP (idle_timers))
4619 timer = XCAR (idle_timers);
4620 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4622 idle_timers = XCDR (idle_timers);
4623 continue;
4625 vector = XVECTOR (timer)->contents;
4627 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
4628 || !INTEGERP (vector[3])
4629 || ! NILP (vector[0]))
4631 idle_timers = XCDR (idle_timers);
4632 continue;
4636 /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
4637 based on the next ordinary timer.
4638 TIMER_DIFFERENCE is the distance in time from NOW to when
4639 this timer becomes ripe (negative if it's already ripe). */
4640 if (!NILP (timers))
4642 timer = XCAR (timers);
4643 vector = XVECTOR (timer)->contents;
4644 EMACS_SET_SECS (timer_time,
4645 (XINT (vector[1]) << 16) | (XINT (vector[2])));
4646 EMACS_SET_USECS (timer_time, XINT (vector[3]));
4647 EMACS_SUB_TIME (timer_difference, timer_time, now);
4650 /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
4651 based on the next idle timer. */
4652 if (!NILP (idle_timers))
4654 idle_timer = XCAR (idle_timers);
4655 vector = XVECTOR (idle_timer)->contents;
4656 EMACS_SET_SECS (idle_timer_time,
4657 (XINT (vector[1]) << 16) | (XINT (vector[2])));
4658 EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
4659 EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
4662 /* Decide which timer is the next timer,
4663 and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
4664 Also step down the list where we found that timer. */
4666 if (! NILP (timers) && ! NILP (idle_timers))
4668 EMACS_TIME temp;
4669 EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
4670 if (EMACS_TIME_NEG_P (temp))
4672 chosen_timer = timer;
4673 timers = XCDR (timers);
4674 difference = timer_difference;
4676 else
4678 chosen_timer = idle_timer;
4679 idle_timers = XCDR (idle_timers);
4680 difference = idle_timer_difference;
4683 else if (! NILP (timers))
4685 chosen_timer = timer;
4686 timers = XCDR (timers);
4687 difference = timer_difference;
4689 else
4691 chosen_timer = idle_timer;
4692 idle_timers = XCDR (idle_timers);
4693 difference = idle_timer_difference;
4695 vector = XVECTOR (chosen_timer)->contents;
4697 /* If timer is ripe, run it if it hasn't been run. */
4698 if (EMACS_TIME_NEG_P (difference)
4699 || (EMACS_SECS (difference) == 0
4700 && EMACS_USECS (difference) == 0))
4702 if (NILP (vector[0]))
4704 int count = SPECPDL_INDEX ();
4705 Lisp_Object old_deactivate_mark = Vdeactivate_mark;
4707 /* Mark the timer as triggered to prevent problems if the lisp
4708 code fails to reschedule it right. */
4709 vector[0] = Qt;
4711 specbind (Qinhibit_quit, Qt);
4713 call1 (Qtimer_event_handler, chosen_timer);
4714 Vdeactivate_mark = old_deactivate_mark;
4715 timers_run++;
4716 unbind_to (count, Qnil);
4718 /* Since we have handled the event,
4719 we don't need to tell the caller to wake up and do it. */
4720 /* But the caller must still wait for the next timer, so
4721 return 0 to indicate that. */
4724 EMACS_SET_SECS (nexttime, 0);
4725 EMACS_SET_USECS (nexttime, 0);
4727 else
4728 /* When we encounter a timer that is still waiting,
4729 return the amount of time to wait before it is ripe. */
4731 UNGCPRO;
4732 return difference;
4736 /* No timers are pending in the future. */
4737 /* Return 0 if we generated an event, and -1 if not. */
4738 UNGCPRO;
4739 return nexttime;
4743 /* Check whether a timer has fired. To prevent larger problems we simply
4744 disregard elements that are not proper timers. Do not make a circular
4745 timer list for the time being.
4747 Returns the time to wait until the next timer fires.
4748 If no timer is active, return -1.
4750 As long as any timer is ripe, we run it.
4752 DO_IT_NOW is now ignored. It used to mean that we should
4753 run the timer directly instead of queueing a timer-event.
4754 Now we always run timers directly. */
4756 EMACS_TIME
4757 timer_check (do_it_now)
4758 int do_it_now;
4760 EMACS_TIME nexttime;
4764 nexttime = timer_check_2 ();
4766 while (EMACS_SECS (nexttime) == 0 && EMACS_USECS (nexttime) == 0);
4768 return nexttime;
4771 DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0,
4772 doc: /* Return the current length of Emacs idleness, or nil.
4773 The value when Emacs is idle is a list of three integers. The first has
4774 the most significant 16 bits of the seconds, while the second has the least
4775 significant 16 bits. The third integer gives the microsecond count.
4777 The value when Emacs is not idle is nil.
4779 The microsecond count is zero on systems that do not provide
4780 resolution finer than a second. */)
4783 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4785 EMACS_TIME now, idleness_now;
4787 EMACS_GET_TIME (now);
4788 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
4790 return list3 (make_number ((EMACS_SECS (idleness_now) >> 16) & 0xffff),
4791 make_number ((EMACS_SECS (idleness_now) >> 0) & 0xffff),
4792 make_number (EMACS_USECS (idleness_now)));
4795 return Qnil;
4798 /* Caches for modify_event_symbol. */
4799 static Lisp_Object accent_key_syms;
4800 static Lisp_Object func_key_syms;
4801 static Lisp_Object mouse_syms;
4802 static Lisp_Object wheel_syms;
4803 static Lisp_Object drag_n_drop_syms;
4805 /* This is a list of keysym codes for special "accent" characters.
4806 It parallels lispy_accent_keys. */
4808 static const int lispy_accent_codes[] =
4810 #ifdef XK_dead_circumflex
4811 XK_dead_circumflex,
4812 #else
4814 #endif
4815 #ifdef XK_dead_grave
4816 XK_dead_grave,
4817 #else
4819 #endif
4820 #ifdef XK_dead_tilde
4821 XK_dead_tilde,
4822 #else
4824 #endif
4825 #ifdef XK_dead_diaeresis
4826 XK_dead_diaeresis,
4827 #else
4829 #endif
4830 #ifdef XK_dead_macron
4831 XK_dead_macron,
4832 #else
4834 #endif
4835 #ifdef XK_dead_degree
4836 XK_dead_degree,
4837 #else
4839 #endif
4840 #ifdef XK_dead_acute
4841 XK_dead_acute,
4842 #else
4844 #endif
4845 #ifdef XK_dead_cedilla
4846 XK_dead_cedilla,
4847 #else
4849 #endif
4850 #ifdef XK_dead_breve
4851 XK_dead_breve,
4852 #else
4854 #endif
4855 #ifdef XK_dead_ogonek
4856 XK_dead_ogonek,
4857 #else
4859 #endif
4860 #ifdef XK_dead_caron
4861 XK_dead_caron,
4862 #else
4864 #endif
4865 #ifdef XK_dead_doubleacute
4866 XK_dead_doubleacute,
4867 #else
4869 #endif
4870 #ifdef XK_dead_abovedot
4871 XK_dead_abovedot,
4872 #else
4874 #endif
4875 #ifdef XK_dead_abovering
4876 XK_dead_abovering,
4877 #else
4879 #endif
4880 #ifdef XK_dead_iota
4881 XK_dead_iota,
4882 #else
4884 #endif
4885 #ifdef XK_dead_belowdot
4886 XK_dead_belowdot,
4887 #else
4889 #endif
4890 #ifdef XK_dead_voiced_sound
4891 XK_dead_voiced_sound,
4892 #else
4894 #endif
4895 #ifdef XK_dead_semivoiced_sound
4896 XK_dead_semivoiced_sound,
4897 #else
4899 #endif
4900 #ifdef XK_dead_hook
4901 XK_dead_hook,
4902 #else
4904 #endif
4905 #ifdef XK_dead_horn
4906 XK_dead_horn,
4907 #else
4909 #endif
4912 /* This is a list of Lisp names for special "accent" characters.
4913 It parallels lispy_accent_codes. */
4915 static char *lispy_accent_keys[] =
4917 "dead-circumflex",
4918 "dead-grave",
4919 "dead-tilde",
4920 "dead-diaeresis",
4921 "dead-macron",
4922 "dead-degree",
4923 "dead-acute",
4924 "dead-cedilla",
4925 "dead-breve",
4926 "dead-ogonek",
4927 "dead-caron",
4928 "dead-doubleacute",
4929 "dead-abovedot",
4930 "dead-abovering",
4931 "dead-iota",
4932 "dead-belowdot",
4933 "dead-voiced-sound",
4934 "dead-semivoiced-sound",
4935 "dead-hook",
4936 "dead-horn",
4939 #ifdef HAVE_NTGUI
4940 #define FUNCTION_KEY_OFFSET 0x0
4942 char *lispy_function_keys[] =
4944 0, /* 0 */
4946 0, /* VK_LBUTTON 0x01 */
4947 0, /* VK_RBUTTON 0x02 */
4948 "cancel", /* VK_CANCEL 0x03 */
4949 0, /* VK_MBUTTON 0x04 */
4951 0, 0, 0, /* 0x05 .. 0x07 */
4953 "backspace", /* VK_BACK 0x08 */
4954 "tab", /* VK_TAB 0x09 */
4956 0, 0, /* 0x0A .. 0x0B */
4958 "clear", /* VK_CLEAR 0x0C */
4959 "return", /* VK_RETURN 0x0D */
4961 0, 0, /* 0x0E .. 0x0F */
4963 0, /* VK_SHIFT 0x10 */
4964 0, /* VK_CONTROL 0x11 */
4965 0, /* VK_MENU 0x12 */
4966 "pause", /* VK_PAUSE 0x13 */
4967 "capslock", /* VK_CAPITAL 0x14 */
4968 "kana", /* VK_KANA/VK_HANGUL 0x15 */
4969 0, /* 0x16 */
4970 "junja", /* VK_JUNJA 0x17 */
4971 "final", /* VK_FINAL 0x18 */
4972 "kanji", /* VK_KANJI/VK_HANJA 0x19 */
4973 0, /* 0x1A */
4974 "escape", /* VK_ESCAPE 0x1B */
4975 "convert", /* VK_CONVERT 0x1C */
4976 "non-convert", /* VK_NONCONVERT 0x1D */
4977 "accept", /* VK_ACCEPT 0x1E */
4978 "mode-change", /* VK_MODECHANGE 0x1F */
4979 0, /* VK_SPACE 0x20 */
4980 "prior", /* VK_PRIOR 0x21 */
4981 "next", /* VK_NEXT 0x22 */
4982 "end", /* VK_END 0x23 */
4983 "home", /* VK_HOME 0x24 */
4984 "left", /* VK_LEFT 0x25 */
4985 "up", /* VK_UP 0x26 */
4986 "right", /* VK_RIGHT 0x27 */
4987 "down", /* VK_DOWN 0x28 */
4988 "select", /* VK_SELECT 0x29 */
4989 "print", /* VK_PRINT 0x2A */
4990 "execute", /* VK_EXECUTE 0x2B */
4991 "snapshot", /* VK_SNAPSHOT 0x2C */
4992 "insert", /* VK_INSERT 0x2D */
4993 "delete", /* VK_DELETE 0x2E */
4994 "help", /* VK_HELP 0x2F */
4996 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
4998 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5000 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
5002 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
5004 0, 0, 0, 0, 0, 0, 0, 0, 0,
5005 0, 0, 0, 0, 0, 0, 0, 0, 0,
5006 0, 0, 0, 0, 0, 0, 0, 0,
5008 "lwindow", /* VK_LWIN 0x5B */
5009 "rwindow", /* VK_RWIN 0x5C */
5010 "apps", /* VK_APPS 0x5D */
5011 0, /* 0x5E */
5012 "sleep",
5013 "kp-0", /* VK_NUMPAD0 0x60 */
5014 "kp-1", /* VK_NUMPAD1 0x61 */
5015 "kp-2", /* VK_NUMPAD2 0x62 */
5016 "kp-3", /* VK_NUMPAD3 0x63 */
5017 "kp-4", /* VK_NUMPAD4 0x64 */
5018 "kp-5", /* VK_NUMPAD5 0x65 */
5019 "kp-6", /* VK_NUMPAD6 0x66 */
5020 "kp-7", /* VK_NUMPAD7 0x67 */
5021 "kp-8", /* VK_NUMPAD8 0x68 */
5022 "kp-9", /* VK_NUMPAD9 0x69 */
5023 "kp-multiply", /* VK_MULTIPLY 0x6A */
5024 "kp-add", /* VK_ADD 0x6B */
5025 "kp-separator", /* VK_SEPARATOR 0x6C */
5026 "kp-subtract", /* VK_SUBTRACT 0x6D */
5027 "kp-decimal", /* VK_DECIMAL 0x6E */
5028 "kp-divide", /* VK_DIVIDE 0x6F */
5029 "f1", /* VK_F1 0x70 */
5030 "f2", /* VK_F2 0x71 */
5031 "f3", /* VK_F3 0x72 */
5032 "f4", /* VK_F4 0x73 */
5033 "f5", /* VK_F5 0x74 */
5034 "f6", /* VK_F6 0x75 */
5035 "f7", /* VK_F7 0x76 */
5036 "f8", /* VK_F8 0x77 */
5037 "f9", /* VK_F9 0x78 */
5038 "f10", /* VK_F10 0x79 */
5039 "f11", /* VK_F11 0x7A */
5040 "f12", /* VK_F12 0x7B */
5041 "f13", /* VK_F13 0x7C */
5042 "f14", /* VK_F14 0x7D */
5043 "f15", /* VK_F15 0x7E */
5044 "f16", /* VK_F16 0x7F */
5045 "f17", /* VK_F17 0x80 */
5046 "f18", /* VK_F18 0x81 */
5047 "f19", /* VK_F19 0x82 */
5048 "f20", /* VK_F20 0x83 */
5049 "f21", /* VK_F21 0x84 */
5050 "f22", /* VK_F22 0x85 */
5051 "f23", /* VK_F23 0x86 */
5052 "f24", /* VK_F24 0x87 */
5054 0, 0, 0, 0, /* 0x88 .. 0x8B */
5055 0, 0, 0, 0, /* 0x8C .. 0x8F */
5057 "kp-numlock", /* VK_NUMLOCK 0x90 */
5058 "scroll", /* VK_SCROLL 0x91 */
5059 /* Not sure where the following block comes from.
5060 Windows headers have NEC and Fujitsu specific keys in
5061 this block, but nothing generic. */
5062 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
5063 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
5064 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
5065 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
5066 "kp-end", /* VK_NUMPAD_END 0x96 */
5067 "kp-home", /* VK_NUMPAD_HOME 0x97 */
5068 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
5069 "kp-up", /* VK_NUMPAD_UP 0x99 */
5070 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
5071 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
5072 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
5073 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
5075 0, 0, /* 0x9E .. 0x9F */
5078 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
5079 * Used only as parameters to GetAsyncKeyState and GetKeyState.
5080 * No other API or message will distinguish left and right keys this way.
5081 * 0xA0 .. 0xA5
5083 0, 0, 0, 0, 0, 0,
5085 /* Multimedia keys. These are handled as WM_APPCOMMAND, which allows us
5086 to enable them selectively, and gives access to a few more functions.
5087 See lispy_multimedia_keys below. */
5088 0, 0, 0, 0, 0, 0, 0, /* 0xA6 .. 0xAC Browser */
5089 0, 0, 0, /* 0xAD .. 0xAF Volume */
5090 0, 0, 0, 0, /* 0xB0 .. 0xB3 Media */
5091 0, 0, 0, 0, /* 0xB4 .. 0xB7 Apps */
5093 /* 0xB8 .. 0xC0 "OEM" keys - all seem to be punctuation. */
5094 0, 0, 0, 0, 0, 0, 0, 0, 0,
5096 /* 0xC1 - 0xDA unallocated, 0xDB-0xDF more OEM keys */
5097 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5098 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5100 0, /* 0xE0 */
5101 "ax", /* VK_OEM_AX 0xE1 */
5102 0, /* VK_OEM_102 0xE2 */
5103 "ico-help", /* VK_ICO_HELP 0xE3 */
5104 "ico-00", /* VK_ICO_00 0xE4 */
5105 0, /* VK_PROCESSKEY 0xE5 */
5106 "ico-clear", /* VK_ICO_CLEAR 0xE6 */
5107 "packet", /* VK_PACKET 0xE7 */
5108 0, /* 0xE8 */
5109 "reset", /* VK_OEM_RESET 0xE9 */
5110 "jump", /* VK_OEM_JUMP 0xEA */
5111 "oem-pa1", /* VK_OEM_PA1 0xEB */
5112 "oem-pa2", /* VK_OEM_PA2 0xEC */
5113 "oem-pa3", /* VK_OEM_PA3 0xED */
5114 "wsctrl", /* VK_OEM_WSCTRL 0xEE */
5115 "cusel", /* VK_OEM_CUSEL 0xEF */
5116 "oem-attn", /* VK_OEM_ATTN 0xF0 */
5117 "finish", /* VK_OEM_FINISH 0xF1 */
5118 "copy", /* VK_OEM_COPY 0xF2 */
5119 "auto", /* VK_OEM_AUTO 0xF3 */
5120 "enlw", /* VK_OEM_ENLW 0xF4 */
5121 "backtab", /* VK_OEM_BACKTAB 0xF5 */
5122 "attn", /* VK_ATTN 0xF6 */
5123 "crsel", /* VK_CRSEL 0xF7 */
5124 "exsel", /* VK_EXSEL 0xF8 */
5125 "ereof", /* VK_EREOF 0xF9 */
5126 "play", /* VK_PLAY 0xFA */
5127 "zoom", /* VK_ZOOM 0xFB */
5128 "noname", /* VK_NONAME 0xFC */
5129 "pa1", /* VK_PA1 0xFD */
5130 "oem_clear", /* VK_OEM_CLEAR 0xFE */
5131 0 /* 0xFF */
5134 /* Some of these duplicate the "Media keys" on newer keyboards,
5135 but they are delivered to the application in a different way. */
5136 static char *lispy_multimedia_keys[] =
5139 "browser-back",
5140 "browser-forward",
5141 "browser-refresh",
5142 "browser-stop",
5143 "browser-search",
5144 "browser-favorites",
5145 "browser-home",
5146 "volume-mute",
5147 "volume-down",
5148 "volume-up",
5149 "media-next",
5150 "media-previous",
5151 "media-stop",
5152 "media-play-pause",
5153 "mail",
5154 "media-select",
5155 "app-1",
5156 "app-2",
5157 "bass-down",
5158 "bass-boost",
5159 "bass-up",
5160 "treble-down",
5161 "treble-up",
5162 "mic-volume-mute",
5163 "mic-volume-down",
5164 "mic-volume-up",
5165 "help",
5166 "find",
5167 "new",
5168 "open",
5169 "close",
5170 "save",
5171 "print",
5172 "undo",
5173 "redo",
5174 "copy",
5175 "cut",
5176 "paste",
5177 "mail-reply",
5178 "mail-forward",
5179 "mail-send",
5180 "spell-check",
5181 "toggle-dictate-command",
5182 "mic-toggle",
5183 "correction-list",
5184 "media-play",
5185 "media-pause",
5186 "media-record",
5187 "media-fast-forward",
5188 "media-rewind",
5189 "media-channel-up",
5190 "media-channel-down"
5193 #else /* not HAVE_NTGUI */
5195 /* This should be dealt with in XTread_socket now, and that doesn't
5196 depend on the client system having the Kana syms defined. See also
5197 the XK_kana_A case below. */
5198 #if 0
5199 #ifdef XK_kana_A
5200 static char *lispy_kana_keys[] =
5202 /* X Keysym value */
5203 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
5204 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
5205 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
5206 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
5207 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
5208 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
5209 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
5210 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
5211 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
5212 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
5213 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
5214 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
5215 "kana-i", "kana-u", "kana-e", "kana-o",
5216 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
5217 "prolongedsound", "kana-A", "kana-I", "kana-U",
5218 "kana-E", "kana-O", "kana-KA", "kana-KI",
5219 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
5220 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
5221 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
5222 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
5223 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
5224 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
5225 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
5226 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
5227 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
5228 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
5229 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
5230 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
5232 #endif /* XK_kana_A */
5233 #endif /* 0 */
5235 #define FUNCTION_KEY_OFFSET 0xff00
5237 /* You'll notice that this table is arranged to be conveniently
5238 indexed by X Windows keysym values. */
5239 static char *lispy_function_keys[] =
5241 /* X Keysym value */
5243 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
5244 "backspace", "tab", "linefeed", "clear",
5245 0, "return", 0, 0,
5246 0, 0, 0, "pause", /* 0xff10...1f */
5247 0, 0, 0, 0, 0, 0, 0, "escape",
5248 0, 0, 0, 0,
5249 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
5250 "romaji", "hiragana", "katakana", "hiragana-katakana",
5251 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
5252 "massyo", "kana-lock", "kana-shift", "eisu-shift",
5253 "eisu-toggle", /* 0xff30...3f */
5254 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5255 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
5257 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
5258 "down", "prior", "next", "end",
5259 "begin", 0, 0, 0, 0, 0, 0, 0,
5260 "select", /* 0xff60 */ /* IsMiscFunctionKey */
5261 "print",
5262 "execute",
5263 "insert",
5264 0, /* 0xff64 */
5265 "undo",
5266 "redo",
5267 "menu",
5268 "find",
5269 "cancel",
5270 "help",
5271 "break", /* 0xff6b */
5273 0, 0, 0, 0,
5274 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
5275 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
5276 "kp-space", /* 0xff80 */ /* IsKeypadKey */
5277 0, 0, 0, 0, 0, 0, 0, 0,
5278 "kp-tab", /* 0xff89 */
5279 0, 0, 0,
5280 "kp-enter", /* 0xff8d */
5281 0, 0, 0,
5282 "kp-f1", /* 0xff91 */
5283 "kp-f2",
5284 "kp-f3",
5285 "kp-f4",
5286 "kp-home", /* 0xff95 */
5287 "kp-left",
5288 "kp-up",
5289 "kp-right",
5290 "kp-down",
5291 "kp-prior", /* kp-page-up */
5292 "kp-next", /* kp-page-down */
5293 "kp-end",
5294 "kp-begin",
5295 "kp-insert",
5296 "kp-delete",
5297 0, /* 0xffa0 */
5298 0, 0, 0, 0, 0, 0, 0, 0, 0,
5299 "kp-multiply", /* 0xffaa */
5300 "kp-add",
5301 "kp-separator",
5302 "kp-subtract",
5303 "kp-decimal",
5304 "kp-divide", /* 0xffaf */
5305 "kp-0", /* 0xffb0 */
5306 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
5307 0, /* 0xffba */
5308 0, 0,
5309 "kp-equal", /* 0xffbd */
5310 "f1", /* 0xffbe */ /* IsFunctionKey */
5311 "f2",
5312 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
5313 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
5314 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
5315 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
5316 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
5317 0, 0, 0, 0, 0, 0, 0, 0,
5318 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
5319 0, 0, 0, 0, 0, 0, 0, "delete"
5322 /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
5323 #define ISO_FUNCTION_KEY_OFFSET 0xfe00
5325 static char *iso_lispy_function_keys[] =
5327 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
5328 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
5329 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
5330 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
5331 "iso-lefttab", /* 0xfe20 */
5332 "iso-move-line-up", "iso-move-line-down",
5333 "iso-partial-line-up", "iso-partial-line-down",
5334 "iso-partial-space-left", "iso-partial-space-right",
5335 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
5336 "iso-release-margin-left", "iso-release-margin-right",
5337 "iso-release-both-margins",
5338 "iso-fast-cursor-left", "iso-fast-cursor-right",
5339 "iso-fast-cursor-up", "iso-fast-cursor-down",
5340 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
5341 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
5344 #endif /* not HAVE_NTGUI */
5346 Lisp_Object Vlispy_mouse_stem;
5348 static char *lispy_wheel_names[] =
5350 "wheel-up", "wheel-down", "wheel-left", "wheel-right"
5353 /* drag-n-drop events are generated when a set of selected files are
5354 dragged from another application and dropped onto an Emacs window. */
5355 static char *lispy_drag_n_drop_names[] =
5357 "drag-n-drop"
5360 /* Scroll bar parts. */
5361 Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
5362 Lisp_Object Qup, Qdown, Qbottom, Qend_scroll;
5363 Lisp_Object Qtop, Qratio;
5365 /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
5366 Lisp_Object *scroll_bar_parts[] = {
5367 &Qabove_handle, &Qhandle, &Qbelow_handle,
5368 &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio
5371 /* A vector, indexed by button number, giving the down-going location
5372 of currently depressed buttons, both scroll bar and non-scroll bar.
5374 The elements have the form
5375 (BUTTON-NUMBER MODIFIER-MASK . REST)
5376 where REST is the cdr of a position as it would be reported in the event.
5378 The make_lispy_event function stores positions here to tell the
5379 difference between click and drag events, and to store the starting
5380 location to be included in drag events. */
5382 static Lisp_Object button_down_location;
5384 /* Information about the most recent up-going button event: Which
5385 button, what location, and what time. */
5387 static int last_mouse_button;
5388 static int last_mouse_x;
5389 static int last_mouse_y;
5390 static unsigned long button_down_time;
5392 /* The maximum time between clicks to make a double-click, or Qnil to
5393 disable double-click detection, or Qt for no time limit. */
5395 Lisp_Object impl_Vdouble_click_time;
5397 /* Maximum number of pixels the mouse may be moved between clicks
5398 to make a double-click. */
5400 EMACS_INT double_click_fuzz;
5402 /* The number of clicks in this multiple-click. */
5404 int double_click_count;
5406 /* Return position of a mouse click or wheel event */
5408 static Lisp_Object
5409 make_lispy_position (f, x, y, time)
5410 struct frame *f;
5411 Lisp_Object *x, *y;
5412 unsigned long time;
5414 Lisp_Object window;
5415 enum window_part part;
5416 Lisp_Object posn = Qnil;
5417 Lisp_Object extra_info = Qnil;
5418 int wx, wy;
5420 /* Set `window' to the window under frame pixel coordinates (x,y) */
5421 if (f)
5422 window = window_from_coordinates (f, XINT (*x), XINT (*y),
5423 &part, &wx, &wy, 0);
5424 else
5425 window = Qnil;
5427 if (WINDOWP (window))
5429 /* It's a click in window window at frame coordinates (x,y) */
5430 struct window *w = XWINDOW (window);
5431 Lisp_Object string_info = Qnil;
5432 int textpos = -1, rx = -1, ry = -1;
5433 int dx = -1, dy = -1;
5434 int width = -1, height = -1;
5435 Lisp_Object object = Qnil;
5437 /* Set event coordinates to window-relative coordinates
5438 for constructing the Lisp event below. */
5439 XSETINT (*x, wx);
5440 XSETINT (*y, wy);
5442 if (part == ON_TEXT)
5444 wx += WINDOW_LEFT_MARGIN_WIDTH (w);
5446 else if (part == ON_MODE_LINE || part == ON_HEADER_LINE)
5448 /* Mode line or header line. Look for a string under
5449 the mouse that may have a `local-map' property. */
5450 Lisp_Object string;
5451 int charpos;
5453 posn = part == ON_MODE_LINE ? Qmode_line : Qheader_line;
5454 rx = wx, ry = wy;
5455 string = mode_line_string (w, part, &rx, &ry, &charpos,
5456 &object, &dx, &dy, &width, &height);
5457 if (STRINGP (string))
5458 string_info = Fcons (string, make_number (charpos));
5459 if (w == XWINDOW (selected_window)
5460 && current_buffer == XBUFFER (w->buffer))
5461 textpos = PT;
5462 else
5463 textpos = XMARKER (w->pointm)->charpos;
5465 else if (part == ON_VERTICAL_BORDER)
5467 posn = Qvertical_line;
5468 wx = -1;
5469 dx = 0;
5470 width = 1;
5472 else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
5474 Lisp_Object string;
5475 int charpos;
5477 posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin;
5478 rx = wx, ry = wy;
5479 string = marginal_area_string (w, part, &rx, &ry, &charpos,
5480 &object, &dx, &dy, &width, &height);
5481 if (STRINGP (string))
5482 string_info = Fcons (string, make_number (charpos));
5483 if (part == ON_LEFT_MARGIN)
5484 wx = 0;
5485 else
5486 wx = window_box_right_offset (w, TEXT_AREA) - 1;
5488 else if (part == ON_LEFT_FRINGE)
5490 posn = Qleft_fringe;
5491 rx = 0;
5492 dx = wx;
5493 wx = (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5495 : window_box_width (w, LEFT_MARGIN_AREA));
5496 dx -= wx;
5498 else if (part == ON_RIGHT_FRINGE)
5500 posn = Qright_fringe;
5501 rx = 0;
5502 dx = wx;
5503 wx = (window_box_width (w, LEFT_MARGIN_AREA)
5504 + window_box_width (w, TEXT_AREA)
5505 + (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5506 ? window_box_width (w, RIGHT_MARGIN_AREA)
5507 : 0));
5508 dx -= wx;
5510 else
5512 /* Note: We have no special posn for part == ON_SCROLL_BAR. */
5513 wx = max (WINDOW_LEFT_MARGIN_WIDTH (w), wx);
5516 if (textpos < 0)
5518 Lisp_Object string2, object2 = Qnil;
5519 struct display_pos p;
5520 int dx2, dy2;
5521 int width2, height2;
5522 string2 = buffer_posn_from_coords (w, &wx, &wy, &p,
5523 &object2, &dx2, &dy2,
5524 &width2, &height2);
5525 textpos = CHARPOS (p.pos);
5526 if (rx < 0) rx = wx;
5527 if (ry < 0) ry = wy;
5528 if (dx < 0) dx = dx2;
5529 if (dy < 0) dy = dy2;
5530 if (width < 0) width = width2;
5531 if (height < 0) height = height2;
5533 if (NILP (posn))
5535 posn = make_number (textpos);
5536 if (STRINGP (string2))
5537 string_info = Fcons (string2,
5538 make_number (CHARPOS (p.string_pos)));
5540 if (NILP (object))
5541 object = object2;
5544 #ifdef HAVE_WINDOW_SYSTEM
5545 if (IMAGEP (object))
5547 Lisp_Object image_map, hotspot;
5548 if ((image_map = Fplist_get (XCDR (object), QCmap),
5549 !NILP (image_map))
5550 && (hotspot = find_hot_spot (image_map, dx, dy),
5551 CONSP (hotspot))
5552 && (hotspot = XCDR (hotspot), CONSP (hotspot)))
5553 posn = XCAR (hotspot);
5555 #endif
5557 /* Object info */
5558 extra_info = Fcons (object,
5559 Fcons (Fcons (make_number (dx),
5560 make_number (dy)),
5561 Fcons (Fcons (make_number (width),
5562 make_number (height)),
5563 Qnil)));
5565 /* String info */
5566 extra_info = Fcons (string_info,
5567 Fcons (make_number (textpos),
5568 Fcons (Fcons (make_number (rx),
5569 make_number (ry)),
5570 extra_info)));
5572 else if (f != 0)
5574 XSETFRAME (window, f);
5576 else
5578 window = Qnil;
5579 XSETFASTINT (*x, 0);
5580 XSETFASTINT (*y, 0);
5583 return Fcons (window,
5584 Fcons (posn,
5585 Fcons (Fcons (*x, *y),
5586 Fcons (make_number (time),
5587 extra_info))));
5590 /* Given a struct input_event, build the lisp event which represents
5591 it. If EVENT is 0, build a mouse movement event from the mouse
5592 movement buffer, which should have a movement event in it.
5594 Note that events must be passed to this function in the order they
5595 are received; this function stores the location of button presses
5596 in order to build drag events when the button is released. */
5598 static Lisp_Object
5599 make_lispy_event (event)
5600 struct input_event *event;
5602 int i;
5604 switch (SWITCH_ENUM_CAST (event->kind))
5606 /* A simple keystroke. */
5607 case ASCII_KEYSTROKE_EVENT:
5608 case MULTIBYTE_CHAR_KEYSTROKE_EVENT:
5610 Lisp_Object lispy_c;
5611 int c = event->code;
5612 if (event->kind == ASCII_KEYSTROKE_EVENT)
5614 c &= 0377;
5615 eassert (c == event->code);
5616 /* Turn ASCII characters into control characters
5617 when proper. */
5618 if (event->modifiers & ctrl_modifier)
5620 c = make_ctrl_char (c);
5621 event->modifiers &= ~ctrl_modifier;
5625 /* Add in the other modifier bits. The shift key was taken care
5626 of by the X code. */
5627 c |= (event->modifiers
5628 & (meta_modifier | alt_modifier
5629 | hyper_modifier | super_modifier | ctrl_modifier));
5630 /* Distinguish Shift-SPC from SPC. */
5631 if ((event->code) == 040
5632 && event->modifiers & shift_modifier)
5633 c |= shift_modifier;
5634 button_down_time = 0;
5635 XSETFASTINT (lispy_c, c);
5636 return lispy_c;
5639 #ifdef HAVE_NS
5640 /* NS_NONKEY_EVENTs are just like NON_ASCII_KEYSTROKE_EVENTs,
5641 except that they are non-key events (last-nonmenu-event is nil). */
5642 case NS_NONKEY_EVENT:
5643 #endif
5645 /* A function key. The symbol may need to have modifier prefixes
5646 tacked onto it. */
5647 case NON_ASCII_KEYSTROKE_EVENT:
5648 button_down_time = 0;
5650 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
5651 if (event->code == lispy_accent_codes[i])
5652 return modify_event_symbol (i,
5653 event->modifiers,
5654 Qfunction_key, Qnil,
5655 lispy_accent_keys, &accent_key_syms,
5656 (sizeof (lispy_accent_keys)
5657 / sizeof (lispy_accent_keys[0])));
5659 #if 0
5660 #ifdef XK_kana_A
5661 if (event->code >= 0x400 && event->code < 0x500)
5662 return modify_event_symbol (event->code - 0x400,
5663 event->modifiers & ~shift_modifier,
5664 Qfunction_key, Qnil,
5665 lispy_kana_keys, &func_key_syms,
5666 (sizeof (lispy_kana_keys)
5667 / sizeof (lispy_kana_keys[0])));
5668 #endif /* XK_kana_A */
5669 #endif /* 0 */
5671 #ifdef ISO_FUNCTION_KEY_OFFSET
5672 if (event->code < FUNCTION_KEY_OFFSET
5673 && event->code >= ISO_FUNCTION_KEY_OFFSET)
5674 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
5675 event->modifiers,
5676 Qfunction_key, Qnil,
5677 iso_lispy_function_keys, &func_key_syms,
5678 (sizeof (iso_lispy_function_keys)
5679 / sizeof (iso_lispy_function_keys[0])));
5680 #endif
5682 /* Handle system-specific or unknown keysyms. */
5683 if (event->code & (1 << 28)
5684 || event->code - FUNCTION_KEY_OFFSET < 0
5685 || (event->code - FUNCTION_KEY_OFFSET
5686 >= sizeof lispy_function_keys / sizeof *lispy_function_keys)
5687 || !lispy_function_keys[event->code - FUNCTION_KEY_OFFSET])
5689 /* We need to use an alist rather than a vector as the cache
5690 since we can't make a vector long enuf. */
5691 if (NILP (current_kboard->system_key_syms))
5692 current_kboard->system_key_syms = Fcons (Qnil, Qnil);
5693 return modify_event_symbol (event->code,
5694 event->modifiers,
5695 Qfunction_key,
5696 current_kboard->Vsystem_key_alist,
5697 0, &current_kboard->system_key_syms,
5698 (unsigned) -1);
5701 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
5702 event->modifiers,
5703 Qfunction_key, Qnil,
5704 lispy_function_keys, &func_key_syms,
5705 (sizeof (lispy_function_keys)
5706 / sizeof (lispy_function_keys[0])));
5708 #ifdef WINDOWSNT
5709 case MULTIMEDIA_KEY_EVENT:
5710 if (event->code < (sizeof (lispy_multimedia_keys)
5711 / sizeof (lispy_multimedia_keys[0]))
5712 && event->code > 0 && lispy_multimedia_keys[event->code])
5714 return modify_event_symbol (event->code, event->modifiers,
5715 Qfunction_key, Qnil,
5716 lispy_multimedia_keys, &func_key_syms,
5717 (sizeof (lispy_multimedia_keys)
5718 / sizeof (lispy_multimedia_keys[0])));
5720 return Qnil;
5721 #endif
5723 #ifdef HAVE_MOUSE
5724 /* A mouse click. Figure out where it is, decide whether it's
5725 a press, click or drag, and build the appropriate structure. */
5726 case MOUSE_CLICK_EVENT:
5727 #ifndef USE_TOOLKIT_SCROLL_BARS
5728 case SCROLL_BAR_CLICK_EVENT:
5729 #endif
5731 int button = event->code;
5732 int is_double;
5733 Lisp_Object position;
5734 Lisp_Object *start_pos_ptr;
5735 Lisp_Object start_pos;
5737 position = Qnil;
5739 /* Build the position as appropriate for this mouse click. */
5740 if (event->kind == MOUSE_CLICK_EVENT)
5742 struct frame *f = XFRAME (event->frame_or_window);
5743 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) && ! defined (HAVE_NS)
5744 int row, column;
5745 #endif
5747 /* Ignore mouse events that were made on frame that
5748 have been deleted. */
5749 if (! FRAME_LIVE_P (f))
5750 return Qnil;
5752 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) && ! defined (HAVE_NS)
5753 /* EVENT->x and EVENT->y are frame-relative pixel
5754 coordinates at this place. Under old redisplay, COLUMN
5755 and ROW are set to frame relative glyph coordinates
5756 which are then used to determine whether this click is
5757 in a menu (non-toolkit version). */
5758 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
5759 &column, &row, NULL, 1);
5761 /* In the non-toolkit version, clicks on the menu bar
5762 are ordinary button events in the event buffer.
5763 Distinguish them, and invoke the menu.
5765 (In the toolkit version, the toolkit handles the menu bar
5766 and Emacs doesn't know about it until after the user
5767 makes a selection.) */
5768 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
5769 && (event->modifiers & down_modifier))
5771 Lisp_Object items, item;
5772 int hpos;
5773 int i;
5775 #if 0
5776 /* Activate the menu bar on the down event. If the
5777 up event comes in before the menu code can deal with it,
5778 just ignore it. */
5779 if (! (event->modifiers & down_modifier))
5780 return Qnil;
5781 #endif
5783 /* Find the menu bar item under `column'. */
5784 item = Qnil;
5785 items = FRAME_MENU_BAR_ITEMS (f);
5786 for (i = 0; i < XVECTOR (items)->size; i += 4)
5788 Lisp_Object pos, string;
5789 string = AREF (items, i + 1);
5790 pos = AREF (items, i + 3);
5791 if (NILP (string))
5792 break;
5793 if (column >= XINT (pos)
5794 && column < XINT (pos) + SCHARS (string))
5796 item = AREF (items, i);
5797 break;
5801 /* ELisp manual 2.4b says (x y) are window relative but
5802 code says they are frame-relative. */
5803 position
5804 = Fcons (event->frame_or_window,
5805 Fcons (Qmenu_bar,
5806 Fcons (Fcons (event->x, event->y),
5807 Fcons (make_number (event->timestamp),
5808 Qnil))));
5810 return Fcons (item, Fcons (position, Qnil));
5812 #endif /* not USE_X_TOOLKIT && not USE_GTK && not HAVE_NS */
5814 position = make_lispy_position (f, &event->x, &event->y,
5815 event->timestamp);
5817 #ifndef USE_TOOLKIT_SCROLL_BARS
5818 else
5820 /* It's a scrollbar click. */
5821 Lisp_Object window;
5822 Lisp_Object portion_whole;
5823 Lisp_Object part;
5825 window = event->frame_or_window;
5826 portion_whole = Fcons (event->x, event->y);
5827 part = *scroll_bar_parts[(int) event->part];
5829 position
5830 = Fcons (window,
5831 Fcons (Qvertical_scroll_bar,
5832 Fcons (portion_whole,
5833 Fcons (make_number (event->timestamp),
5834 Fcons (part, Qnil)))));
5836 #endif /* not USE_TOOLKIT_SCROLL_BARS */
5838 if (button >= ASIZE (button_down_location))
5840 button_down_location = larger_vector (button_down_location,
5841 button + 1, Qnil);
5842 mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
5845 start_pos_ptr = &AREF (button_down_location, button);
5846 start_pos = *start_pos_ptr;
5847 *start_pos_ptr = Qnil;
5850 /* On window-system frames, use the value of
5851 double-click-fuzz as is. On other frames, interpret it
5852 as a multiple of 1/8 characters. */
5853 struct frame *f;
5854 int fuzz;
5856 if (WINDOWP (event->frame_or_window))
5857 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
5858 else if (FRAMEP (event->frame_or_window))
5859 f = XFRAME (event->frame_or_window);
5860 else
5861 abort ();
5863 if (FRAME_WINDOW_P (f))
5864 fuzz = double_click_fuzz;
5865 else
5866 fuzz = double_click_fuzz / 8;
5868 is_double = (button == last_mouse_button
5869 && (eabs (XINT (event->x) - last_mouse_x) <= fuzz)
5870 && (eabs (XINT (event->y) - last_mouse_y) <= fuzz)
5871 && button_down_time != 0
5872 && (EQ (Vdouble_click_time, Qt)
5873 || (INTEGERP (Vdouble_click_time)
5874 && ((int)(event->timestamp - button_down_time)
5875 < XINT (Vdouble_click_time)))));
5878 last_mouse_button = button;
5879 last_mouse_x = XINT (event->x);
5880 last_mouse_y = XINT (event->y);
5882 /* If this is a button press, squirrel away the location, so
5883 we can decide later whether it was a click or a drag. */
5884 if (event->modifiers & down_modifier)
5886 if (is_double)
5888 double_click_count++;
5889 event->modifiers |= ((double_click_count > 2)
5890 ? triple_modifier
5891 : double_modifier);
5893 else
5894 double_click_count = 1;
5895 button_down_time = event->timestamp;
5896 *start_pos_ptr = Fcopy_alist (position);
5897 ignore_mouse_drag_p = 0;
5900 /* Now we're releasing a button - check the co-ordinates to
5901 see if this was a click or a drag. */
5902 else if (event->modifiers & up_modifier)
5904 /* If we did not see a down before this up, ignore the up.
5905 Probably this happened because the down event chose a
5906 menu item. It would be an annoyance to treat the
5907 release of the button that chose the menu item as a
5908 separate event. */
5910 if (!CONSP (start_pos))
5911 return Qnil;
5913 event->modifiers &= ~up_modifier;
5914 #if 0 /* Formerly we treated an up with no down as a click event. */
5915 if (!CONSP (start_pos))
5916 event->modifiers |= click_modifier;
5917 else
5918 #endif
5920 Lisp_Object down;
5921 EMACS_INT xdiff = double_click_fuzz, ydiff = double_click_fuzz;
5923 /* The third element of every position
5924 should be the (x,y) pair. */
5925 down = Fcar (Fcdr (Fcdr (start_pos)));
5926 if (CONSP (down)
5927 && INTEGERP (XCAR (down)) && INTEGERP (XCDR (down)))
5929 xdiff = XINT (event->x) - XINT (XCAR (down));
5930 ydiff = XINT (event->y) - XINT (XCDR (down));
5933 if (ignore_mouse_drag_p)
5935 event->modifiers |= click_modifier;
5936 ignore_mouse_drag_p = 0;
5938 else if (xdiff < double_click_fuzz && xdiff > - double_click_fuzz
5939 && ydiff < double_click_fuzz && ydiff > - double_click_fuzz
5940 /* Maybe the mouse has moved a lot, caused scrolling, and
5941 eventually ended up at the same screen position (but
5942 not buffer position) in which case it is a drag, not
5943 a click. */
5944 /* FIXME: OTOH if the buffer position has changed
5945 because of a timer or process filter rather than
5946 because of mouse movement, it should be considered as
5947 a click. But mouse-drag-region completely ignores
5948 this case and it hasn't caused any real problem, so
5949 it's probably OK to ignore it as well. */
5950 && EQ (Fcar (Fcdr (start_pos)), Fcar (Fcdr (position))))
5951 /* Mouse hasn't moved (much). */
5952 event->modifiers |= click_modifier;
5953 else
5955 button_down_time = 0;
5956 event->modifiers |= drag_modifier;
5959 /* Don't check is_double; treat this as multiple
5960 if the down-event was multiple. */
5961 if (double_click_count > 1)
5962 event->modifiers |= ((double_click_count > 2)
5963 ? triple_modifier
5964 : double_modifier);
5967 else
5968 /* Every mouse event should either have the down_modifier or
5969 the up_modifier set. */
5970 abort ();
5973 /* Get the symbol we should use for the mouse click. */
5974 Lisp_Object head;
5976 head = modify_event_symbol (button,
5977 event->modifiers,
5978 Qmouse_click, Vlispy_mouse_stem,
5979 NULL,
5980 &mouse_syms,
5981 XVECTOR (mouse_syms)->size);
5982 if (event->modifiers & drag_modifier)
5983 return Fcons (head,
5984 Fcons (start_pos,
5985 Fcons (position,
5986 Qnil)));
5987 else if (event->modifiers & (double_modifier | triple_modifier))
5988 return Fcons (head,
5989 Fcons (position,
5990 Fcons (make_number (double_click_count),
5991 Qnil)));
5992 else
5993 return Fcons (head,
5994 Fcons (position,
5995 Qnil));
5999 case WHEEL_EVENT:
6000 case HORIZ_WHEEL_EVENT:
6002 Lisp_Object position;
6003 Lisp_Object head;
6005 /* Build the position as appropriate for this mouse click. */
6006 struct frame *f = XFRAME (event->frame_or_window);
6008 /* Ignore wheel events that were made on frame that have been
6009 deleted. */
6010 if (! FRAME_LIVE_P (f))
6011 return Qnil;
6013 position = make_lispy_position (f, &event->x, &event->y,
6014 event->timestamp);
6016 /* Set double or triple modifiers to indicate the wheel speed. */
6018 /* On window-system frames, use the value of
6019 double-click-fuzz as is. On other frames, interpret it
6020 as a multiple of 1/8 characters. */
6021 struct frame *f;
6022 int fuzz;
6023 int symbol_num;
6024 int is_double;
6026 if (WINDOWP (event->frame_or_window))
6027 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
6028 else if (FRAMEP (event->frame_or_window))
6029 f = XFRAME (event->frame_or_window);
6030 else
6031 abort ();
6033 if (FRAME_WINDOW_P (f))
6034 fuzz = double_click_fuzz;
6035 else
6036 fuzz = double_click_fuzz / 8;
6038 if (event->modifiers & up_modifier)
6040 /* Emit a wheel-up event. */
6041 event->modifiers &= ~up_modifier;
6042 symbol_num = 0;
6044 else if (event->modifiers & down_modifier)
6046 /* Emit a wheel-down event. */
6047 event->modifiers &= ~down_modifier;
6048 symbol_num = 1;
6050 else
6051 /* Every wheel event should either have the down_modifier or
6052 the up_modifier set. */
6053 abort ();
6055 if (event->kind == HORIZ_WHEEL_EVENT)
6056 symbol_num += 2;
6058 is_double = (last_mouse_button == - (1 + symbol_num)
6059 && (eabs (XINT (event->x) - last_mouse_x) <= fuzz)
6060 && (eabs (XINT (event->y) - last_mouse_y) <= fuzz)
6061 && button_down_time != 0
6062 && (EQ (Vdouble_click_time, Qt)
6063 || (INTEGERP (Vdouble_click_time)
6064 && ((int)(event->timestamp - button_down_time)
6065 < XINT (Vdouble_click_time)))));
6066 if (is_double)
6068 double_click_count++;
6069 event->modifiers |= ((double_click_count > 2)
6070 ? triple_modifier
6071 : double_modifier);
6073 else
6075 double_click_count = 1;
6076 event->modifiers |= click_modifier;
6079 button_down_time = event->timestamp;
6080 /* Use a negative value to distinguish wheel from mouse button. */
6081 last_mouse_button = - (1 + symbol_num);
6082 last_mouse_x = XINT (event->x);
6083 last_mouse_y = XINT (event->y);
6085 /* Get the symbol we should use for the wheel event. */
6086 head = modify_event_symbol (symbol_num,
6087 event->modifiers,
6088 Qmouse_click,
6089 Qnil,
6090 lispy_wheel_names,
6091 &wheel_syms,
6092 ASIZE (wheel_syms));
6095 if (event->modifiers & (double_modifier | triple_modifier))
6096 return Fcons (head,
6097 Fcons (position,
6098 Fcons (make_number (double_click_count),
6099 Qnil)));
6100 else
6101 return Fcons (head,
6102 Fcons (position,
6103 Qnil));
6107 #ifdef USE_TOOLKIT_SCROLL_BARS
6109 /* We don't have down and up events if using toolkit scroll bars,
6110 so make this always a click event. Store in the `part' of
6111 the Lisp event a symbol which maps to the following actions:
6113 `above_handle' page up
6114 `below_handle' page down
6115 `up' line up
6116 `down' line down
6117 `top' top of buffer
6118 `bottom' bottom of buffer
6119 `handle' thumb has been dragged.
6120 `end-scroll' end of interaction with scroll bar
6122 The incoming input_event contains in its `part' member an
6123 index of type `enum scroll_bar_part' which we can use as an
6124 index in scroll_bar_parts to get the appropriate symbol. */
6126 case SCROLL_BAR_CLICK_EVENT:
6128 Lisp_Object position, head, window, portion_whole, part;
6130 window = event->frame_or_window;
6131 portion_whole = Fcons (event->x, event->y);
6132 part = *scroll_bar_parts[(int) event->part];
6134 position
6135 = Fcons (window,
6136 Fcons (Qvertical_scroll_bar,
6137 Fcons (portion_whole,
6138 Fcons (make_number (event->timestamp),
6139 Fcons (part, Qnil)))));
6141 /* Always treat scroll bar events as clicks. */
6142 event->modifiers |= click_modifier;
6143 event->modifiers &= ~up_modifier;
6145 if (event->code >= ASIZE (mouse_syms))
6146 mouse_syms = larger_vector (mouse_syms, event->code + 1, Qnil);
6148 /* Get the symbol we should use for the mouse click. */
6149 head = modify_event_symbol (event->code,
6150 event->modifiers,
6151 Qmouse_click,
6152 Vlispy_mouse_stem,
6153 NULL, &mouse_syms,
6154 XVECTOR (mouse_syms)->size);
6155 return Fcons (head, Fcons (position, Qnil));
6158 #endif /* USE_TOOLKIT_SCROLL_BARS */
6160 case DRAG_N_DROP_EVENT:
6162 FRAME_PTR f;
6163 Lisp_Object head, position;
6164 Lisp_Object files;
6166 f = XFRAME (event->frame_or_window);
6167 files = event->arg;
6169 /* Ignore mouse events that were made on frames that
6170 have been deleted. */
6171 if (! FRAME_LIVE_P (f))
6172 return Qnil;
6174 position = make_lispy_position (f, &event->x, &event->y,
6175 event->timestamp);
6177 head = modify_event_symbol (0, event->modifiers,
6178 Qdrag_n_drop, Qnil,
6179 lispy_drag_n_drop_names,
6180 &drag_n_drop_syms, 1);
6181 return Fcons (head,
6182 Fcons (position,
6183 Fcons (files,
6184 Qnil)));
6186 #endif /* HAVE_MOUSE */
6188 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
6189 || defined(HAVE_NS) || defined (USE_GTK)
6190 case MENU_BAR_EVENT:
6191 if (EQ (event->arg, event->frame_or_window))
6192 /* This is the prefix key. We translate this to
6193 `(menu_bar)' because the code in keyboard.c for menu
6194 events, which we use, relies on this. */
6195 return Fcons (Qmenu_bar, Qnil);
6196 return event->arg;
6197 #endif
6199 case SELECT_WINDOW_EVENT:
6200 /* Make an event (select-window (WINDOW)). */
6201 return Fcons (Qselect_window,
6202 Fcons (Fcons (event->frame_or_window, Qnil),
6203 Qnil));
6205 case TOOL_BAR_EVENT:
6206 if (EQ (event->arg, event->frame_or_window))
6207 /* This is the prefix key. We translate this to
6208 `(tool_bar)' because the code in keyboard.c for tool bar
6209 events, which we use, relies on this. */
6210 return Fcons (Qtool_bar, Qnil);
6211 else if (SYMBOLP (event->arg))
6212 return apply_modifiers (event->modifiers, event->arg);
6213 return event->arg;
6215 case USER_SIGNAL_EVENT:
6216 /* A user signal. */
6218 char *name = find_user_signal_name (event->code);
6219 if (!name)
6220 abort ();
6221 return intern (name);
6224 case SAVE_SESSION_EVENT:
6225 return Qsave_session;
6227 #ifdef HAVE_DBUS
6228 case DBUS_EVENT:
6230 return Fcons (Qdbus_event, event->arg);
6232 #endif /* HAVE_DBUS */
6234 case CONFIG_CHANGED_EVENT:
6235 return Fcons (Qconfig_changed_event,
6236 Fcons (event->arg,
6237 Fcons (event->frame_or_window, Qnil)));
6238 #ifdef HAVE_GPM
6239 case GPM_CLICK_EVENT:
6241 FRAME_PTR f = XFRAME (event->frame_or_window);
6242 Lisp_Object head, position;
6243 Lisp_Object *start_pos_ptr;
6244 Lisp_Object start_pos;
6245 int button = event->code;
6247 if (button >= ASIZE (button_down_location))
6249 button_down_location = larger_vector (button_down_location,
6250 button + 1, Qnil);
6251 mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
6254 start_pos_ptr = &AREF (button_down_location, button);
6255 start_pos = *start_pos_ptr;
6257 position = make_lispy_position (f, &event->x, &event->y,
6258 event->timestamp);
6260 if (event->modifiers & down_modifier)
6261 *start_pos_ptr = Fcopy_alist (position);
6262 else if (event->modifiers & (up_modifier | drag_modifier))
6264 if (!CONSP (start_pos))
6265 return Qnil;
6266 event->modifiers &= ~up_modifier;
6269 head = modify_event_symbol (button,
6270 event->modifiers,
6271 Qmouse_click, Vlispy_mouse_stem,
6272 NULL,
6273 &mouse_syms,
6274 XVECTOR (mouse_syms)->size);
6276 if (event->modifiers & drag_modifier)
6277 return Fcons (head,
6278 Fcons (start_pos,
6279 Fcons (position,
6280 Qnil)));
6281 else if (event->modifiers & double_modifier)
6282 return Fcons (head,
6283 Fcons (position,
6284 Fcons (make_number (2),
6285 Qnil)));
6286 else if (event->modifiers & triple_modifier)
6287 return Fcons (head,
6288 Fcons (position,
6289 Fcons (make_number (3),
6290 Qnil)));
6291 else
6292 return Fcons (head,
6293 Fcons (position,
6294 Qnil));
6296 #endif /* HAVE_GPM */
6298 /* The 'kind' field of the event is something we don't recognize. */
6299 default:
6300 abort ();
6304 #if defined(HAVE_MOUSE) || defined(HAVE_GPM)
6306 static Lisp_Object
6307 make_lispy_movement (frame, bar_window, part, x, y, time)
6308 FRAME_PTR frame;
6309 Lisp_Object bar_window;
6310 enum scroll_bar_part part;
6311 Lisp_Object x, y;
6312 unsigned long time;
6314 /* Is it a scroll bar movement? */
6315 if (frame && ! NILP (bar_window))
6317 Lisp_Object part_sym;
6319 part_sym = *scroll_bar_parts[(int) part];
6320 return Fcons (Qscroll_bar_movement,
6321 (Fcons (Fcons (bar_window,
6322 Fcons (Qvertical_scroll_bar,
6323 Fcons (Fcons (x, y),
6324 Fcons (make_number (time),
6325 Fcons (part_sym,
6326 Qnil))))),
6327 Qnil)));
6330 /* Or is it an ordinary mouse movement? */
6331 else
6333 Lisp_Object position;
6335 position = make_lispy_position (frame, &x, &y, time);
6337 return Fcons (Qmouse_movement,
6338 Fcons (position,
6339 Qnil));
6343 #endif /* HAVE_MOUSE || HAVE GPM */
6345 /* Construct a switch frame event. */
6346 static Lisp_Object
6347 make_lispy_switch_frame (frame)
6348 Lisp_Object frame;
6350 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
6353 /* Manipulating modifiers. */
6355 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
6357 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
6358 SYMBOL's name of the end of the modifiers; the string from this
6359 position is the unmodified symbol name.
6361 This doesn't use any caches. */
6363 static int
6364 parse_modifiers_uncached (symbol, modifier_end)
6365 Lisp_Object symbol;
6366 int *modifier_end;
6368 Lisp_Object name;
6369 int i;
6370 int modifiers;
6372 CHECK_SYMBOL (symbol);
6374 modifiers = 0;
6375 name = SYMBOL_NAME (symbol);
6377 for (i = 0; i+2 <= SBYTES (name); )
6379 int this_mod_end = 0;
6380 int this_mod = 0;
6382 /* See if the name continues with a modifier word.
6383 Check that the word appears, but don't check what follows it.
6384 Set this_mod and this_mod_end to record what we find. */
6386 switch (SREF (name, i))
6388 #define SINGLE_LETTER_MOD(BIT) \
6389 (this_mod_end = i + 1, this_mod = BIT)
6391 case 'A':
6392 SINGLE_LETTER_MOD (alt_modifier);
6393 break;
6395 case 'C':
6396 SINGLE_LETTER_MOD (ctrl_modifier);
6397 break;
6399 case 'H':
6400 SINGLE_LETTER_MOD (hyper_modifier);
6401 break;
6403 case 'M':
6404 SINGLE_LETTER_MOD (meta_modifier);
6405 break;
6407 case 'S':
6408 SINGLE_LETTER_MOD (shift_modifier);
6409 break;
6411 case 's':
6412 SINGLE_LETTER_MOD (super_modifier);
6413 break;
6415 #undef SINGLE_LETTER_MOD
6417 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6418 if (i + LEN + 1 <= SBYTES (name) \
6419 && ! strncmp (SDATA (name) + i, NAME, LEN)) \
6421 this_mod_end = i + LEN; \
6422 this_mod = BIT; \
6425 case 'd':
6426 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6427 MULTI_LETTER_MOD (down_modifier, "down", 4);
6428 MULTI_LETTER_MOD (double_modifier, "double", 6);
6429 break;
6431 case 't':
6432 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6433 break;
6434 #undef MULTI_LETTER_MOD
6438 /* If we found no modifier, stop looking for them. */
6439 if (this_mod_end == 0)
6440 break;
6442 /* Check there is a dash after the modifier, so that it
6443 really is a modifier. */
6444 if (this_mod_end >= SBYTES (name)
6445 || SREF (name, this_mod_end) != '-')
6446 break;
6448 /* This modifier is real; look for another. */
6449 modifiers |= this_mod;
6450 i = this_mod_end + 1;
6453 /* Should we include the `click' modifier? */
6454 if (! (modifiers & (down_modifier | drag_modifier
6455 | double_modifier | triple_modifier))
6456 && i + 7 == SBYTES (name)
6457 && strncmp (SDATA (name) + i, "mouse-", 6) == 0
6458 && ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9'))
6459 modifiers |= click_modifier;
6461 if (! (modifiers & (double_modifier | triple_modifier))
6462 && i + 6 < SBYTES (name)
6463 && strncmp (SDATA (name) + i, "wheel-", 6) == 0)
6464 modifiers |= click_modifier;
6466 if (modifier_end)
6467 *modifier_end = i;
6469 return modifiers;
6472 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
6473 prepended to the string BASE[0..BASE_LEN-1].
6474 This doesn't use any caches. */
6475 static Lisp_Object
6476 apply_modifiers_uncached (modifiers, base, base_len, base_len_byte)
6477 int modifiers;
6478 char *base;
6479 int base_len, base_len_byte;
6481 /* Since BASE could contain nulls, we can't use intern here; we have
6482 to use Fintern, which expects a genuine Lisp_String, and keeps a
6483 reference to it. */
6484 char *new_mods
6485 = (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
6486 int mod_len;
6489 char *p = new_mods;
6491 /* Only the event queue may use the `up' modifier; it should always
6492 be turned into a click or drag event before presented to lisp code. */
6493 if (modifiers & up_modifier)
6494 abort ();
6496 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
6497 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
6498 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
6499 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
6500 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
6501 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
6502 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
6503 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
6504 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
6505 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
6506 /* The click modifier is denoted by the absence of other modifiers. */
6508 *p = '\0';
6510 mod_len = p - new_mods;
6514 Lisp_Object new_name;
6516 new_name = make_uninit_multibyte_string (mod_len + base_len,
6517 mod_len + base_len_byte);
6518 bcopy (new_mods, SDATA (new_name), mod_len);
6519 bcopy (base, SDATA (new_name) + mod_len, base_len_byte);
6521 return Fintern (new_name, Qnil);
6526 static const char *modifier_names[] =
6528 "up", "down", "drag", "click", "double", "triple", 0, 0,
6529 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
6530 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
6532 #define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
6534 static Lisp_Object modifier_symbols;
6536 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
6537 static Lisp_Object
6538 lispy_modifier_list (modifiers)
6539 int modifiers;
6541 Lisp_Object modifier_list;
6542 int i;
6544 modifier_list = Qnil;
6545 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
6546 if (modifiers & (1<<i))
6547 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
6548 modifier_list);
6550 return modifier_list;
6554 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
6555 where UNMODIFIED is the unmodified form of SYMBOL,
6556 MASK is the set of modifiers present in SYMBOL's name.
6557 This is similar to parse_modifiers_uncached, but uses the cache in
6558 SYMBOL's Qevent_symbol_element_mask property, and maintains the
6559 Qevent_symbol_elements property. */
6561 #define KEY_TO_CHAR(k) (XINT (k) & ((1 << CHARACTERBITS) - 1))
6563 Lisp_Object
6564 parse_modifiers (symbol)
6565 Lisp_Object symbol;
6567 Lisp_Object elements;
6569 if (INTEGERP (symbol))
6570 return (Fcons (make_number (KEY_TO_CHAR (symbol)),
6571 Fcons (make_number (XINT (symbol) & CHAR_MODIFIER_MASK),
6572 Qnil)));
6573 else if (!SYMBOLP (symbol))
6574 return Qnil;
6576 elements = Fget (symbol, Qevent_symbol_element_mask);
6577 if (CONSP (elements))
6578 return elements;
6579 else
6581 int end;
6582 int modifiers = parse_modifiers_uncached (symbol, &end);
6583 Lisp_Object unmodified;
6584 Lisp_Object mask;
6586 unmodified = Fintern (make_string (SDATA (SYMBOL_NAME (symbol)) + end,
6587 SBYTES (SYMBOL_NAME (symbol)) - end),
6588 Qnil);
6590 if (modifiers & ~INTMASK)
6591 abort ();
6592 XSETFASTINT (mask, modifiers);
6593 elements = Fcons (unmodified, Fcons (mask, Qnil));
6595 /* Cache the parsing results on SYMBOL. */
6596 Fput (symbol, Qevent_symbol_element_mask,
6597 elements);
6598 Fput (symbol, Qevent_symbol_elements,
6599 Fcons (unmodified, lispy_modifier_list (modifiers)));
6601 /* Since we know that SYMBOL is modifiers applied to unmodified,
6602 it would be nice to put that in unmodified's cache.
6603 But we can't, since we're not sure that parse_modifiers is
6604 canonical. */
6606 return elements;
6610 DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,
6611 Sevent_symbol_parse_modifiers, 1, 1, 0,
6612 doc: /* Parse the event symbol. For internal use. */)
6613 (symbol)
6614 Lisp_Object symbol;
6616 /* Fill the cache if needed. */
6617 parse_modifiers (symbol);
6618 /* Ignore the result (which is stored on Qevent_symbol_element_mask)
6619 and use the Lispier representation stored on Qevent_symbol_elements
6620 instead. */
6621 return Fget (symbol, Qevent_symbol_elements);
6624 /* Apply the modifiers MODIFIERS to the symbol BASE.
6625 BASE must be unmodified.
6627 This is like apply_modifiers_uncached, but uses BASE's
6628 Qmodifier_cache property, if present. It also builds
6629 Qevent_symbol_elements properties, since it has that info anyway.
6631 apply_modifiers copies the value of BASE's Qevent_kind property to
6632 the modified symbol. */
6633 static Lisp_Object
6634 apply_modifiers (modifiers, base)
6635 int modifiers;
6636 Lisp_Object base;
6638 Lisp_Object cache, index, entry, new_symbol;
6640 /* Mask out upper bits. We don't know where this value's been. */
6641 modifiers &= INTMASK;
6643 if (INTEGERP (base))
6644 return make_number (XINT (base) | modifiers);
6646 /* The click modifier never figures into cache indices. */
6647 cache = Fget (base, Qmodifier_cache);
6648 XSETFASTINT (index, (modifiers & ~click_modifier));
6649 entry = assq_no_quit (index, cache);
6651 if (CONSP (entry))
6652 new_symbol = XCDR (entry);
6653 else
6655 /* We have to create the symbol ourselves. */
6656 new_symbol = apply_modifiers_uncached (modifiers,
6657 SDATA (SYMBOL_NAME (base)),
6658 SCHARS (SYMBOL_NAME (base)),
6659 SBYTES (SYMBOL_NAME (base)));
6661 /* Add the new symbol to the base's cache. */
6662 entry = Fcons (index, new_symbol);
6663 Fput (base, Qmodifier_cache, Fcons (entry, cache));
6665 /* We have the parsing info now for free, so we could add it to
6666 the caches:
6667 XSETFASTINT (index, modifiers);
6668 Fput (new_symbol, Qevent_symbol_element_mask,
6669 Fcons (base, Fcons (index, Qnil)));
6670 Fput (new_symbol, Qevent_symbol_elements,
6671 Fcons (base, lispy_modifier_list (modifiers)));
6672 Sadly, this is only correct if `base' is indeed a base event,
6673 which is not necessarily the case. -stef */
6676 /* Make sure this symbol is of the same kind as BASE.
6678 You'd think we could just set this once and for all when we
6679 intern the symbol above, but reorder_modifiers may call us when
6680 BASE's property isn't set right; we can't assume that just
6681 because it has a Qmodifier_cache property it must have its
6682 Qevent_kind set right as well. */
6683 if (NILP (Fget (new_symbol, Qevent_kind)))
6685 Lisp_Object kind;
6687 kind = Fget (base, Qevent_kind);
6688 if (! NILP (kind))
6689 Fput (new_symbol, Qevent_kind, kind);
6692 return new_symbol;
6696 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
6697 return a symbol with the modifiers placed in the canonical order.
6698 Canonical order is alphabetical, except for down and drag, which
6699 always come last. The 'click' modifier is never written out.
6701 Fdefine_key calls this to make sure that (for example) C-M-foo
6702 and M-C-foo end up being equivalent in the keymap. */
6704 Lisp_Object
6705 reorder_modifiers (symbol)
6706 Lisp_Object symbol;
6708 /* It's hopefully okay to write the code this way, since everything
6709 will soon be in caches, and no consing will be done at all. */
6710 Lisp_Object parsed;
6712 parsed = parse_modifiers (symbol);
6713 return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))),
6714 XCAR (parsed));
6718 /* For handling events, we often want to produce a symbol whose name
6719 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
6720 to some base, like the name of a function key or mouse button.
6721 modify_event_symbol produces symbols of this sort.
6723 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
6724 is the name of the i'th symbol. TABLE_SIZE is the number of elements
6725 in the table.
6727 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
6728 into symbol names, or a string specifying a name stem used to
6729 construct a symbol name or the form `STEM-N', where N is the decimal
6730 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
6731 non-nil; otherwise NAME_TABLE is used.
6733 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
6734 persist between calls to modify_event_symbol that it can use to
6735 store a cache of the symbols it's generated for this NAME_TABLE
6736 before. The object stored there may be a vector or an alist.
6738 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
6740 MODIFIERS is a set of modifier bits (as given in struct input_events)
6741 whose prefixes should be applied to the symbol name.
6743 SYMBOL_KIND is the value to be placed in the event_kind property of
6744 the returned symbol.
6746 The symbols we create are supposed to have an
6747 `event-symbol-elements' property, which lists the modifiers present
6748 in the symbol's name. */
6750 static Lisp_Object
6751 modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist_or_stem,
6752 name_table, symbol_table, table_size)
6753 int symbol_num;
6754 unsigned modifiers;
6755 Lisp_Object symbol_kind;
6756 Lisp_Object name_alist_or_stem;
6757 char **name_table;
6758 Lisp_Object *symbol_table;
6759 unsigned int table_size;
6761 Lisp_Object value;
6762 Lisp_Object symbol_int;
6764 /* Get rid of the "vendor-specific" bit here. */
6765 XSETINT (symbol_int, symbol_num & 0xffffff);
6767 /* Is this a request for a valid symbol? */
6768 if (symbol_num < 0 || symbol_num >= table_size)
6769 return Qnil;
6771 if (CONSP (*symbol_table))
6772 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
6774 /* If *symbol_table doesn't seem to be initialized properly, fix that.
6775 *symbol_table should be a lisp vector TABLE_SIZE elements long,
6776 where the Nth element is the symbol for NAME_TABLE[N], or nil if
6777 we've never used that symbol before. */
6778 else
6780 if (! VECTORP (*symbol_table)
6781 || XVECTOR (*symbol_table)->size != table_size)
6783 Lisp_Object size;
6785 XSETFASTINT (size, table_size);
6786 *symbol_table = Fmake_vector (size, Qnil);
6789 value = XVECTOR (*symbol_table)->contents[symbol_num];
6792 /* Have we already used this symbol before? */
6793 if (NILP (value))
6795 /* No; let's create it. */
6796 if (CONSP (name_alist_or_stem))
6797 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
6798 else if (STRINGP (name_alist_or_stem))
6800 int len = SBYTES (name_alist_or_stem);
6801 char *buf = (char *) alloca (len + 50);
6802 sprintf (buf, "%s-%ld", SDATA (name_alist_or_stem),
6803 (long) XINT (symbol_int) + 1);
6804 value = intern (buf);
6806 else if (name_table != 0 && name_table[symbol_num])
6807 value = intern (name_table[symbol_num]);
6809 #ifdef HAVE_WINDOW_SYSTEM
6810 if (NILP (value))
6812 char *name = x_get_keysym_name (symbol_num);
6813 if (name)
6814 value = intern (name);
6816 #endif
6818 if (NILP (value))
6820 char buf[20];
6821 sprintf (buf, "key-%d", symbol_num);
6822 value = intern (buf);
6825 if (CONSP (*symbol_table))
6826 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
6827 else
6828 XVECTOR (*symbol_table)->contents[symbol_num] = value;
6830 /* Fill in the cache entries for this symbol; this also
6831 builds the Qevent_symbol_elements property, which the user
6832 cares about. */
6833 apply_modifiers (modifiers & click_modifier, value);
6834 Fput (value, Qevent_kind, symbol_kind);
6837 /* Apply modifiers to that symbol. */
6838 return apply_modifiers (modifiers, value);
6841 /* Convert a list that represents an event type,
6842 such as (ctrl meta backspace), into the usual representation of that
6843 event type as a number or a symbol. */
6845 DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
6846 doc: /* Convert the event description list EVENT-DESC to an event type.
6847 EVENT-DESC should contain one base event type (a character or symbol)
6848 and zero or more modifier names (control, meta, hyper, super, shift, alt,
6849 drag, down, double or triple). The base must be last.
6850 The return value is an event type (a character or symbol) which
6851 has the same base event type and all the specified modifiers. */)
6852 (event_desc)
6853 Lisp_Object event_desc;
6855 Lisp_Object base;
6856 int modifiers = 0;
6857 Lisp_Object rest;
6859 base = Qnil;
6860 rest = event_desc;
6861 while (CONSP (rest))
6863 Lisp_Object elt;
6864 int this = 0;
6866 elt = XCAR (rest);
6867 rest = XCDR (rest);
6869 /* Given a symbol, see if it is a modifier name. */
6870 if (SYMBOLP (elt) && CONSP (rest))
6871 this = parse_solitary_modifier (elt);
6873 if (this != 0)
6874 modifiers |= this;
6875 else if (!NILP (base))
6876 error ("Two bases given in one event");
6877 else
6878 base = elt;
6882 /* Let the symbol A refer to the character A. */
6883 if (SYMBOLP (base) && SCHARS (SYMBOL_NAME (base)) == 1)
6884 XSETINT (base, SREF (SYMBOL_NAME (base), 0));
6886 if (INTEGERP (base))
6888 /* Turn (shift a) into A. */
6889 if ((modifiers & shift_modifier) != 0
6890 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
6892 XSETINT (base, XINT (base) - ('a' - 'A'));
6893 modifiers &= ~shift_modifier;
6896 /* Turn (control a) into C-a. */
6897 if (modifiers & ctrl_modifier)
6898 return make_number ((modifiers & ~ctrl_modifier)
6899 | make_ctrl_char (XINT (base)));
6900 else
6901 return make_number (modifiers | XINT (base));
6903 else if (SYMBOLP (base))
6904 return apply_modifiers (modifiers, base);
6905 else
6907 error ("Invalid base event");
6908 return Qnil;
6912 /* Try to recognize SYMBOL as a modifier name.
6913 Return the modifier flag bit, or 0 if not recognized. */
6916 parse_solitary_modifier (Lisp_Object symbol)
6918 Lisp_Object name = SYMBOL_NAME (symbol);
6920 switch (SREF (name, 0))
6922 #define SINGLE_LETTER_MOD(BIT) \
6923 if (SBYTES (name) == 1) \
6924 return BIT;
6926 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6927 if (LEN == SBYTES (name) \
6928 && ! strncmp (SDATA (name), NAME, LEN)) \
6929 return BIT;
6931 case 'A':
6932 SINGLE_LETTER_MOD (alt_modifier);
6933 break;
6935 case 'a':
6936 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
6937 break;
6939 case 'C':
6940 SINGLE_LETTER_MOD (ctrl_modifier);
6941 break;
6943 case 'c':
6944 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
6945 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
6946 break;
6948 case 'H':
6949 SINGLE_LETTER_MOD (hyper_modifier);
6950 break;
6952 case 'h':
6953 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
6954 break;
6956 case 'M':
6957 SINGLE_LETTER_MOD (meta_modifier);
6958 break;
6960 case 'm':
6961 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
6962 break;
6964 case 'S':
6965 SINGLE_LETTER_MOD (shift_modifier);
6966 break;
6968 case 's':
6969 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
6970 MULTI_LETTER_MOD (super_modifier, "super", 5);
6971 SINGLE_LETTER_MOD (super_modifier);
6972 break;
6974 case 'd':
6975 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6976 MULTI_LETTER_MOD (down_modifier, "down", 4);
6977 MULTI_LETTER_MOD (double_modifier, "double", 6);
6978 break;
6980 case 't':
6981 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6982 break;
6984 #undef SINGLE_LETTER_MOD
6985 #undef MULTI_LETTER_MOD
6988 return 0;
6991 /* Return 1 if EVENT is a list whose elements are all integers or symbols.
6992 Such a list is not valid as an event,
6993 but it can be a Lucid-style event type list. */
6996 lucid_event_type_list_p (object)
6997 Lisp_Object object;
6999 Lisp_Object tail;
7001 if (! CONSP (object))
7002 return 0;
7004 if (EQ (XCAR (object), Qhelp_echo)
7005 || EQ (XCAR (object), Qvertical_line)
7006 || EQ (XCAR (object), Qmode_line)
7007 || EQ (XCAR (object), Qheader_line))
7008 return 0;
7010 for (tail = object; CONSP (tail); tail = XCDR (tail))
7012 Lisp_Object elt;
7013 elt = XCAR (tail);
7014 if (! (INTEGERP (elt) || SYMBOLP (elt)))
7015 return 0;
7018 return NILP (tail);
7021 /* Store into *addr a value nonzero if terminal input chars are available.
7022 Serves the purpose of ioctl (0, FIONREAD, addr)
7023 but works even if FIONREAD does not exist.
7024 (In fact, this may actually read some input.)
7026 If READABLE_EVENTS_DO_TIMERS_NOW is set in FLAGS, actually run
7027 timer events that are ripe.
7028 If READABLE_EVENTS_FILTER_EVENTS is set in FLAGS, ignore internal
7029 events (FOCUS_IN_EVENT).
7030 If READABLE_EVENTS_IGNORE_SQUEEZABLES is set in FLAGS, ignore mouse
7031 movements and toolkit scroll bar thumb drags. */
7033 static void
7034 get_input_pending (addr, flags)
7035 int *addr;
7036 int flags;
7038 /* First of all, have we already counted some input? */
7039 *addr = (!NILP (Vquit_flag) || readable_events (flags));
7041 /* If input is being read as it arrives, and we have none, there is none. */
7042 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
7043 return;
7045 /* Try to read some input and see how much we get. */
7046 gobble_input (0);
7047 *addr = (!NILP (Vquit_flag) || readable_events (flags));
7050 /* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
7052 void
7053 gobble_input (expected)
7054 int expected;
7056 #ifdef HAVE_DBUS
7057 /* Read D-Bus messages. */
7058 xd_read_queued_messages ();
7059 #endif /* HAVE_DBUS */
7061 #ifdef SIGIO
7062 if (interrupt_input)
7064 SIGMASKTYPE mask;
7065 mask = sigblock (sigmask (SIGIO));
7066 read_avail_input (expected);
7067 sigsetmask (mask);
7069 else
7070 #ifdef POLL_FOR_INPUT
7071 /* XXX This condition was (read_socket_hook && !interrupt_input),
7072 but read_socket_hook is not global anymore. Let's pretend that
7073 it's always set. */
7074 if (!interrupt_input && poll_suppress_count == 0)
7076 SIGMASKTYPE mask;
7077 mask = sigblock (sigmask (SIGALRM));
7078 read_avail_input (expected);
7079 sigsetmask (mask);
7081 else
7082 #endif
7083 #endif
7084 read_avail_input (expected);
7087 /* Put a BUFFER_SWITCH_EVENT in the buffer
7088 so that read_key_sequence will notice the new current buffer. */
7090 void
7091 record_asynch_buffer_change ()
7093 struct input_event event;
7094 Lisp_Object tem;
7095 EVENT_INIT (event);
7097 event.kind = BUFFER_SWITCH_EVENT;
7098 event.frame_or_window = Qnil;
7099 event.arg = Qnil;
7101 #ifdef subprocesses
7102 /* We don't need a buffer-switch event unless Emacs is waiting for input.
7103 The purpose of the event is to make read_key_sequence look up the
7104 keymaps again. If we aren't in read_key_sequence, we don't need one,
7105 and the event could cause trouble by messing up (input-pending-p). */
7106 tem = Fwaiting_for_user_input_p ();
7107 if (NILP (tem))
7108 return;
7109 #else
7110 /* We never need these events if we have no asynchronous subprocesses. */
7111 return;
7112 #endif
7114 /* Make sure no interrupt happens while storing the event. */
7115 #ifdef SIGIO
7116 if (interrupt_input)
7118 SIGMASKTYPE mask;
7119 mask = sigblock (sigmask (SIGIO));
7120 kbd_buffer_store_event (&event);
7121 sigsetmask (mask);
7123 else
7124 #endif
7126 stop_polling ();
7127 kbd_buffer_store_event (&event);
7128 start_polling ();
7132 /* Read any terminal input already buffered up by the system
7133 into the kbd_buffer, but do not wait.
7135 EXPECTED should be nonzero if the caller knows there is some input.
7137 Returns the number of keyboard chars read, or -1 meaning
7138 this is a bad time to try to read input. */
7140 static int
7141 read_avail_input (expected)
7142 int expected;
7144 int nread = 0;
7145 int err = 0;
7146 struct terminal *t;
7148 /* Store pending user signal events, if any. */
7149 if (store_user_signal_events ())
7150 expected = 0;
7152 /* Loop through the available terminals, and call their input hooks. */
7153 t = terminal_list;
7154 while (t)
7156 struct terminal *next = t->next_terminal;
7158 if (t->read_socket_hook)
7160 int nr;
7161 struct input_event hold_quit;
7163 EVENT_INIT (hold_quit);
7164 hold_quit.kind = NO_EVENT;
7166 /* No need for FIONREAD or fcntl; just say don't wait. */
7167 while (nr = (*t->read_socket_hook) (t, expected, &hold_quit), nr > 0)
7169 nread += nr;
7170 expected = 0;
7173 if (nr == -1) /* Not OK to read input now. */
7175 err = 1;
7177 else if (nr == -2) /* Non-transient error. */
7179 /* The terminal device terminated; it should be closed. */
7181 /* Kill Emacs if this was our last terminal. */
7182 if (!terminal_list->next_terminal)
7183 /* Formerly simply reported no input, but that
7184 sometimes led to a failure of Emacs to terminate.
7185 SIGHUP seems appropriate if we can't reach the
7186 terminal. */
7187 /* ??? Is it really right to send the signal just to
7188 this process rather than to the whole process
7189 group? Perhaps on systems with FIONREAD Emacs is
7190 alone in its group. */
7191 kill (getpid (), SIGHUP);
7193 /* XXX Is calling delete_terminal safe here? It calls delete_frame. */
7195 Lisp_Object tmp;
7196 XSETTERMINAL (tmp, t);
7197 Fdelete_terminal (tmp, Qnoelisp);
7201 if (hold_quit.kind != NO_EVENT)
7202 kbd_buffer_store_event (&hold_quit);
7205 t = next;
7208 if (err && !nread)
7209 nread = -1;
7211 frame_make_pointer_visible ();
7213 return nread;
7216 static void
7217 decode_keyboard_code (struct tty_display_info *tty,
7218 struct coding_system *coding,
7219 unsigned char *buf, int nbytes)
7221 unsigned char *src = buf;
7222 const unsigned char *p;
7223 int i;
7225 if (nbytes == 0)
7226 return;
7227 if (tty->meta_key != 2)
7228 for (i = 0; i < nbytes; i++)
7229 buf[i] &= ~0x80;
7230 if (coding->carryover_bytes > 0)
7232 src = alloca (coding->carryover_bytes + nbytes);
7233 memcpy (src, coding->carryover, coding->carryover_bytes);
7234 memcpy (src + coding->carryover_bytes, buf, nbytes);
7235 nbytes += coding->carryover_bytes;
7237 coding->destination = alloca (nbytes * 4);
7238 coding->dst_bytes = nbytes * 4;
7239 decode_coding_c_string (coding, src, nbytes, Qnil);
7240 if (coding->produced_char == 0)
7241 return;
7242 for (i = 0, p = coding->destination; i < coding->produced_char; i++)
7244 struct input_event buf;
7246 EVENT_INIT (buf);
7247 buf.code = STRING_CHAR_ADVANCE (p);
7248 buf.kind = (ASCII_CHAR_P (buf.code)
7249 ? ASCII_KEYSTROKE_EVENT : MULTIBYTE_CHAR_KEYSTROKE_EVENT);
7250 /* See the comment in tty_read_avail_input. */
7251 buf.frame_or_window = tty->top_frame;
7252 buf.arg = Qnil;
7253 kbd_buffer_store_event (&buf);
7257 /* This is the tty way of reading available input.
7259 Note that each terminal device has its own `struct terminal' object,
7260 and so this function is called once for each individual termcap
7261 terminal. The first parameter indicates which terminal to read from. */
7264 tty_read_avail_input (struct terminal *terminal,
7265 int expected,
7266 struct input_event *hold_quit)
7268 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
7269 the kbd_buffer can really hold. That may prevent loss
7270 of characters on some systems when input is stuffed at us. */
7271 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
7272 int n_to_read, i;
7273 struct tty_display_info *tty = terminal->display_info.tty;
7274 int nread = 0;
7276 if (!terminal->name) /* Don't read from a dead terminal. */
7277 return 0;
7279 if (terminal->type != output_termcap
7280 && terminal->type != output_msdos_raw)
7281 abort ();
7283 /* XXX I think the following code should be moved to separate hook
7284 functions in system-dependent files. */
7285 #ifdef WINDOWSNT
7286 return 0;
7287 #else /* not WINDOWSNT */
7288 if (! tty->term_initted) /* In case we get called during bootstrap. */
7289 return 0;
7291 if (! tty->input)
7292 return 0; /* The terminal is suspended. */
7294 #ifdef MSDOS
7295 n_to_read = dos_keysns ();
7296 if (n_to_read == 0)
7297 return 0;
7299 cbuf[0] = dos_keyread ();
7300 nread = 1;
7302 #else /* not MSDOS */
7303 #ifdef HAVE_GPM
7304 if (gpm_tty == tty)
7306 Gpm_Event event;
7307 struct input_event hold_quit;
7308 int gpm, fd = gpm_fd;
7310 EVENT_INIT (hold_quit);
7311 hold_quit.kind = NO_EVENT;
7313 /* gpm==1 if event received.
7314 gpm==0 if the GPM daemon has closed the connection, in which case
7315 Gpm_GetEvent closes gpm_fd and clears it to -1, which is why
7316 we save it in `fd' so close_gpm can remove it from the
7317 select masks.
7318 gpm==-1 if a protocol error or EWOULDBLOCK; the latter is normal. */
7319 while (gpm = Gpm_GetEvent (&event), gpm == 1) {
7320 nread += handle_one_term_event (tty, &event, &hold_quit);
7322 if (gpm == 0)
7323 /* Presumably the GPM daemon has closed the connection. */
7324 close_gpm (fd);
7325 if (hold_quit.kind != NO_EVENT)
7326 kbd_buffer_store_event (&hold_quit);
7327 if (nread)
7328 return nread;
7330 #endif /* HAVE_GPM */
7332 /* Determine how many characters we should *try* to read. */
7333 #ifdef FIONREAD
7334 /* Find out how much input is available. */
7335 if (ioctl (fileno (tty->input), FIONREAD, &n_to_read) < 0)
7337 if (! noninteractive)
7338 return -2; /* Close this terminal. */
7339 else
7340 n_to_read = 0;
7342 if (n_to_read == 0)
7343 return 0;
7344 if (n_to_read > sizeof cbuf)
7345 n_to_read = sizeof cbuf;
7346 #else /* no FIONREAD */
7347 #if defined (USG) || defined(CYGWIN)
7348 /* Read some input if available, but don't wait. */
7349 n_to_read = sizeof cbuf;
7350 fcntl (fileno (tty->input), F_SETFL, O_NDELAY);
7351 #else
7352 you lose;
7353 #endif
7354 #endif
7356 /* Now read; for one reason or another, this will not block.
7357 NREAD is set to the number of chars read. */
7360 nread = emacs_read (fileno (tty->input), cbuf, n_to_read);
7361 /* POSIX infers that processes which are not in the session leader's
7362 process group won't get SIGHUP's at logout time. BSDI adheres to
7363 this part standard and returns -1 from read (0) with errno==EIO
7364 when the control tty is taken away.
7365 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
7366 if (nread == -1 && errno == EIO)
7367 return -2; /* Close this terminal. */
7368 #if defined (AIX) && defined (_BSD)
7369 /* The kernel sometimes fails to deliver SIGHUP for ptys.
7370 This looks incorrect, but it isn't, because _BSD causes
7371 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
7372 and that causes a value other than 0 when there is no input. */
7373 if (nread == 0)
7374 return -2; /* Close this terminal. */
7375 #endif
7377 while (
7378 /* We used to retry the read if it was interrupted.
7379 But this does the wrong thing when O_NDELAY causes
7380 an EAGAIN error. Does anybody know of a situation
7381 where a retry is actually needed? */
7382 #if 0
7383 nread < 0 && (errno == EAGAIN
7384 #ifdef EFAULT
7385 || errno == EFAULT
7386 #endif
7387 #ifdef EBADSLT
7388 || errno == EBADSLT
7389 #endif
7391 #else
7393 #endif
7396 #ifndef FIONREAD
7397 #if defined (USG) || defined (CYGWIN)
7398 fcntl (fileno (tty->input), F_SETFL, 0);
7399 #endif /* USG or CYGWIN */
7400 #endif /* no FIONREAD */
7402 if (nread <= 0)
7403 return nread;
7405 #endif /* not MSDOS */
7406 #endif /* not WINDOWSNT */
7408 if (TERMINAL_KEYBOARD_CODING (terminal)->common_flags
7409 & CODING_REQUIRE_DECODING_MASK)
7411 struct coding_system *coding = TERMINAL_KEYBOARD_CODING (terminal);
7412 int from;
7414 /* Decode the key sequence except for those with meta
7415 modifiers. */
7416 for (i = from = 0; ; i++)
7417 if (i == nread || (tty->meta_key == 1 && (cbuf[i] & 0x80)))
7419 struct input_event buf;
7421 decode_keyboard_code (tty, coding, cbuf + from, i - from);
7422 if (i == nread)
7423 break;
7425 EVENT_INIT (buf);
7426 buf.kind = ASCII_KEYSTROKE_EVENT;
7427 buf.modifiers = meta_modifier;
7428 buf.code = cbuf[i] & ~0x80;
7429 /* See the comment below. */
7430 buf.frame_or_window = tty->top_frame;
7431 buf.arg = Qnil;
7432 kbd_buffer_store_event (&buf);
7433 from = i + 1;
7435 return nread;
7438 for (i = 0; i < nread; i++)
7440 struct input_event buf;
7441 EVENT_INIT (buf);
7442 buf.kind = ASCII_KEYSTROKE_EVENT;
7443 buf.modifiers = 0;
7444 if (tty->meta_key == 1 && (cbuf[i] & 0x80))
7445 buf.modifiers = meta_modifier;
7446 if (tty->meta_key != 2)
7447 cbuf[i] &= ~0x80;
7449 buf.code = cbuf[i];
7450 /* Set the frame corresponding to the active tty. Note that the
7451 value of selected_frame is not reliable here, redisplay tends
7452 to temporarily change it. */
7453 buf.frame_or_window = tty->top_frame;
7454 buf.arg = Qnil;
7456 kbd_buffer_store_event (&buf);
7457 /* Don't look at input that follows a C-g too closely.
7458 This reduces lossage due to autorepeat on C-g. */
7459 if (buf.kind == ASCII_KEYSTROKE_EVENT
7460 && buf.code == quit_char)
7461 break;
7464 return nread;
7467 void
7468 handle_async_input ()
7470 interrupt_input_pending = 0;
7471 #ifdef SYNC_INPUT
7472 pending_signals = pending_atimers;
7473 #endif
7474 /* Tell ns_read_socket() it is being called asynchronously so it can avoid
7475 doing anything dangerous. */
7476 #ifdef HAVE_NS
7477 ++handling_signal;
7478 #endif
7479 while (1)
7481 int nread;
7482 nread = read_avail_input (1);
7483 /* -1 means it's not ok to read the input now.
7484 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
7485 0 means there was no keyboard input available. */
7486 if (nread <= 0)
7487 break;
7489 #ifdef HAVE_NS
7490 --handling_signal;
7491 #endif
7494 void
7495 process_pending_signals ()
7497 if (interrupt_input_pending)
7498 handle_async_input ();
7499 do_pending_atimers ();
7502 #ifdef SIGIO /* for entire page */
7503 /* Note SIGIO has been undef'd if FIONREAD is missing. */
7505 static SIGTYPE
7506 input_available_signal (signo)
7507 int signo;
7509 /* Must preserve main program's value of errno. */
7510 int old_errno = errno;
7511 SIGNAL_THREAD_CHECK (signo);
7513 #ifdef SYNC_INPUT
7514 interrupt_input_pending = 1;
7515 pending_signals = 1;
7516 #endif
7518 if (input_available_clear_time)
7519 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
7521 #ifndef SYNC_INPUT
7522 handle_async_input ();
7523 #endif
7525 errno = old_errno;
7527 #endif /* SIGIO */
7529 /* Send ourselves a SIGIO.
7531 This function exists so that the UNBLOCK_INPUT macro in
7532 blockinput.h can have some way to take care of input we put off
7533 dealing with, without assuming that every file which uses
7534 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
7535 void
7536 reinvoke_input_signal ()
7538 #ifdef SIGIO
7539 handle_async_input ();
7540 #endif
7545 /* User signal events. */
7547 struct user_signal_info
7549 /* Signal number. */
7550 int sig;
7552 /* Name of the signal. */
7553 char *name;
7555 /* Number of pending signals. */
7556 int npending;
7558 struct user_signal_info *next;
7561 /* List of user signals. */
7562 static struct user_signal_info *user_signals = NULL;
7564 void
7565 add_user_signal (sig, name)
7566 int sig;
7567 const char *name;
7569 struct user_signal_info *p;
7571 for (p = user_signals; p; p = p->next)
7572 if (p->sig == sig)
7573 /* Already added. */
7574 return;
7576 p = xmalloc (sizeof (struct user_signal_info));
7577 p->sig = sig;
7578 p->name = xstrdup (name);
7579 p->npending = 0;
7580 p->next = user_signals;
7581 user_signals = p;
7583 signal (sig, handle_user_signal);
7586 static SIGTYPE
7587 handle_user_signal (sig)
7588 int sig;
7590 int old_errno = errno;
7591 struct user_signal_info *p;
7593 SIGNAL_THREAD_CHECK (sig);
7595 for (p = user_signals; p; p = p->next)
7596 if (p->sig == sig)
7598 p->npending++;
7599 #ifdef SIGIO
7600 if (interrupt_input)
7601 kill (getpid (), SIGIO);
7602 else
7603 #endif
7605 /* Tell wait_reading_process_output that it needs to wake
7606 up and look around. */
7607 if (input_available_clear_time)
7608 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
7610 break;
7613 errno = old_errno;
7616 static char *
7617 find_user_signal_name (sig)
7618 int sig;
7620 struct user_signal_info *p;
7622 for (p = user_signals; p; p = p->next)
7623 if (p->sig == sig)
7624 return p->name;
7626 return NULL;
7629 static int
7630 store_user_signal_events ()
7632 struct user_signal_info *p;
7633 struct input_event buf;
7634 int nstored = 0;
7636 for (p = user_signals; p; p = p->next)
7637 if (p->npending > 0)
7639 SIGMASKTYPE mask;
7641 if (nstored == 0)
7643 bzero (&buf, sizeof buf);
7644 buf.kind = USER_SIGNAL_EVENT;
7645 buf.frame_or_window = selected_frame;
7647 nstored += p->npending;
7649 mask = sigblock (sigmask (p->sig));
7652 buf.code = p->sig;
7653 kbd_buffer_store_event (&buf);
7654 p->npending--;
7656 while (p->npending > 0);
7657 sigsetmask (mask);
7660 return nstored;
7664 static void menu_bar_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object, void*));
7665 static Lisp_Object menu_bar_one_keymap_changed_items;
7667 /* These variables hold the vector under construction within
7668 menu_bar_items and its subroutines, and the current index
7669 for storing into that vector. */
7670 static Lisp_Object menu_bar_items_vector;
7671 static int menu_bar_items_index;
7673 /* Return a vector of menu items for a menu bar, appropriate
7674 to the current buffer. Each item has three elements in the vector:
7675 KEY STRING MAPLIST.
7677 OLD is an old vector we can optionally reuse, or nil. */
7679 Lisp_Object
7680 menu_bar_items (old)
7681 Lisp_Object old;
7683 /* The number of keymaps we're scanning right now, and the number of
7684 keymaps we have allocated space for. */
7685 int nmaps;
7687 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
7688 in the current keymaps, or nil where it is not a prefix. */
7689 Lisp_Object *maps;
7691 Lisp_Object def, tail;
7693 Lisp_Object result;
7695 int mapno;
7696 Lisp_Object oquit;
7698 int i;
7700 /* In order to build the menus, we need to call the keymap
7701 accessors. They all call QUIT. But this function is called
7702 during redisplay, during which a quit is fatal. So inhibit
7703 quitting while building the menus.
7704 We do this instead of specbind because (1) errors will clear it anyway
7705 and (2) this avoids risk of specpdl overflow. */
7706 oquit = Vinhibit_quit;
7707 Vinhibit_quit = Qt;
7709 if (!NILP (old))
7710 menu_bar_items_vector = old;
7711 else
7712 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
7713 menu_bar_items_index = 0;
7715 /* Build our list of keymaps.
7716 If we recognize a function key and replace its escape sequence in
7717 keybuf with its symbol, or if the sequence starts with a mouse
7718 click and we need to switch buffers, we jump back here to rebuild
7719 the initial keymaps from the current buffer. */
7721 Lisp_Object *tmaps;
7723 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7724 if (!NILP (Voverriding_local_map_menu_flag))
7726 /* Yes, use them (if non-nil) as well as the global map. */
7727 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
7728 nmaps = 0;
7729 if (!NILP (current_kboard->Voverriding_terminal_local_map))
7730 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
7731 if (!NILP (Voverriding_local_map))
7732 maps[nmaps++] = Voverriding_local_map;
7734 else
7736 /* No, so use major and minor mode keymaps and keymap property.
7737 Note that menu-bar bindings in the local-map and keymap
7738 properties may not work reliable, as they are only
7739 recognized when the menu-bar (or mode-line) is updated,
7740 which does not normally happen after every command. */
7741 Lisp_Object tem;
7742 int nminor;
7743 nminor = current_minor_maps (NULL, &tmaps);
7744 maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
7745 nmaps = 0;
7746 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
7747 maps[nmaps++] = tem;
7748 bcopy (tmaps, (void *) (maps + nmaps), nminor * sizeof (maps[0]));
7749 nmaps += nminor;
7750 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
7752 maps[nmaps++] = current_global_map;
7755 /* Look up in each map the dummy prefix key `menu-bar'. */
7757 result = Qnil;
7759 for (mapno = nmaps - 1; mapno >= 0; mapno--)
7760 if (!NILP (maps[mapno]))
7762 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
7763 0, 1);
7764 if (CONSP (def))
7766 menu_bar_one_keymap_changed_items = Qnil;
7767 map_keymap (def, menu_bar_item, Qnil, NULL, 1);
7771 /* Move to the end those items that should be at the end. */
7773 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
7775 int i;
7776 int end = menu_bar_items_index;
7778 for (i = 0; i < end; i += 4)
7779 if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i]))
7781 Lisp_Object tem0, tem1, tem2, tem3;
7782 /* Move the item at index I to the end,
7783 shifting all the others forward. */
7784 tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
7785 tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
7786 tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
7787 tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
7788 if (end > i + 4)
7789 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
7790 &XVECTOR (menu_bar_items_vector)->contents[i],
7791 (end - i - 4) * sizeof (Lisp_Object));
7792 XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
7793 XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
7794 XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
7795 XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
7796 break;
7800 /* Add nil, nil, nil, nil at the end. */
7801 i = menu_bar_items_index;
7802 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
7803 menu_bar_items_vector = larger_vector (menu_bar_items_vector, 2 * i, Qnil);
7804 /* Add this item. */
7805 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
7806 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
7807 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
7808 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
7809 menu_bar_items_index = i;
7811 Vinhibit_quit = oquit;
7812 return menu_bar_items_vector;
7815 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
7816 If there's already an item for KEY, add this DEF to it. */
7818 Lisp_Object item_properties;
7820 static void
7821 menu_bar_item (key, item, dummy1, dummy2)
7822 Lisp_Object key, item, dummy1;
7823 void *dummy2;
7825 struct gcpro gcpro1;
7826 int i;
7827 Lisp_Object tem;
7829 if (EQ (item, Qundefined))
7831 /* If a map has an explicit `undefined' as definition,
7832 discard any previously made menu bar item. */
7834 for (i = 0; i < menu_bar_items_index; i += 4)
7835 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
7837 if (menu_bar_items_index > i + 4)
7838 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
7839 &XVECTOR (menu_bar_items_vector)->contents[i],
7840 (menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
7841 menu_bar_items_index -= 4;
7845 /* If this keymap has already contributed to this KEY,
7846 don't contribute to it a second time. */
7847 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
7848 if (!NILP (tem) || NILP (item))
7849 return;
7851 menu_bar_one_keymap_changed_items
7852 = Fcons (key, menu_bar_one_keymap_changed_items);
7854 /* We add to menu_bar_one_keymap_changed_items before doing the
7855 parse_menu_item, so that if it turns out it wasn't a menu item,
7856 it still correctly hides any further menu item. */
7857 GCPRO1 (key);
7858 i = parse_menu_item (item, 1);
7859 UNGCPRO;
7860 if (!i)
7861 return;
7863 item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
7865 /* Find any existing item for this KEY. */
7866 for (i = 0; i < menu_bar_items_index; i += 4)
7867 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
7868 break;
7870 /* If we did not find this KEY, add it at the end. */
7871 if (i == menu_bar_items_index)
7873 /* If vector is too small, get a bigger one. */
7874 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
7875 menu_bar_items_vector = larger_vector (menu_bar_items_vector, 2 * i, Qnil);
7876 /* Add this item. */
7877 XVECTOR (menu_bar_items_vector)->contents[i++] = key;
7878 XVECTOR (menu_bar_items_vector)->contents[i++]
7879 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
7880 XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
7881 XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
7882 menu_bar_items_index = i;
7884 /* We did find an item for this KEY. Add ITEM to its list of maps. */
7885 else
7887 Lisp_Object old;
7888 old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
7889 /* If the new and the old items are not both keymaps,
7890 the lookup will only find `item'. */
7891 item = Fcons (item, KEYMAPP (item) && KEYMAPP (XCAR (old)) ? old : Qnil);
7892 XVECTOR (menu_bar_items_vector)->contents[i + 2] = item;
7896 /* This is used as the handler when calling menu_item_eval_property. */
7897 static Lisp_Object
7898 menu_item_eval_property_1 (arg)
7899 Lisp_Object arg;
7901 /* If we got a quit from within the menu computation,
7902 quit all the way out of it. This takes care of C-] in the debugger. */
7903 if (CONSP (arg) && EQ (XCAR (arg), Qquit))
7904 Fsignal (Qquit, Qnil);
7906 return Qnil;
7909 /* Evaluate an expression and return the result (or nil if something
7910 went wrong). Used to evaluate dynamic parts of menu items. */
7911 Lisp_Object
7912 menu_item_eval_property (sexpr)
7913 Lisp_Object sexpr;
7915 int count = SPECPDL_INDEX ();
7916 Lisp_Object val;
7917 specbind (Qinhibit_redisplay, Qt);
7918 val = internal_condition_case_1 (Feval, sexpr, Qerror,
7919 menu_item_eval_property_1);
7920 return unbind_to (count, val);
7923 /* This function parses a menu item and leaves the result in the
7924 vector item_properties.
7925 ITEM is a key binding, a possible menu item.
7926 INMENUBAR is > 0 when this is considered for an entry in a menu bar
7927 top level.
7928 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
7929 parse_menu_item returns true if the item is a menu item and false
7930 otherwise. */
7933 parse_menu_item (item, inmenubar)
7934 Lisp_Object item;
7935 int inmenubar;
7937 Lisp_Object def, tem, item_string, start;
7938 Lisp_Object filter;
7939 Lisp_Object keyhint;
7940 int i;
7942 filter = Qnil;
7943 keyhint = Qnil;
7945 if (!CONSP (item))
7946 return 0;
7948 /* Create item_properties vector if necessary. */
7949 if (NILP (item_properties))
7950 item_properties
7951 = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
7953 /* Initialize optional entries. */
7954 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
7955 ASET (item_properties, i, Qnil);
7956 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7958 /* Save the item here to protect it from GC. */
7959 ASET (item_properties, ITEM_PROPERTY_ITEM, item);
7961 item_string = XCAR (item);
7963 start = item;
7964 item = XCDR (item);
7965 if (STRINGP (item_string))
7967 /* Old format menu item. */
7968 ASET (item_properties, ITEM_PROPERTY_NAME, item_string);
7970 /* Maybe help string. */
7971 if (CONSP (item) && STRINGP (XCAR (item)))
7973 ASET (item_properties, ITEM_PROPERTY_HELP, XCAR (item));
7974 start = item;
7975 item = XCDR (item);
7978 /* Maybe an obsolete key binding cache. */
7979 if (CONSP (item) && CONSP (XCAR (item))
7980 && (NILP (XCAR (XCAR (item)))
7981 || VECTORP (XCAR (XCAR (item)))))
7982 item = XCDR (item);
7984 /* This is the real definition--the function to run. */
7985 ASET (item_properties, ITEM_PROPERTY_DEF, item);
7987 /* Get enable property, if any. */
7988 if (SYMBOLP (item))
7990 tem = Fget (item, Qmenu_enable);
7991 if (!NILP (Venable_disabled_menus_and_buttons))
7992 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7993 else if (!NILP (tem))
7994 ASET (item_properties, ITEM_PROPERTY_ENABLE, tem);
7997 else if (EQ (item_string, Qmenu_item) && CONSP (item))
7999 /* New format menu item. */
8000 ASET (item_properties, ITEM_PROPERTY_NAME, XCAR (item));
8001 start = XCDR (item);
8002 if (CONSP (start))
8004 /* We have a real binding. */
8005 ASET (item_properties, ITEM_PROPERTY_DEF, XCAR (start));
8007 item = XCDR (start);
8008 /* Is there an obsolete cache list with key equivalences. */
8009 if (CONSP (item) && CONSP (XCAR (item)))
8010 item = XCDR (item);
8012 /* Parse properties. */
8013 while (CONSP (item) && CONSP (XCDR (item)))
8015 tem = XCAR (item);
8016 item = XCDR (item);
8018 if (EQ (tem, QCenable))
8020 if (!NILP (Venable_disabled_menus_and_buttons))
8021 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
8022 else
8023 ASET (item_properties, ITEM_PROPERTY_ENABLE, XCAR (item));
8025 else if (EQ (tem, QCvisible))
8027 /* If got a visible property and that evaluates to nil
8028 then ignore this item. */
8029 tem = menu_item_eval_property (XCAR (item));
8030 if (NILP (tem))
8031 return 0;
8033 else if (EQ (tem, QChelp))
8034 ASET (item_properties, ITEM_PROPERTY_HELP, XCAR (item));
8035 else if (EQ (tem, QCfilter))
8036 filter = item;
8037 else if (EQ (tem, QCkey_sequence))
8039 tem = XCAR (item);
8040 if (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem))
8041 /* Be GC protected. Set keyhint to item instead of tem. */
8042 keyhint = item;
8044 else if (EQ (tem, QCkeys))
8046 tem = XCAR (item);
8047 if (CONSP (tem) || STRINGP (tem))
8048 ASET (item_properties, ITEM_PROPERTY_KEYEQ, tem);
8050 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
8052 Lisp_Object type;
8053 tem = XCAR (item);
8054 type = XCAR (tem);
8055 if (EQ (type, QCtoggle) || EQ (type, QCradio))
8057 ASET (item_properties, ITEM_PROPERTY_SELECTED,
8058 XCDR (tem));
8059 ASET (item_properties, ITEM_PROPERTY_TYPE, type);
8062 item = XCDR (item);
8065 else if (inmenubar || !NILP (start))
8066 return 0;
8068 else
8069 return 0; /* not a menu item */
8071 /* If item string is not a string, evaluate it to get string.
8072 If we don't get a string, skip this item. */
8073 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
8074 if (!(STRINGP (item_string)))
8076 item_string = menu_item_eval_property (item_string);
8077 if (!STRINGP (item_string))
8078 return 0;
8079 ASET (item_properties, ITEM_PROPERTY_NAME, item_string);
8082 /* If got a filter apply it on definition. */
8083 def = AREF (item_properties, ITEM_PROPERTY_DEF);
8084 if (!NILP (filter))
8086 def = menu_item_eval_property (list2 (XCAR (filter),
8087 list2 (Qquote, def)));
8089 ASET (item_properties, ITEM_PROPERTY_DEF, def);
8092 /* Enable or disable selection of item. */
8093 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
8094 if (!EQ (tem, Qt))
8096 tem = menu_item_eval_property (tem);
8097 if (inmenubar && NILP (tem))
8098 return 0; /* Ignore disabled items in menu bar. */
8099 ASET (item_properties, ITEM_PROPERTY_ENABLE, tem);
8102 /* If we got no definition, this item is just unselectable text which
8103 is OK in a submenu but not in the menubar. */
8104 if (NILP (def))
8105 return (inmenubar ? 0 : 1);
8107 /* See if this is a separate pane or a submenu. */
8108 def = AREF (item_properties, ITEM_PROPERTY_DEF);
8109 tem = get_keymap (def, 0, 1);
8110 /* For a subkeymap, just record its details and exit. */
8111 if (CONSP (tem))
8113 ASET (item_properties, ITEM_PROPERTY_MAP, tem);
8114 ASET (item_properties, ITEM_PROPERTY_DEF, tem);
8115 return 1;
8118 /* At the top level in the menu bar, do likewise for commands also.
8119 The menu bar does not display equivalent key bindings anyway.
8120 ITEM_PROPERTY_DEF is already set up properly. */
8121 if (inmenubar > 0)
8122 return 1;
8124 { /* This is a command. See if there is an equivalent key binding. */
8125 Lisp_Object keyeq = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
8127 /* The previous code preferred :key-sequence to :keys, so we
8128 preserve this behavior. */
8129 if (STRINGP (keyeq) && !CONSP (keyhint))
8130 keyeq = Fsubstitute_command_keys (keyeq);
8131 else
8133 Lisp_Object prefix = keyeq;
8134 Lisp_Object keys = Qnil;
8136 if (CONSP (prefix))
8138 def = XCAR (prefix);
8139 prefix = XCDR (prefix);
8141 else
8142 def = AREF (item_properties, ITEM_PROPERTY_DEF);
8144 if (CONSP (keyhint) && !NILP (XCAR (keyhint)))
8146 keys = XCAR (keyhint);
8147 tem = Fkey_binding (keys, Qnil, Qnil, Qnil);
8149 /* We have a suggested key. Is it bound to the command? */
8150 if (NILP (tem)
8151 || (!EQ (tem, def)
8152 /* If the command is an alias for another
8153 (such as lmenu.el set it up), check if the
8154 original command matches the cached command. */
8155 && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))))
8156 keys = Qnil;
8159 if (NILP (keys))
8160 keys = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qnil);
8162 if (!NILP (keys))
8164 tem = Fkey_description (keys, Qnil);
8165 if (CONSP (prefix))
8167 if (STRINGP (XCAR (prefix)))
8168 tem = concat2 (XCAR (prefix), tem);
8169 if (STRINGP (XCDR (prefix)))
8170 tem = concat2 (tem, XCDR (prefix));
8172 keyeq = concat2 (build_string (" "), tem);
8173 /* keyeq = concat3(build_string(" ("),tem,build_string(")")); */
8175 else
8176 keyeq = Qnil;
8179 /* If we have an equivalent key binding, use that. */
8180 ASET (item_properties, ITEM_PROPERTY_KEYEQ, keyeq);
8183 /* Include this when menu help is implemented.
8184 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
8185 if (!(NILP (tem) || STRINGP (tem)))
8187 tem = menu_item_eval_property (tem);
8188 if (!STRINGP (tem))
8189 tem = Qnil;
8190 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
8194 /* Handle radio buttons or toggle boxes. */
8195 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
8196 if (!NILP (tem))
8197 ASET (item_properties, ITEM_PROPERTY_SELECTED,
8198 menu_item_eval_property (tem));
8200 return 1;
8205 /***********************************************************************
8206 Tool-bars
8207 ***********************************************************************/
8209 /* A vector holding tool bar items while they are parsed in function
8210 tool_bar_items. Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
8211 in the vector. */
8213 static Lisp_Object tool_bar_items_vector;
8215 /* A vector holding the result of parse_tool_bar_item. Layout is like
8216 the one for a single item in tool_bar_items_vector. */
8218 static Lisp_Object tool_bar_item_properties;
8220 /* Next free index in tool_bar_items_vector. */
8222 static int ntool_bar_items;
8224 /* The symbols `tool-bar', `:image' and `:rtl'. */
8226 extern Lisp_Object Qtool_bar;
8227 Lisp_Object QCimage;
8228 Lisp_Object Qrtl;
8230 /* Function prototypes. */
8232 static void init_tool_bar_items P_ ((Lisp_Object));
8233 static void process_tool_bar_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object, void*));
8234 static int parse_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
8235 static void append_tool_bar_item P_ ((void));
8238 /* Return a vector of tool bar items for keymaps currently in effect.
8239 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
8240 tool bar items found. */
8242 Lisp_Object
8243 tool_bar_items (reuse, nitems)
8244 Lisp_Object reuse;
8245 int *nitems;
8247 Lisp_Object *maps;
8248 int nmaps, i;
8249 Lisp_Object oquit;
8250 Lisp_Object *tmaps;
8252 *nitems = 0;
8254 /* In order to build the menus, we need to call the keymap
8255 accessors. They all call QUIT. But this function is called
8256 during redisplay, during which a quit is fatal. So inhibit
8257 quitting while building the menus. We do this instead of
8258 specbind because (1) errors will clear it anyway and (2) this
8259 avoids risk of specpdl overflow. */
8260 oquit = Vinhibit_quit;
8261 Vinhibit_quit = Qt;
8263 /* Initialize tool_bar_items_vector and protect it from GC. */
8264 init_tool_bar_items (reuse);
8266 /* Build list of keymaps in maps. Set nmaps to the number of maps
8267 to process. */
8269 /* Should overriding-terminal-local-map and overriding-local-map apply? */
8270 if (!NILP (Voverriding_local_map_menu_flag))
8272 /* Yes, use them (if non-nil) as well as the global map. */
8273 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
8274 nmaps = 0;
8275 if (!NILP (current_kboard->Voverriding_terminal_local_map))
8276 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
8277 if (!NILP (Voverriding_local_map))
8278 maps[nmaps++] = Voverriding_local_map;
8280 else
8282 /* No, so use major and minor mode keymaps and keymap property.
8283 Note that tool-bar bindings in the local-map and keymap
8284 properties may not work reliable, as they are only
8285 recognized when the tool-bar (or mode-line) is updated,
8286 which does not normally happen after every command. */
8287 Lisp_Object tem;
8288 int nminor;
8289 nminor = current_minor_maps (NULL, &tmaps);
8290 maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
8291 nmaps = 0;
8292 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
8293 maps[nmaps++] = tem;
8294 bcopy (tmaps, (void *) (maps + nmaps), nminor * sizeof (maps[0]));
8295 nmaps += nminor;
8296 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
8299 /* Add global keymap at the end. */
8300 maps[nmaps++] = current_global_map;
8302 /* Process maps in reverse order and look up in each map the prefix
8303 key `tool-bar'. */
8304 for (i = nmaps - 1; i >= 0; --i)
8305 if (!NILP (maps[i]))
8307 Lisp_Object keymap;
8309 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
8310 if (CONSP (keymap))
8311 map_keymap (keymap, process_tool_bar_item, Qnil, NULL, 1);
8314 Vinhibit_quit = oquit;
8315 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
8316 return tool_bar_items_vector;
8320 /* Process the definition of KEY which is DEF. */
8322 static void
8323 process_tool_bar_item (key, def, data, args)
8324 Lisp_Object key, def, data;
8325 void *args;
8327 int i;
8328 extern Lisp_Object Qundefined;
8329 struct gcpro gcpro1, gcpro2;
8331 /* Protect KEY and DEF from GC because parse_tool_bar_item may call
8332 eval. */
8333 GCPRO2 (key, def);
8335 if (EQ (def, Qundefined))
8337 /* If a map has an explicit `undefined' as definition,
8338 discard any previously made item. */
8339 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
8341 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
8343 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
8345 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
8346 bcopy (v + TOOL_BAR_ITEM_NSLOTS, v,
8347 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
8348 * sizeof (Lisp_Object)));
8349 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
8350 break;
8354 else if (parse_tool_bar_item (key, def))
8355 /* Append a new tool bar item to tool_bar_items_vector. Accept
8356 more than one definition for the same key. */
8357 append_tool_bar_item ();
8359 UNGCPRO;
8363 /* Parse a tool bar item specification ITEM for key KEY and return the
8364 result in tool_bar_item_properties. Value is zero if ITEM is
8365 invalid.
8367 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
8369 CAPTION is the caption of the item, If it's not a string, it is
8370 evaluated to get a string.
8372 BINDING is the tool bar item's binding. Tool-bar items with keymaps
8373 as binding are currently ignored.
8375 The following properties are recognized:
8377 - `:enable FORM'.
8379 FORM is evaluated and specifies whether the tool bar item is
8380 enabled or disabled.
8382 - `:visible FORM'
8384 FORM is evaluated and specifies whether the tool bar item is visible.
8386 - `:filter FUNCTION'
8388 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
8389 result is stored as the new binding.
8391 - `:button (TYPE SELECTED)'
8393 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
8394 and specifies whether the button is selected (pressed) or not.
8396 - `:image IMAGES'
8398 IMAGES is either a single image specification or a vector of four
8399 image specifications. See enum tool_bar_item_images.
8401 - `:help HELP-STRING'.
8403 Gives a help string to display for the tool bar item. */
8405 static int
8406 parse_tool_bar_item (key, item)
8407 Lisp_Object key, item;
8409 /* Access slot with index IDX of vector tool_bar_item_properties. */
8410 #define PROP(IDX) XVECTOR (tool_bar_item_properties)->contents[IDX]
8412 Lisp_Object filter = Qnil;
8413 Lisp_Object caption;
8414 int i;
8416 /* Defininition looks like `(menu-item CAPTION BINDING PROPS...)'.
8417 Rule out items that aren't lists, don't start with
8418 `menu-item' or whose rest following `tool-bar-item' is not a
8419 list. */
8420 if (!CONSP (item)
8421 || !EQ (XCAR (item), Qmenu_item)
8422 || (item = XCDR (item),
8423 !CONSP (item)))
8424 return 0;
8426 /* Create tool_bar_item_properties vector if necessary. Reset it to
8427 defaults. */
8428 if (VECTORP (tool_bar_item_properties))
8430 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
8431 PROP (i) = Qnil;
8433 else
8434 tool_bar_item_properties
8435 = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
8437 /* Set defaults. */
8438 PROP (TOOL_BAR_ITEM_KEY) = key;
8439 PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
8441 /* Get the caption of the item. If the caption is not a string,
8442 evaluate it to get a string. If we don't get a string, skip this
8443 item. */
8444 caption = XCAR (item);
8445 if (!STRINGP (caption))
8447 caption = menu_item_eval_property (caption);
8448 if (!STRINGP (caption))
8449 return 0;
8451 PROP (TOOL_BAR_ITEM_CAPTION) = caption;
8453 /* Give up if rest following the caption is not a list. */
8454 item = XCDR (item);
8455 if (!CONSP (item))
8456 return 0;
8458 /* Store the binding. */
8459 PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item);
8460 item = XCDR (item);
8462 /* Ignore cached key binding, if any. */
8463 if (CONSP (item) && CONSP (XCAR (item)))
8464 item = XCDR (item);
8466 /* Process the rest of the properties. */
8467 for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
8469 Lisp_Object key, value;
8471 key = XCAR (item);
8472 value = XCAR (XCDR (item));
8474 if (EQ (key, QCenable))
8476 /* `:enable FORM'. */
8477 if (!NILP (Venable_disabled_menus_and_buttons))
8478 PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
8479 else
8480 PROP (TOOL_BAR_ITEM_ENABLED_P) = value;
8482 else if (EQ (key, QCvisible))
8484 /* `:visible FORM'. If got a visible property and that
8485 evaluates to nil then ignore this item. */
8486 if (NILP (menu_item_eval_property (value)))
8487 return 0;
8489 else if (EQ (key, QChelp))
8490 /* `:help HELP-STRING'. */
8491 PROP (TOOL_BAR_ITEM_HELP) = value;
8492 else if (EQ (key, QCfilter))
8493 /* ':filter FORM'. */
8494 filter = value;
8495 else if (EQ (key, QCbutton) && CONSP (value))
8497 /* `:button (TYPE . SELECTED)'. */
8498 Lisp_Object type, selected;
8500 type = XCAR (value);
8501 selected = XCDR (value);
8502 if (EQ (type, QCtoggle) || EQ (type, QCradio))
8504 PROP (TOOL_BAR_ITEM_SELECTED_P) = selected;
8505 PROP (TOOL_BAR_ITEM_TYPE) = type;
8508 else if (EQ (key, QCimage)
8509 && (CONSP (value)
8510 || (VECTORP (value) && XVECTOR (value)->size == 4)))
8511 /* Value is either a single image specification or a vector
8512 of 4 such specifications for the different button states. */
8513 PROP (TOOL_BAR_ITEM_IMAGES) = value;
8514 else if (EQ (key, Qrtl))
8515 /* ':rtl STRING' */
8516 PROP (TOOL_BAR_ITEM_RTL_IMAGE) = value;
8519 /* If got a filter apply it on binding. */
8520 if (!NILP (filter))
8521 PROP (TOOL_BAR_ITEM_BINDING)
8522 = menu_item_eval_property (list2 (filter,
8523 list2 (Qquote,
8524 PROP (TOOL_BAR_ITEM_BINDING))));
8526 /* See if the binding is a keymap. Give up if it is. */
8527 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
8528 return 0;
8530 /* Enable or disable selection of item. */
8531 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
8532 PROP (TOOL_BAR_ITEM_ENABLED_P)
8533 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P));
8535 /* Handle radio buttons or toggle boxes. */
8536 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
8537 PROP (TOOL_BAR_ITEM_SELECTED_P)
8538 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P));
8540 return 1;
8542 #undef PROP
8546 /* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
8547 that can be reused. */
8549 static void
8550 init_tool_bar_items (reuse)
8551 Lisp_Object reuse;
8553 if (VECTORP (reuse))
8554 tool_bar_items_vector = reuse;
8555 else
8556 tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
8557 ntool_bar_items = 0;
8561 /* Append parsed tool bar item properties from
8562 tool_bar_item_properties */
8564 static void
8565 append_tool_bar_item ()
8567 Lisp_Object *to, *from;
8569 /* Enlarge tool_bar_items_vector if necessary. */
8570 if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
8571 >= XVECTOR (tool_bar_items_vector)->size)
8572 tool_bar_items_vector
8573 = larger_vector (tool_bar_items_vector,
8574 2 * XVECTOR (tool_bar_items_vector)->size, Qnil);
8576 /* Append entries from tool_bar_item_properties to the end of
8577 tool_bar_items_vector. */
8578 to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
8579 from = XVECTOR (tool_bar_item_properties)->contents;
8580 bcopy (from, to, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
8581 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
8588 /* Read a character using menus based on maps in the array MAPS.
8589 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
8590 Return t if we displayed a menu but the user rejected it.
8592 PREV_EVENT is the previous input event, or nil if we are reading
8593 the first event of a key sequence.
8595 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
8596 if we used a mouse menu to read the input, or zero otherwise. If
8597 USED_MOUSE_MENU is null, we don't dereference it.
8599 The prompting is done based on the prompt-string of the map
8600 and the strings associated with various map elements.
8602 This can be done with X menus or with menus put in the minibuf.
8603 These are done in different ways, depending on how the input will be read.
8604 Menus using X are done after auto-saving in read-char, getting the input
8605 event from Fx_popup_menu; menus using the minibuf use read_char recursively
8606 and do auto-saving in the inner call of read_char. */
8608 static Lisp_Object
8609 read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
8610 int nmaps;
8611 Lisp_Object *maps;
8612 Lisp_Object prev_event;
8613 int *used_mouse_menu;
8615 int mapno;
8617 if (used_mouse_menu)
8618 *used_mouse_menu = 0;
8620 /* Use local over global Menu maps */
8622 if (! menu_prompting)
8623 return Qnil;
8625 /* Optionally disregard all but the global map. */
8626 if (inhibit_local_menu_bar_menus)
8628 maps += (nmaps - 1);
8629 nmaps = 1;
8632 #ifdef HAVE_MENUS
8633 /* If we got to this point via a mouse click,
8634 use a real menu for mouse selection. */
8635 if (EVENT_HAS_PARAMETERS (prev_event)
8636 && !EQ (XCAR (prev_event), Qmenu_bar)
8637 && !EQ (XCAR (prev_event), Qtool_bar))
8639 /* Display the menu and get the selection. */
8640 Lisp_Object *realmaps
8641 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
8642 Lisp_Object value;
8643 int nmaps1 = 0;
8645 /* Use the maps that are not nil. */
8646 for (mapno = 0; mapno < nmaps; mapno++)
8647 if (!NILP (maps[mapno]))
8648 realmaps[nmaps1++] = maps[mapno];
8650 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
8651 if (CONSP (value))
8653 Lisp_Object tem;
8655 record_menu_key (XCAR (value));
8657 /* If we got multiple events, unread all but
8658 the first.
8659 There is no way to prevent those unread events
8660 from showing up later in last_nonmenu_event.
8661 So turn symbol and integer events into lists,
8662 to indicate that they came from a mouse menu,
8663 so that when present in last_nonmenu_event
8664 they won't confuse things. */
8665 for (tem = XCDR (value); CONSP (tem); tem = XCDR (tem))
8667 record_menu_key (XCAR (tem));
8668 if (SYMBOLP (XCAR (tem))
8669 || INTEGERP (XCAR (tem)))
8670 XSETCAR (tem, Fcons (XCAR (tem), Qdisabled));
8673 /* If we got more than one event, put all but the first
8674 onto this list to be read later.
8675 Return just the first event now. */
8676 Vunread_command_events
8677 = nconc2 (XCDR (value), Vunread_command_events);
8678 value = XCAR (value);
8680 else if (NILP (value))
8681 value = Qt;
8682 if (used_mouse_menu)
8683 *used_mouse_menu = 1;
8684 return value;
8686 #endif /* HAVE_MENUS */
8687 return Qnil ;
8690 /* Buffer in use so far for the minibuf prompts for menu keymaps.
8691 We make this bigger when necessary, and never free it. */
8692 static char *read_char_minibuf_menu_text;
8693 /* Size of that buffer. */
8694 static int read_char_minibuf_menu_width;
8696 static Lisp_Object
8697 read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
8698 int commandflag ;
8699 int nmaps;
8700 Lisp_Object *maps;
8702 int mapno;
8703 register Lisp_Object name;
8704 int nlength;
8705 /* FIXME: Use the minibuffer's frame width. */
8706 int width = FRAME_COLS (SELECTED_FRAME ()) - 4;
8707 int idx = -1;
8708 int nobindings = 1;
8709 Lisp_Object rest, vector;
8710 char *menu;
8712 vector = Qnil;
8713 name = Qnil;
8715 if (! menu_prompting)
8716 return Qnil;
8718 /* Get the menu name from the first map that has one (a prompt string). */
8719 for (mapno = 0; mapno < nmaps; mapno++)
8721 name = Fkeymap_prompt (maps[mapno]);
8722 if (!NILP (name))
8723 break;
8726 /* If we don't have any menus, just read a character normally. */
8727 if (!STRINGP (name))
8728 return Qnil;
8730 /* Make sure we have a big enough buffer for the menu text. */
8731 width = max (width, SBYTES (name));
8732 if (read_char_minibuf_menu_text == 0)
8734 read_char_minibuf_menu_width = width + 4;
8735 read_char_minibuf_menu_text = (char *) xmalloc (width + 4);
8737 else if (width + 4 > read_char_minibuf_menu_width)
8739 read_char_minibuf_menu_width = width + 4;
8740 read_char_minibuf_menu_text
8741 = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
8743 menu = read_char_minibuf_menu_text;
8745 /* Prompt string always starts with map's prompt, and a space. */
8746 strcpy (menu, SDATA (name));
8747 nlength = SBYTES (name);
8748 menu[nlength++] = ':';
8749 menu[nlength++] = ' ';
8750 menu[nlength] = 0;
8752 /* Start prompting at start of first map. */
8753 mapno = 0;
8754 rest = maps[mapno];
8756 /* Present the documented bindings, a line at a time. */
8757 while (1)
8759 int notfirst = 0;
8760 int i = nlength;
8761 Lisp_Object obj;
8762 int ch;
8763 Lisp_Object orig_defn_macro;
8765 /* Loop over elements of map. */
8766 while (i < width)
8768 Lisp_Object elt;
8770 /* If reached end of map, start at beginning of next map. */
8771 if (NILP (rest))
8773 mapno++;
8774 /* At end of last map, wrap around to first map if just starting,
8775 or end this line if already have something on it. */
8776 if (mapno == nmaps)
8778 mapno = 0;
8779 if (notfirst || nobindings) break;
8781 rest = maps[mapno];
8784 /* Look at the next element of the map. */
8785 if (idx >= 0)
8786 elt = XVECTOR (vector)->contents[idx];
8787 else
8788 elt = Fcar_safe (rest);
8790 if (idx < 0 && VECTORP (elt))
8792 /* If we found a dense table in the keymap,
8793 advanced past it, but start scanning its contents. */
8794 rest = Fcdr_safe (rest);
8795 vector = elt;
8796 idx = 0;
8798 else
8800 /* An ordinary element. */
8801 Lisp_Object event, tem;
8803 if (idx < 0)
8805 event = Fcar_safe (elt); /* alist */
8806 elt = Fcdr_safe (elt);
8808 else
8810 XSETINT (event, idx); /* vector */
8813 /* Ignore the element if it has no prompt string. */
8814 if (INTEGERP (event) && parse_menu_item (elt, -1))
8816 /* 1 if the char to type matches the string. */
8817 int char_matches;
8818 Lisp_Object upcased_event, downcased_event;
8819 Lisp_Object desc = Qnil;
8820 Lisp_Object s
8821 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
8823 upcased_event = Fupcase (event);
8824 downcased_event = Fdowncase (event);
8825 char_matches = (XINT (upcased_event) == SREF (s, 0)
8826 || XINT (downcased_event) == SREF (s, 0));
8827 if (! char_matches)
8828 desc = Fsingle_key_description (event, Qnil);
8830 #if 0 /* It is redundant to list the equivalent key bindings because
8831 the prefix is what the user has already typed. */
8833 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
8834 if (!NILP (tem))
8835 /* Insert equivalent keybinding. */
8836 s = concat2 (s, tem);
8837 #endif
8839 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
8840 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
8842 /* Insert button prefix. */
8843 Lisp_Object selected
8844 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
8845 if (EQ (tem, QCradio))
8846 tem = build_string (NILP (selected) ? "(*) " : "( ) ");
8847 else
8848 tem = build_string (NILP (selected) ? "[X] " : "[ ] ");
8849 s = concat2 (tem, s);
8853 /* If we have room for the prompt string, add it to this line.
8854 If this is the first on the line, always add it. */
8855 if ((SCHARS (s) + i + 2
8856 + (char_matches ? 0 : SCHARS (desc) + 3))
8857 < width
8858 || !notfirst)
8860 int thiswidth;
8862 /* Punctuate between strings. */
8863 if (notfirst)
8865 strcpy (menu + i, ", ");
8866 i += 2;
8868 notfirst = 1;
8869 nobindings = 0 ;
8871 /* If the char to type doesn't match the string's
8872 first char, explicitly show what char to type. */
8873 if (! char_matches)
8875 /* Add as much of string as fits. */
8876 thiswidth = SCHARS (desc);
8877 if (thiswidth + i > width)
8878 thiswidth = width - i;
8879 bcopy (SDATA (desc), menu + i, thiswidth);
8880 i += thiswidth;
8881 strcpy (menu + i, " = ");
8882 i += 3;
8885 /* Add as much of string as fits. */
8886 thiswidth = SCHARS (s);
8887 if (thiswidth + i > width)
8888 thiswidth = width - i;
8889 bcopy (SDATA (s), menu + i, thiswidth);
8890 i += thiswidth;
8891 menu[i] = 0;
8893 else
8895 /* If this element does not fit, end the line now,
8896 and save the element for the next line. */
8897 strcpy (menu + i, "...");
8898 break;
8902 /* Move past this element. */
8903 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
8904 /* Handle reaching end of dense table. */
8905 idx = -1;
8906 if (idx >= 0)
8907 idx++;
8908 else
8909 rest = Fcdr_safe (rest);
8913 /* Prompt with that and read response. */
8914 message2_nolog (menu, strlen (menu),
8915 ! NILP (BUF_ENABLE_MULTIBYTE_CHARACTERS (current_buffer)));
8917 /* Make believe its not a keyboard macro in case the help char
8918 is pressed. Help characters are not recorded because menu prompting
8919 is not used on replay.
8921 orig_defn_macro = current_kboard->defining_kbd_macro;
8922 current_kboard->defining_kbd_macro = Qnil;
8924 obj = read_char (commandflag, 0, 0, Qt, 0, NULL);
8925 while (BUFFERP (obj));
8926 current_kboard->defining_kbd_macro = orig_defn_macro;
8928 if (!INTEGERP (obj))
8929 return obj;
8930 else if (XINT (obj) == -2)
8931 return obj;
8932 else
8933 ch = XINT (obj);
8935 if (! EQ (obj, menu_prompt_more_char)
8936 && (!INTEGERP (menu_prompt_more_char)
8937 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
8939 if (!NILP (current_kboard->defining_kbd_macro))
8940 store_kbd_macro_char (obj);
8941 return obj;
8943 /* Help char - go round again */
8947 /* Reading key sequences. */
8949 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
8950 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
8951 keymap, or nil otherwise. Return the index of the first keymap in
8952 which KEY has any binding, or NMAPS if no map has a binding.
8954 If KEY is a meta ASCII character, treat it like meta-prefix-char
8955 followed by the corresponding non-meta character. Keymaps in
8956 CURRENT with non-prefix bindings for meta-prefix-char become nil in
8957 NEXT.
8959 If KEY has no bindings in any of the CURRENT maps, NEXT is left
8960 unmodified.
8962 NEXT may be the same array as CURRENT. */
8964 static int
8965 follow_key (key, nmaps, current, defs, next)
8966 Lisp_Object key;
8967 Lisp_Object *current, *defs, *next;
8968 int nmaps;
8970 int i, first_binding;
8972 first_binding = nmaps;
8973 for (i = nmaps - 1; i >= 0; i--)
8975 if (! NILP (current[i]))
8977 defs[i] = access_keymap (current[i], key, 1, 0, 1);
8978 if (! NILP (defs[i]))
8979 first_binding = i;
8981 else
8982 defs[i] = Qnil;
8985 /* Given the set of bindings we've found, produce the next set of maps. */
8986 if (first_binding < nmaps)
8987 for (i = 0; i < nmaps; i++)
8988 next[i] = NILP (defs[i]) ? Qnil : get_keymap (defs[i], 0, 1);
8990 return first_binding;
8993 /* Structure used to keep track of partial application of key remapping
8994 such as Vfunction_key_map and Vkey_translation_map. */
8995 typedef struct keyremap
8997 /* This is the map originally specified for this use. */
8998 Lisp_Object parent;
8999 /* This is a submap reached by looking up, in PARENT,
9000 the events from START to END. */
9001 Lisp_Object map;
9002 /* Positions [START, END) in the key sequence buffer
9003 are the key that we have scanned so far.
9004 Those events are the ones that we will replace
9005 if PAREHT maps them into a key sequence. */
9006 int start, end;
9007 } keyremap;
9009 /* Lookup KEY in MAP.
9010 MAP is a keymap mapping keys to key vectors or functions.
9011 If the mapping is a function and DO_FUNCTION is non-zero, then
9012 the function is called with PROMPT as parameter and its return
9013 value is used as the return value of this function (after checking
9014 that it is indeed a vector). */
9016 static Lisp_Object
9017 access_keymap_keyremap (map, key, prompt, do_funcall)
9018 Lisp_Object map, key, prompt;
9019 int do_funcall;
9021 Lisp_Object next;
9023 next = access_keymap (map, key, 1, 0, 1);
9025 /* Handle symbol with autoload definition. */
9026 if (SYMBOLP (next) && !NILP (Ffboundp (next))
9027 && CONSP (XSYMBOL (next)->function)
9028 && EQ (XCAR (XSYMBOL (next)->function), Qautoload))
9029 do_autoload (XSYMBOL (next)->function, next);
9031 /* Handle a symbol whose function definition is a keymap
9032 or an array. */
9033 if (SYMBOLP (next) && !NILP (Ffboundp (next))
9034 && (ARRAYP (XSYMBOL (next)->function)
9035 || KEYMAPP (XSYMBOL (next)->function)))
9036 next = XSYMBOL (next)->function;
9038 /* If the keymap gives a function, not an
9039 array, then call the function with one arg and use
9040 its value instead. */
9041 if (SYMBOLP (next) && !NILP (Ffboundp (next)) && do_funcall)
9043 Lisp_Object tem;
9044 tem = next;
9046 next = call1 (next, prompt);
9047 /* If the function returned something invalid,
9048 barf--don't ignore it.
9049 (To ignore it safely, we would need to gcpro a bunch of
9050 other variables.) */
9051 if (! (VECTORP (next) || STRINGP (next)))
9052 error ("Function %s returns invalid key sequence", tem);
9054 return next;
9057 /* Do one step of the key remapping used for function-key-map and
9058 key-translation-map:
9059 KEYBUF is the buffer holding the input events.
9060 BUFSIZE is its maximum size.
9061 FKEY is a pointer to the keyremap structure to use.
9062 INPUT is the index of the last element in KEYBUF.
9063 DOIT if non-zero says that the remapping can actually take place.
9064 DIFF is used to return the number of keys added/removed by the remapping.
9065 PARENT is the root of the keymap.
9066 PROMPT is the prompt to use if the remapping happens through a function.
9067 The return value is non-zero if the remapping actually took place. */
9069 static int
9070 keyremap_step (keybuf, bufsize, fkey, input, doit, diff, prompt)
9071 Lisp_Object *keybuf, prompt;
9072 keyremap *fkey;
9073 int input, doit, *diff, bufsize;
9075 Lisp_Object next, key;
9077 key = keybuf[fkey->end++];
9079 if (KEYMAPP (fkey->parent))
9080 next = access_keymap_keyremap (fkey->map, key, prompt, doit);
9081 else
9082 next = Qnil;
9084 /* If keybuf[fkey->start..fkey->end] is bound in the
9085 map and we're in a position to do the key remapping, replace it with
9086 the binding and restart with fkey->start at the end. */
9087 if ((VECTORP (next) || STRINGP (next)) && doit)
9089 int len = XFASTINT (Flength (next));
9090 int i;
9092 *diff = len - (fkey->end - fkey->start);
9094 if (input + *diff >= bufsize)
9095 error ("Key sequence too long");
9097 /* Shift the keys that follow fkey->end. */
9098 if (*diff < 0)
9099 for (i = fkey->end; i < input; i++)
9100 keybuf[i + *diff] = keybuf[i];
9101 else if (*diff > 0)
9102 for (i = input - 1; i >= fkey->end; i--)
9103 keybuf[i + *diff] = keybuf[i];
9104 /* Overwrite the old keys with the new ones. */
9105 for (i = 0; i < len; i++)
9106 keybuf[fkey->start + i]
9107 = Faref (next, make_number (i));
9109 fkey->start = fkey->end += *diff;
9110 fkey->map = fkey->parent;
9112 return 1;
9115 fkey->map = get_keymap (next, 0, 1);
9117 /* If we no longer have a bound suffix, try a new position for
9118 fkey->start. */
9119 if (!CONSP (fkey->map))
9121 fkey->end = ++fkey->start;
9122 fkey->map = fkey->parent;
9124 return 0;
9127 /* Read a sequence of keys that ends with a non prefix character,
9128 storing it in KEYBUF, a buffer of size BUFSIZE.
9129 Prompt with PROMPT.
9130 Return the length of the key sequence stored.
9131 Return -1 if the user rejected a command menu.
9133 Echo starting immediately unless `prompt' is 0.
9135 Where a key sequence ends depends on the currently active keymaps.
9136 These include any minor mode keymaps active in the current buffer,
9137 the current buffer's local map, and the global map.
9139 If a key sequence has no other bindings, we check Vfunction_key_map
9140 to see if some trailing subsequence might be the beginning of a
9141 function key's sequence. If so, we try to read the whole function
9142 key, and substitute its symbolic name into the key sequence.
9144 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
9145 `double-' events into similar click events, if that would make them
9146 bound. We try to turn `triple-' events first into `double-' events,
9147 then into clicks.
9149 If we get a mouse click in a mode line, vertical divider, or other
9150 non-text area, we treat the click as if it were prefixed by the
9151 symbol denoting that area - `mode-line', `vertical-line', or
9152 whatever.
9154 If the sequence starts with a mouse click, we read the key sequence
9155 with respect to the buffer clicked on, not the current buffer.
9157 If the user switches frames in the midst of a key sequence, we put
9158 off the switch-frame event until later; the next call to
9159 read_char will return it.
9161 If FIX_CURRENT_BUFFER is nonzero, we restore current_buffer
9162 from the selected window's buffer. */
9164 static int
9165 read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
9166 can_return_switch_frame, fix_current_buffer)
9167 Lisp_Object *keybuf;
9168 int bufsize;
9169 Lisp_Object prompt;
9170 int dont_downcase_last;
9171 int can_return_switch_frame;
9172 int fix_current_buffer;
9174 volatile Lisp_Object from_string;
9175 volatile int count = SPECPDL_INDEX ();
9177 /* How many keys there are in the current key sequence. */
9178 volatile int t;
9180 /* The length of the echo buffer when we started reading, and
9181 the length of this_command_keys when we started reading. */
9182 volatile int echo_start;
9183 volatile int keys_start;
9185 /* The number of keymaps we're scanning right now, and the number of
9186 keymaps we have allocated space for. */
9187 volatile int nmaps;
9188 volatile int nmaps_allocated = 0;
9190 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
9191 the current keymaps. */
9192 Lisp_Object *volatile defs = NULL;
9194 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
9195 in the current keymaps, or nil where it is not a prefix. */
9196 Lisp_Object *volatile submaps = NULL;
9198 /* The local map to start out with at start of key sequence. */
9199 volatile Lisp_Object orig_local_map;
9201 /* The map from the `keymap' property to start out with at start of
9202 key sequence. */
9203 volatile Lisp_Object orig_keymap;
9205 /* 1 if we have already considered switching to the local-map property
9206 of the place where a mouse click occurred. */
9207 volatile int localized_local_map = 0;
9209 /* The index in submaps[] of the first keymap that has a binding for
9210 this key sequence. In other words, the lowest i such that
9211 submaps[i] is non-nil. */
9212 volatile int first_binding;
9213 /* Index of the first key that has no binding.
9214 It is useless to try fkey.start larger than that. */
9215 volatile int first_unbound;
9217 /* If t < mock_input, then KEYBUF[t] should be read as the next
9218 input key.
9220 We use this to recover after recognizing a function key. Once we
9221 realize that a suffix of the current key sequence is actually a
9222 function key's escape sequence, we replace the suffix with the
9223 function key's binding from Vfunction_key_map. Now keybuf
9224 contains a new and different key sequence, so the echo area,
9225 this_command_keys, and the submaps and defs arrays are wrong. In
9226 this situation, we set mock_input to t, set t to 0, and jump to
9227 restart_sequence; the loop will read keys from keybuf up until
9228 mock_input, thus rebuilding the state; and then it will resume
9229 reading characters from the keyboard. */
9230 volatile int mock_input = 0;
9232 /* If the sequence is unbound in submaps[], then
9233 keybuf[fkey.start..fkey.end-1] is a prefix in Vfunction_key_map,
9234 and fkey.map is its binding.
9236 These might be > t, indicating that all function key scanning
9237 should hold off until t reaches them. We do this when we've just
9238 recognized a function key, to avoid searching for the function
9239 key's again in Vfunction_key_map. */
9240 volatile keyremap fkey;
9242 /* Likewise, for key_translation_map and input-decode-map. */
9243 volatile keyremap keytran, indec;
9245 /* Non-zero if we are trying to map a key by changing an upper-case
9246 letter to lower case, or a shifted function key to an unshifted
9247 one. */
9248 volatile int shift_translated = 0;
9250 /* If we receive a `switch-frame' or `select-window' event in the middle of
9251 a key sequence, we put it off for later.
9252 While we're reading, we keep the event here. */
9253 volatile Lisp_Object delayed_switch_frame;
9255 /* See the comment below... */
9256 #if defined (GOBBLE_FIRST_EVENT)
9257 Lisp_Object first_event;
9258 #endif
9260 volatile Lisp_Object original_uppercase;
9261 volatile int original_uppercase_position = -1;
9263 /* Gets around Microsoft compiler limitations. */
9264 int dummyflag = 0;
9266 struct buffer *starting_buffer;
9268 /* List of events for which a fake prefix key has been generated. */
9269 volatile Lisp_Object fake_prefixed_keys = Qnil;
9271 #if defined (GOBBLE_FIRST_EVENT)
9272 int junk;
9273 #endif
9275 struct gcpro gcpro1;
9277 GCPRO1 (fake_prefixed_keys);
9278 raw_keybuf_count = 0;
9280 last_nonmenu_event = Qnil;
9282 delayed_switch_frame = Qnil;
9284 if (INTERACTIVE)
9286 if (!NILP (prompt))
9287 echo_prompt (prompt);
9288 else if (cursor_in_echo_area
9289 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
9290 && NILP (Fzerop (Vecho_keystrokes)))
9291 /* This doesn't put in a dash if the echo buffer is empty, so
9292 you don't always see a dash hanging out in the minibuffer. */
9293 echo_dash ();
9296 /* Record the initial state of the echo area and this_command_keys;
9297 we will need to restore them if we replay a key sequence. */
9298 if (INTERACTIVE)
9299 echo_start = echo_length ();
9300 keys_start = this_command_key_count;
9301 this_single_command_key_start = keys_start;
9303 #if defined (GOBBLE_FIRST_EVENT)
9304 /* This doesn't quite work, because some of the things that read_char
9305 does cannot safely be bypassed. It seems too risky to try to make
9306 this work right. */
9308 /* Read the first char of the sequence specially, before setting
9309 up any keymaps, in case a filter runs and switches buffers on us. */
9310 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
9311 &junk, NULL);
9312 #endif /* GOBBLE_FIRST_EVENT */
9314 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
9315 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
9316 from_string = Qnil;
9318 /* We jump here when we need to reinitialize fkey and keytran; this
9319 happens if we switch keyboards between rescans. */
9320 replay_entire_sequence:
9322 indec.map = indec.parent = current_kboard->Vinput_decode_map;
9323 fkey.map = fkey.parent = current_kboard->Vlocal_function_key_map;
9324 keytran.map = keytran.parent = Vkey_translation_map;
9325 indec.start = indec.end = 0;
9326 fkey.start = fkey.end = 0;
9327 keytran.start = keytran.end = 0;
9329 /* We jump here when the key sequence has been thoroughly changed, and
9330 we need to rescan it starting from the beginning. When we jump here,
9331 keybuf[0..mock_input] holds the sequence we should reread. */
9332 replay_sequence:
9334 starting_buffer = current_buffer;
9335 first_unbound = bufsize + 1;
9337 /* Build our list of keymaps.
9338 If we recognize a function key and replace its escape sequence in
9339 keybuf with its symbol, or if the sequence starts with a mouse
9340 click and we need to switch buffers, we jump back here to rebuild
9341 the initial keymaps from the current buffer. */
9342 nmaps = 0;
9344 if (!NILP (current_kboard->Voverriding_terminal_local_map))
9346 if (2 > nmaps_allocated)
9348 submaps = (Lisp_Object *) alloca (2 * sizeof (submaps[0]));
9349 defs = (Lisp_Object *) alloca (2 * sizeof (defs[0]));
9350 nmaps_allocated = 2;
9352 submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
9354 else if (!NILP (Voverriding_local_map))
9356 if (2 > nmaps_allocated)
9358 submaps = (Lisp_Object *) alloca (2 * sizeof (submaps[0]));
9359 defs = (Lisp_Object *) alloca (2 * sizeof (defs[0]));
9360 nmaps_allocated = 2;
9362 submaps[nmaps++] = Voverriding_local_map;
9364 else
9366 int nminor;
9367 int total;
9368 Lisp_Object *maps;
9370 nminor = current_minor_maps (0, &maps);
9371 total = nminor + (!NILP (orig_keymap) ? 3 : 2);
9373 if (total > nmaps_allocated)
9375 submaps = (Lisp_Object *) alloca (total * sizeof (submaps[0]));
9376 defs = (Lisp_Object *) alloca (total * sizeof (defs[0]));
9377 nmaps_allocated = total;
9380 if (!NILP (orig_keymap))
9381 submaps[nmaps++] = orig_keymap;
9383 bcopy (maps, (void *) (submaps + nmaps),
9384 nminor * sizeof (submaps[0]));
9386 nmaps += nminor;
9388 submaps[nmaps++] = orig_local_map;
9390 submaps[nmaps++] = current_global_map;
9392 /* Find an accurate initial value for first_binding. */
9393 for (first_binding = 0; first_binding < nmaps; first_binding++)
9394 if (! NILP (submaps[first_binding]))
9395 break;
9397 /* Start from the beginning in keybuf. */
9398 t = 0;
9400 /* These are no-ops the first time through, but if we restart, they
9401 revert the echo area and this_command_keys to their original state. */
9402 this_command_key_count = keys_start;
9403 if (INTERACTIVE && t < mock_input)
9404 echo_truncate (echo_start);
9406 /* If the best binding for the current key sequence is a keymap, or
9407 we may be looking at a function key's escape sequence, keep on
9408 reading. */
9409 while (first_binding < nmaps
9410 /* Keep reading as long as there's a prefix binding. */
9411 ? !NILP (submaps[first_binding])
9412 /* Don't return in the middle of a possible function key sequence,
9413 if the only bindings we found were via case conversion.
9414 Thus, if ESC O a has a function-key-map translation
9415 and ESC o has a binding, don't return after ESC O,
9416 so that we can translate ESC O plus the next character. */
9417 : (/* indec.start < t || fkey.start < t || */ keytran.start < t))
9419 Lisp_Object key;
9420 int used_mouse_menu = 0;
9422 /* Where the last real key started. If we need to throw away a
9423 key that has expanded into more than one element of keybuf
9424 (say, a mouse click on the mode line which is being treated
9425 as [mode-line (mouse-...)], then we backtrack to this point
9426 of keybuf. */
9427 volatile int last_real_key_start;
9429 /* These variables are analogous to echo_start and keys_start;
9430 while those allow us to restart the entire key sequence,
9431 echo_local_start and keys_local_start allow us to throw away
9432 just one key. */
9433 volatile int echo_local_start, keys_local_start, local_first_binding;
9435 eassert (indec.end == t || (indec.end > t && indec.end <= mock_input));
9436 eassert (indec.start <= indec.end);
9437 eassert (fkey.start <= fkey.end);
9438 eassert (keytran.start <= keytran.end);
9439 /* key-translation-map is applied *after* function-key-map
9440 which is itself applied *after* input-decode-map. */
9441 eassert (fkey.end <= indec.start);
9442 eassert (keytran.end <= fkey.start);
9444 if (/* first_unbound < indec.start && first_unbound < fkey.start && */
9445 first_unbound < keytran.start)
9446 { /* The prefix upto first_unbound has no binding and has
9447 no translation left to do either, so we know it's unbound.
9448 If we don't stop now, we risk staying here indefinitely
9449 (if the user keeps entering fkey or keytran prefixes
9450 like C-c ESC ESC ESC ESC ...) */
9451 int i;
9452 for (i = first_unbound + 1; i < t; i++)
9453 keybuf[i - first_unbound - 1] = keybuf[i];
9454 mock_input = t - first_unbound - 1;
9455 indec.end = indec.start -= first_unbound + 1;
9456 indec.map = indec.parent;
9457 fkey.end = fkey.start -= first_unbound + 1;
9458 fkey.map = fkey.parent;
9459 keytran.end = keytran.start -= first_unbound + 1;
9460 keytran.map = keytran.parent;
9461 goto replay_sequence;
9464 if (t >= bufsize)
9465 error ("Key sequence too long");
9467 if (INTERACTIVE)
9468 echo_local_start = echo_length ();
9469 keys_local_start = this_command_key_count;
9470 local_first_binding = first_binding;
9472 replay_key:
9473 /* These are no-ops, unless we throw away a keystroke below and
9474 jumped back up to replay_key; in that case, these restore the
9475 variables to their original state, allowing us to replay the
9476 loop. */
9477 if (INTERACTIVE && t < mock_input)
9478 echo_truncate (echo_local_start);
9479 this_command_key_count = keys_local_start;
9480 first_binding = local_first_binding;
9482 /* By default, assume each event is "real". */
9483 last_real_key_start = t;
9485 /* Does mock_input indicate that we are re-reading a key sequence? */
9486 if (t < mock_input)
9488 key = keybuf[t];
9489 add_command_key (key);
9490 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
9491 && NILP (Fzerop (Vecho_keystrokes)))
9492 echo_char (key);
9495 /* If not, we should actually read a character. */
9496 else
9499 KBOARD *interrupted_kboard = current_kboard;
9500 struct frame *interrupted_frame = SELECTED_FRAME ();
9501 key = read_char (NILP (prompt), nmaps,
9502 (Lisp_Object *) submaps, last_nonmenu_event,
9503 &used_mouse_menu, NULL);
9504 if ((INTEGERP (key) && XINT (key) == -2) /* wrong_kboard_jmpbuf */
9505 /* When switching to a new tty (with a new keyboard),
9506 read_char returns the new buffer, rather than -2
9507 (Bug#5095). This is because `terminal-init-xterm'
9508 calls read-char, which eats the wrong_kboard_jmpbuf
9509 return. Any better way to fix this? -- cyd */
9510 || (interrupted_kboard != current_kboard))
9512 int found = 0;
9513 struct kboard *k;
9515 for (k = all_kboards; k; k = k->next_kboard)
9516 if (k == interrupted_kboard)
9517 found = 1;
9519 if (!found)
9521 /* Don't touch interrupted_kboard when it's been
9522 deleted. */
9523 delayed_switch_frame = Qnil;
9524 goto replay_entire_sequence;
9527 if (!NILP (delayed_switch_frame))
9529 interrupted_kboard->kbd_queue
9530 = Fcons (delayed_switch_frame,
9531 interrupted_kboard->kbd_queue);
9532 delayed_switch_frame = Qnil;
9535 while (t > 0)
9536 interrupted_kboard->kbd_queue
9537 = Fcons (keybuf[--t], interrupted_kboard->kbd_queue);
9539 /* If the side queue is non-empty, ensure it begins with a
9540 switch-frame, so we'll replay it in the right context. */
9541 if (CONSP (interrupted_kboard->kbd_queue)
9542 && (key = XCAR (interrupted_kboard->kbd_queue),
9543 !(EVENT_HAS_PARAMETERS (key)
9544 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
9545 Qswitch_frame))))
9547 Lisp_Object frame;
9548 XSETFRAME (frame, interrupted_frame);
9549 interrupted_kboard->kbd_queue
9550 = Fcons (make_lispy_switch_frame (frame),
9551 interrupted_kboard->kbd_queue);
9553 mock_input = 0;
9554 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
9555 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
9556 goto replay_entire_sequence;
9560 /* read_char returns t when it shows a menu and the user rejects it.
9561 Just return -1. */
9562 if (EQ (key, Qt))
9564 unbind_to (count, Qnil);
9565 UNGCPRO;
9566 return -1;
9569 /* read_char returns -1 at the end of a macro.
9570 Emacs 18 handles this by returning immediately with a
9571 zero, so that's what we'll do. */
9572 if (INTEGERP (key) && XINT (key) == -1)
9574 t = 0;
9575 /* The Microsoft C compiler can't handle the goto that
9576 would go here. */
9577 dummyflag = 1;
9578 break;
9581 /* If the current buffer has been changed from under us, the
9582 keymap may have changed, so replay the sequence. */
9583 if (BUFFERP (key))
9585 timer_resume_idle ();
9587 mock_input = t;
9588 /* Reset the current buffer from the selected window
9589 in case something changed the former and not the latter.
9590 This is to be more consistent with the behavior
9591 of the command_loop_1. */
9592 if (fix_current_buffer)
9594 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
9595 Fkill_emacs (Qnil);
9596 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
9597 Fset_buffer (XWINDOW (selected_window)->buffer);
9600 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
9601 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
9602 goto replay_sequence;
9605 /* If we have a quit that was typed in another frame, and
9606 quit_throw_to_read_char switched buffers,
9607 replay to get the right keymap. */
9608 if (INTEGERP (key)
9609 && XINT (key) == quit_char
9610 && current_buffer != starting_buffer)
9612 GROW_RAW_KEYBUF;
9613 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
9614 keybuf[t++] = key;
9615 mock_input = t;
9616 Vquit_flag = Qnil;
9617 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
9618 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
9619 goto replay_sequence;
9622 Vquit_flag = Qnil;
9624 if (EVENT_HAS_PARAMETERS (key)
9625 /* Either a `switch-frame' or a `select-window' event. */
9626 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
9628 /* If we're at the beginning of a key sequence, and the caller
9629 says it's okay, go ahead and return this event. If we're
9630 in the midst of a key sequence, delay it until the end. */
9631 if (t > 0 || !can_return_switch_frame)
9633 delayed_switch_frame = key;
9634 goto replay_key;
9638 GROW_RAW_KEYBUF;
9639 ASET (raw_keybuf, raw_keybuf_count, key);
9640 raw_keybuf_count++;
9643 /* Clicks in non-text areas get prefixed by the symbol
9644 in their CHAR-ADDRESS field. For example, a click on
9645 the mode line is prefixed by the symbol `mode-line'.
9647 Furthermore, key sequences beginning with mouse clicks
9648 are read using the keymaps of the buffer clicked on, not
9649 the current buffer. So we may have to switch the buffer
9650 here.
9652 When we turn one event into two events, we must make sure
9653 that neither of the two looks like the original--so that,
9654 if we replay the events, they won't be expanded again.
9655 If not for this, such reexpansion could happen either here
9656 or when user programs play with this-command-keys. */
9657 if (EVENT_HAS_PARAMETERS (key))
9659 Lisp_Object kind;
9660 Lisp_Object string;
9662 kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
9663 if (EQ (kind, Qmouse_click))
9665 Lisp_Object window, posn;
9667 window = POSN_WINDOW (EVENT_START (key));
9668 posn = POSN_POSN (EVENT_START (key));
9670 if (CONSP (posn)
9671 || (!NILP (fake_prefixed_keys)
9672 && !NILP (Fmemq (key, fake_prefixed_keys))))
9674 /* We're looking a second time at an event for which
9675 we generated a fake prefix key. Set
9676 last_real_key_start appropriately. */
9677 if (t > 0)
9678 last_real_key_start = t - 1;
9681 /* Key sequences beginning with mouse clicks are
9682 read using the keymaps in the buffer clicked on,
9683 not the current buffer. If we're at the
9684 beginning of a key sequence, switch buffers. */
9685 if (last_real_key_start == 0
9686 && WINDOWP (window)
9687 && BUFFERP (XWINDOW (window)->buffer)
9688 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
9690 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
9691 keybuf[t] = key;
9692 mock_input = t + 1;
9694 /* Arrange to go back to the original buffer once we're
9695 done reading the key sequence. Note that we can't
9696 use save_excursion_{save,restore} here, because they
9697 save point as well as the current buffer; we don't
9698 want to save point, because redisplay may change it,
9699 to accommodate a Fset_window_start or something. We
9700 don't want to do this at the top of the function,
9701 because we may get input from a subprocess which
9702 wants to change the selected window and stuff (say,
9703 emacsclient). */
9704 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
9706 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
9707 Fkill_emacs (Qnil);
9708 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
9709 orig_local_map = get_local_map (PT, current_buffer,
9710 Qlocal_map);
9711 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
9712 goto replay_sequence;
9715 /* For a mouse click, get the local text-property keymap
9716 of the place clicked on, rather than point. */
9717 if (last_real_key_start == 0
9718 && CONSP (XCDR (key))
9719 && ! localized_local_map)
9721 Lisp_Object map_here, start, pos;
9723 localized_local_map = 1;
9724 start = EVENT_START (key);
9726 if (CONSP (start) && POSN_INBUFFER_P (start))
9728 pos = POSN_BUFFER_POSN (start);
9729 if (INTEGERP (pos)
9730 && XINT (pos) >= BEGV
9731 && XINT (pos) <= ZV)
9733 map_here = get_local_map (XINT (pos),
9734 current_buffer, Qlocal_map);
9735 if (!EQ (map_here, orig_local_map))
9737 orig_local_map = map_here;
9738 ++localized_local_map;
9741 map_here = get_local_map (XINT (pos),
9742 current_buffer, Qkeymap);
9743 if (!EQ (map_here, orig_keymap))
9745 orig_keymap = map_here;
9746 ++localized_local_map;
9749 if (localized_local_map > 1)
9751 keybuf[t] = key;
9752 mock_input = t + 1;
9754 goto replay_sequence;
9760 /* Expand mode-line and scroll-bar events into two events:
9761 use posn as a fake prefix key. */
9762 if (SYMBOLP (posn)
9763 && (NILP (fake_prefixed_keys)
9764 || NILP (Fmemq (key, fake_prefixed_keys))))
9766 if (t + 1 >= bufsize)
9767 error ("Key sequence too long");
9769 keybuf[t] = posn;
9770 keybuf[t + 1] = key;
9771 mock_input = t + 2;
9773 /* Record that a fake prefix key has been generated
9774 for KEY. Don't modify the event; this would
9775 prevent proper action when the event is pushed
9776 back into unread-command-events. */
9777 fake_prefixed_keys = Fcons (key, fake_prefixed_keys);
9779 /* If on a mode line string with a local keymap,
9780 reconsider the key sequence with that keymap. */
9781 if (string = POSN_STRING (EVENT_START (key)),
9782 (CONSP (string) && STRINGP (XCAR (string))))
9784 Lisp_Object pos, map, map2;
9786 pos = XCDR (string);
9787 string = XCAR (string);
9788 if (XINT (pos) >= 0
9789 && XINT (pos) < SCHARS (string))
9791 map = Fget_text_property (pos, Qlocal_map, string);
9792 if (!NILP (map))
9793 orig_local_map = map;
9794 map2 = Fget_text_property (pos, Qkeymap, string);
9795 if (!NILP (map2))
9796 orig_keymap = map2;
9797 if (!NILP (map) || !NILP (map2))
9798 goto replay_sequence;
9802 goto replay_key;
9804 else if (NILP (from_string)
9805 && (string = POSN_STRING (EVENT_START (key)),
9806 (CONSP (string) && STRINGP (XCAR (string)))))
9808 /* For a click on a string, i.e. overlay string or a
9809 string displayed via the `display' property,
9810 consider `local-map' and `keymap' properties of
9811 that string. */
9812 Lisp_Object pos, map, map2;
9814 pos = XCDR (string);
9815 string = XCAR (string);
9816 if (XINT (pos) >= 0
9817 && XINT (pos) < SCHARS (string))
9819 map = Fget_text_property (pos, Qlocal_map, string);
9820 if (!NILP (map))
9821 orig_local_map = map;
9822 map2 = Fget_text_property (pos, Qkeymap, string);
9823 if (!NILP (map2))
9824 orig_keymap = map2;
9826 if (!NILP (map) || !NILP (map2))
9828 from_string = string;
9829 keybuf[t++] = key;
9830 mock_input = t;
9831 goto replay_sequence;
9836 else if (CONSP (XCDR (key))
9837 && CONSP (EVENT_START (key))
9838 && CONSP (XCDR (EVENT_START (key))))
9840 Lisp_Object posn;
9842 posn = POSN_POSN (EVENT_START (key));
9843 /* Handle menu-bar events:
9844 insert the dummy prefix event `menu-bar'. */
9845 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
9847 if (t + 1 >= bufsize)
9848 error ("Key sequence too long");
9849 keybuf[t] = posn;
9850 keybuf[t+1] = key;
9852 /* Zap the position in key, so we know that we've
9853 expanded it, and don't try to do so again. */
9854 POSN_SET_POSN (EVENT_START (key),
9855 Fcons (posn, Qnil));
9857 mock_input = t + 2;
9858 goto replay_sequence;
9860 else if (CONSP (posn))
9862 /* We're looking at the second event of a
9863 sequence which we expanded before. Set
9864 last_real_key_start appropriately. */
9865 if (last_real_key_start == t && t > 0)
9866 last_real_key_start = t - 1;
9871 /* We have finally decided that KEY is something we might want
9872 to look up. */
9873 first_binding = (follow_key (key,
9874 nmaps - first_binding,
9875 submaps + first_binding,
9876 defs + first_binding,
9877 submaps + first_binding)
9878 + first_binding);
9880 /* If KEY wasn't bound, we'll try some fallbacks. */
9881 if (first_binding < nmaps)
9882 /* This is needed for the following scenario:
9883 event 0: a down-event that gets dropped by calling replay_key.
9884 event 1: some normal prefix like C-h.
9885 After event 0, first_unbound is 0, after event 1 indec.start,
9886 fkey.start, and keytran.start are all 1, so when we see that
9887 C-h is bound, we need to update first_unbound. */
9888 first_unbound = max (t + 1, first_unbound);
9889 else
9891 Lisp_Object head;
9893 /* Remember the position to put an upper bound on indec.start. */
9894 first_unbound = min (t, first_unbound);
9896 head = EVENT_HEAD (key);
9897 if (help_char_p (head) && t > 0)
9899 read_key_sequence_cmd = Vprefix_help_command;
9900 keybuf[t++] = key;
9901 last_nonmenu_event = key;
9902 /* The Microsoft C compiler can't handle the goto that
9903 would go here. */
9904 dummyflag = 1;
9905 break;
9908 if (SYMBOLP (head))
9910 Lisp_Object breakdown;
9911 int modifiers;
9913 breakdown = parse_modifiers (head);
9914 modifiers = XINT (XCAR (XCDR (breakdown)));
9915 /* Attempt to reduce an unbound mouse event to a simpler
9916 event that is bound:
9917 Drags reduce to clicks.
9918 Double-clicks reduce to clicks.
9919 Triple-clicks reduce to double-clicks, then to clicks.
9920 Down-clicks are eliminated.
9921 Double-downs reduce to downs, then are eliminated.
9922 Triple-downs reduce to double-downs, then to downs,
9923 then are eliminated. */
9924 if (modifiers & (down_modifier | drag_modifier
9925 | double_modifier | triple_modifier))
9927 while (modifiers & (down_modifier | drag_modifier
9928 | double_modifier | triple_modifier))
9930 Lisp_Object new_head, new_click;
9931 if (modifiers & triple_modifier)
9932 modifiers ^= (double_modifier | triple_modifier);
9933 else if (modifiers & double_modifier)
9934 modifiers &= ~double_modifier;
9935 else if (modifiers & drag_modifier)
9936 modifiers &= ~drag_modifier;
9937 else
9939 /* Dispose of this `down' event by simply jumping
9940 back to replay_key, to get another event.
9942 Note that if this event came from mock input,
9943 then just jumping back to replay_key will just
9944 hand it to us again. So we have to wipe out any
9945 mock input.
9947 We could delete keybuf[t] and shift everything
9948 after that to the left by one spot, but we'd also
9949 have to fix up any variable that points into
9950 keybuf, and shifting isn't really necessary
9951 anyway.
9953 Adding prefixes for non-textual mouse clicks
9954 creates two characters of mock input, and both
9955 must be thrown away. If we're only looking at
9956 the prefix now, we can just jump back to
9957 replay_key. On the other hand, if we've already
9958 processed the prefix, and now the actual click
9959 itself is giving us trouble, then we've lost the
9960 state of the keymaps we want to backtrack to, and
9961 we need to replay the whole sequence to rebuild
9964 Beyond that, only function key expansion could
9965 create more than two keys, but that should never
9966 generate mouse events, so it's okay to zero
9967 mock_input in that case too.
9969 FIXME: The above paragraph seems just plain
9970 wrong, if you consider things like
9971 xterm-mouse-mode. -stef
9973 Isn't this just the most wonderful code ever? */
9975 /* If mock_input > t + 1, the above simplification
9976 will actually end up dropping keys on the floor.
9977 This is probably OK for now, but even
9978 if mock_input <= t + 1, we need to adjust indec,
9979 fkey, and keytran.
9980 Typical case [header-line down-mouse-N]:
9981 mock_input = 2, t = 1, fkey.end = 1,
9982 last_real_key_start = 0. */
9983 if (indec.end > last_real_key_start)
9985 indec.end = indec.start
9986 = min (last_real_key_start, indec.start);
9987 indec.map = indec.parent;
9988 if (fkey.end > last_real_key_start)
9990 fkey.end = fkey.start
9991 = min (last_real_key_start, fkey.start);
9992 fkey.map = fkey.parent;
9993 if (keytran.end > last_real_key_start)
9995 keytran.end = keytran.start
9996 = min (last_real_key_start, keytran.start);
9997 keytran.map = keytran.parent;
10001 if (t == last_real_key_start)
10003 mock_input = 0;
10004 goto replay_key;
10006 else
10008 mock_input = last_real_key_start;
10009 goto replay_sequence;
10013 new_head
10014 = apply_modifiers (modifiers, XCAR (breakdown));
10015 new_click
10016 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
10018 /* Look for a binding for this new key. follow_key
10019 promises that it didn't munge submaps the
10020 last time we called it, since key was unbound. */
10021 first_binding
10022 = (follow_key (new_click,
10023 nmaps - local_first_binding,
10024 submaps + local_first_binding,
10025 defs + local_first_binding,
10026 submaps + local_first_binding)
10027 + local_first_binding);
10029 /* If that click is bound, go for it. */
10030 if (first_binding < nmaps)
10032 key = new_click;
10033 break;
10035 /* Otherwise, we'll leave key set to the drag event. */
10041 keybuf[t++] = key;
10042 /* Normally, last_nonmenu_event gets the previous key we read.
10043 But when a mouse popup menu is being used,
10044 we don't update last_nonmenu_event; it continues to hold the mouse
10045 event that preceded the first level of menu. */
10046 if (!used_mouse_menu)
10047 last_nonmenu_event = key;
10049 /* Record what part of this_command_keys is the current key sequence. */
10050 this_single_command_key_start = this_command_key_count - t;
10052 /* Look for this sequence in input-decode-map.
10053 Scan from indec.end until we find a bound suffix. */
10054 while (indec.end < t)
10056 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10057 int done, diff;
10059 GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
10060 done = keyremap_step (keybuf, bufsize, &indec, max (t, mock_input),
10061 1, &diff, prompt);
10062 UNGCPRO;
10063 if (done)
10065 mock_input = diff + max (t, mock_input);
10066 goto replay_sequence;
10070 if (first_binding < nmaps && NILP (submaps[first_binding])
10071 && indec.start >= t)
10072 /* There is a binding and it's not a prefix.
10073 (and it doesn't have any input-decode-map translation pending).
10074 There is thus no function-key in this sequence.
10075 Moving fkey.start is important in this case to allow keytran.start
10076 to go over the sequence before we return (since we keep the
10077 invariant that keytran.end <= fkey.start). */
10079 if (fkey.start < t)
10080 (fkey.start = fkey.end = t, fkey.map = fkey.parent);
10082 else
10083 /* If the sequence is unbound, see if we can hang a function key
10084 off the end of it. */
10085 /* Continue scan from fkey.end until we find a bound suffix. */
10086 while (fkey.end < indec.start)
10088 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10089 int done, diff;
10091 GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
10092 done = keyremap_step (keybuf, bufsize, &fkey,
10093 max (t, mock_input),
10094 /* If there's a binding (i.e.
10095 first_binding >= nmaps) we don't want
10096 to apply this function-key-mapping. */
10097 fkey.end + 1 == t && first_binding >= nmaps,
10098 &diff, prompt);
10099 UNGCPRO;
10100 if (done)
10102 mock_input = diff + max (t, mock_input);
10103 /* Adjust the input-decode-map counters. */
10104 indec.end += diff;
10105 indec.start += diff;
10107 goto replay_sequence;
10111 /* Look for this sequence in key-translation-map.
10112 Scan from keytran.end until we find a bound suffix. */
10113 while (keytran.end < fkey.start)
10115 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10116 int done, diff;
10118 GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
10119 done = keyremap_step (keybuf, bufsize, &keytran, max (t, mock_input),
10120 1, &diff, prompt);
10121 UNGCPRO;
10122 if (done)
10124 mock_input = diff + max (t, mock_input);
10125 /* Adjust the function-key-map and input-decode-map counters. */
10126 indec.end += diff;
10127 indec.start += diff;
10128 fkey.end += diff;
10129 fkey.start += diff;
10131 goto replay_sequence;
10135 /* If KEY is not defined in any of the keymaps,
10136 and cannot be part of a function key or translation,
10137 and is an upper case letter
10138 use the corresponding lower-case letter instead. */
10139 if (first_binding >= nmaps
10140 && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t
10141 && INTEGERP (key)
10142 && ((CHARACTERP (make_number (XINT (key) & ~CHAR_MODIFIER_MASK))
10143 && UPPERCASEP (XINT (key) & ~CHAR_MODIFIER_MASK))
10144 || (XINT (key) & shift_modifier)))
10146 Lisp_Object new_key;
10148 original_uppercase = key;
10149 original_uppercase_position = t - 1;
10151 if (XINT (key) & shift_modifier)
10152 XSETINT (new_key, XINT (key) & ~shift_modifier);
10153 else
10154 XSETINT (new_key, (DOWNCASE (XINT (key) & ~CHAR_MODIFIER_MASK)
10155 | (XINT (key) & CHAR_MODIFIER_MASK)));
10157 /* We have to do this unconditionally, regardless of whether
10158 the lower-case char is defined in the keymaps, because they
10159 might get translated through function-key-map. */
10160 keybuf[t - 1] = new_key;
10161 mock_input = max (t, mock_input);
10162 shift_translated = 1;
10164 goto replay_sequence;
10166 /* If KEY is not defined in any of the keymaps,
10167 and cannot be part of a function key or translation,
10168 and is a shifted function key,
10169 use the corresponding unshifted function key instead. */
10170 if (first_binding >= nmaps
10171 && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t)
10173 Lisp_Object breakdown = parse_modifiers (key);
10174 int modifiers
10175 = CONSP (breakdown) ? (XINT (XCAR (XCDR (breakdown)))) : 0;
10177 if (modifiers & shift_modifier
10178 /* Treat uppercase keys as shifted. */
10179 || (INTEGERP (key)
10180 && (KEY_TO_CHAR (key)
10181 < XCHAR_TABLE (BUF_DOWNCASE_TABLE (current_buffer))->size)
10182 && UPPERCASEP (KEY_TO_CHAR (key))))
10184 Lisp_Object new_key
10185 = (modifiers & shift_modifier
10186 ? apply_modifiers (modifiers & ~shift_modifier,
10187 XCAR (breakdown))
10188 : make_number (DOWNCASE (KEY_TO_CHAR (key)) | modifiers));
10190 original_uppercase = key;
10191 original_uppercase_position = t - 1;
10193 /* We have to do this unconditionally, regardless of whether
10194 the lower-case char is defined in the keymaps, because they
10195 might get translated through function-key-map. */
10196 keybuf[t - 1] = new_key;
10197 mock_input = max (t, mock_input);
10198 /* Reset fkey (and consequently keytran) to apply
10199 function-key-map on the result, so that S-backspace is
10200 correctly mapped to DEL (via backspace). OTOH,
10201 input-decode-map doesn't need to go through it again. */
10202 fkey.start = fkey.end = 0;
10203 keytran.start = keytran.end = 0;
10204 shift_translated = 1;
10206 goto replay_sequence;
10210 if (!dummyflag)
10211 read_key_sequence_cmd = (first_binding < nmaps
10212 ? defs[first_binding]
10213 : Qnil);
10215 unread_switch_frame = delayed_switch_frame;
10216 unbind_to (count, Qnil);
10218 /* Don't downcase the last character if the caller says don't.
10219 Don't downcase it if the result is undefined, either. */
10220 if ((dont_downcase_last || first_binding >= nmaps)
10221 && t > 0
10222 && t - 1 == original_uppercase_position)
10224 keybuf[t - 1] = original_uppercase;
10225 shift_translated = 0;
10228 if (shift_translated)
10229 Vthis_command_keys_shift_translated = Qt;
10231 /* Occasionally we fabricate events, perhaps by expanding something
10232 according to function-key-map, or by adding a prefix symbol to a
10233 mouse click in the scroll bar or modeline. In this cases, return
10234 the entire generated key sequence, even if we hit an unbound
10235 prefix or a definition before the end. This means that you will
10236 be able to push back the event properly, and also means that
10237 read-key-sequence will always return a logical unit.
10239 Better ideas? */
10240 for (; t < mock_input; t++)
10242 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
10243 && NILP (Fzerop (Vecho_keystrokes)))
10244 echo_char (keybuf[t]);
10245 add_command_key (keybuf[t]);
10248 UNGCPRO;
10249 return t;
10252 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
10253 doc: /* Read a sequence of keystrokes and return as a string or vector.
10254 The sequence is sufficient to specify a non-prefix command in the
10255 current local and global maps.
10257 First arg PROMPT is a prompt string. If nil, do not prompt specially.
10258 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos
10259 as a continuation of the previous key.
10261 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
10262 convert the last event to lower case. (Normally any upper case event
10263 is converted to lower case if the original event is undefined and the lower
10264 case equivalent is defined.) A non-nil value is appropriate for reading
10265 a key sequence to be defined.
10267 A C-g typed while in this function is treated like any other character,
10268 and `quit-flag' is not set.
10270 If the key sequence starts with a mouse click, then the sequence is read
10271 using the keymaps of the buffer of the window clicked in, not the buffer
10272 of the selected window as normal.
10274 `read-key-sequence' drops unbound button-down events, since you normally
10275 only care about the click or drag events which follow them. If a drag
10276 or multi-click event is unbound, but the corresponding click event would
10277 be bound, `read-key-sequence' turns the event into a click event at the
10278 drag's starting position. This means that you don't have to distinguish
10279 between click and drag, double, or triple events unless you want to.
10281 `read-key-sequence' prefixes mouse events on mode lines, the vertical
10282 lines separating windows, and scroll bars with imaginary keys
10283 `mode-line', `vertical-line', and `vertical-scroll-bar'.
10285 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this
10286 function will process a switch-frame event if the user switches frames
10287 before typing anything. If the user switches frames in the middle of a
10288 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME
10289 is nil, then the event will be put off until after the current key sequence.
10291 `read-key-sequence' checks `function-key-map' for function key
10292 sequences, where they wouldn't conflict with ordinary bindings. See
10293 `function-key-map' for more details.
10295 The optional fifth argument COMMAND-LOOP, if non-nil, means
10296 that this key sequence is being read by something that will
10297 read commands one after another. It should be nil if the caller
10298 will read just one key sequence. */)
10299 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
10300 command_loop)
10301 Lisp_Object prompt, continue_echo, dont_downcase_last;
10302 Lisp_Object can_return_switch_frame, command_loop;
10304 Lisp_Object keybuf[30];
10305 register int i;
10306 struct gcpro gcpro1;
10307 int count = SPECPDL_INDEX ();
10309 if (!NILP (prompt))
10310 CHECK_STRING (prompt);
10311 QUIT;
10313 specbind (Qinput_method_exit_on_first_char,
10314 (NILP (command_loop) ? Qt : Qnil));
10315 specbind (Qinput_method_use_echo_area,
10316 (NILP (command_loop) ? Qt : Qnil));
10318 bzero (keybuf, sizeof keybuf);
10319 GCPRO1 (keybuf[0]);
10320 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
10322 if (NILP (continue_echo))
10324 this_command_key_count = 0;
10325 this_command_key_count_reset = 0;
10326 this_single_command_key_start = 0;
10329 #ifdef HAVE_WINDOW_SYSTEM
10330 if (display_hourglass_p)
10331 cancel_hourglass ();
10332 #endif
10333 Fmutex_lock (minibuffer_mutex);
10334 record_unwind_protect (Fmutex_unlock, minibuffer_mutex);
10336 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
10337 prompt, ! NILP (dont_downcase_last),
10338 ! NILP (can_return_switch_frame), 0);
10340 #if 0 /* The following is fine for code reading a key sequence and
10341 then proceeding with a lenghty computation, but it's not good
10342 for code reading keys in a loop, like an input method. */
10343 #ifdef HAVE_WINDOW_SYSTEM
10344 if (display_hourglass_p)
10345 start_hourglass ();
10346 #endif
10347 #endif
10349 if (i == -1)
10351 Vquit_flag = Qt;
10352 QUIT;
10354 UNGCPRO;
10355 return unbind_to (count, make_event_array (i, keybuf));
10358 DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
10359 Sread_key_sequence_vector, 1, 5, 0,
10360 doc: /* Like `read-key-sequence' but always return a vector. */)
10361 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
10362 command_loop)
10363 Lisp_Object prompt, continue_echo, dont_downcase_last;
10364 Lisp_Object can_return_switch_frame, command_loop;
10366 Lisp_Object keybuf[30];
10367 register int i;
10368 struct gcpro gcpro1;
10369 int count = SPECPDL_INDEX ();
10371 if (!NILP (prompt))
10372 CHECK_STRING (prompt);
10373 QUIT;
10375 specbind (Qinput_method_exit_on_first_char,
10376 (NILP (command_loop) ? Qt : Qnil));
10377 specbind (Qinput_method_use_echo_area,
10378 (NILP (command_loop) ? Qt : Qnil));
10380 bzero (keybuf, sizeof keybuf);
10381 GCPRO1 (keybuf[0]);
10382 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
10384 if (NILP (continue_echo))
10386 this_command_key_count = 0;
10387 this_command_key_count_reset = 0;
10388 this_single_command_key_start = 0;
10391 #ifdef HAVE_WINDOW_SYSTEM
10392 if (display_hourglass_p)
10393 cancel_hourglass ();
10394 #endif
10396 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
10397 prompt, ! NILP (dont_downcase_last),
10398 ! NILP (can_return_switch_frame), 0);
10400 #ifdef HAVE_WINDOW_SYSTEM
10401 if (display_hourglass_p)
10402 start_hourglass ();
10403 #endif
10405 if (i == -1)
10407 Vquit_flag = Qt;
10408 QUIT;
10410 UNGCPRO;
10411 return unbind_to (count, Fvector (i, keybuf));
10414 DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0,
10415 doc: /* Execute CMD as an editor command.
10416 CMD must be a symbol that satisfies the `commandp' predicate.
10417 Optional second arg RECORD-FLAG non-nil
10418 means unconditionally put this command in `command-history'.
10419 Otherwise, that is done only if an arg is read using the minibuffer.
10420 The argument KEYS specifies the value to use instead of (this-command-keys)
10421 when reading the arguments; if it is nil, (this-command-keys) is used.
10422 The argument SPECIAL, if non-nil, means that this command is executing
10423 a special event, so ignore the prefix argument and don't clear it. */)
10424 (cmd, record_flag, keys, special)
10425 Lisp_Object cmd, record_flag, keys, special;
10427 register Lisp_Object final;
10428 register Lisp_Object tem;
10429 Lisp_Object prefixarg;
10430 extern int debug_on_next_call;
10432 debug_on_next_call = 0;
10434 if (NILP (special))
10436 prefixarg = current_kboard->Vprefix_arg;
10437 Vcurrent_prefix_arg = prefixarg;
10438 current_kboard->Vprefix_arg = Qnil;
10440 else
10441 prefixarg = Qnil;
10443 if (SYMBOLP (cmd))
10445 tem = Fget (cmd, Qdisabled);
10446 if (!NILP (tem) && !NILP (Vrun_hooks))
10448 tem = Fsymbol_value (Qdisabled_command_function);
10449 if (!NILP (tem))
10450 return call1 (Vrun_hooks, Qdisabled_command_function);
10454 while (1)
10456 final = Findirect_function (cmd, Qnil);
10458 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
10460 struct gcpro gcpro1, gcpro2;
10462 GCPRO2 (cmd, prefixarg);
10463 do_autoload (final, cmd);
10464 UNGCPRO;
10466 else
10467 break;
10470 if (STRINGP (final) || VECTORP (final))
10472 /* If requested, place the macro in the command history. For
10473 other sorts of commands, call-interactively takes care of
10474 this. */
10475 if (!NILP (record_flag))
10477 Vcommand_history
10478 = Fcons (Fcons (Qexecute_kbd_macro,
10479 Fcons (final, Fcons (prefixarg, Qnil))),
10480 Vcommand_history);
10482 /* Don't keep command history around forever. */
10483 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
10485 tem = Fnthcdr (Vhistory_length, Vcommand_history);
10486 if (CONSP (tem))
10487 XSETCDR (tem, Qnil);
10491 return Fexecute_kbd_macro (final, prefixarg, Qnil);
10494 if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
10495 /* Don't call Fcall_interactively directly because we want to make
10496 sure the backtrace has an entry for `call-interactively'.
10497 For the same reason, pass `cmd' rather than `final'. */
10498 return call3 (Qcall_interactively, cmd, record_flag, keys);
10500 return Qnil;
10505 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
10506 1, 1, "P",
10507 doc: /* Read function name, then read its arguments and call it.
10509 To pass a numeric argument to the command you are invoking with, specify
10510 the numeric argument to this command.
10512 Noninteractively, the argument PREFIXARG is the prefix argument to
10513 give to the command you invoke, if it asks for an argument. */)
10514 (prefixarg)
10515 Lisp_Object prefixarg;
10517 Lisp_Object function;
10518 char buf[40];
10519 int saved_last_point_position;
10520 Lisp_Object saved_keys, saved_last_point_position_buffer;
10521 Lisp_Object bindings, value;
10522 struct gcpro gcpro1, gcpro2, gcpro3;
10523 #ifdef HAVE_WINDOW_SYSTEM
10524 /* The call to Fcompleting_read wil start and cancel the hourglass,
10525 but if the hourglass was already scheduled, this means that no
10526 hourglass will be shown for the actual M-x command itself.
10527 So we restart it if it is already scheduled. Note that checking
10528 hourglass_shown_p is not enough, normally the hourglass is not shown,
10529 just scheduled to be shown. */
10530 int hstarted = hourglass_started ();
10531 #endif
10533 saved_keys = Fvector (this_command_key_count,
10534 XVECTOR (this_command_keys)->contents);
10535 saved_last_point_position_buffer = last_point_position_buffer;
10536 saved_last_point_position = last_point_position;
10537 buf[0] = 0;
10538 GCPRO3 (saved_keys, prefixarg, saved_last_point_position_buffer);
10540 if (EQ (prefixarg, Qminus))
10541 strcpy (buf, "- ");
10542 else if (CONSP (prefixarg) && XINT (XCAR (prefixarg)) == 4)
10543 strcpy (buf, "C-u ");
10544 else if (CONSP (prefixarg) && INTEGERP (XCAR (prefixarg)))
10545 sprintf (buf, "%ld ", (long) XINT (XCAR (prefixarg)));
10546 else if (INTEGERP (prefixarg))
10547 sprintf (buf, "%ld ", (long) XINT (prefixarg));
10549 /* This isn't strictly correct if execute-extended-command
10550 is bound to anything else. Perhaps it should use
10551 this_command_keys? */
10552 strcat (buf, "M-x ");
10554 /* Prompt with buf, and then read a string, completing from and
10555 restricting to the set of all defined commands. Don't provide
10556 any initial input. Save the command read on the extended-command
10557 history list. */
10558 function = Fcompleting_read (build_string (buf),
10559 Vobarray, Qcommandp,
10560 Qt, Qnil, Qextended_command_history, Qnil,
10561 Qnil);
10563 #ifdef HAVE_WINDOW_SYSTEM
10564 if (hstarted) start_hourglass ();
10565 #endif
10567 if (STRINGP (function) && SCHARS (function) == 0)
10568 error ("No command name given");
10570 /* Set this_command_keys to the concatenation of saved_keys and
10571 function, followed by a RET. */
10573 Lisp_Object *keys;
10574 int i;
10576 this_command_key_count = 0;
10577 this_command_key_count_reset = 0;
10578 this_single_command_key_start = 0;
10580 keys = XVECTOR (saved_keys)->contents;
10581 for (i = 0; i < XVECTOR (saved_keys)->size; i++)
10582 add_command_key (keys[i]);
10584 for (i = 0; i < SCHARS (function); i++)
10585 add_command_key (Faref (function, make_number (i)));
10587 add_command_key (make_number ('\015'));
10590 last_point_position = saved_last_point_position;
10591 last_point_position_buffer = saved_last_point_position_buffer;
10593 UNGCPRO;
10595 function = Fintern (function, Qnil);
10596 current_kboard->Vprefix_arg = prefixarg;
10597 Vthis_command = function;
10598 real_this_command = function;
10600 /* If enabled, show which key runs this command. */
10601 if (!NILP (Vsuggest_key_bindings)
10602 && NILP (Vexecuting_kbd_macro)
10603 && SYMBOLP (function))
10604 bindings = Fwhere_is_internal (function, Voverriding_local_map,
10605 Qt, Qnil, Qnil);
10606 else
10607 bindings = Qnil;
10609 value = Qnil;
10610 GCPRO3 (bindings, value, function);
10611 value = Fcommand_execute (function, Qt, Qnil, Qnil);
10613 /* If the command has a key binding, print it now. */
10614 if (!NILP (bindings)
10615 && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
10616 Qmouse_movement)))
10618 /* But first wait, and skip the message if there is input. */
10619 Lisp_Object waited;
10621 /* If this command displayed something in the echo area;
10622 wait a few seconds, then display our suggestion message. */
10623 if (NILP (echo_area_buffer[0]))
10624 waited = sit_for (make_number (0), 0, 2);
10625 else if (NUMBERP (Vsuggest_key_bindings))
10626 waited = sit_for (Vsuggest_key_bindings, 0, 2);
10627 else
10628 waited = sit_for (make_number (2), 0, 2);
10630 if (!NILP (waited) && ! CONSP (Vunread_command_events))
10632 Lisp_Object binding;
10633 char *newmessage;
10634 int message_p = push_message ();
10635 int count = SPECPDL_INDEX ();
10637 record_unwind_protect (pop_message_unwind, Qnil);
10638 binding = Fkey_description (bindings, Qnil);
10640 newmessage
10641 = (char *) alloca (SCHARS (SYMBOL_NAME (function))
10642 + SBYTES (binding)
10643 + 100);
10644 sprintf (newmessage, "You can run the command `%s' with %s",
10645 SDATA (SYMBOL_NAME (function)),
10646 SDATA (binding));
10647 message2_nolog (newmessage,
10648 strlen (newmessage),
10649 STRING_MULTIBYTE (binding));
10650 if (NUMBERP (Vsuggest_key_bindings))
10651 waited = sit_for (Vsuggest_key_bindings, 0, 2);
10652 else
10653 waited = sit_for (make_number (2), 0, 2);
10655 if (!NILP (waited) && message_p)
10656 restore_message ();
10658 unbind_to (count, Qnil);
10662 RETURN_UNGCPRO (value);
10666 /* Return nonzero if input events are pending. */
10669 detect_input_pending ()
10671 if (!input_pending)
10672 get_input_pending (&input_pending, 0);
10674 return input_pending;
10677 /* Return nonzero if input events other than mouse movements are
10678 pending. */
10681 detect_input_pending_ignore_squeezables ()
10683 if (!input_pending)
10684 get_input_pending (&input_pending, READABLE_EVENTS_IGNORE_SQUEEZABLES);
10686 return input_pending;
10689 /* Return nonzero if input events are pending, and run any pending timers. */
10692 detect_input_pending_run_timers (do_display)
10693 int do_display;
10695 int old_timers_run = timers_run;
10697 if (!input_pending)
10698 get_input_pending (&input_pending, READABLE_EVENTS_DO_TIMERS_NOW);
10700 if (old_timers_run != timers_run && do_display)
10702 redisplay_preserve_echo_area (8);
10703 /* The following fixes a bug when using lazy-lock with
10704 lazy-lock-defer-on-the-fly set to t, i.e. when fontifying
10705 from an idle timer function. The symptom of the bug is that
10706 the cursor sometimes doesn't become visible until the next X
10707 event is processed. --gerd. */
10709 Lisp_Object tail, frame;
10710 FOR_EACH_FRAME (tail, frame)
10711 if (FRAME_RIF (XFRAME (frame)))
10712 FRAME_RIF (XFRAME (frame))->flush_display (XFRAME (frame));
10716 return input_pending;
10719 /* This is called in some cases before a possible quit.
10720 It cases the next call to detect_input_pending to recompute input_pending.
10721 So calling this function unnecessarily can't do any harm. */
10723 void
10724 clear_input_pending ()
10726 input_pending = 0;
10729 /* Return nonzero if there are pending requeued events.
10730 This isn't used yet. The hope is to make wait_reading_process_output
10731 call it, and return if it runs Lisp code that unreads something.
10732 The problem is, kbd_buffer_get_event needs to be fixed to know what
10733 to do in that case. It isn't trivial. */
10736 requeued_events_pending_p ()
10738 return (!NILP (Vunread_command_events) || unread_command_char != -1);
10742 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
10743 doc: /* Return t if command input is currently available with no wait.
10744 Actually, the value is nil only if we can be sure that no input is available;
10745 if there is a doubt, the value is t. */)
10748 if (!NILP (Vunread_command_events) || unread_command_char != -1
10749 || !NILP (Vunread_post_input_method_events)
10750 || !NILP (Vunread_input_method_events))
10751 return (Qt);
10753 get_input_pending (&input_pending,
10754 READABLE_EVENTS_DO_TIMERS_NOW
10755 | READABLE_EVENTS_FILTER_EVENTS);
10756 return input_pending > 0 ? Qt : Qnil;
10759 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
10760 doc: /* Return vector of last 300 events, not counting those from keyboard macros. */)
10763 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
10764 Lisp_Object val;
10766 if (total_keys < NUM_RECENT_KEYS)
10767 return Fvector (total_keys, keys);
10768 else
10770 val = Fvector (NUM_RECENT_KEYS, keys);
10771 bcopy (keys + recent_keys_index,
10772 XVECTOR (val)->contents,
10773 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
10774 bcopy (keys,
10775 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
10776 recent_keys_index * sizeof (Lisp_Object));
10777 return val;
10781 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
10782 doc: /* Return the key sequence that invoked this command.
10783 However, if the command has called `read-key-sequence', it returns
10784 the last key sequence that has been read.
10785 The value is a string or a vector.
10787 See also `this-command-keys-vector'. */)
10790 return make_event_array (this_command_key_count,
10791 XVECTOR (this_command_keys)->contents);
10794 DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
10795 doc: /* Return the key sequence that invoked this command, as a vector.
10796 However, if the command has called `read-key-sequence', it returns
10797 the last key sequence that has been read.
10799 See also `this-command-keys'. */)
10802 return Fvector (this_command_key_count,
10803 XVECTOR (this_command_keys)->contents);
10806 DEFUN ("this-single-command-keys", Fthis_single_command_keys,
10807 Sthis_single_command_keys, 0, 0, 0,
10808 doc: /* Return the key sequence that invoked this command.
10809 More generally, it returns the last key sequence read, either by
10810 the command loop or by `read-key-sequence'.
10811 Unlike `this-command-keys', this function's value
10812 does not include prefix arguments.
10813 The value is always a vector. */)
10816 return Fvector (this_command_key_count
10817 - this_single_command_key_start,
10818 (XVECTOR (this_command_keys)->contents
10819 + this_single_command_key_start));
10822 DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
10823 Sthis_single_command_raw_keys, 0, 0, 0,
10824 doc: /* Return the raw events that were read for this command.
10825 More generally, it returns the last key sequence read, either by
10826 the command loop or by `read-key-sequence'.
10827 Unlike `this-single-command-keys', this function's value
10828 shows the events before all translations (except for input methods).
10829 The value is always a vector. */)
10832 return Fvector (raw_keybuf_count,
10833 (XVECTOR (raw_keybuf)->contents));
10836 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
10837 Sreset_this_command_lengths, 0, 0, 0,
10838 doc: /* Make the unread events replace the last command and echo.
10839 Used in `universal-argument-other-key'.
10841 `universal-argument-other-key' rereads the event just typed.
10842 It then gets translated through `function-key-map'.
10843 The translated event has to replace the real events,
10844 both in the value of (this-command-keys) and in echoing.
10845 To achieve this, `universal-argument-other-key' calls
10846 `reset-this-command-lengths', which discards the record of reading
10847 these events the first time. */)
10850 this_command_key_count = before_command_key_count;
10851 if (this_command_key_count < this_single_command_key_start)
10852 this_single_command_key_start = this_command_key_count;
10854 echo_truncate (before_command_echo_length);
10856 /* Cause whatever we put into unread-command-events
10857 to echo as if it were being freshly read from the keyboard. */
10858 this_command_key_count_reset = 1;
10860 return Qnil;
10863 DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
10864 Sclear_this_command_keys, 0, 1, 0,
10865 doc: /* Clear out the vector that `this-command-keys' returns.
10866 Also clear the record of the last 100 events, unless optional arg
10867 KEEP-RECORD is non-nil. */)
10868 (keep_record)
10869 Lisp_Object keep_record;
10871 int i;
10873 this_command_key_count = 0;
10874 this_command_key_count_reset = 0;
10876 if (NILP (keep_record))
10878 for (i = 0; i < XVECTOR (recent_keys)->size; ++i)
10879 XVECTOR (recent_keys)->contents[i] = Qnil;
10880 total_keys = 0;
10881 recent_keys_index = 0;
10883 return Qnil;
10886 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
10887 doc: /* Return the current depth in recursive edits. */)
10890 Lisp_Object temp;
10891 XSETFASTINT (temp, command_loop_level + minibuf_level);
10892 return temp;
10895 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
10896 "FOpen dribble file: ",
10897 doc: /* Start writing all keyboard characters to a dribble file called FILE.
10898 If FILE is nil, close any open dribble file. */)
10899 (file)
10900 Lisp_Object file;
10902 if (dribble)
10904 BLOCK_INPUT;
10905 fclose (dribble);
10906 UNBLOCK_INPUT;
10907 dribble = 0;
10909 if (!NILP (file))
10911 file = Fexpand_file_name (file, Qnil);
10912 dribble = fopen (SDATA (file), "w");
10913 if (dribble == 0)
10914 report_file_error ("Opening dribble", Fcons (file, Qnil));
10916 return Qnil;
10919 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
10920 doc: /* Discard the contents of the terminal input buffer.
10921 Also end any kbd macro being defined. */)
10924 if (!NILP (current_kboard->defining_kbd_macro))
10926 /* Discard the last command from the macro. */
10927 Fcancel_kbd_macro_events ();
10928 end_kbd_macro ();
10931 update_mode_lines++;
10933 Vunread_command_events = Qnil;
10934 unread_command_char = -1;
10936 discard_tty_input ();
10938 kbd_fetch_ptr = kbd_store_ptr;
10939 input_pending = 0;
10941 return Qnil;
10944 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
10945 doc: /* Stop Emacs and return to superior process. You can resume later.
10946 If `cannot-suspend' is non-nil, or if the system doesn't support job
10947 control, run a subshell instead.
10949 If optional arg STUFFSTRING is non-nil, its characters are stuffed
10950 to be read as terminal input by Emacs's parent, after suspension.
10952 Before suspending, run the normal hook `suspend-hook'.
10953 After resumption run the normal hook `suspend-resume-hook'.
10955 Some operating systems cannot stop the Emacs process and resume it later.
10956 On such systems, Emacs starts a subshell instead of suspending. */)
10957 (stuffstring)
10958 Lisp_Object stuffstring;
10960 int count = SPECPDL_INDEX ();
10961 int old_height, old_width;
10962 int width, height;
10963 struct gcpro gcpro1;
10965 if (tty_list && tty_list->next)
10966 error ("There are other tty frames open; close them before suspending Emacs");
10968 if (!NILP (stuffstring))
10969 CHECK_STRING (stuffstring);
10971 /* Run the functions in suspend-hook. */
10972 if (!NILP (Vrun_hooks))
10973 call1 (Vrun_hooks, intern ("suspend-hook"));
10975 GCPRO1 (stuffstring);
10976 get_tty_size (fileno (CURTTY ()->input), &old_width, &old_height);
10977 reset_all_sys_modes ();
10978 /* sys_suspend can get an error if it tries to fork a subshell
10979 and the system resources aren't available for that. */
10980 record_unwind_protect ((Lisp_Object (*) P_ ((Lisp_Object))) init_all_sys_modes,
10981 Qnil);
10982 stuff_buffered_input (stuffstring);
10983 if (cannot_suspend)
10984 sys_subshell ();
10985 else
10986 sys_suspend ();
10987 unbind_to (count, Qnil);
10989 /* Check if terminal/window size has changed.
10990 Note that this is not useful when we are running directly
10991 with a window system; but suspend should be disabled in that case. */
10992 get_tty_size (fileno (CURTTY ()->input), &width, &height);
10993 if (width != old_width || height != old_height)
10994 change_frame_size (SELECTED_FRAME (), height, width, 0, 0, 0);
10996 /* Run suspend-resume-hook. */
10997 if (!NILP (Vrun_hooks))
10998 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
11000 UNGCPRO;
11001 return Qnil;
11004 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
11005 Then in any case stuff anything Emacs has read ahead and not used. */
11007 void
11008 stuff_buffered_input (stuffstring)
11009 Lisp_Object stuffstring;
11011 #ifdef SIGTSTP /* stuff_char is defined if SIGTSTP. */
11012 register unsigned char *p;
11014 if (STRINGP (stuffstring))
11016 register int count;
11018 p = SDATA (stuffstring);
11019 count = SBYTES (stuffstring);
11020 while (count-- > 0)
11021 stuff_char (*p++);
11022 stuff_char ('\n');
11025 /* Anything we have read ahead, put back for the shell to read. */
11026 /* ?? What should this do when we have multiple keyboards??
11027 Should we ignore anything that was typed in at the "wrong" kboard?
11029 rms: we should stuff everything back into the kboard
11030 it came from. */
11031 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
11034 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
11035 kbd_fetch_ptr = kbd_buffer;
11036 if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT)
11037 stuff_char (kbd_fetch_ptr->code);
11039 clear_event (kbd_fetch_ptr);
11042 input_pending = 0;
11043 #endif /* SIGTSTP */
11046 void
11047 set_waiting_for_input (time_to_clear)
11048 EMACS_TIME *time_to_clear;
11050 input_available_clear_time = time_to_clear;
11052 /* Tell handle_interrupt to throw back to read_char, */
11053 waiting_for_input = 1;
11055 /* If handle_interrupt was called before and buffered a C-g,
11056 make it run again now, to avoid timing error. */
11057 if (!NILP (Vquit_flag))
11058 quit_throw_to_read_char ();
11061 void
11062 clear_waiting_for_input ()
11064 /* Tell handle_interrupt not to throw back to read_char, */
11065 waiting_for_input = 0;
11066 input_available_clear_time = 0;
11069 /* The SIGINT handler.
11071 If we have a frame on the controlling tty, we assume that the
11072 SIGINT was generated by C-g, so we call handle_interrupt.
11073 Otherwise, the handler kills Emacs. */
11075 static SIGTYPE
11076 interrupt_signal (signalnum) /* If we don't have an argument, */
11077 int signalnum; /* some compilers complain in signal calls. */
11079 /* Must preserve main program's value of errno. */
11080 int old_errno = errno;
11081 struct terminal *terminal;
11083 SIGNAL_THREAD_CHECK (signalnum);
11085 /* See if we have an active terminal on our controlling tty. */
11086 terminal = get_named_tty ("/dev/tty");
11087 if (!terminal)
11089 /* If there are no frames there, let's pretend that we are a
11090 well-behaving UN*X program and quit. */
11091 Fkill_emacs (Qnil);
11093 else
11095 /* Otherwise, the SIGINT was probably generated by C-g. */
11097 /* Set internal_last_event_frame to the top frame of the
11098 controlling tty, if we have a frame there. We disable the
11099 interrupt key on secondary ttys, so the SIGINT must have come
11100 from the controlling tty. */
11101 internal_last_event_frame = terminal->display_info.tty->top_frame;
11103 handle_interrupt ();
11106 errno = old_errno;
11109 /* This routine is called at interrupt level in response to C-g.
11111 It is called from the SIGINT handler or kbd_buffer_store_event.
11113 If `waiting_for_input' is non zero, then unless `echoing' is
11114 nonzero, immediately throw back to read_char.
11116 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
11117 eval to throw, when it gets a chance. If quit-flag is already
11118 non-nil, it stops the job right away. */
11120 static void
11121 handle_interrupt ()
11123 char c;
11125 cancel_echoing ();
11127 /* XXX This code needs to be revised for multi-tty support. */
11128 if (!NILP (Vquit_flag) && get_named_tty ("/dev/tty"))
11130 /* If SIGINT isn't blocked, don't let us be interrupted by
11131 another SIGINT, it might be harmful due to non-reentrancy
11132 in I/O functions. */
11133 sigblock (sigmask (SIGINT));
11135 fflush (stdout);
11136 reset_all_sys_modes ();
11138 #ifdef SIGTSTP /* Support possible in later USG versions */
11140 * On systems which can suspend the current process and return to the original
11141 * shell, this command causes the user to end up back at the shell.
11142 * The "Auto-save" and "Abort" questions are not asked until
11143 * the user elects to return to emacs, at which point he can save the current
11144 * job and either dump core or continue.
11146 sys_suspend ();
11147 #else
11148 /* Perhaps should really fork an inferior shell?
11149 But that would not provide any way to get back
11150 to the original shell, ever. */
11151 printf ("No support for stopping a process on this operating system;\n");
11152 printf ("you can continue or abort.\n");
11153 #endif /* not SIGTSTP */
11154 #ifdef MSDOS
11155 /* We must remain inside the screen area when the internal terminal
11156 is used. Note that [Enter] is not echoed by dos. */
11157 cursor_to (SELECTED_FRAME (), 0, 0);
11158 #endif
11159 /* It doesn't work to autosave while GC is in progress;
11160 the code used for auto-saving doesn't cope with the mark bit. */
11161 if (!gc_in_progress)
11163 printf ("Auto-save? (y or n) ");
11164 fflush (stdout);
11165 if (((c = getchar ()) & ~040) == 'Y')
11167 Fdo_auto_save (Qt, Qnil);
11168 #ifdef MSDOS
11169 printf ("\r\nAuto-save done");
11170 #else /* not MSDOS */
11171 printf ("Auto-save done\n");
11172 #endif /* not MSDOS */
11174 while (c != '\n') c = getchar ();
11176 else
11178 /* During GC, it must be safe to reenable quitting again. */
11179 Vinhibit_quit = Qnil;
11180 #ifdef MSDOS
11181 printf ("\r\n");
11182 #endif /* not MSDOS */
11183 printf ("Garbage collection in progress; cannot auto-save now\r\n");
11184 printf ("but will instead do a real quit after garbage collection ends\r\n");
11185 fflush (stdout);
11188 #ifdef MSDOS
11189 printf ("\r\nAbort? (y or n) ");
11190 #else /* not MSDOS */
11191 printf ("Abort (and dump core)? (y or n) ");
11192 #endif /* not MSDOS */
11193 fflush (stdout);
11194 if (((c = getchar ()) & ~040) == 'Y')
11195 abort ();
11196 while (c != '\n') c = getchar ();
11197 #ifdef MSDOS
11198 printf ("\r\nContinuing...\r\n");
11199 #else /* not MSDOS */
11200 printf ("Continuing...\n");
11201 #endif /* not MSDOS */
11202 fflush (stdout);
11203 init_all_sys_modes ();
11204 sigfree ();
11206 else
11208 /* If executing a function that wants to be interrupted out of
11209 and the user has not deferred quitting by binding `inhibit-quit'
11210 then quit right away. */
11211 if (immediate_quit && NILP (Vinhibit_quit))
11213 struct gl_state_s saved;
11214 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
11216 immediate_quit = 0;
11217 sigfree ();
11218 saved = gl_state;
11219 GCPRO4 (saved.object, saved.global_code,
11220 saved.current_syntax_table, saved.old_prop);
11221 Fsignal (Qquit, Qnil);
11222 /* FIXME: AFAIK, `quit' can never return, so this code is dead! */
11223 gl_state = saved;
11224 UNGCPRO;
11226 else
11227 /* Else request quit when it's safe */
11228 Vquit_flag = Qt;
11231 /* TODO: The longjmp in this call throws the NS event loop integration off,
11232 and it seems to do fine without this. Probably some attention
11233 needs to be paid to the setting of waiting_for_input in
11234 wait_reading_process_output() under HAVE_NS because of the call
11235 to ns_select there (needed because otherwise events aren't picked up
11236 outside of polling since we don't get SIGIO like X and we don't have a
11237 separate event loop thread like W32. */
11238 #ifndef HAVE_NS
11239 if (waiting_for_input && !echoing)
11240 quit_throw_to_read_char ();
11241 #endif
11244 /* Handle a C-g by making read_char return C-g. */
11246 void
11247 quit_throw_to_read_char ()
11249 sigfree ();
11250 /* Prevent another signal from doing this before we finish. */
11251 clear_waiting_for_input ();
11252 input_pending = 0;
11254 Vunread_command_events = Qnil;
11255 unread_command_char = -1;
11257 #if 0 /* Currently, sit_for is called from read_char without turning
11258 off polling. And that can call set_waiting_for_input.
11259 It seems to be harmless. */
11260 #ifdef POLL_FOR_INPUT
11261 /* May be > 1 if in recursive minibuffer. */
11262 if (poll_suppress_count == 0)
11263 abort ();
11264 #endif
11265 #endif
11266 if (FRAMEP (internal_last_event_frame)
11267 && !EQ (internal_last_event_frame, selected_frame))
11268 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
11269 0, 0, Qnil);
11271 _longjmp (getcjmp, 1);
11274 DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode, Sset_input_interrupt_mode, 1, 1, 0,
11275 doc: /* Set interrupt mode of reading keyboard input.
11276 If INTERRUPT is non-nil, Emacs will use input interrupts;
11277 otherwise Emacs uses CBREAK mode.
11279 See also `current-input-mode'. */)
11280 (interrupt)
11281 Lisp_Object interrupt;
11283 int new_interrupt_input;
11284 #ifdef SIGIO
11285 /* Note SIGIO has been undef'd if FIONREAD is missing. */
11286 #ifdef HAVE_X_WINDOWS
11287 if (x_display_list != NULL)
11289 /* When using X, don't give the user a real choice,
11290 because we haven't implemented the mechanisms to support it. */
11291 new_interrupt_input = 1;
11293 else
11294 #endif /* HAVE_X_WINDOWS */
11295 new_interrupt_input = !NILP (interrupt);
11296 #else /* not SIGIO */
11297 new_interrupt_input = 0;
11298 #endif /* not SIGIO */
11300 if (new_interrupt_input != interrupt_input)
11302 #ifdef POLL_FOR_INPUT
11303 stop_polling ();
11304 #endif
11305 #ifndef DOS_NT
11306 /* this causes startup screen to be restored and messes with the mouse */
11307 reset_all_sys_modes ();
11308 #endif
11309 interrupt_input = new_interrupt_input;
11310 #ifndef DOS_NT
11311 init_all_sys_modes ();
11312 #endif
11314 #ifdef POLL_FOR_INPUT
11315 poll_suppress_count = 1;
11316 start_polling ();
11317 #endif
11319 return Qnil;
11322 DEFUN ("set-output-flow-control", Fset_output_flow_control, Sset_output_flow_control, 1, 2, 0,
11323 doc: /* Enable or disable ^S/^Q flow control for output to TERMINAL.
11324 If FLOW is non-nil, flow control is enabled and you cannot use C-s or
11325 C-q in key sequences.
11327 This setting only has an effect on tty terminals and only when
11328 Emacs reads input in CBREAK mode; see `set-input-interrupt-mode'.
11330 See also `current-input-mode'. */)
11331 (flow, terminal)
11332 Lisp_Object flow, terminal;
11334 struct terminal *t = get_terminal (terminal, 1);
11335 struct tty_display_info *tty;
11336 if (t == NULL || (t->type != output_termcap && t->type != output_msdos_raw))
11337 return Qnil;
11338 tty = t->display_info.tty;
11340 if (tty->flow_control != !NILP (flow))
11342 #ifndef DOS_NT
11343 /* this causes startup screen to be restored and messes with the mouse */
11344 reset_sys_modes (tty);
11345 #endif
11347 tty->flow_control = !NILP (flow);
11349 #ifndef DOS_NT
11350 init_sys_modes (tty);
11351 #endif
11353 return Qnil;
11356 DEFUN ("set-input-meta-mode", Fset_input_meta_mode, Sset_input_meta_mode, 1, 2, 0,
11357 doc: /* Enable or disable 8-bit input on TERMINAL.
11358 If META is t, Emacs will accept 8-bit input, and interpret the 8th
11359 bit as the Meta modifier.
11361 If META is nil, Emacs will ignore the top bit, on the assumption it is
11362 parity.
11364 Otherwise, Emacs will accept and pass through 8-bit input without
11365 specially interpreting the top bit.
11367 This setting only has an effect on tty terminal devices.
11369 Optional parameter TERMINAL specifies the tty terminal device to use.
11370 It may be a terminal object, a frame, or nil for the terminal used by
11371 the currently selected frame.
11373 See also `current-input-mode'. */)
11374 (meta, terminal)
11375 Lisp_Object meta, terminal;
11377 struct terminal *t = get_terminal (terminal, 1);
11378 struct tty_display_info *tty;
11379 int new_meta;
11381 if (t == NULL || (t->type != output_termcap && t->type != output_msdos_raw))
11382 return Qnil;
11383 tty = t->display_info.tty;
11385 if (NILP (meta))
11386 new_meta = 0;
11387 else if (EQ (meta, Qt))
11388 new_meta = 1;
11389 else
11390 new_meta = 2;
11392 if (tty->meta_key != new_meta)
11394 #ifndef DOS_NT
11395 /* this causes startup screen to be restored and messes with the mouse */
11396 reset_sys_modes (tty);
11397 #endif
11399 tty->meta_key = new_meta;
11401 #ifndef DOS_NT
11402 init_sys_modes (tty);
11403 #endif
11405 return Qnil;
11408 DEFUN ("set-quit-char", Fset_quit_char, Sset_quit_char, 1, 1, 0,
11409 doc: /* Specify character used for quitting.
11410 QUIT must be an ASCII character.
11412 This function only has an effect on the controlling tty of the Emacs
11413 process.
11415 See also `current-input-mode'. */)
11416 (quit)
11417 Lisp_Object quit;
11419 struct terminal *t = get_named_tty ("/dev/tty");
11420 struct tty_display_info *tty;
11421 if (t == NULL || (t->type != output_termcap && t->type != output_msdos_raw))
11422 return Qnil;
11423 tty = t->display_info.tty;
11425 if (NILP (quit) || !INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400)
11426 error ("QUIT must be an ASCII character");
11428 #ifndef DOS_NT
11429 /* this causes startup screen to be restored and messes with the mouse */
11430 reset_sys_modes (tty);
11431 #endif
11433 /* Don't let this value be out of range. */
11434 quit_char = XINT (quit) & (tty->meta_key == 0 ? 0177 : 0377);
11436 #ifndef DOS_NT
11437 init_sys_modes (tty);
11438 #endif
11440 return Qnil;
11443 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
11444 doc: /* Set mode of reading keyboard input.
11445 First arg INTERRUPT non-nil means use input interrupts;
11446 nil means use CBREAK mode.
11447 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
11448 (no effect except in CBREAK mode).
11449 Third arg META t means accept 8-bit input (for a Meta key).
11450 META nil means ignore the top bit, on the assumption it is parity.
11451 Otherwise, accept 8-bit input and don't use the top bit for Meta.
11452 Optional fourth arg QUIT if non-nil specifies character to use for quitting.
11453 See also `current-input-mode'. */)
11454 (interrupt, flow, meta, quit)
11455 Lisp_Object interrupt, flow, meta, quit;
11457 Fset_input_interrupt_mode (interrupt);
11458 Fset_output_flow_control (flow, Qnil);
11459 Fset_input_meta_mode (meta, Qnil);
11460 if (!NILP (quit))
11461 Fset_quit_char (quit);
11462 return Qnil;
11465 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
11466 doc: /* Return information about the way Emacs currently reads keyboard input.
11467 The value is a list of the form (INTERRUPT FLOW META QUIT), where
11468 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if
11469 nil, Emacs is using CBREAK mode.
11470 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
11471 terminal; this does not apply if Emacs uses interrupt-driven input.
11472 META is t if accepting 8-bit input with 8th bit as Meta flag.
11473 META nil means ignoring the top bit, on the assumption it is parity.
11474 META is neither t nor nil if accepting 8-bit input and using
11475 all 8 bits as the character code.
11476 QUIT is the character Emacs currently uses to quit.
11477 The elements of this list correspond to the arguments of
11478 `set-input-mode'. */)
11481 Lisp_Object val[4];
11482 struct frame *sf = XFRAME (selected_frame);
11484 val[0] = interrupt_input ? Qt : Qnil;
11485 if (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf))
11487 val[1] = FRAME_TTY (sf)->flow_control ? Qt : Qnil;
11488 val[2] = (FRAME_TTY (sf)->meta_key == 2
11489 ? make_number (0)
11490 : (CURTTY ()->meta_key == 1 ? Qt : Qnil));
11492 else
11494 val[1] = Qnil;
11495 val[2] = Qt;
11497 XSETFASTINT (val[3], quit_char);
11499 return Flist (sizeof (val) / sizeof (val[0]), val);
11502 DEFUN ("posn-at-x-y", Fposn_at_x_y, Sposn_at_x_y, 2, 4, 0,
11503 doc: /* Return position information for pixel coordinates X and Y.
11504 By default, X and Y are relative to text area of the selected window.
11505 Optional third arg FRAME-OR-WINDOW non-nil specifies frame or window.
11506 If optional fourth arg WHOLE is non-nil, X is relative to the left
11507 edge of the window.
11509 The return value is similar to a mouse click position:
11510 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
11511 IMAGE (DX . DY) (WIDTH . HEIGHT))
11512 The `posn-' functions access elements of such lists. */)
11513 (x, y, frame_or_window, whole)
11514 Lisp_Object x, y, frame_or_window, whole;
11516 CHECK_NATNUM (x);
11517 CHECK_NATNUM (y);
11519 if (NILP (frame_or_window))
11520 frame_or_window = selected_window;
11522 if (WINDOWP (frame_or_window))
11524 struct window *w;
11526 CHECK_LIVE_WINDOW (frame_or_window);
11528 w = XWINDOW (frame_or_window);
11529 XSETINT (x, (XINT (x)
11530 + WINDOW_LEFT_EDGE_X (w)
11531 + (NILP (whole)
11532 ? window_box_left_offset (w, TEXT_AREA)
11533 : 0)));
11534 XSETINT (y, WINDOW_TO_FRAME_PIXEL_Y (w, XINT (y)));
11535 frame_or_window = w->frame;
11538 CHECK_LIVE_FRAME (frame_or_window);
11540 return make_lispy_position (XFRAME (frame_or_window), &x, &y, 0);
11543 DEFUN ("posn-at-point", Fposn_at_point, Sposn_at_point, 0, 2, 0,
11544 doc: /* Return position information for buffer POS in WINDOW.
11545 POS defaults to point in WINDOW; WINDOW defaults to the selected window.
11547 Return nil if position is not visible in window. Otherwise,
11548 the return value is similar to that returned by `event-start' for
11549 a mouse click at the upper left corner of the glyph corresponding
11550 to the given buffer position:
11551 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
11552 IMAGE (DX . DY) (WIDTH . HEIGHT))
11553 The `posn-' functions access elements of such lists. */)
11554 (pos, window)
11555 Lisp_Object pos, window;
11557 Lisp_Object tem;
11559 if (NILP (window))
11560 window = selected_window;
11562 tem = Fpos_visible_in_window_p (pos, window, Qt);
11563 if (!NILP (tem))
11565 Lisp_Object x = XCAR (tem);
11566 Lisp_Object y = XCAR (XCDR (tem));
11568 /* Point invisible due to hscrolling? */
11569 if (XINT (x) < 0)
11570 return Qnil;
11571 tem = Fposn_at_x_y (x, y, window, Qnil);
11574 return tem;
11579 * Set up a new kboard object with reasonable initial values.
11581 void
11582 init_kboard (kb)
11583 KBOARD *kb;
11585 kb->Voverriding_terminal_local_map = Qnil;
11586 kb->Vlast_command = Qnil;
11587 kb->Vreal_last_command = Qnil;
11588 kb->Vkeyboard_translate_table = Qnil;
11589 kb->Vlast_repeatable_command = Qnil;
11590 kb->Vprefix_arg = Qnil;
11591 kb->Vlast_prefix_arg = Qnil;
11592 kb->kbd_queue = Qnil;
11593 kb->kbd_queue_has_data = 0;
11594 kb->immediate_echo = 0;
11595 kb->echo_string = Qnil;
11596 kb->echo_after_prompt = -1;
11597 kb->kbd_macro_buffer = 0;
11598 kb->kbd_macro_bufsize = 0;
11599 kb->defining_kbd_macro = Qnil;
11600 kb->Vlast_kbd_macro = Qnil;
11601 kb->reference_count = 0;
11602 kb->Vsystem_key_alist = Qnil;
11603 kb->system_key_syms = Qnil;
11604 kb->Vwindow_system = Qt; /* Unset. */
11605 kb->Vinput_decode_map = Fmake_sparse_keymap (Qnil);
11606 kb->Vlocal_function_key_map = Fmake_sparse_keymap (Qnil);
11607 Fset_keymap_parent (kb->Vlocal_function_key_map, Vfunction_key_map);
11608 kb->Vdefault_minibuffer_frame = Qnil;
11612 * Destroy the contents of a kboard object, but not the object itself.
11613 * We use this just before deleting it, or if we're going to initialize
11614 * it a second time.
11616 static void
11617 wipe_kboard (kb)
11618 KBOARD *kb;
11620 xfree (kb->kbd_macro_buffer);
11623 /* Free KB and memory referenced from it. */
11625 void
11626 delete_kboard (kb)
11627 KBOARD *kb;
11629 KBOARD **kbp;
11631 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
11632 if (*kbp == NULL)
11633 abort ();
11634 *kbp = kb->next_kboard;
11636 /* Prevent a dangling reference to KB. */
11637 if (kb == current_kboard
11638 && FRAMEP (selected_frame)
11639 && FRAME_LIVE_P (XFRAME (selected_frame)))
11641 current_kboard = FRAME_KBOARD (XFRAME (selected_frame));
11642 single_kboard = 0;
11643 if (current_kboard == kb)
11644 abort ();
11647 wipe_kboard (kb);
11648 xfree (kb);
11651 void
11652 init_keyboard ()
11654 /* This is correct before outermost invocation of the editor loop */
11655 command_loop_level = -1;
11656 immediate_quit = 0;
11657 quit_char = Ctl ('g');
11658 Vunread_command_events = Qnil;
11659 unread_command_char = -1;
11660 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
11661 total_keys = 0;
11662 recent_keys_index = 0;
11663 kbd_fetch_ptr = kbd_buffer;
11664 kbd_store_ptr = kbd_buffer;
11665 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
11666 do_mouse_tracking = Qnil;
11667 #endif
11668 input_pending = 0;
11669 interrupt_input_blocked = 0;
11670 interrupt_input_pending = 0;
11671 #ifdef SYNC_INPUT
11672 pending_signals = 0;
11673 #endif
11675 /* This means that command_loop_1 won't try to select anything the first
11676 time through. */
11677 internal_last_event_frame = Qnil;
11678 Vlast_event_frame = internal_last_event_frame;
11680 current_kboard = initial_kboard;
11681 /* Re-initialize the keyboard again. */
11682 wipe_kboard (current_kboard);
11683 init_kboard (current_kboard);
11684 /* A value of nil for Vwindow_system normally means a tty, but we also use
11685 it for the initial terminal since there is no window system there. */
11686 current_kboard->Vwindow_system = Qnil;
11688 if (!noninteractive)
11690 /* Before multi-tty support, these handlers used to be installed
11691 only if the current session was a tty session. Now an Emacs
11692 session may have multiple display types, so we always handle
11693 SIGINT. There is special code in interrupt_signal to exit
11694 Emacs on SIGINT when there are no termcap frames on the
11695 controlling terminal. */
11696 signal (SIGINT, interrupt_signal);
11697 #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
11698 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
11699 SIGQUIT and we can't tell which one it will give us. */
11700 signal (SIGQUIT, interrupt_signal);
11701 #endif /* HAVE_TERMIO */
11703 /* Note SIGIO has been undef'd if FIONREAD is missing. */
11704 #ifdef SIGIO
11705 if (!noninteractive)
11706 signal (SIGIO, input_available_signal);
11707 #endif /* SIGIO */
11709 /* Use interrupt input by default, if it works and noninterrupt input
11710 has deficiencies. */
11712 #ifdef INTERRUPT_INPUT
11713 interrupt_input = 1;
11714 #else
11715 interrupt_input = 0;
11716 #endif
11718 sigfree ();
11719 dribble = 0;
11721 if (keyboard_init_hook)
11722 (*keyboard_init_hook) ();
11724 #ifdef POLL_FOR_INPUT
11725 poll_timer = NULL;
11726 poll_suppress_count = 1;
11727 start_polling ();
11728 #endif
11731 /* This type's only use is in syms_of_keyboard, to initialize the
11732 event header symbols and put properties on them. */
11733 struct event_head {
11734 Lisp_Object *var;
11735 char *name;
11736 Lisp_Object *kind;
11739 struct event_head head_table[] = {
11740 {&Qmouse_movement, "mouse-movement", &Qmouse_movement},
11741 {&Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement},
11742 {&Qswitch_frame, "switch-frame", &Qswitch_frame},
11743 {&Qdelete_frame, "delete-frame", &Qdelete_frame},
11744 {&Qiconify_frame, "iconify-frame", &Qiconify_frame},
11745 {&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible},
11746 /* `select-window' should be handled just like `switch-frame'
11747 in read_key_sequence. */
11748 {&Qselect_window, "select-window", &Qswitch_frame}
11751 void
11752 syms_of_keyboard ()
11754 pending_funcalls = Qnil;
11755 staticpro (&pending_funcalls);
11757 Vlispy_mouse_stem = make_pure_c_string ("mouse");
11758 staticpro (&Vlispy_mouse_stem);
11760 /* Tool-bars. */
11761 QCimage = intern_c_string (":image");
11762 staticpro (&QCimage);
11764 staticpro (&Qhelp_echo);
11765 Qhelp_echo = intern_c_string ("help-echo");
11767 staticpro (&Qrtl);
11768 Qrtl = intern_c_string (":rtl");
11770 staticpro (&item_properties);
11771 item_properties = Qnil;
11773 staticpro (&tool_bar_item_properties);
11774 tool_bar_item_properties = Qnil;
11775 staticpro (&tool_bar_items_vector);
11776 tool_bar_items_vector = Qnil;
11778 staticpro (&real_this_command);
11779 real_this_command = Qnil;
11781 Qtimer_event_handler = intern_c_string ("timer-event-handler");
11782 staticpro (&Qtimer_event_handler);
11784 Qdisabled_command_function = intern_c_string ("disabled-command-function");
11785 staticpro (&Qdisabled_command_function);
11787 Qself_insert_command = intern_c_string ("self-insert-command");
11788 staticpro (&Qself_insert_command);
11790 Qforward_char = intern_c_string ("forward-char");
11791 staticpro (&Qforward_char);
11793 Qbackward_char = intern_c_string ("backward-char");
11794 staticpro (&Qbackward_char);
11796 Qdisabled = intern_c_string ("disabled");
11797 staticpro (&Qdisabled);
11799 Qundefined = intern_c_string ("undefined");
11800 staticpro (&Qundefined);
11802 Qpre_command_hook = intern_c_string ("pre-command-hook");
11803 staticpro (&Qpre_command_hook);
11805 Qpost_command_hook = intern_c_string ("post-command-hook");
11806 staticpro (&Qpost_command_hook);
11808 Qdeferred_action_function = intern_c_string ("deferred-action-function");
11809 staticpro (&Qdeferred_action_function);
11811 Qcommand_hook_internal = intern_c_string ("command-hook-internal");
11812 staticpro (&Qcommand_hook_internal);
11814 Qfunction_key = intern_c_string ("function-key");
11815 staticpro (&Qfunction_key);
11816 Qmouse_click = intern_c_string ("mouse-click");
11817 staticpro (&Qmouse_click);
11818 #if defined (WINDOWSNT)
11819 Qlanguage_change = intern_c_string ("language-change");
11820 staticpro (&Qlanguage_change);
11821 #endif
11822 Qdrag_n_drop = intern_c_string ("drag-n-drop");
11823 staticpro (&Qdrag_n_drop);
11825 Qsave_session = intern_c_string ("save-session");
11826 staticpro (&Qsave_session);
11828 #ifdef HAVE_DBUS
11829 Qdbus_event = intern_c_string ("dbus-event");
11830 staticpro (&Qdbus_event);
11831 #endif
11833 Qconfig_changed_event = intern_c_string ("config-changed-event");
11834 staticpro (&Qconfig_changed_event);
11836 Qmenu_enable = intern_c_string ("menu-enable");
11837 staticpro (&Qmenu_enable);
11838 QCenable = intern_c_string (":enable");
11839 staticpro (&QCenable);
11840 QCvisible = intern_c_string (":visible");
11841 staticpro (&QCvisible);
11842 QChelp = intern_c_string (":help");
11843 staticpro (&QChelp);
11844 QCfilter = intern_c_string (":filter");
11845 staticpro (&QCfilter);
11846 QCbutton = intern_c_string (":button");
11847 staticpro (&QCbutton);
11848 QCkeys = intern_c_string (":keys");
11849 staticpro (&QCkeys);
11850 QCkey_sequence = intern_c_string (":key-sequence");
11851 staticpro (&QCkey_sequence);
11852 QCtoggle = intern_c_string (":toggle");
11853 staticpro (&QCtoggle);
11854 QCradio = intern_c_string (":radio");
11855 staticpro (&QCradio);
11857 Qmode_line = intern_c_string ("mode-line");
11858 staticpro (&Qmode_line);
11859 Qvertical_line = intern_c_string ("vertical-line");
11860 staticpro (&Qvertical_line);
11861 Qvertical_scroll_bar = intern_c_string ("vertical-scroll-bar");
11862 staticpro (&Qvertical_scroll_bar);
11863 Qmenu_bar = intern_c_string ("menu-bar");
11864 staticpro (&Qmenu_bar);
11866 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
11867 Qmouse_fixup_help_message = intern_c_string ("mouse-fixup-help-message");
11868 staticpro (&Qmouse_fixup_help_message);
11869 #endif
11871 Qabove_handle = intern_c_string ("above-handle");
11872 staticpro (&Qabove_handle);
11873 Qhandle = intern_c_string ("handle");
11874 staticpro (&Qhandle);
11875 Qbelow_handle = intern_c_string ("below-handle");
11876 staticpro (&Qbelow_handle);
11877 Qup = intern_c_string ("up");
11878 staticpro (&Qup);
11879 Qdown = intern_c_string ("down");
11880 staticpro (&Qdown);
11881 Qtop = intern_c_string ("top");
11882 staticpro (&Qtop);
11883 Qbottom = intern_c_string ("bottom");
11884 staticpro (&Qbottom);
11885 Qend_scroll = intern_c_string ("end-scroll");
11886 staticpro (&Qend_scroll);
11887 Qratio = intern_c_string ("ratio");
11888 staticpro (&Qratio);
11890 Qevent_kind = intern_c_string ("event-kind");
11891 staticpro (&Qevent_kind);
11892 Qevent_symbol_elements = intern_c_string ("event-symbol-elements");
11893 staticpro (&Qevent_symbol_elements);
11894 Qevent_symbol_element_mask = intern_c_string ("event-symbol-element-mask");
11895 staticpro (&Qevent_symbol_element_mask);
11896 Qmodifier_cache = intern_c_string ("modifier-cache");
11897 staticpro (&Qmodifier_cache);
11899 Qrecompute_lucid_menubar = intern_c_string ("recompute-lucid-menubar");
11900 staticpro (&Qrecompute_lucid_menubar);
11901 Qactivate_menubar_hook = intern_c_string ("activate-menubar-hook");
11902 staticpro (&Qactivate_menubar_hook);
11904 Qpolling_period = intern_c_string ("polling-period");
11905 staticpro (&Qpolling_period);
11907 Qinput_method_function = intern_c_string ("input-method-function");
11908 staticpro (&Qinput_method_function);
11910 Qinput_method_exit_on_first_char = intern_c_string ("input-method-exit-on-first-char");
11911 staticpro (&Qinput_method_exit_on_first_char);
11912 Qinput_method_use_echo_area = intern_c_string ("input-method-use-echo-area");
11913 staticpro (&Qinput_method_use_echo_area);
11915 Fset (Qinput_method_exit_on_first_char, Qnil);
11916 Fset (Qinput_method_use_echo_area, Qnil);
11918 last_point_position_buffer = Qnil;
11919 last_point_position_window = Qnil;
11922 struct event_head *p;
11924 for (p = head_table;
11925 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
11926 p++)
11928 *p->var = intern_c_string (p->name);
11929 staticpro (p->var);
11930 Fput (*p->var, Qevent_kind, *p->kind);
11931 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
11935 button_down_location = Fmake_vector (make_number (5), Qnil);
11936 staticpro (&button_down_location);
11937 mouse_syms = Fmake_vector (make_number (5), Qnil);
11938 staticpro (&mouse_syms);
11939 wheel_syms = Fmake_vector (make_number (sizeof (lispy_wheel_names)
11940 / sizeof (lispy_wheel_names[0])),
11941 Qnil);
11942 staticpro (&wheel_syms);
11945 int i;
11946 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
11948 modifier_symbols = Fmake_vector (make_number (len), Qnil);
11949 for (i = 0; i < len; i++)
11950 if (modifier_names[i])
11951 XVECTOR (modifier_symbols)->contents[i] = intern_c_string (modifier_names[i]);
11952 staticpro (&modifier_symbols);
11955 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
11956 staticpro (&recent_keys);
11958 this_command_keys = Fmake_vector (make_number (40), Qnil);
11959 staticpro (&this_command_keys);
11961 raw_keybuf = Fmake_vector (make_number (30), Qnil);
11962 staticpro (&raw_keybuf);
11964 Qextended_command_history = intern_c_string ("extended-command-history");
11965 Fset (Qextended_command_history, Qnil);
11966 staticpro (&Qextended_command_history);
11968 accent_key_syms = Qnil;
11969 staticpro (&accent_key_syms);
11971 func_key_syms = Qnil;
11972 staticpro (&func_key_syms);
11974 drag_n_drop_syms = Qnil;
11975 staticpro (&drag_n_drop_syms);
11977 unread_switch_frame = Qnil;
11978 staticpro (&unread_switch_frame);
11980 internal_last_event_frame = Qnil;
11981 staticpro (&internal_last_event_frame);
11983 read_key_sequence_cmd = Qnil;
11984 staticpro (&read_key_sequence_cmd);
11986 menu_bar_one_keymap_changed_items = Qnil;
11987 staticpro (&menu_bar_one_keymap_changed_items);
11989 menu_bar_items_vector = Qnil;
11990 staticpro (&menu_bar_items_vector);
11992 help_form_saved_window_configs = Qnil;
11993 staticpro (&help_form_saved_window_configs);
11995 defsubr (&Scurrent_idle_time);
11996 defsubr (&Sevent_symbol_parse_modifiers);
11997 defsubr (&Sevent_convert_list);
11998 defsubr (&Sread_key_sequence);
11999 defsubr (&Sread_key_sequence_vector);
12000 defsubr (&Srecursive_edit);
12001 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
12002 defsubr (&Strack_mouse);
12003 #endif
12004 defsubr (&Sinput_pending_p);
12005 defsubr (&Scommand_execute);
12006 defsubr (&Srecent_keys);
12007 defsubr (&Sthis_command_keys);
12008 defsubr (&Sthis_command_keys_vector);
12009 defsubr (&Sthis_single_command_keys);
12010 defsubr (&Sthis_single_command_raw_keys);
12011 defsubr (&Sreset_this_command_lengths);
12012 defsubr (&Sclear_this_command_keys);
12013 defsubr (&Ssuspend_emacs);
12014 defsubr (&Sabort_recursive_edit);
12015 defsubr (&Sexit_recursive_edit);
12016 defsubr (&Srecursion_depth);
12017 defsubr (&Stop_level);
12018 defsubr (&Sdiscard_input);
12019 defsubr (&Sopen_dribble_file);
12020 defsubr (&Sset_input_interrupt_mode);
12021 defsubr (&Sset_output_flow_control);
12022 defsubr (&Sset_input_meta_mode);
12023 defsubr (&Sset_quit_char);
12024 defsubr (&Sset_input_mode);
12025 defsubr (&Scurrent_input_mode);
12026 defsubr (&Sexecute_extended_command);
12027 defsubr (&Sposn_at_point);
12028 defsubr (&Sposn_at_x_y);
12030 DEFVAR_LISP ("last-command-event", &last_command_event,
12031 doc: /* Last input event that was part of a command. */);
12033 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
12034 doc: /* Last input event in a command, except for mouse menu events.
12035 Mouse menus give back keys that don't look like mouse events;
12036 this variable holds the actual mouse event that led to the menu,
12037 so that you can determine whether the command was run by mouse or not. */);
12039 DEFVAR_LISP ("last-input-event", &last_input_event,
12040 doc: /* Last input event. */);
12042 DEFVAR_LISP ("unread-command-events", &Vunread_command_events,
12043 doc: /* List of events to be read as the command input.
12044 These events are processed first, before actual keyboard input.
12045 Events read from this list are not normally added to `this-command-keys',
12046 as they will already have been added once as they were read for the first time.
12047 An element of the form (t . EVENT) forces EVENT to be added to that list. */);
12048 Vunread_command_events = Qnil;
12050 DEFVAR_INT ("unread-command-char", &unread_command_char,
12051 doc: /* If not -1, an object to be read as next command input event. */);
12053 DEFVAR_LISP ("unread-post-input-method-events", &Vunread_post_input_method_events,
12054 doc: /* List of events to be processed as input by input methods.
12055 These events are processed before `unread-command-events'
12056 and actual keyboard input, but are not given to `input-method-function'. */);
12057 Vunread_post_input_method_events = Qnil;
12059 DEFVAR_LISP ("unread-input-method-events", &Vunread_input_method_events,
12060 doc: /* List of events to be processed as input by input methods.
12061 These events are processed after `unread-command-events', but
12062 before actual keyboard input.
12063 If there's an active input method, the events are given to
12064 `input-method-function'. */);
12065 Vunread_input_method_events = Qnil;
12067 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
12068 doc: /* Meta-prefix character code.
12069 Meta-foo as command input turns into this character followed by foo. */);
12070 XSETINT (meta_prefix_char, 033);
12072 DEFVAR_KBOARD ("last-command", Vlast_command,
12073 doc: /* The last command executed.
12074 Normally a symbol with a function definition, but can be whatever was found
12075 in the keymap, or whatever the variable `this-command' was set to by that
12076 command.
12078 The value `mode-exit' is special; it means that the previous command
12079 read an event that told it to exit, and it did so and unread that event.
12080 In other words, the present command is the event that made the previous
12081 command exit.
12083 The value `kill-region' is special; it means that the previous command
12084 was a kill command.
12086 `last-command' has a separate binding for each terminal device.
12087 See Info node `(elisp)Multiple displays'. */);
12089 DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
12090 doc: /* Same as `last-command', but never altered by Lisp code. */);
12092 DEFVAR_KBOARD ("last-repeatable-command", Vlast_repeatable_command,
12093 doc: /* Last command that may be repeated.
12094 The last command executed that was not bound to an input event.
12095 This is the command `repeat' will try to repeat. */);
12097 DEFVAR_LISP ("this-command", &Vthis_command,
12098 doc: /* The command now being executed.
12099 The command can set this variable; whatever is put here
12100 will be in `last-command' during the following command. */);
12101 Vthis_command = Qnil;
12103 DEFVAR_LISP ("this-command-keys-shift-translated",
12104 &Vthis_command_keys_shift_translated,
12105 doc: /* Non-nil if the key sequence activating this command was shift-translated.
12106 Shift-translation occurs when there is no binding for the key sequence
12107 as entered, but a binding was found by changing an upper-case letter
12108 to lower-case, or a shifted function key to an unshifted one. */);
12109 Vthis_command_keys_shift_translated = Qnil;
12111 DEFVAR_LISP ("this-original-command", &Vthis_original_command,
12112 doc: /* The command bound to the current key sequence before remapping.
12113 It equals `this-command' if the original command was not remapped through
12114 any of the active keymaps. Otherwise, the value of `this-command' is the
12115 result of looking up the original command in the active keymaps. */);
12116 Vthis_original_command = Qnil;
12118 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
12119 doc: /* *Number of input events between auto-saves.
12120 Zero means disable autosaving due to number of characters typed. */);
12121 auto_save_interval = 300;
12123 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
12124 doc: /* *Number of seconds idle time before auto-save.
12125 Zero or nil means disable auto-saving due to idleness.
12126 After auto-saving due to this many seconds of idle time,
12127 Emacs also does a garbage collection if that seems to be warranted. */);
12128 XSETFASTINT (Vauto_save_timeout, 30);
12130 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes,
12131 doc: /* *Nonzero means echo unfinished commands after this many seconds of pause.
12132 The value may be integer or floating point. */);
12133 Vecho_keystrokes = make_number (1);
12135 DEFVAR_INT ("polling-period", &polling_period,
12136 doc: /* *Interval between polling for input during Lisp execution.
12137 The reason for polling is to make C-g work to stop a running program.
12138 Polling is needed only when using X windows and SIGIO does not work.
12139 Polling is automatically disabled in all other cases. */);
12140 polling_period = 2;
12142 DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
12143 doc: /* *Maximum time between mouse clicks to make a double-click.
12144 Measured in milliseconds. The value nil means disable double-click
12145 recognition; t means double-clicks have no time limit and are detected
12146 by position only. */);
12147 Vdouble_click_time = make_number (500);
12149 DEFVAR_INT ("double-click-fuzz", &double_click_fuzz,
12150 doc: /* *Maximum mouse movement between clicks to make a double-click.
12151 On window-system frames, value is the number of pixels the mouse may have
12152 moved horizontally or vertically between two clicks to make a double-click.
12153 On non window-system frames, value is interpreted in units of 1/8 characters
12154 instead of pixels.
12156 This variable is also the threshold for motion of the mouse
12157 to count as a drag. */);
12158 double_click_fuzz = 3;
12160 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
12161 doc: /* *Non-nil means inhibit local map menu bar menus. */);
12162 inhibit_local_menu_bar_menus = 0;
12164 DEFVAR_INT ("num-input-keys", &num_input_keys,
12165 doc: /* Number of complete key sequences read as input so far.
12166 This includes key sequences read from keyboard macros.
12167 The number is effectively the number of interactive command invocations. */);
12168 num_input_keys = 0;
12170 DEFVAR_INT ("num-nonmacro-input-events", &num_nonmacro_input_events,
12171 doc: /* Number of input events read from the keyboard so far.
12172 This does not include events generated by keyboard macros. */);
12173 num_nonmacro_input_events = 0;
12175 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
12176 doc: /* The frame in which the most recently read event occurred.
12177 If the last event came from a keyboard macro, this is set to `macro'. */);
12178 Vlast_event_frame = Qnil;
12180 /* This variable is set up in sysdep.c. */
12181 DEFVAR_LISP ("tty-erase-char", &Vtty_erase_char,
12182 doc: /* The ERASE character as set by the user with stty. */);
12184 DEFVAR_LISP ("help-char", &Vhelp_char,
12185 doc: /* Character to recognize as meaning Help.
12186 When it is read, do `(eval help-form)', and display result if it's a string.
12187 If the value of `help-form' is nil, this char can be read normally. */);
12188 XSETINT (Vhelp_char, Ctl ('H'));
12190 DEFVAR_LISP ("help-event-list", &Vhelp_event_list,
12191 doc: /* List of input events to recognize as meaning Help.
12192 These work just like the value of `help-char' (see that). */);
12193 Vhelp_event_list = Qnil;
12195 DEFVAR_LISP ("help-form", &Vhelp_form,
12196 doc: /* Form to execute when character `help-char' is read.
12197 If the form returns a string, that string is displayed.
12198 If `help-form' is nil, the help char is not recognized. */);
12199 Vhelp_form = Qnil;
12201 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
12202 doc: /* Command to run when `help-char' character follows a prefix key.
12203 This command is used only when there is no actual binding
12204 for that character after that prefix key. */);
12205 Vprefix_help_command = Qnil;
12207 DEFVAR_LISP ("top-level", &Vtop_level,
12208 doc: /* Form to evaluate when Emacs starts up.
12209 Useful to set before you dump a modified Emacs. */);
12210 Vtop_level = Qnil;
12212 DEFVAR_KBOARD ("keyboard-translate-table", Vkeyboard_translate_table,
12213 doc: /* Translate table for local keyboard input, or nil.
12214 If non-nil, the value should be a char-table. Each character read
12215 from the keyboard is looked up in this char-table. If the value found
12216 there is non-nil, then it is used instead of the actual input character.
12218 The value can also be a string or vector, but this is considered obsolete.
12219 If it is a string or vector of length N, character codes N and up are left
12220 untranslated. In a vector, an element which is nil means "no translation".
12222 This is applied to the characters supplied to input methods, not their
12223 output. See also `translation-table-for-input'.
12225 This variable has a separate binding for each terminal. See Info node
12226 `(elisp)Multiple displays'. */);
12228 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
12229 doc: /* Non-nil means to always spawn a subshell instead of suspending.
12230 \(Even if the operating system has support for stopping a process.\) */);
12231 cannot_suspend = 0;
12233 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
12234 doc: /* Non-nil means prompt with menus when appropriate.
12235 This is done when reading from a keymap that has a prompt string,
12236 for elements that have prompt strings.
12237 The menu is displayed on the screen
12238 if X menus were enabled at configuration
12239 time and the previous event was a mouse click prefix key.
12240 Otherwise, menu prompting uses the echo area. */);
12241 menu_prompting = 1;
12243 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
12244 doc: /* Character to see next line of menu prompt.
12245 Type this character while in a menu prompt to rotate around the lines of it. */);
12246 XSETINT (menu_prompt_more_char, ' ');
12248 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
12249 doc: /* A mask of additional modifier keys to use with every keyboard character.
12250 Emacs applies the modifiers of the character stored here to each keyboard
12251 character it reads. For example, after evaluating the expression
12252 (setq extra-keyboard-modifiers ?\\C-x)
12253 all input characters will have the control modifier applied to them.
12255 Note that the character ?\\C-@, equivalent to the integer zero, does
12256 not count as a control character; rather, it counts as a character
12257 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero
12258 cancels any modification. */);
12259 extra_keyboard_modifiers = 0;
12261 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
12262 doc: /* If an editing command sets this to t, deactivate the mark afterward.
12263 The command loop sets this to nil before each command,
12264 and tests the value when the command returns.
12265 Buffer modification stores t in this variable. */);
12266 Vdeactivate_mark = Qnil;
12267 Qdeactivate_mark = intern_c_string ("deactivate-mark");
12268 staticpro (&Qdeactivate_mark);
12270 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal,
12271 doc: /* Temporary storage of `pre-command-hook' or `post-command-hook'. */);
12272 Vcommand_hook_internal = Qnil;
12274 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
12275 doc: /* Normal hook run before each command is executed.
12276 If an unhandled error happens in running this hook,
12277 the hook value is set to nil, since otherwise the error
12278 might happen repeatedly and make Emacs nonfunctional. */);
12279 Vpre_command_hook = Qnil;
12281 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
12282 doc: /* Normal hook run after each command is executed.
12283 If an unhandled error happens in running this hook,
12284 the hook value is set to nil, since otherwise the error
12285 might happen repeatedly and make Emacs nonfunctional. */);
12286 Vpost_command_hook = Qnil;
12288 #if 0
12289 DEFVAR_LISP ("echo-area-clear-hook", ...,
12290 doc: /* Normal hook run when clearing the echo area. */);
12291 #endif
12292 Qecho_area_clear_hook = intern_c_string ("echo-area-clear-hook");
12293 staticpro (&Qecho_area_clear_hook);
12294 Fset (Qecho_area_clear_hook, Qnil);
12296 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
12297 doc: /* Non-nil means menu bar, specified Lucid style, needs to be recomputed. */);
12298 Vlucid_menu_bar_dirty_flag = Qnil;
12300 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
12301 doc: /* List of menu bar items to move to the end of the menu bar.
12302 The elements of the list are event types that may have menu bar bindings. */);
12303 Vmenu_bar_final_items = Qnil;
12305 DEFVAR_KBOARD ("overriding-terminal-local-map",
12306 Voverriding_terminal_local_map,
12307 doc: /* Per-terminal keymap that overrides all other local keymaps.
12308 If this variable is non-nil, it is used as a keymap instead of the
12309 buffer's local map, and the minor mode keymaps and text property keymaps.
12310 It also replaces `overriding-local-map'.
12312 This variable is intended to let commands such as `universal-argument'
12313 set up a different keymap for reading the next command.
12315 `overriding-terminal-local-map' has a separate binding for each
12316 terminal device.
12317 See Info node `(elisp)Multiple displays'. */);
12319 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map,
12320 doc: /* Keymap that overrides all other local keymaps.
12321 If this variable is non-nil, it is used as a keymap--replacing the
12322 buffer's local map, the minor mode keymaps, and char property keymaps. */);
12323 Voverriding_local_map = Qnil;
12325 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag,
12326 doc: /* Non-nil means `overriding-local-map' applies to the menu bar.
12327 Otherwise, the menu bar continues to reflect the buffer's local map
12328 and the minor mode maps regardless of `overriding-local-map'. */);
12329 Voverriding_local_map_menu_flag = Qnil;
12331 DEFVAR_LISP ("special-event-map", &Vspecial_event_map,
12332 doc: /* Keymap defining bindings for special events to execute at low level. */);
12333 Vspecial_event_map = Fcons (intern_c_string ("keymap"), Qnil);
12335 DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
12336 doc: /* *Non-nil means generate motion events for mouse motion. */);
12338 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
12339 doc: /* Alist of system-specific X windows key symbols.
12340 Each element should have the form (N . SYMBOL) where N is the
12341 numeric keysym code (sans the \"system-specific\" bit 1<<28)
12342 and SYMBOL is its name.
12344 `system-key-alist' has a separate binding for each terminal device.
12345 See Info node `(elisp)Multiple displays'. */);
12347 DEFVAR_KBOARD ("local-function-key-map", Vlocal_function_key_map,
12348 doc: /* Keymap that translates key sequences to key sequences during input.
12349 This is used mainly for mapping key sequences into some preferred
12350 key events (symbols).
12352 The `read-key-sequence' function replaces any subsequence bound by
12353 `local-function-key-map' with its binding. More precisely, when the
12354 active keymaps have no binding for the current key sequence but
12355 `local-function-key-map' binds a suffix of the sequence to a vector or
12356 string, `read-key-sequence' replaces the matching suffix with its
12357 binding, and continues with the new sequence.
12359 If the binding is a function, it is called with one argument (the prompt)
12360 and its return value (a key sequence) is used.
12362 The events that come from bindings in `local-function-key-map' are not
12363 themselves looked up in `local-function-key-map'.
12365 For example, suppose `local-function-key-map' binds `ESC O P' to [f1].
12366 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
12367 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix key,
12368 typing `ESC O P x' would return [f1 x].
12370 `local-function-key-map' has a separate binding for each terminal
12371 device. See Info node `(elisp)Multiple displays'. If you need to
12372 define a binding on all terminals, change `function-key-map'
12373 instead. Initially, `local-function-key-map' is an empty keymap that
12374 has `function-key-map' as its parent on all terminal devices. */);
12376 DEFVAR_KBOARD ("input-decode-map", Vinput_decode_map,
12377 doc: /* Keymap that decodes input escape sequences.
12378 This is used mainly for mapping ASCII function key sequences into
12379 real Emacs function key events (symbols).
12381 The `read-key-sequence' function replaces any subsequence bound by
12382 `input-decode-map' with its binding. Contrary to `function-key-map',
12383 this map applies its rebinding regardless of the presence of an ordinary
12384 binding. So it is more like `key-translation-map' except that it applies
12385 before `function-key-map' rather than after.
12387 If the binding is a function, it is called with one argument (the prompt)
12388 and its return value (a key sequence) is used.
12390 The events that come from bindings in `input-decode-map' are not
12391 themselves looked up in `input-decode-map'.
12393 This variable is keyboard-local. */);
12395 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
12396 doc: /* The parent keymap of all `local-function-key-map' instances.
12397 Function key definitions that apply to all terminal devices should go
12398 here. If a mapping is defined in both the current
12399 `local-function-key-map' binding and this variable, then the local
12400 definition will take precendence. */);
12401 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
12403 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
12404 doc: /* Keymap of key translations that can override keymaps.
12405 This keymap works like `function-key-map', but comes after that,
12406 and its non-prefix bindings override ordinary bindings.
12407 Another difference is that it is global rather than keyboard-local. */);
12408 Vkey_translation_map = Fmake_sparse_keymap (Qnil);
12410 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list,
12411 doc: /* List of deferred actions to be performed at a later time.
12412 The precise format isn't relevant here; we just check whether it is nil. */);
12413 Vdeferred_action_list = Qnil;
12415 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function,
12416 doc: /* Function to call to handle deferred actions, after each command.
12417 This function is called with no arguments after each command
12418 whenever `deferred-action-list' is non-nil. */);
12419 Vdeferred_action_function = Qnil;
12421 DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings,
12422 doc: /* *Non-nil means show the equivalent key-binding when M-x command has one.
12423 The value can be a length of time to show the message for.
12424 If the value is non-nil and not a number, we wait 2 seconds. */);
12425 Vsuggest_key_bindings = Qt;
12427 DEFVAR_LISP ("timer-list", &Vtimer_list,
12428 doc: /* List of active absolute time timers in order of increasing time. */);
12429 Vtimer_list = Qnil;
12431 DEFVAR_LISP ("timer-idle-list", &Vtimer_idle_list,
12432 doc: /* List of active idle-time timers in order of increasing time. */);
12433 Vtimer_idle_list = Qnil;
12435 DEFVAR_LISP ("input-method-function", &Vinput_method_function,
12436 doc: /* If non-nil, the function that implements the current input method.
12437 It's called with one argument, a printing character that was just read.
12438 \(That means a character with code 040...0176.)
12439 Typically this function uses `read-event' to read additional events.
12440 When it does so, it should first bind `input-method-function' to nil
12441 so it will not be called recursively.
12443 The function should return a list of zero or more events
12444 to be used as input. If it wants to put back some events
12445 to be reconsidered, separately, by the input method,
12446 it can add them to the beginning of `unread-command-events'.
12448 The input method function can find in `input-method-previous-message'
12449 the previous echo area message.
12451 The input method function should refer to the variables
12452 `input-method-use-echo-area' and `input-method-exit-on-first-char'
12453 for guidance on what to do. */);
12454 Vinput_method_function = Qnil;
12456 DEFVAR_LISP ("input-method-previous-message",
12457 &Vinput_method_previous_message,
12458 doc: /* When `input-method-function' is called, hold the previous echo area message.
12459 This variable exists because `read-event' clears the echo area
12460 before running the input method. It is nil if there was no message. */);
12461 Vinput_method_previous_message = Qnil;
12463 DEFVAR_LISP ("show-help-function", &Vshow_help_function,
12464 doc: /* If non-nil, the function that implements the display of help.
12465 It's called with one argument, the help string to display. */);
12466 Vshow_help_function = Qnil;
12468 DEFVAR_LISP ("disable-point-adjustment", &Vdisable_point_adjustment,
12469 doc: /* If non-nil, suppress point adjustment after executing a command.
12471 After a command is executed, if point is moved into a region that has
12472 special properties (e.g. composition, display), we adjust point to
12473 the boundary of the region. But, when a command sets this variable to
12474 non-nil, we suppress the point adjustment.
12476 This variable is set to nil before reading a command, and is checked
12477 just after executing the command. */);
12478 Vdisable_point_adjustment = Qnil;
12480 DEFVAR_LISP ("global-disable-point-adjustment",
12481 &Vglobal_disable_point_adjustment,
12482 doc: /* *If non-nil, always suppress point adjustment.
12484 The default value is nil, in which case, point adjustment are
12485 suppressed only after special commands that set
12486 `disable-point-adjustment' (which see) to non-nil. */);
12487 Vglobal_disable_point_adjustment = Qnil;
12489 DEFVAR_LISP ("minibuffer-message-timeout", &Vminibuffer_message_timeout,
12490 doc: /* *How long to display an echo-area message when the minibuffer is active.
12491 If the value is not a number, such messages don't time out. */);
12492 Vminibuffer_message_timeout = make_number (2);
12494 DEFVAR_LISP ("throw-on-input", &Vthrow_on_input,
12495 doc: /* If non-nil, any keyboard input throws to this symbol.
12496 The value of that variable is passed to `quit-flag' and later causes a
12497 peculiar kind of quitting. */);
12498 Vthrow_on_input = Qnil;
12500 DEFVAR_LISP ("command-error-function", &Vcommand_error_function,
12501 doc: /* If non-nil, function to output error messages.
12502 The arguments are the error data, a list of the form
12503 (SIGNALED-CONDITIONS . SIGNAL-DATA)
12504 such as just as `condition-case' would bind its variable to,
12505 the context (a string which normally goes at the start of the message),
12506 and the Lisp function within which the error was signaled. */);
12507 Vcommand_error_function = Qnil;
12509 DEFVAR_LISP ("enable-disabled-menus-and-buttons",
12510 &Venable_disabled_menus_and_buttons,
12511 doc: /* If non-nil, don't ignore events produced by disabled menu items and tool-bar.
12513 Help functions bind this to allow help on disabled menu items
12514 and tool-bar buttons. */);
12515 Venable_disabled_menus_and_buttons = Qnil;
12517 /* Create the initial keyboard. */
12518 initial_kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
12519 init_kboard (initial_kboard);
12520 /* Vwindow_system is left at t for now. */
12521 initial_kboard->next_kboard = all_kboards;
12522 all_kboards = initial_kboard;
12525 void
12526 keys_of_keyboard ()
12528 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
12529 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
12530 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
12531 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
12532 initial_define_key (meta_map, 'x', "execute-extended-command");
12534 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
12535 "handle-delete-frame");
12536 initial_define_lispy_key (Vspecial_event_map, "ns-put-working-text",
12537 "ns-put-working-text");
12538 initial_define_lispy_key (Vspecial_event_map, "ns-unput-working-text",
12539 "ns-unput-working-text");
12540 /* Here we used to use `ignore-event' which would simple set prefix-arg to
12541 current-prefix-arg, as is done in `handle-switch-frame'.
12542 But `handle-switch-frame is not run from the special-map.
12543 Commands from that map are run in a special way that automatically
12544 preserves the prefix-arg. Restoring the prefix arg here is not just
12545 redundant but harmful:
12546 - C-u C-x v =
12547 - current-prefix-arg is set to non-nil, prefix-arg is set to nil.
12548 - after the first prompt, the exit-minibuffer-hook is run which may
12549 iconify a frame and thus push a `iconify-frame' event.
12550 - after running exit-minibuffer-hook, current-prefix-arg is
12551 restored to the non-nil value it had before the prompt.
12552 - we enter the second prompt.
12553 current-prefix-arg is non-nil, prefix-arg is nil.
12554 - before running the first real event, we run the special iconify-frame
12555 event, but we pass the `special' arg to execute-command so
12556 current-prefix-arg and prefix-arg are left untouched.
12557 - here we foolishly copy the non-nil current-prefix-arg to prefix-arg.
12558 - the next key event will have a spuriously non-nil current-prefix-arg. */
12559 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
12560 "ignore");
12561 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
12562 "ignore");
12563 /* Handling it at such a low-level causes read_key_sequence to get
12564 * confused because it doesn't realize that the current_buffer was
12565 * changed by read_char.
12567 * initial_define_lispy_key (Vspecial_event_map, "select-window",
12568 * "handle-select-window"); */
12569 initial_define_lispy_key (Vspecial_event_map, "save-session",
12570 "handle-save-session");
12572 #ifdef HAVE_DBUS
12573 /* Define a special event which is raised for dbus callback
12574 functions. */
12575 initial_define_lispy_key (Vspecial_event_map, "dbus-event",
12576 "dbus-handle-event");
12577 #endif
12579 initial_define_lispy_key (Vspecial_event_map, "config-changed-event",
12580 "ignore");
12583 /* Mark the pointers in the kboard objects.
12584 Called by the Fgarbage_collector. */
12585 void
12586 mark_kboards ()
12588 KBOARD *kb;
12589 Lisp_Object *p;
12590 for (kb = all_kboards; kb; kb = kb->next_kboard)
12592 if (kb->kbd_macro_buffer)
12593 for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
12594 mark_object (*p);
12595 mark_object (kb->Voverriding_terminal_local_map);
12596 mark_object (kb->Vlast_command);
12597 mark_object (kb->Vreal_last_command);
12598 mark_object (kb->Vkeyboard_translate_table);
12599 mark_object (kb->Vlast_repeatable_command);
12600 mark_object (kb->Vprefix_arg);
12601 mark_object (kb->Vlast_prefix_arg);
12602 mark_object (kb->kbd_queue);
12603 mark_object (kb->defining_kbd_macro);
12604 mark_object (kb->Vlast_kbd_macro);
12605 mark_object (kb->Vsystem_key_alist);
12606 mark_object (kb->system_key_syms);
12607 mark_object (kb->Vwindow_system);
12608 mark_object (kb->Vinput_decode_map);
12609 mark_object (kb->Vlocal_function_key_map);
12610 mark_object (kb->Vdefault_minibuffer_frame);
12611 mark_object (kb->echo_string);
12614 struct input_event *event;
12615 for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++)
12617 if (event == kbd_buffer + KBD_BUFFER_SIZE)
12618 event = kbd_buffer;
12619 if (event->kind != SELECTION_REQUEST_EVENT
12620 && event->kind != SELECTION_CLEAR_EVENT)
12622 mark_object (event->x);
12623 mark_object (event->y);
12625 mark_object (event->frame_or_window);
12626 mark_object (event->arg);
12631 /* arch-tag: 774e34d7-6d31-42f3-8397-e079a4e4c9ca
12632 (do not change this comment) */