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