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