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