(Fread_key_sequence): Don't start the busy cursor
[emacs.git] / src / keyboard.c
blobb23e08959e4a3f560cc73641067605b099aae3ea
1 /* Keyboard and mouse input; editor command loop.
2 Copyright (C) 1985,86,87,88,89,93,94,95,96,97,99, 2000
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 256
107 #endif /* No X-windows */
109 /* Following definition copied from eval.c */
111 struct backtrace
113 struct backtrace *next;
114 Lisp_Object *function;
115 Lisp_Object *args; /* Points to vector of args. */
116 int nargs; /* length of vector. If nargs is UNEVALLED,
117 args points to slot holding list of
118 unevalled args */
119 char evalargs;
122 #ifdef MULTI_KBOARD
123 KBOARD *initial_kboard;
124 KBOARD *current_kboard;
125 KBOARD *all_kboards;
126 int single_kboard;
127 #else
128 KBOARD the_only_kboard;
129 #endif
131 /* Non-nil disable property on a command means
132 do not execute it; call disabled-command-hook's value instead. */
133 Lisp_Object Qdisabled, Qdisabled_command_hook;
135 #define NUM_RECENT_KEYS (100)
136 int recent_keys_index; /* Index for storing next element into recent_keys */
137 int total_keys; /* Total number of elements stored into recent_keys */
138 Lisp_Object recent_keys; /* A vector, holding the last 100 keystrokes */
140 /* Vector holding the key sequence that invoked the current command.
141 It is reused for each command, and it may be longer than the current
142 sequence; this_command_key_count indicates how many elements
143 actually mean something.
144 It's easier to staticpro a single Lisp_Object than an array. */
145 Lisp_Object this_command_keys;
146 int this_command_key_count;
148 /* This vector is used as a buffer to record the events that were actually read
149 by read_key_sequence. */
150 Lisp_Object raw_keybuf;
151 int raw_keybuf_count;
153 #define GROW_RAW_KEYBUF \
154 if (raw_keybuf_count == XVECTOR (raw_keybuf)->size) \
156 int newsize = 2 * XVECTOR (raw_keybuf)->size; \
157 Lisp_Object new; \
158 new = Fmake_vector (make_number (newsize), Qnil); \
159 bcopy (XVECTOR (raw_keybuf)->contents, XVECTOR (new)->contents, \
160 raw_keybuf_count * sizeof (Lisp_Object)); \
161 raw_keybuf = new; \
164 /* Number of elements of this_command_keys
165 that precede this key sequence. */
166 int this_single_command_key_start;
168 /* Record values of this_command_key_count and echo_length ()
169 before this command was read. */
170 static int before_command_key_count;
171 static int before_command_echo_length;
172 /* Values of before_command_key_count and before_command_echo_length
173 saved by reset-this-command-lengths. */
174 static int before_command_key_count_1;
175 static int before_command_echo_length_1;
176 /* Flag set by reset-this-command-lengths,
177 saying to reset the lengths when add_command_key is called. */
178 static int before_command_restore_flag;
180 extern int minbuf_level;
182 extern int message_enable_multibyte;
184 extern struct backtrace *backtrace_list;
186 /* If non-nil, the function that implements the display of help.
187 It's called with one argument, the help string to display. */
189 Lisp_Object Vshow_help_function;
191 /* Nonzero means do menu prompting. */
192 static int menu_prompting;
194 /* Character to see next line of menu prompt. */
195 static Lisp_Object menu_prompt_more_char;
197 /* For longjmp to where kbd input is being done. */
198 static jmp_buf getcjmp;
200 /* True while doing kbd input. */
201 int waiting_for_input;
203 /* True while displaying for echoing. Delays C-g throwing. */
205 static int echoing;
207 /* Non-null means we can start echoing at the next input pause even
208 though there is something in the echo area. */
210 static struct kboard *ok_to_echo_at_next_pause;
212 /* The kboard last echoing, or null for none. Reset to 0 in
213 cancel_echoing. If non-null, and a current echo area message
214 exists, and echo_message_buffer is eq to the current message
215 buffer, we know that the message comes from echo_kboard. */
217 static struct kboard *echo_kboard;
219 /* The buffer used for echoing. Set in echo_now, reset in
220 cancel_echoing. */
222 static Lisp_Object echo_message_buffer;
224 /* Nonzero means disregard local maps for the menu bar. */
225 static int inhibit_local_menu_bar_menus;
227 /* Nonzero means C-g should cause immediate error-signal. */
228 int immediate_quit;
230 /* The user's ERASE setting. */
231 Lisp_Object Vtty_erase_char;
233 /* Character to recognize as the help char. */
234 Lisp_Object Vhelp_char;
236 /* List of other event types to recognize as meaning "help". */
237 Lisp_Object Vhelp_event_list;
239 /* Form to execute when help char is typed. */
240 Lisp_Object Vhelp_form;
242 /* Command to run when the help character follows a prefix key. */
243 Lisp_Object Vprefix_help_command;
245 /* List of items that should move to the end of the menu bar. */
246 Lisp_Object Vmenu_bar_final_items;
248 /* Non-nil means show the equivalent key-binding for
249 any M-x command that has one.
250 The value can be a length of time to show the message for.
251 If the value is non-nil and not a number, we wait 2 seconds. */
252 Lisp_Object Vsuggest_key_bindings;
254 /* How long to display an echo-area message when the minibuffer is active.
255 If the value is not a number, such messages don't time out. */
256 Lisp_Object Vminibuffer_message_timeout;
258 /* Character that causes a quit. Normally C-g.
260 If we are running on an ordinary terminal, this must be an ordinary
261 ASCII char, since we want to make it our interrupt character.
263 If we are not running on an ordinary terminal, it still needs to be
264 an ordinary ASCII char. This character needs to be recognized in
265 the input interrupt handler. At this point, the keystroke is
266 represented as a struct input_event, while the desired quit
267 character is specified as a lispy event. The mapping from struct
268 input_events to lispy events cannot run in an interrupt handler,
269 and the reverse mapping is difficult for anything but ASCII
270 keystrokes.
272 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
273 ASCII character. */
274 int quit_char;
276 extern Lisp_Object current_global_map;
277 extern int minibuf_level;
279 /* If non-nil, this is a map that overrides all other local maps. */
280 Lisp_Object Voverriding_local_map;
282 /* If non-nil, Voverriding_local_map applies to the menu bar. */
283 Lisp_Object Voverriding_local_map_menu_flag;
285 /* Keymap that defines special misc events that should
286 be processed immediately at a low level. */
287 Lisp_Object Vspecial_event_map;
289 /* Current depth in recursive edits. */
290 int command_loop_level;
292 /* Total number of times command_loop has read a key sequence. */
293 int num_input_keys;
295 /* Last input character read as a command. */
296 Lisp_Object last_command_char;
298 /* Last input character read as a command, not counting menus
299 reached by the mouse. */
300 Lisp_Object last_nonmenu_event;
302 /* Last input character read for any purpose. */
303 Lisp_Object last_input_char;
305 /* If not Qnil, a list of objects to be read as subsequent command input. */
306 Lisp_Object Vunread_command_events;
308 /* If not Qnil, a list of objects to be read as subsequent command input
309 including input method processing. */
310 Lisp_Object Vunread_input_method_events;
312 /* If not Qnil, a list of objects to be read as subsequent command input
313 but NOT including input method processing. */
314 Lisp_Object Vunread_post_input_method_events;
316 /* If not -1, an event to be read as subsequent command input. */
317 int unread_command_char;
319 /* If not Qnil, this is a switch-frame event which we decided to put
320 off until the end of a key sequence. This should be read as the
321 next command input, after any unread_command_events.
323 read_key_sequence uses this to delay switch-frame events until the
324 end of the key sequence; Fread_char uses it to put off switch-frame
325 events until a non-ASCII event is acceptable as input. */
326 Lisp_Object unread_switch_frame;
328 /* A mask of extra modifier bits to put into every keyboard char. */
329 int extra_keyboard_modifiers;
331 /* Char to use as prefix when a meta character is typed in.
332 This is bound on entry to minibuffer in case ESC is changed there. */
334 Lisp_Object meta_prefix_char;
336 /* Last size recorded for a current buffer which is not a minibuffer. */
337 static int last_non_minibuf_size;
339 /* Number of idle seconds before an auto-save and garbage collection. */
340 static Lisp_Object Vauto_save_timeout;
342 /* Total number of times read_char has returned. */
343 int num_input_events;
345 /* Total number of times read_char has returned, outside of macros. */
346 int num_nonmacro_input_events;
348 /* Auto-save automatically when this many characters have been typed
349 since the last time. */
351 static int auto_save_interval;
353 /* Value of num_nonmacro_input_events as of last auto save. */
355 int last_auto_save;
357 /* The command being executed by the command loop.
358 Commands may set this, and the value set will be copied into
359 current_kboard->Vlast_command instead of the actual command. */
360 Lisp_Object Vthis_command;
362 /* This is like Vthis_command, except that commands never set it. */
363 Lisp_Object real_this_command;
365 /* The value of point when the last command was executed. */
366 int last_point_position;
368 /* The buffer that was current when the last command was started. */
369 Lisp_Object last_point_position_buffer;
371 /* The frame in which the last input event occurred, or Qmacro if the
372 last event came from a macro. We use this to determine when to
373 generate switch-frame events. This may be cleared by functions
374 like Fselect_frame, to make sure that a switch-frame event is
375 generated by the next character. */
376 Lisp_Object internal_last_event_frame;
378 /* A user-visible version of the above, intended to allow users to
379 figure out where the last event came from, if the event doesn't
380 carry that information itself (i.e. if it was a character). */
381 Lisp_Object Vlast_event_frame;
383 /* The timestamp of the last input event we received from the X server.
384 X Windows wants this for selection ownership. */
385 unsigned long last_event_timestamp;
387 Lisp_Object Qself_insert_command;
388 Lisp_Object Qforward_char;
389 Lisp_Object Qbackward_char;
390 Lisp_Object Qundefined;
391 Lisp_Object Qtimer_event_handler;
393 /* read_key_sequence stores here the command definition of the
394 key sequence that it reads. */
395 Lisp_Object read_key_sequence_cmd;
397 /* Echo unfinished commands after this many seconds of pause. */
398 Lisp_Object Vecho_keystrokes;
400 /* Form to evaluate (if non-nil) when Emacs is started. */
401 Lisp_Object Vtop_level;
403 /* User-supplied string to translate input characters through. */
404 Lisp_Object Vkeyboard_translate_table;
406 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
407 extern Lisp_Object Vfunction_key_map;
409 /* Another keymap that maps key sequences into key sequences.
410 This one takes precedence over ordinary definitions. */
411 extern Lisp_Object Vkey_translation_map;
413 /* If non-nil, this implements the current input method. */
414 Lisp_Object Vinput_method_function;
415 Lisp_Object Qinput_method_function;
417 /* When we call Vinput_method_function,
418 this holds the echo area message that was just erased. */
419 Lisp_Object Vinput_method_previous_message;
421 /* Non-nil means deactivate the mark at end of this command. */
422 Lisp_Object Vdeactivate_mark;
424 /* Menu bar specified in Lucid Emacs fashion. */
426 Lisp_Object Vlucid_menu_bar_dirty_flag;
427 Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
429 Lisp_Object Qecho_area_clear_hook;
431 /* Hooks to run before and after each command. */
432 Lisp_Object Qpre_command_hook, Vpre_command_hook;
433 Lisp_Object Qpost_command_hook, Vpost_command_hook;
434 Lisp_Object Qcommand_hook_internal, Vcommand_hook_internal;
435 /* Hook run after a command if there's no more input soon. */
436 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
438 /* Delay time in microseconds before running post-command-idle-hook. */
439 int post_command_idle_delay;
441 /* List of deferred actions to be performed at a later time.
442 The precise format isn't relevant here; we just check whether it is nil. */
443 Lisp_Object Vdeferred_action_list;
445 /* Function to call to handle deferred actions, when there are any. */
446 Lisp_Object Vdeferred_action_function;
447 Lisp_Object Qdeferred_action_function;
449 Lisp_Object Qinput_method_exit_on_first_char;
450 Lisp_Object Qinput_method_use_echo_area;
452 /* File in which we write all commands we read. */
453 FILE *dribble;
455 /* Nonzero if input is available. */
456 int input_pending;
458 /* 1 if should obey 0200 bit in input chars as "Meta", 2 if should
459 keep 0200 bit in input chars. 0 to ignore the 0200 bit. */
461 int meta_key;
463 /* Non-zero means force key bindings update in parse_menu_item. */
465 int update_menu_bindings;
467 extern char *pending_malloc_warning;
469 /* Circular buffer for pre-read keyboard input. */
471 static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
473 /* Vector to GCPRO the Lisp objects referenced from kbd_buffer.
475 The interrupt-level event handlers will never enqueue an event on a
476 frame which is not in Vframe_list, and once an event is dequeued,
477 internal_last_event_frame or the event itself points to the frame.
478 So that's all fine.
480 But while the event is sitting in the queue, it's completely
481 unprotected. Suppose the user types one command which will run for
482 a while and then delete a frame, and then types another event at
483 the frame that will be deleted, before the command gets around to
484 it. Suppose there are no references to this frame elsewhere in
485 Emacs, and a GC occurs before the second event is dequeued. Now we
486 have an event referring to a freed frame, which will crash Emacs
487 when it is dequeued.
489 Similar things happen when an event on a scroll bar is enqueued; the
490 window may be deleted while the event is in the queue.
492 So, we use this vector to protect the Lisp_Objects in the event
493 queue. That way, they'll be dequeued as dead frames or windows,
494 but still valid Lisp objects.
496 If kbd_buffer[i].kind != no_event, then
498 AREF (kbd_buffer_gcpro, 2 * i) == kbd_buffer[i].frame_or_window.
499 AREF (kbd_buffer_gcpro, 2 * i + 1) == kbd_buffer[i].arg. */
501 static Lisp_Object kbd_buffer_gcpro;
503 /* Pointer to next available character in kbd_buffer.
504 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
505 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the the
506 next available char is in kbd_buffer[0]. */
507 static struct input_event *kbd_fetch_ptr;
509 /* Pointer to next place to store character in kbd_buffer. This
510 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
511 character should go in kbd_buffer[0]. */
512 static struct input_event * volatile kbd_store_ptr;
514 /* The above pair of variables forms a "queue empty" flag. When we
515 enqueue a non-hook event, we increment kbd_store_ptr. When we
516 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
517 there is input available iff the two pointers are not equal.
519 Why not just have a flag set and cleared by the enqueuing and
520 dequeuing functions? Such a flag could be screwed up by interrupts
521 at inopportune times. */
523 /* If this flag is non-nil, we check mouse_moved to see when the
524 mouse moves, and motion events will appear in the input stream.
525 Otherwise, mouse motion is ignored. */
526 static Lisp_Object do_mouse_tracking;
528 /* Symbols to head events. */
529 Lisp_Object Qmouse_movement;
530 Lisp_Object Qscroll_bar_movement;
531 Lisp_Object Qswitch_frame;
532 Lisp_Object Qdelete_frame;
533 Lisp_Object Qiconify_frame;
534 Lisp_Object Qmake_frame_visible;
535 Lisp_Object Qhelp_echo;
537 /* Symbols to denote kinds of events. */
538 Lisp_Object Qfunction_key;
539 Lisp_Object Qmouse_click;
540 #ifdef WINDOWSNT
541 Lisp_Object Qmouse_wheel;
542 Lisp_Object Qlanguage_change;
543 #endif
544 Lisp_Object Qdrag_n_drop;
545 /* Lisp_Object Qmouse_movement; - also an event header */
547 /* Properties of event headers. */
548 Lisp_Object Qevent_kind;
549 Lisp_Object Qevent_symbol_elements;
551 /* menu item parts */
552 Lisp_Object Qmenu_alias;
553 Lisp_Object Qmenu_enable;
554 Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCkeys, QCkey_sequence;
555 Lisp_Object QCbutton, QCtoggle, QCradio;
556 extern Lisp_Object Vdefine_key_rebound_commands;
557 extern Lisp_Object Qmenu_item;
559 /* An event header symbol HEAD may have a property named
560 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
561 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
562 mask of modifiers applied to it. If present, this is used to help
563 speed up parse_modifiers. */
564 Lisp_Object Qevent_symbol_element_mask;
566 /* An unmodified event header BASE may have a property named
567 Qmodifier_cache, which is an alist mapping modifier masks onto
568 modified versions of BASE. If present, this helps speed up
569 apply_modifiers. */
570 Lisp_Object Qmodifier_cache;
572 /* Symbols to use for parts of windows. */
573 Lisp_Object Qmode_line;
574 Lisp_Object Qvertical_line;
575 Lisp_Object Qvertical_scroll_bar;
576 Lisp_Object Qmenu_bar;
578 Lisp_Object recursive_edit_unwind (), command_loop ();
579 Lisp_Object Fthis_command_keys ();
580 Lisp_Object Qextended_command_history;
581 EMACS_TIME timer_check ();
583 extern Lisp_Object Vhistory_length;
585 extern char *x_get_keysym_name ();
587 static void record_menu_key ();
589 Lisp_Object Qpolling_period;
591 /* List of absolute timers. Appears in order of next scheduled event. */
592 Lisp_Object Vtimer_list;
594 /* List of idle time timers. Appears in order of next scheduled event. */
595 Lisp_Object Vtimer_idle_list;
597 /* Incremented whenever a timer is run. */
598 int timers_run;
600 extern Lisp_Object Vprint_level, Vprint_length;
602 /* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
603 happens. */
604 EMACS_TIME *input_available_clear_time;
606 /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
607 Default is 1 if INTERRUPT_INPUT is defined. */
608 int interrupt_input;
610 /* Nonzero while interrupts are temporarily deferred during redisplay. */
611 int interrupts_deferred;
613 /* Nonzero means use ^S/^Q for flow control. */
614 int flow_control;
616 /* Allow m- file to inhibit use of FIONREAD. */
617 #ifdef BROKEN_FIONREAD
618 #undef FIONREAD
619 #endif
621 /* We are unable to use interrupts if FIONREAD is not available,
622 so flush SIGIO so we won't try. */
623 #ifndef FIONREAD
624 #ifdef SIGIO
625 #undef SIGIO
626 #endif
627 #endif
629 /* If we support a window system, turn on the code to poll periodically
630 to detect C-g. It isn't actually used when doing interrupt input. */
631 #ifdef HAVE_WINDOW_SYSTEM
632 #define POLL_FOR_INPUT
633 #endif
635 /* After a command is executed, if point is moved into a region that
636 has specific properties (e.g. composition, display), we adjust
637 point to the boundary of the region. But, if a command sets this
638 valiable to non-nil, we suppress this point adjustment. This
639 variable is set to nil before reading a command. */
641 Lisp_Object Vdisable_point_adjustment;
643 /* If non-nil, always disable point adjustment. */
645 Lisp_Object Vglobal_disable_point_adjustment;
648 /* Global variable declarations. */
650 /* Function for init_keyboard to call with no args (if nonzero). */
651 void (*keyboard_init_hook) ();
653 static int read_avail_input P_ ((int));
654 static void get_input_pending P_ ((int *, int));
655 static int readable_events P_ ((int));
656 static Lisp_Object read_char_x_menu_prompt P_ ((int, Lisp_Object *,
657 Lisp_Object, int *));
658 static Lisp_Object read_char_x_menu_prompt ();
659 static Lisp_Object read_char_minibuf_menu_prompt P_ ((int, int,
660 Lisp_Object *));
661 static Lisp_Object make_lispy_event P_ ((struct input_event *));
662 #ifdef HAVE_MOUSE
663 static Lisp_Object make_lispy_movement P_ ((struct frame *, Lisp_Object,
664 enum scroll_bar_part,
665 Lisp_Object, Lisp_Object,
666 unsigned long));
667 #endif
668 static Lisp_Object modify_event_symbol P_ ((int, unsigned, Lisp_Object,
669 Lisp_Object, char **,
670 Lisp_Object *, unsigned));
671 static Lisp_Object make_lispy_switch_frame P_ ((Lisp_Object));
672 static int parse_solitary_modifier P_ ((Lisp_Object));
673 static int parse_solitary_modifier ();
674 static void save_getcjmp P_ ((jmp_buf));
675 static void save_getcjmp ();
676 static void restore_getcjmp P_ ((jmp_buf));
677 static Lisp_Object apply_modifiers P_ ((int, Lisp_Object));
678 static void clear_event P_ ((struct input_event *));
680 /* Nonzero means don't try to suspend even if the operating system seems
681 to support it. */
682 static int cannot_suspend;
684 #define min(a,b) ((a)<(b)?(a):(b))
685 #define max(a,b) ((a)>(b)?(a):(b))
687 /* Install the string STR as the beginning of the string of echoing,
688 so that it serves as a prompt for the next character.
689 Also start echoing. */
691 void
692 echo_prompt (str)
693 char *str;
695 int len = strlen (str);
697 if (len > ECHOBUFSIZE - 4)
698 len = ECHOBUFSIZE - 4;
699 bcopy (str, current_kboard->echobuf, len);
700 current_kboard->echoptr = current_kboard->echobuf + len;
701 *current_kboard->echoptr = '\0';
703 current_kboard->echo_after_prompt = len;
705 echo_now ();
708 /* Add C to the echo string, if echoing is going on.
709 C can be a character, which is printed prettily ("M-C-x" and all that
710 jazz), or a symbol, whose name is printed. */
712 void
713 echo_char (c)
714 Lisp_Object c;
716 extern char *push_key_description ();
718 if (current_kboard->immediate_echo)
720 char *ptr = current_kboard->echoptr;
722 if (ptr != current_kboard->echobuf)
723 *ptr++ = ' ';
725 /* If someone has passed us a composite event, use its head symbol. */
726 c = EVENT_HEAD (c);
728 if (INTEGERP (c))
730 if (ptr - current_kboard->echobuf
731 > ECHOBUFSIZE - KEY_DESCRIPTION_SIZE)
732 return;
734 ptr = push_key_description (XINT (c), ptr);
736 else if (SYMBOLP (c))
738 struct Lisp_String *name = XSYMBOL (c)->name;
739 if ((ptr - current_kboard->echobuf) + STRING_BYTES (name) + 4
740 > ECHOBUFSIZE)
741 return;
742 bcopy (name->data, ptr, STRING_BYTES (name));
743 ptr += STRING_BYTES (name);
746 if (current_kboard->echoptr == current_kboard->echobuf
747 && help_char_p (c))
749 strcpy (ptr, " (Type ? for further options)");
750 ptr += strlen (ptr);
753 *ptr = 0;
754 current_kboard->echoptr = ptr;
756 echo_now ();
760 /* Temporarily add a dash to the end of the echo string if it's not
761 empty, so that it serves as a mini-prompt for the very next character. */
763 void
764 echo_dash ()
766 if (!current_kboard->immediate_echo
767 && current_kboard->echoptr == current_kboard->echobuf)
768 return;
769 /* Do nothing if we just printed a prompt. */
770 if (current_kboard->echo_after_prompt
771 == current_kboard->echoptr - current_kboard->echobuf)
772 return;
773 /* Do nothing if not echoing at all. */
774 if (current_kboard->echoptr == 0)
775 return;
777 /* Put a dash at the end of the buffer temporarily,
778 but make it go away when the next character is added. */
779 current_kboard->echoptr[0] = '-';
780 current_kboard->echoptr[1] = 0;
782 echo_now ();
785 /* Display the current echo string, and begin echoing if not already
786 doing so. */
788 void
789 echo_now ()
791 if (!current_kboard->immediate_echo)
793 int i;
794 current_kboard->immediate_echo = 1;
796 for (i = 0; i < this_command_key_count; i++)
798 Lisp_Object c;
799 c = XVECTOR (this_command_keys)->contents[i];
800 if (! (EVENT_HAS_PARAMETERS (c)
801 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
802 echo_char (c);
804 echo_dash ();
807 echoing = 1;
808 message2_nolog (current_kboard->echobuf, strlen (current_kboard->echobuf),
809 ! NILP (current_buffer->enable_multibyte_characters));
810 echoing = 0;
812 /* Record in what buffer we echoed, and from which kboard. */
813 echo_message_buffer = echo_area_buffer[0];
814 echo_kboard = current_kboard;
816 if (waiting_for_input && !NILP (Vquit_flag))
817 quit_throw_to_read_char ();
820 /* Turn off echoing, for the start of a new command. */
822 void
823 cancel_echoing ()
825 current_kboard->immediate_echo = 0;
826 current_kboard->echoptr = current_kboard->echobuf;
827 current_kboard->echo_after_prompt = -1;
828 ok_to_echo_at_next_pause = NULL;
829 echo_kboard = NULL;
830 echo_message_buffer = Qnil;
833 /* Return the length of the current echo string. */
835 static int
836 echo_length ()
838 return current_kboard->echoptr - current_kboard->echobuf;
841 /* Truncate the current echo message to its first LEN chars.
842 This and echo_char get used by read_key_sequence when the user
843 switches frames while entering a key sequence. */
845 static void
846 echo_truncate (len)
847 int len;
849 current_kboard->echobuf[len] = '\0';
850 current_kboard->echoptr = current_kboard->echobuf + len;
851 truncate_echo_area (len);
855 /* Functions for manipulating this_command_keys. */
856 static void
857 add_command_key (key)
858 Lisp_Object key;
860 int size = XVECTOR (this_command_keys)->size;
862 /* If reset-this-command-length was called recently, obey it now.
863 See the doc string of that function for an explanation of why. */
864 if (before_command_restore_flag)
866 this_command_key_count = before_command_key_count_1;
867 if (this_command_key_count < this_single_command_key_start)
868 this_single_command_key_start = this_command_key_count;
869 echo_truncate (before_command_echo_length_1);
870 before_command_restore_flag = 0;
873 if (this_command_key_count >= size)
875 Lisp_Object new_keys;
877 new_keys = Fmake_vector (make_number (size * 2), Qnil);
878 bcopy (XVECTOR (this_command_keys)->contents,
879 XVECTOR (new_keys)->contents,
880 size * sizeof (Lisp_Object));
882 this_command_keys = new_keys;
885 XVECTOR (this_command_keys)->contents[this_command_key_count++] = key;
888 Lisp_Object
889 recursive_edit_1 ()
891 int count = specpdl_ptr - specpdl;
892 Lisp_Object val;
894 if (command_loop_level > 0)
896 specbind (Qstandard_output, Qt);
897 specbind (Qstandard_input, Qt);
900 #ifdef HAVE_X_WINDOWS
901 /* The command loop has started a busy-cursor timer, so we have to
902 cancel it here, otherwise it will fire because the recursive edit
903 can take some time. */
904 if (display_busy_cursor_p)
905 cancel_busy_cursor ();
906 #endif
908 val = command_loop ();
909 if (EQ (val, Qt))
910 Fsignal (Qquit, Qnil);
911 /* Handle throw from read_minibuf when using minibuffer
912 while it's active but we're in another window. */
913 if (STRINGP (val))
914 Fsignal (Qerror, Fcons (val, Qnil));
916 return unbind_to (count, Qnil);
919 /* When an auto-save happens, record the "time", and don't do again soon. */
921 void
922 record_auto_save ()
924 last_auto_save = num_nonmacro_input_events;
927 /* Make an auto save happen as soon as possible at command level. */
929 void
930 force_auto_save_soon ()
932 last_auto_save = - auto_save_interval - 1;
934 record_asynch_buffer_change ();
937 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
938 "Invoke the editor command loop recursively.\n\
939 To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
940 that tells this function to return.\n\
941 Alternately, `(throw 'exit t)' makes this function signal an error.\n\
942 This function is called by the editor initialization to begin editing.")
945 int count = specpdl_ptr - specpdl;
947 command_loop_level++;
948 update_mode_lines = 1;
950 /* This function may have been called from a debugger called from
951 within redisplay, for instance by Edebugging a function called
952 from fontification-functions. We want to allow redisplay in
953 the debugging session.
955 The recursive edit is left with a `(throw exit ...)'. The `exit'
956 tag is not caught anywhere in redisplay, i.e. when we leave the
957 recursive edit, the original redisplay leading to the recursive
958 edit will be unwound. The outcome should therefore be safe. */
959 specbind (Qinhibit_redisplay, Qnil);
960 redisplaying_p = 0;
962 record_unwind_protect (recursive_edit_unwind,
963 (command_loop_level
964 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
965 ? Fcurrent_buffer ()
966 : Qnil);
967 recursive_edit_1 ();
968 return unbind_to (count, Qnil);
971 Lisp_Object
972 recursive_edit_unwind (buffer)
973 Lisp_Object buffer;
975 if (!NILP (buffer))
976 Fset_buffer (buffer);
978 command_loop_level--;
979 update_mode_lines = 1;
980 return Qnil;
983 static void
984 any_kboard_state ()
986 #ifdef MULTI_KBOARD
987 #if 0 /* Theory: if there's anything in Vunread_command_events,
988 it will right away be read by read_key_sequence,
989 and then if we do switch KBOARDS, it will go into the side
990 queue then. So we don't need to do anything special here -- rms. */
991 if (CONSP (Vunread_command_events))
993 current_kboard->kbd_queue
994 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
995 current_kboard->kbd_queue_has_data = 1;
997 Vunread_command_events = Qnil;
998 #endif
999 single_kboard = 0;
1000 #endif
1003 /* Switch to the single-kboard state, making current_kboard
1004 the only KBOARD from which further input is accepted. */
1006 void
1007 single_kboard_state ()
1009 #ifdef MULTI_KBOARD
1010 single_kboard = 1;
1011 #endif
1014 /* Maintain a stack of kboards, so other parts of Emacs
1015 can switch temporarily to the kboard of a given frame
1016 and then revert to the previous status. */
1018 struct kboard_stack
1020 KBOARD *kboard;
1021 struct kboard_stack *next;
1024 static struct kboard_stack *kboard_stack;
1026 void
1027 push_frame_kboard (f)
1028 FRAME_PTR f;
1030 #ifdef MULTI_KBOARD
1031 struct kboard_stack *p
1032 = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
1034 p->next = kboard_stack;
1035 p->kboard = current_kboard;
1036 kboard_stack = p;
1038 current_kboard = FRAME_KBOARD (f);
1039 #endif
1042 void
1043 pop_frame_kboard ()
1045 #ifdef MULTI_KBOARD
1046 struct kboard_stack *p = kboard_stack;
1047 current_kboard = p->kboard;
1048 kboard_stack = p->next;
1049 xfree (p);
1050 #endif
1053 /* Handle errors that are not handled at inner levels
1054 by printing an error message and returning to the editor command loop. */
1056 Lisp_Object
1057 cmd_error (data)
1058 Lisp_Object data;
1060 Lisp_Object old_level, old_length;
1061 char macroerror[50];
1063 if (!NILP (executing_macro))
1065 if (executing_macro_iterations == 1)
1066 sprintf (macroerror, "After 1 kbd macro iteration: ");
1067 else
1068 sprintf (macroerror, "After %d kbd macro iterations: ",
1069 executing_macro_iterations);
1071 else
1072 *macroerror = 0;
1074 Vstandard_output = Qt;
1075 Vstandard_input = Qt;
1076 Vexecuting_macro = Qnil;
1077 executing_macro = Qnil;
1078 current_kboard->Vprefix_arg = Qnil;
1079 current_kboard->Vlast_prefix_arg = Qnil;
1080 cancel_echoing ();
1082 /* Avoid unquittable loop if data contains a circular list. */
1083 old_level = Vprint_level;
1084 old_length = Vprint_length;
1085 XSETFASTINT (Vprint_level, 10);
1086 XSETFASTINT (Vprint_length, 10);
1087 cmd_error_internal (data, macroerror);
1088 Vprint_level = old_level;
1089 Vprint_length = old_length;
1091 Vquit_flag = Qnil;
1093 Vinhibit_quit = Qnil;
1094 #ifdef MULTI_KBOARD
1095 any_kboard_state ();
1096 #endif
1098 return make_number (0);
1101 /* Take actions on handling an error. DATA is the data that describes
1102 the error.
1104 CONTEXT is a C-string containing ASCII characters only which
1105 describes the context in which the error happened. If we need to
1106 generalize CONTEXT to allow multibyte characters, make it a Lisp
1107 string. */
1109 void
1110 cmd_error_internal (data, context)
1111 Lisp_Object data;
1112 char *context;
1114 Lisp_Object stream;
1115 int kill_emacs_p = 0;
1116 struct frame *sf = SELECTED_FRAME ();
1118 Vquit_flag = Qnil;
1119 Vinhibit_quit = Qt;
1120 clear_message (1, 0);
1122 /* If the window system or terminal frame hasn't been initialized
1123 yet, or we're not interactive, it's best to dump this message out
1124 to stderr and exit. */
1125 if (!sf->glyphs_initialized_p
1126 /* This is the case of the frame dumped with Emacs, when we're
1127 running under a window system. */
1128 || (!NILP (Vwindow_system)
1129 && !inhibit_window_system
1130 && FRAME_TERMCAP_P (sf))
1131 || noninteractive)
1133 stream = Qexternal_debugging_output;
1134 kill_emacs_p = 1;
1136 else
1138 Fdiscard_input ();
1139 bitch_at_user ();
1140 stream = Qt;
1143 if (context != 0)
1144 write_string_1 (context, -1, stream);
1146 print_error_message (data, stream);
1148 /* If the window system or terminal frame hasn't been initialized
1149 yet, or we're in -batch mode, this error should cause Emacs to exit. */
1150 if (kill_emacs_p)
1152 Fterpri (stream);
1153 Fkill_emacs (make_number (-1));
1157 Lisp_Object command_loop_1 ();
1158 Lisp_Object command_loop_2 ();
1159 Lisp_Object top_level_1 ();
1161 /* Entry to editor-command-loop.
1162 This level has the catches for exiting/returning to editor command loop.
1163 It returns nil to exit recursive edit, t to abort it. */
1165 Lisp_Object
1166 command_loop ()
1168 if (command_loop_level > 0 || minibuf_level > 0)
1170 Lisp_Object val;
1171 val = internal_catch (Qexit, command_loop_2, Qnil);
1172 executing_macro = Qnil;
1173 return val;
1175 else
1176 while (1)
1178 internal_catch (Qtop_level, top_level_1, Qnil);
1179 internal_catch (Qtop_level, command_loop_2, Qnil);
1180 executing_macro = Qnil;
1182 /* End of file in -batch run causes exit here. */
1183 if (noninteractive)
1184 Fkill_emacs (Qt);
1188 /* Here we catch errors in execution of commands within the
1189 editing loop, and reenter the editing loop.
1190 When there is an error, cmd_error runs and returns a non-nil
1191 value to us. A value of nil means that cmd_loop_1 itself
1192 returned due to end of file (or end of kbd macro). */
1194 Lisp_Object
1195 command_loop_2 ()
1197 register Lisp_Object val;
1200 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1201 while (!NILP (val));
1203 return Qnil;
1206 Lisp_Object
1207 top_level_2 ()
1209 return Feval (Vtop_level);
1212 Lisp_Object
1213 top_level_1 ()
1215 /* On entry to the outer level, run the startup file */
1216 if (!NILP (Vtop_level))
1217 internal_condition_case (top_level_2, Qerror, cmd_error);
1218 else if (!NILP (Vpurify_flag))
1219 message ("Bare impure Emacs (standard Lisp code not loaded)");
1220 else
1221 message ("Bare Emacs (standard Lisp code not loaded)");
1222 return Qnil;
1225 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1226 "Exit all recursive editing levels.")
1229 #ifdef HAVE_X_WINDOWS
1230 if (display_busy_cursor_p)
1231 cancel_busy_cursor ();
1232 #endif
1233 return Fthrow (Qtop_level, Qnil);
1236 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1237 "Exit from the innermost recursive edit or minibuffer.")
1240 if (command_loop_level > 0 || minibuf_level > 0)
1241 Fthrow (Qexit, Qnil);
1243 error ("No recursive edit is in progress");
1244 return Qnil;
1247 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1248 "Abort the command that requested this recursive edit or minibuffer input.")
1251 if (command_loop_level > 0 || minibuf_level > 0)
1252 Fthrow (Qexit, Qt);
1254 error ("No recursive edit is in progress");
1255 return Qnil;
1258 /* This is the actual command reading loop,
1259 sans error-handling encapsulation. */
1261 Lisp_Object Fcommand_execute ();
1262 static int read_key_sequence ();
1263 void safe_run_hooks ();
1264 static void adjust_point_for_property ();
1266 Lisp_Object
1267 command_loop_1 ()
1269 Lisp_Object cmd;
1270 int lose;
1271 int nonundocount;
1272 Lisp_Object keybuf[30];
1273 int i;
1274 int no_direct;
1275 int prev_modiff;
1276 struct buffer *prev_buffer = NULL;
1277 #ifdef MULTI_KBOARD
1278 int was_locked = single_kboard;
1279 #endif
1281 current_kboard->Vprefix_arg = Qnil;
1282 current_kboard->Vlast_prefix_arg = Qnil;
1283 Vdeactivate_mark = Qnil;
1284 waiting_for_input = 0;
1285 cancel_echoing ();
1287 nonundocount = 0;
1288 this_command_key_count = 0;
1289 this_single_command_key_start = 0;
1291 /* Make sure this hook runs after commands that get errors and
1292 throw to top level. */
1293 /* Note that the value cell will never directly contain nil
1294 if the symbol is a local variable. */
1295 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1296 safe_run_hooks (Qpost_command_hook);
1298 /* If displaying a message, resize the echo area window to fit
1299 that message's size exactly. */
1300 if (!NILP (echo_area_buffer[0]))
1301 resize_echo_area_axactly ();
1303 if (!NILP (Vdeferred_action_list))
1304 call0 (Vdeferred_action_function);
1306 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1308 if (NILP (Vunread_command_events)
1309 && NILP (Vunread_input_method_events)
1310 && NILP (Vunread_post_input_method_events)
1311 && NILP (Vexecuting_macro)
1312 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
1313 safe_run_hooks (Qpost_command_idle_hook);
1316 /* Do this after running Vpost_command_hook, for consistency. */
1317 current_kboard->Vlast_command = Vthis_command;
1318 current_kboard->Vreal_last_command = real_this_command;
1320 while (1)
1322 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1323 Fkill_emacs (Qnil);
1325 /* Make sure the current window's buffer is selected. */
1326 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1327 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1329 /* Display any malloc warning that just came out. Use while because
1330 displaying one warning can cause another. */
1332 while (pending_malloc_warning)
1333 display_malloc_warning ();
1335 no_direct = 0;
1337 Vdeactivate_mark = Qnil;
1339 /* If minibuffer on and echo area in use,
1340 wait a short time and redraw minibuffer. */
1342 if (minibuf_level
1343 && !NILP (echo_area_buffer[0])
1344 && EQ (minibuf_window, echo_area_window)
1345 && NUMBERP (Vminibuffer_message_timeout))
1347 /* Bind inhibit-quit to t so that C-g gets read in
1348 rather than quitting back to the minibuffer. */
1349 int count = specpdl_ptr - specpdl;
1350 specbind (Qinhibit_quit, Qt);
1352 Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil);
1353 /* Clear the echo area. */
1354 message2 (0, 0, 0);
1355 safe_run_hooks (Qecho_area_clear_hook);
1357 unbind_to (count, Qnil);
1359 /* If a C-g came in before, treat it as input now. */
1360 if (!NILP (Vquit_flag))
1362 Vquit_flag = Qnil;
1363 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
1367 #ifdef C_ALLOCA
1368 alloca (0); /* Cause a garbage collection now */
1369 /* Since we can free the most stuff here. */
1370 #endif /* C_ALLOCA */
1372 #if 0
1373 /* Select the frame that the last event came from. Usually,
1374 switch-frame events will take care of this, but if some lisp
1375 code swallows a switch-frame event, we'll fix things up here.
1376 Is this a good idea? */
1377 if (FRAMEP (internal_last_event_frame)
1378 && !EQ (internal_last_event_frame, selected_frame))
1379 Fselect_frame (internal_last_event_frame, Qnil);
1380 #endif
1381 /* If it has changed current-menubar from previous value,
1382 really recompute the menubar from the value. */
1383 if (! NILP (Vlucid_menu_bar_dirty_flag)
1384 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
1385 call0 (Qrecompute_lucid_menubar);
1387 before_command_key_count = this_command_key_count;
1388 before_command_echo_length = echo_length ();
1390 Vthis_command = Qnil;
1391 real_this_command = Qnil;
1393 /* Read next key sequence; i gets its length. */
1394 i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
1395 Qnil, 0, 1, 1);
1397 /* A filter may have run while we were reading the input. */
1398 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1399 Fkill_emacs (Qnil);
1400 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1401 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1403 ++num_input_keys;
1405 /* Now we have read a key sequence of length I,
1406 or else I is 0 and we found end of file. */
1408 if (i == 0) /* End of file -- happens only in */
1409 return Qnil; /* a kbd macro, at the end. */
1410 /* -1 means read_key_sequence got a menu that was rejected.
1411 Just loop around and read another command. */
1412 if (i == -1)
1414 cancel_echoing ();
1415 this_command_key_count = 0;
1416 this_single_command_key_start = 0;
1417 goto finalize;
1420 last_command_char = keybuf[i - 1];
1422 /* If the previous command tried to force a specific window-start,
1423 forget about that, in case this command moves point far away
1424 from that position. But also throw away beg_unchanged and
1425 end_unchanged information in that case, so that redisplay will
1426 update the whole window properly. */
1427 if (!NILP (XWINDOW (selected_window)->force_start))
1429 struct buffer *b;
1430 XWINDOW (selected_window)->force_start = Qnil;
1431 b = XBUFFER (XWINDOW (selected_window)->buffer);
1432 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
1435 cmd = read_key_sequence_cmd;
1436 if (!NILP (Vexecuting_macro))
1438 if (!NILP (Vquit_flag))
1440 Vexecuting_macro = Qt;
1441 QUIT; /* Make some noise. */
1442 /* Will return since macro now empty. */
1446 /* Do redisplay processing after this command except in special
1447 cases identified below. */
1448 prev_buffer = current_buffer;
1449 prev_modiff = MODIFF;
1450 last_point_position = PT;
1451 XSETBUFFER (last_point_position_buffer, prev_buffer);
1453 /* By default, we adjust point to a boundary of a region that
1454 has such a property that should be treated intangible
1455 (e.g. composition, display). But, some commands will set
1456 this variable differently. */
1457 Vdisable_point_adjustment = Qnil;
1459 /* Execute the command. */
1461 Vthis_command = cmd;
1462 real_this_command = cmd;
1463 /* Note that the value cell will never directly contain nil
1464 if the symbol is a local variable. */
1465 if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks))
1466 safe_run_hooks (Qpre_command_hook);
1468 if (NILP (Vthis_command))
1470 /* nil means key is undefined. */
1471 bitch_at_user ();
1472 current_kboard->defining_kbd_macro = Qnil;
1473 update_mode_lines = 1;
1474 current_kboard->Vprefix_arg = Qnil;
1476 else
1478 if (NILP (current_kboard->Vprefix_arg) && ! no_direct)
1480 /* In case we jump to directly_done. */
1481 Vcurrent_prefix_arg = current_kboard->Vprefix_arg;
1483 /* Recognize some common commands in common situations and
1484 do them directly. */
1485 if (EQ (Vthis_command, Qforward_char) && PT < ZV)
1487 struct Lisp_Char_Table *dp
1488 = window_display_table (XWINDOW (selected_window));
1489 lose = FETCH_CHAR (PT_BYTE);
1490 SET_PT (PT + 1);
1491 if ((dp
1492 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1493 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1494 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1495 && (lose >= 0x20 && lose < 0x7f)))
1496 : (lose >= 0x20 && lose < 0x7f))
1497 /* To extract the case of continuation on
1498 wide-column characters. */
1499 && (WIDTH_BY_CHAR_HEAD (FETCH_BYTE (PT_BYTE)) == 1)
1500 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1501 >= MODIFF)
1502 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1503 >= OVERLAY_MODIFF)
1504 && (XFASTINT (XWINDOW (selected_window)->last_point)
1505 == PT - 1)
1506 && !windows_or_buffers_changed
1507 && EQ (current_buffer->selective_display, Qnil)
1508 && !detect_input_pending ()
1509 && NILP (XWINDOW (selected_window)->column_number_displayed)
1510 && NILP (Vexecuting_macro))
1511 direct_output_forward_char (1);
1512 goto directly_done;
1514 else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV)
1516 struct Lisp_Char_Table *dp
1517 = window_display_table (XWINDOW (selected_window));
1518 SET_PT (PT - 1);
1519 lose = FETCH_CHAR (PT_BYTE);
1520 if ((dp
1521 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1522 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1523 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1524 && (lose >= 0x20 && lose < 0x7f)))
1525 : (lose >= 0x20 && lose < 0x7f))
1526 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1527 >= MODIFF)
1528 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1529 >= OVERLAY_MODIFF)
1530 && (XFASTINT (XWINDOW (selected_window)->last_point)
1531 == PT + 1)
1532 && !windows_or_buffers_changed
1533 && EQ (current_buffer->selective_display, Qnil)
1534 && !detect_input_pending ()
1535 && NILP (XWINDOW (selected_window)->column_number_displayed)
1536 && NILP (Vexecuting_macro))
1537 direct_output_forward_char (-1);
1538 goto directly_done;
1540 else if (EQ (Vthis_command, Qself_insert_command)
1541 /* Try this optimization only on ascii keystrokes. */
1542 && INTEGERP (last_command_char))
1544 unsigned int c = XINT (last_command_char);
1545 int value;
1546 if (NILP (Vexecuting_macro)
1547 && !EQ (minibuf_window, selected_window))
1549 if (!nonundocount || nonundocount >= 20)
1551 Fundo_boundary ();
1552 nonundocount = 0;
1554 nonundocount++;
1557 lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
1558 < MODIFF)
1559 || (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1560 < OVERLAY_MODIFF)
1561 || (XFASTINT (XWINDOW (selected_window)->last_point)
1562 != PT)
1563 || MODIFF <= SAVE_MODIFF
1564 || windows_or_buffers_changed
1565 || !EQ (current_buffer->selective_display, Qnil)
1566 || detect_input_pending ()
1567 || !NILP (XWINDOW (selected_window)->column_number_displayed)
1568 || !NILP (Vexecuting_macro));
1570 value = internal_self_insert (c, 0);
1572 if (value == 2)
1573 nonundocount = 0;
1575 /* VALUE == 1 when AFTER-CHANGE functions are
1576 installed which is the case most of the time
1577 because FONT-LOCK installs one. */
1578 if (!lose && !value)
1579 direct_output_for_insert (c);
1580 goto directly_done;
1584 /* Here for a command that isn't executed directly */
1586 #ifdef HAVE_X_WINDOWS
1587 if (display_busy_cursor_p)
1588 start_busy_cursor ();
1589 #endif
1591 nonundocount = 0;
1592 if (NILP (current_kboard->Vprefix_arg))
1593 Fundo_boundary ();
1594 Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
1596 #ifdef HAVE_X_WINDOWS
1597 if (display_busy_cursor_p)
1598 cancel_busy_cursor ();
1599 #endif
1601 directly_done: ;
1602 current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg;
1604 /* Note that the value cell will never directly contain nil
1605 if the symbol is a local variable. */
1606 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1607 safe_run_hooks (Qpost_command_hook);
1609 /* If displaying a message, resize the echo area window to fit
1610 that message's size exactly. */
1611 if (!NILP (echo_area_buffer[0]))
1612 resize_echo_area_axactly ();
1614 if (!NILP (Vdeferred_action_list))
1615 safe_run_hooks (Qdeferred_action_function);
1617 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1619 if (NILP (Vunread_command_events)
1620 && NILP (Vunread_input_method_events)
1621 && NILP (Vunread_post_input_method_events)
1622 && NILP (Vexecuting_macro)
1623 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
1624 safe_run_hooks (Qpost_command_idle_hook);
1627 /* If there is a prefix argument,
1628 1) We don't want Vlast_command to be ``universal-argument''
1629 (that would be dumb), so don't set Vlast_command,
1630 2) we want to leave echoing on so that the prefix will be
1631 echoed as part of this key sequence, so don't call
1632 cancel_echoing, and
1633 3) we want to leave this_command_key_count non-zero, so that
1634 read_char will realize that it is re-reading a character, and
1635 not echo it a second time.
1637 If the command didn't actually create a prefix arg,
1638 but is merely a frame event that is transparent to prefix args,
1639 then the above doesn't apply. */
1640 if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_char))
1642 current_kboard->Vlast_command = Vthis_command;
1643 current_kboard->Vreal_last_command = real_this_command;
1644 cancel_echoing ();
1645 this_command_key_count = 0;
1646 this_single_command_key_start = 0;
1649 if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks))
1651 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
1653 current_buffer->mark_active = Qnil;
1654 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
1656 else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1657 call1 (Vrun_hooks, intern ("activate-mark-hook"));
1660 finalize:
1662 if (current_buffer == prev_buffer
1663 && last_point_position != PT
1664 && NILP (Vdisable_point_adjustment)
1665 && NILP (Vglobal_disable_point_adjustment))
1666 adjust_point_for_property (last_point_position);
1668 /* Install chars successfully executed in kbd macro. */
1670 if (!NILP (current_kboard->defining_kbd_macro)
1671 && NILP (current_kboard->Vprefix_arg))
1672 finalize_kbd_macro_chars ();
1674 #ifdef MULTI_KBOARD
1675 if (!was_locked)
1676 any_kboard_state ();
1677 #endif
1681 extern Lisp_Object Qcomposition, Qdisplay;
1683 /* Adjust point to a boundary of a region that has such a property
1684 that should be treated intangible. For the moment, we check
1685 `composition' and `display' property. LAST_PT is the last position
1686 of point. */
1688 static void
1689 adjust_point_for_property (last_pt)
1690 int last_pt;
1692 int start, end;
1693 Lisp_Object val;
1694 int check_composition = 1, check_display = 1;
1696 while (check_composition || check_display)
1698 if (check_composition
1699 && PT > BEGV && PT < ZV
1700 && get_property_and_range (PT, Qcomposition, &val, &start, &end, Qnil)
1701 && COMPOSITION_VALID_P (start, end, val)
1702 && start < PT && end > PT
1703 && (last_pt <= start || last_pt >= end))
1705 if (PT < last_pt)
1706 SET_PT (start);
1707 else
1708 SET_PT (end);
1709 check_display = 1;
1711 check_composition = 0;
1712 if (check_display
1713 && PT > BEGV && PT < ZV
1714 && get_property_and_range (PT, Qdisplay, &val, &start, &end, Qnil)
1715 && display_prop_intangible_p (val)
1716 && start < PT && end > PT
1717 && (last_pt <= start || last_pt >= end))
1719 if (PT < last_pt)
1720 SET_PT (start);
1721 else
1722 SET_PT (end);
1723 check_composition = 1;
1725 check_display = 0;
1729 /* Subroutine for safe_run_hooks: run the hook HOOK. */
1731 static Lisp_Object
1732 safe_run_hooks_1 (hook)
1733 Lisp_Object hook;
1735 return call1 (Vrun_hooks, Vinhibit_quit);
1738 /* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */
1740 static Lisp_Object
1741 safe_run_hooks_error (data)
1742 Lisp_Object data;
1744 return Fset (Vinhibit_quit, Qnil);
1747 /* If we get an error while running the hook, cause the hook variable
1748 to be nil. Also inhibit quits, so that C-g won't cause the hook
1749 to mysteriously evaporate. */
1751 void
1752 safe_run_hooks (hook)
1753 Lisp_Object hook;
1755 int count = specpdl_ptr - specpdl;
1756 specbind (Qinhibit_quit, hook);
1758 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
1760 unbind_to (count, Qnil);
1764 /* Number of seconds between polling for input. This is a Lisp
1765 variable that can be bound. */
1767 int polling_period;
1769 /* Nonzero means polling for input is temporarily suppressed. */
1771 int poll_suppress_count;
1773 /* Asynchronous timer for polling. */
1775 struct atimer *poll_timer;
1778 #ifdef POLL_FOR_INPUT
1780 /* Poll for input, so what we catch a C-g if it comes in. This
1781 function is called from x_make_frame_visible, see comment
1782 there. */
1784 void
1785 poll_for_input_1 ()
1787 if (interrupt_input_blocked == 0
1788 && !waiting_for_input)
1789 read_avail_input (0);
1792 /* Timer callback function for poll_timer. TIMER is equal to
1793 poll_timer. */
1795 void
1796 poll_for_input (timer)
1797 struct atimer *timer;
1799 if (poll_suppress_count == 0)
1800 poll_for_input_1 ();
1803 #endif /* POLL_FOR_INPUT */
1805 /* Begin signals to poll for input, if they are appropriate.
1806 This function is called unconditionally from various places. */
1808 void
1809 start_polling ()
1811 #ifdef POLL_FOR_INPUT
1812 if (read_socket_hook && !interrupt_input)
1814 /* Turn alarm handling on unconditionally. It might have
1815 been turned off in process.c. */
1816 turn_on_atimers (1);
1818 /* If poll timer doesn't exist, are we need one with
1819 a different interval, start a new one. */
1820 if (poll_timer == NULL
1821 || EMACS_SECS (poll_timer->interval) != polling_period)
1823 EMACS_TIME interval;
1825 if (poll_timer)
1826 cancel_atimer (poll_timer);
1828 EMACS_SET_SECS_USECS (interval, polling_period, 0);
1829 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
1830 poll_for_input, NULL);
1833 /* Let the timer's callback function poll for input
1834 if this becomes zero. */
1835 --poll_suppress_count;
1837 #endif
1840 /* Nonzero if we are using polling to handle input asynchronously. */
1843 input_polling_used ()
1845 #ifdef POLL_FOR_INPUT
1846 return read_socket_hook && !interrupt_input;
1847 #else
1848 return 0;
1849 #endif
1852 /* Turn off polling. */
1854 void
1855 stop_polling ()
1857 #ifdef POLL_FOR_INPUT
1858 if (read_socket_hook && !interrupt_input)
1859 ++poll_suppress_count;
1860 #endif
1863 /* Set the value of poll_suppress_count to COUNT
1864 and start or stop polling accordingly. */
1866 void
1867 set_poll_suppress_count (count)
1868 int count;
1870 #ifdef POLL_FOR_INPUT
1871 if (count == 0 && poll_suppress_count != 0)
1873 poll_suppress_count = 1;
1874 start_polling ();
1876 else if (count != 0 && poll_suppress_count == 0)
1878 stop_polling ();
1880 poll_suppress_count = count;
1881 #endif
1884 /* Bind polling_period to a value at least N.
1885 But don't decrease it. */
1887 void
1888 bind_polling_period (n)
1889 int n;
1891 #ifdef POLL_FOR_INPUT
1892 int new = polling_period;
1894 if (n > new)
1895 new = n;
1897 stop_other_atimers (poll_timer);
1898 stop_polling ();
1899 specbind (Qpolling_period, make_number (new));
1900 /* Start a new alarm with the new period. */
1901 start_polling ();
1902 #endif
1905 /* Apply the control modifier to CHARACTER. */
1908 make_ctrl_char (c)
1909 int c;
1911 /* Save the upper bits here. */
1912 int upper = c & ~0177;
1914 c &= 0177;
1916 /* Everything in the columns containing the upper-case letters
1917 denotes a control character. */
1918 if (c >= 0100 && c < 0140)
1920 int oc = c;
1921 c &= ~0140;
1922 /* Set the shift modifier for a control char
1923 made from a shifted letter. But only for letters! */
1924 if (oc >= 'A' && oc <= 'Z')
1925 c |= shift_modifier;
1928 /* The lower-case letters denote control characters too. */
1929 else if (c >= 'a' && c <= 'z')
1930 c &= ~0140;
1932 /* Include the bits for control and shift
1933 only if the basic ASCII code can't indicate them. */
1934 else if (c >= ' ')
1935 c |= ctrl_modifier;
1937 /* Replace the high bits. */
1938 c |= (upper & ~ctrl_modifier);
1940 return c;
1943 /* Display help echo in the echo area.
1945 HELP a string means display that string, HELP nil means clear the
1946 help echo. If HELP is a function, call it with OBJECT and POS as
1947 arguments; the function should return a help string or nil for
1948 none. For all other types of HELP evaluate it to obtain a string.
1950 WINDOW is the window in which the help was generated, if any.
1951 It is nil if not in a window.
1953 If OBJECT is a buffer, POS is the position in the buffer where the
1954 `help-echo' text property was found.
1956 If OBJECT is an overlay, that overlay has a `help-echo' property,
1957 and POS is the position in the overlay's buffer under the mouse.
1959 If OBJECT is a string (an overlay string or a string displayed with
1960 the `display' property). POS is the position in that string under
1961 the mouse.
1963 OK_TO_IVERWRITE_KEYSTROKE_ECHO non-zero means it's okay if the help
1964 echo overwrites a keystroke echo currently displayed in the echo
1965 area.
1967 Note: this function may only be called with HELP nil or a string
1968 from X code running asynchronously. */
1970 void
1971 show_help_echo (help, window, object, pos, ok_to_overwrite_keystroke_echo)
1972 Lisp_Object help, window, object, pos;
1973 int ok_to_overwrite_keystroke_echo;
1975 if (!NILP (help) && !STRINGP (help))
1977 if (FUNCTIONP (help))
1979 Lisp_Object args[4];
1980 args[0] = help;
1981 args[1] = window;
1982 args[2] = object;
1983 args[3] = pos;
1984 help = safe_call (4, args);
1986 else
1987 help = safe_eval (help);
1989 if (!STRINGP (help))
1990 return;
1993 if (STRINGP (help) || NILP (help))
1995 if (!NILP (Vshow_help_function))
1996 call1 (Vshow_help_function, help);
1997 else if (/* Don't overwrite minibuffer contents. */
1998 !MINI_WINDOW_P (XWINDOW (selected_window))
1999 /* Don't overwrite a keystroke echo. */
2000 && (NILP (echo_message_buffer)
2001 || ok_to_overwrite_keystroke_echo)
2002 /* Don't overwrite a prompt. */
2003 && !cursor_in_echo_area)
2005 if (STRINGP (help))
2007 int count = specpdl_ptr - specpdl;
2008 specbind (Qmessage_truncate_lines, Qt);
2009 message3_nolog (help, STRING_BYTES (XSTRING (help)),
2010 STRING_MULTIBYTE (help));
2011 unbind_to (count, Qnil);
2013 else
2014 message (0);
2017 help_echo_showing_p = STRINGP (help);
2023 /* Input of single characters from keyboard */
2025 Lisp_Object print_help ();
2026 static Lisp_Object kbd_buffer_get_event ();
2027 static void record_char ();
2029 #ifdef MULTI_KBOARD
2030 static jmp_buf wrong_kboard_jmpbuf;
2031 #endif
2033 /* read a character from the keyboard; call the redisplay if needed */
2034 /* commandflag 0 means do not do auto-saving, but do do redisplay.
2035 -1 means do not do redisplay, but do do autosaving.
2036 1 means do both. */
2038 /* The arguments MAPS and NMAPS are for menu prompting.
2039 MAPS is an array of keymaps; NMAPS is the length of MAPS.
2041 PREV_EVENT is the previous input event, or nil if we are reading
2042 the first event of a key sequence (or not reading a key sequence).
2043 If PREV_EVENT is t, that is a "magic" value that says
2044 not to run input methods, but in other respects to act as if
2045 not reading a key sequence.
2047 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
2048 if we used a mouse menu to read the input, or zero otherwise. If
2049 USED_MOUSE_MENU is null, we don't dereference it.
2051 Value is t if we showed a menu and the user rejected it. */
2053 Lisp_Object
2054 read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
2055 int commandflag;
2056 int nmaps;
2057 Lisp_Object *maps;
2058 Lisp_Object prev_event;
2059 int *used_mouse_menu;
2061 volatile Lisp_Object c;
2062 int count;
2063 jmp_buf local_getcjmp;
2064 jmp_buf save_jump;
2065 volatile int key_already_recorded = 0;
2066 Lisp_Object tem, save;
2067 volatile Lisp_Object previous_echo_area_message;
2068 volatile Lisp_Object also_record;
2069 volatile int reread;
2070 struct gcpro gcpro1, gcpro2;
2072 also_record = Qnil;
2074 before_command_key_count = this_command_key_count;
2075 before_command_echo_length = echo_length ();
2076 c = Qnil;
2077 previous_echo_area_message = Qnil;
2079 GCPRO2 (c, previous_echo_area_message);
2081 retry:
2083 reread = 0;
2084 if (CONSP (Vunread_post_input_method_events))
2086 c = XCAR (Vunread_post_input_method_events);
2087 Vunread_post_input_method_events
2088 = XCDR (Vunread_post_input_method_events);
2090 /* Undo what read_char_x_menu_prompt did when it unread
2091 additional keys returned by Fx_popup_menu. */
2092 if (CONSP (c)
2093 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2094 && NILP (XCDR (c)))
2095 c = XCAR (c);
2097 reread = 1;
2098 goto reread_first;
2101 if (unread_command_char != -1)
2103 XSETINT (c, unread_command_char);
2104 unread_command_char = -1;
2106 reread = 1;
2107 goto reread_first;
2110 if (CONSP (Vunread_command_events))
2112 c = XCAR (Vunread_command_events);
2113 Vunread_command_events = XCDR (Vunread_command_events);
2115 /* Undo what read_char_x_menu_prompt did when it unread
2116 additional keys returned by Fx_popup_menu. */
2117 if (CONSP (c)
2118 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2119 && NILP (XCDR (c)))
2120 c = XCAR (c);
2122 reread = 1;
2123 goto reread_for_input_method;
2126 if (CONSP (Vunread_input_method_events))
2128 c = XCAR (Vunread_input_method_events);
2129 Vunread_input_method_events = XCDR (Vunread_input_method_events);
2131 /* Undo what read_char_x_menu_prompt did when it unread
2132 additional keys returned by Fx_popup_menu. */
2133 if (CONSP (c)
2134 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2135 && NILP (XCDR (c)))
2136 c = XCAR (c);
2137 reread = 1;
2138 goto reread_for_input_method;
2141 /* If there is no function key translated before
2142 reset-this-command-lengths takes effect, forget about it. */
2143 before_command_restore_flag = 0;
2145 if (!NILP (Vexecuting_macro))
2147 /* We set this to Qmacro; since that's not a frame, nobody will
2148 try to switch frames on us, and the selected window will
2149 remain unchanged.
2151 Since this event came from a macro, it would be misleading to
2152 leave internal_last_event_frame set to wherever the last
2153 real event came from. Normally, a switch-frame event selects
2154 internal_last_event_frame after each command is read, but
2155 events read from a macro should never cause a new frame to be
2156 selected. */
2157 Vlast_event_frame = internal_last_event_frame = Qmacro;
2159 /* Exit the macro if we are at the end.
2160 Also, some things replace the macro with t
2161 to force an early exit. */
2162 if (EQ (Vexecuting_macro, Qt)
2163 || executing_macro_index >= XFASTINT (Flength (Vexecuting_macro)))
2165 XSETINT (c, -1);
2166 RETURN_UNGCPRO (c);
2169 c = Faref (Vexecuting_macro, make_number (executing_macro_index));
2170 if (STRINGP (Vexecuting_macro)
2171 && (XINT (c) & 0x80))
2172 XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
2174 executing_macro_index++;
2176 goto from_macro;
2179 if (!NILP (unread_switch_frame))
2181 c = unread_switch_frame;
2182 unread_switch_frame = Qnil;
2184 /* This event should make it into this_command_keys, and get echoed
2185 again, so we do not set `reread'. */
2186 goto reread_first;
2189 /* if redisplay was requested */
2190 if (commandflag >= 0)
2192 /* If there is pending input, process any events which are not
2193 user-visible, such as X selection_request events. */
2194 if (input_pending
2195 || detect_input_pending_run_timers (0))
2196 swallow_events (0); /* may clear input_pending */
2198 /* Redisplay if no pending input. */
2199 while (!input_pending)
2201 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
2202 redisplay_preserve_echo_area ();
2203 else
2204 redisplay ();
2206 if (!input_pending)
2207 /* Normal case: no input arrived during redisplay. */
2208 break;
2210 /* Input arrived and pre-empted redisplay.
2211 Process any events which are not user-visible. */
2212 swallow_events (0);
2213 /* If that cleared input_pending, try again to redisplay. */
2217 /* Message turns off echoing unless more keystrokes turn it on again.
2219 The code in 20.x for the condition was
2221 1. echo_area_glyphs && *echo_area_glyphs
2222 2. && echo_area_glyphs != current_kboard->echobuf
2223 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2225 (1) means there's a current message displayed
2227 (2) means it's not the message from echoing from the current
2228 kboard.
2230 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2231 is set to a non-null value. This is done in read_char and it is
2232 set to echo_area_glyphs after a call to echo_char. That means
2233 ok_to_echo_at_next_pause is either null or
2234 current_kboard->echobuf with the appropriate current_kboard at
2235 that time.
2237 So, condition (3) means in clear text ok_to_echo_at_next_pause
2238 must be either null, or the current message isn't from echoing at
2239 all, or it's from echoing from a different kboard than the
2240 current one. */
2242 if (/* There currently something in the echo area */
2243 !NILP (echo_area_buffer[0])
2244 && (/* And it's either not from echoing. */
2245 !EQ (echo_area_buffer[0], echo_message_buffer)
2246 /* Or it's an echo from a different kboard. */
2247 || echo_kboard != current_kboard
2248 /* Or we explicitly allow overwriting whatever there is. */
2249 || ok_to_echo_at_next_pause == NULL))
2250 cancel_echoing ();
2251 else
2252 echo_dash ();
2254 /* Try reading a character via menu prompting in the minibuf.
2255 Try this before the sit-for, because the sit-for
2256 would do the wrong thing if we are supposed to do
2257 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2258 after a mouse event so don't try a minibuf menu. */
2259 c = Qnil;
2260 if (nmaps > 0 && INTERACTIVE
2261 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2262 /* Don't bring up a menu if we already have another event. */
2263 && NILP (Vunread_command_events)
2264 && unread_command_char < 0
2265 && !detect_input_pending_run_timers (0))
2267 c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
2268 if (! NILP (c))
2270 key_already_recorded = 1;
2271 goto non_reread_1;
2275 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2276 We will do that below, temporarily for short sections of code,
2277 when appropriate. local_getcjmp must be in effect
2278 around any call to sit_for or kbd_buffer_get_event;
2279 it *must not* be in effect when we call redisplay. */
2281 if (_setjmp (local_getcjmp))
2283 XSETINT (c, quit_char);
2284 internal_last_event_frame = selected_frame;
2285 Vlast_event_frame = internal_last_event_frame;
2286 /* If we report the quit char as an event,
2287 don't do so more than once. */
2288 if (!NILP (Vinhibit_quit))
2289 Vquit_flag = Qnil;
2291 #ifdef MULTI_KBOARD
2293 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
2294 if (kb != current_kboard)
2296 Lisp_Object *tailp = &kb->kbd_queue;
2297 /* We shouldn't get here if we were in single-kboard mode! */
2298 if (single_kboard)
2299 abort ();
2300 while (CONSP (*tailp))
2301 tailp = &XCDR (*tailp);
2302 if (!NILP (*tailp))
2303 abort ();
2304 *tailp = Fcons (c, Qnil);
2305 kb->kbd_queue_has_data = 1;
2306 current_kboard = kb;
2307 /* This is going to exit from read_char
2308 so we had better get rid of this frame's stuff. */
2309 UNGCPRO;
2310 longjmp (wrong_kboard_jmpbuf, 1);
2313 #endif
2314 goto non_reread;
2317 timer_start_idle ();
2319 /* If in middle of key sequence and minibuffer not active,
2320 start echoing if enough time elapses. */
2322 if (minibuf_level == 0
2323 && !current_kboard->immediate_echo
2324 && this_command_key_count > 0
2325 && ! noninteractive
2326 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2327 && NILP (Fzerop (Vecho_keystrokes))
2328 && (/* No message. */
2329 NILP (echo_area_buffer[0])
2330 /* Or empty message. */
2331 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2332 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2333 /* Or already echoing from same kboard. */
2334 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2335 /* Or not echoing before and echoing allowed. */
2336 || (!echo_kboard && ok_to_echo_at_next_pause)))
2338 Lisp_Object tem0;
2340 /* After a mouse event, start echoing right away.
2341 This is because we are probably about to display a menu,
2342 and we don't want to delay before doing so. */
2343 if (EVENT_HAS_PARAMETERS (prev_event))
2344 echo_now ();
2345 else
2347 int sec, usec;
2348 double duration = extract_float (Vecho_keystrokes);
2349 sec = (int) duration;
2350 usec = (duration - sec) * 1000000;
2351 save_getcjmp (save_jump);
2352 restore_getcjmp (local_getcjmp);
2353 tem0 = sit_for (sec, usec, 1, 1, 0);
2354 restore_getcjmp (save_jump);
2355 if (EQ (tem0, Qt)
2356 && ! CONSP (Vunread_command_events))
2357 echo_now ();
2361 /* Maybe auto save due to number of keystrokes. */
2363 if (commandflag != 0
2364 && auto_save_interval > 0
2365 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
2366 && !detect_input_pending_run_timers (0))
2368 Fdo_auto_save (Qnil, Qnil);
2369 /* Hooks can actually change some buffers in auto save. */
2370 redisplay ();
2373 /* Try reading using an X menu.
2374 This is never confused with reading using the minibuf
2375 because the recursive call of read_char in read_char_minibuf_menu_prompt
2376 does not pass on any keymaps. */
2378 if (nmaps > 0 && INTERACTIVE
2379 && !NILP (prev_event)
2380 && EVENT_HAS_PARAMETERS (prev_event)
2381 && !EQ (XCAR (prev_event), Qmenu_bar)
2382 && !EQ (XCAR (prev_event), Qtool_bar)
2383 /* Don't bring up a menu if we already have another event. */
2384 && NILP (Vunread_command_events)
2385 && unread_command_char < 0)
2387 c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
2389 /* Now that we have read an event, Emacs is not idle. */
2390 timer_stop_idle ();
2392 RETURN_UNGCPRO (c);
2395 /* Maybe autosave and/or garbage collect due to idleness. */
2397 if (INTERACTIVE && NILP (c))
2399 int delay_level, buffer_size;
2401 /* Slow down auto saves logarithmically in size of current buffer,
2402 and garbage collect while we're at it. */
2403 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2404 last_non_minibuf_size = Z - BEG;
2405 buffer_size = (last_non_minibuf_size >> 8) + 1;
2406 delay_level = 0;
2407 while (buffer_size > 64)
2408 delay_level++, buffer_size -= buffer_size >> 2;
2409 if (delay_level < 4) delay_level = 4;
2410 /* delay_level is 4 for files under around 50k, 7 at 100k,
2411 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2413 /* Auto save if enough time goes by without input. */
2414 if (commandflag != 0
2415 && num_nonmacro_input_events > last_auto_save
2416 && INTEGERP (Vauto_save_timeout)
2417 && XINT (Vauto_save_timeout) > 0)
2419 Lisp_Object tem0;
2421 save_getcjmp (save_jump);
2422 restore_getcjmp (local_getcjmp);
2423 tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4,
2424 0, 1, 1, 0);
2425 restore_getcjmp (save_jump);
2427 if (EQ (tem0, Qt)
2428 && ! CONSP (Vunread_command_events))
2430 Fdo_auto_save (Qnil, Qnil);
2432 /* If we have auto-saved and there is still no input
2433 available, garbage collect if there has been enough
2434 consing going on to make it worthwhile. */
2435 if (!detect_input_pending_run_timers (0)
2436 && consing_since_gc > gc_cons_threshold / 2)
2437 Fgarbage_collect ();
2439 redisplay ();
2444 /* If this has become non-nil here, it has been set by a timer
2445 or sentinel or filter. */
2446 if (CONSP (Vunread_command_events))
2448 c = XCAR (Vunread_command_events);
2449 Vunread_command_events = XCDR (Vunread_command_events);
2452 /* Read something from current KBOARD's side queue, if possible. */
2454 if (NILP (c))
2456 if (current_kboard->kbd_queue_has_data)
2458 if (!CONSP (current_kboard->kbd_queue))
2459 abort ();
2460 c = XCAR (current_kboard->kbd_queue);
2461 current_kboard->kbd_queue
2462 = XCDR (current_kboard->kbd_queue);
2463 if (NILP (current_kboard->kbd_queue))
2464 current_kboard->kbd_queue_has_data = 0;
2465 input_pending = readable_events (0);
2466 if (EVENT_HAS_PARAMETERS (c)
2467 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
2468 internal_last_event_frame = XCAR (XCDR (c));
2469 Vlast_event_frame = internal_last_event_frame;
2473 #ifdef MULTI_KBOARD
2474 /* If current_kboard's side queue is empty check the other kboards.
2475 If one of them has data that we have not yet seen here,
2476 switch to it and process the data waiting for it.
2478 Note: if the events queued up for another kboard
2479 have already been seen here, and therefore are not a complete command,
2480 the kbd_queue_has_data field is 0, so we skip that kboard here.
2481 That's to avoid an infinite loop switching between kboards here. */
2482 if (NILP (c) && !single_kboard)
2484 KBOARD *kb;
2485 for (kb = all_kboards; kb; kb = kb->next_kboard)
2486 if (kb->kbd_queue_has_data)
2488 current_kboard = kb;
2489 /* This is going to exit from read_char
2490 so we had better get rid of this frame's stuff. */
2491 UNGCPRO;
2492 longjmp (wrong_kboard_jmpbuf, 1);
2495 #endif
2497 wrong_kboard:
2499 stop_polling ();
2501 /* Finally, we read from the main queue,
2502 and if that gives us something we can't use yet, we put it on the
2503 appropriate side queue and try again. */
2505 if (NILP (c))
2507 KBOARD *kb;
2509 /* Actually read a character, waiting if necessary. */
2510 save_getcjmp (save_jump);
2511 restore_getcjmp (local_getcjmp);
2512 timer_start_idle ();
2513 c = kbd_buffer_get_event (&kb, used_mouse_menu);
2514 restore_getcjmp (save_jump);
2516 #ifdef MULTI_KBOARD
2517 if (! NILP (c) && (kb != current_kboard))
2519 Lisp_Object *tailp = &kb->kbd_queue;
2520 while (CONSP (*tailp))
2521 tailp = &XCDR (*tailp);
2522 if (!NILP (*tailp))
2523 abort ();
2524 *tailp = Fcons (c, Qnil);
2525 kb->kbd_queue_has_data = 1;
2526 c = Qnil;
2527 if (single_kboard)
2528 goto wrong_kboard;
2529 current_kboard = kb;
2530 /* This is going to exit from read_char
2531 so we had better get rid of this frame's stuff. */
2532 UNGCPRO;
2533 longjmp (wrong_kboard_jmpbuf, 1);
2535 #endif
2538 /* Terminate Emacs in batch mode if at eof. */
2539 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
2540 Fkill_emacs (make_number (1));
2542 if (INTEGERP (c))
2544 /* Add in any extra modifiers, where appropriate. */
2545 if ((extra_keyboard_modifiers & CHAR_CTL)
2546 || ((extra_keyboard_modifiers & 0177) < ' '
2547 && (extra_keyboard_modifiers & 0177) != 0))
2548 XSETINT (c, make_ctrl_char (XINT (c)));
2550 /* Transfer any other modifier bits directly from
2551 extra_keyboard_modifiers to c. Ignore the actual character code
2552 in the low 16 bits of extra_keyboard_modifiers. */
2553 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
2556 non_reread:
2558 timer_stop_idle ();
2559 start_polling ();
2561 if (NILP (c))
2563 if (commandflag >= 0
2564 && !input_pending && !detect_input_pending_run_timers (0))
2565 redisplay ();
2567 goto wrong_kboard;
2570 non_reread_1:
2572 /* Buffer switch events are only for internal wakeups
2573 so don't show them to the user.
2574 Also, don't record a key if we already did. */
2575 if (BUFFERP (c) || key_already_recorded)
2576 RETURN_UNGCPRO (c);
2578 /* Process special events within read_char
2579 and loop around to read another event. */
2580 save = Vquit_flag;
2581 Vquit_flag = Qnil;
2582 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
2583 Vquit_flag = save;
2585 if (!NILP (tem))
2587 int was_locked = single_kboard;
2589 last_input_char = c;
2590 Fcommand_execute (tem, Qnil, Fvector (1, &last_input_char), Qt);
2592 /* Resume allowing input from any kboard, if that was true before. */
2593 if (!was_locked)
2594 any_kboard_state ();
2596 goto retry;
2599 /* Handle things that only apply to characters. */
2600 if (INTEGERP (c))
2602 /* If kbd_buffer_get_event gave us an EOF, return that. */
2603 if (XINT (c) == -1)
2604 RETURN_UNGCPRO (c);
2606 if ((STRINGP (Vkeyboard_translate_table)
2607 && XSTRING (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
2608 || (VECTORP (Vkeyboard_translate_table)
2609 && XVECTOR (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
2610 || (CHAR_TABLE_P (Vkeyboard_translate_table)
2611 && CHAR_TABLE_ORDINARY_SLOTS > (unsigned) XFASTINT (c)))
2613 Lisp_Object d;
2614 d = Faref (Vkeyboard_translate_table, c);
2615 /* nil in keyboard-translate-table means no translation. */
2616 if (!NILP (d))
2617 c = d;
2621 /* If this event is a mouse click in the menu bar,
2622 return just menu-bar for now. Modify the mouse click event
2623 so we won't do this twice, then queue it up. */
2624 if (EVENT_HAS_PARAMETERS (c)
2625 && CONSP (XCDR (c))
2626 && CONSP (EVENT_START (c))
2627 && CONSP (XCDR (EVENT_START (c))))
2629 Lisp_Object posn;
2631 posn = POSN_BUFFER_POSN (EVENT_START (c));
2632 /* Handle menu-bar events:
2633 insert the dummy prefix event `menu-bar'. */
2634 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
2636 /* Change menu-bar to (menu-bar) as the event "position". */
2637 POSN_BUFFER_POSN (EVENT_START (c)) = Fcons (posn, Qnil);
2639 also_record = c;
2640 Vunread_command_events = Fcons (c, Vunread_command_events);
2641 c = posn;
2645 /* Store these characters into recent_keys, the dribble file if any,
2646 and the keyboard macro being defined, if any. */
2647 record_char (c);
2648 if (! NILP (also_record))
2649 record_char (also_record);
2651 /* Wipe the echo area.
2652 But first, if we are about to use an input method,
2653 save the echo area contents for it to refer to. */
2654 if (INTEGERP (c)
2655 && ! NILP (Vinput_method_function)
2656 && (unsigned) XINT (c) >= ' '
2657 && (unsigned) XINT (c) != 127
2658 && (unsigned) XINT (c) < 256)
2660 previous_echo_area_message = Fcurrent_message ();
2661 Vinput_method_previous_message = previous_echo_area_message;
2664 /* Now wipe the echo area, except for help events which do their
2665 own stuff with the echo area. */
2666 if (!CONSP (c) || !(EQ (Qhelp_echo, XCAR (c))))
2668 if (!NILP (echo_area_buffer[0]))
2669 safe_run_hooks (Qecho_area_clear_hook);
2670 clear_message (1, 0);
2673 reread_for_input_method:
2674 from_macro:
2675 /* Pass this to the input method, if appropriate. */
2676 if (INTEGERP (c)
2677 && ! NILP (Vinput_method_function)
2678 /* Don't run the input method within a key sequence,
2679 after the first event of the key sequence. */
2680 && NILP (prev_event)
2681 && (unsigned) XINT (c) >= ' '
2682 && (unsigned) XINT (c) != 127
2683 && (unsigned) XINT (c) < 256)
2685 Lisp_Object keys;
2686 int key_count;
2687 struct gcpro gcpro1;
2688 int count = specpdl_ptr - specpdl;
2690 /* Save the echo status. */
2691 int saved_immediate_echo = current_kboard->immediate_echo;
2692 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
2693 int saved_echo_after_prompt = current_kboard->echo_after_prompt;
2695 if (before_command_restore_flag)
2697 this_command_key_count = before_command_key_count_1;
2698 if (this_command_key_count < this_single_command_key_start)
2699 this_single_command_key_start = this_command_key_count;
2700 echo_truncate (before_command_echo_length_1);
2701 before_command_restore_flag = 0;
2704 /* Save the this_command_keys status. */
2705 key_count = this_command_key_count;
2707 if (key_count > 0)
2708 keys = Fcopy_sequence (this_command_keys);
2709 else
2710 keys = Qnil;
2711 GCPRO1 (keys);
2713 /* Clear out this_command_keys. */
2714 this_command_key_count = 0;
2716 /* Now wipe the echo area. */
2717 if (!NILP (echo_area_buffer[0]))
2718 safe_run_hooks (Qecho_area_clear_hook);
2719 clear_message (1, 0);
2720 echo_truncate (0);
2722 /* If we are not reading a key sequence,
2723 never use the echo area. */
2724 if (maps == 0)
2726 specbind (Qinput_method_use_echo_area, Qt);
2729 /* Call the input method. */
2730 tem = call1 (Vinput_method_function, c);
2732 tem = unbind_to (count, tem);
2734 /* Restore the saved echoing state
2735 and this_command_keys state. */
2736 this_command_key_count = key_count;
2737 if (key_count > 0)
2738 this_command_keys = keys;
2740 cancel_echoing ();
2741 ok_to_echo_at_next_pause = saved_ok_to_echo;
2742 current_kboard->echo_after_prompt = saved_echo_after_prompt;
2743 if (saved_immediate_echo)
2744 echo_now ();
2746 UNGCPRO;
2748 /* The input method can return no events. */
2749 if (! CONSP (tem))
2751 /* Bring back the previous message, if any. */
2752 if (! NILP (previous_echo_area_message))
2753 message_with_string ("%s", previous_echo_area_message, 0);
2754 goto retry;
2756 /* It returned one event or more. */
2757 c = XCAR (tem);
2758 Vunread_post_input_method_events
2759 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
2762 reread_first:
2764 /* Display help if not echoing. */
2765 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
2767 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
2768 Lisp_Object help, object, position, window;
2769 help = Fnth (make_number (2), c);
2770 window = Fnth (make_number (3), c);
2771 object = Fnth (make_number (4), c);
2772 position = Fnth (make_number (5), c);
2773 show_help_echo (help, window, object, position, 0);
2774 goto retry;
2777 if (this_command_key_count == 0 || ! reread)
2779 before_command_key_count = this_command_key_count;
2780 before_command_echo_length = echo_length ();
2782 /* Don't echo mouse motion events. */
2783 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2784 && NILP (Fzerop (Vecho_keystrokes))
2785 && ! (EVENT_HAS_PARAMETERS (c)
2786 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
2788 echo_char (c);
2789 if (! NILP (also_record))
2790 echo_char (also_record);
2791 /* Once we reread a character, echoing can happen
2792 the next time we pause to read a new one. */
2793 ok_to_echo_at_next_pause = current_kboard;
2796 /* Record this character as part of the current key. */
2797 add_command_key (c);
2798 if (! NILP (also_record))
2799 add_command_key (also_record);
2802 last_input_char = c;
2803 num_input_events++;
2805 /* Process the help character specially if enabled */
2806 if (!NILP (Vhelp_form) && help_char_p (c))
2808 Lisp_Object tem0;
2809 count = specpdl_ptr - specpdl;
2811 record_unwind_protect (Fset_window_configuration,
2812 Fcurrent_window_configuration (Qnil));
2814 tem0 = Feval (Vhelp_form);
2815 if (STRINGP (tem0))
2816 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
2818 cancel_echoing ();
2820 c = read_char (0, 0, 0, Qnil, 0);
2821 while (BUFFERP (c));
2822 /* Remove the help from the frame */
2823 unbind_to (count, Qnil);
2825 redisplay ();
2826 if (EQ (c, make_number (040)))
2828 cancel_echoing ();
2830 c = read_char (0, 0, 0, Qnil, 0);
2831 while (BUFFERP (c));
2835 RETURN_UNGCPRO (c);
2838 /* Record a key that came from a mouse menu.
2839 Record it for echoing, for this-command-keys, and so on. */
2841 static void
2842 record_menu_key (c)
2843 Lisp_Object c;
2845 /* Wipe the echo area. */
2846 clear_message (1, 0);
2848 record_char (c);
2850 before_command_key_count = this_command_key_count;
2851 before_command_echo_length = echo_length ();
2853 /* Don't echo mouse motion events. */
2854 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2855 && NILP (Fzerop (Vecho_keystrokes)))
2857 echo_char (c);
2859 /* Once we reread a character, echoing can happen
2860 the next time we pause to read a new one. */
2861 ok_to_echo_at_next_pause = 0;
2864 /* Record this character as part of the current key. */
2865 add_command_key (c);
2867 /* Re-reading in the middle of a command */
2868 last_input_char = c;
2869 num_input_events++;
2872 /* Return 1 if should recognize C as "the help character". */
2875 help_char_p (c)
2876 Lisp_Object c;
2878 Lisp_Object tail;
2880 if (EQ (c, Vhelp_char))
2881 return 1;
2882 for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
2883 if (EQ (c, XCAR (tail)))
2884 return 1;
2885 return 0;
2888 /* Record the input event C in various ways. */
2890 static void
2891 record_char (c)
2892 Lisp_Object c;
2894 Lisp_Object help;
2896 /* Don't record `help-echo' in recent_keys unless it shows some help
2897 message. */
2898 if (!CONSP (c)
2899 || !EQ (XCAR (c), Qhelp_echo)
2900 || (help = Fnth (make_number (2), c),
2901 !NILP (help)))
2903 total_keys++;
2904 ASET (recent_keys, recent_keys_index, c);
2905 if (++recent_keys_index >= NUM_RECENT_KEYS)
2906 recent_keys_index = 0;
2909 /* Write c to the dribble file. If c is a lispy event, write
2910 the event's symbol to the dribble file, in <brackets>. Bleaugh.
2911 If you, dear reader, have a better idea, you've got the source. :-) */
2912 if (dribble)
2914 if (INTEGERP (c))
2916 if (XUINT (c) < 0x100)
2917 putc (XINT (c), dribble);
2918 else
2919 fprintf (dribble, " 0x%x", (int) XUINT (c));
2921 else
2923 Lisp_Object dribblee;
2925 /* If it's a structured event, take the event header. */
2926 dribblee = EVENT_HEAD (c);
2928 if (SYMBOLP (dribblee))
2930 putc ('<', dribble);
2931 fwrite (XSYMBOL (dribblee)->name->data, sizeof (char),
2932 STRING_BYTES (XSYMBOL (dribblee)->name),
2933 dribble);
2934 putc ('>', dribble);
2938 fflush (dribble);
2941 if (!CONSP (c) || !EQ (Qhelp_echo, XCAR (c)))
2942 store_kbd_macro_char (c);
2944 num_nonmacro_input_events++;
2947 Lisp_Object
2948 print_help (object)
2949 Lisp_Object object;
2951 struct buffer *old = current_buffer;
2952 Fprinc (object, Qnil);
2953 set_buffer_internal (XBUFFER (Vstandard_output));
2954 call0 (intern ("help-mode"));
2955 set_buffer_internal (old);
2956 return Qnil;
2959 /* Copy out or in the info on where C-g should throw to.
2960 This is used when running Lisp code from within get_char,
2961 in case get_char is called recursively.
2962 See read_process_output. */
2964 static void
2965 save_getcjmp (temp)
2966 jmp_buf temp;
2968 bcopy (getcjmp, temp, sizeof getcjmp);
2971 static void
2972 restore_getcjmp (temp)
2973 jmp_buf temp;
2975 bcopy (temp, getcjmp, sizeof getcjmp);
2978 #ifdef HAVE_MOUSE
2980 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
2981 of this function. */
2983 static Lisp_Object
2984 tracking_off (old_value)
2985 Lisp_Object old_value;
2987 do_mouse_tracking = old_value;
2988 if (NILP (old_value))
2990 /* Redisplay may have been preempted because there was input
2991 available, and it assumes it will be called again after the
2992 input has been processed. If the only input available was
2993 the sort that we have just disabled, then we need to call
2994 redisplay. */
2995 if (!readable_events (1))
2997 redisplay_preserve_echo_area ();
2998 get_input_pending (&input_pending, 1);
3001 return Qnil;
3004 DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
3005 "Evaluate BODY with mouse movement events enabled.\n\
3006 Within a `track-mouse' form, mouse motion generates input events that\n\
3007 you can read with `read-event'.\n\
3008 Normally, mouse motion is ignored.")
3009 (args)
3010 Lisp_Object args;
3012 int count = specpdl_ptr - specpdl;
3013 Lisp_Object val;
3015 record_unwind_protect (tracking_off, do_mouse_tracking);
3017 do_mouse_tracking = Qt;
3019 val = Fprogn (args);
3020 return unbind_to (count, val);
3023 /* If mouse has moved on some frame, return one of those frames.
3024 Return 0 otherwise. */
3026 static FRAME_PTR
3027 some_mouse_moved ()
3029 Lisp_Object tail, frame;
3031 FOR_EACH_FRAME (tail, frame)
3033 if (XFRAME (frame)->mouse_moved)
3034 return XFRAME (frame);
3037 return 0;
3040 #endif /* HAVE_MOUSE */
3042 /* Low level keyboard/mouse input.
3043 kbd_buffer_store_event places events in kbd_buffer, and
3044 kbd_buffer_get_event retrieves them. */
3046 /* Return true iff there are any events in the queue that read-char
3047 would return. If this returns false, a read-char would block. */
3048 static int
3049 readable_events (do_timers_now)
3050 int do_timers_now;
3052 if (do_timers_now)
3053 timer_check (do_timers_now);
3055 if (kbd_fetch_ptr != kbd_store_ptr)
3056 return 1;
3057 #ifdef HAVE_MOUSE
3058 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3059 return 1;
3060 #endif
3061 if (single_kboard)
3063 if (current_kboard->kbd_queue_has_data)
3064 return 1;
3066 else
3068 KBOARD *kb;
3069 for (kb = all_kboards; kb; kb = kb->next_kboard)
3070 if (kb->kbd_queue_has_data)
3071 return 1;
3073 return 0;
3076 /* Set this for debugging, to have a way to get out */
3077 int stop_character;
3079 #ifdef MULTI_KBOARD
3080 static KBOARD *
3081 event_to_kboard (event)
3082 struct input_event *event;
3084 Lisp_Object frame;
3085 frame = event->frame_or_window;
3086 if (CONSP (frame))
3087 frame = XCAR (frame);
3088 else if (WINDOWP (frame))
3089 frame = WINDOW_FRAME (XWINDOW (frame));
3091 /* There are still some events that don't set this field.
3092 For now, just ignore the problem.
3093 Also ignore dead frames here. */
3094 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
3095 return 0;
3096 else
3097 return FRAME_KBOARD (XFRAME (frame));
3099 #endif
3101 /* Store an event obtained at interrupt level into kbd_buffer, fifo */
3103 void
3104 kbd_buffer_store_event (event)
3105 register struct input_event *event;
3107 if (event->kind == no_event)
3108 abort ();
3110 if (event->kind == ascii_keystroke)
3112 register int c = event->code & 0377;
3114 if (event->modifiers & ctrl_modifier)
3115 c = make_ctrl_char (c);
3117 c |= (event->modifiers
3118 & (meta_modifier | alt_modifier
3119 | hyper_modifier | super_modifier));
3121 if (c == quit_char)
3123 extern SIGTYPE interrupt_signal ();
3124 #ifdef MULTI_KBOARD
3125 KBOARD *kb;
3126 struct input_event *sp;
3128 if (single_kboard
3129 && (kb = FRAME_KBOARD (XFRAME (event->frame_or_window)),
3130 kb != current_kboard))
3132 kb->kbd_queue
3133 = Fcons (make_lispy_switch_frame (event->frame_or_window),
3134 Fcons (make_number (c), Qnil));
3135 kb->kbd_queue_has_data = 1;
3136 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3138 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3139 sp = kbd_buffer;
3141 if (event_to_kboard (sp) == kb)
3143 sp->kind = no_event;
3144 sp->frame_or_window = Qnil;
3145 sp->arg = Qnil;
3148 return;
3150 #endif
3152 /* If this results in a quit_char being returned to Emacs as
3153 input, set Vlast_event_frame properly. If this doesn't
3154 get returned to Emacs as an event, the next event read
3155 will set Vlast_event_frame again, so this is safe to do. */
3157 Lisp_Object focus;
3159 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
3160 if (NILP (focus))
3161 focus = event->frame_or_window;
3162 internal_last_event_frame = focus;
3163 Vlast_event_frame = focus;
3166 last_event_timestamp = event->timestamp;
3167 interrupt_signal ();
3168 return;
3171 if (c && c == stop_character)
3173 sys_suspend ();
3174 return;
3177 /* Don't insert two buffer_switch_event's in a row.
3178 Just ignore the second one. */
3179 else if (event->kind == buffer_switch_event
3180 && kbd_fetch_ptr != kbd_store_ptr
3181 && kbd_store_ptr->kind == buffer_switch_event)
3182 return;
3184 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
3185 kbd_store_ptr = kbd_buffer;
3187 /* Don't let the very last slot in the buffer become full,
3188 since that would make the two pointers equal,
3189 and that is indistinguishable from an empty buffer.
3190 Discard the event if it would fill the last slot. */
3191 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3193 int idx;
3195 #if 0 /* The selection_request_event case looks bogus, and it's error
3196 prone to assign individual members for other events, in case
3197 the input_event structure is changed. --2000-07-13, gerd. */
3198 struct input_event *sp = kbd_store_ptr;
3199 sp->kind = event->kind;
3200 if (event->kind == selection_request_event)
3202 /* We must not use the ordinary copying code for this case,
3203 since `part' is an enum and copying it might not copy enough
3204 in this case. */
3205 bcopy (event, (char *) sp, sizeof (*event));
3207 else
3210 sp->code = event->code;
3211 sp->part = event->part;
3212 sp->frame_or_window = event->frame_or_window;
3213 sp->arg = event->arg;
3214 sp->modifiers = event->modifiers;
3215 sp->x = event->x;
3216 sp->y = event->y;
3217 sp->timestamp = event->timestamp;
3219 #else
3220 *kbd_store_ptr = *event;
3221 #endif
3223 idx = 2 * (kbd_store_ptr - kbd_buffer);
3224 ASET (kbd_buffer_gcpro, idx, event->frame_or_window);
3225 ASET (kbd_buffer_gcpro, idx + 1, event->arg);
3226 ++kbd_store_ptr;
3231 /* Generate HELP_EVENT input_events in BUFP which has room for
3232 SIZE events. If there's not enough room in BUFP, ignore this
3233 event.
3235 HELP is the help form.
3237 FRAME is the frame on which the help is generated. OBJECT is the
3238 Lisp object where the help was found (a buffer, a string, an
3239 overlay, or nil if neither from a string nor from a buffer. POS is
3240 the position within OBJECT where the help was found.
3242 Value is the number of input_events generated. */
3245 gen_help_event (bufp, size, help, frame, window, object, pos)
3246 struct input_event *bufp;
3247 int size;
3248 Lisp_Object help, frame, object, window;
3249 int pos;
3251 int nevents_stored = 0;
3253 if (size >= 2)
3255 bufp->kind = HELP_EVENT;
3256 bufp->frame_or_window = frame;
3257 bufp->arg = object;
3258 bufp->x = make_number (pos);
3259 bufp->code = 0;
3261 ++bufp;
3262 bufp->kind = HELP_EVENT;
3263 bufp->frame_or_window = WINDOWP (window) ? window : frame;
3264 bufp->arg = help;
3265 bufp->code = 1;
3266 nevents_stored = 2;
3269 return nevents_stored;
3273 /* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3275 void
3276 kbd_buffer_store_help_event (frame, help)
3277 Lisp_Object frame, help;
3279 struct input_event event;
3281 event.kind = HELP_EVENT;
3282 event.frame_or_window = frame;
3283 event.arg = Qnil;
3284 event.x = make_number (0);
3285 event.code = 0;
3286 kbd_buffer_store_event (&event);
3288 event.kind = HELP_EVENT;
3289 event.frame_or_window = frame;
3290 event.arg = help;
3291 event.x = make_number (0);
3292 event.code = 1;
3293 kbd_buffer_store_event (&event);
3297 /* Discard any mouse events in the event buffer by setting them to
3298 no_event. */
3299 void
3300 discard_mouse_events ()
3302 struct input_event *sp;
3303 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3305 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3306 sp = kbd_buffer;
3308 if (sp->kind == mouse_click
3309 #ifdef WINDOWSNT
3310 || sp->kind == w32_scroll_bar_click
3311 #endif
3312 || sp->kind == scroll_bar_click)
3314 sp->kind = no_event;
3320 /* Return non-zero if there are any real events waiting in the event
3321 buffer, not counting `no_event's.
3323 If DISCARD is non-zero, discard no_event events at the front of
3324 the input queue, possibly leaving the input queue empty if there
3325 are no real input events. */
3328 kbd_buffer_events_waiting (discard)
3329 int discard;
3331 struct input_event *sp;
3333 for (sp = kbd_fetch_ptr;
3334 sp != kbd_store_ptr && sp->kind == no_event;
3335 ++sp)
3337 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3338 sp = kbd_buffer;
3341 if (discard)
3342 kbd_fetch_ptr = sp;
3344 return sp != kbd_store_ptr && sp->kind != no_event;
3348 /* Clear input event EVENT. */
3350 static INLINE void
3351 clear_event (event)
3352 struct input_event *event;
3354 int idx = 2 * (event - kbd_buffer);
3355 ASET (kbd_buffer_gcpro, idx, Qnil);
3356 ASET (kbd_buffer_gcpro, idx + 1, Qnil);
3357 event->kind = no_event;
3361 /* Read one event from the event buffer, waiting if necessary.
3362 The value is a Lisp object representing the event.
3363 The value is nil for an event that should be ignored,
3364 or that was handled here.
3365 We always read and discard one event. */
3367 static Lisp_Object
3368 kbd_buffer_get_event (kbp, used_mouse_menu)
3369 KBOARD **kbp;
3370 int *used_mouse_menu;
3372 register int c;
3373 Lisp_Object obj;
3375 if (noninteractive)
3377 c = getchar ();
3378 XSETINT (obj, c);
3379 *kbp = current_kboard;
3380 return obj;
3383 /* Wait until there is input available. */
3384 for (;;)
3386 if (kbd_fetch_ptr != kbd_store_ptr)
3387 break;
3388 #ifdef HAVE_MOUSE
3389 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3390 break;
3391 #endif
3393 /* If the quit flag is set, then read_char will return
3394 quit_char, so that counts as "available input." */
3395 if (!NILP (Vquit_flag))
3396 quit_throw_to_read_char ();
3398 /* One way or another, wait until input is available; then, if
3399 interrupt handlers have not read it, read it now. */
3401 #ifdef OLDVMS
3402 wait_for_kbd_input ();
3403 #else
3404 /* Note SIGIO has been undef'd if FIONREAD is missing. */
3405 #ifdef SIGIO
3406 gobble_input (0);
3407 #endif /* SIGIO */
3408 if (kbd_fetch_ptr != kbd_store_ptr)
3409 break;
3410 #ifdef HAVE_MOUSE
3411 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3412 break;
3413 #endif
3415 Lisp_Object minus_one;
3417 XSETINT (minus_one, -1);
3418 wait_reading_process_input (0, 0, minus_one, 1);
3420 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
3421 /* Pass 1 for EXPECT since we just waited to have input. */
3422 read_avail_input (1);
3424 #endif /* not VMS */
3427 if (CONSP (Vunread_command_events))
3429 Lisp_Object first;
3430 first = XCAR (Vunread_command_events);
3431 Vunread_command_events = XCDR (Vunread_command_events);
3432 *kbp = current_kboard;
3433 return first;
3436 /* At this point, we know that there is a readable event available
3437 somewhere. If the event queue is empty, then there must be a
3438 mouse movement enabled and available. */
3439 if (kbd_fetch_ptr != kbd_store_ptr)
3441 struct input_event *event;
3443 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3444 ? kbd_fetch_ptr
3445 : kbd_buffer);
3447 last_event_timestamp = event->timestamp;
3449 #ifdef MULTI_KBOARD
3450 *kbp = event_to_kboard (event);
3451 if (*kbp == 0)
3452 *kbp = current_kboard; /* Better than returning null ptr? */
3453 #else
3454 *kbp = &the_only_kboard;
3455 #endif
3457 obj = Qnil;
3459 /* These two kinds of events get special handling
3460 and don't actually appear to the command loop.
3461 We return nil for them. */
3462 if (event->kind == selection_request_event)
3464 #ifdef HAVE_X11
3465 struct input_event copy;
3467 /* Remove it from the buffer before processing it,
3468 since otherwise swallow_events will see it
3469 and process it again. */
3470 copy = *event;
3471 kbd_fetch_ptr = event + 1;
3472 input_pending = readable_events (0);
3473 x_handle_selection_request (&copy);
3474 #else
3475 /* We're getting selection request events, but we don't have
3476 a window system. */
3477 abort ();
3478 #endif
3481 else if (event->kind == selection_clear_event)
3483 #ifdef HAVE_X11
3484 struct input_event copy;
3486 /* Remove it from the buffer before processing it. */
3487 copy = *event;
3488 kbd_fetch_ptr = event + 1;
3489 input_pending = readable_events (0);
3490 x_handle_selection_clear (&copy);
3491 #else
3492 /* We're getting selection request events, but we don't have
3493 a window system. */
3494 abort ();
3495 #endif
3497 #if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (macintosh)
3498 else if (event->kind == delete_window_event)
3500 /* Make an event (delete-frame (FRAME)). */
3501 obj = Fcons (event->frame_or_window, Qnil);
3502 obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
3503 kbd_fetch_ptr = event + 1;
3505 #endif
3506 #if defined (HAVE_X11) || defined (HAVE_NTGUI)
3507 else if (event->kind == iconify_event)
3509 /* Make an event (iconify-frame (FRAME)). */
3510 obj = Fcons (event->frame_or_window, Qnil);
3511 obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
3512 kbd_fetch_ptr = event + 1;
3514 else if (event->kind == deiconify_event)
3516 /* Make an event (make-frame-visible (FRAME)). */
3517 obj = Fcons (event->frame_or_window, Qnil);
3518 obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
3519 kbd_fetch_ptr = event + 1;
3521 #endif
3522 else if (event->kind == buffer_switch_event)
3524 /* The value doesn't matter here; only the type is tested. */
3525 XSETBUFFER (obj, current_buffer);
3526 kbd_fetch_ptr = event + 1;
3528 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
3529 else if (event->kind == menu_bar_activate_event)
3531 kbd_fetch_ptr = event + 1;
3532 input_pending = readable_events (0);
3533 if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
3534 x_activate_menubar (XFRAME (event->frame_or_window));
3536 #endif
3537 #ifdef WINDOWSNT
3538 else if (event->kind == language_change_event)
3540 /* Make an event (language-change (FRAME CHARSET LCID)). */
3541 obj = Fcons (event->modifiers, Qnil);
3542 obj = Fcons (event->code, Qnil);
3543 obj = Fcons (event->frame_or_window, obj);
3544 obj = Fcons (Qlanguage_change, Fcons (obj, Qnil));
3545 kbd_fetch_ptr = event + 1;
3547 #endif
3548 /* Just discard these, by returning nil.
3549 With MULTI_KBOARD, these events are used as placeholders
3550 when we need to randomly delete events from the queue.
3551 (They shouldn't otherwise be found in the buffer,
3552 but on some machines it appears they do show up
3553 even without MULTI_KBOARD.) */
3554 /* On Windows NT/9X, no_event is used to delete extraneous
3555 mouse events during a popup-menu call. */
3556 else if (event->kind == no_event)
3557 kbd_fetch_ptr = event + 1;
3558 else if (event->kind == HELP_EVENT)
3560 /* There are always two HELP_EVENTs in the input queue. */
3561 Lisp_Object object, position, help, frame, window;
3563 xassert (event->code == 0);
3564 frame = event->frame_or_window;
3565 object = event->arg;
3566 position = event->x;
3567 clear_event (event);
3569 kbd_fetch_ptr = event + 1;
3570 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3571 ? kbd_fetch_ptr
3572 : kbd_buffer);
3573 xassert (event->code == 1);
3574 help = event->arg;
3575 window = event->frame_or_window;
3576 if (!WINDOWP (window))
3577 window = Qnil;
3578 obj = Fcons (Qhelp_echo,
3579 list5 (frame, help, window, object, position));
3580 clear_event (event);
3581 kbd_fetch_ptr = event + 1;
3583 else if (event->kind == FOCUS_IN_EVENT)
3585 /* Notification of a FocusIn event. The frame receiving the
3586 focus is in event->frame_or_window. Generate a
3587 switch-frame event if necessary. */
3588 Lisp_Object frame, focus;
3590 frame = event->frame_or_window;
3591 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
3592 if (FRAMEP (focus))
3593 frame = focus;
3595 if (!EQ (frame, internal_last_event_frame)
3596 && !EQ (frame, selected_frame))
3597 obj = make_lispy_switch_frame (frame);
3598 internal_last_event_frame = frame;
3599 kbd_fetch_ptr = event + 1;
3601 else
3603 /* If this event is on a different frame, return a switch-frame this
3604 time, and leave the event in the queue for next time. */
3605 Lisp_Object frame;
3606 Lisp_Object focus;
3608 frame = event->frame_or_window;
3609 if (CONSP (frame))
3610 frame = XCAR (frame);
3611 else if (WINDOWP (frame))
3612 frame = WINDOW_FRAME (XWINDOW (frame));
3614 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
3615 if (! NILP (focus))
3616 frame = focus;
3618 if (! EQ (frame, internal_last_event_frame)
3619 && !EQ (frame, selected_frame))
3620 obj = make_lispy_switch_frame (frame);
3621 internal_last_event_frame = frame;
3623 /* If we didn't decide to make a switch-frame event, go ahead
3624 and build a real event from the queue entry. */
3626 if (NILP (obj))
3628 int idx;
3630 obj = make_lispy_event (event);
3632 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI)
3633 /* If this was a menu selection, then set the flag to inhibit
3634 writing to last_nonmenu_event. Don't do this if the event
3635 we're returning is (menu-bar), though; that indicates the
3636 beginning of the menu sequence, and we might as well leave
3637 that as the `event with parameters' for this selection. */
3638 if (used_mouse_menu
3639 && !EQ (event->frame_or_window, event->arg)
3640 && (event->kind == MENU_BAR_EVENT
3641 || event->kind == TOOL_BAR_EVENT))
3642 *used_mouse_menu = 1;
3643 #endif
3645 /* Wipe out this event, to catch bugs. */
3646 clear_event (event);
3647 kbd_fetch_ptr = event + 1;
3651 #ifdef HAVE_MOUSE
3652 /* Try generating a mouse motion event. */
3653 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3655 FRAME_PTR f = some_mouse_moved ();
3656 Lisp_Object bar_window;
3657 enum scroll_bar_part part;
3658 Lisp_Object x, y;
3659 unsigned long time;
3661 *kbp = current_kboard;
3662 /* Note that this uses F to determine which display to look at.
3663 If there is no valid info, it does not store anything
3664 so x remains nil. */
3665 x = Qnil;
3666 (*mouse_position_hook) (&f, 0, &bar_window, &part, &x, &y, &time);
3668 obj = Qnil;
3670 /* Decide if we should generate a switch-frame event. Don't
3671 generate switch-frame events for motion outside of all Emacs
3672 frames. */
3673 if (!NILP (x) && f)
3675 Lisp_Object frame;
3677 frame = FRAME_FOCUS_FRAME (f);
3678 if (NILP (frame))
3679 XSETFRAME (frame, f);
3681 if (! EQ (frame, internal_last_event_frame)
3682 && !EQ (frame, selected_frame))
3683 obj = make_lispy_switch_frame (frame);
3684 internal_last_event_frame = frame;
3687 /* If we didn't decide to make a switch-frame event, go ahead and
3688 return a mouse-motion event. */
3689 if (!NILP (x) && NILP (obj))
3690 obj = make_lispy_movement (f, bar_window, part, x, y, time);
3692 #endif /* HAVE_MOUSE */
3693 else
3694 /* We were promised by the above while loop that there was
3695 something for us to read! */
3696 abort ();
3698 input_pending = readable_events (0);
3700 Vlast_event_frame = internal_last_event_frame;
3702 return (obj);
3705 /* Process any events that are not user-visible,
3706 then return, without reading any user-visible events. */
3708 void
3709 swallow_events (do_display)
3710 int do_display;
3712 int old_timers_run;
3714 while (kbd_fetch_ptr != kbd_store_ptr)
3716 struct input_event *event;
3718 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3719 ? kbd_fetch_ptr
3720 : kbd_buffer);
3722 last_event_timestamp = event->timestamp;
3724 /* These two kinds of events get special handling
3725 and don't actually appear to the command loop. */
3726 if (event->kind == selection_request_event)
3728 #ifdef HAVE_X11
3729 struct input_event copy;
3731 /* Remove it from the buffer before processing it,
3732 since otherwise swallow_events called recursively could see it
3733 and process it again. */
3734 copy = *event;
3735 kbd_fetch_ptr = event + 1;
3736 input_pending = readable_events (0);
3737 x_handle_selection_request (&copy);
3738 #else
3739 /* We're getting selection request events, but we don't have
3740 a window system. */
3741 abort ();
3742 #endif
3745 else if (event->kind == selection_clear_event)
3747 #ifdef HAVE_X11
3748 struct input_event copy;
3750 /* Remove it from the buffer before processing it, */
3751 copy = *event;
3753 kbd_fetch_ptr = event + 1;
3754 input_pending = readable_events (0);
3755 x_handle_selection_clear (&copy);
3756 #else
3757 /* We're getting selection request events, but we don't have
3758 a window system. */
3759 abort ();
3760 #endif
3762 else
3763 break;
3766 old_timers_run = timers_run;
3767 get_input_pending (&input_pending, 1);
3769 if (timers_run != old_timers_run && do_display)
3770 redisplay_preserve_echo_area ();
3773 static EMACS_TIME timer_idleness_start_time;
3775 /* Record the start of when Emacs is idle,
3776 for the sake of running idle-time timers. */
3778 void
3779 timer_start_idle ()
3781 Lisp_Object timers;
3783 /* If we are already in the idle state, do nothing. */
3784 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3785 return;
3787 EMACS_GET_TIME (timer_idleness_start_time);
3789 /* Mark all idle-time timers as once again candidates for running. */
3790 for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers))
3792 Lisp_Object timer;
3794 timer = XCAR (timers);
3796 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3797 continue;
3798 XVECTOR (timer)->contents[0] = Qnil;
3802 /* Record that Emacs is no longer idle, so stop running idle-time timers. */
3804 void
3805 timer_stop_idle ()
3807 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
3810 /* This is only for debugging. */
3811 struct input_event last_timer_event;
3813 /* Check whether a timer has fired. To prevent larger problems we simply
3814 disregard elements that are not proper timers. Do not make a circular
3815 timer list for the time being.
3817 Returns the number of seconds to wait until the next timer fires. If a
3818 timer is triggering now, return zero seconds.
3819 If no timer is active, return -1 seconds.
3821 If a timer is ripe, we run it, with quitting turned off.
3823 DO_IT_NOW is now ignored. It used to mean that we should
3824 run the timer directly instead of queueing a timer-event.
3825 Now we always run timers directly. */
3827 EMACS_TIME
3828 timer_check (do_it_now)
3829 int do_it_now;
3831 EMACS_TIME nexttime;
3832 EMACS_TIME now, idleness_now;
3833 Lisp_Object timers, idle_timers, chosen_timer;
3834 struct gcpro gcpro1, gcpro2, gcpro3;
3836 EMACS_SET_SECS (nexttime, -1);
3837 EMACS_SET_USECS (nexttime, -1);
3839 /* Always consider the ordinary timers. */
3840 timers = Vtimer_list;
3841 /* Consider the idle timers only if Emacs is idle. */
3842 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3843 idle_timers = Vtimer_idle_list;
3844 else
3845 idle_timers = Qnil;
3846 chosen_timer = Qnil;
3847 GCPRO3 (timers, idle_timers, chosen_timer);
3849 if (CONSP (timers) || CONSP (idle_timers))
3851 EMACS_GET_TIME (now);
3852 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3853 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
3856 while (CONSP (timers) || CONSP (idle_timers))
3858 Lisp_Object *vector;
3859 Lisp_Object timer = Qnil, idle_timer = Qnil;
3860 EMACS_TIME timer_time, idle_timer_time;
3861 EMACS_TIME difference, timer_difference, idle_timer_difference;
3863 /* Skip past invalid timers and timers already handled. */
3864 if (!NILP (timers))
3866 timer = XCAR (timers);
3867 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3869 timers = XCDR (timers);
3870 continue;
3872 vector = XVECTOR (timer)->contents;
3874 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
3875 || !INTEGERP (vector[3])
3876 || ! NILP (vector[0]))
3878 timers = XCDR (timers);
3879 continue;
3882 if (!NILP (idle_timers))
3884 timer = XCAR (idle_timers);
3885 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3887 idle_timers = XCDR (idle_timers);
3888 continue;
3890 vector = XVECTOR (timer)->contents;
3892 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
3893 || !INTEGERP (vector[3])
3894 || ! NILP (vector[0]))
3896 idle_timers = XCDR (idle_timers);
3897 continue;
3901 /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
3902 based on the next ordinary timer.
3903 TIMER_DIFFERENCE is the distance in time from NOW to when
3904 this timer becomes ripe (negative if it's already ripe). */
3905 if (!NILP (timers))
3907 timer = XCAR (timers);
3908 vector = XVECTOR (timer)->contents;
3909 EMACS_SET_SECS (timer_time,
3910 (XINT (vector[1]) << 16) | (XINT (vector[2])));
3911 EMACS_SET_USECS (timer_time, XINT (vector[3]));
3912 EMACS_SUB_TIME (timer_difference, timer_time, now);
3915 /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
3916 based on the next idle timer. */
3917 if (!NILP (idle_timers))
3919 idle_timer = XCAR (idle_timers);
3920 vector = XVECTOR (idle_timer)->contents;
3921 EMACS_SET_SECS (idle_timer_time,
3922 (XINT (vector[1]) << 16) | (XINT (vector[2])));
3923 EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
3924 EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
3927 /* Decide which timer is the next timer,
3928 and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
3929 Also step down the list where we found that timer. */
3931 if (! NILP (timers) && ! NILP (idle_timers))
3933 EMACS_TIME temp;
3934 EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
3935 if (EMACS_TIME_NEG_P (temp))
3937 chosen_timer = timer;
3938 timers = XCDR (timers);
3939 difference = timer_difference;
3941 else
3943 chosen_timer = idle_timer;
3944 idle_timers = XCDR (idle_timers);
3945 difference = idle_timer_difference;
3948 else if (! NILP (timers))
3950 chosen_timer = timer;
3951 timers = XCDR (timers);
3952 difference = timer_difference;
3954 else
3956 chosen_timer = idle_timer;
3957 idle_timers = XCDR (idle_timers);
3958 difference = idle_timer_difference;
3960 vector = XVECTOR (chosen_timer)->contents;
3962 /* If timer is ripe, run it if it hasn't been run. */
3963 if (EMACS_TIME_NEG_P (difference)
3964 || (EMACS_SECS (difference) == 0
3965 && EMACS_USECS (difference) == 0))
3967 if (NILP (vector[0]))
3969 int was_locked = single_kboard;
3970 int count = specpdl_ptr - specpdl;
3972 /* Mark the timer as triggered to prevent problems if the lisp
3973 code fails to reschedule it right. */
3974 vector[0] = Qt;
3976 specbind (Qinhibit_quit, Qt);
3978 call1 (Qtimer_event_handler, chosen_timer);
3979 timers_run++;
3981 unbind_to (count, Qnil);
3983 /* Resume allowing input from any kboard, if that was true before. */
3984 if (!was_locked)
3985 any_kboard_state ();
3987 /* Since we have handled the event,
3988 we don't need to tell the caller to wake up and do it. */
3991 else
3992 /* When we encounter a timer that is still waiting,
3993 return the amount of time to wait before it is ripe. */
3995 UNGCPRO;
3996 return difference;
4000 /* No timers are pending in the future. */
4001 /* Return 0 if we generated an event, and -1 if not. */
4002 UNGCPRO;
4003 return nexttime;
4006 /* Caches for modify_event_symbol. */
4007 static Lisp_Object accent_key_syms;
4008 static Lisp_Object func_key_syms;
4009 static Lisp_Object mouse_syms;
4010 #ifdef WINDOWSNT
4011 static Lisp_Object mouse_wheel_syms;
4012 #endif
4013 static Lisp_Object drag_n_drop_syms;
4015 /* This is a list of keysym codes for special "accent" characters.
4016 It parallels lispy_accent_keys. */
4018 static int lispy_accent_codes[] =
4020 #ifdef XK_dead_circumflex
4021 XK_dead_circumflex,
4022 #else
4024 #endif
4025 #ifdef XK_dead_grave
4026 XK_dead_grave,
4027 #else
4029 #endif
4030 #ifdef XK_dead_tilde
4031 XK_dead_tilde,
4032 #else
4034 #endif
4035 #ifdef XK_dead_diaeresis
4036 XK_dead_diaeresis,
4037 #else
4039 #endif
4040 #ifdef XK_dead_macron
4041 XK_dead_macron,
4042 #else
4044 #endif
4045 #ifdef XK_dead_degree
4046 XK_dead_degree,
4047 #else
4049 #endif
4050 #ifdef XK_dead_acute
4051 XK_dead_acute,
4052 #else
4054 #endif
4055 #ifdef XK_dead_cedilla
4056 XK_dead_cedilla,
4057 #else
4059 #endif
4060 #ifdef XK_dead_breve
4061 XK_dead_breve,
4062 #else
4064 #endif
4065 #ifdef XK_dead_ogonek
4066 XK_dead_ogonek,
4067 #else
4069 #endif
4070 #ifdef XK_dead_caron
4071 XK_dead_caron,
4072 #else
4074 #endif
4075 #ifdef XK_dead_doubleacute
4076 XK_dead_doubleacute,
4077 #else
4079 #endif
4080 #ifdef XK_dead_abovedot
4081 XK_dead_abovedot,
4082 #else
4084 #endif
4087 /* This is a list of Lisp names for special "accent" characters.
4088 It parallels lispy_accent_codes. */
4090 static char *lispy_accent_keys[] =
4092 "dead-circumflex",
4093 "dead-grave",
4094 "dead-tilde",
4095 "dead-diaeresis",
4096 "dead-macron",
4097 "dead-degree",
4098 "dead-acute",
4099 "dead-cedilla",
4100 "dead-breve",
4101 "dead-ogonek",
4102 "dead-caron",
4103 "dead-doubleacute",
4104 "dead-abovedot",
4107 #ifdef HAVE_NTGUI
4108 #define FUNCTION_KEY_OFFSET 0x0
4110 char *lispy_function_keys[] =
4112 0, /* 0 */
4114 0, /* VK_LBUTTON 0x01 */
4115 0, /* VK_RBUTTON 0x02 */
4116 "cancel", /* VK_CANCEL 0x03 */
4117 0, /* VK_MBUTTON 0x04 */
4119 0, 0, 0, /* 0x05 .. 0x07 */
4121 "backspace", /* VK_BACK 0x08 */
4122 "tab", /* VK_TAB 0x09 */
4124 0, 0, /* 0x0A .. 0x0B */
4126 "clear", /* VK_CLEAR 0x0C */
4127 "return", /* VK_RETURN 0x0D */
4129 0, 0, /* 0x0E .. 0x0F */
4131 0, /* VK_SHIFT 0x10 */
4132 0, /* VK_CONTROL 0x11 */
4133 0, /* VK_MENU 0x12 */
4134 "pause", /* VK_PAUSE 0x13 */
4135 "capslock", /* VK_CAPITAL 0x14 */
4137 0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */
4139 "escape", /* VK_ESCAPE 0x1B */
4141 0, 0, 0, 0, /* 0x1C .. 0x1F */
4143 0, /* VK_SPACE 0x20 */
4144 "prior", /* VK_PRIOR 0x21 */
4145 "next", /* VK_NEXT 0x22 */
4146 "end", /* VK_END 0x23 */
4147 "home", /* VK_HOME 0x24 */
4148 "left", /* VK_LEFT 0x25 */
4149 "up", /* VK_UP 0x26 */
4150 "right", /* VK_RIGHT 0x27 */
4151 "down", /* VK_DOWN 0x28 */
4152 "select", /* VK_SELECT 0x29 */
4153 "print", /* VK_PRINT 0x2A */
4154 "execute", /* VK_EXECUTE 0x2B */
4155 "snapshot", /* VK_SNAPSHOT 0x2C */
4156 "insert", /* VK_INSERT 0x2D */
4157 "delete", /* VK_DELETE 0x2E */
4158 "help", /* VK_HELP 0x2F */
4160 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
4162 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4164 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
4166 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
4168 0, 0, 0, 0, 0, 0, 0, 0, 0,
4169 0, 0, 0, 0, 0, 0, 0, 0, 0,
4170 0, 0, 0, 0, 0, 0, 0, 0,
4172 "lwindow", /* VK_LWIN 0x5B */
4173 "rwindow", /* VK_RWIN 0x5C */
4174 "apps", /* VK_APPS 0x5D */
4176 0, 0, /* 0x5E .. 0x5F */
4178 "kp-0", /* VK_NUMPAD0 0x60 */
4179 "kp-1", /* VK_NUMPAD1 0x61 */
4180 "kp-2", /* VK_NUMPAD2 0x62 */
4181 "kp-3", /* VK_NUMPAD3 0x63 */
4182 "kp-4", /* VK_NUMPAD4 0x64 */
4183 "kp-5", /* VK_NUMPAD5 0x65 */
4184 "kp-6", /* VK_NUMPAD6 0x66 */
4185 "kp-7", /* VK_NUMPAD7 0x67 */
4186 "kp-8", /* VK_NUMPAD8 0x68 */
4187 "kp-9", /* VK_NUMPAD9 0x69 */
4188 "kp-multiply", /* VK_MULTIPLY 0x6A */
4189 "kp-add", /* VK_ADD 0x6B */
4190 "kp-separator", /* VK_SEPARATOR 0x6C */
4191 "kp-subtract", /* VK_SUBTRACT 0x6D */
4192 "kp-decimal", /* VK_DECIMAL 0x6E */
4193 "kp-divide", /* VK_DIVIDE 0x6F */
4194 "f1", /* VK_F1 0x70 */
4195 "f2", /* VK_F2 0x71 */
4196 "f3", /* VK_F3 0x72 */
4197 "f4", /* VK_F4 0x73 */
4198 "f5", /* VK_F5 0x74 */
4199 "f6", /* VK_F6 0x75 */
4200 "f7", /* VK_F7 0x76 */
4201 "f8", /* VK_F8 0x77 */
4202 "f9", /* VK_F9 0x78 */
4203 "f10", /* VK_F10 0x79 */
4204 "f11", /* VK_F11 0x7A */
4205 "f12", /* VK_F12 0x7B */
4206 "f13", /* VK_F13 0x7C */
4207 "f14", /* VK_F14 0x7D */
4208 "f15", /* VK_F15 0x7E */
4209 "f16", /* VK_F16 0x7F */
4210 "f17", /* VK_F17 0x80 */
4211 "f18", /* VK_F18 0x81 */
4212 "f19", /* VK_F19 0x82 */
4213 "f20", /* VK_F20 0x83 */
4214 "f21", /* VK_F21 0x84 */
4215 "f22", /* VK_F22 0x85 */
4216 "f23", /* VK_F23 0x86 */
4217 "f24", /* VK_F24 0x87 */
4219 0, 0, 0, 0, /* 0x88 .. 0x8B */
4220 0, 0, 0, 0, /* 0x8C .. 0x8F */
4222 "kp-numlock", /* VK_NUMLOCK 0x90 */
4223 "scroll", /* VK_SCROLL 0x91 */
4225 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
4226 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
4227 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
4228 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
4229 "kp-end", /* VK_NUMPAD_END 0x96 */
4230 "kp-home", /* VK_NUMPAD_HOME 0x97 */
4231 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
4232 "kp-up", /* VK_NUMPAD_UP 0x99 */
4233 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
4234 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
4235 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
4236 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
4238 0, 0, /* 0x9E .. 0x9F */
4241 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
4242 * Used only as parameters to GetAsyncKeyState and GetKeyState.
4243 * No other API or message will distinguish left and right keys this way.
4245 /* 0xA0 .. 0xEF */
4247 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4248 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4249 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4250 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4251 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4253 /* 0xF0 .. 0xF5 */
4255 0, 0, 0, 0, 0, 0,
4257 "attn", /* VK_ATTN 0xF6 */
4258 "crsel", /* VK_CRSEL 0xF7 */
4259 "exsel", /* VK_EXSEL 0xF8 */
4260 "ereof", /* VK_EREOF 0xF9 */
4261 "play", /* VK_PLAY 0xFA */
4262 "zoom", /* VK_ZOOM 0xFB */
4263 "noname", /* VK_NONAME 0xFC */
4264 "pa1", /* VK_PA1 0xFD */
4265 "oem_clear", /* VK_OEM_CLEAR 0xFE */
4266 0 /* 0xFF */
4269 #else /* not HAVE_NTGUI */
4271 #ifdef XK_kana_A
4272 static char *lispy_kana_keys[] =
4274 /* X Keysym value */
4275 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
4276 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
4277 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
4278 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
4279 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
4280 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
4281 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
4282 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
4283 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
4284 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
4285 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
4286 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
4287 "kana-i", "kana-u", "kana-e", "kana-o",
4288 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
4289 "prolongedsound", "kana-A", "kana-I", "kana-U",
4290 "kana-E", "kana-O", "kana-KA", "kana-KI",
4291 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
4292 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
4293 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
4294 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
4295 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
4296 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
4297 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
4298 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
4299 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
4300 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
4301 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
4302 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
4304 #endif /* XK_kana_A */
4306 #define FUNCTION_KEY_OFFSET 0xff00
4308 /* You'll notice that this table is arranged to be conveniently
4309 indexed by X Windows keysym values. */
4310 static char *lispy_function_keys[] =
4312 /* X Keysym value */
4314 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
4315 "backspace", "tab", "linefeed", "clear",
4316 0, "return", 0, 0,
4317 0, 0, 0, "pause", /* 0xff10...1f */
4318 0, 0, 0, 0, 0, 0, 0, "escape",
4319 0, 0, 0, 0,
4320 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
4321 "romaji", "hiragana", "katakana", "hiragana-katakana",
4322 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
4323 "massyo", "kana-lock", "kana-shift", "eisu-shift",
4324 "eisu-toggle", /* 0xff30...3f */
4325 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4326 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
4328 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
4329 "down", "prior", "next", "end",
4330 "begin", 0, 0, 0, 0, 0, 0, 0,
4331 "select", /* 0xff60 */ /* IsMiscFunctionKey */
4332 "print",
4333 "execute",
4334 "insert",
4335 0, /* 0xff64 */
4336 "undo",
4337 "redo",
4338 "menu",
4339 "find",
4340 "cancel",
4341 "help",
4342 "break", /* 0xff6b */
4344 0, 0, 0, 0,
4345 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
4346 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
4347 "kp-space", /* 0xff80 */ /* IsKeypadKey */
4348 0, 0, 0, 0, 0, 0, 0, 0,
4349 "kp-tab", /* 0xff89 */
4350 0, 0, 0,
4351 "kp-enter", /* 0xff8d */
4352 0, 0, 0,
4353 "kp-f1", /* 0xff91 */
4354 "kp-f2",
4355 "kp-f3",
4356 "kp-f4",
4357 "kp-home", /* 0xff95 */
4358 "kp-left",
4359 "kp-up",
4360 "kp-right",
4361 "kp-down",
4362 "kp-prior", /* kp-page-up */
4363 "kp-next", /* kp-page-down */
4364 "kp-end",
4365 "kp-begin",
4366 "kp-insert",
4367 "kp-delete",
4368 0, /* 0xffa0 */
4369 0, 0, 0, 0, 0, 0, 0, 0, 0,
4370 "kp-multiply", /* 0xffaa */
4371 "kp-add",
4372 "kp-separator",
4373 "kp-subtract",
4374 "kp-decimal",
4375 "kp-divide", /* 0xffaf */
4376 "kp-0", /* 0xffb0 */
4377 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
4378 0, /* 0xffba */
4379 0, 0,
4380 "kp-equal", /* 0xffbd */
4381 "f1", /* 0xffbe */ /* IsFunctionKey */
4382 "f2",
4383 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
4384 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
4385 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
4386 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
4387 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
4388 0, 0, 0, 0, 0, 0, 0, 0,
4389 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
4390 0, 0, 0, 0, 0, 0, 0, "delete"
4393 /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
4394 #define ISO_FUNCTION_KEY_OFFSET 0xfe00
4396 static char *iso_lispy_function_keys[] =
4398 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
4399 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
4400 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
4401 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
4402 "iso-lefttab", /* 0xfe20 */
4403 "iso-move-line-up", "iso-move-line-down",
4404 "iso-partial-line-up", "iso-partial-line-down",
4405 "iso-partial-space-left", "iso-partial-space-right",
4406 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
4407 "iso-release-margin-left", "iso-release-margin-right",
4408 "iso-release-both-margins",
4409 "iso-fast-cursor-left", "iso-fast-cursor-right",
4410 "iso-fast-cursor-up", "iso-fast-cursor-down",
4411 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
4412 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
4415 #endif /* not HAVE_NTGUI */
4417 Lisp_Object Vlispy_mouse_stem;
4419 #ifdef WINDOWSNT
4420 /* mouse-wheel events are generated by the wheel on devices such as
4421 the MS Intellimouse. The wheel sits in between the left and right
4422 mouse buttons, and is typically used to scroll or zoom the window
4423 underneath the pointer. mouse-wheel events specify the object on
4424 which they operate, and a delta corresponding to the amount and
4425 direction that the wheel is rotated. Clicking the mouse-wheel
4426 generates a mouse-2 event. */
4427 static char *lispy_mouse_wheel_names[] =
4429 "mouse-wheel"
4432 #endif /* WINDOWSNT */
4434 /* drag-n-drop events are generated when a set of selected files are
4435 dragged from another application and dropped onto an Emacs window. */
4436 static char *lispy_drag_n_drop_names[] =
4438 "drag-n-drop"
4441 /* Scroll bar parts. */
4442 Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
4443 Lisp_Object Qup, Qdown, Qbottom, Qend_scroll;
4444 Lisp_Object Qtop, Qratio;
4446 /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
4447 Lisp_Object *scroll_bar_parts[] = {
4448 &Qabove_handle, &Qhandle, &Qbelow_handle,
4449 &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio
4452 /* User signal events. */
4453 Lisp_Object Qusr1_signal, Qusr2_signal;
4455 Lisp_Object *lispy_user_signals[] =
4457 &Qusr1_signal, &Qusr2_signal
4461 /* A vector, indexed by button number, giving the down-going location
4462 of currently depressed buttons, both scroll bar and non-scroll bar.
4464 The elements have the form
4465 (BUTTON-NUMBER MODIFIER-MASK . REST)
4466 where REST is the cdr of a position as it would be reported in the event.
4468 The make_lispy_event function stores positions here to tell the
4469 difference between click and drag events, and to store the starting
4470 location to be included in drag events. */
4472 static Lisp_Object button_down_location;
4474 /* Information about the most recent up-going button event: Which
4475 button, what location, and what time. */
4477 static int last_mouse_button;
4478 static int last_mouse_x;
4479 static int last_mouse_y;
4480 static unsigned long button_down_time;
4482 /* The maximum time between clicks to make a double-click,
4483 or Qnil to disable double-click detection,
4484 or Qt for no time limit. */
4485 Lisp_Object Vdouble_click_time;
4487 /* The number of clicks in this multiple-click. */
4489 int double_click_count;
4491 /* Given a struct input_event, build the lisp event which represents
4492 it. If EVENT is 0, build a mouse movement event from the mouse
4493 movement buffer, which should have a movement event in it.
4495 Note that events must be passed to this function in the order they
4496 are received; this function stores the location of button presses
4497 in order to build drag events when the button is released. */
4499 static Lisp_Object
4500 make_lispy_event (event)
4501 struct input_event *event;
4503 int i;
4505 switch (SWITCH_ENUM_CAST (event->kind))
4507 /* A simple keystroke. */
4508 case ascii_keystroke:
4510 Lisp_Object lispy_c;
4511 int c = event->code & 0377;
4512 /* Turn ASCII characters into control characters
4513 when proper. */
4514 if (event->modifiers & ctrl_modifier)
4515 c = make_ctrl_char (c);
4517 /* Add in the other modifier bits. We took care of ctrl_modifier
4518 just above, and the shift key was taken care of by the X code,
4519 and applied to control characters by make_ctrl_char. */
4520 c |= (event->modifiers
4521 & (meta_modifier | alt_modifier
4522 | hyper_modifier | super_modifier));
4523 /* Distinguish Shift-SPC from SPC. */
4524 if ((event->code & 0377) == 040
4525 && event->modifiers & shift_modifier)
4526 c |= shift_modifier;
4527 button_down_time = 0;
4528 XSETFASTINT (lispy_c, c);
4529 return lispy_c;
4532 case multibyte_char_keystroke:
4534 Lisp_Object lispy_c;
4536 XSETFASTINT (lispy_c, event->code);
4537 return lispy_c;
4540 /* A function key. The symbol may need to have modifier prefixes
4541 tacked onto it. */
4542 case non_ascii_keystroke:
4543 button_down_time = 0;
4545 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
4546 if (event->code == lispy_accent_codes[i])
4547 return modify_event_symbol (i,
4548 event->modifiers,
4549 Qfunction_key, Qnil,
4550 lispy_accent_keys, &accent_key_syms,
4551 (sizeof (lispy_accent_keys)
4552 / sizeof (lispy_accent_keys[0])));
4554 /* Handle system-specific keysyms. */
4555 if (event->code & (1 << 28))
4557 /* We need to use an alist rather than a vector as the cache
4558 since we can't make a vector long enuf. */
4559 if (NILP (current_kboard->system_key_syms))
4560 current_kboard->system_key_syms = Fcons (Qnil, Qnil);
4561 return modify_event_symbol (event->code,
4562 event->modifiers,
4563 Qfunction_key,
4564 current_kboard->Vsystem_key_alist,
4565 0, &current_kboard->system_key_syms,
4566 (unsigned)-1);
4569 #ifdef XK_kana_A
4570 if (event->code >= 0x400 && event->code < 0x500)
4571 return modify_event_symbol (event->code - 0x400,
4572 event->modifiers & ~shift_modifier,
4573 Qfunction_key, Qnil,
4574 lispy_kana_keys, &func_key_syms,
4575 (sizeof (lispy_kana_keys)
4576 / sizeof (lispy_kana_keys[0])));
4577 #endif /* XK_kana_A */
4579 #ifdef ISO_FUNCTION_KEY_OFFSET
4580 if (event->code < FUNCTION_KEY_OFFSET
4581 && event->code >= ISO_FUNCTION_KEY_OFFSET)
4582 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
4583 event->modifiers,
4584 Qfunction_key, Qnil,
4585 iso_lispy_function_keys, &func_key_syms,
4586 (sizeof (iso_lispy_function_keys)
4587 / sizeof (iso_lispy_function_keys[0])));
4588 else
4589 #endif
4590 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
4591 event->modifiers,
4592 Qfunction_key, Qnil,
4593 lispy_function_keys, &func_key_syms,
4594 (sizeof (lispy_function_keys)
4595 / sizeof (lispy_function_keys[0])));
4597 #ifdef HAVE_MOUSE
4598 /* A mouse click. Figure out where it is, decide whether it's
4599 a press, click or drag, and build the appropriate structure. */
4600 case mouse_click:
4601 #ifndef USE_TOOLKIT_SCROLL_BARS
4602 case scroll_bar_click:
4603 #endif
4605 int button = event->code;
4606 int is_double;
4607 Lisp_Object position;
4608 Lisp_Object *start_pos_ptr;
4609 Lisp_Object start_pos;
4611 position = Qnil;
4613 /* Build the position as appropriate for this mouse click. */
4614 if (event->kind == mouse_click)
4616 int part;
4617 FRAME_PTR f = XFRAME (event->frame_or_window);
4618 Lisp_Object window;
4619 Lisp_Object posn;
4620 Lisp_Object string_info = Qnil;
4621 int row, column;
4623 /* Ignore mouse events that were made on frame that
4624 have been deleted. */
4625 if (! FRAME_LIVE_P (f))
4626 return Qnil;
4628 /* EVENT->x and EVENT->y are frame-relative pixel
4629 coordinates at this place. Under old redisplay, COLUMN
4630 and ROW are set to frame relative glyph coordinates
4631 which are then used to determine whether this click is
4632 in a menu (non-toolkit version). */
4633 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
4634 &column, &row, NULL, 1);
4636 #ifndef USE_X_TOOLKIT
4637 /* In the non-toolkit version, clicks on the menu bar
4638 are ordinary button events in the event buffer.
4639 Distinguish them, and invoke the menu.
4641 (In the toolkit version, the toolkit handles the menu bar
4642 and Emacs doesn't know about it until after the user
4643 makes a selection.) */
4644 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
4645 && (event->modifiers & down_modifier))
4647 Lisp_Object items, item;
4648 int hpos;
4649 int i;
4651 #if 0
4652 /* Activate the menu bar on the down event. If the
4653 up event comes in before the menu code can deal with it,
4654 just ignore it. */
4655 if (! (event->modifiers & down_modifier))
4656 return Qnil;
4657 #endif
4659 /* Find the menu bar item under `column'. */
4660 item = Qnil;
4661 items = FRAME_MENU_BAR_ITEMS (f);
4662 for (i = 0; i < XVECTOR (items)->size; i += 4)
4664 Lisp_Object pos, string;
4665 string = XVECTOR (items)->contents[i + 1];
4666 pos = XVECTOR (items)->contents[i + 3];
4667 if (NILP (string))
4668 break;
4669 if (column >= XINT (pos)
4670 && column < XINT (pos) + XSTRING (string)->size)
4672 item = XVECTOR (items)->contents[i];
4673 break;
4677 /* ELisp manual 2.4b says (x y) are window relative but
4678 code says they are frame-relative. */
4679 position
4680 = Fcons (event->frame_or_window,
4681 Fcons (Qmenu_bar,
4682 Fcons (Fcons (event->x, event->y),
4683 Fcons (make_number (event->timestamp),
4684 Qnil))));
4686 return Fcons (item, Fcons (position, Qnil));
4688 #endif /* not USE_X_TOOLKIT */
4690 /* Set `window' to the window under frame pixel coordinates
4691 event->x/event->y. */
4692 window = window_from_coordinates (f, XINT (event->x),
4693 XINT (event->y), &part, 0);
4695 if (!WINDOWP (window))
4697 window = event->frame_or_window;
4698 posn = Qnil;
4700 else
4702 /* It's a click in window window at frame coordinates
4703 event->x/ event->y. */
4704 struct window *w = XWINDOW (window);
4706 /* Get window relative coordinates. Original code
4707 `rounded' this to glyph boundaries. */
4708 int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
4709 int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
4711 /* Set event coordinates to window-relative coordinates
4712 for constructing the Lisp event below. */
4713 XSETINT (event->x, wx);
4714 XSETINT (event->y, wy);
4716 if (part == 1 || part == 3)
4718 /* Mode line or header line. Look for a string under
4719 the mouse that may have a `local-map' property. */
4720 Lisp_Object string;
4721 int charpos;
4723 posn = part == 1 ? Qmode_line : Qheader_line;
4724 string = mode_line_string (w, wx, wy, part == 1, &charpos);
4725 if (STRINGP (string))
4726 string_info = Fcons (string, make_number (charpos));
4728 else if (part == 2)
4729 posn = Qvertical_line;
4730 else
4731 XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy));
4734 position
4735 = Fcons (window,
4736 Fcons (posn,
4737 Fcons (Fcons (event->x, event->y),
4738 Fcons (make_number (event->timestamp),
4739 (NILP (string_info)
4740 ? Qnil
4741 : Fcons (string_info, Qnil))))));
4743 #ifndef USE_TOOLKIT_SCROLL_BARS
4744 else
4746 /* It's a scrollbar click. */
4747 Lisp_Object window;
4748 Lisp_Object portion_whole;
4749 Lisp_Object part;
4751 window = event->frame_or_window;
4752 portion_whole = Fcons (event->x, event->y);
4753 part = *scroll_bar_parts[(int) event->part];
4755 position
4756 = Fcons (window,
4757 Fcons (Qvertical_scroll_bar,
4758 Fcons (portion_whole,
4759 Fcons (make_number (event->timestamp),
4760 Fcons (part, Qnil)))));
4762 #endif /* not USE_TOOLKIT_SCROLL_BARS */
4764 if (button >= XVECTOR (button_down_location)->size)
4766 button_down_location = larger_vector (button_down_location,
4767 button + 1, Qnil);
4768 mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
4771 start_pos_ptr = &XVECTOR (button_down_location)->contents[button];
4773 start_pos = *start_pos_ptr;
4774 *start_pos_ptr = Qnil;
4776 is_double = (button == last_mouse_button
4777 && XINT (event->x) == last_mouse_x
4778 && XINT (event->y) == last_mouse_y
4779 && button_down_time != 0
4780 && (EQ (Vdouble_click_time, Qt)
4781 || (INTEGERP (Vdouble_click_time)
4782 && ((int)(event->timestamp - button_down_time)
4783 < XINT (Vdouble_click_time)))));
4784 last_mouse_button = button;
4785 last_mouse_x = XINT (event->x);
4786 last_mouse_y = XINT (event->y);
4788 /* If this is a button press, squirrel away the location, so
4789 we can decide later whether it was a click or a drag. */
4790 if (event->modifiers & down_modifier)
4792 if (is_double)
4794 double_click_count++;
4795 event->modifiers |= ((double_click_count > 2)
4796 ? triple_modifier
4797 : double_modifier);
4799 else
4800 double_click_count = 1;
4801 button_down_time = event->timestamp;
4802 *start_pos_ptr = Fcopy_alist (position);
4805 /* Now we're releasing a button - check the co-ordinates to
4806 see if this was a click or a drag. */
4807 else if (event->modifiers & up_modifier)
4809 /* If we did not see a down before this up,
4810 ignore the up. Probably this happened because
4811 the down event chose a menu item.
4812 It would be an annoyance to treat the release
4813 of the button that chose the menu item
4814 as a separate event. */
4816 if (!CONSP (start_pos))
4817 return Qnil;
4819 event->modifiers &= ~up_modifier;
4820 #if 0 /* Formerly we treated an up with no down as a click event. */
4821 if (!CONSP (start_pos))
4822 event->modifiers |= click_modifier;
4823 else
4824 #endif
4826 /* The third element of every position should be the (x,y)
4827 pair. */
4828 Lisp_Object down;
4830 down = Fnth (make_number (2), start_pos);
4831 if (EQ (event->x, XCAR (down))
4832 && EQ (event->y, XCDR (down)))
4834 event->modifiers |= click_modifier;
4836 else
4838 button_down_time = 0;
4839 event->modifiers |= drag_modifier;
4841 /* Don't check is_double; treat this as multiple
4842 if the down-event was multiple. */
4843 if (double_click_count > 1)
4844 event->modifiers |= ((double_click_count > 2)
4845 ? triple_modifier
4846 : double_modifier);
4849 else
4850 /* Every mouse event should either have the down_modifier or
4851 the up_modifier set. */
4852 abort ();
4855 /* Get the symbol we should use for the mouse click. */
4856 Lisp_Object head;
4858 head = modify_event_symbol (button,
4859 event->modifiers,
4860 Qmouse_click, Vlispy_mouse_stem,
4861 NULL,
4862 &mouse_syms,
4863 XVECTOR (mouse_syms)->size);
4864 if (event->modifiers & drag_modifier)
4865 return Fcons (head,
4866 Fcons (start_pos,
4867 Fcons (position,
4868 Qnil)));
4869 else if (event->modifiers & (double_modifier | triple_modifier))
4870 return Fcons (head,
4871 Fcons (position,
4872 Fcons (make_number (double_click_count),
4873 Qnil)));
4874 else
4875 return Fcons (head,
4876 Fcons (position,
4877 Qnil));
4881 #if USE_TOOLKIT_SCROLL_BARS
4883 /* We don't have down and up events if using toolkit scroll bars,
4884 so make this always a click event. Store in the `part' of
4885 the Lisp event a symbol which maps to the following actions:
4887 `above_handle' page up
4888 `below_handle' page down
4889 `up' line up
4890 `down' line down
4891 `top' top of buffer
4892 `bottom' bottom of buffer
4893 `handle' thumb has been dragged.
4894 `end-scroll' end of interaction with scroll bar
4896 The incoming input_event contains in its `part' member an
4897 index of type `enum scroll_bar_part' which we can use as an
4898 index in scroll_bar_parts to get the appropriate symbol. */
4900 case scroll_bar_click:
4902 Lisp_Object position, head, window, portion_whole, part;
4904 window = event->frame_or_window;
4905 portion_whole = Fcons (event->x, event->y);
4906 part = *scroll_bar_parts[(int) event->part];
4908 position
4909 = Fcons (window,
4910 Fcons (Qvertical_scroll_bar,
4911 Fcons (portion_whole,
4912 Fcons (make_number (event->timestamp),
4913 Fcons (part, Qnil)))));
4915 /* Always treat scroll bar events as clicks. */
4916 event->modifiers |= click_modifier;
4918 /* Get the symbol we should use for the mouse click. */
4919 head = modify_event_symbol (event->code,
4920 event->modifiers,
4921 Qmouse_click,
4922 Vlispy_mouse_stem,
4923 NULL, &mouse_syms,
4924 XVECTOR (mouse_syms)->size);
4925 return Fcons (head, Fcons (position, Qnil));
4928 #endif /* USE_TOOLKIT_SCROLL_BARS */
4930 #ifdef WINDOWSNT
4931 case w32_scroll_bar_click:
4933 int button = event->code;
4934 int is_double;
4935 Lisp_Object position;
4936 Lisp_Object *start_pos_ptr;
4937 Lisp_Object start_pos;
4940 Lisp_Object window;
4941 Lisp_Object portion_whole;
4942 Lisp_Object part;
4944 window = event->frame_or_window;
4945 portion_whole = Fcons (event->x, event->y);
4946 part = *scroll_bar_parts[(int) event->part];
4948 position
4949 = Fcons (window,
4950 Fcons (Qvertical_scroll_bar,
4951 Fcons (portion_whole,
4952 Fcons (make_number (event->timestamp),
4953 Fcons (part, Qnil)))));
4956 /* Always treat W32 scroll bar events as clicks. */
4957 event->modifiers |= click_modifier;
4960 /* Get the symbol we should use for the mouse click. */
4961 Lisp_Object head;
4963 head = modify_event_symbol (button,
4964 event->modifiers,
4965 Qmouse_click,
4966 Vlispy_mouse_stem,
4967 NULL, &mouse_syms,
4968 XVECTOR (mouse_syms)->size);
4969 return Fcons (head,
4970 Fcons (position,
4971 Qnil));
4974 case mouse_wheel:
4976 int part;
4977 FRAME_PTR f = XFRAME (event->frame_or_window);
4978 Lisp_Object window;
4979 Lisp_Object posn;
4980 Lisp_Object head, position;
4981 int row, column;
4983 /* Ignore mouse events that were made on frame that
4984 have been deleted. */
4985 if (! FRAME_LIVE_P (f))
4986 return Qnil;
4987 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
4988 &column, &row, NULL, 1);
4989 window = window_from_coordinates (f, XINT (event->x),
4990 XINT (event->y), &part, 0);
4992 if (!WINDOWP (window))
4994 window = event->frame_or_window;
4995 posn = Qnil;
4997 else
4999 int pixcolumn, pixrow;
5000 column -= XINT (XWINDOW (window)->left);
5001 row -= XINT (XWINDOW (window)->top);
5002 glyph_to_pixel_coords (XWINDOW(window), column, row,
5003 &pixcolumn, &pixrow);
5004 XSETINT (event->x, pixcolumn);
5005 XSETINT (event->y, pixrow);
5007 if (part == 1)
5008 posn = Qmode_line;
5009 else if (part == 2)
5010 posn = Qvertical_line;
5011 else if (part == 3)
5012 posn = Qheader_line;
5013 else
5014 XSETINT (posn,
5015 buffer_posn_from_coords (XWINDOW (window),
5016 &column, &row));
5020 Lisp_Object head, position;
5022 position
5023 = Fcons (window,
5024 Fcons (posn,
5025 Fcons (Fcons (event->x, event->y),
5026 Fcons (make_number (event->timestamp),
5027 Qnil))));
5029 head = modify_event_symbol (0, event->modifiers,
5030 Qmouse_wheel, Qnil,
5031 lispy_mouse_wheel_names,
5032 &mouse_wheel_syms, 1);
5033 return Fcons (head,
5034 Fcons (position,
5035 Fcons (make_number (event->code),
5036 Qnil)));
5039 #endif /* WINDOWSNT */
5041 case drag_n_drop:
5043 int part;
5044 FRAME_PTR f;
5045 Lisp_Object window;
5046 Lisp_Object posn;
5047 Lisp_Object files;
5049 /* The frame_or_window field should be a cons of the frame in
5050 which the event occurred and a list of the filenames
5051 dropped. */
5052 if (! CONSP (event->frame_or_window))
5053 abort ();
5055 f = XFRAME (XCAR (event->frame_or_window));
5056 files = XCDR (event->frame_or_window);
5058 /* Ignore mouse events that were made on frames that
5059 have been deleted. */
5060 if (! FRAME_LIVE_P (f))
5061 return Qnil;
5063 window = window_from_coordinates (f, XINT (event->x),
5064 XINT (event->y), &part, 0);
5066 if (!WINDOWP (window))
5068 window = XCAR (event->frame_or_window);
5069 posn = Qnil;
5071 else
5073 /* It's an event in window `window' at frame coordinates
5074 event->x/ event->y. */
5075 struct window *w = XWINDOW (window);
5077 /* Get window relative coordinates. */
5078 int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
5079 int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
5081 /* Set event coordinates to window-relative coordinates
5082 for constructing the Lisp event below. */
5083 XSETINT (event->x, wx);
5084 XSETINT (event->y, wy);
5086 if (part == 1)
5087 posn = Qmode_line;
5088 else if (part == 2)
5089 posn = Qvertical_line;
5090 else if (part == 3)
5091 posn = Qheader_line;
5092 else
5093 XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy));
5097 Lisp_Object head, position;
5099 position
5100 = Fcons (window,
5101 Fcons (posn,
5102 Fcons (Fcons (event->x, event->y),
5103 Fcons (make_number (event->timestamp),
5104 Qnil))));
5106 head = modify_event_symbol (0, event->modifiers,
5107 Qdrag_n_drop, Qnil,
5108 lispy_drag_n_drop_names,
5109 &drag_n_drop_syms, 1);
5110 return Fcons (head,
5111 Fcons (position,
5112 Fcons (files,
5113 Qnil)));
5116 #endif /* HAVE_MOUSE */
5118 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
5119 case MENU_BAR_EVENT:
5120 if (EQ (event->arg, event->frame_or_window))
5121 /* This is the prefix key. We translate this to
5122 `(menu_bar)' because the code in keyboard.c for menu
5123 events, which we use, relies on this. */
5124 return Fcons (Qmenu_bar, Qnil);
5125 return event->arg;
5126 #endif
5128 case TOOL_BAR_EVENT:
5129 if (EQ (event->arg, event->frame_or_window))
5130 /* This is the prefix key. We translate this to
5131 `(tool_bar)' because the code in keyboard.c for menu
5132 events, which we use, relies on this. */
5133 return Fcons (Qtool_bar, Qnil);
5134 else if (SYMBOLP (event->arg))
5135 return apply_modifiers (event->modifiers, event->arg);
5136 return event->arg;
5138 case USER_SIGNAL_EVENT:
5139 /* A user signal. */
5140 return *lispy_user_signals[event->code];
5142 /* The 'kind' field of the event is something we don't recognize. */
5143 default:
5144 abort ();
5148 #ifdef HAVE_MOUSE
5150 static Lisp_Object
5151 make_lispy_movement (frame, bar_window, part, x, y, time)
5152 FRAME_PTR frame;
5153 Lisp_Object bar_window;
5154 enum scroll_bar_part part;
5155 Lisp_Object x, y;
5156 unsigned long time;
5158 /* Is it a scroll bar movement? */
5159 if (frame && ! NILP (bar_window))
5161 Lisp_Object part_sym;
5163 part_sym = *scroll_bar_parts[(int) part];
5164 return Fcons (Qscroll_bar_movement,
5165 (Fcons (Fcons (bar_window,
5166 Fcons (Qvertical_scroll_bar,
5167 Fcons (Fcons (x, y),
5168 Fcons (make_number (time),
5169 Fcons (part_sym,
5170 Qnil))))),
5171 Qnil)));
5174 /* Or is it an ordinary mouse movement? */
5175 else
5177 int area;
5178 Lisp_Object window;
5179 Lisp_Object posn;
5181 if (frame)
5182 /* It's in a frame; which window on that frame? */
5183 window = window_from_coordinates (frame, XINT (x), XINT (y), &area, 0);
5184 else
5185 window = Qnil;
5187 if (WINDOWP (window))
5189 struct window *w = XWINDOW (window);
5190 int wx, wy;
5192 /* Get window relative coordinates. */
5193 wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (x));
5194 wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (y));
5195 XSETINT (x, wx);
5196 XSETINT (y, wy);
5198 if (area == 1)
5199 posn = Qmode_line;
5200 else if (area == 2)
5201 posn = Qvertical_line;
5202 else if (area == 3)
5203 posn = Qheader_line;
5204 else
5205 XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy));
5207 else if (frame != 0)
5209 XSETFRAME (window, frame);
5210 posn = Qnil;
5212 else
5214 window = Qnil;
5215 posn = Qnil;
5216 XSETFASTINT (x, 0);
5217 XSETFASTINT (y, 0);
5220 return Fcons (Qmouse_movement,
5221 Fcons (Fcons (window,
5222 Fcons (posn,
5223 Fcons (Fcons (x, y),
5224 Fcons (make_number (time),
5225 Qnil)))),
5226 Qnil));
5230 #endif /* HAVE_MOUSE */
5232 /* Construct a switch frame event. */
5233 static Lisp_Object
5234 make_lispy_switch_frame (frame)
5235 Lisp_Object frame;
5237 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
5240 /* Manipulating modifiers. */
5242 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
5244 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
5245 SYMBOL's name of the end of the modifiers; the string from this
5246 position is the unmodified symbol name.
5248 This doesn't use any caches. */
5250 static int
5251 parse_modifiers_uncached (symbol, modifier_end)
5252 Lisp_Object symbol;
5253 int *modifier_end;
5255 struct Lisp_String *name;
5256 int i;
5257 int modifiers;
5259 CHECK_SYMBOL (symbol, 1);
5261 modifiers = 0;
5262 name = XSYMBOL (symbol)->name;
5264 for (i = 0; i+2 <= STRING_BYTES (name); )
5266 int this_mod_end = 0;
5267 int this_mod = 0;
5269 /* See if the name continues with a modifier word.
5270 Check that the word appears, but don't check what follows it.
5271 Set this_mod and this_mod_end to record what we find. */
5273 switch (name->data[i])
5275 #define SINGLE_LETTER_MOD(BIT) \
5276 (this_mod_end = i + 1, this_mod = BIT)
5278 case 'A':
5279 SINGLE_LETTER_MOD (alt_modifier);
5280 break;
5282 case 'C':
5283 SINGLE_LETTER_MOD (ctrl_modifier);
5284 break;
5286 case 'H':
5287 SINGLE_LETTER_MOD (hyper_modifier);
5288 break;
5290 case 'M':
5291 SINGLE_LETTER_MOD (meta_modifier);
5292 break;
5294 case 'S':
5295 SINGLE_LETTER_MOD (shift_modifier);
5296 break;
5298 case 's':
5299 SINGLE_LETTER_MOD (super_modifier);
5300 break;
5302 #undef SINGLE_LETTER_MOD
5305 /* If we found no modifier, stop looking for them. */
5306 if (this_mod_end == 0)
5307 break;
5309 /* Check there is a dash after the modifier, so that it
5310 really is a modifier. */
5311 if (this_mod_end >= STRING_BYTES (name)
5312 || name->data[this_mod_end] != '-')
5313 break;
5315 /* This modifier is real; look for another. */
5316 modifiers |= this_mod;
5317 i = this_mod_end + 1;
5320 /* Should we include the `click' modifier? */
5321 if (! (modifiers & (down_modifier | drag_modifier
5322 | double_modifier | triple_modifier))
5323 && i + 7 == STRING_BYTES (name)
5324 && strncmp (name->data + i, "mouse-", 6) == 0
5325 && ('0' <= name->data[i + 6] && name->data[i + 6] <= '9'))
5326 modifiers |= click_modifier;
5328 if (modifier_end)
5329 *modifier_end = i;
5331 return modifiers;
5334 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
5335 prepended to the string BASE[0..BASE_LEN-1].
5336 This doesn't use any caches. */
5337 static Lisp_Object
5338 apply_modifiers_uncached (modifiers, base, base_len, base_len_byte)
5339 int modifiers;
5340 char *base;
5341 int base_len, base_len_byte;
5343 /* Since BASE could contain nulls, we can't use intern here; we have
5344 to use Fintern, which expects a genuine Lisp_String, and keeps a
5345 reference to it. */
5346 char *new_mods
5347 = (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
5348 int mod_len;
5351 char *p = new_mods;
5353 /* Only the event queue may use the `up' modifier; it should always
5354 be turned into a click or drag event before presented to lisp code. */
5355 if (modifiers & up_modifier)
5356 abort ();
5358 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
5359 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
5360 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
5361 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
5362 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
5363 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
5364 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
5365 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
5366 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
5367 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
5368 /* The click modifier is denoted by the absence of other modifiers. */
5370 *p = '\0';
5372 mod_len = p - new_mods;
5376 Lisp_Object new_name;
5378 new_name = make_uninit_multibyte_string (mod_len + base_len,
5379 mod_len + base_len_byte);
5380 bcopy (new_mods, XSTRING (new_name)->data, mod_len);
5381 bcopy (base, XSTRING (new_name)->data + mod_len, base_len_byte);
5383 return Fintern (new_name, Qnil);
5388 static char *modifier_names[] =
5390 "up", "down", "drag", "click", "double", "triple", 0, 0,
5391 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5392 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
5394 #define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
5396 static Lisp_Object modifier_symbols;
5398 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
5399 static Lisp_Object
5400 lispy_modifier_list (modifiers)
5401 int modifiers;
5403 Lisp_Object modifier_list;
5404 int i;
5406 modifier_list = Qnil;
5407 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
5408 if (modifiers & (1<<i))
5409 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
5410 modifier_list);
5412 return modifier_list;
5416 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
5417 where UNMODIFIED is the unmodified form of SYMBOL,
5418 MASK is the set of modifiers present in SYMBOL's name.
5419 This is similar to parse_modifiers_uncached, but uses the cache in
5420 SYMBOL's Qevent_symbol_element_mask property, and maintains the
5421 Qevent_symbol_elements property. */
5423 Lisp_Object
5424 parse_modifiers (symbol)
5425 Lisp_Object symbol;
5427 Lisp_Object elements;
5429 elements = Fget (symbol, Qevent_symbol_element_mask);
5430 if (CONSP (elements))
5431 return elements;
5432 else
5434 int end;
5435 int modifiers = parse_modifiers_uncached (symbol, &end);
5436 Lisp_Object unmodified;
5437 Lisp_Object mask;
5439 unmodified = Fintern (make_string (XSYMBOL (symbol)->name->data + end,
5440 STRING_BYTES (XSYMBOL (symbol)->name) - end),
5441 Qnil);
5443 if (modifiers & ~(((EMACS_INT)1 << VALBITS) - 1))
5444 abort ();
5445 XSETFASTINT (mask, modifiers);
5446 elements = Fcons (unmodified, Fcons (mask, Qnil));
5448 /* Cache the parsing results on SYMBOL. */
5449 Fput (symbol, Qevent_symbol_element_mask,
5450 elements);
5451 Fput (symbol, Qevent_symbol_elements,
5452 Fcons (unmodified, lispy_modifier_list (modifiers)));
5454 /* Since we know that SYMBOL is modifiers applied to unmodified,
5455 it would be nice to put that in unmodified's cache.
5456 But we can't, since we're not sure that parse_modifiers is
5457 canonical. */
5459 return elements;
5463 /* Apply the modifiers MODIFIERS to the symbol BASE.
5464 BASE must be unmodified.
5466 This is like apply_modifiers_uncached, but uses BASE's
5467 Qmodifier_cache property, if present. It also builds
5468 Qevent_symbol_elements properties, since it has that info anyway.
5470 apply_modifiers copies the value of BASE's Qevent_kind property to
5471 the modified symbol. */
5472 static Lisp_Object
5473 apply_modifiers (modifiers, base)
5474 int modifiers;
5475 Lisp_Object base;
5477 Lisp_Object cache, index, entry, new_symbol;
5479 /* Mask out upper bits. We don't know where this value's been. */
5480 modifiers &= ((EMACS_INT)1 << VALBITS) - 1;
5482 /* The click modifier never figures into cache indices. */
5483 cache = Fget (base, Qmodifier_cache);
5484 XSETFASTINT (index, (modifiers & ~click_modifier));
5485 entry = assq_no_quit (index, cache);
5487 if (CONSP (entry))
5488 new_symbol = XCDR (entry);
5489 else
5491 /* We have to create the symbol ourselves. */
5492 new_symbol = apply_modifiers_uncached (modifiers,
5493 XSYMBOL (base)->name->data,
5494 XSYMBOL (base)->name->size,
5495 STRING_BYTES (XSYMBOL (base)->name));
5497 /* Add the new symbol to the base's cache. */
5498 entry = Fcons (index, new_symbol);
5499 Fput (base, Qmodifier_cache, Fcons (entry, cache));
5501 /* We have the parsing info now for free, so add it to the caches. */
5502 XSETFASTINT (index, modifiers);
5503 Fput (new_symbol, Qevent_symbol_element_mask,
5504 Fcons (base, Fcons (index, Qnil)));
5505 Fput (new_symbol, Qevent_symbol_elements,
5506 Fcons (base, lispy_modifier_list (modifiers)));
5509 /* Make sure this symbol is of the same kind as BASE.
5511 You'd think we could just set this once and for all when we
5512 intern the symbol above, but reorder_modifiers may call us when
5513 BASE's property isn't set right; we can't assume that just
5514 because it has a Qmodifier_cache property it must have its
5515 Qevent_kind set right as well. */
5516 if (NILP (Fget (new_symbol, Qevent_kind)))
5518 Lisp_Object kind;
5520 kind = Fget (base, Qevent_kind);
5521 if (! NILP (kind))
5522 Fput (new_symbol, Qevent_kind, kind);
5525 return new_symbol;
5529 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
5530 return a symbol with the modifiers placed in the canonical order.
5531 Canonical order is alphabetical, except for down and drag, which
5532 always come last. The 'click' modifier is never written out.
5534 Fdefine_key calls this to make sure that (for example) C-M-foo
5535 and M-C-foo end up being equivalent in the keymap. */
5537 Lisp_Object
5538 reorder_modifiers (symbol)
5539 Lisp_Object symbol;
5541 /* It's hopefully okay to write the code this way, since everything
5542 will soon be in caches, and no consing will be done at all. */
5543 Lisp_Object parsed;
5545 parsed = parse_modifiers (symbol);
5546 return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))),
5547 XCAR (parsed));
5551 /* For handling events, we often want to produce a symbol whose name
5552 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
5553 to some base, like the name of a function key or mouse button.
5554 modify_event_symbol produces symbols of this sort.
5556 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
5557 is the name of the i'th symbol. TABLE_SIZE is the number of elements
5558 in the table.
5560 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
5561 into symbol names, or a string specifying a name stem used to
5562 construct a symbol name or the form `STEM-N', where N is the decimal
5563 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
5564 non-nil; otherwise NAME_TABLE is used.
5566 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
5567 persist between calls to modify_event_symbol that it can use to
5568 store a cache of the symbols it's generated for this NAME_TABLE
5569 before. The object stored there may be a vector or an alist.
5571 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
5573 MODIFIERS is a set of modifier bits (as given in struct input_events)
5574 whose prefixes should be applied to the symbol name.
5576 SYMBOL_KIND is the value to be placed in the event_kind property of
5577 the returned symbol.
5579 The symbols we create are supposed to have an
5580 `event-symbol-elements' property, which lists the modifiers present
5581 in the symbol's name. */
5583 static Lisp_Object
5584 modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist_or_stem,
5585 name_table, symbol_table, table_size)
5586 int symbol_num;
5587 unsigned modifiers;
5588 Lisp_Object symbol_kind;
5589 Lisp_Object name_alist_or_stem;
5590 char **name_table;
5591 Lisp_Object *symbol_table;
5592 unsigned int table_size;
5594 Lisp_Object value;
5595 Lisp_Object symbol_int;
5597 /* Get rid of the "vendor-specific" bit here. */
5598 XSETINT (symbol_int, symbol_num & 0xffffff);
5600 /* Is this a request for a valid symbol? */
5601 if (symbol_num < 0 || symbol_num >= table_size)
5602 return Qnil;
5604 if (CONSP (*symbol_table))
5605 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
5607 /* If *symbol_table doesn't seem to be initialized properly, fix that.
5608 *symbol_table should be a lisp vector TABLE_SIZE elements long,
5609 where the Nth element is the symbol for NAME_TABLE[N], or nil if
5610 we've never used that symbol before. */
5611 else
5613 if (! VECTORP (*symbol_table)
5614 || XVECTOR (*symbol_table)->size != table_size)
5616 Lisp_Object size;
5618 XSETFASTINT (size, table_size);
5619 *symbol_table = Fmake_vector (size, Qnil);
5622 value = XVECTOR (*symbol_table)->contents[symbol_num];
5625 /* Have we already used this symbol before? */
5626 if (NILP (value))
5628 /* No; let's create it. */
5629 if (CONSP (name_alist_or_stem))
5630 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
5631 else if (STRINGP (name_alist_or_stem))
5633 int len = STRING_BYTES (XSTRING (name_alist_or_stem));
5634 char *buf = (char *) alloca (len + 50);
5635 sprintf (buf, "%s-%d", XSTRING (name_alist_or_stem)->data,
5636 XINT (symbol_int) + 1);
5637 value = intern (buf);
5639 else if (name_table != 0 && name_table[symbol_num])
5640 value = intern (name_table[symbol_num]);
5642 #ifdef HAVE_WINDOW_SYSTEM
5643 if (NILP (value))
5645 char *name = x_get_keysym_name (symbol_num);
5646 if (name)
5647 value = intern (name);
5649 #endif
5651 if (NILP (value))
5653 char buf[20];
5654 sprintf (buf, "key-%d", symbol_num);
5655 value = intern (buf);
5658 if (CONSP (*symbol_table))
5659 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
5660 else
5661 XVECTOR (*symbol_table)->contents[symbol_num] = value;
5663 /* Fill in the cache entries for this symbol; this also
5664 builds the Qevent_symbol_elements property, which the user
5665 cares about. */
5666 apply_modifiers (modifiers & click_modifier, value);
5667 Fput (value, Qevent_kind, symbol_kind);
5670 /* Apply modifiers to that symbol. */
5671 return apply_modifiers (modifiers, value);
5674 /* Convert a list that represents an event type,
5675 such as (ctrl meta backspace), into the usual representation of that
5676 event type as a number or a symbol. */
5678 DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
5679 "Convert the event description list EVENT-DESC to an event type.\n\
5680 EVENT-DESC should contain one base event type (a character or symbol)\n\
5681 and zero or more modifier names (control, meta, hyper, super, shift, alt,\n\
5682 drag, down, double or triple). The base must be last.\n\
5683 The return value is an event type (a character or symbol) which\n\
5684 has the same base event type and all the specified modifiers.")
5685 (event_desc)
5686 Lisp_Object event_desc;
5688 Lisp_Object base;
5689 int modifiers = 0;
5690 Lisp_Object rest;
5692 base = Qnil;
5693 rest = event_desc;
5694 while (CONSP (rest))
5696 Lisp_Object elt;
5697 int this = 0;
5699 elt = XCAR (rest);
5700 rest = XCDR (rest);
5702 /* Given a symbol, see if it is a modifier name. */
5703 if (SYMBOLP (elt) && CONSP (rest))
5704 this = parse_solitary_modifier (elt);
5706 if (this != 0)
5707 modifiers |= this;
5708 else if (!NILP (base))
5709 error ("Two bases given in one event");
5710 else
5711 base = elt;
5715 /* Let the symbol A refer to the character A. */
5716 if (SYMBOLP (base) && XSYMBOL (base)->name->size == 1)
5717 XSETINT (base, XSYMBOL (base)->name->data[0]);
5719 if (INTEGERP (base))
5721 /* Turn (shift a) into A. */
5722 if ((modifiers & shift_modifier) != 0
5723 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
5725 XSETINT (base, XINT (base) - ('a' - 'A'));
5726 modifiers &= ~shift_modifier;
5729 /* Turn (control a) into C-a. */
5730 if (modifiers & ctrl_modifier)
5731 return make_number ((modifiers & ~ctrl_modifier)
5732 | make_ctrl_char (XINT (base)));
5733 else
5734 return make_number (modifiers | XINT (base));
5736 else if (SYMBOLP (base))
5737 return apply_modifiers (modifiers, base);
5738 else
5740 error ("Invalid base event");
5741 return Qnil;
5745 /* Try to recognize SYMBOL as a modifier name.
5746 Return the modifier flag bit, or 0 if not recognized. */
5748 static int
5749 parse_solitary_modifier (symbol)
5750 Lisp_Object symbol;
5752 struct Lisp_String *name = XSYMBOL (symbol)->name;
5754 switch (name->data[0])
5756 #define SINGLE_LETTER_MOD(BIT) \
5757 if (STRING_BYTES (name) == 1) \
5758 return BIT;
5760 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
5761 if (LEN == STRING_BYTES (name) \
5762 && ! strncmp (name->data, NAME, LEN)) \
5763 return BIT;
5765 case 'A':
5766 SINGLE_LETTER_MOD (alt_modifier);
5767 break;
5769 case 'a':
5770 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
5771 break;
5773 case 'C':
5774 SINGLE_LETTER_MOD (ctrl_modifier);
5775 break;
5777 case 'c':
5778 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
5779 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
5780 break;
5782 case 'H':
5783 SINGLE_LETTER_MOD (hyper_modifier);
5784 break;
5786 case 'h':
5787 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
5788 break;
5790 case 'M':
5791 SINGLE_LETTER_MOD (meta_modifier);
5792 break;
5794 case 'm':
5795 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
5796 break;
5798 case 'S':
5799 SINGLE_LETTER_MOD (shift_modifier);
5800 break;
5802 case 's':
5803 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
5804 MULTI_LETTER_MOD (super_modifier, "super", 5);
5805 SINGLE_LETTER_MOD (super_modifier);
5806 break;
5808 case 'd':
5809 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
5810 MULTI_LETTER_MOD (down_modifier, "down", 4);
5811 MULTI_LETTER_MOD (double_modifier, "double", 6);
5812 break;
5814 case 't':
5815 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
5816 break;
5818 #undef SINGLE_LETTER_MOD
5819 #undef MULTI_LETTER_MOD
5822 return 0;
5825 /* Return 1 if EVENT is a list whose elements are all integers or symbols.
5826 Such a list is not valid as an event,
5827 but it can be a Lucid-style event type list. */
5830 lucid_event_type_list_p (object)
5831 Lisp_Object object;
5833 Lisp_Object tail;
5835 if (! CONSP (object))
5836 return 0;
5838 if (EQ (XCAR (object), Qhelp_echo)
5839 || EQ (XCAR (object), Qvertical_line)
5840 || EQ (XCAR (object), Qmode_line)
5841 || EQ (XCAR (object), Qheader_line))
5842 return 0;
5844 for (tail = object; CONSP (tail); tail = XCDR (tail))
5846 Lisp_Object elt;
5847 elt = XCAR (tail);
5848 if (! (INTEGERP (elt) || SYMBOLP (elt)))
5849 return 0;
5852 return NILP (tail);
5855 /* Store into *addr a value nonzero if terminal input chars are available.
5856 Serves the purpose of ioctl (0, FIONREAD, addr)
5857 but works even if FIONREAD does not exist.
5858 (In fact, this may actually read some input.)
5860 If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe. */
5862 static void
5863 get_input_pending (addr, do_timers_now)
5864 int *addr;
5865 int do_timers_now;
5867 /* First of all, have we already counted some input? */
5868 *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
5870 /* If input is being read as it arrives, and we have none, there is none. */
5871 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
5872 return;
5874 /* Try to read some input and see how much we get. */
5875 gobble_input (0);
5876 *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
5879 /* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
5881 void
5882 gobble_input (expected)
5883 int expected;
5885 #ifndef VMS
5886 #ifdef SIGIO
5887 if (interrupt_input)
5889 SIGMASKTYPE mask;
5890 mask = sigblock (sigmask (SIGIO));
5891 read_avail_input (expected);
5892 sigsetmask (mask);
5894 else
5895 #ifdef POLL_FOR_INPUT
5896 if (read_socket_hook && !interrupt_input && poll_suppress_count == 0)
5898 SIGMASKTYPE mask;
5899 mask = sigblock (sigmask (SIGALRM));
5900 read_avail_input (expected);
5901 sigsetmask (mask);
5903 else
5904 #endif
5905 #endif
5906 read_avail_input (expected);
5907 #endif
5910 /* Put a buffer_switch_event in the buffer
5911 so that read_key_sequence will notice the new current buffer. */
5913 void
5914 record_asynch_buffer_change ()
5916 struct input_event event;
5917 Lisp_Object tem;
5919 event.kind = buffer_switch_event;
5920 event.frame_or_window = Qnil;
5921 event.arg = Qnil;
5923 #ifdef subprocesses
5924 /* We don't need a buffer-switch event unless Emacs is waiting for input.
5925 The purpose of the event is to make read_key_sequence look up the
5926 keymaps again. If we aren't in read_key_sequence, we don't need one,
5927 and the event could cause trouble by messing up (input-pending-p). */
5928 tem = Fwaiting_for_user_input_p ();
5929 if (NILP (tem))
5930 return;
5931 #else
5932 /* We never need these events if we have no asynchronous subprocesses. */
5933 return;
5934 #endif
5936 /* Make sure no interrupt happens while storing the event. */
5937 #ifdef SIGIO
5938 if (interrupt_input)
5940 SIGMASKTYPE mask;
5941 mask = sigblock (sigmask (SIGIO));
5942 kbd_buffer_store_event (&event);
5943 sigsetmask (mask);
5945 else
5946 #endif
5948 stop_polling ();
5949 kbd_buffer_store_event (&event);
5950 start_polling ();
5954 #ifndef VMS
5956 /* Read any terminal input already buffered up by the system
5957 into the kbd_buffer, but do not wait.
5959 EXPECTED should be nonzero if the caller knows there is some input.
5961 Except on VMS, all input is read by this function.
5962 If interrupt_input is nonzero, this function MUST be called
5963 only when SIGIO is blocked.
5965 Returns the number of keyboard chars read, or -1 meaning
5966 this is a bad time to try to read input. */
5968 static int
5969 read_avail_input (expected)
5970 int expected;
5972 struct input_event buf[KBD_BUFFER_SIZE];
5973 register int i;
5974 int nread;
5976 if (read_socket_hook)
5977 /* No need for FIONREAD or fcntl; just say don't wait. */
5978 nread = (*read_socket_hook) (input_fd, buf, KBD_BUFFER_SIZE, expected);
5979 else
5981 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
5982 the kbd_buffer can really hold. That may prevent loss
5983 of characters on some systems when input is stuffed at us. */
5984 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
5985 int n_to_read;
5987 /* Determine how many characters we should *try* to read. */
5988 #ifdef WINDOWSNT
5989 return 0;
5990 #else /* not WINDOWSNT */
5991 #ifdef MSDOS
5992 n_to_read = dos_keysns ();
5993 if (n_to_read == 0)
5994 return 0;
5995 #else /* not MSDOS */
5996 #ifdef FIONREAD
5997 /* Find out how much input is available. */
5998 if (ioctl (input_fd, FIONREAD, &n_to_read) < 0)
5999 /* Formerly simply reported no input, but that sometimes led to
6000 a failure of Emacs to terminate.
6001 SIGHUP seems appropriate if we can't reach the terminal. */
6002 /* ??? Is it really right to send the signal just to this process
6003 rather than to the whole process group?
6004 Perhaps on systems with FIONREAD Emacs is alone in its group. */
6005 kill (getpid (), SIGHUP);
6006 if (n_to_read == 0)
6007 return 0;
6008 if (n_to_read > sizeof cbuf)
6009 n_to_read = sizeof cbuf;
6010 #else /* no FIONREAD */
6011 #if defined (USG) || defined (DGUX)
6012 /* Read some input if available, but don't wait. */
6013 n_to_read = sizeof cbuf;
6014 fcntl (input_fd, F_SETFL, O_NDELAY);
6015 #else
6016 you lose;
6017 #endif
6018 #endif
6019 #endif /* not MSDOS */
6020 #endif /* not WINDOWSNT */
6022 /* Now read; for one reason or another, this will not block.
6023 NREAD is set to the number of chars read. */
6026 #ifdef MSDOS
6027 cbuf[0] = dos_keyread ();
6028 nread = 1;
6029 #else
6030 nread = emacs_read (input_fd, cbuf, n_to_read);
6031 #endif
6032 /* POSIX infers that processes which are not in the session leader's
6033 process group won't get SIGHUP's at logout time. BSDI adheres to
6034 this part standard and returns -1 from read (0) with errno==EIO
6035 when the control tty is taken away.
6036 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
6037 if (nread == -1 && errno == EIO)
6038 kill (0, SIGHUP);
6039 #if defined (AIX) && (! defined (aix386) && defined (_BSD))
6040 /* The kernel sometimes fails to deliver SIGHUP for ptys.
6041 This looks incorrect, but it isn't, because _BSD causes
6042 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
6043 and that causes a value other than 0 when there is no input. */
6044 if (nread == 0)
6045 kill (0, SIGHUP);
6046 #endif
6048 while (
6049 /* We used to retry the read if it was interrupted.
6050 But this does the wrong thing when O_NDELAY causes
6051 an EAGAIN error. Does anybody know of a situation
6052 where a retry is actually needed? */
6053 #if 0
6054 nread < 0 && (errno == EAGAIN
6055 #ifdef EFAULT
6056 || errno == EFAULT
6057 #endif
6058 #ifdef EBADSLT
6059 || errno == EBADSLT
6060 #endif
6062 #else
6064 #endif
6067 #ifndef FIONREAD
6068 #if defined (USG) || defined (DGUX)
6069 fcntl (input_fd, F_SETFL, 0);
6070 #endif /* USG or DGUX */
6071 #endif /* no FIONREAD */
6072 for (i = 0; i < nread; i++)
6074 buf[i].kind = ascii_keystroke;
6075 buf[i].modifiers = 0;
6076 if (meta_key == 1 && (cbuf[i] & 0x80))
6077 buf[i].modifiers = meta_modifier;
6078 if (meta_key != 2)
6079 cbuf[i] &= ~0x80;
6081 buf[i].code = cbuf[i];
6082 buf[i].frame_or_window = selected_frame;
6083 buf[i].arg = Qnil;
6087 /* Scan the chars for C-g and store them in kbd_buffer. */
6088 for (i = 0; i < nread; i++)
6090 kbd_buffer_store_event (&buf[i]);
6091 /* Don't look at input that follows a C-g too closely.
6092 This reduces lossage due to autorepeat on C-g. */
6093 if (buf[i].kind == ascii_keystroke
6094 && buf[i].code == quit_char)
6095 break;
6098 return nread;
6100 #endif /* not VMS */
6102 #ifdef SIGIO /* for entire page */
6103 /* Note SIGIO has been undef'd if FIONREAD is missing. */
6105 SIGTYPE
6106 input_available_signal (signo)
6107 int signo;
6109 /* Must preserve main program's value of errno. */
6110 int old_errno = errno;
6111 #ifdef BSD4_1
6112 extern int select_alarmed;
6113 #endif
6115 #if defined (USG) && !defined (POSIX_SIGNALS)
6116 /* USG systems forget handlers when they are used;
6117 must reestablish each time */
6118 signal (signo, input_available_signal);
6119 #endif /* USG */
6121 #ifdef BSD4_1
6122 sigisheld (SIGIO);
6123 #endif
6125 if (input_available_clear_time)
6126 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
6128 while (1)
6130 int nread;
6131 nread = read_avail_input (1);
6132 /* -1 means it's not ok to read the input now.
6133 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
6134 0 means there was no keyboard input available. */
6135 if (nread <= 0)
6136 break;
6138 #ifdef BSD4_1
6139 select_alarmed = 1; /* Force the select emulator back to life */
6140 #endif
6143 #ifdef BSD4_1
6144 sigfree ();
6145 #endif
6146 errno = old_errno;
6148 #endif /* SIGIO */
6150 /* Send ourselves a SIGIO.
6152 This function exists so that the UNBLOCK_INPUT macro in
6153 blockinput.h can have some way to take care of input we put off
6154 dealing with, without assuming that every file which uses
6155 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
6156 void
6157 reinvoke_input_signal ()
6159 #ifdef SIGIO
6160 kill (getpid (), SIGIO);
6161 #endif
6166 /* Return the prompt-string of a sparse keymap.
6167 This is the first element which is a string.
6168 Return nil if there is none. */
6170 Lisp_Object
6171 map_prompt (map)
6172 Lisp_Object map;
6174 while (CONSP (map))
6176 register Lisp_Object tem;
6177 tem = Fcar (map);
6178 if (STRINGP (tem))
6179 return tem;
6180 map = Fcdr (map);
6182 return Qnil;
6185 static void menu_bar_item P_ ((Lisp_Object, Lisp_Object));
6186 static void menu_bar_one_keymap P_ ((Lisp_Object));
6188 /* These variables hold the vector under construction within
6189 menu_bar_items and its subroutines, and the current index
6190 for storing into that vector. */
6191 static Lisp_Object menu_bar_items_vector;
6192 static int menu_bar_items_index;
6194 /* Return a vector of menu items for a menu bar, appropriate
6195 to the current buffer. Each item has three elements in the vector:
6196 KEY STRING MAPLIST.
6198 OLD is an old vector we can optionally reuse, or nil. */
6200 Lisp_Object
6201 menu_bar_items (old)
6202 Lisp_Object old;
6204 /* The number of keymaps we're scanning right now, and the number of
6205 keymaps we have allocated space for. */
6206 int nmaps;
6208 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
6209 in the current keymaps, or nil where it is not a prefix. */
6210 Lisp_Object *maps;
6212 Lisp_Object def, tem, tail;
6214 Lisp_Object result;
6216 int mapno;
6217 Lisp_Object oquit;
6219 int i;
6221 struct gcpro gcpro1;
6223 /* In order to build the menus, we need to call the keymap
6224 accessors. They all call QUIT. But this function is called
6225 during redisplay, during which a quit is fatal. So inhibit
6226 quitting while building the menus.
6227 We do this instead of specbind because (1) errors will clear it anyway
6228 and (2) this avoids risk of specpdl overflow. */
6229 oquit = Vinhibit_quit;
6230 Vinhibit_quit = Qt;
6232 if (!NILP (old))
6233 menu_bar_items_vector = old;
6234 else
6235 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
6236 menu_bar_items_index = 0;
6238 GCPRO1 (menu_bar_items_vector);
6240 /* Build our list of keymaps.
6241 If we recognize a function key and replace its escape sequence in
6242 keybuf with its symbol, or if the sequence starts with a mouse
6243 click and we need to switch buffers, we jump back here to rebuild
6244 the initial keymaps from the current buffer. */
6246 Lisp_Object *tmaps;
6248 /* Should overriding-terminal-local-map and overriding-local-map apply? */
6249 if (!NILP (Voverriding_local_map_menu_flag))
6251 /* Yes, use them (if non-nil) as well as the global map. */
6252 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
6253 nmaps = 0;
6254 if (!NILP (current_kboard->Voverriding_terminal_local_map))
6255 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
6256 if (!NILP (Voverriding_local_map))
6257 maps[nmaps++] = Voverriding_local_map;
6259 else
6261 /* No, so use major and minor mode keymaps and keymap property. */
6262 int extra_maps = 2;
6263 Lisp_Object map = get_local_map (PT, current_buffer, keymap);
6264 if (!NILP (map))
6265 extra_maps = 3;
6266 nmaps = current_minor_maps (NULL, &tmaps);
6267 maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
6268 * sizeof (maps[0]));
6269 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
6270 if (!NILP (map))
6271 maps[nmaps++] = map;
6272 maps[nmaps++] = get_local_map (PT, current_buffer, local_map);
6274 maps[nmaps++] = current_global_map;
6277 /* Look up in each map the dummy prefix key `menu-bar'. */
6279 result = Qnil;
6281 for (mapno = nmaps - 1; mapno >= 0; mapno--)
6282 if (!NILP (maps[mapno]))
6284 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 0),
6285 0, 0);
6286 if (CONSP (def))
6287 menu_bar_one_keymap (def);
6290 /* Move to the end those items that should be at the end. */
6292 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
6294 int i;
6295 int end = menu_bar_items_index;
6297 for (i = 0; i < end; i += 4)
6298 if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i]))
6300 Lisp_Object tem0, tem1, tem2, tem3;
6301 /* Move the item at index I to the end,
6302 shifting all the others forward. */
6303 tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
6304 tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
6305 tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
6306 tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
6307 if (end > i + 4)
6308 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
6309 &XVECTOR (menu_bar_items_vector)->contents[i],
6310 (end - i - 4) * sizeof (Lisp_Object));
6311 XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
6312 XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
6313 XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
6314 XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
6315 break;
6319 /* Add nil, nil, nil, nil at the end. */
6320 i = menu_bar_items_index;
6321 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
6323 Lisp_Object tem;
6324 tem = Fmake_vector (make_number (2 * i), Qnil);
6325 bcopy (XVECTOR (menu_bar_items_vector)->contents,
6326 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
6327 menu_bar_items_vector = tem;
6329 /* Add this item. */
6330 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6331 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6332 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6333 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6334 menu_bar_items_index = i;
6336 Vinhibit_quit = oquit;
6337 UNGCPRO;
6338 return menu_bar_items_vector;
6341 /* Scan one map KEYMAP, accumulating any menu items it defines
6342 in menu_bar_items_vector. */
6344 static Lisp_Object menu_bar_one_keymap_changed_items;
6346 static void
6347 menu_bar_one_keymap (keymap)
6348 Lisp_Object keymap;
6350 Lisp_Object tail, item;
6352 menu_bar_one_keymap_changed_items = Qnil;
6354 /* Loop over all keymap entries that have menu strings. */
6355 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
6357 item = XCAR (tail);
6358 if (CONSP (item))
6359 menu_bar_item (XCAR (item), XCDR (item));
6360 else if (VECTORP (item))
6362 /* Loop over the char values represented in the vector. */
6363 int len = XVECTOR (item)->size;
6364 int c;
6365 for (c = 0; c < len; c++)
6367 Lisp_Object character;
6368 XSETFASTINT (character, c);
6369 menu_bar_item (character, XVECTOR (item)->contents[c]);
6375 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
6376 If there's already an item for KEY, add this DEF to it. */
6378 Lisp_Object item_properties;
6380 static void
6381 menu_bar_item (key, item)
6382 Lisp_Object key, item;
6384 struct gcpro gcpro1;
6385 int i;
6386 Lisp_Object tem;
6388 if (EQ (item, Qundefined))
6390 /* If a map has an explicit `undefined' as definition,
6391 discard any previously made menu bar item. */
6393 for (i = 0; i < menu_bar_items_index; i += 4)
6394 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
6396 if (menu_bar_items_index > i + 4)
6397 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
6398 &XVECTOR (menu_bar_items_vector)->contents[i],
6399 (menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
6400 menu_bar_items_index -= 4;
6404 /* If this keymap has already contributed to this KEY,
6405 don't contribute to it a second time. */
6406 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
6407 if (!NILP (tem) || NILP (item))
6408 return;
6410 menu_bar_one_keymap_changed_items
6411 = Fcons (key, menu_bar_one_keymap_changed_items);
6413 /* We add to menu_bar_one_keymap_changed_items before doing the
6414 parse_menu_item, so that if it turns out it wasn't a menu item,
6415 it still correctly hides any further menu item. */
6416 GCPRO1 (key);
6417 i = parse_menu_item (item, 0, 1);
6418 UNGCPRO;
6419 if (!i)
6420 return;
6422 item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
6424 /* Find any existing item for this KEY. */
6425 for (i = 0; i < menu_bar_items_index; i += 4)
6426 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
6427 break;
6429 /* If we did not find this KEY, add it at the end. */
6430 if (i == menu_bar_items_index)
6432 /* If vector is too small, get a bigger one. */
6433 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
6435 Lisp_Object tem;
6436 tem = Fmake_vector (make_number (2 * i), Qnil);
6437 bcopy (XVECTOR (menu_bar_items_vector)->contents,
6438 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
6439 menu_bar_items_vector = tem;
6442 /* Add this item. */
6443 XVECTOR (menu_bar_items_vector)->contents[i++] = key;
6444 XVECTOR (menu_bar_items_vector)->contents[i++]
6445 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
6446 XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
6447 XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
6448 menu_bar_items_index = i;
6450 /* We did find an item for this KEY. Add ITEM to its list of maps. */
6451 else
6453 Lisp_Object old;
6454 old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
6455 XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (item, old);
6459 /* This is used as the handler when calling menu_item_eval_property. */
6460 static Lisp_Object
6461 menu_item_eval_property_1 (arg)
6462 Lisp_Object arg;
6464 /* If we got a quit from within the menu computation,
6465 quit all the way out of it. This takes care of C-] in the debugger. */
6466 if (CONSP (arg) && EQ (XCAR (arg), Qquit))
6467 Fsignal (Qquit, Qnil);
6469 return Qnil;
6472 /* Evaluate an expression and return the result (or nil if something
6473 went wrong). Used to evaluate dynamic parts of menu items. */
6474 Lisp_Object
6475 menu_item_eval_property (sexpr)
6476 Lisp_Object sexpr;
6478 int count = specpdl_ptr - specpdl;
6479 Lisp_Object val;
6480 specbind (Qinhibit_redisplay, Qt);
6481 val = internal_condition_case_1 (Feval, sexpr, Qerror,
6482 menu_item_eval_property_1);
6483 return unbind_to (count, val);
6486 /* This function parses a menu item and leaves the result in the
6487 vector item_properties.
6488 ITEM is a key binding, a possible menu item.
6489 If NOTREAL is nonzero, only check for equivalent key bindings, don't
6490 evaluate dynamic expressions in the menu item.
6491 INMENUBAR is > 0 when this is considered for an entry in a menu bar
6492 top level.
6493 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
6494 parse_menu_item returns true if the item is a menu item and false
6495 otherwise. */
6498 parse_menu_item (item, notreal, inmenubar)
6499 Lisp_Object item;
6500 int notreal, inmenubar;
6502 Lisp_Object def, tem, item_string, start;
6503 Lisp_Object cachelist;
6504 Lisp_Object filter;
6505 Lisp_Object keyhint;
6506 int i;
6507 int newcache = 0;
6509 cachelist = Qnil;
6510 filter = Qnil;
6511 keyhint = Qnil;
6513 if (!CONSP (item))
6514 return 0;
6516 /* Create item_properties vector if necessary. */
6517 if (NILP (item_properties))
6518 item_properties
6519 = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
6521 /* Initialize optional entries. */
6522 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
6523 AREF (item_properties, i) = Qnil;
6524 AREF (item_properties, ITEM_PROPERTY_ENABLE) = Qt;
6526 /* Save the item here to protect it from GC. */
6527 AREF (item_properties, ITEM_PROPERTY_ITEM) = item;
6529 item_string = XCAR (item);
6531 start = item;
6532 item = XCDR (item);
6533 if (STRINGP (item_string))
6535 /* Old format menu item. */
6536 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
6538 /* Maybe help string. */
6539 if (CONSP (item) && STRINGP (XCAR (item)))
6541 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
6542 start = item;
6543 item = XCDR (item);
6546 /* Maybe key binding cache. */
6547 if (CONSP (item) && CONSP (XCAR (item))
6548 && (NILP (XCAR (XCAR (item)))
6549 || VECTORP (XCAR (XCAR (item)))))
6551 cachelist = XCAR (item);
6552 item = XCDR (item);
6555 /* This is the real definition--the function to run. */
6556 AREF (item_properties, ITEM_PROPERTY_DEF) = item;
6558 /* Get enable property, if any. */
6559 if (SYMBOLP (item))
6561 tem = Fget (item, Qmenu_enable);
6562 if (!NILP (tem))
6563 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
6566 else if (EQ (item_string, Qmenu_item) && CONSP (item))
6568 /* New format menu item. */
6569 AREF (item_properties, ITEM_PROPERTY_NAME) = XCAR (item);
6570 start = XCDR (item);
6571 if (CONSP (start))
6573 /* We have a real binding. */
6574 AREF (item_properties, ITEM_PROPERTY_DEF) = XCAR (start);
6576 item = XCDR (start);
6577 /* Is there a cache list with key equivalences. */
6578 if (CONSP (item) && CONSP (XCAR (item)))
6580 cachelist = XCAR (item);
6581 item = XCDR (item);
6584 /* Parse properties. */
6585 while (CONSP (item) && CONSP (XCDR (item)))
6587 tem = XCAR (item);
6588 item = XCDR (item);
6590 if (EQ (tem, QCenable))
6591 AREF (item_properties, ITEM_PROPERTY_ENABLE) = XCAR (item);
6592 else if (EQ (tem, QCvisible) && !notreal)
6594 /* If got a visible property and that evaluates to nil
6595 then ignore this item. */
6596 tem = menu_item_eval_property (XCAR (item));
6597 if (NILP (tem))
6598 return 0;
6600 else if (EQ (tem, QChelp))
6601 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
6602 else if (EQ (tem, QCfilter))
6603 filter = item;
6604 else if (EQ (tem, QCkey_sequence))
6606 tem = XCAR (item);
6607 if (NILP (cachelist)
6608 && (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem)))
6609 /* Be GC protected. Set keyhint to item instead of tem. */
6610 keyhint = item;
6612 else if (EQ (tem, QCkeys))
6614 tem = XCAR (item);
6615 if (CONSP (tem) || (STRINGP (tem) && NILP (cachelist)))
6616 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
6618 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
6620 Lisp_Object type;
6621 tem = XCAR (item);
6622 type = XCAR (tem);
6623 if (EQ (type, QCtoggle) || EQ (type, QCradio))
6625 AREF (item_properties, ITEM_PROPERTY_SELECTED)
6626 = XCDR (tem);
6627 AREF (item_properties, ITEM_PROPERTY_TYPE)
6628 = type;
6631 item = XCDR (item);
6634 else if (inmenubar || !NILP (start))
6635 return 0;
6637 else
6638 return 0; /* not a menu item */
6640 /* If item string is not a string, evaluate it to get string.
6641 If we don't get a string, skip this item. */
6642 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
6643 if (!(STRINGP (item_string) || notreal))
6645 item_string = menu_item_eval_property (item_string);
6646 if (!STRINGP (item_string))
6647 return 0;
6648 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
6651 /* If got a filter apply it on definition. */
6652 def = AREF (item_properties, ITEM_PROPERTY_DEF);
6653 if (!NILP (filter))
6655 def = menu_item_eval_property (list2 (XCAR (filter),
6656 list2 (Qquote, def)));
6658 AREF (item_properties, ITEM_PROPERTY_DEF) = def;
6661 /* If we got no definition, this item is just unselectable text which
6662 is OK in a submenu but not in the menubar. */
6663 if (NILP (def))
6664 return (inmenubar ? 0 : 1);
6666 /* Enable or disable selection of item. */
6667 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
6668 if (!EQ (tem, Qt))
6670 if (notreal)
6671 tem = Qt;
6672 else
6673 tem = menu_item_eval_property (tem);
6674 if (inmenubar && NILP (tem))
6675 return 0; /* Ignore disabled items in menu bar. */
6676 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
6679 /* See if this is a separate pane or a submenu. */
6680 def = AREF (item_properties, ITEM_PROPERTY_DEF);
6681 tem = get_keymap (def, 0, 1);
6682 /* For a subkeymap, just record its details and exit. */
6683 if (CONSP (tem))
6685 AREF (item_properties, ITEM_PROPERTY_MAP) = tem;
6686 AREF (item_properties, ITEM_PROPERTY_DEF) = tem;
6687 return 1;
6690 /* At the top level in the menu bar, do likewise for commands also.
6691 The menu bar does not display equivalent key bindings anyway.
6692 ITEM_PROPERTY_DEF is already set up properly. */
6693 if (inmenubar > 0)
6694 return 1;
6696 /* This is a command. See if there is an equivalent key binding. */
6697 if (NILP (cachelist))
6699 /* We have to create a cachelist. */
6700 CHECK_IMPURE (start);
6701 XCDR (start) = Fcons (Fcons (Qnil, Qnil), XCDR (start));
6702 cachelist = XCAR (XCDR (start));
6703 newcache = 1;
6704 tem = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
6705 if (!NILP (keyhint))
6707 XCAR (cachelist) = XCAR (keyhint);
6708 newcache = 0;
6710 else if (STRINGP (tem))
6712 XCDR (cachelist) = Fsubstitute_command_keys (tem);
6713 XCAR (cachelist) = Qt;
6717 tem = XCAR (cachelist);
6718 if (!EQ (tem, Qt))
6720 int chkcache = 0;
6721 Lisp_Object prefix;
6723 if (!NILP (tem))
6724 tem = Fkey_binding (tem, Qnil);
6726 prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
6727 if (CONSP (prefix))
6729 def = XCAR (prefix);
6730 prefix = XCDR (prefix);
6732 else
6733 def = AREF (item_properties, ITEM_PROPERTY_DEF);
6735 if (!update_menu_bindings)
6736 chkcache = 0;
6737 else if (NILP (XCAR (cachelist))) /* Have no saved key. */
6739 if (newcache /* Always check first time. */
6740 /* Should we check everything when precomputing key
6741 bindings? */
6742 /* If something had no key binding before, don't recheck it
6743 because that is too slow--except if we have a list of
6744 rebound commands in Vdefine_key_rebound_commands, do
6745 recheck any command that appears in that list. */
6746 || (CONSP (Vdefine_key_rebound_commands)
6747 && !NILP (Fmemq (def, Vdefine_key_rebound_commands))))
6748 chkcache = 1;
6750 /* We had a saved key. Is it still bound to the command? */
6751 else if (NILP (tem)
6752 || (!EQ (tem, def)
6753 /* If the command is an alias for another
6754 (such as lmenu.el set it up), check if the
6755 original command matches the cached command. */
6756 && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))))
6757 chkcache = 1; /* Need to recompute key binding. */
6759 if (chkcache)
6761 /* Recompute equivalent key binding. If the command is an alias
6762 for another (such as lmenu.el set it up), see if the original
6763 command name has equivalent keys. Otherwise look up the
6764 specified command itself. We don't try both, because that
6765 makes lmenu menus slow. */
6766 if (SYMBOLP (def)
6767 && SYMBOLP (XSYMBOL (def)->function)
6768 && ! NILP (Fget (def, Qmenu_alias)))
6769 def = XSYMBOL (def)->function;
6770 tem = Fwhere_is_internal (def, Qnil, Qt, Qnil);
6771 XCAR (cachelist) = tem;
6772 if (NILP (tem))
6774 XCDR (cachelist) = Qnil;
6775 chkcache = 0;
6778 else if (!NILP (keyhint) && !NILP (XCAR (cachelist)))
6780 tem = XCAR (cachelist);
6781 chkcache = 1;
6784 newcache = chkcache;
6785 if (chkcache)
6787 tem = Fkey_description (tem);
6788 if (CONSP (prefix))
6790 if (STRINGP (XCAR (prefix)))
6791 tem = concat2 (XCAR (prefix), tem);
6792 if (STRINGP (XCDR (prefix)))
6793 tem = concat2 (tem, XCDR (prefix));
6795 XCDR (cachelist) = tem;
6799 tem = XCDR (cachelist);
6800 if (newcache && !NILP (tem))
6802 tem = concat3 (build_string (" ("), tem, build_string (")"));
6803 XCDR (cachelist) = tem;
6806 /* If we only want to precompute equivalent key bindings, stop here. */
6807 if (notreal)
6808 return 1;
6810 /* If we have an equivalent key binding, use that. */
6811 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
6813 /* Include this when menu help is implemented.
6814 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
6815 if (!(NILP (tem) || STRINGP (tem)))
6817 tem = menu_item_eval_property (tem);
6818 if (!STRINGP (tem))
6819 tem = Qnil;
6820 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
6824 /* Handle radio buttons or toggle boxes. */
6825 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
6826 if (!NILP (tem))
6827 AREF (item_properties, ITEM_PROPERTY_SELECTED)
6828 = menu_item_eval_property (tem);
6830 return 1;
6835 /***********************************************************************
6836 Tool-bars
6837 ***********************************************************************/
6839 /* A vector holding tool bar items while they are parsed in function
6840 tool_bar_items runs Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
6841 in the vector. */
6843 static Lisp_Object tool_bar_items_vector;
6845 /* A vector holding the result of parse_tool_bar_item. Layout is like
6846 the one for a single item in tool_bar_items_vector. */
6848 static Lisp_Object tool_bar_item_properties;
6850 /* Next free index in tool_bar_items_vector. */
6852 static int ntool_bar_items;
6854 /* The symbols `tool-bar', and `:image'. */
6856 extern Lisp_Object Qtool_bar;
6857 Lisp_Object QCimage;
6859 /* Function prototypes. */
6861 static void init_tool_bar_items P_ ((Lisp_Object));
6862 static void process_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
6863 static int parse_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
6864 static void append_tool_bar_item P_ ((void));
6867 /* Return a vector of tool bar items for keymaps currently in effect.
6868 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
6869 tool bar items found. */
6871 Lisp_Object
6872 tool_bar_items (reuse, nitems)
6873 Lisp_Object reuse;
6874 int *nitems;
6876 Lisp_Object *maps;
6877 int nmaps, i;
6878 Lisp_Object oquit;
6879 Lisp_Object *tmaps;
6880 extern Lisp_Object Voverriding_local_map_menu_flag;
6881 extern Lisp_Object Voverriding_local_map;
6883 *nitems = 0;
6885 /* In order to build the menus, we need to call the keymap
6886 accessors. They all call QUIT. But this function is called
6887 during redisplay, during which a quit is fatal. So inhibit
6888 quitting while building the menus. We do this instead of
6889 specbind because (1) errors will clear it anyway and (2) this
6890 avoids risk of specpdl overflow. */
6891 oquit = Vinhibit_quit;
6892 Vinhibit_quit = Qt;
6894 /* Initialize tool_bar_items_vector and protect it from GC. */
6895 init_tool_bar_items (reuse);
6897 /* Build list of keymaps in maps. Set nmaps to the number of maps
6898 to process. */
6900 /* Should overriding-terminal-local-map and overriding-local-map apply? */
6901 if (!NILP (Voverriding_local_map_menu_flag))
6903 /* Yes, use them (if non-nil) as well as the global map. */
6904 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
6905 nmaps = 0;
6906 if (!NILP (current_kboard->Voverriding_terminal_local_map))
6907 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
6908 if (!NILP (Voverriding_local_map))
6909 maps[nmaps++] = Voverriding_local_map;
6911 else
6913 /* No, so use major and minor mode keymaps and keymap property. */
6914 int extra_maps = 2;
6915 Lisp_Object map = get_local_map (PT, current_buffer, keymap);
6916 if (!NILP (map))
6917 extra_maps = 3;
6918 nmaps = current_minor_maps (NULL, &tmaps);
6919 maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
6920 * sizeof (maps[0]));
6921 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
6922 if (!NILP (map))
6923 maps[nmaps++] = map;
6924 maps[nmaps++] = get_local_map (PT, current_buffer, local_map);
6927 /* Add global keymap at the end. */
6928 maps[nmaps++] = current_global_map;
6930 /* Process maps in reverse order and look up in each map the prefix
6931 key `tool-bar'. */
6932 for (i = nmaps - 1; i >= 0; --i)
6933 if (!NILP (maps[i]))
6935 Lisp_Object keymap;
6937 /* Why set the `noinherit' flag ? -sm */
6938 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 1, 0), 0, 0);
6939 if (CONSP (keymap))
6941 Lisp_Object tail;
6943 /* KEYMAP is a list `(keymap (KEY . BINDING) ...)'. */
6944 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
6946 Lisp_Object keydef = XCAR (tail);
6947 if (CONSP (keydef))
6948 process_tool_bar_item (XCAR (keydef), XCDR (keydef));
6953 Vinhibit_quit = oquit;
6954 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
6955 return tool_bar_items_vector;
6959 /* Process the definition of KEY which is DEF. */
6961 static void
6962 process_tool_bar_item (key, def)
6963 Lisp_Object key, def;
6965 int i;
6966 extern Lisp_Object Qundefined;
6967 struct gcpro gcpro1, gcpro2;
6969 /* Protect KEY and DEF from GC because parse_tool_bar_item may call
6970 eval. */
6971 GCPRO2 (key, def);
6973 if (EQ (def, Qundefined))
6975 /* If a map has an explicit `undefined' as definition,
6976 discard any previously made item. */
6977 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
6979 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
6981 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
6983 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
6984 bcopy (v + TOOL_BAR_ITEM_NSLOTS, v,
6985 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
6986 * sizeof (Lisp_Object)));
6987 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
6988 break;
6992 else if (parse_tool_bar_item (key, def))
6993 /* Append a new tool bar item to tool_bar_items_vector. Accept
6994 more than one definition for the same key. */
6995 append_tool_bar_item ();
6997 UNGCPRO;
7001 /* Parse a tool bar item specification ITEM for key KEY and return the
7002 result in tool_bar_item_properties. Value is zero if ITEM is
7003 invalid.
7005 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
7007 CAPTION is the caption of the item, If it's not a string, it is
7008 evaluated to get a string.
7010 BINDING is the tool bar item's binding. Tool-bar items with keymaps
7011 as binding are currently ignored.
7013 The following properties are recognized:
7015 - `:enable FORM'.
7017 FORM is evaluated and specifies whether the tool bar item is
7018 enabled or disabled.
7020 - `:visible FORM'
7022 FORM is evaluated and specifies whether the tool bar item is visible.
7024 - `:filter FUNCTION'
7026 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
7027 result is stored as the new binding.
7029 - `:button (TYPE SELECTED)'
7031 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
7032 and specifies whether the button is selected (pressed) or not.
7034 - `:image IMAGES'
7036 IMAGES is either a single image specification or a vector of four
7037 image specifications. See enum tool_bar_item_images.
7039 - `:help HELP-STRING'.
7041 Gives a help string to display for the tool bar item. */
7043 static int
7044 parse_tool_bar_item (key, item)
7045 Lisp_Object key, item;
7047 /* Access slot with index IDX of vector tool_bar_item_properties. */
7048 #define PROP(IDX) XVECTOR (tool_bar_item_properties)->contents[IDX]
7050 Lisp_Object filter = Qnil;
7051 Lisp_Object caption;
7052 extern Lisp_Object QCenable, QCvisible, QChelp, QCfilter;
7053 extern Lisp_Object QCbutton, QCtoggle, QCradio;
7054 int i;
7056 /* Defininition looks like `(menu-item CAPTION BINDING PROPS...)'.
7057 Rule out items that aren't lists, don't start with
7058 `menu-item' or whose rest following `tool-bar-item' is not a
7059 list. */
7060 if (!CONSP (item)
7061 || !EQ (XCAR (item), Qmenu_item)
7062 || (item = XCDR (item),
7063 !CONSP (item)))
7064 return 0;
7066 /* Create tool_bar_item_properties vector if necessary. Reset it to
7067 defaults. */
7068 if (VECTORP (tool_bar_item_properties))
7070 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
7071 PROP (i) = Qnil;
7073 else
7074 tool_bar_item_properties
7075 = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
7077 /* Set defaults. */
7078 PROP (TOOL_BAR_ITEM_KEY) = key;
7079 PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
7081 /* Get the caption of the item. If the caption is not a string,
7082 evaluate it to get a string. If we don't get a string, skip this
7083 item. */
7084 caption = XCAR (item);
7085 if (!STRINGP (caption))
7087 caption = menu_item_eval_property (caption);
7088 if (!STRINGP (caption))
7089 return 0;
7091 PROP (TOOL_BAR_ITEM_CAPTION) = caption;
7093 /* Give up if rest following the caption is not a list. */
7094 item = XCDR (item);
7095 if (!CONSP (item))
7096 return 0;
7098 /* Store the binding. */
7099 PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item);
7100 item = XCDR (item);
7102 /* Ignore cached key binding, if any. */
7103 if (CONSP (item) && CONSP (XCAR (item)))
7104 item = XCDR (item);
7106 /* Process the rest of the properties. */
7107 for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
7109 Lisp_Object key, value;
7111 key = XCAR (item);
7112 value = XCAR (XCDR (item));
7114 if (EQ (key, QCenable))
7115 /* `:enable FORM'. */
7116 PROP (TOOL_BAR_ITEM_ENABLED_P) = value;
7117 else if (EQ (key, QCvisible))
7119 /* `:visible FORM'. If got a visible property and that
7120 evaluates to nil then ignore this item. */
7121 if (NILP (menu_item_eval_property (value)))
7122 return 0;
7124 else if (EQ (key, QChelp))
7125 /* `:help HELP-STRING'. */
7126 PROP (TOOL_BAR_ITEM_HELP) = value;
7127 else if (EQ (key, QCfilter))
7128 /* ':filter FORM'. */
7129 filter = value;
7130 else if (EQ (key, QCbutton) && CONSP (value))
7132 /* `:button (TYPE . SELECTED)'. */
7133 Lisp_Object type, selected;
7135 type = XCAR (value);
7136 selected = XCDR (value);
7137 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7139 PROP (TOOL_BAR_ITEM_SELECTED_P) = selected;
7140 PROP (TOOL_BAR_ITEM_TYPE) = type;
7143 else if (EQ (key, QCimage)
7144 && (CONSP (value)
7145 || (VECTORP (value) && XVECTOR (value)->size == 4)))
7146 /* Value is either a single image specification or a vector
7147 of 4 such specifications for the different buttion states. */
7148 PROP (TOOL_BAR_ITEM_IMAGES) = value;
7151 /* If got a filter apply it on binding. */
7152 if (!NILP (filter))
7153 PROP (TOOL_BAR_ITEM_BINDING)
7154 = menu_item_eval_property (list2 (filter,
7155 list2 (Qquote,
7156 PROP (TOOL_BAR_ITEM_BINDING))));
7158 /* See if the binding is a keymap. Give up if it is. */
7159 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
7160 return 0;
7162 /* Enable or disable selection of item. */
7163 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
7164 PROP (TOOL_BAR_ITEM_ENABLED_P)
7165 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P));
7167 /* Handle radio buttons or toggle boxes. */
7168 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
7169 PROP (TOOL_BAR_ITEM_SELECTED_P)
7170 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P));
7172 return 1;
7174 #undef PROP
7178 /* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
7179 that can be reused. */
7181 static void
7182 init_tool_bar_items (reuse)
7183 Lisp_Object reuse;
7185 if (VECTORP (reuse))
7186 tool_bar_items_vector = reuse;
7187 else
7188 tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
7189 ntool_bar_items = 0;
7193 /* Append parsed tool bar item properties from
7194 tool_bar_item_properties */
7196 static void
7197 append_tool_bar_item ()
7199 Lisp_Object *to, *from;
7201 /* Enlarge tool_bar_items_vector if necessary. */
7202 if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
7203 >= XVECTOR (tool_bar_items_vector)->size)
7205 Lisp_Object new_vector;
7206 int old_size = XVECTOR (tool_bar_items_vector)->size;
7208 new_vector = Fmake_vector (make_number (2 * old_size), Qnil);
7209 bcopy (XVECTOR (tool_bar_items_vector)->contents,
7210 XVECTOR (new_vector)->contents,
7211 old_size * sizeof (Lisp_Object));
7212 tool_bar_items_vector = new_vector;
7215 /* Append entries from tool_bar_item_properties to the end of
7216 tool_bar_items_vector. */
7217 to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
7218 from = XVECTOR (tool_bar_item_properties)->contents;
7219 bcopy (from, to, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
7220 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
7227 /* Read a character using menus based on maps in the array MAPS.
7228 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
7229 Return t if we displayed a menu but the user rejected it.
7231 PREV_EVENT is the previous input event, or nil if we are reading
7232 the first event of a key sequence.
7234 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
7235 if we used a mouse menu to read the input, or zero otherwise. If
7236 USED_MOUSE_MENU is null, we don't dereference it.
7238 The prompting is done based on the prompt-string of the map
7239 and the strings associated with various map elements.
7241 This can be done with X menus or with menus put in the minibuf.
7242 These are done in different ways, depending on how the input will be read.
7243 Menus using X are done after auto-saving in read-char, getting the input
7244 event from Fx_popup_menu; menus using the minibuf use read_char recursively
7245 and do auto-saving in the inner call of read_char. */
7247 static Lisp_Object
7248 read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
7249 int nmaps;
7250 Lisp_Object *maps;
7251 Lisp_Object prev_event;
7252 int *used_mouse_menu;
7254 int mapno;
7255 register Lisp_Object name;
7257 if (used_mouse_menu)
7258 *used_mouse_menu = 0;
7260 /* Use local over global Menu maps */
7262 if (! menu_prompting)
7263 return Qnil;
7265 /* Optionally disregard all but the global map. */
7266 if (inhibit_local_menu_bar_menus)
7268 maps += (nmaps - 1);
7269 nmaps = 1;
7272 /* Get the menu name from the first map that has one (a prompt string). */
7273 for (mapno = 0; mapno < nmaps; mapno++)
7275 name = map_prompt (maps[mapno]);
7276 if (!NILP (name))
7277 break;
7280 /* If we don't have any menus, just read a character normally. */
7281 if (mapno >= nmaps)
7282 return Qnil;
7284 #ifdef HAVE_MENUS
7285 /* If we got to this point via a mouse click,
7286 use a real menu for mouse selection. */
7287 if (EVENT_HAS_PARAMETERS (prev_event)
7288 && !EQ (XCAR (prev_event), Qmenu_bar)
7289 && !EQ (XCAR (prev_event), Qtool_bar))
7291 /* Display the menu and get the selection. */
7292 Lisp_Object *realmaps
7293 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
7294 Lisp_Object value;
7295 int nmaps1 = 0;
7297 /* Use the maps that are not nil. */
7298 for (mapno = 0; mapno < nmaps; mapno++)
7299 if (!NILP (maps[mapno]))
7300 realmaps[nmaps1++] = maps[mapno];
7302 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
7303 if (CONSP (value))
7305 Lisp_Object tem;
7307 record_menu_key (XCAR (value));
7309 /* If we got multiple events, unread all but
7310 the first.
7311 There is no way to prevent those unread events
7312 from showing up later in last_nonmenu_event.
7313 So turn symbol and integer events into lists,
7314 to indicate that they came from a mouse menu,
7315 so that when present in last_nonmenu_event
7316 they won't confuse things. */
7317 for (tem = XCDR (value); !NILP (tem);
7318 tem = XCDR (tem))
7320 record_menu_key (XCAR (tem));
7321 if (SYMBOLP (XCAR (tem))
7322 || INTEGERP (XCAR (tem)))
7323 XCAR (tem)
7324 = Fcons (XCAR (tem), Qnil);
7327 /* If we got more than one event, put all but the first
7328 onto this list to be read later.
7329 Return just the first event now. */
7330 Vunread_command_events
7331 = nconc2 (XCDR (value), Vunread_command_events);
7332 value = XCAR (value);
7334 else if (NILP (value))
7335 value = Qt;
7336 if (used_mouse_menu)
7337 *used_mouse_menu = 1;
7338 return value;
7340 #endif /* HAVE_MENUS */
7341 return Qnil ;
7344 /* Buffer in use so far for the minibuf prompts for menu keymaps.
7345 We make this bigger when necessary, and never free it. */
7346 static char *read_char_minibuf_menu_text;
7347 /* Size of that buffer. */
7348 static int read_char_minibuf_menu_width;
7350 static Lisp_Object
7351 read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
7352 int commandflag ;
7353 int nmaps;
7354 Lisp_Object *maps;
7356 int mapno;
7357 register Lisp_Object name;
7358 int nlength;
7359 int width = FRAME_WIDTH (SELECTED_FRAME ()) - 4;
7360 int idx = -1;
7361 int nobindings = 1;
7362 Lisp_Object rest, vector;
7363 char *menu;
7365 vector = Qnil;
7367 if (! menu_prompting)
7368 return Qnil;
7370 /* Make sure we have a big enough buffer for the menu text. */
7371 if (read_char_minibuf_menu_text == 0)
7373 read_char_minibuf_menu_width = width + 4;
7374 read_char_minibuf_menu_text = (char *) xmalloc (width + 4);
7376 else if (width + 4 > read_char_minibuf_menu_width)
7378 read_char_minibuf_menu_width = width + 4;
7379 read_char_minibuf_menu_text
7380 = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
7382 menu = read_char_minibuf_menu_text;
7384 /* Get the menu name from the first map that has one (a prompt string). */
7385 for (mapno = 0; mapno < nmaps; mapno++)
7387 name = map_prompt (maps[mapno]);
7388 if (!NILP (name))
7389 break;
7392 /* If we don't have any menus, just read a character normally. */
7393 if (mapno >= nmaps)
7394 return Qnil;
7396 /* Prompt string always starts with map's prompt, and a space. */
7397 strcpy (menu, XSTRING (name)->data);
7398 nlength = STRING_BYTES (XSTRING (name));
7399 menu[nlength++] = ':';
7400 menu[nlength++] = ' ';
7401 menu[nlength] = 0;
7403 /* Start prompting at start of first map. */
7404 mapno = 0;
7405 rest = maps[mapno];
7407 /* Present the documented bindings, a line at a time. */
7408 while (1)
7410 int notfirst = 0;
7411 int i = nlength;
7412 Lisp_Object obj;
7413 int ch;
7414 Lisp_Object orig_defn_macro;
7416 /* Loop over elements of map. */
7417 while (i < width)
7419 Lisp_Object elt;
7421 /* If reached end of map, start at beginning of next map. */
7422 if (NILP (rest))
7424 mapno++;
7425 /* At end of last map, wrap around to first map if just starting,
7426 or end this line if already have something on it. */
7427 if (mapno == nmaps)
7429 mapno = 0;
7430 if (notfirst || nobindings) break;
7432 rest = maps[mapno];
7435 /* Look at the next element of the map. */
7436 if (idx >= 0)
7437 elt = XVECTOR (vector)->contents[idx];
7438 else
7439 elt = Fcar_safe (rest);
7441 if (idx < 0 && VECTORP (elt))
7443 /* If we found a dense table in the keymap,
7444 advanced past it, but start scanning its contents. */
7445 rest = Fcdr_safe (rest);
7446 vector = elt;
7447 idx = 0;
7449 else
7451 /* An ordinary element. */
7452 Lisp_Object event, tem;
7454 if (idx < 0)
7456 event = Fcar_safe (elt); /* alist */
7457 elt = Fcdr_safe (elt);
7459 else
7461 XSETINT (event, idx); /* vector */
7464 /* Ignore the element if it has no prompt string. */
7465 if (INTEGERP (event) && parse_menu_item (elt, 0, -1))
7467 /* 1 if the char to type matches the string. */
7468 int char_matches;
7469 Lisp_Object upcased_event, downcased_event;
7470 Lisp_Object desc = Qnil;
7471 Lisp_Object s
7472 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
7474 upcased_event = Fupcase (event);
7475 downcased_event = Fdowncase (event);
7476 char_matches = (XINT (upcased_event) == XSTRING (s)->data[0]
7477 || XINT (downcased_event) == XSTRING (s)->data[0]);
7478 if (! char_matches)
7479 desc = Fsingle_key_description (event, Qnil);
7482 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
7483 if (!NILP (tem))
7484 /* Insert equivalent keybinding. */
7485 s = concat2 (s, tem);
7488 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
7489 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
7491 /* Insert button prefix. */
7492 Lisp_Object selected
7493 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
7494 if (EQ (tem, QCradio))
7495 tem = build_string (NILP (selected) ? "(*) " : "( ) ");
7496 else
7497 tem = build_string (NILP (selected) ? "[X] " : "[ ] ");
7498 s = concat2 (tem, s);
7502 /* If we have room for the prompt string, add it to this line.
7503 If this is the first on the line, always add it. */
7504 if ((XSTRING (s)->size + i + 2
7505 + (char_matches ? 0 : XSTRING (desc)->size + 3))
7506 < width
7507 || !notfirst)
7509 int thiswidth;
7511 /* Punctuate between strings. */
7512 if (notfirst)
7514 strcpy (menu + i, ", ");
7515 i += 2;
7517 notfirst = 1;
7518 nobindings = 0 ;
7520 /* If the char to type doesn't match the string's
7521 first char, explicitly show what char to type. */
7522 if (! char_matches)
7524 /* Add as much of string as fits. */
7525 thiswidth = XSTRING (desc)->size;
7526 if (thiswidth + i > width)
7527 thiswidth = width - i;
7528 bcopy (XSTRING (desc)->data, menu + i, thiswidth);
7529 i += thiswidth;
7530 strcpy (menu + i, " = ");
7531 i += 3;
7534 /* Add as much of string as fits. */
7535 thiswidth = XSTRING (s)->size;
7536 if (thiswidth + i > width)
7537 thiswidth = width - i;
7538 bcopy (XSTRING (s)->data, menu + i, thiswidth);
7539 i += thiswidth;
7540 menu[i] = 0;
7542 else
7544 /* If this element does not fit, end the line now,
7545 and save the element for the next line. */
7546 strcpy (menu + i, "...");
7547 break;
7551 /* Move past this element. */
7552 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
7553 /* Handle reaching end of dense table. */
7554 idx = -1;
7555 if (idx >= 0)
7556 idx++;
7557 else
7558 rest = Fcdr_safe (rest);
7562 /* Prompt with that and read response. */
7563 message2_nolog (menu, strlen (menu),
7564 ! NILP (current_buffer->enable_multibyte_characters));
7566 /* Make believe its not a keyboard macro in case the help char
7567 is pressed. Help characters are not recorded because menu prompting
7568 is not used on replay.
7570 orig_defn_macro = current_kboard->defining_kbd_macro;
7571 current_kboard->defining_kbd_macro = Qnil;
7573 obj = read_char (commandflag, 0, 0, Qt, 0);
7574 while (BUFFERP (obj));
7575 current_kboard->defining_kbd_macro = orig_defn_macro;
7577 if (!INTEGERP (obj))
7578 return obj;
7579 else
7580 ch = XINT (obj);
7582 if (! EQ (obj, menu_prompt_more_char)
7583 && (!INTEGERP (menu_prompt_more_char)
7584 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
7586 if (!NILP (current_kboard->defining_kbd_macro))
7587 store_kbd_macro_char (obj);
7588 return obj;
7590 /* Help char - go round again */
7594 /* Reading key sequences. */
7596 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
7597 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
7598 keymap, or nil otherwise. Return the index of the first keymap in
7599 which KEY has any binding, or NMAPS if no map has a binding.
7601 If KEY is a meta ASCII character, treat it like meta-prefix-char
7602 followed by the corresponding non-meta character. Keymaps in
7603 CURRENT with non-prefix bindings for meta-prefix-char become nil in
7604 NEXT.
7606 If KEY has no bindings in any of the CURRENT maps, NEXT is left
7607 unmodified.
7609 NEXT may be the same array as CURRENT. */
7611 static int
7612 follow_key (key, nmaps, current, defs, next)
7613 Lisp_Object key;
7614 Lisp_Object *current, *defs, *next;
7615 int nmaps;
7617 int i, first_binding;
7618 int did_meta = 0;
7620 first_binding = nmaps;
7621 for (i = nmaps - 1; i >= 0; i--)
7623 if (! NILP (current[i]))
7625 Lisp_Object map;
7626 if (did_meta)
7627 map = defs[i];
7628 else
7629 map = current[i];
7631 defs[i] = access_keymap (map, key, 1, 0, 1);
7632 if (! NILP (defs[i]))
7633 first_binding = i;
7635 else
7636 defs[i] = Qnil;
7639 /* Given the set of bindings we've found, produce the next set of maps. */
7640 if (first_binding < nmaps)
7641 for (i = 0; i < nmaps; i++)
7642 next[i] = NILP (defs[i]) ? Qnil : get_keymap (defs[i], 0, 1);
7644 return first_binding;
7647 /* Read a sequence of keys that ends with a non prefix character,
7648 storing it in KEYBUF, a buffer of size BUFSIZE.
7649 Prompt with PROMPT.
7650 Return the length of the key sequence stored.
7651 Return -1 if the user rejected a command menu.
7653 Echo starting immediately unless `prompt' is 0.
7655 Where a key sequence ends depends on the currently active keymaps.
7656 These include any minor mode keymaps active in the current buffer,
7657 the current buffer's local map, and the global map.
7659 If a key sequence has no other bindings, we check Vfunction_key_map
7660 to see if some trailing subsequence might be the beginning of a
7661 function key's sequence. If so, we try to read the whole function
7662 key, and substitute its symbolic name into the key sequence.
7664 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
7665 `double-' events into similar click events, if that would make them
7666 bound. We try to turn `triple-' events first into `double-' events,
7667 then into clicks.
7669 If we get a mouse click in a mode line, vertical divider, or other
7670 non-text area, we treat the click as if it were prefixed by the
7671 symbol denoting that area - `mode-line', `vertical-line', or
7672 whatever.
7674 If the sequence starts with a mouse click, we read the key sequence
7675 with respect to the buffer clicked on, not the current buffer.
7677 If the user switches frames in the midst of a key sequence, we put
7678 off the switch-frame event until later; the next call to
7679 read_char will return it.
7681 If FIX_CURRENT_BUFFER is nonzero, we restore current_buffer
7682 from the selected window's buffer. */
7684 static int
7685 read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
7686 can_return_switch_frame, fix_current_buffer)
7687 Lisp_Object *keybuf;
7688 int bufsize;
7689 Lisp_Object prompt;
7690 int dont_downcase_last;
7691 int can_return_switch_frame;
7692 int fix_current_buffer;
7694 volatile int count = specpdl_ptr - specpdl;
7696 /* How many keys there are in the current key sequence. */
7697 volatile int t;
7699 /* The length of the echo buffer when we started reading, and
7700 the length of this_command_keys when we started reading. */
7701 volatile int echo_start;
7702 volatile int keys_start;
7704 /* The number of keymaps we're scanning right now, and the number of
7705 keymaps we have allocated space for. */
7706 volatile int nmaps;
7707 volatile int nmaps_allocated = 0;
7709 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
7710 the current keymaps. */
7711 Lisp_Object *volatile defs = NULL;
7713 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
7714 in the current keymaps, or nil where it is not a prefix. */
7715 Lisp_Object *volatile submaps = NULL;
7717 /* The local map to start out with at start of key sequence. */
7718 volatile Lisp_Object orig_local_map;
7720 /* The map from the `keymap' property to start out with at start of
7721 key sequence. */
7722 volatile Lisp_Object orig_keymap;
7724 /* 1 if we have already considered switching to the local-map property
7725 of the place where a mouse click occurred. */
7726 volatile int localized_local_map = 0;
7728 /* The index in defs[] of the first keymap that has a binding for
7729 this key sequence. In other words, the lowest i such that
7730 defs[i] is non-nil. */
7731 volatile int first_binding;
7733 /* If t < mock_input, then KEYBUF[t] should be read as the next
7734 input key.
7736 We use this to recover after recognizing a function key. Once we
7737 realize that a suffix of the current key sequence is actually a
7738 function key's escape sequence, we replace the suffix with the
7739 function key's binding from Vfunction_key_map. Now keybuf
7740 contains a new and different key sequence, so the echo area,
7741 this_command_keys, and the submaps and defs arrays are wrong. In
7742 this situation, we set mock_input to t, set t to 0, and jump to
7743 restart_sequence; the loop will read keys from keybuf up until
7744 mock_input, thus rebuilding the state; and then it will resume
7745 reading characters from the keyboard. */
7746 volatile int mock_input = 0;
7748 /* If the sequence is unbound in submaps[], then
7749 keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map,
7750 and fkey_map is its binding.
7752 These might be > t, indicating that all function key scanning
7753 should hold off until t reaches them. We do this when we've just
7754 recognized a function key, to avoid searching for the function
7755 key's again in Vfunction_key_map. */
7756 volatile int fkey_start = 0, fkey_end = 0;
7757 volatile Lisp_Object fkey_map;
7759 /* Likewise, for key_translation_map. */
7760 volatile int keytran_start = 0, keytran_end = 0;
7761 volatile Lisp_Object keytran_map;
7763 /* If we receive a ``switch-frame'' event in the middle of a key sequence,
7764 we put it off for later. While we're reading, we keep the event here. */
7765 volatile Lisp_Object delayed_switch_frame;
7767 /* See the comment below... */
7768 #if defined (GOBBLE_FIRST_EVENT)
7769 Lisp_Object first_event;
7770 #endif
7772 volatile Lisp_Object original_uppercase;
7773 volatile int original_uppercase_position = -1;
7775 /* Gets around Microsoft compiler limitations. */
7776 int dummyflag = 0;
7778 struct buffer *starting_buffer;
7780 /* Nonzero if we seem to have got the beginning of a binding
7781 in function_key_map. */
7782 volatile int function_key_possible = 0;
7783 volatile int key_translation_possible = 0;
7785 /* Save the status of key translation before each step,
7786 so that we can restore this after downcasing. */
7787 Lisp_Object prev_fkey_map;
7788 int prev_fkey_start;
7789 int prev_fkey_end;
7791 Lisp_Object prev_keytran_map;
7792 int prev_keytran_start;
7793 int prev_keytran_end;
7795 #if defined (GOBBLE_FIRST_EVENT)
7796 int junk;
7797 #endif
7799 raw_keybuf_count = 0;
7801 last_nonmenu_event = Qnil;
7803 delayed_switch_frame = Qnil;
7804 fkey_map = Vfunction_key_map;
7805 keytran_map = Vkey_translation_map;
7807 /* If there is no function-key-map, turn off function key scanning. */
7808 if (!KEYMAPP (Vfunction_key_map))
7809 fkey_start = fkey_end = bufsize + 1;
7811 /* If there is no key-translation-map, turn off scanning. */
7812 if (!KEYMAPP (Vkey_translation_map))
7813 keytran_start = keytran_end = bufsize + 1;
7815 if (INTERACTIVE)
7817 if (!NILP (prompt))
7818 echo_prompt (XSTRING (prompt)->data);
7819 else if (cursor_in_echo_area
7820 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
7821 && NILP (Fzerop (Vecho_keystrokes)))
7822 /* This doesn't put in a dash if the echo buffer is empty, so
7823 you don't always see a dash hanging out in the minibuffer. */
7824 echo_dash ();
7827 /* Record the initial state of the echo area and this_command_keys;
7828 we will need to restore them if we replay a key sequence. */
7829 if (INTERACTIVE)
7830 echo_start = echo_length ();
7831 keys_start = this_command_key_count;
7832 this_single_command_key_start = keys_start;
7834 #if defined (GOBBLE_FIRST_EVENT)
7835 /* This doesn't quite work, because some of the things that read_char
7836 does cannot safely be bypassed. It seems too risky to try to make
7837 this work right. */
7839 /* Read the first char of the sequence specially, before setting
7840 up any keymaps, in case a filter runs and switches buffers on us. */
7841 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
7842 &junk);
7843 #endif /* GOBBLE_FIRST_EVENT */
7845 orig_local_map = get_local_map (PT, current_buffer, local_map);
7846 orig_keymap = get_local_map (PT, current_buffer, keymap);
7848 /* We jump here when the key sequence has been thoroughly changed, and
7849 we need to rescan it starting from the beginning. When we jump here,
7850 keybuf[0..mock_input] holds the sequence we should reread. */
7851 replay_sequence:
7853 starting_buffer = current_buffer;
7854 function_key_possible = 0;
7855 key_translation_possible = 0;
7857 /* Build our list of keymaps.
7858 If we recognize a function key and replace its escape sequence in
7859 keybuf with its symbol, or if the sequence starts with a mouse
7860 click and we need to switch buffers, we jump back here to rebuild
7861 the initial keymaps from the current buffer. */
7863 Lisp_Object *maps;
7865 if (!NILP (current_kboard->Voverriding_terminal_local_map)
7866 || !NILP (Voverriding_local_map))
7868 if (3 > nmaps_allocated)
7870 submaps = (Lisp_Object *) alloca (3 * sizeof (submaps[0]));
7871 defs = (Lisp_Object *) alloca (3 * sizeof (defs[0]));
7872 nmaps_allocated = 3;
7874 nmaps = 0;
7875 if (!NILP (current_kboard->Voverriding_terminal_local_map))
7876 submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
7877 if (!NILP (Voverriding_local_map))
7878 submaps[nmaps++] = Voverriding_local_map;
7880 else
7882 int extra_maps = 2;
7883 nmaps = current_minor_maps (0, &maps);
7884 if (!NILP (orig_keymap))
7885 extra_maps = 3;
7886 if (nmaps + extra_maps > nmaps_allocated)
7888 submaps = (Lisp_Object *) alloca ((nmaps+extra_maps)
7889 * sizeof (submaps[0]));
7890 defs = (Lisp_Object *) alloca ((nmaps+extra_maps)
7891 * sizeof (defs[0]));
7892 nmaps_allocated = nmaps + extra_maps;
7894 bcopy (maps, (void *) submaps, nmaps * sizeof (submaps[0]));
7895 if (!NILP (orig_keymap))
7896 submaps[nmaps++] = orig_keymap;
7897 submaps[nmaps++] = orig_local_map;
7899 submaps[nmaps++] = current_global_map;
7902 /* Find an accurate initial value for first_binding. */
7903 for (first_binding = 0; first_binding < nmaps; first_binding++)
7904 if (! NILP (submaps[first_binding]))
7905 break;
7907 /* Start from the beginning in keybuf. */
7908 t = 0;
7910 /* These are no-ops the first time through, but if we restart, they
7911 revert the echo area and this_command_keys to their original state. */
7912 this_command_key_count = keys_start;
7913 if (INTERACTIVE && t < mock_input)
7914 echo_truncate (echo_start);
7916 /* If the best binding for the current key sequence is a keymap, or
7917 we may be looking at a function key's escape sequence, keep on
7918 reading. */
7919 while ((first_binding < nmaps && ! NILP (submaps[first_binding]))
7920 || (first_binding >= nmaps
7921 && fkey_start < t
7922 /* mock input is never part of a function key's sequence. */
7923 && mock_input <= fkey_start)
7924 || (first_binding >= nmaps
7925 && keytran_start < t && key_translation_possible)
7926 /* Don't return in the middle of a possible function key sequence,
7927 if the only bindings we found were via case conversion.
7928 Thus, if ESC O a has a function-key-map translation
7929 and ESC o has a binding, don't return after ESC O,
7930 so that we can translate ESC O plus the next character. */
7933 Lisp_Object key;
7934 int used_mouse_menu = 0;
7936 /* Where the last real key started. If we need to throw away a
7937 key that has expanded into more than one element of keybuf
7938 (say, a mouse click on the mode line which is being treated
7939 as [mode-line (mouse-...)], then we backtrack to this point
7940 of keybuf. */
7941 volatile int last_real_key_start;
7943 /* These variables are analogous to echo_start and keys_start;
7944 while those allow us to restart the entire key sequence,
7945 echo_local_start and keys_local_start allow us to throw away
7946 just one key. */
7947 volatile int echo_local_start, keys_local_start, local_first_binding;
7949 if (t >= bufsize)
7950 error ("Key sequence too long");
7952 if (INTERACTIVE)
7953 echo_local_start = echo_length ();
7954 keys_local_start = this_command_key_count;
7955 local_first_binding = first_binding;
7957 replay_key:
7958 /* These are no-ops, unless we throw away a keystroke below and
7959 jumped back up to replay_key; in that case, these restore the
7960 variables to their original state, allowing us to replay the
7961 loop. */
7962 if (INTERACTIVE && t < mock_input)
7963 echo_truncate (echo_local_start);
7964 this_command_key_count = keys_local_start;
7965 first_binding = local_first_binding;
7967 /* By default, assume each event is "real". */
7968 last_real_key_start = t;
7970 /* Does mock_input indicate that we are re-reading a key sequence? */
7971 if (t < mock_input)
7973 key = keybuf[t];
7974 add_command_key (key);
7975 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
7976 && NILP (Fzerop (Vecho_keystrokes)))
7977 echo_char (key);
7980 /* If not, we should actually read a character. */
7981 else
7984 #ifdef MULTI_KBOARD
7985 KBOARD *interrupted_kboard = current_kboard;
7986 struct frame *interrupted_frame = SELECTED_FRAME ();
7987 if (setjmp (wrong_kboard_jmpbuf))
7989 if (!NILP (delayed_switch_frame))
7991 interrupted_kboard->kbd_queue
7992 = Fcons (delayed_switch_frame,
7993 interrupted_kboard->kbd_queue);
7994 delayed_switch_frame = Qnil;
7996 while (t > 0)
7997 interrupted_kboard->kbd_queue
7998 = Fcons (keybuf[--t], interrupted_kboard->kbd_queue);
8000 /* If the side queue is non-empty, ensure it begins with a
8001 switch-frame, so we'll replay it in the right context. */
8002 if (CONSP (interrupted_kboard->kbd_queue)
8003 && (key = XCAR (interrupted_kboard->kbd_queue),
8004 !(EVENT_HAS_PARAMETERS (key)
8005 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
8006 Qswitch_frame))))
8008 Lisp_Object frame;
8009 XSETFRAME (frame, interrupted_frame);
8010 interrupted_kboard->kbd_queue
8011 = Fcons (make_lispy_switch_frame (frame),
8012 interrupted_kboard->kbd_queue);
8014 mock_input = 0;
8015 orig_local_map = get_local_map (PT, current_buffer, local_map);
8016 orig_keymap = get_local_map (PT, current_buffer, keymap);
8017 goto replay_sequence;
8019 #endif
8020 key = read_char (NILP (prompt), nmaps,
8021 (Lisp_Object *) submaps, last_nonmenu_event,
8022 &used_mouse_menu);
8025 /* read_char returns t when it shows a menu and the user rejects it.
8026 Just return -1. */
8027 if (EQ (key, Qt))
8029 unbind_to (count, Qnil);
8030 return -1;
8033 /* read_char returns -1 at the end of a macro.
8034 Emacs 18 handles this by returning immediately with a
8035 zero, so that's what we'll do. */
8036 if (INTEGERP (key) && XINT (key) == -1)
8038 t = 0;
8039 /* The Microsoft C compiler can't handle the goto that
8040 would go here. */
8041 dummyflag = 1;
8042 break;
8045 /* If the current buffer has been changed from under us, the
8046 keymap may have changed, so replay the sequence. */
8047 if (BUFFERP (key))
8049 mock_input = t;
8050 /* Reset the current buffer from the selected window
8051 in case something changed the former and not the latter.
8052 This is to be more consistent with the behavior
8053 of the command_loop_1. */
8054 if (fix_current_buffer)
8056 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
8057 Fkill_emacs (Qnil);
8058 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
8059 Fset_buffer (XWINDOW (selected_window)->buffer);
8062 orig_local_map = get_local_map (PT, current_buffer, local_map);
8063 orig_keymap = get_local_map (PT, current_buffer, keymap);
8064 goto replay_sequence;
8067 /* If we have a quit that was typed in another frame, and
8068 quit_throw_to_read_char switched buffers,
8069 replay to get the right keymap. */
8070 if (XINT (key) == quit_char && current_buffer != starting_buffer)
8072 GROW_RAW_KEYBUF;
8073 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8074 keybuf[t++] = key;
8075 mock_input = t;
8076 Vquit_flag = Qnil;
8077 orig_local_map = get_local_map (PT, current_buffer, local_map);
8078 orig_keymap = get_local_map (PT, current_buffer, keymap);
8079 goto replay_sequence;
8082 Vquit_flag = Qnil;
8084 if (EVENT_HAS_PARAMETERS (key)
8085 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
8087 /* If we're at the beginning of a key sequence, and the caller
8088 says it's okay, go ahead and return this event. If we're
8089 in the midst of a key sequence, delay it until the end. */
8090 if (t > 0 || !can_return_switch_frame)
8092 delayed_switch_frame = key;
8093 goto replay_key;
8097 GROW_RAW_KEYBUF;
8098 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8101 /* Clicks in non-text areas get prefixed by the symbol
8102 in their CHAR-ADDRESS field. For example, a click on
8103 the mode line is prefixed by the symbol `mode-line'.
8105 Furthermore, key sequences beginning with mouse clicks
8106 are read using the keymaps of the buffer clicked on, not
8107 the current buffer. So we may have to switch the buffer
8108 here.
8110 When we turn one event into two events, we must make sure
8111 that neither of the two looks like the original--so that,
8112 if we replay the events, they won't be expanded again.
8113 If not for this, such reexpansion could happen either here
8114 or when user programs play with this-command-keys. */
8115 if (EVENT_HAS_PARAMETERS (key))
8117 Lisp_Object kind;
8119 kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
8120 if (EQ (kind, Qmouse_click))
8122 Lisp_Object window, posn;
8124 window = POSN_WINDOW (EVENT_START (key));
8125 posn = POSN_BUFFER_POSN (EVENT_START (key));
8127 if (CONSP (posn))
8129 /* We're looking at the second event of a
8130 sequence which we expanded before. Set
8131 last_real_key_start appropriately. */
8132 if (t > 0)
8133 last_real_key_start = t - 1;
8136 /* Key sequences beginning with mouse clicks are
8137 read using the keymaps in the buffer clicked on,
8138 not the current buffer. If we're at the
8139 beginning of a key sequence, switch buffers. */
8140 if (last_real_key_start == 0
8141 && WINDOWP (window)
8142 && BUFFERP (XWINDOW (window)->buffer)
8143 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
8145 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8146 keybuf[t] = key;
8147 mock_input = t + 1;
8149 /* Arrange to go back to the original buffer once we're
8150 done reading the key sequence. Note that we can't
8151 use save_excursion_{save,restore} here, because they
8152 save point as well as the current buffer; we don't
8153 want to save point, because redisplay may change it,
8154 to accommodate a Fset_window_start or something. We
8155 don't want to do this at the top of the function,
8156 because we may get input from a subprocess which
8157 wants to change the selected window and stuff (say,
8158 emacsclient). */
8159 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
8161 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
8162 Fkill_emacs (Qnil);
8163 set_buffer_internal (XBUFFER (XWINDOW
8164 (window)->buffer)
8166 orig_local_map = get_local_map (PT, current_buffer,
8167 local_map);
8168 orig_keymap = get_local_map (PT, current_buffer, keymap);
8169 goto replay_sequence;
8172 /* For a mouse click, get the local text-property keymap
8173 of the place clicked on, rather than point. */
8174 if (last_real_key_start == 0
8175 && CONSP (XCDR (key))
8176 && ! localized_local_map)
8178 Lisp_Object map_here, start, pos;
8180 localized_local_map = 1;
8181 start = EVENT_START (key);
8183 if (CONSP (start) && CONSP (XCDR (start)))
8185 pos = POSN_BUFFER_POSN (start);
8186 if (INTEGERP (pos)
8187 && XINT (pos) >= BEG && XINT (pos) <= Z)
8189 map_here = get_local_map (XINT (pos),
8190 current_buffer, local_map);
8191 if (!EQ (map_here, orig_local_map))
8193 orig_local_map = map_here;
8194 keybuf[t] = key;
8195 mock_input = t + 1;
8197 goto replay_sequence;
8199 map_here = get_local_map (XINT (pos),
8200 current_buffer, keymap);
8201 if (!EQ (map_here, orig_keymap))
8203 orig_keymap = map_here;
8204 keybuf[t] = key;
8205 mock_input = t + 1;
8207 goto replay_sequence;
8213 /* Expand mode-line and scroll-bar events into two events:
8214 use posn as a fake prefix key. */
8215 if (SYMBOLP (posn))
8217 if (t + 1 >= bufsize)
8218 error ("Key sequence too long");
8219 keybuf[t] = posn;
8220 keybuf[t+1] = key;
8221 mock_input = t + 2;
8223 /* Zap the position in key, so we know that we've
8224 expanded it, and don't try to do so again. */
8225 POSN_BUFFER_POSN (EVENT_START (key))
8226 = Fcons (posn, Qnil);
8228 /* If on a mode line string with a local keymap,
8229 reconsider the key sequence with that keymap. */
8230 if (CONSP (POSN_STRING (EVENT_START (key))))
8232 Lisp_Object string, pos, map, map2;
8234 string = POSN_STRING (EVENT_START (key));
8235 pos = XCDR (string);
8236 string = XCAR (string);
8237 if (XINT (pos) >= 0
8238 && XINT (pos) < XSTRING (string)->size)
8240 map = Fget_text_property (pos, Qlocal_map, string);
8241 if (!NILP (map))
8242 orig_local_map = map;
8243 map2 = Fget_text_property (pos, Qkeymap, string);
8244 if (!NILP (map2))
8245 orig_keymap = map2;
8246 if (!NILP (map) || !NILP (map2))
8247 goto replay_sequence;
8251 goto replay_key;
8254 else if (CONSP (XCDR (key))
8255 && CONSP (EVENT_START (key))
8256 && CONSP (XCDR (EVENT_START (key))))
8258 Lisp_Object posn;
8260 posn = POSN_BUFFER_POSN (EVENT_START (key));
8261 /* Handle menu-bar events:
8262 insert the dummy prefix event `menu-bar'. */
8263 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
8265 if (t + 1 >= bufsize)
8266 error ("Key sequence too long");
8267 keybuf[t] = posn;
8268 keybuf[t+1] = key;
8270 /* Zap the position in key, so we know that we've
8271 expanded it, and don't try to do so again. */
8272 POSN_BUFFER_POSN (EVENT_START (key))
8273 = Fcons (posn, Qnil);
8275 mock_input = t + 2;
8276 goto replay_sequence;
8278 else if (CONSP (posn))
8280 /* We're looking at the second event of a
8281 sequence which we expanded before. Set
8282 last_real_key_start appropriately. */
8283 if (last_real_key_start == t && t > 0)
8284 last_real_key_start = t - 1;
8289 /* We have finally decided that KEY is something we might want
8290 to look up. */
8291 first_binding = (follow_key (key,
8292 nmaps - first_binding,
8293 submaps + first_binding,
8294 defs + first_binding,
8295 submaps + first_binding)
8296 + first_binding);
8298 /* If KEY wasn't bound, we'll try some fallbacks. */
8299 if (first_binding >= nmaps)
8301 Lisp_Object head;
8303 head = EVENT_HEAD (key);
8304 if (help_char_p (head) && t > 0)
8306 read_key_sequence_cmd = Vprefix_help_command;
8307 keybuf[t++] = key;
8308 last_nonmenu_event = key;
8309 /* The Microsoft C compiler can't handle the goto that
8310 would go here. */
8311 dummyflag = 1;
8312 break;
8315 if (SYMBOLP (head))
8317 Lisp_Object breakdown;
8318 int modifiers;
8320 breakdown = parse_modifiers (head);
8321 modifiers = XINT (XCAR (XCDR (breakdown)));
8322 /* Attempt to reduce an unbound mouse event to a simpler
8323 event that is bound:
8324 Drags reduce to clicks.
8325 Double-clicks reduce to clicks.
8326 Triple-clicks reduce to double-clicks, then to clicks.
8327 Down-clicks are eliminated.
8328 Double-downs reduce to downs, then are eliminated.
8329 Triple-downs reduce to double-downs, then to downs,
8330 then are eliminated. */
8331 if (modifiers & (down_modifier | drag_modifier
8332 | double_modifier | triple_modifier))
8334 while (modifiers & (down_modifier | drag_modifier
8335 | double_modifier | triple_modifier))
8337 Lisp_Object new_head, new_click;
8338 if (modifiers & triple_modifier)
8339 modifiers ^= (double_modifier | triple_modifier);
8340 else if (modifiers & double_modifier)
8341 modifiers &= ~double_modifier;
8342 else if (modifiers & drag_modifier)
8343 modifiers &= ~drag_modifier;
8344 else
8346 /* Dispose of this `down' event by simply jumping
8347 back to replay_key, to get another event.
8349 Note that if this event came from mock input,
8350 then just jumping back to replay_key will just
8351 hand it to us again. So we have to wipe out any
8352 mock input.
8354 We could delete keybuf[t] and shift everything
8355 after that to the left by one spot, but we'd also
8356 have to fix up any variable that points into
8357 keybuf, and shifting isn't really necessary
8358 anyway.
8360 Adding prefixes for non-textual mouse clicks
8361 creates two characters of mock input, and both
8362 must be thrown away. If we're only looking at
8363 the prefix now, we can just jump back to
8364 replay_key. On the other hand, if we've already
8365 processed the prefix, and now the actual click
8366 itself is giving us trouble, then we've lost the
8367 state of the keymaps we want to backtrack to, and
8368 we need to replay the whole sequence to rebuild
8371 Beyond that, only function key expansion could
8372 create more than two keys, but that should never
8373 generate mouse events, so it's okay to zero
8374 mock_input in that case too.
8376 Isn't this just the most wonderful code ever? */
8377 if (t == last_real_key_start)
8379 mock_input = 0;
8380 goto replay_key;
8382 else
8384 mock_input = last_real_key_start;
8385 goto replay_sequence;
8389 new_head
8390 = apply_modifiers (modifiers, XCAR (breakdown));
8391 new_click
8392 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
8394 /* Look for a binding for this new key. follow_key
8395 promises that it didn't munge submaps the
8396 last time we called it, since key was unbound. */
8397 first_binding
8398 = (follow_key (new_click,
8399 nmaps - local_first_binding,
8400 submaps + local_first_binding,
8401 defs + local_first_binding,
8402 submaps + local_first_binding)
8403 + local_first_binding);
8405 /* If that click is bound, go for it. */
8406 if (first_binding < nmaps)
8408 key = new_click;
8409 break;
8411 /* Otherwise, we'll leave key set to the drag event. */
8417 keybuf[t++] = key;
8418 /* Normally, last_nonmenu_event gets the previous key we read.
8419 But when a mouse popup menu is being used,
8420 we don't update last_nonmenu_event; it continues to hold the mouse
8421 event that preceded the first level of menu. */
8422 if (!used_mouse_menu)
8423 last_nonmenu_event = key;
8425 /* Record what part of this_command_keys is the current key sequence. */
8426 this_single_command_key_start = this_command_key_count - t;
8428 prev_fkey_map = fkey_map;
8429 prev_fkey_start = fkey_start;
8430 prev_fkey_end = fkey_end;
8432 prev_keytran_map = keytran_map;
8433 prev_keytran_start = keytran_start;
8434 prev_keytran_end = keytran_end;
8436 /* If the sequence is unbound, see if we can hang a function key
8437 off the end of it. We only want to scan real keyboard input
8438 for function key sequences, so if mock_input says that we're
8439 re-reading old events, don't examine it. */
8440 if (first_binding >= nmaps
8441 && t >= mock_input)
8443 Lisp_Object fkey_next;
8445 /* Continue scan from fkey_end until we find a bound suffix.
8446 If we fail, increment fkey_start
8447 and start fkey_end from there. */
8448 while (fkey_end < t)
8450 Lisp_Object key;
8452 key = keybuf[fkey_end++];
8453 fkey_next
8454 = access_keymap (fkey_map, key, 1, 0, 1);
8456 /* Handle symbol with autoload definition. */
8457 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
8458 && CONSP (XSYMBOL (fkey_next)->function)
8459 && EQ (XCAR (XSYMBOL (fkey_next)->function), Qautoload))
8460 do_autoload (XSYMBOL (fkey_next)->function,
8461 fkey_next);
8463 /* Handle a symbol whose function definition is a keymap
8464 or an array. */
8465 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
8466 && (!NILP (Farrayp (XSYMBOL (fkey_next)->function))
8467 || KEYMAPP (XSYMBOL (fkey_next)->function)))
8468 fkey_next = XSYMBOL (fkey_next)->function;
8470 #if 0 /* I didn't turn this on, because it might cause trouble
8471 for the mapping of return into C-m and tab into C-i. */
8472 /* Optionally don't map function keys into other things.
8473 This enables the user to redefine kp- keys easily. */
8474 if (SYMBOLP (key) && !NILP (Vinhibit_function_key_mapping))
8475 fkey_next = Qnil;
8476 #endif
8478 /* If the function key map gives a function, not an
8479 array, then call the function with no args and use
8480 its value instead. */
8481 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
8482 && fkey_end == t)
8484 struct gcpro gcpro1, gcpro2, gcpro3;
8485 Lisp_Object tem;
8486 tem = fkey_next;
8488 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
8489 fkey_next = call1 (fkey_next, prompt);
8490 UNGCPRO;
8491 /* If the function returned something invalid,
8492 barf--don't ignore it.
8493 (To ignore it safely, we would need to gcpro a bunch of
8494 other variables.) */
8495 if (! (VECTORP (fkey_next) || STRINGP (fkey_next)))
8496 error ("Function in key-translation-map returns invalid key sequence");
8499 function_key_possible = ! NILP (fkey_next);
8501 /* If keybuf[fkey_start..fkey_end] is bound in the
8502 function key map and it's a suffix of the current
8503 sequence (i.e. fkey_end == t), replace it with
8504 the binding and restart with fkey_start at the end. */
8505 if ((VECTORP (fkey_next) || STRINGP (fkey_next))
8506 && fkey_end == t)
8508 int len = XFASTINT (Flength (fkey_next));
8510 t = fkey_start + len;
8511 if (t >= bufsize)
8512 error ("Key sequence too long");
8514 if (VECTORP (fkey_next))
8515 bcopy (XVECTOR (fkey_next)->contents,
8516 keybuf + fkey_start,
8517 (t - fkey_start) * sizeof (keybuf[0]));
8518 else if (STRINGP (fkey_next))
8520 int i;
8522 for (i = 0; i < len; i++)
8523 XSETFASTINT (keybuf[fkey_start + i],
8524 XSTRING (fkey_next)->data[i]);
8527 mock_input = t;
8528 fkey_start = fkey_end = t;
8529 fkey_map = Vfunction_key_map;
8531 /* Do pass the results through key-translation-map.
8532 But don't retranslate what key-translation-map
8533 has already translated. */
8534 keytran_end = keytran_start;
8535 keytran_map = Vkey_translation_map;
8537 goto replay_sequence;
8540 fkey_map = get_keymap (fkey_next, 0, 1);
8542 /* If we no longer have a bound suffix, try a new positions for
8543 fkey_start. */
8544 if (!CONSP (fkey_map))
8546 fkey_end = ++fkey_start;
8547 fkey_map = Vfunction_key_map;
8548 function_key_possible = 0;
8553 /* Look for this sequence in key-translation-map. */
8555 Lisp_Object keytran_next;
8557 /* Scan from keytran_end until we find a bound suffix. */
8558 while (keytran_end < t)
8560 Lisp_Object key;
8562 key = keybuf[keytran_end++];
8563 keytran_next
8564 = access_keymap (keytran_map, key, 1, 0, 1);
8566 /* Handle symbol with autoload definition. */
8567 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
8568 && CONSP (XSYMBOL (keytran_next)->function)
8569 && EQ (XCAR (XSYMBOL (keytran_next)->function), Qautoload))
8570 do_autoload (XSYMBOL (keytran_next)->function,
8571 keytran_next);
8573 /* Handle a symbol whose function definition is a keymap
8574 or an array. */
8575 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
8576 && (!NILP (Farrayp (XSYMBOL (keytran_next)->function))
8577 || KEYMAPP (XSYMBOL (keytran_next)->function)))
8578 keytran_next = XSYMBOL (keytran_next)->function;
8580 /* If the key translation map gives a function, not an
8581 array, then call the function with one arg and use
8582 its value instead. */
8583 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
8584 && keytran_end == t)
8586 struct gcpro gcpro1, gcpro2, gcpro3;
8587 Lisp_Object tem;
8588 tem = keytran_next;
8590 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
8591 keytran_next = call1 (keytran_next, prompt);
8592 UNGCPRO;
8593 /* If the function returned something invalid,
8594 barf--don't ignore it.
8595 (To ignore it safely, we would need to gcpro a bunch of
8596 other variables.) */
8597 if (! (VECTORP (keytran_next) || STRINGP (keytran_next)))
8598 error ("Function in key-translation-map returns invalid key sequence");
8601 key_translation_possible = ! NILP (keytran_next);
8603 /* If keybuf[keytran_start..keytran_end] is bound in the
8604 key translation map and it's a suffix of the current
8605 sequence (i.e. keytran_end == t), replace it with
8606 the binding and restart with keytran_start at the end. */
8607 if ((VECTORP (keytran_next) || STRINGP (keytran_next))
8608 && keytran_end == t)
8610 int len = XFASTINT (Flength (keytran_next));
8612 t = keytran_start + len;
8613 if (t >= bufsize)
8614 error ("Key sequence too long");
8616 if (VECTORP (keytran_next))
8617 bcopy (XVECTOR (keytran_next)->contents,
8618 keybuf + keytran_start,
8619 (t - keytran_start) * sizeof (keybuf[0]));
8620 else if (STRINGP (keytran_next))
8622 int i;
8624 for (i = 0; i < len; i++)
8625 XSETFASTINT (keybuf[keytran_start + i],
8626 XSTRING (keytran_next)->data[i]);
8629 mock_input = t;
8630 keytran_start = keytran_end = t;
8631 keytran_map = Vkey_translation_map;
8633 /* Don't pass the results of key-translation-map
8634 through function-key-map. */
8635 fkey_start = fkey_end = t;
8636 fkey_map = Vfunction_key_map;
8638 goto replay_sequence;
8641 keytran_map = get_keymap (keytran_next, 0, 1);
8643 /* If we no longer have a bound suffix, try a new positions for
8644 keytran_start. */
8645 if (!CONSP (keytran_map))
8647 keytran_end = ++keytran_start;
8648 keytran_map = Vkey_translation_map;
8649 key_translation_possible = 0;
8654 /* If KEY is not defined in any of the keymaps,
8655 and cannot be part of a function key or translation,
8656 and is an upper case letter
8657 use the corresponding lower-case letter instead. */
8658 if (first_binding == nmaps && ! function_key_possible
8659 && ! key_translation_possible
8660 && INTEGERP (key)
8661 && ((((XINT (key) & 0x3ffff)
8662 < XCHAR_TABLE (current_buffer->downcase_table)->size)
8663 && UPPERCASEP (XINT (key) & 0x3ffff))
8664 || (XINT (key) & shift_modifier)))
8666 Lisp_Object new_key;
8668 original_uppercase = key;
8669 original_uppercase_position = t - 1;
8671 if (XINT (key) & shift_modifier)
8672 XSETINT (new_key, XINT (key) & ~shift_modifier);
8673 else
8674 XSETINT (new_key, (DOWNCASE (XINT (key) & 0x3ffff)
8675 | (XINT (key) & ~0x3ffff)));
8677 /* We have to do this unconditionally, regardless of whether
8678 the lower-case char is defined in the keymaps, because they
8679 might get translated through function-key-map. */
8680 keybuf[t - 1] = new_key;
8681 mock_input = t;
8683 fkey_map = prev_fkey_map;
8684 fkey_start = prev_fkey_start;
8685 fkey_end = prev_fkey_end;
8687 keytran_map = prev_keytran_map;
8688 keytran_start = prev_keytran_start;
8689 keytran_end = prev_keytran_end;
8691 goto replay_sequence;
8693 /* If KEY is not defined in any of the keymaps,
8694 and cannot be part of a function key or translation,
8695 and is a shifted function key,
8696 use the corresponding unshifted function key instead. */
8697 if (first_binding == nmaps && ! function_key_possible
8698 && ! key_translation_possible
8699 && SYMBOLP (key))
8701 Lisp_Object breakdown;
8702 int modifiers;
8704 breakdown = parse_modifiers (key);
8705 modifiers = XINT (XCAR (XCDR (breakdown)));
8706 if (modifiers & shift_modifier)
8708 Lisp_Object new_key;
8710 original_uppercase = key;
8711 original_uppercase_position = t - 1;
8713 modifiers &= ~shift_modifier;
8714 new_key = apply_modifiers (modifiers,
8715 XCAR (breakdown));
8717 keybuf[t - 1] = new_key;
8718 mock_input = t;
8720 fkey_map = prev_fkey_map;
8721 fkey_start = prev_fkey_start;
8722 fkey_end = prev_fkey_end;
8724 keytran_map = prev_keytran_map;
8725 keytran_start = prev_keytran_start;
8726 keytran_end = prev_keytran_end;
8728 goto replay_sequence;
8733 if (!dummyflag)
8734 read_key_sequence_cmd = (first_binding < nmaps
8735 ? defs[first_binding]
8736 : Qnil);
8738 unread_switch_frame = delayed_switch_frame;
8739 unbind_to (count, Qnil);
8741 /* Don't downcase the last character if the caller says don't.
8742 Don't downcase it if the result is undefined, either. */
8743 if ((dont_downcase_last || first_binding >= nmaps)
8744 && t - 1 == original_uppercase_position)
8745 keybuf[t - 1] = original_uppercase;
8747 /* Occasionally we fabricate events, perhaps by expanding something
8748 according to function-key-map, or by adding a prefix symbol to a
8749 mouse click in the scroll bar or modeline. In this cases, return
8750 the entire generated key sequence, even if we hit an unbound
8751 prefix or a definition before the end. This means that you will
8752 be able to push back the event properly, and also means that
8753 read-key-sequence will always return a logical unit.
8755 Better ideas? */
8756 for (; t < mock_input; t++)
8758 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8759 && NILP (Fzerop (Vecho_keystrokes)))
8760 echo_char (keybuf[t]);
8761 add_command_key (keybuf[t]);
8766 return t;
8769 #if 0 /* This doc string is too long for some compilers.
8770 This commented-out definition serves for DOC. */
8771 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0,
8772 "Read a sequence of keystrokes and return as a string or vector.\n\
8773 The sequence is sufficient to specify a non-prefix command in the\n\
8774 current local and global maps.\n\
8776 First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
8777 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\
8778 as a continuation of the previous key.\n\
8780 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not\n\
8781 convert the last event to lower case. (Normally any upper case event\n\
8782 is converted to lower case if the original event is undefined and the lower\n\
8783 case equivalent is defined.) A non-nil value is appropriate for reading\n\
8784 a key sequence to be defined.\n\
8786 A C-g typed while in this function is treated like any other character,\n\
8787 and `quit-flag' is not set.\n\
8789 If the key sequence starts with a mouse click, then the sequence is read\n\
8790 using the keymaps of the buffer of the window clicked in, not the buffer\n\
8791 of the selected window as normal.\n\
8792 ""\n\
8793 `read-key-sequence' drops unbound button-down events, since you normally\n\
8794 only care about the click or drag events which follow them. If a drag\n\
8795 or multi-click event is unbound, but the corresponding click event would\n\
8796 be bound, `read-key-sequence' turns the event into a click event at the\n\
8797 drag's starting position. This means that you don't have to distinguish\n\
8798 between click and drag, double, or triple events unless you want to.\n\
8800 `read-key-sequence' prefixes mouse events on mode lines, the vertical\n\
8801 lines separating windows, and scroll bars with imaginary keys\n\
8802 `mode-line', `vertical-line', and `vertical-scroll-bar'.\n\
8804 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this\n\
8805 function will process a switch-frame event if the user switches frames\n\
8806 before typing anything. If the user switches frames in the middle of a\n\
8807 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME\n\
8808 is nil, then the event will be put off until after the current key sequence.\n\
8810 `read-key-sequence' checks `function-key-map' for function key\n\
8811 sequences, where they wouldn't conflict with ordinary bindings. See\n\
8812 `function-key-map' for more details.\n\
8814 The optional fifth argument COMMAND-LOOP, if non-nil, means\n\
8815 that this key sequence is being read by something that will\n\
8816 read commands one after another. It should be nil if the caller\n\
8817 will read just one key sequence.")
8818 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame, command-loop)
8819 #endif
8821 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
8823 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
8824 command_loop)
8825 Lisp_Object prompt, continue_echo, dont_downcase_last;
8826 Lisp_Object can_return_switch_frame, command_loop;
8828 Lisp_Object keybuf[30];
8829 register int i;
8830 struct gcpro gcpro1;
8831 int count = specpdl_ptr - specpdl;
8833 if (!NILP (prompt))
8834 CHECK_STRING (prompt, 0);
8835 QUIT;
8837 specbind (Qinput_method_exit_on_first_char,
8838 (NILP (command_loop) ? Qt : Qnil));
8839 specbind (Qinput_method_use_echo_area,
8840 (NILP (command_loop) ? Qt : Qnil));
8842 bzero (keybuf, sizeof keybuf);
8843 GCPRO1 (keybuf[0]);
8844 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
8846 if (NILP (continue_echo))
8848 this_command_key_count = 0;
8849 this_single_command_key_start = 0;
8852 #ifdef HAVE_X_WINDOWS
8853 if (display_busy_cursor_p)
8854 cancel_busy_cursor ();
8855 #endif
8857 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
8858 prompt, ! NILP (dont_downcase_last),
8859 ! NILP (can_return_switch_frame), 0);
8861 #if 0 /* The following is fine for code reading a key sequence and
8862 then proceeding with a lenghty compuation, but it's not good
8863 for code reading keys in a loop, like an input method. */
8864 #ifdef HAVE_X_WINDOWS
8865 if (display_busy_cursor_p)
8866 start_busy_cursor ();
8867 #endif
8868 #endif
8870 if (i == -1)
8872 Vquit_flag = Qt;
8873 QUIT;
8875 UNGCPRO;
8876 return unbind_to (count, make_event_array (i, keybuf));
8879 DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
8880 Sread_key_sequence_vector, 1, 5, 0,
8881 "Like `read-key-sequence' but always return a vector.")
8882 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
8883 command_loop)
8884 Lisp_Object prompt, continue_echo, dont_downcase_last;
8885 Lisp_Object can_return_switch_frame, command_loop;
8887 Lisp_Object keybuf[30];
8888 register int i;
8889 struct gcpro gcpro1;
8890 int count = specpdl_ptr - specpdl;
8892 if (!NILP (prompt))
8893 CHECK_STRING (prompt, 0);
8894 QUIT;
8896 specbind (Qinput_method_exit_on_first_char,
8897 (NILP (command_loop) ? Qt : Qnil));
8898 specbind (Qinput_method_use_echo_area,
8899 (NILP (command_loop) ? Qt : Qnil));
8901 bzero (keybuf, sizeof keybuf);
8902 GCPRO1 (keybuf[0]);
8903 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
8905 if (NILP (continue_echo))
8907 this_command_key_count = 0;
8908 this_single_command_key_start = 0;
8911 #ifdef HAVE_X_WINDOWS
8912 if (display_busy_cursor_p)
8913 cancel_busy_cursor ();
8914 #endif
8916 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
8917 prompt, ! NILP (dont_downcase_last),
8918 ! NILP (can_return_switch_frame), 0);
8920 #ifdef HAVE_X_WINDOWS
8921 if (display_busy_cursor_p)
8922 start_busy_cursor ();
8923 #endif
8925 if (i == -1)
8927 Vquit_flag = Qt;
8928 QUIT;
8930 UNGCPRO;
8931 return unbind_to (count, Fvector (i, keybuf));
8934 DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0,
8935 "Execute CMD as an editor command.\n\
8936 CMD must be a symbol that satisfies the `commandp' predicate.\n\
8937 Optional second arg RECORD-FLAG non-nil\n\
8938 means unconditionally put this command in `command-history'.\n\
8939 Otherwise, that is done only if an arg is read using the minibuffer.\n\
8940 The argument KEYS specifies the value to use instead of (this-command-keys)\n\
8941 when reading the arguments; if it is nil, (this-command-keys) is used.\n\
8942 The argument SPECIAL, if non-nil, means that this command is executing\n\
8943 a special event, so ignore the prefix argument and don't clear it.")
8944 (cmd, record_flag, keys, special)
8945 Lisp_Object cmd, record_flag, keys, special;
8947 register Lisp_Object final;
8948 register Lisp_Object tem;
8949 Lisp_Object prefixarg;
8950 struct backtrace backtrace;
8951 extern int debug_on_next_call;
8953 debug_on_next_call = 0;
8955 if (NILP (special))
8957 prefixarg = current_kboard->Vprefix_arg;
8958 Vcurrent_prefix_arg = prefixarg;
8959 current_kboard->Vprefix_arg = Qnil;
8961 else
8962 prefixarg = Qnil;
8964 if (SYMBOLP (cmd))
8966 tem = Fget (cmd, Qdisabled);
8967 if (!NILP (tem) && !NILP (Vrun_hooks))
8969 tem = Fsymbol_value (Qdisabled_command_hook);
8970 if (!NILP (tem))
8971 return call1 (Vrun_hooks, Qdisabled_command_hook);
8975 while (1)
8977 final = Findirect_function (cmd);
8979 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
8981 struct gcpro gcpro1, gcpro2;
8983 GCPRO2 (cmd, prefixarg);
8984 do_autoload (final, cmd);
8985 UNGCPRO;
8987 else
8988 break;
8991 if (STRINGP (final) || VECTORP (final))
8993 /* If requested, place the macro in the command history. For
8994 other sorts of commands, call-interactively takes care of
8995 this. */
8996 if (!NILP (record_flag))
8998 Vcommand_history
8999 = Fcons (Fcons (Qexecute_kbd_macro,
9000 Fcons (final, Fcons (prefixarg, Qnil))),
9001 Vcommand_history);
9003 /* Don't keep command history around forever. */
9004 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
9006 tem = Fnthcdr (Vhistory_length, Vcommand_history);
9007 if (CONSP (tem))
9008 XCDR (tem) = Qnil;
9012 return Fexecute_kbd_macro (final, prefixarg);
9015 if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
9017 backtrace.next = backtrace_list;
9018 backtrace_list = &backtrace;
9019 backtrace.function = &Qcall_interactively;
9020 backtrace.args = &cmd;
9021 backtrace.nargs = 1;
9022 backtrace.evalargs = 0;
9024 tem = Fcall_interactively (cmd, record_flag, keys);
9026 backtrace_list = backtrace.next;
9027 return tem;
9029 return Qnil;
9032 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
9033 1, 1, "P",
9034 "Read function name, then read its arguments and call it.")
9035 (prefixarg)
9036 Lisp_Object prefixarg;
9038 Lisp_Object function;
9039 char buf[40];
9040 Lisp_Object saved_keys;
9041 Lisp_Object bindings, value;
9042 struct gcpro gcpro1, gcpro2;
9044 saved_keys = Fvector (this_command_key_count,
9045 XVECTOR (this_command_keys)->contents);
9046 buf[0] = 0;
9047 GCPRO2 (saved_keys, prefixarg);
9049 if (EQ (prefixarg, Qminus))
9050 strcpy (buf, "- ");
9051 else if (CONSP (prefixarg) && XINT (XCAR (prefixarg)) == 4)
9052 strcpy (buf, "C-u ");
9053 else if (CONSP (prefixarg) && INTEGERP (XCAR (prefixarg)))
9055 if (sizeof (int) == sizeof (EMACS_INT))
9056 sprintf (buf, "%d ", XINT (XCAR (prefixarg)));
9057 else if (sizeof (long) == sizeof (EMACS_INT))
9058 sprintf (buf, "%ld ", (long) XINT (XCAR (prefixarg)));
9059 else
9060 abort ();
9062 else if (INTEGERP (prefixarg))
9064 if (sizeof (int) == sizeof (EMACS_INT))
9065 sprintf (buf, "%d ", XINT (prefixarg));
9066 else if (sizeof (long) == sizeof (EMACS_INT))
9067 sprintf (buf, "%ld ", (long) XINT (prefixarg));
9068 else
9069 abort ();
9072 /* This isn't strictly correct if execute-extended-command
9073 is bound to anything else. Perhaps it should use
9074 this_command_keys? */
9075 strcat (buf, "M-x ");
9077 /* Prompt with buf, and then read a string, completing from and
9078 restricting to the set of all defined commands. Don't provide
9079 any initial input. Save the command read on the extended-command
9080 history list. */
9081 function = Fcompleting_read (build_string (buf),
9082 Vobarray, Qcommandp,
9083 Qt, Qnil, Qextended_command_history, Qnil,
9084 Qnil);
9086 if (STRINGP (function) && XSTRING (function)->size == 0)
9087 error ("No command name given");
9089 /* Set this_command_keys to the concatenation of saved_keys and
9090 function, followed by a RET. */
9092 struct Lisp_String *str;
9093 Lisp_Object *keys;
9094 int i;
9096 this_command_key_count = 0;
9097 this_single_command_key_start = 0;
9099 keys = XVECTOR (saved_keys)->contents;
9100 for (i = 0; i < XVECTOR (saved_keys)->size; i++)
9101 add_command_key (keys[i]);
9103 str = XSTRING (function);
9104 for (i = 0; i < str->size; i++)
9105 add_command_key (Faref (function, make_number (i)));
9107 add_command_key (make_number ('\015'));
9110 UNGCPRO;
9112 function = Fintern (function, Qnil);
9113 current_kboard->Vprefix_arg = prefixarg;
9114 Vthis_command = function;
9115 real_this_command = function;
9117 /* If enabled, show which key runs this command. */
9118 if (!NILP (Vsuggest_key_bindings)
9119 && NILP (Vexecuting_macro)
9120 && SYMBOLP (function))
9121 bindings = Fwhere_is_internal (function, Voverriding_local_map,
9122 Qt, Qnil);
9123 else
9124 bindings = Qnil;
9126 value = Qnil;
9127 GCPRO2 (bindings, value);
9128 value = Fcommand_execute (function, Qt, Qnil, Qnil);
9130 /* If the command has a key binding, print it now. */
9131 if (!NILP (bindings)
9132 && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
9133 Qmouse_movement)))
9135 /* But first wait, and skip the message if there is input. */
9136 int delay_time;
9137 if (!NILP (echo_area_buffer[0]))
9138 /* This command displayed something in the echo area;
9139 so wait a few seconds, then display our suggestion message. */
9140 delay_time = (NUMBERP (Vsuggest_key_bindings)
9141 ? XINT (Vsuggest_key_bindings) : 2);
9142 else
9143 /* This command left the echo area empty,
9144 so display our message immediately. */
9145 delay_time = 0;
9147 if (!NILP (Fsit_for (make_number (delay_time), Qnil, Qnil))
9148 && ! CONSP (Vunread_command_events))
9150 Lisp_Object binding;
9151 char *newmessage;
9152 int message_p = push_message ();
9154 binding = Fkey_description (bindings);
9156 newmessage
9157 = (char *) alloca (XSYMBOL (function)->name->size
9158 + STRING_BYTES (XSTRING (binding))
9159 + 100);
9160 sprintf (newmessage, "You can run the command `%s' with %s",
9161 XSYMBOL (function)->name->data,
9162 XSTRING (binding)->data);
9163 message2_nolog (newmessage,
9164 strlen (newmessage),
9165 STRING_MULTIBYTE (binding));
9166 if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings)
9167 ? Vsuggest_key_bindings : make_number (2)),
9168 Qnil, Qnil))
9169 && message_p)
9170 restore_message ();
9172 pop_message ();
9176 RETURN_UNGCPRO (value);
9179 /* Find the set of keymaps now active.
9180 Store into *MAPS_P a vector holding the various maps
9181 and return the number of them. The vector was malloc'd
9182 and the caller should free it. */
9185 current_active_maps (maps_p)
9186 Lisp_Object **maps_p;
9188 Lisp_Object *tmaps, *maps;
9189 int nmaps;
9191 /* Should overriding-terminal-local-map and overriding-local-map apply? */
9192 if (!NILP (Voverriding_local_map_menu_flag))
9194 /* Yes, use them (if non-nil) as well as the global map. */
9195 maps = (Lisp_Object *) xmalloc (3 * sizeof (maps[0]));
9196 nmaps = 0;
9197 if (!NILP (current_kboard->Voverriding_terminal_local_map))
9198 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
9199 if (!NILP (Voverriding_local_map))
9200 maps[nmaps++] = Voverriding_local_map;
9202 else
9204 /* No, so use major and minor mode keymaps and keymap property. */
9205 int extra_maps = 2;
9206 Lisp_Object map = get_local_map (PT, current_buffer, keymap);
9207 if (!NILP (map))
9208 extra_maps = 3;
9209 nmaps = current_minor_maps (NULL, &tmaps);
9210 maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
9211 * sizeof (maps[0]));
9212 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
9213 if (!NILP (map))
9214 maps[nmaps++] = map;
9215 maps[nmaps++] = get_local_map (PT, current_buffer, local_map);
9217 maps[nmaps++] = current_global_map;
9219 *maps_p = maps;
9220 return nmaps;
9223 /* Return nonzero if input events are pending. */
9226 detect_input_pending ()
9228 if (!input_pending)
9229 get_input_pending (&input_pending, 0);
9231 return input_pending;
9234 /* Return nonzero if input events are pending, and run any pending timers. */
9237 detect_input_pending_run_timers (do_display)
9238 int do_display;
9240 int old_timers_run = timers_run;
9242 if (!input_pending)
9243 get_input_pending (&input_pending, 1);
9245 if (old_timers_run != timers_run && do_display)
9247 redisplay_preserve_echo_area ();
9248 /* The following fixes a bug when using lazy-lock with
9249 lazy-lock-defer-on-the-fly set to t, i.e. when fontifying
9250 from an idle timer function. The symptom of the bug is that
9251 the cursor sometimes doesn't become visible until the next X
9252 event is processed. --gerd. */
9253 if (rif)
9254 rif->flush_display (NULL);
9257 return input_pending;
9260 /* This is called in some cases before a possible quit.
9261 It cases the next call to detect_input_pending to recompute input_pending.
9262 So calling this function unnecessarily can't do any harm. */
9264 void
9265 clear_input_pending ()
9267 input_pending = 0;
9270 /* Return nonzero if there are pending requeued events.
9271 This isn't used yet. The hope is to make wait_reading_process_input
9272 call it, and return return if it runs Lisp code that unreads something.
9273 The problem is, kbd_buffer_get_event needs to be fixed to know what
9274 to do in that case. It isn't trivial. */
9277 requeued_events_pending_p ()
9279 return (!NILP (Vunread_command_events) || unread_command_char != -1);
9283 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
9284 "T if command input is currently available with no waiting.\n\
9285 Actually, the value is nil only if we can be sure that no input is available.")
9288 if (!NILP (Vunread_command_events) || unread_command_char != -1)
9289 return (Qt);
9291 get_input_pending (&input_pending, 1);
9292 return input_pending > 0 ? Qt : Qnil;
9295 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
9296 "Return vector of last 100 events, not counting those from keyboard macros.")
9299 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
9300 Lisp_Object val;
9302 if (total_keys < NUM_RECENT_KEYS)
9303 return Fvector (total_keys, keys);
9304 else
9306 val = Fvector (NUM_RECENT_KEYS, keys);
9307 bcopy (keys + recent_keys_index,
9308 XVECTOR (val)->contents,
9309 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
9310 bcopy (keys,
9311 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
9312 recent_keys_index * sizeof (Lisp_Object));
9313 return val;
9317 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
9318 "Return the key sequence that invoked this command.\n\
9319 The value is a string or a vector.")
9322 return make_event_array (this_command_key_count,
9323 XVECTOR (this_command_keys)->contents);
9326 DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
9327 "Return the key sequence that invoked this command, as a vector.")
9330 return Fvector (this_command_key_count,
9331 XVECTOR (this_command_keys)->contents);
9334 DEFUN ("this-single-command-keys", Fthis_single_command_keys,
9335 Sthis_single_command_keys, 0, 0, 0,
9336 "Return the key sequence that invoked this command.\n\
9337 Unlike `this-command-keys', this function's value\n\
9338 does not include prefix arguments.\n\
9339 The value is always a vector.")
9342 return Fvector (this_command_key_count
9343 - this_single_command_key_start,
9344 (XVECTOR (this_command_keys)->contents
9345 + this_single_command_key_start));
9348 DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
9349 Sthis_single_command_raw_keys, 0, 0, 0,
9350 "Return the raw events that were read for this command.\n\
9351 Unlike `this-single-command-keys', this function's value\n\
9352 shows the events before all translations (except for input methods).\n\
9353 The value is always a vector.")
9356 return Fvector (raw_keybuf_count,
9357 (XVECTOR (raw_keybuf)->contents));
9360 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
9361 Sreset_this_command_lengths, 0, 0, 0,
9362 "Used for complicated reasons in `universal-argument-other-key'.\n\
9364 `universal-argument-other-key' rereads the event just typed.\n\
9365 It then gets translated through `function-key-map'.\n\
9366 The translated event gets included in the echo area and in\n\
9367 the value of `this-command-keys' in addition to the raw original event.\n\
9368 That is not right.\n\
9370 Calling this function directs the translated event to replace\n\
9371 the original event, so that only one version of the event actually\n\
9372 appears in the echo area and in the value of `this-command-keys.'.")
9375 before_command_restore_flag = 1;
9376 before_command_key_count_1 = before_command_key_count;
9377 before_command_echo_length_1 = before_command_echo_length;
9378 return Qnil;
9381 DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
9382 Sclear_this_command_keys, 0, 0, 0,
9383 "Clear out the vector that `this-command-keys' returns.\n\
9384 Clear vector containing last 100 events.")
9387 int i;
9389 this_command_key_count = 0;
9391 for (i = 0; i < XVECTOR (recent_keys)->size; ++i)
9392 XVECTOR (recent_keys)->contents[i] = Qnil;
9393 total_keys = 0;
9394 recent_keys_index = 0;
9395 return Qnil;
9398 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
9399 "Return the current depth in recursive edits.")
9402 Lisp_Object temp;
9403 XSETFASTINT (temp, command_loop_level + minibuf_level);
9404 return temp;
9407 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
9408 "FOpen dribble file: ",
9409 "Start writing all keyboard characters to a dribble file called FILE.\n\
9410 If FILE is nil, close any open dribble file.")
9411 (file)
9412 Lisp_Object file;
9414 if (dribble)
9416 fclose (dribble);
9417 dribble = 0;
9419 if (!NILP (file))
9421 file = Fexpand_file_name (file, Qnil);
9422 dribble = fopen (XSTRING (file)->data, "w");
9423 if (dribble == 0)
9424 report_file_error ("Opening dribble", Fcons (file, Qnil));
9426 return Qnil;
9429 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
9430 "Discard the contents of the terminal input buffer.\n\
9431 Also cancel any kbd macro being defined.")
9434 current_kboard->defining_kbd_macro = Qnil;
9435 update_mode_lines++;
9437 Vunread_command_events = Qnil;
9438 unread_command_char = -1;
9440 discard_tty_input ();
9442 kbd_fetch_ptr = kbd_store_ptr;
9443 Ffillarray (kbd_buffer_gcpro, Qnil);
9444 input_pending = 0;
9446 return Qnil;
9449 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
9450 "Stop Emacs and return to superior process. You can resume later.\n\
9451 If `cannot-suspend' is non-nil, or if the system doesn't support job\n\
9452 control, run a subshell instead.\n\n\
9453 If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
9454 to be read as terminal input by Emacs's parent, after suspension.\n\
9456 Before suspending, run the normal hook `suspend-hook'.\n\
9457 After resumption run the normal hook `suspend-resume-hook'.\n\
9459 Some operating systems cannot stop the Emacs process and resume it later.\n\
9460 On such systems, Emacs starts a subshell instead of suspending.")
9461 (stuffstring)
9462 Lisp_Object stuffstring;
9464 int count = specpdl_ptr - specpdl;
9465 int old_height, old_width;
9466 int width, height;
9467 struct gcpro gcpro1;
9469 if (!NILP (stuffstring))
9470 CHECK_STRING (stuffstring, 0);
9472 /* Run the functions in suspend-hook. */
9473 if (!NILP (Vrun_hooks))
9474 call1 (Vrun_hooks, intern ("suspend-hook"));
9476 GCPRO1 (stuffstring);
9477 get_frame_size (&old_width, &old_height);
9478 reset_sys_modes ();
9479 /* sys_suspend can get an error if it tries to fork a subshell
9480 and the system resources aren't available for that. */
9481 record_unwind_protect ((Lisp_Object (*) P_ ((Lisp_Object))) init_sys_modes,
9482 Qnil);
9483 stuff_buffered_input (stuffstring);
9484 if (cannot_suspend)
9485 sys_subshell ();
9486 else
9487 sys_suspend ();
9488 unbind_to (count, Qnil);
9490 /* Check if terminal/window size has changed.
9491 Note that this is not useful when we are running directly
9492 with a window system; but suspend should be disabled in that case. */
9493 get_frame_size (&width, &height);
9494 if (width != old_width || height != old_height)
9495 change_frame_size (SELECTED_FRAME (), height, width, 0, 0, 0);
9497 /* Run suspend-resume-hook. */
9498 if (!NILP (Vrun_hooks))
9499 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
9501 UNGCPRO;
9502 return Qnil;
9505 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
9506 Then in any case stuff anything Emacs has read ahead and not used. */
9508 void
9509 stuff_buffered_input (stuffstring)
9510 Lisp_Object stuffstring;
9512 /* stuff_char works only in BSD, versions 4.2 and up. */
9513 #ifdef BSD_SYSTEM
9514 #ifndef BSD4_1
9515 register unsigned char *p;
9517 if (STRINGP (stuffstring))
9519 register int count;
9521 p = XSTRING (stuffstring)->data;
9522 count = STRING_BYTES (XSTRING (stuffstring));
9523 while (count-- > 0)
9524 stuff_char (*p++);
9525 stuff_char ('\n');
9528 /* Anything we have read ahead, put back for the shell to read. */
9529 /* ?? What should this do when we have multiple keyboards??
9530 Should we ignore anything that was typed in at the "wrong" kboard? */
9531 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
9533 int idx;
9535 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
9536 kbd_fetch_ptr = kbd_buffer;
9537 if (kbd_fetch_ptr->kind == ascii_keystroke)
9538 stuff_char (kbd_fetch_ptr->code);
9540 kbd_fetch_ptr->kind = no_event;
9541 idx = 2 * (kbd_fetch_ptr - kbd_buffer);
9542 ASET (kbd_buffer_gcpro, idx, Qnil);
9543 ASET (kbd_buffer_gcpro, idx + 1, Qnil);
9546 input_pending = 0;
9547 #endif
9548 #endif /* BSD_SYSTEM and not BSD4_1 */
9551 void
9552 set_waiting_for_input (time_to_clear)
9553 EMACS_TIME *time_to_clear;
9555 input_available_clear_time = time_to_clear;
9557 /* Tell interrupt_signal to throw back to read_char, */
9558 waiting_for_input = 1;
9560 /* If interrupt_signal was called before and buffered a C-g,
9561 make it run again now, to avoid timing error. */
9562 if (!NILP (Vquit_flag))
9563 quit_throw_to_read_char ();
9566 void
9567 clear_waiting_for_input ()
9569 /* Tell interrupt_signal not to throw back to read_char, */
9570 waiting_for_input = 0;
9571 input_available_clear_time = 0;
9574 /* This routine is called at interrupt level in response to C-G.
9576 If interrupt_input, this is the handler for SIGINT. Otherwise, it
9577 is called from kbd_buffer_store_event, in handling SIGIO or
9578 SIGTINT.
9580 If `waiting_for_input' is non zero, then unless `echoing' is
9581 nonzero, immediately throw back to read_char.
9583 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
9584 eval to throw, when it gets a chance. If quit-flag is already
9585 non-nil, it stops the job right away. */
9587 SIGTYPE
9588 interrupt_signal (signalnum) /* If we don't have an argument, */
9589 int signalnum; /* some compilers complain in signal calls. */
9591 char c;
9592 /* Must preserve main program's value of errno. */
9593 int old_errno = errno;
9594 struct frame *sf = SELECTED_FRAME ();
9596 #if defined (USG) && !defined (POSIX_SIGNALS)
9597 if (!read_socket_hook && NILP (Vwindow_system))
9599 /* USG systems forget handlers when they are used;
9600 must reestablish each time */
9601 signal (SIGINT, interrupt_signal);
9602 signal (SIGQUIT, interrupt_signal);
9604 #endif /* USG */
9606 cancel_echoing ();
9608 if (!NILP (Vquit_flag)
9609 && (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf)))
9611 /* If SIGINT isn't blocked, don't let us be interrupted by
9612 another SIGINT, it might be harmful due to non-reentrancy
9613 in I/O functions. */
9614 sigblock (sigmask (SIGINT));
9616 fflush (stdout);
9617 reset_sys_modes ();
9619 #ifdef SIGTSTP /* Support possible in later USG versions */
9621 * On systems which can suspend the current process and return to the original
9622 * shell, this command causes the user to end up back at the shell.
9623 * The "Auto-save" and "Abort" questions are not asked until
9624 * the user elects to return to emacs, at which point he can save the current
9625 * job and either dump core or continue.
9627 sys_suspend ();
9628 #else
9629 #ifdef VMS
9630 if (sys_suspend () == -1)
9632 printf ("Not running as a subprocess;\n");
9633 printf ("you can continue or abort.\n");
9635 #else /* not VMS */
9636 /* Perhaps should really fork an inferior shell?
9637 But that would not provide any way to get back
9638 to the original shell, ever. */
9639 printf ("No support for stopping a process on this operating system;\n");
9640 printf ("you can continue or abort.\n");
9641 #endif /* not VMS */
9642 #endif /* not SIGTSTP */
9643 #ifdef MSDOS
9644 /* We must remain inside the screen area when the internal terminal
9645 is used. Note that [Enter] is not echoed by dos. */
9646 cursor_to (0, 0);
9647 #endif
9648 /* It doesn't work to autosave while GC is in progress;
9649 the code used for auto-saving doesn't cope with the mark bit. */
9650 if (!gc_in_progress)
9652 printf ("Auto-save? (y or n) ");
9653 fflush (stdout);
9654 if (((c = getchar ()) & ~040) == 'Y')
9656 Fdo_auto_save (Qt, Qnil);
9657 #ifdef MSDOS
9658 printf ("\r\nAuto-save done");
9659 #else /* not MSDOS */
9660 printf ("Auto-save done\n");
9661 #endif /* not MSDOS */
9663 while (c != '\n') c = getchar ();
9665 else
9667 /* During GC, it must be safe to reenable quitting again. */
9668 Vinhibit_quit = Qnil;
9669 #ifdef MSDOS
9670 printf ("\r\n");
9671 #endif /* not MSDOS */
9672 printf ("Garbage collection in progress; cannot auto-save now\r\n");
9673 printf ("but will instead do a real quit after garbage collection ends\r\n");
9674 fflush (stdout);
9677 #ifdef MSDOS
9678 printf ("\r\nAbort? (y or n) ");
9679 #else /* not MSDOS */
9680 #ifdef VMS
9681 printf ("Abort (and enter debugger)? (y or n) ");
9682 #else /* not VMS */
9683 printf ("Abort (and dump core)? (y or n) ");
9684 #endif /* not VMS */
9685 #endif /* not MSDOS */
9686 fflush (stdout);
9687 if (((c = getchar ()) & ~040) == 'Y')
9688 abort ();
9689 while (c != '\n') c = getchar ();
9690 #ifdef MSDOS
9691 printf ("\r\nContinuing...\r\n");
9692 #else /* not MSDOS */
9693 printf ("Continuing...\n");
9694 #endif /* not MSDOS */
9695 fflush (stdout);
9696 init_sys_modes ();
9697 sigfree ();
9699 else
9701 /* If executing a function that wants to be interrupted out of
9702 and the user has not deferred quitting by binding `inhibit-quit'
9703 then quit right away. */
9704 if (immediate_quit && NILP (Vinhibit_quit))
9706 struct gl_state_s saved;
9707 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9709 immediate_quit = 0;
9710 sigfree ();
9711 saved = gl_state;
9712 GCPRO4 (saved.object, saved.global_code,
9713 saved.current_syntax_table, saved.old_prop);
9714 Fsignal (Qquit, Qnil);
9715 gl_state = saved;
9716 UNGCPRO;
9718 else
9719 /* Else request quit when it's safe */
9720 Vquit_flag = Qt;
9723 if (waiting_for_input && !echoing)
9724 quit_throw_to_read_char ();
9726 errno = old_errno;
9729 /* Handle a C-g by making read_char return C-g. */
9731 void
9732 quit_throw_to_read_char ()
9734 sigfree ();
9735 /* Prevent another signal from doing this before we finish. */
9736 clear_waiting_for_input ();
9737 input_pending = 0;
9739 Vunread_command_events = Qnil;
9740 unread_command_char = -1;
9742 #if 0 /* Currently, sit_for is called from read_char without turning
9743 off polling. And that can call set_waiting_for_input.
9744 It seems to be harmless. */
9745 #ifdef POLL_FOR_INPUT
9746 /* May be > 1 if in recursive minibuffer. */
9747 if (poll_suppress_count == 0)
9748 abort ();
9749 #endif
9750 #endif
9751 if (FRAMEP (internal_last_event_frame)
9752 && !EQ (internal_last_event_frame, selected_frame))
9753 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
9754 Qnil, 0);
9756 _longjmp (getcjmp, 1);
9759 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
9760 "Set mode of reading keyboard input.\n\
9761 First arg INTERRUPT non-nil means use input interrupts;\n\
9762 nil means use CBREAK mode.\n\
9763 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
9764 (no effect except in CBREAK mode).\n\
9765 Third arg META t means accept 8-bit input (for a Meta key).\n\
9766 META nil means ignore the top bit, on the assumption it is parity.\n\
9767 Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\
9768 Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\
9769 See also `current-input-mode'.")
9770 (interrupt, flow, meta, quit)
9771 Lisp_Object interrupt, flow, meta, quit;
9773 if (!NILP (quit)
9774 && (!INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400))
9775 error ("set-input-mode: QUIT must be an ASCII character");
9777 #ifdef POLL_FOR_INPUT
9778 stop_polling ();
9779 #endif
9781 #ifndef DOS_NT
9782 /* this causes startup screen to be restored and messes with the mouse */
9783 reset_sys_modes ();
9784 #endif
9786 #ifdef SIGIO
9787 /* Note SIGIO has been undef'd if FIONREAD is missing. */
9788 if (read_socket_hook)
9790 /* When using X, don't give the user a real choice,
9791 because we haven't implemented the mechanisms to support it. */
9792 #ifdef NO_SOCK_SIGIO
9793 interrupt_input = 0;
9794 #else /* not NO_SOCK_SIGIO */
9795 interrupt_input = 1;
9796 #endif /* NO_SOCK_SIGIO */
9798 else
9799 interrupt_input = !NILP (interrupt);
9800 #else /* not SIGIO */
9801 interrupt_input = 0;
9802 #endif /* not SIGIO */
9804 /* Our VMS input only works by interrupts, as of now. */
9805 #ifdef VMS
9806 interrupt_input = 1;
9807 #endif
9809 flow_control = !NILP (flow);
9810 if (NILP (meta))
9811 meta_key = 0;
9812 else if (EQ (meta, Qt))
9813 meta_key = 1;
9814 else
9815 meta_key = 2;
9816 if (!NILP (quit))
9817 /* Don't let this value be out of range. */
9818 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
9820 #ifndef DOS_NT
9821 init_sys_modes ();
9822 #endif
9824 #ifdef POLL_FOR_INPUT
9825 poll_suppress_count = 1;
9826 start_polling ();
9827 #endif
9828 return Qnil;
9831 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
9832 "Return information about the way Emacs currently reads keyboard input.\n\
9833 The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\
9834 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\
9835 nil, Emacs is using CBREAK mode.\n\
9836 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\
9837 terminal; this does not apply if Emacs uses interrupt-driven input.\n\
9838 META is t if accepting 8-bit input with 8th bit as Meta flag.\n\
9839 META nil means ignoring the top bit, on the assumption it is parity.\n\
9840 META is neither t nor nil if accepting 8-bit input and using\n\
9841 all 8 bits as the character code.\n\
9842 QUIT is the character Emacs currently uses to quit.\n\
9843 The elements of this list correspond to the arguments of\n\
9844 `set-input-mode'.")
9847 Lisp_Object val[4];
9849 val[0] = interrupt_input ? Qt : Qnil;
9850 val[1] = flow_control ? Qt : Qnil;
9851 val[2] = meta_key == 2 ? make_number (0) : meta_key == 1 ? Qt : Qnil;
9852 XSETFASTINT (val[3], quit_char);
9854 return Flist (sizeof (val) / sizeof (val[0]), val);
9859 * Set up a new kboard object with reasonable initial values.
9861 void
9862 init_kboard (kb)
9863 KBOARD *kb;
9865 kb->Voverriding_terminal_local_map = Qnil;
9866 kb->Vlast_command = Qnil;
9867 kb->Vreal_last_command = Qnil;
9868 kb->Vprefix_arg = Qnil;
9869 kb->Vlast_prefix_arg = Qnil;
9870 kb->kbd_queue = Qnil;
9871 kb->kbd_queue_has_data = 0;
9872 kb->immediate_echo = 0;
9873 kb->echoptr = kb->echobuf;
9874 kb->echo_after_prompt = -1;
9875 kb->kbd_macro_buffer = 0;
9876 kb->kbd_macro_bufsize = 0;
9877 kb->defining_kbd_macro = Qnil;
9878 kb->Vlast_kbd_macro = Qnil;
9879 kb->reference_count = 0;
9880 kb->Vsystem_key_alist = Qnil;
9881 kb->system_key_syms = Qnil;
9882 kb->Vdefault_minibuffer_frame = Qnil;
9886 * Destroy the contents of a kboard object, but not the object itself.
9887 * We use this just before deleting it, or if we're going to initialize
9888 * it a second time.
9890 static void
9891 wipe_kboard (kb)
9892 KBOARD *kb;
9894 if (kb->kbd_macro_buffer)
9895 xfree (kb->kbd_macro_buffer);
9898 #ifdef MULTI_KBOARD
9899 void
9900 delete_kboard (kb)
9901 KBOARD *kb;
9903 KBOARD **kbp;
9904 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
9905 if (*kbp == NULL)
9906 abort ();
9907 *kbp = kb->next_kboard;
9908 wipe_kboard (kb);
9909 xfree (kb);
9911 #endif
9913 void
9914 init_keyboard ()
9916 /* This is correct before outermost invocation of the editor loop */
9917 command_loop_level = -1;
9918 immediate_quit = 0;
9919 quit_char = Ctl ('g');
9920 Vunread_command_events = Qnil;
9921 unread_command_char = -1;
9922 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
9923 total_keys = 0;
9924 recent_keys_index = 0;
9925 kbd_fetch_ptr = kbd_buffer;
9926 kbd_store_ptr = kbd_buffer;
9927 kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
9928 #ifdef HAVE_MOUSE
9929 do_mouse_tracking = Qnil;
9930 #endif
9931 input_pending = 0;
9933 /* This means that command_loop_1 won't try to select anything the first
9934 time through. */
9935 internal_last_event_frame = Qnil;
9936 Vlast_event_frame = internal_last_event_frame;
9938 #ifdef MULTI_KBOARD
9939 current_kboard = initial_kboard;
9940 #endif
9941 wipe_kboard (current_kboard);
9942 init_kboard (current_kboard);
9944 if (!noninteractive && !read_socket_hook && NILP (Vwindow_system))
9946 signal (SIGINT, interrupt_signal);
9947 #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
9948 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
9949 SIGQUIT and we can't tell which one it will give us. */
9950 signal (SIGQUIT, interrupt_signal);
9951 #endif /* HAVE_TERMIO */
9953 /* Note SIGIO has been undef'd if FIONREAD is missing. */
9954 #ifdef SIGIO
9955 if (!noninteractive)
9956 signal (SIGIO, input_available_signal);
9957 #endif /* SIGIO */
9959 /* Use interrupt input by default, if it works and noninterrupt input
9960 has deficiencies. */
9962 #ifdef INTERRUPT_INPUT
9963 interrupt_input = 1;
9964 #else
9965 interrupt_input = 0;
9966 #endif
9968 /* Our VMS input only works by interrupts, as of now. */
9969 #ifdef VMS
9970 interrupt_input = 1;
9971 #endif
9973 sigfree ();
9974 dribble = 0;
9976 if (keyboard_init_hook)
9977 (*keyboard_init_hook) ();
9979 #ifdef POLL_FOR_INPUT
9980 poll_suppress_count = 1;
9981 start_polling ();
9982 #endif
9985 /* This type's only use is in syms_of_keyboard, to initialize the
9986 event header symbols and put properties on them. */
9987 struct event_head {
9988 Lisp_Object *var;
9989 char *name;
9990 Lisp_Object *kind;
9993 struct event_head head_table[] = {
9994 &Qmouse_movement, "mouse-movement", &Qmouse_movement,
9995 &Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement,
9996 &Qswitch_frame, "switch-frame", &Qswitch_frame,
9997 &Qdelete_frame, "delete-frame", &Qdelete_frame,
9998 &Qiconify_frame, "iconify-frame", &Qiconify_frame,
9999 &Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible,
10002 void
10003 syms_of_keyboard ()
10005 Vlispy_mouse_stem = build_string ("mouse");
10006 staticpro (&Vlispy_mouse_stem);
10008 /* Tool-bars. */
10009 QCimage = intern (":image");
10010 staticpro (&QCimage);
10012 staticpro (&Qhelp_echo);
10013 Qhelp_echo = intern ("help-echo");
10015 staticpro (&item_properties);
10016 item_properties = Qnil;
10018 staticpro (&tool_bar_item_properties);
10019 tool_bar_item_properties = Qnil;
10020 staticpro (&tool_bar_items_vector);
10021 tool_bar_items_vector = Qnil;
10023 staticpro (&real_this_command);
10024 real_this_command = Qnil;
10026 Qtimer_event_handler = intern ("timer-event-handler");
10027 staticpro (&Qtimer_event_handler);
10029 Qdisabled_command_hook = intern ("disabled-command-hook");
10030 staticpro (&Qdisabled_command_hook);
10032 Qself_insert_command = intern ("self-insert-command");
10033 staticpro (&Qself_insert_command);
10035 Qforward_char = intern ("forward-char");
10036 staticpro (&Qforward_char);
10038 Qbackward_char = intern ("backward-char");
10039 staticpro (&Qbackward_char);
10041 Qdisabled = intern ("disabled");
10042 staticpro (&Qdisabled);
10044 Qundefined = intern ("undefined");
10045 staticpro (&Qundefined);
10047 Qpre_command_hook = intern ("pre-command-hook");
10048 staticpro (&Qpre_command_hook);
10050 Qpost_command_hook = intern ("post-command-hook");
10051 staticpro (&Qpost_command_hook);
10053 Qpost_command_idle_hook = intern ("post-command-idle-hook");
10054 staticpro (&Qpost_command_idle_hook);
10056 Qdeferred_action_function = intern ("deferred-action-function");
10057 staticpro (&Qdeferred_action_function);
10059 Qcommand_hook_internal = intern ("command-hook-internal");
10060 staticpro (&Qcommand_hook_internal);
10062 Qfunction_key = intern ("function-key");
10063 staticpro (&Qfunction_key);
10064 Qmouse_click = intern ("mouse-click");
10065 staticpro (&Qmouse_click);
10066 #ifdef WINDOWSNT
10067 Qmouse_wheel = intern ("mouse-wheel");
10068 staticpro (&Qmouse_wheel);
10069 Qlanguage_change = intern ("language-change");
10070 staticpro (&Qlanguage_change);
10071 #endif
10072 Qdrag_n_drop = intern ("drag-n-drop");
10073 staticpro (&Qdrag_n_drop);
10075 Qusr1_signal = intern ("usr1-signal");
10076 staticpro (&Qusr1_signal);
10077 Qusr2_signal = intern ("usr2-signal");
10078 staticpro (&Qusr2_signal);
10080 Qmenu_enable = intern ("menu-enable");
10081 staticpro (&Qmenu_enable);
10082 Qmenu_alias = intern ("menu-alias");
10083 staticpro (&Qmenu_alias);
10084 QCenable = intern (":enable");
10085 staticpro (&QCenable);
10086 QCvisible = intern (":visible");
10087 staticpro (&QCvisible);
10088 QChelp = intern (":help");
10089 staticpro (&QChelp);
10090 QCfilter = intern (":filter");
10091 staticpro (&QCfilter);
10092 QCbutton = intern (":button");
10093 staticpro (&QCbutton);
10094 QCkeys = intern (":keys");
10095 staticpro (&QCkeys);
10096 QCkey_sequence = intern (":key-sequence");
10097 staticpro (&QCkey_sequence);
10098 QCtoggle = intern (":toggle");
10099 staticpro (&QCtoggle);
10100 QCradio = intern (":radio");
10101 staticpro (&QCradio);
10103 Qmode_line = intern ("mode-line");
10104 staticpro (&Qmode_line);
10105 Qvertical_line = intern ("vertical-line");
10106 staticpro (&Qvertical_line);
10107 Qvertical_scroll_bar = intern ("vertical-scroll-bar");
10108 staticpro (&Qvertical_scroll_bar);
10109 Qmenu_bar = intern ("menu-bar");
10110 staticpro (&Qmenu_bar);
10112 Qabove_handle = intern ("above-handle");
10113 staticpro (&Qabove_handle);
10114 Qhandle = intern ("handle");
10115 staticpro (&Qhandle);
10116 Qbelow_handle = intern ("below-handle");
10117 staticpro (&Qbelow_handle);
10118 Qup = intern ("up");
10119 staticpro (&Qup);
10120 Qdown = intern ("down");
10121 staticpro (&Qdown);
10122 Qtop = intern ("top");
10123 staticpro (&Qtop);
10124 Qbottom = intern ("bottom");
10125 staticpro (&Qbottom);
10126 Qend_scroll = intern ("end-scroll");
10127 staticpro (&Qend_scroll);
10128 Qratio = intern ("ratio");
10129 staticpro (&Qratio);
10131 Qevent_kind = intern ("event-kind");
10132 staticpro (&Qevent_kind);
10133 Qevent_symbol_elements = intern ("event-symbol-elements");
10134 staticpro (&Qevent_symbol_elements);
10135 Qevent_symbol_element_mask = intern ("event-symbol-element-mask");
10136 staticpro (&Qevent_symbol_element_mask);
10137 Qmodifier_cache = intern ("modifier-cache");
10138 staticpro (&Qmodifier_cache);
10140 Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar");
10141 staticpro (&Qrecompute_lucid_menubar);
10142 Qactivate_menubar_hook = intern ("activate-menubar-hook");
10143 staticpro (&Qactivate_menubar_hook);
10145 Qpolling_period = intern ("polling-period");
10146 staticpro (&Qpolling_period);
10148 Qinput_method_function = intern ("input-method-function");
10149 staticpro (&Qinput_method_function);
10151 Qinput_method_exit_on_first_char = intern ("input-method-exit-on-first-char");
10152 staticpro (&Qinput_method_exit_on_first_char);
10153 Qinput_method_use_echo_area = intern ("input-method-use-echo-area");
10154 staticpro (&Qinput_method_use_echo_area);
10156 Fset (Qinput_method_exit_on_first_char, Qnil);
10157 Fset (Qinput_method_use_echo_area, Qnil);
10159 last_point_position_buffer = Qnil;
10162 struct event_head *p;
10164 for (p = head_table;
10165 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
10166 p++)
10168 *p->var = intern (p->name);
10169 staticpro (p->var);
10170 Fput (*p->var, Qevent_kind, *p->kind);
10171 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
10175 button_down_location = Fmake_vector (make_number (1), Qnil);
10176 staticpro (&button_down_location);
10177 mouse_syms = Fmake_vector (make_number (1), Qnil);
10178 staticpro (&mouse_syms);
10181 int i;
10182 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
10184 modifier_symbols = Fmake_vector (make_number (len), Qnil);
10185 for (i = 0; i < len; i++)
10186 if (modifier_names[i])
10187 XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]);
10188 staticpro (&modifier_symbols);
10191 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
10192 staticpro (&recent_keys);
10194 this_command_keys = Fmake_vector (make_number (40), Qnil);
10195 staticpro (&this_command_keys);
10197 raw_keybuf = Fmake_vector (make_number (30), Qnil);
10198 staticpro (&raw_keybuf);
10200 Qextended_command_history = intern ("extended-command-history");
10201 Fset (Qextended_command_history, Qnil);
10202 staticpro (&Qextended_command_history);
10204 kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
10205 staticpro (&kbd_buffer_gcpro);
10207 accent_key_syms = Qnil;
10208 staticpro (&accent_key_syms);
10210 func_key_syms = Qnil;
10211 staticpro (&func_key_syms);
10213 #ifdef WINDOWSNT
10214 mouse_wheel_syms = Qnil;
10215 staticpro (&mouse_wheel_syms);
10217 drag_n_drop_syms = Qnil;
10218 staticpro (&drag_n_drop_syms);
10219 #endif
10221 unread_switch_frame = Qnil;
10222 staticpro (&unread_switch_frame);
10224 internal_last_event_frame = Qnil;
10225 staticpro (&internal_last_event_frame);
10227 read_key_sequence_cmd = Qnil;
10228 staticpro (&read_key_sequence_cmd);
10230 menu_bar_one_keymap_changed_items = Qnil;
10231 staticpro (&menu_bar_one_keymap_changed_items);
10233 defsubr (&Sevent_convert_list);
10234 defsubr (&Sread_key_sequence);
10235 defsubr (&Sread_key_sequence_vector);
10236 defsubr (&Srecursive_edit);
10237 #ifdef HAVE_MOUSE
10238 defsubr (&Strack_mouse);
10239 #endif
10240 defsubr (&Sinput_pending_p);
10241 defsubr (&Scommand_execute);
10242 defsubr (&Srecent_keys);
10243 defsubr (&Sthis_command_keys);
10244 defsubr (&Sthis_command_keys_vector);
10245 defsubr (&Sthis_single_command_keys);
10246 defsubr (&Sthis_single_command_raw_keys);
10247 defsubr (&Sreset_this_command_lengths);
10248 defsubr (&Sclear_this_command_keys);
10249 defsubr (&Ssuspend_emacs);
10250 defsubr (&Sabort_recursive_edit);
10251 defsubr (&Sexit_recursive_edit);
10252 defsubr (&Srecursion_depth);
10253 defsubr (&Stop_level);
10254 defsubr (&Sdiscard_input);
10255 defsubr (&Sopen_dribble_file);
10256 defsubr (&Sset_input_mode);
10257 defsubr (&Scurrent_input_mode);
10258 defsubr (&Sexecute_extended_command);
10260 DEFVAR_LISP ("last-command-char", &last_command_char,
10261 "Last input event that was part of a command.");
10263 DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char,
10264 "Last input event that was part of a command.");
10266 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
10267 "Last input event in a command, except for mouse menu events.\n\
10268 Mouse menus give back keys that don't look like mouse events;\n\
10269 this variable holds the actual mouse event that led to the menu,\n\
10270 so that you can determine whether the command was run by mouse or not.");
10272 DEFVAR_LISP ("last-input-char", &last_input_char,
10273 "Last input event.");
10275 DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char,
10276 "Last input event.");
10278 DEFVAR_LISP ("unread-command-events", &Vunread_command_events,
10279 "List of events to be read as the command input.\n\
10280 These events are processed first, before actual keyboard input.");
10281 Vunread_command_events = Qnil;
10283 DEFVAR_INT ("unread-command-char", &unread_command_char,
10284 "If not -1, an object to be read as next command input event.");
10286 DEFVAR_LISP ("unread-post-input-method-events", &Vunread_post_input_method_events,
10287 "List of events to be processed as input by input methods.\n\
10288 These events are processed after `unread-command-events', but\n\
10289 before actual keyboard input.");
10290 Vunread_post_input_method_events = Qnil;
10292 DEFVAR_LISP ("unread-input-method-events", &Vunread_input_method_events,
10293 "List of events to be processed as input by input methods.\n\
10294 These events are processed after `unread-command-events', but\n\
10295 before actual keyboard input.");
10296 Vunread_input_method_events = Qnil;
10298 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
10299 "Meta-prefix character code.\n\
10300 Meta-foo as command input turns into this character followed by foo.");
10301 XSETINT (meta_prefix_char, 033);
10303 DEFVAR_KBOARD ("last-command", Vlast_command,
10304 "The last command executed.\n\
10305 Normally a symbol with a function definition, but can be whatever was found\n\
10306 in the keymap, or whatever the variable `this-command' was set to by that\n\
10307 command.\n\
10309 The value `mode-exit' is special; it means that the previous command\n\
10310 read an event that told it to exit, and it did so and unread that event.\n\
10311 In other words, the present command is the event that made the previous\n\
10312 command exit.\n\
10314 The value `kill-region' is special; it means that the previous command\n\
10315 was a kill command.");
10317 DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
10318 "Same as `last-command', but never altered by Lisp code.");
10320 DEFVAR_LISP ("this-command", &Vthis_command,
10321 "The command now being executed.\n\
10322 The command can set this variable; whatever is put here\n\
10323 will be in `last-command' during the following command.");
10324 Vthis_command = Qnil;
10326 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
10327 "*Number of input events between auto-saves.\n\
10328 Zero means disable autosaving due to number of characters typed.");
10329 auto_save_interval = 300;
10331 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
10332 "*Number of seconds idle time before auto-save.\n\
10333 Zero or nil means disable auto-saving due to idleness.\n\
10334 After auto-saving due to this many seconds of idle time,\n\
10335 Emacs also does a garbage collection if that seems to be warranted.");
10336 XSETFASTINT (Vauto_save_timeout, 30);
10338 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes,
10339 "*Nonzero means echo unfinished commands after this many seconds of pause.\n\
10340 The value may be integer or floating point.");
10341 Vecho_keystrokes = make_number (1);
10343 DEFVAR_INT ("polling-period", &polling_period,
10344 "*Interval between polling for input during Lisp execution.\n\
10345 The reason for polling is to make C-g work to stop a running program.\n\
10346 Polling is needed only when using X windows and SIGIO does not work.\n\
10347 Polling is automatically disabled in all other cases.");
10348 polling_period = 2;
10350 DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
10351 "*Maximum time between mouse clicks to make a double-click.\n\
10352 Measured in milliseconds. nil means disable double-click recognition;\n\
10353 t means double-clicks have no time limit and are detected\n\
10354 by position only.");
10355 Vdouble_click_time = make_number (500);
10357 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
10358 "*Non-nil means inhibit local map menu bar menus.");
10359 inhibit_local_menu_bar_menus = 0;
10361 DEFVAR_INT ("num-input-keys", &num_input_keys,
10362 "Number of complete key sequences read as input so far.\n\
10363 This includes key sequences read from keyboard macros.\n\
10364 The number is effectively the number of interactive command invocations.");
10365 num_input_keys = 0;
10367 DEFVAR_INT ("num-nonmacro-input-events", &num_nonmacro_input_events,
10368 "Number of input events read from the keyboard so far.\n\
10369 This does not include events generated by keyboard macros.");
10370 num_nonmacro_input_events = 0;
10372 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
10373 "The frame in which the most recently read event occurred.\n\
10374 If the last event came from a keyboard macro, this is set to `macro'.");
10375 Vlast_event_frame = Qnil;
10377 /* This variable is set up in sysdep.c. */
10378 DEFVAR_LISP ("tty-erase-char", &Vtty_erase_char,
10379 "The ERASE character as set by the user with stty.");
10381 DEFVAR_LISP ("help-char", &Vhelp_char,
10382 "Character to recognize as meaning Help.\n\
10383 When it is read, do `(eval help-form)', and display result if it's a string.\n\
10384 If the value of `help-form' is nil, this char can be read normally.");
10385 XSETINT (Vhelp_char, Ctl ('H'));
10387 DEFVAR_LISP ("help-event-list", &Vhelp_event_list,
10388 "List of input events to recognize as meaning Help.\n\
10389 These work just like the value of `help-char' (see that).");
10390 Vhelp_event_list = Qnil;
10392 DEFVAR_LISP ("help-form", &Vhelp_form,
10393 "Form to execute when character `help-char' is read.\n\
10394 If the form returns a string, that string is displayed.\n\
10395 If `help-form' is nil, the help char is not recognized.");
10396 Vhelp_form = Qnil;
10398 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
10399 "Command to run when `help-char' character follows a prefix key.\n\
10400 This command is used only when there is no actual binding\n\
10401 for that character after that prefix key.");
10402 Vprefix_help_command = Qnil;
10404 DEFVAR_LISP ("top-level", &Vtop_level,
10405 "Form to evaluate when Emacs starts up.\n\
10406 Useful to set before you dump a modified Emacs.");
10407 Vtop_level = Qnil;
10409 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
10410 "Translate table for keyboard input, or nil.\n\
10411 Each character is looked up in this string and the contents used instead.\n\
10412 The value may be a string, a vector, or a char-table.\n\
10413 If it is a string or vector of length N,\n\
10414 character codes N and up are untranslated.\n\
10415 In a vector or a char-table, an element which is nil means \"no translation\".");
10416 Vkeyboard_translate_table = Qnil;
10418 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
10419 "Non-nil means to always spawn a subshell instead of suspending.\n\
10420 \(Even if the operating system has support for stopping a process.\)");
10421 cannot_suspend = 0;
10423 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
10424 "Non-nil means prompt with menus when appropriate.\n\
10425 This is done when reading from a keymap that has a prompt string,\n\
10426 for elements that have prompt strings.\n\
10427 The menu is displayed on the screen\n\
10428 if X menus were enabled at configuration\n\
10429 time and the previous event was a mouse click prefix key.\n\
10430 Otherwise, menu prompting uses the echo area.");
10431 menu_prompting = 1;
10433 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
10434 "Character to see next line of menu prompt.\n\
10435 Type this character while in a menu prompt to rotate around the lines of it.");
10436 XSETINT (menu_prompt_more_char, ' ');
10438 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
10439 "A mask of additional modifier keys to use with every keyboard character.\n\
10440 Emacs applies the modifiers of the character stored here to each keyboard\n\
10441 character it reads. For example, after evaluating the expression\n\
10442 (setq extra-keyboard-modifiers ?\\C-x)\n\
10443 all input characters will have the control modifier applied to them.\n\
10445 Note that the character ?\\C-@, equivalent to the integer zero, does\n\
10446 not count as a control character; rather, it counts as a character\n\
10447 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero\n\
10448 cancels any modification.");
10449 extra_keyboard_modifiers = 0;
10451 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
10452 "If an editing command sets this to t, deactivate the mark afterward.\n\
10453 The command loop sets this to nil before each command,\n\
10454 and tests the value when the command returns.\n\
10455 Buffer modification stores t in this variable.");
10456 Vdeactivate_mark = Qnil;
10458 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal,
10459 "Temporary storage of pre-command-hook or post-command-hook.");
10460 Vcommand_hook_internal = Qnil;
10462 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
10463 "Normal hook run before each command is executed.\n\
10464 If an unhandled error happens in running this hook,\n\
10465 the hook value is set to nil, since otherwise the error\n\
10466 might happen repeatedly and make Emacs nonfunctional.");
10467 Vpre_command_hook = Qnil;
10469 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
10470 "Normal hook run after each command is executed.\n\
10471 If an unhandled error happens in running this hook,\n\
10472 the hook value is set to nil, since otherwise the error\n\
10473 might happen repeatedly and make Emacs nonfunctional.");
10474 Vpost_command_hook = Qnil;
10476 DEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook,
10477 "Normal hook run after each command is executed, if idle.\n\
10478 Errors running the hook are caught and ignored.\n\
10479 This feature is obsolete; use idle timers instead. See `etc/NEWS'.");
10480 Vpost_command_idle_hook = Qnil;
10482 DEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay,
10483 "Delay time before running `post-command-idle-hook'.\n\
10484 This is measured in microseconds.");
10485 post_command_idle_delay = 100000;
10487 #if 0
10488 DEFVAR_LISP ("echo-area-clear-hook", ...,
10489 "Normal hook run when clearing the echo area.");
10490 #endif
10491 Qecho_area_clear_hook = intern ("echo-area-clear-hook");
10492 XSYMBOL (Qecho_area_clear_hook)->value = Qnil;
10494 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
10495 "t means menu bar, specified Lucid style, needs to be recomputed.");
10496 Vlucid_menu_bar_dirty_flag = Qnil;
10498 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
10499 "List of menu bar items to move to the end of the menu bar.\n\
10500 The elements of the list are event types that may have menu bar bindings.");
10501 Vmenu_bar_final_items = Qnil;
10503 DEFVAR_KBOARD ("overriding-terminal-local-map",
10504 Voverriding_terminal_local_map,
10505 "Per-terminal keymap that overrides all other local keymaps.\n\
10506 If this variable is non-nil, it is used as a keymap instead of the\n\
10507 buffer's local map, and the minor mode keymaps and text property keymaps.\n\
10508 This variable is intended to let commands such as `universal-argumemnt'\n\
10509 set up a different keymap for reading the next command.");
10511 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map,
10512 "Keymap that overrides all other local keymaps.\n\
10513 If this variable is non-nil, it is used as a keymap instead of the\n\
10514 buffer's local map, and the minor mode keymaps and text property keymaps.");
10515 Voverriding_local_map = Qnil;
10517 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag,
10518 "Non-nil means `overriding-local-map' applies to the menu bar.\n\
10519 Otherwise, the menu bar continues to reflect the buffer's local map\n\
10520 and the minor mode maps regardless of `overriding-local-map'.");
10521 Voverriding_local_map_menu_flag = Qnil;
10523 DEFVAR_LISP ("special-event-map", &Vspecial_event_map,
10524 "Keymap defining bindings for special events to execute at low level.");
10525 Vspecial_event_map = Fcons (intern ("keymap"), Qnil);
10527 DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
10528 "*Non-nil means generate motion events for mouse motion.");
10530 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
10531 "Alist of system-specific X windows key symbols.\n\
10532 Each element should have the form (N . SYMBOL) where N is the\n\
10533 numeric keysym code (sans the \"system-specific\" bit 1<<28)\n\
10534 and SYMBOL is its name.");
10536 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list,
10537 "List of deferred actions to be performed at a later time.\n\
10538 The precise format isn't relevant here; we just check whether it is nil.");
10539 Vdeferred_action_list = Qnil;
10541 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function,
10542 "Function to call to handle deferred actions, after each command.\n\
10543 This function is called with no arguments after each command\n\
10544 whenever `deferred-action-list' is non-nil.");
10545 Vdeferred_action_function = Qnil;
10547 DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings,
10548 "*Non-nil means show the equivalent key-binding when M-x command has one.\n\
10549 The value can be a length of time to show the message for.\n\
10550 If the value is non-nil and not a number, we wait 2 seconds.");
10551 Vsuggest_key_bindings = Qt;
10553 DEFVAR_LISP ("timer-list", &Vtimer_list,
10554 "List of active absolute time timers in order of increasing time");
10555 Vtimer_list = Qnil;
10557 DEFVAR_LISP ("timer-idle-list", &Vtimer_idle_list,
10558 "List of active idle-time timers in order of increasing time");
10559 Vtimer_idle_list = Qnil;
10561 DEFVAR_LISP ("input-method-function", &Vinput_method_function,
10562 "If non-nil, the function that implements the current input method.\n\
10563 It's called with one argument, a printing character that was just read.\n\
10564 \(That means a character with code 040...0176.)\n\
10565 Typically this function uses `read-event' to read additional events.\n\
10566 When it does so, it should first bind `input-method-function' to nil\n\
10567 so it will not be called recursively.\n\
10569 The function should return a list of zero or more events\n\
10570 to be used as input. If it wants to put back some events\n\
10571 to be reconsidered, separately, by the input method,\n\
10572 it can add them to the beginning of `unread-command-events'.\n\
10574 The input method function can find in `input-method-previous-method'\n\
10575 the previous echo area message.\n\
10577 The input method function should refer to the variables\n\
10578 `input-method-use-echo-area' and `input-method-exit-on-first-char'\n\
10579 for guidance on what to do.");
10580 Vinput_method_function = Qnil;
10582 DEFVAR_LISP ("input-method-previous-message",
10583 &Vinput_method_previous_message,
10584 "When `input-method-function' is called, hold the previous echo area message.\n\
10585 This variable exists because `read-event' clears the echo area\n\
10586 before running the input method. It is nil if there was no message.");
10587 Vinput_method_previous_message = Qnil;
10589 DEFVAR_LISP ("show-help-function", &Vshow_help_function,
10590 "If non-nil, the function that implements the display of help.\n\
10591 It's called with one argument, the help string to display.");
10592 Vshow_help_function = Qnil;
10594 DEFVAR_LISP ("disable-point-adjustment", &Vdisable_point_adjustment,
10595 "If non-nil, suppress point adjustment after executing a command.\n\
10597 After a command is executed, if point is moved into a region that has\n\
10598 special properties (e.g. composition, display), we adjust point to\n\
10599 the boundary of the region. But, several special commands sets this\n\
10600 variable to non-nil, then we suppress the point adjustment.\n\
10602 This variable is set to nil before reading a command, and is checked\n\
10603 just after executing the command");
10604 Vdisable_point_adjustment = Qnil;
10606 DEFVAR_LISP ("global-disable-point-adjustment",
10607 &Vglobal_disable_point_adjustment,
10608 "*If non-nil, always suppress point adjustment.\n\
10610 The default value is nil, in which case, point adjustment are\n\
10611 suppressed only after special commands that set\n\
10612 `disable-point-adjustment' (which see) to non-nil.");
10613 Vglobal_disable_point_adjustment = Qnil;
10615 DEFVAR_BOOL ("update-menu-bindings", &update_menu_bindings,
10616 "Non-nil means updating menu bindings is allowed.\n\
10617 A value of nil means menu bindings should not be updated.\n\
10618 Used during Emacs' startup.");
10619 update_menu_bindings = 1;
10621 DEFVAR_LISP ("minibuffer-message-timeout", &Vminibuffer_message_timeout,
10622 "*How long to display an echo-area message when the minibuffer is active.\n\
10623 If the value is not a number, such messages don't time out.");
10624 Vminibuffer_message_timeout = make_number (2);
10627 void
10628 keys_of_keyboard ()
10630 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
10631 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
10632 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
10633 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
10634 initial_define_key (meta_map, 'x', "execute-extended-command");
10636 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
10637 "handle-delete-frame");
10638 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
10639 "ignore-event");
10640 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
10641 "ignore-event");