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