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