*** empty log message ***
[emacs.git] / src / keyboard.c
blobaae29f6335289e985a6ece25b306a006e59614b2
1 /* Keyboard and mouse input; editor command loop.
2 Copyright (C) 1985,86,87,88,89,93,94,95,96,97,99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 #include <config.h>
23 #include <signal.h>
24 #include <stdio.h>
25 #include "termchar.h"
26 #include "termopts.h"
27 #include "lisp.h"
28 #include "termhooks.h"
29 #include "macros.h"
30 #include "keyboard.h"
31 #include "frame.h"
32 #include "window.h"
33 #include "commands.h"
34 #include "buffer.h"
35 #include "charset.h"
36 #include "disptab.h"
37 #include "dispextern.h"
38 #include "syntax.h"
39 #include "intervals.h"
40 #include "blockinput.h"
41 #include "puresize.h"
42 #include "systime.h"
43 #include "atimer.h"
44 #include <setjmp.h>
45 #include <errno.h>
47 #ifdef MSDOS
48 #include "msdos.h"
49 #include <time.h>
50 #else /* not MSDOS */
51 #ifndef VMS
52 #include <sys/ioctl.h>
53 #endif
54 #endif /* not MSDOS */
56 #include "syssignal.h"
57 #include "systty.h"
59 #include <sys/types.h>
60 #ifdef HAVE_UNISTD_H
61 #include <unistd.h>
62 #endif
64 /* This is to get the definitions of the XK_ symbols. */
65 #ifdef HAVE_X_WINDOWS
66 #include "xterm.h"
67 #endif
69 #ifdef HAVE_NTGUI
70 #include "w32term.h"
71 #endif /* HAVE_NTGUI */
73 #ifdef macintosh
74 #include "macterm.h"
75 #endif
77 /* Include systime.h after xterm.h to avoid double inclusion of time.h. */
78 #include "systime.h"
80 #ifndef USE_CRT_DLL
81 extern int errno;
82 #endif
84 /* Variables for blockinput.h: */
86 /* Non-zero if interrupt input is blocked right now. */
87 int interrupt_input_blocked;
89 /* Nonzero means an input interrupt has arrived
90 during the current critical section. */
91 int interrupt_input_pending;
94 /* File descriptor to use for input. */
95 extern int input_fd;
97 #ifdef HAVE_WINDOW_SYSTEM
98 /* Make all keyboard buffers much bigger when using X windows. */
99 #ifdef macintosh
100 /* But not too big (local data > 32K error) if on macintosh. */
101 #define KBD_BUFFER_SIZE 512
102 #else
103 #define KBD_BUFFER_SIZE 4096
104 #endif
105 #else /* No X-windows, character input */
106 #define KBD_BUFFER_SIZE 4096
107 #endif /* No X-windows */
109 #define abs(x) ((x) >= 0 ? (x) : -(x))
111 /* Following definition copied from eval.c */
113 struct backtrace
115 struct backtrace *next;
116 Lisp_Object *function;
117 Lisp_Object *args; /* Points to vector of args. */
118 int nargs; /* length of vector. If nargs is UNEVALLED,
119 args points to slot holding list of
120 unevalled args */
121 char evalargs;
124 #ifdef MULTI_KBOARD
125 KBOARD *initial_kboard;
126 KBOARD *current_kboard;
127 KBOARD *all_kboards;
128 int single_kboard;
129 #else
130 KBOARD the_only_kboard;
131 #endif
133 /* Non-nil disable property on a command means
134 do not execute it; call disabled-command-hook's value instead. */
135 Lisp_Object Qdisabled, Qdisabled_command_hook;
137 #define NUM_RECENT_KEYS (100)
138 int recent_keys_index; /* Index for storing next element into recent_keys */
139 int total_keys; /* Total number of elements stored into recent_keys */
140 Lisp_Object recent_keys; /* A vector, holding the last 100 keystrokes */
142 /* Vector holding the key sequence that invoked the current command.
143 It is reused for each command, and it may be longer than the current
144 sequence; this_command_key_count indicates how many elements
145 actually mean something.
146 It's easier to staticpro a single Lisp_Object than an array. */
147 Lisp_Object this_command_keys;
148 int this_command_key_count;
150 /* This vector is used as a buffer to record the events that were actually read
151 by read_key_sequence. */
152 Lisp_Object raw_keybuf;
153 int raw_keybuf_count;
155 #define GROW_RAW_KEYBUF \
156 if (raw_keybuf_count == XVECTOR (raw_keybuf)->size) \
158 int newsize = 2 * XVECTOR (raw_keybuf)->size; \
159 Lisp_Object new; \
160 new = Fmake_vector (make_number (newsize), Qnil); \
161 bcopy (XVECTOR (raw_keybuf)->contents, XVECTOR (new)->contents, \
162 raw_keybuf_count * sizeof (Lisp_Object)); \
163 raw_keybuf = new; \
166 /* Number of elements of this_command_keys
167 that precede this key sequence. */
168 int this_single_command_key_start;
170 /* Record values of this_command_key_count and echo_length ()
171 before this command was read. */
172 static int before_command_key_count;
173 static int before_command_echo_length;
174 /* Values of before_command_key_count and before_command_echo_length
175 saved by reset-this-command-lengths. */
176 static int before_command_key_count_1;
177 static int before_command_echo_length_1;
178 /* Flag set by reset-this-command-lengths,
179 saying to reset the lengths when add_command_key is called. */
180 static int before_command_restore_flag;
182 extern int minbuf_level;
184 extern int message_enable_multibyte;
186 extern struct backtrace *backtrace_list;
188 /* If non-nil, the function that implements the display of help.
189 It's called with one argument, the help string to display. */
191 Lisp_Object Vshow_help_function;
193 /* If a string, the message displayed before displaying a help-echo
194 in the echo area. */
196 Lisp_Object Vpre_help_message;
198 /* Nonzero means do menu prompting. */
200 static int menu_prompting;
202 /* Character to see next line of menu prompt. */
204 static Lisp_Object menu_prompt_more_char;
206 /* For longjmp to where kbd input is being done. */
208 static jmp_buf getcjmp;
210 /* True while doing kbd input. */
211 int waiting_for_input;
213 /* True while displaying for echoing. Delays C-g throwing. */
215 int echoing;
217 /* Non-null means we can start echoing at the next input pause even
218 though there is something in the echo area. */
220 static struct kboard *ok_to_echo_at_next_pause;
222 /* The kboard last echoing, or null for none. Reset to 0 in
223 cancel_echoing. If non-null, and a current echo area message
224 exists, and echo_message_buffer is eq to the current message
225 buffer, we know that the message comes from echo_kboard. */
227 struct kboard *echo_kboard;
229 /* The buffer used for echoing. Set in echo_now, reset in
230 cancel_echoing. */
232 Lisp_Object echo_message_buffer;
234 /* Nonzero means disregard local maps for the menu bar. */
235 static int inhibit_local_menu_bar_menus;
237 /* Nonzero means C-g should cause immediate error-signal. */
238 int immediate_quit;
240 /* The user's ERASE setting. */
241 Lisp_Object Vtty_erase_char;
243 /* Character to recognize as the help char. */
244 Lisp_Object Vhelp_char;
246 /* List of other event types to recognize as meaning "help". */
247 Lisp_Object Vhelp_event_list;
249 /* Form to execute when help char is typed. */
250 Lisp_Object Vhelp_form;
252 /* Command to run when the help character follows a prefix key. */
253 Lisp_Object Vprefix_help_command;
255 /* List of items that should move to the end of the menu bar. */
256 Lisp_Object Vmenu_bar_final_items;
258 /* Non-nil means show the equivalent key-binding for
259 any M-x command that has one.
260 The value can be a length of time to show the message for.
261 If the value is non-nil and not a number, we wait 2 seconds. */
262 Lisp_Object Vsuggest_key_bindings;
264 /* How long to display an echo-area message when the minibuffer is active.
265 If the value is not a number, such messages don't time out. */
266 Lisp_Object Vminibuffer_message_timeout;
268 /* Character that causes a quit. Normally C-g.
270 If we are running on an ordinary terminal, this must be an ordinary
271 ASCII char, since we want to make it our interrupt character.
273 If we are not running on an ordinary terminal, it still needs to be
274 an ordinary ASCII char. This character needs to be recognized in
275 the input interrupt handler. At this point, the keystroke is
276 represented as a struct input_event, while the desired quit
277 character is specified as a lispy event. The mapping from struct
278 input_events to lispy events cannot run in an interrupt handler,
279 and the reverse mapping is difficult for anything but ASCII
280 keystrokes.
282 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
283 ASCII character. */
284 int quit_char;
286 extern Lisp_Object current_global_map;
287 extern int minibuf_level;
289 /* If non-nil, this is a map that overrides all other local maps. */
290 Lisp_Object Voverriding_local_map;
292 /* If non-nil, Voverriding_local_map applies to the menu bar. */
293 Lisp_Object Voverriding_local_map_menu_flag;
295 /* Keymap that defines special misc events that should
296 be processed immediately at a low level. */
297 Lisp_Object Vspecial_event_map;
299 /* Current depth in recursive edits. */
300 int command_loop_level;
302 /* Total number of times command_loop has read a key sequence. */
303 int num_input_keys;
305 /* Last input character read as a command. */
306 Lisp_Object last_command_char;
308 /* Last input character read as a command, not counting menus
309 reached by the mouse. */
310 Lisp_Object last_nonmenu_event;
312 /* Last input character read for any purpose. */
313 Lisp_Object last_input_char;
315 /* If not Qnil, a list of objects to be read as subsequent command input. */
316 Lisp_Object Vunread_command_events;
318 /* If not Qnil, a list of objects to be read as subsequent command input
319 including input method processing. */
320 Lisp_Object Vunread_input_method_events;
322 /* If not Qnil, a list of objects to be read as subsequent command input
323 but NOT including input method processing. */
324 Lisp_Object Vunread_post_input_method_events;
326 /* If not -1, an event to be read as subsequent command input. */
327 int unread_command_char;
329 /* If not Qnil, this is a switch-frame event which we decided to put
330 off until the end of a key sequence. This should be read as the
331 next command input, after any unread_command_events.
333 read_key_sequence uses this to delay switch-frame events until the
334 end of the key sequence; Fread_char uses it to put off switch-frame
335 events until a non-ASCII event is acceptable as input. */
336 Lisp_Object unread_switch_frame;
338 /* A mask of extra modifier bits to put into every keyboard char. */
339 int extra_keyboard_modifiers;
341 /* Char to use as prefix when a meta character is typed in.
342 This is bound on entry to minibuffer in case ESC is changed there. */
344 Lisp_Object meta_prefix_char;
346 /* Last size recorded for a current buffer which is not a minibuffer. */
347 static int last_non_minibuf_size;
349 /* Number of idle seconds before an auto-save and garbage collection. */
350 static Lisp_Object Vauto_save_timeout;
352 /* Total number of times read_char has returned. */
353 int num_input_events;
355 /* Total number of times read_char has returned, outside of macros. */
356 int num_nonmacro_input_events;
358 /* Auto-save automatically when this many characters have been typed
359 since the last time. */
361 static int auto_save_interval;
363 /* Value of num_nonmacro_input_events as of last auto save. */
365 int last_auto_save;
367 /* The command being executed by the command loop.
368 Commands may set this, and the value set will be copied into
369 current_kboard->Vlast_command instead of the actual command. */
370 Lisp_Object Vthis_command;
372 /* This is like Vthis_command, except that commands never set it. */
373 Lisp_Object real_this_command;
375 /* The value of point when the last command was executed. */
376 int last_point_position;
378 /* The buffer that was current when the last command was started. */
379 Lisp_Object last_point_position_buffer;
381 /* The frame in which the last input event occurred, or Qmacro if the
382 last event came from a macro. We use this to determine when to
383 generate switch-frame events. This may be cleared by functions
384 like Fselect_frame, to make sure that a switch-frame event is
385 generated by the next character. */
386 Lisp_Object internal_last_event_frame;
388 /* A user-visible version of the above, intended to allow users to
389 figure out where the last event came from, if the event doesn't
390 carry that information itself (i.e. if it was a character). */
391 Lisp_Object Vlast_event_frame;
393 /* The timestamp of the last input event we received from the X server.
394 X Windows wants this for selection ownership. */
395 unsigned long last_event_timestamp;
397 Lisp_Object Qself_insert_command;
398 Lisp_Object Qforward_char;
399 Lisp_Object Qbackward_char;
400 Lisp_Object Qundefined;
401 Lisp_Object Qtimer_event_handler;
403 /* read_key_sequence stores here the command definition of the
404 key sequence that it reads. */
405 Lisp_Object read_key_sequence_cmd;
407 /* Echo unfinished commands after this many seconds of pause. */
408 Lisp_Object Vecho_keystrokes;
410 /* Form to evaluate (if non-nil) when Emacs is started. */
411 Lisp_Object Vtop_level;
413 /* User-supplied string to translate input characters through. */
414 Lisp_Object Vkeyboard_translate_table;
416 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
417 extern Lisp_Object Vfunction_key_map;
419 /* Another keymap that maps key sequences into key sequences.
420 This one takes precedence over ordinary definitions. */
421 extern Lisp_Object Vkey_translation_map;
423 /* If non-nil, this implements the current input method. */
424 Lisp_Object Vinput_method_function;
425 Lisp_Object Qinput_method_function;
427 /* When we call Vinput_method_function,
428 this holds the echo area message that was just erased. */
429 Lisp_Object Vinput_method_previous_message;
431 /* Non-nil means deactivate the mark at end of this command. */
432 Lisp_Object Vdeactivate_mark;
434 /* Menu bar specified in Lucid Emacs fashion. */
436 Lisp_Object Vlucid_menu_bar_dirty_flag;
437 Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
439 Lisp_Object Qecho_area_clear_hook;
441 /* Hooks to run before and after each command. */
442 Lisp_Object Qpre_command_hook, Vpre_command_hook;
443 Lisp_Object Qpost_command_hook, Vpost_command_hook;
444 Lisp_Object Qcommand_hook_internal, Vcommand_hook_internal;
445 /* Hook run after a command if there's no more input soon. */
446 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
448 /* Delay time in microseconds before running post-command-idle-hook. */
449 int post_command_idle_delay;
451 /* List of deferred actions to be performed at a later time.
452 The precise format isn't relevant here; we just check whether it is nil. */
453 Lisp_Object Vdeferred_action_list;
455 /* Function to call to handle deferred actions, when there are any. */
456 Lisp_Object Vdeferred_action_function;
457 Lisp_Object Qdeferred_action_function;
459 Lisp_Object Qinput_method_exit_on_first_char;
460 Lisp_Object Qinput_method_use_echo_area;
462 /* File in which we write all commands we read. */
463 FILE *dribble;
465 /* Nonzero if input is available. */
466 int input_pending;
468 /* 1 if should obey 0200 bit in input chars as "Meta", 2 if should
469 keep 0200 bit in input chars. 0 to ignore the 0200 bit. */
471 int meta_key;
473 /* Non-zero means force key bindings update in parse_menu_item. */
475 int update_menu_bindings;
477 extern char *pending_malloc_warning;
479 /* Circular buffer for pre-read keyboard input. */
481 static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
483 /* Vector to GCPRO the Lisp objects referenced from kbd_buffer.
485 The interrupt-level event handlers will never enqueue an event on a
486 frame which is not in Vframe_list, and once an event is dequeued,
487 internal_last_event_frame or the event itself points to the frame.
488 So that's all fine.
490 But while the event is sitting in the queue, it's completely
491 unprotected. Suppose the user types one command which will run for
492 a while and then delete a frame, and then types another event at
493 the frame that will be deleted, before the command gets around to
494 it. Suppose there are no references to this frame elsewhere in
495 Emacs, and a GC occurs before the second event is dequeued. Now we
496 have an event referring to a freed frame, which will crash Emacs
497 when it is dequeued.
499 Similar things happen when an event on a scroll bar is enqueued; the
500 window may be deleted while the event is in the queue.
502 So, we use this vector to protect the Lisp_Objects in the event
503 queue. That way, they'll be dequeued as dead frames or windows,
504 but still valid Lisp objects.
506 If kbd_buffer[i].kind != no_event, then
508 AREF (kbd_buffer_gcpro, 2 * i) == kbd_buffer[i].frame_or_window.
509 AREF (kbd_buffer_gcpro, 2 * i + 1) == kbd_buffer[i].arg. */
511 static Lisp_Object kbd_buffer_gcpro;
513 /* Pointer to next available character in kbd_buffer.
514 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
515 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the the
516 next available char is in kbd_buffer[0]. */
517 static struct input_event *kbd_fetch_ptr;
519 /* Pointer to next place to store character in kbd_buffer. This
520 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
521 character should go in kbd_buffer[0]. */
522 static struct input_event * volatile kbd_store_ptr;
524 /* The above pair of variables forms a "queue empty" flag. When we
525 enqueue a non-hook event, we increment kbd_store_ptr. When we
526 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
527 there is input available iff the two pointers are not equal.
529 Why not just have a flag set and cleared by the enqueuing and
530 dequeuing functions? Such a flag could be screwed up by interrupts
531 at inopportune times. */
533 /* If this flag is non-nil, we check mouse_moved to see when the
534 mouse moves, and motion events will appear in the input stream.
535 Otherwise, mouse motion is ignored. */
536 Lisp_Object do_mouse_tracking;
538 /* Symbols to head events. */
539 Lisp_Object Qmouse_movement;
540 Lisp_Object Qscroll_bar_movement;
541 Lisp_Object Qswitch_frame;
542 Lisp_Object Qdelete_frame;
543 Lisp_Object Qiconify_frame;
544 Lisp_Object Qmake_frame_visible;
545 Lisp_Object Qhelp_echo;
547 /* Symbols to denote kinds of events. */
548 Lisp_Object Qfunction_key;
549 Lisp_Object Qmouse_click;
550 #ifdef WINDOWSNT
551 Lisp_Object Qmouse_wheel;
552 Lisp_Object Qlanguage_change;
553 #endif
554 Lisp_Object Qdrag_n_drop;
555 /* Lisp_Object Qmouse_movement; - also an event header */
557 /* Properties of event headers. */
558 Lisp_Object Qevent_kind;
559 Lisp_Object Qevent_symbol_elements;
561 /* menu item parts */
562 Lisp_Object Qmenu_alias;
563 Lisp_Object Qmenu_enable;
564 Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCkeys, QCkey_sequence;
565 Lisp_Object QCbutton, QCtoggle, QCradio;
566 extern Lisp_Object Vdefine_key_rebound_commands;
567 extern Lisp_Object Qmenu_item;
569 /* An event header symbol HEAD may have a property named
570 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
571 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
572 mask of modifiers applied to it. If present, this is used to help
573 speed up parse_modifiers. */
574 Lisp_Object Qevent_symbol_element_mask;
576 /* An unmodified event header BASE may have a property named
577 Qmodifier_cache, which is an alist mapping modifier masks onto
578 modified versions of BASE. If present, this helps speed up
579 apply_modifiers. */
580 Lisp_Object Qmodifier_cache;
582 /* Symbols to use for parts of windows. */
583 Lisp_Object Qmode_line;
584 Lisp_Object Qvertical_line;
585 Lisp_Object Qvertical_scroll_bar;
586 Lisp_Object Qmenu_bar;
588 Lisp_Object recursive_edit_unwind (), command_loop ();
589 Lisp_Object Fthis_command_keys ();
590 Lisp_Object Qextended_command_history;
591 EMACS_TIME timer_check ();
593 extern Lisp_Object Vhistory_length;
595 extern char *x_get_keysym_name ();
597 static void record_menu_key ();
599 Lisp_Object Qpolling_period;
601 /* List of absolute timers. Appears in order of next scheduled event. */
602 Lisp_Object Vtimer_list;
604 /* List of idle time timers. Appears in order of next scheduled event. */
605 Lisp_Object Vtimer_idle_list;
607 /* Incremented whenever a timer is run. */
608 int timers_run;
610 extern Lisp_Object Vprint_level, Vprint_length;
612 /* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
613 happens. */
614 EMACS_TIME *input_available_clear_time;
616 /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
617 Default is 1 if INTERRUPT_INPUT is defined. */
618 int interrupt_input;
620 /* Nonzero while interrupts are temporarily deferred during redisplay. */
621 int interrupts_deferred;
623 /* Nonzero means use ^S/^Q for flow control. */
624 int flow_control;
626 /* Allow m- file to inhibit use of FIONREAD. */
627 #ifdef BROKEN_FIONREAD
628 #undef FIONREAD
629 #endif
631 /* We are unable to use interrupts if FIONREAD is not available,
632 so flush SIGIO so we won't try. */
633 #ifndef FIONREAD
634 #ifdef SIGIO
635 #undef SIGIO
636 #endif
637 #endif
639 /* If we support a window system, turn on the code to poll periodically
640 to detect C-g. It isn't actually used when doing interrupt input. */
641 #ifdef HAVE_WINDOW_SYSTEM
642 #define POLL_FOR_INPUT
643 #endif
645 /* After a command is executed, if point is moved into a region that
646 has specific properties (e.g. composition, display), we adjust
647 point to the boundary of the region. But, if a command sets this
648 valiable to non-nil, we suppress this point adjustment. This
649 variable is set to nil before reading a command. */
651 Lisp_Object Vdisable_point_adjustment;
653 /* If non-nil, always disable point adjustment. */
655 Lisp_Object Vglobal_disable_point_adjustment;
657 /* The time when Emacs started being idle. */
659 static EMACS_TIME timer_idleness_start_time;
662 /* Global variable declarations. */
664 /* Function for init_keyboard to call with no args (if nonzero). */
665 void (*keyboard_init_hook) ();
667 static int read_avail_input P_ ((int));
668 static void get_input_pending P_ ((int *, int));
669 static int readable_events P_ ((int));
670 static Lisp_Object read_char_x_menu_prompt P_ ((int, Lisp_Object *,
671 Lisp_Object, int *));
672 static Lisp_Object read_char_x_menu_prompt ();
673 static Lisp_Object read_char_minibuf_menu_prompt P_ ((int, int,
674 Lisp_Object *));
675 static Lisp_Object make_lispy_event P_ ((struct input_event *));
676 #ifdef HAVE_MOUSE
677 static Lisp_Object make_lispy_movement P_ ((struct frame *, Lisp_Object,
678 enum scroll_bar_part,
679 Lisp_Object, Lisp_Object,
680 unsigned long));
681 #endif
682 static Lisp_Object modify_event_symbol P_ ((int, unsigned, Lisp_Object,
683 Lisp_Object, char **,
684 Lisp_Object *, unsigned));
685 static Lisp_Object make_lispy_switch_frame P_ ((Lisp_Object));
686 static int parse_solitary_modifier P_ ((Lisp_Object));
687 static int parse_solitary_modifier ();
688 static void save_getcjmp P_ ((jmp_buf));
689 static void save_getcjmp ();
690 static void restore_getcjmp P_ ((jmp_buf));
691 static Lisp_Object apply_modifiers P_ ((int, Lisp_Object));
692 static void clear_event P_ ((struct input_event *));
693 static void any_kboard_state P_ ((void));
695 /* Nonzero means don't try to suspend even if the operating system seems
696 to support it. */
697 static int cannot_suspend;
699 #define min(a,b) ((a)<(b)?(a):(b))
700 #define max(a,b) ((a)>(b)?(a):(b))
702 /* Install the string STR as the beginning of the string of echoing,
703 so that it serves as a prompt for the next character.
704 Also start echoing. */
706 void
707 echo_prompt (str)
708 Lisp_Object str;
710 int nbytes = STRING_BYTES (XSTRING (str));
711 int multibyte_p = STRING_MULTIBYTE (str);
713 if (nbytes > ECHOBUFSIZE - 4)
715 if (multibyte_p)
717 /* Have to find the last character that fit's into the
718 echo buffer. */
719 unsigned char *p = XSTRING (str)->data;
720 unsigned char *pend = p + ECHOBUFSIZE - 4;
721 int char_len;
725 PARSE_MULTIBYTE_SEQ (p, pend - p, char_len);
726 p += char_len;
728 while (p < pend);
730 nbytes = p - XSTRING (str)->data - char_len;
732 else
733 nbytes = ECHOBUFSIZE - 4;
736 nbytes = copy_text (XSTRING (str)->data, current_kboard->echobuf, nbytes,
737 STRING_MULTIBYTE (str), 1);
738 current_kboard->echoptr = current_kboard->echobuf + nbytes;
739 *current_kboard->echoptr = '\0';
740 current_kboard->echo_after_prompt = nbytes;
742 echo_now ();
745 /* Add C to the echo string, if echoing is going on.
746 C can be a character, which is printed prettily ("M-C-x" and all that
747 jazz), or a symbol, whose name is printed. */
749 void
750 echo_char (c)
751 Lisp_Object c;
753 if (current_kboard->immediate_echo)
755 char *ptr = current_kboard->echoptr;
757 if (ptr != current_kboard->echobuf)
758 *ptr++ = ' ';
760 /* If someone has passed us a composite event, use its head symbol. */
761 c = EVENT_HEAD (c);
763 if (INTEGERP (c))
765 int ch = XINT (c);
767 if (ptr - current_kboard->echobuf
768 > ECHOBUFSIZE - KEY_DESCRIPTION_SIZE)
769 return;
771 ptr = push_key_description (ch, ptr, 1);
773 else if (SYMBOLP (c))
775 struct Lisp_String *name = XSYMBOL (c)->name;
776 if ((ptr - current_kboard->echobuf) + STRING_BYTES (name) + 4
777 > ECHOBUFSIZE)
778 return;
779 ptr += copy_text (name->data, ptr, STRING_BYTES (name),
780 name->size_byte >= 0, 1);
783 if (current_kboard->echoptr == current_kboard->echobuf
784 && help_char_p (c))
786 strcpy (ptr, " (Type ? for further options)");
787 ptr += strlen (ptr);
790 *ptr = 0;
791 current_kboard->echoptr = ptr;
793 echo_now ();
797 /* Temporarily add a dash to the end of the echo string if it's not
798 empty, so that it serves as a mini-prompt for the very next character. */
800 void
801 echo_dash ()
803 if (!current_kboard->immediate_echo
804 && current_kboard->echoptr == current_kboard->echobuf)
805 return;
806 /* Do nothing if we just printed a prompt. */
807 if (current_kboard->echo_after_prompt
808 == current_kboard->echoptr - current_kboard->echobuf)
809 return;
810 /* Do nothing if not echoing at all. */
811 if (current_kboard->echoptr == 0)
812 return;
814 /* Put a dash at the end of the buffer temporarily,
815 but make it go away when the next character is added. */
816 current_kboard->echoptr[0] = '-';
817 current_kboard->echoptr[1] = 0;
819 echo_now ();
822 /* Display the current echo string, and begin echoing if not already
823 doing so. */
825 void
826 echo_now ()
828 if (!current_kboard->immediate_echo)
830 int i;
831 current_kboard->immediate_echo = 1;
833 for (i = 0; i < this_command_key_count; i++)
835 Lisp_Object c;
836 c = XVECTOR (this_command_keys)->contents[i];
837 if (! (EVENT_HAS_PARAMETERS (c)
838 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
839 echo_char (c);
841 echo_dash ();
844 echoing = 1;
845 message2_nolog (current_kboard->echobuf, strlen (current_kboard->echobuf),
847 echoing = 0;
849 /* Record in what buffer we echoed, and from which kboard. */
850 echo_message_buffer = echo_area_buffer[0];
851 echo_kboard = current_kboard;
853 if (waiting_for_input && !NILP (Vquit_flag))
854 quit_throw_to_read_char ();
857 /* Turn off echoing, for the start of a new command. */
859 void
860 cancel_echoing ()
862 current_kboard->immediate_echo = 0;
863 current_kboard->echoptr = current_kboard->echobuf;
864 current_kboard->echo_after_prompt = -1;
865 ok_to_echo_at_next_pause = NULL;
866 echo_kboard = NULL;
867 echo_message_buffer = Qnil;
870 /* Return the length of the current echo string. */
872 static int
873 echo_length ()
875 return current_kboard->echoptr - current_kboard->echobuf;
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 (len)
884 int len;
886 current_kboard->echobuf[len] = '\0';
887 current_kboard->echoptr = current_kboard->echobuf + len;
888 truncate_echo_area (len);
892 /* Functions for manipulating this_command_keys. */
893 static void
894 add_command_key (key)
895 Lisp_Object key;
897 /* If reset-this-command-length was called recently, obey it now.
898 See the doc string of that function for an explanation of why. */
899 if (before_command_restore_flag)
901 this_command_key_count = before_command_key_count_1;
902 if (this_command_key_count < this_single_command_key_start)
903 this_single_command_key_start = this_command_key_count;
904 echo_truncate (before_command_echo_length_1);
905 before_command_restore_flag = 0;
908 if (this_command_key_count >= ASIZE (this_command_keys))
909 this_command_keys = larger_vector (this_command_keys,
910 2 * ASIZE (this_command_keys),
911 Qnil);
913 AREF (this_command_keys, this_command_key_count) = key;
914 ++this_command_key_count;
918 Lisp_Object
919 recursive_edit_1 ()
921 int count = specpdl_ptr - specpdl;
922 Lisp_Object val;
924 if (command_loop_level > 0)
926 specbind (Qstandard_output, Qt);
927 specbind (Qstandard_input, Qt);
930 #ifdef HAVE_X_WINDOWS
931 /* The command loop has started an hourglass timer, so we have to
932 cancel it here, otherwise it will fire because the recursive edit
933 can take some time. */
934 if (display_hourglass_p)
935 cancel_hourglass ();
936 #endif
938 /* This function may have been called from a debugger called from
939 within redisplay, for instance by Edebugging a function called
940 from fontification-functions. We want to allow redisplay in
941 the debugging session.
943 The recursive edit is left with a `(throw exit ...)'. The `exit'
944 tag is not caught anywhere in redisplay, i.e. when we leave the
945 recursive edit, the original redisplay leading to the recursive
946 edit will be unwound. The outcome should therefore be safe. */
947 specbind (Qinhibit_redisplay, Qnil);
948 redisplaying_p = 0;
950 val = command_loop ();
951 if (EQ (val, Qt))
952 Fsignal (Qquit, Qnil);
953 /* Handle throw from read_minibuf when using minibuffer
954 while it's active but we're in another window. */
955 if (STRINGP (val))
956 Fsignal (Qerror, Fcons (val, Qnil));
958 return unbind_to (count, Qnil);
961 /* When an auto-save happens, record the "time", and don't do again soon. */
963 void
964 record_auto_save ()
966 last_auto_save = num_nonmacro_input_events;
969 /* Make an auto save happen as soon as possible at command level. */
971 void
972 force_auto_save_soon ()
974 last_auto_save = - auto_save_interval - 1;
976 record_asynch_buffer_change ();
979 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
980 "Invoke the editor command loop recursively.\n\
981 To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
982 that tells this function to return.\n\
983 Alternately, `(throw 'exit t)' makes this function signal an error.\n\
984 This function is called by the editor initialization to begin editing.")
987 int count = specpdl_ptr - specpdl;
988 Lisp_Object buffer;
990 command_loop_level++;
991 update_mode_lines = 1;
993 if (command_loop_level
994 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
995 buffer = Fcurrent_buffer ();
996 else
997 buffer = Qnil;
999 /* If we leave recursive_edit_1 below with a `throw' for instance,
1000 like it is done in the splash screen display, we have to
1001 make sure that we restore single_kboard as command_loop_1
1002 would have done if it were left normally. */
1003 record_unwind_protect (recursive_edit_unwind,
1004 Fcons (buffer, single_kboard ? Qt : Qnil));
1006 recursive_edit_1 ();
1007 return unbind_to (count, Qnil);
1010 Lisp_Object
1011 recursive_edit_unwind (info)
1012 Lisp_Object info;
1014 if (BUFFERP (XCAR (info)))
1015 Fset_buffer (XCAR (info));
1017 if (NILP (XCDR (info)))
1018 any_kboard_state ();
1019 else
1020 single_kboard_state ();
1022 command_loop_level--;
1023 update_mode_lines = 1;
1024 return Qnil;
1028 static void
1029 any_kboard_state ()
1031 #ifdef MULTI_KBOARD
1032 #if 0 /* Theory: if there's anything in Vunread_command_events,
1033 it will right away be read by read_key_sequence,
1034 and then if we do switch KBOARDS, it will go into the side
1035 queue then. So we don't need to do anything special here -- rms. */
1036 if (CONSP (Vunread_command_events))
1038 current_kboard->kbd_queue
1039 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
1040 current_kboard->kbd_queue_has_data = 1;
1042 Vunread_command_events = Qnil;
1043 #endif
1044 single_kboard = 0;
1045 #endif
1048 /* Switch to the single-kboard state, making current_kboard
1049 the only KBOARD from which further input is accepted. */
1051 void
1052 single_kboard_state ()
1054 #ifdef MULTI_KBOARD
1055 single_kboard = 1;
1056 #endif
1059 /* Maintain a stack of kboards, so other parts of Emacs
1060 can switch temporarily to the kboard of a given frame
1061 and then revert to the previous status. */
1063 struct kboard_stack
1065 KBOARD *kboard;
1066 struct kboard_stack *next;
1069 static struct kboard_stack *kboard_stack;
1071 void
1072 push_frame_kboard (f)
1073 FRAME_PTR f;
1075 #ifdef MULTI_KBOARD
1076 struct kboard_stack *p
1077 = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
1079 p->next = kboard_stack;
1080 p->kboard = current_kboard;
1081 kboard_stack = p;
1083 current_kboard = FRAME_KBOARD (f);
1084 #endif
1087 void
1088 pop_frame_kboard ()
1090 #ifdef MULTI_KBOARD
1091 struct kboard_stack *p = kboard_stack;
1092 current_kboard = p->kboard;
1093 kboard_stack = p->next;
1094 xfree (p);
1095 #endif
1098 /* Handle errors that are not handled at inner levels
1099 by printing an error message and returning to the editor command loop. */
1101 Lisp_Object
1102 cmd_error (data)
1103 Lisp_Object data;
1105 Lisp_Object old_level, old_length;
1106 char macroerror[50];
1108 if (!NILP (executing_macro))
1110 if (executing_macro_iterations == 1)
1111 sprintf (macroerror, "After 1 kbd macro iteration: ");
1112 else
1113 sprintf (macroerror, "After %d kbd macro iterations: ",
1114 executing_macro_iterations);
1116 else
1117 *macroerror = 0;
1119 Vstandard_output = Qt;
1120 Vstandard_input = Qt;
1121 Vexecuting_macro = Qnil;
1122 executing_macro = Qnil;
1123 current_kboard->Vprefix_arg = Qnil;
1124 current_kboard->Vlast_prefix_arg = Qnil;
1125 cancel_echoing ();
1127 /* Avoid unquittable loop if data contains a circular list. */
1128 old_level = Vprint_level;
1129 old_length = Vprint_length;
1130 XSETFASTINT (Vprint_level, 10);
1131 XSETFASTINT (Vprint_length, 10);
1132 cmd_error_internal (data, macroerror);
1133 Vprint_level = old_level;
1134 Vprint_length = old_length;
1136 Vquit_flag = Qnil;
1138 Vinhibit_quit = Qnil;
1139 #ifdef MULTI_KBOARD
1140 any_kboard_state ();
1141 #endif
1143 return make_number (0);
1146 /* Take actions on handling an error. DATA is the data that describes
1147 the error.
1149 CONTEXT is a C-string containing ASCII characters only which
1150 describes the context in which the error happened. If we need to
1151 generalize CONTEXT to allow multibyte characters, make it a Lisp
1152 string. */
1154 void
1155 cmd_error_internal (data, context)
1156 Lisp_Object data;
1157 char *context;
1159 Lisp_Object stream;
1160 int kill_emacs_p = 0;
1161 struct frame *sf = SELECTED_FRAME ();
1163 Vquit_flag = Qnil;
1164 Vinhibit_quit = Qt;
1165 clear_message (1, 0);
1167 /* If the window system or terminal frame hasn't been initialized
1168 yet, or we're not interactive, it's best to dump this message out
1169 to stderr and exit. */
1170 if (!sf->glyphs_initialized_p
1171 /* This is the case of the frame dumped with Emacs, when we're
1172 running under a window system. */
1173 || (!NILP (Vwindow_system)
1174 && !inhibit_window_system
1175 && FRAME_TERMCAP_P (sf))
1176 || noninteractive)
1178 stream = Qexternal_debugging_output;
1179 kill_emacs_p = 1;
1181 else
1183 Fdiscard_input ();
1184 bitch_at_user ();
1185 stream = Qt;
1188 if (context != 0)
1189 write_string_1 (context, -1, stream);
1191 print_error_message (data, stream);
1193 /* If the window system or terminal frame hasn't been initialized
1194 yet, or we're in -batch mode, this error should cause Emacs to exit. */
1195 if (kill_emacs_p)
1197 Fterpri (stream);
1198 Fkill_emacs (make_number (-1));
1202 Lisp_Object command_loop_1 ();
1203 Lisp_Object command_loop_2 ();
1204 Lisp_Object top_level_1 ();
1206 /* Entry to editor-command-loop.
1207 This level has the catches for exiting/returning to editor command loop.
1208 It returns nil to exit recursive edit, t to abort it. */
1210 Lisp_Object
1211 command_loop ()
1213 if (command_loop_level > 0 || minibuf_level > 0)
1215 Lisp_Object val;
1216 val = internal_catch (Qexit, command_loop_2, Qnil);
1217 executing_macro = Qnil;
1218 return val;
1220 else
1221 while (1)
1223 internal_catch (Qtop_level, top_level_1, Qnil);
1224 internal_catch (Qtop_level, command_loop_2, Qnil);
1225 executing_macro = Qnil;
1227 /* End of file in -batch run causes exit here. */
1228 if (noninteractive)
1229 Fkill_emacs (Qt);
1233 /* Here we catch errors in execution of commands within the
1234 editing loop, and reenter the editing loop.
1235 When there is an error, cmd_error runs and returns a non-nil
1236 value to us. A value of nil means that cmd_loop_1 itself
1237 returned due to end of file (or end of kbd macro). */
1239 Lisp_Object
1240 command_loop_2 ()
1242 register Lisp_Object val;
1245 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1246 while (!NILP (val));
1248 return Qnil;
1251 Lisp_Object
1252 top_level_2 ()
1254 return Feval (Vtop_level);
1257 Lisp_Object
1258 top_level_1 ()
1260 /* On entry to the outer level, run the startup file */
1261 if (!NILP (Vtop_level))
1262 internal_condition_case (top_level_2, Qerror, cmd_error);
1263 else if (!NILP (Vpurify_flag))
1264 message ("Bare impure Emacs (standard Lisp code not loaded)");
1265 else
1266 message ("Bare Emacs (standard Lisp code not loaded)");
1267 return Qnil;
1270 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1271 "Exit all recursive editing levels.")
1274 #ifdef HAVE_X_WINDOWS
1275 if (display_hourglass_p)
1276 cancel_hourglass ();
1277 #endif
1278 return Fthrow (Qtop_level, Qnil);
1281 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1282 "Exit from the innermost recursive edit or minibuffer.")
1285 if (command_loop_level > 0 || minibuf_level > 0)
1286 Fthrow (Qexit, Qnil);
1288 error ("No recursive edit is in progress");
1289 return Qnil;
1292 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1293 "Abort the command that requested this recursive edit or minibuffer input.")
1296 if (command_loop_level > 0 || minibuf_level > 0)
1297 Fthrow (Qexit, Qt);
1299 error ("No recursive edit is in progress");
1300 return Qnil;
1303 /* This is the actual command reading loop,
1304 sans error-handling encapsulation. */
1306 EXFUN (Fcommand_execute, 4);
1307 static int read_key_sequence P_ ((Lisp_Object *, int, Lisp_Object,
1308 int, int, int));
1309 void safe_run_hooks P_ ((Lisp_Object));
1310 static void adjust_point_for_property P_ ((int));
1312 Lisp_Object
1313 command_loop_1 ()
1315 Lisp_Object cmd;
1316 int lose;
1317 int nonundocount;
1318 Lisp_Object keybuf[30];
1319 int i;
1320 int no_direct;
1321 int prev_modiff;
1322 struct buffer *prev_buffer = NULL;
1323 #ifdef MULTI_KBOARD
1324 int was_locked = single_kboard;
1325 #endif
1327 current_kboard->Vprefix_arg = Qnil;
1328 current_kboard->Vlast_prefix_arg = Qnil;
1329 Vdeactivate_mark = Qnil;
1330 waiting_for_input = 0;
1331 cancel_echoing ();
1333 nonundocount = 0;
1334 this_command_key_count = 0;
1335 this_single_command_key_start = 0;
1337 /* Make sure this hook runs after commands that get errors and
1338 throw to top level. */
1339 /* Note that the value cell will never directly contain nil
1340 if the symbol is a local variable. */
1341 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1342 safe_run_hooks (Qpost_command_hook);
1344 /* If displaying a message, resize the echo area window to fit
1345 that message's size exactly. */
1346 if (!NILP (echo_area_buffer[0]))
1347 resize_echo_area_exactly ();
1349 if (!NILP (Vdeferred_action_list))
1350 call0 (Vdeferred_action_function);
1352 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1354 if (NILP (Vunread_command_events)
1355 && NILP (Vunread_input_method_events)
1356 && NILP (Vunread_post_input_method_events)
1357 && NILP (Vexecuting_macro)
1358 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
1359 safe_run_hooks (Qpost_command_idle_hook);
1362 /* Do this after running Vpost_command_hook, for consistency. */
1363 current_kboard->Vlast_command = Vthis_command;
1364 current_kboard->Vreal_last_command = real_this_command;
1366 while (1)
1368 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1369 Fkill_emacs (Qnil);
1371 /* Make sure the current window's buffer is selected. */
1372 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1373 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1375 /* Display any malloc warning that just came out. Use while because
1376 displaying one warning can cause another. */
1378 while (pending_malloc_warning)
1379 display_malloc_warning ();
1381 no_direct = 0;
1383 Vdeactivate_mark = Qnil;
1385 /* If minibuffer on and echo area in use,
1386 wait a short time and redraw minibuffer. */
1388 if (minibuf_level
1389 && !NILP (echo_area_buffer[0])
1390 && EQ (minibuf_window, echo_area_window)
1391 && NUMBERP (Vminibuffer_message_timeout))
1393 /* Bind inhibit-quit to t so that C-g gets read in
1394 rather than quitting back to the minibuffer. */
1395 int count = specpdl_ptr - specpdl;
1396 specbind (Qinhibit_quit, Qt);
1398 Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil);
1399 /* Clear the echo area. */
1400 message2 (0, 0, 0);
1401 safe_run_hooks (Qecho_area_clear_hook);
1403 unbind_to (count, Qnil);
1405 /* If a C-g came in before, treat it as input now. */
1406 if (!NILP (Vquit_flag))
1408 Vquit_flag = Qnil;
1409 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
1413 #ifdef C_ALLOCA
1414 alloca (0); /* Cause a garbage collection now */
1415 /* Since we can free the most stuff here. */
1416 #endif /* C_ALLOCA */
1418 #if 0
1419 /* Select the frame that the last event came from. Usually,
1420 switch-frame events will take care of this, but if some lisp
1421 code swallows a switch-frame event, we'll fix things up here.
1422 Is this a good idea? */
1423 if (FRAMEP (internal_last_event_frame)
1424 && !EQ (internal_last_event_frame, selected_frame))
1425 Fselect_frame (internal_last_event_frame, Qnil);
1426 #endif
1427 /* If it has changed current-menubar from previous value,
1428 really recompute the menubar from the value. */
1429 if (! NILP (Vlucid_menu_bar_dirty_flag)
1430 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
1431 call0 (Qrecompute_lucid_menubar);
1433 before_command_key_count = this_command_key_count;
1434 before_command_echo_length = echo_length ();
1436 Vthis_command = Qnil;
1437 real_this_command = Qnil;
1439 /* Read next key sequence; i gets its length. */
1440 i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
1441 Qnil, 0, 1, 1);
1443 /* A filter may have run while we were reading the input. */
1444 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1445 Fkill_emacs (Qnil);
1446 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1447 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1449 ++num_input_keys;
1451 /* Now we have read a key sequence of length I,
1452 or else I is 0 and we found end of file. */
1454 if (i == 0) /* End of file -- happens only in */
1455 return Qnil; /* a kbd macro, at the end. */
1456 /* -1 means read_key_sequence got a menu that was rejected.
1457 Just loop around and read another command. */
1458 if (i == -1)
1460 cancel_echoing ();
1461 this_command_key_count = 0;
1462 this_single_command_key_start = 0;
1463 goto finalize;
1466 last_command_char = keybuf[i - 1];
1468 /* If the previous command tried to force a specific window-start,
1469 forget about that, in case this command moves point far away
1470 from that position. But also throw away beg_unchanged and
1471 end_unchanged information in that case, so that redisplay will
1472 update the whole window properly. */
1473 if (!NILP (XWINDOW (selected_window)->force_start))
1475 struct buffer *b;
1476 XWINDOW (selected_window)->force_start = Qnil;
1477 b = XBUFFER (XWINDOW (selected_window)->buffer);
1478 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
1481 cmd = read_key_sequence_cmd;
1482 if (!NILP (Vexecuting_macro))
1484 if (!NILP (Vquit_flag))
1486 Vexecuting_macro = Qt;
1487 QUIT; /* Make some noise. */
1488 /* Will return since macro now empty. */
1492 /* Do redisplay processing after this command except in special
1493 cases identified below. */
1494 prev_buffer = current_buffer;
1495 prev_modiff = MODIFF;
1496 last_point_position = PT;
1497 XSETBUFFER (last_point_position_buffer, prev_buffer);
1499 /* By default, we adjust point to a boundary of a region that
1500 has such a property that should be treated intangible
1501 (e.g. composition, display). But, some commands will set
1502 this variable differently. */
1503 Vdisable_point_adjustment = Qnil;
1505 /* Process filters and timers may have messed with deactivate-mark.
1506 reset it before we execute the command. */
1507 Vdeactivate_mark = Qnil;
1509 /* Execute the command. */
1511 Vthis_command = cmd;
1512 real_this_command = cmd;
1513 /* Note that the value cell will never directly contain nil
1514 if the symbol is a local variable. */
1515 if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks))
1516 safe_run_hooks (Qpre_command_hook);
1518 if (NILP (Vthis_command))
1520 /* nil means key is undefined. */
1521 bitch_at_user ();
1522 current_kboard->defining_kbd_macro = Qnil;
1523 update_mode_lines = 1;
1524 current_kboard->Vprefix_arg = Qnil;
1526 else
1528 if (NILP (current_kboard->Vprefix_arg) && ! no_direct)
1530 /* In case we jump to directly_done. */
1531 Vcurrent_prefix_arg = current_kboard->Vprefix_arg;
1533 /* Recognize some common commands in common situations and
1534 do them directly. */
1535 if (EQ (Vthis_command, Qforward_char) && PT < ZV)
1537 struct Lisp_Char_Table *dp
1538 = window_display_table (XWINDOW (selected_window));
1539 lose = FETCH_CHAR (PT_BYTE);
1540 SET_PT (PT + 1);
1541 if ((dp
1542 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1543 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1544 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1545 && (lose >= 0x20 && lose < 0x7f)))
1546 : (lose >= 0x20 && lose < 0x7f))
1547 /* To extract the case of continuation on
1548 wide-column characters. */
1549 && (WIDTH_BY_CHAR_HEAD (FETCH_BYTE (PT_BYTE)) == 1)
1550 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1551 >= MODIFF)
1552 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1553 >= OVERLAY_MODIFF)
1554 && (XFASTINT (XWINDOW (selected_window)->last_point)
1555 == PT - 1)
1556 && !windows_or_buffers_changed
1557 && EQ (current_buffer->selective_display, Qnil)
1558 && !detect_input_pending ()
1559 && NILP (XWINDOW (selected_window)->column_number_displayed)
1560 && NILP (Vexecuting_macro))
1561 direct_output_forward_char (1);
1562 goto directly_done;
1564 else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV)
1566 struct Lisp_Char_Table *dp
1567 = window_display_table (XWINDOW (selected_window));
1568 SET_PT (PT - 1);
1569 lose = FETCH_CHAR (PT_BYTE);
1570 if ((dp
1571 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1572 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1573 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1574 && (lose >= 0x20 && lose < 0x7f)))
1575 : (lose >= 0x20 && lose < 0x7f))
1576 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1577 >= MODIFF)
1578 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1579 >= OVERLAY_MODIFF)
1580 && (XFASTINT (XWINDOW (selected_window)->last_point)
1581 == PT + 1)
1582 && !windows_or_buffers_changed
1583 && EQ (current_buffer->selective_display, Qnil)
1584 && !detect_input_pending ()
1585 && NILP (XWINDOW (selected_window)->column_number_displayed)
1586 && NILP (Vexecuting_macro))
1587 direct_output_forward_char (-1);
1588 goto directly_done;
1590 else if (EQ (Vthis_command, Qself_insert_command)
1591 /* Try this optimization only on ascii keystrokes. */
1592 && INTEGERP (last_command_char))
1594 unsigned int c = XINT (last_command_char);
1595 int value;
1596 if (NILP (Vexecuting_macro)
1597 && !EQ (minibuf_window, selected_window))
1599 if (!nonundocount || nonundocount >= 20)
1601 Fundo_boundary ();
1602 nonundocount = 0;
1604 nonundocount++;
1607 lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
1608 < MODIFF)
1609 || (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1610 < OVERLAY_MODIFF)
1611 || (XFASTINT (XWINDOW (selected_window)->last_point)
1612 != PT)
1613 || MODIFF <= SAVE_MODIFF
1614 || windows_or_buffers_changed
1615 || !EQ (current_buffer->selective_display, Qnil)
1616 || detect_input_pending ()
1617 || !NILP (XWINDOW (selected_window)->column_number_displayed)
1618 || !NILP (Vexecuting_macro));
1620 value = internal_self_insert (c, 0);
1622 if (value == 2)
1623 nonundocount = 0;
1625 /* VALUE == 1 when AFTER-CHANGE functions are
1626 installed which is the case most of the time
1627 because FONT-LOCK installs one. */
1628 if (!lose && !value)
1629 direct_output_for_insert (c);
1630 goto directly_done;
1634 /* Here for a command that isn't executed directly */
1636 #ifdef HAVE_X_WINDOWS
1637 if (display_hourglass_p)
1638 start_hourglass ();
1639 #endif
1641 nonundocount = 0;
1642 if (NILP (current_kboard->Vprefix_arg))
1643 Fundo_boundary ();
1644 Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
1646 #ifdef HAVE_X_WINDOWS
1647 if (display_hourglass_p)
1648 cancel_hourglass ();
1649 #endif
1651 directly_done: ;
1652 current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg;
1654 /* Note that the value cell will never directly contain nil
1655 if the symbol is a local variable. */
1656 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1657 safe_run_hooks (Qpost_command_hook);
1659 /* If displaying a message, resize the echo area window to fit
1660 that message's size exactly. */
1661 if (!NILP (echo_area_buffer[0]))
1662 resize_echo_area_exactly ();
1664 if (!NILP (Vdeferred_action_list))
1665 safe_run_hooks (Qdeferred_action_function);
1667 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1669 if (NILP (Vunread_command_events)
1670 && NILP (Vunread_input_method_events)
1671 && NILP (Vunread_post_input_method_events)
1672 && NILP (Vexecuting_macro)
1673 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
1674 safe_run_hooks (Qpost_command_idle_hook);
1677 /* If there is a prefix argument,
1678 1) We don't want Vlast_command to be ``universal-argument''
1679 (that would be dumb), so don't set Vlast_command,
1680 2) we want to leave echoing on so that the prefix will be
1681 echoed as part of this key sequence, so don't call
1682 cancel_echoing, and
1683 3) we want to leave this_command_key_count non-zero, so that
1684 read_char will realize that it is re-reading a character, and
1685 not echo it a second time.
1687 If the command didn't actually create a prefix arg,
1688 but is merely a frame event that is transparent to prefix args,
1689 then the above doesn't apply. */
1690 if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_char))
1692 current_kboard->Vlast_command = Vthis_command;
1693 current_kboard->Vreal_last_command = real_this_command;
1694 cancel_echoing ();
1695 this_command_key_count = 0;
1696 this_single_command_key_start = 0;
1699 if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks))
1701 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
1703 current_buffer->mark_active = Qnil;
1704 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
1706 else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1707 call1 (Vrun_hooks, intern ("activate-mark-hook"));
1710 finalize:
1712 if (current_buffer == prev_buffer
1713 && last_point_position != PT
1714 && NILP (Vdisable_point_adjustment)
1715 && NILP (Vglobal_disable_point_adjustment))
1716 adjust_point_for_property (last_point_position);
1718 /* Install chars successfully executed in kbd macro. */
1720 if (!NILP (current_kboard->defining_kbd_macro)
1721 && NILP (current_kboard->Vprefix_arg))
1722 finalize_kbd_macro_chars ();
1724 #ifdef MULTI_KBOARD
1725 if (!was_locked)
1726 any_kboard_state ();
1727 #endif
1731 extern Lisp_Object Qcomposition, Qdisplay;
1733 /* Adjust point to a boundary of a region that has such a property
1734 that should be treated intangible. For the moment, we check
1735 `composition' and `display' property. LAST_PT is the last position
1736 of point. */
1738 static void
1739 adjust_point_for_property (last_pt)
1740 int last_pt;
1742 int start, end;
1743 Lisp_Object val;
1744 int check_composition = 1, check_display = 1;
1746 while (check_composition || check_display)
1748 if (check_composition
1749 && PT > BEGV && PT < ZV
1750 && get_property_and_range (PT, Qcomposition, &val, &start, &end, Qnil)
1751 && COMPOSITION_VALID_P (start, end, val)
1752 && start < PT && end > PT
1753 && (last_pt <= start || last_pt >= end))
1755 if (PT < last_pt)
1756 SET_PT (start);
1757 else
1758 SET_PT (end);
1759 check_display = 1;
1761 check_composition = 0;
1762 if (check_display
1763 && PT > BEGV && PT < ZV
1764 && get_property_and_range (PT, Qdisplay, &val, &start, &end, Qnil)
1765 && display_prop_intangible_p (val)
1766 && start < PT && end > PT
1767 && (last_pt <= start || last_pt >= end))
1769 if (PT < last_pt)
1770 SET_PT (start);
1771 else
1772 SET_PT (end);
1773 check_composition = 1;
1775 check_display = 0;
1779 /* Subroutine for safe_run_hooks: run the hook HOOK. */
1781 static Lisp_Object
1782 safe_run_hooks_1 (hook)
1783 Lisp_Object hook;
1785 return call1 (Vrun_hooks, Vinhibit_quit);
1788 /* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */
1790 static Lisp_Object
1791 safe_run_hooks_error (data)
1792 Lisp_Object data;
1794 return Fset (Vinhibit_quit, Qnil);
1797 /* If we get an error while running the hook, cause the hook variable
1798 to be nil. Also inhibit quits, so that C-g won't cause the hook
1799 to mysteriously evaporate. */
1801 void
1802 safe_run_hooks (hook)
1803 Lisp_Object hook;
1805 int count = specpdl_ptr - specpdl;
1806 specbind (Qinhibit_quit, hook);
1808 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
1810 unbind_to (count, Qnil);
1814 /* Number of seconds between polling for input. This is a Lisp
1815 variable that can be bound. */
1817 int polling_period;
1819 /* Nonzero means polling for input is temporarily suppressed. */
1821 int poll_suppress_count;
1823 /* Asynchronous timer for polling. */
1825 struct atimer *poll_timer;
1828 #ifdef POLL_FOR_INPUT
1830 /* Poll for input, so what we catch a C-g if it comes in. This
1831 function is called from x_make_frame_visible, see comment
1832 there. */
1834 void
1835 poll_for_input_1 ()
1837 if (interrupt_input_blocked == 0
1838 && !waiting_for_input)
1839 read_avail_input (0);
1842 /* Timer callback function for poll_timer. TIMER is equal to
1843 poll_timer. */
1845 void
1846 poll_for_input (timer)
1847 struct atimer *timer;
1849 if (poll_suppress_count == 0)
1850 poll_for_input_1 ();
1853 #endif /* POLL_FOR_INPUT */
1855 /* Begin signals to poll for input, if they are appropriate.
1856 This function is called unconditionally from various places. */
1858 void
1859 start_polling ()
1861 #ifdef POLL_FOR_INPUT
1862 if (read_socket_hook && !interrupt_input)
1864 /* Turn alarm handling on unconditionally. It might have
1865 been turned off in process.c. */
1866 turn_on_atimers (1);
1868 /* If poll timer doesn't exist, are we need one with
1869 a different interval, start a new one. */
1870 if (poll_timer == NULL
1871 || EMACS_SECS (poll_timer->interval) != polling_period)
1873 EMACS_TIME interval;
1875 if (poll_timer)
1876 cancel_atimer (poll_timer);
1878 EMACS_SET_SECS_USECS (interval, polling_period, 0);
1879 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
1880 poll_for_input, NULL);
1883 /* Let the timer's callback function poll for input
1884 if this becomes zero. */
1885 --poll_suppress_count;
1887 #endif
1890 /* Nonzero if we are using polling to handle input asynchronously. */
1893 input_polling_used ()
1895 #ifdef POLL_FOR_INPUT
1896 return read_socket_hook && !interrupt_input;
1897 #else
1898 return 0;
1899 #endif
1902 /* Turn off polling. */
1904 void
1905 stop_polling ()
1907 #ifdef POLL_FOR_INPUT
1908 if (read_socket_hook && !interrupt_input)
1909 ++poll_suppress_count;
1910 #endif
1913 /* Set the value of poll_suppress_count to COUNT
1914 and start or stop polling accordingly. */
1916 void
1917 set_poll_suppress_count (count)
1918 int count;
1920 #ifdef POLL_FOR_INPUT
1921 if (count == 0 && poll_suppress_count != 0)
1923 poll_suppress_count = 1;
1924 start_polling ();
1926 else if (count != 0 && poll_suppress_count == 0)
1928 stop_polling ();
1930 poll_suppress_count = count;
1931 #endif
1934 /* Bind polling_period to a value at least N.
1935 But don't decrease it. */
1937 void
1938 bind_polling_period (n)
1939 int n;
1941 #ifdef POLL_FOR_INPUT
1942 int new = polling_period;
1944 if (n > new)
1945 new = n;
1947 stop_other_atimers (poll_timer);
1948 stop_polling ();
1949 specbind (Qpolling_period, make_number (new));
1950 /* Start a new alarm with the new period. */
1951 start_polling ();
1952 #endif
1955 /* Apply the control modifier to CHARACTER. */
1958 make_ctrl_char (c)
1959 int c;
1961 /* Save the upper bits here. */
1962 int upper = c & ~0177;
1964 c &= 0177;
1966 /* Everything in the columns containing the upper-case letters
1967 denotes a control character. */
1968 if (c >= 0100 && c < 0140)
1970 int oc = c;
1971 c &= ~0140;
1972 /* Set the shift modifier for a control char
1973 made from a shifted letter. But only for letters! */
1974 if (oc >= 'A' && oc <= 'Z')
1975 c |= shift_modifier;
1978 /* The lower-case letters denote control characters too. */
1979 else if (c >= 'a' && c <= 'z')
1980 c &= ~0140;
1982 /* Include the bits for control and shift
1983 only if the basic ASCII code can't indicate them. */
1984 else if (c >= ' ')
1985 c |= ctrl_modifier;
1987 /* Replace the high bits. */
1988 c |= (upper & ~ctrl_modifier);
1990 return c;
1993 /* Display help echo in the echo area.
1995 HELP a string means display that string, HELP nil means clear the
1996 help echo. If HELP is a function, call it with OBJECT and POS as
1997 arguments; the function should return a help string or nil for
1998 none. For all other types of HELP evaluate it to obtain a string.
2000 WINDOW is the window in which the help was generated, if any.
2001 It is nil if not in a window.
2003 If OBJECT is a buffer, POS is the position in the buffer where the
2004 `help-echo' text property was found.
2006 If OBJECT is an overlay, that overlay has a `help-echo' property,
2007 and POS is the position in the overlay's buffer under the mouse.
2009 If OBJECT is a string (an overlay string or a string displayed with
2010 the `display' property). POS is the position in that string under
2011 the mouse.
2013 OK_TO_IVERWRITE_KEYSTROKE_ECHO non-zero means it's okay if the help
2014 echo overwrites a keystroke echo currently displayed in the echo
2015 area.
2017 Note: this function may only be called with HELP nil or a string
2018 from X code running asynchronously. */
2020 void
2021 show_help_echo (help, window, object, pos, ok_to_overwrite_keystroke_echo)
2022 Lisp_Object help, window, object, pos;
2023 int ok_to_overwrite_keystroke_echo;
2025 if (!NILP (help) && !STRINGP (help))
2027 if (FUNCTIONP (help))
2029 Lisp_Object args[4];
2030 args[0] = help;
2031 args[1] = window;
2032 args[2] = object;
2033 args[3] = pos;
2034 help = safe_call (4, args);
2036 else
2037 help = safe_eval (help);
2039 if (!STRINGP (help))
2040 return;
2043 if (STRINGP (help) || NILP (help))
2045 if (!NILP (Vshow_help_function))
2046 call1 (Vshow_help_function, help);
2047 else if (/* Don't overwrite minibuffer contents. */
2048 !MINI_WINDOW_P (XWINDOW (selected_window))
2049 /* Don't overwrite a keystroke echo. */
2050 && (NILP (echo_message_buffer)
2051 || ok_to_overwrite_keystroke_echo)
2052 /* Don't overwrite a prompt. */
2053 && !cursor_in_echo_area)
2055 if (STRINGP (help))
2057 int count = BINDING_STACK_SIZE ();
2059 if (!help_echo_showing_p)
2060 Vpre_help_message = current_message ();
2062 specbind (Qmessage_truncate_lines, Qt);
2063 message3_nolog (help, STRING_BYTES (XSTRING (help)),
2064 STRING_MULTIBYTE (help));
2065 unbind_to (count, Qnil);
2067 else if (STRINGP (Vpre_help_message))
2069 message3_nolog (Vpre_help_message,
2070 STRING_BYTES (XSTRING (Vpre_help_message)),
2071 STRING_MULTIBYTE (Vpre_help_message));
2072 Vpre_help_message = Qnil;
2074 else
2075 message (0);
2078 help_echo_showing_p = STRINGP (help);
2084 /* Input of single characters from keyboard */
2086 Lisp_Object print_help ();
2087 static Lisp_Object kbd_buffer_get_event ();
2088 static void record_char ();
2090 #ifdef MULTI_KBOARD
2091 static jmp_buf wrong_kboard_jmpbuf;
2092 #endif
2094 /* read a character from the keyboard; call the redisplay if needed */
2095 /* commandflag 0 means do not do auto-saving, but do do redisplay.
2096 -1 means do not do redisplay, but do do autosaving.
2097 1 means do both. */
2099 /* The arguments MAPS and NMAPS are for menu prompting.
2100 MAPS is an array of keymaps; NMAPS is the length of MAPS.
2102 PREV_EVENT is the previous input event, or nil if we are reading
2103 the first event of a key sequence (or not reading a key sequence).
2104 If PREV_EVENT is t, that is a "magic" value that says
2105 not to run input methods, but in other respects to act as if
2106 not reading a key sequence.
2108 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
2109 if we used a mouse menu to read the input, or zero otherwise. If
2110 USED_MOUSE_MENU is null, we don't dereference it.
2112 Value is t if we showed a menu and the user rejected it. */
2114 Lisp_Object
2115 read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
2116 int commandflag;
2117 int nmaps;
2118 Lisp_Object *maps;
2119 Lisp_Object prev_event;
2120 int *used_mouse_menu;
2122 volatile Lisp_Object c;
2123 int count;
2124 jmp_buf local_getcjmp;
2125 jmp_buf save_jump;
2126 volatile int key_already_recorded = 0;
2127 Lisp_Object tem, save;
2128 volatile Lisp_Object previous_echo_area_message;
2129 volatile Lisp_Object also_record;
2130 volatile int reread;
2131 struct gcpro gcpro1, gcpro2;
2132 EMACS_TIME last_idle_start;
2134 also_record = Qnil;
2136 before_command_key_count = this_command_key_count;
2137 before_command_echo_length = echo_length ();
2138 c = Qnil;
2139 previous_echo_area_message = Qnil;
2141 GCPRO2 (c, previous_echo_area_message);
2143 retry:
2145 reread = 0;
2146 if (CONSP (Vunread_post_input_method_events))
2148 c = XCAR (Vunread_post_input_method_events);
2149 Vunread_post_input_method_events
2150 = XCDR (Vunread_post_input_method_events);
2152 /* Undo what read_char_x_menu_prompt did when it unread
2153 additional keys returned by Fx_popup_menu. */
2154 if (CONSP (c)
2155 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2156 && NILP (XCDR (c)))
2157 c = XCAR (c);
2159 reread = 1;
2160 goto reread_first;
2163 if (unread_command_char != -1)
2165 XSETINT (c, unread_command_char);
2166 unread_command_char = -1;
2168 reread = 1;
2169 goto reread_first;
2172 if (CONSP (Vunread_command_events))
2174 c = XCAR (Vunread_command_events);
2175 Vunread_command_events = XCDR (Vunread_command_events);
2177 /* Undo what read_char_x_menu_prompt did when it unread
2178 additional keys returned by Fx_popup_menu. */
2179 if (CONSP (c)
2180 && EQ (XCDR (c), Qdisabled)
2181 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))))
2182 c = XCAR (c);
2184 /* If the queued event is something that used the mouse,
2185 set used_mouse_menu accordingly. */
2186 if (used_mouse_menu
2187 && (EQ (c, Qtool_bar) || EQ (c, Qmenu_bar)))
2188 *used_mouse_menu = 1;
2190 reread = 1;
2191 goto reread_for_input_method;
2194 if (CONSP (Vunread_input_method_events))
2196 c = XCAR (Vunread_input_method_events);
2197 Vunread_input_method_events = XCDR (Vunread_input_method_events);
2199 /* Undo what read_char_x_menu_prompt did when it unread
2200 additional keys returned by Fx_popup_menu. */
2201 if (CONSP (c)
2202 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2203 && NILP (XCDR (c)))
2204 c = XCAR (c);
2205 reread = 1;
2206 goto reread_for_input_method;
2209 /* If there is no function key translated before
2210 reset-this-command-lengths takes effect, forget about it. */
2211 before_command_restore_flag = 0;
2213 if (!NILP (Vexecuting_macro))
2215 /* We set this to Qmacro; since that's not a frame, nobody will
2216 try to switch frames on us, and the selected window will
2217 remain unchanged.
2219 Since this event came from a macro, it would be misleading to
2220 leave internal_last_event_frame set to wherever the last
2221 real event came from. Normally, a switch-frame event selects
2222 internal_last_event_frame after each command is read, but
2223 events read from a macro should never cause a new frame to be
2224 selected. */
2225 Vlast_event_frame = internal_last_event_frame = Qmacro;
2227 /* Exit the macro if we are at the end.
2228 Also, some things replace the macro with t
2229 to force an early exit. */
2230 if (EQ (Vexecuting_macro, Qt)
2231 || executing_macro_index >= XFASTINT (Flength (Vexecuting_macro)))
2233 XSETINT (c, -1);
2234 RETURN_UNGCPRO (c);
2237 c = Faref (Vexecuting_macro, make_number (executing_macro_index));
2238 if (STRINGP (Vexecuting_macro)
2239 && (XINT (c) & 0x80))
2240 XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
2242 executing_macro_index++;
2244 goto from_macro;
2247 if (!NILP (unread_switch_frame))
2249 c = unread_switch_frame;
2250 unread_switch_frame = Qnil;
2252 /* This event should make it into this_command_keys, and get echoed
2253 again, so we do not set `reread'. */
2254 goto reread_first;
2257 /* if redisplay was requested */
2258 if (commandflag >= 0)
2260 /* If there is pending input, process any events which are not
2261 user-visible, such as X selection_request events. */
2262 if (input_pending
2263 || detect_input_pending_run_timers (0))
2264 swallow_events (0); /* may clear input_pending */
2266 /* Redisplay if no pending input. */
2267 while (!input_pending)
2269 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
2270 redisplay_preserve_echo_area (5);
2271 else
2272 redisplay ();
2274 if (!input_pending)
2275 /* Normal case: no input arrived during redisplay. */
2276 break;
2278 /* Input arrived and pre-empted redisplay.
2279 Process any events which are not user-visible. */
2280 swallow_events (0);
2281 /* If that cleared input_pending, try again to redisplay. */
2285 /* Message turns off echoing unless more keystrokes turn it on again.
2287 The code in 20.x for the condition was
2289 1. echo_area_glyphs && *echo_area_glyphs
2290 2. && echo_area_glyphs != current_kboard->echobuf
2291 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2293 (1) means there's a current message displayed
2295 (2) means it's not the message from echoing from the current
2296 kboard.
2298 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2299 is set to a non-null value. This is done in read_char and it is
2300 set to echo_area_glyphs after a call to echo_char. That means
2301 ok_to_echo_at_next_pause is either null or
2302 current_kboard->echobuf with the appropriate current_kboard at
2303 that time.
2305 So, condition (3) means in clear text ok_to_echo_at_next_pause
2306 must be either null, or the current message isn't from echoing at
2307 all, or it's from echoing from a different kboard than the
2308 current one. */
2310 if (/* There currently something in the echo area */
2311 !NILP (echo_area_buffer[0])
2312 && (/* And it's either not from echoing. */
2313 !EQ (echo_area_buffer[0], echo_message_buffer)
2314 /* Or it's an echo from a different kboard. */
2315 || echo_kboard != current_kboard
2316 /* Or we explicitly allow overwriting whatever there is. */
2317 || ok_to_echo_at_next_pause == NULL))
2318 cancel_echoing ();
2319 else
2320 echo_dash ();
2322 /* Try reading a character via menu prompting in the minibuf.
2323 Try this before the sit-for, because the sit-for
2324 would do the wrong thing if we are supposed to do
2325 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2326 after a mouse event so don't try a minibuf menu. */
2327 c = Qnil;
2328 if (nmaps > 0 && INTERACTIVE
2329 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2330 /* Don't bring up a menu if we already have another event. */
2331 && NILP (Vunread_command_events)
2332 && unread_command_char < 0
2333 && !detect_input_pending_run_timers (0))
2335 c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
2336 if (! NILP (c))
2338 key_already_recorded = 1;
2339 goto non_reread_1;
2343 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2344 We will do that below, temporarily for short sections of code,
2345 when appropriate. local_getcjmp must be in effect
2346 around any call to sit_for or kbd_buffer_get_event;
2347 it *must not* be in effect when we call redisplay. */
2349 if (_setjmp (local_getcjmp))
2351 XSETINT (c, quit_char);
2352 internal_last_event_frame = selected_frame;
2353 Vlast_event_frame = internal_last_event_frame;
2354 /* If we report the quit char as an event,
2355 don't do so more than once. */
2356 if (!NILP (Vinhibit_quit))
2357 Vquit_flag = Qnil;
2359 #ifdef MULTI_KBOARD
2361 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
2362 if (kb != current_kboard)
2364 Lisp_Object *tailp = &kb->kbd_queue;
2365 /* We shouldn't get here if we were in single-kboard mode! */
2366 if (single_kboard)
2367 abort ();
2368 while (CONSP (*tailp))
2369 tailp = &XCDR (*tailp);
2370 if (!NILP (*tailp))
2371 abort ();
2372 *tailp = Fcons (c, Qnil);
2373 kb->kbd_queue_has_data = 1;
2374 current_kboard = kb;
2375 /* This is going to exit from read_char
2376 so we had better get rid of this frame's stuff. */
2377 UNGCPRO;
2378 longjmp (wrong_kboard_jmpbuf, 1);
2381 #endif
2382 goto non_reread;
2385 timer_start_idle ();
2387 /* If in middle of key sequence and minibuffer not active,
2388 start echoing if enough time elapses. */
2390 if (minibuf_level == 0
2391 && !current_kboard->immediate_echo
2392 && this_command_key_count > 0
2393 && ! noninteractive
2394 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2395 && NILP (Fzerop (Vecho_keystrokes))
2396 && (/* No message. */
2397 NILP (echo_area_buffer[0])
2398 /* Or empty message. */
2399 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2400 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2401 /* Or already echoing from same kboard. */
2402 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2403 /* Or not echoing before and echoing allowed. */
2404 || (!echo_kboard && ok_to_echo_at_next_pause)))
2406 Lisp_Object tem0;
2408 /* After a mouse event, start echoing right away.
2409 This is because we are probably about to display a menu,
2410 and we don't want to delay before doing so. */
2411 if (EVENT_HAS_PARAMETERS (prev_event))
2412 echo_now ();
2413 else
2415 int sec, usec;
2416 double duration = extract_float (Vecho_keystrokes);
2417 sec = (int) duration;
2418 usec = (duration - sec) * 1000000;
2419 save_getcjmp (save_jump);
2420 restore_getcjmp (local_getcjmp);
2421 tem0 = sit_for (sec, usec, 1, 1, 0);
2422 restore_getcjmp (save_jump);
2423 if (EQ (tem0, Qt)
2424 && ! CONSP (Vunread_command_events))
2425 echo_now ();
2429 /* Maybe auto save due to number of keystrokes. */
2431 if (commandflag != 0
2432 && auto_save_interval > 0
2433 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
2434 && !detect_input_pending_run_timers (0))
2436 Fdo_auto_save (Qnil, Qnil);
2437 /* Hooks can actually change some buffers in auto save. */
2438 redisplay ();
2441 /* Try reading using an X menu.
2442 This is never confused with reading using the minibuf
2443 because the recursive call of read_char in read_char_minibuf_menu_prompt
2444 does not pass on any keymaps. */
2446 if (nmaps > 0 && INTERACTIVE
2447 && !NILP (prev_event)
2448 && EVENT_HAS_PARAMETERS (prev_event)
2449 && !EQ (XCAR (prev_event), Qmenu_bar)
2450 && !EQ (XCAR (prev_event), Qtool_bar)
2451 /* Don't bring up a menu if we already have another event. */
2452 && NILP (Vunread_command_events)
2453 && unread_command_char < 0)
2455 c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
2457 /* Now that we have read an event, Emacs is not idle. */
2458 timer_stop_idle ();
2460 RETURN_UNGCPRO (c);
2463 /* Maybe autosave and/or garbage collect due to idleness. */
2465 if (INTERACTIVE && NILP (c))
2467 int delay_level, buffer_size;
2469 /* Slow down auto saves logarithmically in size of current buffer,
2470 and garbage collect while we're at it. */
2471 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2472 last_non_minibuf_size = Z - BEG;
2473 buffer_size = (last_non_minibuf_size >> 8) + 1;
2474 delay_level = 0;
2475 while (buffer_size > 64)
2476 delay_level++, buffer_size -= buffer_size >> 2;
2477 if (delay_level < 4) delay_level = 4;
2478 /* delay_level is 4 for files under around 50k, 7 at 100k,
2479 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2481 /* Auto save if enough time goes by without input. */
2482 if (commandflag != 0
2483 && num_nonmacro_input_events > last_auto_save
2484 && INTEGERP (Vauto_save_timeout)
2485 && XINT (Vauto_save_timeout) > 0)
2487 Lisp_Object tem0;
2489 save_getcjmp (save_jump);
2490 restore_getcjmp (local_getcjmp);
2491 tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4,
2492 0, 1, 1, 0);
2493 restore_getcjmp (save_jump);
2495 if (EQ (tem0, Qt)
2496 && ! CONSP (Vunread_command_events))
2498 Fdo_auto_save (Qnil, Qnil);
2500 /* If we have auto-saved and there is still no input
2501 available, garbage collect if there has been enough
2502 consing going on to make it worthwhile. */
2503 if (!detect_input_pending_run_timers (0)
2504 && consing_since_gc > gc_cons_threshold / 2)
2505 Fgarbage_collect ();
2507 redisplay ();
2512 /* If this has become non-nil here, it has been set by a timer
2513 or sentinel or filter. */
2514 if (CONSP (Vunread_command_events))
2516 c = XCAR (Vunread_command_events);
2517 Vunread_command_events = XCDR (Vunread_command_events);
2520 /* Read something from current KBOARD's side queue, if possible. */
2522 if (NILP (c))
2524 if (current_kboard->kbd_queue_has_data)
2526 if (!CONSP (current_kboard->kbd_queue))
2527 abort ();
2528 c = XCAR (current_kboard->kbd_queue);
2529 current_kboard->kbd_queue
2530 = XCDR (current_kboard->kbd_queue);
2531 if (NILP (current_kboard->kbd_queue))
2532 current_kboard->kbd_queue_has_data = 0;
2533 input_pending = readable_events (0);
2534 if (EVENT_HAS_PARAMETERS (c)
2535 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
2536 internal_last_event_frame = XCAR (XCDR (c));
2537 Vlast_event_frame = internal_last_event_frame;
2541 #ifdef MULTI_KBOARD
2542 /* If current_kboard's side queue is empty check the other kboards.
2543 If one of them has data that we have not yet seen here,
2544 switch to it and process the data waiting for it.
2546 Note: if the events queued up for another kboard
2547 have already been seen here, and therefore are not a complete command,
2548 the kbd_queue_has_data field is 0, so we skip that kboard here.
2549 That's to avoid an infinite loop switching between kboards here. */
2550 if (NILP (c) && !single_kboard)
2552 KBOARD *kb;
2553 for (kb = all_kboards; kb; kb = kb->next_kboard)
2554 if (kb->kbd_queue_has_data)
2556 current_kboard = kb;
2557 /* This is going to exit from read_char
2558 so we had better get rid of this frame's stuff. */
2559 UNGCPRO;
2560 longjmp (wrong_kboard_jmpbuf, 1);
2563 #endif
2565 wrong_kboard:
2567 stop_polling ();
2569 /* Finally, we read from the main queue,
2570 and if that gives us something we can't use yet, we put it on the
2571 appropriate side queue and try again. */
2573 if (NILP (c))
2575 KBOARD *kb;
2577 /* Actually read a character, waiting if necessary. */
2578 save_getcjmp (save_jump);
2579 restore_getcjmp (local_getcjmp);
2580 timer_start_idle ();
2581 c = kbd_buffer_get_event (&kb, used_mouse_menu);
2582 restore_getcjmp (save_jump);
2584 #ifdef MULTI_KBOARD
2585 if (! NILP (c) && (kb != current_kboard))
2587 Lisp_Object *tailp = &kb->kbd_queue;
2588 while (CONSP (*tailp))
2589 tailp = &XCDR (*tailp);
2590 if (!NILP (*tailp))
2591 abort ();
2592 *tailp = Fcons (c, Qnil);
2593 kb->kbd_queue_has_data = 1;
2594 c = Qnil;
2595 if (single_kboard)
2596 goto wrong_kboard;
2597 current_kboard = kb;
2598 /* This is going to exit from read_char
2599 so we had better get rid of this frame's stuff. */
2600 UNGCPRO;
2601 longjmp (wrong_kboard_jmpbuf, 1);
2603 #endif
2606 /* Terminate Emacs in batch mode if at eof. */
2607 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
2608 Fkill_emacs (make_number (1));
2610 if (INTEGERP (c))
2612 /* Add in any extra modifiers, where appropriate. */
2613 if ((extra_keyboard_modifiers & CHAR_CTL)
2614 || ((extra_keyboard_modifiers & 0177) < ' '
2615 && (extra_keyboard_modifiers & 0177) != 0))
2616 XSETINT (c, make_ctrl_char (XINT (c)));
2618 /* Transfer any other modifier bits directly from
2619 extra_keyboard_modifiers to c. Ignore the actual character code
2620 in the low 16 bits of extra_keyboard_modifiers. */
2621 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
2624 non_reread:
2626 /* Record the last idle start time so that we can reset it
2627 should the next event read be a help-echo. */
2628 last_idle_start = timer_idleness_start_time;
2629 timer_stop_idle ();
2630 start_polling ();
2632 if (NILP (c))
2634 if (commandflag >= 0
2635 && !input_pending && !detect_input_pending_run_timers (0))
2636 redisplay ();
2638 goto wrong_kboard;
2641 non_reread_1:
2643 /* Buffer switch events are only for internal wakeups
2644 so don't show them to the user.
2645 Also, don't record a key if we already did. */
2646 if (BUFFERP (c) || key_already_recorded)
2647 RETURN_UNGCPRO (c);
2649 /* Process special events within read_char
2650 and loop around to read another event. */
2651 save = Vquit_flag;
2652 Vquit_flag = Qnil;
2653 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
2654 Vquit_flag = save;
2656 if (!NILP (tem))
2658 int was_locked = single_kboard;
2660 last_input_char = c;
2661 Fcommand_execute (tem, Qnil, Fvector (1, &last_input_char), Qt);
2663 /* Resume allowing input from any kboard, if that was true before. */
2664 if (!was_locked)
2665 any_kboard_state ();
2667 goto retry;
2670 /* Handle things that only apply to characters. */
2671 if (INTEGERP (c))
2673 /* If kbd_buffer_get_event gave us an EOF, return that. */
2674 if (XINT (c) == -1)
2675 RETURN_UNGCPRO (c);
2677 if ((STRINGP (Vkeyboard_translate_table)
2678 && XSTRING (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
2679 || (VECTORP (Vkeyboard_translate_table)
2680 && XVECTOR (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
2681 || (CHAR_TABLE_P (Vkeyboard_translate_table)
2682 && CHAR_TABLE_ORDINARY_SLOTS > (unsigned) XFASTINT (c)))
2684 Lisp_Object d;
2685 d = Faref (Vkeyboard_translate_table, c);
2686 /* nil in keyboard-translate-table means no translation. */
2687 if (!NILP (d))
2688 c = d;
2692 /* If this event is a mouse click in the menu bar,
2693 return just menu-bar for now. Modify the mouse click event
2694 so we won't do this twice, then queue it up. */
2695 if (EVENT_HAS_PARAMETERS (c)
2696 && CONSP (XCDR (c))
2697 && CONSP (EVENT_START (c))
2698 && CONSP (XCDR (EVENT_START (c))))
2700 Lisp_Object posn;
2702 posn = POSN_BUFFER_POSN (EVENT_START (c));
2703 /* Handle menu-bar events:
2704 insert the dummy prefix event `menu-bar'. */
2705 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
2707 /* Change menu-bar to (menu-bar) as the event "position". */
2708 POSN_BUFFER_POSN (EVENT_START (c)) = Fcons (posn, Qnil);
2710 also_record = c;
2711 Vunread_command_events = Fcons (c, Vunread_command_events);
2712 c = posn;
2716 /* Store these characters into recent_keys, the dribble file if any,
2717 and the keyboard macro being defined, if any. */
2718 record_char (c);
2719 if (! NILP (also_record))
2720 record_char (also_record);
2722 /* Wipe the echo area.
2723 But first, if we are about to use an input method,
2724 save the echo area contents for it to refer to. */
2725 if (INTEGERP (c)
2726 && ! NILP (Vinput_method_function)
2727 && (unsigned) XINT (c) >= ' '
2728 && (unsigned) XINT (c) != 127
2729 && (unsigned) XINT (c) < 256)
2731 previous_echo_area_message = Fcurrent_message ();
2732 Vinput_method_previous_message = previous_echo_area_message;
2735 /* Now wipe the echo area, except for help events which do their
2736 own stuff with the echo area. */
2737 if (!CONSP (c)
2738 || (!(EQ (Qhelp_echo, XCAR (c)))
2739 && !(EQ (Qswitch_frame, XCAR (c)))))
2741 if (!NILP (echo_area_buffer[0]))
2742 safe_run_hooks (Qecho_area_clear_hook);
2743 clear_message (1, 0);
2746 reread_for_input_method:
2747 from_macro:
2748 /* Pass this to the input method, if appropriate. */
2749 if (INTEGERP (c)
2750 && ! NILP (Vinput_method_function)
2751 /* Don't run the input method within a key sequence,
2752 after the first event of the key sequence. */
2753 && NILP (prev_event)
2754 && (unsigned) XINT (c) >= ' '
2755 && (unsigned) XINT (c) != 127
2756 && (unsigned) XINT (c) < 256)
2758 Lisp_Object keys;
2759 int key_count;
2760 struct gcpro gcpro1;
2761 int count = specpdl_ptr - specpdl;
2763 /* Save the echo status. */
2764 int saved_immediate_echo = current_kboard->immediate_echo;
2765 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
2766 int saved_echo_after_prompt = current_kboard->echo_after_prompt;
2768 if (before_command_restore_flag)
2770 this_command_key_count = before_command_key_count_1;
2771 if (this_command_key_count < this_single_command_key_start)
2772 this_single_command_key_start = this_command_key_count;
2773 echo_truncate (before_command_echo_length_1);
2774 before_command_restore_flag = 0;
2777 /* Save the this_command_keys status. */
2778 key_count = this_command_key_count;
2780 if (key_count > 0)
2781 keys = Fcopy_sequence (this_command_keys);
2782 else
2783 keys = Qnil;
2784 GCPRO1 (keys);
2786 /* Clear out this_command_keys. */
2787 this_command_key_count = 0;
2789 /* Now wipe the echo area. */
2790 if (!NILP (echo_area_buffer[0]))
2791 safe_run_hooks (Qecho_area_clear_hook);
2792 clear_message (1, 0);
2793 echo_truncate (0);
2795 /* If we are not reading a key sequence,
2796 never use the echo area. */
2797 if (maps == 0)
2799 specbind (Qinput_method_use_echo_area, Qt);
2802 /* Call the input method. */
2803 tem = call1 (Vinput_method_function, c);
2805 tem = unbind_to (count, tem);
2807 /* Restore the saved echoing state
2808 and this_command_keys state. */
2809 this_command_key_count = key_count;
2810 if (key_count > 0)
2811 this_command_keys = keys;
2813 cancel_echoing ();
2814 ok_to_echo_at_next_pause = saved_ok_to_echo;
2815 current_kboard->echo_after_prompt = saved_echo_after_prompt;
2816 if (saved_immediate_echo)
2817 echo_now ();
2819 UNGCPRO;
2821 /* The input method can return no events. */
2822 if (! CONSP (tem))
2824 /* Bring back the previous message, if any. */
2825 if (! NILP (previous_echo_area_message))
2826 message_with_string ("%s", previous_echo_area_message, 0);
2827 goto retry;
2829 /* It returned one event or more. */
2830 c = XCAR (tem);
2831 Vunread_post_input_method_events
2832 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
2835 reread_first:
2837 /* Display help if not echoing. */
2838 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
2840 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
2841 Lisp_Object help, object, position, window;
2842 help = Fnth (make_number (2), c);
2843 window = Fnth (make_number (3), c);
2844 object = Fnth (make_number (4), c);
2845 position = Fnth (make_number (5), c);
2846 show_help_echo (help, window, object, position, 0);
2848 /* We stopped being idle for this event; undo that. */
2849 timer_idleness_start_time = last_idle_start;
2850 goto retry;
2853 if (this_command_key_count == 0 || ! reread)
2855 before_command_key_count = this_command_key_count;
2856 before_command_echo_length = echo_length ();
2858 /* Don't echo mouse motion events. */
2859 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2860 && NILP (Fzerop (Vecho_keystrokes))
2861 && ! (EVENT_HAS_PARAMETERS (c)
2862 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
2864 echo_char (c);
2865 if (! NILP (also_record))
2866 echo_char (also_record);
2867 /* Once we reread a character, echoing can happen
2868 the next time we pause to read a new one. */
2869 ok_to_echo_at_next_pause = current_kboard;
2872 /* Record this character as part of the current key. */
2873 add_command_key (c);
2874 if (! NILP (also_record))
2875 add_command_key (also_record);
2878 last_input_char = c;
2879 num_input_events++;
2881 /* Process the help character specially if enabled */
2882 if (!NILP (Vhelp_form) && help_char_p (c))
2884 Lisp_Object tem0;
2885 count = specpdl_ptr - specpdl;
2887 record_unwind_protect (Fset_window_configuration,
2888 Fcurrent_window_configuration (Qnil));
2890 tem0 = Feval (Vhelp_form);
2891 if (STRINGP (tem0))
2892 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
2894 cancel_echoing ();
2896 c = read_char (0, 0, 0, Qnil, 0);
2897 while (BUFFERP (c));
2898 /* Remove the help from the frame */
2899 unbind_to (count, Qnil);
2901 redisplay ();
2902 if (EQ (c, make_number (040)))
2904 cancel_echoing ();
2906 c = read_char (0, 0, 0, Qnil, 0);
2907 while (BUFFERP (c));
2911 RETURN_UNGCPRO (c);
2914 /* Record a key that came from a mouse menu.
2915 Record it for echoing, for this-command-keys, and so on. */
2917 static void
2918 record_menu_key (c)
2919 Lisp_Object c;
2921 /* Wipe the echo area. */
2922 clear_message (1, 0);
2924 record_char (c);
2926 before_command_key_count = this_command_key_count;
2927 before_command_echo_length = echo_length ();
2929 /* Don't echo mouse motion events. */
2930 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2931 && NILP (Fzerop (Vecho_keystrokes)))
2933 echo_char (c);
2935 /* Once we reread a character, echoing can happen
2936 the next time we pause to read a new one. */
2937 ok_to_echo_at_next_pause = 0;
2940 /* Record this character as part of the current key. */
2941 add_command_key (c);
2943 /* Re-reading in the middle of a command */
2944 last_input_char = c;
2945 num_input_events++;
2948 /* Return 1 if should recognize C as "the help character". */
2951 help_char_p (c)
2952 Lisp_Object c;
2954 Lisp_Object tail;
2956 if (EQ (c, Vhelp_char))
2957 return 1;
2958 for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
2959 if (EQ (c, XCAR (tail)))
2960 return 1;
2961 return 0;
2964 /* Record the input event C in various ways. */
2966 static void
2967 record_char (c)
2968 Lisp_Object c;
2970 /* Don't record `help-echo' in recent_keys unless it shows some help
2971 message, and a different help than the previously recorded
2972 event. */
2973 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
2975 Lisp_Object help;
2977 help = Fnth (make_number (2), c);
2978 if (STRINGP (help))
2980 int last_idx;
2981 Lisp_Object last_c, last_help;
2983 last_idx = recent_keys_index - 1;
2984 if (last_idx < 0)
2985 last_idx = NUM_RECENT_KEYS - 1;
2986 last_c = AREF (recent_keys, last_idx);
2988 if (!CONSP (last_c)
2989 || !EQ (XCAR (last_c), Qhelp_echo)
2990 || (last_help = Fnth (make_number (2), last_c),
2991 !EQ (last_help, help)))
2993 total_keys++;
2994 ASET (recent_keys, recent_keys_index, c);
2995 if (++recent_keys_index >= NUM_RECENT_KEYS)
2996 recent_keys_index = 0;
3000 else
3002 total_keys++;
3003 ASET (recent_keys, recent_keys_index, c);
3004 if (++recent_keys_index >= NUM_RECENT_KEYS)
3005 recent_keys_index = 0;
3008 /* Write c to the dribble file. If c is a lispy event, write
3009 the event's symbol to the dribble file, in <brackets>. Bleaugh.
3010 If you, dear reader, have a better idea, you've got the source. :-) */
3011 if (dribble)
3013 if (INTEGERP (c))
3015 if (XUINT (c) < 0x100)
3016 putc (XINT (c), dribble);
3017 else
3018 fprintf (dribble, " 0x%x", (int) XUINT (c));
3020 else
3022 Lisp_Object dribblee;
3024 /* If it's a structured event, take the event header. */
3025 dribblee = EVENT_HEAD (c);
3027 if (SYMBOLP (dribblee))
3029 putc ('<', dribble);
3030 fwrite (XSYMBOL (dribblee)->name->data, sizeof (char),
3031 STRING_BYTES (XSYMBOL (dribblee)->name),
3032 dribble);
3033 putc ('>', dribble);
3037 fflush (dribble);
3040 if (!CONSP (c) || !EQ (Qhelp_echo, XCAR (c)))
3041 store_kbd_macro_char (c);
3043 num_nonmacro_input_events++;
3046 Lisp_Object
3047 print_help (object)
3048 Lisp_Object object;
3050 struct buffer *old = current_buffer;
3051 Fprinc (object, Qnil);
3052 set_buffer_internal (XBUFFER (Vstandard_output));
3053 call0 (intern ("help-mode"));
3054 set_buffer_internal (old);
3055 return Qnil;
3058 /* Copy out or in the info on where C-g should throw to.
3059 This is used when running Lisp code from within get_char,
3060 in case get_char is called recursively.
3061 See read_process_output. */
3063 static void
3064 save_getcjmp (temp)
3065 jmp_buf temp;
3067 bcopy (getcjmp, temp, sizeof getcjmp);
3070 static void
3071 restore_getcjmp (temp)
3072 jmp_buf temp;
3074 bcopy (temp, getcjmp, sizeof getcjmp);
3077 #ifdef HAVE_MOUSE
3079 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
3080 of this function. */
3082 static Lisp_Object
3083 tracking_off (old_value)
3084 Lisp_Object old_value;
3086 do_mouse_tracking = old_value;
3087 if (NILP (old_value))
3089 /* Redisplay may have been preempted because there was input
3090 available, and it assumes it will be called again after the
3091 input has been processed. If the only input available was
3092 the sort that we have just disabled, then we need to call
3093 redisplay. */
3094 if (!readable_events (1))
3096 redisplay_preserve_echo_area (6);
3097 get_input_pending (&input_pending, 1);
3100 return Qnil;
3103 DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
3104 "Evaluate BODY with mouse movement events enabled.\n\
3105 Within a `track-mouse' form, mouse motion generates input events that\n\
3106 you can read with `read-event'.\n\
3107 Normally, mouse motion is ignored.")
3108 (args)
3109 Lisp_Object args;
3111 int count = specpdl_ptr - specpdl;
3112 Lisp_Object val;
3114 record_unwind_protect (tracking_off, do_mouse_tracking);
3116 do_mouse_tracking = Qt;
3118 val = Fprogn (args);
3119 return unbind_to (count, val);
3122 /* If mouse has moved on some frame, return one of those frames.
3123 Return 0 otherwise. */
3125 static FRAME_PTR
3126 some_mouse_moved ()
3128 Lisp_Object tail, frame;
3130 FOR_EACH_FRAME (tail, frame)
3132 if (XFRAME (frame)->mouse_moved)
3133 return XFRAME (frame);
3136 return 0;
3139 #endif /* HAVE_MOUSE */
3141 /* Low level keyboard/mouse input.
3142 kbd_buffer_store_event places events in kbd_buffer, and
3143 kbd_buffer_get_event retrieves them. */
3145 /* Return true iff there are any events in the queue that read-char
3146 would return. If this returns false, a read-char would block. */
3147 static int
3148 readable_events (do_timers_now)
3149 int do_timers_now;
3151 if (do_timers_now)
3152 timer_check (do_timers_now);
3154 if (kbd_fetch_ptr != kbd_store_ptr)
3155 return 1;
3156 #ifdef HAVE_MOUSE
3157 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3158 return 1;
3159 #endif
3160 if (single_kboard)
3162 if (current_kboard->kbd_queue_has_data)
3163 return 1;
3165 else
3167 KBOARD *kb;
3168 for (kb = all_kboards; kb; kb = kb->next_kboard)
3169 if (kb->kbd_queue_has_data)
3170 return 1;
3172 return 0;
3175 /* Set this for debugging, to have a way to get out */
3176 int stop_character;
3178 #ifdef MULTI_KBOARD
3179 static KBOARD *
3180 event_to_kboard (event)
3181 struct input_event *event;
3183 Lisp_Object frame;
3184 frame = event->frame_or_window;
3185 if (CONSP (frame))
3186 frame = XCAR (frame);
3187 else if (WINDOWP (frame))
3188 frame = WINDOW_FRAME (XWINDOW (frame));
3190 /* There are still some events that don't set this field.
3191 For now, just ignore the problem.
3192 Also ignore dead frames here. */
3193 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
3194 return 0;
3195 else
3196 return FRAME_KBOARD (XFRAME (frame));
3198 #endif
3200 /* Store an event obtained at interrupt level into kbd_buffer, fifo */
3202 void
3203 kbd_buffer_store_event (event)
3204 register struct input_event *event;
3206 if (event->kind == no_event)
3207 abort ();
3209 if (event->kind == ascii_keystroke)
3211 register int c = event->code & 0377;
3213 if (event->modifiers & ctrl_modifier)
3214 c = make_ctrl_char (c);
3216 c |= (event->modifiers
3217 & (meta_modifier | alt_modifier
3218 | hyper_modifier | super_modifier));
3220 if (c == quit_char)
3222 extern SIGTYPE interrupt_signal ();
3223 #ifdef MULTI_KBOARD
3224 KBOARD *kb;
3225 struct input_event *sp;
3227 if (single_kboard
3228 && (kb = FRAME_KBOARD (XFRAME (event->frame_or_window)),
3229 kb != current_kboard))
3231 kb->kbd_queue
3232 = Fcons (make_lispy_switch_frame (event->frame_or_window),
3233 Fcons (make_number (c), Qnil));
3234 kb->kbd_queue_has_data = 1;
3235 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3237 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3238 sp = kbd_buffer;
3240 if (event_to_kboard (sp) == kb)
3242 sp->kind = no_event;
3243 sp->frame_or_window = Qnil;
3244 sp->arg = Qnil;
3247 return;
3249 #endif
3251 /* If this results in a quit_char being returned to Emacs as
3252 input, set Vlast_event_frame properly. If this doesn't
3253 get returned to Emacs as an event, the next event read
3254 will set Vlast_event_frame again, so this is safe to do. */
3256 Lisp_Object focus;
3258 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
3259 if (NILP (focus))
3260 focus = event->frame_or_window;
3261 internal_last_event_frame = focus;
3262 Vlast_event_frame = focus;
3265 last_event_timestamp = event->timestamp;
3266 interrupt_signal ();
3267 return;
3270 if (c && c == stop_character)
3272 sys_suspend ();
3273 return;
3276 /* Don't insert two buffer_switch_event's in a row.
3277 Just ignore the second one. */
3278 else if (event->kind == buffer_switch_event
3279 && kbd_fetch_ptr != kbd_store_ptr
3280 && kbd_store_ptr->kind == buffer_switch_event)
3281 return;
3283 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
3284 kbd_store_ptr = kbd_buffer;
3286 /* Don't let the very last slot in the buffer become full,
3287 since that would make the two pointers equal,
3288 and that is indistinguishable from an empty buffer.
3289 Discard the event if it would fill the last slot. */
3290 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3292 int idx;
3294 #if 0 /* The selection_request_event case looks bogus, and it's error
3295 prone to assign individual members for other events, in case
3296 the input_event structure is changed. --2000-07-13, gerd. */
3297 struct input_event *sp = kbd_store_ptr;
3298 sp->kind = event->kind;
3299 if (event->kind == selection_request_event)
3301 /* We must not use the ordinary copying code for this case,
3302 since `part' is an enum and copying it might not copy enough
3303 in this case. */
3304 bcopy (event, (char *) sp, sizeof (*event));
3306 else
3309 sp->code = event->code;
3310 sp->part = event->part;
3311 sp->frame_or_window = event->frame_or_window;
3312 sp->arg = event->arg;
3313 sp->modifiers = event->modifiers;
3314 sp->x = event->x;
3315 sp->y = event->y;
3316 sp->timestamp = event->timestamp;
3318 #else
3319 *kbd_store_ptr = *event;
3320 #endif
3322 idx = 2 * (kbd_store_ptr - kbd_buffer);
3323 ASET (kbd_buffer_gcpro, idx, event->frame_or_window);
3324 ASET (kbd_buffer_gcpro, idx + 1, event->arg);
3325 ++kbd_store_ptr;
3330 /* Generate HELP_EVENT input_events in BUFP which has room for
3331 SIZE events. If there's not enough room in BUFP, ignore this
3332 event.
3334 HELP is the help form.
3336 FRAME is the frame on which the help is generated. OBJECT is the
3337 Lisp object where the help was found (a buffer, a string, an
3338 overlay, or nil if neither from a string nor from a buffer. POS is
3339 the position within OBJECT where the help was found.
3341 Value is the number of input_events generated. */
3344 gen_help_event (bufp, size, help, frame, window, object, pos)
3345 struct input_event *bufp;
3346 int size;
3347 Lisp_Object help, frame, object, window;
3348 int pos;
3350 int nevents_stored = 0;
3352 if (size >= 2)
3354 bufp->kind = HELP_EVENT;
3355 bufp->frame_or_window = frame;
3356 bufp->arg = object;
3357 bufp->x = make_number (pos);
3358 bufp->code = 0;
3360 ++bufp;
3361 bufp->kind = HELP_EVENT;
3362 bufp->frame_or_window = WINDOWP (window) ? window : frame;
3363 bufp->arg = help;
3364 bufp->code = 1;
3365 nevents_stored = 2;
3368 return nevents_stored;
3372 /* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3374 void
3375 kbd_buffer_store_help_event (frame, help)
3376 Lisp_Object frame, help;
3378 struct input_event event;
3380 event.kind = HELP_EVENT;
3381 event.frame_or_window = frame;
3382 event.arg = Qnil;
3383 event.x = make_number (0);
3384 event.code = 0;
3385 kbd_buffer_store_event (&event);
3387 event.kind = HELP_EVENT;
3388 event.frame_or_window = frame;
3389 event.arg = help;
3390 event.x = make_number (0);
3391 event.code = 1;
3392 kbd_buffer_store_event (&event);
3396 /* Discard any mouse events in the event buffer by setting them to
3397 no_event. */
3398 void
3399 discard_mouse_events ()
3401 struct input_event *sp;
3402 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3404 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3405 sp = kbd_buffer;
3407 if (sp->kind == mouse_click
3408 #ifdef WINDOWSNT
3409 || sp->kind == w32_scroll_bar_click
3410 #endif
3411 || sp->kind == scroll_bar_click)
3413 sp->kind = no_event;
3419 /* Return non-zero if there are any real events waiting in the event
3420 buffer, not counting `no_event's.
3422 If DISCARD is non-zero, discard no_event events at the front of
3423 the input queue, possibly leaving the input queue empty if there
3424 are no real input events. */
3427 kbd_buffer_events_waiting (discard)
3428 int discard;
3430 struct input_event *sp;
3432 for (sp = kbd_fetch_ptr;
3433 sp != kbd_store_ptr && sp->kind == no_event;
3434 ++sp)
3436 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3437 sp = kbd_buffer;
3440 if (discard)
3441 kbd_fetch_ptr = sp;
3443 return sp != kbd_store_ptr && sp->kind != no_event;
3447 /* Clear input event EVENT. */
3449 static INLINE void
3450 clear_event (event)
3451 struct input_event *event;
3453 int idx = 2 * (event - kbd_buffer);
3454 ASET (kbd_buffer_gcpro, idx, Qnil);
3455 ASET (kbd_buffer_gcpro, idx + 1, Qnil);
3456 event->kind = no_event;
3460 /* Read one event from the event buffer, waiting if necessary.
3461 The value is a Lisp object representing the event.
3462 The value is nil for an event that should be ignored,
3463 or that was handled here.
3464 We always read and discard one event. */
3466 static Lisp_Object
3467 kbd_buffer_get_event (kbp, used_mouse_menu)
3468 KBOARD **kbp;
3469 int *used_mouse_menu;
3471 register int c;
3472 Lisp_Object obj;
3474 if (noninteractive)
3476 c = getchar ();
3477 XSETINT (obj, c);
3478 *kbp = current_kboard;
3479 return obj;
3482 /* Wait until there is input available. */
3483 for (;;)
3485 if (kbd_fetch_ptr != kbd_store_ptr)
3486 break;
3487 #ifdef HAVE_MOUSE
3488 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3489 break;
3490 #endif
3492 /* If the quit flag is set, then read_char will return
3493 quit_char, so that counts as "available input." */
3494 if (!NILP (Vquit_flag))
3495 quit_throw_to_read_char ();
3497 /* One way or another, wait until input is available; then, if
3498 interrupt handlers have not read it, read it now. */
3500 #ifdef OLDVMS
3501 wait_for_kbd_input ();
3502 #else
3503 /* Note SIGIO has been undef'd if FIONREAD is missing. */
3504 #ifdef SIGIO
3505 gobble_input (0);
3506 #endif /* SIGIO */
3507 if (kbd_fetch_ptr != kbd_store_ptr)
3508 break;
3509 #ifdef HAVE_MOUSE
3510 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3511 break;
3512 #endif
3514 Lisp_Object minus_one;
3516 XSETINT (minus_one, -1);
3517 wait_reading_process_input (0, 0, minus_one, 1);
3519 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
3520 /* Pass 1 for EXPECT since we just waited to have input. */
3521 read_avail_input (1);
3523 #endif /* not VMS */
3526 if (CONSP (Vunread_command_events))
3528 Lisp_Object first;
3529 first = XCAR (Vunread_command_events);
3530 Vunread_command_events = XCDR (Vunread_command_events);
3531 *kbp = current_kboard;
3532 return first;
3535 /* At this point, we know that there is a readable event available
3536 somewhere. If the event queue is empty, then there must be a
3537 mouse movement enabled and available. */
3538 if (kbd_fetch_ptr != kbd_store_ptr)
3540 struct input_event *event;
3542 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3543 ? kbd_fetch_ptr
3544 : kbd_buffer);
3546 last_event_timestamp = event->timestamp;
3548 #ifdef MULTI_KBOARD
3549 *kbp = event_to_kboard (event);
3550 if (*kbp == 0)
3551 *kbp = current_kboard; /* Better than returning null ptr? */
3552 #else
3553 *kbp = &the_only_kboard;
3554 #endif
3556 obj = Qnil;
3558 /* These two kinds of events get special handling
3559 and don't actually appear to the command loop.
3560 We return nil for them. */
3561 if (event->kind == selection_request_event)
3563 #ifdef HAVE_X11
3564 struct input_event copy;
3566 /* Remove it from the buffer before processing it,
3567 since otherwise swallow_events will see it
3568 and process it again. */
3569 copy = *event;
3570 kbd_fetch_ptr = event + 1;
3571 input_pending = readable_events (0);
3572 x_handle_selection_request (&copy);
3573 #else
3574 /* We're getting selection request events, but we don't have
3575 a window system. */
3576 abort ();
3577 #endif
3580 else if (event->kind == selection_clear_event)
3582 #ifdef HAVE_X11
3583 struct input_event copy;
3585 /* Remove it from the buffer before processing it. */
3586 copy = *event;
3587 kbd_fetch_ptr = event + 1;
3588 input_pending = readable_events (0);
3589 x_handle_selection_clear (&copy);
3590 #else
3591 /* We're getting selection request events, but we don't have
3592 a window system. */
3593 abort ();
3594 #endif
3596 #if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (macintosh)
3597 else if (event->kind == delete_window_event)
3599 /* Make an event (delete-frame (FRAME)). */
3600 obj = Fcons (event->frame_or_window, Qnil);
3601 obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
3602 kbd_fetch_ptr = event + 1;
3604 #endif
3605 #if defined (HAVE_X11) || defined (HAVE_NTGUI)
3606 else if (event->kind == iconify_event)
3608 /* Make an event (iconify-frame (FRAME)). */
3609 obj = Fcons (event->frame_or_window, Qnil);
3610 obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
3611 kbd_fetch_ptr = event + 1;
3613 else if (event->kind == deiconify_event)
3615 /* Make an event (make-frame-visible (FRAME)). */
3616 obj = Fcons (event->frame_or_window, Qnil);
3617 obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
3618 kbd_fetch_ptr = event + 1;
3620 #endif
3621 else if (event->kind == buffer_switch_event)
3623 /* The value doesn't matter here; only the type is tested. */
3624 XSETBUFFER (obj, current_buffer);
3625 kbd_fetch_ptr = event + 1;
3627 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
3628 else if (event->kind == menu_bar_activate_event)
3630 kbd_fetch_ptr = event + 1;
3631 input_pending = readable_events (0);
3632 if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
3633 x_activate_menubar (XFRAME (event->frame_or_window));
3635 #endif
3636 #ifdef WINDOWSNT
3637 else if (event->kind == language_change_event)
3639 /* Make an event (language-change (FRAME CHARSET LCID)). */
3640 obj = Fcons (event->modifiers, Qnil);
3641 obj = Fcons (event->code, Qnil);
3642 obj = Fcons (event->frame_or_window, obj);
3643 obj = Fcons (Qlanguage_change, Fcons (obj, Qnil));
3644 kbd_fetch_ptr = event + 1;
3646 #endif
3647 /* Just discard these, by returning nil.
3648 With MULTI_KBOARD, these events are used as placeholders
3649 when we need to randomly delete events from the queue.
3650 (They shouldn't otherwise be found in the buffer,
3651 but on some machines it appears they do show up
3652 even without MULTI_KBOARD.) */
3653 /* On Windows NT/9X, no_event is used to delete extraneous
3654 mouse events during a popup-menu call. */
3655 else if (event->kind == no_event)
3656 kbd_fetch_ptr = event + 1;
3657 else if (event->kind == HELP_EVENT)
3659 /* There are always two HELP_EVENTs in the input queue. */
3660 Lisp_Object object, position, help, frame, window;
3662 xassert (event->code == 0);
3663 frame = event->frame_or_window;
3664 object = event->arg;
3665 position = event->x;
3666 clear_event (event);
3668 kbd_fetch_ptr = event + 1;
3669 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3670 ? kbd_fetch_ptr
3671 : kbd_buffer);
3672 xassert (event->code == 1);
3673 help = event->arg;
3674 window = event->frame_or_window;
3675 if (!WINDOWP (window))
3676 window = Qnil;
3677 obj = Fcons (Qhelp_echo,
3678 list5 (frame, help, window, object, position));
3679 clear_event (event);
3680 kbd_fetch_ptr = event + 1;
3682 else if (event->kind == FOCUS_IN_EVENT)
3684 /* Notification of a FocusIn event. The frame receiving the
3685 focus is in event->frame_or_window. Generate a
3686 switch-frame event if necessary. */
3687 Lisp_Object frame, focus;
3689 frame = event->frame_or_window;
3690 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
3691 if (FRAMEP (focus))
3692 frame = focus;
3694 if (!EQ (frame, internal_last_event_frame)
3695 && !EQ (frame, selected_frame))
3696 obj = make_lispy_switch_frame (frame);
3697 internal_last_event_frame = frame;
3698 kbd_fetch_ptr = event + 1;
3700 else
3702 /* If this event is on a different frame, return a switch-frame this
3703 time, and leave the event in the queue for next time. */
3704 Lisp_Object frame;
3705 Lisp_Object focus;
3707 frame = event->frame_or_window;
3708 if (CONSP (frame))
3709 frame = XCAR (frame);
3710 else if (WINDOWP (frame))
3711 frame = WINDOW_FRAME (XWINDOW (frame));
3713 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
3714 if (! NILP (focus))
3715 frame = focus;
3717 if (! EQ (frame, internal_last_event_frame)
3718 && !EQ (frame, selected_frame))
3719 obj = make_lispy_switch_frame (frame);
3720 internal_last_event_frame = frame;
3722 /* If we didn't decide to make a switch-frame event, go ahead
3723 and build a real event from the queue entry. */
3725 if (NILP (obj))
3727 obj = make_lispy_event (event);
3729 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI)
3730 /* If this was a menu selection, then set the flag to inhibit
3731 writing to last_nonmenu_event. Don't do this if the event
3732 we're returning is (menu-bar), though; that indicates the
3733 beginning of the menu sequence, and we might as well leave
3734 that as the `event with parameters' for this selection. */
3735 if (used_mouse_menu
3736 && !EQ (event->frame_or_window, event->arg)
3737 && (event->kind == MENU_BAR_EVENT
3738 || event->kind == TOOL_BAR_EVENT))
3739 *used_mouse_menu = 1;
3740 #endif
3742 /* Wipe out this event, to catch bugs. */
3743 clear_event (event);
3744 kbd_fetch_ptr = event + 1;
3748 #ifdef HAVE_MOUSE
3749 /* Try generating a mouse motion event. */
3750 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3752 FRAME_PTR f = some_mouse_moved ();
3753 Lisp_Object bar_window;
3754 enum scroll_bar_part part;
3755 Lisp_Object x, y;
3756 unsigned long time;
3758 *kbp = current_kboard;
3759 /* Note that this uses F to determine which display to look at.
3760 If there is no valid info, it does not store anything
3761 so x remains nil. */
3762 x = Qnil;
3763 (*mouse_position_hook) (&f, 0, &bar_window, &part, &x, &y, &time);
3765 obj = Qnil;
3767 /* Decide if we should generate a switch-frame event. Don't
3768 generate switch-frame events for motion outside of all Emacs
3769 frames. */
3770 if (!NILP (x) && f)
3772 Lisp_Object frame;
3774 frame = FRAME_FOCUS_FRAME (f);
3775 if (NILP (frame))
3776 XSETFRAME (frame, f);
3778 if (! EQ (frame, internal_last_event_frame)
3779 && !EQ (frame, selected_frame))
3780 obj = make_lispy_switch_frame (frame);
3781 internal_last_event_frame = frame;
3784 /* If we didn't decide to make a switch-frame event, go ahead and
3785 return a mouse-motion event. */
3786 if (!NILP (x) && NILP (obj))
3787 obj = make_lispy_movement (f, bar_window, part, x, y, time);
3789 #endif /* HAVE_MOUSE */
3790 else
3791 /* We were promised by the above while loop that there was
3792 something for us to read! */
3793 abort ();
3795 input_pending = readable_events (0);
3797 Vlast_event_frame = internal_last_event_frame;
3799 return (obj);
3802 /* Process any events that are not user-visible,
3803 then return, without reading any user-visible events. */
3805 void
3806 swallow_events (do_display)
3807 int do_display;
3809 int old_timers_run;
3811 while (kbd_fetch_ptr != kbd_store_ptr)
3813 struct input_event *event;
3815 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3816 ? kbd_fetch_ptr
3817 : kbd_buffer);
3819 last_event_timestamp = event->timestamp;
3821 /* These two kinds of events get special handling
3822 and don't actually appear to the command loop. */
3823 if (event->kind == selection_request_event)
3825 #ifdef HAVE_X11
3826 struct input_event copy;
3828 /* Remove it from the buffer before processing it,
3829 since otherwise swallow_events called recursively could see it
3830 and process it again. */
3831 copy = *event;
3832 kbd_fetch_ptr = event + 1;
3833 input_pending = readable_events (0);
3834 x_handle_selection_request (&copy);
3835 #else
3836 /* We're getting selection request events, but we don't have
3837 a window system. */
3838 abort ();
3839 #endif
3842 else if (event->kind == selection_clear_event)
3844 #ifdef HAVE_X11
3845 struct input_event copy;
3847 /* Remove it from the buffer before processing it, */
3848 copy = *event;
3850 kbd_fetch_ptr = event + 1;
3851 input_pending = readable_events (0);
3852 x_handle_selection_clear (&copy);
3853 #else
3854 /* We're getting selection request events, but we don't have
3855 a window system. */
3856 abort ();
3857 #endif
3859 else
3860 break;
3863 old_timers_run = timers_run;
3864 get_input_pending (&input_pending, 1);
3866 if (timers_run != old_timers_run && do_display)
3867 redisplay_preserve_echo_area (7);
3870 /* Record the start of when Emacs is idle,
3871 for the sake of running idle-time timers. */
3873 void
3874 timer_start_idle ()
3876 Lisp_Object timers;
3878 /* If we are already in the idle state, do nothing. */
3879 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3880 return;
3882 EMACS_GET_TIME (timer_idleness_start_time);
3884 /* Mark all idle-time timers as once again candidates for running. */
3885 for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers))
3887 Lisp_Object timer;
3889 timer = XCAR (timers);
3891 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3892 continue;
3893 XVECTOR (timer)->contents[0] = Qnil;
3897 /* Record that Emacs is no longer idle, so stop running idle-time timers. */
3899 void
3900 timer_stop_idle ()
3902 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
3905 /* This is only for debugging. */
3906 struct input_event last_timer_event;
3908 /* Check whether a timer has fired. To prevent larger problems we simply
3909 disregard elements that are not proper timers. Do not make a circular
3910 timer list for the time being.
3912 Returns the number of seconds to wait until the next timer fires. If a
3913 timer is triggering now, return zero seconds.
3914 If no timer is active, return -1 seconds.
3916 If a timer is ripe, we run it, with quitting turned off.
3918 DO_IT_NOW is now ignored. It used to mean that we should
3919 run the timer directly instead of queueing a timer-event.
3920 Now we always run timers directly. */
3922 EMACS_TIME
3923 timer_check (do_it_now)
3924 int do_it_now;
3926 EMACS_TIME nexttime;
3927 EMACS_TIME now, idleness_now;
3928 Lisp_Object timers, idle_timers, chosen_timer;
3929 struct gcpro gcpro1, gcpro2, gcpro3;
3931 EMACS_SET_SECS (nexttime, -1);
3932 EMACS_SET_USECS (nexttime, -1);
3934 /* Always consider the ordinary timers. */
3935 timers = Vtimer_list;
3936 /* Consider the idle timers only if Emacs is idle. */
3937 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3938 idle_timers = Vtimer_idle_list;
3939 else
3940 idle_timers = Qnil;
3941 chosen_timer = Qnil;
3942 GCPRO3 (timers, idle_timers, chosen_timer);
3944 if (CONSP (timers) || CONSP (idle_timers))
3946 EMACS_GET_TIME (now);
3947 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3948 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
3951 while (CONSP (timers) || CONSP (idle_timers))
3953 Lisp_Object *vector;
3954 Lisp_Object timer = Qnil, idle_timer = Qnil;
3955 EMACS_TIME timer_time, idle_timer_time;
3956 EMACS_TIME difference, timer_difference, idle_timer_difference;
3958 /* Skip past invalid timers and timers already handled. */
3959 if (!NILP (timers))
3961 timer = XCAR (timers);
3962 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3964 timers = XCDR (timers);
3965 continue;
3967 vector = XVECTOR (timer)->contents;
3969 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
3970 || !INTEGERP (vector[3])
3971 || ! NILP (vector[0]))
3973 timers = XCDR (timers);
3974 continue;
3977 if (!NILP (idle_timers))
3979 timer = XCAR (idle_timers);
3980 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3982 idle_timers = XCDR (idle_timers);
3983 continue;
3985 vector = XVECTOR (timer)->contents;
3987 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
3988 || !INTEGERP (vector[3])
3989 || ! NILP (vector[0]))
3991 idle_timers = XCDR (idle_timers);
3992 continue;
3996 /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
3997 based on the next ordinary timer.
3998 TIMER_DIFFERENCE is the distance in time from NOW to when
3999 this timer becomes ripe (negative if it's already ripe). */
4000 if (!NILP (timers))
4002 timer = XCAR (timers);
4003 vector = XVECTOR (timer)->contents;
4004 EMACS_SET_SECS (timer_time,
4005 (XINT (vector[1]) << 16) | (XINT (vector[2])));
4006 EMACS_SET_USECS (timer_time, XINT (vector[3]));
4007 EMACS_SUB_TIME (timer_difference, timer_time, now);
4010 /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
4011 based on the next idle timer. */
4012 if (!NILP (idle_timers))
4014 idle_timer = XCAR (idle_timers);
4015 vector = XVECTOR (idle_timer)->contents;
4016 EMACS_SET_SECS (idle_timer_time,
4017 (XINT (vector[1]) << 16) | (XINT (vector[2])));
4018 EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
4019 EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
4022 /* Decide which timer is the next timer,
4023 and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
4024 Also step down the list where we found that timer. */
4026 if (! NILP (timers) && ! NILP (idle_timers))
4028 EMACS_TIME temp;
4029 EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
4030 if (EMACS_TIME_NEG_P (temp))
4032 chosen_timer = timer;
4033 timers = XCDR (timers);
4034 difference = timer_difference;
4036 else
4038 chosen_timer = idle_timer;
4039 idle_timers = XCDR (idle_timers);
4040 difference = idle_timer_difference;
4043 else if (! NILP (timers))
4045 chosen_timer = timer;
4046 timers = XCDR (timers);
4047 difference = timer_difference;
4049 else
4051 chosen_timer = idle_timer;
4052 idle_timers = XCDR (idle_timers);
4053 difference = idle_timer_difference;
4055 vector = XVECTOR (chosen_timer)->contents;
4057 /* If timer is ripe, run it if it hasn't been run. */
4058 if (EMACS_TIME_NEG_P (difference)
4059 || (EMACS_SECS (difference) == 0
4060 && EMACS_USECS (difference) == 0))
4062 if (NILP (vector[0]))
4064 int was_locked = single_kboard;
4065 int count = BINDING_STACK_SIZE ();
4066 Lisp_Object old_deactivate_mark = Vdeactivate_mark;
4068 /* Mark the timer as triggered to prevent problems if the lisp
4069 code fails to reschedule it right. */
4070 vector[0] = Qt;
4072 specbind (Qinhibit_quit, Qt);
4074 call1 (Qtimer_event_handler, chosen_timer);
4075 Vdeactivate_mark = old_deactivate_mark;
4076 timers_run++;
4077 unbind_to (count, Qnil);
4079 /* Resume allowing input from any kboard, if that was true before. */
4080 if (!was_locked)
4081 any_kboard_state ();
4083 /* Since we have handled the event,
4084 we don't need to tell the caller to wake up and do it. */
4087 else
4088 /* When we encounter a timer that is still waiting,
4089 return the amount of time to wait before it is ripe. */
4091 UNGCPRO;
4092 return difference;
4096 /* No timers are pending in the future. */
4097 /* Return 0 if we generated an event, and -1 if not. */
4098 UNGCPRO;
4099 return nexttime;
4102 /* Caches for modify_event_symbol. */
4103 static Lisp_Object accent_key_syms;
4104 static Lisp_Object func_key_syms;
4105 static Lisp_Object mouse_syms;
4106 #ifdef WINDOWSNT
4107 static Lisp_Object mouse_wheel_syms;
4108 #endif
4109 static Lisp_Object drag_n_drop_syms;
4111 /* This is a list of keysym codes for special "accent" characters.
4112 It parallels lispy_accent_keys. */
4114 static int lispy_accent_codes[] =
4116 #ifdef XK_dead_circumflex
4117 XK_dead_circumflex,
4118 #else
4120 #endif
4121 #ifdef XK_dead_grave
4122 XK_dead_grave,
4123 #else
4125 #endif
4126 #ifdef XK_dead_tilde
4127 XK_dead_tilde,
4128 #else
4130 #endif
4131 #ifdef XK_dead_diaeresis
4132 XK_dead_diaeresis,
4133 #else
4135 #endif
4136 #ifdef XK_dead_macron
4137 XK_dead_macron,
4138 #else
4140 #endif
4141 #ifdef XK_dead_degree
4142 XK_dead_degree,
4143 #else
4145 #endif
4146 #ifdef XK_dead_acute
4147 XK_dead_acute,
4148 #else
4150 #endif
4151 #ifdef XK_dead_cedilla
4152 XK_dead_cedilla,
4153 #else
4155 #endif
4156 #ifdef XK_dead_breve
4157 XK_dead_breve,
4158 #else
4160 #endif
4161 #ifdef XK_dead_ogonek
4162 XK_dead_ogonek,
4163 #else
4165 #endif
4166 #ifdef XK_dead_caron
4167 XK_dead_caron,
4168 #else
4170 #endif
4171 #ifdef XK_dead_doubleacute
4172 XK_dead_doubleacute,
4173 #else
4175 #endif
4176 #ifdef XK_dead_abovedot
4177 XK_dead_abovedot,
4178 #else
4180 #endif
4183 /* This is a list of Lisp names for special "accent" characters.
4184 It parallels lispy_accent_codes. */
4186 static char *lispy_accent_keys[] =
4188 "dead-circumflex",
4189 "dead-grave",
4190 "dead-tilde",
4191 "dead-diaeresis",
4192 "dead-macron",
4193 "dead-degree",
4194 "dead-acute",
4195 "dead-cedilla",
4196 "dead-breve",
4197 "dead-ogonek",
4198 "dead-caron",
4199 "dead-doubleacute",
4200 "dead-abovedot",
4203 #ifdef HAVE_NTGUI
4204 #define FUNCTION_KEY_OFFSET 0x0
4206 char *lispy_function_keys[] =
4208 0, /* 0 */
4210 0, /* VK_LBUTTON 0x01 */
4211 0, /* VK_RBUTTON 0x02 */
4212 "cancel", /* VK_CANCEL 0x03 */
4213 0, /* VK_MBUTTON 0x04 */
4215 0, 0, 0, /* 0x05 .. 0x07 */
4217 "backspace", /* VK_BACK 0x08 */
4218 "tab", /* VK_TAB 0x09 */
4220 0, 0, /* 0x0A .. 0x0B */
4222 "clear", /* VK_CLEAR 0x0C */
4223 "return", /* VK_RETURN 0x0D */
4225 0, 0, /* 0x0E .. 0x0F */
4227 0, /* VK_SHIFT 0x10 */
4228 0, /* VK_CONTROL 0x11 */
4229 0, /* VK_MENU 0x12 */
4230 "pause", /* VK_PAUSE 0x13 */
4231 "capslock", /* VK_CAPITAL 0x14 */
4233 0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */
4235 "escape", /* VK_ESCAPE 0x1B */
4237 0, 0, 0, 0, /* 0x1C .. 0x1F */
4239 0, /* VK_SPACE 0x20 */
4240 "prior", /* VK_PRIOR 0x21 */
4241 "next", /* VK_NEXT 0x22 */
4242 "end", /* VK_END 0x23 */
4243 "home", /* VK_HOME 0x24 */
4244 "left", /* VK_LEFT 0x25 */
4245 "up", /* VK_UP 0x26 */
4246 "right", /* VK_RIGHT 0x27 */
4247 "down", /* VK_DOWN 0x28 */
4248 "select", /* VK_SELECT 0x29 */
4249 "print", /* VK_PRINT 0x2A */
4250 "execute", /* VK_EXECUTE 0x2B */
4251 "snapshot", /* VK_SNAPSHOT 0x2C */
4252 "insert", /* VK_INSERT 0x2D */
4253 "delete", /* VK_DELETE 0x2E */
4254 "help", /* VK_HELP 0x2F */
4256 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
4258 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4260 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
4262 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
4264 0, 0, 0, 0, 0, 0, 0, 0, 0,
4265 0, 0, 0, 0, 0, 0, 0, 0, 0,
4266 0, 0, 0, 0, 0, 0, 0, 0,
4268 "lwindow", /* VK_LWIN 0x5B */
4269 "rwindow", /* VK_RWIN 0x5C */
4270 "apps", /* VK_APPS 0x5D */
4272 0, 0, /* 0x5E .. 0x5F */
4274 "kp-0", /* VK_NUMPAD0 0x60 */
4275 "kp-1", /* VK_NUMPAD1 0x61 */
4276 "kp-2", /* VK_NUMPAD2 0x62 */
4277 "kp-3", /* VK_NUMPAD3 0x63 */
4278 "kp-4", /* VK_NUMPAD4 0x64 */
4279 "kp-5", /* VK_NUMPAD5 0x65 */
4280 "kp-6", /* VK_NUMPAD6 0x66 */
4281 "kp-7", /* VK_NUMPAD7 0x67 */
4282 "kp-8", /* VK_NUMPAD8 0x68 */
4283 "kp-9", /* VK_NUMPAD9 0x69 */
4284 "kp-multiply", /* VK_MULTIPLY 0x6A */
4285 "kp-add", /* VK_ADD 0x6B */
4286 "kp-separator", /* VK_SEPARATOR 0x6C */
4287 "kp-subtract", /* VK_SUBTRACT 0x6D */
4288 "kp-decimal", /* VK_DECIMAL 0x6E */
4289 "kp-divide", /* VK_DIVIDE 0x6F */
4290 "f1", /* VK_F1 0x70 */
4291 "f2", /* VK_F2 0x71 */
4292 "f3", /* VK_F3 0x72 */
4293 "f4", /* VK_F4 0x73 */
4294 "f5", /* VK_F5 0x74 */
4295 "f6", /* VK_F6 0x75 */
4296 "f7", /* VK_F7 0x76 */
4297 "f8", /* VK_F8 0x77 */
4298 "f9", /* VK_F9 0x78 */
4299 "f10", /* VK_F10 0x79 */
4300 "f11", /* VK_F11 0x7A */
4301 "f12", /* VK_F12 0x7B */
4302 "f13", /* VK_F13 0x7C */
4303 "f14", /* VK_F14 0x7D */
4304 "f15", /* VK_F15 0x7E */
4305 "f16", /* VK_F16 0x7F */
4306 "f17", /* VK_F17 0x80 */
4307 "f18", /* VK_F18 0x81 */
4308 "f19", /* VK_F19 0x82 */
4309 "f20", /* VK_F20 0x83 */
4310 "f21", /* VK_F21 0x84 */
4311 "f22", /* VK_F22 0x85 */
4312 "f23", /* VK_F23 0x86 */
4313 "f24", /* VK_F24 0x87 */
4315 0, 0, 0, 0, /* 0x88 .. 0x8B */
4316 0, 0, 0, 0, /* 0x8C .. 0x8F */
4318 "kp-numlock", /* VK_NUMLOCK 0x90 */
4319 "scroll", /* VK_SCROLL 0x91 */
4321 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
4322 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
4323 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
4324 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
4325 "kp-end", /* VK_NUMPAD_END 0x96 */
4326 "kp-home", /* VK_NUMPAD_HOME 0x97 */
4327 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
4328 "kp-up", /* VK_NUMPAD_UP 0x99 */
4329 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
4330 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
4331 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
4332 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
4334 0, 0, /* 0x9E .. 0x9F */
4337 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
4338 * Used only as parameters to GetAsyncKeyState and GetKeyState.
4339 * No other API or message will distinguish left and right keys this way.
4341 /* 0xA0 .. 0xEF */
4343 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4344 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4345 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4346 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4347 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4349 /* 0xF0 .. 0xF5 */
4351 0, 0, 0, 0, 0, 0,
4353 "attn", /* VK_ATTN 0xF6 */
4354 "crsel", /* VK_CRSEL 0xF7 */
4355 "exsel", /* VK_EXSEL 0xF8 */
4356 "ereof", /* VK_EREOF 0xF9 */
4357 "play", /* VK_PLAY 0xFA */
4358 "zoom", /* VK_ZOOM 0xFB */
4359 "noname", /* VK_NONAME 0xFC */
4360 "pa1", /* VK_PA1 0xFD */
4361 "oem_clear", /* VK_OEM_CLEAR 0xFE */
4362 0 /* 0xFF */
4365 #else /* not HAVE_NTGUI */
4367 #ifdef XK_kana_A
4368 static char *lispy_kana_keys[] =
4370 /* X Keysym value */
4371 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
4372 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
4373 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
4374 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
4375 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
4376 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
4377 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
4378 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
4379 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
4380 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
4381 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
4382 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
4383 "kana-i", "kana-u", "kana-e", "kana-o",
4384 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
4385 "prolongedsound", "kana-A", "kana-I", "kana-U",
4386 "kana-E", "kana-O", "kana-KA", "kana-KI",
4387 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
4388 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
4389 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
4390 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
4391 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
4392 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
4393 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
4394 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
4395 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
4396 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
4397 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
4398 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
4400 #endif /* XK_kana_A */
4402 #define FUNCTION_KEY_OFFSET 0xff00
4404 /* You'll notice that this table is arranged to be conveniently
4405 indexed by X Windows keysym values. */
4406 static char *lispy_function_keys[] =
4408 /* X Keysym value */
4410 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
4411 "backspace", "tab", "linefeed", "clear",
4412 0, "return", 0, 0,
4413 0, 0, 0, "pause", /* 0xff10...1f */
4414 0, 0, 0, 0, 0, 0, 0, "escape",
4415 0, 0, 0, 0,
4416 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
4417 "romaji", "hiragana", "katakana", "hiragana-katakana",
4418 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
4419 "massyo", "kana-lock", "kana-shift", "eisu-shift",
4420 "eisu-toggle", /* 0xff30...3f */
4421 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4422 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
4424 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
4425 "down", "prior", "next", "end",
4426 "begin", 0, 0, 0, 0, 0, 0, 0,
4427 "select", /* 0xff60 */ /* IsMiscFunctionKey */
4428 "print",
4429 "execute",
4430 "insert",
4431 0, /* 0xff64 */
4432 "undo",
4433 "redo",
4434 "menu",
4435 "find",
4436 "cancel",
4437 "help",
4438 "break", /* 0xff6b */
4440 0, 0, 0, 0,
4441 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
4442 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
4443 "kp-space", /* 0xff80 */ /* IsKeypadKey */
4444 0, 0, 0, 0, 0, 0, 0, 0,
4445 "kp-tab", /* 0xff89 */
4446 0, 0, 0,
4447 "kp-enter", /* 0xff8d */
4448 0, 0, 0,
4449 "kp-f1", /* 0xff91 */
4450 "kp-f2",
4451 "kp-f3",
4452 "kp-f4",
4453 "kp-home", /* 0xff95 */
4454 "kp-left",
4455 "kp-up",
4456 "kp-right",
4457 "kp-down",
4458 "kp-prior", /* kp-page-up */
4459 "kp-next", /* kp-page-down */
4460 "kp-end",
4461 "kp-begin",
4462 "kp-insert",
4463 "kp-delete",
4464 0, /* 0xffa0 */
4465 0, 0, 0, 0, 0, 0, 0, 0, 0,
4466 "kp-multiply", /* 0xffaa */
4467 "kp-add",
4468 "kp-separator",
4469 "kp-subtract",
4470 "kp-decimal",
4471 "kp-divide", /* 0xffaf */
4472 "kp-0", /* 0xffb0 */
4473 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
4474 0, /* 0xffba */
4475 0, 0,
4476 "kp-equal", /* 0xffbd */
4477 "f1", /* 0xffbe */ /* IsFunctionKey */
4478 "f2",
4479 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
4480 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
4481 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
4482 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
4483 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
4484 0, 0, 0, 0, 0, 0, 0, 0,
4485 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
4486 0, 0, 0, 0, 0, 0, 0, "delete"
4489 /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
4490 #define ISO_FUNCTION_KEY_OFFSET 0xfe00
4492 static char *iso_lispy_function_keys[] =
4494 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
4495 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
4496 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
4497 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
4498 "iso-lefttab", /* 0xfe20 */
4499 "iso-move-line-up", "iso-move-line-down",
4500 "iso-partial-line-up", "iso-partial-line-down",
4501 "iso-partial-space-left", "iso-partial-space-right",
4502 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
4503 "iso-release-margin-left", "iso-release-margin-right",
4504 "iso-release-both-margins",
4505 "iso-fast-cursor-left", "iso-fast-cursor-right",
4506 "iso-fast-cursor-up", "iso-fast-cursor-down",
4507 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
4508 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
4511 #endif /* not HAVE_NTGUI */
4513 Lisp_Object Vlispy_mouse_stem;
4515 #ifdef WINDOWSNT
4516 /* mouse-wheel events are generated by the wheel on devices such as
4517 the MS Intellimouse. The wheel sits in between the left and right
4518 mouse buttons, and is typically used to scroll or zoom the window
4519 underneath the pointer. mouse-wheel events specify the object on
4520 which they operate, and a delta corresponding to the amount and
4521 direction that the wheel is rotated. Clicking the mouse-wheel
4522 generates a mouse-2 event. */
4523 static char *lispy_mouse_wheel_names[] =
4525 "mouse-wheel"
4528 #endif /* WINDOWSNT */
4530 /* drag-n-drop events are generated when a set of selected files are
4531 dragged from another application and dropped onto an Emacs window. */
4532 static char *lispy_drag_n_drop_names[] =
4534 "drag-n-drop"
4537 /* Scroll bar parts. */
4538 Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
4539 Lisp_Object Qup, Qdown, Qbottom, Qend_scroll;
4540 Lisp_Object Qtop, Qratio;
4542 /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
4543 Lisp_Object *scroll_bar_parts[] = {
4544 &Qabove_handle, &Qhandle, &Qbelow_handle,
4545 &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio
4548 /* User signal events. */
4549 Lisp_Object Qusr1_signal, Qusr2_signal;
4551 Lisp_Object *lispy_user_signals[] =
4553 &Qusr1_signal, &Qusr2_signal
4557 /* A vector, indexed by button number, giving the down-going location
4558 of currently depressed buttons, both scroll bar and non-scroll bar.
4560 The elements have the form
4561 (BUTTON-NUMBER MODIFIER-MASK . REST)
4562 where REST is the cdr of a position as it would be reported in the event.
4564 The make_lispy_event function stores positions here to tell the
4565 difference between click and drag events, and to store the starting
4566 location to be included in drag events. */
4568 static Lisp_Object button_down_location;
4570 /* Information about the most recent up-going button event: Which
4571 button, what location, and what time. */
4573 static int last_mouse_button;
4574 static int last_mouse_x;
4575 static int last_mouse_y;
4576 static unsigned long button_down_time;
4578 /* The maximum time between clicks to make a double-click, or Qnil to
4579 disable double-click detection, or Qt for no time limit. */
4581 Lisp_Object Vdouble_click_time;
4583 /* Maximum number of pixels the mouse may be moved between clicks
4584 to make a double-click. */
4586 int double_click_fuzz;
4588 /* The number of clicks in this multiple-click. */
4590 int double_click_count;
4592 /* Given a struct input_event, build the lisp event which represents
4593 it. If EVENT is 0, build a mouse movement event from the mouse
4594 movement buffer, which should have a movement event in it.
4596 Note that events must be passed to this function in the order they
4597 are received; this function stores the location of button presses
4598 in order to build drag events when the button is released. */
4600 static Lisp_Object
4601 make_lispy_event (event)
4602 struct input_event *event;
4604 int i;
4606 switch (SWITCH_ENUM_CAST (event->kind))
4608 /* A simple keystroke. */
4609 case ascii_keystroke:
4611 Lisp_Object lispy_c;
4612 int c = event->code & 0377;
4613 /* Turn ASCII characters into control characters
4614 when proper. */
4615 if (event->modifiers & ctrl_modifier)
4616 c = make_ctrl_char (c);
4618 /* Add in the other modifier bits. We took care of ctrl_modifier
4619 just above, and the shift key was taken care of by the X code,
4620 and applied to control characters by make_ctrl_char. */
4621 c |= (event->modifiers
4622 & (meta_modifier | alt_modifier
4623 | hyper_modifier | super_modifier));
4624 /* Distinguish Shift-SPC from SPC. */
4625 if ((event->code & 0377) == 040
4626 && event->modifiers & shift_modifier)
4627 c |= shift_modifier;
4628 button_down_time = 0;
4629 XSETFASTINT (lispy_c, c);
4630 return lispy_c;
4633 case multibyte_char_keystroke:
4635 Lisp_Object lispy_c;
4637 XSETFASTINT (lispy_c, event->code);
4638 return lispy_c;
4641 /* A function key. The symbol may need to have modifier prefixes
4642 tacked onto it. */
4643 case non_ascii_keystroke:
4644 button_down_time = 0;
4646 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
4647 if (event->code == lispy_accent_codes[i])
4648 return modify_event_symbol (i,
4649 event->modifiers,
4650 Qfunction_key, Qnil,
4651 lispy_accent_keys, &accent_key_syms,
4652 (sizeof (lispy_accent_keys)
4653 / sizeof (lispy_accent_keys[0])));
4655 /* Handle system-specific keysyms. */
4656 if (event->code & (1 << 28))
4658 /* We need to use an alist rather than a vector as the cache
4659 since we can't make a vector long enuf. */
4660 if (NILP (current_kboard->system_key_syms))
4661 current_kboard->system_key_syms = Fcons (Qnil, Qnil);
4662 return modify_event_symbol (event->code,
4663 event->modifiers,
4664 Qfunction_key,
4665 current_kboard->Vsystem_key_alist,
4666 0, &current_kboard->system_key_syms,
4667 (unsigned)-1);
4670 #ifdef XK_kana_A
4671 if (event->code >= 0x400 && event->code < 0x500)
4672 return modify_event_symbol (event->code - 0x400,
4673 event->modifiers & ~shift_modifier,
4674 Qfunction_key, Qnil,
4675 lispy_kana_keys, &func_key_syms,
4676 (sizeof (lispy_kana_keys)
4677 / sizeof (lispy_kana_keys[0])));
4678 #endif /* XK_kana_A */
4680 #ifdef ISO_FUNCTION_KEY_OFFSET
4681 if (event->code < FUNCTION_KEY_OFFSET
4682 && event->code >= ISO_FUNCTION_KEY_OFFSET)
4683 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
4684 event->modifiers,
4685 Qfunction_key, Qnil,
4686 iso_lispy_function_keys, &func_key_syms,
4687 (sizeof (iso_lispy_function_keys)
4688 / sizeof (iso_lispy_function_keys[0])));
4689 else
4690 #endif
4691 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
4692 event->modifiers,
4693 Qfunction_key, Qnil,
4694 lispy_function_keys, &func_key_syms,
4695 (sizeof (lispy_function_keys)
4696 / sizeof (lispy_function_keys[0])));
4698 #ifdef HAVE_MOUSE
4699 /* A mouse click. Figure out where it is, decide whether it's
4700 a press, click or drag, and build the appropriate structure. */
4701 case mouse_click:
4702 #ifndef USE_TOOLKIT_SCROLL_BARS
4703 case scroll_bar_click:
4704 #endif
4706 int button = event->code;
4707 int is_double;
4708 Lisp_Object position;
4709 Lisp_Object *start_pos_ptr;
4710 Lisp_Object start_pos;
4711 Lisp_Object window;
4713 position = Qnil;
4715 /* Build the position as appropriate for this mouse click. */
4716 if (event->kind == mouse_click)
4718 int part;
4719 struct frame *f = XFRAME (event->frame_or_window);
4720 Lisp_Object posn;
4721 Lisp_Object string_info = Qnil;
4722 int row, column;
4724 /* Ignore mouse events that were made on frame that
4725 have been deleted. */
4726 if (! FRAME_LIVE_P (f))
4727 return Qnil;
4729 /* EVENT->x and EVENT->y are frame-relative pixel
4730 coordinates at this place. Under old redisplay, COLUMN
4731 and ROW are set to frame relative glyph coordinates
4732 which are then used to determine whether this click is
4733 in a menu (non-toolkit version). */
4734 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
4735 &column, &row, NULL, 1);
4737 #ifndef USE_X_TOOLKIT
4738 /* In the non-toolkit version, clicks on the menu bar
4739 are ordinary button events in the event buffer.
4740 Distinguish them, and invoke the menu.
4742 (In the toolkit version, the toolkit handles the menu bar
4743 and Emacs doesn't know about it until after the user
4744 makes a selection.) */
4745 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
4746 && (event->modifiers & down_modifier))
4748 Lisp_Object items, item;
4749 int hpos;
4750 int i;
4752 #if 0
4753 /* Activate the menu bar on the down event. If the
4754 up event comes in before the menu code can deal with it,
4755 just ignore it. */
4756 if (! (event->modifiers & down_modifier))
4757 return Qnil;
4758 #endif
4760 /* Find the menu bar item under `column'. */
4761 item = Qnil;
4762 items = FRAME_MENU_BAR_ITEMS (f);
4763 for (i = 0; i < XVECTOR (items)->size; i += 4)
4765 Lisp_Object pos, string;
4766 string = AREF (items, i + 1);
4767 pos = AREF (items, i + 3);
4768 if (NILP (string))
4769 break;
4770 if (column >= XINT (pos)
4771 && column < XINT (pos) + XSTRING (string)->size)
4773 item = AREF (items, i);
4774 break;
4778 /* ELisp manual 2.4b says (x y) are window relative but
4779 code says they are frame-relative. */
4780 position
4781 = Fcons (event->frame_or_window,
4782 Fcons (Qmenu_bar,
4783 Fcons (Fcons (event->x, event->y),
4784 Fcons (make_number (event->timestamp),
4785 Qnil))));
4787 return Fcons (item, Fcons (position, Qnil));
4789 #endif /* not USE_X_TOOLKIT */
4791 /* Set `window' to the window under frame pixel coordinates
4792 event->x/event->y. */
4793 window = window_from_coordinates (f, XINT (event->x),
4794 XINT (event->y), &part, 0);
4796 if (!WINDOWP (window))
4798 window = event->frame_or_window;
4799 posn = Qnil;
4801 else
4803 /* It's a click in window window at frame coordinates
4804 event->x/ event->y. */
4805 struct window *w = XWINDOW (window);
4807 /* Get window relative coordinates. Original code
4808 `rounded' this to glyph boundaries. */
4809 int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
4810 int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
4812 /* Set event coordinates to window-relative coordinates
4813 for constructing the Lisp event below. */
4814 XSETINT (event->x, wx);
4815 XSETINT (event->y, wy);
4817 if (part == 1 || part == 3)
4819 /* Mode line or header line. Look for a string under
4820 the mouse that may have a `local-map' property. */
4821 Lisp_Object string;
4822 int charpos;
4824 posn = part == 1 ? Qmode_line : Qheader_line;
4825 string = mode_line_string (w, wx, wy, part == 1, &charpos);
4826 if (STRINGP (string))
4827 string_info = Fcons (string, make_number (charpos));
4829 else if (part == 2)
4830 posn = Qvertical_line;
4831 else
4833 Lisp_Object object;
4834 struct display_pos p;
4835 buffer_posn_from_coords (w, &wx, &wy, &object, &p);
4836 posn = make_number (CHARPOS (p.pos));
4837 if (STRINGP (object))
4838 string_info
4839 = Fcons (object,
4840 make_number (CHARPOS (p.string_pos)));
4844 position
4845 = Fcons (window,
4846 Fcons (posn,
4847 Fcons (Fcons (event->x, event->y),
4848 Fcons (make_number (event->timestamp),
4849 (NILP (string_info)
4850 ? Qnil
4851 : Fcons (string_info, Qnil))))));
4853 #ifndef USE_TOOLKIT_SCROLL_BARS
4854 else
4856 /* It's a scrollbar click. */
4857 Lisp_Object portion_whole;
4858 Lisp_Object part;
4860 window = event->frame_or_window;
4861 portion_whole = Fcons (event->x, event->y);
4862 part = *scroll_bar_parts[(int) event->part];
4864 position
4865 = Fcons (window,
4866 Fcons (Qvertical_scroll_bar,
4867 Fcons (portion_whole,
4868 Fcons (make_number (event->timestamp),
4869 Fcons (part, Qnil)))));
4871 #endif /* not USE_TOOLKIT_SCROLL_BARS */
4873 if (button >= ASIZE (button_down_location))
4875 button_down_location = larger_vector (button_down_location,
4876 button + 1, Qnil);
4877 mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
4880 start_pos_ptr = &AREF (button_down_location, button);
4881 start_pos = *start_pos_ptr;
4882 *start_pos_ptr = Qnil;
4885 /* On window-system frames, use the value of
4886 double-click-fuzz as is. On other frames, interpret it
4887 as a multiple of 1/8 characters. */
4888 struct frame *f;
4889 int fuzz;
4891 if (WINDOWP (event->frame_or_window))
4892 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
4893 else if (FRAMEP (event->frame_or_window))
4894 f = XFRAME (event->frame_or_window);
4895 else
4896 abort ();
4898 if (FRAME_WINDOW_P (f))
4899 fuzz = double_click_fuzz;
4900 else
4901 fuzz = double_click_fuzz / 8;
4903 is_double = (button == last_mouse_button
4904 && (abs (XINT (event->x) - last_mouse_x) <= fuzz)
4905 && (abs (XINT (event->y) - last_mouse_y) <= fuzz)
4906 && button_down_time != 0
4907 && (EQ (Vdouble_click_time, Qt)
4908 || (INTEGERP (Vdouble_click_time)
4909 && ((int)(event->timestamp - button_down_time)
4910 < XINT (Vdouble_click_time)))));
4913 last_mouse_button = button;
4914 last_mouse_x = XINT (event->x);
4915 last_mouse_y = XINT (event->y);
4917 /* If this is a button press, squirrel away the location, so
4918 we can decide later whether it was a click or a drag. */
4919 if (event->modifiers & down_modifier)
4921 if (is_double)
4923 double_click_count++;
4924 event->modifiers |= ((double_click_count > 2)
4925 ? triple_modifier
4926 : double_modifier);
4928 else
4929 double_click_count = 1;
4930 button_down_time = event->timestamp;
4931 *start_pos_ptr = Fcopy_alist (position);
4934 /* Now we're releasing a button - check the co-ordinates to
4935 see if this was a click or a drag. */
4936 else if (event->modifiers & up_modifier)
4938 /* If we did not see a down before this up, ignore the up.
4939 Probably this happened because the down event chose a
4940 menu item. It would be an annoyance to treat the
4941 release of the button that chose the menu item as a
4942 separate event. */
4944 if (!CONSP (start_pos))
4945 return Qnil;
4947 event->modifiers &= ~up_modifier;
4948 #if 0 /* Formerly we treated an up with no down as a click event. */
4949 if (!CONSP (start_pos))
4950 event->modifiers |= click_modifier;
4951 else
4952 #endif
4954 /* The third element of every position should be the (x,y)
4955 pair. */
4956 Lisp_Object down;
4958 down = Fnth (make_number (2), start_pos);
4959 if (EQ (event->x, XCAR (down)) && EQ (event->y, XCDR (down)))
4960 /* Mouse hasn't moved. */
4961 event->modifiers |= click_modifier;
4962 else
4964 Lisp_Object window1, window2, posn1, posn2;
4966 /* Avoid generating a drag event if the mouse
4967 hasn't actually moved off the buffer position. */
4968 window1 = Fnth (make_number (0), position);
4969 posn1 = Fnth (make_number (1), position);
4970 window2 = Fnth (make_number (0), start_pos);
4971 posn2 = Fnth (make_number (1), start_pos);
4973 if (EQ (window1, window2) && EQ (posn1, posn2))
4974 event->modifiers |= click_modifier;
4975 else
4977 button_down_time = 0;
4978 event->modifiers |= drag_modifier;
4982 /* Don't check is_double; treat this as multiple
4983 if the down-event was multiple. */
4984 if (double_click_count > 1)
4985 event->modifiers |= ((double_click_count > 2)
4986 ? triple_modifier
4987 : double_modifier);
4990 else
4991 /* Every mouse event should either have the down_modifier or
4992 the up_modifier set. */
4993 abort ();
4996 /* Get the symbol we should use for the mouse click. */
4997 Lisp_Object head;
4999 head = modify_event_symbol (button,
5000 event->modifiers,
5001 Qmouse_click, Vlispy_mouse_stem,
5002 NULL,
5003 &mouse_syms,
5004 XVECTOR (mouse_syms)->size);
5005 if (event->modifiers & drag_modifier)
5006 return Fcons (head,
5007 Fcons (start_pos,
5008 Fcons (position,
5009 Qnil)));
5010 else if (event->modifiers & (double_modifier | triple_modifier))
5011 return Fcons (head,
5012 Fcons (position,
5013 Fcons (make_number (double_click_count),
5014 Qnil)));
5015 else
5016 return Fcons (head,
5017 Fcons (position,
5018 Qnil));
5022 #if USE_TOOLKIT_SCROLL_BARS
5024 /* We don't have down and up events if using toolkit scroll bars,
5025 so make this always a click event. Store in the `part' of
5026 the Lisp event a symbol which maps to the following actions:
5028 `above_handle' page up
5029 `below_handle' page down
5030 `up' line up
5031 `down' line down
5032 `top' top of buffer
5033 `bottom' bottom of buffer
5034 `handle' thumb has been dragged.
5035 `end-scroll' end of interaction with scroll bar
5037 The incoming input_event contains in its `part' member an
5038 index of type `enum scroll_bar_part' which we can use as an
5039 index in scroll_bar_parts to get the appropriate symbol. */
5041 case scroll_bar_click:
5043 Lisp_Object position, head, window, portion_whole, part;
5045 window = event->frame_or_window;
5046 portion_whole = Fcons (event->x, event->y);
5047 part = *scroll_bar_parts[(int) event->part];
5049 position
5050 = Fcons (window,
5051 Fcons (Qvertical_scroll_bar,
5052 Fcons (portion_whole,
5053 Fcons (make_number (event->timestamp),
5054 Fcons (part, Qnil)))));
5056 /* Always treat scroll bar events as clicks. */
5057 event->modifiers |= click_modifier;
5059 /* Get the symbol we should use for the mouse click. */
5060 head = modify_event_symbol (event->code,
5061 event->modifiers,
5062 Qmouse_click,
5063 Vlispy_mouse_stem,
5064 NULL, &mouse_syms,
5065 XVECTOR (mouse_syms)->size);
5066 return Fcons (head, Fcons (position, Qnil));
5069 #endif /* USE_TOOLKIT_SCROLL_BARS */
5071 #ifdef WINDOWSNT
5072 case w32_scroll_bar_click:
5074 int button = event->code;
5075 int is_double;
5076 Lisp_Object position;
5077 Lisp_Object *start_pos_ptr;
5078 Lisp_Object start_pos;
5081 Lisp_Object window;
5082 Lisp_Object portion_whole;
5083 Lisp_Object part;
5085 window = event->frame_or_window;
5086 portion_whole = Fcons (event->x, event->y);
5087 part = *scroll_bar_parts[(int) event->part];
5089 position
5090 = Fcons (window,
5091 Fcons (Qvertical_scroll_bar,
5092 Fcons (portion_whole,
5093 Fcons (make_number (event->timestamp),
5094 Fcons (part, Qnil)))));
5097 /* Always treat W32 scroll bar events as clicks. */
5098 event->modifiers |= click_modifier;
5101 /* Get the symbol we should use for the mouse click. */
5102 Lisp_Object head;
5104 head = modify_event_symbol (button,
5105 event->modifiers,
5106 Qmouse_click,
5107 Vlispy_mouse_stem,
5108 NULL, &mouse_syms,
5109 XVECTOR (mouse_syms)->size);
5110 return Fcons (head,
5111 Fcons (position,
5112 Qnil));
5115 case mouse_wheel:
5117 int part;
5118 FRAME_PTR f = XFRAME (event->frame_or_window);
5119 Lisp_Object window;
5120 Lisp_Object posn;
5121 Lisp_Object head, position;
5122 int row, column;
5124 /* Ignore mouse events that were made on frame that
5125 have been deleted. */
5126 if (! FRAME_LIVE_P (f))
5127 return Qnil;
5128 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
5129 &column, &row, NULL, 1);
5130 window = window_from_coordinates (f, XINT (event->x),
5131 XINT (event->y), &part, 0);
5133 if (!WINDOWP (window))
5135 window = event->frame_or_window;
5136 posn = Qnil;
5138 else
5140 int pixcolumn, pixrow;
5141 column -= XINT (XWINDOW (window)->left);
5142 row -= XINT (XWINDOW (window)->top);
5143 glyph_to_pixel_coords (XWINDOW(window), column, row,
5144 &pixcolumn, &pixrow);
5145 XSETINT (event->x, pixcolumn);
5146 XSETINT (event->y, pixrow);
5148 if (part == 1)
5149 posn = Qmode_line;
5150 else if (part == 2)
5151 posn = Qvertical_line;
5152 else if (part == 3)
5153 posn = Qheader_line;
5154 else
5156 Lisp_Object object;
5157 struct display_pos p;
5158 buffer_posn_from_coords (XWINDOW (window), &column, &row,
5159 &object, &p);
5160 posn = make_number (CHARPOS (p.pos));
5165 Lisp_Object head, position;
5167 position
5168 = Fcons (window,
5169 Fcons (posn,
5170 Fcons (Fcons (event->x, event->y),
5171 Fcons (make_number (event->timestamp),
5172 Qnil))));
5174 head = modify_event_symbol (0, event->modifiers,
5175 Qmouse_wheel, Qnil,
5176 lispy_mouse_wheel_names,
5177 &mouse_wheel_syms, 1);
5178 return Fcons (head,
5179 Fcons (position,
5180 Fcons (make_number (event->code),
5181 Qnil)));
5184 #endif /* WINDOWSNT */
5186 case drag_n_drop:
5188 int part;
5189 FRAME_PTR f;
5190 Lisp_Object window;
5191 Lisp_Object posn;
5192 Lisp_Object files;
5194 /* The frame_or_window field should be a cons of the frame in
5195 which the event occurred and a list of the filenames
5196 dropped. */
5197 if (! CONSP (event->frame_or_window))
5198 abort ();
5200 f = XFRAME (XCAR (event->frame_or_window));
5201 files = XCDR (event->frame_or_window);
5203 /* Ignore mouse events that were made on frames that
5204 have been deleted. */
5205 if (! FRAME_LIVE_P (f))
5206 return Qnil;
5208 window = window_from_coordinates (f, XINT (event->x),
5209 XINT (event->y), &part, 0);
5211 if (!WINDOWP (window))
5213 window = XCAR (event->frame_or_window);
5214 posn = Qnil;
5216 else
5218 /* It's an event in window `window' at frame coordinates
5219 event->x/ event->y. */
5220 struct window *w = XWINDOW (window);
5222 /* Get window relative coordinates. */
5223 int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
5224 int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
5226 /* Set event coordinates to window-relative coordinates
5227 for constructing the Lisp event below. */
5228 XSETINT (event->x, wx);
5229 XSETINT (event->y, wy);
5231 if (part == 1)
5232 posn = Qmode_line;
5233 else if (part == 2)
5234 posn = Qvertical_line;
5235 else if (part == 3)
5236 posn = Qheader_line;
5237 else
5239 Lisp_Object object;
5240 struct display_pos p;
5241 buffer_posn_from_coords (w, &wx, &wy, &object, &p);
5242 posn = make_number (CHARPOS (p.pos));
5247 Lisp_Object head, position;
5249 position
5250 = Fcons (window,
5251 Fcons (posn,
5252 Fcons (Fcons (event->x, event->y),
5253 Fcons (make_number (event->timestamp),
5254 Qnil))));
5256 head = modify_event_symbol (0, event->modifiers,
5257 Qdrag_n_drop, Qnil,
5258 lispy_drag_n_drop_names,
5259 &drag_n_drop_syms, 1);
5260 return Fcons (head,
5261 Fcons (position,
5262 Fcons (files,
5263 Qnil)));
5266 #endif /* HAVE_MOUSE */
5268 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
5269 case MENU_BAR_EVENT:
5270 if (EQ (event->arg, event->frame_or_window))
5271 /* This is the prefix key. We translate this to
5272 `(menu_bar)' because the code in keyboard.c for menu
5273 events, which we use, relies on this. */
5274 return Fcons (Qmenu_bar, Qnil);
5275 return event->arg;
5276 #endif
5278 case TOOL_BAR_EVENT:
5279 if (EQ (event->arg, event->frame_or_window))
5280 /* This is the prefix key. We translate this to
5281 `(tool_bar)' because the code in keyboard.c for menu
5282 events, which we use, relies on this. */
5283 return Fcons (Qtool_bar, Qnil);
5284 else if (SYMBOLP (event->arg))
5285 return apply_modifiers (event->modifiers, event->arg);
5286 return event->arg;
5288 case USER_SIGNAL_EVENT:
5289 /* A user signal. */
5290 return *lispy_user_signals[event->code];
5292 /* The 'kind' field of the event is something we don't recognize. */
5293 default:
5294 abort ();
5298 #ifdef HAVE_MOUSE
5300 static Lisp_Object
5301 make_lispy_movement (frame, bar_window, part, x, y, time)
5302 FRAME_PTR frame;
5303 Lisp_Object bar_window;
5304 enum scroll_bar_part part;
5305 Lisp_Object x, y;
5306 unsigned long time;
5308 /* Is it a scroll bar movement? */
5309 if (frame && ! NILP (bar_window))
5311 Lisp_Object part_sym;
5313 part_sym = *scroll_bar_parts[(int) part];
5314 return Fcons (Qscroll_bar_movement,
5315 (Fcons (Fcons (bar_window,
5316 Fcons (Qvertical_scroll_bar,
5317 Fcons (Fcons (x, y),
5318 Fcons (make_number (time),
5319 Fcons (part_sym,
5320 Qnil))))),
5321 Qnil)));
5324 /* Or is it an ordinary mouse movement? */
5325 else
5327 int area;
5328 Lisp_Object window;
5329 Lisp_Object posn;
5331 if (frame)
5332 /* It's in a frame; which window on that frame? */
5333 window = window_from_coordinates (frame, XINT (x), XINT (y), &area, 0);
5334 else
5335 window = Qnil;
5337 if (WINDOWP (window))
5339 struct window *w = XWINDOW (window);
5340 int wx, wy;
5342 /* Get window relative coordinates. */
5343 wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (x));
5344 wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (y));
5345 XSETINT (x, wx);
5346 XSETINT (y, wy);
5348 if (area == 1)
5349 posn = Qmode_line;
5350 else if (area == 2)
5351 posn = Qvertical_line;
5352 else if (area == 3)
5353 posn = Qheader_line;
5354 else
5356 Lisp_Object object;
5357 struct display_pos p;
5358 buffer_posn_from_coords (w, &wx, &wy, &object, &p);
5359 posn = make_number (CHARPOS (p.pos));
5362 else if (frame != 0)
5364 XSETFRAME (window, frame);
5365 posn = Qnil;
5367 else
5369 window = Qnil;
5370 posn = Qnil;
5371 XSETFASTINT (x, 0);
5372 XSETFASTINT (y, 0);
5375 return Fcons (Qmouse_movement,
5376 Fcons (Fcons (window,
5377 Fcons (posn,
5378 Fcons (Fcons (x, y),
5379 Fcons (make_number (time),
5380 Qnil)))),
5381 Qnil));
5385 #endif /* HAVE_MOUSE */
5387 /* Construct a switch frame event. */
5388 static Lisp_Object
5389 make_lispy_switch_frame (frame)
5390 Lisp_Object frame;
5392 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
5395 /* Manipulating modifiers. */
5397 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
5399 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
5400 SYMBOL's name of the end of the modifiers; the string from this
5401 position is the unmodified symbol name.
5403 This doesn't use any caches. */
5405 static int
5406 parse_modifiers_uncached (symbol, modifier_end)
5407 Lisp_Object symbol;
5408 int *modifier_end;
5410 struct Lisp_String *name;
5411 int i;
5412 int modifiers;
5414 CHECK_SYMBOL (symbol, 1);
5416 modifiers = 0;
5417 name = XSYMBOL (symbol)->name;
5419 for (i = 0; i+2 <= STRING_BYTES (name); )
5421 int this_mod_end = 0;
5422 int this_mod = 0;
5424 /* See if the name continues with a modifier word.
5425 Check that the word appears, but don't check what follows it.
5426 Set this_mod and this_mod_end to record what we find. */
5428 switch (name->data[i])
5430 #define SINGLE_LETTER_MOD(BIT) \
5431 (this_mod_end = i + 1, this_mod = BIT)
5433 case 'A':
5434 SINGLE_LETTER_MOD (alt_modifier);
5435 break;
5437 case 'C':
5438 SINGLE_LETTER_MOD (ctrl_modifier);
5439 break;
5441 case 'H':
5442 SINGLE_LETTER_MOD (hyper_modifier);
5443 break;
5445 case 'M':
5446 SINGLE_LETTER_MOD (meta_modifier);
5447 break;
5449 case 'S':
5450 SINGLE_LETTER_MOD (shift_modifier);
5451 break;
5453 case 's':
5454 SINGLE_LETTER_MOD (super_modifier);
5455 break;
5457 #undef SINGLE_LETTER_MOD
5460 /* If we found no modifier, stop looking for them. */
5461 if (this_mod_end == 0)
5462 break;
5464 /* Check there is a dash after the modifier, so that it
5465 really is a modifier. */
5466 if (this_mod_end >= STRING_BYTES (name)
5467 || name->data[this_mod_end] != '-')
5468 break;
5470 /* This modifier is real; look for another. */
5471 modifiers |= this_mod;
5472 i = this_mod_end + 1;
5475 /* Should we include the `click' modifier? */
5476 if (! (modifiers & (down_modifier | drag_modifier
5477 | double_modifier | triple_modifier))
5478 && i + 7 == STRING_BYTES (name)
5479 && strncmp (name->data + i, "mouse-", 6) == 0
5480 && ('0' <= name->data[i + 6] && name->data[i + 6] <= '9'))
5481 modifiers |= click_modifier;
5483 if (modifier_end)
5484 *modifier_end = i;
5486 return modifiers;
5489 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
5490 prepended to the string BASE[0..BASE_LEN-1].
5491 This doesn't use any caches. */
5492 static Lisp_Object
5493 apply_modifiers_uncached (modifiers, base, base_len, base_len_byte)
5494 int modifiers;
5495 char *base;
5496 int base_len, base_len_byte;
5498 /* Since BASE could contain nulls, we can't use intern here; we have
5499 to use Fintern, which expects a genuine Lisp_String, and keeps a
5500 reference to it. */
5501 char *new_mods
5502 = (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
5503 int mod_len;
5506 char *p = new_mods;
5508 /* Only the event queue may use the `up' modifier; it should always
5509 be turned into a click or drag event before presented to lisp code. */
5510 if (modifiers & up_modifier)
5511 abort ();
5513 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
5514 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
5515 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
5516 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
5517 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
5518 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
5519 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
5520 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
5521 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
5522 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
5523 /* The click modifier is denoted by the absence of other modifiers. */
5525 *p = '\0';
5527 mod_len = p - new_mods;
5531 Lisp_Object new_name;
5533 new_name = make_uninit_multibyte_string (mod_len + base_len,
5534 mod_len + base_len_byte);
5535 bcopy (new_mods, XSTRING (new_name)->data, mod_len);
5536 bcopy (base, XSTRING (new_name)->data + mod_len, base_len_byte);
5538 return Fintern (new_name, Qnil);
5543 static char *modifier_names[] =
5545 "up", "down", "drag", "click", "double", "triple", 0, 0,
5546 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5547 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
5549 #define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
5551 static Lisp_Object modifier_symbols;
5553 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
5554 static Lisp_Object
5555 lispy_modifier_list (modifiers)
5556 int modifiers;
5558 Lisp_Object modifier_list;
5559 int i;
5561 modifier_list = Qnil;
5562 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
5563 if (modifiers & (1<<i))
5564 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
5565 modifier_list);
5567 return modifier_list;
5571 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
5572 where UNMODIFIED is the unmodified form of SYMBOL,
5573 MASK is the set of modifiers present in SYMBOL's name.
5574 This is similar to parse_modifiers_uncached, but uses the cache in
5575 SYMBOL's Qevent_symbol_element_mask property, and maintains the
5576 Qevent_symbol_elements property. */
5578 Lisp_Object
5579 parse_modifiers (symbol)
5580 Lisp_Object symbol;
5582 Lisp_Object elements;
5584 elements = Fget (symbol, Qevent_symbol_element_mask);
5585 if (CONSP (elements))
5586 return elements;
5587 else
5589 int end;
5590 int modifiers = parse_modifiers_uncached (symbol, &end);
5591 Lisp_Object unmodified;
5592 Lisp_Object mask;
5594 unmodified = Fintern (make_string (XSYMBOL (symbol)->name->data + end,
5595 STRING_BYTES (XSYMBOL (symbol)->name) - end),
5596 Qnil);
5598 if (modifiers & ~(((EMACS_INT)1 << VALBITS) - 1))
5599 abort ();
5600 XSETFASTINT (mask, modifiers);
5601 elements = Fcons (unmodified, Fcons (mask, Qnil));
5603 /* Cache the parsing results on SYMBOL. */
5604 Fput (symbol, Qevent_symbol_element_mask,
5605 elements);
5606 Fput (symbol, Qevent_symbol_elements,
5607 Fcons (unmodified, lispy_modifier_list (modifiers)));
5609 /* Since we know that SYMBOL is modifiers applied to unmodified,
5610 it would be nice to put that in unmodified's cache.
5611 But we can't, since we're not sure that parse_modifiers is
5612 canonical. */
5614 return elements;
5618 /* Apply the modifiers MODIFIERS to the symbol BASE.
5619 BASE must be unmodified.
5621 This is like apply_modifiers_uncached, but uses BASE's
5622 Qmodifier_cache property, if present. It also builds
5623 Qevent_symbol_elements properties, since it has that info anyway.
5625 apply_modifiers copies the value of BASE's Qevent_kind property to
5626 the modified symbol. */
5627 static Lisp_Object
5628 apply_modifiers (modifiers, base)
5629 int modifiers;
5630 Lisp_Object base;
5632 Lisp_Object cache, index, entry, new_symbol;
5634 /* Mask out upper bits. We don't know where this value's been. */
5635 modifiers &= ((EMACS_INT)1 << VALBITS) - 1;
5637 /* The click modifier never figures into cache indices. */
5638 cache = Fget (base, Qmodifier_cache);
5639 XSETFASTINT (index, (modifiers & ~click_modifier));
5640 entry = assq_no_quit (index, cache);
5642 if (CONSP (entry))
5643 new_symbol = XCDR (entry);
5644 else
5646 /* We have to create the symbol ourselves. */
5647 new_symbol = apply_modifiers_uncached (modifiers,
5648 XSYMBOL (base)->name->data,
5649 XSYMBOL (base)->name->size,
5650 STRING_BYTES (XSYMBOL (base)->name));
5652 /* Add the new symbol to the base's cache. */
5653 entry = Fcons (index, new_symbol);
5654 Fput (base, Qmodifier_cache, Fcons (entry, cache));
5656 /* We have the parsing info now for free, so add it to the caches. */
5657 XSETFASTINT (index, modifiers);
5658 Fput (new_symbol, Qevent_symbol_element_mask,
5659 Fcons (base, Fcons (index, Qnil)));
5660 Fput (new_symbol, Qevent_symbol_elements,
5661 Fcons (base, lispy_modifier_list (modifiers)));
5664 /* Make sure this symbol is of the same kind as BASE.
5666 You'd think we could just set this once and for all when we
5667 intern the symbol above, but reorder_modifiers may call us when
5668 BASE's property isn't set right; we can't assume that just
5669 because it has a Qmodifier_cache property it must have its
5670 Qevent_kind set right as well. */
5671 if (NILP (Fget (new_symbol, Qevent_kind)))
5673 Lisp_Object kind;
5675 kind = Fget (base, Qevent_kind);
5676 if (! NILP (kind))
5677 Fput (new_symbol, Qevent_kind, kind);
5680 return new_symbol;
5684 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
5685 return a symbol with the modifiers placed in the canonical order.
5686 Canonical order is alphabetical, except for down and drag, which
5687 always come last. The 'click' modifier is never written out.
5689 Fdefine_key calls this to make sure that (for example) C-M-foo
5690 and M-C-foo end up being equivalent in the keymap. */
5692 Lisp_Object
5693 reorder_modifiers (symbol)
5694 Lisp_Object symbol;
5696 /* It's hopefully okay to write the code this way, since everything
5697 will soon be in caches, and no consing will be done at all. */
5698 Lisp_Object parsed;
5700 parsed = parse_modifiers (symbol);
5701 return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))),
5702 XCAR (parsed));
5706 /* For handling events, we often want to produce a symbol whose name
5707 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
5708 to some base, like the name of a function key or mouse button.
5709 modify_event_symbol produces symbols of this sort.
5711 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
5712 is the name of the i'th symbol. TABLE_SIZE is the number of elements
5713 in the table.
5715 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
5716 into symbol names, or a string specifying a name stem used to
5717 construct a symbol name or the form `STEM-N', where N is the decimal
5718 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
5719 non-nil; otherwise NAME_TABLE is used.
5721 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
5722 persist between calls to modify_event_symbol that it can use to
5723 store a cache of the symbols it's generated for this NAME_TABLE
5724 before. The object stored there may be a vector or an alist.
5726 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
5728 MODIFIERS is a set of modifier bits (as given in struct input_events)
5729 whose prefixes should be applied to the symbol name.
5731 SYMBOL_KIND is the value to be placed in the event_kind property of
5732 the returned symbol.
5734 The symbols we create are supposed to have an
5735 `event-symbol-elements' property, which lists the modifiers present
5736 in the symbol's name. */
5738 static Lisp_Object
5739 modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist_or_stem,
5740 name_table, symbol_table, table_size)
5741 int symbol_num;
5742 unsigned modifiers;
5743 Lisp_Object symbol_kind;
5744 Lisp_Object name_alist_or_stem;
5745 char **name_table;
5746 Lisp_Object *symbol_table;
5747 unsigned int table_size;
5749 Lisp_Object value;
5750 Lisp_Object symbol_int;
5752 /* Get rid of the "vendor-specific" bit here. */
5753 XSETINT (symbol_int, symbol_num & 0xffffff);
5755 /* Is this a request for a valid symbol? */
5756 if (symbol_num < 0 || symbol_num >= table_size)
5757 return Qnil;
5759 if (CONSP (*symbol_table))
5760 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
5762 /* If *symbol_table doesn't seem to be initialized properly, fix that.
5763 *symbol_table should be a lisp vector TABLE_SIZE elements long,
5764 where the Nth element is the symbol for NAME_TABLE[N], or nil if
5765 we've never used that symbol before. */
5766 else
5768 if (! VECTORP (*symbol_table)
5769 || XVECTOR (*symbol_table)->size != table_size)
5771 Lisp_Object size;
5773 XSETFASTINT (size, table_size);
5774 *symbol_table = Fmake_vector (size, Qnil);
5777 value = XVECTOR (*symbol_table)->contents[symbol_num];
5780 /* Have we already used this symbol before? */
5781 if (NILP (value))
5783 /* No; let's create it. */
5784 if (CONSP (name_alist_or_stem))
5785 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
5786 else if (STRINGP (name_alist_or_stem))
5788 int len = STRING_BYTES (XSTRING (name_alist_or_stem));
5789 char *buf = (char *) alloca (len + 50);
5790 sprintf (buf, "%s-%d", XSTRING (name_alist_or_stem)->data,
5791 XINT (symbol_int) + 1);
5792 value = intern (buf);
5794 else if (name_table != 0 && name_table[symbol_num])
5795 value = intern (name_table[symbol_num]);
5797 #ifdef HAVE_WINDOW_SYSTEM
5798 if (NILP (value))
5800 char *name = x_get_keysym_name (symbol_num);
5801 if (name)
5802 value = intern (name);
5804 #endif
5806 if (NILP (value))
5808 char buf[20];
5809 sprintf (buf, "key-%d", symbol_num);
5810 value = intern (buf);
5813 if (CONSP (*symbol_table))
5814 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
5815 else
5816 XVECTOR (*symbol_table)->contents[symbol_num] = value;
5818 /* Fill in the cache entries for this symbol; this also
5819 builds the Qevent_symbol_elements property, which the user
5820 cares about. */
5821 apply_modifiers (modifiers & click_modifier, value);
5822 Fput (value, Qevent_kind, symbol_kind);
5825 /* Apply modifiers to that symbol. */
5826 return apply_modifiers (modifiers, value);
5829 /* Convert a list that represents an event type,
5830 such as (ctrl meta backspace), into the usual representation of that
5831 event type as a number or a symbol. */
5833 DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
5834 "Convert the event description list EVENT-DESC to an event type.\n\
5835 EVENT-DESC should contain one base event type (a character or symbol)\n\
5836 and zero or more modifier names (control, meta, hyper, super, shift, alt,\n\
5837 drag, down, double or triple). The base must be last.\n\
5838 The return value is an event type (a character or symbol) which\n\
5839 has the same base event type and all the specified modifiers.")
5840 (event_desc)
5841 Lisp_Object event_desc;
5843 Lisp_Object base;
5844 int modifiers = 0;
5845 Lisp_Object rest;
5847 base = Qnil;
5848 rest = event_desc;
5849 while (CONSP (rest))
5851 Lisp_Object elt;
5852 int this = 0;
5854 elt = XCAR (rest);
5855 rest = XCDR (rest);
5857 /* Given a symbol, see if it is a modifier name. */
5858 if (SYMBOLP (elt) && CONSP (rest))
5859 this = parse_solitary_modifier (elt);
5861 if (this != 0)
5862 modifiers |= this;
5863 else if (!NILP (base))
5864 error ("Two bases given in one event");
5865 else
5866 base = elt;
5870 /* Let the symbol A refer to the character A. */
5871 if (SYMBOLP (base) && XSYMBOL (base)->name->size == 1)
5872 XSETINT (base, XSYMBOL (base)->name->data[0]);
5874 if (INTEGERP (base))
5876 /* Turn (shift a) into A. */
5877 if ((modifiers & shift_modifier) != 0
5878 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
5880 XSETINT (base, XINT (base) - ('a' - 'A'));
5881 modifiers &= ~shift_modifier;
5884 /* Turn (control a) into C-a. */
5885 if (modifiers & ctrl_modifier)
5886 return make_number ((modifiers & ~ctrl_modifier)
5887 | make_ctrl_char (XINT (base)));
5888 else
5889 return make_number (modifiers | XINT (base));
5891 else if (SYMBOLP (base))
5892 return apply_modifiers (modifiers, base);
5893 else
5895 error ("Invalid base event");
5896 return Qnil;
5900 /* Try to recognize SYMBOL as a modifier name.
5901 Return the modifier flag bit, or 0 if not recognized. */
5903 static int
5904 parse_solitary_modifier (symbol)
5905 Lisp_Object symbol;
5907 struct Lisp_String *name = XSYMBOL (symbol)->name;
5909 switch (name->data[0])
5911 #define SINGLE_LETTER_MOD(BIT) \
5912 if (STRING_BYTES (name) == 1) \
5913 return BIT;
5915 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
5916 if (LEN == STRING_BYTES (name) \
5917 && ! strncmp (name->data, NAME, LEN)) \
5918 return BIT;
5920 case 'A':
5921 SINGLE_LETTER_MOD (alt_modifier);
5922 break;
5924 case 'a':
5925 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
5926 break;
5928 case 'C':
5929 SINGLE_LETTER_MOD (ctrl_modifier);
5930 break;
5932 case 'c':
5933 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
5934 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
5935 break;
5937 case 'H':
5938 SINGLE_LETTER_MOD (hyper_modifier);
5939 break;
5941 case 'h':
5942 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
5943 break;
5945 case 'M':
5946 SINGLE_LETTER_MOD (meta_modifier);
5947 break;
5949 case 'm':
5950 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
5951 break;
5953 case 'S':
5954 SINGLE_LETTER_MOD (shift_modifier);
5955 break;
5957 case 's':
5958 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
5959 MULTI_LETTER_MOD (super_modifier, "super", 5);
5960 SINGLE_LETTER_MOD (super_modifier);
5961 break;
5963 case 'd':
5964 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
5965 MULTI_LETTER_MOD (down_modifier, "down", 4);
5966 MULTI_LETTER_MOD (double_modifier, "double", 6);
5967 break;
5969 case 't':
5970 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
5971 break;
5973 #undef SINGLE_LETTER_MOD
5974 #undef MULTI_LETTER_MOD
5977 return 0;
5980 /* Return 1 if EVENT is a list whose elements are all integers or symbols.
5981 Such a list is not valid as an event,
5982 but it can be a Lucid-style event type list. */
5985 lucid_event_type_list_p (object)
5986 Lisp_Object object;
5988 Lisp_Object tail;
5990 if (! CONSP (object))
5991 return 0;
5993 if (EQ (XCAR (object), Qhelp_echo)
5994 || EQ (XCAR (object), Qvertical_line)
5995 || EQ (XCAR (object), Qmode_line)
5996 || EQ (XCAR (object), Qheader_line))
5997 return 0;
5999 for (tail = object; CONSP (tail); tail = XCDR (tail))
6001 Lisp_Object elt;
6002 elt = XCAR (tail);
6003 if (! (INTEGERP (elt) || SYMBOLP (elt)))
6004 return 0;
6007 return NILP (tail);
6010 /* Store into *addr a value nonzero if terminal input chars are available.
6011 Serves the purpose of ioctl (0, FIONREAD, addr)
6012 but works even if FIONREAD does not exist.
6013 (In fact, this may actually read some input.)
6015 If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe. */
6017 static void
6018 get_input_pending (addr, do_timers_now)
6019 int *addr;
6020 int do_timers_now;
6022 /* First of all, have we already counted some input? */
6023 *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
6025 /* If input is being read as it arrives, and we have none, there is none. */
6026 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
6027 return;
6029 /* Try to read some input and see how much we get. */
6030 gobble_input (0);
6031 *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
6034 /* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
6036 void
6037 gobble_input (expected)
6038 int expected;
6040 #ifndef VMS
6041 #ifdef SIGIO
6042 if (interrupt_input)
6044 SIGMASKTYPE mask;
6045 mask = sigblock (sigmask (SIGIO));
6046 read_avail_input (expected);
6047 sigsetmask (mask);
6049 else
6050 #ifdef POLL_FOR_INPUT
6051 if (read_socket_hook && !interrupt_input && poll_suppress_count == 0)
6053 SIGMASKTYPE mask;
6054 mask = sigblock (sigmask (SIGALRM));
6055 read_avail_input (expected);
6056 sigsetmask (mask);
6058 else
6059 #endif
6060 #endif
6061 read_avail_input (expected);
6062 #endif
6065 /* Put a buffer_switch_event in the buffer
6066 so that read_key_sequence will notice the new current buffer. */
6068 void
6069 record_asynch_buffer_change ()
6071 struct input_event event;
6072 Lisp_Object tem;
6074 event.kind = buffer_switch_event;
6075 event.frame_or_window = Qnil;
6076 event.arg = Qnil;
6078 #ifdef subprocesses
6079 /* We don't need a buffer-switch event unless Emacs is waiting for input.
6080 The purpose of the event is to make read_key_sequence look up the
6081 keymaps again. If we aren't in read_key_sequence, we don't need one,
6082 and the event could cause trouble by messing up (input-pending-p). */
6083 tem = Fwaiting_for_user_input_p ();
6084 if (NILP (tem))
6085 return;
6086 #else
6087 /* We never need these events if we have no asynchronous subprocesses. */
6088 return;
6089 #endif
6091 /* Make sure no interrupt happens while storing the event. */
6092 #ifdef SIGIO
6093 if (interrupt_input)
6095 SIGMASKTYPE mask;
6096 mask = sigblock (sigmask (SIGIO));
6097 kbd_buffer_store_event (&event);
6098 sigsetmask (mask);
6100 else
6101 #endif
6103 stop_polling ();
6104 kbd_buffer_store_event (&event);
6105 start_polling ();
6109 #ifndef VMS
6111 /* Read any terminal input already buffered up by the system
6112 into the kbd_buffer, but do not wait.
6114 EXPECTED should be nonzero if the caller knows there is some input.
6116 Except on VMS, all input is read by this function.
6117 If interrupt_input is nonzero, this function MUST be called
6118 only when SIGIO is blocked.
6120 Returns the number of keyboard chars read, or -1 meaning
6121 this is a bad time to try to read input. */
6123 static int
6124 read_avail_input (expected)
6125 int expected;
6127 struct input_event buf[KBD_BUFFER_SIZE];
6128 register int i;
6129 int nread;
6131 if (read_socket_hook)
6132 /* No need for FIONREAD or fcntl; just say don't wait. */
6133 nread = (*read_socket_hook) (input_fd, buf, KBD_BUFFER_SIZE, expected);
6134 else
6136 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
6137 the kbd_buffer can really hold. That may prevent loss
6138 of characters on some systems when input is stuffed at us. */
6139 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
6140 int n_to_read;
6142 /* Determine how many characters we should *try* to read. */
6143 #ifdef WINDOWSNT
6144 return 0;
6145 #else /* not WINDOWSNT */
6146 #ifdef MSDOS
6147 n_to_read = dos_keysns ();
6148 if (n_to_read == 0)
6149 return 0;
6150 #else /* not MSDOS */
6151 #ifdef FIONREAD
6152 /* Find out how much input is available. */
6153 if (ioctl (input_fd, FIONREAD, &n_to_read) < 0)
6154 /* Formerly simply reported no input, but that sometimes led to
6155 a failure of Emacs to terminate.
6156 SIGHUP seems appropriate if we can't reach the terminal. */
6157 /* ??? Is it really right to send the signal just to this process
6158 rather than to the whole process group?
6159 Perhaps on systems with FIONREAD Emacs is alone in its group. */
6160 kill (getpid (), SIGHUP);
6161 if (n_to_read == 0)
6162 return 0;
6163 if (n_to_read > sizeof cbuf)
6164 n_to_read = sizeof cbuf;
6165 #else /* no FIONREAD */
6166 #if defined (USG) || defined (DGUX)
6167 /* Read some input if available, but don't wait. */
6168 n_to_read = sizeof cbuf;
6169 fcntl (input_fd, F_SETFL, O_NDELAY);
6170 #else
6171 you lose;
6172 #endif
6173 #endif
6174 #endif /* not MSDOS */
6175 #endif /* not WINDOWSNT */
6177 /* Now read; for one reason or another, this will not block.
6178 NREAD is set to the number of chars read. */
6181 #ifdef MSDOS
6182 cbuf[0] = dos_keyread ();
6183 nread = 1;
6184 #else
6185 nread = emacs_read (input_fd, cbuf, n_to_read);
6186 #endif
6187 /* POSIX infers that processes which are not in the session leader's
6188 process group won't get SIGHUP's at logout time. BSDI adheres to
6189 this part standard and returns -1 from read (0) with errno==EIO
6190 when the control tty is taken away.
6191 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
6192 if (nread == -1 && errno == EIO)
6193 kill (0, SIGHUP);
6194 #if defined (AIX) && (! defined (aix386) && defined (_BSD))
6195 /* The kernel sometimes fails to deliver SIGHUP for ptys.
6196 This looks incorrect, but it isn't, because _BSD causes
6197 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
6198 and that causes a value other than 0 when there is no input. */
6199 if (nread == 0)
6200 kill (0, SIGHUP);
6201 #endif
6203 while (
6204 /* We used to retry the read if it was interrupted.
6205 But this does the wrong thing when O_NDELAY causes
6206 an EAGAIN error. Does anybody know of a situation
6207 where a retry is actually needed? */
6208 #if 0
6209 nread < 0 && (errno == EAGAIN
6210 #ifdef EFAULT
6211 || errno == EFAULT
6212 #endif
6213 #ifdef EBADSLT
6214 || errno == EBADSLT
6215 #endif
6217 #else
6219 #endif
6222 #ifndef FIONREAD
6223 #if defined (USG) || defined (DGUX)
6224 fcntl (input_fd, F_SETFL, 0);
6225 #endif /* USG or DGUX */
6226 #endif /* no FIONREAD */
6227 for (i = 0; i < nread; i++)
6229 buf[i].kind = ascii_keystroke;
6230 buf[i].modifiers = 0;
6231 if (meta_key == 1 && (cbuf[i] & 0x80))
6232 buf[i].modifiers = meta_modifier;
6233 if (meta_key != 2)
6234 cbuf[i] &= ~0x80;
6236 buf[i].code = cbuf[i];
6237 buf[i].frame_or_window = selected_frame;
6238 buf[i].arg = Qnil;
6242 /* Scan the chars for C-g and store them in kbd_buffer. */
6243 for (i = 0; i < nread; i++)
6245 kbd_buffer_store_event (&buf[i]);
6246 /* Don't look at input that follows a C-g too closely.
6247 This reduces lossage due to autorepeat on C-g. */
6248 if (buf[i].kind == ascii_keystroke
6249 && buf[i].code == quit_char)
6250 break;
6253 return nread;
6255 #endif /* not VMS */
6257 #ifdef SIGIO /* for entire page */
6258 /* Note SIGIO has been undef'd if FIONREAD is missing. */
6260 SIGTYPE
6261 input_available_signal (signo)
6262 int signo;
6264 /* Must preserve main program's value of errno. */
6265 int old_errno = errno;
6266 #ifdef BSD4_1
6267 extern int select_alarmed;
6268 #endif
6270 #if defined (USG) && !defined (POSIX_SIGNALS)
6271 /* USG systems forget handlers when they are used;
6272 must reestablish each time */
6273 signal (signo, input_available_signal);
6274 #endif /* USG */
6276 #ifdef BSD4_1
6277 sigisheld (SIGIO);
6278 #endif
6280 if (input_available_clear_time)
6281 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
6283 while (1)
6285 int nread;
6286 nread = read_avail_input (1);
6287 /* -1 means it's not ok to read the input now.
6288 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
6289 0 means there was no keyboard input available. */
6290 if (nread <= 0)
6291 break;
6293 #ifdef BSD4_1
6294 select_alarmed = 1; /* Force the select emulator back to life */
6295 #endif
6298 #ifdef BSD4_1
6299 sigfree ();
6300 #endif
6301 errno = old_errno;
6303 #endif /* SIGIO */
6305 /* Send ourselves a SIGIO.
6307 This function exists so that the UNBLOCK_INPUT macro in
6308 blockinput.h can have some way to take care of input we put off
6309 dealing with, without assuming that every file which uses
6310 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
6311 void
6312 reinvoke_input_signal ()
6314 #ifdef SIGIO
6315 kill (getpid (), SIGIO);
6316 #endif
6321 /* Return the prompt-string of a sparse keymap.
6322 This is the first element which is a string.
6323 Return nil if there is none. */
6325 Lisp_Object
6326 map_prompt (map)
6327 Lisp_Object map;
6329 while (CONSP (map))
6331 register Lisp_Object tem;
6332 tem = Fcar (map);
6333 if (STRINGP (tem))
6334 return tem;
6335 map = Fcdr (map);
6337 return Qnil;
6340 static void menu_bar_item P_ ((Lisp_Object, Lisp_Object));
6341 static void menu_bar_one_keymap P_ ((Lisp_Object));
6343 /* These variables hold the vector under construction within
6344 menu_bar_items and its subroutines, and the current index
6345 for storing into that vector. */
6346 static Lisp_Object menu_bar_items_vector;
6347 static int menu_bar_items_index;
6349 /* Return a vector of menu items for a menu bar, appropriate
6350 to the current buffer. Each item has three elements in the vector:
6351 KEY STRING MAPLIST.
6353 OLD is an old vector we can optionally reuse, or nil. */
6355 Lisp_Object
6356 menu_bar_items (old)
6357 Lisp_Object old;
6359 /* The number of keymaps we're scanning right now, and the number of
6360 keymaps we have allocated space for. */
6361 int nmaps;
6363 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
6364 in the current keymaps, or nil where it is not a prefix. */
6365 Lisp_Object *maps;
6367 Lisp_Object def, tail;
6369 Lisp_Object result;
6371 int mapno;
6372 Lisp_Object oquit;
6374 int i;
6376 struct gcpro gcpro1;
6378 /* In order to build the menus, we need to call the keymap
6379 accessors. They all call QUIT. But this function is called
6380 during redisplay, during which a quit is fatal. So inhibit
6381 quitting while building the menus.
6382 We do this instead of specbind because (1) errors will clear it anyway
6383 and (2) this avoids risk of specpdl overflow. */
6384 oquit = Vinhibit_quit;
6385 Vinhibit_quit = Qt;
6387 if (!NILP (old))
6388 menu_bar_items_vector = old;
6389 else
6390 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
6391 menu_bar_items_index = 0;
6393 GCPRO1 (menu_bar_items_vector);
6395 /* Build our list of keymaps.
6396 If we recognize a function key and replace its escape sequence in
6397 keybuf with its symbol, or if the sequence starts with a mouse
6398 click and we need to switch buffers, we jump back here to rebuild
6399 the initial keymaps from the current buffer. */
6401 Lisp_Object *tmaps;
6403 /* Should overriding-terminal-local-map and overriding-local-map apply? */
6404 if (!NILP (Voverriding_local_map_menu_flag))
6406 /* Yes, use them (if non-nil) as well as the global map. */
6407 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
6408 nmaps = 0;
6409 if (!NILP (current_kboard->Voverriding_terminal_local_map))
6410 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
6411 if (!NILP (Voverriding_local_map))
6412 maps[nmaps++] = Voverriding_local_map;
6414 else
6416 /* No, so use major and minor mode keymaps and keymap property. */
6417 int extra_maps = 2;
6418 Lisp_Object map = get_local_map (PT, current_buffer, Qkeymap);
6419 if (!NILP (map))
6420 extra_maps = 3;
6421 nmaps = current_minor_maps (NULL, &tmaps);
6422 maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
6423 * sizeof (maps[0]));
6424 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
6425 if (!NILP (map))
6426 maps[nmaps++] = map;
6427 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
6429 maps[nmaps++] = current_global_map;
6432 /* Look up in each map the dummy prefix key `menu-bar'. */
6434 result = Qnil;
6436 for (mapno = nmaps - 1; mapno >= 0; mapno--)
6437 if (!NILP (maps[mapno]))
6439 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
6440 0, 1);
6441 if (CONSP (def))
6442 menu_bar_one_keymap (def);
6445 /* Move to the end those items that should be at the end. */
6447 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
6449 int i;
6450 int end = menu_bar_items_index;
6452 for (i = 0; i < end; i += 4)
6453 if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i]))
6455 Lisp_Object tem0, tem1, tem2, tem3;
6456 /* Move the item at index I to the end,
6457 shifting all the others forward. */
6458 tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
6459 tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
6460 tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
6461 tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
6462 if (end > i + 4)
6463 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
6464 &XVECTOR (menu_bar_items_vector)->contents[i],
6465 (end - i - 4) * sizeof (Lisp_Object));
6466 XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
6467 XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
6468 XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
6469 XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
6470 break;
6474 /* Add nil, nil, nil, nil at the end. */
6475 i = menu_bar_items_index;
6476 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
6478 Lisp_Object tem;
6479 tem = Fmake_vector (make_number (2 * i), Qnil);
6480 bcopy (XVECTOR (menu_bar_items_vector)->contents,
6481 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
6482 menu_bar_items_vector = tem;
6484 /* Add this item. */
6485 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6486 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6487 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6488 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6489 menu_bar_items_index = i;
6491 Vinhibit_quit = oquit;
6492 UNGCPRO;
6493 return menu_bar_items_vector;
6496 /* Scan one map KEYMAP, accumulating any menu items it defines
6497 in menu_bar_items_vector. */
6499 static Lisp_Object menu_bar_one_keymap_changed_items;
6501 static void
6502 menu_bar_one_keymap (keymap)
6503 Lisp_Object keymap;
6505 Lisp_Object tail, item;
6507 menu_bar_one_keymap_changed_items = Qnil;
6509 /* Loop over all keymap entries that have menu strings. */
6510 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
6512 item = XCAR (tail);
6513 if (CONSP (item))
6514 menu_bar_item (XCAR (item), XCDR (item));
6515 else if (VECTORP (item))
6517 /* Loop over the char values represented in the vector. */
6518 int len = XVECTOR (item)->size;
6519 int c;
6520 for (c = 0; c < len; c++)
6522 Lisp_Object character;
6523 XSETFASTINT (character, c);
6524 menu_bar_item (character, XVECTOR (item)->contents[c]);
6530 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
6531 If there's already an item for KEY, add this DEF to it. */
6533 Lisp_Object item_properties;
6535 static void
6536 menu_bar_item (key, item)
6537 Lisp_Object key, item;
6539 struct gcpro gcpro1;
6540 int i;
6541 Lisp_Object tem;
6543 if (EQ (item, Qundefined))
6545 /* If a map has an explicit `undefined' as definition,
6546 discard any previously made menu bar item. */
6548 for (i = 0; i < menu_bar_items_index; i += 4)
6549 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
6551 if (menu_bar_items_index > i + 4)
6552 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
6553 &XVECTOR (menu_bar_items_vector)->contents[i],
6554 (menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
6555 menu_bar_items_index -= 4;
6559 /* If this keymap has already contributed to this KEY,
6560 don't contribute to it a second time. */
6561 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
6562 if (!NILP (tem) || NILP (item))
6563 return;
6565 menu_bar_one_keymap_changed_items
6566 = Fcons (key, menu_bar_one_keymap_changed_items);
6568 /* We add to menu_bar_one_keymap_changed_items before doing the
6569 parse_menu_item, so that if it turns out it wasn't a menu item,
6570 it still correctly hides any further menu item. */
6571 GCPRO1 (key);
6572 i = parse_menu_item (item, 0, 1);
6573 UNGCPRO;
6574 if (!i)
6575 return;
6577 item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
6579 /* Find any existing item for this KEY. */
6580 for (i = 0; i < menu_bar_items_index; i += 4)
6581 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
6582 break;
6584 /* If we did not find this KEY, add it at the end. */
6585 if (i == menu_bar_items_index)
6587 /* If vector is too small, get a bigger one. */
6588 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
6590 Lisp_Object tem;
6591 tem = Fmake_vector (make_number (2 * i), Qnil);
6592 bcopy (XVECTOR (menu_bar_items_vector)->contents,
6593 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
6594 menu_bar_items_vector = tem;
6597 /* Add this item. */
6598 XVECTOR (menu_bar_items_vector)->contents[i++] = key;
6599 XVECTOR (menu_bar_items_vector)->contents[i++]
6600 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
6601 XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
6602 XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
6603 menu_bar_items_index = i;
6605 /* We did find an item for this KEY. Add ITEM to its list of maps. */
6606 else
6608 Lisp_Object old;
6609 old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
6610 XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (item, old);
6614 /* This is used as the handler when calling menu_item_eval_property. */
6615 static Lisp_Object
6616 menu_item_eval_property_1 (arg)
6617 Lisp_Object arg;
6619 /* If we got a quit from within the menu computation,
6620 quit all the way out of it. This takes care of C-] in the debugger. */
6621 if (CONSP (arg) && EQ (XCAR (arg), Qquit))
6622 Fsignal (Qquit, Qnil);
6624 return Qnil;
6627 /* Evaluate an expression and return the result (or nil if something
6628 went wrong). Used to evaluate dynamic parts of menu items. */
6629 Lisp_Object
6630 menu_item_eval_property (sexpr)
6631 Lisp_Object sexpr;
6633 int count = specpdl_ptr - specpdl;
6634 Lisp_Object val;
6635 specbind (Qinhibit_redisplay, Qt);
6636 val = internal_condition_case_1 (Feval, sexpr, Qerror,
6637 menu_item_eval_property_1);
6638 return unbind_to (count, val);
6641 /* This function parses a menu item and leaves the result in the
6642 vector item_properties.
6643 ITEM is a key binding, a possible menu item.
6644 If NOTREAL is nonzero, only check for equivalent key bindings, don't
6645 evaluate dynamic expressions in the menu item.
6646 INMENUBAR is > 0 when this is considered for an entry in a menu bar
6647 top level.
6648 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
6649 parse_menu_item returns true if the item is a menu item and false
6650 otherwise. */
6653 parse_menu_item (item, notreal, inmenubar)
6654 Lisp_Object item;
6655 int notreal, inmenubar;
6657 Lisp_Object def, tem, item_string, start;
6658 Lisp_Object cachelist;
6659 Lisp_Object filter;
6660 Lisp_Object keyhint;
6661 int i;
6662 int newcache = 0;
6664 cachelist = Qnil;
6665 filter = Qnil;
6666 keyhint = Qnil;
6668 if (!CONSP (item))
6669 return 0;
6671 /* Create item_properties vector if necessary. */
6672 if (NILP (item_properties))
6673 item_properties
6674 = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
6676 /* Initialize optional entries. */
6677 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
6678 AREF (item_properties, i) = Qnil;
6679 AREF (item_properties, ITEM_PROPERTY_ENABLE) = Qt;
6681 /* Save the item here to protect it from GC. */
6682 AREF (item_properties, ITEM_PROPERTY_ITEM) = item;
6684 item_string = XCAR (item);
6686 start = item;
6687 item = XCDR (item);
6688 if (STRINGP (item_string))
6690 /* Old format menu item. */
6691 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
6693 /* Maybe help string. */
6694 if (CONSP (item) && STRINGP (XCAR (item)))
6696 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
6697 start = item;
6698 item = XCDR (item);
6701 /* Maybe key binding cache. */
6702 if (CONSP (item) && CONSP (XCAR (item))
6703 && (NILP (XCAR (XCAR (item)))
6704 || VECTORP (XCAR (XCAR (item)))))
6706 cachelist = XCAR (item);
6707 item = XCDR (item);
6710 /* This is the real definition--the function to run. */
6711 AREF (item_properties, ITEM_PROPERTY_DEF) = item;
6713 /* Get enable property, if any. */
6714 if (SYMBOLP (item))
6716 tem = Fget (item, Qmenu_enable);
6717 if (!NILP (tem))
6718 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
6721 else if (EQ (item_string, Qmenu_item) && CONSP (item))
6723 /* New format menu item. */
6724 AREF (item_properties, ITEM_PROPERTY_NAME) = XCAR (item);
6725 start = XCDR (item);
6726 if (CONSP (start))
6728 /* We have a real binding. */
6729 AREF (item_properties, ITEM_PROPERTY_DEF) = XCAR (start);
6731 item = XCDR (start);
6732 /* Is there a cache list with key equivalences. */
6733 if (CONSP (item) && CONSP (XCAR (item)))
6735 cachelist = XCAR (item);
6736 item = XCDR (item);
6739 /* Parse properties. */
6740 while (CONSP (item) && CONSP (XCDR (item)))
6742 tem = XCAR (item);
6743 item = XCDR (item);
6745 if (EQ (tem, QCenable))
6746 AREF (item_properties, ITEM_PROPERTY_ENABLE) = XCAR (item);
6747 else if (EQ (tem, QCvisible) && !notreal)
6749 /* If got a visible property and that evaluates to nil
6750 then ignore this item. */
6751 tem = menu_item_eval_property (XCAR (item));
6752 if (NILP (tem))
6753 return 0;
6755 else if (EQ (tem, QChelp))
6756 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
6757 else if (EQ (tem, QCfilter))
6758 filter = item;
6759 else if (EQ (tem, QCkey_sequence))
6761 tem = XCAR (item);
6762 if (NILP (cachelist)
6763 && (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem)))
6764 /* Be GC protected. Set keyhint to item instead of tem. */
6765 keyhint = item;
6767 else if (EQ (tem, QCkeys))
6769 tem = XCAR (item);
6770 if (CONSP (tem) || (STRINGP (tem) && NILP (cachelist)))
6771 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
6773 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
6775 Lisp_Object type;
6776 tem = XCAR (item);
6777 type = XCAR (tem);
6778 if (EQ (type, QCtoggle) || EQ (type, QCradio))
6780 AREF (item_properties, ITEM_PROPERTY_SELECTED)
6781 = XCDR (tem);
6782 AREF (item_properties, ITEM_PROPERTY_TYPE)
6783 = type;
6786 item = XCDR (item);
6789 else if (inmenubar || !NILP (start))
6790 return 0;
6792 else
6793 return 0; /* not a menu item */
6795 /* If item string is not a string, evaluate it to get string.
6796 If we don't get a string, skip this item. */
6797 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
6798 if (!(STRINGP (item_string) || notreal))
6800 item_string = menu_item_eval_property (item_string);
6801 if (!STRINGP (item_string))
6802 return 0;
6803 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
6806 /* If got a filter apply it on definition. */
6807 def = AREF (item_properties, ITEM_PROPERTY_DEF);
6808 if (!NILP (filter))
6810 def = menu_item_eval_property (list2 (XCAR (filter),
6811 list2 (Qquote, def)));
6813 AREF (item_properties, ITEM_PROPERTY_DEF) = def;
6816 /* If we got no definition, this item is just unselectable text which
6817 is OK in a submenu but not in the menubar. */
6818 if (NILP (def))
6819 return (inmenubar ? 0 : 1);
6821 /* Enable or disable selection of item. */
6822 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
6823 if (!EQ (tem, Qt))
6825 if (notreal)
6826 tem = Qt;
6827 else
6828 tem = menu_item_eval_property (tem);
6829 if (inmenubar && NILP (tem))
6830 return 0; /* Ignore disabled items in menu bar. */
6831 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
6834 /* See if this is a separate pane or a submenu. */
6835 def = AREF (item_properties, ITEM_PROPERTY_DEF);
6836 tem = get_keymap (def, 0, 1);
6837 /* For a subkeymap, just record its details and exit. */
6838 if (CONSP (tem))
6840 AREF (item_properties, ITEM_PROPERTY_MAP) = tem;
6841 AREF (item_properties, ITEM_PROPERTY_DEF) = tem;
6842 return 1;
6845 /* At the top level in the menu bar, do likewise for commands also.
6846 The menu bar does not display equivalent key bindings anyway.
6847 ITEM_PROPERTY_DEF is already set up properly. */
6848 if (inmenubar > 0)
6849 return 1;
6851 /* This is a command. See if there is an equivalent key binding. */
6852 if (NILP (cachelist))
6854 /* We have to create a cachelist. */
6855 CHECK_IMPURE (start);
6856 XCDR (start) = Fcons (Fcons (Qnil, Qnil), XCDR (start));
6857 cachelist = XCAR (XCDR (start));
6858 newcache = 1;
6859 tem = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
6860 if (!NILP (keyhint))
6862 XCAR (cachelist) = XCAR (keyhint);
6863 newcache = 0;
6865 else if (STRINGP (tem))
6867 XCDR (cachelist) = Fsubstitute_command_keys (tem);
6868 XCAR (cachelist) = Qt;
6872 tem = XCAR (cachelist);
6873 if (!EQ (tem, Qt))
6875 int chkcache = 0;
6876 Lisp_Object prefix;
6878 if (!NILP (tem))
6879 tem = Fkey_binding (tem, Qnil);
6881 prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
6882 if (CONSP (prefix))
6884 def = XCAR (prefix);
6885 prefix = XCDR (prefix);
6887 else
6888 def = AREF (item_properties, ITEM_PROPERTY_DEF);
6890 if (!update_menu_bindings)
6891 chkcache = 0;
6892 else if (NILP (XCAR (cachelist))) /* Have no saved key. */
6894 if (newcache /* Always check first time. */
6895 /* Should we check everything when precomputing key
6896 bindings? */
6897 /* If something had no key binding before, don't recheck it
6898 because that is too slow--except if we have a list of
6899 rebound commands in Vdefine_key_rebound_commands, do
6900 recheck any command that appears in that list. */
6901 || (CONSP (Vdefine_key_rebound_commands)
6902 && !NILP (Fmemq (def, Vdefine_key_rebound_commands))))
6903 chkcache = 1;
6905 /* We had a saved key. Is it still bound to the command? */
6906 else if (NILP (tem)
6907 || (!EQ (tem, def)
6908 /* If the command is an alias for another
6909 (such as lmenu.el set it up), check if the
6910 original command matches the cached command. */
6911 && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))))
6912 chkcache = 1; /* Need to recompute key binding. */
6914 if (chkcache)
6916 /* Recompute equivalent key binding. If the command is an alias
6917 for another (such as lmenu.el set it up), see if the original
6918 command name has equivalent keys. Otherwise look up the
6919 specified command itself. We don't try both, because that
6920 makes lmenu menus slow. */
6921 if (SYMBOLP (def)
6922 && SYMBOLP (XSYMBOL (def)->function)
6923 && ! NILP (Fget (def, Qmenu_alias)))
6924 def = XSYMBOL (def)->function;
6925 tem = Fwhere_is_internal (def, Qnil, Qt, Qnil);
6926 XCAR (cachelist) = tem;
6927 if (NILP (tem))
6929 XCDR (cachelist) = Qnil;
6930 chkcache = 0;
6933 else if (!NILP (keyhint) && !NILP (XCAR (cachelist)))
6935 tem = XCAR (cachelist);
6936 chkcache = 1;
6939 newcache = chkcache;
6940 if (chkcache)
6942 tem = Fkey_description (tem);
6943 if (CONSP (prefix))
6945 if (STRINGP (XCAR (prefix)))
6946 tem = concat2 (XCAR (prefix), tem);
6947 if (STRINGP (XCDR (prefix)))
6948 tem = concat2 (tem, XCDR (prefix));
6950 XCDR (cachelist) = tem;
6954 tem = XCDR (cachelist);
6955 if (newcache && !NILP (tem))
6957 tem = concat3 (build_string (" ("), tem, build_string (")"));
6958 XCDR (cachelist) = tem;
6961 /* If we only want to precompute equivalent key bindings, stop here. */
6962 if (notreal)
6963 return 1;
6965 /* If we have an equivalent key binding, use that. */
6966 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
6968 /* Include this when menu help is implemented.
6969 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
6970 if (!(NILP (tem) || STRINGP (tem)))
6972 tem = menu_item_eval_property (tem);
6973 if (!STRINGP (tem))
6974 tem = Qnil;
6975 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
6979 /* Handle radio buttons or toggle boxes. */
6980 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
6981 if (!NILP (tem))
6982 AREF (item_properties, ITEM_PROPERTY_SELECTED)
6983 = menu_item_eval_property (tem);
6985 return 1;
6990 /***********************************************************************
6991 Tool-bars
6992 ***********************************************************************/
6994 /* A vector holding tool bar items while they are parsed in function
6995 tool_bar_items runs Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
6996 in the vector. */
6998 static Lisp_Object tool_bar_items_vector;
7000 /* A vector holding the result of parse_tool_bar_item. Layout is like
7001 the one for a single item in tool_bar_items_vector. */
7003 static Lisp_Object tool_bar_item_properties;
7005 /* Next free index in tool_bar_items_vector. */
7007 static int ntool_bar_items;
7009 /* The symbols `tool-bar', and `:image'. */
7011 extern Lisp_Object Qtool_bar;
7012 Lisp_Object QCimage;
7014 /* Function prototypes. */
7016 static void init_tool_bar_items P_ ((Lisp_Object));
7017 static void process_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
7018 static int parse_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
7019 static void append_tool_bar_item P_ ((void));
7022 /* Return a vector of tool bar items for keymaps currently in effect.
7023 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
7024 tool bar items found. */
7026 Lisp_Object
7027 tool_bar_items (reuse, nitems)
7028 Lisp_Object reuse;
7029 int *nitems;
7031 Lisp_Object *maps;
7032 int nmaps, i;
7033 Lisp_Object oquit;
7034 Lisp_Object *tmaps;
7035 extern Lisp_Object Voverriding_local_map_menu_flag;
7036 extern Lisp_Object Voverriding_local_map;
7038 *nitems = 0;
7040 /* In order to build the menus, we need to call the keymap
7041 accessors. They all call QUIT. But this function is called
7042 during redisplay, during which a quit is fatal. So inhibit
7043 quitting while building the menus. We do this instead of
7044 specbind because (1) errors will clear it anyway and (2) this
7045 avoids risk of specpdl overflow. */
7046 oquit = Vinhibit_quit;
7047 Vinhibit_quit = Qt;
7049 /* Initialize tool_bar_items_vector and protect it from GC. */
7050 init_tool_bar_items (reuse);
7052 /* Build list of keymaps in maps. Set nmaps to the number of maps
7053 to process. */
7055 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7056 if (!NILP (Voverriding_local_map_menu_flag))
7058 /* Yes, use them (if non-nil) as well as the global map. */
7059 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
7060 nmaps = 0;
7061 if (!NILP (current_kboard->Voverriding_terminal_local_map))
7062 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
7063 if (!NILP (Voverriding_local_map))
7064 maps[nmaps++] = Voverriding_local_map;
7066 else
7068 /* No, so use major and minor mode keymaps and keymap property. */
7069 int extra_maps = 2;
7070 Lisp_Object map = get_local_map (PT, current_buffer, Qkeymap);
7071 if (!NILP (map))
7072 extra_maps = 3;
7073 nmaps = current_minor_maps (NULL, &tmaps);
7074 maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
7075 * sizeof (maps[0]));
7076 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
7077 if (!NILP (map))
7078 maps[nmaps++] = map;
7079 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
7082 /* Add global keymap at the end. */
7083 maps[nmaps++] = current_global_map;
7085 /* Process maps in reverse order and look up in each map the prefix
7086 key `tool-bar'. */
7087 for (i = nmaps - 1; i >= 0; --i)
7088 if (!NILP (maps[i]))
7090 Lisp_Object keymap;
7092 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
7093 if (CONSP (keymap))
7095 Lisp_Object tail;
7097 /* KEYMAP is a list `(keymap (KEY . BINDING) ...)'. */
7098 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
7100 Lisp_Object keydef = XCAR (tail);
7101 if (CONSP (keydef))
7102 process_tool_bar_item (XCAR (keydef), XCDR (keydef));
7107 Vinhibit_quit = oquit;
7108 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
7109 return tool_bar_items_vector;
7113 /* Process the definition of KEY which is DEF. */
7115 static void
7116 process_tool_bar_item (key, def)
7117 Lisp_Object key, def;
7119 int i;
7120 extern Lisp_Object Qundefined;
7121 struct gcpro gcpro1, gcpro2;
7123 /* Protect KEY and DEF from GC because parse_tool_bar_item may call
7124 eval. */
7125 GCPRO2 (key, def);
7127 if (EQ (def, Qundefined))
7129 /* If a map has an explicit `undefined' as definition,
7130 discard any previously made item. */
7131 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
7133 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
7135 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
7137 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
7138 bcopy (v + TOOL_BAR_ITEM_NSLOTS, v,
7139 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
7140 * sizeof (Lisp_Object)));
7141 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
7142 break;
7146 else if (parse_tool_bar_item (key, def))
7147 /* Append a new tool bar item to tool_bar_items_vector. Accept
7148 more than one definition for the same key. */
7149 append_tool_bar_item ();
7151 UNGCPRO;
7155 /* Parse a tool bar item specification ITEM for key KEY and return the
7156 result in tool_bar_item_properties. Value is zero if ITEM is
7157 invalid.
7159 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
7161 CAPTION is the caption of the item, If it's not a string, it is
7162 evaluated to get a string.
7164 BINDING is the tool bar item's binding. Tool-bar items with keymaps
7165 as binding are currently ignored.
7167 The following properties are recognized:
7169 - `:enable FORM'.
7171 FORM is evaluated and specifies whether the tool bar item is
7172 enabled or disabled.
7174 - `:visible FORM'
7176 FORM is evaluated and specifies whether the tool bar item is visible.
7178 - `:filter FUNCTION'
7180 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
7181 result is stored as the new binding.
7183 - `:button (TYPE SELECTED)'
7185 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
7186 and specifies whether the button is selected (pressed) or not.
7188 - `:image IMAGES'
7190 IMAGES is either a single image specification or a vector of four
7191 image specifications. See enum tool_bar_item_images.
7193 - `:help HELP-STRING'.
7195 Gives a help string to display for the tool bar item. */
7197 static int
7198 parse_tool_bar_item (key, item)
7199 Lisp_Object key, item;
7201 /* Access slot with index IDX of vector tool_bar_item_properties. */
7202 #define PROP(IDX) XVECTOR (tool_bar_item_properties)->contents[IDX]
7204 Lisp_Object filter = Qnil;
7205 Lisp_Object caption;
7206 extern Lisp_Object QCenable, QCvisible, QChelp, QCfilter;
7207 extern Lisp_Object QCbutton, QCtoggle, QCradio;
7208 int i;
7210 /* Defininition looks like `(menu-item CAPTION BINDING PROPS...)'.
7211 Rule out items that aren't lists, don't start with
7212 `menu-item' or whose rest following `tool-bar-item' is not a
7213 list. */
7214 if (!CONSP (item)
7215 || !EQ (XCAR (item), Qmenu_item)
7216 || (item = XCDR (item),
7217 !CONSP (item)))
7218 return 0;
7220 /* Create tool_bar_item_properties vector if necessary. Reset it to
7221 defaults. */
7222 if (VECTORP (tool_bar_item_properties))
7224 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
7225 PROP (i) = Qnil;
7227 else
7228 tool_bar_item_properties
7229 = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
7231 /* Set defaults. */
7232 PROP (TOOL_BAR_ITEM_KEY) = key;
7233 PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
7235 /* Get the caption of the item. If the caption is not a string,
7236 evaluate it to get a string. If we don't get a string, skip this
7237 item. */
7238 caption = XCAR (item);
7239 if (!STRINGP (caption))
7241 caption = menu_item_eval_property (caption);
7242 if (!STRINGP (caption))
7243 return 0;
7245 PROP (TOOL_BAR_ITEM_CAPTION) = caption;
7247 /* Give up if rest following the caption is not a list. */
7248 item = XCDR (item);
7249 if (!CONSP (item))
7250 return 0;
7252 /* Store the binding. */
7253 PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item);
7254 item = XCDR (item);
7256 /* Ignore cached key binding, if any. */
7257 if (CONSP (item) && CONSP (XCAR (item)))
7258 item = XCDR (item);
7260 /* Process the rest of the properties. */
7261 for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
7263 Lisp_Object key, value;
7265 key = XCAR (item);
7266 value = XCAR (XCDR (item));
7268 if (EQ (key, QCenable))
7269 /* `:enable FORM'. */
7270 PROP (TOOL_BAR_ITEM_ENABLED_P) = value;
7271 else if (EQ (key, QCvisible))
7273 /* `:visible FORM'. If got a visible property and that
7274 evaluates to nil then ignore this item. */
7275 if (NILP (menu_item_eval_property (value)))
7276 return 0;
7278 else if (EQ (key, QChelp))
7279 /* `:help HELP-STRING'. */
7280 PROP (TOOL_BAR_ITEM_HELP) = value;
7281 else if (EQ (key, QCfilter))
7282 /* ':filter FORM'. */
7283 filter = value;
7284 else if (EQ (key, QCbutton) && CONSP (value))
7286 /* `:button (TYPE . SELECTED)'. */
7287 Lisp_Object type, selected;
7289 type = XCAR (value);
7290 selected = XCDR (value);
7291 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7293 PROP (TOOL_BAR_ITEM_SELECTED_P) = selected;
7294 PROP (TOOL_BAR_ITEM_TYPE) = type;
7297 else if (EQ (key, QCimage)
7298 && (CONSP (value)
7299 || (VECTORP (value) && XVECTOR (value)->size == 4)))
7300 /* Value is either a single image specification or a vector
7301 of 4 such specifications for the different buttion states. */
7302 PROP (TOOL_BAR_ITEM_IMAGES) = value;
7305 /* If got a filter apply it on binding. */
7306 if (!NILP (filter))
7307 PROP (TOOL_BAR_ITEM_BINDING)
7308 = menu_item_eval_property (list2 (filter,
7309 list2 (Qquote,
7310 PROP (TOOL_BAR_ITEM_BINDING))));
7312 /* See if the binding is a keymap. Give up if it is. */
7313 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
7314 return 0;
7316 /* Enable or disable selection of item. */
7317 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
7318 PROP (TOOL_BAR_ITEM_ENABLED_P)
7319 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P));
7321 /* Handle radio buttons or toggle boxes. */
7322 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
7323 PROP (TOOL_BAR_ITEM_SELECTED_P)
7324 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P));
7326 return 1;
7328 #undef PROP
7332 /* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
7333 that can be reused. */
7335 static void
7336 init_tool_bar_items (reuse)
7337 Lisp_Object reuse;
7339 if (VECTORP (reuse))
7340 tool_bar_items_vector = reuse;
7341 else
7342 tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
7343 ntool_bar_items = 0;
7347 /* Append parsed tool bar item properties from
7348 tool_bar_item_properties */
7350 static void
7351 append_tool_bar_item ()
7353 Lisp_Object *to, *from;
7355 /* Enlarge tool_bar_items_vector if necessary. */
7356 if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
7357 >= XVECTOR (tool_bar_items_vector)->size)
7359 Lisp_Object new_vector;
7360 int old_size = XVECTOR (tool_bar_items_vector)->size;
7362 new_vector = Fmake_vector (make_number (2 * old_size), Qnil);
7363 bcopy (XVECTOR (tool_bar_items_vector)->contents,
7364 XVECTOR (new_vector)->contents,
7365 old_size * sizeof (Lisp_Object));
7366 tool_bar_items_vector = new_vector;
7369 /* Append entries from tool_bar_item_properties to the end of
7370 tool_bar_items_vector. */
7371 to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
7372 from = XVECTOR (tool_bar_item_properties)->contents;
7373 bcopy (from, to, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
7374 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
7381 /* Read a character using menus based on maps in the array MAPS.
7382 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
7383 Return t if we displayed a menu but the user rejected it.
7385 PREV_EVENT is the previous input event, or nil if we are reading
7386 the first event of a key sequence.
7388 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
7389 if we used a mouse menu to read the input, or zero otherwise. If
7390 USED_MOUSE_MENU is null, we don't dereference it.
7392 The prompting is done based on the prompt-string of the map
7393 and the strings associated with various map elements.
7395 This can be done with X menus or with menus put in the minibuf.
7396 These are done in different ways, depending on how the input will be read.
7397 Menus using X are done after auto-saving in read-char, getting the input
7398 event from Fx_popup_menu; menus using the minibuf use read_char recursively
7399 and do auto-saving in the inner call of read_char. */
7401 static Lisp_Object
7402 read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
7403 int nmaps;
7404 Lisp_Object *maps;
7405 Lisp_Object prev_event;
7406 int *used_mouse_menu;
7408 int mapno;
7409 register Lisp_Object name;
7411 if (used_mouse_menu)
7412 *used_mouse_menu = 0;
7414 /* Use local over global Menu maps */
7416 if (! menu_prompting)
7417 return Qnil;
7419 /* Optionally disregard all but the global map. */
7420 if (inhibit_local_menu_bar_menus)
7422 maps += (nmaps - 1);
7423 nmaps = 1;
7426 /* Get the menu name from the first map that has one (a prompt string). */
7427 for (mapno = 0; mapno < nmaps; mapno++)
7429 name = map_prompt (maps[mapno]);
7430 if (!NILP (name))
7431 break;
7434 /* If we don't have any menus, just read a character normally. */
7435 if (mapno >= nmaps)
7436 return Qnil;
7438 #ifdef HAVE_MENUS
7439 /* If we got to this point via a mouse click,
7440 use a real menu for mouse selection. */
7441 if (EVENT_HAS_PARAMETERS (prev_event)
7442 && !EQ (XCAR (prev_event), Qmenu_bar)
7443 && !EQ (XCAR (prev_event), Qtool_bar))
7445 /* Display the menu and get the selection. */
7446 Lisp_Object *realmaps
7447 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
7448 Lisp_Object value;
7449 int nmaps1 = 0;
7451 /* Use the maps that are not nil. */
7452 for (mapno = 0; mapno < nmaps; mapno++)
7453 if (!NILP (maps[mapno]))
7454 realmaps[nmaps1++] = maps[mapno];
7456 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
7457 if (CONSP (value))
7459 Lisp_Object tem;
7461 record_menu_key (XCAR (value));
7463 /* If we got multiple events, unread all but
7464 the first.
7465 There is no way to prevent those unread events
7466 from showing up later in last_nonmenu_event.
7467 So turn symbol and integer events into lists,
7468 to indicate that they came from a mouse menu,
7469 so that when present in last_nonmenu_event
7470 they won't confuse things. */
7471 for (tem = XCDR (value); !NILP (tem); tem = XCDR (tem))
7473 record_menu_key (XCAR (tem));
7474 if (SYMBOLP (XCAR (tem))
7475 || INTEGERP (XCAR (tem)))
7476 XCAR (tem) = Fcons (XCAR (tem), Qdisabled);
7479 /* If we got more than one event, put all but the first
7480 onto this list to be read later.
7481 Return just the first event now. */
7482 Vunread_command_events
7483 = nconc2 (XCDR (value), Vunread_command_events);
7484 value = XCAR (value);
7486 else if (NILP (value))
7487 value = Qt;
7488 if (used_mouse_menu)
7489 *used_mouse_menu = 1;
7490 return value;
7492 #endif /* HAVE_MENUS */
7493 return Qnil ;
7496 /* Buffer in use so far for the minibuf prompts for menu keymaps.
7497 We make this bigger when necessary, and never free it. */
7498 static char *read_char_minibuf_menu_text;
7499 /* Size of that buffer. */
7500 static int read_char_minibuf_menu_width;
7502 static Lisp_Object
7503 read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
7504 int commandflag ;
7505 int nmaps;
7506 Lisp_Object *maps;
7508 int mapno;
7509 register Lisp_Object name;
7510 int nlength;
7511 int width = FRAME_WIDTH (SELECTED_FRAME ()) - 4;
7512 int idx = -1;
7513 int nobindings = 1;
7514 Lisp_Object rest, vector;
7515 char *menu;
7517 vector = Qnil;
7519 if (! menu_prompting)
7520 return Qnil;
7522 /* Make sure we have a big enough buffer for the menu text. */
7523 if (read_char_minibuf_menu_text == 0)
7525 read_char_minibuf_menu_width = width + 4;
7526 read_char_minibuf_menu_text = (char *) xmalloc (width + 4);
7528 else if (width + 4 > read_char_minibuf_menu_width)
7530 read_char_minibuf_menu_width = width + 4;
7531 read_char_minibuf_menu_text
7532 = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
7534 menu = read_char_minibuf_menu_text;
7536 /* Get the menu name from the first map that has one (a prompt string). */
7537 for (mapno = 0; mapno < nmaps; mapno++)
7539 name = map_prompt (maps[mapno]);
7540 if (!NILP (name))
7541 break;
7544 /* If we don't have any menus, just read a character normally. */
7545 if (mapno >= nmaps)
7546 return Qnil;
7548 /* Prompt string always starts with map's prompt, and a space. */
7549 strcpy (menu, XSTRING (name)->data);
7550 nlength = STRING_BYTES (XSTRING (name));
7551 menu[nlength++] = ':';
7552 menu[nlength++] = ' ';
7553 menu[nlength] = 0;
7555 /* Start prompting at start of first map. */
7556 mapno = 0;
7557 rest = maps[mapno];
7559 /* Present the documented bindings, a line at a time. */
7560 while (1)
7562 int notfirst = 0;
7563 int i = nlength;
7564 Lisp_Object obj;
7565 int ch;
7566 Lisp_Object orig_defn_macro;
7568 /* Loop over elements of map. */
7569 while (i < width)
7571 Lisp_Object elt;
7573 /* If reached end of map, start at beginning of next map. */
7574 if (NILP (rest))
7576 mapno++;
7577 /* At end of last map, wrap around to first map if just starting,
7578 or end this line if already have something on it. */
7579 if (mapno == nmaps)
7581 mapno = 0;
7582 if (notfirst || nobindings) break;
7584 rest = maps[mapno];
7587 /* Look at the next element of the map. */
7588 if (idx >= 0)
7589 elt = XVECTOR (vector)->contents[idx];
7590 else
7591 elt = Fcar_safe (rest);
7593 if (idx < 0 && VECTORP (elt))
7595 /* If we found a dense table in the keymap,
7596 advanced past it, but start scanning its contents. */
7597 rest = Fcdr_safe (rest);
7598 vector = elt;
7599 idx = 0;
7601 else
7603 /* An ordinary element. */
7604 Lisp_Object event, tem;
7606 if (idx < 0)
7608 event = Fcar_safe (elt); /* alist */
7609 elt = Fcdr_safe (elt);
7611 else
7613 XSETINT (event, idx); /* vector */
7616 /* Ignore the element if it has no prompt string. */
7617 if (INTEGERP (event) && parse_menu_item (elt, 0, -1))
7619 /* 1 if the char to type matches the string. */
7620 int char_matches;
7621 Lisp_Object upcased_event, downcased_event;
7622 Lisp_Object desc = Qnil;
7623 Lisp_Object s
7624 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
7626 upcased_event = Fupcase (event);
7627 downcased_event = Fdowncase (event);
7628 char_matches = (XINT (upcased_event) == XSTRING (s)->data[0]
7629 || XINT (downcased_event) == XSTRING (s)->data[0]);
7630 if (! char_matches)
7631 desc = Fsingle_key_description (event, Qnil);
7634 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
7635 if (!NILP (tem))
7636 /* Insert equivalent keybinding. */
7637 s = concat2 (s, tem);
7640 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
7641 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
7643 /* Insert button prefix. */
7644 Lisp_Object selected
7645 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
7646 if (EQ (tem, QCradio))
7647 tem = build_string (NILP (selected) ? "(*) " : "( ) ");
7648 else
7649 tem = build_string (NILP (selected) ? "[X] " : "[ ] ");
7650 s = concat2 (tem, s);
7654 /* If we have room for the prompt string, add it to this line.
7655 If this is the first on the line, always add it. */
7656 if ((XSTRING (s)->size + i + 2
7657 + (char_matches ? 0 : XSTRING (desc)->size + 3))
7658 < width
7659 || !notfirst)
7661 int thiswidth;
7663 /* Punctuate between strings. */
7664 if (notfirst)
7666 strcpy (menu + i, ", ");
7667 i += 2;
7669 notfirst = 1;
7670 nobindings = 0 ;
7672 /* If the char to type doesn't match the string's
7673 first char, explicitly show what char to type. */
7674 if (! char_matches)
7676 /* Add as much of string as fits. */
7677 thiswidth = XSTRING (desc)->size;
7678 if (thiswidth + i > width)
7679 thiswidth = width - i;
7680 bcopy (XSTRING (desc)->data, menu + i, thiswidth);
7681 i += thiswidth;
7682 strcpy (menu + i, " = ");
7683 i += 3;
7686 /* Add as much of string as fits. */
7687 thiswidth = XSTRING (s)->size;
7688 if (thiswidth + i > width)
7689 thiswidth = width - i;
7690 bcopy (XSTRING (s)->data, menu + i, thiswidth);
7691 i += thiswidth;
7692 menu[i] = 0;
7694 else
7696 /* If this element does not fit, end the line now,
7697 and save the element for the next line. */
7698 strcpy (menu + i, "...");
7699 break;
7703 /* Move past this element. */
7704 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
7705 /* Handle reaching end of dense table. */
7706 idx = -1;
7707 if (idx >= 0)
7708 idx++;
7709 else
7710 rest = Fcdr_safe (rest);
7714 /* Prompt with that and read response. */
7715 message2_nolog (menu, strlen (menu),
7716 ! NILP (current_buffer->enable_multibyte_characters));
7718 /* Make believe its not a keyboard macro in case the help char
7719 is pressed. Help characters are not recorded because menu prompting
7720 is not used on replay.
7722 orig_defn_macro = current_kboard->defining_kbd_macro;
7723 current_kboard->defining_kbd_macro = Qnil;
7725 obj = read_char (commandflag, 0, 0, Qt, 0);
7726 while (BUFFERP (obj));
7727 current_kboard->defining_kbd_macro = orig_defn_macro;
7729 if (!INTEGERP (obj))
7730 return obj;
7731 else
7732 ch = XINT (obj);
7734 if (! EQ (obj, menu_prompt_more_char)
7735 && (!INTEGERP (menu_prompt_more_char)
7736 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
7738 if (!NILP (current_kboard->defining_kbd_macro))
7739 store_kbd_macro_char (obj);
7740 return obj;
7742 /* Help char - go round again */
7746 /* Reading key sequences. */
7748 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
7749 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
7750 keymap, or nil otherwise. Return the index of the first keymap in
7751 which KEY has any binding, or NMAPS if no map has a binding.
7753 If KEY is a meta ASCII character, treat it like meta-prefix-char
7754 followed by the corresponding non-meta character. Keymaps in
7755 CURRENT with non-prefix bindings for meta-prefix-char become nil in
7756 NEXT.
7758 If KEY has no bindings in any of the CURRENT maps, NEXT is left
7759 unmodified.
7761 NEXT may be the same array as CURRENT. */
7763 static int
7764 follow_key (key, nmaps, current, defs, next)
7765 Lisp_Object key;
7766 Lisp_Object *current, *defs, *next;
7767 int nmaps;
7769 int i, first_binding;
7770 int did_meta = 0;
7772 first_binding = nmaps;
7773 for (i = nmaps - 1; i >= 0; i--)
7775 if (! NILP (current[i]))
7777 Lisp_Object map;
7778 if (did_meta)
7779 map = defs[i];
7780 else
7781 map = current[i];
7783 defs[i] = access_keymap (map, key, 1, 0, 1);
7784 if (! NILP (defs[i]))
7785 first_binding = i;
7787 else
7788 defs[i] = Qnil;
7791 /* Given the set of bindings we've found, produce the next set of maps. */
7792 if (first_binding < nmaps)
7793 for (i = 0; i < nmaps; i++)
7794 next[i] = NILP (defs[i]) ? Qnil : get_keymap (defs[i], 0, 1);
7796 return first_binding;
7799 /* Read a sequence of keys that ends with a non prefix character,
7800 storing it in KEYBUF, a buffer of size BUFSIZE.
7801 Prompt with PROMPT.
7802 Return the length of the key sequence stored.
7803 Return -1 if the user rejected a command menu.
7805 Echo starting immediately unless `prompt' is 0.
7807 Where a key sequence ends depends on the currently active keymaps.
7808 These include any minor mode keymaps active in the current buffer,
7809 the current buffer's local map, and the global map.
7811 If a key sequence has no other bindings, we check Vfunction_key_map
7812 to see if some trailing subsequence might be the beginning of a
7813 function key's sequence. If so, we try to read the whole function
7814 key, and substitute its symbolic name into the key sequence.
7816 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
7817 `double-' events into similar click events, if that would make them
7818 bound. We try to turn `triple-' events first into `double-' events,
7819 then into clicks.
7821 If we get a mouse click in a mode line, vertical divider, or other
7822 non-text area, we treat the click as if it were prefixed by the
7823 symbol denoting that area - `mode-line', `vertical-line', or
7824 whatever.
7826 If the sequence starts with a mouse click, we read the key sequence
7827 with respect to the buffer clicked on, not the current buffer.
7829 If the user switches frames in the midst of a key sequence, we put
7830 off the switch-frame event until later; the next call to
7831 read_char will return it.
7833 If FIX_CURRENT_BUFFER is nonzero, we restore current_buffer
7834 from the selected window's buffer. */
7836 static int
7837 read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
7838 can_return_switch_frame, fix_current_buffer)
7839 Lisp_Object *keybuf;
7840 int bufsize;
7841 Lisp_Object prompt;
7842 int dont_downcase_last;
7843 int can_return_switch_frame;
7844 int fix_current_buffer;
7846 volatile Lisp_Object from_string;
7847 volatile int count = specpdl_ptr - specpdl;
7849 /* How many keys there are in the current key sequence. */
7850 volatile int t;
7852 /* The length of the echo buffer when we started reading, and
7853 the length of this_command_keys when we started reading. */
7854 volatile int echo_start;
7855 volatile int keys_start;
7857 /* The number of keymaps we're scanning right now, and the number of
7858 keymaps we have allocated space for. */
7859 volatile int nmaps;
7860 volatile int nmaps_allocated = 0;
7862 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
7863 the current keymaps. */
7864 Lisp_Object *volatile defs = NULL;
7866 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
7867 in the current keymaps, or nil where it is not a prefix. */
7868 Lisp_Object *volatile submaps = NULL;
7870 /* The local map to start out with at start of key sequence. */
7871 volatile Lisp_Object orig_local_map;
7873 /* The map from the `keymap' property to start out with at start of
7874 key sequence. */
7875 volatile Lisp_Object orig_keymap;
7877 /* 1 if we have already considered switching to the local-map property
7878 of the place where a mouse click occurred. */
7879 volatile int localized_local_map = 0;
7881 /* The index in defs[] of the first keymap that has a binding for
7882 this key sequence. In other words, the lowest i such that
7883 defs[i] is non-nil. */
7884 volatile int first_binding;
7886 /* If t < mock_input, then KEYBUF[t] should be read as the next
7887 input key.
7889 We use this to recover after recognizing a function key. Once we
7890 realize that a suffix of the current key sequence is actually a
7891 function key's escape sequence, we replace the suffix with the
7892 function key's binding from Vfunction_key_map. Now keybuf
7893 contains a new and different key sequence, so the echo area,
7894 this_command_keys, and the submaps and defs arrays are wrong. In
7895 this situation, we set mock_input to t, set t to 0, and jump to
7896 restart_sequence; the loop will read keys from keybuf up until
7897 mock_input, thus rebuilding the state; and then it will resume
7898 reading characters from the keyboard. */
7899 volatile int mock_input = 0;
7901 /* If the sequence is unbound in submaps[], then
7902 keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map,
7903 and fkey_map is its binding.
7905 These might be > t, indicating that all function key scanning
7906 should hold off until t reaches them. We do this when we've just
7907 recognized a function key, to avoid searching for the function
7908 key's again in Vfunction_key_map. */
7909 volatile int fkey_start = 0, fkey_end = 0;
7910 volatile Lisp_Object fkey_map;
7912 /* Likewise, for key_translation_map. */
7913 volatile int keytran_start = 0, keytran_end = 0;
7914 volatile Lisp_Object keytran_map;
7916 /* If we receive a ``switch-frame'' event in the middle of a key sequence,
7917 we put it off for later. While we're reading, we keep the event here. */
7918 volatile Lisp_Object delayed_switch_frame;
7920 /* See the comment below... */
7921 #if defined (GOBBLE_FIRST_EVENT)
7922 Lisp_Object first_event;
7923 #endif
7925 volatile Lisp_Object original_uppercase;
7926 volatile int original_uppercase_position = -1;
7928 /* Gets around Microsoft compiler limitations. */
7929 int dummyflag = 0;
7931 struct buffer *starting_buffer;
7933 /* Nonzero if we seem to have got the beginning of a binding
7934 in function_key_map. */
7935 volatile int function_key_possible = 0;
7936 volatile int key_translation_possible = 0;
7938 /* List of events for which a fake prefix key has been generated. */
7939 volatile Lisp_Object fake_prefixed_keys = Qnil;
7941 /* Save the status of key translation before each step,
7942 so that we can restore this after downcasing. */
7943 Lisp_Object prev_fkey_map;
7944 int prev_fkey_start;
7945 int prev_fkey_end;
7947 Lisp_Object prev_keytran_map;
7948 int prev_keytran_start;
7949 int prev_keytran_end;
7951 #if defined (GOBBLE_FIRST_EVENT)
7952 int junk;
7953 #endif
7955 struct gcpro gcpro1;
7957 GCPRO1 (fake_prefixed_keys);
7958 raw_keybuf_count = 0;
7960 last_nonmenu_event = Qnil;
7962 delayed_switch_frame = Qnil;
7963 fkey_map = Vfunction_key_map;
7964 keytran_map = Vkey_translation_map;
7966 /* If there is no function-key-map, turn off function key scanning. */
7967 if (!KEYMAPP (Vfunction_key_map))
7968 fkey_start = fkey_end = bufsize + 1;
7970 /* If there is no key-translation-map, turn off scanning. */
7971 if (!KEYMAPP (Vkey_translation_map))
7972 keytran_start = keytran_end = bufsize + 1;
7974 if (INTERACTIVE)
7976 if (!NILP (prompt))
7977 echo_prompt (prompt);
7978 else if (cursor_in_echo_area
7979 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
7980 && NILP (Fzerop (Vecho_keystrokes)))
7981 /* This doesn't put in a dash if the echo buffer is empty, so
7982 you don't always see a dash hanging out in the minibuffer. */
7983 echo_dash ();
7986 /* Record the initial state of the echo area and this_command_keys;
7987 we will need to restore them if we replay a key sequence. */
7988 if (INTERACTIVE)
7989 echo_start = echo_length ();
7990 keys_start = this_command_key_count;
7991 this_single_command_key_start = keys_start;
7993 #if defined (GOBBLE_FIRST_EVENT)
7994 /* This doesn't quite work, because some of the things that read_char
7995 does cannot safely be bypassed. It seems too risky to try to make
7996 this work right. */
7998 /* Read the first char of the sequence specially, before setting
7999 up any keymaps, in case a filter runs and switches buffers on us. */
8000 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
8001 &junk);
8002 #endif /* GOBBLE_FIRST_EVENT */
8004 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8005 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
8006 from_string = Qnil;
8008 /* We jump here when the key sequence has been thoroughly changed, and
8009 we need to rescan it starting from the beginning. When we jump here,
8010 keybuf[0..mock_input] holds the sequence we should reread. */
8011 replay_sequence:
8013 starting_buffer = current_buffer;
8014 function_key_possible = 0;
8015 key_translation_possible = 0;
8017 /* Build our list of keymaps.
8018 If we recognize a function key and replace its escape sequence in
8019 keybuf with its symbol, or if the sequence starts with a mouse
8020 click and we need to switch buffers, we jump back here to rebuild
8021 the initial keymaps from the current buffer. */
8023 Lisp_Object *maps;
8025 if (!NILP (current_kboard->Voverriding_terminal_local_map)
8026 || !NILP (Voverriding_local_map))
8028 if (3 > nmaps_allocated)
8030 submaps = (Lisp_Object *) alloca (3 * sizeof (submaps[0]));
8031 defs = (Lisp_Object *) alloca (3 * sizeof (defs[0]));
8032 nmaps_allocated = 3;
8034 nmaps = 0;
8035 if (!NILP (current_kboard->Voverriding_terminal_local_map))
8036 submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
8037 if (!NILP (Voverriding_local_map))
8038 submaps[nmaps++] = Voverriding_local_map;
8040 else
8042 int extra_maps = 2;
8043 nmaps = current_minor_maps (0, &maps);
8044 if (!NILP (orig_keymap))
8045 extra_maps = 3;
8046 if (nmaps + extra_maps > nmaps_allocated)
8048 submaps = (Lisp_Object *) alloca ((nmaps+extra_maps)
8049 * sizeof (submaps[0]));
8050 defs = (Lisp_Object *) alloca ((nmaps+extra_maps)
8051 * sizeof (defs[0]));
8052 nmaps_allocated = nmaps + extra_maps;
8054 bcopy (maps, (void *) submaps, nmaps * sizeof (submaps[0]));
8055 if (!NILP (orig_keymap))
8056 submaps[nmaps++] = orig_keymap;
8057 submaps[nmaps++] = orig_local_map;
8059 submaps[nmaps++] = current_global_map;
8062 /* Find an accurate initial value for first_binding. */
8063 for (first_binding = 0; first_binding < nmaps; first_binding++)
8064 if (! NILP (submaps[first_binding]))
8065 break;
8067 /* Start from the beginning in keybuf. */
8068 t = 0;
8070 /* These are no-ops the first time through, but if we restart, they
8071 revert the echo area and this_command_keys to their original state. */
8072 this_command_key_count = keys_start;
8073 if (INTERACTIVE && t < mock_input)
8074 echo_truncate (echo_start);
8076 /* If the best binding for the current key sequence is a keymap, or
8077 we may be looking at a function key's escape sequence, keep on
8078 reading. */
8079 while ((first_binding < nmaps && ! NILP (submaps[first_binding]))
8080 || (first_binding >= nmaps
8081 && fkey_start < t
8082 /* mock input is never part of a function key's sequence. */
8083 && mock_input <= fkey_start)
8084 || (first_binding >= nmaps
8085 && keytran_start < t && key_translation_possible)
8086 /* Don't return in the middle of a possible function key sequence,
8087 if the only bindings we found were via case conversion.
8088 Thus, if ESC O a has a function-key-map translation
8089 and ESC o has a binding, don't return after ESC O,
8090 so that we can translate ESC O plus the next character. */
8093 Lisp_Object key;
8094 int used_mouse_menu = 0;
8096 /* Where the last real key started. If we need to throw away a
8097 key that has expanded into more than one element of keybuf
8098 (say, a mouse click on the mode line which is being treated
8099 as [mode-line (mouse-...)], then we backtrack to this point
8100 of keybuf. */
8101 volatile int last_real_key_start;
8103 /* These variables are analogous to echo_start and keys_start;
8104 while those allow us to restart the entire key sequence,
8105 echo_local_start and keys_local_start allow us to throw away
8106 just one key. */
8107 volatile int echo_local_start, keys_local_start, local_first_binding;
8109 if (t >= bufsize)
8110 error ("Key sequence too long");
8112 if (INTERACTIVE)
8113 echo_local_start = echo_length ();
8114 keys_local_start = this_command_key_count;
8115 local_first_binding = first_binding;
8117 replay_key:
8118 /* These are no-ops, unless we throw away a keystroke below and
8119 jumped back up to replay_key; in that case, these restore the
8120 variables to their original state, allowing us to replay the
8121 loop. */
8122 if (INTERACTIVE && t < mock_input)
8123 echo_truncate (echo_local_start);
8124 this_command_key_count = keys_local_start;
8125 first_binding = local_first_binding;
8127 /* By default, assume each event is "real". */
8128 last_real_key_start = t;
8130 /* Does mock_input indicate that we are re-reading a key sequence? */
8131 if (t < mock_input)
8133 key = keybuf[t];
8134 add_command_key (key);
8135 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8136 && NILP (Fzerop (Vecho_keystrokes)))
8137 echo_char (key);
8140 /* If not, we should actually read a character. */
8141 else
8144 #ifdef MULTI_KBOARD
8145 KBOARD *interrupted_kboard = current_kboard;
8146 struct frame *interrupted_frame = SELECTED_FRAME ();
8147 if (setjmp (wrong_kboard_jmpbuf))
8149 if (!NILP (delayed_switch_frame))
8151 interrupted_kboard->kbd_queue
8152 = Fcons (delayed_switch_frame,
8153 interrupted_kboard->kbd_queue);
8154 delayed_switch_frame = Qnil;
8156 while (t > 0)
8157 interrupted_kboard->kbd_queue
8158 = Fcons (keybuf[--t], interrupted_kboard->kbd_queue);
8160 /* If the side queue is non-empty, ensure it begins with a
8161 switch-frame, so we'll replay it in the right context. */
8162 if (CONSP (interrupted_kboard->kbd_queue)
8163 && (key = XCAR (interrupted_kboard->kbd_queue),
8164 !(EVENT_HAS_PARAMETERS (key)
8165 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
8166 Qswitch_frame))))
8168 Lisp_Object frame;
8169 XSETFRAME (frame, interrupted_frame);
8170 interrupted_kboard->kbd_queue
8171 = Fcons (make_lispy_switch_frame (frame),
8172 interrupted_kboard->kbd_queue);
8174 mock_input = 0;
8175 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8176 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
8177 goto replay_sequence;
8179 #endif
8180 key = read_char (NILP (prompt), nmaps,
8181 (Lisp_Object *) submaps, last_nonmenu_event,
8182 &used_mouse_menu);
8185 /* read_char returns t when it shows a menu and the user rejects it.
8186 Just return -1. */
8187 if (EQ (key, Qt))
8189 unbind_to (count, Qnil);
8190 UNGCPRO;
8191 return -1;
8194 /* read_char returns -1 at the end of a macro.
8195 Emacs 18 handles this by returning immediately with a
8196 zero, so that's what we'll do. */
8197 if (INTEGERP (key) && XINT (key) == -1)
8199 t = 0;
8200 /* The Microsoft C compiler can't handle the goto that
8201 would go here. */
8202 dummyflag = 1;
8203 break;
8206 /* If the current buffer has been changed from under us, the
8207 keymap may have changed, so replay the sequence. */
8208 if (BUFFERP (key))
8210 mock_input = t;
8211 /* Reset the current buffer from the selected window
8212 in case something changed the former and not the latter.
8213 This is to be more consistent with the behavior
8214 of the command_loop_1. */
8215 if (fix_current_buffer)
8217 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
8218 Fkill_emacs (Qnil);
8219 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
8220 Fset_buffer (XWINDOW (selected_window)->buffer);
8223 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8224 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
8225 goto replay_sequence;
8228 /* If we have a quit that was typed in another frame, and
8229 quit_throw_to_read_char switched buffers,
8230 replay to get the right keymap. */
8231 if (INTEGERP (key)
8232 && XINT (key) == quit_char
8233 && current_buffer != starting_buffer)
8235 GROW_RAW_KEYBUF;
8236 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8237 keybuf[t++] = key;
8238 mock_input = t;
8239 Vquit_flag = Qnil;
8240 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8241 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
8242 goto replay_sequence;
8245 Vquit_flag = Qnil;
8247 if (EVENT_HAS_PARAMETERS (key)
8248 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
8250 /* If we're at the beginning of a key sequence, and the caller
8251 says it's okay, go ahead and return this event. If we're
8252 in the midst of a key sequence, delay it until the end. */
8253 if (t > 0 || !can_return_switch_frame)
8255 delayed_switch_frame = key;
8256 goto replay_key;
8260 GROW_RAW_KEYBUF;
8261 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8264 /* Clicks in non-text areas get prefixed by the symbol
8265 in their CHAR-ADDRESS field. For example, a click on
8266 the mode line is prefixed by the symbol `mode-line'.
8268 Furthermore, key sequences beginning with mouse clicks
8269 are read using the keymaps of the buffer clicked on, not
8270 the current buffer. So we may have to switch the buffer
8271 here.
8273 When we turn one event into two events, we must make sure
8274 that neither of the two looks like the original--so that,
8275 if we replay the events, they won't be expanded again.
8276 If not for this, such reexpansion could happen either here
8277 or when user programs play with this-command-keys. */
8278 if (EVENT_HAS_PARAMETERS (key))
8280 Lisp_Object kind;
8282 kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
8283 if (EQ (kind, Qmouse_click))
8285 Lisp_Object window, posn;
8287 window = POSN_WINDOW (EVENT_START (key));
8288 posn = POSN_BUFFER_POSN (EVENT_START (key));
8290 if (CONSP (posn)
8291 || (!NILP (fake_prefixed_keys)
8292 && !NILP (Fmemq (key, fake_prefixed_keys))))
8294 /* We're looking a second time at an event for which
8295 we generated a fake prefix key. Set
8296 last_real_key_start appropriately. */
8297 if (t > 0)
8298 last_real_key_start = t - 1;
8301 /* Key sequences beginning with mouse clicks are
8302 read using the keymaps in the buffer clicked on,
8303 not the current buffer. If we're at the
8304 beginning of a key sequence, switch buffers. */
8305 if (last_real_key_start == 0
8306 && WINDOWP (window)
8307 && BUFFERP (XWINDOW (window)->buffer)
8308 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
8310 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8311 keybuf[t] = key;
8312 mock_input = t + 1;
8314 /* Arrange to go back to the original buffer once we're
8315 done reading the key sequence. Note that we can't
8316 use save_excursion_{save,restore} here, because they
8317 save point as well as the current buffer; we don't
8318 want to save point, because redisplay may change it,
8319 to accommodate a Fset_window_start or something. We
8320 don't want to do this at the top of the function,
8321 because we may get input from a subprocess which
8322 wants to change the selected window and stuff (say,
8323 emacsclient). */
8324 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
8326 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
8327 Fkill_emacs (Qnil);
8328 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
8329 orig_local_map = get_local_map (PT, current_buffer,
8330 Qlocal_map);
8331 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
8332 goto replay_sequence;
8335 /* For a mouse click, get the local text-property keymap
8336 of the place clicked on, rather than point. */
8337 if (last_real_key_start == 0
8338 && CONSP (XCDR (key))
8339 && ! localized_local_map)
8341 Lisp_Object map_here, start, pos;
8343 localized_local_map = 1;
8344 start = EVENT_START (key);
8346 if (CONSP (start) && CONSP (XCDR (start)))
8348 pos = POSN_BUFFER_POSN (start);
8349 if (INTEGERP (pos)
8350 && XINT (pos) >= BEG && XINT (pos) <= Z)
8352 map_here = get_local_map (XINT (pos),
8353 current_buffer, Qlocal_map);
8354 if (!EQ (map_here, orig_local_map))
8356 orig_local_map = map_here;
8357 keybuf[t] = key;
8358 mock_input = t + 1;
8360 goto replay_sequence;
8362 map_here = get_local_map (XINT (pos),
8363 current_buffer, Qkeymap);
8364 if (!EQ (map_here, orig_keymap))
8366 orig_keymap = map_here;
8367 keybuf[t] = key;
8368 mock_input = t + 1;
8370 goto replay_sequence;
8376 /* Expand mode-line and scroll-bar events into two events:
8377 use posn as a fake prefix key. */
8378 if (SYMBOLP (posn)
8379 && (NILP (fake_prefixed_keys)
8380 || NILP (Fmemq (key, fake_prefixed_keys))))
8382 if (t + 1 >= bufsize)
8383 error ("Key sequence too long");
8385 keybuf[t] = posn;
8386 keybuf[t + 1] = key;
8387 mock_input = t + 2;
8389 /* Record that a fake prefix key has been generated
8390 for KEY. Don't modify the event; this would
8391 prevent proper action when the event is pushed
8392 back tino unread-command-events. */
8393 fake_prefixed_keys = Fcons (key, fake_prefixed_keys);
8395 /* If on a mode line string with a local keymap,
8396 reconsider the key sequence with that keymap. */
8397 if (CONSP (POSN_STRING (EVENT_START (key))))
8399 Lisp_Object string, pos, map, map2;
8401 string = POSN_STRING (EVENT_START (key));
8402 pos = XCDR (string);
8403 string = XCAR (string);
8404 if (XINT (pos) >= 0
8405 && XINT (pos) < XSTRING (string)->size)
8407 map = Fget_text_property (pos, Qlocal_map, string);
8408 if (!NILP (map))
8409 orig_local_map = map;
8410 map2 = Fget_text_property (pos, Qkeymap, string);
8411 if (!NILP (map2))
8412 orig_keymap = map2;
8413 if (!NILP (map) || !NILP (map2))
8414 goto replay_sequence;
8418 goto replay_key;
8420 else if (CONSP (POSN_STRING (EVENT_START (key)))
8421 && NILP (from_string))
8423 /* For a click on a string, i.e. overlay string or a
8424 string displayed via the `display' property,
8425 consider `local-map' and `keymap' properties of
8426 that string. */
8427 Lisp_Object string, pos, map, map2;
8429 string = POSN_STRING (EVENT_START (key));
8430 pos = XCDR (string);
8431 string = XCAR (string);
8432 if (XINT (pos) >= 0
8433 && XINT (pos) < XSTRING (string)->size)
8435 map = Fget_text_property (pos, Qlocal_map, string);
8436 if (!NILP (map))
8437 orig_local_map = map;
8438 map2 = Fget_text_property (pos, Qkeymap, string);
8439 if (!NILP (map2))
8440 orig_keymap = map2;
8442 if (!NILP (map) || !NILP (map2))
8444 from_string = string;
8445 goto replay_sequence;
8450 else if (CONSP (XCDR (key))
8451 && CONSP (EVENT_START (key))
8452 && CONSP (XCDR (EVENT_START (key))))
8454 Lisp_Object posn;
8456 posn = POSN_BUFFER_POSN (EVENT_START (key));
8457 /* Handle menu-bar events:
8458 insert the dummy prefix event `menu-bar'. */
8459 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
8461 if (t + 1 >= bufsize)
8462 error ("Key sequence too long");
8463 keybuf[t] = posn;
8464 keybuf[t+1] = key;
8466 /* Zap the position in key, so we know that we've
8467 expanded it, and don't try to do so again. */
8468 POSN_BUFFER_POSN (EVENT_START (key))
8469 = Fcons (posn, Qnil);
8471 mock_input = t + 2;
8472 goto replay_sequence;
8474 else if (CONSP (posn))
8476 /* We're looking at the second event of a
8477 sequence which we expanded before. Set
8478 last_real_key_start appropriately. */
8479 if (last_real_key_start == t && t > 0)
8480 last_real_key_start = t - 1;
8485 /* We have finally decided that KEY is something we might want
8486 to look up. */
8487 first_binding = (follow_key (key,
8488 nmaps - first_binding,
8489 submaps + first_binding,
8490 defs + first_binding,
8491 submaps + first_binding)
8492 + first_binding);
8494 /* If KEY wasn't bound, we'll try some fallbacks. */
8495 if (first_binding >= nmaps)
8497 Lisp_Object head;
8499 head = EVENT_HEAD (key);
8500 if (help_char_p (head) && t > 0)
8502 read_key_sequence_cmd = Vprefix_help_command;
8503 keybuf[t++] = key;
8504 last_nonmenu_event = key;
8505 /* The Microsoft C compiler can't handle the goto that
8506 would go here. */
8507 dummyflag = 1;
8508 break;
8511 if (SYMBOLP (head))
8513 Lisp_Object breakdown;
8514 int modifiers;
8516 breakdown = parse_modifiers (head);
8517 modifiers = XINT (XCAR (XCDR (breakdown)));
8518 /* Attempt to reduce an unbound mouse event to a simpler
8519 event that is bound:
8520 Drags reduce to clicks.
8521 Double-clicks reduce to clicks.
8522 Triple-clicks reduce to double-clicks, then to clicks.
8523 Down-clicks are eliminated.
8524 Double-downs reduce to downs, then are eliminated.
8525 Triple-downs reduce to double-downs, then to downs,
8526 then are eliminated. */
8527 if (modifiers & (down_modifier | drag_modifier
8528 | double_modifier | triple_modifier))
8530 while (modifiers & (down_modifier | drag_modifier
8531 | double_modifier | triple_modifier))
8533 Lisp_Object new_head, new_click;
8534 if (modifiers & triple_modifier)
8535 modifiers ^= (double_modifier | triple_modifier);
8536 else if (modifiers & double_modifier)
8537 modifiers &= ~double_modifier;
8538 else if (modifiers & drag_modifier)
8539 modifiers &= ~drag_modifier;
8540 else
8542 /* Dispose of this `down' event by simply jumping
8543 back to replay_key, to get another event.
8545 Note that if this event came from mock input,
8546 then just jumping back to replay_key will just
8547 hand it to us again. So we have to wipe out any
8548 mock input.
8550 We could delete keybuf[t] and shift everything
8551 after that to the left by one spot, but we'd also
8552 have to fix up any variable that points into
8553 keybuf, and shifting isn't really necessary
8554 anyway.
8556 Adding prefixes for non-textual mouse clicks
8557 creates two characters of mock input, and both
8558 must be thrown away. If we're only looking at
8559 the prefix now, we can just jump back to
8560 replay_key. On the other hand, if we've already
8561 processed the prefix, and now the actual click
8562 itself is giving us trouble, then we've lost the
8563 state of the keymaps we want to backtrack to, and
8564 we need to replay the whole sequence to rebuild
8567 Beyond that, only function key expansion could
8568 create more than two keys, but that should never
8569 generate mouse events, so it's okay to zero
8570 mock_input in that case too.
8572 Isn't this just the most wonderful code ever? */
8573 if (t == last_real_key_start)
8575 mock_input = 0;
8576 goto replay_key;
8578 else
8580 mock_input = last_real_key_start;
8581 goto replay_sequence;
8585 new_head
8586 = apply_modifiers (modifiers, XCAR (breakdown));
8587 new_click
8588 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
8590 /* Look for a binding for this new key. follow_key
8591 promises that it didn't munge submaps the
8592 last time we called it, since key was unbound. */
8593 first_binding
8594 = (follow_key (new_click,
8595 nmaps - local_first_binding,
8596 submaps + local_first_binding,
8597 defs + local_first_binding,
8598 submaps + local_first_binding)
8599 + local_first_binding);
8601 /* If that click is bound, go for it. */
8602 if (first_binding < nmaps)
8604 key = new_click;
8605 break;
8607 /* Otherwise, we'll leave key set to the drag event. */
8613 keybuf[t++] = key;
8614 /* Normally, last_nonmenu_event gets the previous key we read.
8615 But when a mouse popup menu is being used,
8616 we don't update last_nonmenu_event; it continues to hold the mouse
8617 event that preceded the first level of menu. */
8618 if (!used_mouse_menu)
8619 last_nonmenu_event = key;
8621 /* Record what part of this_command_keys is the current key sequence. */
8622 this_single_command_key_start = this_command_key_count - t;
8624 prev_fkey_map = fkey_map;
8625 prev_fkey_start = fkey_start;
8626 prev_fkey_end = fkey_end;
8628 prev_keytran_map = keytran_map;
8629 prev_keytran_start = keytran_start;
8630 prev_keytran_end = keytran_end;
8632 /* If the sequence is unbound, see if we can hang a function key
8633 off the end of it. We only want to scan real keyboard input
8634 for function key sequences, so if mock_input says that we're
8635 re-reading old events, don't examine it. */
8636 if (first_binding >= nmaps
8637 && t >= mock_input)
8639 Lisp_Object fkey_next;
8641 /* Continue scan from fkey_end until we find a bound suffix.
8642 If we fail, increment fkey_start
8643 and start fkey_end from there. */
8644 while (fkey_end < t)
8646 Lisp_Object key;
8648 key = keybuf[fkey_end++];
8649 fkey_next
8650 = access_keymap (fkey_map, key, 1, 0, 1);
8652 /* Handle symbol with autoload definition. */
8653 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
8654 && CONSP (XSYMBOL (fkey_next)->function)
8655 && EQ (XCAR (XSYMBOL (fkey_next)->function), Qautoload))
8656 do_autoload (XSYMBOL (fkey_next)->function,
8657 fkey_next);
8659 /* Handle a symbol whose function definition is a keymap
8660 or an array. */
8661 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
8662 && (!NILP (Farrayp (XSYMBOL (fkey_next)->function))
8663 || KEYMAPP (XSYMBOL (fkey_next)->function)))
8664 fkey_next = XSYMBOL (fkey_next)->function;
8666 #if 0 /* I didn't turn this on, because it might cause trouble
8667 for the mapping of return into C-m and tab into C-i. */
8668 /* Optionally don't map function keys into other things.
8669 This enables the user to redefine kp- keys easily. */
8670 if (SYMBOLP (key) && !NILP (Vinhibit_function_key_mapping))
8671 fkey_next = Qnil;
8672 #endif
8674 /* If the function key map gives a function, not an
8675 array, then call the function with no args and use
8676 its value instead. */
8677 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
8678 && fkey_end == t)
8680 struct gcpro gcpro1, gcpro2, gcpro3;
8681 Lisp_Object tem;
8682 tem = fkey_next;
8684 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
8685 fkey_next = call1 (fkey_next, prompt);
8686 UNGCPRO;
8687 /* If the function returned something invalid,
8688 barf--don't ignore it.
8689 (To ignore it safely, we would need to gcpro a bunch of
8690 other variables.) */
8691 if (! (VECTORP (fkey_next) || STRINGP (fkey_next)))
8692 error ("Function in key-translation-map returns invalid key sequence");
8695 function_key_possible = ! NILP (fkey_next);
8697 /* If keybuf[fkey_start..fkey_end] is bound in the
8698 function key map and it's a suffix of the current
8699 sequence (i.e. fkey_end == t), replace it with
8700 the binding and restart with fkey_start at the end. */
8701 if ((VECTORP (fkey_next) || STRINGP (fkey_next))
8702 && fkey_end == t)
8704 int len = XFASTINT (Flength (fkey_next));
8706 t = fkey_start + len;
8707 if (t >= bufsize)
8708 error ("Key sequence too long");
8710 if (VECTORP (fkey_next))
8711 bcopy (XVECTOR (fkey_next)->contents,
8712 keybuf + fkey_start,
8713 (t - fkey_start) * sizeof (keybuf[0]));
8714 else if (STRINGP (fkey_next))
8716 int i;
8718 for (i = 0; i < len; i++)
8719 XSETFASTINT (keybuf[fkey_start + i],
8720 XSTRING (fkey_next)->data[i]);
8723 mock_input = t;
8724 fkey_start = fkey_end = t;
8725 fkey_map = Vfunction_key_map;
8727 /* Do pass the results through key-translation-map.
8728 But don't retranslate what key-translation-map
8729 has already translated. */
8730 keytran_end = keytran_start;
8731 keytran_map = Vkey_translation_map;
8733 goto replay_sequence;
8736 fkey_map = get_keymap (fkey_next, 0, 1);
8738 /* If we no longer have a bound suffix, try a new positions for
8739 fkey_start. */
8740 if (!CONSP (fkey_map))
8742 fkey_end = ++fkey_start;
8743 fkey_map = Vfunction_key_map;
8744 function_key_possible = 0;
8749 /* Look for this sequence in key-translation-map. */
8751 Lisp_Object keytran_next;
8753 /* Scan from keytran_end until we find a bound suffix. */
8754 while (keytran_end < t)
8756 Lisp_Object key;
8758 key = keybuf[keytran_end++];
8759 keytran_next
8760 = access_keymap (keytran_map, key, 1, 0, 1);
8762 /* Handle symbol with autoload definition. */
8763 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
8764 && CONSP (XSYMBOL (keytran_next)->function)
8765 && EQ (XCAR (XSYMBOL (keytran_next)->function), Qautoload))
8766 do_autoload (XSYMBOL (keytran_next)->function,
8767 keytran_next);
8769 /* Handle a symbol whose function definition is a keymap
8770 or an array. */
8771 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
8772 && (!NILP (Farrayp (XSYMBOL (keytran_next)->function))
8773 || KEYMAPP (XSYMBOL (keytran_next)->function)))
8774 keytran_next = XSYMBOL (keytran_next)->function;
8776 /* If the key translation map gives a function, not an
8777 array, then call the function with one arg and use
8778 its value instead. */
8779 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
8780 && keytran_end == t)
8782 struct gcpro gcpro1, gcpro2, gcpro3;
8783 Lisp_Object tem;
8784 tem = keytran_next;
8786 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
8787 keytran_next = call1 (keytran_next, prompt);
8788 UNGCPRO;
8789 /* If the function returned something invalid,
8790 barf--don't ignore it.
8791 (To ignore it safely, we would need to gcpro a bunch of
8792 other variables.) */
8793 if (! (VECTORP (keytran_next) || STRINGP (keytran_next)))
8794 error ("Function in key-translation-map returns invalid key sequence");
8797 key_translation_possible = ! NILP (keytran_next);
8799 /* If keybuf[keytran_start..keytran_end] is bound in the
8800 key translation map and it's a suffix of the current
8801 sequence (i.e. keytran_end == t), replace it with
8802 the binding and restart with keytran_start at the end. */
8803 if ((VECTORP (keytran_next) || STRINGP (keytran_next))
8804 && keytran_end == t)
8806 int len = XFASTINT (Flength (keytran_next));
8808 t = keytran_start + len;
8809 if (t >= bufsize)
8810 error ("Key sequence too long");
8812 if (VECTORP (keytran_next))
8813 bcopy (XVECTOR (keytran_next)->contents,
8814 keybuf + keytran_start,
8815 (t - keytran_start) * sizeof (keybuf[0]));
8816 else if (STRINGP (keytran_next))
8818 int i;
8820 for (i = 0; i < len; i++)
8821 XSETFASTINT (keybuf[keytran_start + i],
8822 XSTRING (keytran_next)->data[i]);
8825 mock_input = t;
8826 keytran_start = keytran_end = t;
8827 keytran_map = Vkey_translation_map;
8829 /* Don't pass the results of key-translation-map
8830 through function-key-map. */
8831 fkey_start = fkey_end = t;
8832 fkey_map = Vfunction_key_map;
8834 goto replay_sequence;
8837 keytran_map = get_keymap (keytran_next, 0, 1);
8839 /* If we no longer have a bound suffix, try a new positions for
8840 keytran_start. */
8841 if (!CONSP (keytran_map))
8843 keytran_end = ++keytran_start;
8844 keytran_map = Vkey_translation_map;
8845 key_translation_possible = 0;
8850 /* If KEY is not defined in any of the keymaps,
8851 and cannot be part of a function key or translation,
8852 and is an upper case letter
8853 use the corresponding lower-case letter instead. */
8854 if (first_binding == nmaps && ! function_key_possible
8855 && ! key_translation_possible
8856 && INTEGERP (key)
8857 && ((((XINT (key) & 0x3ffff)
8858 < XCHAR_TABLE (current_buffer->downcase_table)->size)
8859 && UPPERCASEP (XINT (key) & 0x3ffff))
8860 || (XINT (key) & shift_modifier)))
8862 Lisp_Object new_key;
8864 original_uppercase = key;
8865 original_uppercase_position = t - 1;
8867 if (XINT (key) & shift_modifier)
8868 XSETINT (new_key, XINT (key) & ~shift_modifier);
8869 else
8870 XSETINT (new_key, (DOWNCASE (XINT (key) & 0x3ffff)
8871 | (XINT (key) & ~0x3ffff)));
8873 /* We have to do this unconditionally, regardless of whether
8874 the lower-case char is defined in the keymaps, because they
8875 might get translated through function-key-map. */
8876 keybuf[t - 1] = new_key;
8877 mock_input = t;
8879 fkey_map = prev_fkey_map;
8880 fkey_start = prev_fkey_start;
8881 fkey_end = prev_fkey_end;
8883 keytran_map = prev_keytran_map;
8884 keytran_start = prev_keytran_start;
8885 keytran_end = prev_keytran_end;
8887 goto replay_sequence;
8889 /* If KEY is not defined in any of the keymaps,
8890 and cannot be part of a function key or translation,
8891 and is a shifted function key,
8892 use the corresponding unshifted function key instead. */
8893 if (first_binding == nmaps && ! function_key_possible
8894 && ! key_translation_possible
8895 && SYMBOLP (key))
8897 Lisp_Object breakdown;
8898 int modifiers;
8900 breakdown = parse_modifiers (key);
8901 modifiers = XINT (XCAR (XCDR (breakdown)));
8902 if (modifiers & shift_modifier)
8904 Lisp_Object new_key;
8906 original_uppercase = key;
8907 original_uppercase_position = t - 1;
8909 modifiers &= ~shift_modifier;
8910 new_key = apply_modifiers (modifiers,
8911 XCAR (breakdown));
8913 keybuf[t - 1] = new_key;
8914 mock_input = t;
8916 fkey_map = prev_fkey_map;
8917 fkey_start = prev_fkey_start;
8918 fkey_end = prev_fkey_end;
8920 keytran_map = prev_keytran_map;
8921 keytran_start = prev_keytran_start;
8922 keytran_end = prev_keytran_end;
8924 goto replay_sequence;
8929 if (!dummyflag)
8930 read_key_sequence_cmd = (first_binding < nmaps
8931 ? defs[first_binding]
8932 : Qnil);
8934 unread_switch_frame = delayed_switch_frame;
8935 unbind_to (count, Qnil);
8937 /* Don't downcase the last character if the caller says don't.
8938 Don't downcase it if the result is undefined, either. */
8939 if ((dont_downcase_last || first_binding >= nmaps)
8940 && t - 1 == original_uppercase_position)
8941 keybuf[t - 1] = original_uppercase;
8943 /* Occasionally we fabricate events, perhaps by expanding something
8944 according to function-key-map, or by adding a prefix symbol to a
8945 mouse click in the scroll bar or modeline. In this cases, return
8946 the entire generated key sequence, even if we hit an unbound
8947 prefix or a definition before the end. This means that you will
8948 be able to push back the event properly, and also means that
8949 read-key-sequence will always return a logical unit.
8951 Better ideas? */
8952 for (; t < mock_input; t++)
8954 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8955 && NILP (Fzerop (Vecho_keystrokes)))
8956 echo_char (keybuf[t]);
8957 add_command_key (keybuf[t]);
8962 UNGCPRO;
8963 return t;
8966 #if 0 /* This doc string is too long for some compilers.
8967 This commented-out definition serves for DOC. */
8968 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0,
8969 "Read a sequence of keystrokes and return as a string or vector.\n\
8970 The sequence is sufficient to specify a non-prefix command in the\n\
8971 current local and global maps.\n\
8973 First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
8974 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\
8975 as a continuation of the previous key.\n\
8977 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not\n\
8978 convert the last event to lower case. (Normally any upper case event\n\
8979 is converted to lower case if the original event is undefined and the lower\n\
8980 case equivalent is defined.) A non-nil value is appropriate for reading\n\
8981 a key sequence to be defined.\n\
8983 A C-g typed while in this function is treated like any other character,\n\
8984 and `quit-flag' is not set.\n\
8986 If the key sequence starts with a mouse click, then the sequence is read\n\
8987 using the keymaps of the buffer of the window clicked in, not the buffer\n\
8988 of the selected window as normal.\n\
8989 ""\n\
8990 `read-key-sequence' drops unbound button-down events, since you normally\n\
8991 only care about the click or drag events which follow them. If a drag\n\
8992 or multi-click event is unbound, but the corresponding click event would\n\
8993 be bound, `read-key-sequence' turns the event into a click event at the\n\
8994 drag's starting position. This means that you don't have to distinguish\n\
8995 between click and drag, double, or triple events unless you want to.\n\
8997 `read-key-sequence' prefixes mouse events on mode lines, the vertical\n\
8998 lines separating windows, and scroll bars with imaginary keys\n\
8999 `mode-line', `vertical-line', and `vertical-scroll-bar'.\n\
9001 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this\n\
9002 function will process a switch-frame event if the user switches frames\n\
9003 before typing anything. If the user switches frames in the middle of a\n\
9004 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME\n\
9005 is nil, then the event will be put off until after the current key sequence.\n\
9007 `read-key-sequence' checks `function-key-map' for function key\n\
9008 sequences, where they wouldn't conflict with ordinary bindings. See\n\
9009 `function-key-map' for more details.\n\
9011 The optional fifth argument COMMAND-LOOP, if non-nil, means\n\
9012 that this key sequence is being read by something that will\n\
9013 read commands one after another. It should be nil if the caller\n\
9014 will read just one key sequence.")
9015 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame, command-loop)
9016 #endif
9018 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
9020 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
9021 command_loop)
9022 Lisp_Object prompt, continue_echo, dont_downcase_last;
9023 Lisp_Object can_return_switch_frame, command_loop;
9025 Lisp_Object keybuf[30];
9026 register int i;
9027 struct gcpro gcpro1;
9028 int count = specpdl_ptr - specpdl;
9030 if (!NILP (prompt))
9031 CHECK_STRING (prompt, 0);
9032 QUIT;
9034 specbind (Qinput_method_exit_on_first_char,
9035 (NILP (command_loop) ? Qt : Qnil));
9036 specbind (Qinput_method_use_echo_area,
9037 (NILP (command_loop) ? Qt : Qnil));
9039 bzero (keybuf, sizeof keybuf);
9040 GCPRO1 (keybuf[0]);
9041 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
9043 if (NILP (continue_echo))
9045 this_command_key_count = 0;
9046 this_single_command_key_start = 0;
9049 #ifdef HAVE_X_WINDOWS
9050 if (display_hourglass_p)
9051 cancel_hourglass ();
9052 #endif
9054 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
9055 prompt, ! NILP (dont_downcase_last),
9056 ! NILP (can_return_switch_frame), 0);
9058 #if 0 /* The following is fine for code reading a key sequence and
9059 then proceeding with a lenghty compuation, but it's not good
9060 for code reading keys in a loop, like an input method. */
9061 #ifdef HAVE_X_WINDOWS
9062 if (display_hourglass_p)
9063 start_hourglass ();
9064 #endif
9065 #endif
9067 if (i == -1)
9069 Vquit_flag = Qt;
9070 QUIT;
9072 UNGCPRO;
9073 return unbind_to (count, make_event_array (i, keybuf));
9076 DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
9077 Sread_key_sequence_vector, 1, 5, 0,
9078 "Like `read-key-sequence' but always return a vector.")
9079 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
9080 command_loop)
9081 Lisp_Object prompt, continue_echo, dont_downcase_last;
9082 Lisp_Object can_return_switch_frame, command_loop;
9084 Lisp_Object keybuf[30];
9085 register int i;
9086 struct gcpro gcpro1;
9087 int count = specpdl_ptr - specpdl;
9089 if (!NILP (prompt))
9090 CHECK_STRING (prompt, 0);
9091 QUIT;
9093 specbind (Qinput_method_exit_on_first_char,
9094 (NILP (command_loop) ? Qt : Qnil));
9095 specbind (Qinput_method_use_echo_area,
9096 (NILP (command_loop) ? Qt : Qnil));
9098 bzero (keybuf, sizeof keybuf);
9099 GCPRO1 (keybuf[0]);
9100 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
9102 if (NILP (continue_echo))
9104 this_command_key_count = 0;
9105 this_single_command_key_start = 0;
9108 #ifdef HAVE_X_WINDOWS
9109 if (display_hourglass_p)
9110 cancel_hourglass ();
9111 #endif
9113 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
9114 prompt, ! NILP (dont_downcase_last),
9115 ! NILP (can_return_switch_frame), 0);
9117 #ifdef HAVE_X_WINDOWS
9118 if (display_hourglass_p)
9119 start_hourglass ();
9120 #endif
9122 if (i == -1)
9124 Vquit_flag = Qt;
9125 QUIT;
9127 UNGCPRO;
9128 return unbind_to (count, Fvector (i, keybuf));
9131 DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0,
9132 "Execute CMD as an editor command.\n\
9133 CMD must be a symbol that satisfies the `commandp' predicate.\n\
9134 Optional second arg RECORD-FLAG non-nil\n\
9135 means unconditionally put this command in `command-history'.\n\
9136 Otherwise, that is done only if an arg is read using the minibuffer.\n\
9137 The argument KEYS specifies the value to use instead of (this-command-keys)\n\
9138 when reading the arguments; if it is nil, (this-command-keys) is used.\n\
9139 The argument SPECIAL, if non-nil, means that this command is executing\n\
9140 a special event, so ignore the prefix argument and don't clear it.")
9141 (cmd, record_flag, keys, special)
9142 Lisp_Object cmd, record_flag, keys, special;
9144 register Lisp_Object final;
9145 register Lisp_Object tem;
9146 Lisp_Object prefixarg;
9147 struct backtrace backtrace;
9148 extern int debug_on_next_call;
9150 debug_on_next_call = 0;
9152 if (NILP (special))
9154 prefixarg = current_kboard->Vprefix_arg;
9155 Vcurrent_prefix_arg = prefixarg;
9156 current_kboard->Vprefix_arg = Qnil;
9158 else
9159 prefixarg = Qnil;
9161 if (SYMBOLP (cmd))
9163 tem = Fget (cmd, Qdisabled);
9164 if (!NILP (tem) && !NILP (Vrun_hooks))
9166 tem = Fsymbol_value (Qdisabled_command_hook);
9167 if (!NILP (tem))
9168 return call1 (Vrun_hooks, Qdisabled_command_hook);
9172 while (1)
9174 final = Findirect_function (cmd);
9176 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
9178 struct gcpro gcpro1, gcpro2;
9180 GCPRO2 (cmd, prefixarg);
9181 do_autoload (final, cmd);
9182 UNGCPRO;
9184 else
9185 break;
9188 if (STRINGP (final) || VECTORP (final))
9190 /* If requested, place the macro in the command history. For
9191 other sorts of commands, call-interactively takes care of
9192 this. */
9193 if (!NILP (record_flag))
9195 Vcommand_history
9196 = Fcons (Fcons (Qexecute_kbd_macro,
9197 Fcons (final, Fcons (prefixarg, Qnil))),
9198 Vcommand_history);
9200 /* Don't keep command history around forever. */
9201 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
9203 tem = Fnthcdr (Vhistory_length, Vcommand_history);
9204 if (CONSP (tem))
9205 XCDR (tem) = Qnil;
9209 return Fexecute_kbd_macro (final, prefixarg);
9212 if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
9214 backtrace.next = backtrace_list;
9215 backtrace_list = &backtrace;
9216 backtrace.function = &Qcall_interactively;
9217 backtrace.args = &cmd;
9218 backtrace.nargs = 1;
9219 backtrace.evalargs = 0;
9221 tem = Fcall_interactively (cmd, record_flag, keys);
9223 backtrace_list = backtrace.next;
9224 return tem;
9226 return Qnil;
9231 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
9232 1, 1, "P",
9233 "Read function name, then read its arguments and call it.")
9234 (prefixarg)
9235 Lisp_Object prefixarg;
9237 Lisp_Object function;
9238 char buf[40];
9239 Lisp_Object saved_keys;
9240 Lisp_Object bindings, value;
9241 struct gcpro gcpro1, gcpro2;
9243 saved_keys = Fvector (this_command_key_count,
9244 XVECTOR (this_command_keys)->contents);
9245 buf[0] = 0;
9246 GCPRO2 (saved_keys, prefixarg);
9248 if (EQ (prefixarg, Qminus))
9249 strcpy (buf, "- ");
9250 else if (CONSP (prefixarg) && XINT (XCAR (prefixarg)) == 4)
9251 strcpy (buf, "C-u ");
9252 else if (CONSP (prefixarg) && INTEGERP (XCAR (prefixarg)))
9254 if (sizeof (int) == sizeof (EMACS_INT))
9255 sprintf (buf, "%d ", XINT (XCAR (prefixarg)));
9256 else if (sizeof (long) == sizeof (EMACS_INT))
9257 sprintf (buf, "%ld ", (long) XINT (XCAR (prefixarg)));
9258 else
9259 abort ();
9261 else if (INTEGERP (prefixarg))
9263 if (sizeof (int) == sizeof (EMACS_INT))
9264 sprintf (buf, "%d ", XINT (prefixarg));
9265 else if (sizeof (long) == sizeof (EMACS_INT))
9266 sprintf (buf, "%ld ", (long) XINT (prefixarg));
9267 else
9268 abort ();
9271 /* This isn't strictly correct if execute-extended-command
9272 is bound to anything else. Perhaps it should use
9273 this_command_keys? */
9274 strcat (buf, "M-x ");
9276 /* Prompt with buf, and then read a string, completing from and
9277 restricting to the set of all defined commands. Don't provide
9278 any initial input. Save the command read on the extended-command
9279 history list. */
9280 function = Fcompleting_read (build_string (buf),
9281 Vobarray, Qcommandp,
9282 Qt, Qnil, Qextended_command_history, Qnil,
9283 Qnil);
9285 if (STRINGP (function) && XSTRING (function)->size == 0)
9286 error ("No command name given");
9288 /* Set this_command_keys to the concatenation of saved_keys and
9289 function, followed by a RET. */
9291 struct Lisp_String *str;
9292 Lisp_Object *keys;
9293 int i;
9295 this_command_key_count = 0;
9296 this_single_command_key_start = 0;
9298 keys = XVECTOR (saved_keys)->contents;
9299 for (i = 0; i < XVECTOR (saved_keys)->size; i++)
9300 add_command_key (keys[i]);
9302 str = XSTRING (function);
9303 for (i = 0; i < str->size; i++)
9304 add_command_key (Faref (function, make_number (i)));
9306 add_command_key (make_number ('\015'));
9309 UNGCPRO;
9311 function = Fintern (function, Qnil);
9312 current_kboard->Vprefix_arg = prefixarg;
9313 Vthis_command = function;
9314 real_this_command = function;
9316 /* If enabled, show which key runs this command. */
9317 if (!NILP (Vsuggest_key_bindings)
9318 && NILP (Vexecuting_macro)
9319 && SYMBOLP (function))
9320 bindings = Fwhere_is_internal (function, Voverriding_local_map,
9321 Qt, Qnil);
9322 else
9323 bindings = Qnil;
9325 value = Qnil;
9326 GCPRO2 (bindings, value);
9327 value = Fcommand_execute (function, Qt, Qnil, Qnil);
9329 /* If the command has a key binding, print it now. */
9330 if (!NILP (bindings)
9331 && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
9332 Qmouse_movement)))
9334 /* But first wait, and skip the message if there is input. */
9335 int delay_time;
9336 if (!NILP (echo_area_buffer[0]))
9337 /* This command displayed something in the echo area;
9338 so wait a few seconds, then display our suggestion message. */
9339 delay_time = (NUMBERP (Vsuggest_key_bindings)
9340 ? XINT (Vsuggest_key_bindings) : 2);
9341 else
9342 /* This command left the echo area empty,
9343 so display our message immediately. */
9344 delay_time = 0;
9346 if (!NILP (Fsit_for (make_number (delay_time), Qnil, Qnil))
9347 && ! CONSP (Vunread_command_events))
9349 Lisp_Object binding;
9350 char *newmessage;
9351 int message_p = push_message ();
9352 int count = BINDING_STACK_SIZE ();
9354 record_unwind_protect (push_message_unwind, Qnil);
9355 binding = Fkey_description (bindings);
9357 newmessage
9358 = (char *) alloca (XSYMBOL (function)->name->size
9359 + STRING_BYTES (XSTRING (binding))
9360 + 100);
9361 sprintf (newmessage, "You can run the command `%s' with %s",
9362 XSYMBOL (function)->name->data,
9363 XSTRING (binding)->data);
9364 message2_nolog (newmessage,
9365 strlen (newmessage),
9366 STRING_MULTIBYTE (binding));
9367 if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings)
9368 ? Vsuggest_key_bindings : make_number (2)),
9369 Qnil, Qnil))
9370 && message_p)
9371 restore_message ();
9373 unbind_to (count, Qnil);
9377 RETURN_UNGCPRO (value);
9380 /* Find the set of keymaps now active.
9381 Store into *MAPS_P a vector holding the various maps
9382 and return the number of them. The vector was malloc'd
9383 and the caller should free it. */
9386 current_active_maps (maps_p)
9387 Lisp_Object **maps_p;
9389 Lisp_Object *tmaps, *maps;
9390 int nmaps;
9392 /* Should overriding-terminal-local-map and overriding-local-map apply? */
9393 if (!NILP (Voverriding_local_map_menu_flag))
9395 /* Yes, use them (if non-nil) as well as the global map. */
9396 maps = (Lisp_Object *) xmalloc (3 * sizeof (maps[0]));
9397 nmaps = 0;
9398 if (!NILP (current_kboard->Voverriding_terminal_local_map))
9399 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
9400 if (!NILP (Voverriding_local_map))
9401 maps[nmaps++] = Voverriding_local_map;
9403 else
9405 /* No, so use major and minor mode keymaps and keymap property. */
9406 int extra_maps = 2;
9407 Lisp_Object map = get_local_map (PT, current_buffer, Qkeymap);
9408 if (!NILP (map))
9409 extra_maps = 3;
9410 nmaps = current_minor_maps (NULL, &tmaps);
9411 maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
9412 * sizeof (maps[0]));
9413 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
9414 if (!NILP (map))
9415 maps[nmaps++] = map;
9416 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
9418 maps[nmaps++] = current_global_map;
9420 *maps_p = maps;
9421 return nmaps;
9424 /* Return nonzero if input events are pending. */
9427 detect_input_pending ()
9429 if (!input_pending)
9430 get_input_pending (&input_pending, 0);
9432 return input_pending;
9435 /* Return nonzero if input events are pending, and run any pending timers. */
9438 detect_input_pending_run_timers (do_display)
9439 int do_display;
9441 int old_timers_run = timers_run;
9443 if (!input_pending)
9444 get_input_pending (&input_pending, 1);
9446 if (old_timers_run != timers_run && do_display)
9448 redisplay_preserve_echo_area (8);
9449 /* The following fixes a bug when using lazy-lock with
9450 lazy-lock-defer-on-the-fly set to t, i.e. when fontifying
9451 from an idle timer function. The symptom of the bug is that
9452 the cursor sometimes doesn't become visible until the next X
9453 event is processed. --gerd. */
9454 if (rif)
9455 rif->flush_display (NULL);
9458 return input_pending;
9461 /* This is called in some cases before a possible quit.
9462 It cases the next call to detect_input_pending to recompute input_pending.
9463 So calling this function unnecessarily can't do any harm. */
9465 void
9466 clear_input_pending ()
9468 input_pending = 0;
9471 /* Return nonzero if there are pending requeued events.
9472 This isn't used yet. The hope is to make wait_reading_process_input
9473 call it, and return return if it runs Lisp code that unreads something.
9474 The problem is, kbd_buffer_get_event needs to be fixed to know what
9475 to do in that case. It isn't trivial. */
9478 requeued_events_pending_p ()
9480 return (!NILP (Vunread_command_events) || unread_command_char != -1);
9484 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
9485 "T if command input is currently available with no waiting.\n\
9486 Actually, the value is nil only if we can be sure that no input is available.")
9489 if (!NILP (Vunread_command_events) || unread_command_char != -1)
9490 return (Qt);
9492 get_input_pending (&input_pending, 1);
9493 return input_pending > 0 ? Qt : Qnil;
9496 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
9497 "Return vector of last 100 events, not counting those from keyboard macros.")
9500 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
9501 Lisp_Object val;
9503 if (total_keys < NUM_RECENT_KEYS)
9504 return Fvector (total_keys, keys);
9505 else
9507 val = Fvector (NUM_RECENT_KEYS, keys);
9508 bcopy (keys + recent_keys_index,
9509 XVECTOR (val)->contents,
9510 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
9511 bcopy (keys,
9512 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
9513 recent_keys_index * sizeof (Lisp_Object));
9514 return val;
9518 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
9519 "Return the key sequence that invoked this command.\n\
9520 The value is a string or a vector.")
9523 return make_event_array (this_command_key_count,
9524 XVECTOR (this_command_keys)->contents);
9527 DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
9528 "Return the key sequence that invoked this command, as a vector.")
9531 return Fvector (this_command_key_count,
9532 XVECTOR (this_command_keys)->contents);
9535 DEFUN ("this-single-command-keys", Fthis_single_command_keys,
9536 Sthis_single_command_keys, 0, 0, 0,
9537 "Return the key sequence that invoked this command.\n\
9538 Unlike `this-command-keys', this function's value\n\
9539 does not include prefix arguments.\n\
9540 The value is always a vector.")
9543 return Fvector (this_command_key_count
9544 - this_single_command_key_start,
9545 (XVECTOR (this_command_keys)->contents
9546 + this_single_command_key_start));
9549 DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
9550 Sthis_single_command_raw_keys, 0, 0, 0,
9551 "Return the raw events that were read for this command.\n\
9552 Unlike `this-single-command-keys', this function's value\n\
9553 shows the events before all translations (except for input methods).\n\
9554 The value is always a vector.")
9557 return Fvector (raw_keybuf_count,
9558 (XVECTOR (raw_keybuf)->contents));
9561 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
9562 Sreset_this_command_lengths, 0, 0, 0,
9563 "Used for complicated reasons in `universal-argument-other-key'.\n\
9565 `universal-argument-other-key' rereads the event just typed.\n\
9566 It then gets translated through `function-key-map'.\n\
9567 The translated event gets included in the echo area and in\n\
9568 the value of `this-command-keys' in addition to the raw original event.\n\
9569 That is not right.\n\
9571 Calling this function directs the translated event to replace\n\
9572 the original event, so that only one version of the event actually\n\
9573 appears in the echo area and in the value of `this-command-keys'.")
9576 before_command_restore_flag = 1;
9577 before_command_key_count_1 = before_command_key_count;
9578 before_command_echo_length_1 = before_command_echo_length;
9579 return Qnil;
9582 DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
9583 Sclear_this_command_keys, 0, 0, 0,
9584 "Clear out the vector that `this-command-keys' returns.\n\
9585 Clear vector containing last 100 events.")
9588 int i;
9590 this_command_key_count = 0;
9592 for (i = 0; i < XVECTOR (recent_keys)->size; ++i)
9593 XVECTOR (recent_keys)->contents[i] = Qnil;
9594 total_keys = 0;
9595 recent_keys_index = 0;
9596 return Qnil;
9599 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
9600 "Return the current depth in recursive edits.")
9603 Lisp_Object temp;
9604 XSETFASTINT (temp, command_loop_level + minibuf_level);
9605 return temp;
9608 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
9609 "FOpen dribble file: ",
9610 "Start writing all keyboard characters to a dribble file called FILE.\n\
9611 If FILE is nil, close any open dribble file.")
9612 (file)
9613 Lisp_Object file;
9615 if (dribble)
9617 fclose (dribble);
9618 dribble = 0;
9620 if (!NILP (file))
9622 file = Fexpand_file_name (file, Qnil);
9623 dribble = fopen (XSTRING (file)->data, "w");
9624 if (dribble == 0)
9625 report_file_error ("Opening dribble", Fcons (file, Qnil));
9627 return Qnil;
9630 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
9631 "Discard the contents of the terminal input buffer.\n\
9632 Also cancel any kbd macro being defined.")
9635 current_kboard->defining_kbd_macro = Qnil;
9636 update_mode_lines++;
9638 Vunread_command_events = Qnil;
9639 unread_command_char = -1;
9641 discard_tty_input ();
9643 kbd_fetch_ptr = kbd_store_ptr;
9644 Ffillarray (kbd_buffer_gcpro, Qnil);
9645 input_pending = 0;
9647 return Qnil;
9650 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
9651 "Stop Emacs and return to superior process. You can resume later.\n\
9652 If `cannot-suspend' is non-nil, or if the system doesn't support job\n\
9653 control, run a subshell instead.\n\n\
9654 If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
9655 to be read as terminal input by Emacs's parent, after suspension.\n\
9657 Before suspending, run the normal hook `suspend-hook'.\n\
9658 After resumption run the normal hook `suspend-resume-hook'.\n\
9660 Some operating systems cannot stop the Emacs process and resume it later.\n\
9661 On such systems, Emacs starts a subshell instead of suspending.")
9662 (stuffstring)
9663 Lisp_Object stuffstring;
9665 int count = specpdl_ptr - specpdl;
9666 int old_height, old_width;
9667 int width, height;
9668 struct gcpro gcpro1;
9670 if (!NILP (stuffstring))
9671 CHECK_STRING (stuffstring, 0);
9673 /* Run the functions in suspend-hook. */
9674 if (!NILP (Vrun_hooks))
9675 call1 (Vrun_hooks, intern ("suspend-hook"));
9677 GCPRO1 (stuffstring);
9678 get_frame_size (&old_width, &old_height);
9679 reset_sys_modes ();
9680 /* sys_suspend can get an error if it tries to fork a subshell
9681 and the system resources aren't available for that. */
9682 record_unwind_protect ((Lisp_Object (*) P_ ((Lisp_Object))) init_sys_modes,
9683 Qnil);
9684 stuff_buffered_input (stuffstring);
9685 if (cannot_suspend)
9686 sys_subshell ();
9687 else
9688 sys_suspend ();
9689 unbind_to (count, Qnil);
9691 /* Check if terminal/window size has changed.
9692 Note that this is not useful when we are running directly
9693 with a window system; but suspend should be disabled in that case. */
9694 get_frame_size (&width, &height);
9695 if (width != old_width || height != old_height)
9696 change_frame_size (SELECTED_FRAME (), height, width, 0, 0, 0);
9698 /* Run suspend-resume-hook. */
9699 if (!NILP (Vrun_hooks))
9700 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
9702 UNGCPRO;
9703 return Qnil;
9706 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
9707 Then in any case stuff anything Emacs has read ahead and not used. */
9709 void
9710 stuff_buffered_input (stuffstring)
9711 Lisp_Object stuffstring;
9713 /* stuff_char works only in BSD, versions 4.2 and up. */
9714 #ifdef BSD_SYSTEM
9715 #ifndef BSD4_1
9716 register unsigned char *p;
9718 if (STRINGP (stuffstring))
9720 register int count;
9722 p = XSTRING (stuffstring)->data;
9723 count = STRING_BYTES (XSTRING (stuffstring));
9724 while (count-- > 0)
9725 stuff_char (*p++);
9726 stuff_char ('\n');
9729 /* Anything we have read ahead, put back for the shell to read. */
9730 /* ?? What should this do when we have multiple keyboards??
9731 Should we ignore anything that was typed in at the "wrong" kboard? */
9732 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
9734 int idx;
9736 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
9737 kbd_fetch_ptr = kbd_buffer;
9738 if (kbd_fetch_ptr->kind == ascii_keystroke)
9739 stuff_char (kbd_fetch_ptr->code);
9741 kbd_fetch_ptr->kind = no_event;
9742 idx = 2 * (kbd_fetch_ptr - kbd_buffer);
9743 ASET (kbd_buffer_gcpro, idx, Qnil);
9744 ASET (kbd_buffer_gcpro, idx + 1, Qnil);
9747 input_pending = 0;
9748 #endif
9749 #endif /* BSD_SYSTEM and not BSD4_1 */
9752 void
9753 set_waiting_for_input (time_to_clear)
9754 EMACS_TIME *time_to_clear;
9756 input_available_clear_time = time_to_clear;
9758 /* Tell interrupt_signal to throw back to read_char, */
9759 waiting_for_input = 1;
9761 /* If interrupt_signal was called before and buffered a C-g,
9762 make it run again now, to avoid timing error. */
9763 if (!NILP (Vquit_flag))
9764 quit_throw_to_read_char ();
9767 void
9768 clear_waiting_for_input ()
9770 /* Tell interrupt_signal not to throw back to read_char, */
9771 waiting_for_input = 0;
9772 input_available_clear_time = 0;
9775 /* This routine is called at interrupt level in response to C-G.
9777 If interrupt_input, this is the handler for SIGINT. Otherwise, it
9778 is called from kbd_buffer_store_event, in handling SIGIO or
9779 SIGTINT.
9781 If `waiting_for_input' is non zero, then unless `echoing' is
9782 nonzero, immediately throw back to read_char.
9784 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
9785 eval to throw, when it gets a chance. If quit-flag is already
9786 non-nil, it stops the job right away. */
9788 SIGTYPE
9789 interrupt_signal (signalnum) /* If we don't have an argument, */
9790 int signalnum; /* some compilers complain in signal calls. */
9792 char c;
9793 /* Must preserve main program's value of errno. */
9794 int old_errno = errno;
9795 struct frame *sf = SELECTED_FRAME ();
9797 #if defined (USG) && !defined (POSIX_SIGNALS)
9798 if (!read_socket_hook && NILP (Vwindow_system))
9800 /* USG systems forget handlers when they are used;
9801 must reestablish each time */
9802 signal (SIGINT, interrupt_signal);
9803 signal (SIGQUIT, interrupt_signal);
9805 #endif /* USG */
9807 cancel_echoing ();
9809 if (!NILP (Vquit_flag)
9810 && (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf)))
9812 /* If SIGINT isn't blocked, don't let us be interrupted by
9813 another SIGINT, it might be harmful due to non-reentrancy
9814 in I/O functions. */
9815 sigblock (sigmask (SIGINT));
9817 fflush (stdout);
9818 reset_sys_modes ();
9820 #ifdef SIGTSTP /* Support possible in later USG versions */
9822 * On systems which can suspend the current process and return to the original
9823 * shell, this command causes the user to end up back at the shell.
9824 * The "Auto-save" and "Abort" questions are not asked until
9825 * the user elects to return to emacs, at which point he can save the current
9826 * job and either dump core or continue.
9828 sys_suspend ();
9829 #else
9830 #ifdef VMS
9831 if (sys_suspend () == -1)
9833 printf ("Not running as a subprocess;\n");
9834 printf ("you can continue or abort.\n");
9836 #else /* not VMS */
9837 /* Perhaps should really fork an inferior shell?
9838 But that would not provide any way to get back
9839 to the original shell, ever. */
9840 printf ("No support for stopping a process on this operating system;\n");
9841 printf ("you can continue or abort.\n");
9842 #endif /* not VMS */
9843 #endif /* not SIGTSTP */
9844 #ifdef MSDOS
9845 /* We must remain inside the screen area when the internal terminal
9846 is used. Note that [Enter] is not echoed by dos. */
9847 cursor_to (0, 0);
9848 #endif
9849 /* It doesn't work to autosave while GC is in progress;
9850 the code used for auto-saving doesn't cope with the mark bit. */
9851 if (!gc_in_progress)
9853 printf ("Auto-save? (y or n) ");
9854 fflush (stdout);
9855 if (((c = getchar ()) & ~040) == 'Y')
9857 Fdo_auto_save (Qt, Qnil);
9858 #ifdef MSDOS
9859 printf ("\r\nAuto-save done");
9860 #else /* not MSDOS */
9861 printf ("Auto-save done\n");
9862 #endif /* not MSDOS */
9864 while (c != '\n') c = getchar ();
9866 else
9868 /* During GC, it must be safe to reenable quitting again. */
9869 Vinhibit_quit = Qnil;
9870 #ifdef MSDOS
9871 printf ("\r\n");
9872 #endif /* not MSDOS */
9873 printf ("Garbage collection in progress; cannot auto-save now\r\n");
9874 printf ("but will instead do a real quit after garbage collection ends\r\n");
9875 fflush (stdout);
9878 #ifdef MSDOS
9879 printf ("\r\nAbort? (y or n) ");
9880 #else /* not MSDOS */
9881 #ifdef VMS
9882 printf ("Abort (and enter debugger)? (y or n) ");
9883 #else /* not VMS */
9884 printf ("Abort (and dump core)? (y or n) ");
9885 #endif /* not VMS */
9886 #endif /* not MSDOS */
9887 fflush (stdout);
9888 if (((c = getchar ()) & ~040) == 'Y')
9889 abort ();
9890 while (c != '\n') c = getchar ();
9891 #ifdef MSDOS
9892 printf ("\r\nContinuing...\r\n");
9893 #else /* not MSDOS */
9894 printf ("Continuing...\n");
9895 #endif /* not MSDOS */
9896 fflush (stdout);
9897 init_sys_modes ();
9898 sigfree ();
9900 else
9902 /* If executing a function that wants to be interrupted out of
9903 and the user has not deferred quitting by binding `inhibit-quit'
9904 then quit right away. */
9905 if (immediate_quit && NILP (Vinhibit_quit))
9907 struct gl_state_s saved;
9908 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9910 immediate_quit = 0;
9911 sigfree ();
9912 saved = gl_state;
9913 GCPRO4 (saved.object, saved.global_code,
9914 saved.current_syntax_table, saved.old_prop);
9915 Fsignal (Qquit, Qnil);
9916 gl_state = saved;
9917 UNGCPRO;
9919 else
9920 /* Else request quit when it's safe */
9921 Vquit_flag = Qt;
9924 if (waiting_for_input && !echoing)
9925 quit_throw_to_read_char ();
9927 errno = old_errno;
9930 /* Handle a C-g by making read_char return C-g. */
9932 void
9933 quit_throw_to_read_char ()
9935 sigfree ();
9936 /* Prevent another signal from doing this before we finish. */
9937 clear_waiting_for_input ();
9938 input_pending = 0;
9940 Vunread_command_events = Qnil;
9941 unread_command_char = -1;
9943 #if 0 /* Currently, sit_for is called from read_char without turning
9944 off polling. And that can call set_waiting_for_input.
9945 It seems to be harmless. */
9946 #ifdef POLL_FOR_INPUT
9947 /* May be > 1 if in recursive minibuffer. */
9948 if (poll_suppress_count == 0)
9949 abort ();
9950 #endif
9951 #endif
9952 if (FRAMEP (internal_last_event_frame)
9953 && !EQ (internal_last_event_frame, selected_frame))
9954 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
9955 0, 0);
9957 _longjmp (getcjmp, 1);
9960 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
9961 "Set mode of reading keyboard input.\n\
9962 First arg INTERRUPT non-nil means use input interrupts;\n\
9963 nil means use CBREAK mode.\n\
9964 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
9965 (no effect except in CBREAK mode).\n\
9966 Third arg META t means accept 8-bit input (for a Meta key).\n\
9967 META nil means ignore the top bit, on the assumption it is parity.\n\
9968 Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\
9969 Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\
9970 See also `current-input-mode'.")
9971 (interrupt, flow, meta, quit)
9972 Lisp_Object interrupt, flow, meta, quit;
9974 if (!NILP (quit)
9975 && (!INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400))
9976 error ("set-input-mode: QUIT must be an ASCII character");
9978 #ifdef POLL_FOR_INPUT
9979 stop_polling ();
9980 #endif
9982 #ifndef DOS_NT
9983 /* this causes startup screen to be restored and messes with the mouse */
9984 reset_sys_modes ();
9985 #endif
9987 #ifdef SIGIO
9988 /* Note SIGIO has been undef'd if FIONREAD is missing. */
9989 if (read_socket_hook)
9991 /* When using X, don't give the user a real choice,
9992 because we haven't implemented the mechanisms to support it. */
9993 #ifdef NO_SOCK_SIGIO
9994 interrupt_input = 0;
9995 #else /* not NO_SOCK_SIGIO */
9996 interrupt_input = 1;
9997 #endif /* NO_SOCK_SIGIO */
9999 else
10000 interrupt_input = !NILP (interrupt);
10001 #else /* not SIGIO */
10002 interrupt_input = 0;
10003 #endif /* not SIGIO */
10005 /* Our VMS input only works by interrupts, as of now. */
10006 #ifdef VMS
10007 interrupt_input = 1;
10008 #endif
10010 flow_control = !NILP (flow);
10011 if (NILP (meta))
10012 meta_key = 0;
10013 else if (EQ (meta, Qt))
10014 meta_key = 1;
10015 else
10016 meta_key = 2;
10017 if (!NILP (quit))
10018 /* Don't let this value be out of range. */
10019 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
10021 #ifndef DOS_NT
10022 init_sys_modes ();
10023 #endif
10025 #ifdef POLL_FOR_INPUT
10026 poll_suppress_count = 1;
10027 start_polling ();
10028 #endif
10029 return Qnil;
10032 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
10033 "Return information about the way Emacs currently reads keyboard input.\n\
10034 The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\
10035 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\
10036 nil, Emacs is using CBREAK mode.\n\
10037 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\
10038 terminal; this does not apply if Emacs uses interrupt-driven input.\n\
10039 META is t if accepting 8-bit input with 8th bit as Meta flag.\n\
10040 META nil means ignoring the top bit, on the assumption it is parity.\n\
10041 META is neither t nor nil if accepting 8-bit input and using\n\
10042 all 8 bits as the character code.\n\
10043 QUIT is the character Emacs currently uses to quit.\n\
10044 The elements of this list correspond to the arguments of\n\
10045 `set-input-mode'.")
10048 Lisp_Object val[4];
10050 val[0] = interrupt_input ? Qt : Qnil;
10051 val[1] = flow_control ? Qt : Qnil;
10052 val[2] = meta_key == 2 ? make_number (0) : meta_key == 1 ? Qt : Qnil;
10053 XSETFASTINT (val[3], quit_char);
10055 return Flist (sizeof (val) / sizeof (val[0]), val);
10060 * Set up a new kboard object with reasonable initial values.
10062 void
10063 init_kboard (kb)
10064 KBOARD *kb;
10066 kb->Voverriding_terminal_local_map = Qnil;
10067 kb->Vlast_command = Qnil;
10068 kb->Vreal_last_command = Qnil;
10069 kb->Vprefix_arg = Qnil;
10070 kb->Vlast_prefix_arg = Qnil;
10071 kb->kbd_queue = Qnil;
10072 kb->kbd_queue_has_data = 0;
10073 kb->immediate_echo = 0;
10074 kb->echoptr = kb->echobuf;
10075 kb->echo_after_prompt = -1;
10076 kb->kbd_macro_buffer = 0;
10077 kb->kbd_macro_bufsize = 0;
10078 kb->defining_kbd_macro = Qnil;
10079 kb->Vlast_kbd_macro = Qnil;
10080 kb->reference_count = 0;
10081 kb->Vsystem_key_alist = Qnil;
10082 kb->system_key_syms = Qnil;
10083 kb->Vdefault_minibuffer_frame = Qnil;
10087 * Destroy the contents of a kboard object, but not the object itself.
10088 * We use this just before deleting it, or if we're going to initialize
10089 * it a second time.
10091 static void
10092 wipe_kboard (kb)
10093 KBOARD *kb;
10095 if (kb->kbd_macro_buffer)
10096 xfree (kb->kbd_macro_buffer);
10099 #ifdef MULTI_KBOARD
10101 /* Free KB and memory referenced from it. */
10103 void
10104 delete_kboard (kb)
10105 KBOARD *kb;
10107 KBOARD **kbp;
10109 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
10110 if (*kbp == NULL)
10111 abort ();
10112 *kbp = kb->next_kboard;
10114 /* Prevent a dangling reference to KB. */
10115 if (kb == current_kboard
10116 && FRAMEP (selected_frame)
10117 && FRAME_LIVE_P (XFRAME (selected_frame)))
10119 current_kboard = XFRAME (selected_frame)->kboard;
10120 if (current_kboard == kb)
10121 abort ();
10124 wipe_kboard (kb);
10125 xfree (kb);
10128 #endif /* MULTI_KBOARD */
10130 void
10131 init_keyboard ()
10133 /* This is correct before outermost invocation of the editor loop */
10134 command_loop_level = -1;
10135 immediate_quit = 0;
10136 quit_char = Ctl ('g');
10137 Vunread_command_events = Qnil;
10138 unread_command_char = -1;
10139 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
10140 total_keys = 0;
10141 recent_keys_index = 0;
10142 kbd_fetch_ptr = kbd_buffer;
10143 kbd_store_ptr = kbd_buffer;
10144 kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
10145 #ifdef HAVE_MOUSE
10146 do_mouse_tracking = Qnil;
10147 #endif
10148 input_pending = 0;
10150 /* This means that command_loop_1 won't try to select anything the first
10151 time through. */
10152 internal_last_event_frame = Qnil;
10153 Vlast_event_frame = internal_last_event_frame;
10155 #ifdef MULTI_KBOARD
10156 current_kboard = initial_kboard;
10157 #endif
10158 wipe_kboard (current_kboard);
10159 init_kboard (current_kboard);
10161 if (!noninteractive && !read_socket_hook && NILP (Vwindow_system))
10163 signal (SIGINT, interrupt_signal);
10164 #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
10165 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
10166 SIGQUIT and we can't tell which one it will give us. */
10167 signal (SIGQUIT, interrupt_signal);
10168 #endif /* HAVE_TERMIO */
10170 /* Note SIGIO has been undef'd if FIONREAD is missing. */
10171 #ifdef SIGIO
10172 if (!noninteractive)
10173 signal (SIGIO, input_available_signal);
10174 #endif /* SIGIO */
10176 /* Use interrupt input by default, if it works and noninterrupt input
10177 has deficiencies. */
10179 #ifdef INTERRUPT_INPUT
10180 interrupt_input = 1;
10181 #else
10182 interrupt_input = 0;
10183 #endif
10185 /* Our VMS input only works by interrupts, as of now. */
10186 #ifdef VMS
10187 interrupt_input = 1;
10188 #endif
10190 sigfree ();
10191 dribble = 0;
10193 if (keyboard_init_hook)
10194 (*keyboard_init_hook) ();
10196 #ifdef POLL_FOR_INPUT
10197 poll_suppress_count = 1;
10198 start_polling ();
10199 #endif
10202 /* This type's only use is in syms_of_keyboard, to initialize the
10203 event header symbols and put properties on them. */
10204 struct event_head {
10205 Lisp_Object *var;
10206 char *name;
10207 Lisp_Object *kind;
10210 struct event_head head_table[] = {
10211 &Qmouse_movement, "mouse-movement", &Qmouse_movement,
10212 &Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement,
10213 &Qswitch_frame, "switch-frame", &Qswitch_frame,
10214 &Qdelete_frame, "delete-frame", &Qdelete_frame,
10215 &Qiconify_frame, "iconify-frame", &Qiconify_frame,
10216 &Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible,
10219 void
10220 syms_of_keyboard ()
10222 Vpre_help_message = Qnil;
10223 staticpro (&Vpre_help_message);
10225 Vlispy_mouse_stem = build_string ("mouse");
10226 staticpro (&Vlispy_mouse_stem);
10228 /* Tool-bars. */
10229 QCimage = intern (":image");
10230 staticpro (&QCimage);
10232 staticpro (&Qhelp_echo);
10233 Qhelp_echo = intern ("help-echo");
10235 staticpro (&item_properties);
10236 item_properties = Qnil;
10238 staticpro (&tool_bar_item_properties);
10239 tool_bar_item_properties = Qnil;
10240 staticpro (&tool_bar_items_vector);
10241 tool_bar_items_vector = Qnil;
10243 staticpro (&real_this_command);
10244 real_this_command = Qnil;
10246 Qtimer_event_handler = intern ("timer-event-handler");
10247 staticpro (&Qtimer_event_handler);
10249 Qdisabled_command_hook = intern ("disabled-command-hook");
10250 staticpro (&Qdisabled_command_hook);
10252 Qself_insert_command = intern ("self-insert-command");
10253 staticpro (&Qself_insert_command);
10255 Qforward_char = intern ("forward-char");
10256 staticpro (&Qforward_char);
10258 Qbackward_char = intern ("backward-char");
10259 staticpro (&Qbackward_char);
10261 Qdisabled = intern ("disabled");
10262 staticpro (&Qdisabled);
10264 Qundefined = intern ("undefined");
10265 staticpro (&Qundefined);
10267 Qpre_command_hook = intern ("pre-command-hook");
10268 staticpro (&Qpre_command_hook);
10270 Qpost_command_hook = intern ("post-command-hook");
10271 staticpro (&Qpost_command_hook);
10273 Qpost_command_idle_hook = intern ("post-command-idle-hook");
10274 staticpro (&Qpost_command_idle_hook);
10276 Qdeferred_action_function = intern ("deferred-action-function");
10277 staticpro (&Qdeferred_action_function);
10279 Qcommand_hook_internal = intern ("command-hook-internal");
10280 staticpro (&Qcommand_hook_internal);
10282 Qfunction_key = intern ("function-key");
10283 staticpro (&Qfunction_key);
10284 Qmouse_click = intern ("mouse-click");
10285 staticpro (&Qmouse_click);
10286 #ifdef WINDOWSNT
10287 Qmouse_wheel = intern ("mouse-wheel");
10288 staticpro (&Qmouse_wheel);
10289 Qlanguage_change = intern ("language-change");
10290 staticpro (&Qlanguage_change);
10291 #endif
10292 Qdrag_n_drop = intern ("drag-n-drop");
10293 staticpro (&Qdrag_n_drop);
10295 Qusr1_signal = intern ("usr1-signal");
10296 staticpro (&Qusr1_signal);
10297 Qusr2_signal = intern ("usr2-signal");
10298 staticpro (&Qusr2_signal);
10300 Qmenu_enable = intern ("menu-enable");
10301 staticpro (&Qmenu_enable);
10302 Qmenu_alias = intern ("menu-alias");
10303 staticpro (&Qmenu_alias);
10304 QCenable = intern (":enable");
10305 staticpro (&QCenable);
10306 QCvisible = intern (":visible");
10307 staticpro (&QCvisible);
10308 QChelp = intern (":help");
10309 staticpro (&QChelp);
10310 QCfilter = intern (":filter");
10311 staticpro (&QCfilter);
10312 QCbutton = intern (":button");
10313 staticpro (&QCbutton);
10314 QCkeys = intern (":keys");
10315 staticpro (&QCkeys);
10316 QCkey_sequence = intern (":key-sequence");
10317 staticpro (&QCkey_sequence);
10318 QCtoggle = intern (":toggle");
10319 staticpro (&QCtoggle);
10320 QCradio = intern (":radio");
10321 staticpro (&QCradio);
10323 Qmode_line = intern ("mode-line");
10324 staticpro (&Qmode_line);
10325 Qvertical_line = intern ("vertical-line");
10326 staticpro (&Qvertical_line);
10327 Qvertical_scroll_bar = intern ("vertical-scroll-bar");
10328 staticpro (&Qvertical_scroll_bar);
10329 Qmenu_bar = intern ("menu-bar");
10330 staticpro (&Qmenu_bar);
10332 Qabove_handle = intern ("above-handle");
10333 staticpro (&Qabove_handle);
10334 Qhandle = intern ("handle");
10335 staticpro (&Qhandle);
10336 Qbelow_handle = intern ("below-handle");
10337 staticpro (&Qbelow_handle);
10338 Qup = intern ("up");
10339 staticpro (&Qup);
10340 Qdown = intern ("down");
10341 staticpro (&Qdown);
10342 Qtop = intern ("top");
10343 staticpro (&Qtop);
10344 Qbottom = intern ("bottom");
10345 staticpro (&Qbottom);
10346 Qend_scroll = intern ("end-scroll");
10347 staticpro (&Qend_scroll);
10348 Qratio = intern ("ratio");
10349 staticpro (&Qratio);
10351 Qevent_kind = intern ("event-kind");
10352 staticpro (&Qevent_kind);
10353 Qevent_symbol_elements = intern ("event-symbol-elements");
10354 staticpro (&Qevent_symbol_elements);
10355 Qevent_symbol_element_mask = intern ("event-symbol-element-mask");
10356 staticpro (&Qevent_symbol_element_mask);
10357 Qmodifier_cache = intern ("modifier-cache");
10358 staticpro (&Qmodifier_cache);
10360 Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar");
10361 staticpro (&Qrecompute_lucid_menubar);
10362 Qactivate_menubar_hook = intern ("activate-menubar-hook");
10363 staticpro (&Qactivate_menubar_hook);
10365 Qpolling_period = intern ("polling-period");
10366 staticpro (&Qpolling_period);
10368 Qinput_method_function = intern ("input-method-function");
10369 staticpro (&Qinput_method_function);
10371 Qinput_method_exit_on_first_char = intern ("input-method-exit-on-first-char");
10372 staticpro (&Qinput_method_exit_on_first_char);
10373 Qinput_method_use_echo_area = intern ("input-method-use-echo-area");
10374 staticpro (&Qinput_method_use_echo_area);
10376 Fset (Qinput_method_exit_on_first_char, Qnil);
10377 Fset (Qinput_method_use_echo_area, Qnil);
10379 last_point_position_buffer = Qnil;
10382 struct event_head *p;
10384 for (p = head_table;
10385 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
10386 p++)
10388 *p->var = intern (p->name);
10389 staticpro (p->var);
10390 Fput (*p->var, Qevent_kind, *p->kind);
10391 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
10395 button_down_location = Fmake_vector (make_number (1), Qnil);
10396 staticpro (&button_down_location);
10397 mouse_syms = Fmake_vector (make_number (1), Qnil);
10398 staticpro (&mouse_syms);
10401 int i;
10402 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
10404 modifier_symbols = Fmake_vector (make_number (len), Qnil);
10405 for (i = 0; i < len; i++)
10406 if (modifier_names[i])
10407 XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]);
10408 staticpro (&modifier_symbols);
10411 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
10412 staticpro (&recent_keys);
10414 this_command_keys = Fmake_vector (make_number (40), Qnil);
10415 staticpro (&this_command_keys);
10417 raw_keybuf = Fmake_vector (make_number (30), Qnil);
10418 staticpro (&raw_keybuf);
10420 Qextended_command_history = intern ("extended-command-history");
10421 Fset (Qextended_command_history, Qnil);
10422 staticpro (&Qextended_command_history);
10424 kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
10425 staticpro (&kbd_buffer_gcpro);
10427 accent_key_syms = Qnil;
10428 staticpro (&accent_key_syms);
10430 func_key_syms = Qnil;
10431 staticpro (&func_key_syms);
10433 #ifdef WINDOWSNT
10434 mouse_wheel_syms = Qnil;
10435 staticpro (&mouse_wheel_syms);
10437 drag_n_drop_syms = Qnil;
10438 staticpro (&drag_n_drop_syms);
10439 #endif
10441 unread_switch_frame = Qnil;
10442 staticpro (&unread_switch_frame);
10444 internal_last_event_frame = Qnil;
10445 staticpro (&internal_last_event_frame);
10447 read_key_sequence_cmd = Qnil;
10448 staticpro (&read_key_sequence_cmd);
10450 menu_bar_one_keymap_changed_items = Qnil;
10451 staticpro (&menu_bar_one_keymap_changed_items);
10453 defsubr (&Sevent_convert_list);
10454 defsubr (&Sread_key_sequence);
10455 defsubr (&Sread_key_sequence_vector);
10456 defsubr (&Srecursive_edit);
10457 #ifdef HAVE_MOUSE
10458 defsubr (&Strack_mouse);
10459 #endif
10460 defsubr (&Sinput_pending_p);
10461 defsubr (&Scommand_execute);
10462 defsubr (&Srecent_keys);
10463 defsubr (&Sthis_command_keys);
10464 defsubr (&Sthis_command_keys_vector);
10465 defsubr (&Sthis_single_command_keys);
10466 defsubr (&Sthis_single_command_raw_keys);
10467 defsubr (&Sreset_this_command_lengths);
10468 defsubr (&Sclear_this_command_keys);
10469 defsubr (&Ssuspend_emacs);
10470 defsubr (&Sabort_recursive_edit);
10471 defsubr (&Sexit_recursive_edit);
10472 defsubr (&Srecursion_depth);
10473 defsubr (&Stop_level);
10474 defsubr (&Sdiscard_input);
10475 defsubr (&Sopen_dribble_file);
10476 defsubr (&Sset_input_mode);
10477 defsubr (&Scurrent_input_mode);
10478 defsubr (&Sexecute_extended_command);
10480 DEFVAR_LISP ("last-command-char", &last_command_char,
10481 "Last input event that was part of a command.");
10483 DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char,
10484 "Last input event that was part of a command.");
10486 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
10487 "Last input event in a command, except for mouse menu events.\n\
10488 Mouse menus give back keys that don't look like mouse events;\n\
10489 this variable holds the actual mouse event that led to the menu,\n\
10490 so that you can determine whether the command was run by mouse or not.");
10492 DEFVAR_LISP ("last-input-char", &last_input_char,
10493 "Last input event.");
10495 DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char,
10496 "Last input event.");
10498 DEFVAR_LISP ("unread-command-events", &Vunread_command_events,
10499 "List of events to be read as the command input.\n\
10500 These events are processed first, before actual keyboard input.");
10501 Vunread_command_events = Qnil;
10503 DEFVAR_INT ("unread-command-char", &unread_command_char,
10504 "If not -1, an object to be read as next command input event.");
10506 DEFVAR_LISP ("unread-post-input-method-events", &Vunread_post_input_method_events,
10507 "List of events to be processed as input by input methods.\n\
10508 These events are processed after `unread-command-events', but\n\
10509 before actual keyboard input.");
10510 Vunread_post_input_method_events = Qnil;
10512 DEFVAR_LISP ("unread-input-method-events", &Vunread_input_method_events,
10513 "List of events to be processed as input by input methods.\n\
10514 These events are processed after `unread-command-events', but\n\
10515 before actual keyboard input.");
10516 Vunread_input_method_events = Qnil;
10518 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
10519 "Meta-prefix character code.\n\
10520 Meta-foo as command input turns into this character followed by foo.");
10521 XSETINT (meta_prefix_char, 033);
10523 DEFVAR_KBOARD ("last-command", Vlast_command,
10524 "The last command executed.\n\
10525 Normally a symbol with a function definition, but can be whatever was found\n\
10526 in the keymap, or whatever the variable `this-command' was set to by that\n\
10527 command.\n\
10529 The value `mode-exit' is special; it means that the previous command\n\
10530 read an event that told it to exit, and it did so and unread that event.\n\
10531 In other words, the present command is the event that made the previous\n\
10532 command exit.\n\
10534 The value `kill-region' is special; it means that the previous command\n\
10535 was a kill command.");
10537 DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
10538 "Same as `last-command', but never altered by Lisp code.");
10540 DEFVAR_LISP ("this-command", &Vthis_command,
10541 "The command now being executed.\n\
10542 The command can set this variable; whatever is put here\n\
10543 will be in `last-command' during the following command.");
10544 Vthis_command = Qnil;
10546 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
10547 "*Number of input events between auto-saves.\n\
10548 Zero means disable autosaving due to number of characters typed.");
10549 auto_save_interval = 300;
10551 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
10552 "*Number of seconds idle time before auto-save.\n\
10553 Zero or nil means disable auto-saving due to idleness.\n\
10554 After auto-saving due to this many seconds of idle time,\n\
10555 Emacs also does a garbage collection if that seems to be warranted.");
10556 XSETFASTINT (Vauto_save_timeout, 30);
10558 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes,
10559 "*Nonzero means echo unfinished commands after this many seconds of pause.\n\
10560 The value may be integer or floating point.");
10561 Vecho_keystrokes = make_number (1);
10563 DEFVAR_INT ("polling-period", &polling_period,
10564 "*Interval between polling for input during Lisp execution.\n\
10565 The reason for polling is to make C-g work to stop a running program.\n\
10566 Polling is needed only when using X windows and SIGIO does not work.\n\
10567 Polling is automatically disabled in all other cases.");
10568 polling_period = 2;
10570 DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
10571 "*Maximum time between mouse clicks to make a double-click.\n\
10572 Measured in milliseconds. nil means disable double-click recognition;\n\
10573 t means double-clicks have no time limit and are detected\n\
10574 by position only.");
10575 Vdouble_click_time = make_number (500);
10577 DEFVAR_INT ("double-click-fuzz", &double_click_fuzz,
10578 "*Maximum mouse movement between clicks to make a double-click.\n\
10579 On window-system frames, value is the number of pixels the mouse may have\n\
10580 moved horizontally or vertically between two clicks to make a double-click.\n\
10581 On non window-system frames, value is interpreted in units of 1/8 characters\n\
10582 instead of pixels.");
10583 double_click_fuzz = 3;
10585 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
10586 "*Non-nil means inhibit local map menu bar menus.");
10587 inhibit_local_menu_bar_menus = 0;
10589 DEFVAR_INT ("num-input-keys", &num_input_keys,
10590 "Number of complete key sequences read as input so far.\n\
10591 This includes key sequences read from keyboard macros.\n\
10592 The number is effectively the number of interactive command invocations.");
10593 num_input_keys = 0;
10595 DEFVAR_INT ("num-nonmacro-input-events", &num_nonmacro_input_events,
10596 "Number of input events read from the keyboard so far.\n\
10597 This does not include events generated by keyboard macros.");
10598 num_nonmacro_input_events = 0;
10600 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
10601 "The frame in which the most recently read event occurred.\n\
10602 If the last event came from a keyboard macro, this is set to `macro'.");
10603 Vlast_event_frame = Qnil;
10605 /* This variable is set up in sysdep.c. */
10606 DEFVAR_LISP ("tty-erase-char", &Vtty_erase_char,
10607 "The ERASE character as set by the user with stty.");
10609 DEFVAR_LISP ("help-char", &Vhelp_char,
10610 "Character to recognize as meaning Help.\n\
10611 When it is read, do `(eval help-form)', and display result if it's a string.\n\
10612 If the value of `help-form' is nil, this char can be read normally.");
10613 XSETINT (Vhelp_char, Ctl ('H'));
10615 DEFVAR_LISP ("help-event-list", &Vhelp_event_list,
10616 "List of input events to recognize as meaning Help.\n\
10617 These work just like the value of `help-char' (see that).");
10618 Vhelp_event_list = Qnil;
10620 DEFVAR_LISP ("help-form", &Vhelp_form,
10621 "Form to execute when character `help-char' is read.\n\
10622 If the form returns a string, that string is displayed.\n\
10623 If `help-form' is nil, the help char is not recognized.");
10624 Vhelp_form = Qnil;
10626 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
10627 "Command to run when `help-char' character follows a prefix key.\n\
10628 This command is used only when there is no actual binding\n\
10629 for that character after that prefix key.");
10630 Vprefix_help_command = Qnil;
10632 DEFVAR_LISP ("top-level", &Vtop_level,
10633 "Form to evaluate when Emacs starts up.\n\
10634 Useful to set before you dump a modified Emacs.");
10635 Vtop_level = Qnil;
10637 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
10638 "Translate table for keyboard input, or nil.\n\
10639 Each character is looked up in this string and the contents used instead.\n\
10640 The value may be a string, a vector, or a char-table.\n\
10641 If it is a string or vector of length N,\n\
10642 character codes N and up are untranslated.\n\
10643 In a vector or a char-table, an element which is nil means \"no translation\".");
10644 Vkeyboard_translate_table = Qnil;
10646 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
10647 "Non-nil means to always spawn a subshell instead of suspending.\n\
10648 \(Even if the operating system has support for stopping a process.\)");
10649 cannot_suspend = 0;
10651 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
10652 "Non-nil means prompt with menus when appropriate.\n\
10653 This is done when reading from a keymap that has a prompt string,\n\
10654 for elements that have prompt strings.\n\
10655 The menu is displayed on the screen\n\
10656 if X menus were enabled at configuration\n\
10657 time and the previous event was a mouse click prefix key.\n\
10658 Otherwise, menu prompting uses the echo area.");
10659 menu_prompting = 1;
10661 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
10662 "Character to see next line of menu prompt.\n\
10663 Type this character while in a menu prompt to rotate around the lines of it.");
10664 XSETINT (menu_prompt_more_char, ' ');
10666 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
10667 "A mask of additional modifier keys to use with every keyboard character.\n\
10668 Emacs applies the modifiers of the character stored here to each keyboard\n\
10669 character it reads. For example, after evaluating the expression\n\
10670 (setq extra-keyboard-modifiers ?\\C-x)\n\
10671 all input characters will have the control modifier applied to them.\n\
10673 Note that the character ?\\C-@, equivalent to the integer zero, does\n\
10674 not count as a control character; rather, it counts as a character\n\
10675 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero\n\
10676 cancels any modification.");
10677 extra_keyboard_modifiers = 0;
10679 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
10680 "If an editing command sets this to t, deactivate the mark afterward.\n\
10681 The command loop sets this to nil before each command,\n\
10682 and tests the value when the command returns.\n\
10683 Buffer modification stores t in this variable.");
10684 Vdeactivate_mark = Qnil;
10686 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal,
10687 "Temporary storage of pre-command-hook or post-command-hook.");
10688 Vcommand_hook_internal = Qnil;
10690 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
10691 "Normal hook run before each command is executed.\n\
10692 If an unhandled error happens in running this hook,\n\
10693 the hook value is set to nil, since otherwise the error\n\
10694 might happen repeatedly and make Emacs nonfunctional.");
10695 Vpre_command_hook = Qnil;
10697 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
10698 "Normal hook run after each command is executed.\n\
10699 If an unhandled error happens in running this hook,\n\
10700 the hook value is set to nil, since otherwise the error\n\
10701 might happen repeatedly and make Emacs nonfunctional.");
10702 Vpost_command_hook = Qnil;
10704 DEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook,
10705 "Normal hook run after each command is executed, if idle.\n\
10706 Errors running the hook are caught and ignored.\n\
10707 This feature is obsolete; use idle timers instead. See `etc/NEWS'.");
10708 Vpost_command_idle_hook = Qnil;
10710 DEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay,
10711 "Delay time before running `post-command-idle-hook'.\n\
10712 This is measured in microseconds.");
10713 post_command_idle_delay = 100000;
10715 #if 0
10716 DEFVAR_LISP ("echo-area-clear-hook", ...,
10717 "Normal hook run when clearing the echo area.");
10718 #endif
10719 Qecho_area_clear_hook = intern ("echo-area-clear-hook");
10720 XSYMBOL (Qecho_area_clear_hook)->value = Qnil;
10722 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
10723 "t means menu bar, specified Lucid style, needs to be recomputed.");
10724 Vlucid_menu_bar_dirty_flag = Qnil;
10726 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
10727 "List of menu bar items to move to the end of the menu bar.\n\
10728 The elements of the list are event types that may have menu bar bindings.");
10729 Vmenu_bar_final_items = Qnil;
10731 DEFVAR_KBOARD ("overriding-terminal-local-map",
10732 Voverriding_terminal_local_map,
10733 "Per-terminal keymap that overrides all other local keymaps.\n\
10734 If this variable is non-nil, it is used as a keymap instead of the\n\
10735 buffer's local map, and the minor mode keymaps and text property keymaps.\n\
10736 This variable is intended to let commands such as `universal-argument'\n\
10737 set up a different keymap for reading the next command.");
10739 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map,
10740 "Keymap that overrides all other local keymaps.\n\
10741 If this variable is non-nil, it is used as a keymap instead of the\n\
10742 buffer's local map, and the minor mode keymaps and text property keymaps.");
10743 Voverriding_local_map = Qnil;
10745 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag,
10746 "Non-nil means `overriding-local-map' applies to the menu bar.\n\
10747 Otherwise, the menu bar continues to reflect the buffer's local map\n\
10748 and the minor mode maps regardless of `overriding-local-map'.");
10749 Voverriding_local_map_menu_flag = Qnil;
10751 DEFVAR_LISP ("special-event-map", &Vspecial_event_map,
10752 "Keymap defining bindings for special events to execute at low level.");
10753 Vspecial_event_map = Fcons (intern ("keymap"), Qnil);
10755 DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
10756 "*Non-nil means generate motion events for mouse motion.");
10758 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
10759 "Alist of system-specific X windows key symbols.\n\
10760 Each element should have the form (N . SYMBOL) where N is the\n\
10761 numeric keysym code (sans the \"system-specific\" bit 1<<28)\n\
10762 and SYMBOL is its name.");
10764 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list,
10765 "List of deferred actions to be performed at a later time.\n\
10766 The precise format isn't relevant here; we just check whether it is nil.");
10767 Vdeferred_action_list = Qnil;
10769 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function,
10770 "Function to call to handle deferred actions, after each command.\n\
10771 This function is called with no arguments after each command\n\
10772 whenever `deferred-action-list' is non-nil.");
10773 Vdeferred_action_function = Qnil;
10775 DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings,
10776 "*Non-nil means show the equivalent key-binding when M-x command has one.\n\
10777 The value can be a length of time to show the message for.\n\
10778 If the value is non-nil and not a number, we wait 2 seconds.");
10779 Vsuggest_key_bindings = Qt;
10781 DEFVAR_LISP ("timer-list", &Vtimer_list,
10782 "List of active absolute time timers in order of increasing time.");
10783 Vtimer_list = Qnil;
10785 DEFVAR_LISP ("timer-idle-list", &Vtimer_idle_list,
10786 "List of active idle-time timers in order of increasing time.");
10787 Vtimer_idle_list = Qnil;
10789 DEFVAR_LISP ("input-method-function", &Vinput_method_function,
10790 "If non-nil, the function that implements the current input method.\n\
10791 It's called with one argument, a printing character that was just read.\n\
10792 \(That means a character with code 040...0176.)\n\
10793 Typically this function uses `read-event' to read additional events.\n\
10794 When it does so, it should first bind `input-method-function' to nil\n\
10795 so it will not be called recursively.\n\
10797 The function should return a list of zero or more events\n\
10798 to be used as input. If it wants to put back some events\n\
10799 to be reconsidered, separately, by the input method,\n\
10800 it can add them to the beginning of `unread-command-events'.\n\
10802 The input method function can find in `input-method-previous-method'\n\
10803 the previous echo area message.\n\
10805 The input method function should refer to the variables\n\
10806 `input-method-use-echo-area' and `input-method-exit-on-first-char'\n\
10807 for guidance on what to do.");
10808 Vinput_method_function = Qnil;
10810 DEFVAR_LISP ("input-method-previous-message",
10811 &Vinput_method_previous_message,
10812 "When `input-method-function' is called, hold the previous echo area message.\n\
10813 This variable exists because `read-event' clears the echo area\n\
10814 before running the input method. It is nil if there was no message.");
10815 Vinput_method_previous_message = Qnil;
10817 DEFVAR_LISP ("show-help-function", &Vshow_help_function,
10818 "If non-nil, the function that implements the display of help.\n\
10819 It's called with one argument, the help string to display.");
10820 Vshow_help_function = Qnil;
10822 DEFVAR_LISP ("disable-point-adjustment", &Vdisable_point_adjustment,
10823 "If non-nil, suppress point adjustment after executing a command.\n\
10825 After a command is executed, if point is moved into a region that has\n\
10826 special properties (e.g. composition, display), we adjust point to\n\
10827 the boundary of the region. But, several special commands sets this\n\
10828 variable to non-nil, then we suppress the point adjustment.\n\
10830 This variable is set to nil before reading a command, and is checked\n\
10831 just after executing the command.");
10832 Vdisable_point_adjustment = Qnil;
10834 DEFVAR_LISP ("global-disable-point-adjustment",
10835 &Vglobal_disable_point_adjustment,
10836 "*If non-nil, always suppress point adjustment.\n\
10838 The default value is nil, in which case, point adjustment are\n\
10839 suppressed only after special commands that set\n\
10840 `disable-point-adjustment' (which see) to non-nil.");
10841 Vglobal_disable_point_adjustment = Qnil;
10843 DEFVAR_BOOL ("update-menu-bindings", &update_menu_bindings,
10844 "Non-nil means updating menu bindings is allowed.\n\
10845 A value of nil means menu bindings should not be updated.\n\
10846 Used during Emacs' startup.");
10847 update_menu_bindings = 1;
10849 DEFVAR_LISP ("minibuffer-message-timeout", &Vminibuffer_message_timeout,
10850 "*How long to display an echo-area message when the minibuffer is active.\n\
10851 If the value is not a number, such messages don't time out.");
10852 Vminibuffer_message_timeout = make_number (2);
10855 void
10856 keys_of_keyboard ()
10858 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
10859 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
10860 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
10861 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
10862 initial_define_key (meta_map, 'x', "execute-extended-command");
10864 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
10865 "handle-delete-frame");
10866 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
10867 "ignore-event");
10868 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
10869 "ignore-event");