*** empty log message ***
[emacs.git] / src / keyboard.c
blob8fb0a1ec8973f3b452f16fd9ba92a8d0f257493b
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 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 Lisp_Object str;
695 int len = STRING_BYTES (XSTRING (str));
696 int multibyte_p = STRING_MULTIBYTE (str);
698 if (len > ECHOBUFSIZE - 4)
700 if (multibyte_p)
702 unsigned char *p = XSTRING (str)->data, *lastp;
703 unsigned char *pend = p + ECHOBUFSIZE - 4;
705 while (p < pend)
707 int this_len;
709 lastp = p;
710 PARSE_MULTIBYTE_SEQ (p, pend - p, this_len);
711 p += this_len;
713 len = lastp - XSTRING (str)->data;
715 else
716 len = ECHOBUFSIZE - 4;
719 current_kboard->echoptr
720 += copy_text (XSTRING (str)->data, current_kboard->echobuf, len,
721 STRING_MULTIBYTE (str), 1);
722 *current_kboard->echoptr = '\0';
724 current_kboard->echo_after_prompt = len;
726 echo_now ();
729 /* Add C to the echo string, if echoing is going on.
730 C can be a character, which is printed prettily ("M-C-x" and all that
731 jazz), or a symbol, whose name is printed. */
733 void
734 echo_char (c)
735 Lisp_Object c;
737 extern char *push_key_description ();
739 if (current_kboard->immediate_echo)
741 char *ptr = current_kboard->echoptr;
743 if (ptr != current_kboard->echobuf)
744 *ptr++ = ' ';
746 /* If someone has passed us a composite event, use its head symbol. */
747 c = EVENT_HEAD (c);
749 if (INTEGERP (c))
751 int ch = XINT (c);
753 if (ptr - current_kboard->echobuf
754 > ECHOBUFSIZE - KEY_DESCRIPTION_SIZE)
755 return;
757 if (ASCII_BYTE_P (ch))
758 ptr = push_key_description (ch, ptr);
759 else
761 if (SINGLE_BYTE_CHAR_P (ch))
762 ch = unibyte_char_to_multibyte (ch);
763 ptr += CHAR_STRING (ch, ptr);
766 else if (SYMBOLP (c))
768 struct Lisp_String *name = XSYMBOL (c)->name;
769 if ((ptr - current_kboard->echobuf) + STRING_BYTES (name) + 4
770 > ECHOBUFSIZE)
771 return;
772 ptr += copy_text (name->data, ptr, STRING_BYTES (name),
773 name->size_byte >= 0, 1);
776 if (current_kboard->echoptr == current_kboard->echobuf
777 && help_char_p (c))
779 strcpy (ptr, " (Type ? for further options)");
780 ptr += strlen (ptr);
783 *ptr = 0;
784 current_kboard->echoptr = ptr;
786 echo_now ();
790 /* Temporarily add a dash to the end of the echo string if it's not
791 empty, so that it serves as a mini-prompt for the very next character. */
793 void
794 echo_dash ()
796 if (!current_kboard->immediate_echo
797 && current_kboard->echoptr == current_kboard->echobuf)
798 return;
799 /* Do nothing if we just printed a prompt. */
800 if (current_kboard->echo_after_prompt
801 == current_kboard->echoptr - current_kboard->echobuf)
802 return;
803 /* Do nothing if not echoing at all. */
804 if (current_kboard->echoptr == 0)
805 return;
807 /* Put a dash at the end of the buffer temporarily,
808 but make it go away when the next character is added. */
809 current_kboard->echoptr[0] = '-';
810 current_kboard->echoptr[1] = 0;
812 echo_now ();
815 /* Display the current echo string, and begin echoing if not already
816 doing so. */
818 void
819 echo_now ()
821 if (!current_kboard->immediate_echo)
823 int i;
824 current_kboard->immediate_echo = 1;
826 for (i = 0; i < this_command_key_count; i++)
828 Lisp_Object c;
829 c = XVECTOR (this_command_keys)->contents[i];
830 if (! (EVENT_HAS_PARAMETERS (c)
831 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
832 echo_char (c);
834 echo_dash ();
837 echoing = 1;
838 message2_nolog (current_kboard->echobuf, strlen (current_kboard->echobuf),
840 echoing = 0;
842 /* Record in what buffer we echoed, and from which kboard. */
843 echo_message_buffer = echo_area_buffer[0];
844 echo_kboard = current_kboard;
846 if (waiting_for_input && !NILP (Vquit_flag))
847 quit_throw_to_read_char ();
850 /* Turn off echoing, for the start of a new command. */
852 void
853 cancel_echoing ()
855 current_kboard->immediate_echo = 0;
856 current_kboard->echoptr = current_kboard->echobuf;
857 current_kboard->echo_after_prompt = -1;
858 ok_to_echo_at_next_pause = NULL;
859 echo_kboard = NULL;
860 echo_message_buffer = Qnil;
863 /* Return the length of the current echo string. */
865 static int
866 echo_length ()
868 return current_kboard->echoptr - current_kboard->echobuf;
871 /* Truncate the current echo message to its first LEN chars.
872 This and echo_char get used by read_key_sequence when the user
873 switches frames while entering a key sequence. */
875 static void
876 echo_truncate (len)
877 int len;
879 current_kboard->echobuf[len] = '\0';
880 current_kboard->echoptr = current_kboard->echobuf + len;
881 truncate_echo_area (len);
885 /* Functions for manipulating this_command_keys. */
886 static void
887 add_command_key (key)
888 Lisp_Object key;
890 int size = XVECTOR (this_command_keys)->size;
892 /* If reset-this-command-length was called recently, obey it now.
893 See the doc string of that function for an explanation of why. */
894 if (before_command_restore_flag)
896 this_command_key_count = before_command_key_count_1;
897 if (this_command_key_count < this_single_command_key_start)
898 this_single_command_key_start = this_command_key_count;
899 echo_truncate (before_command_echo_length_1);
900 before_command_restore_flag = 0;
903 if (this_command_key_count >= size)
905 Lisp_Object new_keys;
907 new_keys = Fmake_vector (make_number (size * 2), Qnil);
908 bcopy (XVECTOR (this_command_keys)->contents,
909 XVECTOR (new_keys)->contents,
910 size * sizeof (Lisp_Object));
912 this_command_keys = new_keys;
915 XVECTOR (this_command_keys)->contents[this_command_key_count++] = key;
918 Lisp_Object
919 recursive_edit_1 ()
921 int count = specpdl_ptr - specpdl;
922 Lisp_Object val;
924 if (command_loop_level > 0)
926 specbind (Qstandard_output, Qt);
927 specbind (Qstandard_input, Qt);
930 #ifdef HAVE_X_WINDOWS
931 /* The command loop has started a busy-cursor timer, so we have to
932 cancel it here, otherwise it will fire because the recursive edit
933 can take some time. */
934 if (display_busy_cursor_p)
935 cancel_busy_cursor ();
936 #endif
938 val = command_loop ();
939 if (EQ (val, Qt))
940 Fsignal (Qquit, Qnil);
941 /* Handle throw from read_minibuf when using minibuffer
942 while it's active but we're in another window. */
943 if (STRINGP (val))
944 Fsignal (Qerror, Fcons (val, Qnil));
946 return unbind_to (count, Qnil);
949 /* When an auto-save happens, record the "time", and don't do again soon. */
951 void
952 record_auto_save ()
954 last_auto_save = num_nonmacro_input_events;
957 /* Make an auto save happen as soon as possible at command level. */
959 void
960 force_auto_save_soon ()
962 last_auto_save = - auto_save_interval - 1;
964 record_asynch_buffer_change ();
967 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
968 "Invoke the editor command loop recursively.\n\
969 To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
970 that tells this function to return.\n\
971 Alternately, `(throw 'exit t)' makes this function signal an error.\n\
972 This function is called by the editor initialization to begin editing.")
975 int count = specpdl_ptr - specpdl;
977 command_loop_level++;
978 update_mode_lines = 1;
980 /* This function may have been called from a debugger called from
981 within redisplay, for instance by Edebugging a function called
982 from fontification-functions. We want to allow redisplay in
983 the debugging session.
985 The recursive edit is left with a `(throw exit ...)'. The `exit'
986 tag is not caught anywhere in redisplay, i.e. when we leave the
987 recursive edit, the original redisplay leading to the recursive
988 edit will be unwound. The outcome should therefore be safe. */
989 specbind (Qinhibit_redisplay, Qnil);
990 redisplaying_p = 0;
992 record_unwind_protect (recursive_edit_unwind,
993 (command_loop_level
994 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
995 ? Fcurrent_buffer ()
996 : Qnil);
997 recursive_edit_1 ();
998 return unbind_to (count, Qnil);
1001 Lisp_Object
1002 recursive_edit_unwind (buffer)
1003 Lisp_Object buffer;
1005 if (!NILP (buffer))
1006 Fset_buffer (buffer);
1008 command_loop_level--;
1009 update_mode_lines = 1;
1010 return Qnil;
1013 static void
1014 any_kboard_state ()
1016 #ifdef MULTI_KBOARD
1017 #if 0 /* Theory: if there's anything in Vunread_command_events,
1018 it will right away be read by read_key_sequence,
1019 and then if we do switch KBOARDS, it will go into the side
1020 queue then. So we don't need to do anything special here -- rms. */
1021 if (CONSP (Vunread_command_events))
1023 current_kboard->kbd_queue
1024 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
1025 current_kboard->kbd_queue_has_data = 1;
1027 Vunread_command_events = Qnil;
1028 #endif
1029 single_kboard = 0;
1030 #endif
1033 /* Switch to the single-kboard state, making current_kboard
1034 the only KBOARD from which further input is accepted. */
1036 void
1037 single_kboard_state ()
1039 #ifdef MULTI_KBOARD
1040 single_kboard = 1;
1041 #endif
1044 /* Maintain a stack of kboards, so other parts of Emacs
1045 can switch temporarily to the kboard of a given frame
1046 and then revert to the previous status. */
1048 struct kboard_stack
1050 KBOARD *kboard;
1051 struct kboard_stack *next;
1054 static struct kboard_stack *kboard_stack;
1056 void
1057 push_frame_kboard (f)
1058 FRAME_PTR f;
1060 #ifdef MULTI_KBOARD
1061 struct kboard_stack *p
1062 = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
1064 p->next = kboard_stack;
1065 p->kboard = current_kboard;
1066 kboard_stack = p;
1068 current_kboard = FRAME_KBOARD (f);
1069 #endif
1072 void
1073 pop_frame_kboard ()
1075 #ifdef MULTI_KBOARD
1076 struct kboard_stack *p = kboard_stack;
1077 current_kboard = p->kboard;
1078 kboard_stack = p->next;
1079 xfree (p);
1080 #endif
1083 /* Handle errors that are not handled at inner levels
1084 by printing an error message and returning to the editor command loop. */
1086 Lisp_Object
1087 cmd_error (data)
1088 Lisp_Object data;
1090 Lisp_Object old_level, old_length;
1091 char macroerror[50];
1093 if (!NILP (executing_macro))
1095 if (executing_macro_iterations == 1)
1096 sprintf (macroerror, "After 1 kbd macro iteration: ");
1097 else
1098 sprintf (macroerror, "After %d kbd macro iterations: ",
1099 executing_macro_iterations);
1101 else
1102 *macroerror = 0;
1104 Vstandard_output = Qt;
1105 Vstandard_input = Qt;
1106 Vexecuting_macro = Qnil;
1107 executing_macro = Qnil;
1108 current_kboard->Vprefix_arg = Qnil;
1109 current_kboard->Vlast_prefix_arg = Qnil;
1110 cancel_echoing ();
1112 /* Avoid unquittable loop if data contains a circular list. */
1113 old_level = Vprint_level;
1114 old_length = Vprint_length;
1115 XSETFASTINT (Vprint_level, 10);
1116 XSETFASTINT (Vprint_length, 10);
1117 cmd_error_internal (data, macroerror);
1118 Vprint_level = old_level;
1119 Vprint_length = old_length;
1121 Vquit_flag = Qnil;
1123 Vinhibit_quit = Qnil;
1124 #ifdef MULTI_KBOARD
1125 any_kboard_state ();
1126 #endif
1128 return make_number (0);
1131 /* Take actions on handling an error. DATA is the data that describes
1132 the error.
1134 CONTEXT is a C-string containing ASCII characters only which
1135 describes the context in which the error happened. If we need to
1136 generalize CONTEXT to allow multibyte characters, make it a Lisp
1137 string. */
1139 void
1140 cmd_error_internal (data, context)
1141 Lisp_Object data;
1142 char *context;
1144 Lisp_Object stream;
1145 int kill_emacs_p = 0;
1146 struct frame *sf = SELECTED_FRAME ();
1148 Vquit_flag = Qnil;
1149 Vinhibit_quit = Qt;
1150 clear_message (1, 0);
1152 /* If the window system or terminal frame hasn't been initialized
1153 yet, or we're not interactive, it's best to dump this message out
1154 to stderr and exit. */
1155 if (!sf->glyphs_initialized_p
1156 /* This is the case of the frame dumped with Emacs, when we're
1157 running under a window system. */
1158 || (!NILP (Vwindow_system)
1159 && !inhibit_window_system
1160 && FRAME_TERMCAP_P (sf))
1161 || noninteractive)
1163 stream = Qexternal_debugging_output;
1164 kill_emacs_p = 1;
1166 else
1168 Fdiscard_input ();
1169 bitch_at_user ();
1170 stream = Qt;
1173 if (context != 0)
1174 write_string_1 (context, -1, stream);
1176 print_error_message (data, stream);
1178 /* If the window system or terminal frame hasn't been initialized
1179 yet, or we're in -batch mode, this error should cause Emacs to exit. */
1180 if (kill_emacs_p)
1182 Fterpri (stream);
1183 Fkill_emacs (make_number (-1));
1187 Lisp_Object command_loop_1 ();
1188 Lisp_Object command_loop_2 ();
1189 Lisp_Object top_level_1 ();
1191 /* Entry to editor-command-loop.
1192 This level has the catches for exiting/returning to editor command loop.
1193 It returns nil to exit recursive edit, t to abort it. */
1195 Lisp_Object
1196 command_loop ()
1198 if (command_loop_level > 0 || minibuf_level > 0)
1200 Lisp_Object val;
1201 val = internal_catch (Qexit, command_loop_2, Qnil);
1202 executing_macro = Qnil;
1203 return val;
1205 else
1206 while (1)
1208 internal_catch (Qtop_level, top_level_1, Qnil);
1209 internal_catch (Qtop_level, command_loop_2, Qnil);
1210 executing_macro = Qnil;
1212 /* End of file in -batch run causes exit here. */
1213 if (noninteractive)
1214 Fkill_emacs (Qt);
1218 /* Here we catch errors in execution of commands within the
1219 editing loop, and reenter the editing loop.
1220 When there is an error, cmd_error runs and returns a non-nil
1221 value to us. A value of nil means that cmd_loop_1 itself
1222 returned due to end of file (or end of kbd macro). */
1224 Lisp_Object
1225 command_loop_2 ()
1227 register Lisp_Object val;
1230 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1231 while (!NILP (val));
1233 return Qnil;
1236 Lisp_Object
1237 top_level_2 ()
1239 return Feval (Vtop_level);
1242 Lisp_Object
1243 top_level_1 ()
1245 /* On entry to the outer level, run the startup file */
1246 if (!NILP (Vtop_level))
1247 internal_condition_case (top_level_2, Qerror, cmd_error);
1248 else if (!NILP (Vpurify_flag))
1249 message ("Bare impure Emacs (standard Lisp code not loaded)");
1250 else
1251 message ("Bare Emacs (standard Lisp code not loaded)");
1252 return Qnil;
1255 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1256 "Exit all recursive editing levels.")
1259 #ifdef HAVE_X_WINDOWS
1260 if (display_busy_cursor_p)
1261 cancel_busy_cursor ();
1262 #endif
1263 return Fthrow (Qtop_level, Qnil);
1266 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1267 "Exit from the innermost recursive edit or minibuffer.")
1270 if (command_loop_level > 0 || minibuf_level > 0)
1271 Fthrow (Qexit, Qnil);
1273 error ("No recursive edit is in progress");
1274 return Qnil;
1277 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1278 "Abort the command that requested this recursive edit or minibuffer input.")
1281 if (command_loop_level > 0 || minibuf_level > 0)
1282 Fthrow (Qexit, Qt);
1284 error ("No recursive edit is in progress");
1285 return Qnil;
1288 /* This is the actual command reading loop,
1289 sans error-handling encapsulation. */
1291 Lisp_Object Fcommand_execute ();
1292 static int read_key_sequence ();
1293 void safe_run_hooks ();
1294 static void adjust_point_for_property ();
1296 Lisp_Object
1297 command_loop_1 ()
1299 Lisp_Object cmd;
1300 int lose;
1301 int nonundocount;
1302 Lisp_Object keybuf[30];
1303 int i;
1304 int no_direct;
1305 int prev_modiff;
1306 struct buffer *prev_buffer = NULL;
1307 #ifdef MULTI_KBOARD
1308 int was_locked = single_kboard;
1309 #endif
1311 current_kboard->Vprefix_arg = Qnil;
1312 current_kboard->Vlast_prefix_arg = Qnil;
1313 Vdeactivate_mark = Qnil;
1314 waiting_for_input = 0;
1315 cancel_echoing ();
1317 nonundocount = 0;
1318 this_command_key_count = 0;
1319 this_single_command_key_start = 0;
1321 /* Make sure this hook runs after commands that get errors and
1322 throw to top level. */
1323 /* Note that the value cell will never directly contain nil
1324 if the symbol is a local variable. */
1325 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1326 safe_run_hooks (Qpost_command_hook);
1328 /* If displaying a message, resize the echo area window to fit
1329 that message's size exactly. */
1330 if (!NILP (echo_area_buffer[0]))
1331 resize_echo_area_axactly ();
1333 if (!NILP (Vdeferred_action_list))
1334 call0 (Vdeferred_action_function);
1336 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1338 if (NILP (Vunread_command_events)
1339 && NILP (Vunread_input_method_events)
1340 && NILP (Vunread_post_input_method_events)
1341 && NILP (Vexecuting_macro)
1342 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
1343 safe_run_hooks (Qpost_command_idle_hook);
1346 /* Do this after running Vpost_command_hook, for consistency. */
1347 current_kboard->Vlast_command = Vthis_command;
1348 current_kboard->Vreal_last_command = real_this_command;
1350 while (1)
1352 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1353 Fkill_emacs (Qnil);
1355 /* Make sure the current window's buffer is selected. */
1356 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1357 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1359 /* Display any malloc warning that just came out. Use while because
1360 displaying one warning can cause another. */
1362 while (pending_malloc_warning)
1363 display_malloc_warning ();
1365 no_direct = 0;
1367 Vdeactivate_mark = Qnil;
1369 /* If minibuffer on and echo area in use,
1370 wait a short time and redraw minibuffer. */
1372 if (minibuf_level
1373 && !NILP (echo_area_buffer[0])
1374 && EQ (minibuf_window, echo_area_window)
1375 && NUMBERP (Vminibuffer_message_timeout))
1377 /* Bind inhibit-quit to t so that C-g gets read in
1378 rather than quitting back to the minibuffer. */
1379 int count = specpdl_ptr - specpdl;
1380 specbind (Qinhibit_quit, Qt);
1382 Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil);
1383 /* Clear the echo area. */
1384 message2 (0, 0, 0);
1385 safe_run_hooks (Qecho_area_clear_hook);
1387 unbind_to (count, Qnil);
1389 /* If a C-g came in before, treat it as input now. */
1390 if (!NILP (Vquit_flag))
1392 Vquit_flag = Qnil;
1393 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
1397 #ifdef C_ALLOCA
1398 alloca (0); /* Cause a garbage collection now */
1399 /* Since we can free the most stuff here. */
1400 #endif /* C_ALLOCA */
1402 #if 0
1403 /* Select the frame that the last event came from. Usually,
1404 switch-frame events will take care of this, but if some lisp
1405 code swallows a switch-frame event, we'll fix things up here.
1406 Is this a good idea? */
1407 if (FRAMEP (internal_last_event_frame)
1408 && !EQ (internal_last_event_frame, selected_frame))
1409 Fselect_frame (internal_last_event_frame, Qnil);
1410 #endif
1411 /* If it has changed current-menubar from previous value,
1412 really recompute the menubar from the value. */
1413 if (! NILP (Vlucid_menu_bar_dirty_flag)
1414 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
1415 call0 (Qrecompute_lucid_menubar);
1417 before_command_key_count = this_command_key_count;
1418 before_command_echo_length = echo_length ();
1420 Vthis_command = Qnil;
1421 real_this_command = Qnil;
1423 /* Read next key sequence; i gets its length. */
1424 i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
1425 Qnil, 0, 1, 1);
1427 /* A filter may have run while we were reading the input. */
1428 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1429 Fkill_emacs (Qnil);
1430 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1431 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1433 ++num_input_keys;
1435 /* Now we have read a key sequence of length I,
1436 or else I is 0 and we found end of file. */
1438 if (i == 0) /* End of file -- happens only in */
1439 return Qnil; /* a kbd macro, at the end. */
1440 /* -1 means read_key_sequence got a menu that was rejected.
1441 Just loop around and read another command. */
1442 if (i == -1)
1444 cancel_echoing ();
1445 this_command_key_count = 0;
1446 this_single_command_key_start = 0;
1447 goto finalize;
1450 last_command_char = keybuf[i - 1];
1452 /* If the previous command tried to force a specific window-start,
1453 forget about that, in case this command moves point far away
1454 from that position. But also throw away beg_unchanged and
1455 end_unchanged information in that case, so that redisplay will
1456 update the whole window properly. */
1457 if (!NILP (XWINDOW (selected_window)->force_start))
1459 struct buffer *b;
1460 XWINDOW (selected_window)->force_start = Qnil;
1461 b = XBUFFER (XWINDOW (selected_window)->buffer);
1462 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
1465 cmd = read_key_sequence_cmd;
1466 if (!NILP (Vexecuting_macro))
1468 if (!NILP (Vquit_flag))
1470 Vexecuting_macro = Qt;
1471 QUIT; /* Make some noise. */
1472 /* Will return since macro now empty. */
1476 /* Do redisplay processing after this command except in special
1477 cases identified below. */
1478 prev_buffer = current_buffer;
1479 prev_modiff = MODIFF;
1480 last_point_position = PT;
1481 XSETBUFFER (last_point_position_buffer, prev_buffer);
1483 /* By default, we adjust point to a boundary of a region that
1484 has such a property that should be treated intangible
1485 (e.g. composition, display). But, some commands will set
1486 this variable differently. */
1487 Vdisable_point_adjustment = Qnil;
1489 /* Execute the command. */
1491 Vthis_command = cmd;
1492 real_this_command = cmd;
1493 /* Note that the value cell will never directly contain nil
1494 if the symbol is a local variable. */
1495 if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks))
1496 safe_run_hooks (Qpre_command_hook);
1498 if (NILP (Vthis_command))
1500 /* nil means key is undefined. */
1501 bitch_at_user ();
1502 current_kboard->defining_kbd_macro = Qnil;
1503 update_mode_lines = 1;
1504 current_kboard->Vprefix_arg = Qnil;
1506 else
1508 if (NILP (current_kboard->Vprefix_arg) && ! no_direct)
1510 /* In case we jump to directly_done. */
1511 Vcurrent_prefix_arg = current_kboard->Vprefix_arg;
1513 /* Recognize some common commands in common situations and
1514 do them directly. */
1515 if (EQ (Vthis_command, Qforward_char) && PT < ZV)
1517 struct Lisp_Char_Table *dp
1518 = window_display_table (XWINDOW (selected_window));
1519 lose = FETCH_CHAR (PT_BYTE);
1520 SET_PT (PT + 1);
1521 if ((dp
1522 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1523 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1524 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1525 && (lose >= 0x20 && lose < 0x7f)))
1526 : (lose >= 0x20 && lose < 0x7f))
1527 /* To extract the case of continuation on
1528 wide-column characters. */
1529 && (WIDTH_BY_CHAR_HEAD (FETCH_BYTE (PT_BYTE)) == 1)
1530 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1531 >= MODIFF)
1532 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1533 >= OVERLAY_MODIFF)
1534 && (XFASTINT (XWINDOW (selected_window)->last_point)
1535 == PT - 1)
1536 && !windows_or_buffers_changed
1537 && EQ (current_buffer->selective_display, Qnil)
1538 && !detect_input_pending ()
1539 && NILP (XWINDOW (selected_window)->column_number_displayed)
1540 && NILP (Vexecuting_macro))
1541 direct_output_forward_char (1);
1542 goto directly_done;
1544 else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV)
1546 struct Lisp_Char_Table *dp
1547 = window_display_table (XWINDOW (selected_window));
1548 SET_PT (PT - 1);
1549 lose = FETCH_CHAR (PT_BYTE);
1550 if ((dp
1551 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1552 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1553 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1554 && (lose >= 0x20 && lose < 0x7f)))
1555 : (lose >= 0x20 && lose < 0x7f))
1556 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1557 >= MODIFF)
1558 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1559 >= OVERLAY_MODIFF)
1560 && (XFASTINT (XWINDOW (selected_window)->last_point)
1561 == PT + 1)
1562 && !windows_or_buffers_changed
1563 && EQ (current_buffer->selective_display, Qnil)
1564 && !detect_input_pending ()
1565 && NILP (XWINDOW (selected_window)->column_number_displayed)
1566 && NILP (Vexecuting_macro))
1567 direct_output_forward_char (-1);
1568 goto directly_done;
1570 else if (EQ (Vthis_command, Qself_insert_command)
1571 /* Try this optimization only on ascii keystrokes. */
1572 && INTEGERP (last_command_char))
1574 unsigned int c = XINT (last_command_char);
1575 int value;
1576 if (NILP (Vexecuting_macro)
1577 && !EQ (minibuf_window, selected_window))
1579 if (!nonundocount || nonundocount >= 20)
1581 Fundo_boundary ();
1582 nonundocount = 0;
1584 nonundocount++;
1587 lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
1588 < MODIFF)
1589 || (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1590 < OVERLAY_MODIFF)
1591 || (XFASTINT (XWINDOW (selected_window)->last_point)
1592 != PT)
1593 || MODIFF <= SAVE_MODIFF
1594 || windows_or_buffers_changed
1595 || !EQ (current_buffer->selective_display, Qnil)
1596 || detect_input_pending ()
1597 || !NILP (XWINDOW (selected_window)->column_number_displayed)
1598 || !NILP (Vexecuting_macro));
1600 value = internal_self_insert (c, 0);
1602 if (value == 2)
1603 nonundocount = 0;
1605 /* VALUE == 1 when AFTER-CHANGE functions are
1606 installed which is the case most of the time
1607 because FONT-LOCK installs one. */
1608 if (!lose && !value)
1609 direct_output_for_insert (c);
1610 goto directly_done;
1614 /* Here for a command that isn't executed directly */
1616 #ifdef HAVE_X_WINDOWS
1617 if (display_busy_cursor_p)
1618 start_busy_cursor ();
1619 #endif
1621 nonundocount = 0;
1622 if (NILP (current_kboard->Vprefix_arg))
1623 Fundo_boundary ();
1624 Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
1626 #ifdef HAVE_X_WINDOWS
1627 if (display_busy_cursor_p)
1628 cancel_busy_cursor ();
1629 #endif
1631 directly_done: ;
1632 current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg;
1634 /* Note that the value cell will never directly contain nil
1635 if the symbol is a local variable. */
1636 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1637 safe_run_hooks (Qpost_command_hook);
1639 /* If displaying a message, resize the echo area window to fit
1640 that message's size exactly. */
1641 if (!NILP (echo_area_buffer[0]))
1642 resize_echo_area_axactly ();
1644 if (!NILP (Vdeferred_action_list))
1645 safe_run_hooks (Qdeferred_action_function);
1647 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1649 if (NILP (Vunread_command_events)
1650 && NILP (Vunread_input_method_events)
1651 && NILP (Vunread_post_input_method_events)
1652 && NILP (Vexecuting_macro)
1653 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
1654 safe_run_hooks (Qpost_command_idle_hook);
1657 /* If there is a prefix argument,
1658 1) We don't want Vlast_command to be ``universal-argument''
1659 (that would be dumb), so don't set Vlast_command,
1660 2) we want to leave echoing on so that the prefix will be
1661 echoed as part of this key sequence, so don't call
1662 cancel_echoing, and
1663 3) we want to leave this_command_key_count non-zero, so that
1664 read_char will realize that it is re-reading a character, and
1665 not echo it a second time.
1667 If the command didn't actually create a prefix arg,
1668 but is merely a frame event that is transparent to prefix args,
1669 then the above doesn't apply. */
1670 if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_char))
1672 current_kboard->Vlast_command = Vthis_command;
1673 current_kboard->Vreal_last_command = real_this_command;
1674 cancel_echoing ();
1675 this_command_key_count = 0;
1676 this_single_command_key_start = 0;
1679 if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks))
1681 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
1683 current_buffer->mark_active = Qnil;
1684 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
1686 else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1687 call1 (Vrun_hooks, intern ("activate-mark-hook"));
1690 finalize:
1692 if (current_buffer == prev_buffer
1693 && last_point_position != PT
1694 && NILP (Vdisable_point_adjustment)
1695 && NILP (Vglobal_disable_point_adjustment))
1696 adjust_point_for_property (last_point_position);
1698 /* Install chars successfully executed in kbd macro. */
1700 if (!NILP (current_kboard->defining_kbd_macro)
1701 && NILP (current_kboard->Vprefix_arg))
1702 finalize_kbd_macro_chars ();
1704 #ifdef MULTI_KBOARD
1705 if (!was_locked)
1706 any_kboard_state ();
1707 #endif
1711 extern Lisp_Object Qcomposition, Qdisplay;
1713 /* Adjust point to a boundary of a region that has such a property
1714 that should be treated intangible. For the moment, we check
1715 `composition' and `display' property. LAST_PT is the last position
1716 of point. */
1718 static void
1719 adjust_point_for_property (last_pt)
1720 int last_pt;
1722 int start, end;
1723 Lisp_Object val;
1724 int check_composition = 1, check_display = 1;
1726 while (check_composition || check_display)
1728 if (check_composition
1729 && PT > BEGV && PT < ZV
1730 && get_property_and_range (PT, Qcomposition, &val, &start, &end, Qnil)
1731 && COMPOSITION_VALID_P (start, end, val)
1732 && start < PT && end > PT
1733 && (last_pt <= start || last_pt >= end))
1735 if (PT < last_pt)
1736 SET_PT (start);
1737 else
1738 SET_PT (end);
1739 check_display = 1;
1741 check_composition = 0;
1742 if (check_display
1743 && PT > BEGV && PT < ZV
1744 && get_property_and_range (PT, Qdisplay, &val, &start, &end, Qnil)
1745 && display_prop_intangible_p (val)
1746 && start < PT && end > PT
1747 && (last_pt <= start || last_pt >= end))
1749 if (PT < last_pt)
1750 SET_PT (start);
1751 else
1752 SET_PT (end);
1753 check_composition = 1;
1755 check_display = 0;
1759 /* Subroutine for safe_run_hooks: run the hook HOOK. */
1761 static Lisp_Object
1762 safe_run_hooks_1 (hook)
1763 Lisp_Object hook;
1765 return call1 (Vrun_hooks, Vinhibit_quit);
1768 /* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */
1770 static Lisp_Object
1771 safe_run_hooks_error (data)
1772 Lisp_Object data;
1774 return Fset (Vinhibit_quit, Qnil);
1777 /* If we get an error while running the hook, cause the hook variable
1778 to be nil. Also inhibit quits, so that C-g won't cause the hook
1779 to mysteriously evaporate. */
1781 void
1782 safe_run_hooks (hook)
1783 Lisp_Object hook;
1785 int count = specpdl_ptr - specpdl;
1786 specbind (Qinhibit_quit, hook);
1788 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
1790 unbind_to (count, Qnil);
1794 /* Number of seconds between polling for input. This is a Lisp
1795 variable that can be bound. */
1797 int polling_period;
1799 /* Nonzero means polling for input is temporarily suppressed. */
1801 int poll_suppress_count;
1803 /* Asynchronous timer for polling. */
1805 struct atimer *poll_timer;
1808 #ifdef POLL_FOR_INPUT
1810 /* Poll for input, so what we catch a C-g if it comes in. This
1811 function is called from x_make_frame_visible, see comment
1812 there. */
1814 void
1815 poll_for_input_1 ()
1817 if (interrupt_input_blocked == 0
1818 && !waiting_for_input)
1819 read_avail_input (0);
1822 /* Timer callback function for poll_timer. TIMER is equal to
1823 poll_timer. */
1825 void
1826 poll_for_input (timer)
1827 struct atimer *timer;
1829 if (poll_suppress_count == 0)
1830 poll_for_input_1 ();
1833 #endif /* POLL_FOR_INPUT */
1835 /* Begin signals to poll for input, if they are appropriate.
1836 This function is called unconditionally from various places. */
1838 void
1839 start_polling ()
1841 #ifdef POLL_FOR_INPUT
1842 if (read_socket_hook && !interrupt_input)
1844 /* Turn alarm handling on unconditionally. It might have
1845 been turned off in process.c. */
1846 turn_on_atimers (1);
1848 /* If poll timer doesn't exist, are we need one with
1849 a different interval, start a new one. */
1850 if (poll_timer == NULL
1851 || EMACS_SECS (poll_timer->interval) != polling_period)
1853 EMACS_TIME interval;
1855 if (poll_timer)
1856 cancel_atimer (poll_timer);
1858 EMACS_SET_SECS_USECS (interval, polling_period, 0);
1859 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
1860 poll_for_input, NULL);
1863 /* Let the timer's callback function poll for input
1864 if this becomes zero. */
1865 --poll_suppress_count;
1867 #endif
1870 /* Nonzero if we are using polling to handle input asynchronously. */
1873 input_polling_used ()
1875 #ifdef POLL_FOR_INPUT
1876 return read_socket_hook && !interrupt_input;
1877 #else
1878 return 0;
1879 #endif
1882 /* Turn off polling. */
1884 void
1885 stop_polling ()
1887 #ifdef POLL_FOR_INPUT
1888 if (read_socket_hook && !interrupt_input)
1889 ++poll_suppress_count;
1890 #endif
1893 /* Set the value of poll_suppress_count to COUNT
1894 and start or stop polling accordingly. */
1896 void
1897 set_poll_suppress_count (count)
1898 int count;
1900 #ifdef POLL_FOR_INPUT
1901 if (count == 0 && poll_suppress_count != 0)
1903 poll_suppress_count = 1;
1904 start_polling ();
1906 else if (count != 0 && poll_suppress_count == 0)
1908 stop_polling ();
1910 poll_suppress_count = count;
1911 #endif
1914 /* Bind polling_period to a value at least N.
1915 But don't decrease it. */
1917 void
1918 bind_polling_period (n)
1919 int n;
1921 #ifdef POLL_FOR_INPUT
1922 int new = polling_period;
1924 if (n > new)
1925 new = n;
1927 stop_other_atimers (poll_timer);
1928 stop_polling ();
1929 specbind (Qpolling_period, make_number (new));
1930 /* Start a new alarm with the new period. */
1931 start_polling ();
1932 #endif
1935 /* Apply the control modifier to CHARACTER. */
1938 make_ctrl_char (c)
1939 int c;
1941 /* Save the upper bits here. */
1942 int upper = c & ~0177;
1944 c &= 0177;
1946 /* Everything in the columns containing the upper-case letters
1947 denotes a control character. */
1948 if (c >= 0100 && c < 0140)
1950 int oc = c;
1951 c &= ~0140;
1952 /* Set the shift modifier for a control char
1953 made from a shifted letter. But only for letters! */
1954 if (oc >= 'A' && oc <= 'Z')
1955 c |= shift_modifier;
1958 /* The lower-case letters denote control characters too. */
1959 else if (c >= 'a' && c <= 'z')
1960 c &= ~0140;
1962 /* Include the bits for control and shift
1963 only if the basic ASCII code can't indicate them. */
1964 else if (c >= ' ')
1965 c |= ctrl_modifier;
1967 /* Replace the high bits. */
1968 c |= (upper & ~ctrl_modifier);
1970 return c;
1973 /* Display help echo in the echo area.
1975 HELP a string means display that string, HELP nil means clear the
1976 help echo. If HELP is a function, call it with OBJECT and POS as
1977 arguments; the function should return a help string or nil for
1978 none. For all other types of HELP evaluate it to obtain a string.
1980 WINDOW is the window in which the help was generated, if any.
1981 It is nil if not in a window.
1983 If OBJECT is a buffer, POS is the position in the buffer where the
1984 `help-echo' text property was found.
1986 If OBJECT is an overlay, that overlay has a `help-echo' property,
1987 and POS is the position in the overlay's buffer under the mouse.
1989 If OBJECT is a string (an overlay string or a string displayed with
1990 the `display' property). POS is the position in that string under
1991 the mouse.
1993 OK_TO_IVERWRITE_KEYSTROKE_ECHO non-zero means it's okay if the help
1994 echo overwrites a keystroke echo currently displayed in the echo
1995 area.
1997 Note: this function may only be called with HELP nil or a string
1998 from X code running asynchronously. */
2000 void
2001 show_help_echo (help, window, object, pos, ok_to_overwrite_keystroke_echo)
2002 Lisp_Object help, window, object, pos;
2003 int ok_to_overwrite_keystroke_echo;
2005 if (!NILP (help) && !STRINGP (help))
2007 if (FUNCTIONP (help))
2009 Lisp_Object args[4];
2010 args[0] = help;
2011 args[1] = window;
2012 args[2] = object;
2013 args[3] = pos;
2014 help = safe_call (4, args);
2016 else
2017 help = safe_eval (help);
2019 if (!STRINGP (help))
2020 return;
2023 if (STRINGP (help) || NILP (help))
2025 if (!NILP (Vshow_help_function))
2026 call1 (Vshow_help_function, help);
2027 else if (/* Don't overwrite minibuffer contents. */
2028 !MINI_WINDOW_P (XWINDOW (selected_window))
2029 /* Don't overwrite a keystroke echo. */
2030 && (NILP (echo_message_buffer)
2031 || ok_to_overwrite_keystroke_echo)
2032 /* Don't overwrite a prompt. */
2033 && !cursor_in_echo_area)
2035 if (STRINGP (help))
2037 int count = specpdl_ptr - specpdl;
2038 specbind (Qmessage_truncate_lines, Qt);
2039 message3_nolog (help, STRING_BYTES (XSTRING (help)),
2040 STRING_MULTIBYTE (help));
2041 unbind_to (count, Qnil);
2043 else
2044 message (0);
2047 help_echo_showing_p = STRINGP (help);
2053 /* Input of single characters from keyboard */
2055 Lisp_Object print_help ();
2056 static Lisp_Object kbd_buffer_get_event ();
2057 static void record_char ();
2059 #ifdef MULTI_KBOARD
2060 static jmp_buf wrong_kboard_jmpbuf;
2061 #endif
2063 /* read a character from the keyboard; call the redisplay if needed */
2064 /* commandflag 0 means do not do auto-saving, but do do redisplay.
2065 -1 means do not do redisplay, but do do autosaving.
2066 1 means do both. */
2068 /* The arguments MAPS and NMAPS are for menu prompting.
2069 MAPS is an array of keymaps; NMAPS is the length of MAPS.
2071 PREV_EVENT is the previous input event, or nil if we are reading
2072 the first event of a key sequence (or not reading a key sequence).
2073 If PREV_EVENT is t, that is a "magic" value that says
2074 not to run input methods, but in other respects to act as if
2075 not reading a key sequence.
2077 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
2078 if we used a mouse menu to read the input, or zero otherwise. If
2079 USED_MOUSE_MENU is null, we don't dereference it.
2081 Value is t if we showed a menu and the user rejected it. */
2083 Lisp_Object
2084 read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
2085 int commandflag;
2086 int nmaps;
2087 Lisp_Object *maps;
2088 Lisp_Object prev_event;
2089 int *used_mouse_menu;
2091 volatile Lisp_Object c;
2092 int count;
2093 jmp_buf local_getcjmp;
2094 jmp_buf save_jump;
2095 volatile int key_already_recorded = 0;
2096 Lisp_Object tem, save;
2097 volatile Lisp_Object previous_echo_area_message;
2098 volatile Lisp_Object also_record;
2099 volatile int reread;
2100 struct gcpro gcpro1, gcpro2;
2102 also_record = Qnil;
2104 before_command_key_count = this_command_key_count;
2105 before_command_echo_length = echo_length ();
2106 c = Qnil;
2107 previous_echo_area_message = Qnil;
2109 GCPRO2 (c, previous_echo_area_message);
2111 retry:
2113 reread = 0;
2114 if (CONSP (Vunread_post_input_method_events))
2116 c = XCAR (Vunread_post_input_method_events);
2117 Vunread_post_input_method_events
2118 = XCDR (Vunread_post_input_method_events);
2120 /* Undo what read_char_x_menu_prompt did when it unread
2121 additional keys returned by Fx_popup_menu. */
2122 if (CONSP (c)
2123 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2124 && NILP (XCDR (c)))
2125 c = XCAR (c);
2127 reread = 1;
2128 goto reread_first;
2131 if (unread_command_char != -1)
2133 XSETINT (c, unread_command_char);
2134 unread_command_char = -1;
2136 reread = 1;
2137 goto reread_first;
2140 if (CONSP (Vunread_command_events))
2142 c = XCAR (Vunread_command_events);
2143 Vunread_command_events = XCDR (Vunread_command_events);
2145 /* Undo what read_char_x_menu_prompt did when it unread
2146 additional keys returned by Fx_popup_menu. */
2147 if (CONSP (c)
2148 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2149 && NILP (XCDR (c)))
2150 c = XCAR (c);
2152 reread = 1;
2153 goto reread_for_input_method;
2156 if (CONSP (Vunread_input_method_events))
2158 c = XCAR (Vunread_input_method_events);
2159 Vunread_input_method_events = XCDR (Vunread_input_method_events);
2161 /* Undo what read_char_x_menu_prompt did when it unread
2162 additional keys returned by Fx_popup_menu. */
2163 if (CONSP (c)
2164 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2165 && NILP (XCDR (c)))
2166 c = XCAR (c);
2167 reread = 1;
2168 goto reread_for_input_method;
2171 /* If there is no function key translated before
2172 reset-this-command-lengths takes effect, forget about it. */
2173 before_command_restore_flag = 0;
2175 if (!NILP (Vexecuting_macro))
2177 /* We set this to Qmacro; since that's not a frame, nobody will
2178 try to switch frames on us, and the selected window will
2179 remain unchanged.
2181 Since this event came from a macro, it would be misleading to
2182 leave internal_last_event_frame set to wherever the last
2183 real event came from. Normally, a switch-frame event selects
2184 internal_last_event_frame after each command is read, but
2185 events read from a macro should never cause a new frame to be
2186 selected. */
2187 Vlast_event_frame = internal_last_event_frame = Qmacro;
2189 /* Exit the macro if we are at the end.
2190 Also, some things replace the macro with t
2191 to force an early exit. */
2192 if (EQ (Vexecuting_macro, Qt)
2193 || executing_macro_index >= XFASTINT (Flength (Vexecuting_macro)))
2195 XSETINT (c, -1);
2196 RETURN_UNGCPRO (c);
2199 c = Faref (Vexecuting_macro, make_number (executing_macro_index));
2200 if (STRINGP (Vexecuting_macro)
2201 && (XINT (c) & 0x80))
2202 XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
2204 executing_macro_index++;
2206 goto from_macro;
2209 if (!NILP (unread_switch_frame))
2211 c = unread_switch_frame;
2212 unread_switch_frame = Qnil;
2214 /* This event should make it into this_command_keys, and get echoed
2215 again, so we do not set `reread'. */
2216 goto reread_first;
2219 /* if redisplay was requested */
2220 if (commandflag >= 0)
2222 /* If there is pending input, process any events which are not
2223 user-visible, such as X selection_request events. */
2224 if (input_pending
2225 || detect_input_pending_run_timers (0))
2226 swallow_events (0); /* may clear input_pending */
2228 /* Redisplay if no pending input. */
2229 while (!input_pending)
2231 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
2232 redisplay_preserve_echo_area ();
2233 else
2234 redisplay ();
2236 if (!input_pending)
2237 /* Normal case: no input arrived during redisplay. */
2238 break;
2240 /* Input arrived and pre-empted redisplay.
2241 Process any events which are not user-visible. */
2242 swallow_events (0);
2243 /* If that cleared input_pending, try again to redisplay. */
2247 /* Message turns off echoing unless more keystrokes turn it on again.
2249 The code in 20.x for the condition was
2251 1. echo_area_glyphs && *echo_area_glyphs
2252 2. && echo_area_glyphs != current_kboard->echobuf
2253 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2255 (1) means there's a current message displayed
2257 (2) means it's not the message from echoing from the current
2258 kboard.
2260 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2261 is set to a non-null value. This is done in read_char and it is
2262 set to echo_area_glyphs after a call to echo_char. That means
2263 ok_to_echo_at_next_pause is either null or
2264 current_kboard->echobuf with the appropriate current_kboard at
2265 that time.
2267 So, condition (3) means in clear text ok_to_echo_at_next_pause
2268 must be either null, or the current message isn't from echoing at
2269 all, or it's from echoing from a different kboard than the
2270 current one. */
2272 if (/* There currently something in the echo area */
2273 !NILP (echo_area_buffer[0])
2274 && (/* And it's either not from echoing. */
2275 !EQ (echo_area_buffer[0], echo_message_buffer)
2276 /* Or it's an echo from a different kboard. */
2277 || echo_kboard != current_kboard
2278 /* Or we explicitly allow overwriting whatever there is. */
2279 || ok_to_echo_at_next_pause == NULL))
2280 cancel_echoing ();
2281 else
2282 echo_dash ();
2284 /* Try reading a character via menu prompting in the minibuf.
2285 Try this before the sit-for, because the sit-for
2286 would do the wrong thing if we are supposed to do
2287 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2288 after a mouse event so don't try a minibuf menu. */
2289 c = Qnil;
2290 if (nmaps > 0 && INTERACTIVE
2291 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2292 /* Don't bring up a menu if we already have another event. */
2293 && NILP (Vunread_command_events)
2294 && unread_command_char < 0
2295 && !detect_input_pending_run_timers (0))
2297 c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
2298 if (! NILP (c))
2300 key_already_recorded = 1;
2301 goto non_reread_1;
2305 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2306 We will do that below, temporarily for short sections of code,
2307 when appropriate. local_getcjmp must be in effect
2308 around any call to sit_for or kbd_buffer_get_event;
2309 it *must not* be in effect when we call redisplay. */
2311 if (_setjmp (local_getcjmp))
2313 XSETINT (c, quit_char);
2314 internal_last_event_frame = selected_frame;
2315 Vlast_event_frame = internal_last_event_frame;
2316 /* If we report the quit char as an event,
2317 don't do so more than once. */
2318 if (!NILP (Vinhibit_quit))
2319 Vquit_flag = Qnil;
2321 #ifdef MULTI_KBOARD
2323 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
2324 if (kb != current_kboard)
2326 Lisp_Object *tailp = &kb->kbd_queue;
2327 /* We shouldn't get here if we were in single-kboard mode! */
2328 if (single_kboard)
2329 abort ();
2330 while (CONSP (*tailp))
2331 tailp = &XCDR (*tailp);
2332 if (!NILP (*tailp))
2333 abort ();
2334 *tailp = Fcons (c, Qnil);
2335 kb->kbd_queue_has_data = 1;
2336 current_kboard = kb;
2337 /* This is going to exit from read_char
2338 so we had better get rid of this frame's stuff. */
2339 UNGCPRO;
2340 longjmp (wrong_kboard_jmpbuf, 1);
2343 #endif
2344 goto non_reread;
2347 timer_start_idle ();
2349 /* If in middle of key sequence and minibuffer not active,
2350 start echoing if enough time elapses. */
2352 if (minibuf_level == 0
2353 && !current_kboard->immediate_echo
2354 && this_command_key_count > 0
2355 && ! noninteractive
2356 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2357 && NILP (Fzerop (Vecho_keystrokes))
2358 && (/* No message. */
2359 NILP (echo_area_buffer[0])
2360 /* Or empty message. */
2361 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2362 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2363 /* Or already echoing from same kboard. */
2364 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2365 /* Or not echoing before and echoing allowed. */
2366 || (!echo_kboard && ok_to_echo_at_next_pause)))
2368 Lisp_Object tem0;
2370 /* After a mouse event, start echoing right away.
2371 This is because we are probably about to display a menu,
2372 and we don't want to delay before doing so. */
2373 if (EVENT_HAS_PARAMETERS (prev_event))
2374 echo_now ();
2375 else
2377 int sec, usec;
2378 double duration = extract_float (Vecho_keystrokes);
2379 sec = (int) duration;
2380 usec = (duration - sec) * 1000000;
2381 save_getcjmp (save_jump);
2382 restore_getcjmp (local_getcjmp);
2383 tem0 = sit_for (sec, usec, 1, 1, 0);
2384 restore_getcjmp (save_jump);
2385 if (EQ (tem0, Qt)
2386 && ! CONSP (Vunread_command_events))
2387 echo_now ();
2391 /* Maybe auto save due to number of keystrokes. */
2393 if (commandflag != 0
2394 && auto_save_interval > 0
2395 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
2396 && !detect_input_pending_run_timers (0))
2398 Fdo_auto_save (Qnil, Qnil);
2399 /* Hooks can actually change some buffers in auto save. */
2400 redisplay ();
2403 /* Try reading using an X menu.
2404 This is never confused with reading using the minibuf
2405 because the recursive call of read_char in read_char_minibuf_menu_prompt
2406 does not pass on any keymaps. */
2408 if (nmaps > 0 && INTERACTIVE
2409 && !NILP (prev_event)
2410 && EVENT_HAS_PARAMETERS (prev_event)
2411 && !EQ (XCAR (prev_event), Qmenu_bar)
2412 && !EQ (XCAR (prev_event), Qtool_bar)
2413 /* Don't bring up a menu if we already have another event. */
2414 && NILP (Vunread_command_events)
2415 && unread_command_char < 0)
2417 c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
2419 /* Now that we have read an event, Emacs is not idle. */
2420 timer_stop_idle ();
2422 RETURN_UNGCPRO (c);
2425 /* Maybe autosave and/or garbage collect due to idleness. */
2427 if (INTERACTIVE && NILP (c))
2429 int delay_level, buffer_size;
2431 /* Slow down auto saves logarithmically in size of current buffer,
2432 and garbage collect while we're at it. */
2433 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2434 last_non_minibuf_size = Z - BEG;
2435 buffer_size = (last_non_minibuf_size >> 8) + 1;
2436 delay_level = 0;
2437 while (buffer_size > 64)
2438 delay_level++, buffer_size -= buffer_size >> 2;
2439 if (delay_level < 4) delay_level = 4;
2440 /* delay_level is 4 for files under around 50k, 7 at 100k,
2441 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2443 /* Auto save if enough time goes by without input. */
2444 if (commandflag != 0
2445 && num_nonmacro_input_events > last_auto_save
2446 && INTEGERP (Vauto_save_timeout)
2447 && XINT (Vauto_save_timeout) > 0)
2449 Lisp_Object tem0;
2451 save_getcjmp (save_jump);
2452 restore_getcjmp (local_getcjmp);
2453 tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4,
2454 0, 1, 1, 0);
2455 restore_getcjmp (save_jump);
2457 if (EQ (tem0, Qt)
2458 && ! CONSP (Vunread_command_events))
2460 Fdo_auto_save (Qnil, Qnil);
2462 /* If we have auto-saved and there is still no input
2463 available, garbage collect if there has been enough
2464 consing going on to make it worthwhile. */
2465 if (!detect_input_pending_run_timers (0)
2466 && consing_since_gc > gc_cons_threshold / 2)
2467 Fgarbage_collect ();
2469 redisplay ();
2474 /* If this has become non-nil here, it has been set by a timer
2475 or sentinel or filter. */
2476 if (CONSP (Vunread_command_events))
2478 c = XCAR (Vunread_command_events);
2479 Vunread_command_events = XCDR (Vunread_command_events);
2482 /* Read something from current KBOARD's side queue, if possible. */
2484 if (NILP (c))
2486 if (current_kboard->kbd_queue_has_data)
2488 if (!CONSP (current_kboard->kbd_queue))
2489 abort ();
2490 c = XCAR (current_kboard->kbd_queue);
2491 current_kboard->kbd_queue
2492 = XCDR (current_kboard->kbd_queue);
2493 if (NILP (current_kboard->kbd_queue))
2494 current_kboard->kbd_queue_has_data = 0;
2495 input_pending = readable_events (0);
2496 if (EVENT_HAS_PARAMETERS (c)
2497 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
2498 internal_last_event_frame = XCAR (XCDR (c));
2499 Vlast_event_frame = internal_last_event_frame;
2503 #ifdef MULTI_KBOARD
2504 /* If current_kboard's side queue is empty check the other kboards.
2505 If one of them has data that we have not yet seen here,
2506 switch to it and process the data waiting for it.
2508 Note: if the events queued up for another kboard
2509 have already been seen here, and therefore are not a complete command,
2510 the kbd_queue_has_data field is 0, so we skip that kboard here.
2511 That's to avoid an infinite loop switching between kboards here. */
2512 if (NILP (c) && !single_kboard)
2514 KBOARD *kb;
2515 for (kb = all_kboards; kb; kb = kb->next_kboard)
2516 if (kb->kbd_queue_has_data)
2518 current_kboard = kb;
2519 /* This is going to exit from read_char
2520 so we had better get rid of this frame's stuff. */
2521 UNGCPRO;
2522 longjmp (wrong_kboard_jmpbuf, 1);
2525 #endif
2527 wrong_kboard:
2529 stop_polling ();
2531 /* Finally, we read from the main queue,
2532 and if that gives us something we can't use yet, we put it on the
2533 appropriate side queue and try again. */
2535 if (NILP (c))
2537 KBOARD *kb;
2539 /* Actually read a character, waiting if necessary. */
2540 save_getcjmp (save_jump);
2541 restore_getcjmp (local_getcjmp);
2542 timer_start_idle ();
2543 c = kbd_buffer_get_event (&kb, used_mouse_menu);
2544 restore_getcjmp (save_jump);
2546 #ifdef MULTI_KBOARD
2547 if (! NILP (c) && (kb != current_kboard))
2549 Lisp_Object *tailp = &kb->kbd_queue;
2550 while (CONSP (*tailp))
2551 tailp = &XCDR (*tailp);
2552 if (!NILP (*tailp))
2553 abort ();
2554 *tailp = Fcons (c, Qnil);
2555 kb->kbd_queue_has_data = 1;
2556 c = Qnil;
2557 if (single_kboard)
2558 goto wrong_kboard;
2559 current_kboard = kb;
2560 /* This is going to exit from read_char
2561 so we had better get rid of this frame's stuff. */
2562 UNGCPRO;
2563 longjmp (wrong_kboard_jmpbuf, 1);
2565 #endif
2568 /* Terminate Emacs in batch mode if at eof. */
2569 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
2570 Fkill_emacs (make_number (1));
2572 if (INTEGERP (c))
2574 /* Add in any extra modifiers, where appropriate. */
2575 if ((extra_keyboard_modifiers & CHAR_CTL)
2576 || ((extra_keyboard_modifiers & 0177) < ' '
2577 && (extra_keyboard_modifiers & 0177) != 0))
2578 XSETINT (c, make_ctrl_char (XINT (c)));
2580 /* Transfer any other modifier bits directly from
2581 extra_keyboard_modifiers to c. Ignore the actual character code
2582 in the low 16 bits of extra_keyboard_modifiers. */
2583 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
2586 non_reread:
2588 timer_stop_idle ();
2589 start_polling ();
2591 if (NILP (c))
2593 if (commandflag >= 0
2594 && !input_pending && !detect_input_pending_run_timers (0))
2595 redisplay ();
2597 goto wrong_kboard;
2600 non_reread_1:
2602 /* Buffer switch events are only for internal wakeups
2603 so don't show them to the user.
2604 Also, don't record a key if we already did. */
2605 if (BUFFERP (c) || key_already_recorded)
2606 RETURN_UNGCPRO (c);
2608 /* Process special events within read_char
2609 and loop around to read another event. */
2610 save = Vquit_flag;
2611 Vquit_flag = Qnil;
2612 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
2613 Vquit_flag = save;
2615 if (!NILP (tem))
2617 int was_locked = single_kboard;
2619 last_input_char = c;
2620 Fcommand_execute (tem, Qnil, Fvector (1, &last_input_char), Qt);
2622 /* Resume allowing input from any kboard, if that was true before. */
2623 if (!was_locked)
2624 any_kboard_state ();
2626 goto retry;
2629 /* Handle things that only apply to characters. */
2630 if (INTEGERP (c))
2632 /* If kbd_buffer_get_event gave us an EOF, return that. */
2633 if (XINT (c) == -1)
2634 RETURN_UNGCPRO (c);
2636 if ((STRINGP (Vkeyboard_translate_table)
2637 && XSTRING (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
2638 || (VECTORP (Vkeyboard_translate_table)
2639 && XVECTOR (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
2640 || (CHAR_TABLE_P (Vkeyboard_translate_table)
2641 && CHAR_TABLE_ORDINARY_SLOTS > (unsigned) XFASTINT (c)))
2643 Lisp_Object d;
2644 d = Faref (Vkeyboard_translate_table, c);
2645 /* nil in keyboard-translate-table means no translation. */
2646 if (!NILP (d))
2647 c = d;
2651 /* If this event is a mouse click in the menu bar,
2652 return just menu-bar for now. Modify the mouse click event
2653 so we won't do this twice, then queue it up. */
2654 if (EVENT_HAS_PARAMETERS (c)
2655 && CONSP (XCDR (c))
2656 && CONSP (EVENT_START (c))
2657 && CONSP (XCDR (EVENT_START (c))))
2659 Lisp_Object posn;
2661 posn = POSN_BUFFER_POSN (EVENT_START (c));
2662 /* Handle menu-bar events:
2663 insert the dummy prefix event `menu-bar'. */
2664 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
2666 /* Change menu-bar to (menu-bar) as the event "position". */
2667 POSN_BUFFER_POSN (EVENT_START (c)) = Fcons (posn, Qnil);
2669 also_record = c;
2670 Vunread_command_events = Fcons (c, Vunread_command_events);
2671 c = posn;
2675 /* Store these characters into recent_keys, the dribble file if any,
2676 and the keyboard macro being defined, if any. */
2677 record_char (c);
2678 if (! NILP (also_record))
2679 record_char (also_record);
2681 /* Wipe the echo area.
2682 But first, if we are about to use an input method,
2683 save the echo area contents for it to refer to. */
2684 if (INTEGERP (c)
2685 && ! NILP (Vinput_method_function)
2686 && (unsigned) XINT (c) >= ' '
2687 && (unsigned) XINT (c) != 127
2688 && (unsigned) XINT (c) < 256)
2690 previous_echo_area_message = Fcurrent_message ();
2691 Vinput_method_previous_message = previous_echo_area_message;
2694 /* Now wipe the echo area, except for help events which do their
2695 own stuff with the echo area. */
2696 if (!CONSP (c) || !(EQ (Qhelp_echo, XCAR (c))))
2698 if (!NILP (echo_area_buffer[0]))
2699 safe_run_hooks (Qecho_area_clear_hook);
2700 clear_message (1, 0);
2703 reread_for_input_method:
2704 from_macro:
2705 /* Pass this to the input method, if appropriate. */
2706 if (INTEGERP (c)
2707 && ! NILP (Vinput_method_function)
2708 /* Don't run the input method within a key sequence,
2709 after the first event of the key sequence. */
2710 && NILP (prev_event)
2711 && (unsigned) XINT (c) >= ' '
2712 && (unsigned) XINT (c) != 127
2713 && (unsigned) XINT (c) < 256)
2715 Lisp_Object keys;
2716 int key_count;
2717 struct gcpro gcpro1;
2718 int count = specpdl_ptr - specpdl;
2720 /* Save the echo status. */
2721 int saved_immediate_echo = current_kboard->immediate_echo;
2722 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
2723 int saved_echo_after_prompt = current_kboard->echo_after_prompt;
2725 if (before_command_restore_flag)
2727 this_command_key_count = before_command_key_count_1;
2728 if (this_command_key_count < this_single_command_key_start)
2729 this_single_command_key_start = this_command_key_count;
2730 echo_truncate (before_command_echo_length_1);
2731 before_command_restore_flag = 0;
2734 /* Save the this_command_keys status. */
2735 key_count = this_command_key_count;
2737 if (key_count > 0)
2738 keys = Fcopy_sequence (this_command_keys);
2739 else
2740 keys = Qnil;
2741 GCPRO1 (keys);
2743 /* Clear out this_command_keys. */
2744 this_command_key_count = 0;
2746 /* Now wipe the echo area. */
2747 if (!NILP (echo_area_buffer[0]))
2748 safe_run_hooks (Qecho_area_clear_hook);
2749 clear_message (1, 0);
2750 echo_truncate (0);
2752 /* If we are not reading a key sequence,
2753 never use the echo area. */
2754 if (maps == 0)
2756 specbind (Qinput_method_use_echo_area, Qt);
2759 /* Call the input method. */
2760 tem = call1 (Vinput_method_function, c);
2762 tem = unbind_to (count, tem);
2764 /* Restore the saved echoing state
2765 and this_command_keys state. */
2766 this_command_key_count = key_count;
2767 if (key_count > 0)
2768 this_command_keys = keys;
2770 cancel_echoing ();
2771 ok_to_echo_at_next_pause = saved_ok_to_echo;
2772 current_kboard->echo_after_prompt = saved_echo_after_prompt;
2773 if (saved_immediate_echo)
2774 echo_now ();
2776 UNGCPRO;
2778 /* The input method can return no events. */
2779 if (! CONSP (tem))
2781 /* Bring back the previous message, if any. */
2782 if (! NILP (previous_echo_area_message))
2783 message_with_string ("%s", previous_echo_area_message, 0);
2784 goto retry;
2786 /* It returned one event or more. */
2787 c = XCAR (tem);
2788 Vunread_post_input_method_events
2789 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
2792 reread_first:
2794 /* Display help if not echoing. */
2795 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
2797 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
2798 Lisp_Object help, object, position, window;
2799 help = Fnth (make_number (2), c);
2800 window = Fnth (make_number (3), c);
2801 object = Fnth (make_number (4), c);
2802 position = Fnth (make_number (5), c);
2803 show_help_echo (help, window, object, position, 0);
2804 goto retry;
2807 if (this_command_key_count == 0 || ! reread)
2809 before_command_key_count = this_command_key_count;
2810 before_command_echo_length = echo_length ();
2812 /* Don't echo mouse motion events. */
2813 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2814 && NILP (Fzerop (Vecho_keystrokes))
2815 && ! (EVENT_HAS_PARAMETERS (c)
2816 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
2818 echo_char (c);
2819 if (! NILP (also_record))
2820 echo_char (also_record);
2821 /* Once we reread a character, echoing can happen
2822 the next time we pause to read a new one. */
2823 ok_to_echo_at_next_pause = current_kboard;
2826 /* Record this character as part of the current key. */
2827 add_command_key (c);
2828 if (! NILP (also_record))
2829 add_command_key (also_record);
2832 last_input_char = c;
2833 num_input_events++;
2835 /* Process the help character specially if enabled */
2836 if (!NILP (Vhelp_form) && help_char_p (c))
2838 Lisp_Object tem0;
2839 count = specpdl_ptr - specpdl;
2841 record_unwind_protect (Fset_window_configuration,
2842 Fcurrent_window_configuration (Qnil));
2844 tem0 = Feval (Vhelp_form);
2845 if (STRINGP (tem0))
2846 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
2848 cancel_echoing ();
2850 c = read_char (0, 0, 0, Qnil, 0);
2851 while (BUFFERP (c));
2852 /* Remove the help from the frame */
2853 unbind_to (count, Qnil);
2855 redisplay ();
2856 if (EQ (c, make_number (040)))
2858 cancel_echoing ();
2860 c = read_char (0, 0, 0, Qnil, 0);
2861 while (BUFFERP (c));
2865 RETURN_UNGCPRO (c);
2868 /* Record a key that came from a mouse menu.
2869 Record it for echoing, for this-command-keys, and so on. */
2871 static void
2872 record_menu_key (c)
2873 Lisp_Object c;
2875 /* Wipe the echo area. */
2876 clear_message (1, 0);
2878 record_char (c);
2880 before_command_key_count = this_command_key_count;
2881 before_command_echo_length = echo_length ();
2883 /* Don't echo mouse motion events. */
2884 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2885 && NILP (Fzerop (Vecho_keystrokes)))
2887 echo_char (c);
2889 /* Once we reread a character, echoing can happen
2890 the next time we pause to read a new one. */
2891 ok_to_echo_at_next_pause = 0;
2894 /* Record this character as part of the current key. */
2895 add_command_key (c);
2897 /* Re-reading in the middle of a command */
2898 last_input_char = c;
2899 num_input_events++;
2902 /* Return 1 if should recognize C as "the help character". */
2905 help_char_p (c)
2906 Lisp_Object c;
2908 Lisp_Object tail;
2910 if (EQ (c, Vhelp_char))
2911 return 1;
2912 for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
2913 if (EQ (c, XCAR (tail)))
2914 return 1;
2915 return 0;
2918 /* Record the input event C in various ways. */
2920 static void
2921 record_char (c)
2922 Lisp_Object c;
2924 Lisp_Object help;
2926 /* Don't record `help-echo' in recent_keys unless it shows some help
2927 message, and a different help than the previoiusly recorded
2928 event. */
2929 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
2931 Lisp_Object help;
2933 help = Fnth (make_number (2), c);
2934 if (STRINGP (help))
2936 int last_idx;
2937 Lisp_Object last_c, last_help;
2939 last_idx = recent_keys_index - 1;
2940 if (last_idx < 0)
2941 last_idx = NUM_RECENT_KEYS - 1;
2942 last_c = AREF (recent_keys, last_idx);
2944 if (!CONSP (last_c)
2945 || !EQ (XCAR (last_c), Qhelp_echo)
2946 || (last_help = Fnth (make_number (2), last_c),
2947 !EQ (last_help, help)))
2949 total_keys++;
2950 ASET (recent_keys, recent_keys_index, c);
2951 if (++recent_keys_index >= NUM_RECENT_KEYS)
2952 recent_keys_index = 0;
2956 else
2958 total_keys++;
2959 ASET (recent_keys, recent_keys_index, c);
2960 if (++recent_keys_index >= NUM_RECENT_KEYS)
2961 recent_keys_index = 0;
2964 /* Write c to the dribble file. If c is a lispy event, write
2965 the event's symbol to the dribble file, in <brackets>. Bleaugh.
2966 If you, dear reader, have a better idea, you've got the source. :-) */
2967 if (dribble)
2969 if (INTEGERP (c))
2971 if (XUINT (c) < 0x100)
2972 putc (XINT (c), dribble);
2973 else
2974 fprintf (dribble, " 0x%x", (int) XUINT (c));
2976 else
2978 Lisp_Object dribblee;
2980 /* If it's a structured event, take the event header. */
2981 dribblee = EVENT_HEAD (c);
2983 if (SYMBOLP (dribblee))
2985 putc ('<', dribble);
2986 fwrite (XSYMBOL (dribblee)->name->data, sizeof (char),
2987 STRING_BYTES (XSYMBOL (dribblee)->name),
2988 dribble);
2989 putc ('>', dribble);
2993 fflush (dribble);
2996 if (!CONSP (c) || !EQ (Qhelp_echo, XCAR (c)))
2997 store_kbd_macro_char (c);
2999 num_nonmacro_input_events++;
3002 Lisp_Object
3003 print_help (object)
3004 Lisp_Object object;
3006 struct buffer *old = current_buffer;
3007 Fprinc (object, Qnil);
3008 set_buffer_internal (XBUFFER (Vstandard_output));
3009 call0 (intern ("help-mode"));
3010 set_buffer_internal (old);
3011 return Qnil;
3014 /* Copy out or in the info on where C-g should throw to.
3015 This is used when running Lisp code from within get_char,
3016 in case get_char is called recursively.
3017 See read_process_output. */
3019 static void
3020 save_getcjmp (temp)
3021 jmp_buf temp;
3023 bcopy (getcjmp, temp, sizeof getcjmp);
3026 static void
3027 restore_getcjmp (temp)
3028 jmp_buf temp;
3030 bcopy (temp, getcjmp, sizeof getcjmp);
3033 #ifdef HAVE_MOUSE
3035 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
3036 of this function. */
3038 static Lisp_Object
3039 tracking_off (old_value)
3040 Lisp_Object old_value;
3042 do_mouse_tracking = old_value;
3043 if (NILP (old_value))
3045 /* Redisplay may have been preempted because there was input
3046 available, and it assumes it will be called again after the
3047 input has been processed. If the only input available was
3048 the sort that we have just disabled, then we need to call
3049 redisplay. */
3050 if (!readable_events (1))
3052 redisplay_preserve_echo_area ();
3053 get_input_pending (&input_pending, 1);
3056 return Qnil;
3059 DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
3060 "Evaluate BODY with mouse movement events enabled.\n\
3061 Within a `track-mouse' form, mouse motion generates input events that\n\
3062 you can read with `read-event'.\n\
3063 Normally, mouse motion is ignored.")
3064 (args)
3065 Lisp_Object args;
3067 int count = specpdl_ptr - specpdl;
3068 Lisp_Object val;
3070 record_unwind_protect (tracking_off, do_mouse_tracking);
3072 do_mouse_tracking = Qt;
3074 val = Fprogn (args);
3075 return unbind_to (count, val);
3078 /* If mouse has moved on some frame, return one of those frames.
3079 Return 0 otherwise. */
3081 static FRAME_PTR
3082 some_mouse_moved ()
3084 Lisp_Object tail, frame;
3086 FOR_EACH_FRAME (tail, frame)
3088 if (XFRAME (frame)->mouse_moved)
3089 return XFRAME (frame);
3092 return 0;
3095 #endif /* HAVE_MOUSE */
3097 /* Low level keyboard/mouse input.
3098 kbd_buffer_store_event places events in kbd_buffer, and
3099 kbd_buffer_get_event retrieves them. */
3101 /* Return true iff there are any events in the queue that read-char
3102 would return. If this returns false, a read-char would block. */
3103 static int
3104 readable_events (do_timers_now)
3105 int do_timers_now;
3107 if (do_timers_now)
3108 timer_check (do_timers_now);
3110 if (kbd_fetch_ptr != kbd_store_ptr)
3111 return 1;
3112 #ifdef HAVE_MOUSE
3113 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3114 return 1;
3115 #endif
3116 if (single_kboard)
3118 if (current_kboard->kbd_queue_has_data)
3119 return 1;
3121 else
3123 KBOARD *kb;
3124 for (kb = all_kboards; kb; kb = kb->next_kboard)
3125 if (kb->kbd_queue_has_data)
3126 return 1;
3128 return 0;
3131 /* Set this for debugging, to have a way to get out */
3132 int stop_character;
3134 #ifdef MULTI_KBOARD
3135 static KBOARD *
3136 event_to_kboard (event)
3137 struct input_event *event;
3139 Lisp_Object frame;
3140 frame = event->frame_or_window;
3141 if (CONSP (frame))
3142 frame = XCAR (frame);
3143 else if (WINDOWP (frame))
3144 frame = WINDOW_FRAME (XWINDOW (frame));
3146 /* There are still some events that don't set this field.
3147 For now, just ignore the problem.
3148 Also ignore dead frames here. */
3149 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
3150 return 0;
3151 else
3152 return FRAME_KBOARD (XFRAME (frame));
3154 #endif
3156 /* Store an event obtained at interrupt level into kbd_buffer, fifo */
3158 void
3159 kbd_buffer_store_event (event)
3160 register struct input_event *event;
3162 if (event->kind == no_event)
3163 abort ();
3165 if (event->kind == ascii_keystroke)
3167 register int c = event->code & 0377;
3169 if (event->modifiers & ctrl_modifier)
3170 c = make_ctrl_char (c);
3172 c |= (event->modifiers
3173 & (meta_modifier | alt_modifier
3174 | hyper_modifier | super_modifier));
3176 if (c == quit_char)
3178 extern SIGTYPE interrupt_signal ();
3179 #ifdef MULTI_KBOARD
3180 KBOARD *kb;
3181 struct input_event *sp;
3183 if (single_kboard
3184 && (kb = FRAME_KBOARD (XFRAME (event->frame_or_window)),
3185 kb != current_kboard))
3187 kb->kbd_queue
3188 = Fcons (make_lispy_switch_frame (event->frame_or_window),
3189 Fcons (make_number (c), Qnil));
3190 kb->kbd_queue_has_data = 1;
3191 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3193 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3194 sp = kbd_buffer;
3196 if (event_to_kboard (sp) == kb)
3198 sp->kind = no_event;
3199 sp->frame_or_window = Qnil;
3200 sp->arg = Qnil;
3203 return;
3205 #endif
3207 /* If this results in a quit_char being returned to Emacs as
3208 input, set Vlast_event_frame properly. If this doesn't
3209 get returned to Emacs as an event, the next event read
3210 will set Vlast_event_frame again, so this is safe to do. */
3212 Lisp_Object focus;
3214 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
3215 if (NILP (focus))
3216 focus = event->frame_or_window;
3217 internal_last_event_frame = focus;
3218 Vlast_event_frame = focus;
3221 last_event_timestamp = event->timestamp;
3222 interrupt_signal ();
3223 return;
3226 if (c && c == stop_character)
3228 sys_suspend ();
3229 return;
3232 /* Don't insert two buffer_switch_event's in a row.
3233 Just ignore the second one. */
3234 else if (event->kind == buffer_switch_event
3235 && kbd_fetch_ptr != kbd_store_ptr
3236 && kbd_store_ptr->kind == buffer_switch_event)
3237 return;
3239 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
3240 kbd_store_ptr = kbd_buffer;
3242 /* Don't let the very last slot in the buffer become full,
3243 since that would make the two pointers equal,
3244 and that is indistinguishable from an empty buffer.
3245 Discard the event if it would fill the last slot. */
3246 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3248 int idx;
3250 #if 0 /* The selection_request_event case looks bogus, and it's error
3251 prone to assign individual members for other events, in case
3252 the input_event structure is changed. --2000-07-13, gerd. */
3253 struct input_event *sp = kbd_store_ptr;
3254 sp->kind = event->kind;
3255 if (event->kind == selection_request_event)
3257 /* We must not use the ordinary copying code for this case,
3258 since `part' is an enum and copying it might not copy enough
3259 in this case. */
3260 bcopy (event, (char *) sp, sizeof (*event));
3262 else
3265 sp->code = event->code;
3266 sp->part = event->part;
3267 sp->frame_or_window = event->frame_or_window;
3268 sp->arg = event->arg;
3269 sp->modifiers = event->modifiers;
3270 sp->x = event->x;
3271 sp->y = event->y;
3272 sp->timestamp = event->timestamp;
3274 #else
3275 *kbd_store_ptr = *event;
3276 #endif
3278 idx = 2 * (kbd_store_ptr - kbd_buffer);
3279 ASET (kbd_buffer_gcpro, idx, event->frame_or_window);
3280 ASET (kbd_buffer_gcpro, idx + 1, event->arg);
3281 ++kbd_store_ptr;
3286 /* Generate HELP_EVENT input_events in BUFP which has room for
3287 SIZE events. If there's not enough room in BUFP, ignore this
3288 event.
3290 HELP is the help form.
3292 FRAME is the frame on which the help is generated. OBJECT is the
3293 Lisp object where the help was found (a buffer, a string, an
3294 overlay, or nil if neither from a string nor from a buffer. POS is
3295 the position within OBJECT where the help was found.
3297 Value is the number of input_events generated. */
3300 gen_help_event (bufp, size, help, frame, window, object, pos)
3301 struct input_event *bufp;
3302 int size;
3303 Lisp_Object help, frame, object, window;
3304 int pos;
3306 int nevents_stored = 0;
3308 if (size >= 2)
3310 bufp->kind = HELP_EVENT;
3311 bufp->frame_or_window = frame;
3312 bufp->arg = object;
3313 bufp->x = make_number (pos);
3314 bufp->code = 0;
3316 ++bufp;
3317 bufp->kind = HELP_EVENT;
3318 bufp->frame_or_window = WINDOWP (window) ? window : frame;
3319 bufp->arg = help;
3320 bufp->code = 1;
3321 nevents_stored = 2;
3324 return nevents_stored;
3328 /* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3330 void
3331 kbd_buffer_store_help_event (frame, help)
3332 Lisp_Object frame, help;
3334 struct input_event event;
3336 event.kind = HELP_EVENT;
3337 event.frame_or_window = frame;
3338 event.arg = Qnil;
3339 event.x = make_number (0);
3340 event.code = 0;
3341 kbd_buffer_store_event (&event);
3343 event.kind = HELP_EVENT;
3344 event.frame_or_window = frame;
3345 event.arg = help;
3346 event.x = make_number (0);
3347 event.code = 1;
3348 kbd_buffer_store_event (&event);
3352 /* Discard any mouse events in the event buffer by setting them to
3353 no_event. */
3354 void
3355 discard_mouse_events ()
3357 struct input_event *sp;
3358 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3360 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3361 sp = kbd_buffer;
3363 if (sp->kind == mouse_click
3364 #ifdef WINDOWSNT
3365 || sp->kind == w32_scroll_bar_click
3366 #endif
3367 || sp->kind == scroll_bar_click)
3369 sp->kind = no_event;
3375 /* Return non-zero if there are any real events waiting in the event
3376 buffer, not counting `no_event's.
3378 If DISCARD is non-zero, discard no_event events at the front of
3379 the input queue, possibly leaving the input queue empty if there
3380 are no real input events. */
3383 kbd_buffer_events_waiting (discard)
3384 int discard;
3386 struct input_event *sp;
3388 for (sp = kbd_fetch_ptr;
3389 sp != kbd_store_ptr && sp->kind == no_event;
3390 ++sp)
3392 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3393 sp = kbd_buffer;
3396 if (discard)
3397 kbd_fetch_ptr = sp;
3399 return sp != kbd_store_ptr && sp->kind != no_event;
3403 /* Clear input event EVENT. */
3405 static INLINE void
3406 clear_event (event)
3407 struct input_event *event;
3409 int idx = 2 * (event - kbd_buffer);
3410 ASET (kbd_buffer_gcpro, idx, Qnil);
3411 ASET (kbd_buffer_gcpro, idx + 1, Qnil);
3412 event->kind = no_event;
3416 /* Read one event from the event buffer, waiting if necessary.
3417 The value is a Lisp object representing the event.
3418 The value is nil for an event that should be ignored,
3419 or that was handled here.
3420 We always read and discard one event. */
3422 static Lisp_Object
3423 kbd_buffer_get_event (kbp, used_mouse_menu)
3424 KBOARD **kbp;
3425 int *used_mouse_menu;
3427 register int c;
3428 Lisp_Object obj;
3430 if (noninteractive)
3432 c = getchar ();
3433 XSETINT (obj, c);
3434 *kbp = current_kboard;
3435 return obj;
3438 /* Wait until there is input available. */
3439 for (;;)
3441 if (kbd_fetch_ptr != kbd_store_ptr)
3442 break;
3443 #ifdef HAVE_MOUSE
3444 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3445 break;
3446 #endif
3448 /* If the quit flag is set, then read_char will return
3449 quit_char, so that counts as "available input." */
3450 if (!NILP (Vquit_flag))
3451 quit_throw_to_read_char ();
3453 /* One way or another, wait until input is available; then, if
3454 interrupt handlers have not read it, read it now. */
3456 #ifdef OLDVMS
3457 wait_for_kbd_input ();
3458 #else
3459 /* Note SIGIO has been undef'd if FIONREAD is missing. */
3460 #ifdef SIGIO
3461 gobble_input (0);
3462 #endif /* SIGIO */
3463 if (kbd_fetch_ptr != kbd_store_ptr)
3464 break;
3465 #ifdef HAVE_MOUSE
3466 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3467 break;
3468 #endif
3470 Lisp_Object minus_one;
3472 XSETINT (minus_one, -1);
3473 wait_reading_process_input (0, 0, minus_one, 1);
3475 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
3476 /* Pass 1 for EXPECT since we just waited to have input. */
3477 read_avail_input (1);
3479 #endif /* not VMS */
3482 if (CONSP (Vunread_command_events))
3484 Lisp_Object first;
3485 first = XCAR (Vunread_command_events);
3486 Vunread_command_events = XCDR (Vunread_command_events);
3487 *kbp = current_kboard;
3488 return first;
3491 /* At this point, we know that there is a readable event available
3492 somewhere. If the event queue is empty, then there must be a
3493 mouse movement enabled and available. */
3494 if (kbd_fetch_ptr != kbd_store_ptr)
3496 struct input_event *event;
3498 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3499 ? kbd_fetch_ptr
3500 : kbd_buffer);
3502 last_event_timestamp = event->timestamp;
3504 #ifdef MULTI_KBOARD
3505 *kbp = event_to_kboard (event);
3506 if (*kbp == 0)
3507 *kbp = current_kboard; /* Better than returning null ptr? */
3508 #else
3509 *kbp = &the_only_kboard;
3510 #endif
3512 obj = Qnil;
3514 /* These two kinds of events get special handling
3515 and don't actually appear to the command loop.
3516 We return nil for them. */
3517 if (event->kind == selection_request_event)
3519 #ifdef HAVE_X11
3520 struct input_event copy;
3522 /* Remove it from the buffer before processing it,
3523 since otherwise swallow_events will see it
3524 and process it again. */
3525 copy = *event;
3526 kbd_fetch_ptr = event + 1;
3527 input_pending = readable_events (0);
3528 x_handle_selection_request (&copy);
3529 #else
3530 /* We're getting selection request events, but we don't have
3531 a window system. */
3532 abort ();
3533 #endif
3536 else if (event->kind == selection_clear_event)
3538 #ifdef HAVE_X11
3539 struct input_event copy;
3541 /* Remove it from the buffer before processing it. */
3542 copy = *event;
3543 kbd_fetch_ptr = event + 1;
3544 input_pending = readable_events (0);
3545 x_handle_selection_clear (&copy);
3546 #else
3547 /* We're getting selection request events, but we don't have
3548 a window system. */
3549 abort ();
3550 #endif
3552 #if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (macintosh)
3553 else if (event->kind == delete_window_event)
3555 /* Make an event (delete-frame (FRAME)). */
3556 obj = Fcons (event->frame_or_window, Qnil);
3557 obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
3558 kbd_fetch_ptr = event + 1;
3560 #endif
3561 #if defined (HAVE_X11) || defined (HAVE_NTGUI)
3562 else if (event->kind == iconify_event)
3564 /* Make an event (iconify-frame (FRAME)). */
3565 obj = Fcons (event->frame_or_window, Qnil);
3566 obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
3567 kbd_fetch_ptr = event + 1;
3569 else if (event->kind == deiconify_event)
3571 /* Make an event (make-frame-visible (FRAME)). */
3572 obj = Fcons (event->frame_or_window, Qnil);
3573 obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
3574 kbd_fetch_ptr = event + 1;
3576 #endif
3577 else if (event->kind == buffer_switch_event)
3579 /* The value doesn't matter here; only the type is tested. */
3580 XSETBUFFER (obj, current_buffer);
3581 kbd_fetch_ptr = event + 1;
3583 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
3584 else if (event->kind == menu_bar_activate_event)
3586 kbd_fetch_ptr = event + 1;
3587 input_pending = readable_events (0);
3588 if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
3589 x_activate_menubar (XFRAME (event->frame_or_window));
3591 #endif
3592 #ifdef WINDOWSNT
3593 else if (event->kind == language_change_event)
3595 /* Make an event (language-change (FRAME CHARSET LCID)). */
3596 obj = Fcons (event->modifiers, Qnil);
3597 obj = Fcons (event->code, Qnil);
3598 obj = Fcons (event->frame_or_window, obj);
3599 obj = Fcons (Qlanguage_change, Fcons (obj, Qnil));
3600 kbd_fetch_ptr = event + 1;
3602 #endif
3603 /* Just discard these, by returning nil.
3604 With MULTI_KBOARD, these events are used as placeholders
3605 when we need to randomly delete events from the queue.
3606 (They shouldn't otherwise be found in the buffer,
3607 but on some machines it appears they do show up
3608 even without MULTI_KBOARD.) */
3609 /* On Windows NT/9X, no_event is used to delete extraneous
3610 mouse events during a popup-menu call. */
3611 else if (event->kind == no_event)
3612 kbd_fetch_ptr = event + 1;
3613 else if (event->kind == HELP_EVENT)
3615 /* There are always two HELP_EVENTs in the input queue. */
3616 Lisp_Object object, position, help, frame, window;
3618 xassert (event->code == 0);
3619 frame = event->frame_or_window;
3620 object = event->arg;
3621 position = event->x;
3622 clear_event (event);
3624 kbd_fetch_ptr = event + 1;
3625 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3626 ? kbd_fetch_ptr
3627 : kbd_buffer);
3628 xassert (event->code == 1);
3629 help = event->arg;
3630 window = event->frame_or_window;
3631 if (!WINDOWP (window))
3632 window = Qnil;
3633 obj = Fcons (Qhelp_echo,
3634 list5 (frame, help, window, object, position));
3635 clear_event (event);
3636 kbd_fetch_ptr = event + 1;
3638 else if (event->kind == FOCUS_IN_EVENT)
3640 /* Notification of a FocusIn event. The frame receiving the
3641 focus is in event->frame_or_window. Generate a
3642 switch-frame event if necessary. */
3643 Lisp_Object frame, focus;
3645 frame = event->frame_or_window;
3646 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
3647 if (FRAMEP (focus))
3648 frame = focus;
3650 if (!EQ (frame, internal_last_event_frame)
3651 && !EQ (frame, selected_frame))
3652 obj = make_lispy_switch_frame (frame);
3653 internal_last_event_frame = frame;
3654 kbd_fetch_ptr = event + 1;
3656 else
3658 /* If this event is on a different frame, return a switch-frame this
3659 time, and leave the event in the queue for next time. */
3660 Lisp_Object frame;
3661 Lisp_Object focus;
3663 frame = event->frame_or_window;
3664 if (CONSP (frame))
3665 frame = XCAR (frame);
3666 else if (WINDOWP (frame))
3667 frame = WINDOW_FRAME (XWINDOW (frame));
3669 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
3670 if (! NILP (focus))
3671 frame = focus;
3673 if (! EQ (frame, internal_last_event_frame)
3674 && !EQ (frame, selected_frame))
3675 obj = make_lispy_switch_frame (frame);
3676 internal_last_event_frame = frame;
3678 /* If we didn't decide to make a switch-frame event, go ahead
3679 and build a real event from the queue entry. */
3681 if (NILP (obj))
3683 int idx;
3685 obj = make_lispy_event (event);
3687 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI)
3688 /* If this was a menu selection, then set the flag to inhibit
3689 writing to last_nonmenu_event. Don't do this if the event
3690 we're returning is (menu-bar), though; that indicates the
3691 beginning of the menu sequence, and we might as well leave
3692 that as the `event with parameters' for this selection. */
3693 if (used_mouse_menu
3694 && !EQ (event->frame_or_window, event->arg)
3695 && (event->kind == MENU_BAR_EVENT
3696 || event->kind == TOOL_BAR_EVENT))
3697 *used_mouse_menu = 1;
3698 #endif
3700 /* Wipe out this event, to catch bugs. */
3701 clear_event (event);
3702 kbd_fetch_ptr = event + 1;
3706 #ifdef HAVE_MOUSE
3707 /* Try generating a mouse motion event. */
3708 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3710 FRAME_PTR f = some_mouse_moved ();
3711 Lisp_Object bar_window;
3712 enum scroll_bar_part part;
3713 Lisp_Object x, y;
3714 unsigned long time;
3716 *kbp = current_kboard;
3717 /* Note that this uses F to determine which display to look at.
3718 If there is no valid info, it does not store anything
3719 so x remains nil. */
3720 x = Qnil;
3721 (*mouse_position_hook) (&f, 0, &bar_window, &part, &x, &y, &time);
3723 obj = Qnil;
3725 /* Decide if we should generate a switch-frame event. Don't
3726 generate switch-frame events for motion outside of all Emacs
3727 frames. */
3728 if (!NILP (x) && f)
3730 Lisp_Object frame;
3732 frame = FRAME_FOCUS_FRAME (f);
3733 if (NILP (frame))
3734 XSETFRAME (frame, f);
3736 if (! EQ (frame, internal_last_event_frame)
3737 && !EQ (frame, selected_frame))
3738 obj = make_lispy_switch_frame (frame);
3739 internal_last_event_frame = frame;
3742 /* If we didn't decide to make a switch-frame event, go ahead and
3743 return a mouse-motion event. */
3744 if (!NILP (x) && NILP (obj))
3745 obj = make_lispy_movement (f, bar_window, part, x, y, time);
3747 #endif /* HAVE_MOUSE */
3748 else
3749 /* We were promised by the above while loop that there was
3750 something for us to read! */
3751 abort ();
3753 input_pending = readable_events (0);
3755 Vlast_event_frame = internal_last_event_frame;
3757 return (obj);
3760 /* Process any events that are not user-visible,
3761 then return, without reading any user-visible events. */
3763 void
3764 swallow_events (do_display)
3765 int do_display;
3767 int old_timers_run;
3769 while (kbd_fetch_ptr != kbd_store_ptr)
3771 struct input_event *event;
3773 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3774 ? kbd_fetch_ptr
3775 : kbd_buffer);
3777 last_event_timestamp = event->timestamp;
3779 /* These two kinds of events get special handling
3780 and don't actually appear to the command loop. */
3781 if (event->kind == selection_request_event)
3783 #ifdef HAVE_X11
3784 struct input_event copy;
3786 /* Remove it from the buffer before processing it,
3787 since otherwise swallow_events called recursively could see it
3788 and process it again. */
3789 copy = *event;
3790 kbd_fetch_ptr = event + 1;
3791 input_pending = readable_events (0);
3792 x_handle_selection_request (&copy);
3793 #else
3794 /* We're getting selection request events, but we don't have
3795 a window system. */
3796 abort ();
3797 #endif
3800 else if (event->kind == selection_clear_event)
3802 #ifdef HAVE_X11
3803 struct input_event copy;
3805 /* Remove it from the buffer before processing it, */
3806 copy = *event;
3808 kbd_fetch_ptr = event + 1;
3809 input_pending = readable_events (0);
3810 x_handle_selection_clear (&copy);
3811 #else
3812 /* We're getting selection request events, but we don't have
3813 a window system. */
3814 abort ();
3815 #endif
3817 else
3818 break;
3821 old_timers_run = timers_run;
3822 get_input_pending (&input_pending, 1);
3824 if (timers_run != old_timers_run && do_display)
3825 redisplay_preserve_echo_area ();
3828 static EMACS_TIME timer_idleness_start_time;
3830 /* Record the start of when Emacs is idle,
3831 for the sake of running idle-time timers. */
3833 void
3834 timer_start_idle ()
3836 Lisp_Object timers;
3838 /* If we are already in the idle state, do nothing. */
3839 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3840 return;
3842 EMACS_GET_TIME (timer_idleness_start_time);
3844 /* Mark all idle-time timers as once again candidates for running. */
3845 for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers))
3847 Lisp_Object timer;
3849 timer = XCAR (timers);
3851 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3852 continue;
3853 XVECTOR (timer)->contents[0] = Qnil;
3857 /* Record that Emacs is no longer idle, so stop running idle-time timers. */
3859 void
3860 timer_stop_idle ()
3862 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
3865 /* This is only for debugging. */
3866 struct input_event last_timer_event;
3868 /* Check whether a timer has fired. To prevent larger problems we simply
3869 disregard elements that are not proper timers. Do not make a circular
3870 timer list for the time being.
3872 Returns the number of seconds to wait until the next timer fires. If a
3873 timer is triggering now, return zero seconds.
3874 If no timer is active, return -1 seconds.
3876 If a timer is ripe, we run it, with quitting turned off.
3878 DO_IT_NOW is now ignored. It used to mean that we should
3879 run the timer directly instead of queueing a timer-event.
3880 Now we always run timers directly. */
3882 EMACS_TIME
3883 timer_check (do_it_now)
3884 int do_it_now;
3886 EMACS_TIME nexttime;
3887 EMACS_TIME now, idleness_now;
3888 Lisp_Object timers, idle_timers, chosen_timer;
3889 struct gcpro gcpro1, gcpro2, gcpro3;
3891 EMACS_SET_SECS (nexttime, -1);
3892 EMACS_SET_USECS (nexttime, -1);
3894 /* Always consider the ordinary timers. */
3895 timers = Vtimer_list;
3896 /* Consider the idle timers only if Emacs is idle. */
3897 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3898 idle_timers = Vtimer_idle_list;
3899 else
3900 idle_timers = Qnil;
3901 chosen_timer = Qnil;
3902 GCPRO3 (timers, idle_timers, chosen_timer);
3904 if (CONSP (timers) || CONSP (idle_timers))
3906 EMACS_GET_TIME (now);
3907 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3908 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
3911 while (CONSP (timers) || CONSP (idle_timers))
3913 Lisp_Object *vector;
3914 Lisp_Object timer = Qnil, idle_timer = Qnil;
3915 EMACS_TIME timer_time, idle_timer_time;
3916 EMACS_TIME difference, timer_difference, idle_timer_difference;
3918 /* Skip past invalid timers and timers already handled. */
3919 if (!NILP (timers))
3921 timer = XCAR (timers);
3922 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3924 timers = XCDR (timers);
3925 continue;
3927 vector = XVECTOR (timer)->contents;
3929 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
3930 || !INTEGERP (vector[3])
3931 || ! NILP (vector[0]))
3933 timers = XCDR (timers);
3934 continue;
3937 if (!NILP (idle_timers))
3939 timer = XCAR (idle_timers);
3940 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3942 idle_timers = XCDR (idle_timers);
3943 continue;
3945 vector = XVECTOR (timer)->contents;
3947 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
3948 || !INTEGERP (vector[3])
3949 || ! NILP (vector[0]))
3951 idle_timers = XCDR (idle_timers);
3952 continue;
3956 /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
3957 based on the next ordinary timer.
3958 TIMER_DIFFERENCE is the distance in time from NOW to when
3959 this timer becomes ripe (negative if it's already ripe). */
3960 if (!NILP (timers))
3962 timer = XCAR (timers);
3963 vector = XVECTOR (timer)->contents;
3964 EMACS_SET_SECS (timer_time,
3965 (XINT (vector[1]) << 16) | (XINT (vector[2])));
3966 EMACS_SET_USECS (timer_time, XINT (vector[3]));
3967 EMACS_SUB_TIME (timer_difference, timer_time, now);
3970 /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
3971 based on the next idle timer. */
3972 if (!NILP (idle_timers))
3974 idle_timer = XCAR (idle_timers);
3975 vector = XVECTOR (idle_timer)->contents;
3976 EMACS_SET_SECS (idle_timer_time,
3977 (XINT (vector[1]) << 16) | (XINT (vector[2])));
3978 EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
3979 EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
3982 /* Decide which timer is the next timer,
3983 and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
3984 Also step down the list where we found that timer. */
3986 if (! NILP (timers) && ! NILP (idle_timers))
3988 EMACS_TIME temp;
3989 EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
3990 if (EMACS_TIME_NEG_P (temp))
3992 chosen_timer = timer;
3993 timers = XCDR (timers);
3994 difference = timer_difference;
3996 else
3998 chosen_timer = idle_timer;
3999 idle_timers = XCDR (idle_timers);
4000 difference = idle_timer_difference;
4003 else if (! NILP (timers))
4005 chosen_timer = timer;
4006 timers = XCDR (timers);
4007 difference = timer_difference;
4009 else
4011 chosen_timer = idle_timer;
4012 idle_timers = XCDR (idle_timers);
4013 difference = idle_timer_difference;
4015 vector = XVECTOR (chosen_timer)->contents;
4017 /* If timer is ripe, run it if it hasn't been run. */
4018 if (EMACS_TIME_NEG_P (difference)
4019 || (EMACS_SECS (difference) == 0
4020 && EMACS_USECS (difference) == 0))
4022 if (NILP (vector[0]))
4024 int was_locked = single_kboard;
4025 int count = specpdl_ptr - specpdl;
4027 /* Mark the timer as triggered to prevent problems if the lisp
4028 code fails to reschedule it right. */
4029 vector[0] = Qt;
4031 specbind (Qinhibit_quit, Qt);
4033 call1 (Qtimer_event_handler, chosen_timer);
4034 timers_run++;
4036 unbind_to (count, Qnil);
4038 /* Resume allowing input from any kboard, if that was true before. */
4039 if (!was_locked)
4040 any_kboard_state ();
4042 /* Since we have handled the event,
4043 we don't need to tell the caller to wake up and do it. */
4046 else
4047 /* When we encounter a timer that is still waiting,
4048 return the amount of time to wait before it is ripe. */
4050 UNGCPRO;
4051 return difference;
4055 /* No timers are pending in the future. */
4056 /* Return 0 if we generated an event, and -1 if not. */
4057 UNGCPRO;
4058 return nexttime;
4061 /* Caches for modify_event_symbol. */
4062 static Lisp_Object accent_key_syms;
4063 static Lisp_Object func_key_syms;
4064 static Lisp_Object mouse_syms;
4065 #ifdef WINDOWSNT
4066 static Lisp_Object mouse_wheel_syms;
4067 #endif
4068 static Lisp_Object drag_n_drop_syms;
4070 /* This is a list of keysym codes for special "accent" characters.
4071 It parallels lispy_accent_keys. */
4073 static int lispy_accent_codes[] =
4075 #ifdef XK_dead_circumflex
4076 XK_dead_circumflex,
4077 #else
4079 #endif
4080 #ifdef XK_dead_grave
4081 XK_dead_grave,
4082 #else
4084 #endif
4085 #ifdef XK_dead_tilde
4086 XK_dead_tilde,
4087 #else
4089 #endif
4090 #ifdef XK_dead_diaeresis
4091 XK_dead_diaeresis,
4092 #else
4094 #endif
4095 #ifdef XK_dead_macron
4096 XK_dead_macron,
4097 #else
4099 #endif
4100 #ifdef XK_dead_degree
4101 XK_dead_degree,
4102 #else
4104 #endif
4105 #ifdef XK_dead_acute
4106 XK_dead_acute,
4107 #else
4109 #endif
4110 #ifdef XK_dead_cedilla
4111 XK_dead_cedilla,
4112 #else
4114 #endif
4115 #ifdef XK_dead_breve
4116 XK_dead_breve,
4117 #else
4119 #endif
4120 #ifdef XK_dead_ogonek
4121 XK_dead_ogonek,
4122 #else
4124 #endif
4125 #ifdef XK_dead_caron
4126 XK_dead_caron,
4127 #else
4129 #endif
4130 #ifdef XK_dead_doubleacute
4131 XK_dead_doubleacute,
4132 #else
4134 #endif
4135 #ifdef XK_dead_abovedot
4136 XK_dead_abovedot,
4137 #else
4139 #endif
4142 /* This is a list of Lisp names for special "accent" characters.
4143 It parallels lispy_accent_codes. */
4145 static char *lispy_accent_keys[] =
4147 "dead-circumflex",
4148 "dead-grave",
4149 "dead-tilde",
4150 "dead-diaeresis",
4151 "dead-macron",
4152 "dead-degree",
4153 "dead-acute",
4154 "dead-cedilla",
4155 "dead-breve",
4156 "dead-ogonek",
4157 "dead-caron",
4158 "dead-doubleacute",
4159 "dead-abovedot",
4162 #ifdef HAVE_NTGUI
4163 #define FUNCTION_KEY_OFFSET 0x0
4165 char *lispy_function_keys[] =
4167 0, /* 0 */
4169 0, /* VK_LBUTTON 0x01 */
4170 0, /* VK_RBUTTON 0x02 */
4171 "cancel", /* VK_CANCEL 0x03 */
4172 0, /* VK_MBUTTON 0x04 */
4174 0, 0, 0, /* 0x05 .. 0x07 */
4176 "backspace", /* VK_BACK 0x08 */
4177 "tab", /* VK_TAB 0x09 */
4179 0, 0, /* 0x0A .. 0x0B */
4181 "clear", /* VK_CLEAR 0x0C */
4182 "return", /* VK_RETURN 0x0D */
4184 0, 0, /* 0x0E .. 0x0F */
4186 0, /* VK_SHIFT 0x10 */
4187 0, /* VK_CONTROL 0x11 */
4188 0, /* VK_MENU 0x12 */
4189 "pause", /* VK_PAUSE 0x13 */
4190 "capslock", /* VK_CAPITAL 0x14 */
4192 0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */
4194 "escape", /* VK_ESCAPE 0x1B */
4196 0, 0, 0, 0, /* 0x1C .. 0x1F */
4198 0, /* VK_SPACE 0x20 */
4199 "prior", /* VK_PRIOR 0x21 */
4200 "next", /* VK_NEXT 0x22 */
4201 "end", /* VK_END 0x23 */
4202 "home", /* VK_HOME 0x24 */
4203 "left", /* VK_LEFT 0x25 */
4204 "up", /* VK_UP 0x26 */
4205 "right", /* VK_RIGHT 0x27 */
4206 "down", /* VK_DOWN 0x28 */
4207 "select", /* VK_SELECT 0x29 */
4208 "print", /* VK_PRINT 0x2A */
4209 "execute", /* VK_EXECUTE 0x2B */
4210 "snapshot", /* VK_SNAPSHOT 0x2C */
4211 "insert", /* VK_INSERT 0x2D */
4212 "delete", /* VK_DELETE 0x2E */
4213 "help", /* VK_HELP 0x2F */
4215 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
4217 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4219 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
4221 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
4223 0, 0, 0, 0, 0, 0, 0, 0, 0,
4224 0, 0, 0, 0, 0, 0, 0, 0, 0,
4225 0, 0, 0, 0, 0, 0, 0, 0,
4227 "lwindow", /* VK_LWIN 0x5B */
4228 "rwindow", /* VK_RWIN 0x5C */
4229 "apps", /* VK_APPS 0x5D */
4231 0, 0, /* 0x5E .. 0x5F */
4233 "kp-0", /* VK_NUMPAD0 0x60 */
4234 "kp-1", /* VK_NUMPAD1 0x61 */
4235 "kp-2", /* VK_NUMPAD2 0x62 */
4236 "kp-3", /* VK_NUMPAD3 0x63 */
4237 "kp-4", /* VK_NUMPAD4 0x64 */
4238 "kp-5", /* VK_NUMPAD5 0x65 */
4239 "kp-6", /* VK_NUMPAD6 0x66 */
4240 "kp-7", /* VK_NUMPAD7 0x67 */
4241 "kp-8", /* VK_NUMPAD8 0x68 */
4242 "kp-9", /* VK_NUMPAD9 0x69 */
4243 "kp-multiply", /* VK_MULTIPLY 0x6A */
4244 "kp-add", /* VK_ADD 0x6B */
4245 "kp-separator", /* VK_SEPARATOR 0x6C */
4246 "kp-subtract", /* VK_SUBTRACT 0x6D */
4247 "kp-decimal", /* VK_DECIMAL 0x6E */
4248 "kp-divide", /* VK_DIVIDE 0x6F */
4249 "f1", /* VK_F1 0x70 */
4250 "f2", /* VK_F2 0x71 */
4251 "f3", /* VK_F3 0x72 */
4252 "f4", /* VK_F4 0x73 */
4253 "f5", /* VK_F5 0x74 */
4254 "f6", /* VK_F6 0x75 */
4255 "f7", /* VK_F7 0x76 */
4256 "f8", /* VK_F8 0x77 */
4257 "f9", /* VK_F9 0x78 */
4258 "f10", /* VK_F10 0x79 */
4259 "f11", /* VK_F11 0x7A */
4260 "f12", /* VK_F12 0x7B */
4261 "f13", /* VK_F13 0x7C */
4262 "f14", /* VK_F14 0x7D */
4263 "f15", /* VK_F15 0x7E */
4264 "f16", /* VK_F16 0x7F */
4265 "f17", /* VK_F17 0x80 */
4266 "f18", /* VK_F18 0x81 */
4267 "f19", /* VK_F19 0x82 */
4268 "f20", /* VK_F20 0x83 */
4269 "f21", /* VK_F21 0x84 */
4270 "f22", /* VK_F22 0x85 */
4271 "f23", /* VK_F23 0x86 */
4272 "f24", /* VK_F24 0x87 */
4274 0, 0, 0, 0, /* 0x88 .. 0x8B */
4275 0, 0, 0, 0, /* 0x8C .. 0x8F */
4277 "kp-numlock", /* VK_NUMLOCK 0x90 */
4278 "scroll", /* VK_SCROLL 0x91 */
4280 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
4281 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
4282 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
4283 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
4284 "kp-end", /* VK_NUMPAD_END 0x96 */
4285 "kp-home", /* VK_NUMPAD_HOME 0x97 */
4286 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
4287 "kp-up", /* VK_NUMPAD_UP 0x99 */
4288 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
4289 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
4290 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
4291 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
4293 0, 0, /* 0x9E .. 0x9F */
4296 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
4297 * Used only as parameters to GetAsyncKeyState and GetKeyState.
4298 * No other API or message will distinguish left and right keys this way.
4300 /* 0xA0 .. 0xEF */
4302 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4303 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4304 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4305 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4306 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4308 /* 0xF0 .. 0xF5 */
4310 0, 0, 0, 0, 0, 0,
4312 "attn", /* VK_ATTN 0xF6 */
4313 "crsel", /* VK_CRSEL 0xF7 */
4314 "exsel", /* VK_EXSEL 0xF8 */
4315 "ereof", /* VK_EREOF 0xF9 */
4316 "play", /* VK_PLAY 0xFA */
4317 "zoom", /* VK_ZOOM 0xFB */
4318 "noname", /* VK_NONAME 0xFC */
4319 "pa1", /* VK_PA1 0xFD */
4320 "oem_clear", /* VK_OEM_CLEAR 0xFE */
4321 0 /* 0xFF */
4324 #else /* not HAVE_NTGUI */
4326 #ifdef XK_kana_A
4327 static char *lispy_kana_keys[] =
4329 /* X Keysym value */
4330 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
4331 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
4332 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
4333 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
4334 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
4335 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
4336 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
4337 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
4338 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
4339 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
4340 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
4341 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
4342 "kana-i", "kana-u", "kana-e", "kana-o",
4343 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
4344 "prolongedsound", "kana-A", "kana-I", "kana-U",
4345 "kana-E", "kana-O", "kana-KA", "kana-KI",
4346 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
4347 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
4348 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
4349 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
4350 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
4351 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
4352 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
4353 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
4354 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
4355 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
4356 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
4357 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
4359 #endif /* XK_kana_A */
4361 #define FUNCTION_KEY_OFFSET 0xff00
4363 /* You'll notice that this table is arranged to be conveniently
4364 indexed by X Windows keysym values. */
4365 static char *lispy_function_keys[] =
4367 /* X Keysym value */
4369 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
4370 "backspace", "tab", "linefeed", "clear",
4371 0, "return", 0, 0,
4372 0, 0, 0, "pause", /* 0xff10...1f */
4373 0, 0, 0, 0, 0, 0, 0, "escape",
4374 0, 0, 0, 0,
4375 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
4376 "romaji", "hiragana", "katakana", "hiragana-katakana",
4377 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
4378 "massyo", "kana-lock", "kana-shift", "eisu-shift",
4379 "eisu-toggle", /* 0xff30...3f */
4380 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4381 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
4383 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
4384 "down", "prior", "next", "end",
4385 "begin", 0, 0, 0, 0, 0, 0, 0,
4386 "select", /* 0xff60 */ /* IsMiscFunctionKey */
4387 "print",
4388 "execute",
4389 "insert",
4390 0, /* 0xff64 */
4391 "undo",
4392 "redo",
4393 "menu",
4394 "find",
4395 "cancel",
4396 "help",
4397 "break", /* 0xff6b */
4399 0, 0, 0, 0,
4400 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
4401 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
4402 "kp-space", /* 0xff80 */ /* IsKeypadKey */
4403 0, 0, 0, 0, 0, 0, 0, 0,
4404 "kp-tab", /* 0xff89 */
4405 0, 0, 0,
4406 "kp-enter", /* 0xff8d */
4407 0, 0, 0,
4408 "kp-f1", /* 0xff91 */
4409 "kp-f2",
4410 "kp-f3",
4411 "kp-f4",
4412 "kp-home", /* 0xff95 */
4413 "kp-left",
4414 "kp-up",
4415 "kp-right",
4416 "kp-down",
4417 "kp-prior", /* kp-page-up */
4418 "kp-next", /* kp-page-down */
4419 "kp-end",
4420 "kp-begin",
4421 "kp-insert",
4422 "kp-delete",
4423 0, /* 0xffa0 */
4424 0, 0, 0, 0, 0, 0, 0, 0, 0,
4425 "kp-multiply", /* 0xffaa */
4426 "kp-add",
4427 "kp-separator",
4428 "kp-subtract",
4429 "kp-decimal",
4430 "kp-divide", /* 0xffaf */
4431 "kp-0", /* 0xffb0 */
4432 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
4433 0, /* 0xffba */
4434 0, 0,
4435 "kp-equal", /* 0xffbd */
4436 "f1", /* 0xffbe */ /* IsFunctionKey */
4437 "f2",
4438 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
4439 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
4440 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
4441 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
4442 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
4443 0, 0, 0, 0, 0, 0, 0, 0,
4444 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
4445 0, 0, 0, 0, 0, 0, 0, "delete"
4448 /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
4449 #define ISO_FUNCTION_KEY_OFFSET 0xfe00
4451 static char *iso_lispy_function_keys[] =
4453 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
4454 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
4455 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
4456 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
4457 "iso-lefttab", /* 0xfe20 */
4458 "iso-move-line-up", "iso-move-line-down",
4459 "iso-partial-line-up", "iso-partial-line-down",
4460 "iso-partial-space-left", "iso-partial-space-right",
4461 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
4462 "iso-release-margin-left", "iso-release-margin-right",
4463 "iso-release-both-margins",
4464 "iso-fast-cursor-left", "iso-fast-cursor-right",
4465 "iso-fast-cursor-up", "iso-fast-cursor-down",
4466 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
4467 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
4470 #endif /* not HAVE_NTGUI */
4472 Lisp_Object Vlispy_mouse_stem;
4474 #ifdef WINDOWSNT
4475 /* mouse-wheel events are generated by the wheel on devices such as
4476 the MS Intellimouse. The wheel sits in between the left and right
4477 mouse buttons, and is typically used to scroll or zoom the window
4478 underneath the pointer. mouse-wheel events specify the object on
4479 which they operate, and a delta corresponding to the amount and
4480 direction that the wheel is rotated. Clicking the mouse-wheel
4481 generates a mouse-2 event. */
4482 static char *lispy_mouse_wheel_names[] =
4484 "mouse-wheel"
4487 #endif /* WINDOWSNT */
4489 /* drag-n-drop events are generated when a set of selected files are
4490 dragged from another application and dropped onto an Emacs window. */
4491 static char *lispy_drag_n_drop_names[] =
4493 "drag-n-drop"
4496 /* Scroll bar parts. */
4497 Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
4498 Lisp_Object Qup, Qdown, Qbottom, Qend_scroll;
4499 Lisp_Object Qtop, Qratio;
4501 /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
4502 Lisp_Object *scroll_bar_parts[] = {
4503 &Qabove_handle, &Qhandle, &Qbelow_handle,
4504 &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio
4507 /* User signal events. */
4508 Lisp_Object Qusr1_signal, Qusr2_signal;
4510 Lisp_Object *lispy_user_signals[] =
4512 &Qusr1_signal, &Qusr2_signal
4516 /* A vector, indexed by button number, giving the down-going location
4517 of currently depressed buttons, both scroll bar and non-scroll bar.
4519 The elements have the form
4520 (BUTTON-NUMBER MODIFIER-MASK . REST)
4521 where REST is the cdr of a position as it would be reported in the event.
4523 The make_lispy_event function stores positions here to tell the
4524 difference between click and drag events, and to store the starting
4525 location to be included in drag events. */
4527 static Lisp_Object button_down_location;
4529 /* Information about the most recent up-going button event: Which
4530 button, what location, and what time. */
4532 static int last_mouse_button;
4533 static int last_mouse_x;
4534 static int last_mouse_y;
4535 static unsigned long button_down_time;
4537 /* The maximum time between clicks to make a double-click,
4538 or Qnil to disable double-click detection,
4539 or Qt for no time limit. */
4540 Lisp_Object Vdouble_click_time;
4542 /* The number of clicks in this multiple-click. */
4544 int double_click_count;
4546 /* Given a struct input_event, build the lisp event which represents
4547 it. If EVENT is 0, build a mouse movement event from the mouse
4548 movement buffer, which should have a movement event in it.
4550 Note that events must be passed to this function in the order they
4551 are received; this function stores the location of button presses
4552 in order to build drag events when the button is released. */
4554 static Lisp_Object
4555 make_lispy_event (event)
4556 struct input_event *event;
4558 int i;
4560 switch (SWITCH_ENUM_CAST (event->kind))
4562 /* A simple keystroke. */
4563 case ascii_keystroke:
4565 Lisp_Object lispy_c;
4566 int c = event->code & 0377;
4567 /* Turn ASCII characters into control characters
4568 when proper. */
4569 if (event->modifiers & ctrl_modifier)
4570 c = make_ctrl_char (c);
4572 /* Add in the other modifier bits. We took care of ctrl_modifier
4573 just above, and the shift key was taken care of by the X code,
4574 and applied to control characters by make_ctrl_char. */
4575 c |= (event->modifiers
4576 & (meta_modifier | alt_modifier
4577 | hyper_modifier | super_modifier));
4578 /* Distinguish Shift-SPC from SPC. */
4579 if ((event->code & 0377) == 040
4580 && event->modifiers & shift_modifier)
4581 c |= shift_modifier;
4582 button_down_time = 0;
4583 XSETFASTINT (lispy_c, c);
4584 return lispy_c;
4587 case multibyte_char_keystroke:
4589 Lisp_Object lispy_c;
4591 XSETFASTINT (lispy_c, event->code);
4592 return lispy_c;
4595 /* A function key. The symbol may need to have modifier prefixes
4596 tacked onto it. */
4597 case non_ascii_keystroke:
4598 button_down_time = 0;
4600 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
4601 if (event->code == lispy_accent_codes[i])
4602 return modify_event_symbol (i,
4603 event->modifiers,
4604 Qfunction_key, Qnil,
4605 lispy_accent_keys, &accent_key_syms,
4606 (sizeof (lispy_accent_keys)
4607 / sizeof (lispy_accent_keys[0])));
4609 /* Handle system-specific keysyms. */
4610 if (event->code & (1 << 28))
4612 /* We need to use an alist rather than a vector as the cache
4613 since we can't make a vector long enuf. */
4614 if (NILP (current_kboard->system_key_syms))
4615 current_kboard->system_key_syms = Fcons (Qnil, Qnil);
4616 return modify_event_symbol (event->code,
4617 event->modifiers,
4618 Qfunction_key,
4619 current_kboard->Vsystem_key_alist,
4620 0, &current_kboard->system_key_syms,
4621 (unsigned)-1);
4624 #ifdef XK_kana_A
4625 if (event->code >= 0x400 && event->code < 0x500)
4626 return modify_event_symbol (event->code - 0x400,
4627 event->modifiers & ~shift_modifier,
4628 Qfunction_key, Qnil,
4629 lispy_kana_keys, &func_key_syms,
4630 (sizeof (lispy_kana_keys)
4631 / sizeof (lispy_kana_keys[0])));
4632 #endif /* XK_kana_A */
4634 #ifdef ISO_FUNCTION_KEY_OFFSET
4635 if (event->code < FUNCTION_KEY_OFFSET
4636 && event->code >= ISO_FUNCTION_KEY_OFFSET)
4637 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
4638 event->modifiers,
4639 Qfunction_key, Qnil,
4640 iso_lispy_function_keys, &func_key_syms,
4641 (sizeof (iso_lispy_function_keys)
4642 / sizeof (iso_lispy_function_keys[0])));
4643 else
4644 #endif
4645 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
4646 event->modifiers,
4647 Qfunction_key, Qnil,
4648 lispy_function_keys, &func_key_syms,
4649 (sizeof (lispy_function_keys)
4650 / sizeof (lispy_function_keys[0])));
4652 #ifdef HAVE_MOUSE
4653 /* A mouse click. Figure out where it is, decide whether it's
4654 a press, click or drag, and build the appropriate structure. */
4655 case mouse_click:
4656 #ifndef USE_TOOLKIT_SCROLL_BARS
4657 case scroll_bar_click:
4658 #endif
4660 int button = event->code;
4661 int is_double;
4662 Lisp_Object position;
4663 Lisp_Object *start_pos_ptr;
4664 Lisp_Object start_pos;
4666 position = Qnil;
4668 /* Build the position as appropriate for this mouse click. */
4669 if (event->kind == mouse_click)
4671 int part;
4672 FRAME_PTR f = XFRAME (event->frame_or_window);
4673 Lisp_Object window;
4674 Lisp_Object posn;
4675 Lisp_Object string_info = Qnil;
4676 int row, column;
4678 /* Ignore mouse events that were made on frame that
4679 have been deleted. */
4680 if (! FRAME_LIVE_P (f))
4681 return Qnil;
4683 /* EVENT->x and EVENT->y are frame-relative pixel
4684 coordinates at this place. Under old redisplay, COLUMN
4685 and ROW are set to frame relative glyph coordinates
4686 which are then used to determine whether this click is
4687 in a menu (non-toolkit version). */
4688 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
4689 &column, &row, NULL, 1);
4691 #ifndef USE_X_TOOLKIT
4692 /* In the non-toolkit version, clicks on the menu bar
4693 are ordinary button events in the event buffer.
4694 Distinguish them, and invoke the menu.
4696 (In the toolkit version, the toolkit handles the menu bar
4697 and Emacs doesn't know about it until after the user
4698 makes a selection.) */
4699 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
4700 && (event->modifiers & down_modifier))
4702 Lisp_Object items, item;
4703 int hpos;
4704 int i;
4706 #if 0
4707 /* Activate the menu bar on the down event. If the
4708 up event comes in before the menu code can deal with it,
4709 just ignore it. */
4710 if (! (event->modifiers & down_modifier))
4711 return Qnil;
4712 #endif
4714 /* Find the menu bar item under `column'. */
4715 item = Qnil;
4716 items = FRAME_MENU_BAR_ITEMS (f);
4717 for (i = 0; i < XVECTOR (items)->size; i += 4)
4719 Lisp_Object pos, string;
4720 string = XVECTOR (items)->contents[i + 1];
4721 pos = XVECTOR (items)->contents[i + 3];
4722 if (NILP (string))
4723 break;
4724 if (column >= XINT (pos)
4725 && column < XINT (pos) + XSTRING (string)->size)
4727 item = XVECTOR (items)->contents[i];
4728 break;
4732 /* ELisp manual 2.4b says (x y) are window relative but
4733 code says they are frame-relative. */
4734 position
4735 = Fcons (event->frame_or_window,
4736 Fcons (Qmenu_bar,
4737 Fcons (Fcons (event->x, event->y),
4738 Fcons (make_number (event->timestamp),
4739 Qnil))));
4741 return Fcons (item, Fcons (position, Qnil));
4743 #endif /* not USE_X_TOOLKIT */
4745 /* Set `window' to the window under frame pixel coordinates
4746 event->x/event->y. */
4747 window = window_from_coordinates (f, XINT (event->x),
4748 XINT (event->y), &part, 0);
4750 if (!WINDOWP (window))
4752 window = event->frame_or_window;
4753 posn = Qnil;
4755 else
4757 /* It's a click in window window at frame coordinates
4758 event->x/ event->y. */
4759 struct window *w = XWINDOW (window);
4761 /* Get window relative coordinates. Original code
4762 `rounded' this to glyph boundaries. */
4763 int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
4764 int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
4766 /* Set event coordinates to window-relative coordinates
4767 for constructing the Lisp event below. */
4768 XSETINT (event->x, wx);
4769 XSETINT (event->y, wy);
4771 if (part == 1 || part == 3)
4773 /* Mode line or header line. Look for a string under
4774 the mouse that may have a `local-map' property. */
4775 Lisp_Object string;
4776 int charpos;
4778 posn = part == 1 ? Qmode_line : Qheader_line;
4779 string = mode_line_string (w, wx, wy, part == 1, &charpos);
4780 if (STRINGP (string))
4781 string_info = Fcons (string, make_number (charpos));
4783 else if (part == 2)
4784 posn = Qvertical_line;
4785 else
4786 XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy));
4789 position
4790 = Fcons (window,
4791 Fcons (posn,
4792 Fcons (Fcons (event->x, event->y),
4793 Fcons (make_number (event->timestamp),
4794 (NILP (string_info)
4795 ? Qnil
4796 : Fcons (string_info, Qnil))))));
4798 #ifndef USE_TOOLKIT_SCROLL_BARS
4799 else
4801 /* It's a scrollbar click. */
4802 Lisp_Object window;
4803 Lisp_Object portion_whole;
4804 Lisp_Object part;
4806 window = event->frame_or_window;
4807 portion_whole = Fcons (event->x, event->y);
4808 part = *scroll_bar_parts[(int) event->part];
4810 position
4811 = Fcons (window,
4812 Fcons (Qvertical_scroll_bar,
4813 Fcons (portion_whole,
4814 Fcons (make_number (event->timestamp),
4815 Fcons (part, Qnil)))));
4817 #endif /* not USE_TOOLKIT_SCROLL_BARS */
4819 if (button >= XVECTOR (button_down_location)->size)
4821 button_down_location = larger_vector (button_down_location,
4822 button + 1, Qnil);
4823 mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
4826 start_pos_ptr = &XVECTOR (button_down_location)->contents[button];
4828 start_pos = *start_pos_ptr;
4829 *start_pos_ptr = Qnil;
4831 is_double = (button == last_mouse_button
4832 && XINT (event->x) == last_mouse_x
4833 && XINT (event->y) == last_mouse_y
4834 && button_down_time != 0
4835 && (EQ (Vdouble_click_time, Qt)
4836 || (INTEGERP (Vdouble_click_time)
4837 && ((int)(event->timestamp - button_down_time)
4838 < XINT (Vdouble_click_time)))));
4839 last_mouse_button = button;
4840 last_mouse_x = XINT (event->x);
4841 last_mouse_y = XINT (event->y);
4843 /* If this is a button press, squirrel away the location, so
4844 we can decide later whether it was a click or a drag. */
4845 if (event->modifiers & down_modifier)
4847 if (is_double)
4849 double_click_count++;
4850 event->modifiers |= ((double_click_count > 2)
4851 ? triple_modifier
4852 : double_modifier);
4854 else
4855 double_click_count = 1;
4856 button_down_time = event->timestamp;
4857 *start_pos_ptr = Fcopy_alist (position);
4860 /* Now we're releasing a button - check the co-ordinates to
4861 see if this was a click or a drag. */
4862 else if (event->modifiers & up_modifier)
4864 /* If we did not see a down before this up,
4865 ignore the up. Probably this happened because
4866 the down event chose a menu item.
4867 It would be an annoyance to treat the release
4868 of the button that chose the menu item
4869 as a separate event. */
4871 if (!CONSP (start_pos))
4872 return Qnil;
4874 event->modifiers &= ~up_modifier;
4875 #if 0 /* Formerly we treated an up with no down as a click event. */
4876 if (!CONSP (start_pos))
4877 event->modifiers |= click_modifier;
4878 else
4879 #endif
4881 /* The third element of every position should be the (x,y)
4882 pair. */
4883 Lisp_Object down;
4885 down = Fnth (make_number (2), start_pos);
4886 if (EQ (event->x, XCAR (down))
4887 && EQ (event->y, XCDR (down)))
4889 event->modifiers |= click_modifier;
4891 else
4893 button_down_time = 0;
4894 event->modifiers |= drag_modifier;
4896 /* Don't check is_double; treat this as multiple
4897 if the down-event was multiple. */
4898 if (double_click_count > 1)
4899 event->modifiers |= ((double_click_count > 2)
4900 ? triple_modifier
4901 : double_modifier);
4904 else
4905 /* Every mouse event should either have the down_modifier or
4906 the up_modifier set. */
4907 abort ();
4910 /* Get the symbol we should use for the mouse click. */
4911 Lisp_Object head;
4913 head = modify_event_symbol (button,
4914 event->modifiers,
4915 Qmouse_click, Vlispy_mouse_stem,
4916 NULL,
4917 &mouse_syms,
4918 XVECTOR (mouse_syms)->size);
4919 if (event->modifiers & drag_modifier)
4920 return Fcons (head,
4921 Fcons (start_pos,
4922 Fcons (position,
4923 Qnil)));
4924 else if (event->modifiers & (double_modifier | triple_modifier))
4925 return Fcons (head,
4926 Fcons (position,
4927 Fcons (make_number (double_click_count),
4928 Qnil)));
4929 else
4930 return Fcons (head,
4931 Fcons (position,
4932 Qnil));
4936 #if USE_TOOLKIT_SCROLL_BARS
4938 /* We don't have down and up events if using toolkit scroll bars,
4939 so make this always a click event. Store in the `part' of
4940 the Lisp event a symbol which maps to the following actions:
4942 `above_handle' page up
4943 `below_handle' page down
4944 `up' line up
4945 `down' line down
4946 `top' top of buffer
4947 `bottom' bottom of buffer
4948 `handle' thumb has been dragged.
4949 `end-scroll' end of interaction with scroll bar
4951 The incoming input_event contains in its `part' member an
4952 index of type `enum scroll_bar_part' which we can use as an
4953 index in scroll_bar_parts to get the appropriate symbol. */
4955 case scroll_bar_click:
4957 Lisp_Object position, head, window, portion_whole, part;
4959 window = event->frame_or_window;
4960 portion_whole = Fcons (event->x, event->y);
4961 part = *scroll_bar_parts[(int) event->part];
4963 position
4964 = Fcons (window,
4965 Fcons (Qvertical_scroll_bar,
4966 Fcons (portion_whole,
4967 Fcons (make_number (event->timestamp),
4968 Fcons (part, Qnil)))));
4970 /* Always treat scroll bar events as clicks. */
4971 event->modifiers |= click_modifier;
4973 /* Get the symbol we should use for the mouse click. */
4974 head = modify_event_symbol (event->code,
4975 event->modifiers,
4976 Qmouse_click,
4977 Vlispy_mouse_stem,
4978 NULL, &mouse_syms,
4979 XVECTOR (mouse_syms)->size);
4980 return Fcons (head, Fcons (position, Qnil));
4983 #endif /* USE_TOOLKIT_SCROLL_BARS */
4985 #ifdef WINDOWSNT
4986 case w32_scroll_bar_click:
4988 int button = event->code;
4989 int is_double;
4990 Lisp_Object position;
4991 Lisp_Object *start_pos_ptr;
4992 Lisp_Object start_pos;
4995 Lisp_Object window;
4996 Lisp_Object portion_whole;
4997 Lisp_Object part;
4999 window = event->frame_or_window;
5000 portion_whole = Fcons (event->x, event->y);
5001 part = *scroll_bar_parts[(int) event->part];
5003 position
5004 = Fcons (window,
5005 Fcons (Qvertical_scroll_bar,
5006 Fcons (portion_whole,
5007 Fcons (make_number (event->timestamp),
5008 Fcons (part, Qnil)))));
5011 /* Always treat W32 scroll bar events as clicks. */
5012 event->modifiers |= click_modifier;
5015 /* Get the symbol we should use for the mouse click. */
5016 Lisp_Object head;
5018 head = modify_event_symbol (button,
5019 event->modifiers,
5020 Qmouse_click,
5021 Vlispy_mouse_stem,
5022 NULL, &mouse_syms,
5023 XVECTOR (mouse_syms)->size);
5024 return Fcons (head,
5025 Fcons (position,
5026 Qnil));
5029 case mouse_wheel:
5031 int part;
5032 FRAME_PTR f = XFRAME (event->frame_or_window);
5033 Lisp_Object window;
5034 Lisp_Object posn;
5035 Lisp_Object head, position;
5036 int row, column;
5038 /* Ignore mouse events that were made on frame that
5039 have been deleted. */
5040 if (! FRAME_LIVE_P (f))
5041 return Qnil;
5042 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
5043 &column, &row, NULL, 1);
5044 window = window_from_coordinates (f, XINT (event->x),
5045 XINT (event->y), &part, 0);
5047 if (!WINDOWP (window))
5049 window = event->frame_or_window;
5050 posn = Qnil;
5052 else
5054 int pixcolumn, pixrow;
5055 column -= XINT (XWINDOW (window)->left);
5056 row -= XINT (XWINDOW (window)->top);
5057 glyph_to_pixel_coords (XWINDOW(window), column, row,
5058 &pixcolumn, &pixrow);
5059 XSETINT (event->x, pixcolumn);
5060 XSETINT (event->y, pixrow);
5062 if (part == 1)
5063 posn = Qmode_line;
5064 else if (part == 2)
5065 posn = Qvertical_line;
5066 else if (part == 3)
5067 posn = Qheader_line;
5068 else
5069 XSETINT (posn,
5070 buffer_posn_from_coords (XWINDOW (window),
5071 &column, &row));
5075 Lisp_Object head, position;
5077 position
5078 = Fcons (window,
5079 Fcons (posn,
5080 Fcons (Fcons (event->x, event->y),
5081 Fcons (make_number (event->timestamp),
5082 Qnil))));
5084 head = modify_event_symbol (0, event->modifiers,
5085 Qmouse_wheel, Qnil,
5086 lispy_mouse_wheel_names,
5087 &mouse_wheel_syms, 1);
5088 return Fcons (head,
5089 Fcons (position,
5090 Fcons (make_number (event->code),
5091 Qnil)));
5094 #endif /* WINDOWSNT */
5096 case drag_n_drop:
5098 int part;
5099 FRAME_PTR f;
5100 Lisp_Object window;
5101 Lisp_Object posn;
5102 Lisp_Object files;
5104 /* The frame_or_window field should be a cons of the frame in
5105 which the event occurred and a list of the filenames
5106 dropped. */
5107 if (! CONSP (event->frame_or_window))
5108 abort ();
5110 f = XFRAME (XCAR (event->frame_or_window));
5111 files = XCDR (event->frame_or_window);
5113 /* Ignore mouse events that were made on frames that
5114 have been deleted. */
5115 if (! FRAME_LIVE_P (f))
5116 return Qnil;
5118 window = window_from_coordinates (f, XINT (event->x),
5119 XINT (event->y), &part, 0);
5121 if (!WINDOWP (window))
5123 window = XCAR (event->frame_or_window);
5124 posn = Qnil;
5126 else
5128 /* It's an event in window `window' at frame coordinates
5129 event->x/ event->y. */
5130 struct window *w = XWINDOW (window);
5132 /* Get window relative coordinates. */
5133 int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
5134 int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
5136 /* Set event coordinates to window-relative coordinates
5137 for constructing the Lisp event below. */
5138 XSETINT (event->x, wx);
5139 XSETINT (event->y, wy);
5141 if (part == 1)
5142 posn = Qmode_line;
5143 else if (part == 2)
5144 posn = Qvertical_line;
5145 else if (part == 3)
5146 posn = Qheader_line;
5147 else
5148 XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy));
5152 Lisp_Object head, position;
5154 position
5155 = Fcons (window,
5156 Fcons (posn,
5157 Fcons (Fcons (event->x, event->y),
5158 Fcons (make_number (event->timestamp),
5159 Qnil))));
5161 head = modify_event_symbol (0, event->modifiers,
5162 Qdrag_n_drop, Qnil,
5163 lispy_drag_n_drop_names,
5164 &drag_n_drop_syms, 1);
5165 return Fcons (head,
5166 Fcons (position,
5167 Fcons (files,
5168 Qnil)));
5171 #endif /* HAVE_MOUSE */
5173 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
5174 case MENU_BAR_EVENT:
5175 if (EQ (event->arg, event->frame_or_window))
5176 /* This is the prefix key. We translate this to
5177 `(menu_bar)' because the code in keyboard.c for menu
5178 events, which we use, relies on this. */
5179 return Fcons (Qmenu_bar, Qnil);
5180 return event->arg;
5181 #endif
5183 case TOOL_BAR_EVENT:
5184 if (EQ (event->arg, event->frame_or_window))
5185 /* This is the prefix key. We translate this to
5186 `(tool_bar)' because the code in keyboard.c for menu
5187 events, which we use, relies on this. */
5188 return Fcons (Qtool_bar, Qnil);
5189 else if (SYMBOLP (event->arg))
5190 return apply_modifiers (event->modifiers, event->arg);
5191 return event->arg;
5193 case USER_SIGNAL_EVENT:
5194 /* A user signal. */
5195 return *lispy_user_signals[event->code];
5197 /* The 'kind' field of the event is something we don't recognize. */
5198 default:
5199 abort ();
5203 #ifdef HAVE_MOUSE
5205 static Lisp_Object
5206 make_lispy_movement (frame, bar_window, part, x, y, time)
5207 FRAME_PTR frame;
5208 Lisp_Object bar_window;
5209 enum scroll_bar_part part;
5210 Lisp_Object x, y;
5211 unsigned long time;
5213 /* Is it a scroll bar movement? */
5214 if (frame && ! NILP (bar_window))
5216 Lisp_Object part_sym;
5218 part_sym = *scroll_bar_parts[(int) part];
5219 return Fcons (Qscroll_bar_movement,
5220 (Fcons (Fcons (bar_window,
5221 Fcons (Qvertical_scroll_bar,
5222 Fcons (Fcons (x, y),
5223 Fcons (make_number (time),
5224 Fcons (part_sym,
5225 Qnil))))),
5226 Qnil)));
5229 /* Or is it an ordinary mouse movement? */
5230 else
5232 int area;
5233 Lisp_Object window;
5234 Lisp_Object posn;
5236 if (frame)
5237 /* It's in a frame; which window on that frame? */
5238 window = window_from_coordinates (frame, XINT (x), XINT (y), &area, 0);
5239 else
5240 window = Qnil;
5242 if (WINDOWP (window))
5244 struct window *w = XWINDOW (window);
5245 int wx, wy;
5247 /* Get window relative coordinates. */
5248 wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (x));
5249 wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (y));
5250 XSETINT (x, wx);
5251 XSETINT (y, wy);
5253 if (area == 1)
5254 posn = Qmode_line;
5255 else if (area == 2)
5256 posn = Qvertical_line;
5257 else if (area == 3)
5258 posn = Qheader_line;
5259 else
5260 XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy));
5262 else if (frame != 0)
5264 XSETFRAME (window, frame);
5265 posn = Qnil;
5267 else
5269 window = Qnil;
5270 posn = Qnil;
5271 XSETFASTINT (x, 0);
5272 XSETFASTINT (y, 0);
5275 return Fcons (Qmouse_movement,
5276 Fcons (Fcons (window,
5277 Fcons (posn,
5278 Fcons (Fcons (x, y),
5279 Fcons (make_number (time),
5280 Qnil)))),
5281 Qnil));
5285 #endif /* HAVE_MOUSE */
5287 /* Construct a switch frame event. */
5288 static Lisp_Object
5289 make_lispy_switch_frame (frame)
5290 Lisp_Object frame;
5292 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
5295 /* Manipulating modifiers. */
5297 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
5299 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
5300 SYMBOL's name of the end of the modifiers; the string from this
5301 position is the unmodified symbol name.
5303 This doesn't use any caches. */
5305 static int
5306 parse_modifiers_uncached (symbol, modifier_end)
5307 Lisp_Object symbol;
5308 int *modifier_end;
5310 struct Lisp_String *name;
5311 int i;
5312 int modifiers;
5314 CHECK_SYMBOL (symbol, 1);
5316 modifiers = 0;
5317 name = XSYMBOL (symbol)->name;
5319 for (i = 0; i+2 <= STRING_BYTES (name); )
5321 int this_mod_end = 0;
5322 int this_mod = 0;
5324 /* See if the name continues with a modifier word.
5325 Check that the word appears, but don't check what follows it.
5326 Set this_mod and this_mod_end to record what we find. */
5328 switch (name->data[i])
5330 #define SINGLE_LETTER_MOD(BIT) \
5331 (this_mod_end = i + 1, this_mod = BIT)
5333 case 'A':
5334 SINGLE_LETTER_MOD (alt_modifier);
5335 break;
5337 case 'C':
5338 SINGLE_LETTER_MOD (ctrl_modifier);
5339 break;
5341 case 'H':
5342 SINGLE_LETTER_MOD (hyper_modifier);
5343 break;
5345 case 'M':
5346 SINGLE_LETTER_MOD (meta_modifier);
5347 break;
5349 case 'S':
5350 SINGLE_LETTER_MOD (shift_modifier);
5351 break;
5353 case 's':
5354 SINGLE_LETTER_MOD (super_modifier);
5355 break;
5357 #undef SINGLE_LETTER_MOD
5360 /* If we found no modifier, stop looking for them. */
5361 if (this_mod_end == 0)
5362 break;
5364 /* Check there is a dash after the modifier, so that it
5365 really is a modifier. */
5366 if (this_mod_end >= STRING_BYTES (name)
5367 || name->data[this_mod_end] != '-')
5368 break;
5370 /* This modifier is real; look for another. */
5371 modifiers |= this_mod;
5372 i = this_mod_end + 1;
5375 /* Should we include the `click' modifier? */
5376 if (! (modifiers & (down_modifier | drag_modifier
5377 | double_modifier | triple_modifier))
5378 && i + 7 == STRING_BYTES (name)
5379 && strncmp (name->data + i, "mouse-", 6) == 0
5380 && ('0' <= name->data[i + 6] && name->data[i + 6] <= '9'))
5381 modifiers |= click_modifier;
5383 if (modifier_end)
5384 *modifier_end = i;
5386 return modifiers;
5389 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
5390 prepended to the string BASE[0..BASE_LEN-1].
5391 This doesn't use any caches. */
5392 static Lisp_Object
5393 apply_modifiers_uncached (modifiers, base, base_len, base_len_byte)
5394 int modifiers;
5395 char *base;
5396 int base_len, base_len_byte;
5398 /* Since BASE could contain nulls, we can't use intern here; we have
5399 to use Fintern, which expects a genuine Lisp_String, and keeps a
5400 reference to it. */
5401 char *new_mods
5402 = (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
5403 int mod_len;
5406 char *p = new_mods;
5408 /* Only the event queue may use the `up' modifier; it should always
5409 be turned into a click or drag event before presented to lisp code. */
5410 if (modifiers & up_modifier)
5411 abort ();
5413 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
5414 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
5415 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
5416 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
5417 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
5418 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
5419 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
5420 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
5421 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
5422 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
5423 /* The click modifier is denoted by the absence of other modifiers. */
5425 *p = '\0';
5427 mod_len = p - new_mods;
5431 Lisp_Object new_name;
5433 new_name = make_uninit_multibyte_string (mod_len + base_len,
5434 mod_len + base_len_byte);
5435 bcopy (new_mods, XSTRING (new_name)->data, mod_len);
5436 bcopy (base, XSTRING (new_name)->data + mod_len, base_len_byte);
5438 return Fintern (new_name, Qnil);
5443 static char *modifier_names[] =
5445 "up", "down", "drag", "click", "double", "triple", 0, 0,
5446 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5447 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
5449 #define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
5451 static Lisp_Object modifier_symbols;
5453 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
5454 static Lisp_Object
5455 lispy_modifier_list (modifiers)
5456 int modifiers;
5458 Lisp_Object modifier_list;
5459 int i;
5461 modifier_list = Qnil;
5462 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
5463 if (modifiers & (1<<i))
5464 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
5465 modifier_list);
5467 return modifier_list;
5471 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
5472 where UNMODIFIED is the unmodified form of SYMBOL,
5473 MASK is the set of modifiers present in SYMBOL's name.
5474 This is similar to parse_modifiers_uncached, but uses the cache in
5475 SYMBOL's Qevent_symbol_element_mask property, and maintains the
5476 Qevent_symbol_elements property. */
5478 Lisp_Object
5479 parse_modifiers (symbol)
5480 Lisp_Object symbol;
5482 Lisp_Object elements;
5484 elements = Fget (symbol, Qevent_symbol_element_mask);
5485 if (CONSP (elements))
5486 return elements;
5487 else
5489 int end;
5490 int modifiers = parse_modifiers_uncached (symbol, &end);
5491 Lisp_Object unmodified;
5492 Lisp_Object mask;
5494 unmodified = Fintern (make_string (XSYMBOL (symbol)->name->data + end,
5495 STRING_BYTES (XSYMBOL (symbol)->name) - end),
5496 Qnil);
5498 if (modifiers & ~(((EMACS_INT)1 << VALBITS) - 1))
5499 abort ();
5500 XSETFASTINT (mask, modifiers);
5501 elements = Fcons (unmodified, Fcons (mask, Qnil));
5503 /* Cache the parsing results on SYMBOL. */
5504 Fput (symbol, Qevent_symbol_element_mask,
5505 elements);
5506 Fput (symbol, Qevent_symbol_elements,
5507 Fcons (unmodified, lispy_modifier_list (modifiers)));
5509 /* Since we know that SYMBOL is modifiers applied to unmodified,
5510 it would be nice to put that in unmodified's cache.
5511 But we can't, since we're not sure that parse_modifiers is
5512 canonical. */
5514 return elements;
5518 /* Apply the modifiers MODIFIERS to the symbol BASE.
5519 BASE must be unmodified.
5521 This is like apply_modifiers_uncached, but uses BASE's
5522 Qmodifier_cache property, if present. It also builds
5523 Qevent_symbol_elements properties, since it has that info anyway.
5525 apply_modifiers copies the value of BASE's Qevent_kind property to
5526 the modified symbol. */
5527 static Lisp_Object
5528 apply_modifiers (modifiers, base)
5529 int modifiers;
5530 Lisp_Object base;
5532 Lisp_Object cache, index, entry, new_symbol;
5534 /* Mask out upper bits. We don't know where this value's been. */
5535 modifiers &= ((EMACS_INT)1 << VALBITS) - 1;
5537 /* The click modifier never figures into cache indices. */
5538 cache = Fget (base, Qmodifier_cache);
5539 XSETFASTINT (index, (modifiers & ~click_modifier));
5540 entry = assq_no_quit (index, cache);
5542 if (CONSP (entry))
5543 new_symbol = XCDR (entry);
5544 else
5546 /* We have to create the symbol ourselves. */
5547 new_symbol = apply_modifiers_uncached (modifiers,
5548 XSYMBOL (base)->name->data,
5549 XSYMBOL (base)->name->size,
5550 STRING_BYTES (XSYMBOL (base)->name));
5552 /* Add the new symbol to the base's cache. */
5553 entry = Fcons (index, new_symbol);
5554 Fput (base, Qmodifier_cache, Fcons (entry, cache));
5556 /* We have the parsing info now for free, so add it to the caches. */
5557 XSETFASTINT (index, modifiers);
5558 Fput (new_symbol, Qevent_symbol_element_mask,
5559 Fcons (base, Fcons (index, Qnil)));
5560 Fput (new_symbol, Qevent_symbol_elements,
5561 Fcons (base, lispy_modifier_list (modifiers)));
5564 /* Make sure this symbol is of the same kind as BASE.
5566 You'd think we could just set this once and for all when we
5567 intern the symbol above, but reorder_modifiers may call us when
5568 BASE's property isn't set right; we can't assume that just
5569 because it has a Qmodifier_cache property it must have its
5570 Qevent_kind set right as well. */
5571 if (NILP (Fget (new_symbol, Qevent_kind)))
5573 Lisp_Object kind;
5575 kind = Fget (base, Qevent_kind);
5576 if (! NILP (kind))
5577 Fput (new_symbol, Qevent_kind, kind);
5580 return new_symbol;
5584 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
5585 return a symbol with the modifiers placed in the canonical order.
5586 Canonical order is alphabetical, except for down and drag, which
5587 always come last. The 'click' modifier is never written out.
5589 Fdefine_key calls this to make sure that (for example) C-M-foo
5590 and M-C-foo end up being equivalent in the keymap. */
5592 Lisp_Object
5593 reorder_modifiers (symbol)
5594 Lisp_Object symbol;
5596 /* It's hopefully okay to write the code this way, since everything
5597 will soon be in caches, and no consing will be done at all. */
5598 Lisp_Object parsed;
5600 parsed = parse_modifiers (symbol);
5601 return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))),
5602 XCAR (parsed));
5606 /* For handling events, we often want to produce a symbol whose name
5607 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
5608 to some base, like the name of a function key or mouse button.
5609 modify_event_symbol produces symbols of this sort.
5611 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
5612 is the name of the i'th symbol. TABLE_SIZE is the number of elements
5613 in the table.
5615 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
5616 into symbol names, or a string specifying a name stem used to
5617 construct a symbol name or the form `STEM-N', where N is the decimal
5618 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
5619 non-nil; otherwise NAME_TABLE is used.
5621 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
5622 persist between calls to modify_event_symbol that it can use to
5623 store a cache of the symbols it's generated for this NAME_TABLE
5624 before. The object stored there may be a vector or an alist.
5626 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
5628 MODIFIERS is a set of modifier bits (as given in struct input_events)
5629 whose prefixes should be applied to the symbol name.
5631 SYMBOL_KIND is the value to be placed in the event_kind property of
5632 the returned symbol.
5634 The symbols we create are supposed to have an
5635 `event-symbol-elements' property, which lists the modifiers present
5636 in the symbol's name. */
5638 static Lisp_Object
5639 modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist_or_stem,
5640 name_table, symbol_table, table_size)
5641 int symbol_num;
5642 unsigned modifiers;
5643 Lisp_Object symbol_kind;
5644 Lisp_Object name_alist_or_stem;
5645 char **name_table;
5646 Lisp_Object *symbol_table;
5647 unsigned int table_size;
5649 Lisp_Object value;
5650 Lisp_Object symbol_int;
5652 /* Get rid of the "vendor-specific" bit here. */
5653 XSETINT (symbol_int, symbol_num & 0xffffff);
5655 /* Is this a request for a valid symbol? */
5656 if (symbol_num < 0 || symbol_num >= table_size)
5657 return Qnil;
5659 if (CONSP (*symbol_table))
5660 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
5662 /* If *symbol_table doesn't seem to be initialized properly, fix that.
5663 *symbol_table should be a lisp vector TABLE_SIZE elements long,
5664 where the Nth element is the symbol for NAME_TABLE[N], or nil if
5665 we've never used that symbol before. */
5666 else
5668 if (! VECTORP (*symbol_table)
5669 || XVECTOR (*symbol_table)->size != table_size)
5671 Lisp_Object size;
5673 XSETFASTINT (size, table_size);
5674 *symbol_table = Fmake_vector (size, Qnil);
5677 value = XVECTOR (*symbol_table)->contents[symbol_num];
5680 /* Have we already used this symbol before? */
5681 if (NILP (value))
5683 /* No; let's create it. */
5684 if (CONSP (name_alist_or_stem))
5685 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
5686 else if (STRINGP (name_alist_or_stem))
5688 int len = STRING_BYTES (XSTRING (name_alist_or_stem));
5689 char *buf = (char *) alloca (len + 50);
5690 sprintf (buf, "%s-%d", XSTRING (name_alist_or_stem)->data,
5691 XINT (symbol_int) + 1);
5692 value = intern (buf);
5694 else if (name_table != 0 && name_table[symbol_num])
5695 value = intern (name_table[symbol_num]);
5697 #ifdef HAVE_WINDOW_SYSTEM
5698 if (NILP (value))
5700 char *name = x_get_keysym_name (symbol_num);
5701 if (name)
5702 value = intern (name);
5704 #endif
5706 if (NILP (value))
5708 char buf[20];
5709 sprintf (buf, "key-%d", symbol_num);
5710 value = intern (buf);
5713 if (CONSP (*symbol_table))
5714 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
5715 else
5716 XVECTOR (*symbol_table)->contents[symbol_num] = value;
5718 /* Fill in the cache entries for this symbol; this also
5719 builds the Qevent_symbol_elements property, which the user
5720 cares about. */
5721 apply_modifiers (modifiers & click_modifier, value);
5722 Fput (value, Qevent_kind, symbol_kind);
5725 /* Apply modifiers to that symbol. */
5726 return apply_modifiers (modifiers, value);
5729 /* Convert a list that represents an event type,
5730 such as (ctrl meta backspace), into the usual representation of that
5731 event type as a number or a symbol. */
5733 DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
5734 "Convert the event description list EVENT-DESC to an event type.\n\
5735 EVENT-DESC should contain one base event type (a character or symbol)\n\
5736 and zero or more modifier names (control, meta, hyper, super, shift, alt,\n\
5737 drag, down, double or triple). The base must be last.\n\
5738 The return value is an event type (a character or symbol) which\n\
5739 has the same base event type and all the specified modifiers.")
5740 (event_desc)
5741 Lisp_Object event_desc;
5743 Lisp_Object base;
5744 int modifiers = 0;
5745 Lisp_Object rest;
5747 base = Qnil;
5748 rest = event_desc;
5749 while (CONSP (rest))
5751 Lisp_Object elt;
5752 int this = 0;
5754 elt = XCAR (rest);
5755 rest = XCDR (rest);
5757 /* Given a symbol, see if it is a modifier name. */
5758 if (SYMBOLP (elt) && CONSP (rest))
5759 this = parse_solitary_modifier (elt);
5761 if (this != 0)
5762 modifiers |= this;
5763 else if (!NILP (base))
5764 error ("Two bases given in one event");
5765 else
5766 base = elt;
5770 /* Let the symbol A refer to the character A. */
5771 if (SYMBOLP (base) && XSYMBOL (base)->name->size == 1)
5772 XSETINT (base, XSYMBOL (base)->name->data[0]);
5774 if (INTEGERP (base))
5776 /* Turn (shift a) into A. */
5777 if ((modifiers & shift_modifier) != 0
5778 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
5780 XSETINT (base, XINT (base) - ('a' - 'A'));
5781 modifiers &= ~shift_modifier;
5784 /* Turn (control a) into C-a. */
5785 if (modifiers & ctrl_modifier)
5786 return make_number ((modifiers & ~ctrl_modifier)
5787 | make_ctrl_char (XINT (base)));
5788 else
5789 return make_number (modifiers | XINT (base));
5791 else if (SYMBOLP (base))
5792 return apply_modifiers (modifiers, base);
5793 else
5795 error ("Invalid base event");
5796 return Qnil;
5800 /* Try to recognize SYMBOL as a modifier name.
5801 Return the modifier flag bit, or 0 if not recognized. */
5803 static int
5804 parse_solitary_modifier (symbol)
5805 Lisp_Object symbol;
5807 struct Lisp_String *name = XSYMBOL (symbol)->name;
5809 switch (name->data[0])
5811 #define SINGLE_LETTER_MOD(BIT) \
5812 if (STRING_BYTES (name) == 1) \
5813 return BIT;
5815 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
5816 if (LEN == STRING_BYTES (name) \
5817 && ! strncmp (name->data, NAME, LEN)) \
5818 return BIT;
5820 case 'A':
5821 SINGLE_LETTER_MOD (alt_modifier);
5822 break;
5824 case 'a':
5825 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
5826 break;
5828 case 'C':
5829 SINGLE_LETTER_MOD (ctrl_modifier);
5830 break;
5832 case 'c':
5833 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
5834 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
5835 break;
5837 case 'H':
5838 SINGLE_LETTER_MOD (hyper_modifier);
5839 break;
5841 case 'h':
5842 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
5843 break;
5845 case 'M':
5846 SINGLE_LETTER_MOD (meta_modifier);
5847 break;
5849 case 'm':
5850 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
5851 break;
5853 case 'S':
5854 SINGLE_LETTER_MOD (shift_modifier);
5855 break;
5857 case 's':
5858 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
5859 MULTI_LETTER_MOD (super_modifier, "super", 5);
5860 SINGLE_LETTER_MOD (super_modifier);
5861 break;
5863 case 'd':
5864 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
5865 MULTI_LETTER_MOD (down_modifier, "down", 4);
5866 MULTI_LETTER_MOD (double_modifier, "double", 6);
5867 break;
5869 case 't':
5870 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
5871 break;
5873 #undef SINGLE_LETTER_MOD
5874 #undef MULTI_LETTER_MOD
5877 return 0;
5880 /* Return 1 if EVENT is a list whose elements are all integers or symbols.
5881 Such a list is not valid as an event,
5882 but it can be a Lucid-style event type list. */
5885 lucid_event_type_list_p (object)
5886 Lisp_Object object;
5888 Lisp_Object tail;
5890 if (! CONSP (object))
5891 return 0;
5893 if (EQ (XCAR (object), Qhelp_echo)
5894 || EQ (XCAR (object), Qvertical_line)
5895 || EQ (XCAR (object), Qmode_line)
5896 || EQ (XCAR (object), Qheader_line))
5897 return 0;
5899 for (tail = object; CONSP (tail); tail = XCDR (tail))
5901 Lisp_Object elt;
5902 elt = XCAR (tail);
5903 if (! (INTEGERP (elt) || SYMBOLP (elt)))
5904 return 0;
5907 return NILP (tail);
5910 /* Store into *addr a value nonzero if terminal input chars are available.
5911 Serves the purpose of ioctl (0, FIONREAD, addr)
5912 but works even if FIONREAD does not exist.
5913 (In fact, this may actually read some input.)
5915 If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe. */
5917 static void
5918 get_input_pending (addr, do_timers_now)
5919 int *addr;
5920 int do_timers_now;
5922 /* First of all, have we already counted some input? */
5923 *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
5925 /* If input is being read as it arrives, and we have none, there is none. */
5926 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
5927 return;
5929 /* Try to read some input and see how much we get. */
5930 gobble_input (0);
5931 *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
5934 /* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
5936 void
5937 gobble_input (expected)
5938 int expected;
5940 #ifndef VMS
5941 #ifdef SIGIO
5942 if (interrupt_input)
5944 SIGMASKTYPE mask;
5945 mask = sigblock (sigmask (SIGIO));
5946 read_avail_input (expected);
5947 sigsetmask (mask);
5949 else
5950 #ifdef POLL_FOR_INPUT
5951 if (read_socket_hook && !interrupt_input && poll_suppress_count == 0)
5953 SIGMASKTYPE mask;
5954 mask = sigblock (sigmask (SIGALRM));
5955 read_avail_input (expected);
5956 sigsetmask (mask);
5958 else
5959 #endif
5960 #endif
5961 read_avail_input (expected);
5962 #endif
5965 /* Put a buffer_switch_event in the buffer
5966 so that read_key_sequence will notice the new current buffer. */
5968 void
5969 record_asynch_buffer_change ()
5971 struct input_event event;
5972 Lisp_Object tem;
5974 event.kind = buffer_switch_event;
5975 event.frame_or_window = Qnil;
5976 event.arg = Qnil;
5978 #ifdef subprocesses
5979 /* We don't need a buffer-switch event unless Emacs is waiting for input.
5980 The purpose of the event is to make read_key_sequence look up the
5981 keymaps again. If we aren't in read_key_sequence, we don't need one,
5982 and the event could cause trouble by messing up (input-pending-p). */
5983 tem = Fwaiting_for_user_input_p ();
5984 if (NILP (tem))
5985 return;
5986 #else
5987 /* We never need these events if we have no asynchronous subprocesses. */
5988 return;
5989 #endif
5991 /* Make sure no interrupt happens while storing the event. */
5992 #ifdef SIGIO
5993 if (interrupt_input)
5995 SIGMASKTYPE mask;
5996 mask = sigblock (sigmask (SIGIO));
5997 kbd_buffer_store_event (&event);
5998 sigsetmask (mask);
6000 else
6001 #endif
6003 stop_polling ();
6004 kbd_buffer_store_event (&event);
6005 start_polling ();
6009 #ifndef VMS
6011 /* Read any terminal input already buffered up by the system
6012 into the kbd_buffer, but do not wait.
6014 EXPECTED should be nonzero if the caller knows there is some input.
6016 Except on VMS, all input is read by this function.
6017 If interrupt_input is nonzero, this function MUST be called
6018 only when SIGIO is blocked.
6020 Returns the number of keyboard chars read, or -1 meaning
6021 this is a bad time to try to read input. */
6023 static int
6024 read_avail_input (expected)
6025 int expected;
6027 struct input_event buf[KBD_BUFFER_SIZE];
6028 register int i;
6029 int nread;
6031 if (read_socket_hook)
6032 /* No need for FIONREAD or fcntl; just say don't wait. */
6033 nread = (*read_socket_hook) (input_fd, buf, KBD_BUFFER_SIZE, expected);
6034 else
6036 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
6037 the kbd_buffer can really hold. That may prevent loss
6038 of characters on some systems when input is stuffed at us. */
6039 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
6040 int n_to_read;
6042 /* Determine how many characters we should *try* to read. */
6043 #ifdef WINDOWSNT
6044 return 0;
6045 #else /* not WINDOWSNT */
6046 #ifdef MSDOS
6047 n_to_read = dos_keysns ();
6048 if (n_to_read == 0)
6049 return 0;
6050 #else /* not MSDOS */
6051 #ifdef FIONREAD
6052 /* Find out how much input is available. */
6053 if (ioctl (input_fd, FIONREAD, &n_to_read) < 0)
6054 /* Formerly simply reported no input, but that sometimes led to
6055 a failure of Emacs to terminate.
6056 SIGHUP seems appropriate if we can't reach the terminal. */
6057 /* ??? Is it really right to send the signal just to this process
6058 rather than to the whole process group?
6059 Perhaps on systems with FIONREAD Emacs is alone in its group. */
6060 kill (getpid (), SIGHUP);
6061 if (n_to_read == 0)
6062 return 0;
6063 if (n_to_read > sizeof cbuf)
6064 n_to_read = sizeof cbuf;
6065 #else /* no FIONREAD */
6066 #if defined (USG) || defined (DGUX)
6067 /* Read some input if available, but don't wait. */
6068 n_to_read = sizeof cbuf;
6069 fcntl (input_fd, F_SETFL, O_NDELAY);
6070 #else
6071 you lose;
6072 #endif
6073 #endif
6074 #endif /* not MSDOS */
6075 #endif /* not WINDOWSNT */
6077 /* Now read; for one reason or another, this will not block.
6078 NREAD is set to the number of chars read. */
6081 #ifdef MSDOS
6082 cbuf[0] = dos_keyread ();
6083 nread = 1;
6084 #else
6085 nread = emacs_read (input_fd, cbuf, n_to_read);
6086 #endif
6087 /* POSIX infers that processes which are not in the session leader's
6088 process group won't get SIGHUP's at logout time. BSDI adheres to
6089 this part standard and returns -1 from read (0) with errno==EIO
6090 when the control tty is taken away.
6091 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
6092 if (nread == -1 && errno == EIO)
6093 kill (0, SIGHUP);
6094 #if defined (AIX) && (! defined (aix386) && defined (_BSD))
6095 /* The kernel sometimes fails to deliver SIGHUP for ptys.
6096 This looks incorrect, but it isn't, because _BSD causes
6097 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
6098 and that causes a value other than 0 when there is no input. */
6099 if (nread == 0)
6100 kill (0, SIGHUP);
6101 #endif
6103 while (
6104 /* We used to retry the read if it was interrupted.
6105 But this does the wrong thing when O_NDELAY causes
6106 an EAGAIN error. Does anybody know of a situation
6107 where a retry is actually needed? */
6108 #if 0
6109 nread < 0 && (errno == EAGAIN
6110 #ifdef EFAULT
6111 || errno == EFAULT
6112 #endif
6113 #ifdef EBADSLT
6114 || errno == EBADSLT
6115 #endif
6117 #else
6119 #endif
6122 #ifndef FIONREAD
6123 #if defined (USG) || defined (DGUX)
6124 fcntl (input_fd, F_SETFL, 0);
6125 #endif /* USG or DGUX */
6126 #endif /* no FIONREAD */
6127 for (i = 0; i < nread; i++)
6129 buf[i].kind = ascii_keystroke;
6130 buf[i].modifiers = 0;
6131 if (meta_key == 1 && (cbuf[i] & 0x80))
6132 buf[i].modifiers = meta_modifier;
6133 if (meta_key != 2)
6134 cbuf[i] &= ~0x80;
6136 buf[i].code = cbuf[i];
6137 buf[i].frame_or_window = selected_frame;
6138 buf[i].arg = Qnil;
6142 /* Scan the chars for C-g and store them in kbd_buffer. */
6143 for (i = 0; i < nread; i++)
6145 kbd_buffer_store_event (&buf[i]);
6146 /* Don't look at input that follows a C-g too closely.
6147 This reduces lossage due to autorepeat on C-g. */
6148 if (buf[i].kind == ascii_keystroke
6149 && buf[i].code == quit_char)
6150 break;
6153 return nread;
6155 #endif /* not VMS */
6157 #ifdef SIGIO /* for entire page */
6158 /* Note SIGIO has been undef'd if FIONREAD is missing. */
6160 SIGTYPE
6161 input_available_signal (signo)
6162 int signo;
6164 /* Must preserve main program's value of errno. */
6165 int old_errno = errno;
6166 #ifdef BSD4_1
6167 extern int select_alarmed;
6168 #endif
6170 #if defined (USG) && !defined (POSIX_SIGNALS)
6171 /* USG systems forget handlers when they are used;
6172 must reestablish each time */
6173 signal (signo, input_available_signal);
6174 #endif /* USG */
6176 #ifdef BSD4_1
6177 sigisheld (SIGIO);
6178 #endif
6180 if (input_available_clear_time)
6181 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
6183 while (1)
6185 int nread;
6186 nread = read_avail_input (1);
6187 /* -1 means it's not ok to read the input now.
6188 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
6189 0 means there was no keyboard input available. */
6190 if (nread <= 0)
6191 break;
6193 #ifdef BSD4_1
6194 select_alarmed = 1; /* Force the select emulator back to life */
6195 #endif
6198 #ifdef BSD4_1
6199 sigfree ();
6200 #endif
6201 errno = old_errno;
6203 #endif /* SIGIO */
6205 /* Send ourselves a SIGIO.
6207 This function exists so that the UNBLOCK_INPUT macro in
6208 blockinput.h can have some way to take care of input we put off
6209 dealing with, without assuming that every file which uses
6210 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
6211 void
6212 reinvoke_input_signal ()
6214 #ifdef SIGIO
6215 kill (getpid (), SIGIO);
6216 #endif
6221 /* Return the prompt-string of a sparse keymap.
6222 This is the first element which is a string.
6223 Return nil if there is none. */
6225 Lisp_Object
6226 map_prompt (map)
6227 Lisp_Object map;
6229 while (CONSP (map))
6231 register Lisp_Object tem;
6232 tem = Fcar (map);
6233 if (STRINGP (tem))
6234 return tem;
6235 map = Fcdr (map);
6237 return Qnil;
6240 static void menu_bar_item P_ ((Lisp_Object, Lisp_Object));
6241 static void menu_bar_one_keymap P_ ((Lisp_Object));
6243 /* These variables hold the vector under construction within
6244 menu_bar_items and its subroutines, and the current index
6245 for storing into that vector. */
6246 static Lisp_Object menu_bar_items_vector;
6247 static int menu_bar_items_index;
6249 /* Return a vector of menu items for a menu bar, appropriate
6250 to the current buffer. Each item has three elements in the vector:
6251 KEY STRING MAPLIST.
6253 OLD is an old vector we can optionally reuse, or nil. */
6255 Lisp_Object
6256 menu_bar_items (old)
6257 Lisp_Object old;
6259 /* The number of keymaps we're scanning right now, and the number of
6260 keymaps we have allocated space for. */
6261 int nmaps;
6263 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
6264 in the current keymaps, or nil where it is not a prefix. */
6265 Lisp_Object *maps;
6267 Lisp_Object def, tem, tail;
6269 Lisp_Object result;
6271 int mapno;
6272 Lisp_Object oquit;
6274 int i;
6276 struct gcpro gcpro1;
6278 /* In order to build the menus, we need to call the keymap
6279 accessors. They all call QUIT. But this function is called
6280 during redisplay, during which a quit is fatal. So inhibit
6281 quitting while building the menus.
6282 We do this instead of specbind because (1) errors will clear it anyway
6283 and (2) this avoids risk of specpdl overflow. */
6284 oquit = Vinhibit_quit;
6285 Vinhibit_quit = Qt;
6287 if (!NILP (old))
6288 menu_bar_items_vector = old;
6289 else
6290 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
6291 menu_bar_items_index = 0;
6293 GCPRO1 (menu_bar_items_vector);
6295 /* Build our list of keymaps.
6296 If we recognize a function key and replace its escape sequence in
6297 keybuf with its symbol, or if the sequence starts with a mouse
6298 click and we need to switch buffers, we jump back here to rebuild
6299 the initial keymaps from the current buffer. */
6301 Lisp_Object *tmaps;
6303 /* Should overriding-terminal-local-map and overriding-local-map apply? */
6304 if (!NILP (Voverriding_local_map_menu_flag))
6306 /* Yes, use them (if non-nil) as well as the global map. */
6307 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
6308 nmaps = 0;
6309 if (!NILP (current_kboard->Voverriding_terminal_local_map))
6310 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
6311 if (!NILP (Voverriding_local_map))
6312 maps[nmaps++] = Voverriding_local_map;
6314 else
6316 /* No, so use major and minor mode keymaps and keymap property. */
6317 int extra_maps = 2;
6318 Lisp_Object map = get_local_map (PT, current_buffer, keymap);
6319 if (!NILP (map))
6320 extra_maps = 3;
6321 nmaps = current_minor_maps (NULL, &tmaps);
6322 maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
6323 * sizeof (maps[0]));
6324 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
6325 if (!NILP (map))
6326 maps[nmaps++] = map;
6327 maps[nmaps++] = get_local_map (PT, current_buffer, local_map);
6329 maps[nmaps++] = current_global_map;
6332 /* Look up in each map the dummy prefix key `menu-bar'. */
6334 result = Qnil;
6336 for (mapno = nmaps - 1; mapno >= 0; mapno--)
6337 if (!NILP (maps[mapno]))
6339 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
6340 0, 1);
6341 if (CONSP (def))
6342 menu_bar_one_keymap (def);
6345 /* Move to the end those items that should be at the end. */
6347 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
6349 int i;
6350 int end = menu_bar_items_index;
6352 for (i = 0; i < end; i += 4)
6353 if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i]))
6355 Lisp_Object tem0, tem1, tem2, tem3;
6356 /* Move the item at index I to the end,
6357 shifting all the others forward. */
6358 tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
6359 tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
6360 tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
6361 tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
6362 if (end > i + 4)
6363 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
6364 &XVECTOR (menu_bar_items_vector)->contents[i],
6365 (end - i - 4) * sizeof (Lisp_Object));
6366 XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
6367 XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
6368 XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
6369 XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
6370 break;
6374 /* Add nil, nil, nil, nil at the end. */
6375 i = menu_bar_items_index;
6376 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
6378 Lisp_Object tem;
6379 tem = Fmake_vector (make_number (2 * i), Qnil);
6380 bcopy (XVECTOR (menu_bar_items_vector)->contents,
6381 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
6382 menu_bar_items_vector = tem;
6384 /* Add this item. */
6385 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6386 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6387 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6388 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6389 menu_bar_items_index = i;
6391 Vinhibit_quit = oquit;
6392 UNGCPRO;
6393 return menu_bar_items_vector;
6396 /* Scan one map KEYMAP, accumulating any menu items it defines
6397 in menu_bar_items_vector. */
6399 static Lisp_Object menu_bar_one_keymap_changed_items;
6401 static void
6402 menu_bar_one_keymap (keymap)
6403 Lisp_Object keymap;
6405 Lisp_Object tail, item;
6407 menu_bar_one_keymap_changed_items = Qnil;
6409 /* Loop over all keymap entries that have menu strings. */
6410 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
6412 item = XCAR (tail);
6413 if (CONSP (item))
6414 menu_bar_item (XCAR (item), XCDR (item));
6415 else if (VECTORP (item))
6417 /* Loop over the char values represented in the vector. */
6418 int len = XVECTOR (item)->size;
6419 int c;
6420 for (c = 0; c < len; c++)
6422 Lisp_Object character;
6423 XSETFASTINT (character, c);
6424 menu_bar_item (character, XVECTOR (item)->contents[c]);
6430 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
6431 If there's already an item for KEY, add this DEF to it. */
6433 Lisp_Object item_properties;
6435 static void
6436 menu_bar_item (key, item)
6437 Lisp_Object key, item;
6439 struct gcpro gcpro1;
6440 int i;
6441 Lisp_Object tem;
6443 if (EQ (item, Qundefined))
6445 /* If a map has an explicit `undefined' as definition,
6446 discard any previously made menu bar item. */
6448 for (i = 0; i < menu_bar_items_index; i += 4)
6449 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
6451 if (menu_bar_items_index > i + 4)
6452 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
6453 &XVECTOR (menu_bar_items_vector)->contents[i],
6454 (menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
6455 menu_bar_items_index -= 4;
6459 /* If this keymap has already contributed to this KEY,
6460 don't contribute to it a second time. */
6461 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
6462 if (!NILP (tem) || NILP (item))
6463 return;
6465 menu_bar_one_keymap_changed_items
6466 = Fcons (key, menu_bar_one_keymap_changed_items);
6468 /* We add to menu_bar_one_keymap_changed_items before doing the
6469 parse_menu_item, so that if it turns out it wasn't a menu item,
6470 it still correctly hides any further menu item. */
6471 GCPRO1 (key);
6472 i = parse_menu_item (item, 0, 1);
6473 UNGCPRO;
6474 if (!i)
6475 return;
6477 item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
6479 /* Find any existing item for this KEY. */
6480 for (i = 0; i < menu_bar_items_index; i += 4)
6481 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
6482 break;
6484 /* If we did not find this KEY, add it at the end. */
6485 if (i == menu_bar_items_index)
6487 /* If vector is too small, get a bigger one. */
6488 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
6490 Lisp_Object tem;
6491 tem = Fmake_vector (make_number (2 * i), Qnil);
6492 bcopy (XVECTOR (menu_bar_items_vector)->contents,
6493 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
6494 menu_bar_items_vector = tem;
6497 /* Add this item. */
6498 XVECTOR (menu_bar_items_vector)->contents[i++] = key;
6499 XVECTOR (menu_bar_items_vector)->contents[i++]
6500 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
6501 XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
6502 XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
6503 menu_bar_items_index = i;
6505 /* We did find an item for this KEY. Add ITEM to its list of maps. */
6506 else
6508 Lisp_Object old;
6509 old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
6510 XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (item, old);
6514 /* This is used as the handler when calling menu_item_eval_property. */
6515 static Lisp_Object
6516 menu_item_eval_property_1 (arg)
6517 Lisp_Object arg;
6519 /* If we got a quit from within the menu computation,
6520 quit all the way out of it. This takes care of C-] in the debugger. */
6521 if (CONSP (arg) && EQ (XCAR (arg), Qquit))
6522 Fsignal (Qquit, Qnil);
6524 return Qnil;
6527 /* Evaluate an expression and return the result (or nil if something
6528 went wrong). Used to evaluate dynamic parts of menu items. */
6529 Lisp_Object
6530 menu_item_eval_property (sexpr)
6531 Lisp_Object sexpr;
6533 int count = specpdl_ptr - specpdl;
6534 Lisp_Object val;
6535 specbind (Qinhibit_redisplay, Qt);
6536 val = internal_condition_case_1 (Feval, sexpr, Qerror,
6537 menu_item_eval_property_1);
6538 return unbind_to (count, val);
6541 /* This function parses a menu item and leaves the result in the
6542 vector item_properties.
6543 ITEM is a key binding, a possible menu item.
6544 If NOTREAL is nonzero, only check for equivalent key bindings, don't
6545 evaluate dynamic expressions in the menu item.
6546 INMENUBAR is > 0 when this is considered for an entry in a menu bar
6547 top level.
6548 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
6549 parse_menu_item returns true if the item is a menu item and false
6550 otherwise. */
6553 parse_menu_item (item, notreal, inmenubar)
6554 Lisp_Object item;
6555 int notreal, inmenubar;
6557 Lisp_Object def, tem, item_string, start;
6558 Lisp_Object cachelist;
6559 Lisp_Object filter;
6560 Lisp_Object keyhint;
6561 int i;
6562 int newcache = 0;
6564 cachelist = Qnil;
6565 filter = Qnil;
6566 keyhint = Qnil;
6568 if (!CONSP (item))
6569 return 0;
6571 /* Create item_properties vector if necessary. */
6572 if (NILP (item_properties))
6573 item_properties
6574 = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
6576 /* Initialize optional entries. */
6577 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
6578 AREF (item_properties, i) = Qnil;
6579 AREF (item_properties, ITEM_PROPERTY_ENABLE) = Qt;
6581 /* Save the item here to protect it from GC. */
6582 AREF (item_properties, ITEM_PROPERTY_ITEM) = item;
6584 item_string = XCAR (item);
6586 start = item;
6587 item = XCDR (item);
6588 if (STRINGP (item_string))
6590 /* Old format menu item. */
6591 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
6593 /* Maybe help string. */
6594 if (CONSP (item) && STRINGP (XCAR (item)))
6596 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
6597 start = item;
6598 item = XCDR (item);
6601 /* Maybe key binding cache. */
6602 if (CONSP (item) && CONSP (XCAR (item))
6603 && (NILP (XCAR (XCAR (item)))
6604 || VECTORP (XCAR (XCAR (item)))))
6606 cachelist = XCAR (item);
6607 item = XCDR (item);
6610 /* This is the real definition--the function to run. */
6611 AREF (item_properties, ITEM_PROPERTY_DEF) = item;
6613 /* Get enable property, if any. */
6614 if (SYMBOLP (item))
6616 tem = Fget (item, Qmenu_enable);
6617 if (!NILP (tem))
6618 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
6621 else if (EQ (item_string, Qmenu_item) && CONSP (item))
6623 /* New format menu item. */
6624 AREF (item_properties, ITEM_PROPERTY_NAME) = XCAR (item);
6625 start = XCDR (item);
6626 if (CONSP (start))
6628 /* We have a real binding. */
6629 AREF (item_properties, ITEM_PROPERTY_DEF) = XCAR (start);
6631 item = XCDR (start);
6632 /* Is there a cache list with key equivalences. */
6633 if (CONSP (item) && CONSP (XCAR (item)))
6635 cachelist = XCAR (item);
6636 item = XCDR (item);
6639 /* Parse properties. */
6640 while (CONSP (item) && CONSP (XCDR (item)))
6642 tem = XCAR (item);
6643 item = XCDR (item);
6645 if (EQ (tem, QCenable))
6646 AREF (item_properties, ITEM_PROPERTY_ENABLE) = XCAR (item);
6647 else if (EQ (tem, QCvisible) && !notreal)
6649 /* If got a visible property and that evaluates to nil
6650 then ignore this item. */
6651 tem = menu_item_eval_property (XCAR (item));
6652 if (NILP (tem))
6653 return 0;
6655 else if (EQ (tem, QChelp))
6656 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
6657 else if (EQ (tem, QCfilter))
6658 filter = item;
6659 else if (EQ (tem, QCkey_sequence))
6661 tem = XCAR (item);
6662 if (NILP (cachelist)
6663 && (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem)))
6664 /* Be GC protected. Set keyhint to item instead of tem. */
6665 keyhint = item;
6667 else if (EQ (tem, QCkeys))
6669 tem = XCAR (item);
6670 if (CONSP (tem) || (STRINGP (tem) && NILP (cachelist)))
6671 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
6673 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
6675 Lisp_Object type;
6676 tem = XCAR (item);
6677 type = XCAR (tem);
6678 if (EQ (type, QCtoggle) || EQ (type, QCradio))
6680 AREF (item_properties, ITEM_PROPERTY_SELECTED)
6681 = XCDR (tem);
6682 AREF (item_properties, ITEM_PROPERTY_TYPE)
6683 = type;
6686 item = XCDR (item);
6689 else if (inmenubar || !NILP (start))
6690 return 0;
6692 else
6693 return 0; /* not a menu item */
6695 /* If item string is not a string, evaluate it to get string.
6696 If we don't get a string, skip this item. */
6697 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
6698 if (!(STRINGP (item_string) || notreal))
6700 item_string = menu_item_eval_property (item_string);
6701 if (!STRINGP (item_string))
6702 return 0;
6703 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
6706 /* If got a filter apply it on definition. */
6707 def = AREF (item_properties, ITEM_PROPERTY_DEF);
6708 if (!NILP (filter))
6710 def = menu_item_eval_property (list2 (XCAR (filter),
6711 list2 (Qquote, def)));
6713 AREF (item_properties, ITEM_PROPERTY_DEF) = def;
6716 /* If we got no definition, this item is just unselectable text which
6717 is OK in a submenu but not in the menubar. */
6718 if (NILP (def))
6719 return (inmenubar ? 0 : 1);
6721 /* Enable or disable selection of item. */
6722 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
6723 if (!EQ (tem, Qt))
6725 if (notreal)
6726 tem = Qt;
6727 else
6728 tem = menu_item_eval_property (tem);
6729 if (inmenubar && NILP (tem))
6730 return 0; /* Ignore disabled items in menu bar. */
6731 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
6734 /* See if this is a separate pane or a submenu. */
6735 def = AREF (item_properties, ITEM_PROPERTY_DEF);
6736 tem = get_keymap (def, 0, 1);
6737 /* For a subkeymap, just record its details and exit. */
6738 if (CONSP (tem))
6740 AREF (item_properties, ITEM_PROPERTY_MAP) = tem;
6741 AREF (item_properties, ITEM_PROPERTY_DEF) = tem;
6742 return 1;
6745 /* At the top level in the menu bar, do likewise for commands also.
6746 The menu bar does not display equivalent key bindings anyway.
6747 ITEM_PROPERTY_DEF is already set up properly. */
6748 if (inmenubar > 0)
6749 return 1;
6751 /* This is a command. See if there is an equivalent key binding. */
6752 if (NILP (cachelist))
6754 /* We have to create a cachelist. */
6755 CHECK_IMPURE (start);
6756 XCDR (start) = Fcons (Fcons (Qnil, Qnil), XCDR (start));
6757 cachelist = XCAR (XCDR (start));
6758 newcache = 1;
6759 tem = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
6760 if (!NILP (keyhint))
6762 XCAR (cachelist) = XCAR (keyhint);
6763 newcache = 0;
6765 else if (STRINGP (tem))
6767 XCDR (cachelist) = Fsubstitute_command_keys (tem);
6768 XCAR (cachelist) = Qt;
6772 tem = XCAR (cachelist);
6773 if (!EQ (tem, Qt))
6775 int chkcache = 0;
6776 Lisp_Object prefix;
6778 if (!NILP (tem))
6779 tem = Fkey_binding (tem, Qnil);
6781 prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
6782 if (CONSP (prefix))
6784 def = XCAR (prefix);
6785 prefix = XCDR (prefix);
6787 else
6788 def = AREF (item_properties, ITEM_PROPERTY_DEF);
6790 if (!update_menu_bindings)
6791 chkcache = 0;
6792 else if (NILP (XCAR (cachelist))) /* Have no saved key. */
6794 if (newcache /* Always check first time. */
6795 /* Should we check everything when precomputing key
6796 bindings? */
6797 /* If something had no key binding before, don't recheck it
6798 because that is too slow--except if we have a list of
6799 rebound commands in Vdefine_key_rebound_commands, do
6800 recheck any command that appears in that list. */
6801 || (CONSP (Vdefine_key_rebound_commands)
6802 && !NILP (Fmemq (def, Vdefine_key_rebound_commands))))
6803 chkcache = 1;
6805 /* We had a saved key. Is it still bound to the command? */
6806 else if (NILP (tem)
6807 || (!EQ (tem, def)
6808 /* If the command is an alias for another
6809 (such as lmenu.el set it up), check if the
6810 original command matches the cached command. */
6811 && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))))
6812 chkcache = 1; /* Need to recompute key binding. */
6814 if (chkcache)
6816 /* Recompute equivalent key binding. If the command is an alias
6817 for another (such as lmenu.el set it up), see if the original
6818 command name has equivalent keys. Otherwise look up the
6819 specified command itself. We don't try both, because that
6820 makes lmenu menus slow. */
6821 if (SYMBOLP (def)
6822 && SYMBOLP (XSYMBOL (def)->function)
6823 && ! NILP (Fget (def, Qmenu_alias)))
6824 def = XSYMBOL (def)->function;
6825 tem = Fwhere_is_internal (def, Qnil, Qt, Qnil);
6826 XCAR (cachelist) = tem;
6827 if (NILP (tem))
6829 XCDR (cachelist) = Qnil;
6830 chkcache = 0;
6833 else if (!NILP (keyhint) && !NILP (XCAR (cachelist)))
6835 tem = XCAR (cachelist);
6836 chkcache = 1;
6839 newcache = chkcache;
6840 if (chkcache)
6842 tem = Fkey_description (tem);
6843 if (CONSP (prefix))
6845 if (STRINGP (XCAR (prefix)))
6846 tem = concat2 (XCAR (prefix), tem);
6847 if (STRINGP (XCDR (prefix)))
6848 tem = concat2 (tem, XCDR (prefix));
6850 XCDR (cachelist) = tem;
6854 tem = XCDR (cachelist);
6855 if (newcache && !NILP (tem))
6857 tem = concat3 (build_string (" ("), tem, build_string (")"));
6858 XCDR (cachelist) = tem;
6861 /* If we only want to precompute equivalent key bindings, stop here. */
6862 if (notreal)
6863 return 1;
6865 /* If we have an equivalent key binding, use that. */
6866 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
6868 /* Include this when menu help is implemented.
6869 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
6870 if (!(NILP (tem) || STRINGP (tem)))
6872 tem = menu_item_eval_property (tem);
6873 if (!STRINGP (tem))
6874 tem = Qnil;
6875 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
6879 /* Handle radio buttons or toggle boxes. */
6880 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
6881 if (!NILP (tem))
6882 AREF (item_properties, ITEM_PROPERTY_SELECTED)
6883 = menu_item_eval_property (tem);
6885 return 1;
6890 /***********************************************************************
6891 Tool-bars
6892 ***********************************************************************/
6894 /* A vector holding tool bar items while they are parsed in function
6895 tool_bar_items runs Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
6896 in the vector. */
6898 static Lisp_Object tool_bar_items_vector;
6900 /* A vector holding the result of parse_tool_bar_item. Layout is like
6901 the one for a single item in tool_bar_items_vector. */
6903 static Lisp_Object tool_bar_item_properties;
6905 /* Next free index in tool_bar_items_vector. */
6907 static int ntool_bar_items;
6909 /* The symbols `tool-bar', and `:image'. */
6911 extern Lisp_Object Qtool_bar;
6912 Lisp_Object QCimage;
6914 /* Function prototypes. */
6916 static void init_tool_bar_items P_ ((Lisp_Object));
6917 static void process_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
6918 static int parse_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
6919 static void append_tool_bar_item P_ ((void));
6922 /* Return a vector of tool bar items for keymaps currently in effect.
6923 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
6924 tool bar items found. */
6926 Lisp_Object
6927 tool_bar_items (reuse, nitems)
6928 Lisp_Object reuse;
6929 int *nitems;
6931 Lisp_Object *maps;
6932 int nmaps, i;
6933 Lisp_Object oquit;
6934 Lisp_Object *tmaps;
6935 extern Lisp_Object Voverriding_local_map_menu_flag;
6936 extern Lisp_Object Voverriding_local_map;
6938 *nitems = 0;
6940 /* In order to build the menus, we need to call the keymap
6941 accessors. They all call QUIT. But this function is called
6942 during redisplay, during which a quit is fatal. So inhibit
6943 quitting while building the menus. We do this instead of
6944 specbind because (1) errors will clear it anyway and (2) this
6945 avoids risk of specpdl overflow. */
6946 oquit = Vinhibit_quit;
6947 Vinhibit_quit = Qt;
6949 /* Initialize tool_bar_items_vector and protect it from GC. */
6950 init_tool_bar_items (reuse);
6952 /* Build list of keymaps in maps. Set nmaps to the number of maps
6953 to process. */
6955 /* Should overriding-terminal-local-map and overriding-local-map apply? */
6956 if (!NILP (Voverriding_local_map_menu_flag))
6958 /* Yes, use them (if non-nil) as well as the global map. */
6959 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
6960 nmaps = 0;
6961 if (!NILP (current_kboard->Voverriding_terminal_local_map))
6962 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
6963 if (!NILP (Voverriding_local_map))
6964 maps[nmaps++] = Voverriding_local_map;
6966 else
6968 /* No, so use major and minor mode keymaps and keymap property. */
6969 int extra_maps = 2;
6970 Lisp_Object map = get_local_map (PT, current_buffer, keymap);
6971 if (!NILP (map))
6972 extra_maps = 3;
6973 nmaps = current_minor_maps (NULL, &tmaps);
6974 maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
6975 * sizeof (maps[0]));
6976 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
6977 if (!NILP (map))
6978 maps[nmaps++] = map;
6979 maps[nmaps++] = get_local_map (PT, current_buffer, local_map);
6982 /* Add global keymap at the end. */
6983 maps[nmaps++] = current_global_map;
6985 /* Process maps in reverse order and look up in each map the prefix
6986 key `tool-bar'. */
6987 for (i = nmaps - 1; i >= 0; --i)
6988 if (!NILP (maps[i]))
6990 Lisp_Object keymap;
6992 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
6993 if (CONSP (keymap))
6995 Lisp_Object tail;
6997 /* KEYMAP is a list `(keymap (KEY . BINDING) ...)'. */
6998 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
7000 Lisp_Object keydef = XCAR (tail);
7001 if (CONSP (keydef))
7002 process_tool_bar_item (XCAR (keydef), XCDR (keydef));
7007 Vinhibit_quit = oquit;
7008 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
7009 return tool_bar_items_vector;
7013 /* Process the definition of KEY which is DEF. */
7015 static void
7016 process_tool_bar_item (key, def)
7017 Lisp_Object key, def;
7019 int i;
7020 extern Lisp_Object Qundefined;
7021 struct gcpro gcpro1, gcpro2;
7023 /* Protect KEY and DEF from GC because parse_tool_bar_item may call
7024 eval. */
7025 GCPRO2 (key, def);
7027 if (EQ (def, Qundefined))
7029 /* If a map has an explicit `undefined' as definition,
7030 discard any previously made item. */
7031 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
7033 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
7035 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
7037 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
7038 bcopy (v + TOOL_BAR_ITEM_NSLOTS, v,
7039 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
7040 * sizeof (Lisp_Object)));
7041 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
7042 break;
7046 else if (parse_tool_bar_item (key, def))
7047 /* Append a new tool bar item to tool_bar_items_vector. Accept
7048 more than one definition for the same key. */
7049 append_tool_bar_item ();
7051 UNGCPRO;
7055 /* Parse a tool bar item specification ITEM for key KEY and return the
7056 result in tool_bar_item_properties. Value is zero if ITEM is
7057 invalid.
7059 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
7061 CAPTION is the caption of the item, If it's not a string, it is
7062 evaluated to get a string.
7064 BINDING is the tool bar item's binding. Tool-bar items with keymaps
7065 as binding are currently ignored.
7067 The following properties are recognized:
7069 - `:enable FORM'.
7071 FORM is evaluated and specifies whether the tool bar item is
7072 enabled or disabled.
7074 - `:visible FORM'
7076 FORM is evaluated and specifies whether the tool bar item is visible.
7078 - `:filter FUNCTION'
7080 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
7081 result is stored as the new binding.
7083 - `:button (TYPE SELECTED)'
7085 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
7086 and specifies whether the button is selected (pressed) or not.
7088 - `:image IMAGES'
7090 IMAGES is either a single image specification or a vector of four
7091 image specifications. See enum tool_bar_item_images.
7093 - `:help HELP-STRING'.
7095 Gives a help string to display for the tool bar item. */
7097 static int
7098 parse_tool_bar_item (key, item)
7099 Lisp_Object key, item;
7101 /* Access slot with index IDX of vector tool_bar_item_properties. */
7102 #define PROP(IDX) XVECTOR (tool_bar_item_properties)->contents[IDX]
7104 Lisp_Object filter = Qnil;
7105 Lisp_Object caption;
7106 extern Lisp_Object QCenable, QCvisible, QChelp, QCfilter;
7107 extern Lisp_Object QCbutton, QCtoggle, QCradio;
7108 int i;
7110 /* Defininition looks like `(menu-item CAPTION BINDING PROPS...)'.
7111 Rule out items that aren't lists, don't start with
7112 `menu-item' or whose rest following `tool-bar-item' is not a
7113 list. */
7114 if (!CONSP (item)
7115 || !EQ (XCAR (item), Qmenu_item)
7116 || (item = XCDR (item),
7117 !CONSP (item)))
7118 return 0;
7120 /* Create tool_bar_item_properties vector if necessary. Reset it to
7121 defaults. */
7122 if (VECTORP (tool_bar_item_properties))
7124 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
7125 PROP (i) = Qnil;
7127 else
7128 tool_bar_item_properties
7129 = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
7131 /* Set defaults. */
7132 PROP (TOOL_BAR_ITEM_KEY) = key;
7133 PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
7135 /* Get the caption of the item. If the caption is not a string,
7136 evaluate it to get a string. If we don't get a string, skip this
7137 item. */
7138 caption = XCAR (item);
7139 if (!STRINGP (caption))
7141 caption = menu_item_eval_property (caption);
7142 if (!STRINGP (caption))
7143 return 0;
7145 PROP (TOOL_BAR_ITEM_CAPTION) = caption;
7147 /* Give up if rest following the caption is not a list. */
7148 item = XCDR (item);
7149 if (!CONSP (item))
7150 return 0;
7152 /* Store the binding. */
7153 PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item);
7154 item = XCDR (item);
7156 /* Ignore cached key binding, if any. */
7157 if (CONSP (item) && CONSP (XCAR (item)))
7158 item = XCDR (item);
7160 /* Process the rest of the properties. */
7161 for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
7163 Lisp_Object key, value;
7165 key = XCAR (item);
7166 value = XCAR (XCDR (item));
7168 if (EQ (key, QCenable))
7169 /* `:enable FORM'. */
7170 PROP (TOOL_BAR_ITEM_ENABLED_P) = value;
7171 else if (EQ (key, QCvisible))
7173 /* `:visible FORM'. If got a visible property and that
7174 evaluates to nil then ignore this item. */
7175 if (NILP (menu_item_eval_property (value)))
7176 return 0;
7178 else if (EQ (key, QChelp))
7179 /* `:help HELP-STRING'. */
7180 PROP (TOOL_BAR_ITEM_HELP) = value;
7181 else if (EQ (key, QCfilter))
7182 /* ':filter FORM'. */
7183 filter = value;
7184 else if (EQ (key, QCbutton) && CONSP (value))
7186 /* `:button (TYPE . SELECTED)'. */
7187 Lisp_Object type, selected;
7189 type = XCAR (value);
7190 selected = XCDR (value);
7191 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7193 PROP (TOOL_BAR_ITEM_SELECTED_P) = selected;
7194 PROP (TOOL_BAR_ITEM_TYPE) = type;
7197 else if (EQ (key, QCimage)
7198 && (CONSP (value)
7199 || (VECTORP (value) && XVECTOR (value)->size == 4)))
7200 /* Value is either a single image specification or a vector
7201 of 4 such specifications for the different buttion states. */
7202 PROP (TOOL_BAR_ITEM_IMAGES) = value;
7205 /* If got a filter apply it on binding. */
7206 if (!NILP (filter))
7207 PROP (TOOL_BAR_ITEM_BINDING)
7208 = menu_item_eval_property (list2 (filter,
7209 list2 (Qquote,
7210 PROP (TOOL_BAR_ITEM_BINDING))));
7212 /* See if the binding is a keymap. Give up if it is. */
7213 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
7214 return 0;
7216 /* Enable or disable selection of item. */
7217 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
7218 PROP (TOOL_BAR_ITEM_ENABLED_P)
7219 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P));
7221 /* Handle radio buttons or toggle boxes. */
7222 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
7223 PROP (TOOL_BAR_ITEM_SELECTED_P)
7224 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P));
7226 return 1;
7228 #undef PROP
7232 /* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
7233 that can be reused. */
7235 static void
7236 init_tool_bar_items (reuse)
7237 Lisp_Object reuse;
7239 if (VECTORP (reuse))
7240 tool_bar_items_vector = reuse;
7241 else
7242 tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
7243 ntool_bar_items = 0;
7247 /* Append parsed tool bar item properties from
7248 tool_bar_item_properties */
7250 static void
7251 append_tool_bar_item ()
7253 Lisp_Object *to, *from;
7255 /* Enlarge tool_bar_items_vector if necessary. */
7256 if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
7257 >= XVECTOR (tool_bar_items_vector)->size)
7259 Lisp_Object new_vector;
7260 int old_size = XVECTOR (tool_bar_items_vector)->size;
7262 new_vector = Fmake_vector (make_number (2 * old_size), Qnil);
7263 bcopy (XVECTOR (tool_bar_items_vector)->contents,
7264 XVECTOR (new_vector)->contents,
7265 old_size * sizeof (Lisp_Object));
7266 tool_bar_items_vector = new_vector;
7269 /* Append entries from tool_bar_item_properties to the end of
7270 tool_bar_items_vector. */
7271 to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
7272 from = XVECTOR (tool_bar_item_properties)->contents;
7273 bcopy (from, to, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
7274 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
7281 /* Read a character using menus based on maps in the array MAPS.
7282 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
7283 Return t if we displayed a menu but the user rejected it.
7285 PREV_EVENT is the previous input event, or nil if we are reading
7286 the first event of a key sequence.
7288 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
7289 if we used a mouse menu to read the input, or zero otherwise. If
7290 USED_MOUSE_MENU is null, we don't dereference it.
7292 The prompting is done based on the prompt-string of the map
7293 and the strings associated with various map elements.
7295 This can be done with X menus or with menus put in the minibuf.
7296 These are done in different ways, depending on how the input will be read.
7297 Menus using X are done after auto-saving in read-char, getting the input
7298 event from Fx_popup_menu; menus using the minibuf use read_char recursively
7299 and do auto-saving in the inner call of read_char. */
7301 static Lisp_Object
7302 read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
7303 int nmaps;
7304 Lisp_Object *maps;
7305 Lisp_Object prev_event;
7306 int *used_mouse_menu;
7308 int mapno;
7309 register Lisp_Object name;
7311 if (used_mouse_menu)
7312 *used_mouse_menu = 0;
7314 /* Use local over global Menu maps */
7316 if (! menu_prompting)
7317 return Qnil;
7319 /* Optionally disregard all but the global map. */
7320 if (inhibit_local_menu_bar_menus)
7322 maps += (nmaps - 1);
7323 nmaps = 1;
7326 /* Get the menu name from the first map that has one (a prompt string). */
7327 for (mapno = 0; mapno < nmaps; mapno++)
7329 name = map_prompt (maps[mapno]);
7330 if (!NILP (name))
7331 break;
7334 /* If we don't have any menus, just read a character normally. */
7335 if (mapno >= nmaps)
7336 return Qnil;
7338 #ifdef HAVE_MENUS
7339 /* If we got to this point via a mouse click,
7340 use a real menu for mouse selection. */
7341 if (EVENT_HAS_PARAMETERS (prev_event)
7342 && !EQ (XCAR (prev_event), Qmenu_bar)
7343 && !EQ (XCAR (prev_event), Qtool_bar))
7345 /* Display the menu and get the selection. */
7346 Lisp_Object *realmaps
7347 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
7348 Lisp_Object value;
7349 int nmaps1 = 0;
7351 /* Use the maps that are not nil. */
7352 for (mapno = 0; mapno < nmaps; mapno++)
7353 if (!NILP (maps[mapno]))
7354 realmaps[nmaps1++] = maps[mapno];
7356 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
7357 if (CONSP (value))
7359 Lisp_Object tem;
7361 record_menu_key (XCAR (value));
7363 /* If we got multiple events, unread all but
7364 the first.
7365 There is no way to prevent those unread events
7366 from showing up later in last_nonmenu_event.
7367 So turn symbol and integer events into lists,
7368 to indicate that they came from a mouse menu,
7369 so that when present in last_nonmenu_event
7370 they won't confuse things. */
7371 for (tem = XCDR (value); !NILP (tem);
7372 tem = XCDR (tem))
7374 record_menu_key (XCAR (tem));
7375 if (SYMBOLP (XCAR (tem))
7376 || INTEGERP (XCAR (tem)))
7377 XCAR (tem)
7378 = Fcons (XCAR (tem), Qnil);
7381 /* If we got more than one event, put all but the first
7382 onto this list to be read later.
7383 Return just the first event now. */
7384 Vunread_command_events
7385 = nconc2 (XCDR (value), Vunread_command_events);
7386 value = XCAR (value);
7388 else if (NILP (value))
7389 value = Qt;
7390 if (used_mouse_menu)
7391 *used_mouse_menu = 1;
7392 return value;
7394 #endif /* HAVE_MENUS */
7395 return Qnil ;
7398 /* Buffer in use so far for the minibuf prompts for menu keymaps.
7399 We make this bigger when necessary, and never free it. */
7400 static char *read_char_minibuf_menu_text;
7401 /* Size of that buffer. */
7402 static int read_char_minibuf_menu_width;
7404 static Lisp_Object
7405 read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
7406 int commandflag ;
7407 int nmaps;
7408 Lisp_Object *maps;
7410 int mapno;
7411 register Lisp_Object name;
7412 int nlength;
7413 int width = FRAME_WIDTH (SELECTED_FRAME ()) - 4;
7414 int idx = -1;
7415 int nobindings = 1;
7416 Lisp_Object rest, vector;
7417 char *menu;
7419 vector = Qnil;
7421 if (! menu_prompting)
7422 return Qnil;
7424 /* Make sure we have a big enough buffer for the menu text. */
7425 if (read_char_minibuf_menu_text == 0)
7427 read_char_minibuf_menu_width = width + 4;
7428 read_char_minibuf_menu_text = (char *) xmalloc (width + 4);
7430 else if (width + 4 > read_char_minibuf_menu_width)
7432 read_char_minibuf_menu_width = width + 4;
7433 read_char_minibuf_menu_text
7434 = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
7436 menu = read_char_minibuf_menu_text;
7438 /* Get the menu name from the first map that has one (a prompt string). */
7439 for (mapno = 0; mapno < nmaps; mapno++)
7441 name = map_prompt (maps[mapno]);
7442 if (!NILP (name))
7443 break;
7446 /* If we don't have any menus, just read a character normally. */
7447 if (mapno >= nmaps)
7448 return Qnil;
7450 /* Prompt string always starts with map's prompt, and a space. */
7451 strcpy (menu, XSTRING (name)->data);
7452 nlength = STRING_BYTES (XSTRING (name));
7453 menu[nlength++] = ':';
7454 menu[nlength++] = ' ';
7455 menu[nlength] = 0;
7457 /* Start prompting at start of first map. */
7458 mapno = 0;
7459 rest = maps[mapno];
7461 /* Present the documented bindings, a line at a time. */
7462 while (1)
7464 int notfirst = 0;
7465 int i = nlength;
7466 Lisp_Object obj;
7467 int ch;
7468 Lisp_Object orig_defn_macro;
7470 /* Loop over elements of map. */
7471 while (i < width)
7473 Lisp_Object elt;
7475 /* If reached end of map, start at beginning of next map. */
7476 if (NILP (rest))
7478 mapno++;
7479 /* At end of last map, wrap around to first map if just starting,
7480 or end this line if already have something on it. */
7481 if (mapno == nmaps)
7483 mapno = 0;
7484 if (notfirst || nobindings) break;
7486 rest = maps[mapno];
7489 /* Look at the next element of the map. */
7490 if (idx >= 0)
7491 elt = XVECTOR (vector)->contents[idx];
7492 else
7493 elt = Fcar_safe (rest);
7495 if (idx < 0 && VECTORP (elt))
7497 /* If we found a dense table in the keymap,
7498 advanced past it, but start scanning its contents. */
7499 rest = Fcdr_safe (rest);
7500 vector = elt;
7501 idx = 0;
7503 else
7505 /* An ordinary element. */
7506 Lisp_Object event, tem;
7508 if (idx < 0)
7510 event = Fcar_safe (elt); /* alist */
7511 elt = Fcdr_safe (elt);
7513 else
7515 XSETINT (event, idx); /* vector */
7518 /* Ignore the element if it has no prompt string. */
7519 if (INTEGERP (event) && parse_menu_item (elt, 0, -1))
7521 /* 1 if the char to type matches the string. */
7522 int char_matches;
7523 Lisp_Object upcased_event, downcased_event;
7524 Lisp_Object desc = Qnil;
7525 Lisp_Object s
7526 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
7528 upcased_event = Fupcase (event);
7529 downcased_event = Fdowncase (event);
7530 char_matches = (XINT (upcased_event) == XSTRING (s)->data[0]
7531 || XINT (downcased_event) == XSTRING (s)->data[0]);
7532 if (! char_matches)
7533 desc = Fsingle_key_description (event, Qnil);
7536 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
7537 if (!NILP (tem))
7538 /* Insert equivalent keybinding. */
7539 s = concat2 (s, tem);
7542 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
7543 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
7545 /* Insert button prefix. */
7546 Lisp_Object selected
7547 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
7548 if (EQ (tem, QCradio))
7549 tem = build_string (NILP (selected) ? "(*) " : "( ) ");
7550 else
7551 tem = build_string (NILP (selected) ? "[X] " : "[ ] ");
7552 s = concat2 (tem, s);
7556 /* If we have room for the prompt string, add it to this line.
7557 If this is the first on the line, always add it. */
7558 if ((XSTRING (s)->size + i + 2
7559 + (char_matches ? 0 : XSTRING (desc)->size + 3))
7560 < width
7561 || !notfirst)
7563 int thiswidth;
7565 /* Punctuate between strings. */
7566 if (notfirst)
7568 strcpy (menu + i, ", ");
7569 i += 2;
7571 notfirst = 1;
7572 nobindings = 0 ;
7574 /* If the char to type doesn't match the string's
7575 first char, explicitly show what char to type. */
7576 if (! char_matches)
7578 /* Add as much of string as fits. */
7579 thiswidth = XSTRING (desc)->size;
7580 if (thiswidth + i > width)
7581 thiswidth = width - i;
7582 bcopy (XSTRING (desc)->data, menu + i, thiswidth);
7583 i += thiswidth;
7584 strcpy (menu + i, " = ");
7585 i += 3;
7588 /* Add as much of string as fits. */
7589 thiswidth = XSTRING (s)->size;
7590 if (thiswidth + i > width)
7591 thiswidth = width - i;
7592 bcopy (XSTRING (s)->data, menu + i, thiswidth);
7593 i += thiswidth;
7594 menu[i] = 0;
7596 else
7598 /* If this element does not fit, end the line now,
7599 and save the element for the next line. */
7600 strcpy (menu + i, "...");
7601 break;
7605 /* Move past this element. */
7606 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
7607 /* Handle reaching end of dense table. */
7608 idx = -1;
7609 if (idx >= 0)
7610 idx++;
7611 else
7612 rest = Fcdr_safe (rest);
7616 /* Prompt with that and read response. */
7617 message2_nolog (menu, strlen (menu),
7618 ! NILP (current_buffer->enable_multibyte_characters));
7620 /* Make believe its not a keyboard macro in case the help char
7621 is pressed. Help characters are not recorded because menu prompting
7622 is not used on replay.
7624 orig_defn_macro = current_kboard->defining_kbd_macro;
7625 current_kboard->defining_kbd_macro = Qnil;
7627 obj = read_char (commandflag, 0, 0, Qt, 0);
7628 while (BUFFERP (obj));
7629 current_kboard->defining_kbd_macro = orig_defn_macro;
7631 if (!INTEGERP (obj))
7632 return obj;
7633 else
7634 ch = XINT (obj);
7636 if (! EQ (obj, menu_prompt_more_char)
7637 && (!INTEGERP (menu_prompt_more_char)
7638 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
7640 if (!NILP (current_kboard->defining_kbd_macro))
7641 store_kbd_macro_char (obj);
7642 return obj;
7644 /* Help char - go round again */
7648 /* Reading key sequences. */
7650 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
7651 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
7652 keymap, or nil otherwise. Return the index of the first keymap in
7653 which KEY has any binding, or NMAPS if no map has a binding.
7655 If KEY is a meta ASCII character, treat it like meta-prefix-char
7656 followed by the corresponding non-meta character. Keymaps in
7657 CURRENT with non-prefix bindings for meta-prefix-char become nil in
7658 NEXT.
7660 If KEY has no bindings in any of the CURRENT maps, NEXT is left
7661 unmodified.
7663 NEXT may be the same array as CURRENT. */
7665 static int
7666 follow_key (key, nmaps, current, defs, next)
7667 Lisp_Object key;
7668 Lisp_Object *current, *defs, *next;
7669 int nmaps;
7671 int i, first_binding;
7672 int did_meta = 0;
7674 first_binding = nmaps;
7675 for (i = nmaps - 1; i >= 0; i--)
7677 if (! NILP (current[i]))
7679 Lisp_Object map;
7680 if (did_meta)
7681 map = defs[i];
7682 else
7683 map = current[i];
7685 defs[i] = access_keymap (map, key, 1, 0, 1);
7686 if (! NILP (defs[i]))
7687 first_binding = i;
7689 else
7690 defs[i] = Qnil;
7693 /* Given the set of bindings we've found, produce the next set of maps. */
7694 if (first_binding < nmaps)
7695 for (i = 0; i < nmaps; i++)
7696 next[i] = NILP (defs[i]) ? Qnil : get_keymap (defs[i], 0, 1);
7698 return first_binding;
7701 /* Read a sequence of keys that ends with a non prefix character,
7702 storing it in KEYBUF, a buffer of size BUFSIZE.
7703 Prompt with PROMPT.
7704 Return the length of the key sequence stored.
7705 Return -1 if the user rejected a command menu.
7707 Echo starting immediately unless `prompt' is 0.
7709 Where a key sequence ends depends on the currently active keymaps.
7710 These include any minor mode keymaps active in the current buffer,
7711 the current buffer's local map, and the global map.
7713 If a key sequence has no other bindings, we check Vfunction_key_map
7714 to see if some trailing subsequence might be the beginning of a
7715 function key's sequence. If so, we try to read the whole function
7716 key, and substitute its symbolic name into the key sequence.
7718 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
7719 `double-' events into similar click events, if that would make them
7720 bound. We try to turn `triple-' events first into `double-' events,
7721 then into clicks.
7723 If we get a mouse click in a mode line, vertical divider, or other
7724 non-text area, we treat the click as if it were prefixed by the
7725 symbol denoting that area - `mode-line', `vertical-line', or
7726 whatever.
7728 If the sequence starts with a mouse click, we read the key sequence
7729 with respect to the buffer clicked on, not the current buffer.
7731 If the user switches frames in the midst of a key sequence, we put
7732 off the switch-frame event until later; the next call to
7733 read_char will return it.
7735 If FIX_CURRENT_BUFFER is nonzero, we restore current_buffer
7736 from the selected window's buffer. */
7738 static int
7739 read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
7740 can_return_switch_frame, fix_current_buffer)
7741 Lisp_Object *keybuf;
7742 int bufsize;
7743 Lisp_Object prompt;
7744 int dont_downcase_last;
7745 int can_return_switch_frame;
7746 int fix_current_buffer;
7748 volatile int count = specpdl_ptr - specpdl;
7750 /* How many keys there are in the current key sequence. */
7751 volatile int t;
7753 /* The length of the echo buffer when we started reading, and
7754 the length of this_command_keys when we started reading. */
7755 volatile int echo_start;
7756 volatile int keys_start;
7758 /* The number of keymaps we're scanning right now, and the number of
7759 keymaps we have allocated space for. */
7760 volatile int nmaps;
7761 volatile int nmaps_allocated = 0;
7763 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
7764 the current keymaps. */
7765 Lisp_Object *volatile defs = NULL;
7767 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
7768 in the current keymaps, or nil where it is not a prefix. */
7769 Lisp_Object *volatile submaps = NULL;
7771 /* The local map to start out with at start of key sequence. */
7772 volatile Lisp_Object orig_local_map;
7774 /* The map from the `keymap' property to start out with at start of
7775 key sequence. */
7776 volatile Lisp_Object orig_keymap;
7778 /* 1 if we have already considered switching to the local-map property
7779 of the place where a mouse click occurred. */
7780 volatile int localized_local_map = 0;
7782 /* The index in defs[] of the first keymap that has a binding for
7783 this key sequence. In other words, the lowest i such that
7784 defs[i] is non-nil. */
7785 volatile int first_binding;
7787 /* If t < mock_input, then KEYBUF[t] should be read as the next
7788 input key.
7790 We use this to recover after recognizing a function key. Once we
7791 realize that a suffix of the current key sequence is actually a
7792 function key's escape sequence, we replace the suffix with the
7793 function key's binding from Vfunction_key_map. Now keybuf
7794 contains a new and different key sequence, so the echo area,
7795 this_command_keys, and the submaps and defs arrays are wrong. In
7796 this situation, we set mock_input to t, set t to 0, and jump to
7797 restart_sequence; the loop will read keys from keybuf up until
7798 mock_input, thus rebuilding the state; and then it will resume
7799 reading characters from the keyboard. */
7800 volatile int mock_input = 0;
7802 /* If the sequence is unbound in submaps[], then
7803 keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map,
7804 and fkey_map is its binding.
7806 These might be > t, indicating that all function key scanning
7807 should hold off until t reaches them. We do this when we've just
7808 recognized a function key, to avoid searching for the function
7809 key's again in Vfunction_key_map. */
7810 volatile int fkey_start = 0, fkey_end = 0;
7811 volatile Lisp_Object fkey_map;
7813 /* Likewise, for key_translation_map. */
7814 volatile int keytran_start = 0, keytran_end = 0;
7815 volatile Lisp_Object keytran_map;
7817 /* If we receive a ``switch-frame'' event in the middle of a key sequence,
7818 we put it off for later. While we're reading, we keep the event here. */
7819 volatile Lisp_Object delayed_switch_frame;
7821 /* See the comment below... */
7822 #if defined (GOBBLE_FIRST_EVENT)
7823 Lisp_Object first_event;
7824 #endif
7826 volatile Lisp_Object original_uppercase;
7827 volatile int original_uppercase_position = -1;
7829 /* Gets around Microsoft compiler limitations. */
7830 int dummyflag = 0;
7832 struct buffer *starting_buffer;
7834 /* Nonzero if we seem to have got the beginning of a binding
7835 in function_key_map. */
7836 volatile int function_key_possible = 0;
7837 volatile int key_translation_possible = 0;
7839 /* Save the status of key translation before each step,
7840 so that we can restore this after downcasing. */
7841 Lisp_Object prev_fkey_map;
7842 int prev_fkey_start;
7843 int prev_fkey_end;
7845 Lisp_Object prev_keytran_map;
7846 int prev_keytran_start;
7847 int prev_keytran_end;
7849 #if defined (GOBBLE_FIRST_EVENT)
7850 int junk;
7851 #endif
7853 raw_keybuf_count = 0;
7855 last_nonmenu_event = Qnil;
7857 delayed_switch_frame = Qnil;
7858 fkey_map = Vfunction_key_map;
7859 keytran_map = Vkey_translation_map;
7861 /* If there is no function-key-map, turn off function key scanning. */
7862 if (!KEYMAPP (Vfunction_key_map))
7863 fkey_start = fkey_end = bufsize + 1;
7865 /* If there is no key-translation-map, turn off scanning. */
7866 if (!KEYMAPP (Vkey_translation_map))
7867 keytran_start = keytran_end = bufsize + 1;
7869 if (INTERACTIVE)
7871 if (!NILP (prompt))
7872 echo_prompt (prompt);
7873 else if (cursor_in_echo_area
7874 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
7875 && NILP (Fzerop (Vecho_keystrokes)))
7876 /* This doesn't put in a dash if the echo buffer is empty, so
7877 you don't always see a dash hanging out in the minibuffer. */
7878 echo_dash ();
7881 /* Record the initial state of the echo area and this_command_keys;
7882 we will need to restore them if we replay a key sequence. */
7883 if (INTERACTIVE)
7884 echo_start = echo_length ();
7885 keys_start = this_command_key_count;
7886 this_single_command_key_start = keys_start;
7888 #if defined (GOBBLE_FIRST_EVENT)
7889 /* This doesn't quite work, because some of the things that read_char
7890 does cannot safely be bypassed. It seems too risky to try to make
7891 this work right. */
7893 /* Read the first char of the sequence specially, before setting
7894 up any keymaps, in case a filter runs and switches buffers on us. */
7895 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
7896 &junk);
7897 #endif /* GOBBLE_FIRST_EVENT */
7899 orig_local_map = get_local_map (PT, current_buffer, local_map);
7900 orig_keymap = get_local_map (PT, current_buffer, keymap);
7902 /* We jump here when the key sequence has been thoroughly changed, and
7903 we need to rescan it starting from the beginning. When we jump here,
7904 keybuf[0..mock_input] holds the sequence we should reread. */
7905 replay_sequence:
7907 starting_buffer = current_buffer;
7908 function_key_possible = 0;
7909 key_translation_possible = 0;
7911 /* Build our list of keymaps.
7912 If we recognize a function key and replace its escape sequence in
7913 keybuf with its symbol, or if the sequence starts with a mouse
7914 click and we need to switch buffers, we jump back here to rebuild
7915 the initial keymaps from the current buffer. */
7917 Lisp_Object *maps;
7919 if (!NILP (current_kboard->Voverriding_terminal_local_map)
7920 || !NILP (Voverriding_local_map))
7922 if (3 > nmaps_allocated)
7924 submaps = (Lisp_Object *) alloca (3 * sizeof (submaps[0]));
7925 defs = (Lisp_Object *) alloca (3 * sizeof (defs[0]));
7926 nmaps_allocated = 3;
7928 nmaps = 0;
7929 if (!NILP (current_kboard->Voverriding_terminal_local_map))
7930 submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
7931 if (!NILP (Voverriding_local_map))
7932 submaps[nmaps++] = Voverriding_local_map;
7934 else
7936 int extra_maps = 2;
7937 nmaps = current_minor_maps (0, &maps);
7938 if (!NILP (orig_keymap))
7939 extra_maps = 3;
7940 if (nmaps + extra_maps > nmaps_allocated)
7942 submaps = (Lisp_Object *) alloca ((nmaps+extra_maps)
7943 * sizeof (submaps[0]));
7944 defs = (Lisp_Object *) alloca ((nmaps+extra_maps)
7945 * sizeof (defs[0]));
7946 nmaps_allocated = nmaps + extra_maps;
7948 bcopy (maps, (void *) submaps, nmaps * sizeof (submaps[0]));
7949 if (!NILP (orig_keymap))
7950 submaps[nmaps++] = orig_keymap;
7951 submaps[nmaps++] = orig_local_map;
7953 submaps[nmaps++] = current_global_map;
7956 /* Find an accurate initial value for first_binding. */
7957 for (first_binding = 0; first_binding < nmaps; first_binding++)
7958 if (! NILP (submaps[first_binding]))
7959 break;
7961 /* Start from the beginning in keybuf. */
7962 t = 0;
7964 /* These are no-ops the first time through, but if we restart, they
7965 revert the echo area and this_command_keys to their original state. */
7966 this_command_key_count = keys_start;
7967 if (INTERACTIVE && t < mock_input)
7968 echo_truncate (echo_start);
7970 /* If the best binding for the current key sequence is a keymap, or
7971 we may be looking at a function key's escape sequence, keep on
7972 reading. */
7973 while ((first_binding < nmaps && ! NILP (submaps[first_binding]))
7974 || (first_binding >= nmaps
7975 && fkey_start < t
7976 /* mock input is never part of a function key's sequence. */
7977 && mock_input <= fkey_start)
7978 || (first_binding >= nmaps
7979 && keytran_start < t && key_translation_possible)
7980 /* Don't return in the middle of a possible function key sequence,
7981 if the only bindings we found were via case conversion.
7982 Thus, if ESC O a has a function-key-map translation
7983 and ESC o has a binding, don't return after ESC O,
7984 so that we can translate ESC O plus the next character. */
7987 Lisp_Object key;
7988 int used_mouse_menu = 0;
7990 /* Where the last real key started. If we need to throw away a
7991 key that has expanded into more than one element of keybuf
7992 (say, a mouse click on the mode line which is being treated
7993 as [mode-line (mouse-...)], then we backtrack to this point
7994 of keybuf. */
7995 volatile int last_real_key_start;
7997 /* These variables are analogous to echo_start and keys_start;
7998 while those allow us to restart the entire key sequence,
7999 echo_local_start and keys_local_start allow us to throw away
8000 just one key. */
8001 volatile int echo_local_start, keys_local_start, local_first_binding;
8003 if (t >= bufsize)
8004 error ("Key sequence too long");
8006 if (INTERACTIVE)
8007 echo_local_start = echo_length ();
8008 keys_local_start = this_command_key_count;
8009 local_first_binding = first_binding;
8011 replay_key:
8012 /* These are no-ops, unless we throw away a keystroke below and
8013 jumped back up to replay_key; in that case, these restore the
8014 variables to their original state, allowing us to replay the
8015 loop. */
8016 if (INTERACTIVE && t < mock_input)
8017 echo_truncate (echo_local_start);
8018 this_command_key_count = keys_local_start;
8019 first_binding = local_first_binding;
8021 /* By default, assume each event is "real". */
8022 last_real_key_start = t;
8024 /* Does mock_input indicate that we are re-reading a key sequence? */
8025 if (t < mock_input)
8027 key = keybuf[t];
8028 add_command_key (key);
8029 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8030 && NILP (Fzerop (Vecho_keystrokes)))
8031 echo_char (key);
8034 /* If not, we should actually read a character. */
8035 else
8038 #ifdef MULTI_KBOARD
8039 KBOARD *interrupted_kboard = current_kboard;
8040 struct frame *interrupted_frame = SELECTED_FRAME ();
8041 if (setjmp (wrong_kboard_jmpbuf))
8043 if (!NILP (delayed_switch_frame))
8045 interrupted_kboard->kbd_queue
8046 = Fcons (delayed_switch_frame,
8047 interrupted_kboard->kbd_queue);
8048 delayed_switch_frame = Qnil;
8050 while (t > 0)
8051 interrupted_kboard->kbd_queue
8052 = Fcons (keybuf[--t], interrupted_kboard->kbd_queue);
8054 /* If the side queue is non-empty, ensure it begins with a
8055 switch-frame, so we'll replay it in the right context. */
8056 if (CONSP (interrupted_kboard->kbd_queue)
8057 && (key = XCAR (interrupted_kboard->kbd_queue),
8058 !(EVENT_HAS_PARAMETERS (key)
8059 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
8060 Qswitch_frame))))
8062 Lisp_Object frame;
8063 XSETFRAME (frame, interrupted_frame);
8064 interrupted_kboard->kbd_queue
8065 = Fcons (make_lispy_switch_frame (frame),
8066 interrupted_kboard->kbd_queue);
8068 mock_input = 0;
8069 orig_local_map = get_local_map (PT, current_buffer, local_map);
8070 orig_keymap = get_local_map (PT, current_buffer, keymap);
8071 goto replay_sequence;
8073 #endif
8074 key = read_char (NILP (prompt), nmaps,
8075 (Lisp_Object *) submaps, last_nonmenu_event,
8076 &used_mouse_menu);
8079 /* read_char returns t when it shows a menu and the user rejects it.
8080 Just return -1. */
8081 if (EQ (key, Qt))
8083 unbind_to (count, Qnil);
8084 return -1;
8087 /* read_char returns -1 at the end of a macro.
8088 Emacs 18 handles this by returning immediately with a
8089 zero, so that's what we'll do. */
8090 if (INTEGERP (key) && XINT (key) == -1)
8092 t = 0;
8093 /* The Microsoft C compiler can't handle the goto that
8094 would go here. */
8095 dummyflag = 1;
8096 break;
8099 /* If the current buffer has been changed from under us, the
8100 keymap may have changed, so replay the sequence. */
8101 if (BUFFERP (key))
8103 mock_input = t;
8104 /* Reset the current buffer from the selected window
8105 in case something changed the former and not the latter.
8106 This is to be more consistent with the behavior
8107 of the command_loop_1. */
8108 if (fix_current_buffer)
8110 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
8111 Fkill_emacs (Qnil);
8112 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
8113 Fset_buffer (XWINDOW (selected_window)->buffer);
8116 orig_local_map = get_local_map (PT, current_buffer, local_map);
8117 orig_keymap = get_local_map (PT, current_buffer, keymap);
8118 goto replay_sequence;
8121 /* If we have a quit that was typed in another frame, and
8122 quit_throw_to_read_char switched buffers,
8123 replay to get the right keymap. */
8124 if (XINT (key) == quit_char && current_buffer != starting_buffer)
8126 GROW_RAW_KEYBUF;
8127 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8128 keybuf[t++] = key;
8129 mock_input = t;
8130 Vquit_flag = Qnil;
8131 orig_local_map = get_local_map (PT, current_buffer, local_map);
8132 orig_keymap = get_local_map (PT, current_buffer, keymap);
8133 goto replay_sequence;
8136 Vquit_flag = Qnil;
8138 if (EVENT_HAS_PARAMETERS (key)
8139 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
8141 /* If we're at the beginning of a key sequence, and the caller
8142 says it's okay, go ahead and return this event. If we're
8143 in the midst of a key sequence, delay it until the end. */
8144 if (t > 0 || !can_return_switch_frame)
8146 delayed_switch_frame = key;
8147 goto replay_key;
8151 GROW_RAW_KEYBUF;
8152 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8155 /* Clicks in non-text areas get prefixed by the symbol
8156 in their CHAR-ADDRESS field. For example, a click on
8157 the mode line is prefixed by the symbol `mode-line'.
8159 Furthermore, key sequences beginning with mouse clicks
8160 are read using the keymaps of the buffer clicked on, not
8161 the current buffer. So we may have to switch the buffer
8162 here.
8164 When we turn one event into two events, we must make sure
8165 that neither of the two looks like the original--so that,
8166 if we replay the events, they won't be expanded again.
8167 If not for this, such reexpansion could happen either here
8168 or when user programs play with this-command-keys. */
8169 if (EVENT_HAS_PARAMETERS (key))
8171 Lisp_Object kind;
8173 kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
8174 if (EQ (kind, Qmouse_click))
8176 Lisp_Object window, posn;
8178 window = POSN_WINDOW (EVENT_START (key));
8179 posn = POSN_BUFFER_POSN (EVENT_START (key));
8181 if (CONSP (posn))
8183 /* We're looking at the second event of a
8184 sequence which we expanded before. Set
8185 last_real_key_start appropriately. */
8186 if (t > 0)
8187 last_real_key_start = t - 1;
8190 /* Key sequences beginning with mouse clicks are
8191 read using the keymaps in the buffer clicked on,
8192 not the current buffer. If we're at the
8193 beginning of a key sequence, switch buffers. */
8194 if (last_real_key_start == 0
8195 && WINDOWP (window)
8196 && BUFFERP (XWINDOW (window)->buffer)
8197 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
8199 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8200 keybuf[t] = key;
8201 mock_input = t + 1;
8203 /* Arrange to go back to the original buffer once we're
8204 done reading the key sequence. Note that we can't
8205 use save_excursion_{save,restore} here, because they
8206 save point as well as the current buffer; we don't
8207 want to save point, because redisplay may change it,
8208 to accommodate a Fset_window_start or something. We
8209 don't want to do this at the top of the function,
8210 because we may get input from a subprocess which
8211 wants to change the selected window and stuff (say,
8212 emacsclient). */
8213 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
8215 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
8216 Fkill_emacs (Qnil);
8217 set_buffer_internal (XBUFFER (XWINDOW
8218 (window)->buffer)
8220 orig_local_map = get_local_map (PT, current_buffer,
8221 local_map);
8222 orig_keymap = get_local_map (PT, current_buffer, keymap);
8223 goto replay_sequence;
8226 /* For a mouse click, get the local text-property keymap
8227 of the place clicked on, rather than point. */
8228 if (last_real_key_start == 0
8229 && CONSP (XCDR (key))
8230 && ! localized_local_map)
8232 Lisp_Object map_here, start, pos;
8234 localized_local_map = 1;
8235 start = EVENT_START (key);
8237 if (CONSP (start) && CONSP (XCDR (start)))
8239 pos = POSN_BUFFER_POSN (start);
8240 if (INTEGERP (pos)
8241 && XINT (pos) >= BEG && XINT (pos) <= Z)
8243 map_here = get_local_map (XINT (pos),
8244 current_buffer, local_map);
8245 if (!EQ (map_here, orig_local_map))
8247 orig_local_map = map_here;
8248 keybuf[t] = key;
8249 mock_input = t + 1;
8251 goto replay_sequence;
8253 map_here = get_local_map (XINT (pos),
8254 current_buffer, keymap);
8255 if (!EQ (map_here, orig_keymap))
8257 orig_keymap = map_here;
8258 keybuf[t] = key;
8259 mock_input = t + 1;
8261 goto replay_sequence;
8267 /* Expand mode-line and scroll-bar events into two events:
8268 use posn as a fake prefix key. */
8269 if (SYMBOLP (posn))
8271 if (t + 1 >= bufsize)
8272 error ("Key sequence too long");
8273 keybuf[t] = posn;
8274 keybuf[t+1] = key;
8275 mock_input = t + 2;
8277 /* Zap the position in key, so we know that we've
8278 expanded it, and don't try to do so again. */
8279 POSN_BUFFER_POSN (EVENT_START (key))
8280 = Fcons (posn, Qnil);
8282 /* If on a mode line string with a local keymap,
8283 reconsider the key sequence with that keymap. */
8284 if (CONSP (POSN_STRING (EVENT_START (key))))
8286 Lisp_Object string, pos, map, map2;
8288 string = POSN_STRING (EVENT_START (key));
8289 pos = XCDR (string);
8290 string = XCAR (string);
8291 if (XINT (pos) >= 0
8292 && XINT (pos) < XSTRING (string)->size)
8294 map = Fget_text_property (pos, Qlocal_map, string);
8295 if (!NILP (map))
8296 orig_local_map = map;
8297 map2 = Fget_text_property (pos, Qkeymap, string);
8298 if (!NILP (map2))
8299 orig_keymap = map2;
8300 if (!NILP (map) || !NILP (map2))
8301 goto replay_sequence;
8305 goto replay_key;
8308 else if (CONSP (XCDR (key))
8309 && CONSP (EVENT_START (key))
8310 && CONSP (XCDR (EVENT_START (key))))
8312 Lisp_Object posn;
8314 posn = POSN_BUFFER_POSN (EVENT_START (key));
8315 /* Handle menu-bar events:
8316 insert the dummy prefix event `menu-bar'. */
8317 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
8319 if (t + 1 >= bufsize)
8320 error ("Key sequence too long");
8321 keybuf[t] = posn;
8322 keybuf[t+1] = key;
8324 /* Zap the position in key, so we know that we've
8325 expanded it, and don't try to do so again. */
8326 POSN_BUFFER_POSN (EVENT_START (key))
8327 = Fcons (posn, Qnil);
8329 mock_input = t + 2;
8330 goto replay_sequence;
8332 else if (CONSP (posn))
8334 /* We're looking at the second event of a
8335 sequence which we expanded before. Set
8336 last_real_key_start appropriately. */
8337 if (last_real_key_start == t && t > 0)
8338 last_real_key_start = t - 1;
8343 /* We have finally decided that KEY is something we might want
8344 to look up. */
8345 first_binding = (follow_key (key,
8346 nmaps - first_binding,
8347 submaps + first_binding,
8348 defs + first_binding,
8349 submaps + first_binding)
8350 + first_binding);
8352 /* If KEY wasn't bound, we'll try some fallbacks. */
8353 if (first_binding >= nmaps)
8355 Lisp_Object head;
8357 head = EVENT_HEAD (key);
8358 if (help_char_p (head) && t > 0)
8360 read_key_sequence_cmd = Vprefix_help_command;
8361 keybuf[t++] = key;
8362 last_nonmenu_event = key;
8363 /* The Microsoft C compiler can't handle the goto that
8364 would go here. */
8365 dummyflag = 1;
8366 break;
8369 if (SYMBOLP (head))
8371 Lisp_Object breakdown;
8372 int modifiers;
8374 breakdown = parse_modifiers (head);
8375 modifiers = XINT (XCAR (XCDR (breakdown)));
8376 /* Attempt to reduce an unbound mouse event to a simpler
8377 event that is bound:
8378 Drags reduce to clicks.
8379 Double-clicks reduce to clicks.
8380 Triple-clicks reduce to double-clicks, then to clicks.
8381 Down-clicks are eliminated.
8382 Double-downs reduce to downs, then are eliminated.
8383 Triple-downs reduce to double-downs, then to downs,
8384 then are eliminated. */
8385 if (modifiers & (down_modifier | drag_modifier
8386 | double_modifier | triple_modifier))
8388 while (modifiers & (down_modifier | drag_modifier
8389 | double_modifier | triple_modifier))
8391 Lisp_Object new_head, new_click;
8392 if (modifiers & triple_modifier)
8393 modifiers ^= (double_modifier | triple_modifier);
8394 else if (modifiers & double_modifier)
8395 modifiers &= ~double_modifier;
8396 else if (modifiers & drag_modifier)
8397 modifiers &= ~drag_modifier;
8398 else
8400 /* Dispose of this `down' event by simply jumping
8401 back to replay_key, to get another event.
8403 Note that if this event came from mock input,
8404 then just jumping back to replay_key will just
8405 hand it to us again. So we have to wipe out any
8406 mock input.
8408 We could delete keybuf[t] and shift everything
8409 after that to the left by one spot, but we'd also
8410 have to fix up any variable that points into
8411 keybuf, and shifting isn't really necessary
8412 anyway.
8414 Adding prefixes for non-textual mouse clicks
8415 creates two characters of mock input, and both
8416 must be thrown away. If we're only looking at
8417 the prefix now, we can just jump back to
8418 replay_key. On the other hand, if we've already
8419 processed the prefix, and now the actual click
8420 itself is giving us trouble, then we've lost the
8421 state of the keymaps we want to backtrack to, and
8422 we need to replay the whole sequence to rebuild
8425 Beyond that, only function key expansion could
8426 create more than two keys, but that should never
8427 generate mouse events, so it's okay to zero
8428 mock_input in that case too.
8430 Isn't this just the most wonderful code ever? */
8431 if (t == last_real_key_start)
8433 mock_input = 0;
8434 goto replay_key;
8436 else
8438 mock_input = last_real_key_start;
8439 goto replay_sequence;
8443 new_head
8444 = apply_modifiers (modifiers, XCAR (breakdown));
8445 new_click
8446 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
8448 /* Look for a binding for this new key. follow_key
8449 promises that it didn't munge submaps the
8450 last time we called it, since key was unbound. */
8451 first_binding
8452 = (follow_key (new_click,
8453 nmaps - local_first_binding,
8454 submaps + local_first_binding,
8455 defs + local_first_binding,
8456 submaps + local_first_binding)
8457 + local_first_binding);
8459 /* If that click is bound, go for it. */
8460 if (first_binding < nmaps)
8462 key = new_click;
8463 break;
8465 /* Otherwise, we'll leave key set to the drag event. */
8471 keybuf[t++] = key;
8472 /* Normally, last_nonmenu_event gets the previous key we read.
8473 But when a mouse popup menu is being used,
8474 we don't update last_nonmenu_event; it continues to hold the mouse
8475 event that preceded the first level of menu. */
8476 if (!used_mouse_menu)
8477 last_nonmenu_event = key;
8479 /* Record what part of this_command_keys is the current key sequence. */
8480 this_single_command_key_start = this_command_key_count - t;
8482 prev_fkey_map = fkey_map;
8483 prev_fkey_start = fkey_start;
8484 prev_fkey_end = fkey_end;
8486 prev_keytran_map = keytran_map;
8487 prev_keytran_start = keytran_start;
8488 prev_keytran_end = keytran_end;
8490 /* If the sequence is unbound, see if we can hang a function key
8491 off the end of it. We only want to scan real keyboard input
8492 for function key sequences, so if mock_input says that we're
8493 re-reading old events, don't examine it. */
8494 if (first_binding >= nmaps
8495 && t >= mock_input)
8497 Lisp_Object fkey_next;
8499 /* Continue scan from fkey_end until we find a bound suffix.
8500 If we fail, increment fkey_start
8501 and start fkey_end from there. */
8502 while (fkey_end < t)
8504 Lisp_Object key;
8506 key = keybuf[fkey_end++];
8507 fkey_next
8508 = access_keymap (fkey_map, key, 1, 0, 1);
8510 /* Handle symbol with autoload definition. */
8511 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
8512 && CONSP (XSYMBOL (fkey_next)->function)
8513 && EQ (XCAR (XSYMBOL (fkey_next)->function), Qautoload))
8514 do_autoload (XSYMBOL (fkey_next)->function,
8515 fkey_next);
8517 /* Handle a symbol whose function definition is a keymap
8518 or an array. */
8519 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
8520 && (!NILP (Farrayp (XSYMBOL (fkey_next)->function))
8521 || KEYMAPP (XSYMBOL (fkey_next)->function)))
8522 fkey_next = XSYMBOL (fkey_next)->function;
8524 #if 0 /* I didn't turn this on, because it might cause trouble
8525 for the mapping of return into C-m and tab into C-i. */
8526 /* Optionally don't map function keys into other things.
8527 This enables the user to redefine kp- keys easily. */
8528 if (SYMBOLP (key) && !NILP (Vinhibit_function_key_mapping))
8529 fkey_next = Qnil;
8530 #endif
8532 /* If the function key map gives a function, not an
8533 array, then call the function with no args and use
8534 its value instead. */
8535 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
8536 && fkey_end == t)
8538 struct gcpro gcpro1, gcpro2, gcpro3;
8539 Lisp_Object tem;
8540 tem = fkey_next;
8542 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
8543 fkey_next = call1 (fkey_next, prompt);
8544 UNGCPRO;
8545 /* If the function returned something invalid,
8546 barf--don't ignore it.
8547 (To ignore it safely, we would need to gcpro a bunch of
8548 other variables.) */
8549 if (! (VECTORP (fkey_next) || STRINGP (fkey_next)))
8550 error ("Function in key-translation-map returns invalid key sequence");
8553 function_key_possible = ! NILP (fkey_next);
8555 /* If keybuf[fkey_start..fkey_end] is bound in the
8556 function key map and it's a suffix of the current
8557 sequence (i.e. fkey_end == t), replace it with
8558 the binding and restart with fkey_start at the end. */
8559 if ((VECTORP (fkey_next) || STRINGP (fkey_next))
8560 && fkey_end == t)
8562 int len = XFASTINT (Flength (fkey_next));
8564 t = fkey_start + len;
8565 if (t >= bufsize)
8566 error ("Key sequence too long");
8568 if (VECTORP (fkey_next))
8569 bcopy (XVECTOR (fkey_next)->contents,
8570 keybuf + fkey_start,
8571 (t - fkey_start) * sizeof (keybuf[0]));
8572 else if (STRINGP (fkey_next))
8574 int i;
8576 for (i = 0; i < len; i++)
8577 XSETFASTINT (keybuf[fkey_start + i],
8578 XSTRING (fkey_next)->data[i]);
8581 mock_input = t;
8582 fkey_start = fkey_end = t;
8583 fkey_map = Vfunction_key_map;
8585 /* Do pass the results through key-translation-map.
8586 But don't retranslate what key-translation-map
8587 has already translated. */
8588 keytran_end = keytran_start;
8589 keytran_map = Vkey_translation_map;
8591 goto replay_sequence;
8594 fkey_map = get_keymap (fkey_next, 0, 1);
8596 /* If we no longer have a bound suffix, try a new positions for
8597 fkey_start. */
8598 if (!CONSP (fkey_map))
8600 fkey_end = ++fkey_start;
8601 fkey_map = Vfunction_key_map;
8602 function_key_possible = 0;
8607 /* Look for this sequence in key-translation-map. */
8609 Lisp_Object keytran_next;
8611 /* Scan from keytran_end until we find a bound suffix. */
8612 while (keytran_end < t)
8614 Lisp_Object key;
8616 key = keybuf[keytran_end++];
8617 keytran_next
8618 = access_keymap (keytran_map, key, 1, 0, 1);
8620 /* Handle symbol with autoload definition. */
8621 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
8622 && CONSP (XSYMBOL (keytran_next)->function)
8623 && EQ (XCAR (XSYMBOL (keytran_next)->function), Qautoload))
8624 do_autoload (XSYMBOL (keytran_next)->function,
8625 keytran_next);
8627 /* Handle a symbol whose function definition is a keymap
8628 or an array. */
8629 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
8630 && (!NILP (Farrayp (XSYMBOL (keytran_next)->function))
8631 || KEYMAPP (XSYMBOL (keytran_next)->function)))
8632 keytran_next = XSYMBOL (keytran_next)->function;
8634 /* If the key translation map gives a function, not an
8635 array, then call the function with one arg and use
8636 its value instead. */
8637 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
8638 && keytran_end == t)
8640 struct gcpro gcpro1, gcpro2, gcpro3;
8641 Lisp_Object tem;
8642 tem = keytran_next;
8644 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
8645 keytran_next = call1 (keytran_next, prompt);
8646 UNGCPRO;
8647 /* If the function returned something invalid,
8648 barf--don't ignore it.
8649 (To ignore it safely, we would need to gcpro a bunch of
8650 other variables.) */
8651 if (! (VECTORP (keytran_next) || STRINGP (keytran_next)))
8652 error ("Function in key-translation-map returns invalid key sequence");
8655 key_translation_possible = ! NILP (keytran_next);
8657 /* If keybuf[keytran_start..keytran_end] is bound in the
8658 key translation map and it's a suffix of the current
8659 sequence (i.e. keytran_end == t), replace it with
8660 the binding and restart with keytran_start at the end. */
8661 if ((VECTORP (keytran_next) || STRINGP (keytran_next))
8662 && keytran_end == t)
8664 int len = XFASTINT (Flength (keytran_next));
8666 t = keytran_start + len;
8667 if (t >= bufsize)
8668 error ("Key sequence too long");
8670 if (VECTORP (keytran_next))
8671 bcopy (XVECTOR (keytran_next)->contents,
8672 keybuf + keytran_start,
8673 (t - keytran_start) * sizeof (keybuf[0]));
8674 else if (STRINGP (keytran_next))
8676 int i;
8678 for (i = 0; i < len; i++)
8679 XSETFASTINT (keybuf[keytran_start + i],
8680 XSTRING (keytran_next)->data[i]);
8683 mock_input = t;
8684 keytran_start = keytran_end = t;
8685 keytran_map = Vkey_translation_map;
8687 /* Don't pass the results of key-translation-map
8688 through function-key-map. */
8689 fkey_start = fkey_end = t;
8690 fkey_map = Vfunction_key_map;
8692 goto replay_sequence;
8695 keytran_map = get_keymap (keytran_next, 0, 1);
8697 /* If we no longer have a bound suffix, try a new positions for
8698 keytran_start. */
8699 if (!CONSP (keytran_map))
8701 keytran_end = ++keytran_start;
8702 keytran_map = Vkey_translation_map;
8703 key_translation_possible = 0;
8708 /* If KEY is not defined in any of the keymaps,
8709 and cannot be part of a function key or translation,
8710 and is an upper case letter
8711 use the corresponding lower-case letter instead. */
8712 if (first_binding == nmaps && ! function_key_possible
8713 && ! key_translation_possible
8714 && INTEGERP (key)
8715 && ((((XINT (key) & 0x3ffff)
8716 < XCHAR_TABLE (current_buffer->downcase_table)->size)
8717 && UPPERCASEP (XINT (key) & 0x3ffff))
8718 || (XINT (key) & shift_modifier)))
8720 Lisp_Object new_key;
8722 original_uppercase = key;
8723 original_uppercase_position = t - 1;
8725 if (XINT (key) & shift_modifier)
8726 XSETINT (new_key, XINT (key) & ~shift_modifier);
8727 else
8728 XSETINT (new_key, (DOWNCASE (XINT (key) & 0x3ffff)
8729 | (XINT (key) & ~0x3ffff)));
8731 /* We have to do this unconditionally, regardless of whether
8732 the lower-case char is defined in the keymaps, because they
8733 might get translated through function-key-map. */
8734 keybuf[t - 1] = new_key;
8735 mock_input = t;
8737 fkey_map = prev_fkey_map;
8738 fkey_start = prev_fkey_start;
8739 fkey_end = prev_fkey_end;
8741 keytran_map = prev_keytran_map;
8742 keytran_start = prev_keytran_start;
8743 keytran_end = prev_keytran_end;
8745 goto replay_sequence;
8747 /* If KEY is not defined in any of the keymaps,
8748 and cannot be part of a function key or translation,
8749 and is a shifted function key,
8750 use the corresponding unshifted function key instead. */
8751 if (first_binding == nmaps && ! function_key_possible
8752 && ! key_translation_possible
8753 && SYMBOLP (key))
8755 Lisp_Object breakdown;
8756 int modifiers;
8758 breakdown = parse_modifiers (key);
8759 modifiers = XINT (XCAR (XCDR (breakdown)));
8760 if (modifiers & shift_modifier)
8762 Lisp_Object new_key;
8764 original_uppercase = key;
8765 original_uppercase_position = t - 1;
8767 modifiers &= ~shift_modifier;
8768 new_key = apply_modifiers (modifiers,
8769 XCAR (breakdown));
8771 keybuf[t - 1] = new_key;
8772 mock_input = t;
8774 fkey_map = prev_fkey_map;
8775 fkey_start = prev_fkey_start;
8776 fkey_end = prev_fkey_end;
8778 keytran_map = prev_keytran_map;
8779 keytran_start = prev_keytran_start;
8780 keytran_end = prev_keytran_end;
8782 goto replay_sequence;
8787 if (!dummyflag)
8788 read_key_sequence_cmd = (first_binding < nmaps
8789 ? defs[first_binding]
8790 : Qnil);
8792 unread_switch_frame = delayed_switch_frame;
8793 unbind_to (count, Qnil);
8795 /* Don't downcase the last character if the caller says don't.
8796 Don't downcase it if the result is undefined, either. */
8797 if ((dont_downcase_last || first_binding >= nmaps)
8798 && t - 1 == original_uppercase_position)
8799 keybuf[t - 1] = original_uppercase;
8801 /* Occasionally we fabricate events, perhaps by expanding something
8802 according to function-key-map, or by adding a prefix symbol to a
8803 mouse click in the scroll bar or modeline. In this cases, return
8804 the entire generated key sequence, even if we hit an unbound
8805 prefix or a definition before the end. This means that you will
8806 be able to push back the event properly, and also means that
8807 read-key-sequence will always return a logical unit.
8809 Better ideas? */
8810 for (; t < mock_input; t++)
8812 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8813 && NILP (Fzerop (Vecho_keystrokes)))
8814 echo_char (keybuf[t]);
8815 add_command_key (keybuf[t]);
8820 return t;
8823 #if 0 /* This doc string is too long for some compilers.
8824 This commented-out definition serves for DOC. */
8825 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0,
8826 "Read a sequence of keystrokes and return as a string or vector.\n\
8827 The sequence is sufficient to specify a non-prefix command in the\n\
8828 current local and global maps.\n\
8830 First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
8831 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\
8832 as a continuation of the previous key.\n\
8834 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not\n\
8835 convert the last event to lower case. (Normally any upper case event\n\
8836 is converted to lower case if the original event is undefined and the lower\n\
8837 case equivalent is defined.) A non-nil value is appropriate for reading\n\
8838 a key sequence to be defined.\n\
8840 A C-g typed while in this function is treated like any other character,\n\
8841 and `quit-flag' is not set.\n\
8843 If the key sequence starts with a mouse click, then the sequence is read\n\
8844 using the keymaps of the buffer of the window clicked in, not the buffer\n\
8845 of the selected window as normal.\n\
8846 ""\n\
8847 `read-key-sequence' drops unbound button-down events, since you normally\n\
8848 only care about the click or drag events which follow them. If a drag\n\
8849 or multi-click event is unbound, but the corresponding click event would\n\
8850 be bound, `read-key-sequence' turns the event into a click event at the\n\
8851 drag's starting position. This means that you don't have to distinguish\n\
8852 between click and drag, double, or triple events unless you want to.\n\
8854 `read-key-sequence' prefixes mouse events on mode lines, the vertical\n\
8855 lines separating windows, and scroll bars with imaginary keys\n\
8856 `mode-line', `vertical-line', and `vertical-scroll-bar'.\n\
8858 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this\n\
8859 function will process a switch-frame event if the user switches frames\n\
8860 before typing anything. If the user switches frames in the middle of a\n\
8861 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME\n\
8862 is nil, then the event will be put off until after the current key sequence.\n\
8864 `read-key-sequence' checks `function-key-map' for function key\n\
8865 sequences, where they wouldn't conflict with ordinary bindings. See\n\
8866 `function-key-map' for more details.\n\
8868 The optional fifth argument COMMAND-LOOP, if non-nil, means\n\
8869 that this key sequence is being read by something that will\n\
8870 read commands one after another. It should be nil if the caller\n\
8871 will read just one key sequence.")
8872 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame, command-loop)
8873 #endif
8875 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
8877 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
8878 command_loop)
8879 Lisp_Object prompt, continue_echo, dont_downcase_last;
8880 Lisp_Object can_return_switch_frame, command_loop;
8882 Lisp_Object keybuf[30];
8883 register int i;
8884 struct gcpro gcpro1;
8885 int count = specpdl_ptr - specpdl;
8887 if (!NILP (prompt))
8888 CHECK_STRING (prompt, 0);
8889 QUIT;
8891 specbind (Qinput_method_exit_on_first_char,
8892 (NILP (command_loop) ? Qt : Qnil));
8893 specbind (Qinput_method_use_echo_area,
8894 (NILP (command_loop) ? Qt : Qnil));
8896 bzero (keybuf, sizeof keybuf);
8897 GCPRO1 (keybuf[0]);
8898 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
8900 if (NILP (continue_echo))
8902 this_command_key_count = 0;
8903 this_single_command_key_start = 0;
8906 #ifdef HAVE_X_WINDOWS
8907 if (display_busy_cursor_p)
8908 cancel_busy_cursor ();
8909 #endif
8911 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
8912 prompt, ! NILP (dont_downcase_last),
8913 ! NILP (can_return_switch_frame), 0);
8915 #if 0 /* The following is fine for code reading a key sequence and
8916 then proceeding with a lenghty compuation, but it's not good
8917 for code reading keys in a loop, like an input method. */
8918 #ifdef HAVE_X_WINDOWS
8919 if (display_busy_cursor_p)
8920 start_busy_cursor ();
8921 #endif
8922 #endif
8924 if (i == -1)
8926 Vquit_flag = Qt;
8927 QUIT;
8929 UNGCPRO;
8930 return unbind_to (count, make_event_array (i, keybuf));
8933 DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
8934 Sread_key_sequence_vector, 1, 5, 0,
8935 "Like `read-key-sequence' but always return a vector.")
8936 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
8937 command_loop)
8938 Lisp_Object prompt, continue_echo, dont_downcase_last;
8939 Lisp_Object can_return_switch_frame, command_loop;
8941 Lisp_Object keybuf[30];
8942 register int i;
8943 struct gcpro gcpro1;
8944 int count = specpdl_ptr - specpdl;
8946 if (!NILP (prompt))
8947 CHECK_STRING (prompt, 0);
8948 QUIT;
8950 specbind (Qinput_method_exit_on_first_char,
8951 (NILP (command_loop) ? Qt : Qnil));
8952 specbind (Qinput_method_use_echo_area,
8953 (NILP (command_loop) ? Qt : Qnil));
8955 bzero (keybuf, sizeof keybuf);
8956 GCPRO1 (keybuf[0]);
8957 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
8959 if (NILP (continue_echo))
8961 this_command_key_count = 0;
8962 this_single_command_key_start = 0;
8965 #ifdef HAVE_X_WINDOWS
8966 if (display_busy_cursor_p)
8967 cancel_busy_cursor ();
8968 #endif
8970 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
8971 prompt, ! NILP (dont_downcase_last),
8972 ! NILP (can_return_switch_frame), 0);
8974 #ifdef HAVE_X_WINDOWS
8975 if (display_busy_cursor_p)
8976 start_busy_cursor ();
8977 #endif
8979 if (i == -1)
8981 Vquit_flag = Qt;
8982 QUIT;
8984 UNGCPRO;
8985 return unbind_to (count, Fvector (i, keybuf));
8988 DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0,
8989 "Execute CMD as an editor command.\n\
8990 CMD must be a symbol that satisfies the `commandp' predicate.\n\
8991 Optional second arg RECORD-FLAG non-nil\n\
8992 means unconditionally put this command in `command-history'.\n\
8993 Otherwise, that is done only if an arg is read using the minibuffer.\n\
8994 The argument KEYS specifies the value to use instead of (this-command-keys)\n\
8995 when reading the arguments; if it is nil, (this-command-keys) is used.\n\
8996 The argument SPECIAL, if non-nil, means that this command is executing\n\
8997 a special event, so ignore the prefix argument and don't clear it.")
8998 (cmd, record_flag, keys, special)
8999 Lisp_Object cmd, record_flag, keys, special;
9001 register Lisp_Object final;
9002 register Lisp_Object tem;
9003 Lisp_Object prefixarg;
9004 struct backtrace backtrace;
9005 extern int debug_on_next_call;
9007 debug_on_next_call = 0;
9009 if (NILP (special))
9011 prefixarg = current_kboard->Vprefix_arg;
9012 Vcurrent_prefix_arg = prefixarg;
9013 current_kboard->Vprefix_arg = Qnil;
9015 else
9016 prefixarg = Qnil;
9018 if (SYMBOLP (cmd))
9020 tem = Fget (cmd, Qdisabled);
9021 if (!NILP (tem) && !NILP (Vrun_hooks))
9023 tem = Fsymbol_value (Qdisabled_command_hook);
9024 if (!NILP (tem))
9025 return call1 (Vrun_hooks, Qdisabled_command_hook);
9029 while (1)
9031 final = Findirect_function (cmd);
9033 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
9035 struct gcpro gcpro1, gcpro2;
9037 GCPRO2 (cmd, prefixarg);
9038 do_autoload (final, cmd);
9039 UNGCPRO;
9041 else
9042 break;
9045 if (STRINGP (final) || VECTORP (final))
9047 /* If requested, place the macro in the command history. For
9048 other sorts of commands, call-interactively takes care of
9049 this. */
9050 if (!NILP (record_flag))
9052 Vcommand_history
9053 = Fcons (Fcons (Qexecute_kbd_macro,
9054 Fcons (final, Fcons (prefixarg, Qnil))),
9055 Vcommand_history);
9057 /* Don't keep command history around forever. */
9058 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
9060 tem = Fnthcdr (Vhistory_length, Vcommand_history);
9061 if (CONSP (tem))
9062 XCDR (tem) = Qnil;
9066 return Fexecute_kbd_macro (final, prefixarg);
9069 if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
9071 backtrace.next = backtrace_list;
9072 backtrace_list = &backtrace;
9073 backtrace.function = &Qcall_interactively;
9074 backtrace.args = &cmd;
9075 backtrace.nargs = 1;
9076 backtrace.evalargs = 0;
9078 tem = Fcall_interactively (cmd, record_flag, keys);
9080 backtrace_list = backtrace.next;
9081 return tem;
9083 return Qnil;
9086 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
9087 1, 1, "P",
9088 "Read function name, then read its arguments and call it.")
9089 (prefixarg)
9090 Lisp_Object prefixarg;
9092 Lisp_Object function;
9093 char buf[40];
9094 Lisp_Object saved_keys;
9095 Lisp_Object bindings, value;
9096 struct gcpro gcpro1, gcpro2;
9098 saved_keys = Fvector (this_command_key_count,
9099 XVECTOR (this_command_keys)->contents);
9100 buf[0] = 0;
9101 GCPRO2 (saved_keys, prefixarg);
9103 if (EQ (prefixarg, Qminus))
9104 strcpy (buf, "- ");
9105 else if (CONSP (prefixarg) && XINT (XCAR (prefixarg)) == 4)
9106 strcpy (buf, "C-u ");
9107 else if (CONSP (prefixarg) && INTEGERP (XCAR (prefixarg)))
9109 if (sizeof (int) == sizeof (EMACS_INT))
9110 sprintf (buf, "%d ", XINT (XCAR (prefixarg)));
9111 else if (sizeof (long) == sizeof (EMACS_INT))
9112 sprintf (buf, "%ld ", (long) XINT (XCAR (prefixarg)));
9113 else
9114 abort ();
9116 else if (INTEGERP (prefixarg))
9118 if (sizeof (int) == sizeof (EMACS_INT))
9119 sprintf (buf, "%d ", XINT (prefixarg));
9120 else if (sizeof (long) == sizeof (EMACS_INT))
9121 sprintf (buf, "%ld ", (long) XINT (prefixarg));
9122 else
9123 abort ();
9126 /* This isn't strictly correct if execute-extended-command
9127 is bound to anything else. Perhaps it should use
9128 this_command_keys? */
9129 strcat (buf, "M-x ");
9131 /* Prompt with buf, and then read a string, completing from and
9132 restricting to the set of all defined commands. Don't provide
9133 any initial input. Save the command read on the extended-command
9134 history list. */
9135 function = Fcompleting_read (build_string (buf),
9136 Vobarray, Qcommandp,
9137 Qt, Qnil, Qextended_command_history, Qnil,
9138 Qnil);
9140 if (STRINGP (function) && XSTRING (function)->size == 0)
9141 error ("No command name given");
9143 /* Set this_command_keys to the concatenation of saved_keys and
9144 function, followed by a RET. */
9146 struct Lisp_String *str;
9147 Lisp_Object *keys;
9148 int i;
9150 this_command_key_count = 0;
9151 this_single_command_key_start = 0;
9153 keys = XVECTOR (saved_keys)->contents;
9154 for (i = 0; i < XVECTOR (saved_keys)->size; i++)
9155 add_command_key (keys[i]);
9157 str = XSTRING (function);
9158 for (i = 0; i < str->size; i++)
9159 add_command_key (Faref (function, make_number (i)));
9161 add_command_key (make_number ('\015'));
9164 UNGCPRO;
9166 function = Fintern (function, Qnil);
9167 current_kboard->Vprefix_arg = prefixarg;
9168 Vthis_command = function;
9169 real_this_command = function;
9171 /* If enabled, show which key runs this command. */
9172 if (!NILP (Vsuggest_key_bindings)
9173 && NILP (Vexecuting_macro)
9174 && SYMBOLP (function))
9175 bindings = Fwhere_is_internal (function, Voverriding_local_map,
9176 Qt, Qnil);
9177 else
9178 bindings = Qnil;
9180 value = Qnil;
9181 GCPRO2 (bindings, value);
9182 value = Fcommand_execute (function, Qt, Qnil, Qnil);
9184 /* If the command has a key binding, print it now. */
9185 if (!NILP (bindings)
9186 && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
9187 Qmouse_movement)))
9189 /* But first wait, and skip the message if there is input. */
9190 int delay_time;
9191 if (!NILP (echo_area_buffer[0]))
9192 /* This command displayed something in the echo area;
9193 so wait a few seconds, then display our suggestion message. */
9194 delay_time = (NUMBERP (Vsuggest_key_bindings)
9195 ? XINT (Vsuggest_key_bindings) : 2);
9196 else
9197 /* This command left the echo area empty,
9198 so display our message immediately. */
9199 delay_time = 0;
9201 if (!NILP (Fsit_for (make_number (delay_time), Qnil, Qnil))
9202 && ! CONSP (Vunread_command_events))
9204 Lisp_Object binding;
9205 char *newmessage;
9206 int message_p = push_message ();
9208 binding = Fkey_description (bindings);
9210 newmessage
9211 = (char *) alloca (XSYMBOL (function)->name->size
9212 + STRING_BYTES (XSTRING (binding))
9213 + 100);
9214 sprintf (newmessage, "You can run the command `%s' with %s",
9215 XSYMBOL (function)->name->data,
9216 XSTRING (binding)->data);
9217 message2_nolog (newmessage,
9218 strlen (newmessage),
9219 STRING_MULTIBYTE (binding));
9220 if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings)
9221 ? Vsuggest_key_bindings : make_number (2)),
9222 Qnil, Qnil))
9223 && message_p)
9224 restore_message ();
9226 pop_message ();
9230 RETURN_UNGCPRO (value);
9233 /* Find the set of keymaps now active.
9234 Store into *MAPS_P a vector holding the various maps
9235 and return the number of them. The vector was malloc'd
9236 and the caller should free it. */
9239 current_active_maps (maps_p)
9240 Lisp_Object **maps_p;
9242 Lisp_Object *tmaps, *maps;
9243 int nmaps;
9245 /* Should overriding-terminal-local-map and overriding-local-map apply? */
9246 if (!NILP (Voverriding_local_map_menu_flag))
9248 /* Yes, use them (if non-nil) as well as the global map. */
9249 maps = (Lisp_Object *) xmalloc (3 * sizeof (maps[0]));
9250 nmaps = 0;
9251 if (!NILP (current_kboard->Voverriding_terminal_local_map))
9252 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
9253 if (!NILP (Voverriding_local_map))
9254 maps[nmaps++] = Voverriding_local_map;
9256 else
9258 /* No, so use major and minor mode keymaps and keymap property. */
9259 int extra_maps = 2;
9260 Lisp_Object map = get_local_map (PT, current_buffer, keymap);
9261 if (!NILP (map))
9262 extra_maps = 3;
9263 nmaps = current_minor_maps (NULL, &tmaps);
9264 maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
9265 * sizeof (maps[0]));
9266 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
9267 if (!NILP (map))
9268 maps[nmaps++] = map;
9269 maps[nmaps++] = get_local_map (PT, current_buffer, local_map);
9271 maps[nmaps++] = current_global_map;
9273 *maps_p = maps;
9274 return nmaps;
9277 /* Return nonzero if input events are pending. */
9280 detect_input_pending ()
9282 if (!input_pending)
9283 get_input_pending (&input_pending, 0);
9285 return input_pending;
9288 /* Return nonzero if input events are pending, and run any pending timers. */
9291 detect_input_pending_run_timers (do_display)
9292 int do_display;
9294 int old_timers_run = timers_run;
9296 if (!input_pending)
9297 get_input_pending (&input_pending, 1);
9299 if (old_timers_run != timers_run && do_display)
9301 redisplay_preserve_echo_area ();
9302 /* The following fixes a bug when using lazy-lock with
9303 lazy-lock-defer-on-the-fly set to t, i.e. when fontifying
9304 from an idle timer function. The symptom of the bug is that
9305 the cursor sometimes doesn't become visible until the next X
9306 event is processed. --gerd. */
9307 if (rif)
9308 rif->flush_display (NULL);
9311 return input_pending;
9314 /* This is called in some cases before a possible quit.
9315 It cases the next call to detect_input_pending to recompute input_pending.
9316 So calling this function unnecessarily can't do any harm. */
9318 void
9319 clear_input_pending ()
9321 input_pending = 0;
9324 /* Return nonzero if there are pending requeued events.
9325 This isn't used yet. The hope is to make wait_reading_process_input
9326 call it, and return return if it runs Lisp code that unreads something.
9327 The problem is, kbd_buffer_get_event needs to be fixed to know what
9328 to do in that case. It isn't trivial. */
9331 requeued_events_pending_p ()
9333 return (!NILP (Vunread_command_events) || unread_command_char != -1);
9337 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
9338 "T if command input is currently available with no waiting.\n\
9339 Actually, the value is nil only if we can be sure that no input is available.")
9342 if (!NILP (Vunread_command_events) || unread_command_char != -1)
9343 return (Qt);
9345 get_input_pending (&input_pending, 1);
9346 return input_pending > 0 ? Qt : Qnil;
9349 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
9350 "Return vector of last 100 events, not counting those from keyboard macros.")
9353 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
9354 Lisp_Object val;
9356 if (total_keys < NUM_RECENT_KEYS)
9357 return Fvector (total_keys, keys);
9358 else
9360 val = Fvector (NUM_RECENT_KEYS, keys);
9361 bcopy (keys + recent_keys_index,
9362 XVECTOR (val)->contents,
9363 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
9364 bcopy (keys,
9365 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
9366 recent_keys_index * sizeof (Lisp_Object));
9367 return val;
9371 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
9372 "Return the key sequence that invoked this command.\n\
9373 The value is a string or a vector.")
9376 return make_event_array (this_command_key_count,
9377 XVECTOR (this_command_keys)->contents);
9380 DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
9381 "Return the key sequence that invoked this command, as a vector.")
9384 return Fvector (this_command_key_count,
9385 XVECTOR (this_command_keys)->contents);
9388 DEFUN ("this-single-command-keys", Fthis_single_command_keys,
9389 Sthis_single_command_keys, 0, 0, 0,
9390 "Return the key sequence that invoked this command.\n\
9391 Unlike `this-command-keys', this function's value\n\
9392 does not include prefix arguments.\n\
9393 The value is always a vector.")
9396 return Fvector (this_command_key_count
9397 - this_single_command_key_start,
9398 (XVECTOR (this_command_keys)->contents
9399 + this_single_command_key_start));
9402 DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
9403 Sthis_single_command_raw_keys, 0, 0, 0,
9404 "Return the raw events that were read for this command.\n\
9405 Unlike `this-single-command-keys', this function's value\n\
9406 shows the events before all translations (except for input methods).\n\
9407 The value is always a vector.")
9410 return Fvector (raw_keybuf_count,
9411 (XVECTOR (raw_keybuf)->contents));
9414 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
9415 Sreset_this_command_lengths, 0, 0, 0,
9416 "Used for complicated reasons in `universal-argument-other-key'.\n\
9418 `universal-argument-other-key' rereads the event just typed.\n\
9419 It then gets translated through `function-key-map'.\n\
9420 The translated event gets included in the echo area and in\n\
9421 the value of `this-command-keys' in addition to the raw original event.\n\
9422 That is not right.\n\
9424 Calling this function directs the translated event to replace\n\
9425 the original event, so that only one version of the event actually\n\
9426 appears in the echo area and in the value of `this-command-keys.'.")
9429 before_command_restore_flag = 1;
9430 before_command_key_count_1 = before_command_key_count;
9431 before_command_echo_length_1 = before_command_echo_length;
9432 return Qnil;
9435 DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
9436 Sclear_this_command_keys, 0, 0, 0,
9437 "Clear out the vector that `this-command-keys' returns.\n\
9438 Clear vector containing last 100 events.")
9441 int i;
9443 this_command_key_count = 0;
9445 for (i = 0; i < XVECTOR (recent_keys)->size; ++i)
9446 XVECTOR (recent_keys)->contents[i] = Qnil;
9447 total_keys = 0;
9448 recent_keys_index = 0;
9449 return Qnil;
9452 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
9453 "Return the current depth in recursive edits.")
9456 Lisp_Object temp;
9457 XSETFASTINT (temp, command_loop_level + minibuf_level);
9458 return temp;
9461 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
9462 "FOpen dribble file: ",
9463 "Start writing all keyboard characters to a dribble file called FILE.\n\
9464 If FILE is nil, close any open dribble file.")
9465 (file)
9466 Lisp_Object file;
9468 if (dribble)
9470 fclose (dribble);
9471 dribble = 0;
9473 if (!NILP (file))
9475 file = Fexpand_file_name (file, Qnil);
9476 dribble = fopen (XSTRING (file)->data, "w");
9477 if (dribble == 0)
9478 report_file_error ("Opening dribble", Fcons (file, Qnil));
9480 return Qnil;
9483 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
9484 "Discard the contents of the terminal input buffer.\n\
9485 Also cancel any kbd macro being defined.")
9488 current_kboard->defining_kbd_macro = Qnil;
9489 update_mode_lines++;
9491 Vunread_command_events = Qnil;
9492 unread_command_char = -1;
9494 discard_tty_input ();
9496 kbd_fetch_ptr = kbd_store_ptr;
9497 Ffillarray (kbd_buffer_gcpro, Qnil);
9498 input_pending = 0;
9500 return Qnil;
9503 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
9504 "Stop Emacs and return to superior process. You can resume later.\n\
9505 If `cannot-suspend' is non-nil, or if the system doesn't support job\n\
9506 control, run a subshell instead.\n\n\
9507 If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
9508 to be read as terminal input by Emacs's parent, after suspension.\n\
9510 Before suspending, run the normal hook `suspend-hook'.\n\
9511 After resumption run the normal hook `suspend-resume-hook'.\n\
9513 Some operating systems cannot stop the Emacs process and resume it later.\n\
9514 On such systems, Emacs starts a subshell instead of suspending.")
9515 (stuffstring)
9516 Lisp_Object stuffstring;
9518 int count = specpdl_ptr - specpdl;
9519 int old_height, old_width;
9520 int width, height;
9521 struct gcpro gcpro1;
9523 if (!NILP (stuffstring))
9524 CHECK_STRING (stuffstring, 0);
9526 /* Run the functions in suspend-hook. */
9527 if (!NILP (Vrun_hooks))
9528 call1 (Vrun_hooks, intern ("suspend-hook"));
9530 GCPRO1 (stuffstring);
9531 get_frame_size (&old_width, &old_height);
9532 reset_sys_modes ();
9533 /* sys_suspend can get an error if it tries to fork a subshell
9534 and the system resources aren't available for that. */
9535 record_unwind_protect ((Lisp_Object (*) P_ ((Lisp_Object))) init_sys_modes,
9536 Qnil);
9537 stuff_buffered_input (stuffstring);
9538 if (cannot_suspend)
9539 sys_subshell ();
9540 else
9541 sys_suspend ();
9542 unbind_to (count, Qnil);
9544 /* Check if terminal/window size has changed.
9545 Note that this is not useful when we are running directly
9546 with a window system; but suspend should be disabled in that case. */
9547 get_frame_size (&width, &height);
9548 if (width != old_width || height != old_height)
9549 change_frame_size (SELECTED_FRAME (), height, width, 0, 0, 0);
9551 /* Run suspend-resume-hook. */
9552 if (!NILP (Vrun_hooks))
9553 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
9555 UNGCPRO;
9556 return Qnil;
9559 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
9560 Then in any case stuff anything Emacs has read ahead and not used. */
9562 void
9563 stuff_buffered_input (stuffstring)
9564 Lisp_Object stuffstring;
9566 /* stuff_char works only in BSD, versions 4.2 and up. */
9567 #ifdef BSD_SYSTEM
9568 #ifndef BSD4_1
9569 register unsigned char *p;
9571 if (STRINGP (stuffstring))
9573 register int count;
9575 p = XSTRING (stuffstring)->data;
9576 count = STRING_BYTES (XSTRING (stuffstring));
9577 while (count-- > 0)
9578 stuff_char (*p++);
9579 stuff_char ('\n');
9582 /* Anything we have read ahead, put back for the shell to read. */
9583 /* ?? What should this do when we have multiple keyboards??
9584 Should we ignore anything that was typed in at the "wrong" kboard? */
9585 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
9587 int idx;
9589 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
9590 kbd_fetch_ptr = kbd_buffer;
9591 if (kbd_fetch_ptr->kind == ascii_keystroke)
9592 stuff_char (kbd_fetch_ptr->code);
9594 kbd_fetch_ptr->kind = no_event;
9595 idx = 2 * (kbd_fetch_ptr - kbd_buffer);
9596 ASET (kbd_buffer_gcpro, idx, Qnil);
9597 ASET (kbd_buffer_gcpro, idx + 1, Qnil);
9600 input_pending = 0;
9601 #endif
9602 #endif /* BSD_SYSTEM and not BSD4_1 */
9605 void
9606 set_waiting_for_input (time_to_clear)
9607 EMACS_TIME *time_to_clear;
9609 input_available_clear_time = time_to_clear;
9611 /* Tell interrupt_signal to throw back to read_char, */
9612 waiting_for_input = 1;
9614 /* If interrupt_signal was called before and buffered a C-g,
9615 make it run again now, to avoid timing error. */
9616 if (!NILP (Vquit_flag))
9617 quit_throw_to_read_char ();
9620 void
9621 clear_waiting_for_input ()
9623 /* Tell interrupt_signal not to throw back to read_char, */
9624 waiting_for_input = 0;
9625 input_available_clear_time = 0;
9628 /* This routine is called at interrupt level in response to C-G.
9630 If interrupt_input, this is the handler for SIGINT. Otherwise, it
9631 is called from kbd_buffer_store_event, in handling SIGIO or
9632 SIGTINT.
9634 If `waiting_for_input' is non zero, then unless `echoing' is
9635 nonzero, immediately throw back to read_char.
9637 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
9638 eval to throw, when it gets a chance. If quit-flag is already
9639 non-nil, it stops the job right away. */
9641 SIGTYPE
9642 interrupt_signal (signalnum) /* If we don't have an argument, */
9643 int signalnum; /* some compilers complain in signal calls. */
9645 char c;
9646 /* Must preserve main program's value of errno. */
9647 int old_errno = errno;
9648 struct frame *sf = SELECTED_FRAME ();
9650 #if defined (USG) && !defined (POSIX_SIGNALS)
9651 if (!read_socket_hook && NILP (Vwindow_system))
9653 /* USG systems forget handlers when they are used;
9654 must reestablish each time */
9655 signal (SIGINT, interrupt_signal);
9656 signal (SIGQUIT, interrupt_signal);
9658 #endif /* USG */
9660 cancel_echoing ();
9662 if (!NILP (Vquit_flag)
9663 && (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf)))
9665 /* If SIGINT isn't blocked, don't let us be interrupted by
9666 another SIGINT, it might be harmful due to non-reentrancy
9667 in I/O functions. */
9668 sigblock (sigmask (SIGINT));
9670 fflush (stdout);
9671 reset_sys_modes ();
9673 #ifdef SIGTSTP /* Support possible in later USG versions */
9675 * On systems which can suspend the current process and return to the original
9676 * shell, this command causes the user to end up back at the shell.
9677 * The "Auto-save" and "Abort" questions are not asked until
9678 * the user elects to return to emacs, at which point he can save the current
9679 * job and either dump core or continue.
9681 sys_suspend ();
9682 #else
9683 #ifdef VMS
9684 if (sys_suspend () == -1)
9686 printf ("Not running as a subprocess;\n");
9687 printf ("you can continue or abort.\n");
9689 #else /* not VMS */
9690 /* Perhaps should really fork an inferior shell?
9691 But that would not provide any way to get back
9692 to the original shell, ever. */
9693 printf ("No support for stopping a process on this operating system;\n");
9694 printf ("you can continue or abort.\n");
9695 #endif /* not VMS */
9696 #endif /* not SIGTSTP */
9697 #ifdef MSDOS
9698 /* We must remain inside the screen area when the internal terminal
9699 is used. Note that [Enter] is not echoed by dos. */
9700 cursor_to (0, 0);
9701 #endif
9702 /* It doesn't work to autosave while GC is in progress;
9703 the code used for auto-saving doesn't cope with the mark bit. */
9704 if (!gc_in_progress)
9706 printf ("Auto-save? (y or n) ");
9707 fflush (stdout);
9708 if (((c = getchar ()) & ~040) == 'Y')
9710 Fdo_auto_save (Qt, Qnil);
9711 #ifdef MSDOS
9712 printf ("\r\nAuto-save done");
9713 #else /* not MSDOS */
9714 printf ("Auto-save done\n");
9715 #endif /* not MSDOS */
9717 while (c != '\n') c = getchar ();
9719 else
9721 /* During GC, it must be safe to reenable quitting again. */
9722 Vinhibit_quit = Qnil;
9723 #ifdef MSDOS
9724 printf ("\r\n");
9725 #endif /* not MSDOS */
9726 printf ("Garbage collection in progress; cannot auto-save now\r\n");
9727 printf ("but will instead do a real quit after garbage collection ends\r\n");
9728 fflush (stdout);
9731 #ifdef MSDOS
9732 printf ("\r\nAbort? (y or n) ");
9733 #else /* not MSDOS */
9734 #ifdef VMS
9735 printf ("Abort (and enter debugger)? (y or n) ");
9736 #else /* not VMS */
9737 printf ("Abort (and dump core)? (y or n) ");
9738 #endif /* not VMS */
9739 #endif /* not MSDOS */
9740 fflush (stdout);
9741 if (((c = getchar ()) & ~040) == 'Y')
9742 abort ();
9743 while (c != '\n') c = getchar ();
9744 #ifdef MSDOS
9745 printf ("\r\nContinuing...\r\n");
9746 #else /* not MSDOS */
9747 printf ("Continuing...\n");
9748 #endif /* not MSDOS */
9749 fflush (stdout);
9750 init_sys_modes ();
9751 sigfree ();
9753 else
9755 /* If executing a function that wants to be interrupted out of
9756 and the user has not deferred quitting by binding `inhibit-quit'
9757 then quit right away. */
9758 if (immediate_quit && NILP (Vinhibit_quit))
9760 struct gl_state_s saved;
9761 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9763 immediate_quit = 0;
9764 sigfree ();
9765 saved = gl_state;
9766 GCPRO4 (saved.object, saved.global_code,
9767 saved.current_syntax_table, saved.old_prop);
9768 Fsignal (Qquit, Qnil);
9769 gl_state = saved;
9770 UNGCPRO;
9772 else
9773 /* Else request quit when it's safe */
9774 Vquit_flag = Qt;
9777 if (waiting_for_input && !echoing)
9778 quit_throw_to_read_char ();
9780 errno = old_errno;
9783 /* Handle a C-g by making read_char return C-g. */
9785 void
9786 quit_throw_to_read_char ()
9788 sigfree ();
9789 /* Prevent another signal from doing this before we finish. */
9790 clear_waiting_for_input ();
9791 input_pending = 0;
9793 Vunread_command_events = Qnil;
9794 unread_command_char = -1;
9796 #if 0 /* Currently, sit_for is called from read_char without turning
9797 off polling. And that can call set_waiting_for_input.
9798 It seems to be harmless. */
9799 #ifdef POLL_FOR_INPUT
9800 /* May be > 1 if in recursive minibuffer. */
9801 if (poll_suppress_count == 0)
9802 abort ();
9803 #endif
9804 #endif
9805 if (FRAMEP (internal_last_event_frame)
9806 && !EQ (internal_last_event_frame, selected_frame))
9807 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
9808 Qnil, 0);
9810 _longjmp (getcjmp, 1);
9813 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
9814 "Set mode of reading keyboard input.\n\
9815 First arg INTERRUPT non-nil means use input interrupts;\n\
9816 nil means use CBREAK mode.\n\
9817 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
9818 (no effect except in CBREAK mode).\n\
9819 Third arg META t means accept 8-bit input (for a Meta key).\n\
9820 META nil means ignore the top bit, on the assumption it is parity.\n\
9821 Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\
9822 Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\
9823 See also `current-input-mode'.")
9824 (interrupt, flow, meta, quit)
9825 Lisp_Object interrupt, flow, meta, quit;
9827 if (!NILP (quit)
9828 && (!INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400))
9829 error ("set-input-mode: QUIT must be an ASCII character");
9831 #ifdef POLL_FOR_INPUT
9832 stop_polling ();
9833 #endif
9835 #ifndef DOS_NT
9836 /* this causes startup screen to be restored and messes with the mouse */
9837 reset_sys_modes ();
9838 #endif
9840 #ifdef SIGIO
9841 /* Note SIGIO has been undef'd if FIONREAD is missing. */
9842 if (read_socket_hook)
9844 /* When using X, don't give the user a real choice,
9845 because we haven't implemented the mechanisms to support it. */
9846 #ifdef NO_SOCK_SIGIO
9847 interrupt_input = 0;
9848 #else /* not NO_SOCK_SIGIO */
9849 interrupt_input = 1;
9850 #endif /* NO_SOCK_SIGIO */
9852 else
9853 interrupt_input = !NILP (interrupt);
9854 #else /* not SIGIO */
9855 interrupt_input = 0;
9856 #endif /* not SIGIO */
9858 /* Our VMS input only works by interrupts, as of now. */
9859 #ifdef VMS
9860 interrupt_input = 1;
9861 #endif
9863 flow_control = !NILP (flow);
9864 if (NILP (meta))
9865 meta_key = 0;
9866 else if (EQ (meta, Qt))
9867 meta_key = 1;
9868 else
9869 meta_key = 2;
9870 if (!NILP (quit))
9871 /* Don't let this value be out of range. */
9872 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
9874 #ifndef DOS_NT
9875 init_sys_modes ();
9876 #endif
9878 #ifdef POLL_FOR_INPUT
9879 poll_suppress_count = 1;
9880 start_polling ();
9881 #endif
9882 return Qnil;
9885 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
9886 "Return information about the way Emacs currently reads keyboard input.\n\
9887 The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\
9888 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\
9889 nil, Emacs is using CBREAK mode.\n\
9890 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\
9891 terminal; this does not apply if Emacs uses interrupt-driven input.\n\
9892 META is t if accepting 8-bit input with 8th bit as Meta flag.\n\
9893 META nil means ignoring the top bit, on the assumption it is parity.\n\
9894 META is neither t nor nil if accepting 8-bit input and using\n\
9895 all 8 bits as the character code.\n\
9896 QUIT is the character Emacs currently uses to quit.\n\
9897 The elements of this list correspond to the arguments of\n\
9898 `set-input-mode'.")
9901 Lisp_Object val[4];
9903 val[0] = interrupt_input ? Qt : Qnil;
9904 val[1] = flow_control ? Qt : Qnil;
9905 val[2] = meta_key == 2 ? make_number (0) : meta_key == 1 ? Qt : Qnil;
9906 XSETFASTINT (val[3], quit_char);
9908 return Flist (sizeof (val) / sizeof (val[0]), val);
9913 * Set up a new kboard object with reasonable initial values.
9915 void
9916 init_kboard (kb)
9917 KBOARD *kb;
9919 kb->Voverriding_terminal_local_map = Qnil;
9920 kb->Vlast_command = Qnil;
9921 kb->Vreal_last_command = Qnil;
9922 kb->Vprefix_arg = Qnil;
9923 kb->Vlast_prefix_arg = Qnil;
9924 kb->kbd_queue = Qnil;
9925 kb->kbd_queue_has_data = 0;
9926 kb->immediate_echo = 0;
9927 kb->echoptr = kb->echobuf;
9928 kb->echo_after_prompt = -1;
9929 kb->kbd_macro_buffer = 0;
9930 kb->kbd_macro_bufsize = 0;
9931 kb->defining_kbd_macro = Qnil;
9932 kb->Vlast_kbd_macro = Qnil;
9933 kb->reference_count = 0;
9934 kb->Vsystem_key_alist = Qnil;
9935 kb->system_key_syms = Qnil;
9936 kb->Vdefault_minibuffer_frame = Qnil;
9940 * Destroy the contents of a kboard object, but not the object itself.
9941 * We use this just before deleting it, or if we're going to initialize
9942 * it a second time.
9944 static void
9945 wipe_kboard (kb)
9946 KBOARD *kb;
9948 if (kb->kbd_macro_buffer)
9949 xfree (kb->kbd_macro_buffer);
9952 #ifdef MULTI_KBOARD
9953 void
9954 delete_kboard (kb)
9955 KBOARD *kb;
9957 KBOARD **kbp;
9958 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
9959 if (*kbp == NULL)
9960 abort ();
9961 *kbp = kb->next_kboard;
9962 wipe_kboard (kb);
9963 xfree (kb);
9965 #endif
9967 void
9968 init_keyboard ()
9970 /* This is correct before outermost invocation of the editor loop */
9971 command_loop_level = -1;
9972 immediate_quit = 0;
9973 quit_char = Ctl ('g');
9974 Vunread_command_events = Qnil;
9975 unread_command_char = -1;
9976 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
9977 total_keys = 0;
9978 recent_keys_index = 0;
9979 kbd_fetch_ptr = kbd_buffer;
9980 kbd_store_ptr = kbd_buffer;
9981 kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
9982 #ifdef HAVE_MOUSE
9983 do_mouse_tracking = Qnil;
9984 #endif
9985 input_pending = 0;
9987 /* This means that command_loop_1 won't try to select anything the first
9988 time through. */
9989 internal_last_event_frame = Qnil;
9990 Vlast_event_frame = internal_last_event_frame;
9992 #ifdef MULTI_KBOARD
9993 current_kboard = initial_kboard;
9994 #endif
9995 wipe_kboard (current_kboard);
9996 init_kboard (current_kboard);
9998 if (!noninteractive && !read_socket_hook && NILP (Vwindow_system))
10000 signal (SIGINT, interrupt_signal);
10001 #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
10002 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
10003 SIGQUIT and we can't tell which one it will give us. */
10004 signal (SIGQUIT, interrupt_signal);
10005 #endif /* HAVE_TERMIO */
10007 /* Note SIGIO has been undef'd if FIONREAD is missing. */
10008 #ifdef SIGIO
10009 if (!noninteractive)
10010 signal (SIGIO, input_available_signal);
10011 #endif /* SIGIO */
10013 /* Use interrupt input by default, if it works and noninterrupt input
10014 has deficiencies. */
10016 #ifdef INTERRUPT_INPUT
10017 interrupt_input = 1;
10018 #else
10019 interrupt_input = 0;
10020 #endif
10022 /* Our VMS input only works by interrupts, as of now. */
10023 #ifdef VMS
10024 interrupt_input = 1;
10025 #endif
10027 sigfree ();
10028 dribble = 0;
10030 if (keyboard_init_hook)
10031 (*keyboard_init_hook) ();
10033 #ifdef POLL_FOR_INPUT
10034 poll_suppress_count = 1;
10035 start_polling ();
10036 #endif
10039 /* This type's only use is in syms_of_keyboard, to initialize the
10040 event header symbols and put properties on them. */
10041 struct event_head {
10042 Lisp_Object *var;
10043 char *name;
10044 Lisp_Object *kind;
10047 struct event_head head_table[] = {
10048 &Qmouse_movement, "mouse-movement", &Qmouse_movement,
10049 &Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement,
10050 &Qswitch_frame, "switch-frame", &Qswitch_frame,
10051 &Qdelete_frame, "delete-frame", &Qdelete_frame,
10052 &Qiconify_frame, "iconify-frame", &Qiconify_frame,
10053 &Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible,
10056 void
10057 syms_of_keyboard ()
10059 Vlispy_mouse_stem = build_string ("mouse");
10060 staticpro (&Vlispy_mouse_stem);
10062 /* Tool-bars. */
10063 QCimage = intern (":image");
10064 staticpro (&QCimage);
10066 staticpro (&Qhelp_echo);
10067 Qhelp_echo = intern ("help-echo");
10069 staticpro (&item_properties);
10070 item_properties = Qnil;
10072 staticpro (&tool_bar_item_properties);
10073 tool_bar_item_properties = Qnil;
10074 staticpro (&tool_bar_items_vector);
10075 tool_bar_items_vector = Qnil;
10077 staticpro (&real_this_command);
10078 real_this_command = Qnil;
10080 Qtimer_event_handler = intern ("timer-event-handler");
10081 staticpro (&Qtimer_event_handler);
10083 Qdisabled_command_hook = intern ("disabled-command-hook");
10084 staticpro (&Qdisabled_command_hook);
10086 Qself_insert_command = intern ("self-insert-command");
10087 staticpro (&Qself_insert_command);
10089 Qforward_char = intern ("forward-char");
10090 staticpro (&Qforward_char);
10092 Qbackward_char = intern ("backward-char");
10093 staticpro (&Qbackward_char);
10095 Qdisabled = intern ("disabled");
10096 staticpro (&Qdisabled);
10098 Qundefined = intern ("undefined");
10099 staticpro (&Qundefined);
10101 Qpre_command_hook = intern ("pre-command-hook");
10102 staticpro (&Qpre_command_hook);
10104 Qpost_command_hook = intern ("post-command-hook");
10105 staticpro (&Qpost_command_hook);
10107 Qpost_command_idle_hook = intern ("post-command-idle-hook");
10108 staticpro (&Qpost_command_idle_hook);
10110 Qdeferred_action_function = intern ("deferred-action-function");
10111 staticpro (&Qdeferred_action_function);
10113 Qcommand_hook_internal = intern ("command-hook-internal");
10114 staticpro (&Qcommand_hook_internal);
10116 Qfunction_key = intern ("function-key");
10117 staticpro (&Qfunction_key);
10118 Qmouse_click = intern ("mouse-click");
10119 staticpro (&Qmouse_click);
10120 #ifdef WINDOWSNT
10121 Qmouse_wheel = intern ("mouse-wheel");
10122 staticpro (&Qmouse_wheel);
10123 Qlanguage_change = intern ("language-change");
10124 staticpro (&Qlanguage_change);
10125 #endif
10126 Qdrag_n_drop = intern ("drag-n-drop");
10127 staticpro (&Qdrag_n_drop);
10129 Qusr1_signal = intern ("usr1-signal");
10130 staticpro (&Qusr1_signal);
10131 Qusr2_signal = intern ("usr2-signal");
10132 staticpro (&Qusr2_signal);
10134 Qmenu_enable = intern ("menu-enable");
10135 staticpro (&Qmenu_enable);
10136 Qmenu_alias = intern ("menu-alias");
10137 staticpro (&Qmenu_alias);
10138 QCenable = intern (":enable");
10139 staticpro (&QCenable);
10140 QCvisible = intern (":visible");
10141 staticpro (&QCvisible);
10142 QChelp = intern (":help");
10143 staticpro (&QChelp);
10144 QCfilter = intern (":filter");
10145 staticpro (&QCfilter);
10146 QCbutton = intern (":button");
10147 staticpro (&QCbutton);
10148 QCkeys = intern (":keys");
10149 staticpro (&QCkeys);
10150 QCkey_sequence = intern (":key-sequence");
10151 staticpro (&QCkey_sequence);
10152 QCtoggle = intern (":toggle");
10153 staticpro (&QCtoggle);
10154 QCradio = intern (":radio");
10155 staticpro (&QCradio);
10157 Qmode_line = intern ("mode-line");
10158 staticpro (&Qmode_line);
10159 Qvertical_line = intern ("vertical-line");
10160 staticpro (&Qvertical_line);
10161 Qvertical_scroll_bar = intern ("vertical-scroll-bar");
10162 staticpro (&Qvertical_scroll_bar);
10163 Qmenu_bar = intern ("menu-bar");
10164 staticpro (&Qmenu_bar);
10166 Qabove_handle = intern ("above-handle");
10167 staticpro (&Qabove_handle);
10168 Qhandle = intern ("handle");
10169 staticpro (&Qhandle);
10170 Qbelow_handle = intern ("below-handle");
10171 staticpro (&Qbelow_handle);
10172 Qup = intern ("up");
10173 staticpro (&Qup);
10174 Qdown = intern ("down");
10175 staticpro (&Qdown);
10176 Qtop = intern ("top");
10177 staticpro (&Qtop);
10178 Qbottom = intern ("bottom");
10179 staticpro (&Qbottom);
10180 Qend_scroll = intern ("end-scroll");
10181 staticpro (&Qend_scroll);
10182 Qratio = intern ("ratio");
10183 staticpro (&Qratio);
10185 Qevent_kind = intern ("event-kind");
10186 staticpro (&Qevent_kind);
10187 Qevent_symbol_elements = intern ("event-symbol-elements");
10188 staticpro (&Qevent_symbol_elements);
10189 Qevent_symbol_element_mask = intern ("event-symbol-element-mask");
10190 staticpro (&Qevent_symbol_element_mask);
10191 Qmodifier_cache = intern ("modifier-cache");
10192 staticpro (&Qmodifier_cache);
10194 Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar");
10195 staticpro (&Qrecompute_lucid_menubar);
10196 Qactivate_menubar_hook = intern ("activate-menubar-hook");
10197 staticpro (&Qactivate_menubar_hook);
10199 Qpolling_period = intern ("polling-period");
10200 staticpro (&Qpolling_period);
10202 Qinput_method_function = intern ("input-method-function");
10203 staticpro (&Qinput_method_function);
10205 Qinput_method_exit_on_first_char = intern ("input-method-exit-on-first-char");
10206 staticpro (&Qinput_method_exit_on_first_char);
10207 Qinput_method_use_echo_area = intern ("input-method-use-echo-area");
10208 staticpro (&Qinput_method_use_echo_area);
10210 Fset (Qinput_method_exit_on_first_char, Qnil);
10211 Fset (Qinput_method_use_echo_area, Qnil);
10213 last_point_position_buffer = Qnil;
10216 struct event_head *p;
10218 for (p = head_table;
10219 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
10220 p++)
10222 *p->var = intern (p->name);
10223 staticpro (p->var);
10224 Fput (*p->var, Qevent_kind, *p->kind);
10225 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
10229 button_down_location = Fmake_vector (make_number (1), Qnil);
10230 staticpro (&button_down_location);
10231 mouse_syms = Fmake_vector (make_number (1), Qnil);
10232 staticpro (&mouse_syms);
10235 int i;
10236 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
10238 modifier_symbols = Fmake_vector (make_number (len), Qnil);
10239 for (i = 0; i < len; i++)
10240 if (modifier_names[i])
10241 XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]);
10242 staticpro (&modifier_symbols);
10245 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
10246 staticpro (&recent_keys);
10248 this_command_keys = Fmake_vector (make_number (40), Qnil);
10249 staticpro (&this_command_keys);
10251 raw_keybuf = Fmake_vector (make_number (30), Qnil);
10252 staticpro (&raw_keybuf);
10254 Qextended_command_history = intern ("extended-command-history");
10255 Fset (Qextended_command_history, Qnil);
10256 staticpro (&Qextended_command_history);
10258 kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
10259 staticpro (&kbd_buffer_gcpro);
10261 accent_key_syms = Qnil;
10262 staticpro (&accent_key_syms);
10264 func_key_syms = Qnil;
10265 staticpro (&func_key_syms);
10267 #ifdef WINDOWSNT
10268 mouse_wheel_syms = Qnil;
10269 staticpro (&mouse_wheel_syms);
10271 drag_n_drop_syms = Qnil;
10272 staticpro (&drag_n_drop_syms);
10273 #endif
10275 unread_switch_frame = Qnil;
10276 staticpro (&unread_switch_frame);
10278 internal_last_event_frame = Qnil;
10279 staticpro (&internal_last_event_frame);
10281 read_key_sequence_cmd = Qnil;
10282 staticpro (&read_key_sequence_cmd);
10284 menu_bar_one_keymap_changed_items = Qnil;
10285 staticpro (&menu_bar_one_keymap_changed_items);
10287 defsubr (&Sevent_convert_list);
10288 defsubr (&Sread_key_sequence);
10289 defsubr (&Sread_key_sequence_vector);
10290 defsubr (&Srecursive_edit);
10291 #ifdef HAVE_MOUSE
10292 defsubr (&Strack_mouse);
10293 #endif
10294 defsubr (&Sinput_pending_p);
10295 defsubr (&Scommand_execute);
10296 defsubr (&Srecent_keys);
10297 defsubr (&Sthis_command_keys);
10298 defsubr (&Sthis_command_keys_vector);
10299 defsubr (&Sthis_single_command_keys);
10300 defsubr (&Sthis_single_command_raw_keys);
10301 defsubr (&Sreset_this_command_lengths);
10302 defsubr (&Sclear_this_command_keys);
10303 defsubr (&Ssuspend_emacs);
10304 defsubr (&Sabort_recursive_edit);
10305 defsubr (&Sexit_recursive_edit);
10306 defsubr (&Srecursion_depth);
10307 defsubr (&Stop_level);
10308 defsubr (&Sdiscard_input);
10309 defsubr (&Sopen_dribble_file);
10310 defsubr (&Sset_input_mode);
10311 defsubr (&Scurrent_input_mode);
10312 defsubr (&Sexecute_extended_command);
10314 DEFVAR_LISP ("last-command-char", &last_command_char,
10315 "Last input event that was part of a command.");
10317 DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char,
10318 "Last input event that was part of a command.");
10320 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
10321 "Last input event in a command, except for mouse menu events.\n\
10322 Mouse menus give back keys that don't look like mouse events;\n\
10323 this variable holds the actual mouse event that led to the menu,\n\
10324 so that you can determine whether the command was run by mouse or not.");
10326 DEFVAR_LISP ("last-input-char", &last_input_char,
10327 "Last input event.");
10329 DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char,
10330 "Last input event.");
10332 DEFVAR_LISP ("unread-command-events", &Vunread_command_events,
10333 "List of events to be read as the command input.\n\
10334 These events are processed first, before actual keyboard input.");
10335 Vunread_command_events = Qnil;
10337 DEFVAR_INT ("unread-command-char", &unread_command_char,
10338 "If not -1, an object to be read as next command input event.");
10340 DEFVAR_LISP ("unread-post-input-method-events", &Vunread_post_input_method_events,
10341 "List of events to be processed as input by input methods.\n\
10342 These events are processed after `unread-command-events', but\n\
10343 before actual keyboard input.");
10344 Vunread_post_input_method_events = Qnil;
10346 DEFVAR_LISP ("unread-input-method-events", &Vunread_input_method_events,
10347 "List of events to be processed as input by input methods.\n\
10348 These events are processed after `unread-command-events', but\n\
10349 before actual keyboard input.");
10350 Vunread_input_method_events = Qnil;
10352 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
10353 "Meta-prefix character code.\n\
10354 Meta-foo as command input turns into this character followed by foo.");
10355 XSETINT (meta_prefix_char, 033);
10357 DEFVAR_KBOARD ("last-command", Vlast_command,
10358 "The last command executed.\n\
10359 Normally a symbol with a function definition, but can be whatever was found\n\
10360 in the keymap, or whatever the variable `this-command' was set to by that\n\
10361 command.\n\
10363 The value `mode-exit' is special; it means that the previous command\n\
10364 read an event that told it to exit, and it did so and unread that event.\n\
10365 In other words, the present command is the event that made the previous\n\
10366 command exit.\n\
10368 The value `kill-region' is special; it means that the previous command\n\
10369 was a kill command.");
10371 DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
10372 "Same as `last-command', but never altered by Lisp code.");
10374 DEFVAR_LISP ("this-command", &Vthis_command,
10375 "The command now being executed.\n\
10376 The command can set this variable; whatever is put here\n\
10377 will be in `last-command' during the following command.");
10378 Vthis_command = Qnil;
10380 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
10381 "*Number of input events between auto-saves.\n\
10382 Zero means disable autosaving due to number of characters typed.");
10383 auto_save_interval = 300;
10385 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
10386 "*Number of seconds idle time before auto-save.\n\
10387 Zero or nil means disable auto-saving due to idleness.\n\
10388 After auto-saving due to this many seconds of idle time,\n\
10389 Emacs also does a garbage collection if that seems to be warranted.");
10390 XSETFASTINT (Vauto_save_timeout, 30);
10392 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes,
10393 "*Nonzero means echo unfinished commands after this many seconds of pause.\n\
10394 The value may be integer or floating point.");
10395 Vecho_keystrokes = make_number (1);
10397 DEFVAR_INT ("polling-period", &polling_period,
10398 "*Interval between polling for input during Lisp execution.\n\
10399 The reason for polling is to make C-g work to stop a running program.\n\
10400 Polling is needed only when using X windows and SIGIO does not work.\n\
10401 Polling is automatically disabled in all other cases.");
10402 polling_period = 2;
10404 DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
10405 "*Maximum time between mouse clicks to make a double-click.\n\
10406 Measured in milliseconds. nil means disable double-click recognition;\n\
10407 t means double-clicks have no time limit and are detected\n\
10408 by position only.");
10409 Vdouble_click_time = make_number (500);
10411 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
10412 "*Non-nil means inhibit local map menu bar menus.");
10413 inhibit_local_menu_bar_menus = 0;
10415 DEFVAR_INT ("num-input-keys", &num_input_keys,
10416 "Number of complete key sequences read as input so far.\n\
10417 This includes key sequences read from keyboard macros.\n\
10418 The number is effectively the number of interactive command invocations.");
10419 num_input_keys = 0;
10421 DEFVAR_INT ("num-nonmacro-input-events", &num_nonmacro_input_events,
10422 "Number of input events read from the keyboard so far.\n\
10423 This does not include events generated by keyboard macros.");
10424 num_nonmacro_input_events = 0;
10426 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
10427 "The frame in which the most recently read event occurred.\n\
10428 If the last event came from a keyboard macro, this is set to `macro'.");
10429 Vlast_event_frame = Qnil;
10431 /* This variable is set up in sysdep.c. */
10432 DEFVAR_LISP ("tty-erase-char", &Vtty_erase_char,
10433 "The ERASE character as set by the user with stty.");
10435 DEFVAR_LISP ("help-char", &Vhelp_char,
10436 "Character to recognize as meaning Help.\n\
10437 When it is read, do `(eval help-form)', and display result if it's a string.\n\
10438 If the value of `help-form' is nil, this char can be read normally.");
10439 XSETINT (Vhelp_char, Ctl ('H'));
10441 DEFVAR_LISP ("help-event-list", &Vhelp_event_list,
10442 "List of input events to recognize as meaning Help.\n\
10443 These work just like the value of `help-char' (see that).");
10444 Vhelp_event_list = Qnil;
10446 DEFVAR_LISP ("help-form", &Vhelp_form,
10447 "Form to execute when character `help-char' is read.\n\
10448 If the form returns a string, that string is displayed.\n\
10449 If `help-form' is nil, the help char is not recognized.");
10450 Vhelp_form = Qnil;
10452 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
10453 "Command to run when `help-char' character follows a prefix key.\n\
10454 This command is used only when there is no actual binding\n\
10455 for that character after that prefix key.");
10456 Vprefix_help_command = Qnil;
10458 DEFVAR_LISP ("top-level", &Vtop_level,
10459 "Form to evaluate when Emacs starts up.\n\
10460 Useful to set before you dump a modified Emacs.");
10461 Vtop_level = Qnil;
10463 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
10464 "Translate table for keyboard input, or nil.\n\
10465 Each character is looked up in this string and the contents used instead.\n\
10466 The value may be a string, a vector, or a char-table.\n\
10467 If it is a string or vector of length N,\n\
10468 character codes N and up are untranslated.\n\
10469 In a vector or a char-table, an element which is nil means \"no translation\".");
10470 Vkeyboard_translate_table = Qnil;
10472 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
10473 "Non-nil means to always spawn a subshell instead of suspending.\n\
10474 \(Even if the operating system has support for stopping a process.\)");
10475 cannot_suspend = 0;
10477 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
10478 "Non-nil means prompt with menus when appropriate.\n\
10479 This is done when reading from a keymap that has a prompt string,\n\
10480 for elements that have prompt strings.\n\
10481 The menu is displayed on the screen\n\
10482 if X menus were enabled at configuration\n\
10483 time and the previous event was a mouse click prefix key.\n\
10484 Otherwise, menu prompting uses the echo area.");
10485 menu_prompting = 1;
10487 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
10488 "Character to see next line of menu prompt.\n\
10489 Type this character while in a menu prompt to rotate around the lines of it.");
10490 XSETINT (menu_prompt_more_char, ' ');
10492 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
10493 "A mask of additional modifier keys to use with every keyboard character.\n\
10494 Emacs applies the modifiers of the character stored here to each keyboard\n\
10495 character it reads. For example, after evaluating the expression\n\
10496 (setq extra-keyboard-modifiers ?\\C-x)\n\
10497 all input characters will have the control modifier applied to them.\n\
10499 Note that the character ?\\C-@, equivalent to the integer zero, does\n\
10500 not count as a control character; rather, it counts as a character\n\
10501 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero\n\
10502 cancels any modification.");
10503 extra_keyboard_modifiers = 0;
10505 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
10506 "If an editing command sets this to t, deactivate the mark afterward.\n\
10507 The command loop sets this to nil before each command,\n\
10508 and tests the value when the command returns.\n\
10509 Buffer modification stores t in this variable.");
10510 Vdeactivate_mark = Qnil;
10512 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal,
10513 "Temporary storage of pre-command-hook or post-command-hook.");
10514 Vcommand_hook_internal = Qnil;
10516 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
10517 "Normal hook run before each command is executed.\n\
10518 If an unhandled error happens in running this hook,\n\
10519 the hook value is set to nil, since otherwise the error\n\
10520 might happen repeatedly and make Emacs nonfunctional.");
10521 Vpre_command_hook = Qnil;
10523 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
10524 "Normal hook run after each command is executed.\n\
10525 If an unhandled error happens in running this hook,\n\
10526 the hook value is set to nil, since otherwise the error\n\
10527 might happen repeatedly and make Emacs nonfunctional.");
10528 Vpost_command_hook = Qnil;
10530 DEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook,
10531 "Normal hook run after each command is executed, if idle.\n\
10532 Errors running the hook are caught and ignored.\n\
10533 This feature is obsolete; use idle timers instead. See `etc/NEWS'.");
10534 Vpost_command_idle_hook = Qnil;
10536 DEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay,
10537 "Delay time before running `post-command-idle-hook'.\n\
10538 This is measured in microseconds.");
10539 post_command_idle_delay = 100000;
10541 #if 0
10542 DEFVAR_LISP ("echo-area-clear-hook", ...,
10543 "Normal hook run when clearing the echo area.");
10544 #endif
10545 Qecho_area_clear_hook = intern ("echo-area-clear-hook");
10546 XSYMBOL (Qecho_area_clear_hook)->value = Qnil;
10548 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
10549 "t means menu bar, specified Lucid style, needs to be recomputed.");
10550 Vlucid_menu_bar_dirty_flag = Qnil;
10552 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
10553 "List of menu bar items to move to the end of the menu bar.\n\
10554 The elements of the list are event types that may have menu bar bindings.");
10555 Vmenu_bar_final_items = Qnil;
10557 DEFVAR_KBOARD ("overriding-terminal-local-map",
10558 Voverriding_terminal_local_map,
10559 "Per-terminal keymap that overrides all other local keymaps.\n\
10560 If this variable is non-nil, it is used as a keymap instead of the\n\
10561 buffer's local map, and the minor mode keymaps and text property keymaps.\n\
10562 This variable is intended to let commands such as `universal-argumemnt'\n\
10563 set up a different keymap for reading the next command.");
10565 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map,
10566 "Keymap that overrides all other local keymaps.\n\
10567 If this variable is non-nil, it is used as a keymap instead of the\n\
10568 buffer's local map, and the minor mode keymaps and text property keymaps.");
10569 Voverriding_local_map = Qnil;
10571 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag,
10572 "Non-nil means `overriding-local-map' applies to the menu bar.\n\
10573 Otherwise, the menu bar continues to reflect the buffer's local map\n\
10574 and the minor mode maps regardless of `overriding-local-map'.");
10575 Voverriding_local_map_menu_flag = Qnil;
10577 DEFVAR_LISP ("special-event-map", &Vspecial_event_map,
10578 "Keymap defining bindings for special events to execute at low level.");
10579 Vspecial_event_map = Fcons (intern ("keymap"), Qnil);
10581 DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
10582 "*Non-nil means generate motion events for mouse motion.");
10584 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
10585 "Alist of system-specific X windows key symbols.\n\
10586 Each element should have the form (N . SYMBOL) where N is the\n\
10587 numeric keysym code (sans the \"system-specific\" bit 1<<28)\n\
10588 and SYMBOL is its name.");
10590 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list,
10591 "List of deferred actions to be performed at a later time.\n\
10592 The precise format isn't relevant here; we just check whether it is nil.");
10593 Vdeferred_action_list = Qnil;
10595 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function,
10596 "Function to call to handle deferred actions, after each command.\n\
10597 This function is called with no arguments after each command\n\
10598 whenever `deferred-action-list' is non-nil.");
10599 Vdeferred_action_function = Qnil;
10601 DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings,
10602 "*Non-nil means show the equivalent key-binding when M-x command has one.\n\
10603 The value can be a length of time to show the message for.\n\
10604 If the value is non-nil and not a number, we wait 2 seconds.");
10605 Vsuggest_key_bindings = Qt;
10607 DEFVAR_LISP ("timer-list", &Vtimer_list,
10608 "List of active absolute time timers in order of increasing time");
10609 Vtimer_list = Qnil;
10611 DEFVAR_LISP ("timer-idle-list", &Vtimer_idle_list,
10612 "List of active idle-time timers in order of increasing time");
10613 Vtimer_idle_list = Qnil;
10615 DEFVAR_LISP ("input-method-function", &Vinput_method_function,
10616 "If non-nil, the function that implements the current input method.\n\
10617 It's called with one argument, a printing character that was just read.\n\
10618 \(That means a character with code 040...0176.)\n\
10619 Typically this function uses `read-event' to read additional events.\n\
10620 When it does so, it should first bind `input-method-function' to nil\n\
10621 so it will not be called recursively.\n\
10623 The function should return a list of zero or more events\n\
10624 to be used as input. If it wants to put back some events\n\
10625 to be reconsidered, separately, by the input method,\n\
10626 it can add them to the beginning of `unread-command-events'.\n\
10628 The input method function can find in `input-method-previous-method'\n\
10629 the previous echo area message.\n\
10631 The input method function should refer to the variables\n\
10632 `input-method-use-echo-area' and `input-method-exit-on-first-char'\n\
10633 for guidance on what to do.");
10634 Vinput_method_function = Qnil;
10636 DEFVAR_LISP ("input-method-previous-message",
10637 &Vinput_method_previous_message,
10638 "When `input-method-function' is called, hold the previous echo area message.\n\
10639 This variable exists because `read-event' clears the echo area\n\
10640 before running the input method. It is nil if there was no message.");
10641 Vinput_method_previous_message = Qnil;
10643 DEFVAR_LISP ("show-help-function", &Vshow_help_function,
10644 "If non-nil, the function that implements the display of help.\n\
10645 It's called with one argument, the help string to display.");
10646 Vshow_help_function = Qnil;
10648 DEFVAR_LISP ("disable-point-adjustment", &Vdisable_point_adjustment,
10649 "If non-nil, suppress point adjustment after executing a command.\n\
10651 After a command is executed, if point is moved into a region that has\n\
10652 special properties (e.g. composition, display), we adjust point to\n\
10653 the boundary of the region. But, several special commands sets this\n\
10654 variable to non-nil, then we suppress the point adjustment.\n\
10656 This variable is set to nil before reading a command, and is checked\n\
10657 just after executing the command");
10658 Vdisable_point_adjustment = Qnil;
10660 DEFVAR_LISP ("global-disable-point-adjustment",
10661 &Vglobal_disable_point_adjustment,
10662 "*If non-nil, always suppress point adjustment.\n\
10664 The default value is nil, in which case, point adjustment are\n\
10665 suppressed only after special commands that set\n\
10666 `disable-point-adjustment' (which see) to non-nil.");
10667 Vglobal_disable_point_adjustment = Qnil;
10669 DEFVAR_BOOL ("update-menu-bindings", &update_menu_bindings,
10670 "Non-nil means updating menu bindings is allowed.\n\
10671 A value of nil means menu bindings should not be updated.\n\
10672 Used during Emacs' startup.");
10673 update_menu_bindings = 1;
10675 DEFVAR_LISP ("minibuffer-message-timeout", &Vminibuffer_message_timeout,
10676 "*How long to display an echo-area message when the minibuffer is active.\n\
10677 If the value is not a number, such messages don't time out.");
10678 Vminibuffer_message_timeout = make_number (2);
10681 void
10682 keys_of_keyboard ()
10684 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
10685 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
10686 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
10687 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
10688 initial_define_key (meta_map, 'x', "execute-extended-command");
10690 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
10691 "handle-delete-frame");
10692 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
10693 "ignore-event");
10694 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
10695 "ignore-event");