lwlib-Xm.c: Fixed memory leak for menus.
[emacs.git] / src / keyboard.c
blobdae9470f70c7aadbc117ca958c0106ec54b0dfd1
1 /* Keyboard and mouse input; editor command loop.
2 Copyright (C) 1985,86,87,88,89,93,94,95,96,97,99, 2000, 01, 02
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 "keymap.h"
41 #include "blockinput.h"
42 #include "puresize.h"
43 #include "systime.h"
44 #include "atimer.h"
45 #include <setjmp.h>
46 #include <errno.h>
48 #ifdef MSDOS
49 #include "msdos.h"
50 #include <time.h>
51 #else /* not MSDOS */
52 #ifndef VMS
53 #include <sys/ioctl.h>
54 #endif
55 #endif /* not MSDOS */
57 #include "syssignal.h"
58 #include "systty.h"
60 #include <sys/types.h>
61 #ifdef HAVE_UNISTD_H
62 #include <unistd.h>
63 #endif
65 /* This is to get the definitions of the XK_ symbols. */
66 #ifdef HAVE_X_WINDOWS
67 #include "xterm.h"
68 #endif
70 #ifdef HAVE_NTGUI
71 #include "w32term.h"
72 #endif /* HAVE_NTGUI */
74 #ifdef MAC_OS
75 #include "macterm.h"
76 #endif
78 #ifndef USE_CRT_DLL
79 extern int errno;
80 #endif
82 /* Variables for blockinput.h: */
84 /* Non-zero if interrupt input is blocked right now. */
85 int interrupt_input_blocked;
87 /* Nonzero means an input interrupt has arrived
88 during the current critical section. */
89 int interrupt_input_pending;
92 /* File descriptor to use for input. */
93 extern int input_fd;
95 #ifdef HAVE_WINDOW_SYSTEM
96 /* Make all keyboard buffers much bigger when using X windows. */
97 #ifdef MAC_OS8
98 /* But not too big (local data > 32K error) if on Mac OS Classic. */
99 #define KBD_BUFFER_SIZE 512
100 #else
101 #define KBD_BUFFER_SIZE 4096
102 #endif
103 #else /* No X-windows, character input */
104 #define KBD_BUFFER_SIZE 4096
105 #endif /* No X-windows */
107 #define abs(x) ((x) >= 0 ? (x) : -(x))
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 /* If a string, the message displayed before displaying a help-echo
192 in the echo area. */
194 Lisp_Object Vpre_help_message;
196 /* Nonzero means do menu prompting. */
198 static int menu_prompting;
200 /* Character to see next line of menu prompt. */
202 static Lisp_Object menu_prompt_more_char;
204 /* For longjmp to where kbd input is being done. */
206 static jmp_buf getcjmp;
208 /* True while doing kbd input. */
209 int waiting_for_input;
211 /* True while displaying for echoing. Delays C-g throwing. */
213 int echoing;
215 /* Non-null means we can start echoing at the next input pause even
216 though there is something in the echo area. */
218 static struct kboard *ok_to_echo_at_next_pause;
220 /* The kboard last echoing, or null for none. Reset to 0 in
221 cancel_echoing. If non-null, and a current echo area message
222 exists, and echo_message_buffer is eq to the current message
223 buffer, we know that the message comes from echo_kboard. */
225 struct kboard *echo_kboard;
227 /* The buffer used for echoing. Set in echo_now, reset in
228 cancel_echoing. */
230 Lisp_Object echo_message_buffer;
232 /* Nonzero means disregard local maps for the menu bar. */
233 static int inhibit_local_menu_bar_menus;
235 /* Nonzero means C-g should cause immediate error-signal. */
236 int immediate_quit;
238 /* The user's ERASE setting. */
239 Lisp_Object Vtty_erase_char;
241 /* Character to recognize as the help char. */
242 Lisp_Object Vhelp_char;
244 /* List of other event types to recognize as meaning "help". */
245 Lisp_Object Vhelp_event_list;
247 /* Form to execute when help char is typed. */
248 Lisp_Object Vhelp_form;
250 /* Command to run when the help character follows a prefix key. */
251 Lisp_Object Vprefix_help_command;
253 /* List of items that should move to the end of the menu bar. */
254 Lisp_Object Vmenu_bar_final_items;
256 /* Non-nil means show the equivalent key-binding for
257 any M-x command that has one.
258 The value can be a length of time to show the message for.
259 If the value is non-nil and not a number, we wait 2 seconds. */
260 Lisp_Object Vsuggest_key_bindings;
262 /* How long to display an echo-area message when the minibuffer is active.
263 If the value is not a number, such messages don't time out. */
264 Lisp_Object Vminibuffer_message_timeout;
266 /* Character that causes a quit. Normally C-g.
268 If we are running on an ordinary terminal, this must be an ordinary
269 ASCII char, since we want to make it our interrupt character.
271 If we are not running on an ordinary terminal, it still needs to be
272 an ordinary ASCII char. This character needs to be recognized in
273 the input interrupt handler. At this point, the keystroke is
274 represented as a struct input_event, while the desired quit
275 character is specified as a lispy event. The mapping from struct
276 input_events to lispy events cannot run in an interrupt handler,
277 and the reverse mapping is difficult for anything but ASCII
278 keystrokes.
280 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
281 ASCII character. */
282 int quit_char;
284 extern Lisp_Object current_global_map;
285 extern int minibuf_level;
287 /* If non-nil, this is a map that overrides all other local maps. */
288 Lisp_Object Voverriding_local_map;
290 /* If non-nil, Voverriding_local_map applies to the menu bar. */
291 Lisp_Object Voverriding_local_map_menu_flag;
293 /* Keymap that defines special misc events that should
294 be processed immediately at a low level. */
295 Lisp_Object Vspecial_event_map;
297 /* Current depth in recursive edits. */
298 int command_loop_level;
300 /* Total number of times command_loop has read a key sequence. */
301 EMACS_INT num_input_keys;
303 /* Last input character read as a command. */
304 Lisp_Object last_command_char;
306 /* Last input character read as a command, not counting menus
307 reached by the mouse. */
308 Lisp_Object last_nonmenu_event;
310 /* Last input character read for any purpose. */
311 Lisp_Object last_input_char;
313 /* If not Qnil, a list of objects to be read as subsequent command input. */
314 Lisp_Object Vunread_command_events;
316 /* If not Qnil, a list of objects to be read as subsequent command input
317 including input method processing. */
318 Lisp_Object Vunread_input_method_events;
320 /* If not Qnil, a list of objects to be read as subsequent command input
321 but NOT including input method processing. */
322 Lisp_Object Vunread_post_input_method_events;
324 /* If not -1, an event to be read as subsequent command input. */
325 EMACS_INT unread_command_char;
327 /* If not Qnil, this is a switch-frame event which we decided to put
328 off until the end of a key sequence. This should be read as the
329 next command input, after any unread_command_events.
331 read_key_sequence uses this to delay switch-frame events until the
332 end of the key sequence; Fread_char uses it to put off switch-frame
333 events until a non-ASCII event is acceptable as input. */
334 Lisp_Object unread_switch_frame;
336 /* A mask of extra modifier bits to put into every keyboard char. */
337 EMACS_INT extra_keyboard_modifiers;
339 /* Char to use as prefix when a meta character is typed in.
340 This is bound on entry to minibuffer in case ESC is changed there. */
342 Lisp_Object meta_prefix_char;
344 /* Last size recorded for a current buffer which is not a minibuffer. */
345 static int last_non_minibuf_size;
347 /* Number of idle seconds before an auto-save and garbage collection. */
348 static Lisp_Object Vauto_save_timeout;
350 /* Total number of times read_char has returned. */
351 int num_input_events;
353 /* Total number of times read_char has returned, outside of macros. */
354 EMACS_INT num_nonmacro_input_events;
356 /* Auto-save automatically when this many characters have been typed
357 since the last time. */
359 static EMACS_INT auto_save_interval;
361 /* Value of num_nonmacro_input_events as of last auto save. */
363 int last_auto_save;
365 /* The command being executed by the command loop.
366 Commands may set this, and the value set will be copied into
367 current_kboard->Vlast_command instead of the actual command. */
368 Lisp_Object Vthis_command;
370 /* This is like Vthis_command, except that commands never set it. */
371 Lisp_Object real_this_command;
373 /* If the lookup of the command returns a binding, the original
374 command is stored in this-original-command. It is nil otherwise. */
375 Lisp_Object Vthis_original_command;
377 /* The value of point when the last command was executed. */
378 int last_point_position;
380 /* The buffer that was current when the last command was started. */
381 Lisp_Object last_point_position_buffer;
383 /* The frame in which the last input event occurred, or Qmacro if the
384 last event came from a macro. We use this to determine when to
385 generate switch-frame events. This may be cleared by functions
386 like Fselect_frame, to make sure that a switch-frame event is
387 generated by the next character. */
388 Lisp_Object internal_last_event_frame;
390 /* A user-visible version of the above, intended to allow users to
391 figure out where the last event came from, if the event doesn't
392 carry that information itself (i.e. if it was a character). */
393 Lisp_Object Vlast_event_frame;
395 /* The timestamp of the last input event we received from the X server.
396 X Windows wants this for selection ownership. */
397 unsigned long last_event_timestamp;
399 Lisp_Object Qself_insert_command;
400 Lisp_Object Qforward_char;
401 Lisp_Object Qbackward_char;
402 Lisp_Object Qundefined;
403 Lisp_Object Qtimer_event_handler;
405 /* read_key_sequence stores here the command definition of the
406 key sequence that it reads. */
407 Lisp_Object read_key_sequence_cmd;
409 /* Echo unfinished commands after this many seconds of pause. */
410 Lisp_Object Vecho_keystrokes;
412 /* Form to evaluate (if non-nil) when Emacs is started. */
413 Lisp_Object Vtop_level;
415 /* User-supplied table to translate input characters. */
416 Lisp_Object Vkeyboard_translate_table;
418 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
419 extern Lisp_Object Vfunction_key_map;
421 /* Another keymap that maps key sequences into key sequences.
422 This one takes precedence over ordinary definitions. */
423 extern Lisp_Object Vkey_translation_map;
425 /* If non-nil, this implements the current input method. */
426 Lisp_Object Vinput_method_function;
427 Lisp_Object Qinput_method_function;
429 /* When we call Vinput_method_function,
430 this holds the echo area message that was just erased. */
431 Lisp_Object Vinput_method_previous_message;
433 /* Non-nil means deactivate the mark at end of this command. */
434 Lisp_Object Vdeactivate_mark;
436 /* Menu bar specified in Lucid Emacs fashion. */
438 Lisp_Object Vlucid_menu_bar_dirty_flag;
439 Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
441 Lisp_Object Qecho_area_clear_hook;
443 /* Hooks to run before and after each command. */
444 Lisp_Object Qpre_command_hook, Vpre_command_hook;
445 Lisp_Object Qpost_command_hook, Vpost_command_hook;
446 Lisp_Object Qcommand_hook_internal, Vcommand_hook_internal;
447 /* Hook run after a command if there's no more input soon. */
448 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
450 /* Delay time in microseconds before running post-command-idle-hook. */
451 EMACS_INT post_command_idle_delay;
453 /* List of deferred actions to be performed at a later time.
454 The precise format isn't relevant here; we just check whether it is nil. */
455 Lisp_Object Vdeferred_action_list;
457 /* Function to call to handle deferred actions, when there are any. */
458 Lisp_Object Vdeferred_action_function;
459 Lisp_Object Qdeferred_action_function;
461 Lisp_Object Qinput_method_exit_on_first_char;
462 Lisp_Object Qinput_method_use_echo_area;
464 /* File in which we write all commands we read. */
465 FILE *dribble;
467 /* Nonzero if input is available. */
468 int input_pending;
470 /* 1 if should obey 0200 bit in input chars as "Meta", 2 if should
471 keep 0200 bit in input chars. 0 to ignore the 0200 bit. */
473 int meta_key;
475 /* Non-zero means force key bindings update in parse_menu_item. */
477 int update_menu_bindings;
479 extern char *pending_malloc_warning;
481 /* Circular buffer for pre-read keyboard input. */
483 static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
485 /* Vector to GCPRO the Lisp objects referenced from kbd_buffer.
487 The interrupt-level event handlers will never enqueue an event on a
488 frame which is not in Vframe_list, and once an event is dequeued,
489 internal_last_event_frame or the event itself points to the frame.
490 So that's all fine.
492 But while the event is sitting in the queue, it's completely
493 unprotected. Suppose the user types one command which will run for
494 a while and then delete a frame, and then types another event at
495 the frame that will be deleted, before the command gets around to
496 it. Suppose there are no references to this frame elsewhere in
497 Emacs, and a GC occurs before the second event is dequeued. Now we
498 have an event referring to a freed frame, which will crash Emacs
499 when it is dequeued.
501 Similar things happen when an event on a scroll bar is enqueued; the
502 window may be deleted while the event is in the queue.
504 So, we use this vector to protect the Lisp_Objects in the event
505 queue. That way, they'll be dequeued as dead frames or windows,
506 but still valid Lisp objects.
508 If kbd_buffer[i].kind != NO_EVENT, then
510 AREF (kbd_buffer_gcpro, 2 * i) == kbd_buffer[i].frame_or_window.
511 AREF (kbd_buffer_gcpro, 2 * i + 1) == kbd_buffer[i].arg. */
513 static Lisp_Object kbd_buffer_gcpro;
515 /* Pointer to next available character in kbd_buffer.
516 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
517 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the
518 next available char is in kbd_buffer[0]. */
519 static struct input_event *kbd_fetch_ptr;
521 /* Pointer to next place to store character in kbd_buffer. This
522 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
523 character should go in kbd_buffer[0]. */
524 static struct input_event * volatile kbd_store_ptr;
526 /* The above pair of variables forms a "queue empty" flag. When we
527 enqueue a non-hook event, we increment kbd_store_ptr. When we
528 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
529 there is input available iff the two pointers are not equal.
531 Why not just have a flag set and cleared by the enqueuing and
532 dequeuing functions? Such a flag could be screwed up by interrupts
533 at inopportune times. */
535 /* If this flag is non-nil, we check mouse_moved to see when the
536 mouse moves, and motion events will appear in the input stream.
537 Otherwise, mouse motion is ignored. */
538 Lisp_Object do_mouse_tracking;
540 /* Symbols to head events. */
541 Lisp_Object Qmouse_movement;
542 Lisp_Object Qscroll_bar_movement;
543 Lisp_Object Qswitch_frame;
544 Lisp_Object Qdelete_frame;
545 Lisp_Object Qiconify_frame;
546 Lisp_Object Qmake_frame_visible;
547 Lisp_Object Qselect_window;
548 Lisp_Object Qhelp_echo;
550 /* Symbols to denote kinds of events. */
551 Lisp_Object Qfunction_key;
552 Lisp_Object Qmouse_click;
553 #if defined(WINDOWSNT) || defined(MAC_OSX)
554 Lisp_Object Qmouse_wheel;
555 #endif
556 #ifdef WINDOWSNT
557 Lisp_Object Qlanguage_change;
558 #endif
559 Lisp_Object Qdrag_n_drop;
560 Lisp_Object Qsave_session;
562 /* Lisp_Object Qmouse_movement; - also an event header */
564 /* Properties of event headers. */
565 Lisp_Object Qevent_kind;
566 Lisp_Object Qevent_symbol_elements;
568 /* menu item parts */
569 Lisp_Object Qmenu_alias;
570 Lisp_Object Qmenu_enable;
571 Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCkeys, QCkey_sequence;
572 Lisp_Object QCbutton, QCtoggle, QCradio;
573 extern Lisp_Object Vdefine_key_rebound_commands;
574 extern Lisp_Object Qmenu_item;
576 /* An event header symbol HEAD may have a property named
577 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
578 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
579 mask of modifiers applied to it. If present, this is used to help
580 speed up parse_modifiers. */
581 Lisp_Object Qevent_symbol_element_mask;
583 /* An unmodified event header BASE may have a property named
584 Qmodifier_cache, which is an alist mapping modifier masks onto
585 modified versions of BASE. If present, this helps speed up
586 apply_modifiers. */
587 Lisp_Object Qmodifier_cache;
589 /* Symbols to use for parts of windows. */
590 Lisp_Object Qmode_line;
591 Lisp_Object Qvertical_line;
592 Lisp_Object Qvertical_scroll_bar;
593 Lisp_Object Qmenu_bar;
594 extern Lisp_Object Qleft_margin, Qright_margin;
596 Lisp_Object recursive_edit_unwind (), command_loop ();
597 Lisp_Object Fthis_command_keys ();
598 Lisp_Object Qextended_command_history;
599 EMACS_TIME timer_check ();
601 extern Lisp_Object Vhistory_length, Vtranslation_table_for_input;
603 extern char *x_get_keysym_name ();
605 static void record_menu_key ();
607 Lisp_Object Qpolling_period;
609 /* List of absolute timers. Appears in order of next scheduled event. */
610 Lisp_Object Vtimer_list;
612 /* List of idle time timers. Appears in order of next scheduled event. */
613 Lisp_Object Vtimer_idle_list;
615 /* Incremented whenever a timer is run. */
616 int timers_run;
618 extern Lisp_Object Vprint_level, Vprint_length;
620 /* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
621 happens. */
622 EMACS_TIME *input_available_clear_time;
624 /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
625 Default is 1 if INTERRUPT_INPUT is defined. */
626 int interrupt_input;
628 /* Nonzero while interrupts are temporarily deferred during redisplay. */
629 int interrupts_deferred;
631 /* Nonzero means use ^S/^Q for flow control. */
632 int flow_control;
634 /* Allow m- file to inhibit use of FIONREAD. */
635 #ifdef BROKEN_FIONREAD
636 #undef FIONREAD
637 #endif
639 /* We are unable to use interrupts if FIONREAD is not available,
640 so flush SIGIO so we won't try. */
641 #ifndef FIONREAD
642 #ifdef SIGIO
643 #undef SIGIO
644 #endif
645 #endif
647 /* If we support a window system, turn on the code to poll periodically
648 to detect C-g. It isn't actually used when doing interrupt input. */
649 #if defined(HAVE_WINDOW_SYSTEM) && !defined(USE_ASYNC_EVENTS)
650 #define POLL_FOR_INPUT
651 #endif
653 /* After a command is executed, if point is moved into a region that
654 has specific properties (e.g. composition, display), we adjust
655 point to the boundary of the region. But, if a command sets this
656 variable to non-nil, we suppress this point adjustment. This
657 variable is set to nil before reading a command. */
659 Lisp_Object Vdisable_point_adjustment;
661 /* If non-nil, always disable point adjustment. */
663 Lisp_Object Vglobal_disable_point_adjustment;
665 /* The time when Emacs started being idle. */
667 static EMACS_TIME timer_idleness_start_time;
669 /* After Emacs stops being idle, this saves the last value
670 of timer_idleness_start_time from when it was idle. */
672 static EMACS_TIME timer_last_idleness_start_time;
675 /* Global variable declarations. */
677 /* Function for init_keyboard to call with no args (if nonzero). */
678 void (*keyboard_init_hook) ();
680 static int read_avail_input P_ ((int));
681 static void get_input_pending P_ ((int *, int));
682 static void get_filtered_input_pending P_ ((int *, int, int));
683 static int readable_events P_ ((int));
684 static int readable_filtered_events P_ ((int, int));
685 static Lisp_Object read_char_x_menu_prompt P_ ((int, Lisp_Object *,
686 Lisp_Object, int *));
687 static Lisp_Object read_char_x_menu_prompt ();
688 static Lisp_Object read_char_minibuf_menu_prompt P_ ((int, int,
689 Lisp_Object *));
690 static Lisp_Object make_lispy_event P_ ((struct input_event *));
691 #ifdef HAVE_MOUSE
692 static Lisp_Object make_lispy_movement P_ ((struct frame *, Lisp_Object,
693 enum scroll_bar_part,
694 Lisp_Object, Lisp_Object,
695 unsigned long));
696 #endif
697 static Lisp_Object modify_event_symbol P_ ((int, unsigned, Lisp_Object,
698 Lisp_Object, char **,
699 Lisp_Object *, unsigned));
700 static Lisp_Object make_lispy_switch_frame P_ ((Lisp_Object));
701 static int parse_solitary_modifier P_ ((Lisp_Object));
702 static int parse_solitary_modifier ();
703 static void save_getcjmp P_ ((jmp_buf));
704 static void save_getcjmp ();
705 static void restore_getcjmp P_ ((jmp_buf));
706 static Lisp_Object apply_modifiers P_ ((int, Lisp_Object));
707 static void clear_event P_ ((struct input_event *));
708 static void any_kboard_state P_ ((void));
709 static SIGTYPE interrupt_signal P_ ((int signalnum));
711 /* Nonzero means don't try to suspend even if the operating system seems
712 to support it. */
713 static int cannot_suspend;
715 /* Install the string STR as the beginning of the string of echoing,
716 so that it serves as a prompt for the next character.
717 Also start echoing. */
719 void
720 echo_prompt (str)
721 Lisp_Object str;
723 current_kboard->echo_string = str;
724 current_kboard->echo_after_prompt = SCHARS (str);
725 echo_now ();
728 /* Add C to the echo string, if echoing is going on.
729 C can be a character, which is printed prettily ("M-C-x" and all that
730 jazz), or a symbol, whose name is printed. */
732 void
733 echo_char (c)
734 Lisp_Object c;
736 if (current_kboard->immediate_echo)
738 int size = KEY_DESCRIPTION_SIZE + 100;
739 char *buffer = (char *) alloca (size);
740 char *ptr = buffer;
741 Lisp_Object echo_string;
743 echo_string = current_kboard->echo_string;
745 /* If someone has passed us a composite event, use its head symbol. */
746 c = EVENT_HEAD (c);
748 if (INTEGERP (c))
750 ptr = push_key_description (XINT (c), ptr, 1);
752 else if (SYMBOLP (c))
754 Lisp_Object name = SYMBOL_NAME (c);
755 int nbytes = SBYTES (name);
757 if (size - (ptr - buffer) < nbytes)
759 int offset = ptr - buffer;
760 size = max (2 * size, size + nbytes);
761 buffer = (char *) alloca (size);
762 ptr = buffer + offset;
765 ptr += copy_text (SDATA (name), ptr, nbytes,
766 STRING_MULTIBYTE (name), 1);
769 if ((NILP (echo_string) || SCHARS (echo_string) == 0)
770 && help_char_p (c))
772 const char *text = " (Type ? for further options)";
773 int len = strlen (text);
775 if (size - (ptr - buffer) < len)
777 int offset = ptr - buffer;
778 size += len;
779 buffer = (char *) alloca (size);
780 ptr = buffer + offset;
783 bcopy (text, ptr, len);
784 ptr += len;
787 /* Replace a dash from echo_dash with a space, otherwise
788 add a space at the end as a separator between keys. */
789 if (STRINGP (echo_string)
790 && SCHARS (echo_string) > 0)
792 Lisp_Object last_char, idx;
794 idx = make_number (SCHARS (echo_string) - 1);
795 last_char = Faref (echo_string, idx);
797 if (XINT (last_char) == '-')
798 Faset (echo_string, idx, make_number (' '));
799 else
800 echo_string = concat2 (echo_string, build_string (" "));
803 current_kboard->echo_string
804 = concat2 (echo_string, make_string (buffer, ptr - buffer));
806 echo_now ();
810 /* Temporarily add a dash to the end of the echo string if it's not
811 empty, so that it serves as a mini-prompt for the very next character. */
813 void
814 echo_dash ()
816 /* Do nothing if not echoing at all. */
817 if (NILP (current_kboard->echo_string))
818 return;
820 if (!current_kboard->immediate_echo
821 && SCHARS (current_kboard->echo_string) == 0)
822 return;
824 /* Do nothing if we just printed a prompt. */
825 if (current_kboard->echo_after_prompt
826 == SCHARS (current_kboard->echo_string))
827 return;
829 /* Put a dash at the end of the buffer temporarily,
830 but make it go away when the next character is added. */
831 current_kboard->echo_string = concat2 (current_kboard->echo_string,
832 build_string ("-"));
833 echo_now ();
836 /* Display the current echo string, and begin echoing if not already
837 doing so. */
839 void
840 echo_now ()
842 if (!current_kboard->immediate_echo)
844 int i;
845 current_kboard->immediate_echo = 1;
847 for (i = 0; i < this_command_key_count; i++)
849 Lisp_Object c;
850 c = XVECTOR (this_command_keys)->contents[i];
851 if (! (EVENT_HAS_PARAMETERS (c)
852 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
853 echo_char (c);
855 echo_dash ();
858 echoing = 1;
859 message3_nolog (current_kboard->echo_string,
860 SBYTES (current_kboard->echo_string),
861 STRING_MULTIBYTE (current_kboard->echo_string));
862 echoing = 0;
864 /* Record in what buffer we echoed, and from which kboard. */
865 echo_message_buffer = echo_area_buffer[0];
866 echo_kboard = current_kboard;
868 if (waiting_for_input && !NILP (Vquit_flag))
869 quit_throw_to_read_char ();
872 /* Turn off echoing, for the start of a new command. */
874 void
875 cancel_echoing ()
877 current_kboard->immediate_echo = 0;
878 current_kboard->echo_after_prompt = -1;
879 current_kboard->echo_string = Qnil;
880 ok_to_echo_at_next_pause = NULL;
881 echo_kboard = NULL;
882 echo_message_buffer = Qnil;
885 /* Return the length of the current echo string. */
887 static int
888 echo_length ()
890 return (STRINGP (current_kboard->echo_string)
891 ? SCHARS (current_kboard->echo_string)
892 : 0);
895 /* Truncate the current echo message to its first LEN chars.
896 This and echo_char get used by read_key_sequence when the user
897 switches frames while entering a key sequence. */
899 static void
900 echo_truncate (nchars)
901 int nchars;
903 if (STRINGP (current_kboard->echo_string))
904 current_kboard->echo_string
905 = Fsubstring (current_kboard->echo_string,
906 make_number (0), make_number (nchars));
907 truncate_echo_area (nchars);
911 /* Functions for manipulating this_command_keys. */
912 static void
913 add_command_key (key)
914 Lisp_Object key;
916 /* If reset-this-command-length was called recently, obey it now.
917 See the doc string of that function for an explanation of why. */
918 if (before_command_restore_flag)
920 this_command_key_count = before_command_key_count_1;
921 if (this_command_key_count < this_single_command_key_start)
922 this_single_command_key_start = this_command_key_count;
923 echo_truncate (before_command_echo_length_1);
924 before_command_restore_flag = 0;
927 if (this_command_key_count >= ASIZE (this_command_keys))
928 this_command_keys = larger_vector (this_command_keys,
929 2 * ASIZE (this_command_keys),
930 Qnil);
932 AREF (this_command_keys, this_command_key_count) = key;
933 ++this_command_key_count;
937 Lisp_Object
938 recursive_edit_1 ()
940 int count = SPECPDL_INDEX ();
941 Lisp_Object val;
943 if (command_loop_level > 0)
945 specbind (Qstandard_output, Qt);
946 specbind (Qstandard_input, Qt);
949 #ifdef HAVE_X_WINDOWS
950 /* The command loop has started an hourglass timer, so we have to
951 cancel it here, otherwise it will fire because the recursive edit
952 can take some time. Do not check for display_hourglass_p here,
953 because it could already be nil. */
954 cancel_hourglass ();
955 #endif
957 /* This function may have been called from a debugger called from
958 within redisplay, for instance by Edebugging a function called
959 from fontification-functions. We want to allow redisplay in
960 the debugging session.
962 The recursive edit is left with a `(throw exit ...)'. The `exit'
963 tag is not caught anywhere in redisplay, i.e. when we leave the
964 recursive edit, the original redisplay leading to the recursive
965 edit will be unwound. The outcome should therefore be safe. */
966 specbind (Qinhibit_redisplay, Qnil);
967 redisplaying_p = 0;
969 val = command_loop ();
970 if (EQ (val, Qt))
971 Fsignal (Qquit, Qnil);
972 /* Handle throw from read_minibuf when using minibuffer
973 while it's active but we're in another window. */
974 if (STRINGP (val))
975 Fsignal (Qerror, Fcons (val, Qnil));
977 return unbind_to (count, Qnil);
980 /* When an auto-save happens, record the "time", and don't do again soon. */
982 void
983 record_auto_save ()
985 last_auto_save = num_nonmacro_input_events;
988 /* Make an auto save happen as soon as possible at command level. */
990 void
991 force_auto_save_soon ()
993 last_auto_save = - auto_save_interval - 1;
995 record_asynch_buffer_change ();
998 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
999 doc: /* Invoke the editor command loop recursively.
1000 To get out of the recursive edit, a command can do `(throw 'exit nil)';
1001 that tells this function to return.
1002 Alternately, `(throw 'exit t)' makes this function signal an error.
1003 This function is called by the editor initialization to begin editing. */)
1006 int count = SPECPDL_INDEX ();
1007 Lisp_Object buffer;
1009 command_loop_level++;
1010 update_mode_lines = 1;
1012 if (command_loop_level
1013 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
1014 buffer = Fcurrent_buffer ();
1015 else
1016 buffer = Qnil;
1018 /* If we leave recursive_edit_1 below with a `throw' for instance,
1019 like it is done in the splash screen display, we have to
1020 make sure that we restore single_kboard as command_loop_1
1021 would have done if it were left normally. */
1022 record_unwind_protect (recursive_edit_unwind,
1023 Fcons (buffer, single_kboard ? Qt : Qnil));
1025 recursive_edit_1 ();
1026 return unbind_to (count, Qnil);
1029 Lisp_Object
1030 recursive_edit_unwind (info)
1031 Lisp_Object info;
1033 if (BUFFERP (XCAR (info)))
1034 Fset_buffer (XCAR (info));
1036 if (NILP (XCDR (info)))
1037 any_kboard_state ();
1038 else
1039 single_kboard_state ();
1041 command_loop_level--;
1042 update_mode_lines = 1;
1043 return Qnil;
1047 static void
1048 any_kboard_state ()
1050 #ifdef MULTI_KBOARD
1051 #if 0 /* Theory: if there's anything in Vunread_command_events,
1052 it will right away be read by read_key_sequence,
1053 and then if we do switch KBOARDS, it will go into the side
1054 queue then. So we don't need to do anything special here -- rms. */
1055 if (CONSP (Vunread_command_events))
1057 current_kboard->kbd_queue
1058 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
1059 current_kboard->kbd_queue_has_data = 1;
1061 Vunread_command_events = Qnil;
1062 #endif
1063 single_kboard = 0;
1064 #endif
1067 /* Switch to the single-kboard state, making current_kboard
1068 the only KBOARD from which further input is accepted. */
1070 void
1071 single_kboard_state ()
1073 #ifdef MULTI_KBOARD
1074 single_kboard = 1;
1075 #endif
1078 /* Maintain a stack of kboards, so other parts of Emacs
1079 can switch temporarily to the kboard of a given frame
1080 and then revert to the previous status. */
1082 struct kboard_stack
1084 KBOARD *kboard;
1085 struct kboard_stack *next;
1088 static struct kboard_stack *kboard_stack;
1090 void
1091 push_frame_kboard (f)
1092 FRAME_PTR f;
1094 #ifdef MULTI_KBOARD
1095 struct kboard_stack *p
1096 = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
1098 p->next = kboard_stack;
1099 p->kboard = current_kboard;
1100 kboard_stack = p;
1102 current_kboard = FRAME_KBOARD (f);
1103 #endif
1106 void
1107 pop_frame_kboard ()
1109 #ifdef MULTI_KBOARD
1110 struct kboard_stack *p = kboard_stack;
1111 current_kboard = p->kboard;
1112 kboard_stack = p->next;
1113 xfree (p);
1114 #endif
1117 /* Handle errors that are not handled at inner levels
1118 by printing an error message and returning to the editor command loop. */
1120 Lisp_Object
1121 cmd_error (data)
1122 Lisp_Object data;
1124 Lisp_Object old_level, old_length;
1125 char macroerror[50];
1127 #ifdef HAVE_X_WINDOWS
1128 if (display_hourglass_p)
1129 cancel_hourglass ();
1130 #endif
1132 if (!NILP (executing_macro))
1134 if (executing_macro_iterations == 1)
1135 sprintf (macroerror, "After 1 kbd macro iteration: ");
1136 else
1137 sprintf (macroerror, "After %d kbd macro iterations: ",
1138 executing_macro_iterations);
1140 else
1141 *macroerror = 0;
1143 Vstandard_output = Qt;
1144 Vstandard_input = Qt;
1145 Vexecuting_macro = Qnil;
1146 executing_macro = Qnil;
1147 current_kboard->Vprefix_arg = Qnil;
1148 current_kboard->Vlast_prefix_arg = Qnil;
1149 cancel_echoing ();
1151 /* Avoid unquittable loop if data contains a circular list. */
1152 old_level = Vprint_level;
1153 old_length = Vprint_length;
1154 XSETFASTINT (Vprint_level, 10);
1155 XSETFASTINT (Vprint_length, 10);
1156 cmd_error_internal (data, macroerror);
1157 Vprint_level = old_level;
1158 Vprint_length = old_length;
1160 Vquit_flag = Qnil;
1162 Vinhibit_quit = Qnil;
1163 #ifdef MULTI_KBOARD
1164 any_kboard_state ();
1165 #endif
1167 return make_number (0);
1170 /* Take actions on handling an error. DATA is the data that describes
1171 the error.
1173 CONTEXT is a C-string containing ASCII characters only which
1174 describes the context in which the error happened. If we need to
1175 generalize CONTEXT to allow multibyte characters, make it a Lisp
1176 string. */
1178 void
1179 cmd_error_internal (data, context)
1180 Lisp_Object data;
1181 char *context;
1183 Lisp_Object stream;
1184 int kill_emacs_p = 0;
1185 struct frame *sf = SELECTED_FRAME ();
1187 Vquit_flag = Qnil;
1188 Vinhibit_quit = Qt;
1189 clear_message (1, 0);
1191 /* If the window system or terminal frame hasn't been initialized
1192 yet, or we're not interactive, it's best to dump this message out
1193 to stderr and exit. */
1194 if (!sf->glyphs_initialized_p
1195 /* This is the case of the frame dumped with Emacs, when we're
1196 running under a window system. */
1197 || (!NILP (Vwindow_system)
1198 && !inhibit_window_system
1199 && FRAME_TERMCAP_P (sf))
1200 || noninteractive)
1202 stream = Qexternal_debugging_output;
1203 kill_emacs_p = 1;
1205 else
1207 Fdiscard_input ();
1208 message_log_maybe_newline ();
1209 bitch_at_user ();
1210 stream = Qt;
1213 /* The immediate context is not interesting for Quits,
1214 since they are asyncronous. */
1215 if (EQ (XCAR (data), Qquit))
1216 Vsignaling_function = Qnil;
1218 print_error_message (data, stream, context, Vsignaling_function);
1220 Vsignaling_function = Qnil;
1222 /* If the window system or terminal frame hasn't been initialized
1223 yet, or we're in -batch mode, this error should cause Emacs to exit. */
1224 if (kill_emacs_p)
1226 Fterpri (stream);
1227 Fkill_emacs (make_number (-1));
1231 Lisp_Object command_loop_1 ();
1232 Lisp_Object command_loop_2 ();
1233 Lisp_Object top_level_1 ();
1235 /* Entry to editor-command-loop.
1236 This level has the catches for exiting/returning to editor command loop.
1237 It returns nil to exit recursive edit, t to abort it. */
1239 Lisp_Object
1240 command_loop ()
1242 if (command_loop_level > 0 || minibuf_level > 0)
1244 Lisp_Object val;
1245 val = internal_catch (Qexit, command_loop_2, Qnil);
1246 executing_macro = Qnil;
1247 return val;
1249 else
1250 while (1)
1252 internal_catch (Qtop_level, top_level_1, Qnil);
1253 internal_catch (Qtop_level, command_loop_2, Qnil);
1254 executing_macro = Qnil;
1256 /* End of file in -batch run causes exit here. */
1257 if (noninteractive)
1258 Fkill_emacs (Qt);
1262 /* Here we catch errors in execution of commands within the
1263 editing loop, and reenter the editing loop.
1264 When there is an error, cmd_error runs and returns a non-nil
1265 value to us. A value of nil means that command_loop_1 itself
1266 returned due to end of file (or end of kbd macro). */
1268 Lisp_Object
1269 command_loop_2 ()
1271 register Lisp_Object val;
1274 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1275 while (!NILP (val));
1277 return Qnil;
1280 Lisp_Object
1281 top_level_2 ()
1283 return Feval (Vtop_level);
1286 Lisp_Object
1287 top_level_1 ()
1289 /* On entry to the outer level, run the startup file */
1290 if (!NILP (Vtop_level))
1291 internal_condition_case (top_level_2, Qerror, cmd_error);
1292 else if (!NILP (Vpurify_flag))
1293 message ("Bare impure Emacs (standard Lisp code not loaded)");
1294 else
1295 message ("Bare Emacs (standard Lisp code not loaded)");
1296 return Qnil;
1299 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1300 doc: /* Exit all recursive editing levels. */)
1303 #ifdef HAVE_X_WINDOWS
1304 if (display_hourglass_p)
1305 cancel_hourglass ();
1306 #endif
1307 return Fthrow (Qtop_level, Qnil);
1310 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1311 doc: /* Exit from the innermost recursive edit or minibuffer. */)
1314 if (command_loop_level > 0 || minibuf_level > 0)
1315 Fthrow (Qexit, Qnil);
1317 error ("No recursive edit is in progress");
1318 return Qnil;
1321 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1322 doc: /* Abort the command that requested this recursive edit or minibuffer input. */)
1325 if (command_loop_level > 0 || minibuf_level > 0)
1326 Fthrow (Qexit, Qt);
1328 error ("No recursive edit is in progress");
1329 return Qnil;
1332 /* This is the actual command reading loop,
1333 sans error-handling encapsulation. */
1335 static int read_key_sequence P_ ((Lisp_Object *, int, Lisp_Object,
1336 int, int, int));
1337 void safe_run_hooks P_ ((Lisp_Object));
1338 static void adjust_point_for_property P_ ((int, int));
1340 Lisp_Object
1341 command_loop_1 ()
1343 Lisp_Object cmd;
1344 int lose;
1345 int nonundocount;
1346 Lisp_Object keybuf[30];
1347 int i;
1348 int no_direct;
1349 int prev_modiff;
1350 struct buffer *prev_buffer = NULL;
1351 #ifdef MULTI_KBOARD
1352 int was_locked = single_kboard;
1353 #endif
1354 int already_adjusted;
1356 current_kboard->Vprefix_arg = Qnil;
1357 current_kboard->Vlast_prefix_arg = Qnil;
1358 Vdeactivate_mark = Qnil;
1359 waiting_for_input = 0;
1360 cancel_echoing ();
1362 nonundocount = 0;
1363 this_command_key_count = 0;
1364 this_single_command_key_start = 0;
1366 if (NILP (Vmemory_full))
1368 /* Make sure this hook runs after commands that get errors and
1369 throw to top level. */
1370 /* Note that the value cell will never directly contain nil
1371 if the symbol is a local variable. */
1372 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1373 safe_run_hooks (Qpost_command_hook);
1375 /* If displaying a message, resize the echo area window to fit
1376 that message's size exactly. */
1377 if (!NILP (echo_area_buffer[0]))
1378 resize_echo_area_exactly ();
1380 if (!NILP (Vdeferred_action_list))
1381 call0 (Vdeferred_action_function);
1383 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1385 if (NILP (Vunread_command_events)
1386 && NILP (Vunread_input_method_events)
1387 && NILP (Vunread_post_input_method_events)
1388 && NILP (Vexecuting_macro)
1389 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
1390 safe_run_hooks (Qpost_command_idle_hook);
1394 Vmemory_full = Qnil;
1396 /* Do this after running Vpost_command_hook, for consistency. */
1397 current_kboard->Vlast_command = Vthis_command;
1398 current_kboard->Vreal_last_command = real_this_command;
1400 while (1)
1402 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1403 Fkill_emacs (Qnil);
1405 /* Make sure the current window's buffer is selected. */
1406 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1407 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1409 /* Display any malloc warning that just came out. Use while because
1410 displaying one warning can cause another. */
1412 while (pending_malloc_warning)
1413 display_malloc_warning ();
1415 no_direct = 0;
1417 Vdeactivate_mark = Qnil;
1419 /* If minibuffer on and echo area in use,
1420 wait a short time and redraw minibuffer. */
1422 if (minibuf_level
1423 && !NILP (echo_area_buffer[0])
1424 && EQ (minibuf_window, echo_area_window)
1425 && NUMBERP (Vminibuffer_message_timeout))
1427 /* Bind inhibit-quit to t so that C-g gets read in
1428 rather than quitting back to the minibuffer. */
1429 int count = SPECPDL_INDEX ();
1430 specbind (Qinhibit_quit, Qt);
1432 Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil);
1433 /* Clear the echo area. */
1434 message2 (0, 0, 0);
1435 safe_run_hooks (Qecho_area_clear_hook);
1437 unbind_to (count, Qnil);
1439 /* If a C-g came in before, treat it as input now. */
1440 if (!NILP (Vquit_flag))
1442 Vquit_flag = Qnil;
1443 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
1447 #ifdef C_ALLOCA
1448 alloca (0); /* Cause a garbage collection now */
1449 /* Since we can free the most stuff here. */
1450 #endif /* C_ALLOCA */
1452 #if 0
1453 /* Select the frame that the last event came from. Usually,
1454 switch-frame events will take care of this, but if some lisp
1455 code swallows a switch-frame event, we'll fix things up here.
1456 Is this a good idea? */
1457 if (FRAMEP (internal_last_event_frame)
1458 && !EQ (internal_last_event_frame, selected_frame))
1459 Fselect_frame (internal_last_event_frame, Qnil);
1460 #endif
1461 /* If it has changed current-menubar from previous value,
1462 really recompute the menubar from the value. */
1463 if (! NILP (Vlucid_menu_bar_dirty_flag)
1464 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
1465 call0 (Qrecompute_lucid_menubar);
1467 before_command_key_count = this_command_key_count;
1468 before_command_echo_length = echo_length ();
1470 Vthis_command = Qnil;
1471 real_this_command = Qnil;
1473 /* Read next key sequence; i gets its length. */
1474 i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
1475 Qnil, 0, 1, 1);
1477 /* A filter may have run while we were reading the input. */
1478 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1479 Fkill_emacs (Qnil);
1480 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1481 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1483 ++num_input_keys;
1485 /* Now we have read a key sequence of length I,
1486 or else I is 0 and we found end of file. */
1488 if (i == 0) /* End of file -- happens only in */
1489 return Qnil; /* a kbd macro, at the end. */
1490 /* -1 means read_key_sequence got a menu that was rejected.
1491 Just loop around and read another command. */
1492 if (i == -1)
1494 cancel_echoing ();
1495 this_command_key_count = 0;
1496 this_single_command_key_start = 0;
1497 goto finalize;
1500 last_command_char = keybuf[i - 1];
1502 /* If the previous command tried to force a specific window-start,
1503 forget about that, in case this command moves point far away
1504 from that position. But also throw away beg_unchanged and
1505 end_unchanged information in that case, so that redisplay will
1506 update the whole window properly. */
1507 if (!NILP (XWINDOW (selected_window)->force_start))
1509 struct buffer *b;
1510 XWINDOW (selected_window)->force_start = Qnil;
1511 b = XBUFFER (XWINDOW (selected_window)->buffer);
1512 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
1515 cmd = read_key_sequence_cmd;
1516 if (!NILP (Vexecuting_macro))
1518 if (!NILP (Vquit_flag))
1520 Vexecuting_macro = Qt;
1521 QUIT; /* Make some noise. */
1522 /* Will return since macro now empty. */
1526 /* Do redisplay processing after this command except in special
1527 cases identified below. */
1528 prev_buffer = current_buffer;
1529 prev_modiff = MODIFF;
1530 last_point_position = PT;
1531 XSETBUFFER (last_point_position_buffer, prev_buffer);
1533 /* By default, we adjust point to a boundary of a region that
1534 has such a property that should be treated intangible
1535 (e.g. composition, display). But, some commands will set
1536 this variable differently. */
1537 Vdisable_point_adjustment = Qnil;
1539 /* Process filters and timers may have messed with deactivate-mark.
1540 reset it before we execute the command. */
1541 Vdeactivate_mark = Qnil;
1543 /* Remap command through active keymaps */
1544 Vthis_original_command = cmd;
1545 if (SYMBOLP (cmd))
1547 Lisp_Object cmd1;
1548 if (cmd1 = Fremap_command (cmd), !NILP (cmd1))
1549 cmd = cmd1;
1552 /* Execute the command. */
1554 Vthis_command = cmd;
1555 real_this_command = cmd;
1556 /* Note that the value cell will never directly contain nil
1557 if the symbol is a local variable. */
1558 if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks))
1559 safe_run_hooks (Qpre_command_hook);
1561 already_adjusted = 0;
1563 if (NILP (Vthis_command))
1565 /* nil means key is undefined. */
1566 bitch_at_user ();
1567 current_kboard->defining_kbd_macro = Qnil;
1568 update_mode_lines = 1;
1569 current_kboard->Vprefix_arg = Qnil;
1571 else
1573 if (NILP (current_kboard->Vprefix_arg) && ! no_direct)
1575 /* In case we jump to directly_done. */
1576 Vcurrent_prefix_arg = current_kboard->Vprefix_arg;
1578 /* Recognize some common commands in common situations and
1579 do them directly. */
1580 if (EQ (Vthis_command, Qforward_char) && PT < ZV)
1582 struct Lisp_Char_Table *dp
1583 = window_display_table (XWINDOW (selected_window));
1584 lose = FETCH_CHAR (PT_BYTE);
1585 SET_PT (PT + 1);
1586 if (! NILP (Vpost_command_hook))
1587 /* Put this before calling adjust_point_for_property
1588 so it will only get called once in any case. */
1589 goto directly_done;
1590 adjust_point_for_property (last_point_position, 0);
1591 already_adjusted = 1;
1592 if (PT == last_point_position + 1
1593 && (dp
1594 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1595 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1596 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1597 && (lose >= 0x20 && lose < 0x7f)))
1598 : (lose >= 0x20 && lose < 0x7f))
1599 /* To extract the case of continuation on
1600 wide-column characters. */
1601 && (WIDTH_BY_CHAR_HEAD (FETCH_BYTE (PT_BYTE)) == 1)
1602 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1603 >= MODIFF)
1604 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1605 >= OVERLAY_MODIFF)
1606 && (XFASTINT (XWINDOW (selected_window)->last_point)
1607 == PT - 1)
1608 && !windows_or_buffers_changed
1609 && EQ (current_buffer->selective_display, Qnil)
1610 && !detect_input_pending ()
1611 && NILP (XWINDOW (selected_window)->column_number_displayed)
1612 && NILP (Vexecuting_macro))
1613 direct_output_forward_char (1);
1614 goto directly_done;
1616 else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV)
1618 struct Lisp_Char_Table *dp
1619 = window_display_table (XWINDOW (selected_window));
1620 SET_PT (PT - 1);
1621 lose = FETCH_CHAR (PT_BYTE);
1622 if (! NILP (Vpost_command_hook))
1623 goto directly_done;
1624 adjust_point_for_property (last_point_position, 0);
1625 already_adjusted = 1;
1626 if (PT == last_point_position - 1
1627 && (dp
1628 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1629 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1630 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1631 && (lose >= 0x20 && lose < 0x7f)))
1632 : (lose >= 0x20 && lose < 0x7f))
1633 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1634 >= MODIFF)
1635 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1636 >= OVERLAY_MODIFF)
1637 && (XFASTINT (XWINDOW (selected_window)->last_point)
1638 == PT + 1)
1639 && !windows_or_buffers_changed
1640 && EQ (current_buffer->selective_display, Qnil)
1641 && !detect_input_pending ()
1642 && NILP (XWINDOW (selected_window)->column_number_displayed)
1643 && NILP (Vexecuting_macro))
1644 direct_output_forward_char (-1);
1645 goto directly_done;
1647 else if (EQ (Vthis_command, Qself_insert_command)
1648 /* Try this optimization only on char keystrokes. */
1649 && NATNUMP (last_command_char)
1650 && CHAR_VALID_P (XFASTINT (last_command_char), 0))
1652 unsigned int c
1653 = translate_char (Vtranslation_table_for_input,
1654 XFASTINT (last_command_char), 0, 0, 0);
1655 int value;
1656 if (NILP (Vexecuting_macro)
1657 && !EQ (minibuf_window, selected_window))
1659 if (!nonundocount || nonundocount >= 20)
1661 Fundo_boundary ();
1662 nonundocount = 0;
1664 nonundocount++;
1667 lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
1668 < MODIFF)
1669 || (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1670 < OVERLAY_MODIFF)
1671 || (XFASTINT (XWINDOW (selected_window)->last_point)
1672 != PT)
1673 || MODIFF <= SAVE_MODIFF
1674 || windows_or_buffers_changed
1675 || !EQ (current_buffer->selective_display, Qnil)
1676 || detect_input_pending ()
1677 || !NILP (XWINDOW (selected_window)->column_number_displayed)
1678 || !NILP (Vexecuting_macro));
1680 value = internal_self_insert (c, 0);
1682 if (value == 2)
1683 nonundocount = 0;
1685 if (! NILP (Vpost_command_hook))
1686 /* Put this before calling adjust_point_for_property
1687 so it will only get called once in any case. */
1688 goto directly_done;
1690 /* VALUE == 1 when AFTER-CHANGE functions are
1691 installed which is the case most of the time
1692 because FONT-LOCK installs one. */
1693 if (!lose && !value)
1694 direct_output_for_insert (c);
1695 goto directly_done;
1699 /* Here for a command that isn't executed directly */
1701 #ifdef HAVE_X_WINDOWS
1702 if (display_hourglass_p
1703 && NILP (Vexecuting_macro))
1704 start_hourglass ();
1705 #endif
1707 nonundocount = 0;
1708 if (NILP (current_kboard->Vprefix_arg))
1709 Fundo_boundary ();
1710 Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
1712 #ifdef HAVE_X_WINDOWS
1713 /* Do not check display_hourglass_p here, because
1714 Fcommand_execute could change it, but we should cancel
1715 hourglass cursor anyway.
1716 But don't cancel the hourglass within a macro
1717 just because a command in the macro finishes. */
1718 if (NILP (Vexecuting_macro))
1719 cancel_hourglass ();
1720 #endif
1722 directly_done: ;
1723 current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg;
1725 /* Note that the value cell will never directly contain nil
1726 if the symbol is a local variable. */
1727 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1728 safe_run_hooks (Qpost_command_hook);
1730 /* If displaying a message, resize the echo area window to fit
1731 that message's size exactly. */
1732 if (!NILP (echo_area_buffer[0]))
1733 resize_echo_area_exactly ();
1735 if (!NILP (Vdeferred_action_list))
1736 safe_run_hooks (Qdeferred_action_function);
1738 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1740 if (NILP (Vunread_command_events)
1741 && NILP (Vunread_input_method_events)
1742 && NILP (Vunread_post_input_method_events)
1743 && NILP (Vexecuting_macro)
1744 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
1745 safe_run_hooks (Qpost_command_idle_hook);
1748 /* If there is a prefix argument,
1749 1) We don't want Vlast_command to be ``universal-argument''
1750 (that would be dumb), so don't set Vlast_command,
1751 2) we want to leave echoing on so that the prefix will be
1752 echoed as part of this key sequence, so don't call
1753 cancel_echoing, and
1754 3) we want to leave this_command_key_count non-zero, so that
1755 read_char will realize that it is re-reading a character, and
1756 not echo it a second time.
1758 If the command didn't actually create a prefix arg,
1759 but is merely a frame event that is transparent to prefix args,
1760 then the above doesn't apply. */
1761 if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_char))
1763 current_kboard->Vlast_command = Vthis_command;
1764 current_kboard->Vreal_last_command = real_this_command;
1765 cancel_echoing ();
1766 this_command_key_count = 0;
1767 this_single_command_key_start = 0;
1770 if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks))
1772 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
1774 /* We could also call `deactivate'mark'. */
1775 if (EQ (Vtransient_mark_mode, Qlambda))
1776 Vtransient_mark_mode = Qnil;
1777 else
1779 current_buffer->mark_active = Qnil;
1780 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
1783 else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1784 call1 (Vrun_hooks, intern ("activate-mark-hook"));
1787 finalize:
1789 if (current_buffer == prev_buffer
1790 && last_point_position != PT
1791 && NILP (Vdisable_point_adjustment)
1792 && NILP (Vglobal_disable_point_adjustment)
1793 && !already_adjusted)
1794 adjust_point_for_property (last_point_position, MODIFF != prev_modiff);
1796 /* Install chars successfully executed in kbd macro. */
1798 if (!NILP (current_kboard->defining_kbd_macro)
1799 && NILP (current_kboard->Vprefix_arg))
1800 finalize_kbd_macro_chars ();
1802 #ifdef MULTI_KBOARD
1803 if (!was_locked)
1804 any_kboard_state ();
1805 #endif
1809 extern Lisp_Object Qcomposition, Qdisplay;
1811 /* Adjust point to a boundary of a region that has such a property
1812 that should be treated intangible. For the moment, we check
1813 `composition', `display' and `invisible' properties.
1814 LAST_PT is the last position of point. */
1816 extern Lisp_Object Qafter_string, Qbefore_string;
1817 extern Lisp_Object get_pos_property P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
1819 static void
1820 adjust_point_for_property (last_pt, modified)
1821 int last_pt;
1822 int modified;
1824 int beg, end;
1825 Lisp_Object val, overlay, tmp;
1826 int check_composition = 1, check_display = 1, check_invisible = 1;
1828 while (check_composition || check_display || check_invisible)
1830 if (check_composition
1831 && PT > BEGV && PT < ZV
1832 && get_property_and_range (PT, Qcomposition, &val, &beg, &end, Qnil)
1833 && COMPOSITION_VALID_P (beg, end, val)
1834 && beg < PT /* && end > PT <- It's always the case. */
1835 && (last_pt <= beg || last_pt >= end))
1837 xassert (end > PT);
1838 SET_PT (PT < last_pt ? beg : end);
1839 check_display = check_invisible = 1;
1841 check_composition = 0;
1842 if (check_display
1843 && PT > BEGV && PT < ZV
1844 && !NILP (val = get_char_property_and_overlay
1845 (make_number (PT), Qdisplay, Qnil, &overlay))
1846 && display_prop_intangible_p (val)
1847 && (!OVERLAYP (overlay)
1848 ? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil)
1849 : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)),
1850 end = OVERLAY_POSITION (OVERLAY_END (overlay))))
1851 && beg < PT) /* && end > PT <- It's always the case. */
1853 xassert (end > PT);
1854 SET_PT (PT < last_pt ? beg : end);
1855 check_composition = check_invisible = 1;
1857 check_display = 0;
1858 if (check_invisible && PT > BEGV && PT < ZV)
1860 int inv, ellipsis = 0;
1861 beg = end = PT;
1863 /* Find boundaries `beg' and `end' of the invisible area, if any. */
1864 while (end < ZV
1865 && !NILP (val = get_char_property_and_overlay
1866 (make_number (end), Qinvisible, Qnil, &overlay))
1867 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1869 ellipsis = ellipsis || inv > 1
1870 || (OVERLAYP (overlay)
1871 && (!NILP (Foverlay_get (overlay, Qafter_string))
1872 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1873 tmp = Fnext_single_char_property_change
1874 (make_number (end), Qinvisible, Qnil, Qnil);
1875 end = NATNUMP (tmp) ? XFASTINT (tmp) : ZV;
1877 while (beg > BEGV
1878 && !NILP (val = get_char_property_and_overlay
1879 (make_number (beg - 1), Qinvisible, Qnil, &overlay))
1880 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1882 ellipsis = ellipsis || inv > 1
1883 || (OVERLAYP (overlay)
1884 && (!NILP (Foverlay_get (overlay, Qafter_string))
1885 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1886 tmp = Fprevious_single_char_property_change
1887 (make_number (beg), Qinvisible, Qnil, Qnil);
1888 beg = NATNUMP (tmp) ? XFASTINT (tmp) : BEGV;
1891 /* Move away from the inside area. */
1892 if (beg < PT && end > PT)
1894 SET_PT (PT < last_pt ? beg : end);
1895 check_composition = check_display = 1;
1897 xassert (PT == beg || PT == end);
1898 /* Pretend the area doesn't exist if the buffer is not
1899 modified. */
1900 if (!modified && !ellipsis && beg < end)
1902 if (last_pt == beg && PT == end && end < ZV)
1903 (check_composition = check_display = 1, SET_PT (end + 1));
1904 else if (last_pt == end && PT == beg && beg > BEGV)
1905 (check_composition = check_display = 1, SET_PT (beg - 1));
1906 else if (PT == ((PT < last_pt) ? beg : end))
1907 /* We've already moved as far as we can. Trying to go
1908 to the other end would mean moving backwards and thus
1909 could lead to an infinite loop. */
1911 else if (val = get_pos_property (make_number (PT),
1912 Qinvisible, Qnil),
1913 TEXT_PROP_MEANS_INVISIBLE (val)
1914 && (val = get_pos_property
1915 (make_number (PT == beg ? end : beg),
1916 Qinvisible, Qnil),
1917 !TEXT_PROP_MEANS_INVISIBLE (val)))
1918 (check_composition = check_display = 1,
1919 SET_PT (PT == beg ? end : beg));
1922 check_invisible = 0;
1926 /* Subroutine for safe_run_hooks: run the hook HOOK. */
1928 static Lisp_Object
1929 safe_run_hooks_1 (hook)
1930 Lisp_Object hook;
1932 return call1 (Vrun_hooks, Vinhibit_quit);
1935 /* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */
1937 static Lisp_Object
1938 safe_run_hooks_error (data)
1939 Lisp_Object data;
1941 return Fset (Vinhibit_quit, Qnil);
1944 /* If we get an error while running the hook, cause the hook variable
1945 to be nil. Also inhibit quits, so that C-g won't cause the hook
1946 to mysteriously evaporate. */
1948 void
1949 safe_run_hooks (hook)
1950 Lisp_Object hook;
1952 int count = SPECPDL_INDEX ();
1953 specbind (Qinhibit_quit, hook);
1955 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
1957 unbind_to (count, Qnil);
1961 /* Number of seconds between polling for input. This is a Lisp
1962 variable that can be bound. */
1964 EMACS_INT polling_period;
1966 /* Nonzero means polling for input is temporarily suppressed. */
1968 int poll_suppress_count;
1970 /* Asynchronous timer for polling. */
1972 struct atimer *poll_timer;
1975 #ifdef POLL_FOR_INPUT
1977 /* Poll for input, so what we catch a C-g if it comes in. This
1978 function is called from x_make_frame_visible, see comment
1979 there. */
1981 void
1982 poll_for_input_1 ()
1984 if (interrupt_input_blocked == 0
1985 && !waiting_for_input)
1986 read_avail_input (0);
1989 /* Timer callback function for poll_timer. TIMER is equal to
1990 poll_timer. */
1992 void
1993 poll_for_input (timer)
1994 struct atimer *timer;
1996 if (poll_suppress_count == 0)
1997 poll_for_input_1 ();
2000 #endif /* POLL_FOR_INPUT */
2002 /* Begin signals to poll for input, if they are appropriate.
2003 This function is called unconditionally from various places. */
2005 void
2006 start_polling ()
2008 #ifdef POLL_FOR_INPUT
2009 if (read_socket_hook && !interrupt_input)
2011 /* Turn alarm handling on unconditionally. It might have
2012 been turned off in process.c. */
2013 turn_on_atimers (1);
2015 /* If poll timer doesn't exist, are we need one with
2016 a different interval, start a new one. */
2017 if (poll_timer == NULL
2018 || EMACS_SECS (poll_timer->interval) != polling_period)
2020 EMACS_TIME interval;
2022 if (poll_timer)
2023 cancel_atimer (poll_timer);
2025 EMACS_SET_SECS_USECS (interval, polling_period, 0);
2026 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
2027 poll_for_input, NULL);
2030 /* Let the timer's callback function poll for input
2031 if this becomes zero. */
2032 --poll_suppress_count;
2034 #endif
2037 /* Nonzero if we are using polling to handle input asynchronously. */
2040 input_polling_used ()
2042 #ifdef POLL_FOR_INPUT
2043 return read_socket_hook && !interrupt_input;
2044 #else
2045 return 0;
2046 #endif
2049 /* Turn off polling. */
2051 void
2052 stop_polling ()
2054 #ifdef POLL_FOR_INPUT
2055 if (read_socket_hook && !interrupt_input)
2056 ++poll_suppress_count;
2057 #endif
2060 /* Set the value of poll_suppress_count to COUNT
2061 and start or stop polling accordingly. */
2063 void
2064 set_poll_suppress_count (count)
2065 int count;
2067 #ifdef POLL_FOR_INPUT
2068 if (count == 0 && poll_suppress_count != 0)
2070 poll_suppress_count = 1;
2071 start_polling ();
2073 else if (count != 0 && poll_suppress_count == 0)
2075 stop_polling ();
2077 poll_suppress_count = count;
2078 #endif
2081 /* Bind polling_period to a value at least N.
2082 But don't decrease it. */
2084 void
2085 bind_polling_period (n)
2086 int n;
2088 #ifdef POLL_FOR_INPUT
2089 int new = polling_period;
2091 if (n > new)
2092 new = n;
2094 stop_other_atimers (poll_timer);
2095 stop_polling ();
2096 specbind (Qpolling_period, make_number (new));
2097 /* Start a new alarm with the new period. */
2098 start_polling ();
2099 #endif
2102 /* Apply the control modifier to CHARACTER. */
2105 make_ctrl_char (c)
2106 int c;
2108 /* Save the upper bits here. */
2109 int upper = c & ~0177;
2111 c &= 0177;
2113 /* Everything in the columns containing the upper-case letters
2114 denotes a control character. */
2115 if (c >= 0100 && c < 0140)
2117 int oc = c;
2118 c &= ~0140;
2119 /* Set the shift modifier for a control char
2120 made from a shifted letter. But only for letters! */
2121 if (oc >= 'A' && oc <= 'Z')
2122 c |= shift_modifier;
2125 /* The lower-case letters denote control characters too. */
2126 else if (c >= 'a' && c <= 'z')
2127 c &= ~0140;
2129 /* Include the bits for control and shift
2130 only if the basic ASCII code can't indicate them. */
2131 else if (c >= ' ')
2132 c |= ctrl_modifier;
2134 /* Replace the high bits. */
2135 c |= (upper & ~ctrl_modifier);
2137 return c;
2140 /* Display help echo in the echo area.
2142 HELP a string means display that string, HELP nil means clear the
2143 help echo. If HELP is a function, call it with OBJECT and POS as
2144 arguments; the function should return a help string or nil for
2145 none. For all other types of HELP evaluate it to obtain a string.
2147 WINDOW is the window in which the help was generated, if any.
2148 It is nil if not in a window.
2150 If OBJECT is a buffer, POS is the position in the buffer where the
2151 `help-echo' text property was found.
2153 If OBJECT is an overlay, that overlay has a `help-echo' property,
2154 and POS is the position in the overlay's buffer under the mouse.
2156 If OBJECT is a string (an overlay string or a string displayed with
2157 the `display' property). POS is the position in that string under
2158 the mouse.
2160 OK_TO_OVERWRITE_KEYSTROKE_ECHO non-zero means it's okay if the help
2161 echo overwrites a keystroke echo currently displayed in the echo
2162 area.
2164 Note: this function may only be called with HELP nil or a string
2165 from X code running asynchronously. */
2167 void
2168 show_help_echo (help, window, object, pos, ok_to_overwrite_keystroke_echo)
2169 Lisp_Object help, window, object, pos;
2170 int ok_to_overwrite_keystroke_echo;
2172 if (!NILP (help) && !STRINGP (help))
2174 if (FUNCTIONP (help))
2176 Lisp_Object args[4];
2177 args[0] = help;
2178 args[1] = window;
2179 args[2] = object;
2180 args[3] = pos;
2181 help = safe_call (4, args);
2183 else
2184 help = safe_eval (help);
2186 if (!STRINGP (help))
2187 return;
2190 if (STRINGP (help) || NILP (help))
2192 if (!NILP (Vshow_help_function))
2193 call1 (Vshow_help_function, help);
2194 else if (/* Don't overwrite minibuffer contents. */
2195 !MINI_WINDOW_P (XWINDOW (selected_window))
2196 /* Don't overwrite a keystroke echo. */
2197 && (NILP (echo_message_buffer)
2198 || ok_to_overwrite_keystroke_echo)
2199 /* Don't overwrite a prompt. */
2200 && !cursor_in_echo_area)
2202 if (STRINGP (help))
2204 int count = SPECPDL_INDEX ();
2206 if (!help_echo_showing_p)
2207 Vpre_help_message = current_message ();
2209 specbind (Qmessage_truncate_lines, Qt);
2210 message3_nolog (help, SBYTES (help),
2211 STRING_MULTIBYTE (help));
2212 unbind_to (count, Qnil);
2214 else if (STRINGP (Vpre_help_message))
2216 message3_nolog (Vpre_help_message,
2217 SBYTES (Vpre_help_message),
2218 STRING_MULTIBYTE (Vpre_help_message));
2219 Vpre_help_message = Qnil;
2221 else
2222 message (0);
2225 help_echo_showing_p = STRINGP (help);
2231 /* Input of single characters from keyboard */
2233 Lisp_Object print_help ();
2234 static Lisp_Object kbd_buffer_get_event ();
2235 static void record_char ();
2237 #ifdef MULTI_KBOARD
2238 static jmp_buf wrong_kboard_jmpbuf;
2239 #endif
2241 #define STOP_POLLING \
2242 do { if (! polling_stopped_here) stop_polling (); \
2243 polling_stopped_here = 1; } while (0)
2245 #define RESUME_POLLING \
2246 do { if (polling_stopped_here) start_polling (); \
2247 polling_stopped_here = 0; } while (0)
2249 /* read a character from the keyboard; call the redisplay if needed */
2250 /* commandflag 0 means do not do auto-saving, but do do redisplay.
2251 -1 means do not do redisplay, but do do autosaving.
2252 1 means do both. */
2254 /* The arguments MAPS and NMAPS are for menu prompting.
2255 MAPS is an array of keymaps; NMAPS is the length of MAPS.
2257 PREV_EVENT is the previous input event, or nil if we are reading
2258 the first event of a key sequence (or not reading a key sequence).
2259 If PREV_EVENT is t, that is a "magic" value that says
2260 not to run input methods, but in other respects to act as if
2261 not reading a key sequence.
2263 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
2264 if we used a mouse menu to read the input, or zero otherwise. If
2265 USED_MOUSE_MENU is null, we don't dereference it.
2267 Value is t if we showed a menu and the user rejected it. */
2269 Lisp_Object
2270 read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
2271 int commandflag;
2272 int nmaps;
2273 Lisp_Object *maps;
2274 Lisp_Object prev_event;
2275 int *used_mouse_menu;
2277 volatile Lisp_Object c;
2278 int count;
2279 jmp_buf local_getcjmp;
2280 jmp_buf save_jump;
2281 volatile int key_already_recorded = 0;
2282 Lisp_Object tem, save;
2283 volatile Lisp_Object previous_echo_area_message;
2284 volatile Lisp_Object also_record;
2285 volatile int reread;
2286 struct gcpro gcpro1, gcpro2;
2287 EMACS_TIME last_idle_start;
2288 int polling_stopped_here = 0;
2290 also_record = Qnil;
2292 before_command_key_count = this_command_key_count;
2293 before_command_echo_length = echo_length ();
2294 c = Qnil;
2295 previous_echo_area_message = Qnil;
2297 GCPRO2 (c, previous_echo_area_message);
2299 retry:
2301 reread = 0;
2302 if (CONSP (Vunread_post_input_method_events))
2304 c = XCAR (Vunread_post_input_method_events);
2305 Vunread_post_input_method_events
2306 = XCDR (Vunread_post_input_method_events);
2308 /* Undo what read_char_x_menu_prompt did when it unread
2309 additional keys returned by Fx_popup_menu. */
2310 if (CONSP (c)
2311 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2312 && NILP (XCDR (c)))
2313 c = XCAR (c);
2315 reread = 1;
2316 goto reread_first;
2319 if (unread_command_char != -1)
2321 XSETINT (c, unread_command_char);
2322 unread_command_char = -1;
2324 reread = 1;
2325 goto reread_first;
2328 if (CONSP (Vunread_command_events))
2330 c = XCAR (Vunread_command_events);
2331 Vunread_command_events = XCDR (Vunread_command_events);
2333 /* Undo what read_char_x_menu_prompt did when it unread
2334 additional keys returned by Fx_popup_menu. */
2335 if (CONSP (c)
2336 && EQ (XCDR (c), Qdisabled)
2337 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))))
2338 c = XCAR (c);
2340 /* If the queued event is something that used the mouse,
2341 set used_mouse_menu accordingly. */
2342 if (used_mouse_menu
2343 && (EQ (c, Qtool_bar) || EQ (c, Qmenu_bar)))
2344 *used_mouse_menu = 1;
2346 reread = 1;
2347 goto reread_for_input_method;
2350 if (CONSP (Vunread_input_method_events))
2352 c = XCAR (Vunread_input_method_events);
2353 Vunread_input_method_events = XCDR (Vunread_input_method_events);
2355 /* Undo what read_char_x_menu_prompt did when it unread
2356 additional keys returned by Fx_popup_menu. */
2357 if (CONSP (c)
2358 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2359 && NILP (XCDR (c)))
2360 c = XCAR (c);
2361 reread = 1;
2362 goto reread_for_input_method;
2365 /* If there is no function key translated before
2366 reset-this-command-lengths takes effect, forget about it. */
2367 before_command_restore_flag = 0;
2369 if (!NILP (Vexecuting_macro))
2371 /* We set this to Qmacro; since that's not a frame, nobody will
2372 try to switch frames on us, and the selected window will
2373 remain unchanged.
2375 Since this event came from a macro, it would be misleading to
2376 leave internal_last_event_frame set to wherever the last
2377 real event came from. Normally, a switch-frame event selects
2378 internal_last_event_frame after each command is read, but
2379 events read from a macro should never cause a new frame to be
2380 selected. */
2381 Vlast_event_frame = internal_last_event_frame = Qmacro;
2383 /* Exit the macro if we are at the end.
2384 Also, some things replace the macro with t
2385 to force an early exit. */
2386 if (EQ (Vexecuting_macro, Qt)
2387 || executing_macro_index >= XFASTINT (Flength (Vexecuting_macro)))
2389 XSETINT (c, -1);
2390 goto exit;
2393 c = Faref (Vexecuting_macro, make_number (executing_macro_index));
2394 if (STRINGP (Vexecuting_macro)
2395 && (XINT (c) & 0x80))
2396 XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
2398 executing_macro_index++;
2400 goto from_macro;
2403 if (!NILP (unread_switch_frame))
2405 c = unread_switch_frame;
2406 unread_switch_frame = Qnil;
2408 /* This event should make it into this_command_keys, and get echoed
2409 again, so we do not set `reread'. */
2410 goto reread_first;
2413 /* if redisplay was requested */
2414 if (commandflag >= 0)
2416 /* If there is pending input, process any events which are not
2417 user-visible, such as X selection_request events. */
2418 if (input_pending
2419 || detect_input_pending_run_timers (0))
2420 swallow_events (0); /* may clear input_pending */
2422 /* Redisplay if no pending input. */
2423 while (!input_pending)
2425 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
2426 redisplay_preserve_echo_area (5);
2427 else
2428 redisplay ();
2430 if (!input_pending)
2431 /* Normal case: no input arrived during redisplay. */
2432 break;
2434 /* Input arrived and pre-empted redisplay.
2435 Process any events which are not user-visible. */
2436 swallow_events (0);
2437 /* If that cleared input_pending, try again to redisplay. */
2441 /* Message turns off echoing unless more keystrokes turn it on again.
2443 The code in 20.x for the condition was
2445 1. echo_area_glyphs && *echo_area_glyphs
2446 2. && echo_area_glyphs != current_kboard->echobuf
2447 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2449 (1) means there's a current message displayed
2451 (2) means it's not the message from echoing from the current
2452 kboard.
2454 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2455 is set to a non-null value. This is done in read_char and it is
2456 set to echo_area_glyphs after a call to echo_char. That means
2457 ok_to_echo_at_next_pause is either null or
2458 current_kboard->echobuf with the appropriate current_kboard at
2459 that time.
2461 So, condition (3) means in clear text ok_to_echo_at_next_pause
2462 must be either null, or the current message isn't from echoing at
2463 all, or it's from echoing from a different kboard than the
2464 current one. */
2466 if (/* There currently is something in the echo area. */
2467 !NILP (echo_area_buffer[0])
2468 && (/* And it's either not from echoing. */
2469 !EQ (echo_area_buffer[0], echo_message_buffer)
2470 /* Or it's an echo from a different kboard. */
2471 || echo_kboard != current_kboard
2472 /* Or we explicitly allow overwriting whatever there is. */
2473 || ok_to_echo_at_next_pause == NULL))
2474 cancel_echoing ();
2475 else
2476 echo_dash ();
2478 /* Try reading a character via menu prompting in the minibuf.
2479 Try this before the sit-for, because the sit-for
2480 would do the wrong thing if we are supposed to do
2481 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2482 after a mouse event so don't try a minibuf menu. */
2483 c = Qnil;
2484 if (nmaps > 0 && INTERACTIVE
2485 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2486 /* Don't bring up a menu if we already have another event. */
2487 && NILP (Vunread_command_events)
2488 && unread_command_char < 0
2489 && !detect_input_pending_run_timers (0))
2491 c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
2492 if (! NILP (c))
2494 key_already_recorded = 1;
2495 goto non_reread_1;
2499 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2500 We will do that below, temporarily for short sections of code,
2501 when appropriate. local_getcjmp must be in effect
2502 around any call to sit_for or kbd_buffer_get_event;
2503 it *must not* be in effect when we call redisplay. */
2505 if (_setjmp (local_getcjmp))
2507 XSETINT (c, quit_char);
2508 internal_last_event_frame = selected_frame;
2509 Vlast_event_frame = internal_last_event_frame;
2510 /* If we report the quit char as an event,
2511 don't do so more than once. */
2512 if (!NILP (Vinhibit_quit))
2513 Vquit_flag = Qnil;
2515 #ifdef MULTI_KBOARD
2517 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
2518 if (kb != current_kboard)
2520 Lisp_Object link = kb->kbd_queue;
2521 /* We shouldn't get here if we were in single-kboard mode! */
2522 if (single_kboard)
2523 abort ();
2524 if (CONSP (link))
2526 while (CONSP (XCDR (link)))
2527 link = XCDR (link);
2528 if (!NILP (XCDR (link)))
2529 abort ();
2531 if (!CONSP (link))
2532 kb->kbd_queue = Fcons (c, Qnil);
2533 else
2534 XSETCDR (link, Fcons (c, Qnil));
2535 kb->kbd_queue_has_data = 1;
2536 current_kboard = kb;
2537 /* This is going to exit from read_char
2538 so we had better get rid of this frame's stuff. */
2539 UNGCPRO;
2540 longjmp (wrong_kboard_jmpbuf, 1);
2543 #endif
2544 goto non_reread;
2547 timer_start_idle ();
2549 /* If in middle of key sequence and minibuffer not active,
2550 start echoing if enough time elapses. */
2552 if (minibuf_level == 0
2553 && !current_kboard->immediate_echo
2554 && this_command_key_count > 0
2555 && ! noninteractive
2556 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2557 && NILP (Fzerop (Vecho_keystrokes))
2558 && (/* No message. */
2559 NILP (echo_area_buffer[0])
2560 /* Or empty message. */
2561 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2562 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2563 /* Or already echoing from same kboard. */
2564 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2565 /* Or not echoing before and echoing allowed. */
2566 || (!echo_kboard && ok_to_echo_at_next_pause)))
2568 Lisp_Object tem0;
2570 /* After a mouse event, start echoing right away.
2571 This is because we are probably about to display a menu,
2572 and we don't want to delay before doing so. */
2573 if (EVENT_HAS_PARAMETERS (prev_event))
2574 echo_now ();
2575 else
2577 int sec, usec;
2578 double duration = extract_float (Vecho_keystrokes);
2579 sec = (int) duration;
2580 usec = (duration - sec) * 1000000;
2581 save_getcjmp (save_jump);
2582 restore_getcjmp (local_getcjmp);
2583 tem0 = sit_for (sec, usec, 1, 1, 0);
2584 restore_getcjmp (save_jump);
2585 if (EQ (tem0, Qt)
2586 && ! CONSP (Vunread_command_events))
2587 echo_now ();
2591 /* Maybe auto save due to number of keystrokes. */
2593 if (commandflag != 0
2594 && auto_save_interval > 0
2595 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
2596 && !detect_input_pending_run_timers (0))
2598 Fdo_auto_save (Qnil, Qnil);
2599 /* Hooks can actually change some buffers in auto save. */
2600 redisplay ();
2603 /* Try reading using an X menu.
2604 This is never confused with reading using the minibuf
2605 because the recursive call of read_char in read_char_minibuf_menu_prompt
2606 does not pass on any keymaps. */
2608 if (nmaps > 0 && INTERACTIVE
2609 && !NILP (prev_event)
2610 && EVENT_HAS_PARAMETERS (prev_event)
2611 && !EQ (XCAR (prev_event), Qmenu_bar)
2612 && !EQ (XCAR (prev_event), Qtool_bar)
2613 /* Don't bring up a menu if we already have another event. */
2614 && NILP (Vunread_command_events)
2615 && unread_command_char < 0)
2617 c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
2619 /* Now that we have read an event, Emacs is not idle. */
2620 timer_stop_idle ();
2622 goto exit;
2625 /* Maybe autosave and/or garbage collect due to idleness. */
2627 if (INTERACTIVE && NILP (c))
2629 int delay_level, buffer_size;
2631 /* Slow down auto saves logarithmically in size of current buffer,
2632 and garbage collect while we're at it. */
2633 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2634 last_non_minibuf_size = Z - BEG;
2635 buffer_size = (last_non_minibuf_size >> 8) + 1;
2636 delay_level = 0;
2637 while (buffer_size > 64)
2638 delay_level++, buffer_size -= buffer_size >> 2;
2639 if (delay_level < 4) delay_level = 4;
2640 /* delay_level is 4 for files under around 50k, 7 at 100k,
2641 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2643 /* Auto save if enough time goes by without input. */
2644 if (commandflag != 0
2645 && num_nonmacro_input_events > last_auto_save
2646 && INTEGERP (Vauto_save_timeout)
2647 && XINT (Vauto_save_timeout) > 0)
2649 Lisp_Object tem0;
2651 save_getcjmp (save_jump);
2652 restore_getcjmp (local_getcjmp);
2653 tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4,
2654 0, 1, 1, 0);
2655 restore_getcjmp (save_jump);
2657 if (EQ (tem0, Qt)
2658 && ! CONSP (Vunread_command_events))
2660 Fdo_auto_save (Qnil, Qnil);
2662 /* If we have auto-saved and there is still no input
2663 available, garbage collect if there has been enough
2664 consing going on to make it worthwhile. */
2665 if (!detect_input_pending_run_timers (0)
2666 && consing_since_gc > gc_cons_threshold / 2)
2667 Fgarbage_collect ();
2669 redisplay ();
2674 /* If this has become non-nil here, it has been set by a timer
2675 or sentinel or filter. */
2676 if (CONSP (Vunread_command_events))
2678 c = XCAR (Vunread_command_events);
2679 Vunread_command_events = XCDR (Vunread_command_events);
2682 /* Read something from current KBOARD's side queue, if possible. */
2684 if (NILP (c))
2686 if (current_kboard->kbd_queue_has_data)
2688 if (!CONSP (current_kboard->kbd_queue))
2689 abort ();
2690 c = XCAR (current_kboard->kbd_queue);
2691 current_kboard->kbd_queue
2692 = XCDR (current_kboard->kbd_queue);
2693 if (NILP (current_kboard->kbd_queue))
2694 current_kboard->kbd_queue_has_data = 0;
2695 input_pending = readable_events (0);
2696 if (EVENT_HAS_PARAMETERS (c)
2697 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
2698 internal_last_event_frame = XCAR (XCDR (c));
2699 Vlast_event_frame = internal_last_event_frame;
2703 #ifdef MULTI_KBOARD
2704 /* If current_kboard's side queue is empty check the other kboards.
2705 If one of them has data that we have not yet seen here,
2706 switch to it and process the data waiting for it.
2708 Note: if the events queued up for another kboard
2709 have already been seen here, and therefore are not a complete command,
2710 the kbd_queue_has_data field is 0, so we skip that kboard here.
2711 That's to avoid an infinite loop switching between kboards here. */
2712 if (NILP (c) && !single_kboard)
2714 KBOARD *kb;
2715 for (kb = all_kboards; kb; kb = kb->next_kboard)
2716 if (kb->kbd_queue_has_data)
2718 current_kboard = kb;
2719 /* This is going to exit from read_char
2720 so we had better get rid of this frame's stuff. */
2721 UNGCPRO;
2722 longjmp (wrong_kboard_jmpbuf, 1);
2725 #endif
2727 wrong_kboard:
2729 STOP_POLLING;
2731 /* Finally, we read from the main queue,
2732 and if that gives us something we can't use yet, we put it on the
2733 appropriate side queue and try again. */
2735 if (NILP (c))
2737 KBOARD *kb;
2739 /* Actually read a character, waiting if necessary. */
2740 save_getcjmp (save_jump);
2741 restore_getcjmp (local_getcjmp);
2742 timer_start_idle ();
2743 c = kbd_buffer_get_event (&kb, used_mouse_menu);
2744 restore_getcjmp (save_jump);
2746 #ifdef MULTI_KBOARD
2747 if (! NILP (c) && (kb != current_kboard))
2749 Lisp_Object link = kb->kbd_queue;
2750 if (CONSP (link))
2752 while (CONSP (XCDR (link)))
2753 link = XCDR (link);
2754 if (!NILP (XCDR (link)))
2755 abort ();
2757 if (!CONSP (link))
2758 kb->kbd_queue = Fcons (c, Qnil);
2759 else
2760 XSETCDR (link, Fcons (c, Qnil));
2761 kb->kbd_queue_has_data = 1;
2762 c = Qnil;
2763 if (single_kboard)
2764 goto wrong_kboard;
2765 current_kboard = kb;
2766 /* This is going to exit from read_char
2767 so we had better get rid of this frame's stuff. */
2768 UNGCPRO;
2769 longjmp (wrong_kboard_jmpbuf, 1);
2771 #endif
2774 /* Terminate Emacs in batch mode if at eof. */
2775 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
2776 Fkill_emacs (make_number (1));
2778 if (INTEGERP (c))
2780 /* Add in any extra modifiers, where appropriate. */
2781 if ((extra_keyboard_modifiers & CHAR_CTL)
2782 || ((extra_keyboard_modifiers & 0177) < ' '
2783 && (extra_keyboard_modifiers & 0177) != 0))
2784 XSETINT (c, make_ctrl_char (XINT (c)));
2786 /* Transfer any other modifier bits directly from
2787 extra_keyboard_modifiers to c. Ignore the actual character code
2788 in the low 16 bits of extra_keyboard_modifiers. */
2789 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
2792 non_reread:
2794 /* Record the last idle start time so that we can reset it
2795 should the next event read be a help-echo. */
2796 last_idle_start = timer_idleness_start_time;
2797 timer_stop_idle ();
2798 RESUME_POLLING;
2800 if (NILP (c))
2802 if (commandflag >= 0
2803 && !input_pending && !detect_input_pending_run_timers (0))
2804 redisplay ();
2806 goto wrong_kboard;
2809 non_reread_1:
2811 /* Buffer switch events are only for internal wakeups
2812 so don't show them to the user.
2813 Also, don't record a key if we already did. */
2814 if (BUFFERP (c) || key_already_recorded)
2815 goto exit;
2817 /* Process special events within read_char
2818 and loop around to read another event. */
2819 save = Vquit_flag;
2820 Vquit_flag = Qnil;
2821 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
2822 Vquit_flag = save;
2824 if (!NILP (tem))
2826 int was_locked = single_kboard;
2828 last_input_char = c;
2829 Fcommand_execute (tem, Qnil, Fvector (1, &last_input_char), Qt);
2831 if (CONSP (c) && EQ (XCAR (c), Qselect_window))
2832 /* We stopped being idle for this event; undo that. This
2833 prevents automatic window selection (under
2834 mouse_autoselect_window from acting as a real input event, for
2835 example banishing the mouse under mouse-avoidance-mode. */
2836 timer_idleness_start_time = last_idle_start;
2838 /* Resume allowing input from any kboard, if that was true before. */
2839 if (!was_locked)
2840 any_kboard_state ();
2842 goto retry;
2845 /* Handle things that only apply to characters. */
2846 if (INTEGERP (c))
2848 /* If kbd_buffer_get_event gave us an EOF, return that. */
2849 if (XINT (c) == -1)
2850 goto exit;
2852 if ((STRINGP (Vkeyboard_translate_table)
2853 && SCHARS (Vkeyboard_translate_table) > (unsigned) XFASTINT (c))
2854 || (VECTORP (Vkeyboard_translate_table)
2855 && XVECTOR (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
2856 || (CHAR_TABLE_P (Vkeyboard_translate_table)
2857 && CHAR_VALID_P (XINT (c), 0)))
2859 Lisp_Object d;
2860 d = Faref (Vkeyboard_translate_table, c);
2861 /* nil in keyboard-translate-table means no translation. */
2862 if (!NILP (d))
2863 c = d;
2867 /* If this event is a mouse click in the menu bar,
2868 return just menu-bar for now. Modify the mouse click event
2869 so we won't do this twice, then queue it up. */
2870 if (EVENT_HAS_PARAMETERS (c)
2871 && CONSP (XCDR (c))
2872 && CONSP (EVENT_START (c))
2873 && CONSP (XCDR (EVENT_START (c))))
2875 Lisp_Object posn;
2877 posn = POSN_BUFFER_POSN (EVENT_START (c));
2878 /* Handle menu-bar events:
2879 insert the dummy prefix event `menu-bar'. */
2880 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
2882 /* Change menu-bar to (menu-bar) as the event "position". */
2883 POSN_BUFFER_SET_POSN (EVENT_START (c), Fcons (posn, Qnil));
2885 also_record = c;
2886 Vunread_command_events = Fcons (c, Vunread_command_events);
2887 c = posn;
2891 /* Store these characters into recent_keys, the dribble file if any,
2892 and the keyboard macro being defined, if any. */
2893 record_char (c);
2894 if (! NILP (also_record))
2895 record_char (also_record);
2897 /* Wipe the echo area.
2898 But first, if we are about to use an input method,
2899 save the echo area contents for it to refer to. */
2900 if (INTEGERP (c)
2901 && ! NILP (Vinput_method_function)
2902 && (unsigned) XINT (c) >= ' '
2903 && (unsigned) XINT (c) != 127
2904 && (unsigned) XINT (c) < 256)
2906 previous_echo_area_message = Fcurrent_message ();
2907 Vinput_method_previous_message = previous_echo_area_message;
2910 /* Now wipe the echo area, except for help events which do their
2911 own stuff with the echo area. */
2912 if (!CONSP (c)
2913 || (!(EQ (Qhelp_echo, XCAR (c)))
2914 && !(EQ (Qswitch_frame, XCAR (c)))))
2916 if (!NILP (echo_area_buffer[0]))
2917 safe_run_hooks (Qecho_area_clear_hook);
2918 clear_message (1, 0);
2921 reread_for_input_method:
2922 from_macro:
2923 /* Pass this to the input method, if appropriate. */
2924 if (INTEGERP (c)
2925 && ! NILP (Vinput_method_function)
2926 /* Don't run the input method within a key sequence,
2927 after the first event of the key sequence. */
2928 && NILP (prev_event)
2929 && (unsigned) XINT (c) >= ' '
2930 && (unsigned) XINT (c) != 127
2931 && (unsigned) XINT (c) < 256)
2933 Lisp_Object keys;
2934 int key_count;
2935 struct gcpro gcpro1;
2936 int count = SPECPDL_INDEX ();
2938 /* Save the echo status. */
2939 int saved_immediate_echo = current_kboard->immediate_echo;
2940 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
2941 int saved_echo_after_prompt = current_kboard->echo_after_prompt;
2943 if (before_command_restore_flag)
2945 this_command_key_count = before_command_key_count_1;
2946 if (this_command_key_count < this_single_command_key_start)
2947 this_single_command_key_start = this_command_key_count;
2948 echo_truncate (before_command_echo_length_1);
2949 before_command_restore_flag = 0;
2952 /* Save the this_command_keys status. */
2953 key_count = this_command_key_count;
2955 if (key_count > 0)
2956 keys = Fcopy_sequence (this_command_keys);
2957 else
2958 keys = Qnil;
2959 GCPRO1 (keys);
2961 /* Clear out this_command_keys. */
2962 this_command_key_count = 0;
2964 /* Now wipe the echo area. */
2965 if (!NILP (echo_area_buffer[0]))
2966 safe_run_hooks (Qecho_area_clear_hook);
2967 clear_message (1, 0);
2968 echo_truncate (0);
2970 /* If we are not reading a key sequence,
2971 never use the echo area. */
2972 if (maps == 0)
2974 specbind (Qinput_method_use_echo_area, Qt);
2977 /* Call the input method. */
2978 tem = call1 (Vinput_method_function, c);
2980 tem = unbind_to (count, tem);
2982 /* Restore the saved echoing state
2983 and this_command_keys state. */
2984 this_command_key_count = key_count;
2985 if (key_count > 0)
2986 this_command_keys = keys;
2988 cancel_echoing ();
2989 ok_to_echo_at_next_pause = saved_ok_to_echo;
2990 current_kboard->echo_after_prompt = saved_echo_after_prompt;
2991 if (saved_immediate_echo)
2992 echo_now ();
2994 UNGCPRO;
2996 /* The input method can return no events. */
2997 if (! CONSP (tem))
2999 /* Bring back the previous message, if any. */
3000 if (! NILP (previous_echo_area_message))
3001 message_with_string ("%s", previous_echo_area_message, 0);
3002 goto retry;
3004 /* It returned one event or more. */
3005 c = XCAR (tem);
3006 Vunread_post_input_method_events
3007 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
3010 reread_first:
3012 /* Display help if not echoing. */
3013 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
3015 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
3016 Lisp_Object help, object, position, window, tem;
3018 tem = Fcdr (XCDR (c));
3019 help = Fcar (tem);
3020 tem = Fcdr (tem);
3021 window = Fcar (tem);
3022 tem = Fcdr (tem);
3023 object = Fcar (tem);
3024 tem = Fcdr (tem);
3025 position = Fcar (tem);
3027 show_help_echo (help, window, object, position, 0);
3029 /* We stopped being idle for this event; undo that. */
3030 timer_idleness_start_time = last_idle_start;
3031 goto retry;
3034 if (this_command_key_count == 0 || ! reread)
3036 before_command_key_count = this_command_key_count;
3037 before_command_echo_length = echo_length ();
3039 /* Don't echo mouse motion events. */
3040 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
3041 && NILP (Fzerop (Vecho_keystrokes))
3042 && ! (EVENT_HAS_PARAMETERS (c)
3043 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
3045 echo_char (c);
3046 if (! NILP (also_record))
3047 echo_char (also_record);
3048 /* Once we reread a character, echoing can happen
3049 the next time we pause to read a new one. */
3050 ok_to_echo_at_next_pause = current_kboard;
3053 /* Record this character as part of the current key. */
3054 add_command_key (c);
3055 if (! NILP (also_record))
3056 add_command_key (also_record);
3059 last_input_char = c;
3060 num_input_events++;
3062 /* Process the help character specially if enabled */
3063 if (!NILP (Vhelp_form) && help_char_p (c))
3065 Lisp_Object tem0;
3066 count = SPECPDL_INDEX ();
3068 record_unwind_protect (Fset_window_configuration,
3069 Fcurrent_window_configuration (Qnil));
3071 tem0 = Feval (Vhelp_form);
3072 if (STRINGP (tem0))
3073 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
3075 cancel_echoing ();
3077 c = read_char (0, 0, 0, Qnil, 0);
3078 while (BUFFERP (c));
3079 /* Remove the help from the frame */
3080 unbind_to (count, Qnil);
3082 redisplay ();
3083 if (EQ (c, make_number (040)))
3085 cancel_echoing ();
3087 c = read_char (0, 0, 0, Qnil, 0);
3088 while (BUFFERP (c));
3092 exit:
3093 RESUME_POLLING;
3094 RETURN_UNGCPRO (c);
3097 /* Record a key that came from a mouse menu.
3098 Record it for echoing, for this-command-keys, and so on. */
3100 static void
3101 record_menu_key (c)
3102 Lisp_Object c;
3104 /* Wipe the echo area. */
3105 clear_message (1, 0);
3107 record_char (c);
3109 before_command_key_count = this_command_key_count;
3110 before_command_echo_length = echo_length ();
3112 /* Don't echo mouse motion events. */
3113 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
3114 && NILP (Fzerop (Vecho_keystrokes)))
3116 echo_char (c);
3118 /* Once we reread a character, echoing can happen
3119 the next time we pause to read a new one. */
3120 ok_to_echo_at_next_pause = 0;
3123 /* Record this character as part of the current key. */
3124 add_command_key (c);
3126 /* Re-reading in the middle of a command */
3127 last_input_char = c;
3128 num_input_events++;
3131 /* Return 1 if should recognize C as "the help character". */
3134 help_char_p (c)
3135 Lisp_Object c;
3137 Lisp_Object tail;
3139 if (EQ (c, Vhelp_char))
3140 return 1;
3141 for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
3142 if (EQ (c, XCAR (tail)))
3143 return 1;
3144 return 0;
3147 /* Record the input event C in various ways. */
3149 static void
3150 record_char (c)
3151 Lisp_Object c;
3153 int recorded = 0;
3155 if (CONSP (c) && (EQ (XCAR (c), Qhelp_echo) || EQ (XCAR (c), Qmouse_movement)))
3157 /* To avoid filling recent_keys with help-echo and mouse-movement
3158 events, we filter out repeated help-echo events, only store the
3159 first and last in a series of mouse-movement events, and don't
3160 store repeated help-echo events which are only separated by
3161 mouse-movement events. */
3163 Lisp_Object ev1, ev2, ev3;
3164 int ix1, ix2, ix3;
3166 if ((ix1 = recent_keys_index - 1) < 0)
3167 ix1 = NUM_RECENT_KEYS - 1;
3168 ev1 = AREF (recent_keys, ix1);
3170 if ((ix2 = ix1 - 1) < 0)
3171 ix2 = NUM_RECENT_KEYS - 1;
3172 ev2 = AREF (recent_keys, ix2);
3174 if ((ix3 = ix2 - 1) < 0)
3175 ix3 = NUM_RECENT_KEYS - 1;
3176 ev3 = AREF (recent_keys, ix3);
3178 if (EQ (XCAR (c), Qhelp_echo))
3180 /* Don't record `help-echo' in recent_keys unless it shows some help
3181 message, and a different help than the previously recorded
3182 event. */
3183 Lisp_Object help, last_help;
3185 help = Fcar_safe (Fcdr_safe (XCDR (c)));
3186 if (!STRINGP (help))
3187 recorded = 1;
3188 else if (CONSP (ev1) && EQ (XCAR (ev1), Qhelp_echo)
3189 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev1))), EQ (last_help, help)))
3190 recorded = 1;
3191 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3192 && CONSP (ev2) && EQ (XCAR (ev2), Qhelp_echo)
3193 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev2))), EQ (last_help, help)))
3194 recorded = -1;
3195 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3196 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3197 && CONSP (ev3) && EQ (XCAR (ev3), Qhelp_echo)
3198 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev3))), EQ (last_help, help)))
3199 recorded = -2;
3201 else if (EQ (XCAR (c), Qmouse_movement))
3203 /* Only record one pair of `mouse-movement' on a window in recent_keys.
3204 So additional mouse movement events replace the last element. */
3205 Lisp_Object last_window, window;
3207 window = Fcar_safe (Fcar_safe (XCDR (c)));
3208 if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3209 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev1))), EQ (last_window, window))
3210 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3211 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev2))), EQ (last_window, window)))
3213 ASET (recent_keys, ix1, c);
3214 recorded = 1;
3218 else
3219 store_kbd_macro_char (c);
3221 if (!recorded)
3223 total_keys++;
3224 ASET (recent_keys, recent_keys_index, c);
3225 if (++recent_keys_index >= NUM_RECENT_KEYS)
3226 recent_keys_index = 0;
3228 else if (recorded < 0)
3230 /* We need to remove one or two events from recent_keys.
3231 To do this, we simply put nil at those events and move the
3232 recent_keys_index backwards over those events. Usually,
3233 users will never see those nil events, as they will be
3234 overwritten by the command keys entered to see recent_keys
3235 (e.g. C-h l). */
3237 while (recorded++ < 0 && total_keys > 0)
3239 if (total_keys < NUM_RECENT_KEYS)
3240 total_keys--;
3241 if (--recent_keys_index < 0)
3242 recent_keys_index = NUM_RECENT_KEYS - 1;
3243 ASET (recent_keys, recent_keys_index, Qnil);
3247 num_nonmacro_input_events++;
3249 /* Write c to the dribble file. If c is a lispy event, write
3250 the event's symbol to the dribble file, in <brackets>. Bleaugh.
3251 If you, dear reader, have a better idea, you've got the source. :-) */
3252 if (dribble)
3254 if (INTEGERP (c))
3256 if (XUINT (c) < 0x100)
3257 putc (XINT (c), dribble);
3258 else
3259 fprintf (dribble, " 0x%x", (int) XUINT (c));
3261 else
3263 Lisp_Object dribblee;
3265 /* If it's a structured event, take the event header. */
3266 dribblee = EVENT_HEAD (c);
3268 if (SYMBOLP (dribblee))
3270 putc ('<', dribble);
3271 fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
3272 SBYTES (SYMBOL_NAME (dribblee)),
3273 dribble);
3274 putc ('>', dribble);
3278 fflush (dribble);
3282 Lisp_Object
3283 print_help (object)
3284 Lisp_Object object;
3286 struct buffer *old = current_buffer;
3287 Fprinc (object, Qnil);
3288 set_buffer_internal (XBUFFER (Vstandard_output));
3289 call0 (intern ("help-mode"));
3290 set_buffer_internal (old);
3291 return Qnil;
3294 /* Copy out or in the info on where C-g should throw to.
3295 This is used when running Lisp code from within get_char,
3296 in case get_char is called recursively.
3297 See read_process_output. */
3299 static void
3300 save_getcjmp (temp)
3301 jmp_buf temp;
3303 bcopy (getcjmp, temp, sizeof getcjmp);
3306 static void
3307 restore_getcjmp (temp)
3308 jmp_buf temp;
3310 bcopy (temp, getcjmp, sizeof getcjmp);
3313 #ifdef HAVE_MOUSE
3315 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
3316 of this function. */
3318 static Lisp_Object
3319 tracking_off (old_value)
3320 Lisp_Object old_value;
3322 do_mouse_tracking = old_value;
3323 if (NILP (old_value))
3325 /* Redisplay may have been preempted because there was input
3326 available, and it assumes it will be called again after the
3327 input has been processed. If the only input available was
3328 the sort that we have just disabled, then we need to call
3329 redisplay. */
3330 if (!readable_events (1))
3332 redisplay_preserve_echo_area (6);
3333 get_input_pending (&input_pending, 1);
3336 return Qnil;
3339 DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
3340 doc: /* Evaluate BODY with mouse movement events enabled.
3341 Within a `track-mouse' form, mouse motion generates input events that
3342 you can read with `read-event'.
3343 Normally, mouse motion is ignored.
3344 usage: (track-mouse BODY ...) */)
3345 (args)
3346 Lisp_Object args;
3348 int count = SPECPDL_INDEX ();
3349 Lisp_Object val;
3351 record_unwind_protect (tracking_off, do_mouse_tracking);
3353 do_mouse_tracking = Qt;
3355 val = Fprogn (args);
3356 return unbind_to (count, val);
3359 /* If mouse has moved on some frame, return one of those frames.
3360 Return 0 otherwise. */
3362 static FRAME_PTR
3363 some_mouse_moved ()
3365 Lisp_Object tail, frame;
3367 FOR_EACH_FRAME (tail, frame)
3369 if (XFRAME (frame)->mouse_moved)
3370 return XFRAME (frame);
3373 return 0;
3376 #endif /* HAVE_MOUSE */
3378 /* Low level keyboard/mouse input.
3379 kbd_buffer_store_event places events in kbd_buffer, and
3380 kbd_buffer_get_event retrieves them. */
3382 /* Return true iff there are any events in the queue that read-char
3383 would return. If this returns false, a read-char would block. */
3384 static int
3385 readable_filtered_events (do_timers_now, filter_events)
3386 int do_timers_now;
3387 int filter_events;
3389 if (do_timers_now)
3390 timer_check (do_timers_now);
3392 /* If the buffer contains only FOCUS_IN_EVENT events,
3393 and FILTER_EVENTS is nonzero, report it as empty. */
3394 if (kbd_fetch_ptr != kbd_store_ptr)
3396 int have_live_event = 1;
3398 if (filter_events)
3400 struct input_event *event;
3402 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3403 ? kbd_fetch_ptr
3404 : kbd_buffer);
3406 while (have_live_event && event->kind == FOCUS_IN_EVENT)
3408 event++;
3409 if (event == kbd_buffer + KBD_BUFFER_SIZE)
3410 event = kbd_buffer;
3411 if (event == kbd_store_ptr)
3412 have_live_event = 0;
3415 if (have_live_event) return 1;
3418 #ifdef HAVE_MOUSE
3419 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3420 return 1;
3421 #endif
3422 if (single_kboard)
3424 if (current_kboard->kbd_queue_has_data)
3425 return 1;
3427 else
3429 KBOARD *kb;
3430 for (kb = all_kboards; kb; kb = kb->next_kboard)
3431 if (kb->kbd_queue_has_data)
3432 return 1;
3434 return 0;
3437 /* Return true iff there are any events in the queue that read-char
3438 would return. If this returns false, a read-char would block. */
3439 static int
3440 readable_events (do_timers_now)
3441 int do_timers_now;
3443 return readable_filtered_events (do_timers_now, 0);
3446 /* Set this for debugging, to have a way to get out */
3447 int stop_character;
3449 #ifdef MULTI_KBOARD
3450 static KBOARD *
3451 event_to_kboard (event)
3452 struct input_event *event;
3454 Lisp_Object frame;
3455 frame = event->frame_or_window;
3456 if (CONSP (frame))
3457 frame = XCAR (frame);
3458 else if (WINDOWP (frame))
3459 frame = WINDOW_FRAME (XWINDOW (frame));
3461 /* There are still some events that don't set this field.
3462 For now, just ignore the problem.
3463 Also ignore dead frames here. */
3464 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
3465 return 0;
3466 else
3467 return FRAME_KBOARD (XFRAME (frame));
3469 #endif
3471 /* Store an event obtained at interrupt level into kbd_buffer, fifo */
3473 void
3474 kbd_buffer_store_event (event)
3475 register struct input_event *event;
3477 if (event->kind == NO_EVENT)
3478 abort ();
3480 if (event->kind == ASCII_KEYSTROKE_EVENT)
3482 register int c = event->code & 0377;
3484 if (event->modifiers & ctrl_modifier)
3485 c = make_ctrl_char (c);
3487 c |= (event->modifiers
3488 & (meta_modifier | alt_modifier
3489 | hyper_modifier | super_modifier));
3491 if (c == quit_char)
3493 #ifdef MULTI_KBOARD
3494 KBOARD *kb;
3495 struct input_event *sp;
3497 if (single_kboard
3498 && (kb = FRAME_KBOARD (XFRAME (event->frame_or_window)),
3499 kb != current_kboard))
3501 kb->kbd_queue
3502 = Fcons (make_lispy_switch_frame (event->frame_or_window),
3503 Fcons (make_number (c), Qnil));
3504 kb->kbd_queue_has_data = 1;
3505 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3507 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3508 sp = kbd_buffer;
3510 if (event_to_kboard (sp) == kb)
3512 sp->kind = NO_EVENT;
3513 sp->frame_or_window = Qnil;
3514 sp->arg = Qnil;
3517 return;
3519 #endif
3521 /* If this results in a quit_char being returned to Emacs as
3522 input, set Vlast_event_frame properly. If this doesn't
3523 get returned to Emacs as an event, the next event read
3524 will set Vlast_event_frame again, so this is safe to do. */
3526 Lisp_Object focus;
3528 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
3529 if (NILP (focus))
3530 focus = event->frame_or_window;
3531 internal_last_event_frame = focus;
3532 Vlast_event_frame = focus;
3535 last_event_timestamp = event->timestamp;
3536 interrupt_signal (0 /* dummy */);
3537 return;
3540 if (c && c == stop_character)
3542 sys_suspend ();
3543 return;
3546 /* Don't insert two BUFFER_SWITCH_EVENT's in a row.
3547 Just ignore the second one. */
3548 else if (event->kind == BUFFER_SWITCH_EVENT
3549 && kbd_fetch_ptr != kbd_store_ptr
3550 && kbd_store_ptr->kind == BUFFER_SWITCH_EVENT)
3551 return;
3553 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
3554 kbd_store_ptr = kbd_buffer;
3556 /* Don't let the very last slot in the buffer become full,
3557 since that would make the two pointers equal,
3558 and that is indistinguishable from an empty buffer.
3559 Discard the event if it would fill the last slot. */
3560 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3562 int idx;
3564 #if 0 /* The SELECTION_REQUEST_EVENT case looks bogus, and it's error
3565 prone to assign individual members for other events, in case
3566 the input_event structure is changed. --2000-07-13, gerd. */
3567 struct input_event *sp = kbd_store_ptr;
3568 sp->kind = event->kind;
3569 if (event->kind == SELECTION_REQUEST_EVENT)
3571 /* We must not use the ordinary copying code for this case,
3572 since `part' is an enum and copying it might not copy enough
3573 in this case. */
3574 bcopy (event, (char *) sp, sizeof (*event));
3576 else
3579 sp->code = event->code;
3580 sp->part = event->part;
3581 sp->frame_or_window = event->frame_or_window;
3582 sp->arg = event->arg;
3583 sp->modifiers = event->modifiers;
3584 sp->x = event->x;
3585 sp->y = event->y;
3586 sp->timestamp = event->timestamp;
3588 #else
3589 *kbd_store_ptr = *event;
3590 #endif
3592 idx = 2 * (kbd_store_ptr - kbd_buffer);
3593 ASET (kbd_buffer_gcpro, idx, event->frame_or_window);
3594 ASET (kbd_buffer_gcpro, idx + 1, event->arg);
3595 ++kbd_store_ptr;
3600 /* Generate HELP_EVENT input_events in BUFP which has room for
3601 SIZE events. If there's not enough room in BUFP, ignore this
3602 event.
3604 HELP is the help form.
3606 FRAME is the frame on which the help is generated. OBJECT is the
3607 Lisp object where the help was found (a buffer, a string, an
3608 overlay, or nil if neither from a string nor from a buffer. POS is
3609 the position within OBJECT where the help was found.
3611 Value is the number of input_events generated. */
3614 gen_help_event (bufp, size, help, frame, window, object, pos)
3615 struct input_event *bufp;
3616 int size;
3617 Lisp_Object help, frame, object, window;
3618 int pos;
3620 if (size >= 1)
3622 bufp->kind = HELP_EVENT;
3623 bufp->frame_or_window = frame;
3624 bufp->arg = object;
3625 bufp->x = WINDOWP (window) ? window : frame;
3626 bufp->y = help;
3627 bufp->code = pos;
3628 return 1;
3630 return 0;
3634 /* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3636 void
3637 kbd_buffer_store_help_event (frame, help)
3638 Lisp_Object frame, help;
3640 struct input_event event;
3642 event.kind = HELP_EVENT;
3643 event.frame_or_window = frame;
3644 event.arg = Qnil;
3645 event.x = Qnil;
3646 event.y = help;
3647 event.code = 0;
3648 kbd_buffer_store_event (&event);
3652 /* Discard any mouse events in the event buffer by setting them to
3653 NO_EVENT. */
3654 void
3655 discard_mouse_events ()
3657 struct input_event *sp;
3658 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3660 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3661 sp = kbd_buffer;
3663 if (sp->kind == MOUSE_CLICK_EVENT
3664 #ifdef WINDOWSNT
3665 || sp->kind == W32_SCROLL_BAR_CLICK_EVENT
3666 #endif
3667 || sp->kind == SCROLL_BAR_CLICK_EVENT)
3669 sp->kind = NO_EVENT;
3675 /* Return non-zero if there are any real events waiting in the event
3676 buffer, not counting `NO_EVENT's.
3678 If DISCARD is non-zero, discard NO_EVENT events at the front of
3679 the input queue, possibly leaving the input queue empty if there
3680 are no real input events. */
3683 kbd_buffer_events_waiting (discard)
3684 int discard;
3686 struct input_event *sp;
3688 for (sp = kbd_fetch_ptr;
3689 sp != kbd_store_ptr && sp->kind == NO_EVENT;
3690 ++sp)
3692 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3693 sp = kbd_buffer;
3696 if (discard)
3697 kbd_fetch_ptr = sp;
3699 return sp != kbd_store_ptr && sp->kind != NO_EVENT;
3703 /* Clear input event EVENT. */
3705 static INLINE void
3706 clear_event (event)
3707 struct input_event *event;
3709 int idx = 2 * (event - kbd_buffer);
3710 ASET (kbd_buffer_gcpro, idx, Qnil);
3711 ASET (kbd_buffer_gcpro, idx + 1, Qnil);
3712 event->kind = NO_EVENT;
3716 /* Read one event from the event buffer, waiting if necessary.
3717 The value is a Lisp object representing the event.
3718 The value is nil for an event that should be ignored,
3719 or that was handled here.
3720 We always read and discard one event. */
3722 static Lisp_Object
3723 kbd_buffer_get_event (kbp, used_mouse_menu)
3724 KBOARD **kbp;
3725 int *used_mouse_menu;
3727 register int c;
3728 Lisp_Object obj;
3730 if (noninteractive)
3732 c = getchar ();
3733 XSETINT (obj, c);
3734 *kbp = current_kboard;
3735 return obj;
3738 /* Wait until there is input available. */
3739 for (;;)
3741 if (kbd_fetch_ptr != kbd_store_ptr)
3742 break;
3743 #ifdef HAVE_MOUSE
3744 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3745 break;
3746 #endif
3748 /* If the quit flag is set, then read_char will return
3749 quit_char, so that counts as "available input." */
3750 if (!NILP (Vquit_flag))
3751 quit_throw_to_read_char ();
3753 /* One way or another, wait until input is available; then, if
3754 interrupt handlers have not read it, read it now. */
3756 #ifdef OLDVMS
3757 wait_for_kbd_input ();
3758 #else
3759 /* Note SIGIO has been undef'd if FIONREAD is missing. */
3760 #ifdef SIGIO
3761 gobble_input (0);
3762 #endif /* SIGIO */
3763 if (kbd_fetch_ptr != kbd_store_ptr)
3764 break;
3765 #ifdef HAVE_MOUSE
3766 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3767 break;
3768 #endif
3770 Lisp_Object minus_one;
3772 XSETINT (minus_one, -1);
3773 wait_reading_process_input (0, 0, minus_one, 1);
3775 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
3776 /* Pass 1 for EXPECT since we just waited to have input. */
3777 read_avail_input (1);
3779 #endif /* not VMS */
3782 if (CONSP (Vunread_command_events))
3784 Lisp_Object first;
3785 first = XCAR (Vunread_command_events);
3786 Vunread_command_events = XCDR (Vunread_command_events);
3787 *kbp = current_kboard;
3788 return first;
3791 /* At this point, we know that there is a readable event available
3792 somewhere. If the event queue is empty, then there must be a
3793 mouse movement enabled and available. */
3794 if (kbd_fetch_ptr != kbd_store_ptr)
3796 struct input_event *event;
3798 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3799 ? kbd_fetch_ptr
3800 : kbd_buffer);
3802 last_event_timestamp = event->timestamp;
3804 #ifdef MULTI_KBOARD
3805 *kbp = event_to_kboard (event);
3806 if (*kbp == 0)
3807 *kbp = current_kboard; /* Better than returning null ptr? */
3808 #else
3809 *kbp = &the_only_kboard;
3810 #endif
3812 obj = Qnil;
3814 /* These two kinds of events get special handling
3815 and don't actually appear to the command loop.
3816 We return nil for them. */
3817 if (event->kind == SELECTION_REQUEST_EVENT)
3819 #ifdef HAVE_X11
3820 struct input_event copy;
3822 /* Remove it from the buffer before processing it,
3823 since otherwise swallow_events will see it
3824 and process it again. */
3825 copy = *event;
3826 kbd_fetch_ptr = event + 1;
3827 input_pending = readable_events (0);
3828 x_handle_selection_request (&copy);
3829 #else
3830 /* We're getting selection request events, but we don't have
3831 a window system. */
3832 abort ();
3833 #endif
3836 else if (event->kind == SELECTION_CLEAR_EVENT)
3838 #ifdef HAVE_X11
3839 struct input_event copy;
3841 /* Remove it from the buffer before processing it. */
3842 copy = *event;
3843 kbd_fetch_ptr = event + 1;
3844 input_pending = readable_events (0);
3845 x_handle_selection_clear (&copy);
3846 #else
3847 /* We're getting selection request events, but we don't have
3848 a window system. */
3849 abort ();
3850 #endif
3852 #if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (MAC_OS)
3853 else if (event->kind == DELETE_WINDOW_EVENT)
3855 /* Make an event (delete-frame (FRAME)). */
3856 obj = Fcons (event->frame_or_window, Qnil);
3857 obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
3858 kbd_fetch_ptr = event + 1;
3860 #endif
3861 #if defined (HAVE_X11) || defined (HAVE_NTGUI)
3862 else if (event->kind == ICONIFY_EVENT)
3864 /* Make an event (iconify-frame (FRAME)). */
3865 obj = Fcons (event->frame_or_window, Qnil);
3866 obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
3867 kbd_fetch_ptr = event + 1;
3869 else if (event->kind == DEICONIFY_EVENT)
3871 /* Make an event (make-frame-visible (FRAME)). */
3872 obj = Fcons (event->frame_or_window, Qnil);
3873 obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
3874 kbd_fetch_ptr = event + 1;
3876 #endif
3877 else if (event->kind == BUFFER_SWITCH_EVENT)
3879 /* The value doesn't matter here; only the type is tested. */
3880 XSETBUFFER (obj, current_buffer);
3881 kbd_fetch_ptr = event + 1;
3883 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
3884 || defined (USE_GTK)
3885 else if (event->kind == MENU_BAR_ACTIVATE_EVENT)
3887 kbd_fetch_ptr = event + 1;
3888 input_pending = readable_events (0);
3889 if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
3890 x_activate_menubar (XFRAME (event->frame_or_window));
3892 #endif
3893 #ifdef WINDOWSNT
3894 else if (event->kind == LANGUAGE_CHANGE_EVENT)
3896 /* Make an event (language-change (FRAME CHARSET LCID)). */
3897 obj = Fcons (event->modifiers, Qnil);
3898 obj = Fcons (event->code, obj);
3899 obj = Fcons (event->frame_or_window, obj);
3900 obj = Fcons (Qlanguage_change, Fcons (obj, Qnil));
3901 kbd_fetch_ptr = event + 1;
3903 #endif
3904 else if (event->kind == SAVE_SESSION_EVENT)
3906 obj = Fcons (Qsave_session, Qnil);
3907 kbd_fetch_ptr = event + 1;
3909 /* Just discard these, by returning nil.
3910 With MULTI_KBOARD, these events are used as placeholders
3911 when we need to randomly delete events from the queue.
3912 (They shouldn't otherwise be found in the buffer,
3913 but on some machines it appears they do show up
3914 even without MULTI_KBOARD.) */
3915 /* On Windows NT/9X, NO_EVENT is used to delete extraneous
3916 mouse events during a popup-menu call. */
3917 else if (event->kind == NO_EVENT)
3918 kbd_fetch_ptr = event + 1;
3919 else if (event->kind == HELP_EVENT)
3921 Lisp_Object object, position, help, frame, window;
3923 frame = event->frame_or_window;
3924 object = event->arg;
3925 position = make_number (event->code);
3926 window = event->x;
3927 help = event->y;
3928 clear_event (event);
3930 kbd_fetch_ptr = event + 1;
3931 if (!WINDOWP (window))
3932 window = Qnil;
3933 obj = Fcons (Qhelp_echo,
3934 list5 (frame, help, window, object, position));
3936 else if (event->kind == FOCUS_IN_EVENT)
3938 /* Notification of a FocusIn event. The frame receiving the
3939 focus is in event->frame_or_window. Generate a
3940 switch-frame event if necessary. */
3941 Lisp_Object frame, focus;
3943 frame = event->frame_or_window;
3944 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
3945 if (FRAMEP (focus))
3946 frame = focus;
3948 if (!EQ (frame, internal_last_event_frame)
3949 && !EQ (frame, selected_frame))
3950 obj = make_lispy_switch_frame (frame);
3951 internal_last_event_frame = frame;
3952 kbd_fetch_ptr = event + 1;
3954 else if (event->kind == SELECT_WINDOW_EVENT)
3956 /* Make an event (select-window (WINDOW)). */
3957 obj = Fcons (event->frame_or_window, Qnil);
3958 obj = Fcons (Qselect_window, Fcons (obj, Qnil));
3960 kbd_fetch_ptr = event + 1;
3962 else
3964 /* If this event is on a different frame, return a switch-frame this
3965 time, and leave the event in the queue for next time. */
3966 Lisp_Object frame;
3967 Lisp_Object focus;
3969 frame = event->frame_or_window;
3970 if (CONSP (frame))
3971 frame = XCAR (frame);
3972 else if (WINDOWP (frame))
3973 frame = WINDOW_FRAME (XWINDOW (frame));
3975 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
3976 if (! NILP (focus))
3977 frame = focus;
3979 if (! EQ (frame, internal_last_event_frame)
3980 && !EQ (frame, selected_frame))
3981 obj = make_lispy_switch_frame (frame);
3982 internal_last_event_frame = frame;
3984 /* If we didn't decide to make a switch-frame event, go ahead
3985 and build a real event from the queue entry. */
3987 if (NILP (obj))
3989 obj = make_lispy_event (event);
3991 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined(MAC_OS) \
3992 || defined (USE_GTK)
3993 /* If this was a menu selection, then set the flag to inhibit
3994 writing to last_nonmenu_event. Don't do this if the event
3995 we're returning is (menu-bar), though; that indicates the
3996 beginning of the menu sequence, and we might as well leave
3997 that as the `event with parameters' for this selection. */
3998 if (used_mouse_menu
3999 && !EQ (event->frame_or_window, event->arg)
4000 && (event->kind == MENU_BAR_EVENT
4001 || event->kind == TOOL_BAR_EVENT))
4002 *used_mouse_menu = 1;
4003 #endif
4005 /* Wipe out this event, to catch bugs. */
4006 clear_event (event);
4007 kbd_fetch_ptr = event + 1;
4011 #ifdef HAVE_MOUSE
4012 /* Try generating a mouse motion event. */
4013 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
4015 FRAME_PTR f = some_mouse_moved ();
4016 Lisp_Object bar_window;
4017 enum scroll_bar_part part;
4018 Lisp_Object x, y;
4019 unsigned long time;
4021 *kbp = current_kboard;
4022 /* Note that this uses F to determine which display to look at.
4023 If there is no valid info, it does not store anything
4024 so x remains nil. */
4025 x = Qnil;
4026 (*mouse_position_hook) (&f, 0, &bar_window, &part, &x, &y, &time);
4028 obj = Qnil;
4030 /* Decide if we should generate a switch-frame event. Don't
4031 generate switch-frame events for motion outside of all Emacs
4032 frames. */
4033 if (!NILP (x) && f)
4035 Lisp_Object frame;
4037 frame = FRAME_FOCUS_FRAME (f);
4038 if (NILP (frame))
4039 XSETFRAME (frame, f);
4041 if (! EQ (frame, internal_last_event_frame)
4042 && !EQ (frame, selected_frame))
4043 obj = make_lispy_switch_frame (frame);
4044 internal_last_event_frame = frame;
4047 /* If we didn't decide to make a switch-frame event, go ahead and
4048 return a mouse-motion event. */
4049 if (!NILP (x) && NILP (obj))
4050 obj = make_lispy_movement (f, bar_window, part, x, y, time);
4052 #endif /* HAVE_MOUSE */
4053 else
4054 /* We were promised by the above while loop that there was
4055 something for us to read! */
4056 abort ();
4058 input_pending = readable_events (0);
4060 Vlast_event_frame = internal_last_event_frame;
4062 return (obj);
4065 /* Process any events that are not user-visible,
4066 then return, without reading any user-visible events. */
4068 void
4069 swallow_events (do_display)
4070 int do_display;
4072 int old_timers_run;
4074 while (kbd_fetch_ptr != kbd_store_ptr)
4076 struct input_event *event;
4078 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
4079 ? kbd_fetch_ptr
4080 : kbd_buffer);
4082 last_event_timestamp = event->timestamp;
4084 /* These two kinds of events get special handling
4085 and don't actually appear to the command loop. */
4086 if (event->kind == SELECTION_REQUEST_EVENT)
4088 #ifdef HAVE_X11
4089 struct input_event copy;
4091 /* Remove it from the buffer before processing it,
4092 since otherwise swallow_events called recursively could see it
4093 and process it again. */
4094 copy = *event;
4095 kbd_fetch_ptr = event + 1;
4096 input_pending = readable_events (0);
4097 x_handle_selection_request (&copy);
4098 #else
4099 /* We're getting selection request events, but we don't have
4100 a window system. */
4101 abort ();
4102 #endif
4105 else if (event->kind == SELECTION_CLEAR_EVENT)
4107 #ifdef HAVE_X11
4108 struct input_event copy;
4110 /* Remove it from the buffer before processing it, */
4111 copy = *event;
4113 kbd_fetch_ptr = event + 1;
4114 input_pending = readable_events (0);
4115 x_handle_selection_clear (&copy);
4116 #else
4117 /* We're getting selection request events, but we don't have
4118 a window system. */
4119 abort ();
4120 #endif
4122 else
4123 break;
4126 old_timers_run = timers_run;
4127 get_input_pending (&input_pending, 1);
4129 if (timers_run != old_timers_run && do_display)
4130 redisplay_preserve_echo_area (7);
4133 /* Record the start of when Emacs is idle,
4134 for the sake of running idle-time timers. */
4136 void
4137 timer_start_idle ()
4139 Lisp_Object timers;
4141 /* If we are already in the idle state, do nothing. */
4142 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4143 return;
4145 EMACS_GET_TIME (timer_idleness_start_time);
4147 timer_last_idleness_start_time = timer_idleness_start_time;
4149 /* Mark all idle-time timers as once again candidates for running. */
4150 for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers))
4152 Lisp_Object timer;
4154 timer = XCAR (timers);
4156 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4157 continue;
4158 XVECTOR (timer)->contents[0] = Qnil;
4162 /* Record that Emacs is no longer idle, so stop running idle-time timers. */
4164 void
4165 timer_stop_idle ()
4167 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
4170 /* This is only for debugging. */
4171 struct input_event last_timer_event;
4173 /* Check whether a timer has fired. To prevent larger problems we simply
4174 disregard elements that are not proper timers. Do not make a circular
4175 timer list for the time being.
4177 Returns the number of seconds to wait until the next timer fires. If a
4178 timer is triggering now, return zero seconds.
4179 If no timer is active, return -1 seconds.
4181 If a timer is ripe, we run it, with quitting turned off.
4183 DO_IT_NOW is now ignored. It used to mean that we should
4184 run the timer directly instead of queueing a timer-event.
4185 Now we always run timers directly. */
4187 EMACS_TIME
4188 timer_check (do_it_now)
4189 int do_it_now;
4191 EMACS_TIME nexttime;
4192 EMACS_TIME now, idleness_now;
4193 Lisp_Object timers, idle_timers, chosen_timer;
4194 struct gcpro gcpro1, gcpro2, gcpro3;
4196 EMACS_SET_SECS (nexttime, -1);
4197 EMACS_SET_USECS (nexttime, -1);
4199 /* Always consider the ordinary timers. */
4200 timers = Vtimer_list;
4201 /* Consider the idle timers only if Emacs is idle. */
4202 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4203 idle_timers = Vtimer_idle_list;
4204 else
4205 idle_timers = Qnil;
4206 chosen_timer = Qnil;
4207 GCPRO3 (timers, idle_timers, chosen_timer);
4209 if (CONSP (timers) || CONSP (idle_timers))
4211 EMACS_GET_TIME (now);
4212 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4213 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
4216 while (CONSP (timers) || CONSP (idle_timers))
4218 Lisp_Object *vector;
4219 Lisp_Object timer = Qnil, idle_timer = Qnil;
4220 EMACS_TIME timer_time, idle_timer_time;
4221 EMACS_TIME difference, timer_difference, idle_timer_difference;
4223 /* Skip past invalid timers and timers already handled. */
4224 if (!NILP (timers))
4226 timer = XCAR (timers);
4227 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4229 timers = XCDR (timers);
4230 continue;
4232 vector = XVECTOR (timer)->contents;
4234 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
4235 || !INTEGERP (vector[3])
4236 || ! NILP (vector[0]))
4238 timers = XCDR (timers);
4239 continue;
4242 if (!NILP (idle_timers))
4244 timer = XCAR (idle_timers);
4245 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4247 idle_timers = XCDR (idle_timers);
4248 continue;
4250 vector = XVECTOR (timer)->contents;
4252 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
4253 || !INTEGERP (vector[3])
4254 || ! NILP (vector[0]))
4256 idle_timers = XCDR (idle_timers);
4257 continue;
4261 /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
4262 based on the next ordinary timer.
4263 TIMER_DIFFERENCE is the distance in time from NOW to when
4264 this timer becomes ripe (negative if it's already ripe). */
4265 if (!NILP (timers))
4267 timer = XCAR (timers);
4268 vector = XVECTOR (timer)->contents;
4269 EMACS_SET_SECS (timer_time,
4270 (XINT (vector[1]) << 16) | (XINT (vector[2])));
4271 EMACS_SET_USECS (timer_time, XINT (vector[3]));
4272 EMACS_SUB_TIME (timer_difference, timer_time, now);
4275 /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
4276 based on the next idle timer. */
4277 if (!NILP (idle_timers))
4279 idle_timer = XCAR (idle_timers);
4280 vector = XVECTOR (idle_timer)->contents;
4281 EMACS_SET_SECS (idle_timer_time,
4282 (XINT (vector[1]) << 16) | (XINT (vector[2])));
4283 EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
4284 EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
4287 /* Decide which timer is the next timer,
4288 and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
4289 Also step down the list where we found that timer. */
4291 if (! NILP (timers) && ! NILP (idle_timers))
4293 EMACS_TIME temp;
4294 EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
4295 if (EMACS_TIME_NEG_P (temp))
4297 chosen_timer = timer;
4298 timers = XCDR (timers);
4299 difference = timer_difference;
4301 else
4303 chosen_timer = idle_timer;
4304 idle_timers = XCDR (idle_timers);
4305 difference = idle_timer_difference;
4308 else if (! NILP (timers))
4310 chosen_timer = timer;
4311 timers = XCDR (timers);
4312 difference = timer_difference;
4314 else
4316 chosen_timer = idle_timer;
4317 idle_timers = XCDR (idle_timers);
4318 difference = idle_timer_difference;
4320 vector = XVECTOR (chosen_timer)->contents;
4322 /* If timer is ripe, run it if it hasn't been run. */
4323 if (EMACS_TIME_NEG_P (difference)
4324 || (EMACS_SECS (difference) == 0
4325 && EMACS_USECS (difference) == 0))
4327 if (NILP (vector[0]))
4329 int was_locked = single_kboard;
4330 int count = SPECPDL_INDEX ();
4331 Lisp_Object old_deactivate_mark = Vdeactivate_mark;
4333 /* Mark the timer as triggered to prevent problems if the lisp
4334 code fails to reschedule it right. */
4335 vector[0] = Qt;
4337 specbind (Qinhibit_quit, Qt);
4339 call1 (Qtimer_event_handler, chosen_timer);
4340 Vdeactivate_mark = old_deactivate_mark;
4341 timers_run++;
4342 unbind_to (count, Qnil);
4344 /* Resume allowing input from any kboard, if that was true before. */
4345 if (!was_locked)
4346 any_kboard_state ();
4348 /* Since we have handled the event,
4349 we don't need to tell the caller to wake up and do it. */
4352 else
4353 /* When we encounter a timer that is still waiting,
4354 return the amount of time to wait before it is ripe. */
4356 UNGCPRO;
4357 return difference;
4361 /* No timers are pending in the future. */
4362 /* Return 0 if we generated an event, and -1 if not. */
4363 UNGCPRO;
4364 return nexttime;
4367 /* Caches for modify_event_symbol. */
4368 static Lisp_Object accent_key_syms;
4369 static Lisp_Object func_key_syms;
4370 static Lisp_Object mouse_syms;
4371 #if defined(WINDOWSNT) || defined(MAC_OSX)
4372 static Lisp_Object mouse_wheel_syms;
4373 #endif
4374 static Lisp_Object drag_n_drop_syms;
4376 /* This is a list of keysym codes for special "accent" characters.
4377 It parallels lispy_accent_keys. */
4379 static int lispy_accent_codes[] =
4381 #ifdef XK_dead_circumflex
4382 XK_dead_circumflex,
4383 #else
4385 #endif
4386 #ifdef XK_dead_grave
4387 XK_dead_grave,
4388 #else
4390 #endif
4391 #ifdef XK_dead_tilde
4392 XK_dead_tilde,
4393 #else
4395 #endif
4396 #ifdef XK_dead_diaeresis
4397 XK_dead_diaeresis,
4398 #else
4400 #endif
4401 #ifdef XK_dead_macron
4402 XK_dead_macron,
4403 #else
4405 #endif
4406 #ifdef XK_dead_degree
4407 XK_dead_degree,
4408 #else
4410 #endif
4411 #ifdef XK_dead_acute
4412 XK_dead_acute,
4413 #else
4415 #endif
4416 #ifdef XK_dead_cedilla
4417 XK_dead_cedilla,
4418 #else
4420 #endif
4421 #ifdef XK_dead_breve
4422 XK_dead_breve,
4423 #else
4425 #endif
4426 #ifdef XK_dead_ogonek
4427 XK_dead_ogonek,
4428 #else
4430 #endif
4431 #ifdef XK_dead_caron
4432 XK_dead_caron,
4433 #else
4435 #endif
4436 #ifdef XK_dead_doubleacute
4437 XK_dead_doubleacute,
4438 #else
4440 #endif
4441 #ifdef XK_dead_abovedot
4442 XK_dead_abovedot,
4443 #else
4445 #endif
4446 #ifdef XK_dead_abovering
4447 XK_dead_abovering,
4448 #else
4450 #endif
4451 #ifdef XK_dead_iota
4452 XK_dead_iota,
4453 #else
4455 #endif
4456 #ifdef XK_dead_belowdot
4457 XK_dead_belowdot,
4458 #else
4460 #endif
4461 #ifdef XK_dead_voiced_sound
4462 XK_dead_voiced_sound,
4463 #else
4465 #endif
4466 #ifdef XK_dead_semivoiced_sound
4467 XK_dead_semivoiced_sound,
4468 #else
4470 #endif
4471 #ifdef XK_dead_hook
4472 XK_dead_hook,
4473 #else
4475 #endif
4476 #ifdef XK_dead_horn
4477 XK_dead_horn,
4478 #else
4480 #endif
4483 /* This is a list of Lisp names for special "accent" characters.
4484 It parallels lispy_accent_codes. */
4486 static char *lispy_accent_keys[] =
4488 "dead-circumflex",
4489 "dead-grave",
4490 "dead-tilde",
4491 "dead-diaeresis",
4492 "dead-macron",
4493 "dead-degree",
4494 "dead-acute",
4495 "dead-cedilla",
4496 "dead-breve",
4497 "dead-ogonek",
4498 "dead-caron",
4499 "dead-doubleacute",
4500 "dead-abovedot",
4501 "dead-abovering",
4502 "dead-iota",
4503 "dead-belowdot",
4504 "dead-voiced-sound",
4505 "dead-semivoiced-sound",
4506 "dead-hook",
4507 "dead-horn",
4510 #ifdef HAVE_NTGUI
4511 #define FUNCTION_KEY_OFFSET 0x0
4513 char *lispy_function_keys[] =
4515 0, /* 0 */
4517 0, /* VK_LBUTTON 0x01 */
4518 0, /* VK_RBUTTON 0x02 */
4519 "cancel", /* VK_CANCEL 0x03 */
4520 0, /* VK_MBUTTON 0x04 */
4522 0, 0, 0, /* 0x05 .. 0x07 */
4524 "backspace", /* VK_BACK 0x08 */
4525 "tab", /* VK_TAB 0x09 */
4527 0, 0, /* 0x0A .. 0x0B */
4529 "clear", /* VK_CLEAR 0x0C */
4530 "return", /* VK_RETURN 0x0D */
4532 0, 0, /* 0x0E .. 0x0F */
4534 0, /* VK_SHIFT 0x10 */
4535 0, /* VK_CONTROL 0x11 */
4536 0, /* VK_MENU 0x12 */
4537 "pause", /* VK_PAUSE 0x13 */
4538 "capslock", /* VK_CAPITAL 0x14 */
4540 0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */
4542 "escape", /* VK_ESCAPE 0x1B */
4544 0, 0, 0, 0, /* 0x1C .. 0x1F */
4546 0, /* VK_SPACE 0x20 */
4547 "prior", /* VK_PRIOR 0x21 */
4548 "next", /* VK_NEXT 0x22 */
4549 "end", /* VK_END 0x23 */
4550 "home", /* VK_HOME 0x24 */
4551 "left", /* VK_LEFT 0x25 */
4552 "up", /* VK_UP 0x26 */
4553 "right", /* VK_RIGHT 0x27 */
4554 "down", /* VK_DOWN 0x28 */
4555 "select", /* VK_SELECT 0x29 */
4556 "print", /* VK_PRINT 0x2A */
4557 "execute", /* VK_EXECUTE 0x2B */
4558 "snapshot", /* VK_SNAPSHOT 0x2C */
4559 "insert", /* VK_INSERT 0x2D */
4560 "delete", /* VK_DELETE 0x2E */
4561 "help", /* VK_HELP 0x2F */
4563 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
4565 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4567 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
4569 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
4571 0, 0, 0, 0, 0, 0, 0, 0, 0,
4572 0, 0, 0, 0, 0, 0, 0, 0, 0,
4573 0, 0, 0, 0, 0, 0, 0, 0,
4575 "lwindow", /* VK_LWIN 0x5B */
4576 "rwindow", /* VK_RWIN 0x5C */
4577 "apps", /* VK_APPS 0x5D */
4579 0, 0, /* 0x5E .. 0x5F */
4581 "kp-0", /* VK_NUMPAD0 0x60 */
4582 "kp-1", /* VK_NUMPAD1 0x61 */
4583 "kp-2", /* VK_NUMPAD2 0x62 */
4584 "kp-3", /* VK_NUMPAD3 0x63 */
4585 "kp-4", /* VK_NUMPAD4 0x64 */
4586 "kp-5", /* VK_NUMPAD5 0x65 */
4587 "kp-6", /* VK_NUMPAD6 0x66 */
4588 "kp-7", /* VK_NUMPAD7 0x67 */
4589 "kp-8", /* VK_NUMPAD8 0x68 */
4590 "kp-9", /* VK_NUMPAD9 0x69 */
4591 "kp-multiply", /* VK_MULTIPLY 0x6A */
4592 "kp-add", /* VK_ADD 0x6B */
4593 "kp-separator", /* VK_SEPARATOR 0x6C */
4594 "kp-subtract", /* VK_SUBTRACT 0x6D */
4595 "kp-decimal", /* VK_DECIMAL 0x6E */
4596 "kp-divide", /* VK_DIVIDE 0x6F */
4597 "f1", /* VK_F1 0x70 */
4598 "f2", /* VK_F2 0x71 */
4599 "f3", /* VK_F3 0x72 */
4600 "f4", /* VK_F4 0x73 */
4601 "f5", /* VK_F5 0x74 */
4602 "f6", /* VK_F6 0x75 */
4603 "f7", /* VK_F7 0x76 */
4604 "f8", /* VK_F8 0x77 */
4605 "f9", /* VK_F9 0x78 */
4606 "f10", /* VK_F10 0x79 */
4607 "f11", /* VK_F11 0x7A */
4608 "f12", /* VK_F12 0x7B */
4609 "f13", /* VK_F13 0x7C */
4610 "f14", /* VK_F14 0x7D */
4611 "f15", /* VK_F15 0x7E */
4612 "f16", /* VK_F16 0x7F */
4613 "f17", /* VK_F17 0x80 */
4614 "f18", /* VK_F18 0x81 */
4615 "f19", /* VK_F19 0x82 */
4616 "f20", /* VK_F20 0x83 */
4617 "f21", /* VK_F21 0x84 */
4618 "f22", /* VK_F22 0x85 */
4619 "f23", /* VK_F23 0x86 */
4620 "f24", /* VK_F24 0x87 */
4622 0, 0, 0, 0, /* 0x88 .. 0x8B */
4623 0, 0, 0, 0, /* 0x8C .. 0x8F */
4625 "kp-numlock", /* VK_NUMLOCK 0x90 */
4626 "scroll", /* VK_SCROLL 0x91 */
4628 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
4629 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
4630 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
4631 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
4632 "kp-end", /* VK_NUMPAD_END 0x96 */
4633 "kp-home", /* VK_NUMPAD_HOME 0x97 */
4634 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
4635 "kp-up", /* VK_NUMPAD_UP 0x99 */
4636 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
4637 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
4638 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
4639 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
4641 0, 0, /* 0x9E .. 0x9F */
4644 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
4645 * Used only as parameters to GetAsyncKeyState and GetKeyState.
4646 * No other API or message will distinguish left and right keys this way.
4648 /* 0xA0 .. 0xEF */
4650 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4651 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4652 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4653 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4654 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4656 /* 0xF0 .. 0xF5 */
4658 0, 0, 0, 0, 0, 0,
4660 "attn", /* VK_ATTN 0xF6 */
4661 "crsel", /* VK_CRSEL 0xF7 */
4662 "exsel", /* VK_EXSEL 0xF8 */
4663 "ereof", /* VK_EREOF 0xF9 */
4664 "play", /* VK_PLAY 0xFA */
4665 "zoom", /* VK_ZOOM 0xFB */
4666 "noname", /* VK_NONAME 0xFC */
4667 "pa1", /* VK_PA1 0xFD */
4668 "oem_clear", /* VK_OEM_CLEAR 0xFE */
4669 0 /* 0xFF */
4672 #else /* not HAVE_NTGUI */
4674 /* This should be dealt with in XTread_socket now, and that doesn't
4675 depend on the client system having the Kana syms defined. See also
4676 the XK_kana_A case below. */
4677 #if 0
4678 #ifdef XK_kana_A
4679 static char *lispy_kana_keys[] =
4681 /* X Keysym value */
4682 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
4683 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
4684 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
4685 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
4686 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
4687 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
4688 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
4689 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
4690 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
4691 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
4692 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
4693 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
4694 "kana-i", "kana-u", "kana-e", "kana-o",
4695 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
4696 "prolongedsound", "kana-A", "kana-I", "kana-U",
4697 "kana-E", "kana-O", "kana-KA", "kana-KI",
4698 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
4699 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
4700 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
4701 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
4702 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
4703 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
4704 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
4705 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
4706 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
4707 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
4708 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
4709 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
4711 #endif /* XK_kana_A */
4712 #endif /* 0 */
4714 #define FUNCTION_KEY_OFFSET 0xff00
4716 /* You'll notice that this table is arranged to be conveniently
4717 indexed by X Windows keysym values. */
4718 static char *lispy_function_keys[] =
4720 /* X Keysym value */
4722 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
4723 "backspace", "tab", "linefeed", "clear",
4724 0, "return", 0, 0,
4725 0, 0, 0, "pause", /* 0xff10...1f */
4726 0, 0, 0, 0, 0, 0, 0, "escape",
4727 0, 0, 0, 0,
4728 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
4729 "romaji", "hiragana", "katakana", "hiragana-katakana",
4730 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
4731 "massyo", "kana-lock", "kana-shift", "eisu-shift",
4732 "eisu-toggle", /* 0xff30...3f */
4733 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4734 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
4736 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
4737 "down", "prior", "next", "end",
4738 "begin", 0, 0, 0, 0, 0, 0, 0,
4739 "select", /* 0xff60 */ /* IsMiscFunctionKey */
4740 "print",
4741 "execute",
4742 "insert",
4743 0, /* 0xff64 */
4744 "undo",
4745 "redo",
4746 "menu",
4747 "find",
4748 "cancel",
4749 "help",
4750 "break", /* 0xff6b */
4752 0, 0, 0, 0,
4753 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
4754 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
4755 "kp-space", /* 0xff80 */ /* IsKeypadKey */
4756 0, 0, 0, 0, 0, 0, 0, 0,
4757 "kp-tab", /* 0xff89 */
4758 0, 0, 0,
4759 "kp-enter", /* 0xff8d */
4760 0, 0, 0,
4761 "kp-f1", /* 0xff91 */
4762 "kp-f2",
4763 "kp-f3",
4764 "kp-f4",
4765 "kp-home", /* 0xff95 */
4766 "kp-left",
4767 "kp-up",
4768 "kp-right",
4769 "kp-down",
4770 "kp-prior", /* kp-page-up */
4771 "kp-next", /* kp-page-down */
4772 "kp-end",
4773 "kp-begin",
4774 "kp-insert",
4775 "kp-delete",
4776 0, /* 0xffa0 */
4777 0, 0, 0, 0, 0, 0, 0, 0, 0,
4778 "kp-multiply", /* 0xffaa */
4779 "kp-add",
4780 "kp-separator",
4781 "kp-subtract",
4782 "kp-decimal",
4783 "kp-divide", /* 0xffaf */
4784 "kp-0", /* 0xffb0 */
4785 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
4786 0, /* 0xffba */
4787 0, 0,
4788 "kp-equal", /* 0xffbd */
4789 "f1", /* 0xffbe */ /* IsFunctionKey */
4790 "f2",
4791 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
4792 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
4793 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
4794 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
4795 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
4796 0, 0, 0, 0, 0, 0, 0, 0,
4797 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
4798 0, 0, 0, 0, 0, 0, 0, "delete"
4801 /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
4802 #define ISO_FUNCTION_KEY_OFFSET 0xfe00
4804 static char *iso_lispy_function_keys[] =
4806 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
4807 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
4808 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
4809 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
4810 "iso-lefttab", /* 0xfe20 */
4811 "iso-move-line-up", "iso-move-line-down",
4812 "iso-partial-line-up", "iso-partial-line-down",
4813 "iso-partial-space-left", "iso-partial-space-right",
4814 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
4815 "iso-release-margin-left", "iso-release-margin-right",
4816 "iso-release-both-margins",
4817 "iso-fast-cursor-left", "iso-fast-cursor-right",
4818 "iso-fast-cursor-up", "iso-fast-cursor-down",
4819 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
4820 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
4823 #endif /* not HAVE_NTGUI */
4825 Lisp_Object Vlispy_mouse_stem;
4827 #if defined(WINDOWSNT) || defined(MAC_OSX)
4828 /* mouse-wheel events are generated by the wheel on devices such as
4829 the MS Intellimouse. The wheel sits in between the left and right
4830 mouse buttons, and is typically used to scroll or zoom the window
4831 underneath the pointer. mouse-wheel events specify the object on
4832 which they operate, and a delta corresponding to the amount and
4833 direction that the wheel is rotated. Clicking the mouse-wheel
4834 generates a mouse-2 event. */
4835 static char *lispy_mouse_wheel_names[] =
4837 "mouse-wheel"
4840 #endif /* WINDOWSNT */
4842 /* drag-n-drop events are generated when a set of selected files are
4843 dragged from another application and dropped onto an Emacs window. */
4844 static char *lispy_drag_n_drop_names[] =
4846 "drag-n-drop"
4849 /* Scroll bar parts. */
4850 Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
4851 Lisp_Object Qup, Qdown, Qbottom, Qend_scroll;
4852 Lisp_Object Qtop, Qratio;
4854 /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
4855 Lisp_Object *scroll_bar_parts[] = {
4856 &Qabove_handle, &Qhandle, &Qbelow_handle,
4857 &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio
4860 /* User signal events. */
4861 Lisp_Object Qusr1_signal, Qusr2_signal;
4863 Lisp_Object *lispy_user_signals[] =
4865 &Qusr1_signal, &Qusr2_signal
4869 /* A vector, indexed by button number, giving the down-going location
4870 of currently depressed buttons, both scroll bar and non-scroll bar.
4872 The elements have the form
4873 (BUTTON-NUMBER MODIFIER-MASK . REST)
4874 where REST is the cdr of a position as it would be reported in the event.
4876 The make_lispy_event function stores positions here to tell the
4877 difference between click and drag events, and to store the starting
4878 location to be included in drag events. */
4880 static Lisp_Object button_down_location;
4882 /* Information about the most recent up-going button event: Which
4883 button, what location, and what time. */
4885 static int last_mouse_button;
4886 static int last_mouse_x;
4887 static int last_mouse_y;
4888 static unsigned long button_down_time;
4890 /* The maximum time between clicks to make a double-click, or Qnil to
4891 disable double-click detection, or Qt for no time limit. */
4893 Lisp_Object Vdouble_click_time;
4895 /* Maximum number of pixels the mouse may be moved between clicks
4896 to make a double-click. */
4898 EMACS_INT double_click_fuzz;
4900 /* The number of clicks in this multiple-click. */
4902 int double_click_count;
4904 /* Given a struct input_event, build the lisp event which represents
4905 it. If EVENT is 0, build a mouse movement event from the mouse
4906 movement buffer, which should have a movement event in it.
4908 Note that events must be passed to this function in the order they
4909 are received; this function stores the location of button presses
4910 in order to build drag events when the button is released. */
4912 static Lisp_Object
4913 make_lispy_event (event)
4914 struct input_event *event;
4916 int i;
4918 switch (SWITCH_ENUM_CAST (event->kind))
4920 /* A simple keystroke. */
4921 case ASCII_KEYSTROKE_EVENT:
4923 Lisp_Object lispy_c;
4924 int c = event->code & 0377;
4925 /* Turn ASCII characters into control characters
4926 when proper. */
4927 if (event->modifiers & ctrl_modifier)
4928 c = make_ctrl_char (c);
4930 /* Add in the other modifier bits. We took care of ctrl_modifier
4931 just above, and the shift key was taken care of by the X code,
4932 and applied to control characters by make_ctrl_char. */
4933 c |= (event->modifiers
4934 & (meta_modifier | alt_modifier
4935 | hyper_modifier | super_modifier));
4936 /* Distinguish Shift-SPC from SPC. */
4937 if ((event->code & 0377) == 040
4938 && event->modifiers & shift_modifier)
4939 c |= shift_modifier;
4940 button_down_time = 0;
4941 XSETFASTINT (lispy_c, c);
4942 return lispy_c;
4945 case MULTIBYTE_CHAR_KEYSTROKE_EVENT:
4947 Lisp_Object lispy_c;
4949 XSETFASTINT (lispy_c, event->code);
4950 return lispy_c;
4953 /* A function key. The symbol may need to have modifier prefixes
4954 tacked onto it. */
4955 case NON_ASCII_KEYSTROKE_EVENT:
4956 button_down_time = 0;
4958 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
4959 if (event->code == lispy_accent_codes[i])
4960 return modify_event_symbol (i,
4961 event->modifiers,
4962 Qfunction_key, Qnil,
4963 lispy_accent_keys, &accent_key_syms,
4964 (sizeof (lispy_accent_keys)
4965 / sizeof (lispy_accent_keys[0])));
4967 #if 0
4968 #ifdef XK_kana_A
4969 if (event->code >= 0x400 && event->code < 0x500)
4970 return modify_event_symbol (event->code - 0x400,
4971 event->modifiers & ~shift_modifier,
4972 Qfunction_key, Qnil,
4973 lispy_kana_keys, &func_key_syms,
4974 (sizeof (lispy_kana_keys)
4975 / sizeof (lispy_kana_keys[0])));
4976 #endif /* XK_kana_A */
4977 #endif /* 0 */
4979 #ifdef ISO_FUNCTION_KEY_OFFSET
4980 if (event->code < FUNCTION_KEY_OFFSET
4981 && event->code >= ISO_FUNCTION_KEY_OFFSET)
4982 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
4983 event->modifiers,
4984 Qfunction_key, Qnil,
4985 iso_lispy_function_keys, &func_key_syms,
4986 (sizeof (iso_lispy_function_keys)
4987 / sizeof (iso_lispy_function_keys[0])));
4988 #endif
4990 /* Handle system-specific or unknown keysyms. */
4991 if (event->code & (1 << 28)
4992 || event->code - FUNCTION_KEY_OFFSET < 0
4993 || (event->code - FUNCTION_KEY_OFFSET
4994 >= sizeof lispy_function_keys / sizeof *lispy_function_keys)
4995 || !lispy_function_keys[event->code - FUNCTION_KEY_OFFSET])
4997 /* We need to use an alist rather than a vector as the cache
4998 since we can't make a vector long enuf. */
4999 if (NILP (current_kboard->system_key_syms))
5000 current_kboard->system_key_syms = Fcons (Qnil, Qnil);
5001 return modify_event_symbol (event->code,
5002 event->modifiers,
5003 Qfunction_key,
5004 current_kboard->Vsystem_key_alist,
5005 0, &current_kboard->system_key_syms,
5006 (unsigned) -1);
5009 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
5010 event->modifiers,
5011 Qfunction_key, Qnil,
5012 lispy_function_keys, &func_key_syms,
5013 (sizeof (lispy_function_keys)
5014 / sizeof (lispy_function_keys[0])));
5016 #ifdef HAVE_MOUSE
5017 /* A mouse click. Figure out where it is, decide whether it's
5018 a press, click or drag, and build the appropriate structure. */
5019 case MOUSE_CLICK_EVENT:
5020 #ifndef USE_TOOLKIT_SCROLL_BARS
5021 case SCROLL_BAR_CLICK_EVENT:
5022 #endif
5024 int button = event->code;
5025 int is_double;
5026 Lisp_Object position;
5027 Lisp_Object *start_pos_ptr;
5028 Lisp_Object start_pos;
5029 Lisp_Object window;
5031 position = Qnil;
5033 /* Build the position as appropriate for this mouse click. */
5034 if (event->kind == MOUSE_CLICK_EVENT)
5036 int part;
5037 struct frame *f = XFRAME (event->frame_or_window);
5038 Lisp_Object posn;
5039 Lisp_Object string_info = Qnil;
5040 int row, column;
5042 /* Ignore mouse events that were made on frame that
5043 have been deleted. */
5044 if (! FRAME_LIVE_P (f))
5045 return Qnil;
5047 /* EVENT->x and EVENT->y are frame-relative pixel
5048 coordinates at this place. Under old redisplay, COLUMN
5049 and ROW are set to frame relative glyph coordinates
5050 which are then used to determine whether this click is
5051 in a menu (non-toolkit version). */
5052 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
5053 &column, &row, NULL, 1);
5055 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
5056 /* In the non-toolkit version, clicks on the menu bar
5057 are ordinary button events in the event buffer.
5058 Distinguish them, and invoke the menu.
5060 (In the toolkit version, the toolkit handles the menu bar
5061 and Emacs doesn't know about it until after the user
5062 makes a selection.) */
5063 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
5064 && (event->modifiers & down_modifier))
5066 Lisp_Object items, item;
5067 int hpos;
5068 int i;
5070 #if 0
5071 /* Activate the menu bar on the down event. If the
5072 up event comes in before the menu code can deal with it,
5073 just ignore it. */
5074 if (! (event->modifiers & down_modifier))
5075 return Qnil;
5076 #endif
5078 /* Find the menu bar item under `column'. */
5079 item = Qnil;
5080 items = FRAME_MENU_BAR_ITEMS (f);
5081 for (i = 0; i < XVECTOR (items)->size; i += 4)
5083 Lisp_Object pos, string;
5084 string = AREF (items, i + 1);
5085 pos = AREF (items, i + 3);
5086 if (NILP (string))
5087 break;
5088 if (column >= XINT (pos)
5089 && column < XINT (pos) + SCHARS (string))
5091 item = AREF (items, i);
5092 break;
5096 /* ELisp manual 2.4b says (x y) are window relative but
5097 code says they are frame-relative. */
5098 position
5099 = Fcons (event->frame_or_window,
5100 Fcons (Qmenu_bar,
5101 Fcons (Fcons (event->x, event->y),
5102 Fcons (make_number (event->timestamp),
5103 Qnil))));
5105 return Fcons (item, Fcons (position, Qnil));
5107 #endif /* not USE_X_TOOLKIT && not USE_GTK */
5109 /* Set `window' to the window under frame pixel coordinates
5110 event->x/event->y. */
5111 window = window_from_coordinates (f, XINT (event->x),
5112 XINT (event->y), &part, 0);
5114 if (!WINDOWP (window))
5116 window = event->frame_or_window;
5117 posn = Qnil;
5119 else
5121 /* It's a click in window window at frame coordinates
5122 event->x/ event->y. */
5123 struct window *w = XWINDOW (window);
5125 /* Get window relative coordinates. Original code
5126 `rounded' this to glyph boundaries. */
5127 int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
5128 int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
5130 /* Set event coordinates to window-relative coordinates
5131 for constructing the Lisp event below. */
5132 XSETINT (event->x, wx);
5133 XSETINT (event->y, wy);
5135 if (part == 1 || part == 3)
5137 /* Mode line or header line. Look for a string under
5138 the mouse that may have a `local-map' property. */
5139 Lisp_Object string;
5140 int charpos;
5142 posn = part == 1 ? Qmode_line : Qheader_line;
5143 string = mode_line_string (w, wx, wy, part == 1, &charpos);
5144 if (STRINGP (string))
5145 string_info = Fcons (string, make_number (charpos));
5147 else if (part == 2)
5148 posn = Qvertical_line;
5149 else if (part == 6 || part == 7)
5151 int charpos;
5152 Lisp_Object object = marginal_area_string (w, wx, wy, part,
5153 &charpos);
5154 posn = (part == 6) ? Qleft_margin : Qright_margin;
5155 if (STRINGP (object))
5156 string_info = Fcons (object, make_number (charpos));
5158 else
5160 Lisp_Object object;
5161 struct display_pos p;
5162 buffer_posn_from_coords (w, &wx, &wy, &object, &p);
5163 posn = make_number (CHARPOS (p.pos));
5164 if (STRINGP (object))
5165 string_info
5166 = Fcons (object,
5167 make_number (CHARPOS (p.string_pos)));
5171 position
5172 = Fcons (window,
5173 Fcons (posn,
5174 Fcons (Fcons (event->x, event->y),
5175 Fcons (make_number (event->timestamp),
5176 (NILP (string_info)
5177 ? Qnil
5178 : Fcons (string_info, Qnil))))));
5180 #ifndef USE_TOOLKIT_SCROLL_BARS
5181 else
5183 /* It's a scrollbar click. */
5184 Lisp_Object portion_whole;
5185 Lisp_Object part;
5187 window = event->frame_or_window;
5188 portion_whole = Fcons (event->x, event->y);
5189 part = *scroll_bar_parts[(int) event->part];
5191 position
5192 = Fcons (window,
5193 Fcons (Qvertical_scroll_bar,
5194 Fcons (portion_whole,
5195 Fcons (make_number (event->timestamp),
5196 Fcons (part, Qnil)))));
5198 #endif /* not USE_TOOLKIT_SCROLL_BARS */
5200 if (button >= ASIZE (button_down_location))
5202 button_down_location = larger_vector (button_down_location,
5203 button + 1, Qnil);
5204 mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
5207 start_pos_ptr = &AREF (button_down_location, button);
5208 start_pos = *start_pos_ptr;
5209 *start_pos_ptr = Qnil;
5212 /* On window-system frames, use the value of
5213 double-click-fuzz as is. On other frames, interpret it
5214 as a multiple of 1/8 characters. */
5215 struct frame *f;
5216 int fuzz;
5218 if (WINDOWP (event->frame_or_window))
5219 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
5220 else if (FRAMEP (event->frame_or_window))
5221 f = XFRAME (event->frame_or_window);
5222 else
5223 abort ();
5225 if (FRAME_WINDOW_P (f))
5226 fuzz = double_click_fuzz;
5227 else
5228 fuzz = double_click_fuzz / 8;
5230 is_double = (button == last_mouse_button
5231 && (abs (XINT (event->x) - last_mouse_x) <= fuzz)
5232 && (abs (XINT (event->y) - last_mouse_y) <= fuzz)
5233 && button_down_time != 0
5234 && (EQ (Vdouble_click_time, Qt)
5235 || (INTEGERP (Vdouble_click_time)
5236 && ((int)(event->timestamp - button_down_time)
5237 < XINT (Vdouble_click_time)))));
5240 last_mouse_button = button;
5241 last_mouse_x = XINT (event->x);
5242 last_mouse_y = XINT (event->y);
5244 /* If this is a button press, squirrel away the location, so
5245 we can decide later whether it was a click or a drag. */
5246 if (event->modifiers & down_modifier)
5248 if (is_double)
5250 double_click_count++;
5251 event->modifiers |= ((double_click_count > 2)
5252 ? triple_modifier
5253 : double_modifier);
5255 else
5256 double_click_count = 1;
5257 button_down_time = event->timestamp;
5258 *start_pos_ptr = Fcopy_alist (position);
5261 /* Now we're releasing a button - check the co-ordinates to
5262 see if this was a click or a drag. */
5263 else if (event->modifiers & up_modifier)
5265 /* If we did not see a down before this up, ignore the up.
5266 Probably this happened because the down event chose a
5267 menu item. It would be an annoyance to treat the
5268 release of the button that chose the menu item as a
5269 separate event. */
5271 if (!CONSP (start_pos))
5272 return Qnil;
5274 event->modifiers &= ~up_modifier;
5275 #if 0 /* Formerly we treated an up with no down as a click event. */
5276 if (!CONSP (start_pos))
5277 event->modifiers |= click_modifier;
5278 else
5279 #endif
5281 Lisp_Object down;
5282 EMACS_INT xdiff = double_click_fuzz, ydiff = double_click_fuzz;
5284 /* The third element of every position
5285 should be the (x,y) pair. */
5286 down = Fcar (Fcdr (Fcdr (start_pos)));
5287 if (CONSP (down)
5288 && INTEGERP (XCAR (down)) && INTEGERP (XCDR (down)))
5290 xdiff = XFASTINT (event->x) - XFASTINT (XCAR (down));
5291 ydiff = XFASTINT (event->y) - XFASTINT (XCDR (down));
5294 if (xdiff < double_click_fuzz && xdiff > - double_click_fuzz
5295 && ydiff < double_click_fuzz
5296 && ydiff > - double_click_fuzz)
5297 /* Mouse hasn't moved (much). */
5298 event->modifiers |= click_modifier;
5299 else
5301 button_down_time = 0;
5302 event->modifiers |= drag_modifier;
5305 /* Don't check is_double; treat this as multiple
5306 if the down-event was multiple. */
5307 if (double_click_count > 1)
5308 event->modifiers |= ((double_click_count > 2)
5309 ? triple_modifier
5310 : double_modifier);
5313 else
5314 /* Every mouse event should either have the down_modifier or
5315 the up_modifier set. */
5316 abort ();
5319 /* Get the symbol we should use for the mouse click. */
5320 Lisp_Object head;
5322 head = modify_event_symbol (button,
5323 event->modifiers,
5324 Qmouse_click, Vlispy_mouse_stem,
5325 NULL,
5326 &mouse_syms,
5327 XVECTOR (mouse_syms)->size);
5328 if (event->modifiers & drag_modifier)
5329 return Fcons (head,
5330 Fcons (start_pos,
5331 Fcons (position,
5332 Qnil)));
5333 else if (event->modifiers & (double_modifier | triple_modifier))
5334 return Fcons (head,
5335 Fcons (position,
5336 Fcons (make_number (double_click_count),
5337 Qnil)));
5338 else
5339 return Fcons (head,
5340 Fcons (position,
5341 Qnil));
5345 #ifdef USE_TOOLKIT_SCROLL_BARS
5347 /* We don't have down and up events if using toolkit scroll bars,
5348 so make this always a click event. Store in the `part' of
5349 the Lisp event a symbol which maps to the following actions:
5351 `above_handle' page up
5352 `below_handle' page down
5353 `up' line up
5354 `down' line down
5355 `top' top of buffer
5356 `bottom' bottom of buffer
5357 `handle' thumb has been dragged.
5358 `end-scroll' end of interaction with scroll bar
5360 The incoming input_event contains in its `part' member an
5361 index of type `enum scroll_bar_part' which we can use as an
5362 index in scroll_bar_parts to get the appropriate symbol. */
5364 case SCROLL_BAR_CLICK_EVENT:
5366 Lisp_Object position, head, window, portion_whole, part;
5368 window = event->frame_or_window;
5369 portion_whole = Fcons (event->x, event->y);
5370 part = *scroll_bar_parts[(int) event->part];
5372 position
5373 = Fcons (window,
5374 Fcons (Qvertical_scroll_bar,
5375 Fcons (portion_whole,
5376 Fcons (make_number (event->timestamp),
5377 Fcons (part, Qnil)))));
5379 /* Always treat scroll bar events as clicks. */
5380 event->modifiers |= click_modifier;
5381 event->modifiers &= ~up_modifier;
5383 /* Get the symbol we should use for the mouse click. */
5384 head = modify_event_symbol (event->code,
5385 event->modifiers,
5386 Qmouse_click,
5387 Vlispy_mouse_stem,
5388 NULL, &mouse_syms,
5389 XVECTOR (mouse_syms)->size);
5390 return Fcons (head, Fcons (position, Qnil));
5393 #endif /* USE_TOOLKIT_SCROLL_BARS */
5395 #ifdef WINDOWSNT
5396 case W32_SCROLL_BAR_CLICK_EVENT:
5398 int button = event->code;
5399 int is_double;
5400 Lisp_Object position;
5401 Lisp_Object *start_pos_ptr;
5402 Lisp_Object start_pos;
5405 Lisp_Object window;
5406 Lisp_Object portion_whole;
5407 Lisp_Object part;
5409 window = event->frame_or_window;
5410 portion_whole = Fcons (event->x, event->y);
5411 part = *scroll_bar_parts[(int) event->part];
5413 position
5414 = Fcons (window,
5415 Fcons (Qvertical_scroll_bar,
5416 Fcons (portion_whole,
5417 Fcons (make_number (event->timestamp),
5418 Fcons (part, Qnil)))));
5421 /* Always treat W32 scroll bar events as clicks. */
5422 event->modifiers |= click_modifier;
5425 /* Get the symbol we should use for the mouse click. */
5426 Lisp_Object head;
5428 head = modify_event_symbol (button,
5429 event->modifiers,
5430 Qmouse_click,
5431 Vlispy_mouse_stem,
5432 NULL, &mouse_syms,
5433 XVECTOR (mouse_syms)->size);
5434 return Fcons (head,
5435 Fcons (position,
5436 Qnil));
5439 #endif /* WINDOWSNT */
5440 #if defined(WINDOWSNT) || defined(MAC_OSX)
5441 case MOUSE_WHEEL_EVENT:
5443 int part;
5444 FRAME_PTR f = XFRAME (event->frame_or_window);
5445 Lisp_Object window;
5446 Lisp_Object posn;
5447 Lisp_Object head, position;
5448 int row, column;
5450 /* Ignore mouse events that were made on frame that
5451 have been deleted. */
5452 if (! FRAME_LIVE_P (f))
5453 return Qnil;
5454 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
5455 &column, &row, NULL, 1);
5456 window = window_from_coordinates (f, XINT (event->x),
5457 XINT (event->y), &part, 0);
5459 if (!WINDOWP (window))
5461 window = event->frame_or_window;
5462 posn = Qnil;
5464 else
5466 int pixcolumn, pixrow;
5467 column -= XINT (XWINDOW (window)->left);
5468 row -= XINT (XWINDOW (window)->top);
5469 glyph_to_pixel_coords (XWINDOW(window), column, row,
5470 &pixcolumn, &pixrow);
5471 XSETINT (event->x, pixcolumn);
5472 XSETINT (event->y, pixrow);
5474 if (part == 1)
5475 posn = Qmode_line;
5476 else if (part == 2)
5477 posn = Qvertical_line;
5478 else if (part == 3)
5479 posn = Qheader_line;
5480 else
5482 Lisp_Object object;
5483 struct display_pos p;
5484 buffer_posn_from_coords (XWINDOW (window), &column, &row,
5485 &object, &p);
5486 posn = make_number (CHARPOS (p.pos));
5491 Lisp_Object head, position;
5493 position
5494 = Fcons (window,
5495 Fcons (posn,
5496 Fcons (Fcons (event->x, event->y),
5497 Fcons (make_number (event->timestamp),
5498 Qnil))));
5500 head = modify_event_symbol (0, event->modifiers,
5501 Qmouse_wheel, Qnil,
5502 lispy_mouse_wheel_names,
5503 &mouse_wheel_syms, 1);
5504 return Fcons (head,
5505 Fcons (position,
5506 /* Insert 1 here so event-click-count works. */
5507 Fcons (make_number (1),
5508 Fcons (make_number (event->code),
5509 Qnil))));
5512 #endif /* WINDOWSNT || MAC_OSX */
5514 case DRAG_N_DROP_EVENT:
5516 int part;
5517 FRAME_PTR f;
5518 Lisp_Object window;
5519 Lisp_Object posn;
5520 Lisp_Object files;
5522 /* The frame_or_window field should be a cons of the frame in
5523 which the event occurred and a list of the filenames
5524 dropped. */
5525 if (! CONSP (event->frame_or_window))
5526 abort ();
5528 f = XFRAME (XCAR (event->frame_or_window));
5529 files = XCDR (event->frame_or_window);
5531 /* Ignore mouse events that were made on frames that
5532 have been deleted. */
5533 if (! FRAME_LIVE_P (f))
5534 return Qnil;
5536 window = window_from_coordinates (f, XINT (event->x),
5537 XINT (event->y), &part, 0);
5539 if (!WINDOWP (window))
5541 window = XCAR (event->frame_or_window);
5542 posn = Qnil;
5544 else
5546 /* It's an event in window `window' at frame coordinates
5547 event->x/ event->y. */
5548 struct window *w = XWINDOW (window);
5550 /* Get window relative coordinates. */
5551 int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
5552 int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
5554 /* Set event coordinates to window-relative coordinates
5555 for constructing the Lisp event below. */
5556 XSETINT (event->x, wx);
5557 XSETINT (event->y, wy);
5559 if (part == 1)
5560 posn = Qmode_line;
5561 else if (part == 2)
5562 posn = Qvertical_line;
5563 else if (part == 3)
5564 posn = Qheader_line;
5565 else
5567 Lisp_Object object;
5568 struct display_pos p;
5569 buffer_posn_from_coords (w, &wx, &wy, &object, &p);
5570 posn = make_number (CHARPOS (p.pos));
5575 Lisp_Object head, position;
5577 position
5578 = Fcons (window,
5579 Fcons (posn,
5580 Fcons (Fcons (event->x, event->y),
5581 Fcons (make_number (event->timestamp),
5582 Qnil))));
5584 head = modify_event_symbol (0, event->modifiers,
5585 Qdrag_n_drop, Qnil,
5586 lispy_drag_n_drop_names,
5587 &drag_n_drop_syms, 1);
5588 return Fcons (head,
5589 Fcons (position,
5590 Fcons (files,
5591 Qnil)));
5594 #endif /* HAVE_MOUSE */
5596 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (MAC_OS) \
5597 || defined (USE_GTK)
5598 case MENU_BAR_EVENT:
5599 if (EQ (event->arg, event->frame_or_window))
5600 /* This is the prefix key. We translate this to
5601 `(menu_bar)' because the code in keyboard.c for menu
5602 events, which we use, relies on this. */
5603 return Fcons (Qmenu_bar, Qnil);
5604 return event->arg;
5605 #endif
5607 case TOOL_BAR_EVENT:
5608 if (EQ (event->arg, event->frame_or_window))
5609 /* This is the prefix key. We translate this to
5610 `(tool_bar)' because the code in keyboard.c for tool bar
5611 events, which we use, relies on this. */
5612 return Fcons (Qtool_bar, Qnil);
5613 else if (SYMBOLP (event->arg))
5614 return apply_modifiers (event->modifiers, event->arg);
5615 return event->arg;
5617 case USER_SIGNAL_EVENT:
5618 /* A user signal. */
5619 return *lispy_user_signals[event->code];
5621 case SAVE_SESSION_EVENT:
5622 return Qsave_session;
5624 /* The 'kind' field of the event is something we don't recognize. */
5625 default:
5626 abort ();
5630 #ifdef HAVE_MOUSE
5632 static Lisp_Object
5633 make_lispy_movement (frame, bar_window, part, x, y, time)
5634 FRAME_PTR frame;
5635 Lisp_Object bar_window;
5636 enum scroll_bar_part part;
5637 Lisp_Object x, y;
5638 unsigned long time;
5640 /* Is it a scroll bar movement? */
5641 if (frame && ! NILP (bar_window))
5643 Lisp_Object part_sym;
5645 part_sym = *scroll_bar_parts[(int) part];
5646 return Fcons (Qscroll_bar_movement,
5647 (Fcons (Fcons (bar_window,
5648 Fcons (Qvertical_scroll_bar,
5649 Fcons (Fcons (x, y),
5650 Fcons (make_number (time),
5651 Fcons (part_sym,
5652 Qnil))))),
5653 Qnil)));
5656 /* Or is it an ordinary mouse movement? */
5657 else
5659 int area;
5660 Lisp_Object window;
5661 Lisp_Object posn;
5663 if (frame)
5664 /* It's in a frame; which window on that frame? */
5665 window = window_from_coordinates (frame, XINT (x), XINT (y), &area, 0);
5666 else
5667 window = Qnil;
5669 if (WINDOWP (window))
5671 struct window *w = XWINDOW (window);
5672 int wx, wy;
5674 /* Get window relative coordinates. */
5675 wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (x));
5676 wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (y));
5677 XSETINT (x, wx);
5678 XSETINT (y, wy);
5680 if (area == 1)
5681 posn = Qmode_line;
5682 else if (area == 2)
5683 posn = Qvertical_line;
5684 else if (area == 3)
5685 posn = Qheader_line;
5686 else
5688 Lisp_Object object;
5689 struct display_pos p;
5690 buffer_posn_from_coords (w, &wx, &wy, &object, &p);
5691 posn = make_number (CHARPOS (p.pos));
5694 else if (frame != 0)
5696 XSETFRAME (window, frame);
5697 posn = Qnil;
5699 else
5701 window = Qnil;
5702 posn = Qnil;
5703 XSETFASTINT (x, 0);
5704 XSETFASTINT (y, 0);
5707 return Fcons (Qmouse_movement,
5708 Fcons (Fcons (window,
5709 Fcons (posn,
5710 Fcons (Fcons (x, y),
5711 Fcons (make_number (time),
5712 Qnil)))),
5713 Qnil));
5717 #endif /* HAVE_MOUSE */
5719 /* Construct a switch frame event. */
5720 static Lisp_Object
5721 make_lispy_switch_frame (frame)
5722 Lisp_Object frame;
5724 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
5727 /* Manipulating modifiers. */
5729 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
5731 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
5732 SYMBOL's name of the end of the modifiers; the string from this
5733 position is the unmodified symbol name.
5735 This doesn't use any caches. */
5737 static int
5738 parse_modifiers_uncached (symbol, modifier_end)
5739 Lisp_Object symbol;
5740 int *modifier_end;
5742 Lisp_Object name;
5743 int i;
5744 int modifiers;
5746 CHECK_SYMBOL (symbol);
5748 modifiers = 0;
5749 name = SYMBOL_NAME (symbol);
5751 for (i = 0; i+2 <= SBYTES (name); )
5753 int this_mod_end = 0;
5754 int this_mod = 0;
5756 /* See if the name continues with a modifier word.
5757 Check that the word appears, but don't check what follows it.
5758 Set this_mod and this_mod_end to record what we find. */
5760 switch (SREF (name, i))
5762 #define SINGLE_LETTER_MOD(BIT) \
5763 (this_mod_end = i + 1, this_mod = BIT)
5765 case 'A':
5766 SINGLE_LETTER_MOD (alt_modifier);
5767 break;
5769 case 'C':
5770 SINGLE_LETTER_MOD (ctrl_modifier);
5771 break;
5773 case 'H':
5774 SINGLE_LETTER_MOD (hyper_modifier);
5775 break;
5777 case 'M':
5778 SINGLE_LETTER_MOD (meta_modifier);
5779 break;
5781 case 'S':
5782 SINGLE_LETTER_MOD (shift_modifier);
5783 break;
5785 case 's':
5786 SINGLE_LETTER_MOD (super_modifier);
5787 break;
5789 #undef SINGLE_LETTER_MOD
5792 /* If we found no modifier, stop looking for them. */
5793 if (this_mod_end == 0)
5794 break;
5796 /* Check there is a dash after the modifier, so that it
5797 really is a modifier. */
5798 if (this_mod_end >= SBYTES (name)
5799 || SREF (name, this_mod_end) != '-')
5800 break;
5802 /* This modifier is real; look for another. */
5803 modifiers |= this_mod;
5804 i = this_mod_end + 1;
5807 /* Should we include the `click' modifier? */
5808 if (! (modifiers & (down_modifier | drag_modifier
5809 | double_modifier | triple_modifier))
5810 && i + 7 == SBYTES (name)
5811 && strncmp (SDATA (name) + i, "mouse-", 6) == 0
5812 && ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9'))
5813 modifiers |= click_modifier;
5815 if (modifier_end)
5816 *modifier_end = i;
5818 return modifiers;
5821 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
5822 prepended to the string BASE[0..BASE_LEN-1].
5823 This doesn't use any caches. */
5824 static Lisp_Object
5825 apply_modifiers_uncached (modifiers, base, base_len, base_len_byte)
5826 int modifiers;
5827 char *base;
5828 int base_len, base_len_byte;
5830 /* Since BASE could contain nulls, we can't use intern here; we have
5831 to use Fintern, which expects a genuine Lisp_String, and keeps a
5832 reference to it. */
5833 char *new_mods
5834 = (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
5835 int mod_len;
5838 char *p = new_mods;
5840 /* Only the event queue may use the `up' modifier; it should always
5841 be turned into a click or drag event before presented to lisp code. */
5842 if (modifiers & up_modifier)
5843 abort ();
5845 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
5846 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
5847 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
5848 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
5849 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
5850 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
5851 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
5852 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
5853 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
5854 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
5855 /* The click modifier is denoted by the absence of other modifiers. */
5857 *p = '\0';
5859 mod_len = p - new_mods;
5863 Lisp_Object new_name;
5865 new_name = make_uninit_multibyte_string (mod_len + base_len,
5866 mod_len + base_len_byte);
5867 bcopy (new_mods, SDATA (new_name), mod_len);
5868 bcopy (base, SDATA (new_name) + mod_len, base_len_byte);
5870 return Fintern (new_name, Qnil);
5875 static char *modifier_names[] =
5877 "up", "down", "drag", "click", "double", "triple", 0, 0,
5878 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5879 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
5881 #define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
5883 static Lisp_Object modifier_symbols;
5885 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
5886 static Lisp_Object
5887 lispy_modifier_list (modifiers)
5888 int modifiers;
5890 Lisp_Object modifier_list;
5891 int i;
5893 modifier_list = Qnil;
5894 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
5895 if (modifiers & (1<<i))
5896 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
5897 modifier_list);
5899 return modifier_list;
5903 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
5904 where UNMODIFIED is the unmodified form of SYMBOL,
5905 MASK is the set of modifiers present in SYMBOL's name.
5906 This is similar to parse_modifiers_uncached, but uses the cache in
5907 SYMBOL's Qevent_symbol_element_mask property, and maintains the
5908 Qevent_symbol_elements property. */
5910 Lisp_Object
5911 parse_modifiers (symbol)
5912 Lisp_Object symbol;
5914 Lisp_Object elements;
5916 elements = Fget (symbol, Qevent_symbol_element_mask);
5917 if (CONSP (elements))
5918 return elements;
5919 else
5921 int end;
5922 int modifiers = parse_modifiers_uncached (symbol, &end);
5923 Lisp_Object unmodified;
5924 Lisp_Object mask;
5926 unmodified = Fintern (make_string (SDATA (SYMBOL_NAME (symbol)) + end,
5927 SBYTES (SYMBOL_NAME (symbol)) - end),
5928 Qnil);
5930 if (modifiers & ~VALMASK)
5931 abort ();
5932 XSETFASTINT (mask, modifiers);
5933 elements = Fcons (unmodified, Fcons (mask, Qnil));
5935 /* Cache the parsing results on SYMBOL. */
5936 Fput (symbol, Qevent_symbol_element_mask,
5937 elements);
5938 Fput (symbol, Qevent_symbol_elements,
5939 Fcons (unmodified, lispy_modifier_list (modifiers)));
5941 /* Since we know that SYMBOL is modifiers applied to unmodified,
5942 it would be nice to put that in unmodified's cache.
5943 But we can't, since we're not sure that parse_modifiers is
5944 canonical. */
5946 return elements;
5950 /* Apply the modifiers MODIFIERS to the symbol BASE.
5951 BASE must be unmodified.
5953 This is like apply_modifiers_uncached, but uses BASE's
5954 Qmodifier_cache property, if present. It also builds
5955 Qevent_symbol_elements properties, since it has that info anyway.
5957 apply_modifiers copies the value of BASE's Qevent_kind property to
5958 the modified symbol. */
5959 static Lisp_Object
5960 apply_modifiers (modifiers, base)
5961 int modifiers;
5962 Lisp_Object base;
5964 Lisp_Object cache, index, entry, new_symbol;
5966 /* Mask out upper bits. We don't know where this value's been. */
5967 modifiers &= VALMASK;
5969 /* The click modifier never figures into cache indices. */
5970 cache = Fget (base, Qmodifier_cache);
5971 XSETFASTINT (index, (modifiers & ~click_modifier));
5972 entry = assq_no_quit (index, cache);
5974 if (CONSP (entry))
5975 new_symbol = XCDR (entry);
5976 else
5978 /* We have to create the symbol ourselves. */
5979 new_symbol = apply_modifiers_uncached (modifiers,
5980 SDATA (SYMBOL_NAME (base)),
5981 SCHARS (SYMBOL_NAME (base)),
5982 SBYTES (SYMBOL_NAME (base)));
5984 /* Add the new symbol to the base's cache. */
5985 entry = Fcons (index, new_symbol);
5986 Fput (base, Qmodifier_cache, Fcons (entry, cache));
5988 /* We have the parsing info now for free, so add it to the caches. */
5989 XSETFASTINT (index, modifiers);
5990 Fput (new_symbol, Qevent_symbol_element_mask,
5991 Fcons (base, Fcons (index, Qnil)));
5992 Fput (new_symbol, Qevent_symbol_elements,
5993 Fcons (base, lispy_modifier_list (modifiers)));
5996 /* Make sure this symbol is of the same kind as BASE.
5998 You'd think we could just set this once and for all when we
5999 intern the symbol above, but reorder_modifiers may call us when
6000 BASE's property isn't set right; we can't assume that just
6001 because it has a Qmodifier_cache property it must have its
6002 Qevent_kind set right as well. */
6003 if (NILP (Fget (new_symbol, Qevent_kind)))
6005 Lisp_Object kind;
6007 kind = Fget (base, Qevent_kind);
6008 if (! NILP (kind))
6009 Fput (new_symbol, Qevent_kind, kind);
6012 return new_symbol;
6016 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
6017 return a symbol with the modifiers placed in the canonical order.
6018 Canonical order is alphabetical, except for down and drag, which
6019 always come last. The 'click' modifier is never written out.
6021 Fdefine_key calls this to make sure that (for example) C-M-foo
6022 and M-C-foo end up being equivalent in the keymap. */
6024 Lisp_Object
6025 reorder_modifiers (symbol)
6026 Lisp_Object symbol;
6028 /* It's hopefully okay to write the code this way, since everything
6029 will soon be in caches, and no consing will be done at all. */
6030 Lisp_Object parsed;
6032 parsed = parse_modifiers (symbol);
6033 return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))),
6034 XCAR (parsed));
6038 /* For handling events, we often want to produce a symbol whose name
6039 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
6040 to some base, like the name of a function key or mouse button.
6041 modify_event_symbol produces symbols of this sort.
6043 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
6044 is the name of the i'th symbol. TABLE_SIZE is the number of elements
6045 in the table.
6047 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
6048 into symbol names, or a string specifying a name stem used to
6049 construct a symbol name or the form `STEM-N', where N is the decimal
6050 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
6051 non-nil; otherwise NAME_TABLE is used.
6053 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
6054 persist between calls to modify_event_symbol that it can use to
6055 store a cache of the symbols it's generated for this NAME_TABLE
6056 before. The object stored there may be a vector or an alist.
6058 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
6060 MODIFIERS is a set of modifier bits (as given in struct input_events)
6061 whose prefixes should be applied to the symbol name.
6063 SYMBOL_KIND is the value to be placed in the event_kind property of
6064 the returned symbol.
6066 The symbols we create are supposed to have an
6067 `event-symbol-elements' property, which lists the modifiers present
6068 in the symbol's name. */
6070 static Lisp_Object
6071 modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist_or_stem,
6072 name_table, symbol_table, table_size)
6073 int symbol_num;
6074 unsigned modifiers;
6075 Lisp_Object symbol_kind;
6076 Lisp_Object name_alist_or_stem;
6077 char **name_table;
6078 Lisp_Object *symbol_table;
6079 unsigned int table_size;
6081 Lisp_Object value;
6082 Lisp_Object symbol_int;
6084 /* Get rid of the "vendor-specific" bit here. */
6085 XSETINT (symbol_int, symbol_num & 0xffffff);
6087 /* Is this a request for a valid symbol? */
6088 if (symbol_num < 0 || symbol_num >= table_size)
6089 return Qnil;
6091 if (CONSP (*symbol_table))
6092 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
6094 /* If *symbol_table doesn't seem to be initialized properly, fix that.
6095 *symbol_table should be a lisp vector TABLE_SIZE elements long,
6096 where the Nth element is the symbol for NAME_TABLE[N], or nil if
6097 we've never used that symbol before. */
6098 else
6100 if (! VECTORP (*symbol_table)
6101 || XVECTOR (*symbol_table)->size != table_size)
6103 Lisp_Object size;
6105 XSETFASTINT (size, table_size);
6106 *symbol_table = Fmake_vector (size, Qnil);
6109 value = XVECTOR (*symbol_table)->contents[symbol_num];
6112 /* Have we already used this symbol before? */
6113 if (NILP (value))
6115 /* No; let's create it. */
6116 if (CONSP (name_alist_or_stem))
6117 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
6118 else if (STRINGP (name_alist_or_stem))
6120 int len = SBYTES (name_alist_or_stem);
6121 char *buf = (char *) alloca (len + 50);
6122 if (sizeof (int) == sizeof (EMACS_INT))
6123 sprintf (buf, "%s-%d", SDATA (name_alist_or_stem),
6124 XINT (symbol_int) + 1);
6125 else if (sizeof (long) == sizeof (EMACS_INT))
6126 sprintf (buf, "%s-%ld", SDATA (name_alist_or_stem),
6127 XINT (symbol_int) + 1);
6128 value = intern (buf);
6130 else if (name_table != 0 && name_table[symbol_num])
6131 value = intern (name_table[symbol_num]);
6133 #ifdef HAVE_WINDOW_SYSTEM
6134 if (NILP (value))
6136 char *name = x_get_keysym_name (symbol_num);
6137 if (name)
6138 value = intern (name);
6140 #endif
6142 if (NILP (value))
6144 char buf[20];
6145 sprintf (buf, "key-%d", symbol_num);
6146 value = intern (buf);
6149 if (CONSP (*symbol_table))
6150 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
6151 else
6152 XVECTOR (*symbol_table)->contents[symbol_num] = value;
6154 /* Fill in the cache entries for this symbol; this also
6155 builds the Qevent_symbol_elements property, which the user
6156 cares about. */
6157 apply_modifiers (modifiers & click_modifier, value);
6158 Fput (value, Qevent_kind, symbol_kind);
6161 /* Apply modifiers to that symbol. */
6162 return apply_modifiers (modifiers, value);
6165 /* Convert a list that represents an event type,
6166 such as (ctrl meta backspace), into the usual representation of that
6167 event type as a number or a symbol. */
6169 DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
6170 doc: /* Convert the event description list EVENT-DESC to an event type.
6171 EVENT-DESC should contain one base event type (a character or symbol)
6172 and zero or more modifier names (control, meta, hyper, super, shift, alt,
6173 drag, down, double or triple). The base must be last.
6174 The return value is an event type (a character or symbol) which
6175 has the same base event type and all the specified modifiers. */)
6176 (event_desc)
6177 Lisp_Object event_desc;
6179 Lisp_Object base;
6180 int modifiers = 0;
6181 Lisp_Object rest;
6183 base = Qnil;
6184 rest = event_desc;
6185 while (CONSP (rest))
6187 Lisp_Object elt;
6188 int this = 0;
6190 elt = XCAR (rest);
6191 rest = XCDR (rest);
6193 /* Given a symbol, see if it is a modifier name. */
6194 if (SYMBOLP (elt) && CONSP (rest))
6195 this = parse_solitary_modifier (elt);
6197 if (this != 0)
6198 modifiers |= this;
6199 else if (!NILP (base))
6200 error ("Two bases given in one event");
6201 else
6202 base = elt;
6206 /* Let the symbol A refer to the character A. */
6207 if (SYMBOLP (base) && SCHARS (SYMBOL_NAME (base)) == 1)
6208 XSETINT (base, SREF (SYMBOL_NAME (base), 0));
6210 if (INTEGERP (base))
6212 /* Turn (shift a) into A. */
6213 if ((modifiers & shift_modifier) != 0
6214 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
6216 XSETINT (base, XINT (base) - ('a' - 'A'));
6217 modifiers &= ~shift_modifier;
6220 /* Turn (control a) into C-a. */
6221 if (modifiers & ctrl_modifier)
6222 return make_number ((modifiers & ~ctrl_modifier)
6223 | make_ctrl_char (XINT (base)));
6224 else
6225 return make_number (modifiers | XINT (base));
6227 else if (SYMBOLP (base))
6228 return apply_modifiers (modifiers, base);
6229 else
6231 error ("Invalid base event");
6232 return Qnil;
6236 /* Try to recognize SYMBOL as a modifier name.
6237 Return the modifier flag bit, or 0 if not recognized. */
6239 static int
6240 parse_solitary_modifier (symbol)
6241 Lisp_Object symbol;
6243 Lisp_Object name = SYMBOL_NAME (symbol);
6245 switch (SREF (name, 0))
6247 #define SINGLE_LETTER_MOD(BIT) \
6248 if (SBYTES (name) == 1) \
6249 return BIT;
6251 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6252 if (LEN == SBYTES (name) \
6253 && ! strncmp (SDATA (name), NAME, LEN)) \
6254 return BIT;
6256 case 'A':
6257 SINGLE_LETTER_MOD (alt_modifier);
6258 break;
6260 case 'a':
6261 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
6262 break;
6264 case 'C':
6265 SINGLE_LETTER_MOD (ctrl_modifier);
6266 break;
6268 case 'c':
6269 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
6270 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
6271 break;
6273 case 'H':
6274 SINGLE_LETTER_MOD (hyper_modifier);
6275 break;
6277 case 'h':
6278 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
6279 break;
6281 case 'M':
6282 SINGLE_LETTER_MOD (meta_modifier);
6283 break;
6285 case 'm':
6286 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
6287 break;
6289 case 'S':
6290 SINGLE_LETTER_MOD (shift_modifier);
6291 break;
6293 case 's':
6294 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
6295 MULTI_LETTER_MOD (super_modifier, "super", 5);
6296 SINGLE_LETTER_MOD (super_modifier);
6297 break;
6299 case 'd':
6300 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6301 MULTI_LETTER_MOD (down_modifier, "down", 4);
6302 MULTI_LETTER_MOD (double_modifier, "double", 6);
6303 break;
6305 case 't':
6306 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6307 break;
6309 #undef SINGLE_LETTER_MOD
6310 #undef MULTI_LETTER_MOD
6313 return 0;
6316 /* Return 1 if EVENT is a list whose elements are all integers or symbols.
6317 Such a list is not valid as an event,
6318 but it can be a Lucid-style event type list. */
6321 lucid_event_type_list_p (object)
6322 Lisp_Object object;
6324 Lisp_Object tail;
6326 if (! CONSP (object))
6327 return 0;
6329 if (EQ (XCAR (object), Qhelp_echo)
6330 || EQ (XCAR (object), Qvertical_line)
6331 || EQ (XCAR (object), Qmode_line)
6332 || EQ (XCAR (object), Qheader_line))
6333 return 0;
6335 for (tail = object; CONSP (tail); tail = XCDR (tail))
6337 Lisp_Object elt;
6338 elt = XCAR (tail);
6339 if (! (INTEGERP (elt) || SYMBOLP (elt)))
6340 return 0;
6343 return NILP (tail);
6346 /* Store into *addr a value nonzero if terminal input chars are available.
6347 Serves the purpose of ioctl (0, FIONREAD, addr)
6348 but works even if FIONREAD does not exist.
6349 (In fact, this may actually read some input.)
6351 If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe.
6352 If FILTER_EVENTS is nonzero, ignore internal events (FOCUS_IN_EVENT). */
6354 static void
6355 get_filtered_input_pending (addr, do_timers_now, filter_events)
6356 int *addr;
6357 int do_timers_now;
6358 int filter_events;
6360 /* First of all, have we already counted some input? */
6361 *addr = (!NILP (Vquit_flag)
6362 || readable_filtered_events (do_timers_now, filter_events));
6364 /* If input is being read as it arrives, and we have none, there is none. */
6365 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
6366 return;
6368 /* Try to read some input and see how much we get. */
6369 gobble_input (0);
6370 *addr = (!NILP (Vquit_flag)
6371 || readable_filtered_events (do_timers_now, filter_events));
6374 /* Store into *addr a value nonzero if terminal input chars are available.
6375 Serves the purpose of ioctl (0, FIONREAD, addr)
6376 but works even if FIONREAD does not exist.
6377 (In fact, this may actually read some input.)
6379 If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe. */
6381 static void
6382 get_input_pending (addr, do_timers_now)
6383 int *addr;
6384 int do_timers_now;
6386 get_filtered_input_pending (addr, do_timers_now, 0);
6389 /* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
6391 void
6392 gobble_input (expected)
6393 int expected;
6395 #ifndef VMS
6396 #ifdef SIGIO
6397 if (interrupt_input)
6399 SIGMASKTYPE mask;
6400 mask = sigblock (sigmask (SIGIO));
6401 read_avail_input (expected);
6402 sigsetmask (mask);
6404 else
6405 #ifdef POLL_FOR_INPUT
6406 if (read_socket_hook && !interrupt_input && poll_suppress_count == 0)
6408 SIGMASKTYPE mask;
6409 mask = sigblock (sigmask (SIGALRM));
6410 read_avail_input (expected);
6411 sigsetmask (mask);
6413 else
6414 #endif
6415 #endif
6416 read_avail_input (expected);
6417 #endif
6420 /* Put a BUFFER_SWITCH_EVENT in the buffer
6421 so that read_key_sequence will notice the new current buffer. */
6423 void
6424 record_asynch_buffer_change ()
6426 struct input_event event;
6427 Lisp_Object tem;
6429 event.kind = BUFFER_SWITCH_EVENT;
6430 event.frame_or_window = Qnil;
6431 event.arg = Qnil;
6433 #ifdef subprocesses
6434 /* We don't need a buffer-switch event unless Emacs is waiting for input.
6435 The purpose of the event is to make read_key_sequence look up the
6436 keymaps again. If we aren't in read_key_sequence, we don't need one,
6437 and the event could cause trouble by messing up (input-pending-p). */
6438 tem = Fwaiting_for_user_input_p ();
6439 if (NILP (tem))
6440 return;
6441 #else
6442 /* We never need these events if we have no asynchronous subprocesses. */
6443 return;
6444 #endif
6446 /* Make sure no interrupt happens while storing the event. */
6447 #ifdef SIGIO
6448 if (interrupt_input)
6450 SIGMASKTYPE mask;
6451 mask = sigblock (sigmask (SIGIO));
6452 kbd_buffer_store_event (&event);
6453 sigsetmask (mask);
6455 else
6456 #endif
6458 stop_polling ();
6459 kbd_buffer_store_event (&event);
6460 start_polling ();
6464 #ifndef VMS
6466 /* Read any terminal input already buffered up by the system
6467 into the kbd_buffer, but do not wait.
6469 EXPECTED should be nonzero if the caller knows there is some input.
6471 Except on VMS, all input is read by this function.
6472 If interrupt_input is nonzero, this function MUST be called
6473 only when SIGIO is blocked.
6475 Returns the number of keyboard chars read, or -1 meaning
6476 this is a bad time to try to read input. */
6478 static int
6479 read_avail_input (expected)
6480 int expected;
6482 struct input_event buf[KBD_BUFFER_SIZE];
6483 register int i;
6484 int nread;
6486 if (read_socket_hook)
6487 /* No need for FIONREAD or fcntl; just say don't wait. */
6488 nread = (*read_socket_hook) (input_fd, buf, KBD_BUFFER_SIZE, expected);
6489 else
6491 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
6492 the kbd_buffer can really hold. That may prevent loss
6493 of characters on some systems when input is stuffed at us. */
6494 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
6495 int n_to_read;
6497 /* Determine how many characters we should *try* to read. */
6498 #ifdef WINDOWSNT
6499 return 0;
6500 #else /* not WINDOWSNT */
6501 #ifdef MSDOS
6502 n_to_read = dos_keysns ();
6503 if (n_to_read == 0)
6504 return 0;
6505 #else /* not MSDOS */
6506 #ifdef FIONREAD
6507 /* Find out how much input is available. */
6508 if (ioctl (input_fd, FIONREAD, &n_to_read) < 0)
6509 /* Formerly simply reported no input, but that sometimes led to
6510 a failure of Emacs to terminate.
6511 SIGHUP seems appropriate if we can't reach the terminal. */
6512 /* ??? Is it really right to send the signal just to this process
6513 rather than to the whole process group?
6514 Perhaps on systems with FIONREAD Emacs is alone in its group. */
6515 kill (getpid (), SIGHUP);
6516 if (n_to_read == 0)
6517 return 0;
6518 if (n_to_read > sizeof cbuf)
6519 n_to_read = sizeof cbuf;
6520 #else /* no FIONREAD */
6521 #if defined (USG) || defined (DGUX)
6522 /* Read some input if available, but don't wait. */
6523 n_to_read = sizeof cbuf;
6524 fcntl (input_fd, F_SETFL, O_NDELAY);
6525 #else
6526 you lose;
6527 #endif
6528 #endif
6529 #endif /* not MSDOS */
6530 #endif /* not WINDOWSNT */
6532 /* Now read; for one reason or another, this will not block.
6533 NREAD is set to the number of chars read. */
6536 #ifdef MSDOS
6537 cbuf[0] = dos_keyread ();
6538 nread = 1;
6539 #else
6540 nread = emacs_read (input_fd, cbuf, n_to_read);
6541 #endif
6542 /* POSIX infers that processes which are not in the session leader's
6543 process group won't get SIGHUP's at logout time. BSDI adheres to
6544 this part standard and returns -1 from read (0) with errno==EIO
6545 when the control tty is taken away.
6546 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
6547 if (nread == -1 && errno == EIO)
6548 kill (0, SIGHUP);
6549 #if defined (AIX) && (! defined (aix386) && defined (_BSD))
6550 /* The kernel sometimes fails to deliver SIGHUP for ptys.
6551 This looks incorrect, but it isn't, because _BSD causes
6552 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
6553 and that causes a value other than 0 when there is no input. */
6554 if (nread == 0)
6555 kill (0, SIGHUP);
6556 #endif
6558 while (
6559 /* We used to retry the read if it was interrupted.
6560 But this does the wrong thing when O_NDELAY causes
6561 an EAGAIN error. Does anybody know of a situation
6562 where a retry is actually needed? */
6563 #if 0
6564 nread < 0 && (errno == EAGAIN
6565 #ifdef EFAULT
6566 || errno == EFAULT
6567 #endif
6568 #ifdef EBADSLT
6569 || errno == EBADSLT
6570 #endif
6572 #else
6574 #endif
6577 #ifndef FIONREAD
6578 #if defined (USG) || defined (DGUX)
6579 fcntl (input_fd, F_SETFL, 0);
6580 #endif /* USG or DGUX */
6581 #endif /* no FIONREAD */
6582 for (i = 0; i < nread; i++)
6584 buf[i].kind = ASCII_KEYSTROKE_EVENT;
6585 buf[i].modifiers = 0;
6586 if (meta_key == 1 && (cbuf[i] & 0x80))
6587 buf[i].modifiers = meta_modifier;
6588 if (meta_key != 2)
6589 cbuf[i] &= ~0x80;
6591 buf[i].code = cbuf[i];
6592 buf[i].frame_or_window = selected_frame;
6593 buf[i].arg = Qnil;
6597 /* Scan the chars for C-g and store them in kbd_buffer. */
6598 for (i = 0; i < nread; i++)
6600 kbd_buffer_store_event (&buf[i]);
6601 /* Don't look at input that follows a C-g too closely.
6602 This reduces lossage due to autorepeat on C-g. */
6603 if (buf[i].kind == ASCII_KEYSTROKE_EVENT
6604 && buf[i].code == quit_char)
6605 break;
6608 return nread;
6610 #endif /* not VMS */
6612 #ifdef SIGIO /* for entire page */
6613 /* Note SIGIO has been undef'd if FIONREAD is missing. */
6615 SIGTYPE
6616 input_available_signal (signo)
6617 int signo;
6619 /* Must preserve main program's value of errno. */
6620 int old_errno = errno;
6621 #ifdef BSD4_1
6622 extern int select_alarmed;
6623 #endif
6625 #if defined (USG) && !defined (POSIX_SIGNALS)
6626 /* USG systems forget handlers when they are used;
6627 must reestablish each time */
6628 signal (signo, input_available_signal);
6629 #endif /* USG */
6631 #ifdef BSD4_1
6632 sigisheld (SIGIO);
6633 #endif
6635 if (input_available_clear_time)
6636 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
6638 while (1)
6640 int nread;
6641 nread = read_avail_input (1);
6642 /* -1 means it's not ok to read the input now.
6643 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
6644 0 means there was no keyboard input available. */
6645 if (nread <= 0)
6646 break;
6648 #ifdef BSD4_1
6649 select_alarmed = 1; /* Force the select emulator back to life */
6650 #endif
6653 #ifdef BSD4_1
6654 sigfree ();
6655 #endif
6656 errno = old_errno;
6658 #endif /* SIGIO */
6660 /* Send ourselves a SIGIO.
6662 This function exists so that the UNBLOCK_INPUT macro in
6663 blockinput.h can have some way to take care of input we put off
6664 dealing with, without assuming that every file which uses
6665 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
6666 void
6667 reinvoke_input_signal ()
6669 #ifdef SIGIO
6670 kill (getpid (), SIGIO);
6671 #endif
6676 static void menu_bar_item P_ ((Lisp_Object, Lisp_Object));
6677 static void menu_bar_one_keymap P_ ((Lisp_Object));
6679 /* These variables hold the vector under construction within
6680 menu_bar_items and its subroutines, and the current index
6681 for storing into that vector. */
6682 static Lisp_Object menu_bar_items_vector;
6683 static int menu_bar_items_index;
6685 /* Return a vector of menu items for a menu bar, appropriate
6686 to the current buffer. Each item has three elements in the vector:
6687 KEY STRING MAPLIST.
6689 OLD is an old vector we can optionally reuse, or nil. */
6691 Lisp_Object
6692 menu_bar_items (old)
6693 Lisp_Object old;
6695 /* The number of keymaps we're scanning right now, and the number of
6696 keymaps we have allocated space for. */
6697 int nmaps;
6699 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
6700 in the current keymaps, or nil where it is not a prefix. */
6701 Lisp_Object *maps;
6703 Lisp_Object def, tail;
6705 Lisp_Object result;
6707 int mapno;
6708 Lisp_Object oquit;
6710 int i;
6712 struct gcpro gcpro1;
6714 /* In order to build the menus, we need to call the keymap
6715 accessors. They all call QUIT. But this function is called
6716 during redisplay, during which a quit is fatal. So inhibit
6717 quitting while building the menus.
6718 We do this instead of specbind because (1) errors will clear it anyway
6719 and (2) this avoids risk of specpdl overflow. */
6720 oquit = Vinhibit_quit;
6721 Vinhibit_quit = Qt;
6723 if (!NILP (old))
6724 menu_bar_items_vector = old;
6725 else
6726 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
6727 menu_bar_items_index = 0;
6729 GCPRO1 (menu_bar_items_vector);
6731 /* Build our list of keymaps.
6732 If we recognize a function key and replace its escape sequence in
6733 keybuf with its symbol, or if the sequence starts with a mouse
6734 click and we need to switch buffers, we jump back here to rebuild
6735 the initial keymaps from the current buffer. */
6737 Lisp_Object *tmaps;
6739 /* Should overriding-terminal-local-map and overriding-local-map apply? */
6740 if (!NILP (Voverriding_local_map_menu_flag))
6742 /* Yes, use them (if non-nil) as well as the global map. */
6743 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
6744 nmaps = 0;
6745 if (!NILP (current_kboard->Voverriding_terminal_local_map))
6746 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
6747 if (!NILP (Voverriding_local_map))
6748 maps[nmaps++] = Voverriding_local_map;
6750 else
6752 /* No, so use major and minor mode keymaps and keymap property.
6753 Note that menu-bar bindings in the local-map and keymap
6754 properties may not work reliable, as they are only
6755 recognized when the menu-bar (or mode-line) is updated,
6756 which does not normally happen after every command. */
6757 Lisp_Object tem;
6758 int nminor;
6759 nminor = current_minor_maps (NULL, &tmaps);
6760 maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
6761 nmaps = 0;
6762 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
6763 maps[nmaps++] = tem;
6764 bcopy (tmaps, (void *) (maps + nmaps), nminor * sizeof (maps[0]));
6765 nmaps += nminor;
6766 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
6768 maps[nmaps++] = current_global_map;
6771 /* Look up in each map the dummy prefix key `menu-bar'. */
6773 result = Qnil;
6775 for (mapno = nmaps - 1; mapno >= 0; mapno--)
6776 if (!NILP (maps[mapno]))
6778 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
6779 0, 1);
6780 if (CONSP (def))
6781 menu_bar_one_keymap (def);
6784 /* Move to the end those items that should be at the end. */
6786 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
6788 int i;
6789 int end = menu_bar_items_index;
6791 for (i = 0; i < end; i += 4)
6792 if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i]))
6794 Lisp_Object tem0, tem1, tem2, tem3;
6795 /* Move the item at index I to the end,
6796 shifting all the others forward. */
6797 tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
6798 tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
6799 tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
6800 tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
6801 if (end > i + 4)
6802 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
6803 &XVECTOR (menu_bar_items_vector)->contents[i],
6804 (end - i - 4) * sizeof (Lisp_Object));
6805 XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
6806 XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
6807 XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
6808 XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
6809 break;
6813 /* Add nil, nil, nil, nil at the end. */
6814 i = menu_bar_items_index;
6815 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
6817 Lisp_Object tem;
6818 tem = Fmake_vector (make_number (2 * i), Qnil);
6819 bcopy (XVECTOR (menu_bar_items_vector)->contents,
6820 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
6821 menu_bar_items_vector = tem;
6823 /* Add this item. */
6824 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6825 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6826 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6827 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6828 menu_bar_items_index = i;
6830 Vinhibit_quit = oquit;
6831 UNGCPRO;
6832 return menu_bar_items_vector;
6835 /* Scan one map KEYMAP, accumulating any menu items it defines
6836 in menu_bar_items_vector. */
6838 static Lisp_Object menu_bar_one_keymap_changed_items;
6840 static void
6841 menu_bar_one_keymap (keymap)
6842 Lisp_Object keymap;
6844 Lisp_Object tail, item;
6846 menu_bar_one_keymap_changed_items = Qnil;
6848 /* Loop over all keymap entries that have menu strings. */
6849 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
6851 item = XCAR (tail);
6852 if (CONSP (item))
6853 menu_bar_item (XCAR (item), XCDR (item));
6854 else if (VECTORP (item))
6856 /* Loop over the char values represented in the vector. */
6857 int len = XVECTOR (item)->size;
6858 int c;
6859 for (c = 0; c < len; c++)
6861 Lisp_Object character;
6862 XSETFASTINT (character, c);
6863 menu_bar_item (character, XVECTOR (item)->contents[c]);
6869 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
6870 If there's already an item for KEY, add this DEF to it. */
6872 Lisp_Object item_properties;
6874 static void
6875 menu_bar_item (key, item)
6876 Lisp_Object key, item;
6878 struct gcpro gcpro1;
6879 int i;
6880 Lisp_Object tem;
6882 if (EQ (item, Qundefined))
6884 /* If a map has an explicit `undefined' as definition,
6885 discard any previously made menu bar item. */
6887 for (i = 0; i < menu_bar_items_index; i += 4)
6888 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
6890 if (menu_bar_items_index > i + 4)
6891 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
6892 &XVECTOR (menu_bar_items_vector)->contents[i],
6893 (menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
6894 menu_bar_items_index -= 4;
6898 /* If this keymap has already contributed to this KEY,
6899 don't contribute to it a second time. */
6900 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
6901 if (!NILP (tem) || NILP (item))
6902 return;
6904 menu_bar_one_keymap_changed_items
6905 = Fcons (key, menu_bar_one_keymap_changed_items);
6907 /* We add to menu_bar_one_keymap_changed_items before doing the
6908 parse_menu_item, so that if it turns out it wasn't a menu item,
6909 it still correctly hides any further menu item. */
6910 GCPRO1 (key);
6911 i = parse_menu_item (item, 0, 1);
6912 UNGCPRO;
6913 if (!i)
6914 return;
6916 item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
6918 /* Find any existing item for this KEY. */
6919 for (i = 0; i < menu_bar_items_index; i += 4)
6920 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
6921 break;
6923 /* If we did not find this KEY, add it at the end. */
6924 if (i == menu_bar_items_index)
6926 /* If vector is too small, get a bigger one. */
6927 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
6929 Lisp_Object tem;
6930 tem = Fmake_vector (make_number (2 * i), Qnil);
6931 bcopy (XVECTOR (menu_bar_items_vector)->contents,
6932 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
6933 menu_bar_items_vector = tem;
6936 /* Add this item. */
6937 XVECTOR (menu_bar_items_vector)->contents[i++] = key;
6938 XVECTOR (menu_bar_items_vector)->contents[i++]
6939 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
6940 XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
6941 XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
6942 menu_bar_items_index = i;
6944 /* We did find an item for this KEY. Add ITEM to its list of maps. */
6945 else
6947 Lisp_Object old;
6948 old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
6949 XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (item, old);
6953 /* This is used as the handler when calling menu_item_eval_property. */
6954 static Lisp_Object
6955 menu_item_eval_property_1 (arg)
6956 Lisp_Object arg;
6958 /* If we got a quit from within the menu computation,
6959 quit all the way out of it. This takes care of C-] in the debugger. */
6960 if (CONSP (arg) && EQ (XCAR (arg), Qquit))
6961 Fsignal (Qquit, Qnil);
6963 return Qnil;
6966 /* Evaluate an expression and return the result (or nil if something
6967 went wrong). Used to evaluate dynamic parts of menu items. */
6968 Lisp_Object
6969 menu_item_eval_property (sexpr)
6970 Lisp_Object sexpr;
6972 int count = SPECPDL_INDEX ();
6973 Lisp_Object val;
6974 specbind (Qinhibit_redisplay, Qt);
6975 val = internal_condition_case_1 (Feval, sexpr, Qerror,
6976 menu_item_eval_property_1);
6977 return unbind_to (count, val);
6980 /* This function parses a menu item and leaves the result in the
6981 vector item_properties.
6982 ITEM is a key binding, a possible menu item.
6983 If NOTREAL is nonzero, only check for equivalent key bindings, don't
6984 evaluate dynamic expressions in the menu item.
6985 INMENUBAR is > 0 when this is considered for an entry in a menu bar
6986 top level.
6987 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
6988 parse_menu_item returns true if the item is a menu item and false
6989 otherwise. */
6992 parse_menu_item (item, notreal, inmenubar)
6993 Lisp_Object item;
6994 int notreal, inmenubar;
6996 Lisp_Object def, tem, item_string, start;
6997 Lisp_Object cachelist;
6998 Lisp_Object filter;
6999 Lisp_Object keyhint;
7000 int i;
7001 int newcache = 0;
7003 cachelist = Qnil;
7004 filter = Qnil;
7005 keyhint = Qnil;
7007 if (!CONSP (item))
7008 return 0;
7010 /* Create item_properties vector if necessary. */
7011 if (NILP (item_properties))
7012 item_properties
7013 = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
7015 /* Initialize optional entries. */
7016 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
7017 AREF (item_properties, i) = Qnil;
7018 AREF (item_properties, ITEM_PROPERTY_ENABLE) = Qt;
7020 /* Save the item here to protect it from GC. */
7021 AREF (item_properties, ITEM_PROPERTY_ITEM) = item;
7023 item_string = XCAR (item);
7025 start = item;
7026 item = XCDR (item);
7027 if (STRINGP (item_string))
7029 /* Old format menu item. */
7030 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
7032 /* Maybe help string. */
7033 if (CONSP (item) && STRINGP (XCAR (item)))
7035 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
7036 start = item;
7037 item = XCDR (item);
7040 /* Maybe key binding cache. */
7041 if (CONSP (item) && CONSP (XCAR (item))
7042 && (NILP (XCAR (XCAR (item)))
7043 || VECTORP (XCAR (XCAR (item)))))
7045 cachelist = XCAR (item);
7046 item = XCDR (item);
7049 /* This is the real definition--the function to run. */
7050 AREF (item_properties, ITEM_PROPERTY_DEF) = item;
7052 /* Get enable property, if any. */
7053 if (SYMBOLP (item))
7055 tem = Fget (item, Qmenu_enable);
7056 if (!NILP (tem))
7057 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
7060 else if (EQ (item_string, Qmenu_item) && CONSP (item))
7062 /* New format menu item. */
7063 AREF (item_properties, ITEM_PROPERTY_NAME) = XCAR (item);
7064 start = XCDR (item);
7065 if (CONSP (start))
7067 /* We have a real binding. */
7068 AREF (item_properties, ITEM_PROPERTY_DEF) = XCAR (start);
7070 item = XCDR (start);
7071 /* Is there a cache list with key equivalences. */
7072 if (CONSP (item) && CONSP (XCAR (item)))
7074 cachelist = XCAR (item);
7075 item = XCDR (item);
7078 /* Parse properties. */
7079 while (CONSP (item) && CONSP (XCDR (item)))
7081 tem = XCAR (item);
7082 item = XCDR (item);
7084 if (EQ (tem, QCenable))
7085 AREF (item_properties, ITEM_PROPERTY_ENABLE) = XCAR (item);
7086 else if (EQ (tem, QCvisible) && !notreal)
7088 /* If got a visible property and that evaluates to nil
7089 then ignore this item. */
7090 tem = menu_item_eval_property (XCAR (item));
7091 if (NILP (tem))
7092 return 0;
7094 else if (EQ (tem, QChelp))
7095 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
7096 else if (EQ (tem, QCfilter))
7097 filter = item;
7098 else if (EQ (tem, QCkey_sequence))
7100 tem = XCAR (item);
7101 if (NILP (cachelist)
7102 && (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem)))
7103 /* Be GC protected. Set keyhint to item instead of tem. */
7104 keyhint = item;
7106 else if (EQ (tem, QCkeys))
7108 tem = XCAR (item);
7109 if (CONSP (tem) || (STRINGP (tem) && NILP (cachelist)))
7110 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
7112 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
7114 Lisp_Object type;
7115 tem = XCAR (item);
7116 type = XCAR (tem);
7117 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7119 AREF (item_properties, ITEM_PROPERTY_SELECTED)
7120 = XCDR (tem);
7121 AREF (item_properties, ITEM_PROPERTY_TYPE)
7122 = type;
7125 item = XCDR (item);
7128 else if (inmenubar || !NILP (start))
7129 return 0;
7131 else
7132 return 0; /* not a menu item */
7134 /* If item string is not a string, evaluate it to get string.
7135 If we don't get a string, skip this item. */
7136 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
7137 if (!(STRINGP (item_string) || notreal))
7139 item_string = menu_item_eval_property (item_string);
7140 if (!STRINGP (item_string))
7141 return 0;
7142 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
7145 /* If got a filter apply it on definition. */
7146 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7147 if (!NILP (filter))
7149 def = menu_item_eval_property (list2 (XCAR (filter),
7150 list2 (Qquote, def)));
7152 AREF (item_properties, ITEM_PROPERTY_DEF) = def;
7155 /* Enable or disable selection of item. */
7156 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
7157 if (!EQ (tem, Qt))
7159 if (notreal)
7160 tem = Qt;
7161 else
7162 tem = menu_item_eval_property (tem);
7163 if (inmenubar && NILP (tem))
7164 return 0; /* Ignore disabled items in menu bar. */
7165 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
7168 /* If we got no definition, this item is just unselectable text which
7169 is OK in a submenu but not in the menubar. */
7170 if (NILP (def))
7171 return (inmenubar ? 0 : 1);
7173 /* See if this is a separate pane or a submenu. */
7174 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7175 tem = get_keymap (def, 0, 1);
7176 /* For a subkeymap, just record its details and exit. */
7177 if (CONSP (tem))
7179 AREF (item_properties, ITEM_PROPERTY_MAP) = tem;
7180 AREF (item_properties, ITEM_PROPERTY_DEF) = tem;
7181 return 1;
7184 /* At the top level in the menu bar, do likewise for commands also.
7185 The menu bar does not display equivalent key bindings anyway.
7186 ITEM_PROPERTY_DEF is already set up properly. */
7187 if (inmenubar > 0)
7188 return 1;
7190 /* This is a command. See if there is an equivalent key binding. */
7191 if (NILP (cachelist))
7193 /* We have to create a cachelist. */
7194 CHECK_IMPURE (start);
7195 XSETCDR (start, Fcons (Fcons (Qnil, Qnil), XCDR (start)));
7196 cachelist = XCAR (XCDR (start));
7197 newcache = 1;
7198 tem = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
7199 if (!NILP (keyhint))
7201 XSETCAR (cachelist, XCAR (keyhint));
7202 newcache = 0;
7204 else if (STRINGP (tem))
7206 XSETCDR (cachelist, Fsubstitute_command_keys (tem));
7207 XSETCAR (cachelist, Qt);
7211 tem = XCAR (cachelist);
7212 if (!EQ (tem, Qt))
7214 int chkcache = 0;
7215 Lisp_Object prefix;
7217 if (!NILP (tem))
7218 tem = Fkey_binding (tem, Qnil, Qnil);
7220 prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
7221 if (CONSP (prefix))
7223 def = XCAR (prefix);
7224 prefix = XCDR (prefix);
7226 else
7227 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7229 if (!update_menu_bindings)
7230 chkcache = 0;
7231 else if (NILP (XCAR (cachelist))) /* Have no saved key. */
7233 if (newcache /* Always check first time. */
7234 /* Should we check everything when precomputing key
7235 bindings? */
7236 /* If something had no key binding before, don't recheck it
7237 because that is too slow--except if we have a list of
7238 rebound commands in Vdefine_key_rebound_commands, do
7239 recheck any command that appears in that list. */
7240 || (CONSP (Vdefine_key_rebound_commands)
7241 && !NILP (Fmemq (def, Vdefine_key_rebound_commands))))
7242 chkcache = 1;
7244 /* We had a saved key. Is it still bound to the command? */
7245 else if (NILP (tem)
7246 || (!EQ (tem, def)
7247 /* If the command is an alias for another
7248 (such as lmenu.el set it up), check if the
7249 original command matches the cached command. */
7250 && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))))
7251 chkcache = 1; /* Need to recompute key binding. */
7253 if (chkcache)
7255 /* Recompute equivalent key binding. If the command is an alias
7256 for another (such as lmenu.el set it up), see if the original
7257 command name has equivalent keys. Otherwise look up the
7258 specified command itself. We don't try both, because that
7259 makes lmenu menus slow. */
7260 if (SYMBOLP (def)
7261 && SYMBOLP (XSYMBOL (def)->function)
7262 && ! NILP (Fget (def, Qmenu_alias)))
7263 def = XSYMBOL (def)->function;
7264 tem = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qt);
7265 XSETCAR (cachelist, tem);
7266 if (NILP (tem))
7268 XSETCDR (cachelist, Qnil);
7269 chkcache = 0;
7272 else if (!NILP (keyhint) && !NILP (XCAR (cachelist)))
7274 tem = XCAR (cachelist);
7275 chkcache = 1;
7278 newcache = chkcache;
7279 if (chkcache)
7281 tem = Fkey_description (tem);
7282 if (CONSP (prefix))
7284 if (STRINGP (XCAR (prefix)))
7285 tem = concat2 (XCAR (prefix), tem);
7286 if (STRINGP (XCDR (prefix)))
7287 tem = concat2 (tem, XCDR (prefix));
7289 XSETCDR (cachelist, tem);
7293 tem = XCDR (cachelist);
7294 if (newcache && !NILP (tem))
7296 tem = concat3 (build_string (" ("), tem, build_string (")"));
7297 XSETCDR (cachelist, tem);
7300 /* If we only want to precompute equivalent key bindings, stop here. */
7301 if (notreal)
7302 return 1;
7304 /* If we have an equivalent key binding, use that. */
7305 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
7307 /* Include this when menu help is implemented.
7308 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
7309 if (!(NILP (tem) || STRINGP (tem)))
7311 tem = menu_item_eval_property (tem);
7312 if (!STRINGP (tem))
7313 tem = Qnil;
7314 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
7318 /* Handle radio buttons or toggle boxes. */
7319 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
7320 if (!NILP (tem))
7321 AREF (item_properties, ITEM_PROPERTY_SELECTED)
7322 = menu_item_eval_property (tem);
7324 return 1;
7329 /***********************************************************************
7330 Tool-bars
7331 ***********************************************************************/
7333 /* A vector holding tool bar items while they are parsed in function
7334 tool_bar_items. Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
7335 in the vector. */
7337 static Lisp_Object tool_bar_items_vector;
7339 /* A vector holding the result of parse_tool_bar_item. Layout is like
7340 the one for a single item in tool_bar_items_vector. */
7342 static Lisp_Object tool_bar_item_properties;
7344 /* Next free index in tool_bar_items_vector. */
7346 static int ntool_bar_items;
7348 /* The symbols `tool-bar', and `:image'. */
7350 extern Lisp_Object Qtool_bar;
7351 Lisp_Object QCimage;
7353 /* Function prototypes. */
7355 static void init_tool_bar_items P_ ((Lisp_Object));
7356 static void process_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
7357 static int parse_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
7358 static void append_tool_bar_item P_ ((void));
7361 /* Return a vector of tool bar items for keymaps currently in effect.
7362 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
7363 tool bar items found. */
7365 Lisp_Object
7366 tool_bar_items (reuse, nitems)
7367 Lisp_Object reuse;
7368 int *nitems;
7370 Lisp_Object *maps;
7371 int nmaps, i;
7372 Lisp_Object oquit;
7373 Lisp_Object *tmaps;
7375 *nitems = 0;
7377 /* In order to build the menus, we need to call the keymap
7378 accessors. They all call QUIT. But this function is called
7379 during redisplay, during which a quit is fatal. So inhibit
7380 quitting while building the menus. We do this instead of
7381 specbind because (1) errors will clear it anyway and (2) this
7382 avoids risk of specpdl overflow. */
7383 oquit = Vinhibit_quit;
7384 Vinhibit_quit = Qt;
7386 /* Initialize tool_bar_items_vector and protect it from GC. */
7387 init_tool_bar_items (reuse);
7389 /* Build list of keymaps in maps. Set nmaps to the number of maps
7390 to process. */
7392 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7393 if (!NILP (Voverriding_local_map_menu_flag))
7395 /* Yes, use them (if non-nil) as well as the global map. */
7396 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
7397 nmaps = 0;
7398 if (!NILP (current_kboard->Voverriding_terminal_local_map))
7399 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
7400 if (!NILP (Voverriding_local_map))
7401 maps[nmaps++] = Voverriding_local_map;
7403 else
7405 /* No, so use major and minor mode keymaps and keymap property.
7406 Note that tool-bar bindings in the local-map and keymap
7407 properties may not work reliable, as they are only
7408 recognized when the tool-bar (or mode-line) is updated,
7409 which does not normally happen after every command. */
7410 Lisp_Object tem;
7411 int nminor;
7412 nminor = current_minor_maps (NULL, &tmaps);
7413 maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
7414 nmaps = 0;
7415 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
7416 maps[nmaps++] = tem;
7417 bcopy (tmaps, (void *) (maps + nmaps), nminor * sizeof (maps[0]));
7418 nmaps += nminor;
7419 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
7422 /* Add global keymap at the end. */
7423 maps[nmaps++] = current_global_map;
7425 /* Process maps in reverse order and look up in each map the prefix
7426 key `tool-bar'. */
7427 for (i = nmaps - 1; i >= 0; --i)
7428 if (!NILP (maps[i]))
7430 Lisp_Object keymap;
7432 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
7433 if (CONSP (keymap))
7435 Lisp_Object tail;
7437 /* KEYMAP is a list `(keymap (KEY . BINDING) ...)'. */
7438 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
7440 Lisp_Object keydef = XCAR (tail);
7441 if (CONSP (keydef))
7442 process_tool_bar_item (XCAR (keydef), XCDR (keydef));
7447 Vinhibit_quit = oquit;
7448 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
7449 return tool_bar_items_vector;
7453 /* Process the definition of KEY which is DEF. */
7455 static void
7456 process_tool_bar_item (key, def)
7457 Lisp_Object key, def;
7459 int i;
7460 extern Lisp_Object Qundefined;
7461 struct gcpro gcpro1, gcpro2;
7463 /* Protect KEY and DEF from GC because parse_tool_bar_item may call
7464 eval. */
7465 GCPRO2 (key, def);
7467 if (EQ (def, Qundefined))
7469 /* If a map has an explicit `undefined' as definition,
7470 discard any previously made item. */
7471 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
7473 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
7475 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
7477 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
7478 bcopy (v + TOOL_BAR_ITEM_NSLOTS, v,
7479 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
7480 * sizeof (Lisp_Object)));
7481 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
7482 break;
7486 else if (parse_tool_bar_item (key, def))
7487 /* Append a new tool bar item to tool_bar_items_vector. Accept
7488 more than one definition for the same key. */
7489 append_tool_bar_item ();
7491 UNGCPRO;
7495 /* Parse a tool bar item specification ITEM for key KEY and return the
7496 result in tool_bar_item_properties. Value is zero if ITEM is
7497 invalid.
7499 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
7501 CAPTION is the caption of the item, If it's not a string, it is
7502 evaluated to get a string.
7504 BINDING is the tool bar item's binding. Tool-bar items with keymaps
7505 as binding are currently ignored.
7507 The following properties are recognized:
7509 - `:enable FORM'.
7511 FORM is evaluated and specifies whether the tool bar item is
7512 enabled or disabled.
7514 - `:visible FORM'
7516 FORM is evaluated and specifies whether the tool bar item is visible.
7518 - `:filter FUNCTION'
7520 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
7521 result is stored as the new binding.
7523 - `:button (TYPE SELECTED)'
7525 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
7526 and specifies whether the button is selected (pressed) or not.
7528 - `:image IMAGES'
7530 IMAGES is either a single image specification or a vector of four
7531 image specifications. See enum tool_bar_item_images.
7533 - `:help HELP-STRING'.
7535 Gives a help string to display for the tool bar item. */
7537 static int
7538 parse_tool_bar_item (key, item)
7539 Lisp_Object key, item;
7541 /* Access slot with index IDX of vector tool_bar_item_properties. */
7542 #define PROP(IDX) XVECTOR (tool_bar_item_properties)->contents[IDX]
7544 Lisp_Object filter = Qnil;
7545 Lisp_Object caption;
7546 int i;
7548 /* Defininition looks like `(menu-item CAPTION BINDING PROPS...)'.
7549 Rule out items that aren't lists, don't start with
7550 `menu-item' or whose rest following `tool-bar-item' is not a
7551 list. */
7552 if (!CONSP (item)
7553 || !EQ (XCAR (item), Qmenu_item)
7554 || (item = XCDR (item),
7555 !CONSP (item)))
7556 return 0;
7558 /* Create tool_bar_item_properties vector if necessary. Reset it to
7559 defaults. */
7560 if (VECTORP (tool_bar_item_properties))
7562 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
7563 PROP (i) = Qnil;
7565 else
7566 tool_bar_item_properties
7567 = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
7569 /* Set defaults. */
7570 PROP (TOOL_BAR_ITEM_KEY) = key;
7571 PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
7573 /* Get the caption of the item. If the caption is not a string,
7574 evaluate it to get a string. If we don't get a string, skip this
7575 item. */
7576 caption = XCAR (item);
7577 if (!STRINGP (caption))
7579 caption = menu_item_eval_property (caption);
7580 if (!STRINGP (caption))
7581 return 0;
7583 PROP (TOOL_BAR_ITEM_CAPTION) = caption;
7585 /* Give up if rest following the caption is not a list. */
7586 item = XCDR (item);
7587 if (!CONSP (item))
7588 return 0;
7590 /* Store the binding. */
7591 PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item);
7592 item = XCDR (item);
7594 /* Ignore cached key binding, if any. */
7595 if (CONSP (item) && CONSP (XCAR (item)))
7596 item = XCDR (item);
7598 /* Process the rest of the properties. */
7599 for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
7601 Lisp_Object key, value;
7603 key = XCAR (item);
7604 value = XCAR (XCDR (item));
7606 if (EQ (key, QCenable))
7607 /* `:enable FORM'. */
7608 PROP (TOOL_BAR_ITEM_ENABLED_P) = value;
7609 else if (EQ (key, QCvisible))
7611 /* `:visible FORM'. If got a visible property and that
7612 evaluates to nil then ignore this item. */
7613 if (NILP (menu_item_eval_property (value)))
7614 return 0;
7616 else if (EQ (key, QChelp))
7617 /* `:help HELP-STRING'. */
7618 PROP (TOOL_BAR_ITEM_HELP) = value;
7619 else if (EQ (key, QCfilter))
7620 /* ':filter FORM'. */
7621 filter = value;
7622 else if (EQ (key, QCbutton) && CONSP (value))
7624 /* `:button (TYPE . SELECTED)'. */
7625 Lisp_Object type, selected;
7627 type = XCAR (value);
7628 selected = XCDR (value);
7629 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7631 PROP (TOOL_BAR_ITEM_SELECTED_P) = selected;
7632 PROP (TOOL_BAR_ITEM_TYPE) = type;
7635 else if (EQ (key, QCimage)
7636 && (CONSP (value)
7637 || (VECTORP (value) && XVECTOR (value)->size == 4)))
7638 /* Value is either a single image specification or a vector
7639 of 4 such specifications for the different button states. */
7640 PROP (TOOL_BAR_ITEM_IMAGES) = value;
7643 /* If got a filter apply it on binding. */
7644 if (!NILP (filter))
7645 PROP (TOOL_BAR_ITEM_BINDING)
7646 = menu_item_eval_property (list2 (filter,
7647 list2 (Qquote,
7648 PROP (TOOL_BAR_ITEM_BINDING))));
7650 /* See if the binding is a keymap. Give up if it is. */
7651 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
7652 return 0;
7654 /* Enable or disable selection of item. */
7655 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
7656 PROP (TOOL_BAR_ITEM_ENABLED_P)
7657 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P));
7659 /* Handle radio buttons or toggle boxes. */
7660 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
7661 PROP (TOOL_BAR_ITEM_SELECTED_P)
7662 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P));
7664 return 1;
7666 #undef PROP
7670 /* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
7671 that can be reused. */
7673 static void
7674 init_tool_bar_items (reuse)
7675 Lisp_Object reuse;
7677 if (VECTORP (reuse))
7678 tool_bar_items_vector = reuse;
7679 else
7680 tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
7681 ntool_bar_items = 0;
7685 /* Append parsed tool bar item properties from
7686 tool_bar_item_properties */
7688 static void
7689 append_tool_bar_item ()
7691 Lisp_Object *to, *from;
7693 /* Enlarge tool_bar_items_vector if necessary. */
7694 if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
7695 >= XVECTOR (tool_bar_items_vector)->size)
7697 Lisp_Object new_vector;
7698 int old_size = XVECTOR (tool_bar_items_vector)->size;
7700 new_vector = Fmake_vector (make_number (2 * old_size), Qnil);
7701 bcopy (XVECTOR (tool_bar_items_vector)->contents,
7702 XVECTOR (new_vector)->contents,
7703 old_size * sizeof (Lisp_Object));
7704 tool_bar_items_vector = new_vector;
7707 /* Append entries from tool_bar_item_properties to the end of
7708 tool_bar_items_vector. */
7709 to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
7710 from = XVECTOR (tool_bar_item_properties)->contents;
7711 bcopy (from, to, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
7712 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
7719 /* Read a character using menus based on maps in the array MAPS.
7720 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
7721 Return t if we displayed a menu but the user rejected it.
7723 PREV_EVENT is the previous input event, or nil if we are reading
7724 the first event of a key sequence.
7726 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
7727 if we used a mouse menu to read the input, or zero otherwise. If
7728 USED_MOUSE_MENU is null, we don't dereference it.
7730 The prompting is done based on the prompt-string of the map
7731 and the strings associated with various map elements.
7733 This can be done with X menus or with menus put in the minibuf.
7734 These are done in different ways, depending on how the input will be read.
7735 Menus using X are done after auto-saving in read-char, getting the input
7736 event from Fx_popup_menu; menus using the minibuf use read_char recursively
7737 and do auto-saving in the inner call of read_char. */
7739 static Lisp_Object
7740 read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
7741 int nmaps;
7742 Lisp_Object *maps;
7743 Lisp_Object prev_event;
7744 int *used_mouse_menu;
7746 int mapno;
7747 register Lisp_Object name = Qnil;
7749 if (used_mouse_menu)
7750 *used_mouse_menu = 0;
7752 /* Use local over global Menu maps */
7754 if (! menu_prompting)
7755 return Qnil;
7757 /* Optionally disregard all but the global map. */
7758 if (inhibit_local_menu_bar_menus)
7760 maps += (nmaps - 1);
7761 nmaps = 1;
7764 /* Get the menu name from the first map that has one (a prompt string). */
7765 for (mapno = 0; mapno < nmaps; mapno++)
7767 name = Fkeymap_prompt (maps[mapno]);
7768 if (!NILP (name))
7769 break;
7772 /* If we don't have any menus, just read a character normally. */
7773 if (!STRINGP (name))
7774 return Qnil;
7776 #ifdef HAVE_MENUS
7777 /* If we got to this point via a mouse click,
7778 use a real menu for mouse selection. */
7779 if (EVENT_HAS_PARAMETERS (prev_event)
7780 && !EQ (XCAR (prev_event), Qmenu_bar)
7781 && !EQ (XCAR (prev_event), Qtool_bar))
7783 /* Display the menu and get the selection. */
7784 Lisp_Object *realmaps
7785 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
7786 Lisp_Object value;
7787 int nmaps1 = 0;
7789 /* Use the maps that are not nil. */
7790 for (mapno = 0; mapno < nmaps; mapno++)
7791 if (!NILP (maps[mapno]))
7792 realmaps[nmaps1++] = maps[mapno];
7794 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
7795 if (CONSP (value))
7797 Lisp_Object tem;
7799 record_menu_key (XCAR (value));
7801 /* If we got multiple events, unread all but
7802 the first.
7803 There is no way to prevent those unread events
7804 from showing up later in last_nonmenu_event.
7805 So turn symbol and integer events into lists,
7806 to indicate that they came from a mouse menu,
7807 so that when present in last_nonmenu_event
7808 they won't confuse things. */
7809 for (tem = XCDR (value); !NILP (tem); tem = XCDR (tem))
7811 record_menu_key (XCAR (tem));
7812 if (SYMBOLP (XCAR (tem))
7813 || INTEGERP (XCAR (tem)))
7814 XSETCAR (tem, Fcons (XCAR (tem), Qdisabled));
7817 /* If we got more than one event, put all but the first
7818 onto this list to be read later.
7819 Return just the first event now. */
7820 Vunread_command_events
7821 = nconc2 (XCDR (value), Vunread_command_events);
7822 value = XCAR (value);
7824 else if (NILP (value))
7825 value = Qt;
7826 if (used_mouse_menu)
7827 *used_mouse_menu = 1;
7828 return value;
7830 #endif /* HAVE_MENUS */
7831 return Qnil ;
7834 /* Buffer in use so far for the minibuf prompts for menu keymaps.
7835 We make this bigger when necessary, and never free it. */
7836 static char *read_char_minibuf_menu_text;
7837 /* Size of that buffer. */
7838 static int read_char_minibuf_menu_width;
7840 static Lisp_Object
7841 read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
7842 int commandflag ;
7843 int nmaps;
7844 Lisp_Object *maps;
7846 int mapno;
7847 register Lisp_Object name;
7848 int nlength;
7849 /* FIXME: Use the minibuffer's frame width. */
7850 int width = FRAME_WIDTH (SELECTED_FRAME ()) - 4;
7851 int idx = -1;
7852 int nobindings = 1;
7853 Lisp_Object rest, vector;
7854 char *menu;
7856 vector = Qnil;
7857 name = Qnil;
7859 if (! menu_prompting)
7860 return Qnil;
7862 /* Make sure we have a big enough buffer for the menu text. */
7863 if (read_char_minibuf_menu_text == 0)
7865 read_char_minibuf_menu_width = width + 4;
7866 read_char_minibuf_menu_text = (char *) xmalloc (width + 4);
7868 else if (width + 4 > read_char_minibuf_menu_width)
7870 read_char_minibuf_menu_width = width + 4;
7871 read_char_minibuf_menu_text
7872 = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
7874 menu = read_char_minibuf_menu_text;
7876 /* Get the menu name from the first map that has one (a prompt string). */
7877 for (mapno = 0; mapno < nmaps; mapno++)
7879 name = Fkeymap_prompt (maps[mapno]);
7880 if (!NILP (name))
7881 break;
7884 /* If we don't have any menus, just read a character normally. */
7885 if (!STRINGP (name))
7886 return Qnil;
7888 /* Prompt string always starts with map's prompt, and a space. */
7889 strcpy (menu, SDATA (name));
7890 nlength = SBYTES (name);
7891 menu[nlength++] = ':';
7892 menu[nlength++] = ' ';
7893 menu[nlength] = 0;
7895 /* Start prompting at start of first map. */
7896 mapno = 0;
7897 rest = maps[mapno];
7899 /* Present the documented bindings, a line at a time. */
7900 while (1)
7902 int notfirst = 0;
7903 int i = nlength;
7904 Lisp_Object obj;
7905 int ch;
7906 Lisp_Object orig_defn_macro;
7908 /* Loop over elements of map. */
7909 while (i < width)
7911 Lisp_Object elt;
7913 /* If reached end of map, start at beginning of next map. */
7914 if (NILP (rest))
7916 mapno++;
7917 /* At end of last map, wrap around to first map if just starting,
7918 or end this line if already have something on it. */
7919 if (mapno == nmaps)
7921 mapno = 0;
7922 if (notfirst || nobindings) break;
7924 rest = maps[mapno];
7927 /* Look at the next element of the map. */
7928 if (idx >= 0)
7929 elt = XVECTOR (vector)->contents[idx];
7930 else
7931 elt = Fcar_safe (rest);
7933 if (idx < 0 && VECTORP (elt))
7935 /* If we found a dense table in the keymap,
7936 advanced past it, but start scanning its contents. */
7937 rest = Fcdr_safe (rest);
7938 vector = elt;
7939 idx = 0;
7941 else
7943 /* An ordinary element. */
7944 Lisp_Object event, tem;
7946 if (idx < 0)
7948 event = Fcar_safe (elt); /* alist */
7949 elt = Fcdr_safe (elt);
7951 else
7953 XSETINT (event, idx); /* vector */
7956 /* Ignore the element if it has no prompt string. */
7957 if (INTEGERP (event) && parse_menu_item (elt, 0, -1))
7959 /* 1 if the char to type matches the string. */
7960 int char_matches;
7961 Lisp_Object upcased_event, downcased_event;
7962 Lisp_Object desc = Qnil;
7963 Lisp_Object s
7964 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
7966 upcased_event = Fupcase (event);
7967 downcased_event = Fdowncase (event);
7968 char_matches = (XINT (upcased_event) == SREF (s, 0)
7969 || XINT (downcased_event) == SREF (s, 0));
7970 if (! char_matches)
7971 desc = Fsingle_key_description (event, Qnil);
7973 #if 0 /* It is redundant to list the equivalent key bindings because
7974 the prefix is what the user has already typed. */
7976 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
7977 if (!NILP (tem))
7978 /* Insert equivalent keybinding. */
7979 s = concat2 (s, tem);
7980 #endif
7982 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
7983 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
7985 /* Insert button prefix. */
7986 Lisp_Object selected
7987 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
7988 if (EQ (tem, QCradio))
7989 tem = build_string (NILP (selected) ? "(*) " : "( ) ");
7990 else
7991 tem = build_string (NILP (selected) ? "[X] " : "[ ] ");
7992 s = concat2 (tem, s);
7996 /* If we have room for the prompt string, add it to this line.
7997 If this is the first on the line, always add it. */
7998 if ((SCHARS (s) + i + 2
7999 + (char_matches ? 0 : SCHARS (desc) + 3))
8000 < width
8001 || !notfirst)
8003 int thiswidth;
8005 /* Punctuate between strings. */
8006 if (notfirst)
8008 strcpy (menu + i, ", ");
8009 i += 2;
8011 notfirst = 1;
8012 nobindings = 0 ;
8014 /* If the char to type doesn't match the string's
8015 first char, explicitly show what char to type. */
8016 if (! char_matches)
8018 /* Add as much of string as fits. */
8019 thiswidth = SCHARS (desc);
8020 if (thiswidth + i > width)
8021 thiswidth = width - i;
8022 bcopy (SDATA (desc), menu + i, thiswidth);
8023 i += thiswidth;
8024 strcpy (menu + i, " = ");
8025 i += 3;
8028 /* Add as much of string as fits. */
8029 thiswidth = SCHARS (s);
8030 if (thiswidth + i > width)
8031 thiswidth = width - i;
8032 bcopy (SDATA (s), menu + i, thiswidth);
8033 i += thiswidth;
8034 menu[i] = 0;
8036 else
8038 /* If this element does not fit, end the line now,
8039 and save the element for the next line. */
8040 strcpy (menu + i, "...");
8041 break;
8045 /* Move past this element. */
8046 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
8047 /* Handle reaching end of dense table. */
8048 idx = -1;
8049 if (idx >= 0)
8050 idx++;
8051 else
8052 rest = Fcdr_safe (rest);
8056 /* Prompt with that and read response. */
8057 message2_nolog (menu, strlen (menu),
8058 ! NILP (current_buffer->enable_multibyte_characters));
8060 /* Make believe its not a keyboard macro in case the help char
8061 is pressed. Help characters are not recorded because menu prompting
8062 is not used on replay.
8064 orig_defn_macro = current_kboard->defining_kbd_macro;
8065 current_kboard->defining_kbd_macro = Qnil;
8067 obj = read_char (commandflag, 0, 0, Qt, 0);
8068 while (BUFFERP (obj));
8069 current_kboard->defining_kbd_macro = orig_defn_macro;
8071 if (!INTEGERP (obj))
8072 return obj;
8073 else
8074 ch = XINT (obj);
8076 if (! EQ (obj, menu_prompt_more_char)
8077 && (!INTEGERP (menu_prompt_more_char)
8078 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
8080 if (!NILP (current_kboard->defining_kbd_macro))
8081 store_kbd_macro_char (obj);
8082 return obj;
8084 /* Help char - go round again */
8088 /* Reading key sequences. */
8090 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
8091 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
8092 keymap, or nil otherwise. Return the index of the first keymap in
8093 which KEY has any binding, or NMAPS if no map has a binding.
8095 If KEY is a meta ASCII character, treat it like meta-prefix-char
8096 followed by the corresponding non-meta character. Keymaps in
8097 CURRENT with non-prefix bindings for meta-prefix-char become nil in
8098 NEXT.
8100 If KEY has no bindings in any of the CURRENT maps, NEXT is left
8101 unmodified.
8103 NEXT may be the same array as CURRENT. */
8105 static int
8106 follow_key (key, nmaps, current, defs, next)
8107 Lisp_Object key;
8108 Lisp_Object *current, *defs, *next;
8109 int nmaps;
8111 int i, first_binding;
8112 int did_meta = 0;
8114 first_binding = nmaps;
8115 for (i = nmaps - 1; i >= 0; i--)
8117 if (! NILP (current[i]))
8119 Lisp_Object map;
8120 if (did_meta)
8121 map = defs[i];
8122 else
8123 map = current[i];
8125 defs[i] = access_keymap (map, key, 1, 0, 1);
8126 if (! NILP (defs[i]))
8127 first_binding = i;
8129 else
8130 defs[i] = Qnil;
8133 /* Given the set of bindings we've found, produce the next set of maps. */
8134 if (first_binding < nmaps)
8135 for (i = 0; i < nmaps; i++)
8136 next[i] = NILP (defs[i]) ? Qnil : get_keymap (defs[i], 0, 1);
8138 return first_binding;
8141 /* Structure used to keep track of partial application of key remapping
8142 such as Vfunction_key_map and Vkey_translation_map. */
8143 typedef struct keyremap
8145 Lisp_Object map;
8146 int start, end;
8147 } keyremap;
8150 /* Read a sequence of keys that ends with a non prefix character,
8151 storing it in KEYBUF, a buffer of size BUFSIZE.
8152 Prompt with PROMPT.
8153 Return the length of the key sequence stored.
8154 Return -1 if the user rejected a command menu.
8156 Echo starting immediately unless `prompt' is 0.
8158 Where a key sequence ends depends on the currently active keymaps.
8159 These include any minor mode keymaps active in the current buffer,
8160 the current buffer's local map, and the global map.
8162 If a key sequence has no other bindings, we check Vfunction_key_map
8163 to see if some trailing subsequence might be the beginning of a
8164 function key's sequence. If so, we try to read the whole function
8165 key, and substitute its symbolic name into the key sequence.
8167 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
8168 `double-' events into similar click events, if that would make them
8169 bound. We try to turn `triple-' events first into `double-' events,
8170 then into clicks.
8172 If we get a mouse click in a mode line, vertical divider, or other
8173 non-text area, we treat the click as if it were prefixed by the
8174 symbol denoting that area - `mode-line', `vertical-line', or
8175 whatever.
8177 If the sequence starts with a mouse click, we read the key sequence
8178 with respect to the buffer clicked on, not the current buffer.
8180 If the user switches frames in the midst of a key sequence, we put
8181 off the switch-frame event until later; the next call to
8182 read_char will return it.
8184 If FIX_CURRENT_BUFFER is nonzero, we restore current_buffer
8185 from the selected window's buffer. */
8187 static int
8188 read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
8189 can_return_switch_frame, fix_current_buffer)
8190 Lisp_Object *keybuf;
8191 int bufsize;
8192 Lisp_Object prompt;
8193 int dont_downcase_last;
8194 int can_return_switch_frame;
8195 int fix_current_buffer;
8197 volatile Lisp_Object from_string;
8198 volatile int count = SPECPDL_INDEX ();
8200 /* How many keys there are in the current key sequence. */
8201 volatile int t;
8203 /* The length of the echo buffer when we started reading, and
8204 the length of this_command_keys when we started reading. */
8205 volatile int echo_start;
8206 volatile int keys_start;
8208 /* The number of keymaps we're scanning right now, and the number of
8209 keymaps we have allocated space for. */
8210 volatile int nmaps;
8211 volatile int nmaps_allocated = 0;
8213 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
8214 the current keymaps. */
8215 Lisp_Object *volatile defs = NULL;
8217 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
8218 in the current keymaps, or nil where it is not a prefix. */
8219 Lisp_Object *volatile submaps = NULL;
8221 /* The local map to start out with at start of key sequence. */
8222 volatile Lisp_Object orig_local_map;
8224 /* The map from the `keymap' property to start out with at start of
8225 key sequence. */
8226 volatile Lisp_Object orig_keymap;
8228 /* 1 if we have already considered switching to the local-map property
8229 of the place where a mouse click occurred. */
8230 volatile int localized_local_map = 0;
8232 /* The index in defs[] of the first keymap that has a binding for
8233 this key sequence. In other words, the lowest i such that
8234 defs[i] is non-nil. */
8235 volatile int first_binding;
8236 /* Index of the first key that has no binding.
8237 It is useless to try fkey.start larger than that. */
8238 volatile int first_unbound;
8240 /* If t < mock_input, then KEYBUF[t] should be read as the next
8241 input key.
8243 We use this to recover after recognizing a function key. Once we
8244 realize that a suffix of the current key sequence is actually a
8245 function key's escape sequence, we replace the suffix with the
8246 function key's binding from Vfunction_key_map. Now keybuf
8247 contains a new and different key sequence, so the echo area,
8248 this_command_keys, and the submaps and defs arrays are wrong. In
8249 this situation, we set mock_input to t, set t to 0, and jump to
8250 restart_sequence; the loop will read keys from keybuf up until
8251 mock_input, thus rebuilding the state; and then it will resume
8252 reading characters from the keyboard. */
8253 volatile int mock_input = 0;
8255 /* If the sequence is unbound in submaps[], then
8256 keybuf[fkey.start..fkey.end-1] is a prefix in Vfunction_key_map,
8257 and fkey.map is its binding.
8259 These might be > t, indicating that all function key scanning
8260 should hold off until t reaches them. We do this when we've just
8261 recognized a function key, to avoid searching for the function
8262 key's again in Vfunction_key_map. */
8263 volatile keyremap fkey;
8265 /* Likewise, for key_translation_map. */
8266 volatile keyremap keytran;
8268 /* If we receive a ``switch-frame'' event in the middle of a key sequence,
8269 we put it off for later. While we're reading, we keep the event here. */
8270 volatile Lisp_Object delayed_switch_frame;
8272 /* See the comment below... */
8273 #if defined (GOBBLE_FIRST_EVENT)
8274 Lisp_Object first_event;
8275 #endif
8277 volatile Lisp_Object original_uppercase;
8278 volatile int original_uppercase_position = -1;
8280 /* Gets around Microsoft compiler limitations. */
8281 int dummyflag = 0;
8283 struct buffer *starting_buffer;
8285 /* List of events for which a fake prefix key has been generated. */
8286 volatile Lisp_Object fake_prefixed_keys = Qnil;
8288 #if defined (GOBBLE_FIRST_EVENT)
8289 int junk;
8290 #endif
8292 struct gcpro gcpro1;
8294 GCPRO1 (fake_prefixed_keys);
8295 raw_keybuf_count = 0;
8297 last_nonmenu_event = Qnil;
8299 delayed_switch_frame = Qnil;
8300 fkey.map = Vfunction_key_map;
8301 keytran.map = Vkey_translation_map;
8302 /* If there is no translation-map, turn off scanning. */
8303 fkey.start = fkey.end = KEYMAPP (fkey.map) ? 0 : bufsize + 1;
8304 keytran.start = keytran.end = KEYMAPP (keytran.map) ? 0 : bufsize + 1;
8306 if (INTERACTIVE)
8308 if (!NILP (prompt))
8309 echo_prompt (prompt);
8310 else if (cursor_in_echo_area
8311 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8312 && NILP (Fzerop (Vecho_keystrokes)))
8313 /* This doesn't put in a dash if the echo buffer is empty, so
8314 you don't always see a dash hanging out in the minibuffer. */
8315 echo_dash ();
8318 /* Record the initial state of the echo area and this_command_keys;
8319 we will need to restore them if we replay a key sequence. */
8320 if (INTERACTIVE)
8321 echo_start = echo_length ();
8322 keys_start = this_command_key_count;
8323 this_single_command_key_start = keys_start;
8325 #if defined (GOBBLE_FIRST_EVENT)
8326 /* This doesn't quite work, because some of the things that read_char
8327 does cannot safely be bypassed. It seems too risky to try to make
8328 this work right. */
8330 /* Read the first char of the sequence specially, before setting
8331 up any keymaps, in case a filter runs and switches buffers on us. */
8332 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
8333 &junk);
8334 #endif /* GOBBLE_FIRST_EVENT */
8336 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8337 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
8338 from_string = Qnil;
8340 /* We jump here when the key sequence has been thoroughly changed, and
8341 we need to rescan it starting from the beginning. When we jump here,
8342 keybuf[0..mock_input] holds the sequence we should reread. */
8343 replay_sequence:
8345 starting_buffer = current_buffer;
8346 first_unbound = bufsize + 1;
8348 /* Build our list of keymaps.
8349 If we recognize a function key and replace its escape sequence in
8350 keybuf with its symbol, or if the sequence starts with a mouse
8351 click and we need to switch buffers, we jump back here to rebuild
8352 the initial keymaps from the current buffer. */
8353 nmaps = 0;
8355 if (!NILP (current_kboard->Voverriding_terminal_local_map)
8356 || !NILP (Voverriding_local_map))
8358 if (3 > nmaps_allocated)
8360 submaps = (Lisp_Object *) alloca (3 * sizeof (submaps[0]));
8361 defs = (Lisp_Object *) alloca (3 * sizeof (defs[0]));
8362 nmaps_allocated = 3;
8364 if (!NILP (current_kboard->Voverriding_terminal_local_map))
8365 submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
8366 if (!NILP (Voverriding_local_map))
8367 submaps[nmaps++] = Voverriding_local_map;
8369 else
8371 int nminor;
8372 int total;
8373 Lisp_Object *maps;
8375 nminor = current_minor_maps (0, &maps);
8376 total = nminor + (!NILP (orig_keymap) ? 3 : 2);
8378 if (total > nmaps_allocated)
8380 submaps = (Lisp_Object *) alloca (total * sizeof (submaps[0]));
8381 defs = (Lisp_Object *) alloca (total * sizeof (defs[0]));
8382 nmaps_allocated = total;
8385 if (!NILP (orig_keymap))
8386 submaps[nmaps++] = orig_keymap;
8388 bcopy (maps, (void *) (submaps + nmaps),
8389 nminor * sizeof (submaps[0]));
8391 nmaps += nminor;
8393 submaps[nmaps++] = orig_local_map;
8395 submaps[nmaps++] = current_global_map;
8397 /* Find an accurate initial value for first_binding. */
8398 for (first_binding = 0; first_binding < nmaps; first_binding++)
8399 if (! NILP (submaps[first_binding]))
8400 break;
8402 /* Start from the beginning in keybuf. */
8403 t = 0;
8405 /* These are no-ops the first time through, but if we restart, they
8406 revert the echo area and this_command_keys to their original state. */
8407 this_command_key_count = keys_start;
8408 if (INTERACTIVE && t < mock_input)
8409 echo_truncate (echo_start);
8411 /* If the best binding for the current key sequence is a keymap, or
8412 we may be looking at a function key's escape sequence, keep on
8413 reading. */
8414 while (first_binding < nmaps
8415 /* Keep reading as long as there's a prefix binding. */
8416 ? !NILP (submaps[first_binding])
8417 /* Don't return in the middle of a possible function key sequence,
8418 if the only bindings we found were via case conversion.
8419 Thus, if ESC O a has a function-key-map translation
8420 and ESC o has a binding, don't return after ESC O,
8421 so that we can translate ESC O plus the next character. */
8422 : (fkey.start < t || keytran.start < t))
8424 Lisp_Object key;
8425 int used_mouse_menu = 0;
8427 /* Where the last real key started. If we need to throw away a
8428 key that has expanded into more than one element of keybuf
8429 (say, a mouse click on the mode line which is being treated
8430 as [mode-line (mouse-...)], then we backtrack to this point
8431 of keybuf. */
8432 volatile int last_real_key_start;
8434 /* These variables are analogous to echo_start and keys_start;
8435 while those allow us to restart the entire key sequence,
8436 echo_local_start and keys_local_start allow us to throw away
8437 just one key. */
8438 volatile int echo_local_start, keys_local_start, local_first_binding;
8440 /* key-translation-map is applied *after* function-key-map. */
8441 eassert (keytran.end <= fkey.start);
8443 if (first_unbound < fkey.start && first_unbound < keytran.start)
8444 { /* The prefix upto first_unbound has no binding and has
8445 no translation left to do either, so we know it's unbound.
8446 If we don't stop now, we risk staying here indefinitely
8447 (if the user keeps entering fkey or keytran prefixes
8448 like C-c ESC ESC ESC ESC ...) */
8449 int i;
8450 for (i = first_unbound + 1; i < t; i++)
8451 keybuf[i - first_unbound - 1] = keybuf[i];
8452 mock_input = t - first_unbound - 1;
8453 fkey.end = fkey.start -= first_unbound + 1;
8454 fkey.map = Vfunction_key_map;
8455 keytran.end = keytran.start -= first_unbound + 1;
8456 keytran.map = Vkey_translation_map;
8457 goto replay_sequence;
8460 if (t >= bufsize)
8461 error ("Key sequence too long");
8463 if (INTERACTIVE)
8464 echo_local_start = echo_length ();
8465 keys_local_start = this_command_key_count;
8466 local_first_binding = first_binding;
8468 replay_key:
8469 /* These are no-ops, unless we throw away a keystroke below and
8470 jumped back up to replay_key; in that case, these restore the
8471 variables to their original state, allowing us to replay the
8472 loop. */
8473 if (INTERACTIVE && t < mock_input)
8474 echo_truncate (echo_local_start);
8475 this_command_key_count = keys_local_start;
8476 first_binding = local_first_binding;
8478 /* By default, assume each event is "real". */
8479 last_real_key_start = t;
8481 /* Does mock_input indicate that we are re-reading a key sequence? */
8482 if (t < mock_input)
8484 key = keybuf[t];
8485 add_command_key (key);
8486 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8487 && NILP (Fzerop (Vecho_keystrokes)))
8488 echo_char (key);
8491 /* If not, we should actually read a character. */
8492 else
8495 #ifdef MULTI_KBOARD
8496 KBOARD *interrupted_kboard = current_kboard;
8497 struct frame *interrupted_frame = SELECTED_FRAME ();
8498 if (setjmp (wrong_kboard_jmpbuf))
8500 if (!NILP (delayed_switch_frame))
8502 interrupted_kboard->kbd_queue
8503 = Fcons (delayed_switch_frame,
8504 interrupted_kboard->kbd_queue);
8505 delayed_switch_frame = Qnil;
8507 while (t > 0)
8508 interrupted_kboard->kbd_queue
8509 = Fcons (keybuf[--t], interrupted_kboard->kbd_queue);
8511 /* If the side queue is non-empty, ensure it begins with a
8512 switch-frame, so we'll replay it in the right context. */
8513 if (CONSP (interrupted_kboard->kbd_queue)
8514 && (key = XCAR (interrupted_kboard->kbd_queue),
8515 !(EVENT_HAS_PARAMETERS (key)
8516 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
8517 Qswitch_frame))))
8519 Lisp_Object frame;
8520 XSETFRAME (frame, interrupted_frame);
8521 interrupted_kboard->kbd_queue
8522 = Fcons (make_lispy_switch_frame (frame),
8523 interrupted_kboard->kbd_queue);
8525 mock_input = 0;
8526 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8527 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
8528 goto replay_sequence;
8530 #endif
8531 key = read_char (NILP (prompt), nmaps,
8532 (Lisp_Object *) submaps, last_nonmenu_event,
8533 &used_mouse_menu);
8536 /* read_char returns t when it shows a menu and the user rejects it.
8537 Just return -1. */
8538 if (EQ (key, Qt))
8540 unbind_to (count, Qnil);
8541 UNGCPRO;
8542 return -1;
8545 /* read_char returns -1 at the end of a macro.
8546 Emacs 18 handles this by returning immediately with a
8547 zero, so that's what we'll do. */
8548 if (INTEGERP (key) && XINT (key) == -1)
8550 t = 0;
8551 /* The Microsoft C compiler can't handle the goto that
8552 would go here. */
8553 dummyflag = 1;
8554 break;
8557 /* If the current buffer has been changed from under us, the
8558 keymap may have changed, so replay the sequence. */
8559 if (BUFFERP (key))
8561 EMACS_TIME initial_idleness_start_time;
8562 EMACS_SET_SECS_USECS (initial_idleness_start_time,
8563 EMACS_SECS (timer_last_idleness_start_time),
8564 EMACS_USECS (timer_last_idleness_start_time));
8566 /* Resume idle state, using the same start-time as before. */
8567 timer_start_idle ();
8568 timer_idleness_start_time = initial_idleness_start_time;
8570 mock_input = t;
8571 /* Reset the current buffer from the selected window
8572 in case something changed the former and not the latter.
8573 This is to be more consistent with the behavior
8574 of the command_loop_1. */
8575 if (fix_current_buffer)
8577 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
8578 Fkill_emacs (Qnil);
8579 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
8580 Fset_buffer (XWINDOW (selected_window)->buffer);
8583 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8584 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
8585 goto replay_sequence;
8588 /* If we have a quit that was typed in another frame, and
8589 quit_throw_to_read_char switched buffers,
8590 replay to get the right keymap. */
8591 if (INTEGERP (key)
8592 && XINT (key) == quit_char
8593 && current_buffer != starting_buffer)
8595 GROW_RAW_KEYBUF;
8596 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8597 keybuf[t++] = key;
8598 mock_input = t;
8599 Vquit_flag = Qnil;
8600 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8601 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
8602 goto replay_sequence;
8605 Vquit_flag = Qnil;
8607 if (EVENT_HAS_PARAMETERS (key)
8608 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
8610 /* If we're at the beginning of a key sequence, and the caller
8611 says it's okay, go ahead and return this event. If we're
8612 in the midst of a key sequence, delay it until the end. */
8613 if (t > 0 || !can_return_switch_frame)
8615 delayed_switch_frame = key;
8616 goto replay_key;
8620 GROW_RAW_KEYBUF;
8621 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8624 /* Clicks in non-text areas get prefixed by the symbol
8625 in their CHAR-ADDRESS field. For example, a click on
8626 the mode line is prefixed by the symbol `mode-line'.
8628 Furthermore, key sequences beginning with mouse clicks
8629 are read using the keymaps of the buffer clicked on, not
8630 the current buffer. So we may have to switch the buffer
8631 here.
8633 When we turn one event into two events, we must make sure
8634 that neither of the two looks like the original--so that,
8635 if we replay the events, they won't be expanded again.
8636 If not for this, such reexpansion could happen either here
8637 or when user programs play with this-command-keys. */
8638 if (EVENT_HAS_PARAMETERS (key))
8640 Lisp_Object kind;
8642 kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
8643 if (EQ (kind, Qmouse_click))
8645 Lisp_Object window, posn;
8647 window = POSN_WINDOW (EVENT_START (key));
8648 posn = POSN_BUFFER_POSN (EVENT_START (key));
8650 if (CONSP (posn)
8651 || (!NILP (fake_prefixed_keys)
8652 && !NILP (Fmemq (key, fake_prefixed_keys))))
8654 /* We're looking a second time at an event for which
8655 we generated a fake prefix key. Set
8656 last_real_key_start appropriately. */
8657 if (t > 0)
8658 last_real_key_start = t - 1;
8661 /* Key sequences beginning with mouse clicks are
8662 read using the keymaps in the buffer clicked on,
8663 not the current buffer. If we're at the
8664 beginning of a key sequence, switch buffers. */
8665 if (last_real_key_start == 0
8666 && WINDOWP (window)
8667 && BUFFERP (XWINDOW (window)->buffer)
8668 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
8670 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8671 keybuf[t] = key;
8672 mock_input = t + 1;
8674 /* Arrange to go back to the original buffer once we're
8675 done reading the key sequence. Note that we can't
8676 use save_excursion_{save,restore} here, because they
8677 save point as well as the current buffer; we don't
8678 want to save point, because redisplay may change it,
8679 to accommodate a Fset_window_start or something. We
8680 don't want to do this at the top of the function,
8681 because we may get input from a subprocess which
8682 wants to change the selected window and stuff (say,
8683 emacsclient). */
8684 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
8686 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
8687 Fkill_emacs (Qnil);
8688 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
8689 orig_local_map = get_local_map (PT, current_buffer,
8690 Qlocal_map);
8691 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
8692 goto replay_sequence;
8695 /* For a mouse click, get the local text-property keymap
8696 of the place clicked on, rather than point. */
8697 if (last_real_key_start == 0
8698 && CONSP (XCDR (key))
8699 && ! localized_local_map)
8701 Lisp_Object map_here, start, pos;
8703 localized_local_map = 1;
8704 start = EVENT_START (key);
8706 if (CONSP (start) && CONSP (XCDR (start)))
8708 pos = POSN_BUFFER_POSN (start);
8709 if (INTEGERP (pos)
8710 && XINT (pos) >= BEG && XINT (pos) <= Z)
8712 map_here = get_local_map (XINT (pos),
8713 current_buffer, Qlocal_map);
8714 if (!EQ (map_here, orig_local_map))
8716 orig_local_map = map_here;
8717 keybuf[t] = key;
8718 mock_input = t + 1;
8720 goto replay_sequence;
8722 map_here = get_local_map (XINT (pos),
8723 current_buffer, Qkeymap);
8724 if (!EQ (map_here, orig_keymap))
8726 orig_keymap = map_here;
8727 keybuf[t] = key;
8728 mock_input = t + 1;
8730 goto replay_sequence;
8736 /* Expand mode-line and scroll-bar events into two events:
8737 use posn as a fake prefix key. */
8738 if (SYMBOLP (posn)
8739 && (NILP (fake_prefixed_keys)
8740 || NILP (Fmemq (key, fake_prefixed_keys))))
8742 if (t + 1 >= bufsize)
8743 error ("Key sequence too long");
8745 keybuf[t] = posn;
8746 keybuf[t + 1] = key;
8747 mock_input = t + 2;
8749 /* Record that a fake prefix key has been generated
8750 for KEY. Don't modify the event; this would
8751 prevent proper action when the event is pushed
8752 back into unread-command-events. */
8753 fake_prefixed_keys = Fcons (key, fake_prefixed_keys);
8755 /* If on a mode line string with a local keymap,
8756 reconsider the key sequence with that keymap. */
8757 if (CONSP (POSN_STRING (EVENT_START (key))))
8759 Lisp_Object string, pos, map, map2;
8761 string = POSN_STRING (EVENT_START (key));
8762 pos = XCDR (string);
8763 string = XCAR (string);
8764 if (XINT (pos) >= 0
8765 && XINT (pos) < SCHARS (string))
8767 map = Fget_text_property (pos, Qlocal_map, string);
8768 if (!NILP (map))
8769 orig_local_map = map;
8770 map2 = Fget_text_property (pos, Qkeymap, string);
8771 if (!NILP (map2))
8772 orig_keymap = map2;
8773 if (!NILP (map) || !NILP (map2))
8774 goto replay_sequence;
8778 goto replay_key;
8780 else if (CONSP (POSN_STRING (EVENT_START (key)))
8781 && NILP (from_string))
8783 /* For a click on a string, i.e. overlay string or a
8784 string displayed via the `display' property,
8785 consider `local-map' and `keymap' properties of
8786 that string. */
8787 Lisp_Object string, pos, map, map2;
8789 string = POSN_STRING (EVENT_START (key));
8790 pos = XCDR (string);
8791 string = XCAR (string);
8792 if (XINT (pos) >= 0
8793 && XINT (pos) < SCHARS (string))
8795 map = Fget_text_property (pos, Qlocal_map, string);
8796 if (!NILP (map))
8797 orig_local_map = map;
8798 map2 = Fget_text_property (pos, Qkeymap, string);
8799 if (!NILP (map2))
8800 orig_keymap = map2;
8802 if (!NILP (map) || !NILP (map2))
8804 from_string = string;
8805 goto replay_sequence;
8810 else if (CONSP (XCDR (key))
8811 && CONSP (EVENT_START (key))
8812 && CONSP (XCDR (EVENT_START (key))))
8814 Lisp_Object posn;
8816 posn = POSN_BUFFER_POSN (EVENT_START (key));
8817 /* Handle menu-bar events:
8818 insert the dummy prefix event `menu-bar'. */
8819 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
8821 if (t + 1 >= bufsize)
8822 error ("Key sequence too long");
8823 keybuf[t] = posn;
8824 keybuf[t+1] = key;
8826 /* Zap the position in key, so we know that we've
8827 expanded it, and don't try to do so again. */
8828 POSN_BUFFER_SET_POSN (EVENT_START (key),
8829 Fcons (posn, Qnil));
8831 mock_input = t + 2;
8832 goto replay_sequence;
8834 else if (CONSP (posn))
8836 /* We're looking at the second event of a
8837 sequence which we expanded before. Set
8838 last_real_key_start appropriately. */
8839 if (last_real_key_start == t && t > 0)
8840 last_real_key_start = t - 1;
8845 /* We have finally decided that KEY is something we might want
8846 to look up. */
8847 first_binding = (follow_key (key,
8848 nmaps - first_binding,
8849 submaps + first_binding,
8850 defs + first_binding,
8851 submaps + first_binding)
8852 + first_binding);
8854 /* If KEY wasn't bound, we'll try some fallbacks. */
8855 if (first_binding < nmaps)
8856 /* This is needed for the following scenario:
8857 event 0: a down-event that gets dropped by calling replay_key.
8858 event 1: some normal prefix like C-h.
8859 After event 0, first_unbound is 0, after event 1 fkey.start
8860 and keytran.start are both 1, so when we see that C-h is bound,
8861 we need to update first_unbound. */
8862 first_unbound = max (t + 1, first_unbound);
8863 else
8865 Lisp_Object head;
8867 /* Remember the position to put an upper bound on fkey.start. */
8868 first_unbound = min (t, first_unbound);
8870 head = EVENT_HEAD (key);
8871 if (help_char_p (head) && t > 0)
8873 read_key_sequence_cmd = Vprefix_help_command;
8874 keybuf[t++] = key;
8875 last_nonmenu_event = key;
8876 /* The Microsoft C compiler can't handle the goto that
8877 would go here. */
8878 dummyflag = 1;
8879 break;
8882 if (SYMBOLP (head))
8884 Lisp_Object breakdown;
8885 int modifiers;
8887 breakdown = parse_modifiers (head);
8888 modifiers = XINT (XCAR (XCDR (breakdown)));
8889 /* Attempt to reduce an unbound mouse event to a simpler
8890 event that is bound:
8891 Drags reduce to clicks.
8892 Double-clicks reduce to clicks.
8893 Triple-clicks reduce to double-clicks, then to clicks.
8894 Down-clicks are eliminated.
8895 Double-downs reduce to downs, then are eliminated.
8896 Triple-downs reduce to double-downs, then to downs,
8897 then are eliminated. */
8898 if (modifiers & (down_modifier | drag_modifier
8899 | double_modifier | triple_modifier))
8901 while (modifiers & (down_modifier | drag_modifier
8902 | double_modifier | triple_modifier))
8904 Lisp_Object new_head, new_click;
8905 if (modifiers & triple_modifier)
8906 modifiers ^= (double_modifier | triple_modifier);
8907 else if (modifiers & double_modifier)
8908 modifiers &= ~double_modifier;
8909 else if (modifiers & drag_modifier)
8910 modifiers &= ~drag_modifier;
8911 else
8913 /* Dispose of this `down' event by simply jumping
8914 back to replay_key, to get another event.
8916 Note that if this event came from mock input,
8917 then just jumping back to replay_key will just
8918 hand it to us again. So we have to wipe out any
8919 mock input.
8921 We could delete keybuf[t] and shift everything
8922 after that to the left by one spot, but we'd also
8923 have to fix up any variable that points into
8924 keybuf, and shifting isn't really necessary
8925 anyway.
8927 Adding prefixes for non-textual mouse clicks
8928 creates two characters of mock input, and both
8929 must be thrown away. If we're only looking at
8930 the prefix now, we can just jump back to
8931 replay_key. On the other hand, if we've already
8932 processed the prefix, and now the actual click
8933 itself is giving us trouble, then we've lost the
8934 state of the keymaps we want to backtrack to, and
8935 we need to replay the whole sequence to rebuild
8938 Beyond that, only function key expansion could
8939 create more than two keys, but that should never
8940 generate mouse events, so it's okay to zero
8941 mock_input in that case too.
8943 FIXME: The above paragraph seems just plain
8944 wrong, if you consider things like
8945 xterm-mouse-mode. -stef
8947 Isn't this just the most wonderful code ever? */
8948 if (t == last_real_key_start)
8950 mock_input = 0;
8951 goto replay_key;
8953 else
8955 mock_input = last_real_key_start;
8956 goto replay_sequence;
8960 new_head
8961 = apply_modifiers (modifiers, XCAR (breakdown));
8962 new_click
8963 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
8965 /* Look for a binding for this new key. follow_key
8966 promises that it didn't munge submaps the
8967 last time we called it, since key was unbound. */
8968 first_binding
8969 = (follow_key (new_click,
8970 nmaps - local_first_binding,
8971 submaps + local_first_binding,
8972 defs + local_first_binding,
8973 submaps + local_first_binding)
8974 + local_first_binding);
8976 /* If that click is bound, go for it. */
8977 if (first_binding < nmaps)
8979 key = new_click;
8980 break;
8982 /* Otherwise, we'll leave key set to the drag event. */
8988 keybuf[t++] = key;
8989 /* Normally, last_nonmenu_event gets the previous key we read.
8990 But when a mouse popup menu is being used,
8991 we don't update last_nonmenu_event; it continues to hold the mouse
8992 event that preceded the first level of menu. */
8993 if (!used_mouse_menu)
8994 last_nonmenu_event = key;
8996 /* Record what part of this_command_keys is the current key sequence. */
8997 this_single_command_key_start = this_command_key_count - t;
8999 if (first_binding < nmaps && NILP (submaps[first_binding]))
9000 /* There is a binding and it's not a prefix.
9001 There is thus no function-key in this sequence.
9002 Moving fkey.start is important in this case to allow keytran.start
9003 to go over the sequence before we return (since we keep the
9004 invariant that keytran.end <= fkey.start). */
9006 if (fkey.start < t)
9007 (fkey.start = fkey.end = t, fkey.map = Vfunction_key_map);
9009 else
9010 /* If the sequence is unbound, see if we can hang a function key
9011 off the end of it. */
9013 Lisp_Object next;
9015 /* Continue scan from fkey.end until we find a bound suffix.
9016 If we fail, increment fkey.start and start over from there. */
9017 while (fkey.end < t)
9019 Lisp_Object key;
9021 key = keybuf[fkey.end++];
9022 next = access_keymap (fkey.map, key, 1, 0, 1);
9024 /* Handle symbol with autoload definition. */
9025 if (SYMBOLP (next) && ! NILP (Ffboundp (next))
9026 && CONSP (XSYMBOL (next)->function)
9027 && EQ (XCAR (XSYMBOL (next)->function), Qautoload))
9028 do_autoload (XSYMBOL (next)->function, next);
9030 /* Handle a symbol whose function definition is a keymap
9031 or an array. */
9032 if (SYMBOLP (next) && ! NILP (Ffboundp (next))
9033 && (!NILP (Farrayp (XSYMBOL (next)->function))
9034 || KEYMAPP (XSYMBOL (next)->function)))
9035 next = XSYMBOL (next)->function;
9037 #if 0 /* I didn't turn this on, because it might cause trouble
9038 for the mapping of return into C-m and tab into C-i. */
9039 /* Optionally don't map function keys into other things.
9040 This enables the user to redefine kp- keys easily. */
9041 if (SYMBOLP (key) && !NILP (Vinhibit_function_key_mapping))
9042 next = Qnil;
9043 #endif
9045 /* If the function key map gives a function, not an
9046 array, then call the function with no args and use
9047 its value instead. */
9048 if (SYMBOLP (next) && ! NILP (Ffboundp (next))
9049 /* If there's a binding (i.e. first_binding >= nmaps)
9050 we don't want to apply this function-key-mapping. */
9051 && fkey.end == t && first_binding >= nmaps)
9053 struct gcpro gcpro1, gcpro2, gcpro3;
9054 Lisp_Object tem;
9055 tem = next;
9057 GCPRO3 (fkey.map, keytran.map, delayed_switch_frame);
9058 next = call1 (next, prompt);
9059 UNGCPRO;
9060 /* If the function returned something invalid,
9061 barf--don't ignore it.
9062 (To ignore it safely, we would need to gcpro a bunch of
9063 other variables.) */
9064 if (! (VECTORP (next) || STRINGP (next)))
9065 error ("Function in key-translation-map returns invalid key sequence");
9068 /* If keybuf[fkey.start..fkey.end] is bound in the
9069 function key map and it's a suffix of the current
9070 sequence (i.e. fkey.end == t), replace it with
9071 the binding and restart with fkey.start at the end. */
9072 if ((VECTORP (next) || STRINGP (next))
9073 /* If there's a binding (i.e. first_binding >= nmaps)
9074 we don't want to apply this function-key-mapping. */
9075 && fkey.end == t && first_binding >= nmaps)
9077 int len = XFASTINT (Flength (next));
9079 t = fkey.start + len;
9080 if (t >= bufsize)
9081 error ("Key sequence too long");
9083 if (VECTORP (next))
9084 bcopy (XVECTOR (next)->contents,
9085 keybuf + fkey.start,
9086 (t - fkey.start) * sizeof (keybuf[0]));
9087 else if (STRINGP (next))
9089 int i;
9091 for (i = 0; i < len; i++)
9092 XSETFASTINT (keybuf[fkey.start + i], SREF (next, i));
9095 mock_input = t;
9096 fkey.start = fkey.end = t;
9097 fkey.map = Vfunction_key_map;
9099 /* Do pass the results through key-translation-map.
9100 But don't retranslate what key-translation-map
9101 has already translated. */
9102 keytran.end = keytran.start;
9103 keytran.map = Vkey_translation_map;
9105 goto replay_sequence;
9108 fkey.map = get_keymap (next, 0, 1);
9110 /* If we no longer have a bound suffix, try a new positions for
9111 fkey.start. */
9112 if (!CONSP (fkey.map))
9114 fkey.end = ++fkey.start;
9115 fkey.map = Vfunction_key_map;
9120 /* Look for this sequence in key-translation-map. */
9122 Lisp_Object next;
9124 /* Scan from keytran.end until we find a bound suffix. */
9125 while (keytran.end < fkey.start)
9127 Lisp_Object key;
9129 key = keybuf[keytran.end++];
9130 next = access_keymap (keytran.map, key, 1, 0, 1);
9132 /* Handle symbol with autoload definition. */
9133 if (SYMBOLP (next) && ! NILP (Ffboundp (next))
9134 && CONSP (XSYMBOL (next)->function)
9135 && EQ (XCAR (XSYMBOL (next)->function), Qautoload))
9136 do_autoload (XSYMBOL (next)->function, next);
9138 /* Handle a symbol whose function definition is a keymap
9139 or an array. */
9140 if (SYMBOLP (next) && ! NILP (Ffboundp (next))
9141 && (!NILP (Farrayp (XSYMBOL (next)->function))
9142 || KEYMAPP (XSYMBOL (next)->function)))
9143 next = XSYMBOL (next)->function;
9145 /* If the key translation map gives a function, not an
9146 array, then call the function with one arg and use
9147 its value instead. */
9148 if (SYMBOLP (next) && ! NILP (Ffboundp (next)))
9150 struct gcpro gcpro1, gcpro2, gcpro3;
9151 Lisp_Object tem;
9152 tem = next;
9154 GCPRO3 (fkey.map, keytran.map, delayed_switch_frame);
9155 next = call1 (next, prompt);
9156 UNGCPRO;
9157 /* If the function returned something invalid,
9158 barf--don't ignore it.
9159 (To ignore it safely, we would need to gcpro a bunch of
9160 other variables.) */
9161 if (! (VECTORP (next) || STRINGP (next)))
9162 error ("Function in key-translation-map returns invalid key sequence");
9165 /* If keybuf[keytran.start..keytran.end] is bound in the
9166 key translation map and it's a suffix of the current
9167 sequence (i.e. keytran.end == t), replace it with
9168 the binding and restart with keytran.start at the end. */
9169 if ((VECTORP (next) || STRINGP (next)))
9171 int len = XFASTINT (Flength (next));
9172 int i, diff = len - (keytran.end - keytran.start);
9174 mock_input = max (t, mock_input);
9175 if (mock_input + diff >= bufsize)
9176 error ("Key sequence too long");
9178 /* Shift the keys that are after keytran.end. */
9179 if (diff < 0)
9180 for (i = keytran.end; i < mock_input; i++)
9181 keybuf[i + diff] = keybuf[i];
9182 else if (diff > 0)
9183 for (i = mock_input - 1; i >= keytran.end; i--)
9184 keybuf[i + diff] = keybuf[i];
9185 /* Replace the keys between keytran.start and keytran.end
9186 with those from next. */
9187 for (i = 0; i < len; i++)
9188 keybuf[keytran.start + i]
9189 = Faref (next, make_number (i));
9191 mock_input += diff;
9192 keytran.start = keytran.end += diff;
9193 keytran.map = Vkey_translation_map;
9195 /* Adjust the function-key-map counters. */
9196 fkey.start += diff;
9197 fkey.end += diff;
9199 goto replay_sequence;
9202 keytran.map = get_keymap (next, 0, 1);
9204 /* If we no longer have a bound suffix, try a new positions for
9205 keytran.start. */
9206 if (!CONSP (keytran.map))
9208 keytran.end = ++keytran.start;
9209 keytran.map = Vkey_translation_map;
9214 /* If KEY is not defined in any of the keymaps,
9215 and cannot be part of a function key or translation,
9216 and is an upper case letter
9217 use the corresponding lower-case letter instead. */
9218 if (first_binding >= nmaps
9219 && fkey.start >= t && keytran.start >= t
9220 && INTEGERP (key)
9221 && ((((XINT (key) & 0x3ffff)
9222 < XCHAR_TABLE (current_buffer->downcase_table)->size)
9223 && UPPERCASEP (XINT (key) & 0x3ffff))
9224 || (XINT (key) & shift_modifier)))
9226 Lisp_Object new_key;
9228 original_uppercase = key;
9229 original_uppercase_position = t - 1;
9231 if (XINT (key) & shift_modifier)
9232 XSETINT (new_key, XINT (key) & ~shift_modifier);
9233 else
9234 XSETINT (new_key, (DOWNCASE (XINT (key) & 0x3ffff)
9235 | (XINT (key) & ~0x3ffff)));
9237 /* We have to do this unconditionally, regardless of whether
9238 the lower-case char is defined in the keymaps, because they
9239 might get translated through function-key-map. */
9240 keybuf[t - 1] = new_key;
9241 mock_input = max (t, mock_input);
9243 goto replay_sequence;
9245 /* If KEY is not defined in any of the keymaps,
9246 and cannot be part of a function key or translation,
9247 and is a shifted function key,
9248 use the corresponding unshifted function key instead. */
9249 if (first_binding >= nmaps
9250 && fkey.start >= t && keytran.start >= t
9251 && SYMBOLP (key))
9253 Lisp_Object breakdown;
9254 int modifiers;
9256 breakdown = parse_modifiers (key);
9257 modifiers = XINT (XCAR (XCDR (breakdown)));
9258 if (modifiers & shift_modifier)
9260 Lisp_Object new_key;
9262 original_uppercase = key;
9263 original_uppercase_position = t - 1;
9265 modifiers &= ~shift_modifier;
9266 new_key = apply_modifiers (modifiers,
9267 XCAR (breakdown));
9269 keybuf[t - 1] = new_key;
9270 mock_input = max (t, mock_input);
9272 goto replay_sequence;
9277 if (!dummyflag)
9278 read_key_sequence_cmd = (first_binding < nmaps
9279 ? defs[first_binding]
9280 : Qnil);
9282 unread_switch_frame = delayed_switch_frame;
9283 unbind_to (count, Qnil);
9285 /* Don't downcase the last character if the caller says don't.
9286 Don't downcase it if the result is undefined, either. */
9287 if ((dont_downcase_last || first_binding >= nmaps)
9288 && t - 1 == original_uppercase_position)
9289 keybuf[t - 1] = original_uppercase;
9291 /* Occasionally we fabricate events, perhaps by expanding something
9292 according to function-key-map, or by adding a prefix symbol to a
9293 mouse click in the scroll bar or modeline. In this cases, return
9294 the entire generated key sequence, even if we hit an unbound
9295 prefix or a definition before the end. This means that you will
9296 be able to push back the event properly, and also means that
9297 read-key-sequence will always return a logical unit.
9299 Better ideas? */
9300 for (; t < mock_input; t++)
9302 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
9303 && NILP (Fzerop (Vecho_keystrokes)))
9304 echo_char (keybuf[t]);
9305 add_command_key (keybuf[t]);
9310 UNGCPRO;
9311 return t;
9314 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
9315 doc: /* Read a sequence of keystrokes and return as a string or vector.
9316 The sequence is sufficient to specify a non-prefix command in the
9317 current local and global maps.
9319 First arg PROMPT is a prompt string. If nil, do not prompt specially.
9320 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos
9321 as a continuation of the previous key.
9323 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
9324 convert the last event to lower case. (Normally any upper case event
9325 is converted to lower case if the original event is undefined and the lower
9326 case equivalent is defined.) A non-nil value is appropriate for reading
9327 a key sequence to be defined.
9329 A C-g typed while in this function is treated like any other character,
9330 and `quit-flag' is not set.
9332 If the key sequence starts with a mouse click, then the sequence is read
9333 using the keymaps of the buffer of the window clicked in, not the buffer
9334 of the selected window as normal.
9336 `read-key-sequence' drops unbound button-down events, since you normally
9337 only care about the click or drag events which follow them. If a drag
9338 or multi-click event is unbound, but the corresponding click event would
9339 be bound, `read-key-sequence' turns the event into a click event at the
9340 drag's starting position. This means that you don't have to distinguish
9341 between click and drag, double, or triple events unless you want to.
9343 `read-key-sequence' prefixes mouse events on mode lines, the vertical
9344 lines separating windows, and scroll bars with imaginary keys
9345 `mode-line', `vertical-line', and `vertical-scroll-bar'.
9347 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this
9348 function will process a switch-frame event if the user switches frames
9349 before typing anything. If the user switches frames in the middle of a
9350 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME
9351 is nil, then the event will be put off until after the current key sequence.
9353 `read-key-sequence' checks `function-key-map' for function key
9354 sequences, where they wouldn't conflict with ordinary bindings. See
9355 `function-key-map' for more details.
9357 The optional fifth argument COMMAND-LOOP, if non-nil, means
9358 that this key sequence is being read by something that will
9359 read commands one after another. It should be nil if the caller
9360 will read just one key sequence. */)
9361 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
9362 command_loop)
9363 Lisp_Object prompt, continue_echo, dont_downcase_last;
9364 Lisp_Object can_return_switch_frame, command_loop;
9366 Lisp_Object keybuf[30];
9367 register int i;
9368 struct gcpro gcpro1;
9369 int count = SPECPDL_INDEX ();
9371 if (!NILP (prompt))
9372 CHECK_STRING (prompt);
9373 QUIT;
9375 specbind (Qinput_method_exit_on_first_char,
9376 (NILP (command_loop) ? Qt : Qnil));
9377 specbind (Qinput_method_use_echo_area,
9378 (NILP (command_loop) ? Qt : Qnil));
9380 bzero (keybuf, sizeof keybuf);
9381 GCPRO1 (keybuf[0]);
9382 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
9384 if (NILP (continue_echo))
9386 this_command_key_count = 0;
9387 this_single_command_key_start = 0;
9390 #ifdef HAVE_X_WINDOWS
9391 if (display_hourglass_p)
9392 cancel_hourglass ();
9393 #endif
9395 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
9396 prompt, ! NILP (dont_downcase_last),
9397 ! NILP (can_return_switch_frame), 0);
9399 #if 0 /* The following is fine for code reading a key sequence and
9400 then proceeding with a lenghty computation, but it's not good
9401 for code reading keys in a loop, like an input method. */
9402 #ifdef HAVE_X_WINDOWS
9403 if (display_hourglass_p)
9404 start_hourglass ();
9405 #endif
9406 #endif
9408 if (i == -1)
9410 Vquit_flag = Qt;
9411 QUIT;
9413 UNGCPRO;
9414 return unbind_to (count, make_event_array (i, keybuf));
9417 DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
9418 Sread_key_sequence_vector, 1, 5, 0,
9419 doc: /* Like `read-key-sequence' but always return a vector. */)
9420 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
9421 command_loop)
9422 Lisp_Object prompt, continue_echo, dont_downcase_last;
9423 Lisp_Object can_return_switch_frame, command_loop;
9425 Lisp_Object keybuf[30];
9426 register int i;
9427 struct gcpro gcpro1;
9428 int count = SPECPDL_INDEX ();
9430 if (!NILP (prompt))
9431 CHECK_STRING (prompt);
9432 QUIT;
9434 specbind (Qinput_method_exit_on_first_char,
9435 (NILP (command_loop) ? Qt : Qnil));
9436 specbind (Qinput_method_use_echo_area,
9437 (NILP (command_loop) ? Qt : Qnil));
9439 bzero (keybuf, sizeof keybuf);
9440 GCPRO1 (keybuf[0]);
9441 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
9443 if (NILP (continue_echo))
9445 this_command_key_count = 0;
9446 this_single_command_key_start = 0;
9449 #ifdef HAVE_X_WINDOWS
9450 if (display_hourglass_p)
9451 cancel_hourglass ();
9452 #endif
9454 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
9455 prompt, ! NILP (dont_downcase_last),
9456 ! NILP (can_return_switch_frame), 0);
9458 #ifdef HAVE_X_WINDOWS
9459 if (display_hourglass_p)
9460 start_hourglass ();
9461 #endif
9463 if (i == -1)
9465 Vquit_flag = Qt;
9466 QUIT;
9468 UNGCPRO;
9469 return unbind_to (count, Fvector (i, keybuf));
9472 DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0,
9473 doc: /* Execute CMD as an editor command.
9474 CMD must be a symbol that satisfies the `commandp' predicate.
9475 Optional second arg RECORD-FLAG non-nil
9476 means unconditionally put this command in `command-history'.
9477 Otherwise, that is done only if an arg is read using the minibuffer.
9478 The argument KEYS specifies the value to use instead of (this-command-keys)
9479 when reading the arguments; if it is nil, (this-command-keys) is used.
9480 The argument SPECIAL, if non-nil, means that this command is executing
9481 a special event, so ignore the prefix argument and don't clear it. */)
9482 (cmd, record_flag, keys, special)
9483 Lisp_Object cmd, record_flag, keys, special;
9485 register Lisp_Object final;
9486 register Lisp_Object tem;
9487 Lisp_Object prefixarg;
9488 struct backtrace backtrace;
9489 extern int debug_on_next_call;
9491 debug_on_next_call = 0;
9493 if (NILP (special))
9495 prefixarg = current_kboard->Vprefix_arg;
9496 Vcurrent_prefix_arg = prefixarg;
9497 current_kboard->Vprefix_arg = Qnil;
9499 else
9500 prefixarg = Qnil;
9502 if (SYMBOLP (cmd))
9504 tem = Fget (cmd, Qdisabled);
9505 if (!NILP (tem) && !NILP (Vrun_hooks))
9507 tem = Fsymbol_value (Qdisabled_command_hook);
9508 if (!NILP (tem))
9509 return call1 (Vrun_hooks, Qdisabled_command_hook);
9513 while (1)
9515 final = Findirect_function (cmd);
9517 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
9519 struct gcpro gcpro1, gcpro2;
9521 GCPRO2 (cmd, prefixarg);
9522 do_autoload (final, cmd);
9523 UNGCPRO;
9525 else
9526 break;
9529 if (STRINGP (final) || VECTORP (final))
9531 /* If requested, place the macro in the command history. For
9532 other sorts of commands, call-interactively takes care of
9533 this. */
9534 if (!NILP (record_flag))
9536 Vcommand_history
9537 = Fcons (Fcons (Qexecute_kbd_macro,
9538 Fcons (final, Fcons (prefixarg, Qnil))),
9539 Vcommand_history);
9541 /* Don't keep command history around forever. */
9542 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
9544 tem = Fnthcdr (Vhistory_length, Vcommand_history);
9545 if (CONSP (tem))
9546 XSETCDR (tem, Qnil);
9550 return Fexecute_kbd_macro (final, prefixarg, Qnil);
9553 if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
9555 backtrace.next = backtrace_list;
9556 backtrace_list = &backtrace;
9557 backtrace.function = &Qcall_interactively;
9558 backtrace.args = &cmd;
9559 backtrace.nargs = 1;
9560 backtrace.evalargs = 0;
9562 tem = Fcall_interactively (cmd, record_flag, keys);
9564 backtrace_list = backtrace.next;
9565 return tem;
9567 return Qnil;
9572 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
9573 1, 1, "P",
9574 doc: /* Read function name, then read its arguments and call it. */)
9575 (prefixarg)
9576 Lisp_Object prefixarg;
9578 Lisp_Object function;
9579 char buf[40];
9580 int saved_last_point_position;
9581 Lisp_Object saved_keys, saved_last_point_position_buffer;
9582 Lisp_Object bindings, value;
9583 struct gcpro gcpro1, gcpro2, gcpro3;
9585 saved_keys = Fvector (this_command_key_count,
9586 XVECTOR (this_command_keys)->contents);
9587 saved_last_point_position_buffer = last_point_position_buffer;
9588 saved_last_point_position = last_point_position;
9589 buf[0] = 0;
9590 GCPRO3 (saved_keys, prefixarg, saved_last_point_position_buffer);
9592 if (EQ (prefixarg, Qminus))
9593 strcpy (buf, "- ");
9594 else if (CONSP (prefixarg) && XINT (XCAR (prefixarg)) == 4)
9595 strcpy (buf, "C-u ");
9596 else if (CONSP (prefixarg) && INTEGERP (XCAR (prefixarg)))
9598 if (sizeof (int) == sizeof (EMACS_INT))
9599 sprintf (buf, "%d ", XINT (XCAR (prefixarg)));
9600 else if (sizeof (long) == sizeof (EMACS_INT))
9601 sprintf (buf, "%ld ", (long) XINT (XCAR (prefixarg)));
9602 else
9603 abort ();
9605 else if (INTEGERP (prefixarg))
9607 if (sizeof (int) == sizeof (EMACS_INT))
9608 sprintf (buf, "%d ", XINT (prefixarg));
9609 else if (sizeof (long) == sizeof (EMACS_INT))
9610 sprintf (buf, "%ld ", (long) XINT (prefixarg));
9611 else
9612 abort ();
9615 /* This isn't strictly correct if execute-extended-command
9616 is bound to anything else. Perhaps it should use
9617 this_command_keys? */
9618 strcat (buf, "M-x ");
9620 /* Prompt with buf, and then read a string, completing from and
9621 restricting to the set of all defined commands. Don't provide
9622 any initial input. Save the command read on the extended-command
9623 history list. */
9624 function = Fcompleting_read (build_string (buf),
9625 Vobarray, Qcommandp,
9626 Qt, Qnil, Qextended_command_history, Qnil,
9627 Qnil);
9629 if (STRINGP (function) && SCHARS (function) == 0)
9630 error ("No command name given");
9632 /* Set this_command_keys to the concatenation of saved_keys and
9633 function, followed by a RET. */
9635 Lisp_Object *keys;
9636 int i;
9638 this_command_key_count = 0;
9639 this_single_command_key_start = 0;
9641 keys = XVECTOR (saved_keys)->contents;
9642 for (i = 0; i < XVECTOR (saved_keys)->size; i++)
9643 add_command_key (keys[i]);
9645 for (i = 0; i < SCHARS (function); i++)
9646 add_command_key (Faref (function, make_number (i)));
9648 add_command_key (make_number ('\015'));
9651 last_point_position = saved_last_point_position;
9652 last_point_position_buffer = saved_last_point_position_buffer;
9654 UNGCPRO;
9656 function = Fintern (function, Qnil);
9657 current_kboard->Vprefix_arg = prefixarg;
9658 Vthis_command = function;
9659 real_this_command = function;
9661 /* If enabled, show which key runs this command. */
9662 if (!NILP (Vsuggest_key_bindings)
9663 && NILP (Vexecuting_macro)
9664 && SYMBOLP (function))
9665 bindings = Fwhere_is_internal (function, Voverriding_local_map,
9666 Qt, Qnil, Qnil);
9667 else
9668 bindings = Qnil;
9670 value = Qnil;
9671 GCPRO2 (bindings, value);
9672 value = Fcommand_execute (function, Qt, Qnil, Qnil);
9674 /* If the command has a key binding, print it now. */
9675 if (!NILP (bindings)
9676 && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
9677 Qmouse_movement)))
9679 /* But first wait, and skip the message if there is input. */
9680 int delay_time;
9681 if (!NILP (echo_area_buffer[0]))
9682 /* This command displayed something in the echo area;
9683 so wait a few seconds, then display our suggestion message. */
9684 delay_time = (NUMBERP (Vsuggest_key_bindings)
9685 ? XINT (Vsuggest_key_bindings) : 2);
9686 else
9687 /* This command left the echo area empty,
9688 so display our message immediately. */
9689 delay_time = 0;
9691 if (!NILP (Fsit_for (make_number (delay_time), Qnil, Qnil))
9692 && ! CONSP (Vunread_command_events))
9694 Lisp_Object binding;
9695 char *newmessage;
9696 int message_p = push_message ();
9697 int count = SPECPDL_INDEX ();
9699 record_unwind_protect (pop_message_unwind, Qnil);
9700 binding = Fkey_description (bindings);
9702 newmessage
9703 = (char *) alloca (SCHARS (SYMBOL_NAME (function))
9704 + SBYTES (binding)
9705 + 100);
9706 sprintf (newmessage, "You can run the command `%s' with %s",
9707 SDATA (SYMBOL_NAME (function)),
9708 SDATA (binding));
9709 message2_nolog (newmessage,
9710 strlen (newmessage),
9711 STRING_MULTIBYTE (binding));
9712 if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings)
9713 ? Vsuggest_key_bindings : make_number (2)),
9714 Qnil, Qnil))
9715 && message_p)
9716 restore_message ();
9718 unbind_to (count, Qnil);
9722 RETURN_UNGCPRO (value);
9726 /* Return nonzero if input events are pending. */
9729 detect_input_pending ()
9731 if (!input_pending)
9732 get_input_pending (&input_pending, 0);
9734 return input_pending;
9737 /* Return nonzero if input events are pending, and run any pending timers. */
9740 detect_input_pending_run_timers (do_display)
9741 int do_display;
9743 int old_timers_run = timers_run;
9745 if (!input_pending)
9746 get_input_pending (&input_pending, 1);
9748 if (old_timers_run != timers_run && do_display)
9750 redisplay_preserve_echo_area (8);
9751 /* The following fixes a bug when using lazy-lock with
9752 lazy-lock-defer-on-the-fly set to t, i.e. when fontifying
9753 from an idle timer function. The symptom of the bug is that
9754 the cursor sometimes doesn't become visible until the next X
9755 event is processed. --gerd. */
9756 if (rif)
9757 rif->flush_display (NULL);
9760 return input_pending;
9763 /* This is called in some cases before a possible quit.
9764 It cases the next call to detect_input_pending to recompute input_pending.
9765 So calling this function unnecessarily can't do any harm. */
9767 void
9768 clear_input_pending ()
9770 input_pending = 0;
9773 /* Return nonzero if there are pending requeued events.
9774 This isn't used yet. The hope is to make wait_reading_process_input
9775 call it, and return if it runs Lisp code that unreads something.
9776 The problem is, kbd_buffer_get_event needs to be fixed to know what
9777 to do in that case. It isn't trivial. */
9780 requeued_events_pending_p ()
9782 return (!NILP (Vunread_command_events) || unread_command_char != -1);
9786 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
9787 doc: /* Return t if command input is currently available with no wait.
9788 Actually, the value is nil only if we can be sure that no input is available;
9789 if there is a doubt, the value is t. */)
9792 if (!NILP (Vunread_command_events) || unread_command_char != -1)
9793 return (Qt);
9795 get_filtered_input_pending (&input_pending, 1, 1);
9796 return input_pending > 0 ? Qt : Qnil;
9799 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
9800 doc: /* Return vector of last 100 events, not counting those from keyboard macros. */)
9803 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
9804 Lisp_Object val;
9806 if (total_keys < NUM_RECENT_KEYS)
9807 return Fvector (total_keys, keys);
9808 else
9810 val = Fvector (NUM_RECENT_KEYS, keys);
9811 bcopy (keys + recent_keys_index,
9812 XVECTOR (val)->contents,
9813 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
9814 bcopy (keys,
9815 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
9816 recent_keys_index * sizeof (Lisp_Object));
9817 return val;
9821 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
9822 doc: /* Return the key sequence that invoked this command.
9823 However, if the command has called `read-key-sequence', it returns
9824 the last key sequence that has been read.
9825 The value is a string or a vector. */)
9828 return make_event_array (this_command_key_count,
9829 XVECTOR (this_command_keys)->contents);
9832 DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
9833 doc: /* Return the key sequence that invoked this command, as a vector.
9834 However, if the command has called `read-key-sequence', it returns
9835 the last key sequence that has been read. */)
9838 return Fvector (this_command_key_count,
9839 XVECTOR (this_command_keys)->contents);
9842 DEFUN ("this-single-command-keys", Fthis_single_command_keys,
9843 Sthis_single_command_keys, 0, 0, 0,
9844 doc: /* Return the key sequence that invoked this command.
9845 More generally, it returns the last key sequence read, either by
9846 the command loop or by `read-key-sequence'.
9847 Unlike `this-command-keys', this function's value
9848 does not include prefix arguments.
9849 The value is always a vector. */)
9852 return Fvector (this_command_key_count
9853 - this_single_command_key_start,
9854 (XVECTOR (this_command_keys)->contents
9855 + this_single_command_key_start));
9858 DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
9859 Sthis_single_command_raw_keys, 0, 0, 0,
9860 doc: /* Return the raw events that were read for this command.
9861 More generally, it returns the last key sequence read, either by
9862 the command loop or by `read-key-sequence'.
9863 Unlike `this-single-command-keys', this function's value
9864 shows the events before all translations (except for input methods).
9865 The value is always a vector. */)
9868 return Fvector (raw_keybuf_count,
9869 (XVECTOR (raw_keybuf)->contents));
9872 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
9873 Sreset_this_command_lengths, 0, 0, 0,
9874 doc: /* Used for complicated reasons in `universal-argument-other-key'.
9876 `universal-argument-other-key' rereads the event just typed.
9877 It then gets translated through `function-key-map'.
9878 The translated event gets included in the echo area and in
9879 the value of `this-command-keys' in addition to the raw original event.
9880 That is not right.
9882 Calling this function directs the translated event to replace
9883 the original event, so that only one version of the event actually
9884 appears in the echo area and in the value of `this-command-keys'. */)
9887 before_command_restore_flag = 1;
9888 before_command_key_count_1 = before_command_key_count;
9889 before_command_echo_length_1 = before_command_echo_length;
9890 return Qnil;
9893 DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
9894 Sclear_this_command_keys, 0, 1, 0,
9895 doc: /* Clear out the vector that `this-command-keys' returns.
9896 Also clear the record of the last 100 events, unless optional arg
9897 KEEP-RECORD is non-nil. */)
9898 (keep_record)
9899 Lisp_Object keep_record;
9901 int i;
9903 this_command_key_count = 0;
9905 if (NILP (keep_record))
9907 for (i = 0; i < XVECTOR (recent_keys)->size; ++i)
9908 XVECTOR (recent_keys)->contents[i] = Qnil;
9909 total_keys = 0;
9910 recent_keys_index = 0;
9912 return Qnil;
9915 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
9916 doc: /* Return the current depth in recursive edits. */)
9919 Lisp_Object temp;
9920 XSETFASTINT (temp, command_loop_level + minibuf_level);
9921 return temp;
9924 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
9925 "FOpen dribble file: ",
9926 doc: /* Start writing all keyboard characters to a dribble file called FILE.
9927 If FILE is nil, close any open dribble file. */)
9928 (file)
9929 Lisp_Object file;
9931 if (dribble)
9933 fclose (dribble);
9934 dribble = 0;
9936 if (!NILP (file))
9938 file = Fexpand_file_name (file, Qnil);
9939 dribble = fopen (SDATA (file), "w");
9940 if (dribble == 0)
9941 report_file_error ("Opening dribble", Fcons (file, Qnil));
9943 return Qnil;
9946 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
9947 doc: /* Discard the contents of the terminal input buffer.
9948 Also end any kbd macro being defined. */)
9951 if (!NILP (current_kboard->defining_kbd_macro))
9953 /* Discard the last command from the macro. */
9954 Fcancel_kbd_macro_events ();
9955 end_kbd_macro ();
9958 update_mode_lines++;
9960 Vunread_command_events = Qnil;
9961 unread_command_char = -1;
9963 discard_tty_input ();
9965 kbd_fetch_ptr = kbd_store_ptr;
9966 Ffillarray (kbd_buffer_gcpro, Qnil);
9967 input_pending = 0;
9969 return Qnil;
9972 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
9973 doc: /* Stop Emacs and return to superior process. You can resume later.
9974 If `cannot-suspend' is non-nil, or if the system doesn't support job
9975 control, run a subshell instead.
9977 If optional arg STUFFSTRING is non-nil, its characters are stuffed
9978 to be read as terminal input by Emacs's parent, after suspension.
9980 Before suspending, run the normal hook `suspend-hook'.
9981 After resumption run the normal hook `suspend-resume-hook'.
9983 Some operating systems cannot stop the Emacs process and resume it later.
9984 On such systems, Emacs starts a subshell instead of suspending. */)
9985 (stuffstring)
9986 Lisp_Object stuffstring;
9988 int count = SPECPDL_INDEX ();
9989 int old_height, old_width;
9990 int width, height;
9991 struct gcpro gcpro1;
9993 if (!NILP (stuffstring))
9994 CHECK_STRING (stuffstring);
9996 /* Run the functions in suspend-hook. */
9997 if (!NILP (Vrun_hooks))
9998 call1 (Vrun_hooks, intern ("suspend-hook"));
10000 GCPRO1 (stuffstring);
10001 get_frame_size (&old_width, &old_height);
10002 reset_sys_modes ();
10003 /* sys_suspend can get an error if it tries to fork a subshell
10004 and the system resources aren't available for that. */
10005 record_unwind_protect ((Lisp_Object (*) P_ ((Lisp_Object))) init_sys_modes,
10006 Qnil);
10007 stuff_buffered_input (stuffstring);
10008 if (cannot_suspend)
10009 sys_subshell ();
10010 else
10011 sys_suspend ();
10012 unbind_to (count, Qnil);
10014 /* Check if terminal/window size has changed.
10015 Note that this is not useful when we are running directly
10016 with a window system; but suspend should be disabled in that case. */
10017 get_frame_size (&width, &height);
10018 if (width != old_width || height != old_height)
10019 change_frame_size (SELECTED_FRAME (), height, width, 0, 0, 0);
10021 /* Run suspend-resume-hook. */
10022 if (!NILP (Vrun_hooks))
10023 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
10025 UNGCPRO;
10026 return Qnil;
10029 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
10030 Then in any case stuff anything Emacs has read ahead and not used. */
10032 void
10033 stuff_buffered_input (stuffstring)
10034 Lisp_Object stuffstring;
10036 /* stuff_char works only in BSD, versions 4.2 and up. */
10037 #ifdef BSD_SYSTEM
10038 #ifndef BSD4_1
10039 register unsigned char *p;
10041 if (STRINGP (stuffstring))
10043 register int count;
10045 p = SDATA (stuffstring);
10046 count = SBYTES (stuffstring);
10047 while (count-- > 0)
10048 stuff_char (*p++);
10049 stuff_char ('\n');
10052 /* Anything we have read ahead, put back for the shell to read. */
10053 /* ?? What should this do when we have multiple keyboards??
10054 Should we ignore anything that was typed in at the "wrong" kboard? */
10055 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
10057 int idx;
10059 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
10060 kbd_fetch_ptr = kbd_buffer;
10061 if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT)
10062 stuff_char (kbd_fetch_ptr->code);
10064 kbd_fetch_ptr->kind = NO_EVENT;
10065 idx = 2 * (kbd_fetch_ptr - kbd_buffer);
10066 ASET (kbd_buffer_gcpro, idx, Qnil);
10067 ASET (kbd_buffer_gcpro, idx + 1, Qnil);
10070 input_pending = 0;
10071 #endif
10072 #endif /* BSD_SYSTEM and not BSD4_1 */
10075 void
10076 set_waiting_for_input (time_to_clear)
10077 EMACS_TIME *time_to_clear;
10079 input_available_clear_time = time_to_clear;
10081 /* Tell interrupt_signal to throw back to read_char, */
10082 waiting_for_input = 1;
10084 /* If interrupt_signal was called before and buffered a C-g,
10085 make it run again now, to avoid timing error. */
10086 if (!NILP (Vquit_flag))
10087 quit_throw_to_read_char ();
10090 void
10091 clear_waiting_for_input ()
10093 /* Tell interrupt_signal not to throw back to read_char, */
10094 waiting_for_input = 0;
10095 input_available_clear_time = 0;
10098 /* This routine is called at interrupt level in response to C-g.
10100 If interrupt_input, this is the handler for SIGINT. Otherwise, it
10101 is called from kbd_buffer_store_event, in handling SIGIO or
10102 SIGTINT.
10104 If `waiting_for_input' is non zero, then unless `echoing' is
10105 nonzero, immediately throw back to read_char.
10107 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
10108 eval to throw, when it gets a chance. If quit-flag is already
10109 non-nil, it stops the job right away. */
10111 static SIGTYPE
10112 interrupt_signal (signalnum) /* If we don't have an argument, */
10113 int signalnum; /* some compilers complain in signal calls. */
10115 char c;
10116 /* Must preserve main program's value of errno. */
10117 int old_errno = errno;
10118 struct frame *sf = SELECTED_FRAME ();
10120 #if defined (USG) && !defined (POSIX_SIGNALS)
10121 if (!read_socket_hook && NILP (Vwindow_system))
10123 /* USG systems forget handlers when they are used;
10124 must reestablish each time */
10125 signal (SIGINT, interrupt_signal);
10126 signal (SIGQUIT, interrupt_signal);
10128 #endif /* USG */
10130 cancel_echoing ();
10132 if (!NILP (Vquit_flag)
10133 && (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf)))
10135 /* If SIGINT isn't blocked, don't let us be interrupted by
10136 another SIGINT, it might be harmful due to non-reentrancy
10137 in I/O functions. */
10138 sigblock (sigmask (SIGINT));
10140 fflush (stdout);
10141 reset_sys_modes ();
10143 #ifdef SIGTSTP /* Support possible in later USG versions */
10145 * On systems which can suspend the current process and return to the original
10146 * shell, this command causes the user to end up back at the shell.
10147 * The "Auto-save" and "Abort" questions are not asked until
10148 * the user elects to return to emacs, at which point he can save the current
10149 * job and either dump core or continue.
10151 sys_suspend ();
10152 #else
10153 #ifdef VMS
10154 if (sys_suspend () == -1)
10156 printf ("Not running as a subprocess;\n");
10157 printf ("you can continue or abort.\n");
10159 #else /* not VMS */
10160 /* Perhaps should really fork an inferior shell?
10161 But that would not provide any way to get back
10162 to the original shell, ever. */
10163 printf ("No support for stopping a process on this operating system;\n");
10164 printf ("you can continue or abort.\n");
10165 #endif /* not VMS */
10166 #endif /* not SIGTSTP */
10167 #ifdef MSDOS
10168 /* We must remain inside the screen area when the internal terminal
10169 is used. Note that [Enter] is not echoed by dos. */
10170 cursor_to (0, 0);
10171 #endif
10172 /* It doesn't work to autosave while GC is in progress;
10173 the code used for auto-saving doesn't cope with the mark bit. */
10174 if (!gc_in_progress)
10176 printf ("Auto-save? (y or n) ");
10177 fflush (stdout);
10178 if (((c = getchar ()) & ~040) == 'Y')
10180 Fdo_auto_save (Qt, Qnil);
10181 #ifdef MSDOS
10182 printf ("\r\nAuto-save done");
10183 #else /* not MSDOS */
10184 printf ("Auto-save done\n");
10185 #endif /* not MSDOS */
10187 while (c != '\n') c = getchar ();
10189 else
10191 /* During GC, it must be safe to reenable quitting again. */
10192 Vinhibit_quit = Qnil;
10193 #ifdef MSDOS
10194 printf ("\r\n");
10195 #endif /* not MSDOS */
10196 printf ("Garbage collection in progress; cannot auto-save now\r\n");
10197 printf ("but will instead do a real quit after garbage collection ends\r\n");
10198 fflush (stdout);
10201 #ifdef MSDOS
10202 printf ("\r\nAbort? (y or n) ");
10203 #else /* not MSDOS */
10204 #ifdef VMS
10205 printf ("Abort (and enter debugger)? (y or n) ");
10206 #else /* not VMS */
10207 printf ("Abort (and dump core)? (y or n) ");
10208 #endif /* not VMS */
10209 #endif /* not MSDOS */
10210 fflush (stdout);
10211 if (((c = getchar ()) & ~040) == 'Y')
10212 abort ();
10213 while (c != '\n') c = getchar ();
10214 #ifdef MSDOS
10215 printf ("\r\nContinuing...\r\n");
10216 #else /* not MSDOS */
10217 printf ("Continuing...\n");
10218 #endif /* not MSDOS */
10219 fflush (stdout);
10220 init_sys_modes ();
10221 sigfree ();
10223 else
10225 /* If executing a function that wants to be interrupted out of
10226 and the user has not deferred quitting by binding `inhibit-quit'
10227 then quit right away. */
10228 if (immediate_quit && NILP (Vinhibit_quit))
10230 struct gl_state_s saved;
10231 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10233 immediate_quit = 0;
10234 sigfree ();
10235 saved = gl_state;
10236 GCPRO4 (saved.object, saved.global_code,
10237 saved.current_syntax_table, saved.old_prop);
10238 Fsignal (Qquit, Qnil);
10239 gl_state = saved;
10240 UNGCPRO;
10242 else
10243 /* Else request quit when it's safe */
10244 Vquit_flag = Qt;
10247 if (waiting_for_input && !echoing)
10248 quit_throw_to_read_char ();
10250 errno = old_errno;
10253 /* Handle a C-g by making read_char return C-g. */
10255 void
10256 quit_throw_to_read_char ()
10258 sigfree ();
10259 /* Prevent another signal from doing this before we finish. */
10260 clear_waiting_for_input ();
10261 input_pending = 0;
10263 Vunread_command_events = Qnil;
10264 unread_command_char = -1;
10266 #if 0 /* Currently, sit_for is called from read_char without turning
10267 off polling. And that can call set_waiting_for_input.
10268 It seems to be harmless. */
10269 #ifdef POLL_FOR_INPUT
10270 /* May be > 1 if in recursive minibuffer. */
10271 if (poll_suppress_count == 0)
10272 abort ();
10273 #endif
10274 #endif
10275 if (FRAMEP (internal_last_event_frame)
10276 && !EQ (internal_last_event_frame, selected_frame))
10277 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
10278 0, 0);
10280 _longjmp (getcjmp, 1);
10283 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
10284 doc: /* Set mode of reading keyboard input.
10285 First arg INTERRUPT non-nil means use input interrupts;
10286 nil means use CBREAK mode.
10287 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
10288 (no effect except in CBREAK mode).
10289 Third arg META t means accept 8-bit input (for a Meta key).
10290 META nil means ignore the top bit, on the assumption it is parity.
10291 Otherwise, accept 8-bit input and don't use the top bit for Meta.
10292 Optional fourth arg QUIT if non-nil specifies character to use for quitting.
10293 See also `current-input-mode'. */)
10294 (interrupt, flow, meta, quit)
10295 Lisp_Object interrupt, flow, meta, quit;
10297 if (!NILP (quit)
10298 && (!INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400))
10299 error ("set-input-mode: QUIT must be an ASCII character");
10301 #ifdef POLL_FOR_INPUT
10302 stop_polling ();
10303 #endif
10305 #ifndef DOS_NT
10306 /* this causes startup screen to be restored and messes with the mouse */
10307 reset_sys_modes ();
10308 #endif
10310 #ifdef SIGIO
10311 /* Note SIGIO has been undef'd if FIONREAD is missing. */
10312 if (read_socket_hook)
10314 /* When using X, don't give the user a real choice,
10315 because we haven't implemented the mechanisms to support it. */
10316 #ifdef NO_SOCK_SIGIO
10317 interrupt_input = 0;
10318 #else /* not NO_SOCK_SIGIO */
10319 interrupt_input = 1;
10320 #endif /* NO_SOCK_SIGIO */
10322 else
10323 interrupt_input = !NILP (interrupt);
10324 #else /* not SIGIO */
10325 interrupt_input = 0;
10326 #endif /* not SIGIO */
10328 /* Our VMS input only works by interrupts, as of now. */
10329 #ifdef VMS
10330 interrupt_input = 1;
10331 #endif
10333 flow_control = !NILP (flow);
10334 if (NILP (meta))
10335 meta_key = 0;
10336 else if (EQ (meta, Qt))
10337 meta_key = 1;
10338 else
10339 meta_key = 2;
10340 if (!NILP (quit))
10341 /* Don't let this value be out of range. */
10342 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
10344 #ifndef DOS_NT
10345 init_sys_modes ();
10346 #endif
10348 #ifdef POLL_FOR_INPUT
10349 poll_suppress_count = 1;
10350 start_polling ();
10351 #endif
10352 return Qnil;
10355 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
10356 doc: /* Return information about the way Emacs currently reads keyboard input.
10357 The value is a list of the form (INTERRUPT FLOW META QUIT), where
10358 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if
10359 nil, Emacs is using CBREAK mode.
10360 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
10361 terminal; this does not apply if Emacs uses interrupt-driven input.
10362 META is t if accepting 8-bit input with 8th bit as Meta flag.
10363 META nil means ignoring the top bit, on the assumption it is parity.
10364 META is neither t nor nil if accepting 8-bit input and using
10365 all 8 bits as the character code.
10366 QUIT is the character Emacs currently uses to quit.
10367 The elements of this list correspond to the arguments of
10368 `set-input-mode'. */)
10371 Lisp_Object val[4];
10373 val[0] = interrupt_input ? Qt : Qnil;
10374 val[1] = flow_control ? Qt : Qnil;
10375 val[2] = meta_key == 2 ? make_number (0) : meta_key == 1 ? Qt : Qnil;
10376 XSETFASTINT (val[3], quit_char);
10378 return Flist (sizeof (val) / sizeof (val[0]), val);
10383 * Set up a new kboard object with reasonable initial values.
10385 void
10386 init_kboard (kb)
10387 KBOARD *kb;
10389 kb->Voverriding_terminal_local_map = Qnil;
10390 kb->Vlast_command = Qnil;
10391 kb->Vreal_last_command = Qnil;
10392 kb->Vprefix_arg = Qnil;
10393 kb->Vlast_prefix_arg = Qnil;
10394 kb->kbd_queue = Qnil;
10395 kb->kbd_queue_has_data = 0;
10396 kb->immediate_echo = 0;
10397 kb->echo_string = Qnil;
10398 kb->echo_after_prompt = -1;
10399 kb->kbd_macro_buffer = 0;
10400 kb->kbd_macro_bufsize = 0;
10401 kb->defining_kbd_macro = Qnil;
10402 kb->Vlast_kbd_macro = Qnil;
10403 kb->reference_count = 0;
10404 kb->Vsystem_key_alist = Qnil;
10405 kb->system_key_syms = Qnil;
10406 kb->Vdefault_minibuffer_frame = Qnil;
10410 * Destroy the contents of a kboard object, but not the object itself.
10411 * We use this just before deleting it, or if we're going to initialize
10412 * it a second time.
10414 static void
10415 wipe_kboard (kb)
10416 KBOARD *kb;
10418 if (kb->kbd_macro_buffer)
10419 xfree (kb->kbd_macro_buffer);
10422 #ifdef MULTI_KBOARD
10424 /* Free KB and memory referenced from it. */
10426 void
10427 delete_kboard (kb)
10428 KBOARD *kb;
10430 KBOARD **kbp;
10432 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
10433 if (*kbp == NULL)
10434 abort ();
10435 *kbp = kb->next_kboard;
10437 /* Prevent a dangling reference to KB. */
10438 if (kb == current_kboard
10439 && FRAMEP (selected_frame)
10440 && FRAME_LIVE_P (XFRAME (selected_frame)))
10442 current_kboard = XFRAME (selected_frame)->kboard;
10443 if (current_kboard == kb)
10444 abort ();
10447 wipe_kboard (kb);
10448 xfree (kb);
10451 #endif /* MULTI_KBOARD */
10453 void
10454 init_keyboard ()
10456 /* This is correct before outermost invocation of the editor loop */
10457 command_loop_level = -1;
10458 immediate_quit = 0;
10459 quit_char = Ctl ('g');
10460 Vunread_command_events = Qnil;
10461 unread_command_char = -1;
10462 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
10463 total_keys = 0;
10464 recent_keys_index = 0;
10465 kbd_fetch_ptr = kbd_buffer;
10466 kbd_store_ptr = kbd_buffer;
10467 kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
10468 #ifdef HAVE_MOUSE
10469 do_mouse_tracking = Qnil;
10470 #endif
10471 input_pending = 0;
10473 /* This means that command_loop_1 won't try to select anything the first
10474 time through. */
10475 internal_last_event_frame = Qnil;
10476 Vlast_event_frame = internal_last_event_frame;
10478 #ifdef MULTI_KBOARD
10479 current_kboard = initial_kboard;
10480 #endif
10481 wipe_kboard (current_kboard);
10482 init_kboard (current_kboard);
10484 if (!noninteractive && !read_socket_hook && NILP (Vwindow_system))
10486 signal (SIGINT, interrupt_signal);
10487 #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
10488 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
10489 SIGQUIT and we can't tell which one it will give us. */
10490 signal (SIGQUIT, interrupt_signal);
10491 #endif /* HAVE_TERMIO */
10493 /* Note SIGIO has been undef'd if FIONREAD is missing. */
10494 #ifdef SIGIO
10495 if (!noninteractive)
10496 signal (SIGIO, input_available_signal);
10497 #endif /* SIGIO */
10499 /* Use interrupt input by default, if it works and noninterrupt input
10500 has deficiencies. */
10502 #ifdef INTERRUPT_INPUT
10503 interrupt_input = 1;
10504 #else
10505 interrupt_input = 0;
10506 #endif
10508 /* Our VMS input only works by interrupts, as of now. */
10509 #ifdef VMS
10510 interrupt_input = 1;
10511 #endif
10513 sigfree ();
10514 dribble = 0;
10516 if (keyboard_init_hook)
10517 (*keyboard_init_hook) ();
10519 #ifdef POLL_FOR_INPUT
10520 poll_suppress_count = 1;
10521 start_polling ();
10522 #endif
10525 /* This type's only use is in syms_of_keyboard, to initialize the
10526 event header symbols and put properties on them. */
10527 struct event_head {
10528 Lisp_Object *var;
10529 char *name;
10530 Lisp_Object *kind;
10533 struct event_head head_table[] = {
10534 {&Qmouse_movement, "mouse-movement", &Qmouse_movement},
10535 {&Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement},
10536 {&Qswitch_frame, "switch-frame", &Qswitch_frame},
10537 {&Qdelete_frame, "delete-frame", &Qdelete_frame},
10538 {&Qiconify_frame, "iconify-frame", &Qiconify_frame},
10539 {&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible},
10540 {&Qselect_window, "select-window", &Qselect_window}
10543 void
10544 syms_of_keyboard ()
10546 Vpre_help_message = Qnil;
10547 staticpro (&Vpre_help_message);
10549 Vlispy_mouse_stem = build_string ("mouse");
10550 staticpro (&Vlispy_mouse_stem);
10552 /* Tool-bars. */
10553 QCimage = intern (":image");
10554 staticpro (&QCimage);
10556 staticpro (&Qhelp_echo);
10557 Qhelp_echo = intern ("help-echo");
10559 staticpro (&item_properties);
10560 item_properties = Qnil;
10562 staticpro (&tool_bar_item_properties);
10563 tool_bar_item_properties = Qnil;
10564 staticpro (&tool_bar_items_vector);
10565 tool_bar_items_vector = Qnil;
10567 staticpro (&real_this_command);
10568 real_this_command = Qnil;
10570 Qtimer_event_handler = intern ("timer-event-handler");
10571 staticpro (&Qtimer_event_handler);
10573 Qdisabled_command_hook = intern ("disabled-command-hook");
10574 staticpro (&Qdisabled_command_hook);
10576 Qself_insert_command = intern ("self-insert-command");
10577 staticpro (&Qself_insert_command);
10579 Qforward_char = intern ("forward-char");
10580 staticpro (&Qforward_char);
10582 Qbackward_char = intern ("backward-char");
10583 staticpro (&Qbackward_char);
10585 Qdisabled = intern ("disabled");
10586 staticpro (&Qdisabled);
10588 Qundefined = intern ("undefined");
10589 staticpro (&Qundefined);
10591 Qpre_command_hook = intern ("pre-command-hook");
10592 staticpro (&Qpre_command_hook);
10594 Qpost_command_hook = intern ("post-command-hook");
10595 staticpro (&Qpost_command_hook);
10597 Qpost_command_idle_hook = intern ("post-command-idle-hook");
10598 staticpro (&Qpost_command_idle_hook);
10600 Qdeferred_action_function = intern ("deferred-action-function");
10601 staticpro (&Qdeferred_action_function);
10603 Qcommand_hook_internal = intern ("command-hook-internal");
10604 staticpro (&Qcommand_hook_internal);
10606 Qfunction_key = intern ("function-key");
10607 staticpro (&Qfunction_key);
10608 Qmouse_click = intern ("mouse-click");
10609 staticpro (&Qmouse_click);
10610 #if defined(WINDOWSNT) || defined(MAC_OSX)
10611 Qmouse_wheel = intern ("mouse-wheel");
10612 staticpro (&Qmouse_wheel);
10613 #endif
10614 #ifdef WINDOWSNT
10615 Qlanguage_change = intern ("language-change");
10616 staticpro (&Qlanguage_change);
10617 #endif
10618 Qdrag_n_drop = intern ("drag-n-drop");
10619 staticpro (&Qdrag_n_drop);
10621 Qsave_session = intern ("save-session");
10622 staticpro(&Qsave_session);
10624 Qusr1_signal = intern ("usr1-signal");
10625 staticpro (&Qusr1_signal);
10626 Qusr2_signal = intern ("usr2-signal");
10627 staticpro (&Qusr2_signal);
10629 Qmenu_enable = intern ("menu-enable");
10630 staticpro (&Qmenu_enable);
10631 Qmenu_alias = intern ("menu-alias");
10632 staticpro (&Qmenu_alias);
10633 QCenable = intern (":enable");
10634 staticpro (&QCenable);
10635 QCvisible = intern (":visible");
10636 staticpro (&QCvisible);
10637 QChelp = intern (":help");
10638 staticpro (&QChelp);
10639 QCfilter = intern (":filter");
10640 staticpro (&QCfilter);
10641 QCbutton = intern (":button");
10642 staticpro (&QCbutton);
10643 QCkeys = intern (":keys");
10644 staticpro (&QCkeys);
10645 QCkey_sequence = intern (":key-sequence");
10646 staticpro (&QCkey_sequence);
10647 QCtoggle = intern (":toggle");
10648 staticpro (&QCtoggle);
10649 QCradio = intern (":radio");
10650 staticpro (&QCradio);
10652 Qmode_line = intern ("mode-line");
10653 staticpro (&Qmode_line);
10654 Qvertical_line = intern ("vertical-line");
10655 staticpro (&Qvertical_line);
10656 Qvertical_scroll_bar = intern ("vertical-scroll-bar");
10657 staticpro (&Qvertical_scroll_bar);
10658 Qmenu_bar = intern ("menu-bar");
10659 staticpro (&Qmenu_bar);
10661 Qabove_handle = intern ("above-handle");
10662 staticpro (&Qabove_handle);
10663 Qhandle = intern ("handle");
10664 staticpro (&Qhandle);
10665 Qbelow_handle = intern ("below-handle");
10666 staticpro (&Qbelow_handle);
10667 Qup = intern ("up");
10668 staticpro (&Qup);
10669 Qdown = intern ("down");
10670 staticpro (&Qdown);
10671 Qtop = intern ("top");
10672 staticpro (&Qtop);
10673 Qbottom = intern ("bottom");
10674 staticpro (&Qbottom);
10675 Qend_scroll = intern ("end-scroll");
10676 staticpro (&Qend_scroll);
10677 Qratio = intern ("ratio");
10678 staticpro (&Qratio);
10680 Qevent_kind = intern ("event-kind");
10681 staticpro (&Qevent_kind);
10682 Qevent_symbol_elements = intern ("event-symbol-elements");
10683 staticpro (&Qevent_symbol_elements);
10684 Qevent_symbol_element_mask = intern ("event-symbol-element-mask");
10685 staticpro (&Qevent_symbol_element_mask);
10686 Qmodifier_cache = intern ("modifier-cache");
10687 staticpro (&Qmodifier_cache);
10689 Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar");
10690 staticpro (&Qrecompute_lucid_menubar);
10691 Qactivate_menubar_hook = intern ("activate-menubar-hook");
10692 staticpro (&Qactivate_menubar_hook);
10694 Qpolling_period = intern ("polling-period");
10695 staticpro (&Qpolling_period);
10697 Qinput_method_function = intern ("input-method-function");
10698 staticpro (&Qinput_method_function);
10700 Qinput_method_exit_on_first_char = intern ("input-method-exit-on-first-char");
10701 staticpro (&Qinput_method_exit_on_first_char);
10702 Qinput_method_use_echo_area = intern ("input-method-use-echo-area");
10703 staticpro (&Qinput_method_use_echo_area);
10705 Fset (Qinput_method_exit_on_first_char, Qnil);
10706 Fset (Qinput_method_use_echo_area, Qnil);
10708 last_point_position_buffer = Qnil;
10711 struct event_head *p;
10713 for (p = head_table;
10714 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
10715 p++)
10717 *p->var = intern (p->name);
10718 staticpro (p->var);
10719 Fput (*p->var, Qevent_kind, *p->kind);
10720 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
10724 button_down_location = Fmake_vector (make_number (1), Qnil);
10725 staticpro (&button_down_location);
10726 mouse_syms = Fmake_vector (make_number (1), Qnil);
10727 staticpro (&mouse_syms);
10730 int i;
10731 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
10733 modifier_symbols = Fmake_vector (make_number (len), Qnil);
10734 for (i = 0; i < len; i++)
10735 if (modifier_names[i])
10736 XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]);
10737 staticpro (&modifier_symbols);
10740 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
10741 staticpro (&recent_keys);
10743 this_command_keys = Fmake_vector (make_number (40), Qnil);
10744 staticpro (&this_command_keys);
10746 raw_keybuf = Fmake_vector (make_number (30), Qnil);
10747 staticpro (&raw_keybuf);
10749 Qextended_command_history = intern ("extended-command-history");
10750 Fset (Qextended_command_history, Qnil);
10751 staticpro (&Qextended_command_history);
10753 kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
10754 staticpro (&kbd_buffer_gcpro);
10756 accent_key_syms = Qnil;
10757 staticpro (&accent_key_syms);
10759 func_key_syms = Qnil;
10760 staticpro (&func_key_syms);
10762 #if defined(WINDOWSNT) || defined(MAC_OSX)
10763 mouse_wheel_syms = Qnil;
10764 staticpro (&mouse_wheel_syms);
10765 drag_n_drop_syms = Qnil;
10766 staticpro (&drag_n_drop_syms);
10767 #endif
10769 unread_switch_frame = Qnil;
10770 staticpro (&unread_switch_frame);
10772 internal_last_event_frame = Qnil;
10773 staticpro (&internal_last_event_frame);
10775 read_key_sequence_cmd = Qnil;
10776 staticpro (&read_key_sequence_cmd);
10778 menu_bar_one_keymap_changed_items = Qnil;
10779 staticpro (&menu_bar_one_keymap_changed_items);
10781 defsubr (&Sevent_convert_list);
10782 defsubr (&Sread_key_sequence);
10783 defsubr (&Sread_key_sequence_vector);
10784 defsubr (&Srecursive_edit);
10785 #ifdef HAVE_MOUSE
10786 defsubr (&Strack_mouse);
10787 #endif
10788 defsubr (&Sinput_pending_p);
10789 defsubr (&Scommand_execute);
10790 defsubr (&Srecent_keys);
10791 defsubr (&Sthis_command_keys);
10792 defsubr (&Sthis_command_keys_vector);
10793 defsubr (&Sthis_single_command_keys);
10794 defsubr (&Sthis_single_command_raw_keys);
10795 defsubr (&Sreset_this_command_lengths);
10796 defsubr (&Sclear_this_command_keys);
10797 defsubr (&Ssuspend_emacs);
10798 defsubr (&Sabort_recursive_edit);
10799 defsubr (&Sexit_recursive_edit);
10800 defsubr (&Srecursion_depth);
10801 defsubr (&Stop_level);
10802 defsubr (&Sdiscard_input);
10803 defsubr (&Sopen_dribble_file);
10804 defsubr (&Sset_input_mode);
10805 defsubr (&Scurrent_input_mode);
10806 defsubr (&Sexecute_extended_command);
10808 DEFVAR_LISP ("last-command-char", &last_command_char,
10809 doc: /* Last input event that was part of a command. */);
10811 DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char,
10812 doc: /* Last input event that was part of a command. */);
10814 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
10815 doc: /* Last input event in a command, except for mouse menu events.
10816 Mouse menus give back keys that don't look like mouse events;
10817 this variable holds the actual mouse event that led to the menu,
10818 so that you can determine whether the command was run by mouse or not. */);
10820 DEFVAR_LISP ("last-input-char", &last_input_char,
10821 doc: /* Last input event. */);
10823 DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char,
10824 doc: /* Last input event. */);
10826 DEFVAR_LISP ("unread-command-events", &Vunread_command_events,
10827 doc: /* List of events to be read as the command input.
10828 These events are processed first, before actual keyboard input. */);
10829 Vunread_command_events = Qnil;
10831 DEFVAR_INT ("unread-command-char", &unread_command_char,
10832 doc: /* If not -1, an object to be read as next command input event. */);
10834 DEFVAR_LISP ("unread-post-input-method-events", &Vunread_post_input_method_events,
10835 doc: /* List of events to be processed as input by input methods.
10836 These events are processed after `unread-command-events', but
10837 before actual keyboard input. */);
10838 Vunread_post_input_method_events = Qnil;
10840 DEFVAR_LISP ("unread-input-method-events", &Vunread_input_method_events,
10841 doc: /* List of events to be processed as input by input methods.
10842 These events are processed after `unread-command-events', but
10843 before actual keyboard input. */);
10844 Vunread_input_method_events = Qnil;
10846 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
10847 doc: /* Meta-prefix character code.
10848 Meta-foo as command input turns into this character followed by foo. */);
10849 XSETINT (meta_prefix_char, 033);
10851 DEFVAR_KBOARD ("last-command", Vlast_command,
10852 doc: /* The last command executed.
10853 Normally a symbol with a function definition, but can be whatever was found
10854 in the keymap, or whatever the variable `this-command' was set to by that
10855 command.
10857 The value `mode-exit' is special; it means that the previous command
10858 read an event that told it to exit, and it did so and unread that event.
10859 In other words, the present command is the event that made the previous
10860 command exit.
10862 The value `kill-region' is special; it means that the previous command
10863 was a kill command. */);
10865 DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
10866 doc: /* Same as `last-command', but never altered by Lisp code. */);
10868 DEFVAR_LISP ("this-command", &Vthis_command,
10869 doc: /* The command now being executed.
10870 The command can set this variable; whatever is put here
10871 will be in `last-command' during the following command. */);
10872 Vthis_command = Qnil;
10874 DEFVAR_LISP ("this-original-command", &Vthis_original_command,
10875 doc: /* If non-nil, the original command bound to the current key sequence.
10876 The value of `this-command' is the result of looking up the original
10877 command in the active keymaps. */);
10878 Vthis_original_command = Qnil;
10880 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
10881 doc: /* *Number of input events between auto-saves.
10882 Zero means disable autosaving due to number of characters typed. */);
10883 auto_save_interval = 300;
10885 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
10886 doc: /* *Number of seconds idle time before auto-save.
10887 Zero or nil means disable auto-saving due to idleness.
10888 After auto-saving due to this many seconds of idle time,
10889 Emacs also does a garbage collection if that seems to be warranted. */);
10890 XSETFASTINT (Vauto_save_timeout, 30);
10892 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes,
10893 doc: /* *Nonzero means echo unfinished commands after this many seconds of pause.
10894 The value may be integer or floating point. */);
10895 Vecho_keystrokes = make_number (1);
10897 DEFVAR_INT ("polling-period", &polling_period,
10898 doc: /* *Interval between polling for input during Lisp execution.
10899 The reason for polling is to make C-g work to stop a running program.
10900 Polling is needed only when using X windows and SIGIO does not work.
10901 Polling is automatically disabled in all other cases. */);
10902 polling_period = 2;
10904 DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
10905 doc: /* *Maximum time between mouse clicks to make a double-click.
10906 Measured in milliseconds. nil means disable double-click recognition;
10907 t means double-clicks have no time limit and are detected
10908 by position only. */);
10909 Vdouble_click_time = make_number (500);
10911 DEFVAR_INT ("double-click-fuzz", &double_click_fuzz,
10912 doc: /* *Maximum mouse movement between clicks to make a double-click.
10913 On window-system frames, value is the number of pixels the mouse may have
10914 moved horizontally or vertically between two clicks to make a double-click.
10915 On non window-system frames, value is interpreted in units of 1/8 characters
10916 instead of pixels.
10918 This variable is also the threshold for motion of the mouse
10919 to count as a drag. */);
10920 double_click_fuzz = 3;
10922 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
10923 doc: /* *Non-nil means inhibit local map menu bar menus. */);
10924 inhibit_local_menu_bar_menus = 0;
10926 DEFVAR_INT ("num-input-keys", &num_input_keys,
10927 doc: /* Number of complete key sequences read as input so far.
10928 This includes key sequences read from keyboard macros.
10929 The number is effectively the number of interactive command invocations. */);
10930 num_input_keys = 0;
10932 DEFVAR_INT ("num-nonmacro-input-events", &num_nonmacro_input_events,
10933 doc: /* Number of input events read from the keyboard so far.
10934 This does not include events generated by keyboard macros. */);
10935 num_nonmacro_input_events = 0;
10937 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
10938 doc: /* The frame in which the most recently read event occurred.
10939 If the last event came from a keyboard macro, this is set to `macro'. */);
10940 Vlast_event_frame = Qnil;
10942 /* This variable is set up in sysdep.c. */
10943 DEFVAR_LISP ("tty-erase-char", &Vtty_erase_char,
10944 doc: /* The ERASE character as set by the user with stty. */);
10946 DEFVAR_LISP ("help-char", &Vhelp_char,
10947 doc: /* Character to recognize as meaning Help.
10948 When it is read, do `(eval help-form)', and display result if it's a string.
10949 If the value of `help-form' is nil, this char can be read normally. */);
10950 XSETINT (Vhelp_char, Ctl ('H'));
10952 DEFVAR_LISP ("help-event-list", &Vhelp_event_list,
10953 doc: /* List of input events to recognize as meaning Help.
10954 These work just like the value of `help-char' (see that). */);
10955 Vhelp_event_list = Qnil;
10957 DEFVAR_LISP ("help-form", &Vhelp_form,
10958 doc: /* Form to execute when character `help-char' is read.
10959 If the form returns a string, that string is displayed.
10960 If `help-form' is nil, the help char is not recognized. */);
10961 Vhelp_form = Qnil;
10963 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
10964 doc: /* Command to run when `help-char' character follows a prefix key.
10965 This command is used only when there is no actual binding
10966 for that character after that prefix key. */);
10967 Vprefix_help_command = Qnil;
10969 DEFVAR_LISP ("top-level", &Vtop_level,
10970 doc: /* Form to evaluate when Emacs starts up.
10971 Useful to set before you dump a modified Emacs. */);
10972 Vtop_level = Qnil;
10974 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
10975 doc: /* Translate table for keyboard input, or nil.
10976 Each character is looked up in this string and the contents used instead.
10977 The value may be a string, a vector, or a char-table.
10978 If it is a string or vector of length N,
10979 character codes N and up are untranslated.
10980 In a vector or a char-table, an element which is nil means "no translation".
10982 This is applied to the characters supplied to input methods, not their
10983 output. See also `translation-table-for-input'. */);
10984 Vkeyboard_translate_table = Qnil;
10986 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
10987 doc: /* Non-nil means to always spawn a subshell instead of suspending.
10988 \(Even if the operating system has support for stopping a process.\) */);
10989 cannot_suspend = 0;
10991 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
10992 doc: /* Non-nil means prompt with menus when appropriate.
10993 This is done when reading from a keymap that has a prompt string,
10994 for elements that have prompt strings.
10995 The menu is displayed on the screen
10996 if X menus were enabled at configuration
10997 time and the previous event was a mouse click prefix key.
10998 Otherwise, menu prompting uses the echo area. */);
10999 menu_prompting = 1;
11001 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
11002 doc: /* Character to see next line of menu prompt.
11003 Type this character while in a menu prompt to rotate around the lines of it. */);
11004 XSETINT (menu_prompt_more_char, ' ');
11006 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
11007 doc: /* A mask of additional modifier keys to use with every keyboard character.
11008 Emacs applies the modifiers of the character stored here to each keyboard
11009 character it reads. For example, after evaluating the expression
11010 (setq extra-keyboard-modifiers ?\\C-x)
11011 all input characters will have the control modifier applied to them.
11013 Note that the character ?\\C-@, equivalent to the integer zero, does
11014 not count as a control character; rather, it counts as a character
11015 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero
11016 cancels any modification. */);
11017 extra_keyboard_modifiers = 0;
11019 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
11020 doc: /* If an editing command sets this to t, deactivate the mark afterward.
11021 The command loop sets this to nil before each command,
11022 and tests the value when the command returns.
11023 Buffer modification stores t in this variable. */);
11024 Vdeactivate_mark = Qnil;
11026 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal,
11027 doc: /* Temporary storage of pre-command-hook or post-command-hook. */);
11028 Vcommand_hook_internal = Qnil;
11030 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
11031 doc: /* Normal hook run before each command is executed.
11032 If an unhandled error happens in running this hook,
11033 the hook value is set to nil, since otherwise the error
11034 might happen repeatedly and make Emacs nonfunctional. */);
11035 Vpre_command_hook = Qnil;
11037 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
11038 doc: /* Normal hook run after each command is executed.
11039 If an unhandled error happens in running this hook,
11040 the hook value is set to nil, since otherwise the error
11041 might happen repeatedly and make Emacs nonfunctional. */);
11042 Vpost_command_hook = Qnil;
11044 DEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook,
11045 doc: /* Normal hook run after each command is executed, if idle.
11046 Errors running the hook are caught and ignored. */);
11047 Vpost_command_idle_hook = Qnil;
11049 DEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay,
11050 doc: /* Delay time before running `post-command-idle-hook'.
11051 This is measured in microseconds. */);
11052 post_command_idle_delay = 100000;
11054 #if 0
11055 DEFVAR_LISP ("echo-area-clear-hook", ...,
11056 doc: /* Normal hook run when clearing the echo area. */);
11057 #endif
11058 Qecho_area_clear_hook = intern ("echo-area-clear-hook");
11059 SET_SYMBOL_VALUE (Qecho_area_clear_hook, Qnil);
11061 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
11062 doc: /* Non-nil means menu bar, specified Lucid style, needs to be recomputed. */);
11063 Vlucid_menu_bar_dirty_flag = Qnil;
11065 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
11066 doc: /* List of menu bar items to move to the end of the menu bar.
11067 The elements of the list are event types that may have menu bar bindings. */);
11068 Vmenu_bar_final_items = Qnil;
11070 DEFVAR_KBOARD ("overriding-terminal-local-map",
11071 Voverriding_terminal_local_map,
11072 doc: /* Per-terminal keymap that overrides all other local keymaps.
11073 If this variable is non-nil, it is used as a keymap instead of the
11074 buffer's local map, and the minor mode keymaps and text property keymaps.
11075 This variable is intended to let commands such as `universal-argument'
11076 set up a different keymap for reading the next command. */);
11078 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map,
11079 doc: /* Keymap that overrides all other local keymaps.
11080 If this variable is non-nil, it is used as a keymap instead of the
11081 buffer's local map, and the minor mode keymaps and text property keymaps. */);
11082 Voverriding_local_map = Qnil;
11084 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag,
11085 doc: /* Non-nil means `overriding-local-map' applies to the menu bar.
11086 Otherwise, the menu bar continues to reflect the buffer's local map
11087 and the minor mode maps regardless of `overriding-local-map'. */);
11088 Voverriding_local_map_menu_flag = Qnil;
11090 DEFVAR_LISP ("special-event-map", &Vspecial_event_map,
11091 doc: /* Keymap defining bindings for special events to execute at low level. */);
11092 Vspecial_event_map = Fcons (intern ("keymap"), Qnil);
11094 DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
11095 doc: /* *Non-nil means generate motion events for mouse motion. */);
11097 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
11098 doc: /* Alist of system-specific X windows key symbols.
11099 Each element should have the form (N . SYMBOL) where N is the
11100 numeric keysym code (sans the \"system-specific\" bit 1<<28)
11101 and SYMBOL is its name. */);
11103 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list,
11104 doc: /* List of deferred actions to be performed at a later time.
11105 The precise format isn't relevant here; we just check whether it is nil. */);
11106 Vdeferred_action_list = Qnil;
11108 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function,
11109 doc: /* Function to call to handle deferred actions, after each command.
11110 This function is called with no arguments after each command
11111 whenever `deferred-action-list' is non-nil. */);
11112 Vdeferred_action_function = Qnil;
11114 DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings,
11115 doc: /* *Non-nil means show the equivalent key-binding when M-x command has one.
11116 The value can be a length of time to show the message for.
11117 If the value is non-nil and not a number, we wait 2 seconds. */);
11118 Vsuggest_key_bindings = Qt;
11120 DEFVAR_LISP ("timer-list", &Vtimer_list,
11121 doc: /* List of active absolute time timers in order of increasing time. */);
11122 Vtimer_list = Qnil;
11124 DEFVAR_LISP ("timer-idle-list", &Vtimer_idle_list,
11125 doc: /* List of active idle-time timers in order of increasing time. */);
11126 Vtimer_idle_list = Qnil;
11128 DEFVAR_LISP ("input-method-function", &Vinput_method_function,
11129 doc: /* If non-nil, the function that implements the current input method.
11130 It's called with one argument, a printing character that was just read.
11131 \(That means a character with code 040...0176.)
11132 Typically this function uses `read-event' to read additional events.
11133 When it does so, it should first bind `input-method-function' to nil
11134 so it will not be called recursively.
11136 The function should return a list of zero or more events
11137 to be used as input. If it wants to put back some events
11138 to be reconsidered, separately, by the input method,
11139 it can add them to the beginning of `unread-command-events'.
11141 The input method function can find in `input-method-previous-method'
11142 the previous echo area message.
11144 The input method function should refer to the variables
11145 `input-method-use-echo-area' and `input-method-exit-on-first-char'
11146 for guidance on what to do. */);
11147 Vinput_method_function = Qnil;
11149 DEFVAR_LISP ("input-method-previous-message",
11150 &Vinput_method_previous_message,
11151 doc: /* When `input-method-function' is called, hold the previous echo area message.
11152 This variable exists because `read-event' clears the echo area
11153 before running the input method. It is nil if there was no message. */);
11154 Vinput_method_previous_message = Qnil;
11156 DEFVAR_LISP ("show-help-function", &Vshow_help_function,
11157 doc: /* If non-nil, the function that implements the display of help.
11158 It's called with one argument, the help string to display. */);
11159 Vshow_help_function = Qnil;
11161 DEFVAR_LISP ("disable-point-adjustment", &Vdisable_point_adjustment,
11162 doc: /* If non-nil, suppress point adjustment after executing a command.
11164 After a command is executed, if point is moved into a region that has
11165 special properties (e.g. composition, display), we adjust point to
11166 the boundary of the region. But, several special commands sets this
11167 variable to non-nil, then we suppress the point adjustment.
11169 This variable is set to nil before reading a command, and is checked
11170 just after executing the command. */);
11171 Vdisable_point_adjustment = Qnil;
11173 DEFVAR_LISP ("global-disable-point-adjustment",
11174 &Vglobal_disable_point_adjustment,
11175 doc: /* *If non-nil, always suppress point adjustment.
11177 The default value is nil, in which case, point adjustment are
11178 suppressed only after special commands that set
11179 `disable-point-adjustment' (which see) to non-nil. */);
11180 Vglobal_disable_point_adjustment = Qnil;
11182 DEFVAR_BOOL ("update-menu-bindings", &update_menu_bindings,
11183 doc: /* Non-nil means updating menu bindings is allowed.
11184 A value of nil means menu bindings should not be updated.
11185 Used during Emacs' startup. */);
11186 update_menu_bindings = 1;
11188 DEFVAR_LISP ("minibuffer-message-timeout", &Vminibuffer_message_timeout,
11189 doc: /* *How long to display an echo-area message when the minibuffer is active.
11190 If the value is not a number, such messages don't time out. */);
11191 Vminibuffer_message_timeout = make_number (2);
11194 void
11195 keys_of_keyboard ()
11197 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
11198 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
11199 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
11200 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
11201 initial_define_key (meta_map, 'x', "execute-extended-command");
11203 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
11204 "handle-delete-frame");
11205 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
11206 "ignore-event");
11207 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
11208 "ignore-event");
11209 initial_define_lispy_key (Vspecial_event_map, "select-window",
11210 "handle-select-window");
11211 initial_define_lispy_key (Vspecial_event_map, "save-session",
11212 "handle-save-session");