(record_char): Don't record identical help-echo
[bpt/emacs.git] / src / keyboard.c
1 /* Keyboard and mouse input; editor command loop.
2 Copyright (C) 1985,86,87,88,89,93,94,95,96,97,99, 2000
3 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
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.
11
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.
16
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. */
21
22 #include <config.h>
23 #include <signal.h>
24 #include <stdio.h>
25 #include "termchar.h"
26 #include "termopts.h"
27 #include "lisp.h"
28 #include "termhooks.h"
29 #include "macros.h"
30 #include "keyboard.h"
31 #include "frame.h"
32 #include "window.h"
33 #include "commands.h"
34 #include "buffer.h"
35 #include "charset.h"
36 #include "disptab.h"
37 #include "dispextern.h"
38 #include "syntax.h"
39 #include "intervals.h"
40 #include "blockinput.h"
41 #include "puresize.h"
42 #include "systime.h"
43 #include "atimer.h"
44 #include <setjmp.h>
45 #include <errno.h>
46
47 #ifdef MSDOS
48 #include "msdos.h"
49 #include <time.h>
50 #else /* not MSDOS */
51 #ifndef VMS
52 #include <sys/ioctl.h>
53 #endif
54 #endif /* not MSDOS */
55
56 #include "syssignal.h"
57 #include "systty.h"
58
59 #include <sys/types.h>
60 #ifdef HAVE_UNISTD_H
61 #include <unistd.h>
62 #endif
63
64 /* This is to get the definitions of the XK_ symbols. */
65 #ifdef HAVE_X_WINDOWS
66 #include "xterm.h"
67 #endif
68
69 #ifdef HAVE_NTGUI
70 #include "w32term.h"
71 #endif /* HAVE_NTGUI */
72
73 #ifdef macintosh
74 #include "macterm.h"
75 #endif
76
77 /* Include systime.h after xterm.h to avoid double inclusion of time.h. */
78 #include "systime.h"
79
80 #ifndef USE_CRT_DLL
81 extern int errno;
82 #endif
83
84 /* Variables for blockinput.h: */
85
86 /* Non-zero if interrupt input is blocked right now. */
87 int interrupt_input_blocked;
88
89 /* Nonzero means an input interrupt has arrived
90 during the current critical section. */
91 int interrupt_input_pending;
92
93
94 /* File descriptor to use for input. */
95 extern int input_fd;
96
97 #ifdef HAVE_WINDOW_SYSTEM
98 /* Make all keyboard buffers much bigger when using X windows. */
99 #ifdef macintosh
100 /* But not too big (local data > 32K error) if on macintosh. */
101 #define KBD_BUFFER_SIZE 512
102 #else
103 #define KBD_BUFFER_SIZE 4096
104 #endif
105 #else /* No X-windows, character input */
106 #define KBD_BUFFER_SIZE 256
107 #endif /* No X-windows */
108
109 /* Following definition copied from eval.c */
110
111 struct backtrace
112 {
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;
120 };
121
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
130
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;
134
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 */
139
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;
147
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;
152
153 #define GROW_RAW_KEYBUF \
154 if (raw_keybuf_count == XVECTOR (raw_keybuf)->size) \
155 { \
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; \
162 }
163
164 /* Number of elements of this_command_keys
165 that precede this key sequence. */
166 int this_single_command_key_start;
167
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;
179
180 extern int minbuf_level;
181
182 extern int message_enable_multibyte;
183
184 extern struct backtrace *backtrace_list;
185
186 /* If non-nil, the function that implements the display of help.
187 It's called with one argument, the help string to display. */
188
189 Lisp_Object Vshow_help_function;
190
191 /* Nonzero means do menu prompting. */
192 static int menu_prompting;
193
194 /* Character to see next line of menu prompt. */
195 static Lisp_Object menu_prompt_more_char;
196
197 /* For longjmp to where kbd input is being done. */
198 static jmp_buf getcjmp;
199
200 /* True while doing kbd input. */
201 int waiting_for_input;
202
203 /* True while displaying for echoing. Delays C-g throwing. */
204
205 static int echoing;
206
207 /* Non-null means we can start echoing at the next input pause even
208 though there is something in the echo area. */
209
210 static struct kboard *ok_to_echo_at_next_pause;
211
212 /* The kboard last echoing, or null for none. Reset to 0 in
213 cancel_echoing. If non-null, and a current echo area message
214 exists, and echo_message_buffer is eq to the current message
215 buffer, we know that the message comes from echo_kboard. */
216
217 static struct kboard *echo_kboard;
218
219 /* The buffer used for echoing. Set in echo_now, reset in
220 cancel_echoing. */
221
222 static Lisp_Object echo_message_buffer;
223
224 /* Nonzero means disregard local maps for the menu bar. */
225 static int inhibit_local_menu_bar_menus;
226
227 /* Nonzero means C-g should cause immediate error-signal. */
228 int immediate_quit;
229
230 /* The user's ERASE setting. */
231 Lisp_Object Vtty_erase_char;
232
233 /* Character to recognize as the help char. */
234 Lisp_Object Vhelp_char;
235
236 /* List of other event types to recognize as meaning "help". */
237 Lisp_Object Vhelp_event_list;
238
239 /* Form to execute when help char is typed. */
240 Lisp_Object Vhelp_form;
241
242 /* Command to run when the help character follows a prefix key. */
243 Lisp_Object Vprefix_help_command;
244
245 /* List of items that should move to the end of the menu bar. */
246 Lisp_Object Vmenu_bar_final_items;
247
248 /* Non-nil means show the equivalent key-binding for
249 any M-x command that has one.
250 The value can be a length of time to show the message for.
251 If the value is non-nil and not a number, we wait 2 seconds. */
252 Lisp_Object Vsuggest_key_bindings;
253
254 /* How long to display an echo-area message when the minibuffer is active.
255 If the value is not a number, such messages don't time out. */
256 Lisp_Object Vminibuffer_message_timeout;
257
258 /* Character that causes a quit. Normally C-g.
259
260 If we are running on an ordinary terminal, this must be an ordinary
261 ASCII char, since we want to make it our interrupt character.
262
263 If we are not running on an ordinary terminal, it still needs to be
264 an ordinary ASCII char. This character needs to be recognized in
265 the input interrupt handler. At this point, the keystroke is
266 represented as a struct input_event, while the desired quit
267 character is specified as a lispy event. The mapping from struct
268 input_events to lispy events cannot run in an interrupt handler,
269 and the reverse mapping is difficult for anything but ASCII
270 keystrokes.
271
272 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
273 ASCII character. */
274 int quit_char;
275
276 extern Lisp_Object current_global_map;
277 extern int minibuf_level;
278
279 /* If non-nil, this is a map that overrides all other local maps. */
280 Lisp_Object Voverriding_local_map;
281
282 /* If non-nil, Voverriding_local_map applies to the menu bar. */
283 Lisp_Object Voverriding_local_map_menu_flag;
284
285 /* Keymap that defines special misc events that should
286 be processed immediately at a low level. */
287 Lisp_Object Vspecial_event_map;
288
289 /* Current depth in recursive edits. */
290 int command_loop_level;
291
292 /* Total number of times command_loop has read a key sequence. */
293 int num_input_keys;
294
295 /* Last input character read as a command. */
296 Lisp_Object last_command_char;
297
298 /* Last input character read as a command, not counting menus
299 reached by the mouse. */
300 Lisp_Object last_nonmenu_event;
301
302 /* Last input character read for any purpose. */
303 Lisp_Object last_input_char;
304
305 /* If not Qnil, a list of objects to be read as subsequent command input. */
306 Lisp_Object Vunread_command_events;
307
308 /* If not Qnil, a list of objects to be read as subsequent command input
309 including input method processing. */
310 Lisp_Object Vunread_input_method_events;
311
312 /* If not Qnil, a list of objects to be read as subsequent command input
313 but NOT including input method processing. */
314 Lisp_Object Vunread_post_input_method_events;
315
316 /* If not -1, an event to be read as subsequent command input. */
317 int unread_command_char;
318
319 /* If not Qnil, this is a switch-frame event which we decided to put
320 off until the end of a key sequence. This should be read as the
321 next command input, after any unread_command_events.
322
323 read_key_sequence uses this to delay switch-frame events until the
324 end of the key sequence; Fread_char uses it to put off switch-frame
325 events until a non-ASCII event is acceptable as input. */
326 Lisp_Object unread_switch_frame;
327
328 /* A mask of extra modifier bits to put into every keyboard char. */
329 int extra_keyboard_modifiers;
330
331 /* Char to use as prefix when a meta character is typed in.
332 This is bound on entry to minibuffer in case ESC is changed there. */
333
334 Lisp_Object meta_prefix_char;
335
336 /* Last size recorded for a current buffer which is not a minibuffer. */
337 static int last_non_minibuf_size;
338
339 /* Number of idle seconds before an auto-save and garbage collection. */
340 static Lisp_Object Vauto_save_timeout;
341
342 /* Total number of times read_char has returned. */
343 int num_input_events;
344
345 /* Total number of times read_char has returned, outside of macros. */
346 int num_nonmacro_input_events;
347
348 /* Auto-save automatically when this many characters have been typed
349 since the last time. */
350
351 static int auto_save_interval;
352
353 /* Value of num_nonmacro_input_events as of last auto save. */
354
355 int last_auto_save;
356
357 /* The command being executed by the command loop.
358 Commands may set this, and the value set will be copied into
359 current_kboard->Vlast_command instead of the actual command. */
360 Lisp_Object Vthis_command;
361
362 /* This is like Vthis_command, except that commands never set it. */
363 Lisp_Object real_this_command;
364
365 /* The value of point when the last command was executed. */
366 int last_point_position;
367
368 /* The buffer that was current when the last command was started. */
369 Lisp_Object last_point_position_buffer;
370
371 /* The frame in which the last input event occurred, or Qmacro if the
372 last event came from a macro. We use this to determine when to
373 generate switch-frame events. This may be cleared by functions
374 like Fselect_frame, to make sure that a switch-frame event is
375 generated by the next character. */
376 Lisp_Object internal_last_event_frame;
377
378 /* A user-visible version of the above, intended to allow users to
379 figure out where the last event came from, if the event doesn't
380 carry that information itself (i.e. if it was a character). */
381 Lisp_Object Vlast_event_frame;
382
383 /* The timestamp of the last input event we received from the X server.
384 X Windows wants this for selection ownership. */
385 unsigned long last_event_timestamp;
386
387 Lisp_Object Qself_insert_command;
388 Lisp_Object Qforward_char;
389 Lisp_Object Qbackward_char;
390 Lisp_Object Qundefined;
391 Lisp_Object Qtimer_event_handler;
392
393 /* read_key_sequence stores here the command definition of the
394 key sequence that it reads. */
395 Lisp_Object read_key_sequence_cmd;
396
397 /* Echo unfinished commands after this many seconds of pause. */
398 Lisp_Object Vecho_keystrokes;
399
400 /* Form to evaluate (if non-nil) when Emacs is started. */
401 Lisp_Object Vtop_level;
402
403 /* User-supplied string to translate input characters through. */
404 Lisp_Object Vkeyboard_translate_table;
405
406 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
407 extern Lisp_Object Vfunction_key_map;
408
409 /* Another keymap that maps key sequences into key sequences.
410 This one takes precedence over ordinary definitions. */
411 extern Lisp_Object Vkey_translation_map;
412
413 /* If non-nil, this implements the current input method. */
414 Lisp_Object Vinput_method_function;
415 Lisp_Object Qinput_method_function;
416
417 /* When we call Vinput_method_function,
418 this holds the echo area message that was just erased. */
419 Lisp_Object Vinput_method_previous_message;
420
421 /* Non-nil means deactivate the mark at end of this command. */
422 Lisp_Object Vdeactivate_mark;
423
424 /* Menu bar specified in Lucid Emacs fashion. */
425
426 Lisp_Object Vlucid_menu_bar_dirty_flag;
427 Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
428
429 Lisp_Object Qecho_area_clear_hook;
430
431 /* Hooks to run before and after each command. */
432 Lisp_Object Qpre_command_hook, Vpre_command_hook;
433 Lisp_Object Qpost_command_hook, Vpost_command_hook;
434 Lisp_Object Qcommand_hook_internal, Vcommand_hook_internal;
435 /* Hook run after a command if there's no more input soon. */
436 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
437
438 /* Delay time in microseconds before running post-command-idle-hook. */
439 int post_command_idle_delay;
440
441 /* List of deferred actions to be performed at a later time.
442 The precise format isn't relevant here; we just check whether it is nil. */
443 Lisp_Object Vdeferred_action_list;
444
445 /* Function to call to handle deferred actions, when there are any. */
446 Lisp_Object Vdeferred_action_function;
447 Lisp_Object Qdeferred_action_function;
448
449 Lisp_Object Qinput_method_exit_on_first_char;
450 Lisp_Object Qinput_method_use_echo_area;
451
452 /* File in which we write all commands we read. */
453 FILE *dribble;
454
455 /* Nonzero if input is available. */
456 int input_pending;
457
458 /* 1 if should obey 0200 bit in input chars as "Meta", 2 if should
459 keep 0200 bit in input chars. 0 to ignore the 0200 bit. */
460
461 int meta_key;
462
463 /* Non-zero means force key bindings update in parse_menu_item. */
464
465 int update_menu_bindings;
466
467 extern char *pending_malloc_warning;
468
469 /* Circular buffer for pre-read keyboard input. */
470
471 static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
472
473 /* Vector to GCPRO the Lisp objects referenced from kbd_buffer.
474
475 The interrupt-level event handlers will never enqueue an event on a
476 frame which is not in Vframe_list, and once an event is dequeued,
477 internal_last_event_frame or the event itself points to the frame.
478 So that's all fine.
479
480 But while the event is sitting in the queue, it's completely
481 unprotected. Suppose the user types one command which will run for
482 a while and then delete a frame, and then types another event at
483 the frame that will be deleted, before the command gets around to
484 it. Suppose there are no references to this frame elsewhere in
485 Emacs, and a GC occurs before the second event is dequeued. Now we
486 have an event referring to a freed frame, which will crash Emacs
487 when it is dequeued.
488
489 Similar things happen when an event on a scroll bar is enqueued; the
490 window may be deleted while the event is in the queue.
491
492 So, we use this vector to protect the Lisp_Objects in the event
493 queue. That way, they'll be dequeued as dead frames or windows,
494 but still valid Lisp objects.
495
496 If kbd_buffer[i].kind != no_event, then
497
498 AREF (kbd_buffer_gcpro, 2 * i) == kbd_buffer[i].frame_or_window.
499 AREF (kbd_buffer_gcpro, 2 * i + 1) == kbd_buffer[i].arg. */
500
501 static Lisp_Object kbd_buffer_gcpro;
502
503 /* Pointer to next available character in kbd_buffer.
504 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
505 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the the
506 next available char is in kbd_buffer[0]. */
507 static struct input_event *kbd_fetch_ptr;
508
509 /* Pointer to next place to store character in kbd_buffer. This
510 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
511 character should go in kbd_buffer[0]. */
512 static struct input_event * volatile kbd_store_ptr;
513
514 /* The above pair of variables forms a "queue empty" flag. When we
515 enqueue a non-hook event, we increment kbd_store_ptr. When we
516 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
517 there is input available iff the two pointers are not equal.
518
519 Why not just have a flag set and cleared by the enqueuing and
520 dequeuing functions? Such a flag could be screwed up by interrupts
521 at inopportune times. */
522
523 /* If this flag is non-nil, we check mouse_moved to see when the
524 mouse moves, and motion events will appear in the input stream.
525 Otherwise, mouse motion is ignored. */
526 static Lisp_Object do_mouse_tracking;
527
528 /* Symbols to head events. */
529 Lisp_Object Qmouse_movement;
530 Lisp_Object Qscroll_bar_movement;
531 Lisp_Object Qswitch_frame;
532 Lisp_Object Qdelete_frame;
533 Lisp_Object Qiconify_frame;
534 Lisp_Object Qmake_frame_visible;
535 Lisp_Object Qhelp_echo;
536
537 /* Symbols to denote kinds of events. */
538 Lisp_Object Qfunction_key;
539 Lisp_Object Qmouse_click;
540 #ifdef WINDOWSNT
541 Lisp_Object Qmouse_wheel;
542 Lisp_Object Qlanguage_change;
543 #endif
544 Lisp_Object Qdrag_n_drop;
545 /* Lisp_Object Qmouse_movement; - also an event header */
546
547 /* Properties of event headers. */
548 Lisp_Object Qevent_kind;
549 Lisp_Object Qevent_symbol_elements;
550
551 /* menu item parts */
552 Lisp_Object Qmenu_alias;
553 Lisp_Object Qmenu_enable;
554 Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCkeys, QCkey_sequence;
555 Lisp_Object QCbutton, QCtoggle, QCradio;
556 extern Lisp_Object Vdefine_key_rebound_commands;
557 extern Lisp_Object Qmenu_item;
558
559 /* An event header symbol HEAD may have a property named
560 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
561 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
562 mask of modifiers applied to it. If present, this is used to help
563 speed up parse_modifiers. */
564 Lisp_Object Qevent_symbol_element_mask;
565
566 /* An unmodified event header BASE may have a property named
567 Qmodifier_cache, which is an alist mapping modifier masks onto
568 modified versions of BASE. If present, this helps speed up
569 apply_modifiers. */
570 Lisp_Object Qmodifier_cache;
571
572 /* Symbols to use for parts of windows. */
573 Lisp_Object Qmode_line;
574 Lisp_Object Qvertical_line;
575 Lisp_Object Qvertical_scroll_bar;
576 Lisp_Object Qmenu_bar;
577
578 Lisp_Object recursive_edit_unwind (), command_loop ();
579 Lisp_Object Fthis_command_keys ();
580 Lisp_Object Qextended_command_history;
581 EMACS_TIME timer_check ();
582
583 extern Lisp_Object Vhistory_length;
584
585 extern char *x_get_keysym_name ();
586
587 static void record_menu_key ();
588
589 Lisp_Object Qpolling_period;
590
591 /* List of absolute timers. Appears in order of next scheduled event. */
592 Lisp_Object Vtimer_list;
593
594 /* List of idle time timers. Appears in order of next scheduled event. */
595 Lisp_Object Vtimer_idle_list;
596
597 /* Incremented whenever a timer is run. */
598 int timers_run;
599
600 extern Lisp_Object Vprint_level, Vprint_length;
601
602 /* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
603 happens. */
604 EMACS_TIME *input_available_clear_time;
605
606 /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
607 Default is 1 if INTERRUPT_INPUT is defined. */
608 int interrupt_input;
609
610 /* Nonzero while interrupts are temporarily deferred during redisplay. */
611 int interrupts_deferred;
612
613 /* Nonzero means use ^S/^Q for flow control. */
614 int flow_control;
615
616 /* Allow m- file to inhibit use of FIONREAD. */
617 #ifdef BROKEN_FIONREAD
618 #undef FIONREAD
619 #endif
620
621 /* We are unable to use interrupts if FIONREAD is not available,
622 so flush SIGIO so we won't try. */
623 #ifndef FIONREAD
624 #ifdef SIGIO
625 #undef SIGIO
626 #endif
627 #endif
628
629 /* If we support a window system, turn on the code to poll periodically
630 to detect C-g. It isn't actually used when doing interrupt input. */
631 #ifdef HAVE_WINDOW_SYSTEM
632 #define POLL_FOR_INPUT
633 #endif
634
635 /* After a command is executed, if point is moved into a region that
636 has specific properties (e.g. composition, display), we adjust
637 point to the boundary of the region. But, if a command sets this
638 valiable to non-nil, we suppress this point adjustment. This
639 variable is set to nil before reading a command. */
640
641 Lisp_Object Vdisable_point_adjustment;
642
643 /* If non-nil, always disable point adjustment. */
644
645 Lisp_Object Vglobal_disable_point_adjustment;
646
647 \f
648 /* Global variable declarations. */
649
650 /* Function for init_keyboard to call with no args (if nonzero). */
651 void (*keyboard_init_hook) ();
652
653 static int read_avail_input P_ ((int));
654 static void get_input_pending P_ ((int *, int));
655 static int readable_events P_ ((int));
656 static Lisp_Object read_char_x_menu_prompt P_ ((int, Lisp_Object *,
657 Lisp_Object, int *));
658 static Lisp_Object read_char_x_menu_prompt ();
659 static Lisp_Object read_char_minibuf_menu_prompt P_ ((int, int,
660 Lisp_Object *));
661 static Lisp_Object make_lispy_event P_ ((struct input_event *));
662 #ifdef HAVE_MOUSE
663 static Lisp_Object make_lispy_movement P_ ((struct frame *, Lisp_Object,
664 enum scroll_bar_part,
665 Lisp_Object, Lisp_Object,
666 unsigned long));
667 #endif
668 static Lisp_Object modify_event_symbol P_ ((int, unsigned, Lisp_Object,
669 Lisp_Object, char **,
670 Lisp_Object *, unsigned));
671 static Lisp_Object make_lispy_switch_frame P_ ((Lisp_Object));
672 static int parse_solitary_modifier P_ ((Lisp_Object));
673 static int parse_solitary_modifier ();
674 static void save_getcjmp P_ ((jmp_buf));
675 static void save_getcjmp ();
676 static void restore_getcjmp P_ ((jmp_buf));
677 static Lisp_Object apply_modifiers P_ ((int, Lisp_Object));
678 static void clear_event P_ ((struct input_event *));
679
680 /* Nonzero means don't try to suspend even if the operating system seems
681 to support it. */
682 static int cannot_suspend;
683
684 #define min(a,b) ((a)<(b)?(a):(b))
685 #define max(a,b) ((a)>(b)?(a):(b))
686
687 /* Install the string STR as the beginning of the string of echoing,
688 so that it serves as a prompt for the next character.
689 Also start echoing. */
690
691 void
692 echo_prompt (str)
693 char *str;
694 {
695 int len = strlen (str);
696
697 if (len > ECHOBUFSIZE - 4)
698 len = ECHOBUFSIZE - 4;
699 bcopy (str, current_kboard->echobuf, len);
700 current_kboard->echoptr = current_kboard->echobuf + len;
701 *current_kboard->echoptr = '\0';
702
703 current_kboard->echo_after_prompt = len;
704
705 echo_now ();
706 }
707
708 /* Add C to the echo string, if echoing is going on.
709 C can be a character, which is printed prettily ("M-C-x" and all that
710 jazz), or a symbol, whose name is printed. */
711
712 void
713 echo_char (c)
714 Lisp_Object c;
715 {
716 extern char *push_key_description ();
717
718 if (current_kboard->immediate_echo)
719 {
720 char *ptr = current_kboard->echoptr;
721
722 if (ptr != current_kboard->echobuf)
723 *ptr++ = ' ';
724
725 /* If someone has passed us a composite event, use its head symbol. */
726 c = EVENT_HEAD (c);
727
728 if (INTEGERP (c))
729 {
730 if (ptr - current_kboard->echobuf
731 > ECHOBUFSIZE - KEY_DESCRIPTION_SIZE)
732 return;
733
734 ptr = push_key_description (XINT (c), ptr);
735 }
736 else if (SYMBOLP (c))
737 {
738 struct Lisp_String *name = XSYMBOL (c)->name;
739 if ((ptr - current_kboard->echobuf) + STRING_BYTES (name) + 4
740 > ECHOBUFSIZE)
741 return;
742 bcopy (name->data, ptr, STRING_BYTES (name));
743 ptr += STRING_BYTES (name);
744 }
745
746 if (current_kboard->echoptr == current_kboard->echobuf
747 && help_char_p (c))
748 {
749 strcpy (ptr, " (Type ? for further options)");
750 ptr += strlen (ptr);
751 }
752
753 *ptr = 0;
754 current_kboard->echoptr = ptr;
755
756 echo_now ();
757 }
758 }
759
760 /* Temporarily add a dash to the end of the echo string if it's not
761 empty, so that it serves as a mini-prompt for the very next character. */
762
763 void
764 echo_dash ()
765 {
766 if (!current_kboard->immediate_echo
767 && current_kboard->echoptr == current_kboard->echobuf)
768 return;
769 /* Do nothing if we just printed a prompt. */
770 if (current_kboard->echo_after_prompt
771 == current_kboard->echoptr - current_kboard->echobuf)
772 return;
773 /* Do nothing if not echoing at all. */
774 if (current_kboard->echoptr == 0)
775 return;
776
777 /* Put a dash at the end of the buffer temporarily,
778 but make it go away when the next character is added. */
779 current_kboard->echoptr[0] = '-';
780 current_kboard->echoptr[1] = 0;
781
782 echo_now ();
783 }
784
785 /* Display the current echo string, and begin echoing if not already
786 doing so. */
787
788 void
789 echo_now ()
790 {
791 if (!current_kboard->immediate_echo)
792 {
793 int i;
794 current_kboard->immediate_echo = 1;
795
796 for (i = 0; i < this_command_key_count; i++)
797 {
798 Lisp_Object c;
799 c = XVECTOR (this_command_keys)->contents[i];
800 if (! (EVENT_HAS_PARAMETERS (c)
801 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
802 echo_char (c);
803 }
804 echo_dash ();
805 }
806
807 echoing = 1;
808 message2_nolog (current_kboard->echobuf, strlen (current_kboard->echobuf),
809 ! NILP (current_buffer->enable_multibyte_characters));
810 echoing = 0;
811
812 /* Record in what buffer we echoed, and from which kboard. */
813 echo_message_buffer = echo_area_buffer[0];
814 echo_kboard = current_kboard;
815
816 if (waiting_for_input && !NILP (Vquit_flag))
817 quit_throw_to_read_char ();
818 }
819
820 /* Turn off echoing, for the start of a new command. */
821
822 void
823 cancel_echoing ()
824 {
825 current_kboard->immediate_echo = 0;
826 current_kboard->echoptr = current_kboard->echobuf;
827 current_kboard->echo_after_prompt = -1;
828 ok_to_echo_at_next_pause = NULL;
829 echo_kboard = NULL;
830 echo_message_buffer = Qnil;
831 }
832
833 /* Return the length of the current echo string. */
834
835 static int
836 echo_length ()
837 {
838 return current_kboard->echoptr - current_kboard->echobuf;
839 }
840
841 /* Truncate the current echo message to its first LEN chars.
842 This and echo_char get used by read_key_sequence when the user
843 switches frames while entering a key sequence. */
844
845 static void
846 echo_truncate (len)
847 int len;
848 {
849 current_kboard->echobuf[len] = '\0';
850 current_kboard->echoptr = current_kboard->echobuf + len;
851 truncate_echo_area (len);
852 }
853
854 \f
855 /* Functions for manipulating this_command_keys. */
856 static void
857 add_command_key (key)
858 Lisp_Object key;
859 {
860 int size = XVECTOR (this_command_keys)->size;
861
862 /* If reset-this-command-length was called recently, obey it now.
863 See the doc string of that function for an explanation of why. */
864 if (before_command_restore_flag)
865 {
866 this_command_key_count = before_command_key_count_1;
867 if (this_command_key_count < this_single_command_key_start)
868 this_single_command_key_start = this_command_key_count;
869 echo_truncate (before_command_echo_length_1);
870 before_command_restore_flag = 0;
871 }
872
873 if (this_command_key_count >= size)
874 {
875 Lisp_Object new_keys;
876
877 new_keys = Fmake_vector (make_number (size * 2), Qnil);
878 bcopy (XVECTOR (this_command_keys)->contents,
879 XVECTOR (new_keys)->contents,
880 size * sizeof (Lisp_Object));
881
882 this_command_keys = new_keys;
883 }
884
885 XVECTOR (this_command_keys)->contents[this_command_key_count++] = key;
886 }
887 \f
888 Lisp_Object
889 recursive_edit_1 ()
890 {
891 int count = specpdl_ptr - specpdl;
892 Lisp_Object val;
893
894 if (command_loop_level > 0)
895 {
896 specbind (Qstandard_output, Qt);
897 specbind (Qstandard_input, Qt);
898 }
899
900 #ifdef HAVE_X_WINDOWS
901 /* The command loop has started a busy-cursor timer, so we have to
902 cancel it here, otherwise it will fire because the recursive edit
903 can take some time. */
904 if (display_busy_cursor_p)
905 cancel_busy_cursor ();
906 #endif
907
908 val = command_loop ();
909 if (EQ (val, Qt))
910 Fsignal (Qquit, Qnil);
911 /* Handle throw from read_minibuf when using minibuffer
912 while it's active but we're in another window. */
913 if (STRINGP (val))
914 Fsignal (Qerror, Fcons (val, Qnil));
915
916 return unbind_to (count, Qnil);
917 }
918
919 /* When an auto-save happens, record the "time", and don't do again soon. */
920
921 void
922 record_auto_save ()
923 {
924 last_auto_save = num_nonmacro_input_events;
925 }
926
927 /* Make an auto save happen as soon as possible at command level. */
928
929 void
930 force_auto_save_soon ()
931 {
932 last_auto_save = - auto_save_interval - 1;
933
934 record_asynch_buffer_change ();
935 }
936 \f
937 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
938 "Invoke the editor command loop recursively.\n\
939 To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
940 that tells this function to return.\n\
941 Alternately, `(throw 'exit t)' makes this function signal an error.\n\
942 This function is called by the editor initialization to begin editing.")
943 ()
944 {
945 int count = specpdl_ptr - specpdl;
946
947 command_loop_level++;
948 update_mode_lines = 1;
949
950 /* This function may have been called from a debugger called from
951 within redisplay, for instance by Edebugging a function called
952 from fontification-functions. We want to allow redisplay in
953 the debugging session.
954
955 The recursive edit is left with a `(throw exit ...)'. The `exit'
956 tag is not caught anywhere in redisplay, i.e. when we leave the
957 recursive edit, the original redisplay leading to the recursive
958 edit will be unwound. The outcome should therefore be safe. */
959 specbind (Qinhibit_redisplay, Qnil);
960 redisplaying_p = 0;
961
962 record_unwind_protect (recursive_edit_unwind,
963 (command_loop_level
964 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
965 ? Fcurrent_buffer ()
966 : Qnil);
967 recursive_edit_1 ();
968 return unbind_to (count, Qnil);
969 }
970
971 Lisp_Object
972 recursive_edit_unwind (buffer)
973 Lisp_Object buffer;
974 {
975 if (!NILP (buffer))
976 Fset_buffer (buffer);
977
978 command_loop_level--;
979 update_mode_lines = 1;
980 return Qnil;
981 }
982 \f
983 static void
984 any_kboard_state ()
985 {
986 #ifdef MULTI_KBOARD
987 #if 0 /* Theory: if there's anything in Vunread_command_events,
988 it will right away be read by read_key_sequence,
989 and then if we do switch KBOARDS, it will go into the side
990 queue then. So we don't need to do anything special here -- rms. */
991 if (CONSP (Vunread_command_events))
992 {
993 current_kboard->kbd_queue
994 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
995 current_kboard->kbd_queue_has_data = 1;
996 }
997 Vunread_command_events = Qnil;
998 #endif
999 single_kboard = 0;
1000 #endif
1001 }
1002
1003 /* Switch to the single-kboard state, making current_kboard
1004 the only KBOARD from which further input is accepted. */
1005
1006 void
1007 single_kboard_state ()
1008 {
1009 #ifdef MULTI_KBOARD
1010 single_kboard = 1;
1011 #endif
1012 }
1013
1014 /* Maintain a stack of kboards, so other parts of Emacs
1015 can switch temporarily to the kboard of a given frame
1016 and then revert to the previous status. */
1017
1018 struct kboard_stack
1019 {
1020 KBOARD *kboard;
1021 struct kboard_stack *next;
1022 };
1023
1024 static struct kboard_stack *kboard_stack;
1025
1026 void
1027 push_frame_kboard (f)
1028 FRAME_PTR f;
1029 {
1030 #ifdef MULTI_KBOARD
1031 struct kboard_stack *p
1032 = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
1033
1034 p->next = kboard_stack;
1035 p->kboard = current_kboard;
1036 kboard_stack = p;
1037
1038 current_kboard = FRAME_KBOARD (f);
1039 #endif
1040 }
1041
1042 void
1043 pop_frame_kboard ()
1044 {
1045 #ifdef MULTI_KBOARD
1046 struct kboard_stack *p = kboard_stack;
1047 current_kboard = p->kboard;
1048 kboard_stack = p->next;
1049 xfree (p);
1050 #endif
1051 }
1052 \f
1053 /* Handle errors that are not handled at inner levels
1054 by printing an error message and returning to the editor command loop. */
1055
1056 Lisp_Object
1057 cmd_error (data)
1058 Lisp_Object data;
1059 {
1060 Lisp_Object old_level, old_length;
1061 char macroerror[50];
1062
1063 if (!NILP (executing_macro))
1064 {
1065 if (executing_macro_iterations == 1)
1066 sprintf (macroerror, "After 1 kbd macro iteration: ");
1067 else
1068 sprintf (macroerror, "After %d kbd macro iterations: ",
1069 executing_macro_iterations);
1070 }
1071 else
1072 *macroerror = 0;
1073
1074 Vstandard_output = Qt;
1075 Vstandard_input = Qt;
1076 Vexecuting_macro = Qnil;
1077 executing_macro = Qnil;
1078 current_kboard->Vprefix_arg = Qnil;
1079 current_kboard->Vlast_prefix_arg = Qnil;
1080 cancel_echoing ();
1081
1082 /* Avoid unquittable loop if data contains a circular list. */
1083 old_level = Vprint_level;
1084 old_length = Vprint_length;
1085 XSETFASTINT (Vprint_level, 10);
1086 XSETFASTINT (Vprint_length, 10);
1087 cmd_error_internal (data, macroerror);
1088 Vprint_level = old_level;
1089 Vprint_length = old_length;
1090
1091 Vquit_flag = Qnil;
1092
1093 Vinhibit_quit = Qnil;
1094 #ifdef MULTI_KBOARD
1095 any_kboard_state ();
1096 #endif
1097
1098 return make_number (0);
1099 }
1100
1101 /* Take actions on handling an error. DATA is the data that describes
1102 the error.
1103
1104 CONTEXT is a C-string containing ASCII characters only which
1105 describes the context in which the error happened. If we need to
1106 generalize CONTEXT to allow multibyte characters, make it a Lisp
1107 string. */
1108
1109 void
1110 cmd_error_internal (data, context)
1111 Lisp_Object data;
1112 char *context;
1113 {
1114 Lisp_Object stream;
1115 int kill_emacs_p = 0;
1116 struct frame *sf = SELECTED_FRAME ();
1117
1118 Vquit_flag = Qnil;
1119 Vinhibit_quit = Qt;
1120 clear_message (1, 0);
1121
1122 /* If the window system or terminal frame hasn't been initialized
1123 yet, or we're not interactive, it's best to dump this message out
1124 to stderr and exit. */
1125 if (!sf->glyphs_initialized_p
1126 /* This is the case of the frame dumped with Emacs, when we're
1127 running under a window system. */
1128 || (!NILP (Vwindow_system)
1129 && !inhibit_window_system
1130 && FRAME_TERMCAP_P (sf))
1131 || noninteractive)
1132 {
1133 stream = Qexternal_debugging_output;
1134 kill_emacs_p = 1;
1135 }
1136 else
1137 {
1138 Fdiscard_input ();
1139 bitch_at_user ();
1140 stream = Qt;
1141 }
1142
1143 if (context != 0)
1144 write_string_1 (context, -1, stream);
1145
1146 print_error_message (data, stream);
1147
1148 /* If the window system or terminal frame hasn't been initialized
1149 yet, or we're in -batch mode, this error should cause Emacs to exit. */
1150 if (kill_emacs_p)
1151 {
1152 Fterpri (stream);
1153 Fkill_emacs (make_number (-1));
1154 }
1155 }
1156 \f
1157 Lisp_Object command_loop_1 ();
1158 Lisp_Object command_loop_2 ();
1159 Lisp_Object top_level_1 ();
1160
1161 /* Entry to editor-command-loop.
1162 This level has the catches for exiting/returning to editor command loop.
1163 It returns nil to exit recursive edit, t to abort it. */
1164
1165 Lisp_Object
1166 command_loop ()
1167 {
1168 if (command_loop_level > 0 || minibuf_level > 0)
1169 {
1170 Lisp_Object val;
1171 val = internal_catch (Qexit, command_loop_2, Qnil);
1172 executing_macro = Qnil;
1173 return val;
1174 }
1175 else
1176 while (1)
1177 {
1178 internal_catch (Qtop_level, top_level_1, Qnil);
1179 internal_catch (Qtop_level, command_loop_2, Qnil);
1180 executing_macro = Qnil;
1181
1182 /* End of file in -batch run causes exit here. */
1183 if (noninteractive)
1184 Fkill_emacs (Qt);
1185 }
1186 }
1187
1188 /* Here we catch errors in execution of commands within the
1189 editing loop, and reenter the editing loop.
1190 When there is an error, cmd_error runs and returns a non-nil
1191 value to us. A value of nil means that cmd_loop_1 itself
1192 returned due to end of file (or end of kbd macro). */
1193
1194 Lisp_Object
1195 command_loop_2 ()
1196 {
1197 register Lisp_Object val;
1198
1199 do
1200 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1201 while (!NILP (val));
1202
1203 return Qnil;
1204 }
1205
1206 Lisp_Object
1207 top_level_2 ()
1208 {
1209 return Feval (Vtop_level);
1210 }
1211
1212 Lisp_Object
1213 top_level_1 ()
1214 {
1215 /* On entry to the outer level, run the startup file */
1216 if (!NILP (Vtop_level))
1217 internal_condition_case (top_level_2, Qerror, cmd_error);
1218 else if (!NILP (Vpurify_flag))
1219 message ("Bare impure Emacs (standard Lisp code not loaded)");
1220 else
1221 message ("Bare Emacs (standard Lisp code not loaded)");
1222 return Qnil;
1223 }
1224
1225 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1226 "Exit all recursive editing levels.")
1227 ()
1228 {
1229 #ifdef HAVE_X_WINDOWS
1230 if (display_busy_cursor_p)
1231 cancel_busy_cursor ();
1232 #endif
1233 return Fthrow (Qtop_level, Qnil);
1234 }
1235
1236 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1237 "Exit from the innermost recursive edit or minibuffer.")
1238 ()
1239 {
1240 if (command_loop_level > 0 || minibuf_level > 0)
1241 Fthrow (Qexit, Qnil);
1242
1243 error ("No recursive edit is in progress");
1244 return Qnil;
1245 }
1246
1247 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1248 "Abort the command that requested this recursive edit or minibuffer input.")
1249 ()
1250 {
1251 if (command_loop_level > 0 || minibuf_level > 0)
1252 Fthrow (Qexit, Qt);
1253
1254 error ("No recursive edit is in progress");
1255 return Qnil;
1256 }
1257 \f
1258 /* This is the actual command reading loop,
1259 sans error-handling encapsulation. */
1260
1261 Lisp_Object Fcommand_execute ();
1262 static int read_key_sequence ();
1263 void safe_run_hooks ();
1264 static void adjust_point_for_property ();
1265
1266 Lisp_Object
1267 command_loop_1 ()
1268 {
1269 Lisp_Object cmd;
1270 int lose;
1271 int nonundocount;
1272 Lisp_Object keybuf[30];
1273 int i;
1274 int no_direct;
1275 int prev_modiff;
1276 struct buffer *prev_buffer = NULL;
1277 #ifdef MULTI_KBOARD
1278 int was_locked = single_kboard;
1279 #endif
1280
1281 current_kboard->Vprefix_arg = Qnil;
1282 current_kboard->Vlast_prefix_arg = Qnil;
1283 Vdeactivate_mark = Qnil;
1284 waiting_for_input = 0;
1285 cancel_echoing ();
1286
1287 nonundocount = 0;
1288 this_command_key_count = 0;
1289 this_single_command_key_start = 0;
1290
1291 /* Make sure this hook runs after commands that get errors and
1292 throw to top level. */
1293 /* Note that the value cell will never directly contain nil
1294 if the symbol is a local variable. */
1295 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1296 safe_run_hooks (Qpost_command_hook);
1297
1298 /* If displaying a message, resize the echo area window to fit
1299 that message's size exactly. */
1300 if (!NILP (echo_area_buffer[0]))
1301 resize_echo_area_axactly ();
1302
1303 if (!NILP (Vdeferred_action_list))
1304 call0 (Vdeferred_action_function);
1305
1306 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1307 {
1308 if (NILP (Vunread_command_events)
1309 && NILP (Vunread_input_method_events)
1310 && NILP (Vunread_post_input_method_events)
1311 && NILP (Vexecuting_macro)
1312 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
1313 safe_run_hooks (Qpost_command_idle_hook);
1314 }
1315
1316 /* Do this after running Vpost_command_hook, for consistency. */
1317 current_kboard->Vlast_command = Vthis_command;
1318 current_kboard->Vreal_last_command = real_this_command;
1319
1320 while (1)
1321 {
1322 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1323 Fkill_emacs (Qnil);
1324
1325 /* Make sure the current window's buffer is selected. */
1326 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1327 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1328
1329 /* Display any malloc warning that just came out. Use while because
1330 displaying one warning can cause another. */
1331
1332 while (pending_malloc_warning)
1333 display_malloc_warning ();
1334
1335 no_direct = 0;
1336
1337 Vdeactivate_mark = Qnil;
1338
1339 /* If minibuffer on and echo area in use,
1340 wait a short time and redraw minibuffer. */
1341
1342 if (minibuf_level
1343 && !NILP (echo_area_buffer[0])
1344 && EQ (minibuf_window, echo_area_window)
1345 && NUMBERP (Vminibuffer_message_timeout))
1346 {
1347 /* Bind inhibit-quit to t so that C-g gets read in
1348 rather than quitting back to the minibuffer. */
1349 int count = specpdl_ptr - specpdl;
1350 specbind (Qinhibit_quit, Qt);
1351
1352 Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil);
1353 /* Clear the echo area. */
1354 message2 (0, 0, 0);
1355 safe_run_hooks (Qecho_area_clear_hook);
1356
1357 unbind_to (count, Qnil);
1358
1359 /* If a C-g came in before, treat it as input now. */
1360 if (!NILP (Vquit_flag))
1361 {
1362 Vquit_flag = Qnil;
1363 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
1364 }
1365 }
1366
1367 #ifdef C_ALLOCA
1368 alloca (0); /* Cause a garbage collection now */
1369 /* Since we can free the most stuff here. */
1370 #endif /* C_ALLOCA */
1371
1372 #if 0
1373 /* Select the frame that the last event came from. Usually,
1374 switch-frame events will take care of this, but if some lisp
1375 code swallows a switch-frame event, we'll fix things up here.
1376 Is this a good idea? */
1377 if (FRAMEP (internal_last_event_frame)
1378 && !EQ (internal_last_event_frame, selected_frame))
1379 Fselect_frame (internal_last_event_frame, Qnil);
1380 #endif
1381 /* If it has changed current-menubar from previous value,
1382 really recompute the menubar from the value. */
1383 if (! NILP (Vlucid_menu_bar_dirty_flag)
1384 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
1385 call0 (Qrecompute_lucid_menubar);
1386
1387 before_command_key_count = this_command_key_count;
1388 before_command_echo_length = echo_length ();
1389
1390 Vthis_command = Qnil;
1391 real_this_command = Qnil;
1392
1393 /* Read next key sequence; i gets its length. */
1394 i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
1395 Qnil, 0, 1, 1);
1396
1397 /* A filter may have run while we were reading the input. */
1398 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1399 Fkill_emacs (Qnil);
1400 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1401 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1402
1403 ++num_input_keys;
1404
1405 /* Now we have read a key sequence of length I,
1406 or else I is 0 and we found end of file. */
1407
1408 if (i == 0) /* End of file -- happens only in */
1409 return Qnil; /* a kbd macro, at the end. */
1410 /* -1 means read_key_sequence got a menu that was rejected.
1411 Just loop around and read another command. */
1412 if (i == -1)
1413 {
1414 cancel_echoing ();
1415 this_command_key_count = 0;
1416 this_single_command_key_start = 0;
1417 goto finalize;
1418 }
1419
1420 last_command_char = keybuf[i - 1];
1421
1422 /* If the previous command tried to force a specific window-start,
1423 forget about that, in case this command moves point far away
1424 from that position. But also throw away beg_unchanged and
1425 end_unchanged information in that case, so that redisplay will
1426 update the whole window properly. */
1427 if (!NILP (XWINDOW (selected_window)->force_start))
1428 {
1429 struct buffer *b;
1430 XWINDOW (selected_window)->force_start = Qnil;
1431 b = XBUFFER (XWINDOW (selected_window)->buffer);
1432 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
1433 }
1434
1435 cmd = read_key_sequence_cmd;
1436 if (!NILP (Vexecuting_macro))
1437 {
1438 if (!NILP (Vquit_flag))
1439 {
1440 Vexecuting_macro = Qt;
1441 QUIT; /* Make some noise. */
1442 /* Will return since macro now empty. */
1443 }
1444 }
1445
1446 /* Do redisplay processing after this command except in special
1447 cases identified below. */
1448 prev_buffer = current_buffer;
1449 prev_modiff = MODIFF;
1450 last_point_position = PT;
1451 XSETBUFFER (last_point_position_buffer, prev_buffer);
1452
1453 /* By default, we adjust point to a boundary of a region that
1454 has such a property that should be treated intangible
1455 (e.g. composition, display). But, some commands will set
1456 this variable differently. */
1457 Vdisable_point_adjustment = Qnil;
1458
1459 /* Execute the command. */
1460
1461 Vthis_command = cmd;
1462 real_this_command = cmd;
1463 /* Note that the value cell will never directly contain nil
1464 if the symbol is a local variable. */
1465 if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks))
1466 safe_run_hooks (Qpre_command_hook);
1467
1468 if (NILP (Vthis_command))
1469 {
1470 /* nil means key is undefined. */
1471 bitch_at_user ();
1472 current_kboard->defining_kbd_macro = Qnil;
1473 update_mode_lines = 1;
1474 current_kboard->Vprefix_arg = Qnil;
1475 }
1476 else
1477 {
1478 if (NILP (current_kboard->Vprefix_arg) && ! no_direct)
1479 {
1480 /* In case we jump to directly_done. */
1481 Vcurrent_prefix_arg = current_kboard->Vprefix_arg;
1482
1483 /* Recognize some common commands in common situations and
1484 do them directly. */
1485 if (EQ (Vthis_command, Qforward_char) && PT < ZV)
1486 {
1487 struct Lisp_Char_Table *dp
1488 = window_display_table (XWINDOW (selected_window));
1489 lose = FETCH_CHAR (PT_BYTE);
1490 SET_PT (PT + 1);
1491 if ((dp
1492 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1493 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1494 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1495 && (lose >= 0x20 && lose < 0x7f)))
1496 : (lose >= 0x20 && lose < 0x7f))
1497 /* To extract the case of continuation on
1498 wide-column characters. */
1499 && (WIDTH_BY_CHAR_HEAD (FETCH_BYTE (PT_BYTE)) == 1)
1500 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1501 >= MODIFF)
1502 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1503 >= OVERLAY_MODIFF)
1504 && (XFASTINT (XWINDOW (selected_window)->last_point)
1505 == PT - 1)
1506 && !windows_or_buffers_changed
1507 && EQ (current_buffer->selective_display, Qnil)
1508 && !detect_input_pending ()
1509 && NILP (XWINDOW (selected_window)->column_number_displayed)
1510 && NILP (Vexecuting_macro))
1511 direct_output_forward_char (1);
1512 goto directly_done;
1513 }
1514 else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV)
1515 {
1516 struct Lisp_Char_Table *dp
1517 = window_display_table (XWINDOW (selected_window));
1518 SET_PT (PT - 1);
1519 lose = FETCH_CHAR (PT_BYTE);
1520 if ((dp
1521 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1522 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1523 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1524 && (lose >= 0x20 && lose < 0x7f)))
1525 : (lose >= 0x20 && lose < 0x7f))
1526 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1527 >= MODIFF)
1528 && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1529 >= OVERLAY_MODIFF)
1530 && (XFASTINT (XWINDOW (selected_window)->last_point)
1531 == PT + 1)
1532 && !windows_or_buffers_changed
1533 && EQ (current_buffer->selective_display, Qnil)
1534 && !detect_input_pending ()
1535 && NILP (XWINDOW (selected_window)->column_number_displayed)
1536 && NILP (Vexecuting_macro))
1537 direct_output_forward_char (-1);
1538 goto directly_done;
1539 }
1540 else if (EQ (Vthis_command, Qself_insert_command)
1541 /* Try this optimization only on ascii keystrokes. */
1542 && INTEGERP (last_command_char))
1543 {
1544 unsigned int c = XINT (last_command_char);
1545 int value;
1546 if (NILP (Vexecuting_macro)
1547 && !EQ (minibuf_window, selected_window))
1548 {
1549 if (!nonundocount || nonundocount >= 20)
1550 {
1551 Fundo_boundary ();
1552 nonundocount = 0;
1553 }
1554 nonundocount++;
1555 }
1556
1557 lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
1558 < MODIFF)
1559 || (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
1560 < OVERLAY_MODIFF)
1561 || (XFASTINT (XWINDOW (selected_window)->last_point)
1562 != PT)
1563 || MODIFF <= SAVE_MODIFF
1564 || windows_or_buffers_changed
1565 || !EQ (current_buffer->selective_display, Qnil)
1566 || detect_input_pending ()
1567 || !NILP (XWINDOW (selected_window)->column_number_displayed)
1568 || !NILP (Vexecuting_macro));
1569
1570 value = internal_self_insert (c, 0);
1571
1572 if (value == 2)
1573 nonundocount = 0;
1574
1575 /* VALUE == 1 when AFTER-CHANGE functions are
1576 installed which is the case most of the time
1577 because FONT-LOCK installs one. */
1578 if (!lose && !value)
1579 direct_output_for_insert (c);
1580 goto directly_done;
1581 }
1582 }
1583
1584 /* Here for a command that isn't executed directly */
1585
1586 #ifdef HAVE_X_WINDOWS
1587 if (display_busy_cursor_p)
1588 start_busy_cursor ();
1589 #endif
1590
1591 nonundocount = 0;
1592 if (NILP (current_kboard->Vprefix_arg))
1593 Fundo_boundary ();
1594 Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
1595
1596 #ifdef HAVE_X_WINDOWS
1597 if (display_busy_cursor_p)
1598 cancel_busy_cursor ();
1599 #endif
1600 }
1601 directly_done: ;
1602 current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg;
1603
1604 /* Note that the value cell will never directly contain nil
1605 if the symbol is a local variable. */
1606 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1607 safe_run_hooks (Qpost_command_hook);
1608
1609 /* If displaying a message, resize the echo area window to fit
1610 that message's size exactly. */
1611 if (!NILP (echo_area_buffer[0]))
1612 resize_echo_area_axactly ();
1613
1614 if (!NILP (Vdeferred_action_list))
1615 safe_run_hooks (Qdeferred_action_function);
1616
1617 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1618 {
1619 if (NILP (Vunread_command_events)
1620 && NILP (Vunread_input_method_events)
1621 && NILP (Vunread_post_input_method_events)
1622 && NILP (Vexecuting_macro)
1623 && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1)))
1624 safe_run_hooks (Qpost_command_idle_hook);
1625 }
1626
1627 /* If there is a prefix argument,
1628 1) We don't want Vlast_command to be ``universal-argument''
1629 (that would be dumb), so don't set Vlast_command,
1630 2) we want to leave echoing on so that the prefix will be
1631 echoed as part of this key sequence, so don't call
1632 cancel_echoing, and
1633 3) we want to leave this_command_key_count non-zero, so that
1634 read_char will realize that it is re-reading a character, and
1635 not echo it a second time.
1636
1637 If the command didn't actually create a prefix arg,
1638 but is merely a frame event that is transparent to prefix args,
1639 then the above doesn't apply. */
1640 if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_char))
1641 {
1642 current_kboard->Vlast_command = Vthis_command;
1643 current_kboard->Vreal_last_command = real_this_command;
1644 cancel_echoing ();
1645 this_command_key_count = 0;
1646 this_single_command_key_start = 0;
1647 }
1648
1649 if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks))
1650 {
1651 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
1652 {
1653 current_buffer->mark_active = Qnil;
1654 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
1655 }
1656 else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1657 call1 (Vrun_hooks, intern ("activate-mark-hook"));
1658 }
1659
1660 finalize:
1661
1662 if (current_buffer == prev_buffer
1663 && last_point_position != PT
1664 && NILP (Vdisable_point_adjustment)
1665 && NILP (Vglobal_disable_point_adjustment))
1666 adjust_point_for_property (last_point_position);
1667
1668 /* Install chars successfully executed in kbd macro. */
1669
1670 if (!NILP (current_kboard->defining_kbd_macro)
1671 && NILP (current_kboard->Vprefix_arg))
1672 finalize_kbd_macro_chars ();
1673
1674 #ifdef MULTI_KBOARD
1675 if (!was_locked)
1676 any_kboard_state ();
1677 #endif
1678 }
1679 }
1680
1681 extern Lisp_Object Qcomposition, Qdisplay;
1682
1683 /* Adjust point to a boundary of a region that has such a property
1684 that should be treated intangible. For the moment, we check
1685 `composition' and `display' property. LAST_PT is the last position
1686 of point. */
1687
1688 static void
1689 adjust_point_for_property (last_pt)
1690 int last_pt;
1691 {
1692 int start, end;
1693 Lisp_Object val;
1694 int check_composition = 1, check_display = 1;
1695
1696 while (check_composition || check_display)
1697 {
1698 if (check_composition
1699 && PT > BEGV && PT < ZV
1700 && get_property_and_range (PT, Qcomposition, &val, &start, &end, Qnil)
1701 && COMPOSITION_VALID_P (start, end, val)
1702 && start < PT && end > PT
1703 && (last_pt <= start || last_pt >= end))
1704 {
1705 if (PT < last_pt)
1706 SET_PT (start);
1707 else
1708 SET_PT (end);
1709 check_display = 1;
1710 }
1711 check_composition = 0;
1712 if (check_display
1713 && PT > BEGV && PT < ZV
1714 && get_property_and_range (PT, Qdisplay, &val, &start, &end, Qnil)
1715 && display_prop_intangible_p (val)
1716 && start < PT && end > PT
1717 && (last_pt <= start || last_pt >= end))
1718 {
1719 if (PT < last_pt)
1720 SET_PT (start);
1721 else
1722 SET_PT (end);
1723 check_composition = 1;
1724 }
1725 check_display = 0;
1726 }
1727 }
1728
1729 /* Subroutine for safe_run_hooks: run the hook HOOK. */
1730
1731 static Lisp_Object
1732 safe_run_hooks_1 (hook)
1733 Lisp_Object hook;
1734 {
1735 return call1 (Vrun_hooks, Vinhibit_quit);
1736 }
1737
1738 /* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */
1739
1740 static Lisp_Object
1741 safe_run_hooks_error (data)
1742 Lisp_Object data;
1743 {
1744 return Fset (Vinhibit_quit, Qnil);
1745 }
1746
1747 /* If we get an error while running the hook, cause the hook variable
1748 to be nil. Also inhibit quits, so that C-g won't cause the hook
1749 to mysteriously evaporate. */
1750
1751 void
1752 safe_run_hooks (hook)
1753 Lisp_Object hook;
1754 {
1755 int count = specpdl_ptr - specpdl;
1756 specbind (Qinhibit_quit, hook);
1757
1758 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
1759
1760 unbind_to (count, Qnil);
1761 }
1762
1763 \f
1764 /* Number of seconds between polling for input. This is a Lisp
1765 variable that can be bound. */
1766
1767 int polling_period;
1768
1769 /* Nonzero means polling for input is temporarily suppressed. */
1770
1771 int poll_suppress_count;
1772
1773 /* Asynchronous timer for polling. */
1774
1775 struct atimer *poll_timer;
1776
1777
1778 #ifdef POLL_FOR_INPUT
1779
1780 /* Poll for input, so what we catch a C-g if it comes in. This
1781 function is called from x_make_frame_visible, see comment
1782 there. */
1783
1784 void
1785 poll_for_input_1 ()
1786 {
1787 if (interrupt_input_blocked == 0
1788 && !waiting_for_input)
1789 read_avail_input (0);
1790 }
1791
1792 /* Timer callback function for poll_timer. TIMER is equal to
1793 poll_timer. */
1794
1795 void
1796 poll_for_input (timer)
1797 struct atimer *timer;
1798 {
1799 if (poll_suppress_count == 0)
1800 poll_for_input_1 ();
1801 }
1802
1803 #endif /* POLL_FOR_INPUT */
1804
1805 /* Begin signals to poll for input, if they are appropriate.
1806 This function is called unconditionally from various places. */
1807
1808 void
1809 start_polling ()
1810 {
1811 #ifdef POLL_FOR_INPUT
1812 if (read_socket_hook && !interrupt_input)
1813 {
1814 /* Turn alarm handling on unconditionally. It might have
1815 been turned off in process.c. */
1816 turn_on_atimers (1);
1817
1818 /* If poll timer doesn't exist, are we need one with
1819 a different interval, start a new one. */
1820 if (poll_timer == NULL
1821 || EMACS_SECS (poll_timer->interval) != polling_period)
1822 {
1823 EMACS_TIME interval;
1824
1825 if (poll_timer)
1826 cancel_atimer (poll_timer);
1827
1828 EMACS_SET_SECS_USECS (interval, polling_period, 0);
1829 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
1830 poll_for_input, NULL);
1831 }
1832
1833 /* Let the timer's callback function poll for input
1834 if this becomes zero. */
1835 --poll_suppress_count;
1836 }
1837 #endif
1838 }
1839
1840 /* Nonzero if we are using polling to handle input asynchronously. */
1841
1842 int
1843 input_polling_used ()
1844 {
1845 #ifdef POLL_FOR_INPUT
1846 return read_socket_hook && !interrupt_input;
1847 #else
1848 return 0;
1849 #endif
1850 }
1851
1852 /* Turn off polling. */
1853
1854 void
1855 stop_polling ()
1856 {
1857 #ifdef POLL_FOR_INPUT
1858 if (read_socket_hook && !interrupt_input)
1859 ++poll_suppress_count;
1860 #endif
1861 }
1862
1863 /* Set the value of poll_suppress_count to COUNT
1864 and start or stop polling accordingly. */
1865
1866 void
1867 set_poll_suppress_count (count)
1868 int count;
1869 {
1870 #ifdef POLL_FOR_INPUT
1871 if (count == 0 && poll_suppress_count != 0)
1872 {
1873 poll_suppress_count = 1;
1874 start_polling ();
1875 }
1876 else if (count != 0 && poll_suppress_count == 0)
1877 {
1878 stop_polling ();
1879 }
1880 poll_suppress_count = count;
1881 #endif
1882 }
1883
1884 /* Bind polling_period to a value at least N.
1885 But don't decrease it. */
1886
1887 void
1888 bind_polling_period (n)
1889 int n;
1890 {
1891 #ifdef POLL_FOR_INPUT
1892 int new = polling_period;
1893
1894 if (n > new)
1895 new = n;
1896
1897 stop_other_atimers (poll_timer);
1898 stop_polling ();
1899 specbind (Qpolling_period, make_number (new));
1900 /* Start a new alarm with the new period. */
1901 start_polling ();
1902 #endif
1903 }
1904 \f
1905 /* Apply the control modifier to CHARACTER. */
1906
1907 int
1908 make_ctrl_char (c)
1909 int c;
1910 {
1911 /* Save the upper bits here. */
1912 int upper = c & ~0177;
1913
1914 c &= 0177;
1915
1916 /* Everything in the columns containing the upper-case letters
1917 denotes a control character. */
1918 if (c >= 0100 && c < 0140)
1919 {
1920 int oc = c;
1921 c &= ~0140;
1922 /* Set the shift modifier for a control char
1923 made from a shifted letter. But only for letters! */
1924 if (oc >= 'A' && oc <= 'Z')
1925 c |= shift_modifier;
1926 }
1927
1928 /* The lower-case letters denote control characters too. */
1929 else if (c >= 'a' && c <= 'z')
1930 c &= ~0140;
1931
1932 /* Include the bits for control and shift
1933 only if the basic ASCII code can't indicate them. */
1934 else if (c >= ' ')
1935 c |= ctrl_modifier;
1936
1937 /* Replace the high bits. */
1938 c |= (upper & ~ctrl_modifier);
1939
1940 return c;
1941 }
1942
1943 /* Display help echo in the echo area.
1944
1945 HELP a string means display that string, HELP nil means clear the
1946 help echo. If HELP is a function, call it with OBJECT and POS as
1947 arguments; the function should return a help string or nil for
1948 none. For all other types of HELP evaluate it to obtain a string.
1949
1950 WINDOW is the window in which the help was generated, if any.
1951 It is nil if not in a window.
1952
1953 If OBJECT is a buffer, POS is the position in the buffer where the
1954 `help-echo' text property was found.
1955
1956 If OBJECT is an overlay, that overlay has a `help-echo' property,
1957 and POS is the position in the overlay's buffer under the mouse.
1958
1959 If OBJECT is a string (an overlay string or a string displayed with
1960 the `display' property). POS is the position in that string under
1961 the mouse.
1962
1963 OK_TO_IVERWRITE_KEYSTROKE_ECHO non-zero means it's okay if the help
1964 echo overwrites a keystroke echo currently displayed in the echo
1965 area.
1966
1967 Note: this function may only be called with HELP nil or a string
1968 from X code running asynchronously. */
1969
1970 void
1971 show_help_echo (help, window, object, pos, ok_to_overwrite_keystroke_echo)
1972 Lisp_Object help, window, object, pos;
1973 int ok_to_overwrite_keystroke_echo;
1974 {
1975 if (!NILP (help) && !STRINGP (help))
1976 {
1977 if (FUNCTIONP (help))
1978 {
1979 Lisp_Object args[4];
1980 args[0] = help;
1981 args[1] = window;
1982 args[2] = object;
1983 args[3] = pos;
1984 help = safe_call (4, args);
1985 }
1986 else
1987 help = safe_eval (help);
1988
1989 if (!STRINGP (help))
1990 return;
1991 }
1992
1993 if (STRINGP (help) || NILP (help))
1994 {
1995 if (!NILP (Vshow_help_function))
1996 call1 (Vshow_help_function, help);
1997 else if (/* Don't overwrite minibuffer contents. */
1998 !MINI_WINDOW_P (XWINDOW (selected_window))
1999 /* Don't overwrite a keystroke echo. */
2000 && (NILP (echo_message_buffer)
2001 || ok_to_overwrite_keystroke_echo)
2002 /* Don't overwrite a prompt. */
2003 && !cursor_in_echo_area)
2004 {
2005 if (STRINGP (help))
2006 {
2007 int count = specpdl_ptr - specpdl;
2008 specbind (Qmessage_truncate_lines, Qt);
2009 message3_nolog (help, STRING_BYTES (XSTRING (help)),
2010 STRING_MULTIBYTE (help));
2011 unbind_to (count, Qnil);
2012 }
2013 else
2014 message (0);
2015 }
2016
2017 help_echo_showing_p = STRINGP (help);
2018 }
2019 }
2020
2021
2022 \f
2023 /* Input of single characters from keyboard */
2024
2025 Lisp_Object print_help ();
2026 static Lisp_Object kbd_buffer_get_event ();
2027 static void record_char ();
2028
2029 #ifdef MULTI_KBOARD
2030 static jmp_buf wrong_kboard_jmpbuf;
2031 #endif
2032
2033 /* read a character from the keyboard; call the redisplay if needed */
2034 /* commandflag 0 means do not do auto-saving, but do do redisplay.
2035 -1 means do not do redisplay, but do do autosaving.
2036 1 means do both. */
2037
2038 /* The arguments MAPS and NMAPS are for menu prompting.
2039 MAPS is an array of keymaps; NMAPS is the length of MAPS.
2040
2041 PREV_EVENT is the previous input event, or nil if we are reading
2042 the first event of a key sequence (or not reading a key sequence).
2043 If PREV_EVENT is t, that is a "magic" value that says
2044 not to run input methods, but in other respects to act as if
2045 not reading a key sequence.
2046
2047 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
2048 if we used a mouse menu to read the input, or zero otherwise. If
2049 USED_MOUSE_MENU is null, we don't dereference it.
2050
2051 Value is t if we showed a menu and the user rejected it. */
2052
2053 Lisp_Object
2054 read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
2055 int commandflag;
2056 int nmaps;
2057 Lisp_Object *maps;
2058 Lisp_Object prev_event;
2059 int *used_mouse_menu;
2060 {
2061 volatile Lisp_Object c;
2062 int count;
2063 jmp_buf local_getcjmp;
2064 jmp_buf save_jump;
2065 volatile int key_already_recorded = 0;
2066 Lisp_Object tem, save;
2067 volatile Lisp_Object previous_echo_area_message;
2068 volatile Lisp_Object also_record;
2069 volatile int reread;
2070 struct gcpro gcpro1, gcpro2;
2071
2072 also_record = Qnil;
2073
2074 before_command_key_count = this_command_key_count;
2075 before_command_echo_length = echo_length ();
2076 c = Qnil;
2077 previous_echo_area_message = Qnil;
2078
2079 GCPRO2 (c, previous_echo_area_message);
2080
2081 retry:
2082
2083 reread = 0;
2084 if (CONSP (Vunread_post_input_method_events))
2085 {
2086 c = XCAR (Vunread_post_input_method_events);
2087 Vunread_post_input_method_events
2088 = XCDR (Vunread_post_input_method_events);
2089
2090 /* Undo what read_char_x_menu_prompt did when it unread
2091 additional keys returned by Fx_popup_menu. */
2092 if (CONSP (c)
2093 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2094 && NILP (XCDR (c)))
2095 c = XCAR (c);
2096
2097 reread = 1;
2098 goto reread_first;
2099 }
2100
2101 if (unread_command_char != -1)
2102 {
2103 XSETINT (c, unread_command_char);
2104 unread_command_char = -1;
2105
2106 reread = 1;
2107 goto reread_first;
2108 }
2109
2110 if (CONSP (Vunread_command_events))
2111 {
2112 c = XCAR (Vunread_command_events);
2113 Vunread_command_events = XCDR (Vunread_command_events);
2114
2115 /* Undo what read_char_x_menu_prompt did when it unread
2116 additional keys returned by Fx_popup_menu. */
2117 if (CONSP (c)
2118 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2119 && NILP (XCDR (c)))
2120 c = XCAR (c);
2121
2122 reread = 1;
2123 goto reread_for_input_method;
2124 }
2125
2126 if (CONSP (Vunread_input_method_events))
2127 {
2128 c = XCAR (Vunread_input_method_events);
2129 Vunread_input_method_events = XCDR (Vunread_input_method_events);
2130
2131 /* Undo what read_char_x_menu_prompt did when it unread
2132 additional keys returned by Fx_popup_menu. */
2133 if (CONSP (c)
2134 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2135 && NILP (XCDR (c)))
2136 c = XCAR (c);
2137 reread = 1;
2138 goto reread_for_input_method;
2139 }
2140
2141 /* If there is no function key translated before
2142 reset-this-command-lengths takes effect, forget about it. */
2143 before_command_restore_flag = 0;
2144
2145 if (!NILP (Vexecuting_macro))
2146 {
2147 /* We set this to Qmacro; since that's not a frame, nobody will
2148 try to switch frames on us, and the selected window will
2149 remain unchanged.
2150
2151 Since this event came from a macro, it would be misleading to
2152 leave internal_last_event_frame set to wherever the last
2153 real event came from. Normally, a switch-frame event selects
2154 internal_last_event_frame after each command is read, but
2155 events read from a macro should never cause a new frame to be
2156 selected. */
2157 Vlast_event_frame = internal_last_event_frame = Qmacro;
2158
2159 /* Exit the macro if we are at the end.
2160 Also, some things replace the macro with t
2161 to force an early exit. */
2162 if (EQ (Vexecuting_macro, Qt)
2163 || executing_macro_index >= XFASTINT (Flength (Vexecuting_macro)))
2164 {
2165 XSETINT (c, -1);
2166 RETURN_UNGCPRO (c);
2167 }
2168
2169 c = Faref (Vexecuting_macro, make_number (executing_macro_index));
2170 if (STRINGP (Vexecuting_macro)
2171 && (XINT (c) & 0x80))
2172 XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
2173
2174 executing_macro_index++;
2175
2176 goto from_macro;
2177 }
2178
2179 if (!NILP (unread_switch_frame))
2180 {
2181 c = unread_switch_frame;
2182 unread_switch_frame = Qnil;
2183
2184 /* This event should make it into this_command_keys, and get echoed
2185 again, so we do not set `reread'. */
2186 goto reread_first;
2187 }
2188
2189 /* if redisplay was requested */
2190 if (commandflag >= 0)
2191 {
2192 /* If there is pending input, process any events which are not
2193 user-visible, such as X selection_request events. */
2194 if (input_pending
2195 || detect_input_pending_run_timers (0))
2196 swallow_events (0); /* may clear input_pending */
2197
2198 /* Redisplay if no pending input. */
2199 while (!input_pending)
2200 {
2201 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
2202 redisplay_preserve_echo_area ();
2203 else
2204 redisplay ();
2205
2206 if (!input_pending)
2207 /* Normal case: no input arrived during redisplay. */
2208 break;
2209
2210 /* Input arrived and pre-empted redisplay.
2211 Process any events which are not user-visible. */
2212 swallow_events (0);
2213 /* If that cleared input_pending, try again to redisplay. */
2214 }
2215 }
2216
2217 /* Message turns off echoing unless more keystrokes turn it on again.
2218
2219 The code in 20.x for the condition was
2220
2221 1. echo_area_glyphs && *echo_area_glyphs
2222 2. && echo_area_glyphs != current_kboard->echobuf
2223 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2224
2225 (1) means there's a current message displayed
2226
2227 (2) means it's not the message from echoing from the current
2228 kboard.
2229
2230 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2231 is set to a non-null value. This is done in read_char and it is
2232 set to echo_area_glyphs after a call to echo_char. That means
2233 ok_to_echo_at_next_pause is either null or
2234 current_kboard->echobuf with the appropriate current_kboard at
2235 that time.
2236
2237 So, condition (3) means in clear text ok_to_echo_at_next_pause
2238 must be either null, or the current message isn't from echoing at
2239 all, or it's from echoing from a different kboard than the
2240 current one. */
2241
2242 if (/* There currently something in the echo area */
2243 !NILP (echo_area_buffer[0])
2244 && (/* And it's either not from echoing. */
2245 !EQ (echo_area_buffer[0], echo_message_buffer)
2246 /* Or it's an echo from a different kboard. */
2247 || echo_kboard != current_kboard
2248 /* Or we explicitly allow overwriting whatever there is. */
2249 || ok_to_echo_at_next_pause == NULL))
2250 cancel_echoing ();
2251 else
2252 echo_dash ();
2253
2254 /* Try reading a character via menu prompting in the minibuf.
2255 Try this before the sit-for, because the sit-for
2256 would do the wrong thing if we are supposed to do
2257 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2258 after a mouse event so don't try a minibuf menu. */
2259 c = Qnil;
2260 if (nmaps > 0 && INTERACTIVE
2261 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2262 /* Don't bring up a menu if we already have another event. */
2263 && NILP (Vunread_command_events)
2264 && unread_command_char < 0
2265 && !detect_input_pending_run_timers (0))
2266 {
2267 c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
2268 if (! NILP (c))
2269 {
2270 key_already_recorded = 1;
2271 goto non_reread_1;
2272 }
2273 }
2274
2275 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2276 We will do that below, temporarily for short sections of code,
2277 when appropriate. local_getcjmp must be in effect
2278 around any call to sit_for or kbd_buffer_get_event;
2279 it *must not* be in effect when we call redisplay. */
2280
2281 if (_setjmp (local_getcjmp))
2282 {
2283 XSETINT (c, quit_char);
2284 internal_last_event_frame = selected_frame;
2285 Vlast_event_frame = internal_last_event_frame;
2286 /* If we report the quit char as an event,
2287 don't do so more than once. */
2288 if (!NILP (Vinhibit_quit))
2289 Vquit_flag = Qnil;
2290
2291 #ifdef MULTI_KBOARD
2292 {
2293 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
2294 if (kb != current_kboard)
2295 {
2296 Lisp_Object *tailp = &kb->kbd_queue;
2297 /* We shouldn't get here if we were in single-kboard mode! */
2298 if (single_kboard)
2299 abort ();
2300 while (CONSP (*tailp))
2301 tailp = &XCDR (*tailp);
2302 if (!NILP (*tailp))
2303 abort ();
2304 *tailp = Fcons (c, Qnil);
2305 kb->kbd_queue_has_data = 1;
2306 current_kboard = kb;
2307 /* This is going to exit from read_char
2308 so we had better get rid of this frame's stuff. */
2309 UNGCPRO;
2310 longjmp (wrong_kboard_jmpbuf, 1);
2311 }
2312 }
2313 #endif
2314 goto non_reread;
2315 }
2316
2317 timer_start_idle ();
2318
2319 /* If in middle of key sequence and minibuffer not active,
2320 start echoing if enough time elapses. */
2321
2322 if (minibuf_level == 0
2323 && !current_kboard->immediate_echo
2324 && this_command_key_count > 0
2325 && ! noninteractive
2326 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2327 && NILP (Fzerop (Vecho_keystrokes))
2328 && (/* No message. */
2329 NILP (echo_area_buffer[0])
2330 /* Or empty message. */
2331 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2332 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2333 /* Or already echoing from same kboard. */
2334 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2335 /* Or not echoing before and echoing allowed. */
2336 || (!echo_kboard && ok_to_echo_at_next_pause)))
2337 {
2338 Lisp_Object tem0;
2339
2340 /* After a mouse event, start echoing right away.
2341 This is because we are probably about to display a menu,
2342 and we don't want to delay before doing so. */
2343 if (EVENT_HAS_PARAMETERS (prev_event))
2344 echo_now ();
2345 else
2346 {
2347 int sec, usec;
2348 double duration = extract_float (Vecho_keystrokes);
2349 sec = (int) duration;
2350 usec = (duration - sec) * 1000000;
2351 save_getcjmp (save_jump);
2352 restore_getcjmp (local_getcjmp);
2353 tem0 = sit_for (sec, usec, 1, 1, 0);
2354 restore_getcjmp (save_jump);
2355 if (EQ (tem0, Qt)
2356 && ! CONSP (Vunread_command_events))
2357 echo_now ();
2358 }
2359 }
2360
2361 /* Maybe auto save due to number of keystrokes. */
2362
2363 if (commandflag != 0
2364 && auto_save_interval > 0
2365 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
2366 && !detect_input_pending_run_timers (0))
2367 {
2368 Fdo_auto_save (Qnil, Qnil);
2369 /* Hooks can actually change some buffers in auto save. */
2370 redisplay ();
2371 }
2372
2373 /* Try reading using an X menu.
2374 This is never confused with reading using the minibuf
2375 because the recursive call of read_char in read_char_minibuf_menu_prompt
2376 does not pass on any keymaps. */
2377
2378 if (nmaps > 0 && INTERACTIVE
2379 && !NILP (prev_event)
2380 && EVENT_HAS_PARAMETERS (prev_event)
2381 && !EQ (XCAR (prev_event), Qmenu_bar)
2382 && !EQ (XCAR (prev_event), Qtool_bar)
2383 /* Don't bring up a menu if we already have another event. */
2384 && NILP (Vunread_command_events)
2385 && unread_command_char < 0)
2386 {
2387 c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
2388
2389 /* Now that we have read an event, Emacs is not idle. */
2390 timer_stop_idle ();
2391
2392 RETURN_UNGCPRO (c);
2393 }
2394
2395 /* Maybe autosave and/or garbage collect due to idleness. */
2396
2397 if (INTERACTIVE && NILP (c))
2398 {
2399 int delay_level, buffer_size;
2400
2401 /* Slow down auto saves logarithmically in size of current buffer,
2402 and garbage collect while we're at it. */
2403 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2404 last_non_minibuf_size = Z - BEG;
2405 buffer_size = (last_non_minibuf_size >> 8) + 1;
2406 delay_level = 0;
2407 while (buffer_size > 64)
2408 delay_level++, buffer_size -= buffer_size >> 2;
2409 if (delay_level < 4) delay_level = 4;
2410 /* delay_level is 4 for files under around 50k, 7 at 100k,
2411 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2412
2413 /* Auto save if enough time goes by without input. */
2414 if (commandflag != 0
2415 && num_nonmacro_input_events > last_auto_save
2416 && INTEGERP (Vauto_save_timeout)
2417 && XINT (Vauto_save_timeout) > 0)
2418 {
2419 Lisp_Object tem0;
2420
2421 save_getcjmp (save_jump);
2422 restore_getcjmp (local_getcjmp);
2423 tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4,
2424 0, 1, 1, 0);
2425 restore_getcjmp (save_jump);
2426
2427 if (EQ (tem0, Qt)
2428 && ! CONSP (Vunread_command_events))
2429 {
2430 Fdo_auto_save (Qnil, Qnil);
2431
2432 /* If we have auto-saved and there is still no input
2433 available, garbage collect if there has been enough
2434 consing going on to make it worthwhile. */
2435 if (!detect_input_pending_run_timers (0)
2436 && consing_since_gc > gc_cons_threshold / 2)
2437 Fgarbage_collect ();
2438
2439 redisplay ();
2440 }
2441 }
2442 }
2443
2444 /* If this has become non-nil here, it has been set by a timer
2445 or sentinel or filter. */
2446 if (CONSP (Vunread_command_events))
2447 {
2448 c = XCAR (Vunread_command_events);
2449 Vunread_command_events = XCDR (Vunread_command_events);
2450 }
2451
2452 /* Read something from current KBOARD's side queue, if possible. */
2453
2454 if (NILP (c))
2455 {
2456 if (current_kboard->kbd_queue_has_data)
2457 {
2458 if (!CONSP (current_kboard->kbd_queue))
2459 abort ();
2460 c = XCAR (current_kboard->kbd_queue);
2461 current_kboard->kbd_queue
2462 = XCDR (current_kboard->kbd_queue);
2463 if (NILP (current_kboard->kbd_queue))
2464 current_kboard->kbd_queue_has_data = 0;
2465 input_pending = readable_events (0);
2466 if (EVENT_HAS_PARAMETERS (c)
2467 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
2468 internal_last_event_frame = XCAR (XCDR (c));
2469 Vlast_event_frame = internal_last_event_frame;
2470 }
2471 }
2472
2473 #ifdef MULTI_KBOARD
2474 /* If current_kboard's side queue is empty check the other kboards.
2475 If one of them has data that we have not yet seen here,
2476 switch to it and process the data waiting for it.
2477
2478 Note: if the events queued up for another kboard
2479 have already been seen here, and therefore are not a complete command,
2480 the kbd_queue_has_data field is 0, so we skip that kboard here.
2481 That's to avoid an infinite loop switching between kboards here. */
2482 if (NILP (c) && !single_kboard)
2483 {
2484 KBOARD *kb;
2485 for (kb = all_kboards; kb; kb = kb->next_kboard)
2486 if (kb->kbd_queue_has_data)
2487 {
2488 current_kboard = kb;
2489 /* This is going to exit from read_char
2490 so we had better get rid of this frame's stuff. */
2491 UNGCPRO;
2492 longjmp (wrong_kboard_jmpbuf, 1);
2493 }
2494 }
2495 #endif
2496
2497 wrong_kboard:
2498
2499 stop_polling ();
2500
2501 /* Finally, we read from the main queue,
2502 and if that gives us something we can't use yet, we put it on the
2503 appropriate side queue and try again. */
2504
2505 if (NILP (c))
2506 {
2507 KBOARD *kb;
2508
2509 /* Actually read a character, waiting if necessary. */
2510 save_getcjmp (save_jump);
2511 restore_getcjmp (local_getcjmp);
2512 timer_start_idle ();
2513 c = kbd_buffer_get_event (&kb, used_mouse_menu);
2514 restore_getcjmp (save_jump);
2515
2516 #ifdef MULTI_KBOARD
2517 if (! NILP (c) && (kb != current_kboard))
2518 {
2519 Lisp_Object *tailp = &kb->kbd_queue;
2520 while (CONSP (*tailp))
2521 tailp = &XCDR (*tailp);
2522 if (!NILP (*tailp))
2523 abort ();
2524 *tailp = Fcons (c, Qnil);
2525 kb->kbd_queue_has_data = 1;
2526 c = Qnil;
2527 if (single_kboard)
2528 goto wrong_kboard;
2529 current_kboard = kb;
2530 /* This is going to exit from read_char
2531 so we had better get rid of this frame's stuff. */
2532 UNGCPRO;
2533 longjmp (wrong_kboard_jmpbuf, 1);
2534 }
2535 #endif
2536 }
2537
2538 /* Terminate Emacs in batch mode if at eof. */
2539 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
2540 Fkill_emacs (make_number (1));
2541
2542 if (INTEGERP (c))
2543 {
2544 /* Add in any extra modifiers, where appropriate. */
2545 if ((extra_keyboard_modifiers & CHAR_CTL)
2546 || ((extra_keyboard_modifiers & 0177) < ' '
2547 && (extra_keyboard_modifiers & 0177) != 0))
2548 XSETINT (c, make_ctrl_char (XINT (c)));
2549
2550 /* Transfer any other modifier bits directly from
2551 extra_keyboard_modifiers to c. Ignore the actual character code
2552 in the low 16 bits of extra_keyboard_modifiers. */
2553 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
2554 }
2555
2556 non_reread:
2557
2558 timer_stop_idle ();
2559 start_polling ();
2560
2561 if (NILP (c))
2562 {
2563 if (commandflag >= 0
2564 && !input_pending && !detect_input_pending_run_timers (0))
2565 redisplay ();
2566
2567 goto wrong_kboard;
2568 }
2569
2570 non_reread_1:
2571
2572 /* Buffer switch events are only for internal wakeups
2573 so don't show them to the user.
2574 Also, don't record a key if we already did. */
2575 if (BUFFERP (c) || key_already_recorded)
2576 RETURN_UNGCPRO (c);
2577
2578 /* Process special events within read_char
2579 and loop around to read another event. */
2580 save = Vquit_flag;
2581 Vquit_flag = Qnil;
2582 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
2583 Vquit_flag = save;
2584
2585 if (!NILP (tem))
2586 {
2587 int was_locked = single_kboard;
2588
2589 last_input_char = c;
2590 Fcommand_execute (tem, Qnil, Fvector (1, &last_input_char), Qt);
2591
2592 /* Resume allowing input from any kboard, if that was true before. */
2593 if (!was_locked)
2594 any_kboard_state ();
2595
2596 goto retry;
2597 }
2598
2599 /* Handle things that only apply to characters. */
2600 if (INTEGERP (c))
2601 {
2602 /* If kbd_buffer_get_event gave us an EOF, return that. */
2603 if (XINT (c) == -1)
2604 RETURN_UNGCPRO (c);
2605
2606 if ((STRINGP (Vkeyboard_translate_table)
2607 && XSTRING (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
2608 || (VECTORP (Vkeyboard_translate_table)
2609 && XVECTOR (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
2610 || (CHAR_TABLE_P (Vkeyboard_translate_table)
2611 && CHAR_TABLE_ORDINARY_SLOTS > (unsigned) XFASTINT (c)))
2612 {
2613 Lisp_Object d;
2614 d = Faref (Vkeyboard_translate_table, c);
2615 /* nil in keyboard-translate-table means no translation. */
2616 if (!NILP (d))
2617 c = d;
2618 }
2619 }
2620
2621 /* If this event is a mouse click in the menu bar,
2622 return just menu-bar for now. Modify the mouse click event
2623 so we won't do this twice, then queue it up. */
2624 if (EVENT_HAS_PARAMETERS (c)
2625 && CONSP (XCDR (c))
2626 && CONSP (EVENT_START (c))
2627 && CONSP (XCDR (EVENT_START (c))))
2628 {
2629 Lisp_Object posn;
2630
2631 posn = POSN_BUFFER_POSN (EVENT_START (c));
2632 /* Handle menu-bar events:
2633 insert the dummy prefix event `menu-bar'. */
2634 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
2635 {
2636 /* Change menu-bar to (menu-bar) as the event "position". */
2637 POSN_BUFFER_POSN (EVENT_START (c)) = Fcons (posn, Qnil);
2638
2639 also_record = c;
2640 Vunread_command_events = Fcons (c, Vunread_command_events);
2641 c = posn;
2642 }
2643 }
2644
2645 /* Store these characters into recent_keys, the dribble file if any,
2646 and the keyboard macro being defined, if any. */
2647 record_char (c);
2648 if (! NILP (also_record))
2649 record_char (also_record);
2650
2651 /* Wipe the echo area.
2652 But first, if we are about to use an input method,
2653 save the echo area contents for it to refer to. */
2654 if (INTEGERP (c)
2655 && ! NILP (Vinput_method_function)
2656 && (unsigned) XINT (c) >= ' '
2657 && (unsigned) XINT (c) != 127
2658 && (unsigned) XINT (c) < 256)
2659 {
2660 previous_echo_area_message = Fcurrent_message ();
2661 Vinput_method_previous_message = previous_echo_area_message;
2662 }
2663
2664 /* Now wipe the echo area, except for help events which do their
2665 own stuff with the echo area. */
2666 if (!CONSP (c) || !(EQ (Qhelp_echo, XCAR (c))))
2667 {
2668 if (!NILP (echo_area_buffer[0]))
2669 safe_run_hooks (Qecho_area_clear_hook);
2670 clear_message (1, 0);
2671 }
2672
2673 reread_for_input_method:
2674 from_macro:
2675 /* Pass this to the input method, if appropriate. */
2676 if (INTEGERP (c)
2677 && ! NILP (Vinput_method_function)
2678 /* Don't run the input method within a key sequence,
2679 after the first event of the key sequence. */
2680 && NILP (prev_event)
2681 && (unsigned) XINT (c) >= ' '
2682 && (unsigned) XINT (c) != 127
2683 && (unsigned) XINT (c) < 256)
2684 {
2685 Lisp_Object keys;
2686 int key_count;
2687 struct gcpro gcpro1;
2688 int count = specpdl_ptr - specpdl;
2689
2690 /* Save the echo status. */
2691 int saved_immediate_echo = current_kboard->immediate_echo;
2692 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
2693 int saved_echo_after_prompt = current_kboard->echo_after_prompt;
2694
2695 if (before_command_restore_flag)
2696 {
2697 this_command_key_count = before_command_key_count_1;
2698 if (this_command_key_count < this_single_command_key_start)
2699 this_single_command_key_start = this_command_key_count;
2700 echo_truncate (before_command_echo_length_1);
2701 before_command_restore_flag = 0;
2702 }
2703
2704 /* Save the this_command_keys status. */
2705 key_count = this_command_key_count;
2706
2707 if (key_count > 0)
2708 keys = Fcopy_sequence (this_command_keys);
2709 else
2710 keys = Qnil;
2711 GCPRO1 (keys);
2712
2713 /* Clear out this_command_keys. */
2714 this_command_key_count = 0;
2715
2716 /* Now wipe the echo area. */
2717 if (!NILP (echo_area_buffer[0]))
2718 safe_run_hooks (Qecho_area_clear_hook);
2719 clear_message (1, 0);
2720 echo_truncate (0);
2721
2722 /* If we are not reading a key sequence,
2723 never use the echo area. */
2724 if (maps == 0)
2725 {
2726 specbind (Qinput_method_use_echo_area, Qt);
2727 }
2728
2729 /* Call the input method. */
2730 tem = call1 (Vinput_method_function, c);
2731
2732 tem = unbind_to (count, tem);
2733
2734 /* Restore the saved echoing state
2735 and this_command_keys state. */
2736 this_command_key_count = key_count;
2737 if (key_count > 0)
2738 this_command_keys = keys;
2739
2740 cancel_echoing ();
2741 ok_to_echo_at_next_pause = saved_ok_to_echo;
2742 current_kboard->echo_after_prompt = saved_echo_after_prompt;
2743 if (saved_immediate_echo)
2744 echo_now ();
2745
2746 UNGCPRO;
2747
2748 /* The input method can return no events. */
2749 if (! CONSP (tem))
2750 {
2751 /* Bring back the previous message, if any. */
2752 if (! NILP (previous_echo_area_message))
2753 message_with_string ("%s", previous_echo_area_message, 0);
2754 goto retry;
2755 }
2756 /* It returned one event or more. */
2757 c = XCAR (tem);
2758 Vunread_post_input_method_events
2759 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
2760 }
2761
2762 reread_first:
2763
2764 /* Display help if not echoing. */
2765 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
2766 {
2767 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
2768 Lisp_Object help, object, position, window;
2769 help = Fnth (make_number (2), c);
2770 window = Fnth (make_number (3), c);
2771 object = Fnth (make_number (4), c);
2772 position = Fnth (make_number (5), c);
2773 show_help_echo (help, window, object, position, 0);
2774 goto retry;
2775 }
2776
2777 if (this_command_key_count == 0 || ! reread)
2778 {
2779 before_command_key_count = this_command_key_count;
2780 before_command_echo_length = echo_length ();
2781
2782 /* Don't echo mouse motion events. */
2783 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2784 && NILP (Fzerop (Vecho_keystrokes))
2785 && ! (EVENT_HAS_PARAMETERS (c)
2786 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
2787 {
2788 echo_char (c);
2789 if (! NILP (also_record))
2790 echo_char (also_record);
2791 /* Once we reread a character, echoing can happen
2792 the next time we pause to read a new one. */
2793 ok_to_echo_at_next_pause = current_kboard;
2794 }
2795
2796 /* Record this character as part of the current key. */
2797 add_command_key (c);
2798 if (! NILP (also_record))
2799 add_command_key (also_record);
2800 }
2801
2802 last_input_char = c;
2803 num_input_events++;
2804
2805 /* Process the help character specially if enabled */
2806 if (!NILP (Vhelp_form) && help_char_p (c))
2807 {
2808 Lisp_Object tem0;
2809 count = specpdl_ptr - specpdl;
2810
2811 record_unwind_protect (Fset_window_configuration,
2812 Fcurrent_window_configuration (Qnil));
2813
2814 tem0 = Feval (Vhelp_form);
2815 if (STRINGP (tem0))
2816 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
2817
2818 cancel_echoing ();
2819 do
2820 c = read_char (0, 0, 0, Qnil, 0);
2821 while (BUFFERP (c));
2822 /* Remove the help from the frame */
2823 unbind_to (count, Qnil);
2824
2825 redisplay ();
2826 if (EQ (c, make_number (040)))
2827 {
2828 cancel_echoing ();
2829 do
2830 c = read_char (0, 0, 0, Qnil, 0);
2831 while (BUFFERP (c));
2832 }
2833 }
2834
2835 RETURN_UNGCPRO (c);
2836 }
2837
2838 /* Record a key that came from a mouse menu.
2839 Record it for echoing, for this-command-keys, and so on. */
2840
2841 static void
2842 record_menu_key (c)
2843 Lisp_Object c;
2844 {
2845 /* Wipe the echo area. */
2846 clear_message (1, 0);
2847
2848 record_char (c);
2849
2850 before_command_key_count = this_command_key_count;
2851 before_command_echo_length = echo_length ();
2852
2853 /* Don't echo mouse motion events. */
2854 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2855 && NILP (Fzerop (Vecho_keystrokes)))
2856 {
2857 echo_char (c);
2858
2859 /* Once we reread a character, echoing can happen
2860 the next time we pause to read a new one. */
2861 ok_to_echo_at_next_pause = 0;
2862 }
2863
2864 /* Record this character as part of the current key. */
2865 add_command_key (c);
2866
2867 /* Re-reading in the middle of a command */
2868 last_input_char = c;
2869 num_input_events++;
2870 }
2871
2872 /* Return 1 if should recognize C as "the help character". */
2873
2874 int
2875 help_char_p (c)
2876 Lisp_Object c;
2877 {
2878 Lisp_Object tail;
2879
2880 if (EQ (c, Vhelp_char))
2881 return 1;
2882 for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
2883 if (EQ (c, XCAR (tail)))
2884 return 1;
2885 return 0;
2886 }
2887
2888 /* Record the input event C in various ways. */
2889
2890 static void
2891 record_char (c)
2892 Lisp_Object c;
2893 {
2894 Lisp_Object help;
2895
2896 /* Don't record `help-echo' in recent_keys unless it shows some help
2897 message, and a different help than the previoiusly recorded
2898 event. */
2899 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
2900 {
2901 Lisp_Object help;
2902
2903 help = Fnth (make_number (2), c);
2904 if (STRINGP (help))
2905 {
2906 int last_idx;
2907 Lisp_Object last_c, last_help;
2908
2909 last_idx = recent_keys_index - 1;
2910 if (last_idx < 0)
2911 last_idx = NUM_RECENT_KEYS - 1;
2912 last_c = AREF (recent_keys, last_idx);
2913
2914 if (!CONSP (last_c)
2915 || !EQ (XCAR (last_c), Qhelp_echo)
2916 || (last_help = Fnth (make_number (2), last_c),
2917 !EQ (last_help, help)))
2918 {
2919 total_keys++;
2920 ASET (recent_keys, recent_keys_index, c);
2921 if (++recent_keys_index >= NUM_RECENT_KEYS)
2922 recent_keys_index = 0;
2923 }
2924 }
2925 }
2926 else
2927 {
2928 total_keys++;
2929 ASET (recent_keys, recent_keys_index, c);
2930 if (++recent_keys_index >= NUM_RECENT_KEYS)
2931 recent_keys_index = 0;
2932 }
2933
2934 /* Write c to the dribble file. If c is a lispy event, write
2935 the event's symbol to the dribble file, in <brackets>. Bleaugh.
2936 If you, dear reader, have a better idea, you've got the source. :-) */
2937 if (dribble)
2938 {
2939 if (INTEGERP (c))
2940 {
2941 if (XUINT (c) < 0x100)
2942 putc (XINT (c), dribble);
2943 else
2944 fprintf (dribble, " 0x%x", (int) XUINT (c));
2945 }
2946 else
2947 {
2948 Lisp_Object dribblee;
2949
2950 /* If it's a structured event, take the event header. */
2951 dribblee = EVENT_HEAD (c);
2952
2953 if (SYMBOLP (dribblee))
2954 {
2955 putc ('<', dribble);
2956 fwrite (XSYMBOL (dribblee)->name->data, sizeof (char),
2957 STRING_BYTES (XSYMBOL (dribblee)->name),
2958 dribble);
2959 putc ('>', dribble);
2960 }
2961 }
2962
2963 fflush (dribble);
2964 }
2965
2966 if (!CONSP (c) || !EQ (Qhelp_echo, XCAR (c)))
2967 store_kbd_macro_char (c);
2968
2969 num_nonmacro_input_events++;
2970 }
2971
2972 Lisp_Object
2973 print_help (object)
2974 Lisp_Object object;
2975 {
2976 struct buffer *old = current_buffer;
2977 Fprinc (object, Qnil);
2978 set_buffer_internal (XBUFFER (Vstandard_output));
2979 call0 (intern ("help-mode"));
2980 set_buffer_internal (old);
2981 return Qnil;
2982 }
2983
2984 /* Copy out or in the info on where C-g should throw to.
2985 This is used when running Lisp code from within get_char,
2986 in case get_char is called recursively.
2987 See read_process_output. */
2988
2989 static void
2990 save_getcjmp (temp)
2991 jmp_buf temp;
2992 {
2993 bcopy (getcjmp, temp, sizeof getcjmp);
2994 }
2995
2996 static void
2997 restore_getcjmp (temp)
2998 jmp_buf temp;
2999 {
3000 bcopy (temp, getcjmp, sizeof getcjmp);
3001 }
3002 \f
3003 #ifdef HAVE_MOUSE
3004
3005 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
3006 of this function. */
3007
3008 static Lisp_Object
3009 tracking_off (old_value)
3010 Lisp_Object old_value;
3011 {
3012 do_mouse_tracking = old_value;
3013 if (NILP (old_value))
3014 {
3015 /* Redisplay may have been preempted because there was input
3016 available, and it assumes it will be called again after the
3017 input has been processed. If the only input available was
3018 the sort that we have just disabled, then we need to call
3019 redisplay. */
3020 if (!readable_events (1))
3021 {
3022 redisplay_preserve_echo_area ();
3023 get_input_pending (&input_pending, 1);
3024 }
3025 }
3026 return Qnil;
3027 }
3028
3029 DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
3030 "Evaluate BODY with mouse movement events enabled.\n\
3031 Within a `track-mouse' form, mouse motion generates input events that\n\
3032 you can read with `read-event'.\n\
3033 Normally, mouse motion is ignored.")
3034 (args)
3035 Lisp_Object args;
3036 {
3037 int count = specpdl_ptr - specpdl;
3038 Lisp_Object val;
3039
3040 record_unwind_protect (tracking_off, do_mouse_tracking);
3041
3042 do_mouse_tracking = Qt;
3043
3044 val = Fprogn (args);
3045 return unbind_to (count, val);
3046 }
3047
3048 /* If mouse has moved on some frame, return one of those frames.
3049 Return 0 otherwise. */
3050
3051 static FRAME_PTR
3052 some_mouse_moved ()
3053 {
3054 Lisp_Object tail, frame;
3055
3056 FOR_EACH_FRAME (tail, frame)
3057 {
3058 if (XFRAME (frame)->mouse_moved)
3059 return XFRAME (frame);
3060 }
3061
3062 return 0;
3063 }
3064
3065 #endif /* HAVE_MOUSE */
3066 \f
3067 /* Low level keyboard/mouse input.
3068 kbd_buffer_store_event places events in kbd_buffer, and
3069 kbd_buffer_get_event retrieves them. */
3070
3071 /* Return true iff there are any events in the queue that read-char
3072 would return. If this returns false, a read-char would block. */
3073 static int
3074 readable_events (do_timers_now)
3075 int do_timers_now;
3076 {
3077 if (do_timers_now)
3078 timer_check (do_timers_now);
3079
3080 if (kbd_fetch_ptr != kbd_store_ptr)
3081 return 1;
3082 #ifdef HAVE_MOUSE
3083 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3084 return 1;
3085 #endif
3086 if (single_kboard)
3087 {
3088 if (current_kboard->kbd_queue_has_data)
3089 return 1;
3090 }
3091 else
3092 {
3093 KBOARD *kb;
3094 for (kb = all_kboards; kb; kb = kb->next_kboard)
3095 if (kb->kbd_queue_has_data)
3096 return 1;
3097 }
3098 return 0;
3099 }
3100
3101 /* Set this for debugging, to have a way to get out */
3102 int stop_character;
3103
3104 #ifdef MULTI_KBOARD
3105 static KBOARD *
3106 event_to_kboard (event)
3107 struct input_event *event;
3108 {
3109 Lisp_Object frame;
3110 frame = event->frame_or_window;
3111 if (CONSP (frame))
3112 frame = XCAR (frame);
3113 else if (WINDOWP (frame))
3114 frame = WINDOW_FRAME (XWINDOW (frame));
3115
3116 /* There are still some events that don't set this field.
3117 For now, just ignore the problem.
3118 Also ignore dead frames here. */
3119 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
3120 return 0;
3121 else
3122 return FRAME_KBOARD (XFRAME (frame));
3123 }
3124 #endif
3125
3126 /* Store an event obtained at interrupt level into kbd_buffer, fifo */
3127
3128 void
3129 kbd_buffer_store_event (event)
3130 register struct input_event *event;
3131 {
3132 if (event->kind == no_event)
3133 abort ();
3134
3135 if (event->kind == ascii_keystroke)
3136 {
3137 register int c = event->code & 0377;
3138
3139 if (event->modifiers & ctrl_modifier)
3140 c = make_ctrl_char (c);
3141
3142 c |= (event->modifiers
3143 & (meta_modifier | alt_modifier
3144 | hyper_modifier | super_modifier));
3145
3146 if (c == quit_char)
3147 {
3148 extern SIGTYPE interrupt_signal ();
3149 #ifdef MULTI_KBOARD
3150 KBOARD *kb;
3151 struct input_event *sp;
3152
3153 if (single_kboard
3154 && (kb = FRAME_KBOARD (XFRAME (event->frame_or_window)),
3155 kb != current_kboard))
3156 {
3157 kb->kbd_queue
3158 = Fcons (make_lispy_switch_frame (event->frame_or_window),
3159 Fcons (make_number (c), Qnil));
3160 kb->kbd_queue_has_data = 1;
3161 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3162 {
3163 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3164 sp = kbd_buffer;
3165
3166 if (event_to_kboard (sp) == kb)
3167 {
3168 sp->kind = no_event;
3169 sp->frame_or_window = Qnil;
3170 sp->arg = Qnil;
3171 }
3172 }
3173 return;
3174 }
3175 #endif
3176
3177 /* If this results in a quit_char being returned to Emacs as
3178 input, set Vlast_event_frame properly. If this doesn't
3179 get returned to Emacs as an event, the next event read
3180 will set Vlast_event_frame again, so this is safe to do. */
3181 {
3182 Lisp_Object focus;
3183
3184 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
3185 if (NILP (focus))
3186 focus = event->frame_or_window;
3187 internal_last_event_frame = focus;
3188 Vlast_event_frame = focus;
3189 }
3190
3191 last_event_timestamp = event->timestamp;
3192 interrupt_signal ();
3193 return;
3194 }
3195
3196 if (c && c == stop_character)
3197 {
3198 sys_suspend ();
3199 return;
3200 }
3201 }
3202 /* Don't insert two buffer_switch_event's in a row.
3203 Just ignore the second one. */
3204 else if (event->kind == buffer_switch_event
3205 && kbd_fetch_ptr != kbd_store_ptr
3206 && kbd_store_ptr->kind == buffer_switch_event)
3207 return;
3208
3209 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
3210 kbd_store_ptr = kbd_buffer;
3211
3212 /* Don't let the very last slot in the buffer become full,
3213 since that would make the two pointers equal,
3214 and that is indistinguishable from an empty buffer.
3215 Discard the event if it would fill the last slot. */
3216 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3217 {
3218 int idx;
3219
3220 #if 0 /* The selection_request_event case looks bogus, and it's error
3221 prone to assign individual members for other events, in case
3222 the input_event structure is changed. --2000-07-13, gerd. */
3223 struct input_event *sp = kbd_store_ptr;
3224 sp->kind = event->kind;
3225 if (event->kind == selection_request_event)
3226 {
3227 /* We must not use the ordinary copying code for this case,
3228 since `part' is an enum and copying it might not copy enough
3229 in this case. */
3230 bcopy (event, (char *) sp, sizeof (*event));
3231 }
3232 else
3233
3234 {
3235 sp->code = event->code;
3236 sp->part = event->part;
3237 sp->frame_or_window = event->frame_or_window;
3238 sp->arg = event->arg;
3239 sp->modifiers = event->modifiers;
3240 sp->x = event->x;
3241 sp->y = event->y;
3242 sp->timestamp = event->timestamp;
3243 }
3244 #else
3245 *kbd_store_ptr = *event;
3246 #endif
3247
3248 idx = 2 * (kbd_store_ptr - kbd_buffer);
3249 ASET (kbd_buffer_gcpro, idx, event->frame_or_window);
3250 ASET (kbd_buffer_gcpro, idx + 1, event->arg);
3251 ++kbd_store_ptr;
3252 }
3253 }
3254
3255
3256 /* Generate HELP_EVENT input_events in BUFP which has room for
3257 SIZE events. If there's not enough room in BUFP, ignore this
3258 event.
3259
3260 HELP is the help form.
3261
3262 FRAME is the frame on which the help is generated. OBJECT is the
3263 Lisp object where the help was found (a buffer, a string, an
3264 overlay, or nil if neither from a string nor from a buffer. POS is
3265 the position within OBJECT where the help was found.
3266
3267 Value is the number of input_events generated. */
3268
3269 int
3270 gen_help_event (bufp, size, help, frame, window, object, pos)
3271 struct input_event *bufp;
3272 int size;
3273 Lisp_Object help, frame, object, window;
3274 int pos;
3275 {
3276 int nevents_stored = 0;
3277
3278 if (size >= 2)
3279 {
3280 bufp->kind = HELP_EVENT;
3281 bufp->frame_or_window = frame;
3282 bufp->arg = object;
3283 bufp->x = make_number (pos);
3284 bufp->code = 0;
3285
3286 ++bufp;
3287 bufp->kind = HELP_EVENT;
3288 bufp->frame_or_window = WINDOWP (window) ? window : frame;
3289 bufp->arg = help;
3290 bufp->code = 1;
3291 nevents_stored = 2;
3292 }
3293
3294 return nevents_stored;
3295 }
3296
3297
3298 /* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3299
3300 void
3301 kbd_buffer_store_help_event (frame, help)
3302 Lisp_Object frame, help;
3303 {
3304 struct input_event event;
3305
3306 event.kind = HELP_EVENT;
3307 event.frame_or_window = frame;
3308 event.arg = Qnil;
3309 event.x = make_number (0);
3310 event.code = 0;
3311 kbd_buffer_store_event (&event);
3312
3313 event.kind = HELP_EVENT;
3314 event.frame_or_window = frame;
3315 event.arg = help;
3316 event.x = make_number (0);
3317 event.code = 1;
3318 kbd_buffer_store_event (&event);
3319 }
3320
3321 \f
3322 /* Discard any mouse events in the event buffer by setting them to
3323 no_event. */
3324 void
3325 discard_mouse_events ()
3326 {
3327 struct input_event *sp;
3328 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3329 {
3330 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3331 sp = kbd_buffer;
3332
3333 if (sp->kind == mouse_click
3334 #ifdef WINDOWSNT
3335 || sp->kind == w32_scroll_bar_click
3336 #endif
3337 || sp->kind == scroll_bar_click)
3338 {
3339 sp->kind = no_event;
3340 }
3341 }
3342 }
3343
3344
3345 /* Return non-zero if there are any real events waiting in the event
3346 buffer, not counting `no_event's.
3347
3348 If DISCARD is non-zero, discard no_event events at the front of
3349 the input queue, possibly leaving the input queue empty if there
3350 are no real input events. */
3351
3352 int
3353 kbd_buffer_events_waiting (discard)
3354 int discard;
3355 {
3356 struct input_event *sp;
3357
3358 for (sp = kbd_fetch_ptr;
3359 sp != kbd_store_ptr && sp->kind == no_event;
3360 ++sp)
3361 {
3362 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3363 sp = kbd_buffer;
3364 }
3365
3366 if (discard)
3367 kbd_fetch_ptr = sp;
3368
3369 return sp != kbd_store_ptr && sp->kind != no_event;
3370 }
3371
3372 \f
3373 /* Clear input event EVENT. */
3374
3375 static INLINE void
3376 clear_event (event)
3377 struct input_event *event;
3378 {
3379 int idx = 2 * (event - kbd_buffer);
3380 ASET (kbd_buffer_gcpro, idx, Qnil);
3381 ASET (kbd_buffer_gcpro, idx + 1, Qnil);
3382 event->kind = no_event;
3383 }
3384
3385
3386 /* Read one event from the event buffer, waiting if necessary.
3387 The value is a Lisp object representing the event.
3388 The value is nil for an event that should be ignored,
3389 or that was handled here.
3390 We always read and discard one event. */
3391
3392 static Lisp_Object
3393 kbd_buffer_get_event (kbp, used_mouse_menu)
3394 KBOARD **kbp;
3395 int *used_mouse_menu;
3396 {
3397 register int c;
3398 Lisp_Object obj;
3399
3400 if (noninteractive)
3401 {
3402 c = getchar ();
3403 XSETINT (obj, c);
3404 *kbp = current_kboard;
3405 return obj;
3406 }
3407
3408 /* Wait until there is input available. */
3409 for (;;)
3410 {
3411 if (kbd_fetch_ptr != kbd_store_ptr)
3412 break;
3413 #ifdef HAVE_MOUSE
3414 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3415 break;
3416 #endif
3417
3418 /* If the quit flag is set, then read_char will return
3419 quit_char, so that counts as "available input." */
3420 if (!NILP (Vquit_flag))
3421 quit_throw_to_read_char ();
3422
3423 /* One way or another, wait until input is available; then, if
3424 interrupt handlers have not read it, read it now. */
3425
3426 #ifdef OLDVMS
3427 wait_for_kbd_input ();
3428 #else
3429 /* Note SIGIO has been undef'd if FIONREAD is missing. */
3430 #ifdef SIGIO
3431 gobble_input (0);
3432 #endif /* SIGIO */
3433 if (kbd_fetch_ptr != kbd_store_ptr)
3434 break;
3435 #ifdef HAVE_MOUSE
3436 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3437 break;
3438 #endif
3439 {
3440 Lisp_Object minus_one;
3441
3442 XSETINT (minus_one, -1);
3443 wait_reading_process_input (0, 0, minus_one, 1);
3444
3445 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
3446 /* Pass 1 for EXPECT since we just waited to have input. */
3447 read_avail_input (1);
3448 }
3449 #endif /* not VMS */
3450 }
3451
3452 if (CONSP (Vunread_command_events))
3453 {
3454 Lisp_Object first;
3455 first = XCAR (Vunread_command_events);
3456 Vunread_command_events = XCDR (Vunread_command_events);
3457 *kbp = current_kboard;
3458 return first;
3459 }
3460
3461 /* At this point, we know that there is a readable event available
3462 somewhere. If the event queue is empty, then there must be a
3463 mouse movement enabled and available. */
3464 if (kbd_fetch_ptr != kbd_store_ptr)
3465 {
3466 struct input_event *event;
3467
3468 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3469 ? kbd_fetch_ptr
3470 : kbd_buffer);
3471
3472 last_event_timestamp = event->timestamp;
3473
3474 #ifdef MULTI_KBOARD
3475 *kbp = event_to_kboard (event);
3476 if (*kbp == 0)
3477 *kbp = current_kboard; /* Better than returning null ptr? */
3478 #else
3479 *kbp = &the_only_kboard;
3480 #endif
3481
3482 obj = Qnil;
3483
3484 /* These two kinds of events get special handling
3485 and don't actually appear to the command loop.
3486 We return nil for them. */
3487 if (event->kind == selection_request_event)
3488 {
3489 #ifdef HAVE_X11
3490 struct input_event copy;
3491
3492 /* Remove it from the buffer before processing it,
3493 since otherwise swallow_events will see it
3494 and process it again. */
3495 copy = *event;
3496 kbd_fetch_ptr = event + 1;
3497 input_pending = readable_events (0);
3498 x_handle_selection_request (&copy);
3499 #else
3500 /* We're getting selection request events, but we don't have
3501 a window system. */
3502 abort ();
3503 #endif
3504 }
3505
3506 else if (event->kind == selection_clear_event)
3507 {
3508 #ifdef HAVE_X11
3509 struct input_event copy;
3510
3511 /* Remove it from the buffer before processing it. */
3512 copy = *event;
3513 kbd_fetch_ptr = event + 1;
3514 input_pending = readable_events (0);
3515 x_handle_selection_clear (&copy);
3516 #else
3517 /* We're getting selection request events, but we don't have
3518 a window system. */
3519 abort ();
3520 #endif
3521 }
3522 #if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (macintosh)
3523 else if (event->kind == delete_window_event)
3524 {
3525 /* Make an event (delete-frame (FRAME)). */
3526 obj = Fcons (event->frame_or_window, Qnil);
3527 obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
3528 kbd_fetch_ptr = event + 1;
3529 }
3530 #endif
3531 #if defined (HAVE_X11) || defined (HAVE_NTGUI)
3532 else if (event->kind == iconify_event)
3533 {
3534 /* Make an event (iconify-frame (FRAME)). */
3535 obj = Fcons (event->frame_or_window, Qnil);
3536 obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
3537 kbd_fetch_ptr = event + 1;
3538 }
3539 else if (event->kind == deiconify_event)
3540 {
3541 /* Make an event (make-frame-visible (FRAME)). */
3542 obj = Fcons (event->frame_or_window, Qnil);
3543 obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
3544 kbd_fetch_ptr = event + 1;
3545 }
3546 #endif
3547 else if (event->kind == buffer_switch_event)
3548 {
3549 /* The value doesn't matter here; only the type is tested. */
3550 XSETBUFFER (obj, current_buffer);
3551 kbd_fetch_ptr = event + 1;
3552 }
3553 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
3554 else if (event->kind == menu_bar_activate_event)
3555 {
3556 kbd_fetch_ptr = event + 1;
3557 input_pending = readable_events (0);
3558 if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
3559 x_activate_menubar (XFRAME (event->frame_or_window));
3560 }
3561 #endif
3562 #ifdef WINDOWSNT
3563 else if (event->kind == language_change_event)
3564 {
3565 /* Make an event (language-change (FRAME CHARSET LCID)). */
3566 obj = Fcons (event->modifiers, Qnil);
3567 obj = Fcons (event->code, Qnil);
3568 obj = Fcons (event->frame_or_window, obj);
3569 obj = Fcons (Qlanguage_change, Fcons (obj, Qnil));
3570 kbd_fetch_ptr = event + 1;
3571 }
3572 #endif
3573 /* Just discard these, by returning nil.
3574 With MULTI_KBOARD, these events are used as placeholders
3575 when we need to randomly delete events from the queue.
3576 (They shouldn't otherwise be found in the buffer,
3577 but on some machines it appears they do show up
3578 even without MULTI_KBOARD.) */
3579 /* On Windows NT/9X, no_event is used to delete extraneous
3580 mouse events during a popup-menu call. */
3581 else if (event->kind == no_event)
3582 kbd_fetch_ptr = event + 1;
3583 else if (event->kind == HELP_EVENT)
3584 {
3585 /* There are always two HELP_EVENTs in the input queue. */
3586 Lisp_Object object, position, help, frame, window;
3587
3588 xassert (event->code == 0);
3589 frame = event->frame_or_window;
3590 object = event->arg;
3591 position = event->x;
3592 clear_event (event);
3593
3594 kbd_fetch_ptr = event + 1;
3595 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3596 ? kbd_fetch_ptr
3597 : kbd_buffer);
3598 xassert (event->code == 1);
3599 help = event->arg;
3600 window = event->frame_or_window;
3601 if (!WINDOWP (window))
3602 window = Qnil;
3603 obj = Fcons (Qhelp_echo,
3604 list5 (frame, help, window, object, position));
3605 clear_event (event);
3606 kbd_fetch_ptr = event + 1;
3607 }
3608 else if (event->kind == FOCUS_IN_EVENT)
3609 {
3610 /* Notification of a FocusIn event. The frame receiving the
3611 focus is in event->frame_or_window. Generate a
3612 switch-frame event if necessary. */
3613 Lisp_Object frame, focus;
3614
3615 frame = event->frame_or_window;
3616 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
3617 if (FRAMEP (focus))
3618 frame = focus;
3619
3620 if (!EQ (frame, internal_last_event_frame)
3621 && !EQ (frame, selected_frame))
3622 obj = make_lispy_switch_frame (frame);
3623 internal_last_event_frame = frame;
3624 kbd_fetch_ptr = event + 1;
3625 }
3626 else
3627 {
3628 /* If this event is on a different frame, return a switch-frame this
3629 time, and leave the event in the queue for next time. */
3630 Lisp_Object frame;
3631 Lisp_Object focus;
3632
3633 frame = event->frame_or_window;
3634 if (CONSP (frame))
3635 frame = XCAR (frame);
3636 else if (WINDOWP (frame))
3637 frame = WINDOW_FRAME (XWINDOW (frame));
3638
3639 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
3640 if (! NILP (focus))
3641 frame = focus;
3642
3643 if (! EQ (frame, internal_last_event_frame)
3644 && !EQ (frame, selected_frame))
3645 obj = make_lispy_switch_frame (frame);
3646 internal_last_event_frame = frame;
3647
3648 /* If we didn't decide to make a switch-frame event, go ahead
3649 and build a real event from the queue entry. */
3650
3651 if (NILP (obj))
3652 {
3653 int idx;
3654
3655 obj = make_lispy_event (event);
3656
3657 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI)
3658 /* If this was a menu selection, then set the flag to inhibit
3659 writing to last_nonmenu_event. Don't do this if the event
3660 we're returning is (menu-bar), though; that indicates the
3661 beginning of the menu sequence, and we might as well leave
3662 that as the `event with parameters' for this selection. */
3663 if (used_mouse_menu
3664 && !EQ (event->frame_or_window, event->arg)
3665 && (event->kind == MENU_BAR_EVENT
3666 || event->kind == TOOL_BAR_EVENT))
3667 *used_mouse_menu = 1;
3668 #endif
3669
3670 /* Wipe out this event, to catch bugs. */
3671 clear_event (event);
3672 kbd_fetch_ptr = event + 1;
3673 }
3674 }
3675 }
3676 #ifdef HAVE_MOUSE
3677 /* Try generating a mouse motion event. */
3678 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3679 {
3680 FRAME_PTR f = some_mouse_moved ();
3681 Lisp_Object bar_window;
3682 enum scroll_bar_part part;
3683 Lisp_Object x, y;
3684 unsigned long time;
3685
3686 *kbp = current_kboard;
3687 /* Note that this uses F to determine which display to look at.
3688 If there is no valid info, it does not store anything
3689 so x remains nil. */
3690 x = Qnil;
3691 (*mouse_position_hook) (&f, 0, &bar_window, &part, &x, &y, &time);
3692
3693 obj = Qnil;
3694
3695 /* Decide if we should generate a switch-frame event. Don't
3696 generate switch-frame events for motion outside of all Emacs
3697 frames. */
3698 if (!NILP (x) && f)
3699 {
3700 Lisp_Object frame;
3701
3702 frame = FRAME_FOCUS_FRAME (f);
3703 if (NILP (frame))
3704 XSETFRAME (frame, f);
3705
3706 if (! EQ (frame, internal_last_event_frame)
3707 && !EQ (frame, selected_frame))
3708 obj = make_lispy_switch_frame (frame);
3709 internal_last_event_frame = frame;
3710 }
3711
3712 /* If we didn't decide to make a switch-frame event, go ahead and
3713 return a mouse-motion event. */
3714 if (!NILP (x) && NILP (obj))
3715 obj = make_lispy_movement (f, bar_window, part, x, y, time);
3716 }
3717 #endif /* HAVE_MOUSE */
3718 else
3719 /* We were promised by the above while loop that there was
3720 something for us to read! */
3721 abort ();
3722
3723 input_pending = readable_events (0);
3724
3725 Vlast_event_frame = internal_last_event_frame;
3726
3727 return (obj);
3728 }
3729 \f
3730 /* Process any events that are not user-visible,
3731 then return, without reading any user-visible events. */
3732
3733 void
3734 swallow_events (do_display)
3735 int do_display;
3736 {
3737 int old_timers_run;
3738
3739 while (kbd_fetch_ptr != kbd_store_ptr)
3740 {
3741 struct input_event *event;
3742
3743 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3744 ? kbd_fetch_ptr
3745 : kbd_buffer);
3746
3747 last_event_timestamp = event->timestamp;
3748
3749 /* These two kinds of events get special handling
3750 and don't actually appear to the command loop. */
3751 if (event->kind == selection_request_event)
3752 {
3753 #ifdef HAVE_X11
3754 struct input_event copy;
3755
3756 /* Remove it from the buffer before processing it,
3757 since otherwise swallow_events called recursively could see it
3758 and process it again. */
3759 copy = *event;
3760 kbd_fetch_ptr = event + 1;
3761 input_pending = readable_events (0);
3762 x_handle_selection_request (&copy);
3763 #else
3764 /* We're getting selection request events, but we don't have
3765 a window system. */
3766 abort ();
3767 #endif
3768 }
3769
3770 else if (event->kind == selection_clear_event)
3771 {
3772 #ifdef HAVE_X11
3773 struct input_event copy;
3774
3775 /* Remove it from the buffer before processing it, */
3776 copy = *event;
3777
3778 kbd_fetch_ptr = event + 1;
3779 input_pending = readable_events (0);
3780 x_handle_selection_clear (&copy);
3781 #else
3782 /* We're getting selection request events, but we don't have
3783 a window system. */
3784 abort ();
3785 #endif
3786 }
3787 else
3788 break;
3789 }
3790
3791 old_timers_run = timers_run;
3792 get_input_pending (&input_pending, 1);
3793
3794 if (timers_run != old_timers_run && do_display)
3795 redisplay_preserve_echo_area ();
3796 }
3797 \f
3798 static EMACS_TIME timer_idleness_start_time;
3799
3800 /* Record the start of when Emacs is idle,
3801 for the sake of running idle-time timers. */
3802
3803 void
3804 timer_start_idle ()
3805 {
3806 Lisp_Object timers;
3807
3808 /* If we are already in the idle state, do nothing. */
3809 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3810 return;
3811
3812 EMACS_GET_TIME (timer_idleness_start_time);
3813
3814 /* Mark all idle-time timers as once again candidates for running. */
3815 for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers))
3816 {
3817 Lisp_Object timer;
3818
3819 timer = XCAR (timers);
3820
3821 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3822 continue;
3823 XVECTOR (timer)->contents[0] = Qnil;
3824 }
3825 }
3826
3827 /* Record that Emacs is no longer idle, so stop running idle-time timers. */
3828
3829 void
3830 timer_stop_idle ()
3831 {
3832 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
3833 }
3834
3835 /* This is only for debugging. */
3836 struct input_event last_timer_event;
3837
3838 /* Check whether a timer has fired. To prevent larger problems we simply
3839 disregard elements that are not proper timers. Do not make a circular
3840 timer list for the time being.
3841
3842 Returns the number of seconds to wait until the next timer fires. If a
3843 timer is triggering now, return zero seconds.
3844 If no timer is active, return -1 seconds.
3845
3846 If a timer is ripe, we run it, with quitting turned off.
3847
3848 DO_IT_NOW is now ignored. It used to mean that we should
3849 run the timer directly instead of queueing a timer-event.
3850 Now we always run timers directly. */
3851
3852 EMACS_TIME
3853 timer_check (do_it_now)
3854 int do_it_now;
3855 {
3856 EMACS_TIME nexttime;
3857 EMACS_TIME now, idleness_now;
3858 Lisp_Object timers, idle_timers, chosen_timer;
3859 struct gcpro gcpro1, gcpro2, gcpro3;
3860
3861 EMACS_SET_SECS (nexttime, -1);
3862 EMACS_SET_USECS (nexttime, -1);
3863
3864 /* Always consider the ordinary timers. */
3865 timers = Vtimer_list;
3866 /* Consider the idle timers only if Emacs is idle. */
3867 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3868 idle_timers = Vtimer_idle_list;
3869 else
3870 idle_timers = Qnil;
3871 chosen_timer = Qnil;
3872 GCPRO3 (timers, idle_timers, chosen_timer);
3873
3874 if (CONSP (timers) || CONSP (idle_timers))
3875 {
3876 EMACS_GET_TIME (now);
3877 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
3878 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
3879 }
3880
3881 while (CONSP (timers) || CONSP (idle_timers))
3882 {
3883 Lisp_Object *vector;
3884 Lisp_Object timer = Qnil, idle_timer = Qnil;
3885 EMACS_TIME timer_time, idle_timer_time;
3886 EMACS_TIME difference, timer_difference, idle_timer_difference;
3887
3888 /* Skip past invalid timers and timers already handled. */
3889 if (!NILP (timers))
3890 {
3891 timer = XCAR (timers);
3892 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3893 {
3894 timers = XCDR (timers);
3895 continue;
3896 }
3897 vector = XVECTOR (timer)->contents;
3898
3899 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
3900 || !INTEGERP (vector[3])
3901 || ! NILP (vector[0]))
3902 {
3903 timers = XCDR (timers);
3904 continue;
3905 }
3906 }
3907 if (!NILP (idle_timers))
3908 {
3909 timer = XCAR (idle_timers);
3910 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3911 {
3912 idle_timers = XCDR (idle_timers);
3913 continue;
3914 }
3915 vector = XVECTOR (timer)->contents;
3916
3917 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
3918 || !INTEGERP (vector[3])
3919 || ! NILP (vector[0]))
3920 {
3921 idle_timers = XCDR (idle_timers);
3922 continue;
3923 }
3924 }
3925
3926 /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
3927 based on the next ordinary timer.
3928 TIMER_DIFFERENCE is the distance in time from NOW to when
3929 this timer becomes ripe (negative if it's already ripe). */
3930 if (!NILP (timers))
3931 {
3932 timer = XCAR (timers);
3933 vector = XVECTOR (timer)->contents;
3934 EMACS_SET_SECS (timer_time,
3935 (XINT (vector[1]) << 16) | (XINT (vector[2])));
3936 EMACS_SET_USECS (timer_time, XINT (vector[3]));
3937 EMACS_SUB_TIME (timer_difference, timer_time, now);
3938 }
3939
3940 /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
3941 based on the next idle timer. */
3942 if (!NILP (idle_timers))
3943 {
3944 idle_timer = XCAR (idle_timers);
3945 vector = XVECTOR (idle_timer)->contents;
3946 EMACS_SET_SECS (idle_timer_time,
3947 (XINT (vector[1]) << 16) | (XINT (vector[2])));
3948 EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
3949 EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
3950 }
3951
3952 /* Decide which timer is the next timer,
3953 and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
3954 Also step down the list where we found that timer. */
3955
3956 if (! NILP (timers) && ! NILP (idle_timers))
3957 {
3958 EMACS_TIME temp;
3959 EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
3960 if (EMACS_TIME_NEG_P (temp))
3961 {
3962 chosen_timer = timer;
3963 timers = XCDR (timers);
3964 difference = timer_difference;
3965 }
3966 else
3967 {
3968 chosen_timer = idle_timer;
3969 idle_timers = XCDR (idle_timers);
3970 difference = idle_timer_difference;
3971 }
3972 }
3973 else if (! NILP (timers))
3974 {
3975 chosen_timer = timer;
3976 timers = XCDR (timers);
3977 difference = timer_difference;
3978 }
3979 else
3980 {
3981 chosen_timer = idle_timer;
3982 idle_timers = XCDR (idle_timers);
3983 difference = idle_timer_difference;
3984 }
3985 vector = XVECTOR (chosen_timer)->contents;
3986
3987 /* If timer is ripe, run it if it hasn't been run. */
3988 if (EMACS_TIME_NEG_P (difference)
3989 || (EMACS_SECS (difference) == 0
3990 && EMACS_USECS (difference) == 0))
3991 {
3992 if (NILP (vector[0]))
3993 {
3994 int was_locked = single_kboard;
3995 int count = specpdl_ptr - specpdl;
3996
3997 /* Mark the timer as triggered to prevent problems if the lisp
3998 code fails to reschedule it right. */
3999 vector[0] = Qt;
4000
4001 specbind (Qinhibit_quit, Qt);
4002
4003 call1 (Qtimer_event_handler, chosen_timer);
4004 timers_run++;
4005
4006 unbind_to (count, Qnil);
4007
4008 /* Resume allowing input from any kboard, if that was true before. */
4009 if (!was_locked)
4010 any_kboard_state ();
4011
4012 /* Since we have handled the event,
4013 we don't need to tell the caller to wake up and do it. */
4014 }
4015 }
4016 else
4017 /* When we encounter a timer that is still waiting,
4018 return the amount of time to wait before it is ripe. */
4019 {
4020 UNGCPRO;
4021 return difference;
4022 }
4023 }
4024
4025 /* No timers are pending in the future. */
4026 /* Return 0 if we generated an event, and -1 if not. */
4027 UNGCPRO;
4028 return nexttime;
4029 }
4030 \f
4031 /* Caches for modify_event_symbol. */
4032 static Lisp_Object accent_key_syms;
4033 static Lisp_Object func_key_syms;
4034 static Lisp_Object mouse_syms;
4035 #ifdef WINDOWSNT
4036 static Lisp_Object mouse_wheel_syms;
4037 #endif
4038 static Lisp_Object drag_n_drop_syms;
4039
4040 /* This is a list of keysym codes for special "accent" characters.
4041 It parallels lispy_accent_keys. */
4042
4043 static int lispy_accent_codes[] =
4044 {
4045 #ifdef XK_dead_circumflex
4046 XK_dead_circumflex,
4047 #else
4048 0,
4049 #endif
4050 #ifdef XK_dead_grave
4051 XK_dead_grave,
4052 #else
4053 0,
4054 #endif
4055 #ifdef XK_dead_tilde
4056 XK_dead_tilde,
4057 #else
4058 0,
4059 #endif
4060 #ifdef XK_dead_diaeresis
4061 XK_dead_diaeresis,
4062 #else
4063 0,
4064 #endif
4065 #ifdef XK_dead_macron
4066 XK_dead_macron,
4067 #else
4068 0,
4069 #endif
4070 #ifdef XK_dead_degree
4071 XK_dead_degree,
4072 #else
4073 0,
4074 #endif
4075 #ifdef XK_dead_acute
4076 XK_dead_acute,
4077 #else
4078 0,
4079 #endif
4080 #ifdef XK_dead_cedilla
4081 XK_dead_cedilla,
4082 #else
4083 0,
4084 #endif
4085 #ifdef XK_dead_breve
4086 XK_dead_breve,
4087 #else
4088 0,
4089 #endif
4090 #ifdef XK_dead_ogonek
4091 XK_dead_ogonek,
4092 #else
4093 0,
4094 #endif
4095 #ifdef XK_dead_caron
4096 XK_dead_caron,
4097 #else
4098 0,
4099 #endif
4100 #ifdef XK_dead_doubleacute
4101 XK_dead_doubleacute,
4102 #else
4103 0,
4104 #endif
4105 #ifdef XK_dead_abovedot
4106 XK_dead_abovedot,
4107 #else
4108 0,
4109 #endif
4110 };
4111
4112 /* This is a list of Lisp names for special "accent" characters.
4113 It parallels lispy_accent_codes. */
4114
4115 static char *lispy_accent_keys[] =
4116 {
4117 "dead-circumflex",
4118 "dead-grave",
4119 "dead-tilde",
4120 "dead-diaeresis",
4121 "dead-macron",
4122 "dead-degree",
4123 "dead-acute",
4124 "dead-cedilla",
4125 "dead-breve",
4126 "dead-ogonek",
4127 "dead-caron",
4128 "dead-doubleacute",
4129 "dead-abovedot",
4130 };
4131
4132 #ifdef HAVE_NTGUI
4133 #define FUNCTION_KEY_OFFSET 0x0
4134
4135 char *lispy_function_keys[] =
4136 {
4137 0, /* 0 */
4138
4139 0, /* VK_LBUTTON 0x01 */
4140 0, /* VK_RBUTTON 0x02 */
4141 "cancel", /* VK_CANCEL 0x03 */
4142 0, /* VK_MBUTTON 0x04 */
4143
4144 0, 0, 0, /* 0x05 .. 0x07 */
4145
4146 "backspace", /* VK_BACK 0x08 */
4147 "tab", /* VK_TAB 0x09 */
4148
4149 0, 0, /* 0x0A .. 0x0B */
4150
4151 "clear", /* VK_CLEAR 0x0C */
4152 "return", /* VK_RETURN 0x0D */
4153
4154 0, 0, /* 0x0E .. 0x0F */
4155
4156 0, /* VK_SHIFT 0x10 */
4157 0, /* VK_CONTROL 0x11 */
4158 0, /* VK_MENU 0x12 */
4159 "pause", /* VK_PAUSE 0x13 */
4160 "capslock", /* VK_CAPITAL 0x14 */
4161
4162 0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */
4163
4164 "escape", /* VK_ESCAPE 0x1B */
4165
4166 0, 0, 0, 0, /* 0x1C .. 0x1F */
4167
4168 0, /* VK_SPACE 0x20 */
4169 "prior", /* VK_PRIOR 0x21 */
4170 "next", /* VK_NEXT 0x22 */
4171 "end", /* VK_END 0x23 */
4172 "home", /* VK_HOME 0x24 */
4173 "left", /* VK_LEFT 0x25 */
4174 "up", /* VK_UP 0x26 */
4175 "right", /* VK_RIGHT 0x27 */
4176 "down", /* VK_DOWN 0x28 */
4177 "select", /* VK_SELECT 0x29 */
4178 "print", /* VK_PRINT 0x2A */
4179 "execute", /* VK_EXECUTE 0x2B */
4180 "snapshot", /* VK_SNAPSHOT 0x2C */
4181 "insert", /* VK_INSERT 0x2D */
4182 "delete", /* VK_DELETE 0x2E */
4183 "help", /* VK_HELP 0x2F */
4184
4185 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
4186
4187 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4188
4189 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
4190
4191 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
4192
4193 0, 0, 0, 0, 0, 0, 0, 0, 0,
4194 0, 0, 0, 0, 0, 0, 0, 0, 0,
4195 0, 0, 0, 0, 0, 0, 0, 0,
4196
4197 "lwindow", /* VK_LWIN 0x5B */
4198 "rwindow", /* VK_RWIN 0x5C */
4199 "apps", /* VK_APPS 0x5D */
4200
4201 0, 0, /* 0x5E .. 0x5F */
4202
4203 "kp-0", /* VK_NUMPAD0 0x60 */
4204 "kp-1", /* VK_NUMPAD1 0x61 */
4205 "kp-2", /* VK_NUMPAD2 0x62 */
4206 "kp-3", /* VK_NUMPAD3 0x63 */
4207 "kp-4", /* VK_NUMPAD4 0x64 */
4208 "kp-5", /* VK_NUMPAD5 0x65 */
4209 "kp-6", /* VK_NUMPAD6 0x66 */
4210 "kp-7", /* VK_NUMPAD7 0x67 */
4211 "kp-8", /* VK_NUMPAD8 0x68 */
4212 "kp-9", /* VK_NUMPAD9 0x69 */
4213 "kp-multiply", /* VK_MULTIPLY 0x6A */
4214 "kp-add", /* VK_ADD 0x6B */
4215 "kp-separator", /* VK_SEPARATOR 0x6C */
4216 "kp-subtract", /* VK_SUBTRACT 0x6D */
4217 "kp-decimal", /* VK_DECIMAL 0x6E */
4218 "kp-divide", /* VK_DIVIDE 0x6F */
4219 "f1", /* VK_F1 0x70 */
4220 "f2", /* VK_F2 0x71 */
4221 "f3", /* VK_F3 0x72 */
4222 "f4", /* VK_F4 0x73 */
4223 "f5", /* VK_F5 0x74 */
4224 "f6", /* VK_F6 0x75 */
4225 "f7", /* VK_F7 0x76 */
4226 "f8", /* VK_F8 0x77 */
4227 "f9", /* VK_F9 0x78 */
4228 "f10", /* VK_F10 0x79 */
4229 "f11", /* VK_F11 0x7A */
4230 "f12", /* VK_F12 0x7B */
4231 "f13", /* VK_F13 0x7C */
4232 "f14", /* VK_F14 0x7D */
4233 "f15", /* VK_F15 0x7E */
4234 "f16", /* VK_F16 0x7F */
4235 "f17", /* VK_F17 0x80 */
4236 "f18", /* VK_F18 0x81 */
4237 "f19", /* VK_F19 0x82 */
4238 "f20", /* VK_F20 0x83 */
4239 "f21", /* VK_F21 0x84 */
4240 "f22", /* VK_F22 0x85 */
4241 "f23", /* VK_F23 0x86 */
4242 "f24", /* VK_F24 0x87 */
4243
4244 0, 0, 0, 0, /* 0x88 .. 0x8B */
4245 0, 0, 0, 0, /* 0x8C .. 0x8F */
4246
4247 "kp-numlock", /* VK_NUMLOCK 0x90 */
4248 "scroll", /* VK_SCROLL 0x91 */
4249
4250 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
4251 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
4252 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
4253 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
4254 "kp-end", /* VK_NUMPAD_END 0x96 */
4255 "kp-home", /* VK_NUMPAD_HOME 0x97 */
4256 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
4257 "kp-up", /* VK_NUMPAD_UP 0x99 */
4258 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
4259 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
4260 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
4261 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
4262
4263 0, 0, /* 0x9E .. 0x9F */
4264
4265 /*
4266 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
4267 * Used only as parameters to GetAsyncKeyState and GetKeyState.
4268 * No other API or message will distinguish left and right keys this way.
4269 */
4270 /* 0xA0 .. 0xEF */
4271
4272 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4273 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4274 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4275 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4276 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4277
4278 /* 0xF0 .. 0xF5 */
4279
4280 0, 0, 0, 0, 0, 0,
4281
4282 "attn", /* VK_ATTN 0xF6 */
4283 "crsel", /* VK_CRSEL 0xF7 */
4284 "exsel", /* VK_EXSEL 0xF8 */
4285 "ereof", /* VK_EREOF 0xF9 */
4286 "play", /* VK_PLAY 0xFA */
4287 "zoom", /* VK_ZOOM 0xFB */
4288 "noname", /* VK_NONAME 0xFC */
4289 "pa1", /* VK_PA1 0xFD */
4290 "oem_clear", /* VK_OEM_CLEAR 0xFE */
4291 0 /* 0xFF */
4292 };
4293
4294 #else /* not HAVE_NTGUI */
4295
4296 #ifdef XK_kana_A
4297 static char *lispy_kana_keys[] =
4298 {
4299 /* X Keysym value */
4300 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
4301 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
4302 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
4303 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
4304 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
4305 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
4306 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
4307 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
4308 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
4309 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
4310 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
4311 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
4312 "kana-i", "kana-u", "kana-e", "kana-o",
4313 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
4314 "prolongedsound", "kana-A", "kana-I", "kana-U",
4315 "kana-E", "kana-O", "kana-KA", "kana-KI",
4316 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
4317 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
4318 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
4319 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
4320 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
4321 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
4322 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
4323 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
4324 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
4325 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
4326 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
4327 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
4328 };
4329 #endif /* XK_kana_A */
4330
4331 #define FUNCTION_KEY_OFFSET 0xff00
4332
4333 /* You'll notice that this table is arranged to be conveniently
4334 indexed by X Windows keysym values. */
4335 static char *lispy_function_keys[] =
4336 {
4337 /* X Keysym value */
4338
4339 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
4340 "backspace", "tab", "linefeed", "clear",
4341 0, "return", 0, 0,
4342 0, 0, 0, "pause", /* 0xff10...1f */
4343 0, 0, 0, 0, 0, 0, 0, "escape",
4344 0, 0, 0, 0,
4345 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
4346 "romaji", "hiragana", "katakana", "hiragana-katakana",
4347 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
4348 "massyo", "kana-lock", "kana-shift", "eisu-shift",
4349 "eisu-toggle", /* 0xff30...3f */
4350 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4351 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
4352
4353 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
4354 "down", "prior", "next", "end",
4355 "begin", 0, 0, 0, 0, 0, 0, 0,
4356 "select", /* 0xff60 */ /* IsMiscFunctionKey */
4357 "print",
4358 "execute",
4359 "insert",
4360 0, /* 0xff64 */
4361 "undo",
4362 "redo",
4363 "menu",
4364 "find",
4365 "cancel",
4366 "help",
4367 "break", /* 0xff6b */
4368
4369 0, 0, 0, 0,
4370 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
4371 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
4372 "kp-space", /* 0xff80 */ /* IsKeypadKey */
4373 0, 0, 0, 0, 0, 0, 0, 0,
4374 "kp-tab", /* 0xff89 */
4375 0, 0, 0,
4376 "kp-enter", /* 0xff8d */
4377 0, 0, 0,
4378 "kp-f1", /* 0xff91 */
4379 "kp-f2",
4380 "kp-f3",
4381 "kp-f4",
4382 "kp-home", /* 0xff95 */
4383 "kp-left",
4384 "kp-up",
4385 "kp-right",
4386 "kp-down",
4387 "kp-prior", /* kp-page-up */
4388 "kp-next", /* kp-page-down */
4389 "kp-end",
4390 "kp-begin",
4391 "kp-insert",
4392 "kp-delete",
4393 0, /* 0xffa0 */
4394 0, 0, 0, 0, 0, 0, 0, 0, 0,
4395 "kp-multiply", /* 0xffaa */
4396 "kp-add",
4397 "kp-separator",
4398 "kp-subtract",
4399 "kp-decimal",
4400 "kp-divide", /* 0xffaf */
4401 "kp-0", /* 0xffb0 */
4402 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
4403 0, /* 0xffba */
4404 0, 0,
4405 "kp-equal", /* 0xffbd */
4406 "f1", /* 0xffbe */ /* IsFunctionKey */
4407 "f2",
4408 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
4409 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
4410 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
4411 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
4412 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
4413 0, 0, 0, 0, 0, 0, 0, 0,
4414 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
4415 0, 0, 0, 0, 0, 0, 0, "delete"
4416 };
4417
4418 /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
4419 #define ISO_FUNCTION_KEY_OFFSET 0xfe00
4420
4421 static char *iso_lispy_function_keys[] =
4422 {
4423 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
4424 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
4425 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
4426 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
4427 "iso-lefttab", /* 0xfe20 */
4428 "iso-move-line-up", "iso-move-line-down",
4429 "iso-partial-line-up", "iso-partial-line-down",
4430 "iso-partial-space-left", "iso-partial-space-right",
4431 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
4432 "iso-release-margin-left", "iso-release-margin-right",
4433 "iso-release-both-margins",
4434 "iso-fast-cursor-left", "iso-fast-cursor-right",
4435 "iso-fast-cursor-up", "iso-fast-cursor-down",
4436 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
4437 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
4438 };
4439
4440 #endif /* not HAVE_NTGUI */
4441
4442 Lisp_Object Vlispy_mouse_stem;
4443
4444 #ifdef WINDOWSNT
4445 /* mouse-wheel events are generated by the wheel on devices such as
4446 the MS Intellimouse. The wheel sits in between the left and right
4447 mouse buttons, and is typically used to scroll or zoom the window
4448 underneath the pointer. mouse-wheel events specify the object on
4449 which they operate, and a delta corresponding to the amount and
4450 direction that the wheel is rotated. Clicking the mouse-wheel
4451 generates a mouse-2 event. */
4452 static char *lispy_mouse_wheel_names[] =
4453 {
4454 "mouse-wheel"
4455 };
4456
4457 #endif /* WINDOWSNT */
4458
4459 /* drag-n-drop events are generated when a set of selected files are
4460 dragged from another application and dropped onto an Emacs window. */
4461 static char *lispy_drag_n_drop_names[] =
4462 {
4463 "drag-n-drop"
4464 };
4465
4466 /* Scroll bar parts. */
4467 Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
4468 Lisp_Object Qup, Qdown, Qbottom, Qend_scroll;
4469 Lisp_Object Qtop, Qratio;
4470
4471 /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
4472 Lisp_Object *scroll_bar_parts[] = {
4473 &Qabove_handle, &Qhandle, &Qbelow_handle,
4474 &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio
4475 };
4476
4477 /* User signal events. */
4478 Lisp_Object Qusr1_signal, Qusr2_signal;
4479
4480 Lisp_Object *lispy_user_signals[] =
4481 {
4482 &Qusr1_signal, &Qusr2_signal
4483 };
4484
4485
4486 /* A vector, indexed by button number, giving the down-going location
4487 of currently depressed buttons, both scroll bar and non-scroll bar.
4488
4489 The elements have the form
4490 (BUTTON-NUMBER MODIFIER-MASK . REST)
4491 where REST is the cdr of a position as it would be reported in the event.
4492
4493 The make_lispy_event function stores positions here to tell the
4494 difference between click and drag events, and to store the starting
4495 location to be included in drag events. */
4496
4497 static Lisp_Object button_down_location;
4498
4499 /* Information about the most recent up-going button event: Which
4500 button, what location, and what time. */
4501
4502 static int last_mouse_button;
4503 static int last_mouse_x;
4504 static int last_mouse_y;
4505 static unsigned long button_down_time;
4506
4507 /* The maximum time between clicks to make a double-click,
4508 or Qnil to disable double-click detection,
4509 or Qt for no time limit. */
4510 Lisp_Object Vdouble_click_time;
4511
4512 /* The number of clicks in this multiple-click. */
4513
4514 int double_click_count;
4515
4516 /* Given a struct input_event, build the lisp event which represents
4517 it. If EVENT is 0, build a mouse movement event from the mouse
4518 movement buffer, which should have a movement event in it.
4519
4520 Note that events must be passed to this function in the order they
4521 are received; this function stores the location of button presses
4522 in order to build drag events when the button is released. */
4523
4524 static Lisp_Object
4525 make_lispy_event (event)
4526 struct input_event *event;
4527 {
4528 int i;
4529
4530 switch (SWITCH_ENUM_CAST (event->kind))
4531 {
4532 /* A simple keystroke. */
4533 case ascii_keystroke:
4534 {
4535 Lisp_Object lispy_c;
4536 int c = event->code & 0377;
4537 /* Turn ASCII characters into control characters
4538 when proper. */
4539 if (event->modifiers & ctrl_modifier)
4540 c = make_ctrl_char (c);
4541
4542 /* Add in the other modifier bits. We took care of ctrl_modifier
4543 just above, and the shift key was taken care of by the X code,
4544 and applied to control characters by make_ctrl_char. */
4545 c |= (event->modifiers
4546 & (meta_modifier | alt_modifier
4547 | hyper_modifier | super_modifier));
4548 /* Distinguish Shift-SPC from SPC. */
4549 if ((event->code & 0377) == 040
4550 && event->modifiers & shift_modifier)
4551 c |= shift_modifier;
4552 button_down_time = 0;
4553 XSETFASTINT (lispy_c, c);
4554 return lispy_c;
4555 }
4556
4557 case multibyte_char_keystroke:
4558 {
4559 Lisp_Object lispy_c;
4560
4561 XSETFASTINT (lispy_c, event->code);
4562 return lispy_c;
4563 }
4564
4565 /* A function key. The symbol may need to have modifier prefixes
4566 tacked onto it. */
4567 case non_ascii_keystroke:
4568 button_down_time = 0;
4569
4570 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
4571 if (event->code == lispy_accent_codes[i])
4572 return modify_event_symbol (i,
4573 event->modifiers,
4574 Qfunction_key, Qnil,
4575 lispy_accent_keys, &accent_key_syms,
4576 (sizeof (lispy_accent_keys)
4577 / sizeof (lispy_accent_keys[0])));
4578
4579 /* Handle system-specific keysyms. */
4580 if (event->code & (1 << 28))
4581 {
4582 /* We need to use an alist rather than a vector as the cache
4583 since we can't make a vector long enuf. */
4584 if (NILP (current_kboard->system_key_syms))
4585 current_kboard->system_key_syms = Fcons (Qnil, Qnil);
4586 return modify_event_symbol (event->code,
4587 event->modifiers,
4588 Qfunction_key,
4589 current_kboard->Vsystem_key_alist,
4590 0, &current_kboard->system_key_syms,
4591 (unsigned)-1);
4592 }
4593
4594 #ifdef XK_kana_A
4595 if (event->code >= 0x400 && event->code < 0x500)
4596 return modify_event_symbol (event->code - 0x400,
4597 event->modifiers & ~shift_modifier,
4598 Qfunction_key, Qnil,
4599 lispy_kana_keys, &func_key_syms,
4600 (sizeof (lispy_kana_keys)
4601 / sizeof (lispy_kana_keys[0])));
4602 #endif /* XK_kana_A */
4603
4604 #ifdef ISO_FUNCTION_KEY_OFFSET
4605 if (event->code < FUNCTION_KEY_OFFSET
4606 && event->code >= ISO_FUNCTION_KEY_OFFSET)
4607 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
4608 event->modifiers,
4609 Qfunction_key, Qnil,
4610 iso_lispy_function_keys, &func_key_syms,
4611 (sizeof (iso_lispy_function_keys)
4612 / sizeof (iso_lispy_function_keys[0])));
4613 else
4614 #endif
4615 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
4616 event->modifiers,
4617 Qfunction_key, Qnil,
4618 lispy_function_keys, &func_key_syms,
4619 (sizeof (lispy_function_keys)
4620 / sizeof (lispy_function_keys[0])));
4621
4622 #ifdef HAVE_MOUSE
4623 /* A mouse click. Figure out where it is, decide whether it's
4624 a press, click or drag, and build the appropriate structure. */
4625 case mouse_click:
4626 #ifndef USE_TOOLKIT_SCROLL_BARS
4627 case scroll_bar_click:
4628 #endif
4629 {
4630 int button = event->code;
4631 int is_double;
4632 Lisp_Object position;
4633 Lisp_Object *start_pos_ptr;
4634 Lisp_Object start_pos;
4635
4636 position = Qnil;
4637
4638 /* Build the position as appropriate for this mouse click. */
4639 if (event->kind == mouse_click)
4640 {
4641 int part;
4642 FRAME_PTR f = XFRAME (event->frame_or_window);
4643 Lisp_Object window;
4644 Lisp_Object posn;
4645 Lisp_Object string_info = Qnil;
4646 int row, column;
4647
4648 /* Ignore mouse events that were made on frame that
4649 have been deleted. */
4650 if (! FRAME_LIVE_P (f))
4651 return Qnil;
4652
4653 /* EVENT->x and EVENT->y are frame-relative pixel
4654 coordinates at this place. Under old redisplay, COLUMN
4655 and ROW are set to frame relative glyph coordinates
4656 which are then used to determine whether this click is
4657 in a menu (non-toolkit version). */
4658 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
4659 &column, &row, NULL, 1);
4660
4661 #ifndef USE_X_TOOLKIT
4662 /* In the non-toolkit version, clicks on the menu bar
4663 are ordinary button events in the event buffer.
4664 Distinguish them, and invoke the menu.
4665
4666 (In the toolkit version, the toolkit handles the menu bar
4667 and Emacs doesn't know about it until after the user
4668 makes a selection.) */
4669 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
4670 && (event->modifiers & down_modifier))
4671 {
4672 Lisp_Object items, item;
4673 int hpos;
4674 int i;
4675
4676 #if 0
4677 /* Activate the menu bar on the down event. If the
4678 up event comes in before the menu code can deal with it,
4679 just ignore it. */
4680 if (! (event->modifiers & down_modifier))
4681 return Qnil;
4682 #endif
4683
4684 /* Find the menu bar item under `column'. */
4685 item = Qnil;
4686 items = FRAME_MENU_BAR_ITEMS (f);
4687 for (i = 0; i < XVECTOR (items)->size; i += 4)
4688 {
4689 Lisp_Object pos, string;
4690 string = XVECTOR (items)->contents[i + 1];
4691 pos = XVECTOR (items)->contents[i + 3];
4692 if (NILP (string))
4693 break;
4694 if (column >= XINT (pos)
4695 && column < XINT (pos) + XSTRING (string)->size)
4696 {
4697 item = XVECTOR (items)->contents[i];
4698 break;
4699 }
4700 }
4701
4702 /* ELisp manual 2.4b says (x y) are window relative but
4703 code says they are frame-relative. */
4704 position
4705 = Fcons (event->frame_or_window,
4706 Fcons (Qmenu_bar,
4707 Fcons (Fcons (event->x, event->y),
4708 Fcons (make_number (event->timestamp),
4709 Qnil))));
4710
4711 return Fcons (item, Fcons (position, Qnil));
4712 }
4713 #endif /* not USE_X_TOOLKIT */
4714
4715 /* Set `window' to the window under frame pixel coordinates
4716 event->x/event->y. */
4717 window = window_from_coordinates (f, XINT (event->x),
4718 XINT (event->y), &part, 0);
4719
4720 if (!WINDOWP (window))
4721 {
4722 window = event->frame_or_window;
4723 posn = Qnil;
4724 }
4725 else
4726 {
4727 /* It's a click in window window at frame coordinates
4728 event->x/ event->y. */
4729 struct window *w = XWINDOW (window);
4730
4731 /* Get window relative coordinates. Original code
4732 `rounded' this to glyph boundaries. */
4733 int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
4734 int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
4735
4736 /* Set event coordinates to window-relative coordinates
4737 for constructing the Lisp event below. */
4738 XSETINT (event->x, wx);
4739 XSETINT (event->y, wy);
4740
4741 if (part == 1 || part == 3)
4742 {
4743 /* Mode line or header line. Look for a string under
4744 the mouse that may have a `local-map' property. */
4745 Lisp_Object string;
4746 int charpos;
4747
4748 posn = part == 1 ? Qmode_line : Qheader_line;
4749 string = mode_line_string (w, wx, wy, part == 1, &charpos);
4750 if (STRINGP (string))
4751 string_info = Fcons (string, make_number (charpos));
4752 }
4753 else if (part == 2)
4754 posn = Qvertical_line;
4755 else
4756 XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy));
4757 }
4758
4759 position
4760 = Fcons (window,
4761 Fcons (posn,
4762 Fcons (Fcons (event->x, event->y),
4763 Fcons (make_number (event->timestamp),
4764 (NILP (string_info)
4765 ? Qnil
4766 : Fcons (string_info, Qnil))))));
4767 }
4768 #ifndef USE_TOOLKIT_SCROLL_BARS
4769 else
4770 {
4771 /* It's a scrollbar click. */
4772 Lisp_Object window;
4773 Lisp_Object portion_whole;
4774 Lisp_Object part;
4775
4776 window = event->frame_or_window;
4777 portion_whole = Fcons (event->x, event->y);
4778 part = *scroll_bar_parts[(int) event->part];
4779
4780 position
4781 = Fcons (window,
4782 Fcons (Qvertical_scroll_bar,
4783 Fcons (portion_whole,
4784 Fcons (make_number (event->timestamp),
4785 Fcons (part, Qnil)))));
4786 }
4787 #endif /* not USE_TOOLKIT_SCROLL_BARS */
4788
4789 if (button >= XVECTOR (button_down_location)->size)
4790 {
4791 button_down_location = larger_vector (button_down_location,
4792 button + 1, Qnil);
4793 mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
4794 }
4795
4796 start_pos_ptr = &XVECTOR (button_down_location)->contents[button];
4797
4798 start_pos = *start_pos_ptr;
4799 *start_pos_ptr = Qnil;
4800
4801 is_double = (button == last_mouse_button
4802 && XINT (event->x) == last_mouse_x
4803 && XINT (event->y) == last_mouse_y
4804 && button_down_time != 0
4805 && (EQ (Vdouble_click_time, Qt)
4806 || (INTEGERP (Vdouble_click_time)
4807 && ((int)(event->timestamp - button_down_time)
4808 < XINT (Vdouble_click_time)))));
4809 last_mouse_button = button;
4810 last_mouse_x = XINT (event->x);
4811 last_mouse_y = XINT (event->y);
4812
4813 /* If this is a button press, squirrel away the location, so
4814 we can decide later whether it was a click or a drag. */
4815 if (event->modifiers & down_modifier)
4816 {
4817 if (is_double)
4818 {
4819 double_click_count++;
4820 event->modifiers |= ((double_click_count > 2)
4821 ? triple_modifier
4822 : double_modifier);
4823 }
4824 else
4825 double_click_count = 1;
4826 button_down_time = event->timestamp;
4827 *start_pos_ptr = Fcopy_alist (position);
4828 }
4829
4830 /* Now we're releasing a button - check the co-ordinates to
4831 see if this was a click or a drag. */
4832 else if (event->modifiers & up_modifier)
4833 {
4834 /* If we did not see a down before this up,
4835 ignore the up. Probably this happened because
4836 the down event chose a menu item.
4837 It would be an annoyance to treat the release
4838 of the button that chose the menu item
4839 as a separate event. */
4840
4841 if (!CONSP (start_pos))
4842 return Qnil;
4843
4844 event->modifiers &= ~up_modifier;
4845 #if 0 /* Formerly we treated an up with no down as a click event. */
4846 if (!CONSP (start_pos))
4847 event->modifiers |= click_modifier;
4848 else
4849 #endif
4850 {
4851 /* The third element of every position should be the (x,y)
4852 pair. */
4853 Lisp_Object down;
4854
4855 down = Fnth (make_number (2), start_pos);
4856 if (EQ (event->x, XCAR (down))
4857 && EQ (event->y, XCDR (down)))
4858 {
4859 event->modifiers |= click_modifier;
4860 }
4861 else
4862 {
4863 button_down_time = 0;
4864 event->modifiers |= drag_modifier;
4865 }
4866 /* Don't check is_double; treat this as multiple
4867 if the down-event was multiple. */
4868 if (double_click_count > 1)
4869 event->modifiers |= ((double_click_count > 2)
4870 ? triple_modifier
4871 : double_modifier);
4872 }
4873 }
4874 else
4875 /* Every mouse event should either have the down_modifier or
4876 the up_modifier set. */
4877 abort ();
4878
4879 {
4880 /* Get the symbol we should use for the mouse click. */
4881 Lisp_Object head;
4882
4883 head = modify_event_symbol (button,
4884 event->modifiers,
4885 Qmouse_click, Vlispy_mouse_stem,
4886 NULL,
4887 &mouse_syms,
4888 XVECTOR (mouse_syms)->size);
4889 if (event->modifiers & drag_modifier)
4890 return Fcons (head,
4891 Fcons (start_pos,
4892 Fcons (position,
4893 Qnil)));
4894 else if (event->modifiers & (double_modifier | triple_modifier))
4895 return Fcons (head,
4896 Fcons (position,
4897 Fcons (make_number (double_click_count),
4898 Qnil)));
4899 else
4900 return Fcons (head,
4901 Fcons (position,
4902 Qnil));
4903 }
4904 }
4905
4906 #if USE_TOOLKIT_SCROLL_BARS
4907
4908 /* We don't have down and up events if using toolkit scroll bars,
4909 so make this always a click event. Store in the `part' of
4910 the Lisp event a symbol which maps to the following actions:
4911
4912 `above_handle' page up
4913 `below_handle' page down
4914 `up' line up
4915 `down' line down
4916 `top' top of buffer
4917 `bottom' bottom of buffer
4918 `handle' thumb has been dragged.
4919 `end-scroll' end of interaction with scroll bar
4920
4921 The incoming input_event contains in its `part' member an
4922 index of type `enum scroll_bar_part' which we can use as an
4923 index in scroll_bar_parts to get the appropriate symbol. */
4924
4925 case scroll_bar_click:
4926 {
4927 Lisp_Object position, head, window, portion_whole, part;
4928
4929 window = event->frame_or_window;
4930 portion_whole = Fcons (event->x, event->y);
4931 part = *scroll_bar_parts[(int) event->part];
4932
4933 position
4934 = Fcons (window,
4935 Fcons (Qvertical_scroll_bar,
4936 Fcons (portion_whole,
4937 Fcons (make_number (event->timestamp),
4938 Fcons (part, Qnil)))));
4939
4940 /* Always treat scroll bar events as clicks. */
4941 event->modifiers |= click_modifier;
4942
4943 /* Get the symbol we should use for the mouse click. */
4944 head = modify_event_symbol (event->code,
4945 event->modifiers,
4946 Qmouse_click,
4947 Vlispy_mouse_stem,
4948 NULL, &mouse_syms,
4949 XVECTOR (mouse_syms)->size);
4950 return Fcons (head, Fcons (position, Qnil));
4951 }
4952
4953 #endif /* USE_TOOLKIT_SCROLL_BARS */
4954
4955 #ifdef WINDOWSNT
4956 case w32_scroll_bar_click:
4957 {
4958 int button = event->code;
4959 int is_double;
4960 Lisp_Object position;
4961 Lisp_Object *start_pos_ptr;
4962 Lisp_Object start_pos;
4963
4964 {
4965 Lisp_Object window;
4966 Lisp_Object portion_whole;
4967 Lisp_Object part;
4968
4969 window = event->frame_or_window;
4970 portion_whole = Fcons (event->x, event->y);
4971 part = *scroll_bar_parts[(int) event->part];
4972
4973 position
4974 = Fcons (window,
4975 Fcons (Qvertical_scroll_bar,
4976 Fcons (portion_whole,
4977 Fcons (make_number (event->timestamp),
4978 Fcons (part, Qnil)))));
4979 }
4980
4981 /* Always treat W32 scroll bar events as clicks. */
4982 event->modifiers |= click_modifier;
4983
4984 {
4985 /* Get the symbol we should use for the mouse click. */
4986 Lisp_Object head;
4987
4988 head = modify_event_symbol (button,
4989 event->modifiers,
4990 Qmouse_click,
4991 Vlispy_mouse_stem,
4992 NULL, &mouse_syms,
4993 XVECTOR (mouse_syms)->size);
4994 return Fcons (head,
4995 Fcons (position,
4996 Qnil));
4997 }
4998 }
4999 case mouse_wheel:
5000 {
5001 int part;
5002 FRAME_PTR f = XFRAME (event->frame_or_window);
5003 Lisp_Object window;
5004 Lisp_Object posn;
5005 Lisp_Object head, position;
5006 int row, column;
5007
5008 /* Ignore mouse events that were made on frame that
5009 have been deleted. */
5010 if (! FRAME_LIVE_P (f))
5011 return Qnil;
5012 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
5013 &column, &row, NULL, 1);
5014 window = window_from_coordinates (f, XINT (event->x),
5015 XINT (event->y), &part, 0);
5016
5017 if (!WINDOWP (window))
5018 {
5019 window = event->frame_or_window;
5020 posn = Qnil;
5021 }
5022 else
5023 {
5024 int pixcolumn, pixrow;
5025 column -= XINT (XWINDOW (window)->left);
5026 row -= XINT (XWINDOW (window)->top);
5027 glyph_to_pixel_coords (XWINDOW(window), column, row,
5028 &pixcolumn, &pixrow);
5029 XSETINT (event->x, pixcolumn);
5030 XSETINT (event->y, pixrow);
5031
5032 if (part == 1)
5033 posn = Qmode_line;
5034 else if (part == 2)
5035 posn = Qvertical_line;
5036 else if (part == 3)
5037 posn = Qheader_line;
5038 else
5039 XSETINT (posn,
5040 buffer_posn_from_coords (XWINDOW (window),
5041 &column, &row));
5042 }
5043
5044 {
5045 Lisp_Object head, position;
5046
5047 position
5048 = Fcons (window,
5049 Fcons (posn,
5050 Fcons (Fcons (event->x, event->y),
5051 Fcons (make_number (event->timestamp),
5052 Qnil))));
5053
5054 head = modify_event_symbol (0, event->modifiers,
5055 Qmouse_wheel, Qnil,
5056 lispy_mouse_wheel_names,
5057 &mouse_wheel_syms, 1);
5058 return Fcons (head,
5059 Fcons (position,
5060 Fcons (make_number (event->code),
5061 Qnil)));
5062 }
5063 }
5064 #endif /* WINDOWSNT */
5065
5066 case drag_n_drop:
5067 {
5068 int part;
5069 FRAME_PTR f;
5070 Lisp_Object window;
5071 Lisp_Object posn;
5072 Lisp_Object files;
5073
5074 /* The frame_or_window field should be a cons of the frame in
5075 which the event occurred and a list of the filenames
5076 dropped. */
5077 if (! CONSP (event->frame_or_window))
5078 abort ();
5079
5080 f = XFRAME (XCAR (event->frame_or_window));
5081 files = XCDR (event->frame_or_window);
5082
5083 /* Ignore mouse events that were made on frames that
5084 have been deleted. */
5085 if (! FRAME_LIVE_P (f))
5086 return Qnil;
5087
5088 window = window_from_coordinates (f, XINT (event->x),
5089 XINT (event->y), &part, 0);
5090
5091 if (!WINDOWP (window))
5092 {
5093 window = XCAR (event->frame_or_window);
5094 posn = Qnil;
5095 }
5096 else
5097 {
5098 /* It's an event in window `window' at frame coordinates
5099 event->x/ event->y. */
5100 struct window *w = XWINDOW (window);
5101
5102 /* Get window relative coordinates. */
5103 int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x));
5104 int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y));
5105
5106 /* Set event coordinates to window-relative coordinates
5107 for constructing the Lisp event below. */
5108 XSETINT (event->x, wx);
5109 XSETINT (event->y, wy);
5110
5111 if (part == 1)
5112 posn = Qmode_line;
5113 else if (part == 2)
5114 posn = Qvertical_line;
5115 else if (part == 3)
5116 posn = Qheader_line;
5117 else
5118 XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy));
5119 }
5120
5121 {
5122 Lisp_Object head, position;
5123
5124 position
5125 = Fcons (window,
5126 Fcons (posn,
5127 Fcons (Fcons (event->x, event->y),
5128 Fcons (make_number (event->timestamp),
5129 Qnil))));
5130
5131 head = modify_event_symbol (0, event->modifiers,
5132 Qdrag_n_drop, Qnil,
5133 lispy_drag_n_drop_names,
5134 &drag_n_drop_syms, 1);
5135 return Fcons (head,
5136 Fcons (position,
5137 Fcons (files,
5138 Qnil)));
5139 }
5140 }
5141 #endif /* HAVE_MOUSE */
5142
5143 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) || defined (macintosh)
5144 case MENU_BAR_EVENT:
5145 if (EQ (event->arg, event->frame_or_window))
5146 /* This is the prefix key. We translate this to
5147 `(menu_bar)' because the code in keyboard.c for menu
5148 events, which we use, relies on this. */
5149 return Fcons (Qmenu_bar, Qnil);
5150 return event->arg;
5151 #endif
5152
5153 case TOOL_BAR_EVENT:
5154 if (EQ (event->arg, event->frame_or_window))
5155 /* This is the prefix key. We translate this to
5156 `(tool_bar)' because the code in keyboard.c for menu
5157 events, which we use, relies on this. */
5158 return Fcons (Qtool_bar, Qnil);
5159 else if (SYMBOLP (event->arg))
5160 return apply_modifiers (event->modifiers, event->arg);
5161 return event->arg;
5162
5163 case USER_SIGNAL_EVENT:
5164 /* A user signal. */
5165 return *lispy_user_signals[event->code];
5166
5167 /* The 'kind' field of the event is something we don't recognize. */
5168 default:
5169 abort ();
5170 }
5171 }
5172
5173 #ifdef HAVE_MOUSE
5174
5175 static Lisp_Object
5176 make_lispy_movement (frame, bar_window, part, x, y, time)
5177 FRAME_PTR frame;
5178 Lisp_Object bar_window;
5179 enum scroll_bar_part part;
5180 Lisp_Object x, y;
5181 unsigned long time;
5182 {
5183 /* Is it a scroll bar movement? */
5184 if (frame && ! NILP (bar_window))
5185 {
5186 Lisp_Object part_sym;
5187
5188 part_sym = *scroll_bar_parts[(int) part];
5189 return Fcons (Qscroll_bar_movement,
5190 (Fcons (Fcons (bar_window,
5191 Fcons (Qvertical_scroll_bar,
5192 Fcons (Fcons (x, y),
5193 Fcons (make_number (time),
5194 Fcons (part_sym,
5195 Qnil))))),
5196 Qnil)));
5197 }
5198
5199 /* Or is it an ordinary mouse movement? */
5200 else
5201 {
5202 int area;
5203 Lisp_Object window;
5204 Lisp_Object posn;
5205
5206 if (frame)
5207 /* It's in a frame; which window on that frame? */
5208 window = window_from_coordinates (frame, XINT (x), XINT (y), &area, 0);
5209 else
5210 window = Qnil;
5211
5212 if (WINDOWP (window))
5213 {
5214 struct window *w = XWINDOW (window);
5215 int wx, wy;
5216
5217 /* Get window relative coordinates. */
5218 wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (x));
5219 wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (y));
5220 XSETINT (x, wx);
5221 XSETINT (y, wy);
5222
5223 if (area == 1)
5224 posn = Qmode_line;
5225 else if (area == 2)
5226 posn = Qvertical_line;
5227 else if (area == 3)
5228 posn = Qheader_line;
5229 else
5230 XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy));
5231 }
5232 else if (frame != 0)
5233 {
5234 XSETFRAME (window, frame);
5235 posn = Qnil;
5236 }
5237 else
5238 {
5239 window = Qnil;
5240 posn = Qnil;
5241 XSETFASTINT (x, 0);
5242 XSETFASTINT (y, 0);
5243 }
5244
5245 return Fcons (Qmouse_movement,
5246 Fcons (Fcons (window,
5247 Fcons (posn,
5248 Fcons (Fcons (x, y),
5249 Fcons (make_number (time),
5250 Qnil)))),
5251 Qnil));
5252 }
5253 }
5254
5255 #endif /* HAVE_MOUSE */
5256
5257 /* Construct a switch frame event. */
5258 static Lisp_Object
5259 make_lispy_switch_frame (frame)
5260 Lisp_Object frame;
5261 {
5262 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
5263 }
5264 \f
5265 /* Manipulating modifiers. */
5266
5267 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
5268
5269 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
5270 SYMBOL's name of the end of the modifiers; the string from this
5271 position is the unmodified symbol name.
5272
5273 This doesn't use any caches. */
5274
5275 static int
5276 parse_modifiers_uncached (symbol, modifier_end)
5277 Lisp_Object symbol;
5278 int *modifier_end;
5279 {
5280 struct Lisp_String *name;
5281 int i;
5282 int modifiers;
5283
5284 CHECK_SYMBOL (symbol, 1);
5285
5286 modifiers = 0;
5287 name = XSYMBOL (symbol)->name;
5288
5289 for (i = 0; i+2 <= STRING_BYTES (name); )
5290 {
5291 int this_mod_end = 0;
5292 int this_mod = 0;
5293
5294 /* See if the name continues with a modifier word.
5295 Check that the word appears, but don't check what follows it.
5296 Set this_mod and this_mod_end to record what we find. */
5297
5298 switch (name->data[i])
5299 {
5300 #define SINGLE_LETTER_MOD(BIT) \
5301 (this_mod_end = i + 1, this_mod = BIT)
5302
5303 case 'A':
5304 SINGLE_LETTER_MOD (alt_modifier);
5305 break;
5306
5307 case 'C':
5308 SINGLE_LETTER_MOD (ctrl_modifier);
5309 break;
5310
5311 case 'H':
5312 SINGLE_LETTER_MOD (hyper_modifier);
5313 break;
5314
5315 case 'M':
5316 SINGLE_LETTER_MOD (meta_modifier);
5317 break;
5318
5319 case 'S':
5320 SINGLE_LETTER_MOD (shift_modifier);
5321 break;
5322
5323 case 's':
5324 SINGLE_LETTER_MOD (super_modifier);
5325 break;
5326
5327 #undef SINGLE_LETTER_MOD
5328 }
5329
5330 /* If we found no modifier, stop looking for them. */
5331 if (this_mod_end == 0)
5332 break;
5333
5334 /* Check there is a dash after the modifier, so that it
5335 really is a modifier. */
5336 if (this_mod_end >= STRING_BYTES (name)
5337 || name->data[this_mod_end] != '-')
5338 break;
5339
5340 /* This modifier is real; look for another. */
5341 modifiers |= this_mod;
5342 i = this_mod_end + 1;
5343 }
5344
5345 /* Should we include the `click' modifier? */
5346 if (! (modifiers & (down_modifier | drag_modifier
5347 | double_modifier | triple_modifier))
5348 && i + 7 == STRING_BYTES (name)
5349 && strncmp (name->data + i, "mouse-", 6) == 0
5350 && ('0' <= name->data[i + 6] && name->data[i + 6] <= '9'))
5351 modifiers |= click_modifier;
5352
5353 if (modifier_end)
5354 *modifier_end = i;
5355
5356 return modifiers;
5357 }
5358
5359 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
5360 prepended to the string BASE[0..BASE_LEN-1].
5361 This doesn't use any caches. */
5362 static Lisp_Object
5363 apply_modifiers_uncached (modifiers, base, base_len, base_len_byte)
5364 int modifiers;
5365 char *base;
5366 int base_len, base_len_byte;
5367 {
5368 /* Since BASE could contain nulls, we can't use intern here; we have
5369 to use Fintern, which expects a genuine Lisp_String, and keeps a
5370 reference to it. */
5371 char *new_mods
5372 = (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
5373 int mod_len;
5374
5375 {
5376 char *p = new_mods;
5377
5378 /* Only the event queue may use the `up' modifier; it should always
5379 be turned into a click or drag event before presented to lisp code. */
5380 if (modifiers & up_modifier)
5381 abort ();
5382
5383 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
5384 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
5385 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
5386 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
5387 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
5388 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
5389 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
5390 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
5391 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
5392 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
5393 /* The click modifier is denoted by the absence of other modifiers. */
5394
5395 *p = '\0';
5396
5397 mod_len = p - new_mods;
5398 }
5399
5400 {
5401 Lisp_Object new_name;
5402
5403 new_name = make_uninit_multibyte_string (mod_len + base_len,
5404 mod_len + base_len_byte);
5405 bcopy (new_mods, XSTRING (new_name)->data, mod_len);
5406 bcopy (base, XSTRING (new_name)->data + mod_len, base_len_byte);
5407
5408 return Fintern (new_name, Qnil);
5409 }
5410 }
5411
5412
5413 static char *modifier_names[] =
5414 {
5415 "up", "down", "drag", "click", "double", "triple", 0, 0,
5416 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
5417 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
5418 };
5419 #define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
5420
5421 static Lisp_Object modifier_symbols;
5422
5423 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
5424 static Lisp_Object
5425 lispy_modifier_list (modifiers)
5426 int modifiers;
5427 {
5428 Lisp_Object modifier_list;
5429 int i;
5430
5431 modifier_list = Qnil;
5432 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
5433 if (modifiers & (1<<i))
5434 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
5435 modifier_list);
5436
5437 return modifier_list;
5438 }
5439
5440
5441 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
5442 where UNMODIFIED is the unmodified form of SYMBOL,
5443 MASK is the set of modifiers present in SYMBOL's name.
5444 This is similar to parse_modifiers_uncached, but uses the cache in
5445 SYMBOL's Qevent_symbol_element_mask property, and maintains the
5446 Qevent_symbol_elements property. */
5447
5448 Lisp_Object
5449 parse_modifiers (symbol)
5450 Lisp_Object symbol;
5451 {
5452 Lisp_Object elements;
5453
5454 elements = Fget (symbol, Qevent_symbol_element_mask);
5455 if (CONSP (elements))
5456 return elements;
5457 else
5458 {
5459 int end;
5460 int modifiers = parse_modifiers_uncached (symbol, &end);
5461 Lisp_Object unmodified;
5462 Lisp_Object mask;
5463
5464 unmodified = Fintern (make_string (XSYMBOL (symbol)->name->data + end,
5465 STRING_BYTES (XSYMBOL (symbol)->name) - end),
5466 Qnil);
5467
5468 if (modifiers & ~(((EMACS_INT)1 << VALBITS) - 1))
5469 abort ();
5470 XSETFASTINT (mask, modifiers);
5471 elements = Fcons (unmodified, Fcons (mask, Qnil));
5472
5473 /* Cache the parsing results on SYMBOL. */
5474 Fput (symbol, Qevent_symbol_element_mask,
5475 elements);
5476 Fput (symbol, Qevent_symbol_elements,
5477 Fcons (unmodified, lispy_modifier_list (modifiers)));
5478
5479 /* Since we know that SYMBOL is modifiers applied to unmodified,
5480 it would be nice to put that in unmodified's cache.
5481 But we can't, since we're not sure that parse_modifiers is
5482 canonical. */
5483
5484 return elements;
5485 }
5486 }
5487
5488 /* Apply the modifiers MODIFIERS to the symbol BASE.
5489 BASE must be unmodified.
5490
5491 This is like apply_modifiers_uncached, but uses BASE's
5492 Qmodifier_cache property, if present. It also builds
5493 Qevent_symbol_elements properties, since it has that info anyway.
5494
5495 apply_modifiers copies the value of BASE's Qevent_kind property to
5496 the modified symbol. */
5497 static Lisp_Object
5498 apply_modifiers (modifiers, base)
5499 int modifiers;
5500 Lisp_Object base;
5501 {
5502 Lisp_Object cache, index, entry, new_symbol;
5503
5504 /* Mask out upper bits. We don't know where this value's been. */
5505 modifiers &= ((EMACS_INT)1 << VALBITS) - 1;
5506
5507 /* The click modifier never figures into cache indices. */
5508 cache = Fget (base, Qmodifier_cache);
5509 XSETFASTINT (index, (modifiers & ~click_modifier));
5510 entry = assq_no_quit (index, cache);
5511
5512 if (CONSP (entry))
5513 new_symbol = XCDR (entry);
5514 else
5515 {
5516 /* We have to create the symbol ourselves. */
5517 new_symbol = apply_modifiers_uncached (modifiers,
5518 XSYMBOL (base)->name->data,
5519 XSYMBOL (base)->name->size,
5520 STRING_BYTES (XSYMBOL (base)->name));
5521
5522 /* Add the new symbol to the base's cache. */
5523 entry = Fcons (index, new_symbol);
5524 Fput (base, Qmodifier_cache, Fcons (entry, cache));
5525
5526 /* We have the parsing info now for free, so add it to the caches. */
5527 XSETFASTINT (index, modifiers);
5528 Fput (new_symbol, Qevent_symbol_element_mask,
5529 Fcons (base, Fcons (index, Qnil)));
5530 Fput (new_symbol, Qevent_symbol_elements,
5531 Fcons (base, lispy_modifier_list (modifiers)));
5532 }
5533
5534 /* Make sure this symbol is of the same kind as BASE.
5535
5536 You'd think we could just set this once and for all when we
5537 intern the symbol above, but reorder_modifiers may call us when
5538 BASE's property isn't set right; we can't assume that just
5539 because it has a Qmodifier_cache property it must have its
5540 Qevent_kind set right as well. */
5541 if (NILP (Fget (new_symbol, Qevent_kind)))
5542 {
5543 Lisp_Object kind;
5544
5545 kind = Fget (base, Qevent_kind);
5546 if (! NILP (kind))
5547 Fput (new_symbol, Qevent_kind, kind);
5548 }
5549
5550 return new_symbol;
5551 }
5552
5553
5554 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
5555 return a symbol with the modifiers placed in the canonical order.
5556 Canonical order is alphabetical, except for down and drag, which
5557 always come last. The 'click' modifier is never written out.
5558
5559 Fdefine_key calls this to make sure that (for example) C-M-foo
5560 and M-C-foo end up being equivalent in the keymap. */
5561
5562 Lisp_Object
5563 reorder_modifiers (symbol)
5564 Lisp_Object symbol;
5565 {
5566 /* It's hopefully okay to write the code this way, since everything
5567 will soon be in caches, and no consing will be done at all. */
5568 Lisp_Object parsed;
5569
5570 parsed = parse_modifiers (symbol);
5571 return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))),
5572 XCAR (parsed));
5573 }
5574
5575
5576 /* For handling events, we often want to produce a symbol whose name
5577 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
5578 to some base, like the name of a function key or mouse button.
5579 modify_event_symbol produces symbols of this sort.
5580
5581 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
5582 is the name of the i'th symbol. TABLE_SIZE is the number of elements
5583 in the table.
5584
5585 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
5586 into symbol names, or a string specifying a name stem used to
5587 construct a symbol name or the form `STEM-N', where N is the decimal
5588 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
5589 non-nil; otherwise NAME_TABLE is used.
5590
5591 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
5592 persist between calls to modify_event_symbol that it can use to
5593 store a cache of the symbols it's generated for this NAME_TABLE
5594 before. The object stored there may be a vector or an alist.
5595
5596 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
5597
5598 MODIFIERS is a set of modifier bits (as given in struct input_events)
5599 whose prefixes should be applied to the symbol name.
5600
5601 SYMBOL_KIND is the value to be placed in the event_kind property of
5602 the returned symbol.
5603
5604 The symbols we create are supposed to have an
5605 `event-symbol-elements' property, which lists the modifiers present
5606 in the symbol's name. */
5607
5608 static Lisp_Object
5609 modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist_or_stem,
5610 name_table, symbol_table, table_size)
5611 int symbol_num;
5612 unsigned modifiers;
5613 Lisp_Object symbol_kind;
5614 Lisp_Object name_alist_or_stem;
5615 char **name_table;
5616 Lisp_Object *symbol_table;
5617 unsigned int table_size;
5618 {
5619 Lisp_Object value;
5620 Lisp_Object symbol_int;
5621
5622 /* Get rid of the "vendor-specific" bit here. */
5623 XSETINT (symbol_int, symbol_num & 0xffffff);
5624
5625 /* Is this a request for a valid symbol? */
5626 if (symbol_num < 0 || symbol_num >= table_size)
5627 return Qnil;
5628
5629 if (CONSP (*symbol_table))
5630 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
5631
5632 /* If *symbol_table doesn't seem to be initialized properly, fix that.
5633 *symbol_table should be a lisp vector TABLE_SIZE elements long,
5634 where the Nth element is the symbol for NAME_TABLE[N], or nil if
5635 we've never used that symbol before. */
5636 else
5637 {
5638 if (! VECTORP (*symbol_table)
5639 || XVECTOR (*symbol_table)->size != table_size)
5640 {
5641 Lisp_Object size;
5642
5643 XSETFASTINT (size, table_size);
5644 *symbol_table = Fmake_vector (size, Qnil);
5645 }
5646
5647 value = XVECTOR (*symbol_table)->contents[symbol_num];
5648 }
5649
5650 /* Have we already used this symbol before? */
5651 if (NILP (value))
5652 {
5653 /* No; let's create it. */
5654 if (CONSP (name_alist_or_stem))
5655 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
5656 else if (STRINGP (name_alist_or_stem))
5657 {
5658 int len = STRING_BYTES (XSTRING (name_alist_or_stem));
5659 char *buf = (char *) alloca (len + 50);
5660 sprintf (buf, "%s-%d", XSTRING (name_alist_or_stem)->data,
5661 XINT (symbol_int) + 1);
5662 value = intern (buf);
5663 }
5664 else if (name_table != 0 && name_table[symbol_num])
5665 value = intern (name_table[symbol_num]);
5666
5667 #ifdef HAVE_WINDOW_SYSTEM
5668 if (NILP (value))
5669 {
5670 char *name = x_get_keysym_name (symbol_num);
5671 if (name)
5672 value = intern (name);
5673 }
5674 #endif
5675
5676 if (NILP (value))
5677 {
5678 char buf[20];
5679 sprintf (buf, "key-%d", symbol_num);
5680 value = intern (buf);
5681 }
5682
5683 if (CONSP (*symbol_table))
5684 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
5685 else
5686 XVECTOR (*symbol_table)->contents[symbol_num] = value;
5687
5688 /* Fill in the cache entries for this symbol; this also
5689 builds the Qevent_symbol_elements property, which the user
5690 cares about. */
5691 apply_modifiers (modifiers & click_modifier, value);
5692 Fput (value, Qevent_kind, symbol_kind);
5693 }
5694
5695 /* Apply modifiers to that symbol. */
5696 return apply_modifiers (modifiers, value);
5697 }
5698 \f
5699 /* Convert a list that represents an event type,
5700 such as (ctrl meta backspace), into the usual representation of that
5701 event type as a number or a symbol. */
5702
5703 DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
5704 "Convert the event description list EVENT-DESC to an event type.\n\
5705 EVENT-DESC should contain one base event type (a character or symbol)\n\
5706 and zero or more modifier names (control, meta, hyper, super, shift, alt,\n\
5707 drag, down, double or triple). The base must be last.\n\
5708 The return value is an event type (a character or symbol) which\n\
5709 has the same base event type and all the specified modifiers.")
5710 (event_desc)
5711 Lisp_Object event_desc;
5712 {
5713 Lisp_Object base;
5714 int modifiers = 0;
5715 Lisp_Object rest;
5716
5717 base = Qnil;
5718 rest = event_desc;
5719 while (CONSP (rest))
5720 {
5721 Lisp_Object elt;
5722 int this = 0;
5723
5724 elt = XCAR (rest);
5725 rest = XCDR (rest);
5726
5727 /* Given a symbol, see if it is a modifier name. */
5728 if (SYMBOLP (elt) && CONSP (rest))
5729 this = parse_solitary_modifier (elt);
5730
5731 if (this != 0)
5732 modifiers |= this;
5733 else if (!NILP (base))
5734 error ("Two bases given in one event");
5735 else
5736 base = elt;
5737
5738 }
5739
5740 /* Let the symbol A refer to the character A. */
5741 if (SYMBOLP (base) && XSYMBOL (base)->name->size == 1)
5742 XSETINT (base, XSYMBOL (base)->name->data[0]);
5743
5744 if (INTEGERP (base))
5745 {
5746 /* Turn (shift a) into A. */
5747 if ((modifiers & shift_modifier) != 0
5748 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
5749 {
5750 XSETINT (base, XINT (base) - ('a' - 'A'));
5751 modifiers &= ~shift_modifier;
5752 }
5753
5754 /* Turn (control a) into C-a. */
5755 if (modifiers & ctrl_modifier)
5756 return make_number ((modifiers & ~ctrl_modifier)
5757 | make_ctrl_char (XINT (base)));
5758 else
5759 return make_number (modifiers | XINT (base));
5760 }
5761 else if (SYMBOLP (base))
5762 return apply_modifiers (modifiers, base);
5763 else
5764 {
5765 error ("Invalid base event");
5766 return Qnil;
5767 }
5768 }
5769
5770 /* Try to recognize SYMBOL as a modifier name.
5771 Return the modifier flag bit, or 0 if not recognized. */
5772
5773 static int
5774 parse_solitary_modifier (symbol)
5775 Lisp_Object symbol;
5776 {
5777 struct Lisp_String *name = XSYMBOL (symbol)->name;
5778
5779 switch (name->data[0])
5780 {
5781 #define SINGLE_LETTER_MOD(BIT) \
5782 if (STRING_BYTES (name) == 1) \
5783 return BIT;
5784
5785 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
5786 if (LEN == STRING_BYTES (name) \
5787 && ! strncmp (name->data, NAME, LEN)) \
5788 return BIT;
5789
5790 case 'A':
5791 SINGLE_LETTER_MOD (alt_modifier);
5792 break;
5793
5794 case 'a':
5795 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
5796 break;
5797
5798 case 'C':
5799 SINGLE_LETTER_MOD (ctrl_modifier);
5800 break;
5801
5802 case 'c':
5803 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
5804 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
5805 break;
5806
5807 case 'H':
5808 SINGLE_LETTER_MOD (hyper_modifier);
5809 break;
5810
5811 case 'h':
5812 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
5813 break;
5814
5815 case 'M':
5816 SINGLE_LETTER_MOD (meta_modifier);
5817 break;
5818
5819 case 'm':
5820 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
5821 break;
5822
5823 case 'S':
5824 SINGLE_LETTER_MOD (shift_modifier);
5825 break;
5826
5827 case 's':
5828 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
5829 MULTI_LETTER_MOD (super_modifier, "super", 5);
5830 SINGLE_LETTER_MOD (super_modifier);
5831 break;
5832
5833 case 'd':
5834 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
5835 MULTI_LETTER_MOD (down_modifier, "down", 4);
5836 MULTI_LETTER_MOD (double_modifier, "double", 6);
5837 break;
5838
5839 case 't':
5840 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
5841 break;
5842
5843 #undef SINGLE_LETTER_MOD
5844 #undef MULTI_LETTER_MOD
5845 }
5846
5847 return 0;
5848 }
5849
5850 /* Return 1 if EVENT is a list whose elements are all integers or symbols.
5851 Such a list is not valid as an event,
5852 but it can be a Lucid-style event type list. */
5853
5854 int
5855 lucid_event_type_list_p (object)
5856 Lisp_Object object;
5857 {
5858 Lisp_Object tail;
5859
5860 if (! CONSP (object))
5861 return 0;
5862
5863 if (EQ (XCAR (object), Qhelp_echo)
5864 || EQ (XCAR (object), Qvertical_line)
5865 || EQ (XCAR (object), Qmode_line)
5866 || EQ (XCAR (object), Qheader_line))
5867 return 0;
5868
5869 for (tail = object; CONSP (tail); tail = XCDR (tail))
5870 {
5871 Lisp_Object elt;
5872 elt = XCAR (tail);
5873 if (! (INTEGERP (elt) || SYMBOLP (elt)))
5874 return 0;
5875 }
5876
5877 return NILP (tail);
5878 }
5879 \f
5880 /* Store into *addr a value nonzero if terminal input chars are available.
5881 Serves the purpose of ioctl (0, FIONREAD, addr)
5882 but works even if FIONREAD does not exist.
5883 (In fact, this may actually read some input.)
5884
5885 If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe. */
5886
5887 static void
5888 get_input_pending (addr, do_timers_now)
5889 int *addr;
5890 int do_timers_now;
5891 {
5892 /* First of all, have we already counted some input? */
5893 *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
5894
5895 /* If input is being read as it arrives, and we have none, there is none. */
5896 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
5897 return;
5898
5899 /* Try to read some input and see how much we get. */
5900 gobble_input (0);
5901 *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
5902 }
5903
5904 /* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
5905
5906 void
5907 gobble_input (expected)
5908 int expected;
5909 {
5910 #ifndef VMS
5911 #ifdef SIGIO
5912 if (interrupt_input)
5913 {
5914 SIGMASKTYPE mask;
5915 mask = sigblock (sigmask (SIGIO));
5916 read_avail_input (expected);
5917 sigsetmask (mask);
5918 }
5919 else
5920 #ifdef POLL_FOR_INPUT
5921 if (read_socket_hook && !interrupt_input && poll_suppress_count == 0)
5922 {
5923 SIGMASKTYPE mask;
5924 mask = sigblock (sigmask (SIGALRM));
5925 read_avail_input (expected);
5926 sigsetmask (mask);
5927 }
5928 else
5929 #endif
5930 #endif
5931 read_avail_input (expected);
5932 #endif
5933 }
5934
5935 /* Put a buffer_switch_event in the buffer
5936 so that read_key_sequence will notice the new current buffer. */
5937
5938 void
5939 record_asynch_buffer_change ()
5940 {
5941 struct input_event event;
5942 Lisp_Object tem;
5943
5944 event.kind = buffer_switch_event;
5945 event.frame_or_window = Qnil;
5946 event.arg = Qnil;
5947
5948 #ifdef subprocesses
5949 /* We don't need a buffer-switch event unless Emacs is waiting for input.
5950 The purpose of the event is to make read_key_sequence look up the
5951 keymaps again. If we aren't in read_key_sequence, we don't need one,
5952 and the event could cause trouble by messing up (input-pending-p). */
5953 tem = Fwaiting_for_user_input_p ();
5954 if (NILP (tem))
5955 return;
5956 #else
5957 /* We never need these events if we have no asynchronous subprocesses. */
5958 return;
5959 #endif
5960
5961 /* Make sure no interrupt happens while storing the event. */
5962 #ifdef SIGIO
5963 if (interrupt_input)
5964 {
5965 SIGMASKTYPE mask;
5966 mask = sigblock (sigmask (SIGIO));
5967 kbd_buffer_store_event (&event);
5968 sigsetmask (mask);
5969 }
5970 else
5971 #endif
5972 {
5973 stop_polling ();
5974 kbd_buffer_store_event (&event);
5975 start_polling ();
5976 }
5977 }
5978 \f
5979 #ifndef VMS
5980
5981 /* Read any terminal input already buffered up by the system
5982 into the kbd_buffer, but do not wait.
5983
5984 EXPECTED should be nonzero if the caller knows there is some input.
5985
5986 Except on VMS, all input is read by this function.
5987 If interrupt_input is nonzero, this function MUST be called
5988 only when SIGIO is blocked.
5989
5990 Returns the number of keyboard chars read, or -1 meaning
5991 this is a bad time to try to read input. */
5992
5993 static int
5994 read_avail_input (expected)
5995 int expected;
5996 {
5997 struct input_event buf[KBD_BUFFER_SIZE];
5998 register int i;
5999 int nread;
6000
6001 if (read_socket_hook)
6002 /* No need for FIONREAD or fcntl; just say don't wait. */
6003 nread = (*read_socket_hook) (input_fd, buf, KBD_BUFFER_SIZE, expected);
6004 else
6005 {
6006 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
6007 the kbd_buffer can really hold. That may prevent loss
6008 of characters on some systems when input is stuffed at us. */
6009 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
6010 int n_to_read;
6011
6012 /* Determine how many characters we should *try* to read. */
6013 #ifdef WINDOWSNT
6014 return 0;
6015 #else /* not WINDOWSNT */
6016 #ifdef MSDOS
6017 n_to_read = dos_keysns ();
6018 if (n_to_read == 0)
6019 return 0;
6020 #else /* not MSDOS */
6021 #ifdef FIONREAD
6022 /* Find out how much input is available. */
6023 if (ioctl (input_fd, FIONREAD, &n_to_read) < 0)
6024 /* Formerly simply reported no input, but that sometimes led to
6025 a failure of Emacs to terminate.
6026 SIGHUP seems appropriate if we can't reach the terminal. */
6027 /* ??? Is it really right to send the signal just to this process
6028 rather than to the whole process group?
6029 Perhaps on systems with FIONREAD Emacs is alone in its group. */
6030 kill (getpid (), SIGHUP);
6031 if (n_to_read == 0)
6032 return 0;
6033 if (n_to_read > sizeof cbuf)
6034 n_to_read = sizeof cbuf;
6035 #else /* no FIONREAD */
6036 #if defined (USG) || defined (DGUX)
6037 /* Read some input if available, but don't wait. */
6038 n_to_read = sizeof cbuf;
6039 fcntl (input_fd, F_SETFL, O_NDELAY);
6040 #else
6041 you lose;
6042 #endif
6043 #endif
6044 #endif /* not MSDOS */
6045 #endif /* not WINDOWSNT */
6046
6047 /* Now read; for one reason or another, this will not block.
6048 NREAD is set to the number of chars read. */
6049 do
6050 {
6051 #ifdef MSDOS
6052 cbuf[0] = dos_keyread ();
6053 nread = 1;
6054 #else
6055 nread = emacs_read (input_fd, cbuf, n_to_read);
6056 #endif
6057 /* POSIX infers that processes which are not in the session leader's
6058 process group won't get SIGHUP's at logout time. BSDI adheres to
6059 this part standard and returns -1 from read (0) with errno==EIO
6060 when the control tty is taken away.
6061 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
6062 if (nread == -1 && errno == EIO)
6063 kill (0, SIGHUP);
6064 #if defined (AIX) && (! defined (aix386) && defined (_BSD))
6065 /* The kernel sometimes fails to deliver SIGHUP for ptys.
6066 This looks incorrect, but it isn't, because _BSD causes
6067 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
6068 and that causes a value other than 0 when there is no input. */
6069 if (nread == 0)
6070 kill (0, SIGHUP);
6071 #endif
6072 }
6073 while (
6074 /* We used to retry the read if it was interrupted.
6075 But this does the wrong thing when O_NDELAY causes
6076 an EAGAIN error. Does anybody know of a situation
6077 where a retry is actually needed? */
6078 #if 0
6079 nread < 0 && (errno == EAGAIN
6080 #ifdef EFAULT
6081 || errno == EFAULT
6082 #endif
6083 #ifdef EBADSLT
6084 || errno == EBADSLT
6085 #endif
6086 )
6087 #else
6088 0
6089 #endif
6090 );
6091
6092 #ifndef FIONREAD
6093 #if defined (USG) || defined (DGUX)
6094 fcntl (input_fd, F_SETFL, 0);
6095 #endif /* USG or DGUX */
6096 #endif /* no FIONREAD */
6097 for (i = 0; i < nread; i++)
6098 {
6099 buf[i].kind = ascii_keystroke;
6100 buf[i].modifiers = 0;
6101 if (meta_key == 1 && (cbuf[i] & 0x80))
6102 buf[i].modifiers = meta_modifier;
6103 if (meta_key != 2)
6104 cbuf[i] &= ~0x80;
6105
6106 buf[i].code = cbuf[i];
6107 buf[i].frame_or_window = selected_frame;
6108 buf[i].arg = Qnil;
6109 }
6110 }
6111
6112 /* Scan the chars for C-g and store them in kbd_buffer. */
6113 for (i = 0; i < nread; i++)
6114 {
6115 kbd_buffer_store_event (&buf[i]);
6116 /* Don't look at input that follows a C-g too closely.
6117 This reduces lossage due to autorepeat on C-g. */
6118 if (buf[i].kind == ascii_keystroke
6119 && buf[i].code == quit_char)
6120 break;
6121 }
6122
6123 return nread;
6124 }
6125 #endif /* not VMS */
6126 \f
6127 #ifdef SIGIO /* for entire page */
6128 /* Note SIGIO has been undef'd if FIONREAD is missing. */
6129
6130 SIGTYPE
6131 input_available_signal (signo)
6132 int signo;
6133 {
6134 /* Must preserve main program's value of errno. */
6135 int old_errno = errno;
6136 #ifdef BSD4_1
6137 extern int select_alarmed;
6138 #endif
6139
6140 #if defined (USG) && !defined (POSIX_SIGNALS)
6141 /* USG systems forget handlers when they are used;
6142 must reestablish each time */
6143 signal (signo, input_available_signal);
6144 #endif /* USG */
6145
6146 #ifdef BSD4_1
6147 sigisheld (SIGIO);
6148 #endif
6149
6150 if (input_available_clear_time)
6151 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
6152
6153 while (1)
6154 {
6155 int nread;
6156 nread = read_avail_input (1);
6157 /* -1 means it's not ok to read the input now.
6158 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
6159 0 means there was no keyboard input available. */
6160 if (nread <= 0)
6161 break;
6162
6163 #ifdef BSD4_1
6164 select_alarmed = 1; /* Force the select emulator back to life */
6165 #endif
6166 }
6167
6168 #ifdef BSD4_1
6169 sigfree ();
6170 #endif
6171 errno = old_errno;
6172 }
6173 #endif /* SIGIO */
6174
6175 /* Send ourselves a SIGIO.
6176
6177 This function exists so that the UNBLOCK_INPUT macro in
6178 blockinput.h can have some way to take care of input we put off
6179 dealing with, without assuming that every file which uses
6180 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
6181 void
6182 reinvoke_input_signal ()
6183 {
6184 #ifdef SIGIO
6185 kill (getpid (), SIGIO);
6186 #endif
6187 }
6188
6189
6190 \f
6191 /* Return the prompt-string of a sparse keymap.
6192 This is the first element which is a string.
6193 Return nil if there is none. */
6194
6195 Lisp_Object
6196 map_prompt (map)
6197 Lisp_Object map;
6198 {
6199 while (CONSP (map))
6200 {
6201 register Lisp_Object tem;
6202 tem = Fcar (map);
6203 if (STRINGP (tem))
6204 return tem;
6205 map = Fcdr (map);
6206 }
6207 return Qnil;
6208 }
6209
6210 static void menu_bar_item P_ ((Lisp_Object, Lisp_Object));
6211 static void menu_bar_one_keymap P_ ((Lisp_Object));
6212
6213 /* These variables hold the vector under construction within
6214 menu_bar_items and its subroutines, and the current index
6215 for storing into that vector. */
6216 static Lisp_Object menu_bar_items_vector;
6217 static int menu_bar_items_index;
6218
6219 /* Return a vector of menu items for a menu bar, appropriate
6220 to the current buffer. Each item has three elements in the vector:
6221 KEY STRING MAPLIST.
6222
6223 OLD is an old vector we can optionally reuse, or nil. */
6224
6225 Lisp_Object
6226 menu_bar_items (old)
6227 Lisp_Object old;
6228 {
6229 /* The number of keymaps we're scanning right now, and the number of
6230 keymaps we have allocated space for. */
6231 int nmaps;
6232
6233 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
6234 in the current keymaps, or nil where it is not a prefix. */
6235 Lisp_Object *maps;
6236
6237 Lisp_Object def, tem, tail;
6238
6239 Lisp_Object result;
6240
6241 int mapno;
6242 Lisp_Object oquit;
6243
6244 int i;
6245
6246 struct gcpro gcpro1;
6247
6248 /* In order to build the menus, we need to call the keymap
6249 accessors. They all call QUIT. But this function is called
6250 during redisplay, during which a quit is fatal. So inhibit
6251 quitting while building the menus.
6252 We do this instead of specbind because (1) errors will clear it anyway
6253 and (2) this avoids risk of specpdl overflow. */
6254 oquit = Vinhibit_quit;
6255 Vinhibit_quit = Qt;
6256
6257 if (!NILP (old))
6258 menu_bar_items_vector = old;
6259 else
6260 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
6261 menu_bar_items_index = 0;
6262
6263 GCPRO1 (menu_bar_items_vector);
6264
6265 /* Build our list of keymaps.
6266 If we recognize a function key and replace its escape sequence in
6267 keybuf with its symbol, or if the sequence starts with a mouse
6268 click and we need to switch buffers, we jump back here to rebuild
6269 the initial keymaps from the current buffer. */
6270 {
6271 Lisp_Object *tmaps;
6272
6273 /* Should overriding-terminal-local-map and overriding-local-map apply? */
6274 if (!NILP (Voverriding_local_map_menu_flag))
6275 {
6276 /* Yes, use them (if non-nil) as well as the global map. */
6277 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
6278 nmaps = 0;
6279 if (!NILP (current_kboard->Voverriding_terminal_local_map))
6280 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
6281 if (!NILP (Voverriding_local_map))
6282 maps[nmaps++] = Voverriding_local_map;
6283 }
6284 else
6285 {
6286 /* No, so use major and minor mode keymaps and keymap property. */
6287 int extra_maps = 2;
6288 Lisp_Object map = get_local_map (PT, current_buffer, keymap);
6289 if (!NILP (map))
6290 extra_maps = 3;
6291 nmaps = current_minor_maps (NULL, &tmaps);
6292 maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
6293 * sizeof (maps[0]));
6294 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
6295 if (!NILP (map))
6296 maps[nmaps++] = map;
6297 maps[nmaps++] = get_local_map (PT, current_buffer, local_map);
6298 }
6299 maps[nmaps++] = current_global_map;
6300 }
6301
6302 /* Look up in each map the dummy prefix key `menu-bar'. */
6303
6304 result = Qnil;
6305
6306 for (mapno = nmaps - 1; mapno >= 0; mapno--)
6307 if (!NILP (maps[mapno]))
6308 {
6309 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 0),
6310 0, 0);
6311 if (CONSP (def))
6312 menu_bar_one_keymap (def);
6313 }
6314
6315 /* Move to the end those items that should be at the end. */
6316
6317 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
6318 {
6319 int i;
6320 int end = menu_bar_items_index;
6321
6322 for (i = 0; i < end; i += 4)
6323 if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i]))
6324 {
6325 Lisp_Object tem0, tem1, tem2, tem3;
6326 /* Move the item at index I to the end,
6327 shifting all the others forward. */
6328 tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
6329 tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
6330 tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
6331 tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
6332 if (end > i + 4)
6333 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
6334 &XVECTOR (menu_bar_items_vector)->contents[i],
6335 (end - i - 4) * sizeof (Lisp_Object));
6336 XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
6337 XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
6338 XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
6339 XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
6340 break;
6341 }
6342 }
6343
6344 /* Add nil, nil, nil, nil at the end. */
6345 i = menu_bar_items_index;
6346 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
6347 {
6348 Lisp_Object tem;
6349 tem = Fmake_vector (make_number (2 * i), Qnil);
6350 bcopy (XVECTOR (menu_bar_items_vector)->contents,
6351 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
6352 menu_bar_items_vector = tem;
6353 }
6354 /* Add this item. */
6355 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6356 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6357 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6358 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
6359 menu_bar_items_index = i;
6360
6361 Vinhibit_quit = oquit;
6362 UNGCPRO;
6363 return menu_bar_items_vector;
6364 }
6365 \f
6366 /* Scan one map KEYMAP, accumulating any menu items it defines
6367 in menu_bar_items_vector. */
6368
6369 static Lisp_Object menu_bar_one_keymap_changed_items;
6370
6371 static void
6372 menu_bar_one_keymap (keymap)
6373 Lisp_Object keymap;
6374 {
6375 Lisp_Object tail, item;
6376
6377 menu_bar_one_keymap_changed_items = Qnil;
6378
6379 /* Loop over all keymap entries that have menu strings. */
6380 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
6381 {
6382 item = XCAR (tail);
6383 if (CONSP (item))
6384 menu_bar_item (XCAR (item), XCDR (item));
6385 else if (VECTORP (item))
6386 {
6387 /* Loop over the char values represented in the vector. */
6388 int len = XVECTOR (item)->size;
6389 int c;
6390 for (c = 0; c < len; c++)
6391 {
6392 Lisp_Object character;
6393 XSETFASTINT (character, c);
6394 menu_bar_item (character, XVECTOR (item)->contents[c]);
6395 }
6396 }
6397 }
6398 }
6399
6400 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
6401 If there's already an item for KEY, add this DEF to it. */
6402
6403 Lisp_Object item_properties;
6404
6405 static void
6406 menu_bar_item (key, item)
6407 Lisp_Object key, item;
6408 {
6409 struct gcpro gcpro1;
6410 int i;
6411 Lisp_Object tem;
6412
6413 if (EQ (item, Qundefined))
6414 {
6415 /* If a map has an explicit `undefined' as definition,
6416 discard any previously made menu bar item. */
6417
6418 for (i = 0; i < menu_bar_items_index; i += 4)
6419 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
6420 {
6421 if (menu_bar_items_index > i + 4)
6422 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
6423 &XVECTOR (menu_bar_items_vector)->contents[i],
6424 (menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
6425 menu_bar_items_index -= 4;
6426 }
6427 }
6428
6429 /* If this keymap has already contributed to this KEY,
6430 don't contribute to it a second time. */
6431 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
6432 if (!NILP (tem) || NILP (item))
6433 return;
6434
6435 menu_bar_one_keymap_changed_items
6436 = Fcons (key, menu_bar_one_keymap_changed_items);
6437
6438 /* We add to menu_bar_one_keymap_changed_items before doing the
6439 parse_menu_item, so that if it turns out it wasn't a menu item,
6440 it still correctly hides any further menu item. */
6441 GCPRO1 (key);
6442 i = parse_menu_item (item, 0, 1);
6443 UNGCPRO;
6444 if (!i)
6445 return;
6446
6447 item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
6448
6449 /* Find any existing item for this KEY. */
6450 for (i = 0; i < menu_bar_items_index; i += 4)
6451 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
6452 break;
6453
6454 /* If we did not find this KEY, add it at the end. */
6455 if (i == menu_bar_items_index)
6456 {
6457 /* If vector is too small, get a bigger one. */
6458 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
6459 {
6460 Lisp_Object tem;
6461 tem = Fmake_vector (make_number (2 * i), Qnil);
6462 bcopy (XVECTOR (menu_bar_items_vector)->contents,
6463 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
6464 menu_bar_items_vector = tem;
6465 }
6466
6467 /* Add this item. */
6468 XVECTOR (menu_bar_items_vector)->contents[i++] = key;
6469 XVECTOR (menu_bar_items_vector)->contents[i++]
6470 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
6471 XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
6472 XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
6473 menu_bar_items_index = i;
6474 }
6475 /* We did find an item for this KEY. Add ITEM to its list of maps. */
6476 else
6477 {
6478 Lisp_Object old;
6479 old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
6480 XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (item, old);
6481 }
6482 }
6483 \f
6484 /* This is used as the handler when calling menu_item_eval_property. */
6485 static Lisp_Object
6486 menu_item_eval_property_1 (arg)
6487 Lisp_Object arg;
6488 {
6489 /* If we got a quit from within the menu computation,
6490 quit all the way out of it. This takes care of C-] in the debugger. */
6491 if (CONSP (arg) && EQ (XCAR (arg), Qquit))
6492 Fsignal (Qquit, Qnil);
6493
6494 return Qnil;
6495 }
6496
6497 /* Evaluate an expression and return the result (or nil if something
6498 went wrong). Used to evaluate dynamic parts of menu items. */
6499 Lisp_Object
6500 menu_item_eval_property (sexpr)
6501 Lisp_Object sexpr;
6502 {
6503 int count = specpdl_ptr - specpdl;
6504 Lisp_Object val;
6505 specbind (Qinhibit_redisplay, Qt);
6506 val = internal_condition_case_1 (Feval, sexpr, Qerror,
6507 menu_item_eval_property_1);
6508 return unbind_to (count, val);
6509 }
6510
6511 /* This function parses a menu item and leaves the result in the
6512 vector item_properties.
6513 ITEM is a key binding, a possible menu item.
6514 If NOTREAL is nonzero, only check for equivalent key bindings, don't
6515 evaluate dynamic expressions in the menu item.
6516 INMENUBAR is > 0 when this is considered for an entry in a menu bar
6517 top level.
6518 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
6519 parse_menu_item returns true if the item is a menu item and false
6520 otherwise. */
6521
6522 int
6523 parse_menu_item (item, notreal, inmenubar)
6524 Lisp_Object item;
6525 int notreal, inmenubar;
6526 {
6527 Lisp_Object def, tem, item_string, start;
6528 Lisp_Object cachelist;
6529 Lisp_Object filter;
6530 Lisp_Object keyhint;
6531 int i;
6532 int newcache = 0;
6533
6534 cachelist = Qnil;
6535 filter = Qnil;
6536 keyhint = Qnil;
6537
6538 if (!CONSP (item))
6539 return 0;
6540
6541 /* Create item_properties vector if necessary. */
6542 if (NILP (item_properties))
6543 item_properties
6544 = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
6545
6546 /* Initialize optional entries. */
6547 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
6548 AREF (item_properties, i) = Qnil;
6549 AREF (item_properties, ITEM_PROPERTY_ENABLE) = Qt;
6550
6551 /* Save the item here to protect it from GC. */
6552 AREF (item_properties, ITEM_PROPERTY_ITEM) = item;
6553
6554 item_string = XCAR (item);
6555
6556 start = item;
6557 item = XCDR (item);
6558 if (STRINGP (item_string))
6559 {
6560 /* Old format menu item. */
6561 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
6562
6563 /* Maybe help string. */
6564 if (CONSP (item) && STRINGP (XCAR (item)))
6565 {
6566 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
6567 start = item;
6568 item = XCDR (item);
6569 }
6570
6571 /* Maybe key binding cache. */
6572 if (CONSP (item) && CONSP (XCAR (item))
6573 && (NILP (XCAR (XCAR (item)))
6574 || VECTORP (XCAR (XCAR (item)))))
6575 {
6576 cachelist = XCAR (item);
6577 item = XCDR (item);
6578 }
6579
6580 /* This is the real definition--the function to run. */
6581 AREF (item_properties, ITEM_PROPERTY_DEF) = item;
6582
6583 /* Get enable property, if any. */
6584 if (SYMBOLP (item))
6585 {
6586 tem = Fget (item, Qmenu_enable);
6587 if (!NILP (tem))
6588 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
6589 }
6590 }
6591 else if (EQ (item_string, Qmenu_item) && CONSP (item))
6592 {
6593 /* New format menu item. */
6594 AREF (item_properties, ITEM_PROPERTY_NAME) = XCAR (item);
6595 start = XCDR (item);
6596 if (CONSP (start))
6597 {
6598 /* We have a real binding. */
6599 AREF (item_properties, ITEM_PROPERTY_DEF) = XCAR (start);
6600
6601 item = XCDR (start);
6602 /* Is there a cache list with key equivalences. */
6603 if (CONSP (item) && CONSP (XCAR (item)))
6604 {
6605 cachelist = XCAR (item);
6606 item = XCDR (item);
6607 }
6608
6609 /* Parse properties. */
6610 while (CONSP (item) && CONSP (XCDR (item)))
6611 {
6612 tem = XCAR (item);
6613 item = XCDR (item);
6614
6615 if (EQ (tem, QCenable))
6616 AREF (item_properties, ITEM_PROPERTY_ENABLE) = XCAR (item);
6617 else if (EQ (tem, QCvisible) && !notreal)
6618 {
6619 /* If got a visible property and that evaluates to nil
6620 then ignore this item. */
6621 tem = menu_item_eval_property (XCAR (item));
6622 if (NILP (tem))
6623 return 0;
6624 }
6625 else if (EQ (tem, QChelp))
6626 AREF (item_properties, ITEM_PROPERTY_HELP) = XCAR (item);
6627 else if (EQ (tem, QCfilter))
6628 filter = item;
6629 else if (EQ (tem, QCkey_sequence))
6630 {
6631 tem = XCAR (item);
6632 if (NILP (cachelist)
6633 && (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem)))
6634 /* Be GC protected. Set keyhint to item instead of tem. */
6635 keyhint = item;
6636 }
6637 else if (EQ (tem, QCkeys))
6638 {
6639 tem = XCAR (item);
6640 if (CONSP (tem) || (STRINGP (tem) && NILP (cachelist)))
6641 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
6642 }
6643 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
6644 {
6645 Lisp_Object type;
6646 tem = XCAR (item);
6647 type = XCAR (tem);
6648 if (EQ (type, QCtoggle) || EQ (type, QCradio))
6649 {
6650 AREF (item_properties, ITEM_PROPERTY_SELECTED)
6651 = XCDR (tem);
6652 AREF (item_properties, ITEM_PROPERTY_TYPE)
6653 = type;
6654 }
6655 }
6656 item = XCDR (item);
6657 }
6658 }
6659 else if (inmenubar || !NILP (start))
6660 return 0;
6661 }
6662 else
6663 return 0; /* not a menu item */
6664
6665 /* If item string is not a string, evaluate it to get string.
6666 If we don't get a string, skip this item. */
6667 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
6668 if (!(STRINGP (item_string) || notreal))
6669 {
6670 item_string = menu_item_eval_property (item_string);
6671 if (!STRINGP (item_string))
6672 return 0;
6673 AREF (item_properties, ITEM_PROPERTY_NAME) = item_string;
6674 }
6675
6676 /* If got a filter apply it on definition. */
6677 def = AREF (item_properties, ITEM_PROPERTY_DEF);
6678 if (!NILP (filter))
6679 {
6680 def = menu_item_eval_property (list2 (XCAR (filter),
6681 list2 (Qquote, def)));
6682
6683 AREF (item_properties, ITEM_PROPERTY_DEF) = def;
6684 }
6685
6686 /* If we got no definition, this item is just unselectable text which
6687 is OK in a submenu but not in the menubar. */
6688 if (NILP (def))
6689 return (inmenubar ? 0 : 1);
6690
6691 /* Enable or disable selection of item. */
6692 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
6693 if (!EQ (tem, Qt))
6694 {
6695 if (notreal)
6696 tem = Qt;
6697 else
6698 tem = menu_item_eval_property (tem);
6699 if (inmenubar && NILP (tem))
6700 return 0; /* Ignore disabled items in menu bar. */
6701 AREF (item_properties, ITEM_PROPERTY_ENABLE) = tem;
6702 }
6703
6704 /* See if this is a separate pane or a submenu. */
6705 def = AREF (item_properties, ITEM_PROPERTY_DEF);
6706 tem = get_keymap (def, 0, 1);
6707 /* For a subkeymap, just record its details and exit. */
6708 if (CONSP (tem))
6709 {
6710 AREF (item_properties, ITEM_PROPERTY_MAP) = tem;
6711 AREF (item_properties, ITEM_PROPERTY_DEF) = tem;
6712 return 1;
6713 }
6714
6715 /* At the top level in the menu bar, do likewise for commands also.
6716 The menu bar does not display equivalent key bindings anyway.
6717 ITEM_PROPERTY_DEF is already set up properly. */
6718 if (inmenubar > 0)
6719 return 1;
6720
6721 /* This is a command. See if there is an equivalent key binding. */
6722 if (NILP (cachelist))
6723 {
6724 /* We have to create a cachelist. */
6725 CHECK_IMPURE (start);
6726 XCDR (start) = Fcons (Fcons (Qnil, Qnil), XCDR (start));
6727 cachelist = XCAR (XCDR (start));
6728 newcache = 1;
6729 tem = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
6730 if (!NILP (keyhint))
6731 {
6732 XCAR (cachelist) = XCAR (keyhint);
6733 newcache = 0;
6734 }
6735 else if (STRINGP (tem))
6736 {
6737 XCDR (cachelist) = Fsubstitute_command_keys (tem);
6738 XCAR (cachelist) = Qt;
6739 }
6740 }
6741
6742 tem = XCAR (cachelist);
6743 if (!EQ (tem, Qt))
6744 {
6745 int chkcache = 0;
6746 Lisp_Object prefix;
6747
6748 if (!NILP (tem))
6749 tem = Fkey_binding (tem, Qnil);
6750
6751 prefix = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
6752 if (CONSP (prefix))
6753 {
6754 def = XCAR (prefix);
6755 prefix = XCDR (prefix);
6756 }
6757 else
6758 def = AREF (item_properties, ITEM_PROPERTY_DEF);
6759
6760 if (!update_menu_bindings)
6761 chkcache = 0;
6762 else if (NILP (XCAR (cachelist))) /* Have no saved key. */
6763 {
6764 if (newcache /* Always check first time. */
6765 /* Should we check everything when precomputing key
6766 bindings? */
6767 /* If something had no key binding before, don't recheck it
6768 because that is too slow--except if we have a list of
6769 rebound commands in Vdefine_key_rebound_commands, do
6770 recheck any command that appears in that list. */
6771 || (CONSP (Vdefine_key_rebound_commands)
6772 && !NILP (Fmemq (def, Vdefine_key_rebound_commands))))
6773 chkcache = 1;
6774 }
6775 /* We had a saved key. Is it still bound to the command? */
6776 else if (NILP (tem)
6777 || (!EQ (tem, def)
6778 /* If the command is an alias for another
6779 (such as lmenu.el set it up), check if the
6780 original command matches the cached command. */
6781 && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))))
6782 chkcache = 1; /* Need to recompute key binding. */
6783
6784 if (chkcache)
6785 {
6786 /* Recompute equivalent key binding. If the command is an alias
6787 for another (such as lmenu.el set it up), see if the original
6788 command name has equivalent keys. Otherwise look up the
6789 specified command itself. We don't try both, because that
6790 makes lmenu menus slow. */
6791 if (SYMBOLP (def)
6792 && SYMBOLP (XSYMBOL (def)->function)
6793 && ! NILP (Fget (def, Qmenu_alias)))
6794 def = XSYMBOL (def)->function;
6795 tem = Fwhere_is_internal (def, Qnil, Qt, Qnil);
6796 XCAR (cachelist) = tem;
6797 if (NILP (tem))
6798 {
6799 XCDR (cachelist) = Qnil;
6800 chkcache = 0;
6801 }
6802 }
6803 else if (!NILP (keyhint) && !NILP (XCAR (cachelist)))
6804 {
6805 tem = XCAR (cachelist);
6806 chkcache = 1;
6807 }
6808
6809 newcache = chkcache;
6810 if (chkcache)
6811 {
6812 tem = Fkey_description (tem);
6813 if (CONSP (prefix))
6814 {
6815 if (STRINGP (XCAR (prefix)))
6816 tem = concat2 (XCAR (prefix), tem);
6817 if (STRINGP (XCDR (prefix)))
6818 tem = concat2 (tem, XCDR (prefix));
6819 }
6820 XCDR (cachelist) = tem;
6821 }
6822 }
6823
6824 tem = XCDR (cachelist);
6825 if (newcache && !NILP (tem))
6826 {
6827 tem = concat3 (build_string (" ("), tem, build_string (")"));
6828 XCDR (cachelist) = tem;
6829 }
6830
6831 /* If we only want to precompute equivalent key bindings, stop here. */
6832 if (notreal)
6833 return 1;
6834
6835 /* If we have an equivalent key binding, use that. */
6836 AREF (item_properties, ITEM_PROPERTY_KEYEQ) = tem;
6837
6838 /* Include this when menu help is implemented.
6839 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
6840 if (!(NILP (tem) || STRINGP (tem)))
6841 {
6842 tem = menu_item_eval_property (tem);
6843 if (!STRINGP (tem))
6844 tem = Qnil;
6845 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
6846 }
6847 */
6848
6849 /* Handle radio buttons or toggle boxes. */
6850 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
6851 if (!NILP (tem))
6852 AREF (item_properties, ITEM_PROPERTY_SELECTED)
6853 = menu_item_eval_property (tem);
6854
6855 return 1;
6856 }
6857
6858
6859 \f
6860 /***********************************************************************
6861 Tool-bars
6862 ***********************************************************************/
6863
6864 /* A vector holding tool bar items while they are parsed in function
6865 tool_bar_items runs Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
6866 in the vector. */
6867
6868 static Lisp_Object tool_bar_items_vector;
6869
6870 /* A vector holding the result of parse_tool_bar_item. Layout is like
6871 the one for a single item in tool_bar_items_vector. */
6872
6873 static Lisp_Object tool_bar_item_properties;
6874
6875 /* Next free index in tool_bar_items_vector. */
6876
6877 static int ntool_bar_items;
6878
6879 /* The symbols `tool-bar', and `:image'. */
6880
6881 extern Lisp_Object Qtool_bar;
6882 Lisp_Object QCimage;
6883
6884 /* Function prototypes. */
6885
6886 static void init_tool_bar_items P_ ((Lisp_Object));
6887 static void process_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
6888 static int parse_tool_bar_item P_ ((Lisp_Object, Lisp_Object));
6889 static void append_tool_bar_item P_ ((void));
6890
6891
6892 /* Return a vector of tool bar items for keymaps currently in effect.
6893 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
6894 tool bar items found. */
6895
6896 Lisp_Object
6897 tool_bar_items (reuse, nitems)
6898 Lisp_Object reuse;
6899 int *nitems;
6900 {
6901 Lisp_Object *maps;
6902 int nmaps, i;
6903 Lisp_Object oquit;
6904 Lisp_Object *tmaps;
6905 extern Lisp_Object Voverriding_local_map_menu_flag;
6906 extern Lisp_Object Voverriding_local_map;
6907
6908 *nitems = 0;
6909
6910 /* In order to build the menus, we need to call the keymap
6911 accessors. They all call QUIT. But this function is called
6912 during redisplay, during which a quit is fatal. So inhibit
6913 quitting while building the menus. We do this instead of
6914 specbind because (1) errors will clear it anyway and (2) this
6915 avoids risk of specpdl overflow. */
6916 oquit = Vinhibit_quit;
6917 Vinhibit_quit = Qt;
6918
6919 /* Initialize tool_bar_items_vector and protect it from GC. */
6920 init_tool_bar_items (reuse);
6921
6922 /* Build list of keymaps in maps. Set nmaps to the number of maps
6923 to process. */
6924
6925 /* Should overriding-terminal-local-map and overriding-local-map apply? */
6926 if (!NILP (Voverriding_local_map_menu_flag))
6927 {
6928 /* Yes, use them (if non-nil) as well as the global map. */
6929 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
6930 nmaps = 0;
6931 if (!NILP (current_kboard->Voverriding_terminal_local_map))
6932 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
6933 if (!NILP (Voverriding_local_map))
6934 maps[nmaps++] = Voverriding_local_map;
6935 }
6936 else
6937 {
6938 /* No, so use major and minor mode keymaps and keymap property. */
6939 int extra_maps = 2;
6940 Lisp_Object map = get_local_map (PT, current_buffer, keymap);
6941 if (!NILP (map))
6942 extra_maps = 3;
6943 nmaps = current_minor_maps (NULL, &tmaps);
6944 maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
6945 * sizeof (maps[0]));
6946 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
6947 if (!NILP (map))
6948 maps[nmaps++] = map;
6949 maps[nmaps++] = get_local_map (PT, current_buffer, local_map);
6950 }
6951
6952 /* Add global keymap at the end. */
6953 maps[nmaps++] = current_global_map;
6954
6955 /* Process maps in reverse order and look up in each map the prefix
6956 key `tool-bar'. */
6957 for (i = nmaps - 1; i >= 0; --i)
6958 if (!NILP (maps[i]))
6959 {
6960 Lisp_Object keymap;
6961
6962 /* Why set the `noinherit' flag ? -sm */
6963 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 1, 0), 0, 0);
6964 if (CONSP (keymap))
6965 {
6966 Lisp_Object tail;
6967
6968 /* KEYMAP is a list `(keymap (KEY . BINDING) ...)'. */
6969 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
6970 {
6971 Lisp_Object keydef = XCAR (tail);
6972 if (CONSP (keydef))
6973 process_tool_bar_item (XCAR (keydef), XCDR (keydef));
6974 }
6975 }
6976 }
6977
6978 Vinhibit_quit = oquit;
6979 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
6980 return tool_bar_items_vector;
6981 }
6982
6983
6984 /* Process the definition of KEY which is DEF. */
6985
6986 static void
6987 process_tool_bar_item (key, def)
6988 Lisp_Object key, def;
6989 {
6990 int i;
6991 extern Lisp_Object Qundefined;
6992 struct gcpro gcpro1, gcpro2;
6993
6994 /* Protect KEY and DEF from GC because parse_tool_bar_item may call
6995 eval. */
6996 GCPRO2 (key, def);
6997
6998 if (EQ (def, Qundefined))
6999 {
7000 /* If a map has an explicit `undefined' as definition,
7001 discard any previously made item. */
7002 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
7003 {
7004 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
7005
7006 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
7007 {
7008 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
7009 bcopy (v + TOOL_BAR_ITEM_NSLOTS, v,
7010 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
7011 * sizeof (Lisp_Object)));
7012 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
7013 break;
7014 }
7015 }
7016 }
7017 else if (parse_tool_bar_item (key, def))
7018 /* Append a new tool bar item to tool_bar_items_vector. Accept
7019 more than one definition for the same key. */
7020 append_tool_bar_item ();
7021
7022 UNGCPRO;
7023 }
7024
7025
7026 /* Parse a tool bar item specification ITEM for key KEY and return the
7027 result in tool_bar_item_properties. Value is zero if ITEM is
7028 invalid.
7029
7030 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
7031
7032 CAPTION is the caption of the item, If it's not a string, it is
7033 evaluated to get a string.
7034
7035 BINDING is the tool bar item's binding. Tool-bar items with keymaps
7036 as binding are currently ignored.
7037
7038 The following properties are recognized:
7039
7040 - `:enable FORM'.
7041
7042 FORM is evaluated and specifies whether the tool bar item is
7043 enabled or disabled.
7044
7045 - `:visible FORM'
7046
7047 FORM is evaluated and specifies whether the tool bar item is visible.
7048
7049 - `:filter FUNCTION'
7050
7051 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
7052 result is stored as the new binding.
7053
7054 - `:button (TYPE SELECTED)'
7055
7056 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
7057 and specifies whether the button is selected (pressed) or not.
7058
7059 - `:image IMAGES'
7060
7061 IMAGES is either a single image specification or a vector of four
7062 image specifications. See enum tool_bar_item_images.
7063
7064 - `:help HELP-STRING'.
7065
7066 Gives a help string to display for the tool bar item. */
7067
7068 static int
7069 parse_tool_bar_item (key, item)
7070 Lisp_Object key, item;
7071 {
7072 /* Access slot with index IDX of vector tool_bar_item_properties. */
7073 #define PROP(IDX) XVECTOR (tool_bar_item_properties)->contents[IDX]
7074
7075 Lisp_Object filter = Qnil;
7076 Lisp_Object caption;
7077 extern Lisp_Object QCenable, QCvisible, QChelp, QCfilter;
7078 extern Lisp_Object QCbutton, QCtoggle, QCradio;
7079 int i;
7080
7081 /* Defininition looks like `(menu-item CAPTION BINDING PROPS...)'.
7082 Rule out items that aren't lists, don't start with
7083 `menu-item' or whose rest following `tool-bar-item' is not a
7084 list. */
7085 if (!CONSP (item)
7086 || !EQ (XCAR (item), Qmenu_item)
7087 || (item = XCDR (item),
7088 !CONSP (item)))
7089 return 0;
7090
7091 /* Create tool_bar_item_properties vector if necessary. Reset it to
7092 defaults. */
7093 if (VECTORP (tool_bar_item_properties))
7094 {
7095 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
7096 PROP (i) = Qnil;
7097 }
7098 else
7099 tool_bar_item_properties
7100 = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
7101
7102 /* Set defaults. */
7103 PROP (TOOL_BAR_ITEM_KEY) = key;
7104 PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
7105
7106 /* Get the caption of the item. If the caption is not a string,
7107 evaluate it to get a string. If we don't get a string, skip this
7108 item. */
7109 caption = XCAR (item);
7110 if (!STRINGP (caption))
7111 {
7112 caption = menu_item_eval_property (caption);
7113 if (!STRINGP (caption))
7114 return 0;
7115 }
7116 PROP (TOOL_BAR_ITEM_CAPTION) = caption;
7117
7118 /* Give up if rest following the caption is not a list. */
7119 item = XCDR (item);
7120 if (!CONSP (item))
7121 return 0;
7122
7123 /* Store the binding. */
7124 PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item);
7125 item = XCDR (item);
7126
7127 /* Ignore cached key binding, if any. */
7128 if (CONSP (item) && CONSP (XCAR (item)))
7129 item = XCDR (item);
7130
7131 /* Process the rest of the properties. */
7132 for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
7133 {
7134 Lisp_Object key, value;
7135
7136 key = XCAR (item);
7137 value = XCAR (XCDR (item));
7138
7139 if (EQ (key, QCenable))
7140 /* `:enable FORM'. */
7141 PROP (TOOL_BAR_ITEM_ENABLED_P) = value;
7142 else if (EQ (key, QCvisible))
7143 {
7144 /* `:visible FORM'. If got a visible property and that
7145 evaluates to nil then ignore this item. */
7146 if (NILP (menu_item_eval_property (value)))
7147 return 0;
7148 }
7149 else if (EQ (key, QChelp))
7150 /* `:help HELP-STRING'. */
7151 PROP (TOOL_BAR_ITEM_HELP) = value;
7152 else if (EQ (key, QCfilter))
7153 /* ':filter FORM'. */
7154 filter = value;
7155 else if (EQ (key, QCbutton) && CONSP (value))
7156 {
7157 /* `:button (TYPE . SELECTED)'. */
7158 Lisp_Object type, selected;
7159
7160 type = XCAR (value);
7161 selected = XCDR (value);
7162 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7163 {
7164 PROP (TOOL_BAR_ITEM_SELECTED_P) = selected;
7165 PROP (TOOL_BAR_ITEM_TYPE) = type;
7166 }
7167 }
7168 else if (EQ (key, QCimage)
7169 && (CONSP (value)
7170 || (VECTORP (value) && XVECTOR (value)->size == 4)))
7171 /* Value is either a single image specification or a vector
7172 of 4 such specifications for the different buttion states. */
7173 PROP (TOOL_BAR_ITEM_IMAGES) = value;
7174 }
7175
7176 /* If got a filter apply it on binding. */
7177 if (!NILP (filter))
7178 PROP (TOOL_BAR_ITEM_BINDING)
7179 = menu_item_eval_property (list2 (filter,
7180 list2 (Qquote,
7181 PROP (TOOL_BAR_ITEM_BINDING))));
7182
7183 /* See if the binding is a keymap. Give up if it is. */
7184 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
7185 return 0;
7186
7187 /* Enable or disable selection of item. */
7188 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
7189 PROP (TOOL_BAR_ITEM_ENABLED_P)
7190 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P));
7191
7192 /* Handle radio buttons or toggle boxes. */
7193 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
7194 PROP (TOOL_BAR_ITEM_SELECTED_P)
7195 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P));
7196
7197 return 1;
7198
7199 #undef PROP
7200 }
7201
7202
7203 /* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
7204 that can be reused. */
7205
7206 static void
7207 init_tool_bar_items (reuse)
7208 Lisp_Object reuse;
7209 {
7210 if (VECTORP (reuse))
7211 tool_bar_items_vector = reuse;
7212 else
7213 tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
7214 ntool_bar_items = 0;
7215 }
7216
7217
7218 /* Append parsed tool bar item properties from
7219 tool_bar_item_properties */
7220
7221 static void
7222 append_tool_bar_item ()
7223 {
7224 Lisp_Object *to, *from;
7225
7226 /* Enlarge tool_bar_items_vector if necessary. */
7227 if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
7228 >= XVECTOR (tool_bar_items_vector)->size)
7229 {
7230 Lisp_Object new_vector;
7231 int old_size = XVECTOR (tool_bar_items_vector)->size;
7232
7233 new_vector = Fmake_vector (make_number (2 * old_size), Qnil);
7234 bcopy (XVECTOR (tool_bar_items_vector)->contents,
7235 XVECTOR (new_vector)->contents,
7236 old_size * sizeof (Lisp_Object));
7237 tool_bar_items_vector = new_vector;
7238 }
7239
7240 /* Append entries from tool_bar_item_properties to the end of
7241 tool_bar_items_vector. */
7242 to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
7243 from = XVECTOR (tool_bar_item_properties)->contents;
7244 bcopy (from, to, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
7245 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
7246 }
7247
7248
7249
7250
7251 \f
7252 /* Read a character using menus based on maps in the array MAPS.
7253 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
7254 Return t if we displayed a menu but the user rejected it.
7255
7256 PREV_EVENT is the previous input event, or nil if we are reading
7257 the first event of a key sequence.
7258
7259 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
7260 if we used a mouse menu to read the input, or zero otherwise. If
7261 USED_MOUSE_MENU is null, we don't dereference it.
7262
7263 The prompting is done based on the prompt-string of the map
7264 and the strings associated with various map elements.
7265
7266 This can be done with X menus or with menus put in the minibuf.
7267 These are done in different ways, depending on how the input will be read.
7268 Menus using X are done after auto-saving in read-char, getting the input
7269 event from Fx_popup_menu; menus using the minibuf use read_char recursively
7270 and do auto-saving in the inner call of read_char. */
7271
7272 static Lisp_Object
7273 read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
7274 int nmaps;
7275 Lisp_Object *maps;
7276 Lisp_Object prev_event;
7277 int *used_mouse_menu;
7278 {
7279 int mapno;
7280 register Lisp_Object name;
7281
7282 if (used_mouse_menu)
7283 *used_mouse_menu = 0;
7284
7285 /* Use local over global Menu maps */
7286
7287 if (! menu_prompting)
7288 return Qnil;
7289
7290 /* Optionally disregard all but the global map. */
7291 if (inhibit_local_menu_bar_menus)
7292 {
7293 maps += (nmaps - 1);
7294 nmaps = 1;
7295 }
7296
7297 /* Get the menu name from the first map that has one (a prompt string). */
7298 for (mapno = 0; mapno < nmaps; mapno++)
7299 {
7300 name = map_prompt (maps[mapno]);
7301 if (!NILP (name))
7302 break;
7303 }
7304
7305 /* If we don't have any menus, just read a character normally. */
7306 if (mapno >= nmaps)
7307 return Qnil;
7308
7309 #ifdef HAVE_MENUS
7310 /* If we got to this point via a mouse click,
7311 use a real menu for mouse selection. */
7312 if (EVENT_HAS_PARAMETERS (prev_event)
7313 && !EQ (XCAR (prev_event), Qmenu_bar)
7314 && !EQ (XCAR (prev_event), Qtool_bar))
7315 {
7316 /* Display the menu and get the selection. */
7317 Lisp_Object *realmaps
7318 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
7319 Lisp_Object value;
7320 int nmaps1 = 0;
7321
7322 /* Use the maps that are not nil. */
7323 for (mapno = 0; mapno < nmaps; mapno++)
7324 if (!NILP (maps[mapno]))
7325 realmaps[nmaps1++] = maps[mapno];
7326
7327 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
7328 if (CONSP (value))
7329 {
7330 Lisp_Object tem;
7331
7332 record_menu_key (XCAR (value));
7333
7334 /* If we got multiple events, unread all but
7335 the first.
7336 There is no way to prevent those unread events
7337 from showing up later in last_nonmenu_event.
7338 So turn symbol and integer events into lists,
7339 to indicate that they came from a mouse menu,
7340 so that when present in last_nonmenu_event
7341 they won't confuse things. */
7342 for (tem = XCDR (value); !NILP (tem);
7343 tem = XCDR (tem))
7344 {
7345 record_menu_key (XCAR (tem));
7346 if (SYMBOLP (XCAR (tem))
7347 || INTEGERP (XCAR (tem)))
7348 XCAR (tem)
7349 = Fcons (XCAR (tem), Qnil);
7350 }
7351
7352 /* If we got more than one event, put all but the first
7353 onto this list to be read later.
7354 Return just the first event now. */
7355 Vunread_command_events
7356 = nconc2 (XCDR (value), Vunread_command_events);
7357 value = XCAR (value);
7358 }
7359 else if (NILP (value))
7360 value = Qt;
7361 if (used_mouse_menu)
7362 *used_mouse_menu = 1;
7363 return value;
7364 }
7365 #endif /* HAVE_MENUS */
7366 return Qnil ;
7367 }
7368
7369 /* Buffer in use so far for the minibuf prompts for menu keymaps.
7370 We make this bigger when necessary, and never free it. */
7371 static char *read_char_minibuf_menu_text;
7372 /* Size of that buffer. */
7373 static int read_char_minibuf_menu_width;
7374
7375 static Lisp_Object
7376 read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
7377 int commandflag ;
7378 int nmaps;
7379 Lisp_Object *maps;
7380 {
7381 int mapno;
7382 register Lisp_Object name;
7383 int nlength;
7384 int width = FRAME_WIDTH (SELECTED_FRAME ()) - 4;
7385 int idx = -1;
7386 int nobindings = 1;
7387 Lisp_Object rest, vector;
7388 char *menu;
7389
7390 vector = Qnil;
7391
7392 if (! menu_prompting)
7393 return Qnil;
7394
7395 /* Make sure we have a big enough buffer for the menu text. */
7396 if (read_char_minibuf_menu_text == 0)
7397 {
7398 read_char_minibuf_menu_width = width + 4;
7399 read_char_minibuf_menu_text = (char *) xmalloc (width + 4);
7400 }
7401 else if (width + 4 > read_char_minibuf_menu_width)
7402 {
7403 read_char_minibuf_menu_width = width + 4;
7404 read_char_minibuf_menu_text
7405 = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
7406 }
7407 menu = read_char_minibuf_menu_text;
7408
7409 /* Get the menu name from the first map that has one (a prompt string). */
7410 for (mapno = 0; mapno < nmaps; mapno++)
7411 {
7412 name = map_prompt (maps[mapno]);
7413 if (!NILP (name))
7414 break;
7415 }
7416
7417 /* If we don't have any menus, just read a character normally. */
7418 if (mapno >= nmaps)
7419 return Qnil;
7420
7421 /* Prompt string always starts with map's prompt, and a space. */
7422 strcpy (menu, XSTRING (name)->data);
7423 nlength = STRING_BYTES (XSTRING (name));
7424 menu[nlength++] = ':';
7425 menu[nlength++] = ' ';
7426 menu[nlength] = 0;
7427
7428 /* Start prompting at start of first map. */
7429 mapno = 0;
7430 rest = maps[mapno];
7431
7432 /* Present the documented bindings, a line at a time. */
7433 while (1)
7434 {
7435 int notfirst = 0;
7436 int i = nlength;
7437 Lisp_Object obj;
7438 int ch;
7439 Lisp_Object orig_defn_macro;
7440
7441 /* Loop over elements of map. */
7442 while (i < width)
7443 {
7444 Lisp_Object elt;
7445
7446 /* If reached end of map, start at beginning of next map. */
7447 if (NILP (rest))
7448 {
7449 mapno++;
7450 /* At end of last map, wrap around to first map if just starting,
7451 or end this line if already have something on it. */
7452 if (mapno == nmaps)
7453 {
7454 mapno = 0;
7455 if (notfirst || nobindings) break;
7456 }
7457 rest = maps[mapno];
7458 }
7459
7460 /* Look at the next element of the map. */
7461 if (idx >= 0)
7462 elt = XVECTOR (vector)->contents[idx];
7463 else
7464 elt = Fcar_safe (rest);
7465
7466 if (idx < 0 && VECTORP (elt))
7467 {
7468 /* If we found a dense table in the keymap,
7469 advanced past it, but start scanning its contents. */
7470 rest = Fcdr_safe (rest);
7471 vector = elt;
7472 idx = 0;
7473 }
7474 else
7475 {
7476 /* An ordinary element. */
7477 Lisp_Object event, tem;
7478
7479 if (idx < 0)
7480 {
7481 event = Fcar_safe (elt); /* alist */
7482 elt = Fcdr_safe (elt);
7483 }
7484 else
7485 {
7486 XSETINT (event, idx); /* vector */
7487 }
7488
7489 /* Ignore the element if it has no prompt string. */
7490 if (INTEGERP (event) && parse_menu_item (elt, 0, -1))
7491 {
7492 /* 1 if the char to type matches the string. */
7493 int char_matches;
7494 Lisp_Object upcased_event, downcased_event;
7495 Lisp_Object desc = Qnil;
7496 Lisp_Object s
7497 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
7498
7499 upcased_event = Fupcase (event);
7500 downcased_event = Fdowncase (event);
7501 char_matches = (XINT (upcased_event) == XSTRING (s)->data[0]
7502 || XINT (downcased_event) == XSTRING (s)->data[0]);
7503 if (! char_matches)
7504 desc = Fsingle_key_description (event, Qnil);
7505
7506 tem
7507 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
7508 if (!NILP (tem))
7509 /* Insert equivalent keybinding. */
7510 s = concat2 (s, tem);
7511
7512 tem
7513 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
7514 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
7515 {
7516 /* Insert button prefix. */
7517 Lisp_Object selected
7518 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
7519 if (EQ (tem, QCradio))
7520 tem = build_string (NILP (selected) ? "(*) " : "( ) ");
7521 else
7522 tem = build_string (NILP (selected) ? "[X] " : "[ ] ");
7523 s = concat2 (tem, s);
7524 }
7525
7526
7527 /* If we have room for the prompt string, add it to this line.
7528 If this is the first on the line, always add it. */
7529 if ((XSTRING (s)->size + i + 2
7530 + (char_matches ? 0 : XSTRING (desc)->size + 3))
7531 < width
7532 || !notfirst)
7533 {
7534 int thiswidth;
7535
7536 /* Punctuate between strings. */
7537 if (notfirst)
7538 {
7539 strcpy (menu + i, ", ");
7540 i += 2;
7541 }
7542 notfirst = 1;
7543 nobindings = 0 ;
7544
7545 /* If the char to type doesn't match the string's
7546 first char, explicitly show what char to type. */
7547 if (! char_matches)
7548 {
7549 /* Add as much of string as fits. */
7550 thiswidth = XSTRING (desc)->size;
7551 if (thiswidth + i > width)
7552 thiswidth = width - i;
7553 bcopy (XSTRING (desc)->data, menu + i, thiswidth);
7554 i += thiswidth;
7555 strcpy (menu + i, " = ");
7556 i += 3;
7557 }
7558
7559 /* Add as much of string as fits. */
7560 thiswidth = XSTRING (s)->size;
7561 if (thiswidth + i > width)
7562 thiswidth = width - i;
7563 bcopy (XSTRING (s)->data, menu + i, thiswidth);
7564 i += thiswidth;
7565 menu[i] = 0;
7566 }
7567 else
7568 {
7569 /* If this element does not fit, end the line now,
7570 and save the element for the next line. */
7571 strcpy (menu + i, "...");
7572 break;
7573 }
7574 }
7575
7576 /* Move past this element. */
7577 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
7578 /* Handle reaching end of dense table. */
7579 idx = -1;
7580 if (idx >= 0)
7581 idx++;
7582 else
7583 rest = Fcdr_safe (rest);
7584 }
7585 }
7586
7587 /* Prompt with that and read response. */
7588 message2_nolog (menu, strlen (menu),
7589 ! NILP (current_buffer->enable_multibyte_characters));
7590
7591 /* Make believe its not a keyboard macro in case the help char
7592 is pressed. Help characters are not recorded because menu prompting
7593 is not used on replay.
7594 */
7595 orig_defn_macro = current_kboard->defining_kbd_macro;
7596 current_kboard->defining_kbd_macro = Qnil;
7597 do
7598 obj = read_char (commandflag, 0, 0, Qt, 0);
7599 while (BUFFERP (obj));
7600 current_kboard->defining_kbd_macro = orig_defn_macro;
7601
7602 if (!INTEGERP (obj))
7603 return obj;
7604 else
7605 ch = XINT (obj);
7606
7607 if (! EQ (obj, menu_prompt_more_char)
7608 && (!INTEGERP (menu_prompt_more_char)
7609 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
7610 {
7611 if (!NILP (current_kboard->defining_kbd_macro))
7612 store_kbd_macro_char (obj);
7613 return obj;
7614 }
7615 /* Help char - go round again */
7616 }
7617 }
7618 \f
7619 /* Reading key sequences. */
7620
7621 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
7622 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
7623 keymap, or nil otherwise. Return the index of the first keymap in
7624 which KEY has any binding, or NMAPS if no map has a binding.
7625
7626 If KEY is a meta ASCII character, treat it like meta-prefix-char
7627 followed by the corresponding non-meta character. Keymaps in
7628 CURRENT with non-prefix bindings for meta-prefix-char become nil in
7629 NEXT.
7630
7631 If KEY has no bindings in any of the CURRENT maps, NEXT is left
7632 unmodified.
7633
7634 NEXT may be the same array as CURRENT. */
7635
7636 static int
7637 follow_key (key, nmaps, current, defs, next)
7638 Lisp_Object key;
7639 Lisp_Object *current, *defs, *next;
7640 int nmaps;
7641 {
7642 int i, first_binding;
7643 int did_meta = 0;
7644
7645 first_binding = nmaps;
7646 for (i = nmaps - 1; i >= 0; i--)
7647 {
7648 if (! NILP (current[i]))
7649 {
7650 Lisp_Object map;
7651 if (did_meta)
7652 map = defs[i];
7653 else
7654 map = current[i];
7655
7656 defs[i] = access_keymap (map, key, 1, 0, 1);
7657 if (! NILP (defs[i]))
7658 first_binding = i;
7659 }
7660 else
7661 defs[i] = Qnil;
7662 }
7663
7664 /* Given the set of bindings we've found, produce the next set of maps. */
7665 if (first_binding < nmaps)
7666 for (i = 0; i < nmaps; i++)
7667 next[i] = NILP (defs[i]) ? Qnil : get_keymap (defs[i], 0, 1);
7668
7669 return first_binding;
7670 }
7671
7672 /* Read a sequence of keys that ends with a non prefix character,
7673 storing it in KEYBUF, a buffer of size BUFSIZE.
7674 Prompt with PROMPT.
7675 Return the length of the key sequence stored.
7676 Return -1 if the user rejected a command menu.
7677
7678 Echo starting immediately unless `prompt' is 0.
7679
7680 Where a key sequence ends depends on the currently active keymaps.
7681 These include any minor mode keymaps active in the current buffer,
7682 the current buffer's local map, and the global map.
7683
7684 If a key sequence has no other bindings, we check Vfunction_key_map
7685 to see if some trailing subsequence might be the beginning of a
7686 function key's sequence. If so, we try to read the whole function
7687 key, and substitute its symbolic name into the key sequence.
7688
7689 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
7690 `double-' events into similar click events, if that would make them
7691 bound. We try to turn `triple-' events first into `double-' events,
7692 then into clicks.
7693
7694 If we get a mouse click in a mode line, vertical divider, or other
7695 non-text area, we treat the click as if it were prefixed by the
7696 symbol denoting that area - `mode-line', `vertical-line', or
7697 whatever.
7698
7699 If the sequence starts with a mouse click, we read the key sequence
7700 with respect to the buffer clicked on, not the current buffer.
7701
7702 If the user switches frames in the midst of a key sequence, we put
7703 off the switch-frame event until later; the next call to
7704 read_char will return it.
7705
7706 If FIX_CURRENT_BUFFER is nonzero, we restore current_buffer
7707 from the selected window's buffer. */
7708
7709 static int
7710 read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
7711 can_return_switch_frame, fix_current_buffer)
7712 Lisp_Object *keybuf;
7713 int bufsize;
7714 Lisp_Object prompt;
7715 int dont_downcase_last;
7716 int can_return_switch_frame;
7717 int fix_current_buffer;
7718 {
7719 volatile int count = specpdl_ptr - specpdl;
7720
7721 /* How many keys there are in the current key sequence. */
7722 volatile int t;
7723
7724 /* The length of the echo buffer when we started reading, and
7725 the length of this_command_keys when we started reading. */
7726 volatile int echo_start;
7727 volatile int keys_start;
7728
7729 /* The number of keymaps we're scanning right now, and the number of
7730 keymaps we have allocated space for. */
7731 volatile int nmaps;
7732 volatile int nmaps_allocated = 0;
7733
7734 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
7735 the current keymaps. */
7736 Lisp_Object *volatile defs = NULL;
7737
7738 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
7739 in the current keymaps, or nil where it is not a prefix. */
7740 Lisp_Object *volatile submaps = NULL;
7741
7742 /* The local map to start out with at start of key sequence. */
7743 volatile Lisp_Object orig_local_map;
7744
7745 /* The map from the `keymap' property to start out with at start of
7746 key sequence. */
7747 volatile Lisp_Object orig_keymap;
7748
7749 /* 1 if we have already considered switching to the local-map property
7750 of the place where a mouse click occurred. */
7751 volatile int localized_local_map = 0;
7752
7753 /* The index in defs[] of the first keymap that has a binding for
7754 this key sequence. In other words, the lowest i such that
7755 defs[i] is non-nil. */
7756 volatile int first_binding;
7757
7758 /* If t < mock_input, then KEYBUF[t] should be read as the next
7759 input key.
7760
7761 We use this to recover after recognizing a function key. Once we
7762 realize that a suffix of the current key sequence is actually a
7763 function key's escape sequence, we replace the suffix with the
7764 function key's binding from Vfunction_key_map. Now keybuf
7765 contains a new and different key sequence, so the echo area,
7766 this_command_keys, and the submaps and defs arrays are wrong. In
7767 this situation, we set mock_input to t, set t to 0, and jump to
7768 restart_sequence; the loop will read keys from keybuf up until
7769 mock_input, thus rebuilding the state; and then it will resume
7770 reading characters from the keyboard. */
7771 volatile int mock_input = 0;
7772
7773 /* If the sequence is unbound in submaps[], then
7774 keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map,
7775 and fkey_map is its binding.
7776
7777 These might be > t, indicating that all function key scanning
7778 should hold off until t reaches them. We do this when we've just
7779 recognized a function key, to avoid searching for the function
7780 key's again in Vfunction_key_map. */
7781 volatile int fkey_start = 0, fkey_end = 0;
7782 volatile Lisp_Object fkey_map;
7783
7784 /* Likewise, for key_translation_map. */
7785 volatile int keytran_start = 0, keytran_end = 0;
7786 volatile Lisp_Object keytran_map;
7787
7788 /* If we receive a ``switch-frame'' event in the middle of a key sequence,
7789 we put it off for later. While we're reading, we keep the event here. */
7790 volatile Lisp_Object delayed_switch_frame;
7791
7792 /* See the comment below... */
7793 #if defined (GOBBLE_FIRST_EVENT)
7794 Lisp_Object first_event;
7795 #endif
7796
7797 volatile Lisp_Object original_uppercase;
7798 volatile int original_uppercase_position = -1;
7799
7800 /* Gets around Microsoft compiler limitations. */
7801 int dummyflag = 0;
7802
7803 struct buffer *starting_buffer;
7804
7805 /* Nonzero if we seem to have got the beginning of a binding
7806 in function_key_map. */
7807 volatile int function_key_possible = 0;
7808 volatile int key_translation_possible = 0;
7809
7810 /* Save the status of key translation before each step,
7811 so that we can restore this after downcasing. */
7812 Lisp_Object prev_fkey_map;
7813 int prev_fkey_start;
7814 int prev_fkey_end;
7815
7816 Lisp_Object prev_keytran_map;
7817 int prev_keytran_start;
7818 int prev_keytran_end;
7819
7820 #if defined (GOBBLE_FIRST_EVENT)
7821 int junk;
7822 #endif
7823
7824 raw_keybuf_count = 0;
7825
7826 last_nonmenu_event = Qnil;
7827
7828 delayed_switch_frame = Qnil;
7829 fkey_map = Vfunction_key_map;
7830 keytran_map = Vkey_translation_map;
7831
7832 /* If there is no function-key-map, turn off function key scanning. */
7833 if (!KEYMAPP (Vfunction_key_map))
7834 fkey_start = fkey_end = bufsize + 1;
7835
7836 /* If there is no key-translation-map, turn off scanning. */
7837 if (!KEYMAPP (Vkey_translation_map))
7838 keytran_start = keytran_end = bufsize + 1;
7839
7840 if (INTERACTIVE)
7841 {
7842 if (!NILP (prompt))
7843 echo_prompt (XSTRING (prompt)->data);
7844 else if (cursor_in_echo_area
7845 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
7846 && NILP (Fzerop (Vecho_keystrokes)))
7847 /* This doesn't put in a dash if the echo buffer is empty, so
7848 you don't always see a dash hanging out in the minibuffer. */
7849 echo_dash ();
7850 }
7851
7852 /* Record the initial state of the echo area and this_command_keys;
7853 we will need to restore them if we replay a key sequence. */
7854 if (INTERACTIVE)
7855 echo_start = echo_length ();
7856 keys_start = this_command_key_count;
7857 this_single_command_key_start = keys_start;
7858
7859 #if defined (GOBBLE_FIRST_EVENT)
7860 /* This doesn't quite work, because some of the things that read_char
7861 does cannot safely be bypassed. It seems too risky to try to make
7862 this work right. */
7863
7864 /* Read the first char of the sequence specially, before setting
7865 up any keymaps, in case a filter runs and switches buffers on us. */
7866 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
7867 &junk);
7868 #endif /* GOBBLE_FIRST_EVENT */
7869
7870 orig_local_map = get_local_map (PT, current_buffer, local_map);
7871 orig_keymap = get_local_map (PT, current_buffer, keymap);
7872
7873 /* We jump here when the key sequence has been thoroughly changed, and
7874 we need to rescan it starting from the beginning. When we jump here,
7875 keybuf[0..mock_input] holds the sequence we should reread. */
7876 replay_sequence:
7877
7878 starting_buffer = current_buffer;
7879 function_key_possible = 0;
7880 key_translation_possible = 0;
7881
7882 /* Build our list of keymaps.
7883 If we recognize a function key and replace its escape sequence in
7884 keybuf with its symbol, or if the sequence starts with a mouse
7885 click and we need to switch buffers, we jump back here to rebuild
7886 the initial keymaps from the current buffer. */
7887 {
7888 Lisp_Object *maps;
7889
7890 if (!NILP (current_kboard->Voverriding_terminal_local_map)
7891 || !NILP (Voverriding_local_map))
7892 {
7893 if (3 > nmaps_allocated)
7894 {
7895 submaps = (Lisp_Object *) alloca (3 * sizeof (submaps[0]));
7896 defs = (Lisp_Object *) alloca (3 * sizeof (defs[0]));
7897 nmaps_allocated = 3;
7898 }
7899 nmaps = 0;
7900 if (!NILP (current_kboard->Voverriding_terminal_local_map))
7901 submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
7902 if (!NILP (Voverriding_local_map))
7903 submaps[nmaps++] = Voverriding_local_map;
7904 }
7905 else
7906 {
7907 int extra_maps = 2;
7908 nmaps = current_minor_maps (0, &maps);
7909 if (!NILP (orig_keymap))
7910 extra_maps = 3;
7911 if (nmaps + extra_maps > nmaps_allocated)
7912 {
7913 submaps = (Lisp_Object *) alloca ((nmaps+extra_maps)
7914 * sizeof (submaps[0]));
7915 defs = (Lisp_Object *) alloca ((nmaps+extra_maps)
7916 * sizeof (defs[0]));
7917 nmaps_allocated = nmaps + extra_maps;
7918 }
7919 bcopy (maps, (void *) submaps, nmaps * sizeof (submaps[0]));
7920 if (!NILP (orig_keymap))
7921 submaps[nmaps++] = orig_keymap;
7922 submaps[nmaps++] = orig_local_map;
7923 }
7924 submaps[nmaps++] = current_global_map;
7925 }
7926
7927 /* Find an accurate initial value for first_binding. */
7928 for (first_binding = 0; first_binding < nmaps; first_binding++)
7929 if (! NILP (submaps[first_binding]))
7930 break;
7931
7932 /* Start from the beginning in keybuf. */
7933 t = 0;
7934
7935 /* These are no-ops the first time through, but if we restart, they
7936 revert the echo area and this_command_keys to their original state. */
7937 this_command_key_count = keys_start;
7938 if (INTERACTIVE && t < mock_input)
7939 echo_truncate (echo_start);
7940
7941 /* If the best binding for the current key sequence is a keymap, or
7942 we may be looking at a function key's escape sequence, keep on
7943 reading. */
7944 while ((first_binding < nmaps && ! NILP (submaps[first_binding]))
7945 || (first_binding >= nmaps
7946 && fkey_start < t
7947 /* mock input is never part of a function key's sequence. */
7948 && mock_input <= fkey_start)
7949 || (first_binding >= nmaps
7950 && keytran_start < t && key_translation_possible)
7951 /* Don't return in the middle of a possible function key sequence,
7952 if the only bindings we found were via case conversion.
7953 Thus, if ESC O a has a function-key-map translation
7954 and ESC o has a binding, don't return after ESC O,
7955 so that we can translate ESC O plus the next character. */
7956 )
7957 {
7958 Lisp_Object key;
7959 int used_mouse_menu = 0;
7960
7961 /* Where the last real key started. If we need to throw away a
7962 key that has expanded into more than one element of keybuf
7963 (say, a mouse click on the mode line which is being treated
7964 as [mode-line (mouse-...)], then we backtrack to this point
7965 of keybuf. */
7966 volatile int last_real_key_start;
7967
7968 /* These variables are analogous to echo_start and keys_start;
7969 while those allow us to restart the entire key sequence,
7970 echo_local_start and keys_local_start allow us to throw away
7971 just one key. */
7972 volatile int echo_local_start, keys_local_start, local_first_binding;
7973
7974 if (t >= bufsize)
7975 error ("Key sequence too long");
7976
7977 if (INTERACTIVE)
7978 echo_local_start = echo_length ();
7979 keys_local_start = this_command_key_count;
7980 local_first_binding = first_binding;
7981
7982 replay_key:
7983 /* These are no-ops, unless we throw away a keystroke below and
7984 jumped back up to replay_key; in that case, these restore the
7985 variables to their original state, allowing us to replay the
7986 loop. */
7987 if (INTERACTIVE && t < mock_input)
7988 echo_truncate (echo_local_start);
7989 this_command_key_count = keys_local_start;
7990 first_binding = local_first_binding;
7991
7992 /* By default, assume each event is "real". */
7993 last_real_key_start = t;
7994
7995 /* Does mock_input indicate that we are re-reading a key sequence? */
7996 if (t < mock_input)
7997 {
7998 key = keybuf[t];
7999 add_command_key (key);
8000 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8001 && NILP (Fzerop (Vecho_keystrokes)))
8002 echo_char (key);
8003 }
8004
8005 /* If not, we should actually read a character. */
8006 else
8007 {
8008 {
8009 #ifdef MULTI_KBOARD
8010 KBOARD *interrupted_kboard = current_kboard;
8011 struct frame *interrupted_frame = SELECTED_FRAME ();
8012 if (setjmp (wrong_kboard_jmpbuf))
8013 {
8014 if (!NILP (delayed_switch_frame))
8015 {
8016 interrupted_kboard->kbd_queue
8017 = Fcons (delayed_switch_frame,
8018 interrupted_kboard->kbd_queue);
8019 delayed_switch_frame = Qnil;
8020 }
8021 while (t > 0)
8022 interrupted_kboard->kbd_queue
8023 = Fcons (keybuf[--t], interrupted_kboard->kbd_queue);
8024
8025 /* If the side queue is non-empty, ensure it begins with a
8026 switch-frame, so we'll replay it in the right context. */
8027 if (CONSP (interrupted_kboard->kbd_queue)
8028 && (key = XCAR (interrupted_kboard->kbd_queue),
8029 !(EVENT_HAS_PARAMETERS (key)
8030 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
8031 Qswitch_frame))))
8032 {
8033 Lisp_Object frame;
8034 XSETFRAME (frame, interrupted_frame);
8035 interrupted_kboard->kbd_queue
8036 = Fcons (make_lispy_switch_frame (frame),
8037 interrupted_kboard->kbd_queue);
8038 }
8039 mock_input = 0;
8040 orig_local_map = get_local_map (PT, current_buffer, local_map);
8041 orig_keymap = get_local_map (PT, current_buffer, keymap);
8042 goto replay_sequence;
8043 }
8044 #endif
8045 key = read_char (NILP (prompt), nmaps,
8046 (Lisp_Object *) submaps, last_nonmenu_event,
8047 &used_mouse_menu);
8048 }
8049
8050 /* read_char returns t when it shows a menu and the user rejects it.
8051 Just return -1. */
8052 if (EQ (key, Qt))
8053 {
8054 unbind_to (count, Qnil);
8055 return -1;
8056 }
8057
8058 /* read_char returns -1 at the end of a macro.
8059 Emacs 18 handles this by returning immediately with a
8060 zero, so that's what we'll do. */
8061 if (INTEGERP (key) && XINT (key) == -1)
8062 {
8063 t = 0;
8064 /* The Microsoft C compiler can't handle the goto that
8065 would go here. */
8066 dummyflag = 1;
8067 break;
8068 }
8069
8070 /* If the current buffer has been changed from under us, the
8071 keymap may have changed, so replay the sequence. */
8072 if (BUFFERP (key))
8073 {
8074 mock_input = t;
8075 /* Reset the current buffer from the selected window
8076 in case something changed the former and not the latter.
8077 This is to be more consistent with the behavior
8078 of the command_loop_1. */
8079 if (fix_current_buffer)
8080 {
8081 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
8082 Fkill_emacs (Qnil);
8083 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
8084 Fset_buffer (XWINDOW (selected_window)->buffer);
8085 }
8086
8087 orig_local_map = get_local_map (PT, current_buffer, local_map);
8088 orig_keymap = get_local_map (PT, current_buffer, keymap);
8089 goto replay_sequence;
8090 }
8091
8092 /* If we have a quit that was typed in another frame, and
8093 quit_throw_to_read_char switched buffers,
8094 replay to get the right keymap. */
8095 if (XINT (key) == quit_char && current_buffer != starting_buffer)
8096 {
8097 GROW_RAW_KEYBUF;
8098 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8099 keybuf[t++] = key;
8100 mock_input = t;
8101 Vquit_flag = Qnil;
8102 orig_local_map = get_local_map (PT, current_buffer, local_map);
8103 orig_keymap = get_local_map (PT, current_buffer, keymap);
8104 goto replay_sequence;
8105 }
8106
8107 Vquit_flag = Qnil;
8108
8109 if (EVENT_HAS_PARAMETERS (key)
8110 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
8111 {
8112 /* If we're at the beginning of a key sequence, and the caller
8113 says it's okay, go ahead and return this event. If we're
8114 in the midst of a key sequence, delay it until the end. */
8115 if (t > 0 || !can_return_switch_frame)
8116 {
8117 delayed_switch_frame = key;
8118 goto replay_key;
8119 }
8120 }
8121
8122 GROW_RAW_KEYBUF;
8123 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8124 }
8125
8126 /* Clicks in non-text areas get prefixed by the symbol
8127 in their CHAR-ADDRESS field. For example, a click on
8128 the mode line is prefixed by the symbol `mode-line'.
8129
8130 Furthermore, key sequences beginning with mouse clicks
8131 are read using the keymaps of the buffer clicked on, not
8132 the current buffer. So we may have to switch the buffer
8133 here.
8134
8135 When we turn one event into two events, we must make sure
8136 that neither of the two looks like the original--so that,
8137 if we replay the events, they won't be expanded again.
8138 If not for this, such reexpansion could happen either here
8139 or when user programs play with this-command-keys. */
8140 if (EVENT_HAS_PARAMETERS (key))
8141 {
8142 Lisp_Object kind;
8143
8144 kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
8145 if (EQ (kind, Qmouse_click))
8146 {
8147 Lisp_Object window, posn;
8148
8149 window = POSN_WINDOW (EVENT_START (key));
8150 posn = POSN_BUFFER_POSN (EVENT_START (key));
8151
8152 if (CONSP (posn))
8153 {
8154 /* We're looking at the second event of a
8155 sequence which we expanded before. Set
8156 last_real_key_start appropriately. */
8157 if (t > 0)
8158 last_real_key_start = t - 1;
8159 }
8160
8161 /* Key sequences beginning with mouse clicks are
8162 read using the keymaps in the buffer clicked on,
8163 not the current buffer. If we're at the
8164 beginning of a key sequence, switch buffers. */
8165 if (last_real_key_start == 0
8166 && WINDOWP (window)
8167 && BUFFERP (XWINDOW (window)->buffer)
8168 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
8169 {
8170 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
8171 keybuf[t] = key;
8172 mock_input = t + 1;
8173
8174 /* Arrange to go back to the original buffer once we're
8175 done reading the key sequence. Note that we can't
8176 use save_excursion_{save,restore} here, because they
8177 save point as well as the current buffer; we don't
8178 want to save point, because redisplay may change it,
8179 to accommodate a Fset_window_start or something. We
8180 don't want to do this at the top of the function,
8181 because we may get input from a subprocess which
8182 wants to change the selected window and stuff (say,
8183 emacsclient). */
8184 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
8185
8186 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
8187 Fkill_emacs (Qnil);
8188 set_buffer_internal (XBUFFER (XWINDOW
8189 (window)->buffer)
8190 );
8191 orig_local_map = get_local_map (PT, current_buffer,
8192 local_map);
8193 orig_keymap = get_local_map (PT, current_buffer, keymap);
8194 goto replay_sequence;
8195 }
8196
8197 /* For a mouse click, get the local text-property keymap
8198 of the place clicked on, rather than point. */
8199 if (last_real_key_start == 0
8200 && CONSP (XCDR (key))
8201 && ! localized_local_map)
8202 {
8203 Lisp_Object map_here, start, pos;
8204
8205 localized_local_map = 1;
8206 start = EVENT_START (key);
8207
8208 if (CONSP (start) && CONSP (XCDR (start)))
8209 {
8210 pos = POSN_BUFFER_POSN (start);
8211 if (INTEGERP (pos)
8212 && XINT (pos) >= BEG && XINT (pos) <= Z)
8213 {
8214 map_here = get_local_map (XINT (pos),
8215 current_buffer, local_map);
8216 if (!EQ (map_here, orig_local_map))
8217 {
8218 orig_local_map = map_here;
8219 keybuf[t] = key;
8220 mock_input = t + 1;
8221
8222 goto replay_sequence;
8223 }
8224 map_here = get_local_map (XINT (pos),
8225 current_buffer, keymap);
8226 if (!EQ (map_here, orig_keymap))
8227 {
8228 orig_keymap = map_here;
8229 keybuf[t] = key;
8230 mock_input = t + 1;
8231
8232 goto replay_sequence;
8233 }
8234 }
8235 }
8236 }
8237
8238 /* Expand mode-line and scroll-bar events into two events:
8239 use posn as a fake prefix key. */
8240 if (SYMBOLP (posn))
8241 {
8242 if (t + 1 >= bufsize)
8243 error ("Key sequence too long");
8244 keybuf[t] = posn;
8245 keybuf[t+1] = key;
8246 mock_input = t + 2;
8247
8248 /* Zap the position in key, so we know that we've
8249 expanded it, and don't try to do so again. */
8250 POSN_BUFFER_POSN (EVENT_START (key))
8251 = Fcons (posn, Qnil);
8252
8253 /* If on a mode line string with a local keymap,
8254 reconsider the key sequence with that keymap. */
8255 if (CONSP (POSN_STRING (EVENT_START (key))))
8256 {
8257 Lisp_Object string, pos, map, map2;
8258
8259 string = POSN_STRING (EVENT_START (key));
8260 pos = XCDR (string);
8261 string = XCAR (string);
8262 if (XINT (pos) >= 0
8263 && XINT (pos) < XSTRING (string)->size)
8264 {
8265 map = Fget_text_property (pos, Qlocal_map, string);
8266 if (!NILP (map))
8267 orig_local_map = map;
8268 map2 = Fget_text_property (pos, Qkeymap, string);
8269 if (!NILP (map2))
8270 orig_keymap = map2;
8271 if (!NILP (map) || !NILP (map2))
8272 goto replay_sequence;
8273 }
8274 }
8275
8276 goto replay_key;
8277 }
8278 }
8279 else if (CONSP (XCDR (key))
8280 && CONSP (EVENT_START (key))
8281 && CONSP (XCDR (EVENT_START (key))))
8282 {
8283 Lisp_Object posn;
8284
8285 posn = POSN_BUFFER_POSN (EVENT_START (key));
8286 /* Handle menu-bar events:
8287 insert the dummy prefix event `menu-bar'. */
8288 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
8289 {
8290 if (t + 1 >= bufsize)
8291 error ("Key sequence too long");
8292 keybuf[t] = posn;
8293 keybuf[t+1] = key;
8294
8295 /* Zap the position in key, so we know that we've
8296 expanded it, and don't try to do so again. */
8297 POSN_BUFFER_POSN (EVENT_START (key))
8298 = Fcons (posn, Qnil);
8299
8300 mock_input = t + 2;
8301 goto replay_sequence;
8302 }
8303 else if (CONSP (posn))
8304 {
8305 /* We're looking at the second event of a
8306 sequence which we expanded before. Set
8307 last_real_key_start appropriately. */
8308 if (last_real_key_start == t && t > 0)
8309 last_real_key_start = t - 1;
8310 }
8311 }
8312 }
8313
8314 /* We have finally decided that KEY is something we might want
8315 to look up. */
8316 first_binding = (follow_key (key,
8317 nmaps - first_binding,
8318 submaps + first_binding,
8319 defs + first_binding,
8320 submaps + first_binding)
8321 + first_binding);
8322
8323 /* If KEY wasn't bound, we'll try some fallbacks. */
8324 if (first_binding >= nmaps)
8325 {
8326 Lisp_Object head;
8327
8328 head = EVENT_HEAD (key);
8329 if (help_char_p (head) && t > 0)
8330 {
8331 read_key_sequence_cmd = Vprefix_help_command;
8332 keybuf[t++] = key;
8333 last_nonmenu_event = key;
8334 /* The Microsoft C compiler can't handle the goto that
8335 would go here. */
8336 dummyflag = 1;
8337 break;
8338 }
8339
8340 if (SYMBOLP (head))
8341 {
8342 Lisp_Object breakdown;
8343 int modifiers;
8344
8345 breakdown = parse_modifiers (head);
8346 modifiers = XINT (XCAR (XCDR (breakdown)));
8347 /* Attempt to reduce an unbound mouse event to a simpler
8348 event that is bound:
8349 Drags reduce to clicks.
8350 Double-clicks reduce to clicks.
8351 Triple-clicks reduce to double-clicks, then to clicks.
8352 Down-clicks are eliminated.
8353 Double-downs reduce to downs, then are eliminated.
8354 Triple-downs reduce to double-downs, then to downs,
8355 then are eliminated. */
8356 if (modifiers & (down_modifier | drag_modifier
8357 | double_modifier | triple_modifier))
8358 {
8359 while (modifiers & (down_modifier | drag_modifier
8360 | double_modifier | triple_modifier))
8361 {
8362 Lisp_Object new_head, new_click;
8363 if (modifiers & triple_modifier)
8364 modifiers ^= (double_modifier | triple_modifier);
8365 else if (modifiers & double_modifier)
8366 modifiers &= ~double_modifier;
8367 else if (modifiers & drag_modifier)
8368 modifiers &= ~drag_modifier;
8369 else
8370 {
8371 /* Dispose of this `down' event by simply jumping
8372 back to replay_key, to get another event.
8373
8374 Note that if this event came from mock input,
8375 then just jumping back to replay_key will just
8376 hand it to us again. So we have to wipe out any
8377 mock input.
8378
8379 We could delete keybuf[t] and shift everything
8380 after that to the left by one spot, but we'd also
8381 have to fix up any variable that points into
8382 keybuf, and shifting isn't really necessary
8383 anyway.
8384
8385 Adding prefixes for non-textual mouse clicks
8386 creates two characters of mock input, and both
8387 must be thrown away. If we're only looking at
8388 the prefix now, we can just jump back to
8389 replay_key. On the other hand, if we've already
8390 processed the prefix, and now the actual click
8391 itself is giving us trouble, then we've lost the
8392 state of the keymaps we want to backtrack to, and
8393 we need to replay the whole sequence to rebuild
8394 it.
8395
8396 Beyond that, only function key expansion could
8397 create more than two keys, but that should never
8398 generate mouse events, so it's okay to zero
8399 mock_input in that case too.
8400
8401 Isn't this just the most wonderful code ever? */
8402 if (t == last_real_key_start)
8403 {
8404 mock_input = 0;
8405 goto replay_key;
8406 }
8407 else
8408 {
8409 mock_input = last_real_key_start;
8410 goto replay_sequence;
8411 }
8412 }
8413
8414 new_head
8415 = apply_modifiers (modifiers, XCAR (breakdown));
8416 new_click
8417 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
8418
8419 /* Look for a binding for this new key. follow_key
8420 promises that it didn't munge submaps the
8421 last time we called it, since key was unbound. */
8422 first_binding
8423 = (follow_key (new_click,
8424 nmaps - local_first_binding,
8425 submaps + local_first_binding,
8426 defs + local_first_binding,
8427 submaps + local_first_binding)
8428 + local_first_binding);
8429
8430 /* If that click is bound, go for it. */
8431 if (first_binding < nmaps)
8432 {
8433 key = new_click;
8434 break;
8435 }
8436 /* Otherwise, we'll leave key set to the drag event. */
8437 }
8438 }
8439 }
8440 }
8441
8442 keybuf[t++] = key;
8443 /* Normally, last_nonmenu_event gets the previous key we read.
8444 But when a mouse popup menu is being used,
8445 we don't update last_nonmenu_event; it continues to hold the mouse
8446 event that preceded the first level of menu. */
8447 if (!used_mouse_menu)
8448 last_nonmenu_event = key;
8449
8450 /* Record what part of this_command_keys is the current key sequence. */
8451 this_single_command_key_start = this_command_key_count - t;
8452
8453 prev_fkey_map = fkey_map;
8454 prev_fkey_start = fkey_start;
8455 prev_fkey_end = fkey_end;
8456
8457 prev_keytran_map = keytran_map;
8458 prev_keytran_start = keytran_start;
8459 prev_keytran_end = keytran_end;
8460
8461 /* If the sequence is unbound, see if we can hang a function key
8462 off the end of it. We only want to scan real keyboard input
8463 for function key sequences, so if mock_input says that we're
8464 re-reading old events, don't examine it. */
8465 if (first_binding >= nmaps
8466 && t >= mock_input)
8467 {
8468 Lisp_Object fkey_next;
8469
8470 /* Continue scan from fkey_end until we find a bound suffix.
8471 If we fail, increment fkey_start
8472 and start fkey_end from there. */
8473 while (fkey_end < t)
8474 {
8475 Lisp_Object key;
8476
8477 key = keybuf[fkey_end++];
8478 fkey_next
8479 = access_keymap (fkey_map, key, 1, 0, 1);
8480
8481 /* Handle symbol with autoload definition. */
8482 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
8483 && CONSP (XSYMBOL (fkey_next)->function)
8484 && EQ (XCAR (XSYMBOL (fkey_next)->function), Qautoload))
8485 do_autoload (XSYMBOL (fkey_next)->function,
8486 fkey_next);
8487
8488 /* Handle a symbol whose function definition is a keymap
8489 or an array. */
8490 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
8491 && (!NILP (Farrayp (XSYMBOL (fkey_next)->function))
8492 || KEYMAPP (XSYMBOL (fkey_next)->function)))
8493 fkey_next = XSYMBOL (fkey_next)->function;
8494
8495 #if 0 /* I didn't turn this on, because it might cause trouble
8496 for the mapping of return into C-m and tab into C-i. */
8497 /* Optionally don't map function keys into other things.
8498 This enables the user to redefine kp- keys easily. */
8499 if (SYMBOLP (key) && !NILP (Vinhibit_function_key_mapping))
8500 fkey_next = Qnil;
8501 #endif
8502
8503 /* If the function key map gives a function, not an
8504 array, then call the function with no args and use
8505 its value instead. */
8506 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
8507 && fkey_end == t)
8508 {
8509 struct gcpro gcpro1, gcpro2, gcpro3;
8510 Lisp_Object tem;
8511 tem = fkey_next;
8512
8513 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
8514 fkey_next = call1 (fkey_next, prompt);
8515 UNGCPRO;
8516 /* If the function returned something invalid,
8517 barf--don't ignore it.
8518 (To ignore it safely, we would need to gcpro a bunch of
8519 other variables.) */
8520 if (! (VECTORP (fkey_next) || STRINGP (fkey_next)))
8521 error ("Function in key-translation-map returns invalid key sequence");
8522 }
8523
8524 function_key_possible = ! NILP (fkey_next);
8525
8526 /* If keybuf[fkey_start..fkey_end] is bound in the
8527 function key map and it's a suffix of the current
8528 sequence (i.e. fkey_end == t), replace it with
8529 the binding and restart with fkey_start at the end. */
8530 if ((VECTORP (fkey_next) || STRINGP (fkey_next))
8531 && fkey_end == t)
8532 {
8533 int len = XFASTINT (Flength (fkey_next));
8534
8535 t = fkey_start + len;
8536 if (t >= bufsize)
8537 error ("Key sequence too long");
8538
8539 if (VECTORP (fkey_next))
8540 bcopy (XVECTOR (fkey_next)->contents,
8541 keybuf + fkey_start,
8542 (t - fkey_start) * sizeof (keybuf[0]));
8543 else if (STRINGP (fkey_next))
8544 {
8545 int i;
8546
8547 for (i = 0; i < len; i++)
8548 XSETFASTINT (keybuf[fkey_start + i],
8549 XSTRING (fkey_next)->data[i]);
8550 }
8551
8552 mock_input = t;
8553 fkey_start = fkey_end = t;
8554 fkey_map = Vfunction_key_map;
8555
8556 /* Do pass the results through key-translation-map.
8557 But don't retranslate what key-translation-map
8558 has already translated. */
8559 keytran_end = keytran_start;
8560 keytran_map = Vkey_translation_map;
8561
8562 goto replay_sequence;
8563 }
8564
8565 fkey_map = get_keymap (fkey_next, 0, 1);
8566
8567 /* If we no longer have a bound suffix, try a new positions for
8568 fkey_start. */
8569 if (!CONSP (fkey_map))
8570 {
8571 fkey_end = ++fkey_start;
8572 fkey_map = Vfunction_key_map;
8573 function_key_possible = 0;
8574 }
8575 }
8576 }
8577
8578 /* Look for this sequence in key-translation-map. */
8579 {
8580 Lisp_Object keytran_next;
8581
8582 /* Scan from keytran_end until we find a bound suffix. */
8583 while (keytran_end < t)
8584 {
8585 Lisp_Object key;
8586
8587 key = keybuf[keytran_end++];
8588 keytran_next
8589 = access_keymap (keytran_map, key, 1, 0, 1);
8590
8591 /* Handle symbol with autoload definition. */
8592 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
8593 && CONSP (XSYMBOL (keytran_next)->function)
8594 && EQ (XCAR (XSYMBOL (keytran_next)->function), Qautoload))
8595 do_autoload (XSYMBOL (keytran_next)->function,
8596 keytran_next);
8597
8598 /* Handle a symbol whose function definition is a keymap
8599 or an array. */
8600 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
8601 && (!NILP (Farrayp (XSYMBOL (keytran_next)->function))
8602 || KEYMAPP (XSYMBOL (keytran_next)->function)))
8603 keytran_next = XSYMBOL (keytran_next)->function;
8604
8605 /* If the key translation map gives a function, not an
8606 array, then call the function with one arg and use
8607 its value instead. */
8608 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
8609 && keytran_end == t)
8610 {
8611 struct gcpro gcpro1, gcpro2, gcpro3;
8612 Lisp_Object tem;
8613 tem = keytran_next;
8614
8615 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
8616 keytran_next = call1 (keytran_next, prompt);
8617 UNGCPRO;
8618 /* If the function returned something invalid,
8619 barf--don't ignore it.
8620 (To ignore it safely, we would need to gcpro a bunch of
8621 other variables.) */
8622 if (! (VECTORP (keytran_next) || STRINGP (keytran_next)))
8623 error ("Function in key-translation-map returns invalid key sequence");
8624 }
8625
8626 key_translation_possible = ! NILP (keytran_next);
8627
8628 /* If keybuf[keytran_start..keytran_end] is bound in the
8629 key translation map and it's a suffix of the current
8630 sequence (i.e. keytran_end == t), replace it with
8631 the binding and restart with keytran_start at the end. */
8632 if ((VECTORP (keytran_next) || STRINGP (keytran_next))
8633 && keytran_end == t)
8634 {
8635 int len = XFASTINT (Flength (keytran_next));
8636
8637 t = keytran_start + len;
8638 if (t >= bufsize)
8639 error ("Key sequence too long");
8640
8641 if (VECTORP (keytran_next))
8642 bcopy (XVECTOR (keytran_next)->contents,
8643 keybuf + keytran_start,
8644 (t - keytran_start) * sizeof (keybuf[0]));
8645 else if (STRINGP (keytran_next))
8646 {
8647 int i;
8648
8649 for (i = 0; i < len; i++)
8650 XSETFASTINT (keybuf[keytran_start + i],
8651 XSTRING (keytran_next)->data[i]);
8652 }
8653
8654 mock_input = t;
8655 keytran_start = keytran_end = t;
8656 keytran_map = Vkey_translation_map;
8657
8658 /* Don't pass the results of key-translation-map
8659 through function-key-map. */
8660 fkey_start = fkey_end = t;
8661 fkey_map = Vfunction_key_map;
8662
8663 goto replay_sequence;
8664 }
8665
8666 keytran_map = get_keymap (keytran_next, 0, 1);
8667
8668 /* If we no longer have a bound suffix, try a new positions for
8669 keytran_start. */
8670 if (!CONSP (keytran_map))
8671 {
8672 keytran_end = ++keytran_start;
8673 keytran_map = Vkey_translation_map;
8674 key_translation_possible = 0;
8675 }
8676 }
8677 }
8678
8679 /* If KEY is not defined in any of the keymaps,
8680 and cannot be part of a function key or translation,
8681 and is an upper case letter
8682 use the corresponding lower-case letter instead. */
8683 if (first_binding == nmaps && ! function_key_possible
8684 && ! key_translation_possible
8685 && INTEGERP (key)
8686 && ((((XINT (key) & 0x3ffff)
8687 < XCHAR_TABLE (current_buffer->downcase_table)->size)
8688 && UPPERCASEP (XINT (key) & 0x3ffff))
8689 || (XINT (key) & shift_modifier)))
8690 {
8691 Lisp_Object new_key;
8692
8693 original_uppercase = key;
8694 original_uppercase_position = t - 1;
8695
8696 if (XINT (key) & shift_modifier)
8697 XSETINT (new_key, XINT (key) & ~shift_modifier);
8698 else
8699 XSETINT (new_key, (DOWNCASE (XINT (key) & 0x3ffff)
8700 | (XINT (key) & ~0x3ffff)));
8701
8702 /* We have to do this unconditionally, regardless of whether
8703 the lower-case char is defined in the keymaps, because they
8704 might get translated through function-key-map. */
8705 keybuf[t - 1] = new_key;
8706 mock_input = t;
8707
8708 fkey_map = prev_fkey_map;
8709 fkey_start = prev_fkey_start;
8710 fkey_end = prev_fkey_end;
8711
8712 keytran_map = prev_keytran_map;
8713 keytran_start = prev_keytran_start;
8714 keytran_end = prev_keytran_end;
8715
8716 goto replay_sequence;
8717 }
8718 /* If KEY is not defined in any of the keymaps,
8719 and cannot be part of a function key or translation,
8720 and is a shifted function key,
8721 use the corresponding unshifted function key instead. */
8722 if (first_binding == nmaps && ! function_key_possible
8723 && ! key_translation_possible
8724 && SYMBOLP (key))
8725 {
8726 Lisp_Object breakdown;
8727 int modifiers;
8728
8729 breakdown = parse_modifiers (key);
8730 modifiers = XINT (XCAR (XCDR (breakdown)));
8731 if (modifiers & shift_modifier)
8732 {
8733 Lisp_Object new_key;
8734
8735 original_uppercase = key;
8736 original_uppercase_position = t - 1;
8737
8738 modifiers &= ~shift_modifier;
8739 new_key = apply_modifiers (modifiers,
8740 XCAR (breakdown));
8741
8742 keybuf[t - 1] = new_key;
8743 mock_input = t;
8744
8745 fkey_map = prev_fkey_map;
8746 fkey_start = prev_fkey_start;
8747 fkey_end = prev_fkey_end;
8748
8749 keytran_map = prev_keytran_map;
8750 keytran_start = prev_keytran_start;
8751 keytran_end = prev_keytran_end;
8752
8753 goto replay_sequence;
8754 }
8755 }
8756 }
8757
8758 if (!dummyflag)
8759 read_key_sequence_cmd = (first_binding < nmaps
8760 ? defs[first_binding]
8761 : Qnil);
8762
8763 unread_switch_frame = delayed_switch_frame;
8764 unbind_to (count, Qnil);
8765
8766 /* Don't downcase the last character if the caller says don't.
8767 Don't downcase it if the result is undefined, either. */
8768 if ((dont_downcase_last || first_binding >= nmaps)
8769 && t - 1 == original_uppercase_position)
8770 keybuf[t - 1] = original_uppercase;
8771
8772 /* Occasionally we fabricate events, perhaps by expanding something
8773 according to function-key-map, or by adding a prefix symbol to a
8774 mouse click in the scroll bar or modeline. In this cases, return
8775 the entire generated key sequence, even if we hit an unbound
8776 prefix or a definition before the end. This means that you will
8777 be able to push back the event properly, and also means that
8778 read-key-sequence will always return a logical unit.
8779
8780 Better ideas? */
8781 for (; t < mock_input; t++)
8782 {
8783 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8784 && NILP (Fzerop (Vecho_keystrokes)))
8785 echo_char (keybuf[t]);
8786 add_command_key (keybuf[t]);
8787 }
8788
8789
8790
8791 return t;
8792 }
8793
8794 #if 0 /* This doc string is too long for some compilers.
8795 This commented-out definition serves for DOC. */
8796 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0,
8797 "Read a sequence of keystrokes and return as a string or vector.\n\
8798 The sequence is sufficient to specify a non-prefix command in the\n\
8799 current local and global maps.\n\
8800 \n\
8801 First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
8802 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\
8803 as a continuation of the previous key.\n\
8804 \n\
8805 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not\n\
8806 convert the last event to lower case. (Normally any upper case event\n\
8807 is converted to lower case if the original event is undefined and the lower\n\
8808 case equivalent is defined.) A non-nil value is appropriate for reading\n\
8809 a key sequence to be defined.\n\
8810 \n\
8811 A C-g typed while in this function is treated like any other character,\n\
8812 and `quit-flag' is not set.\n\
8813 \n\
8814 If the key sequence starts with a mouse click, then the sequence is read\n\
8815 using the keymaps of the buffer of the window clicked in, not the buffer\n\
8816 of the selected window as normal.\n\
8817 ""\n\
8818 `read-key-sequence' drops unbound button-down events, since you normally\n\
8819 only care about the click or drag events which follow them. If a drag\n\
8820 or multi-click event is unbound, but the corresponding click event would\n\
8821 be bound, `read-key-sequence' turns the event into a click event at the\n\
8822 drag's starting position. This means that you don't have to distinguish\n\
8823 between click and drag, double, or triple events unless you want to.\n\
8824 \n\
8825 `read-key-sequence' prefixes mouse events on mode lines, the vertical\n\
8826 lines separating windows, and scroll bars with imaginary keys\n\
8827 `mode-line', `vertical-line', and `vertical-scroll-bar'.\n\
8828 \n\
8829 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this\n\
8830 function will process a switch-frame event if the user switches frames\n\
8831 before typing anything. If the user switches frames in the middle of a\n\
8832 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME\n\
8833 is nil, then the event will be put off until after the current key sequence.\n\
8834 \n\
8835 `read-key-sequence' checks `function-key-map' for function key\n\
8836 sequences, where they wouldn't conflict with ordinary bindings. See\n\
8837 `function-key-map' for more details.\n\
8838 \n\
8839 The optional fifth argument COMMAND-LOOP, if non-nil, means\n\
8840 that this key sequence is being read by something that will\n\
8841 read commands one after another. It should be nil if the caller\n\
8842 will read just one key sequence.")
8843 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame, command-loop)
8844 #endif
8845
8846 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
8847 0)
8848 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
8849 command_loop)
8850 Lisp_Object prompt, continue_echo, dont_downcase_last;
8851 Lisp_Object can_return_switch_frame, command_loop;
8852 {
8853 Lisp_Object keybuf[30];
8854 register int i;
8855 struct gcpro gcpro1;
8856 int count = specpdl_ptr - specpdl;
8857
8858 if (!NILP (prompt))
8859 CHECK_STRING (prompt, 0);
8860 QUIT;
8861
8862 specbind (Qinput_method_exit_on_first_char,
8863 (NILP (command_loop) ? Qt : Qnil));
8864 specbind (Qinput_method_use_echo_area,
8865 (NILP (command_loop) ? Qt : Qnil));
8866
8867 bzero (keybuf, sizeof keybuf);
8868 GCPRO1 (keybuf[0]);
8869 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
8870
8871 if (NILP (continue_echo))
8872 {
8873 this_command_key_count = 0;
8874 this_single_command_key_start = 0;
8875 }
8876
8877 #ifdef HAVE_X_WINDOWS
8878 if (display_busy_cursor_p)
8879 cancel_busy_cursor ();
8880 #endif
8881
8882 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
8883 prompt, ! NILP (dont_downcase_last),
8884 ! NILP (can_return_switch_frame), 0);
8885
8886 #if 0 /* The following is fine for code reading a key sequence and
8887 then proceeding with a lenghty compuation, but it's not good
8888 for code reading keys in a loop, like an input method. */
8889 #ifdef HAVE_X_WINDOWS
8890 if (display_busy_cursor_p)
8891 start_busy_cursor ();
8892 #endif
8893 #endif
8894
8895 if (i == -1)
8896 {
8897 Vquit_flag = Qt;
8898 QUIT;
8899 }
8900 UNGCPRO;
8901 return unbind_to (count, make_event_array (i, keybuf));
8902 }
8903
8904 DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
8905 Sread_key_sequence_vector, 1, 5, 0,
8906 "Like `read-key-sequence' but always return a vector.")
8907 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame,
8908 command_loop)
8909 Lisp_Object prompt, continue_echo, dont_downcase_last;
8910 Lisp_Object can_return_switch_frame, command_loop;
8911 {
8912 Lisp_Object keybuf[30];
8913 register int i;
8914 struct gcpro gcpro1;
8915 int count = specpdl_ptr - specpdl;
8916
8917 if (!NILP (prompt))
8918 CHECK_STRING (prompt, 0);
8919 QUIT;
8920
8921 specbind (Qinput_method_exit_on_first_char,
8922 (NILP (command_loop) ? Qt : Qnil));
8923 specbind (Qinput_method_use_echo_area,
8924 (NILP (command_loop) ? Qt : Qnil));
8925
8926 bzero (keybuf, sizeof keybuf);
8927 GCPRO1 (keybuf[0]);
8928 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
8929
8930 if (NILP (continue_echo))
8931 {
8932 this_command_key_count = 0;
8933 this_single_command_key_start = 0;
8934 }
8935
8936 #ifdef HAVE_X_WINDOWS
8937 if (display_busy_cursor_p)
8938 cancel_busy_cursor ();
8939 #endif
8940
8941 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
8942 prompt, ! NILP (dont_downcase_last),
8943 ! NILP (can_return_switch_frame), 0);
8944
8945 #ifdef HAVE_X_WINDOWS
8946 if (display_busy_cursor_p)
8947 start_busy_cursor ();
8948 #endif
8949
8950 if (i == -1)
8951 {
8952 Vquit_flag = Qt;
8953 QUIT;
8954 }
8955 UNGCPRO;
8956 return unbind_to (count, Fvector (i, keybuf));
8957 }
8958 \f
8959 DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0,
8960 "Execute CMD as an editor command.\n\
8961 CMD must be a symbol that satisfies the `commandp' predicate.\n\
8962 Optional second arg RECORD-FLAG non-nil\n\
8963 means unconditionally put this command in `command-history'.\n\
8964 Otherwise, that is done only if an arg is read using the minibuffer.\n\
8965 The argument KEYS specifies the value to use instead of (this-command-keys)\n\
8966 when reading the arguments; if it is nil, (this-command-keys) is used.\n\
8967 The argument SPECIAL, if non-nil, means that this command is executing\n\
8968 a special event, so ignore the prefix argument and don't clear it.")
8969 (cmd, record_flag, keys, special)
8970 Lisp_Object cmd, record_flag, keys, special;
8971 {
8972 register Lisp_Object final;
8973 register Lisp_Object tem;
8974 Lisp_Object prefixarg;
8975 struct backtrace backtrace;
8976 extern int debug_on_next_call;
8977
8978 debug_on_next_call = 0;
8979
8980 if (NILP (special))
8981 {
8982 prefixarg = current_kboard->Vprefix_arg;
8983 Vcurrent_prefix_arg = prefixarg;
8984 current_kboard->Vprefix_arg = Qnil;
8985 }
8986 else
8987 prefixarg = Qnil;
8988
8989 if (SYMBOLP (cmd))
8990 {
8991 tem = Fget (cmd, Qdisabled);
8992 if (!NILP (tem) && !NILP (Vrun_hooks))
8993 {
8994 tem = Fsymbol_value (Qdisabled_command_hook);
8995 if (!NILP (tem))
8996 return call1 (Vrun_hooks, Qdisabled_command_hook);
8997 }
8998 }
8999
9000 while (1)
9001 {
9002 final = Findirect_function (cmd);
9003
9004 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
9005 {
9006 struct gcpro gcpro1, gcpro2;
9007
9008 GCPRO2 (cmd, prefixarg);
9009 do_autoload (final, cmd);
9010 UNGCPRO;
9011 }
9012 else
9013 break;
9014 }
9015
9016 if (STRINGP (final) || VECTORP (final))
9017 {
9018 /* If requested, place the macro in the command history. For
9019 other sorts of commands, call-interactively takes care of
9020 this. */
9021 if (!NILP (record_flag))
9022 {
9023 Vcommand_history
9024 = Fcons (Fcons (Qexecute_kbd_macro,
9025 Fcons (final, Fcons (prefixarg, Qnil))),
9026 Vcommand_history);
9027
9028 /* Don't keep command history around forever. */
9029 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
9030 {
9031 tem = Fnthcdr (Vhistory_length, Vcommand_history);
9032 if (CONSP (tem))
9033 XCDR (tem) = Qnil;
9034 }
9035 }
9036
9037 return Fexecute_kbd_macro (final, prefixarg);
9038 }
9039
9040 if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
9041 {
9042 backtrace.next = backtrace_list;
9043 backtrace_list = &backtrace;
9044 backtrace.function = &Qcall_interactively;
9045 backtrace.args = &cmd;
9046 backtrace.nargs = 1;
9047 backtrace.evalargs = 0;
9048
9049 tem = Fcall_interactively (cmd, record_flag, keys);
9050
9051 backtrace_list = backtrace.next;
9052 return tem;
9053 }
9054 return Qnil;
9055 }
9056 \f
9057 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
9058 1, 1, "P",
9059 "Read function name, then read its arguments and call it.")
9060 (prefixarg)
9061 Lisp_Object prefixarg;
9062 {
9063 Lisp_Object function;
9064 char buf[40];
9065 Lisp_Object saved_keys;
9066 Lisp_Object bindings, value;
9067 struct gcpro gcpro1, gcpro2;
9068
9069 saved_keys = Fvector (this_command_key_count,
9070 XVECTOR (this_command_keys)->contents);
9071 buf[0] = 0;
9072 GCPRO2 (saved_keys, prefixarg);
9073
9074 if (EQ (prefixarg, Qminus))
9075 strcpy (buf, "- ");
9076 else if (CONSP (prefixarg) && XINT (XCAR (prefixarg)) == 4)
9077 strcpy (buf, "C-u ");
9078 else if (CONSP (prefixarg) && INTEGERP (XCAR (prefixarg)))
9079 {
9080 if (sizeof (int) == sizeof (EMACS_INT))
9081 sprintf (buf, "%d ", XINT (XCAR (prefixarg)));
9082 else if (sizeof (long) == sizeof (EMACS_INT))
9083 sprintf (buf, "%ld ", (long) XINT (XCAR (prefixarg)));
9084 else
9085 abort ();
9086 }
9087 else if (INTEGERP (prefixarg))
9088 {
9089 if (sizeof (int) == sizeof (EMACS_INT))
9090 sprintf (buf, "%d ", XINT (prefixarg));
9091 else if (sizeof (long) == sizeof (EMACS_INT))
9092 sprintf (buf, "%ld ", (long) XINT (prefixarg));
9093 else
9094 abort ();
9095 }
9096
9097 /* This isn't strictly correct if execute-extended-command
9098 is bound to anything else. Perhaps it should use
9099 this_command_keys? */
9100 strcat (buf, "M-x ");
9101
9102 /* Prompt with buf, and then read a string, completing from and
9103 restricting to the set of all defined commands. Don't provide
9104 any initial input. Save the command read on the extended-command
9105 history list. */
9106 function = Fcompleting_read (build_string (buf),
9107 Vobarray, Qcommandp,
9108 Qt, Qnil, Qextended_command_history, Qnil,
9109 Qnil);
9110
9111 if (STRINGP (function) && XSTRING (function)->size == 0)
9112 error ("No command name given");
9113
9114 /* Set this_command_keys to the concatenation of saved_keys and
9115 function, followed by a RET. */
9116 {
9117 struct Lisp_String *str;
9118 Lisp_Object *keys;
9119 int i;
9120
9121 this_command_key_count = 0;
9122 this_single_command_key_start = 0;
9123
9124 keys = XVECTOR (saved_keys)->contents;
9125 for (i = 0; i < XVECTOR (saved_keys)->size; i++)
9126 add_command_key (keys[i]);
9127
9128 str = XSTRING (function);
9129 for (i = 0; i < str->size; i++)
9130 add_command_key (Faref (function, make_number (i)));
9131
9132 add_command_key (make_number ('\015'));
9133 }
9134
9135 UNGCPRO;
9136
9137 function = Fintern (function, Qnil);
9138 current_kboard->Vprefix_arg = prefixarg;
9139 Vthis_command = function;
9140 real_this_command = function;
9141
9142 /* If enabled, show which key runs this command. */
9143 if (!NILP (Vsuggest_key_bindings)
9144 && NILP (Vexecuting_macro)
9145 && SYMBOLP (function))
9146 bindings = Fwhere_is_internal (function, Voverriding_local_map,
9147 Qt, Qnil);
9148 else
9149 bindings = Qnil;
9150
9151 value = Qnil;
9152 GCPRO2 (bindings, value);
9153 value = Fcommand_execute (function, Qt, Qnil, Qnil);
9154
9155 /* If the command has a key binding, print it now. */
9156 if (!NILP (bindings)
9157 && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
9158 Qmouse_movement)))
9159 {
9160 /* But first wait, and skip the message if there is input. */
9161 int delay_time;
9162 if (!NILP (echo_area_buffer[0]))
9163 /* This command displayed something in the echo area;
9164 so wait a few seconds, then display our suggestion message. */
9165 delay_time = (NUMBERP (Vsuggest_key_bindings)
9166 ? XINT (Vsuggest_key_bindings) : 2);
9167 else
9168 /* This command left the echo area empty,
9169 so display our message immediately. */
9170 delay_time = 0;
9171
9172 if (!NILP (Fsit_for (make_number (delay_time), Qnil, Qnil))
9173 && ! CONSP (Vunread_command_events))
9174 {
9175 Lisp_Object binding;
9176 char *newmessage;
9177 int message_p = push_message ();
9178
9179 binding = Fkey_description (bindings);
9180
9181 newmessage
9182 = (char *) alloca (XSYMBOL (function)->name->size
9183 + STRING_BYTES (XSTRING (binding))
9184 + 100);
9185 sprintf (newmessage, "You can run the command `%s' with %s",
9186 XSYMBOL (function)->name->data,
9187 XSTRING (binding)->data);
9188 message2_nolog (newmessage,
9189 strlen (newmessage),
9190 STRING_MULTIBYTE (binding));
9191 if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings)
9192 ? Vsuggest_key_bindings : make_number (2)),
9193 Qnil, Qnil))
9194 && message_p)
9195 restore_message ();
9196
9197 pop_message ();
9198 }
9199 }
9200
9201 RETURN_UNGCPRO (value);
9202 }
9203
9204 /* Find the set of keymaps now active.
9205 Store into *MAPS_P a vector holding the various maps
9206 and return the number of them. The vector was malloc'd
9207 and the caller should free it. */
9208
9209 int
9210 current_active_maps (maps_p)
9211 Lisp_Object **maps_p;
9212 {
9213 Lisp_Object *tmaps, *maps;
9214 int nmaps;
9215
9216 /* Should overriding-terminal-local-map and overriding-local-map apply? */
9217 if (!NILP (Voverriding_local_map_menu_flag))
9218 {
9219 /* Yes, use them (if non-nil) as well as the global map. */
9220 maps = (Lisp_Object *) xmalloc (3 * sizeof (maps[0]));
9221 nmaps = 0;
9222 if (!NILP (current_kboard->Voverriding_terminal_local_map))
9223 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
9224 if (!NILP (Voverriding_local_map))
9225 maps[nmaps++] = Voverriding_local_map;
9226 }
9227 else
9228 {
9229 /* No, so use major and minor mode keymaps and keymap property. */
9230 int extra_maps = 2;
9231 Lisp_Object map = get_local_map (PT, current_buffer, keymap);
9232 if (!NILP (map))
9233 extra_maps = 3;
9234 nmaps = current_minor_maps (NULL, &tmaps);
9235 maps = (Lisp_Object *) alloca ((nmaps + extra_maps)
9236 * sizeof (maps[0]));
9237 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
9238 if (!NILP (map))
9239 maps[nmaps++] = map;
9240 maps[nmaps++] = get_local_map (PT, current_buffer, local_map);
9241 }
9242 maps[nmaps++] = current_global_map;
9243
9244 *maps_p = maps;
9245 return nmaps;
9246 }
9247 \f
9248 /* Return nonzero if input events are pending. */
9249
9250 int
9251 detect_input_pending ()
9252 {
9253 if (!input_pending)
9254 get_input_pending (&input_pending, 0);
9255
9256 return input_pending;
9257 }
9258
9259 /* Return nonzero if input events are pending, and run any pending timers. */
9260
9261 int
9262 detect_input_pending_run_timers (do_display)
9263 int do_display;
9264 {
9265 int old_timers_run = timers_run;
9266
9267 if (!input_pending)
9268 get_input_pending (&input_pending, 1);
9269
9270 if (old_timers_run != timers_run && do_display)
9271 {
9272 redisplay_preserve_echo_area ();
9273 /* The following fixes a bug when using lazy-lock with
9274 lazy-lock-defer-on-the-fly set to t, i.e. when fontifying
9275 from an idle timer function. The symptom of the bug is that
9276 the cursor sometimes doesn't become visible until the next X
9277 event is processed. --gerd. */
9278 if (rif)
9279 rif->flush_display (NULL);
9280 }
9281
9282 return input_pending;
9283 }
9284
9285 /* This is called in some cases before a possible quit.
9286 It cases the next call to detect_input_pending to recompute input_pending.
9287 So calling this function unnecessarily can't do any harm. */
9288
9289 void
9290 clear_input_pending ()
9291 {
9292 input_pending = 0;
9293 }
9294
9295 /* Return nonzero if there are pending requeued events.
9296 This isn't used yet. The hope is to make wait_reading_process_input
9297 call it, and return return if it runs Lisp code that unreads something.
9298 The problem is, kbd_buffer_get_event needs to be fixed to know what
9299 to do in that case. It isn't trivial. */
9300
9301 int
9302 requeued_events_pending_p ()
9303 {
9304 return (!NILP (Vunread_command_events) || unread_command_char != -1);
9305 }
9306
9307
9308 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
9309 "T if command input is currently available with no waiting.\n\
9310 Actually, the value is nil only if we can be sure that no input is available.")
9311 ()
9312 {
9313 if (!NILP (Vunread_command_events) || unread_command_char != -1)
9314 return (Qt);
9315
9316 get_input_pending (&input_pending, 1);
9317 return input_pending > 0 ? Qt : Qnil;
9318 }
9319
9320 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
9321 "Return vector of last 100 events, not counting those from keyboard macros.")
9322 ()
9323 {
9324 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
9325 Lisp_Object val;
9326
9327 if (total_keys < NUM_RECENT_KEYS)
9328 return Fvector (total_keys, keys);
9329 else
9330 {
9331 val = Fvector (NUM_RECENT_KEYS, keys);
9332 bcopy (keys + recent_keys_index,
9333 XVECTOR (val)->contents,
9334 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
9335 bcopy (keys,
9336 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
9337 recent_keys_index * sizeof (Lisp_Object));
9338 return val;
9339 }
9340 }
9341
9342 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
9343 "Return the key sequence that invoked this command.\n\
9344 The value is a string or a vector.")
9345 ()
9346 {
9347 return make_event_array (this_command_key_count,
9348 XVECTOR (this_command_keys)->contents);
9349 }
9350
9351 DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
9352 "Return the key sequence that invoked this command, as a vector.")
9353 ()
9354 {
9355 return Fvector (this_command_key_count,
9356 XVECTOR (this_command_keys)->contents);
9357 }
9358
9359 DEFUN ("this-single-command-keys", Fthis_single_command_keys,
9360 Sthis_single_command_keys, 0, 0, 0,
9361 "Return the key sequence that invoked this command.\n\
9362 Unlike `this-command-keys', this function's value\n\
9363 does not include prefix arguments.\n\
9364 The value is always a vector.")
9365 ()
9366 {
9367 return Fvector (this_command_key_count
9368 - this_single_command_key_start,
9369 (XVECTOR (this_command_keys)->contents
9370 + this_single_command_key_start));
9371 }
9372
9373 DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
9374 Sthis_single_command_raw_keys, 0, 0, 0,
9375 "Return the raw events that were read for this command.\n\
9376 Unlike `this-single-command-keys', this function's value\n\
9377 shows the events before all translations (except for input methods).\n\
9378 The value is always a vector.")
9379 ()
9380 {
9381 return Fvector (raw_keybuf_count,
9382 (XVECTOR (raw_keybuf)->contents));
9383 }
9384
9385 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
9386 Sreset_this_command_lengths, 0, 0, 0,
9387 "Used for complicated reasons in `universal-argument-other-key'.\n\
9388 \n\
9389 `universal-argument-other-key' rereads the event just typed.\n\
9390 It then gets translated through `function-key-map'.\n\
9391 The translated event gets included in the echo area and in\n\
9392 the value of `this-command-keys' in addition to the raw original event.\n\
9393 That is not right.\n\
9394 \n\
9395 Calling this function directs the translated event to replace\n\
9396 the original event, so that only one version of the event actually\n\
9397 appears in the echo area and in the value of `this-command-keys.'.")
9398 ()
9399 {
9400 before_command_restore_flag = 1;
9401 before_command_key_count_1 = before_command_key_count;
9402 before_command_echo_length_1 = before_command_echo_length;
9403 return Qnil;
9404 }
9405
9406 DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
9407 Sclear_this_command_keys, 0, 0, 0,
9408 "Clear out the vector that `this-command-keys' returns.\n\
9409 Clear vector containing last 100 events.")
9410 ()
9411 {
9412 int i;
9413
9414 this_command_key_count = 0;
9415
9416 for (i = 0; i < XVECTOR (recent_keys)->size; ++i)
9417 XVECTOR (recent_keys)->contents[i] = Qnil;
9418 total_keys = 0;
9419 recent_keys_index = 0;
9420 return Qnil;
9421 }
9422
9423 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
9424 "Return the current depth in recursive edits.")
9425 ()
9426 {
9427 Lisp_Object temp;
9428 XSETFASTINT (temp, command_loop_level + minibuf_level);
9429 return temp;
9430 }
9431
9432 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
9433 "FOpen dribble file: ",
9434 "Start writing all keyboard characters to a dribble file called FILE.\n\
9435 If FILE is nil, close any open dribble file.")
9436 (file)
9437 Lisp_Object file;
9438 {
9439 if (dribble)
9440 {
9441 fclose (dribble);
9442 dribble = 0;
9443 }
9444 if (!NILP (file))
9445 {
9446 file = Fexpand_file_name (file, Qnil);
9447 dribble = fopen (XSTRING (file)->data, "w");
9448 if (dribble == 0)
9449 report_file_error ("Opening dribble", Fcons (file, Qnil));
9450 }
9451 return Qnil;
9452 }
9453
9454 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
9455 "Discard the contents of the terminal input buffer.\n\
9456 Also cancel any kbd macro being defined.")
9457 ()
9458 {
9459 current_kboard->defining_kbd_macro = Qnil;
9460 update_mode_lines++;
9461
9462 Vunread_command_events = Qnil;
9463 unread_command_char = -1;
9464
9465 discard_tty_input ();
9466
9467 kbd_fetch_ptr = kbd_store_ptr;
9468 Ffillarray (kbd_buffer_gcpro, Qnil);
9469 input_pending = 0;
9470
9471 return Qnil;
9472 }
9473 \f
9474 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
9475 "Stop Emacs and return to superior process. You can resume later.\n\
9476 If `cannot-suspend' is non-nil, or if the system doesn't support job\n\
9477 control, run a subshell instead.\n\n\
9478 If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
9479 to be read as terminal input by Emacs's parent, after suspension.\n\
9480 \n\
9481 Before suspending, run the normal hook `suspend-hook'.\n\
9482 After resumption run the normal hook `suspend-resume-hook'.\n\
9483 \n\
9484 Some operating systems cannot stop the Emacs process and resume it later.\n\
9485 On such systems, Emacs starts a subshell instead of suspending.")
9486 (stuffstring)
9487 Lisp_Object stuffstring;
9488 {
9489 int count = specpdl_ptr - specpdl;
9490 int old_height, old_width;
9491 int width, height;
9492 struct gcpro gcpro1;
9493
9494 if (!NILP (stuffstring))
9495 CHECK_STRING (stuffstring, 0);
9496
9497 /* Run the functions in suspend-hook. */
9498 if (!NILP (Vrun_hooks))
9499 call1 (Vrun_hooks, intern ("suspend-hook"));
9500
9501 GCPRO1 (stuffstring);
9502 get_frame_size (&old_width, &old_height);
9503 reset_sys_modes ();
9504 /* sys_suspend can get an error if it tries to fork a subshell
9505 and the system resources aren't available for that. */
9506 record_unwind_protect ((Lisp_Object (*) P_ ((Lisp_Object))) init_sys_modes,
9507 Qnil);
9508 stuff_buffered_input (stuffstring);
9509 if (cannot_suspend)
9510 sys_subshell ();
9511 else
9512 sys_suspend ();
9513 unbind_to (count, Qnil);
9514
9515 /* Check if terminal/window size has changed.
9516 Note that this is not useful when we are running directly
9517 with a window system; but suspend should be disabled in that case. */
9518 get_frame_size (&width, &height);
9519 if (width != old_width || height != old_height)
9520 change_frame_size (SELECTED_FRAME (), height, width, 0, 0, 0);
9521
9522 /* Run suspend-resume-hook. */
9523 if (!NILP (Vrun_hooks))
9524 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
9525
9526 UNGCPRO;
9527 return Qnil;
9528 }
9529
9530 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
9531 Then in any case stuff anything Emacs has read ahead and not used. */
9532
9533 void
9534 stuff_buffered_input (stuffstring)
9535 Lisp_Object stuffstring;
9536 {
9537 /* stuff_char works only in BSD, versions 4.2 and up. */
9538 #ifdef BSD_SYSTEM
9539 #ifndef BSD4_1
9540 register unsigned char *p;
9541
9542 if (STRINGP (stuffstring))
9543 {
9544 register int count;
9545
9546 p = XSTRING (stuffstring)->data;
9547 count = STRING_BYTES (XSTRING (stuffstring));
9548 while (count-- > 0)
9549 stuff_char (*p++);
9550 stuff_char ('\n');
9551 }
9552
9553 /* Anything we have read ahead, put back for the shell to read. */
9554 /* ?? What should this do when we have multiple keyboards??
9555 Should we ignore anything that was typed in at the "wrong" kboard? */
9556 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
9557 {
9558 int idx;
9559
9560 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
9561 kbd_fetch_ptr = kbd_buffer;
9562 if (kbd_fetch_ptr->kind == ascii_keystroke)
9563 stuff_char (kbd_fetch_ptr->code);
9564
9565 kbd_fetch_ptr->kind = no_event;
9566 idx = 2 * (kbd_fetch_ptr - kbd_buffer);
9567 ASET (kbd_buffer_gcpro, idx, Qnil);
9568 ASET (kbd_buffer_gcpro, idx + 1, Qnil);
9569 }
9570
9571 input_pending = 0;
9572 #endif
9573 #endif /* BSD_SYSTEM and not BSD4_1 */
9574 }
9575 \f
9576 void
9577 set_waiting_for_input (time_to_clear)
9578 EMACS_TIME *time_to_clear;
9579 {
9580 input_available_clear_time = time_to_clear;
9581
9582 /* Tell interrupt_signal to throw back to read_char, */
9583 waiting_for_input = 1;
9584
9585 /* If interrupt_signal was called before and buffered a C-g,
9586 make it run again now, to avoid timing error. */
9587 if (!NILP (Vquit_flag))
9588 quit_throw_to_read_char ();
9589 }
9590
9591 void
9592 clear_waiting_for_input ()
9593 {
9594 /* Tell interrupt_signal not to throw back to read_char, */
9595 waiting_for_input = 0;
9596 input_available_clear_time = 0;
9597 }
9598
9599 /* This routine is called at interrupt level in response to C-G.
9600
9601 If interrupt_input, this is the handler for SIGINT. Otherwise, it
9602 is called from kbd_buffer_store_event, in handling SIGIO or
9603 SIGTINT.
9604
9605 If `waiting_for_input' is non zero, then unless `echoing' is
9606 nonzero, immediately throw back to read_char.
9607
9608 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
9609 eval to throw, when it gets a chance. If quit-flag is already
9610 non-nil, it stops the job right away. */
9611
9612 SIGTYPE
9613 interrupt_signal (signalnum) /* If we don't have an argument, */
9614 int signalnum; /* some compilers complain in signal calls. */
9615 {
9616 char c;
9617 /* Must preserve main program's value of errno. */
9618 int old_errno = errno;
9619 struct frame *sf = SELECTED_FRAME ();
9620
9621 #if defined (USG) && !defined (POSIX_SIGNALS)
9622 if (!read_socket_hook && NILP (Vwindow_system))
9623 {
9624 /* USG systems forget handlers when they are used;
9625 must reestablish each time */
9626 signal (SIGINT, interrupt_signal);
9627 signal (SIGQUIT, interrupt_signal);
9628 }
9629 #endif /* USG */
9630
9631 cancel_echoing ();
9632
9633 if (!NILP (Vquit_flag)
9634 && (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf)))
9635 {
9636 /* If SIGINT isn't blocked, don't let us be interrupted by
9637 another SIGINT, it might be harmful due to non-reentrancy
9638 in I/O functions. */
9639 sigblock (sigmask (SIGINT));
9640
9641 fflush (stdout);
9642 reset_sys_modes ();
9643
9644 #ifdef SIGTSTP /* Support possible in later USG versions */
9645 /*
9646 * On systems which can suspend the current process and return to the original
9647 * shell, this command causes the user to end up back at the shell.
9648 * The "Auto-save" and "Abort" questions are not asked until
9649 * the user elects to return to emacs, at which point he can save the current
9650 * job and either dump core or continue.
9651 */
9652 sys_suspend ();
9653 #else
9654 #ifdef VMS
9655 if (sys_suspend () == -1)
9656 {
9657 printf ("Not running as a subprocess;\n");
9658 printf ("you can continue or abort.\n");
9659 }
9660 #else /* not VMS */
9661 /* Perhaps should really fork an inferior shell?
9662 But that would not provide any way to get back
9663 to the original shell, ever. */
9664 printf ("No support for stopping a process on this operating system;\n");
9665 printf ("you can continue or abort.\n");
9666 #endif /* not VMS */
9667 #endif /* not SIGTSTP */
9668 #ifdef MSDOS
9669 /* We must remain inside the screen area when the internal terminal
9670 is used. Note that [Enter] is not echoed by dos. */
9671 cursor_to (0, 0);
9672 #endif
9673 /* It doesn't work to autosave while GC is in progress;
9674 the code used for auto-saving doesn't cope with the mark bit. */
9675 if (!gc_in_progress)
9676 {
9677 printf ("Auto-save? (y or n) ");
9678 fflush (stdout);
9679 if (((c = getchar ()) & ~040) == 'Y')
9680 {
9681 Fdo_auto_save (Qt, Qnil);
9682 #ifdef MSDOS
9683 printf ("\r\nAuto-save done");
9684 #else /* not MSDOS */
9685 printf ("Auto-save done\n");
9686 #endif /* not MSDOS */
9687 }
9688 while (c != '\n') c = getchar ();
9689 }
9690 else
9691 {
9692 /* During GC, it must be safe to reenable quitting again. */
9693 Vinhibit_quit = Qnil;
9694 #ifdef MSDOS
9695 printf ("\r\n");
9696 #endif /* not MSDOS */
9697 printf ("Garbage collection in progress; cannot auto-save now\r\n");
9698 printf ("but will instead do a real quit after garbage collection ends\r\n");
9699 fflush (stdout);
9700 }
9701
9702 #ifdef MSDOS
9703 printf ("\r\nAbort? (y or n) ");
9704 #else /* not MSDOS */
9705 #ifdef VMS
9706 printf ("Abort (and enter debugger)? (y or n) ");
9707 #else /* not VMS */
9708 printf ("Abort (and dump core)? (y or n) ");
9709 #endif /* not VMS */
9710 #endif /* not MSDOS */
9711 fflush (stdout);
9712 if (((c = getchar ()) & ~040) == 'Y')
9713 abort ();
9714 while (c != '\n') c = getchar ();
9715 #ifdef MSDOS
9716 printf ("\r\nContinuing...\r\n");
9717 #else /* not MSDOS */
9718 printf ("Continuing...\n");
9719 #endif /* not MSDOS */
9720 fflush (stdout);
9721 init_sys_modes ();
9722 sigfree ();
9723 }
9724 else
9725 {
9726 /* If executing a function that wants to be interrupted out of
9727 and the user has not deferred quitting by binding `inhibit-quit'
9728 then quit right away. */
9729 if (immediate_quit && NILP (Vinhibit_quit))
9730 {
9731 struct gl_state_s saved;
9732 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9733
9734 immediate_quit = 0;
9735 sigfree ();
9736 saved = gl_state;
9737 GCPRO4 (saved.object, saved.global_code,
9738 saved.current_syntax_table, saved.old_prop);
9739 Fsignal (Qquit, Qnil);
9740 gl_state = saved;
9741 UNGCPRO;
9742 }
9743 else
9744 /* Else request quit when it's safe */
9745 Vquit_flag = Qt;
9746 }
9747
9748 if (waiting_for_input && !echoing)
9749 quit_throw_to_read_char ();
9750
9751 errno = old_errno;
9752 }
9753
9754 /* Handle a C-g by making read_char return C-g. */
9755
9756 void
9757 quit_throw_to_read_char ()
9758 {
9759 sigfree ();
9760 /* Prevent another signal from doing this before we finish. */
9761 clear_waiting_for_input ();
9762 input_pending = 0;
9763
9764 Vunread_command_events = Qnil;
9765 unread_command_char = -1;
9766
9767 #if 0 /* Currently, sit_for is called from read_char without turning
9768 off polling. And that can call set_waiting_for_input.
9769 It seems to be harmless. */
9770 #ifdef POLL_FOR_INPUT
9771 /* May be > 1 if in recursive minibuffer. */
9772 if (poll_suppress_count == 0)
9773 abort ();
9774 #endif
9775 #endif
9776 if (FRAMEP (internal_last_event_frame)
9777 && !EQ (internal_last_event_frame, selected_frame))
9778 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
9779 Qnil, 0);
9780
9781 _longjmp (getcjmp, 1);
9782 }
9783 \f
9784 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
9785 "Set mode of reading keyboard input.\n\
9786 First arg INTERRUPT non-nil means use input interrupts;\n\
9787 nil means use CBREAK mode.\n\
9788 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
9789 (no effect except in CBREAK mode).\n\
9790 Third arg META t means accept 8-bit input (for a Meta key).\n\
9791 META nil means ignore the top bit, on the assumption it is parity.\n\
9792 Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\
9793 Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\
9794 See also `current-input-mode'.")
9795 (interrupt, flow, meta, quit)
9796 Lisp_Object interrupt, flow, meta, quit;
9797 {
9798 if (!NILP (quit)
9799 && (!INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400))
9800 error ("set-input-mode: QUIT must be an ASCII character");
9801
9802 #ifdef POLL_FOR_INPUT
9803 stop_polling ();
9804 #endif
9805
9806 #ifndef DOS_NT
9807 /* this causes startup screen to be restored and messes with the mouse */
9808 reset_sys_modes ();
9809 #endif
9810
9811 #ifdef SIGIO
9812 /* Note SIGIO has been undef'd if FIONREAD is missing. */
9813 if (read_socket_hook)
9814 {
9815 /* When using X, don't give the user a real choice,
9816 because we haven't implemented the mechanisms to support it. */
9817 #ifdef NO_SOCK_SIGIO
9818 interrupt_input = 0;
9819 #else /* not NO_SOCK_SIGIO */
9820 interrupt_input = 1;
9821 #endif /* NO_SOCK_SIGIO */
9822 }
9823 else
9824 interrupt_input = !NILP (interrupt);
9825 #else /* not SIGIO */
9826 interrupt_input = 0;
9827 #endif /* not SIGIO */
9828
9829 /* Our VMS input only works by interrupts, as of now. */
9830 #ifdef VMS
9831 interrupt_input = 1;
9832 #endif
9833
9834 flow_control = !NILP (flow);
9835 if (NILP (meta))
9836 meta_key = 0;
9837 else if (EQ (meta, Qt))
9838 meta_key = 1;
9839 else
9840 meta_key = 2;
9841 if (!NILP (quit))
9842 /* Don't let this value be out of range. */
9843 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
9844
9845 #ifndef DOS_NT
9846 init_sys_modes ();
9847 #endif
9848
9849 #ifdef POLL_FOR_INPUT
9850 poll_suppress_count = 1;
9851 start_polling ();
9852 #endif
9853 return Qnil;
9854 }
9855
9856 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
9857 "Return information about the way Emacs currently reads keyboard input.\n\
9858 The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\
9859 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\
9860 nil, Emacs is using CBREAK mode.\n\
9861 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\
9862 terminal; this does not apply if Emacs uses interrupt-driven input.\n\
9863 META is t if accepting 8-bit input with 8th bit as Meta flag.\n\
9864 META nil means ignoring the top bit, on the assumption it is parity.\n\
9865 META is neither t nor nil if accepting 8-bit input and using\n\
9866 all 8 bits as the character code.\n\
9867 QUIT is the character Emacs currently uses to quit.\n\
9868 The elements of this list correspond to the arguments of\n\
9869 `set-input-mode'.")
9870 ()
9871 {
9872 Lisp_Object val[4];
9873
9874 val[0] = interrupt_input ? Qt : Qnil;
9875 val[1] = flow_control ? Qt : Qnil;
9876 val[2] = meta_key == 2 ? make_number (0) : meta_key == 1 ? Qt : Qnil;
9877 XSETFASTINT (val[3], quit_char);
9878
9879 return Flist (sizeof (val) / sizeof (val[0]), val);
9880 }
9881
9882 \f
9883 /*
9884 * Set up a new kboard object with reasonable initial values.
9885 */
9886 void
9887 init_kboard (kb)
9888 KBOARD *kb;
9889 {
9890 kb->Voverriding_terminal_local_map = Qnil;
9891 kb->Vlast_command = Qnil;
9892 kb->Vreal_last_command = Qnil;
9893 kb->Vprefix_arg = Qnil;
9894 kb->Vlast_prefix_arg = Qnil;
9895 kb->kbd_queue = Qnil;
9896 kb->kbd_queue_has_data = 0;
9897 kb->immediate_echo = 0;
9898 kb->echoptr = kb->echobuf;
9899 kb->echo_after_prompt = -1;
9900 kb->kbd_macro_buffer = 0;
9901 kb->kbd_macro_bufsize = 0;
9902 kb->defining_kbd_macro = Qnil;
9903 kb->Vlast_kbd_macro = Qnil;
9904 kb->reference_count = 0;
9905 kb->Vsystem_key_alist = Qnil;
9906 kb->system_key_syms = Qnil;
9907 kb->Vdefault_minibuffer_frame = Qnil;
9908 }
9909
9910 /*
9911 * Destroy the contents of a kboard object, but not the object itself.
9912 * We use this just before deleting it, or if we're going to initialize
9913 * it a second time.
9914 */
9915 static void
9916 wipe_kboard (kb)
9917 KBOARD *kb;
9918 {
9919 if (kb->kbd_macro_buffer)
9920 xfree (kb->kbd_macro_buffer);
9921 }
9922
9923 #ifdef MULTI_KBOARD
9924 void
9925 delete_kboard (kb)
9926 KBOARD *kb;
9927 {
9928 KBOARD **kbp;
9929 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
9930 if (*kbp == NULL)
9931 abort ();
9932 *kbp = kb->next_kboard;
9933 wipe_kboard (kb);
9934 xfree (kb);
9935 }
9936 #endif
9937
9938 void
9939 init_keyboard ()
9940 {
9941 /* This is correct before outermost invocation of the editor loop */
9942 command_loop_level = -1;
9943 immediate_quit = 0;
9944 quit_char = Ctl ('g');
9945 Vunread_command_events = Qnil;
9946 unread_command_char = -1;
9947 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
9948 total_keys = 0;
9949 recent_keys_index = 0;
9950 kbd_fetch_ptr = kbd_buffer;
9951 kbd_store_ptr = kbd_buffer;
9952 kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
9953 #ifdef HAVE_MOUSE
9954 do_mouse_tracking = Qnil;
9955 #endif
9956 input_pending = 0;
9957
9958 /* This means that command_loop_1 won't try to select anything the first
9959 time through. */
9960 internal_last_event_frame = Qnil;
9961 Vlast_event_frame = internal_last_event_frame;
9962
9963 #ifdef MULTI_KBOARD
9964 current_kboard = initial_kboard;
9965 #endif
9966 wipe_kboard (current_kboard);
9967 init_kboard (current_kboard);
9968
9969 if (!noninteractive && !read_socket_hook && NILP (Vwindow_system))
9970 {
9971 signal (SIGINT, interrupt_signal);
9972 #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
9973 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
9974 SIGQUIT and we can't tell which one it will give us. */
9975 signal (SIGQUIT, interrupt_signal);
9976 #endif /* HAVE_TERMIO */
9977 }
9978 /* Note SIGIO has been undef'd if FIONREAD is missing. */
9979 #ifdef SIGIO
9980 if (!noninteractive)
9981 signal (SIGIO, input_available_signal);
9982 #endif /* SIGIO */
9983
9984 /* Use interrupt input by default, if it works and noninterrupt input
9985 has deficiencies. */
9986
9987 #ifdef INTERRUPT_INPUT
9988 interrupt_input = 1;
9989 #else
9990 interrupt_input = 0;
9991 #endif
9992
9993 /* Our VMS input only works by interrupts, as of now. */
9994 #ifdef VMS
9995 interrupt_input = 1;
9996 #endif
9997
9998 sigfree ();
9999 dribble = 0;
10000
10001 if (keyboard_init_hook)
10002 (*keyboard_init_hook) ();
10003
10004 #ifdef POLL_FOR_INPUT
10005 poll_suppress_count = 1;
10006 start_polling ();
10007 #endif
10008 }
10009
10010 /* This type's only use is in syms_of_keyboard, to initialize the
10011 event header symbols and put properties on them. */
10012 struct event_head {
10013 Lisp_Object *var;
10014 char *name;
10015 Lisp_Object *kind;
10016 };
10017
10018 struct event_head head_table[] = {
10019 &Qmouse_movement, "mouse-movement", &Qmouse_movement,
10020 &Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement,
10021 &Qswitch_frame, "switch-frame", &Qswitch_frame,
10022 &Qdelete_frame, "delete-frame", &Qdelete_frame,
10023 &Qiconify_frame, "iconify-frame", &Qiconify_frame,
10024 &Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible,
10025 };
10026
10027 void
10028 syms_of_keyboard ()
10029 {
10030 Vlispy_mouse_stem = build_string ("mouse");
10031 staticpro (&Vlispy_mouse_stem);
10032
10033 /* Tool-bars. */
10034 QCimage = intern (":image");
10035 staticpro (&QCimage);
10036
10037 staticpro (&Qhelp_echo);
10038 Qhelp_echo = intern ("help-echo");
10039
10040 staticpro (&item_properties);
10041 item_properties = Qnil;
10042
10043 staticpro (&tool_bar_item_properties);
10044 tool_bar_item_properties = Qnil;
10045 staticpro (&tool_bar_items_vector);
10046 tool_bar_items_vector = Qnil;
10047
10048 staticpro (&real_this_command);
10049 real_this_command = Qnil;
10050
10051 Qtimer_event_handler = intern ("timer-event-handler");
10052 staticpro (&Qtimer_event_handler);
10053
10054 Qdisabled_command_hook = intern ("disabled-command-hook");
10055 staticpro (&Qdisabled_command_hook);
10056
10057 Qself_insert_command = intern ("self-insert-command");
10058 staticpro (&Qself_insert_command);
10059
10060 Qforward_char = intern ("forward-char");
10061 staticpro (&Qforward_char);
10062
10063 Qbackward_char = intern ("backward-char");
10064 staticpro (&Qbackward_char);
10065
10066 Qdisabled = intern ("disabled");
10067 staticpro (&Qdisabled);
10068
10069 Qundefined = intern ("undefined");
10070 staticpro (&Qundefined);
10071
10072 Qpre_command_hook = intern ("pre-command-hook");
10073 staticpro (&Qpre_command_hook);
10074
10075 Qpost_command_hook = intern ("post-command-hook");
10076 staticpro (&Qpost_command_hook);
10077
10078 Qpost_command_idle_hook = intern ("post-command-idle-hook");
10079 staticpro (&Qpost_command_idle_hook);
10080
10081 Qdeferred_action_function = intern ("deferred-action-function");
10082 staticpro (&Qdeferred_action_function);
10083
10084 Qcommand_hook_internal = intern ("command-hook-internal");
10085 staticpro (&Qcommand_hook_internal);
10086
10087 Qfunction_key = intern ("function-key");
10088 staticpro (&Qfunction_key);
10089 Qmouse_click = intern ("mouse-click");
10090 staticpro (&Qmouse_click);
10091 #ifdef WINDOWSNT
10092 Qmouse_wheel = intern ("mouse-wheel");
10093 staticpro (&Qmouse_wheel);
10094 Qlanguage_change = intern ("language-change");
10095 staticpro (&Qlanguage_change);
10096 #endif
10097 Qdrag_n_drop = intern ("drag-n-drop");
10098 staticpro (&Qdrag_n_drop);
10099
10100 Qusr1_signal = intern ("usr1-signal");
10101 staticpro (&Qusr1_signal);
10102 Qusr2_signal = intern ("usr2-signal");
10103 staticpro (&Qusr2_signal);
10104
10105 Qmenu_enable = intern ("menu-enable");
10106 staticpro (&Qmenu_enable);
10107 Qmenu_alias = intern ("menu-alias");
10108 staticpro (&Qmenu_alias);
10109 QCenable = intern (":enable");
10110 staticpro (&QCenable);
10111 QCvisible = intern (":visible");
10112 staticpro (&QCvisible);
10113 QChelp = intern (":help");
10114 staticpro (&QChelp);
10115 QCfilter = intern (":filter");
10116 staticpro (&QCfilter);
10117 QCbutton = intern (":button");
10118 staticpro (&QCbutton);
10119 QCkeys = intern (":keys");
10120 staticpro (&QCkeys);
10121 QCkey_sequence = intern (":key-sequence");
10122 staticpro (&QCkey_sequence);
10123 QCtoggle = intern (":toggle");
10124 staticpro (&QCtoggle);
10125 QCradio = intern (":radio");
10126 staticpro (&QCradio);
10127
10128 Qmode_line = intern ("mode-line");
10129 staticpro (&Qmode_line);
10130 Qvertical_line = intern ("vertical-line");
10131 staticpro (&Qvertical_line);
10132 Qvertical_scroll_bar = intern ("vertical-scroll-bar");
10133 staticpro (&Qvertical_scroll_bar);
10134 Qmenu_bar = intern ("menu-bar");
10135 staticpro (&Qmenu_bar);
10136
10137 Qabove_handle = intern ("above-handle");
10138 staticpro (&Qabove_handle);
10139 Qhandle = intern ("handle");
10140 staticpro (&Qhandle);
10141 Qbelow_handle = intern ("below-handle");
10142 staticpro (&Qbelow_handle);
10143 Qup = intern ("up");
10144 staticpro (&Qup);
10145 Qdown = intern ("down");
10146 staticpro (&Qdown);
10147 Qtop = intern ("top");
10148 staticpro (&Qtop);
10149 Qbottom = intern ("bottom");
10150 staticpro (&Qbottom);
10151 Qend_scroll = intern ("end-scroll");
10152 staticpro (&Qend_scroll);
10153 Qratio = intern ("ratio");
10154 staticpro (&Qratio);
10155
10156 Qevent_kind = intern ("event-kind");
10157 staticpro (&Qevent_kind);
10158 Qevent_symbol_elements = intern ("event-symbol-elements");
10159 staticpro (&Qevent_symbol_elements);
10160 Qevent_symbol_element_mask = intern ("event-symbol-element-mask");
10161 staticpro (&Qevent_symbol_element_mask);
10162 Qmodifier_cache = intern ("modifier-cache");
10163 staticpro (&Qmodifier_cache);
10164
10165 Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar");
10166 staticpro (&Qrecompute_lucid_menubar);
10167 Qactivate_menubar_hook = intern ("activate-menubar-hook");
10168 staticpro (&Qactivate_menubar_hook);
10169
10170 Qpolling_period = intern ("polling-period");
10171 staticpro (&Qpolling_period);
10172
10173 Qinput_method_function = intern ("input-method-function");
10174 staticpro (&Qinput_method_function);
10175
10176 Qinput_method_exit_on_first_char = intern ("input-method-exit-on-first-char");
10177 staticpro (&Qinput_method_exit_on_first_char);
10178 Qinput_method_use_echo_area = intern ("input-method-use-echo-area");
10179 staticpro (&Qinput_method_use_echo_area);
10180
10181 Fset (Qinput_method_exit_on_first_char, Qnil);
10182 Fset (Qinput_method_use_echo_area, Qnil);
10183
10184 last_point_position_buffer = Qnil;
10185
10186 {
10187 struct event_head *p;
10188
10189 for (p = head_table;
10190 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
10191 p++)
10192 {
10193 *p->var = intern (p->name);
10194 staticpro (p->var);
10195 Fput (*p->var, Qevent_kind, *p->kind);
10196 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
10197 }
10198 }
10199
10200 button_down_location = Fmake_vector (make_number (1), Qnil);
10201 staticpro (&button_down_location);
10202 mouse_syms = Fmake_vector (make_number (1), Qnil);
10203 staticpro (&mouse_syms);
10204
10205 {
10206 int i;
10207 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
10208
10209 modifier_symbols = Fmake_vector (make_number (len), Qnil);
10210 for (i = 0; i < len; i++)
10211 if (modifier_names[i])
10212 XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]);
10213 staticpro (&modifier_symbols);
10214 }
10215
10216 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
10217 staticpro (&recent_keys);
10218
10219 this_command_keys = Fmake_vector (make_number (40), Qnil);
10220 staticpro (&this_command_keys);
10221
10222 raw_keybuf = Fmake_vector (make_number (30), Qnil);
10223 staticpro (&raw_keybuf);
10224
10225 Qextended_command_history = intern ("extended-command-history");
10226 Fset (Qextended_command_history, Qnil);
10227 staticpro (&Qextended_command_history);
10228
10229 kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil);
10230 staticpro (&kbd_buffer_gcpro);
10231
10232 accent_key_syms = Qnil;
10233 staticpro (&accent_key_syms);
10234
10235 func_key_syms = Qnil;
10236 staticpro (&func_key_syms);
10237
10238 #ifdef WINDOWSNT
10239 mouse_wheel_syms = Qnil;
10240 staticpro (&mouse_wheel_syms);
10241
10242 drag_n_drop_syms = Qnil;
10243 staticpro (&drag_n_drop_syms);
10244 #endif
10245
10246 unread_switch_frame = Qnil;
10247 staticpro (&unread_switch_frame);
10248
10249 internal_last_event_frame = Qnil;
10250 staticpro (&internal_last_event_frame);
10251
10252 read_key_sequence_cmd = Qnil;
10253 staticpro (&read_key_sequence_cmd);
10254
10255 menu_bar_one_keymap_changed_items = Qnil;
10256 staticpro (&menu_bar_one_keymap_changed_items);
10257
10258 defsubr (&Sevent_convert_list);
10259 defsubr (&Sread_key_sequence);
10260 defsubr (&Sread_key_sequence_vector);
10261 defsubr (&Srecursive_edit);
10262 #ifdef HAVE_MOUSE
10263 defsubr (&Strack_mouse);
10264 #endif
10265 defsubr (&Sinput_pending_p);
10266 defsubr (&Scommand_execute);
10267 defsubr (&Srecent_keys);
10268 defsubr (&Sthis_command_keys);
10269 defsubr (&Sthis_command_keys_vector);
10270 defsubr (&Sthis_single_command_keys);
10271 defsubr (&Sthis_single_command_raw_keys);
10272 defsubr (&Sreset_this_command_lengths);
10273 defsubr (&Sclear_this_command_keys);
10274 defsubr (&Ssuspend_emacs);
10275 defsubr (&Sabort_recursive_edit);
10276 defsubr (&Sexit_recursive_edit);
10277 defsubr (&Srecursion_depth);
10278 defsubr (&Stop_level);
10279 defsubr (&Sdiscard_input);
10280 defsubr (&Sopen_dribble_file);
10281 defsubr (&Sset_input_mode);
10282 defsubr (&Scurrent_input_mode);
10283 defsubr (&Sexecute_extended_command);
10284
10285 DEFVAR_LISP ("last-command-char", &last_command_char,
10286 "Last input event that was part of a command.");
10287
10288 DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char,
10289 "Last input event that was part of a command.");
10290
10291 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
10292 "Last input event in a command, except for mouse menu events.\n\
10293 Mouse menus give back keys that don't look like mouse events;\n\
10294 this variable holds the actual mouse event that led to the menu,\n\
10295 so that you can determine whether the command was run by mouse or not.");
10296
10297 DEFVAR_LISP ("last-input-char", &last_input_char,
10298 "Last input event.");
10299
10300 DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char,
10301 "Last input event.");
10302
10303 DEFVAR_LISP ("unread-command-events", &Vunread_command_events,
10304 "List of events to be read as the command input.\n\
10305 These events are processed first, before actual keyboard input.");
10306 Vunread_command_events = Qnil;
10307
10308 DEFVAR_INT ("unread-command-char", &unread_command_char,
10309 "If not -1, an object to be read as next command input event.");
10310
10311 DEFVAR_LISP ("unread-post-input-method-events", &Vunread_post_input_method_events,
10312 "List of events to be processed as input by input methods.\n\
10313 These events are processed after `unread-command-events', but\n\
10314 before actual keyboard input.");
10315 Vunread_post_input_method_events = Qnil;
10316
10317 DEFVAR_LISP ("unread-input-method-events", &Vunread_input_method_events,
10318 "List of events to be processed as input by input methods.\n\
10319 These events are processed after `unread-command-events', but\n\
10320 before actual keyboard input.");
10321 Vunread_input_method_events = Qnil;
10322
10323 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
10324 "Meta-prefix character code.\n\
10325 Meta-foo as command input turns into this character followed by foo.");
10326 XSETINT (meta_prefix_char, 033);
10327
10328 DEFVAR_KBOARD ("last-command", Vlast_command,
10329 "The last command executed.\n\
10330 Normally a symbol with a function definition, but can be whatever was found\n\
10331 in the keymap, or whatever the variable `this-command' was set to by that\n\
10332 command.\n\
10333 \n\
10334 The value `mode-exit' is special; it means that the previous command\n\
10335 read an event that told it to exit, and it did so and unread that event.\n\
10336 In other words, the present command is the event that made the previous\n\
10337 command exit.\n\
10338 \n\
10339 The value `kill-region' is special; it means that the previous command\n\
10340 was a kill command.");
10341
10342 DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
10343 "Same as `last-command', but never altered by Lisp code.");
10344
10345 DEFVAR_LISP ("this-command", &Vthis_command,
10346 "The command now being executed.\n\
10347 The command can set this variable; whatever is put here\n\
10348 will be in `last-command' during the following command.");
10349 Vthis_command = Qnil;
10350
10351 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
10352 "*Number of input events between auto-saves.\n\
10353 Zero means disable autosaving due to number of characters typed.");
10354 auto_save_interval = 300;
10355
10356 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
10357 "*Number of seconds idle time before auto-save.\n\
10358 Zero or nil means disable auto-saving due to idleness.\n\
10359 After auto-saving due to this many seconds of idle time,\n\
10360 Emacs also does a garbage collection if that seems to be warranted.");
10361 XSETFASTINT (Vauto_save_timeout, 30);
10362
10363 DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes,
10364 "*Nonzero means echo unfinished commands after this many seconds of pause.\n\
10365 The value may be integer or floating point.");
10366 Vecho_keystrokes = make_number (1);
10367
10368 DEFVAR_INT ("polling-period", &polling_period,
10369 "*Interval between polling for input during Lisp execution.\n\
10370 The reason for polling is to make C-g work to stop a running program.\n\
10371 Polling is needed only when using X windows and SIGIO does not work.\n\
10372 Polling is automatically disabled in all other cases.");
10373 polling_period = 2;
10374
10375 DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
10376 "*Maximum time between mouse clicks to make a double-click.\n\
10377 Measured in milliseconds. nil means disable double-click recognition;\n\
10378 t means double-clicks have no time limit and are detected\n\
10379 by position only.");
10380 Vdouble_click_time = make_number (500);
10381
10382 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
10383 "*Non-nil means inhibit local map menu bar menus.");
10384 inhibit_local_menu_bar_menus = 0;
10385
10386 DEFVAR_INT ("num-input-keys", &num_input_keys,
10387 "Number of complete key sequences read as input so far.\n\
10388 This includes key sequences read from keyboard macros.\n\
10389 The number is effectively the number of interactive command invocations.");
10390 num_input_keys = 0;
10391
10392 DEFVAR_INT ("num-nonmacro-input-events", &num_nonmacro_input_events,
10393 "Number of input events read from the keyboard so far.\n\
10394 This does not include events generated by keyboard macros.");
10395 num_nonmacro_input_events = 0;
10396
10397 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
10398 "The frame in which the most recently read event occurred.\n\
10399 If the last event came from a keyboard macro, this is set to `macro'.");
10400 Vlast_event_frame = Qnil;
10401
10402 /* This variable is set up in sysdep.c. */
10403 DEFVAR_LISP ("tty-erase-char", &Vtty_erase_char,
10404 "The ERASE character as set by the user with stty.");
10405
10406 DEFVAR_LISP ("help-char", &Vhelp_char,
10407 "Character to recognize as meaning Help.\n\
10408 When it is read, do `(eval help-form)', and display result if it's a string.\n\
10409 If the value of `help-form' is nil, this char can be read normally.");
10410 XSETINT (Vhelp_char, Ctl ('H'));
10411
10412 DEFVAR_LISP ("help-event-list", &Vhelp_event_list,
10413 "List of input events to recognize as meaning Help.\n\
10414 These work just like the value of `help-char' (see that).");
10415 Vhelp_event_list = Qnil;
10416
10417 DEFVAR_LISP ("help-form", &Vhelp_form,
10418 "Form to execute when character `help-char' is read.\n\
10419 If the form returns a string, that string is displayed.\n\
10420 If `help-form' is nil, the help char is not recognized.");
10421 Vhelp_form = Qnil;
10422
10423 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
10424 "Command to run when `help-char' character follows a prefix key.\n\
10425 This command is used only when there is no actual binding\n\
10426 for that character after that prefix key.");
10427 Vprefix_help_command = Qnil;
10428
10429 DEFVAR_LISP ("top-level", &Vtop_level,
10430 "Form to evaluate when Emacs starts up.\n\
10431 Useful to set before you dump a modified Emacs.");
10432 Vtop_level = Qnil;
10433
10434 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
10435 "Translate table for keyboard input, or nil.\n\
10436 Each character is looked up in this string and the contents used instead.\n\
10437 The value may be a string, a vector, or a char-table.\n\
10438 If it is a string or vector of length N,\n\
10439 character codes N and up are untranslated.\n\
10440 In a vector or a char-table, an element which is nil means \"no translation\".");
10441 Vkeyboard_translate_table = Qnil;
10442
10443 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
10444 "Non-nil means to always spawn a subshell instead of suspending.\n\
10445 \(Even if the operating system has support for stopping a process.\)");
10446 cannot_suspend = 0;
10447
10448 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
10449 "Non-nil means prompt with menus when appropriate.\n\
10450 This is done when reading from a keymap that has a prompt string,\n\
10451 for elements that have prompt strings.\n\
10452 The menu is displayed on the screen\n\
10453 if X menus were enabled at configuration\n\
10454 time and the previous event was a mouse click prefix key.\n\
10455 Otherwise, menu prompting uses the echo area.");
10456 menu_prompting = 1;
10457
10458 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
10459 "Character to see next line of menu prompt.\n\
10460 Type this character while in a menu prompt to rotate around the lines of it.");
10461 XSETINT (menu_prompt_more_char, ' ');
10462
10463 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
10464 "A mask of additional modifier keys to use with every keyboard character.\n\
10465 Emacs applies the modifiers of the character stored here to each keyboard\n\
10466 character it reads. For example, after evaluating the expression\n\
10467 (setq extra-keyboard-modifiers ?\\C-x)\n\
10468 all input characters will have the control modifier applied to them.\n\
10469 \n\
10470 Note that the character ?\\C-@, equivalent to the integer zero, does\n\
10471 not count as a control character; rather, it counts as a character\n\
10472 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero\n\
10473 cancels any modification.");
10474 extra_keyboard_modifiers = 0;
10475
10476 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
10477 "If an editing command sets this to t, deactivate the mark afterward.\n\
10478 The command loop sets this to nil before each command,\n\
10479 and tests the value when the command returns.\n\
10480 Buffer modification stores t in this variable.");
10481 Vdeactivate_mark = Qnil;
10482
10483 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal,
10484 "Temporary storage of pre-command-hook or post-command-hook.");
10485 Vcommand_hook_internal = Qnil;
10486
10487 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
10488 "Normal hook run before each command is executed.\n\
10489 If an unhandled error happens in running this hook,\n\
10490 the hook value is set to nil, since otherwise the error\n\
10491 might happen repeatedly and make Emacs nonfunctional.");
10492 Vpre_command_hook = Qnil;
10493
10494 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
10495 "Normal hook run after each command is executed.\n\
10496 If an unhandled error happens in running this hook,\n\
10497 the hook value is set to nil, since otherwise the error\n\
10498 might happen repeatedly and make Emacs nonfunctional.");
10499 Vpost_command_hook = Qnil;
10500
10501 DEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook,
10502 "Normal hook run after each command is executed, if idle.\n\
10503 Errors running the hook are caught and ignored.\n\
10504 This feature is obsolete; use idle timers instead. See `etc/NEWS'.");
10505 Vpost_command_idle_hook = Qnil;
10506
10507 DEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay,
10508 "Delay time before running `post-command-idle-hook'.\n\
10509 This is measured in microseconds.");
10510 post_command_idle_delay = 100000;
10511
10512 #if 0
10513 DEFVAR_LISP ("echo-area-clear-hook", ...,
10514 "Normal hook run when clearing the echo area.");
10515 #endif
10516 Qecho_area_clear_hook = intern ("echo-area-clear-hook");
10517 XSYMBOL (Qecho_area_clear_hook)->value = Qnil;
10518
10519 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
10520 "t means menu bar, specified Lucid style, needs to be recomputed.");
10521 Vlucid_menu_bar_dirty_flag = Qnil;
10522
10523 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
10524 "List of menu bar items to move to the end of the menu bar.\n\
10525 The elements of the list are event types that may have menu bar bindings.");
10526 Vmenu_bar_final_items = Qnil;
10527
10528 DEFVAR_KBOARD ("overriding-terminal-local-map",
10529 Voverriding_terminal_local_map,
10530 "Per-terminal keymap that overrides all other local keymaps.\n\
10531 If this variable is non-nil, it is used as a keymap instead of the\n\
10532 buffer's local map, and the minor mode keymaps and text property keymaps.\n\
10533 This variable is intended to let commands such as `universal-argumemnt'\n\
10534 set up a different keymap for reading the next command.");
10535
10536 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map,
10537 "Keymap that overrides all other local keymaps.\n\
10538 If this variable is non-nil, it is used as a keymap instead of the\n\
10539 buffer's local map, and the minor mode keymaps and text property keymaps.");
10540 Voverriding_local_map = Qnil;
10541
10542 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag,
10543 "Non-nil means `overriding-local-map' applies to the menu bar.\n\
10544 Otherwise, the menu bar continues to reflect the buffer's local map\n\
10545 and the minor mode maps regardless of `overriding-local-map'.");
10546 Voverriding_local_map_menu_flag = Qnil;
10547
10548 DEFVAR_LISP ("special-event-map", &Vspecial_event_map,
10549 "Keymap defining bindings for special events to execute at low level.");
10550 Vspecial_event_map = Fcons (intern ("keymap"), Qnil);
10551
10552 DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
10553 "*Non-nil means generate motion events for mouse motion.");
10554
10555 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
10556 "Alist of system-specific X windows key symbols.\n\
10557 Each element should have the form (N . SYMBOL) where N is the\n\
10558 numeric keysym code (sans the \"system-specific\" bit 1<<28)\n\
10559 and SYMBOL is its name.");
10560
10561 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list,
10562 "List of deferred actions to be performed at a later time.\n\
10563 The precise format isn't relevant here; we just check whether it is nil.");
10564 Vdeferred_action_list = Qnil;
10565
10566 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function,
10567 "Function to call to handle deferred actions, after each command.\n\
10568 This function is called with no arguments after each command\n\
10569 whenever `deferred-action-list' is non-nil.");
10570 Vdeferred_action_function = Qnil;
10571
10572 DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings,
10573 "*Non-nil means show the equivalent key-binding when M-x command has one.\n\
10574 The value can be a length of time to show the message for.\n\
10575 If the value is non-nil and not a number, we wait 2 seconds.");
10576 Vsuggest_key_bindings = Qt;
10577
10578 DEFVAR_LISP ("timer-list", &Vtimer_list,
10579 "List of active absolute time timers in order of increasing time");
10580 Vtimer_list = Qnil;
10581
10582 DEFVAR_LISP ("timer-idle-list", &Vtimer_idle_list,
10583 "List of active idle-time timers in order of increasing time");
10584 Vtimer_idle_list = Qnil;
10585
10586 DEFVAR_LISP ("input-method-function", &Vinput_method_function,
10587 "If non-nil, the function that implements the current input method.\n\
10588 It's called with one argument, a printing character that was just read.\n\
10589 \(That means a character with code 040...0176.)\n\
10590 Typically this function uses `read-event' to read additional events.\n\
10591 When it does so, it should first bind `input-method-function' to nil\n\
10592 so it will not be called recursively.\n\
10593 \n\
10594 The function should return a list of zero or more events\n\
10595 to be used as input. If it wants to put back some events\n\
10596 to be reconsidered, separately, by the input method,\n\
10597 it can add them to the beginning of `unread-command-events'.\n\
10598 \n\
10599 The input method function can find in `input-method-previous-method'\n\
10600 the previous echo area message.\n\
10601 \n\
10602 The input method function should refer to the variables\n\
10603 `input-method-use-echo-area' and `input-method-exit-on-first-char'\n\
10604 for guidance on what to do.");
10605 Vinput_method_function = Qnil;
10606
10607 DEFVAR_LISP ("input-method-previous-message",
10608 &Vinput_method_previous_message,
10609 "When `input-method-function' is called, hold the previous echo area message.\n\
10610 This variable exists because `read-event' clears the echo area\n\
10611 before running the input method. It is nil if there was no message.");
10612 Vinput_method_previous_message = Qnil;
10613
10614 DEFVAR_LISP ("show-help-function", &Vshow_help_function,
10615 "If non-nil, the function that implements the display of help.\n\
10616 It's called with one argument, the help string to display.");
10617 Vshow_help_function = Qnil;
10618
10619 DEFVAR_LISP ("disable-point-adjustment", &Vdisable_point_adjustment,
10620 "If non-nil, suppress point adjustment after executing a command.\n\
10621 \n\
10622 After a command is executed, if point is moved into a region that has\n\
10623 special properties (e.g. composition, display), we adjust point to\n\
10624 the boundary of the region. But, several special commands sets this\n\
10625 variable to non-nil, then we suppress the point adjustment.\n\
10626 \n\
10627 This variable is set to nil before reading a command, and is checked\n\
10628 just after executing the command");
10629 Vdisable_point_adjustment = Qnil;
10630
10631 DEFVAR_LISP ("global-disable-point-adjustment",
10632 &Vglobal_disable_point_adjustment,
10633 "*If non-nil, always suppress point adjustment.\n\
10634 \n\
10635 The default value is nil, in which case, point adjustment are\n\
10636 suppressed only after special commands that set\n\
10637 `disable-point-adjustment' (which see) to non-nil.");
10638 Vglobal_disable_point_adjustment = Qnil;
10639
10640 DEFVAR_BOOL ("update-menu-bindings", &update_menu_bindings,
10641 "Non-nil means updating menu bindings is allowed.\n\
10642 A value of nil means menu bindings should not be updated.\n\
10643 Used during Emacs' startup.");
10644 update_menu_bindings = 1;
10645
10646 DEFVAR_LISP ("minibuffer-message-timeout", &Vminibuffer_message_timeout,
10647 "*How long to display an echo-area message when the minibuffer is active.\n\
10648 If the value is not a number, such messages don't time out.");
10649 Vminibuffer_message_timeout = make_number (2);
10650 }
10651
10652 void
10653 keys_of_keyboard ()
10654 {
10655 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
10656 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
10657 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
10658 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
10659 initial_define_key (meta_map, 'x', "execute-extended-command");
10660
10661 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
10662 "handle-delete-frame");
10663 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
10664 "ignore-event");
10665 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
10666 "ignore-event");
10667 }