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