* keyboard.c (parse_modifiers_uncached, parse_modifiers):
[emacs.git] / src / keyboard.c
blobe29c7e9bc5c0d1a3a2fc8250517e2c3d1306c73e
1 /* Keyboard and mouse input; editor command loop.
3 Copyright (C) 1985-1989, 1993-1997, 1999-2011 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 #include <config.h>
21 #include <signal.h>
22 #include <stdio.h>
23 #include <setjmp.h>
24 #include "lisp.h"
25 #include "termchar.h"
26 #include "termopts.h"
27 #include "frame.h"
28 #include "termhooks.h"
29 #include "macros.h"
30 #include "keyboard.h"
31 #include "window.h"
32 #include "commands.h"
33 #include "buffer.h"
34 #include "character.h"
35 #include "disptab.h"
36 #include "dispextern.h"
37 #include "syntax.h"
38 #include "intervals.h"
39 #include "keymap.h"
40 #include "blockinput.h"
41 #include "puresize.h"
42 #include "systime.h"
43 #include "atimer.h"
44 #include "process.h"
45 #include <errno.h>
47 #ifdef HAVE_GTK_AND_PTHREAD
48 #include <pthread.h>
49 #endif
50 #ifdef MSDOS
51 #include "msdos.h"
52 #include <time.h>
53 #else /* not MSDOS */
54 #include <sys/ioctl.h>
55 #endif /* not MSDOS */
57 #include "syssignal.h"
59 #include <sys/types.h>
60 #include <unistd.h>
61 #include <fcntl.h>
63 /* This is to get the definitions of the XK_ symbols. */
64 #ifdef HAVE_X_WINDOWS
65 #include "xterm.h"
66 #endif
68 #ifdef HAVE_NTGUI
69 #include "w32term.h"
70 #endif /* HAVE_NTGUI */
72 #ifdef HAVE_NS
73 #include "nsterm.h"
74 #endif
76 /* Variables for blockinput.h: */
78 /* Non-zero if interrupt input is blocked right now. */
79 volatile int interrupt_input_blocked;
81 /* Nonzero means an input interrupt has arrived
82 during the current critical section. */
83 int interrupt_input_pending;
85 /* This var should be (interrupt_input_pending || pending_atimers).
86 The QUIT macro checks this instead of interrupt_input_pending and
87 pending_atimers separately, to reduce code size. So, any code that
88 changes interrupt_input_pending or pending_atimers should update
89 this too. */
90 #ifdef SYNC_INPUT
91 int pending_signals;
92 #endif
94 #define KBD_BUFFER_SIZE 4096
96 KBOARD *initial_kboard;
97 KBOARD *current_kboard;
98 KBOARD *all_kboards;
99 int single_kboard;
101 /* Non-nil disable property on a command means
102 do not execute it; call disabled-command-function's value instead. */
103 Lisp_Object Qdisabled, Qdisabled_command_function;
105 #define NUM_RECENT_KEYS (300)
106 int recent_keys_index; /* Index for storing next element into recent_keys */
107 int total_keys; /* Total number of elements stored into recent_keys */
108 Lisp_Object recent_keys; /* Vector holds the last NUM_RECENT_KEYS keystrokes */
110 /* Vector holding the key sequence that invoked the current command.
111 It is reused for each command, and it may be longer than the current
112 sequence; this_command_key_count indicates how many elements
113 actually mean something.
114 It's easier to staticpro a single Lisp_Object than an array. */
115 Lisp_Object this_command_keys;
116 int this_command_key_count;
118 /* 1 after calling Freset_this_command_lengths.
119 Usually it is 0. */
120 int this_command_key_count_reset;
122 /* This vector is used as a buffer to record the events that were actually read
123 by read_key_sequence. */
124 Lisp_Object raw_keybuf;
125 int raw_keybuf_count;
127 #define GROW_RAW_KEYBUF \
128 if (raw_keybuf_count == XVECTOR (raw_keybuf)->size) \
129 raw_keybuf = larger_vector (raw_keybuf, raw_keybuf_count * 2, Qnil) \
131 /* Number of elements of this_command_keys
132 that precede this key sequence. */
133 int this_single_command_key_start;
135 /* Record values of this_command_key_count and echo_length ()
136 before this command was read. */
137 static int before_command_key_count;
138 static int before_command_echo_length;
140 /* For longjmp to where kbd input is being done. */
142 static jmp_buf getcjmp;
144 /* True while doing kbd input. */
145 int waiting_for_input;
147 /* True while displaying for echoing. Delays C-g throwing. */
149 int echoing;
151 /* Non-null means we can start echoing at the next input pause even
152 though there is something in the echo area. */
154 static struct kboard *ok_to_echo_at_next_pause;
156 /* The kboard last echoing, or null for none. Reset to 0 in
157 cancel_echoing. If non-null, and a current echo area message
158 exists, and echo_message_buffer is eq to the current message
159 buffer, we know that the message comes from echo_kboard. */
161 struct kboard *echo_kboard;
163 /* The buffer used for echoing. Set in echo_now, reset in
164 cancel_echoing. */
166 Lisp_Object echo_message_buffer;
168 /* Nonzero means C-g should cause immediate error-signal. */
169 int immediate_quit;
171 /* Character that causes a quit. Normally C-g.
173 If we are running on an ordinary terminal, this must be an ordinary
174 ASCII char, since we want to make it our interrupt character.
176 If we are not running on an ordinary terminal, it still needs to be
177 an ordinary ASCII char. This character needs to be recognized in
178 the input interrupt handler. At this point, the keystroke is
179 represented as a struct input_event, while the desired quit
180 character is specified as a lispy event. The mapping from struct
181 input_events to lispy events cannot run in an interrupt handler,
182 and the reverse mapping is difficult for anything but ASCII
183 keystrokes.
185 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
186 ASCII character. */
187 int quit_char;
189 /* Current depth in recursive edits. */
190 int command_loop_level;
192 /* If not Qnil, this is a switch-frame event which we decided to put
193 off until the end of a key sequence. This should be read as the
194 next command input, after any unread_command_events.
196 read_key_sequence uses this to delay switch-frame events until the
197 end of the key sequence; Fread_char uses it to put off switch-frame
198 events until a non-ASCII event is acceptable as input. */
199 Lisp_Object unread_switch_frame;
201 /* Last size recorded for a current buffer which is not a minibuffer. */
202 static EMACS_INT last_non_minibuf_size;
204 /* Total number of times read_char has returned, modulo SIZE_MAX + 1. */
205 size_t num_input_events;
207 /* Value of num_nonmacro_input_events as of last auto save. */
209 int last_auto_save;
211 /* This is like Vthis_command, except that commands never set it. */
212 Lisp_Object real_this_command;
214 /* The value of point when the last command was started. */
215 EMACS_INT last_point_position;
217 /* The buffer that was current when the last command was started. */
218 Lisp_Object last_point_position_buffer;
220 /* The window that was selected when the last command was started. */
221 Lisp_Object last_point_position_window;
223 /* The frame in which the last input event occurred, or Qmacro if the
224 last event came from a macro. We use this to determine when to
225 generate switch-frame events. This may be cleared by functions
226 like Fselect_frame, to make sure that a switch-frame event is
227 generated by the next character. */
228 Lisp_Object internal_last_event_frame;
230 /* The timestamp of the last input event we received from the X server.
231 X Windows wants this for selection ownership. */
232 unsigned long last_event_timestamp;
234 Lisp_Object Qx_set_selection, QPRIMARY, Qhandle_switch_frame;
236 Lisp_Object Qself_insert_command;
237 Lisp_Object Qforward_char;
238 Lisp_Object Qbackward_char;
239 Lisp_Object Qundefined;
240 Lisp_Object Qtimer_event_handler;
242 /* read_key_sequence stores here the command definition of the
243 key sequence that it reads. */
244 Lisp_Object read_key_sequence_cmd;
246 Lisp_Object Qinput_method_function;
248 Lisp_Object Qdeactivate_mark;
250 Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
252 Lisp_Object Qecho_area_clear_hook;
254 /* Hooks to run before and after each command. */
255 Lisp_Object Qpre_command_hook;
256 Lisp_Object Qpost_command_hook;
257 Lisp_Object Qcommand_hook_internal;
259 Lisp_Object Qdeferred_action_function;
261 Lisp_Object Qinput_method_exit_on_first_char;
262 Lisp_Object Qinput_method_use_echo_area;
264 /* File in which we write all commands we read. */
265 FILE *dribble;
267 /* Nonzero if input is available. */
268 int input_pending;
270 /* Circular buffer for pre-read keyboard input. */
272 static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
274 /* Pointer to next available character in kbd_buffer.
275 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
276 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the
277 next available char is in kbd_buffer[0]. */
278 static struct input_event *kbd_fetch_ptr;
280 /* Pointer to next place to store character in kbd_buffer. This
281 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
282 character should go in kbd_buffer[0]. */
283 static struct input_event * volatile kbd_store_ptr;
285 /* The above pair of variables forms a "queue empty" flag. When we
286 enqueue a non-hook event, we increment kbd_store_ptr. When we
287 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
288 there is input available if the two pointers are not equal.
290 Why not just have a flag set and cleared by the enqueuing and
291 dequeuing functions? Such a flag could be screwed up by interrupts
292 at inopportune times. */
294 /* Symbols to head events. */
295 Lisp_Object Qmouse_movement;
296 Lisp_Object Qscroll_bar_movement;
297 Lisp_Object Qswitch_frame;
298 Lisp_Object Qdelete_frame;
299 Lisp_Object Qiconify_frame;
300 Lisp_Object Qmake_frame_visible;
301 Lisp_Object Qselect_window;
302 Lisp_Object Qhelp_echo;
304 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
305 Lisp_Object Qmouse_fixup_help_message;
306 #endif
308 /* Symbols to denote kinds of events. */
309 Lisp_Object Qfunction_key;
310 Lisp_Object Qmouse_click;
311 #if defined (WINDOWSNT)
312 Lisp_Object Qlanguage_change;
313 #endif
314 Lisp_Object Qdrag_n_drop;
315 Lisp_Object Qsave_session;
316 #ifdef HAVE_DBUS
317 Lisp_Object Qdbus_event;
318 #endif
319 Lisp_Object Qconfig_changed_event;
321 /* Lisp_Object Qmouse_movement; - also an event header */
323 /* Properties of event headers. */
324 Lisp_Object Qevent_kind;
325 Lisp_Object Qevent_symbol_elements;
327 /* menu and tool bar item parts */
328 Lisp_Object Qmenu_enable;
329 Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCkeys, QCkey_sequence;
330 Lisp_Object QCbutton, QCtoggle, QCradio, QClabel, QCvert_only;
332 /* An event header symbol HEAD may have a property named
333 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
334 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
335 mask of modifiers applied to it. If present, this is used to help
336 speed up parse_modifiers. */
337 Lisp_Object Qevent_symbol_element_mask;
339 /* An unmodified event header BASE may have a property named
340 Qmodifier_cache, which is an alist mapping modifier masks onto
341 modified versions of BASE. If present, this helps speed up
342 apply_modifiers. */
343 Lisp_Object Qmodifier_cache;
345 /* Symbols to use for parts of windows. */
346 Lisp_Object Qmode_line;
347 Lisp_Object Qvertical_line;
348 Lisp_Object Qvertical_scroll_bar;
349 Lisp_Object Qmenu_bar;
351 Lisp_Object recursive_edit_unwind (Lisp_Object buffer), command_loop (void);
352 Lisp_Object Fthis_command_keys (void);
353 Lisp_Object Qextended_command_history;
354 EMACS_TIME timer_check (void);
356 static void record_menu_key (Lisp_Object c);
357 static int echo_length (void);
359 Lisp_Object Qpolling_period;
361 /* Incremented whenever a timer is run. */
362 int timers_run;
364 /* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
365 happens. */
366 EMACS_TIME *input_available_clear_time;
368 /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
369 Default is 1 if INTERRUPT_INPUT is defined. */
370 int interrupt_input;
372 /* Nonzero while interrupts are temporarily deferred during redisplay. */
373 int interrupts_deferred;
375 /* Allow m- file to inhibit use of FIONREAD. */
376 #ifdef BROKEN_FIONREAD
377 #undef FIONREAD
378 #endif
380 /* We are unable to use interrupts if FIONREAD is not available,
381 so flush SIGIO so we won't try. */
382 #if !defined (FIONREAD)
383 #ifdef SIGIO
384 #undef SIGIO
385 #endif
386 #endif
388 /* If we support a window system, turn on the code to poll periodically
389 to detect C-g. It isn't actually used when doing interrupt input. */
390 #if defined(HAVE_WINDOW_SYSTEM) && !defined(USE_ASYNC_EVENTS)
391 #define POLL_FOR_INPUT
392 #endif
394 /* The time when Emacs started being idle. */
396 static EMACS_TIME timer_idleness_start_time;
398 /* After Emacs stops being idle, this saves the last value
399 of timer_idleness_start_time from when it was idle. */
401 static EMACS_TIME timer_last_idleness_start_time;
404 /* Global variable declarations. */
406 /* Flags for readable_events. */
407 #define READABLE_EVENTS_DO_TIMERS_NOW (1 << 0)
408 #define READABLE_EVENTS_FILTER_EVENTS (1 << 1)
409 #define READABLE_EVENTS_IGNORE_SQUEEZABLES (1 << 2)
411 /* Function for init_keyboard to call with no args (if nonzero). */
412 void (*keyboard_init_hook) (void);
414 static int read_avail_input (int);
415 static void get_input_pending (int *, int);
416 static int readable_events (int);
417 static Lisp_Object read_char_x_menu_prompt (int, Lisp_Object *,
418 Lisp_Object, int *);
419 static Lisp_Object read_char_minibuf_menu_prompt (int, int,
420 Lisp_Object *);
421 static Lisp_Object make_lispy_event (struct input_event *);
422 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
423 static Lisp_Object make_lispy_movement (struct frame *, Lisp_Object,
424 enum scroll_bar_part,
425 Lisp_Object, Lisp_Object,
426 unsigned long);
427 #endif
428 static Lisp_Object modify_event_symbol (EMACS_INT, unsigned, Lisp_Object,
429 Lisp_Object, const char *const *,
430 Lisp_Object *, unsigned);
431 static Lisp_Object make_lispy_switch_frame (Lisp_Object);
432 static void save_getcjmp (jmp_buf);
433 static void restore_getcjmp (jmp_buf);
434 static Lisp_Object apply_modifiers (int, Lisp_Object);
435 static void clear_event (struct input_event *);
436 static Lisp_Object restore_kboard_configuration (Lisp_Object);
437 static void interrupt_signal (int signalnum);
438 #ifdef SIGIO
439 static void input_available_signal (int signo);
440 #endif
441 static void handle_interrupt (void);
442 static void timer_start_idle (void);
443 static void timer_stop_idle (void);
444 static void timer_resume_idle (void);
445 static void handle_user_signal (int);
446 static char *find_user_signal_name (int);
447 static int store_user_signal_events (void);
450 /* Add C to the echo string, if echoing is going on.
451 C can be a character, which is printed prettily ("M-C-x" and all that
452 jazz), or a symbol, whose name is printed. */
454 static void
455 echo_char (Lisp_Object c)
457 if (current_kboard->immediate_echo)
459 int size = KEY_DESCRIPTION_SIZE + 100;
460 char *buffer = (char *) alloca (size);
461 char *ptr = buffer;
462 Lisp_Object echo_string;
464 echo_string = KVAR (current_kboard, echo_string);
466 /* If someone has passed us a composite event, use its head symbol. */
467 c = EVENT_HEAD (c);
469 if (INTEGERP (c))
471 ptr = push_key_description (XINT (c), ptr, 1);
473 else if (SYMBOLP (c))
475 Lisp_Object name = SYMBOL_NAME (c);
476 int nbytes = SBYTES (name);
478 if (size - (ptr - buffer) < nbytes)
480 int offset = ptr - buffer;
481 size = max (2 * size, size + nbytes);
482 buffer = (char *) alloca (size);
483 ptr = buffer + offset;
486 ptr += copy_text (SDATA (name), (unsigned char *) ptr, nbytes,
487 STRING_MULTIBYTE (name), 1);
490 if ((NILP (echo_string) || SCHARS (echo_string) == 0)
491 && help_char_p (c))
493 const char *text = " (Type ? for further options)";
494 int len = strlen (text);
496 if (size - (ptr - buffer) < len)
498 int offset = ptr - buffer;
499 size += len;
500 buffer = (char *) alloca (size);
501 ptr = buffer + offset;
504 memcpy (ptr, text, len);
505 ptr += len;
508 /* Replace a dash from echo_dash with a space, otherwise
509 add a space at the end as a separator between keys. */
510 if (STRINGP (echo_string)
511 && SCHARS (echo_string) > 1)
513 Lisp_Object last_char, prev_char, idx;
515 idx = make_number (SCHARS (echo_string) - 2);
516 prev_char = Faref (echo_string, idx);
518 idx = make_number (SCHARS (echo_string) - 1);
519 last_char = Faref (echo_string, idx);
521 /* We test PREV_CHAR to make sure this isn't the echoing
522 of a minus-sign. */
523 if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
524 Faset (echo_string, idx, make_number (' '));
525 else
526 echo_string = concat2 (echo_string, build_string (" "));
528 else if (STRINGP (echo_string))
529 echo_string = concat2 (echo_string, build_string (" "));
531 KVAR (current_kboard, echo_string)
532 = concat2 (echo_string, make_string (buffer, ptr - buffer));
534 echo_now ();
538 /* Temporarily add a dash to the end of the echo string if it's not
539 empty, so that it serves as a mini-prompt for the very next character. */
541 static void
542 echo_dash (void)
544 /* Do nothing if not echoing at all. */
545 if (NILP (KVAR (current_kboard, echo_string)))
546 return;
548 if (this_command_key_count == 0)
549 return;
551 if (!current_kboard->immediate_echo
552 && SCHARS (KVAR (current_kboard, echo_string)) == 0)
553 return;
555 /* Do nothing if we just printed a prompt. */
556 if (current_kboard->echo_after_prompt
557 == SCHARS (KVAR (current_kboard, echo_string)))
558 return;
560 /* Do nothing if we have already put a dash at the end. */
561 if (SCHARS (KVAR (current_kboard, echo_string)) > 1)
563 Lisp_Object last_char, prev_char, idx;
565 idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 2);
566 prev_char = Faref (KVAR (current_kboard, echo_string), idx);
568 idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 1);
569 last_char = Faref (KVAR (current_kboard, echo_string), idx);
571 if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
572 return;
575 /* Put a dash at the end of the buffer temporarily,
576 but make it go away when the next character is added. */
577 KVAR (current_kboard, echo_string) = concat2 (KVAR (current_kboard, echo_string),
578 build_string ("-"));
579 echo_now ();
582 /* Display the current echo string, and begin echoing if not already
583 doing so. */
585 void
586 echo_now (void)
588 if (!current_kboard->immediate_echo)
590 int i;
591 current_kboard->immediate_echo = 1;
593 for (i = 0; i < this_command_key_count; i++)
595 Lisp_Object c;
597 /* Set before_command_echo_length to the value that would
598 have been saved before the start of this subcommand in
599 command_loop_1, if we had already been echoing then. */
600 if (i == this_single_command_key_start)
601 before_command_echo_length = echo_length ();
603 c = XVECTOR (this_command_keys)->contents[i];
604 if (! (EVENT_HAS_PARAMETERS (c)
605 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
606 echo_char (c);
609 /* Set before_command_echo_length to the value that would
610 have been saved before the start of this subcommand in
611 command_loop_1, if we had already been echoing then. */
612 if (this_command_key_count == this_single_command_key_start)
613 before_command_echo_length = echo_length ();
615 /* Put a dash at the end to invite the user to type more. */
616 echo_dash ();
619 echoing = 1;
620 message3_nolog (KVAR (current_kboard, echo_string),
621 SBYTES (KVAR (current_kboard, echo_string)),
622 STRING_MULTIBYTE (KVAR (current_kboard, echo_string)));
623 echoing = 0;
625 /* Record in what buffer we echoed, and from which kboard. */
626 echo_message_buffer = echo_area_buffer[0];
627 echo_kboard = current_kboard;
629 if (waiting_for_input && !NILP (Vquit_flag))
630 quit_throw_to_read_char ();
633 /* Turn off echoing, for the start of a new command. */
635 void
636 cancel_echoing (void)
638 current_kboard->immediate_echo = 0;
639 current_kboard->echo_after_prompt = -1;
640 KVAR (current_kboard, echo_string) = Qnil;
641 ok_to_echo_at_next_pause = NULL;
642 echo_kboard = NULL;
643 echo_message_buffer = Qnil;
646 /* Return the length of the current echo string. */
648 static int
649 echo_length (void)
651 return (STRINGP (KVAR (current_kboard, echo_string))
652 ? SCHARS (KVAR (current_kboard, echo_string))
653 : 0);
656 /* Truncate the current echo message to its first LEN chars.
657 This and echo_char get used by read_key_sequence when the user
658 switches frames while entering a key sequence. */
660 static void
661 echo_truncate (EMACS_INT nchars)
663 if (STRINGP (KVAR (current_kboard, echo_string)))
664 KVAR (current_kboard, echo_string)
665 = Fsubstring (KVAR (current_kboard, echo_string),
666 make_number (0), make_number (nchars));
667 truncate_echo_area (nchars);
671 /* Functions for manipulating this_command_keys. */
672 static void
673 add_command_key (Lisp_Object key)
675 #if 0 /* Not needed after we made Freset_this_command_lengths
676 do the job immediately. */
677 /* If reset-this-command-length was called recently, obey it now.
678 See the doc string of that function for an explanation of why. */
679 if (before_command_restore_flag)
681 this_command_key_count = before_command_key_count_1;
682 if (this_command_key_count < this_single_command_key_start)
683 this_single_command_key_start = this_command_key_count;
684 echo_truncate (before_command_echo_length_1);
685 before_command_restore_flag = 0;
687 #endif
689 if (this_command_key_count >= ASIZE (this_command_keys))
690 this_command_keys = larger_vector (this_command_keys,
691 2 * ASIZE (this_command_keys),
692 Qnil);
694 ASET (this_command_keys, this_command_key_count, key);
695 ++this_command_key_count;
699 Lisp_Object
700 recursive_edit_1 (void)
702 int count = SPECPDL_INDEX ();
703 Lisp_Object val;
705 if (command_loop_level > 0)
707 specbind (Qstandard_output, Qt);
708 specbind (Qstandard_input, Qt);
711 #ifdef HAVE_WINDOW_SYSTEM
712 /* The command loop has started an hourglass timer, so we have to
713 cancel it here, otherwise it will fire because the recursive edit
714 can take some time. Do not check for display_hourglass_p here,
715 because it could already be nil. */
716 cancel_hourglass ();
717 #endif
719 /* This function may have been called from a debugger called from
720 within redisplay, for instance by Edebugging a function called
721 from fontification-functions. We want to allow redisplay in
722 the debugging session.
724 The recursive edit is left with a `(throw exit ...)'. The `exit'
725 tag is not caught anywhere in redisplay, i.e. when we leave the
726 recursive edit, the original redisplay leading to the recursive
727 edit will be unwound. The outcome should therefore be safe. */
728 specbind (Qinhibit_redisplay, Qnil);
729 redisplaying_p = 0;
731 val = command_loop ();
732 if (EQ (val, Qt))
733 Fsignal (Qquit, Qnil);
734 /* Handle throw from read_minibuf when using minibuffer
735 while it's active but we're in another window. */
736 if (STRINGP (val))
737 xsignal1 (Qerror, val);
739 return unbind_to (count, Qnil);
742 /* When an auto-save happens, record the "time", and don't do again soon. */
744 void
745 record_auto_save (void)
747 last_auto_save = num_nonmacro_input_events;
750 /* Make an auto save happen as soon as possible at command level. */
752 void
753 force_auto_save_soon (void)
755 last_auto_save = - auto_save_interval - 1;
757 record_asynch_buffer_change ();
760 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
761 doc: /* Invoke the editor command loop recursively.
762 To get out of the recursive edit, a command can do `(throw 'exit nil)';
763 that tells this function to return.
764 Alternatively, `(throw 'exit t)' makes this function signal an error.
765 This function is called by the editor initialization to begin editing. */)
766 (void)
768 int count = SPECPDL_INDEX ();
769 Lisp_Object buffer;
771 /* If we enter while input is blocked, don't lock up here.
772 This may happen through the debugger during redisplay. */
773 if (INPUT_BLOCKED_P)
774 return Qnil;
776 command_loop_level++;
777 update_mode_lines = 1;
779 if (command_loop_level
780 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
781 buffer = Fcurrent_buffer ();
782 else
783 buffer = Qnil;
785 /* If we leave recursive_edit_1 below with a `throw' for instance,
786 like it is done in the splash screen display, we have to
787 make sure that we restore single_kboard as command_loop_1
788 would have done if it were left normally. */
789 if (command_loop_level > 0)
790 temporarily_switch_to_single_kboard (SELECTED_FRAME ());
791 record_unwind_protect (recursive_edit_unwind, buffer);
793 recursive_edit_1 ();
794 return unbind_to (count, Qnil);
797 Lisp_Object
798 recursive_edit_unwind (Lisp_Object buffer)
800 if (BUFFERP (buffer))
801 Fset_buffer (buffer);
803 command_loop_level--;
804 update_mode_lines = 1;
805 return Qnil;
809 #if 0 /* These two functions are now replaced with
810 temporarily_switch_to_single_kboard. */
811 static void
812 any_kboard_state ()
814 #if 0 /* Theory: if there's anything in Vunread_command_events,
815 it will right away be read by read_key_sequence,
816 and then if we do switch KBOARDS, it will go into the side
817 queue then. So we don't need to do anything special here -- rms. */
818 if (CONSP (Vunread_command_events))
820 current_kboard->kbd_queue
821 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
822 current_kboard->kbd_queue_has_data = 1;
824 Vunread_command_events = Qnil;
825 #endif
826 single_kboard = 0;
829 /* Switch to the single-kboard state, making current_kboard
830 the only KBOARD from which further input is accepted. */
832 void
833 single_kboard_state ()
835 single_kboard = 1;
837 #endif
839 /* If we're in single_kboard state for kboard KBOARD,
840 get out of it. */
842 void
843 not_single_kboard_state (KBOARD *kboard)
845 if (kboard == current_kboard)
846 single_kboard = 0;
849 /* Maintain a stack of kboards, so other parts of Emacs
850 can switch temporarily to the kboard of a given frame
851 and then revert to the previous status. */
853 struct kboard_stack
855 KBOARD *kboard;
856 struct kboard_stack *next;
859 static struct kboard_stack *kboard_stack;
861 void
862 push_kboard (struct kboard *k)
864 struct kboard_stack *p
865 = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
867 p->next = kboard_stack;
868 p->kboard = current_kboard;
869 kboard_stack = p;
871 current_kboard = k;
874 void
875 pop_kboard (void)
877 struct terminal *t;
878 struct kboard_stack *p = kboard_stack;
879 int found = 0;
880 for (t = terminal_list; t; t = t->next_terminal)
882 if (t->kboard == p->kboard)
884 current_kboard = p->kboard;
885 found = 1;
886 break;
889 if (!found)
891 /* The terminal we remembered has been deleted. */
892 current_kboard = FRAME_KBOARD (SELECTED_FRAME ());
893 single_kboard = 0;
895 kboard_stack = p->next;
896 xfree (p);
899 /* Switch to single_kboard mode, making current_kboard the only KBOARD
900 from which further input is accepted. If F is non-nil, set its
901 KBOARD as the current keyboard.
903 This function uses record_unwind_protect to return to the previous
904 state later.
906 If Emacs is already in single_kboard mode, and F's keyboard is
907 locked, then this function will throw an errow. */
909 void
910 temporarily_switch_to_single_kboard (struct frame *f)
912 int was_locked = single_kboard;
913 if (was_locked)
915 if (f != NULL && FRAME_KBOARD (f) != current_kboard)
916 /* We can not switch keyboards while in single_kboard mode.
917 In rare cases, Lisp code may call `recursive-edit' (or
918 `read-minibuffer' or `y-or-n-p') after it switched to a
919 locked frame. For example, this is likely to happen
920 when server.el connects to a new terminal while Emacs is in
921 single_kboard mode. It is best to throw an error instead
922 of presenting the user with a frozen screen. */
923 error ("Terminal %d is locked, cannot read from it",
924 FRAME_TERMINAL (f)->id);
925 else
926 /* This call is unnecessary, but helps
927 `restore_kboard_configuration' discover if somebody changed
928 `current_kboard' behind our back. */
929 push_kboard (current_kboard);
931 else if (f != NULL)
932 current_kboard = FRAME_KBOARD (f);
933 single_kboard = 1;
934 record_unwind_protect (restore_kboard_configuration,
935 (was_locked ? Qt : Qnil));
938 #if 0 /* This function is not needed anymore. */
939 void
940 record_single_kboard_state ()
942 if (single_kboard)
943 push_kboard (current_kboard);
944 record_unwind_protect (restore_kboard_configuration,
945 (single_kboard ? Qt : Qnil));
947 #endif
949 static Lisp_Object
950 restore_kboard_configuration (Lisp_Object was_locked)
952 if (NILP (was_locked))
953 single_kboard = 0;
954 else
956 struct kboard *prev = current_kboard;
957 single_kboard = 1;
958 pop_kboard ();
959 /* The pop should not change the kboard. */
960 if (single_kboard && current_kboard != prev)
961 abort ();
963 return Qnil;
967 /* Handle errors that are not handled at inner levels
968 by printing an error message and returning to the editor command loop. */
970 static Lisp_Object
971 cmd_error (Lisp_Object data)
973 Lisp_Object old_level, old_length;
974 char macroerror[50];
976 #ifdef HAVE_WINDOW_SYSTEM
977 if (display_hourglass_p)
978 cancel_hourglass ();
979 #endif
981 if (!NILP (executing_kbd_macro))
983 if (executing_kbd_macro_iterations == 1)
984 sprintf (macroerror, "After 1 kbd macro iteration: ");
985 else
986 sprintf (macroerror, "After %d kbd macro iterations: ",
987 executing_kbd_macro_iterations);
989 else
990 *macroerror = 0;
992 Vstandard_output = Qt;
993 Vstandard_input = Qt;
994 Vexecuting_kbd_macro = Qnil;
995 executing_kbd_macro = Qnil;
996 KVAR (current_kboard, Vprefix_arg) = Qnil;
997 KVAR (current_kboard, Vlast_prefix_arg) = Qnil;
998 cancel_echoing ();
1000 /* Avoid unquittable loop if data contains a circular list. */
1001 old_level = Vprint_level;
1002 old_length = Vprint_length;
1003 XSETFASTINT (Vprint_level, 10);
1004 XSETFASTINT (Vprint_length, 10);
1005 cmd_error_internal (data, macroerror);
1006 Vprint_level = old_level;
1007 Vprint_length = old_length;
1009 Vquit_flag = Qnil;
1011 Vinhibit_quit = Qnil;
1012 #if 0 /* This shouldn't be necessary anymore. --lorentey */
1013 if (command_loop_level == 0 && minibuf_level == 0)
1014 any_kboard_state ();
1015 #endif
1017 return make_number (0);
1020 /* Take actions on handling an error. DATA is the data that describes
1021 the error.
1023 CONTEXT is a C-string containing ASCII characters only which
1024 describes the context in which the error happened. If we need to
1025 generalize CONTEXT to allow multibyte characters, make it a Lisp
1026 string. */
1028 void
1029 cmd_error_internal (Lisp_Object data, const char *context)
1031 struct frame *sf = SELECTED_FRAME ();
1033 /* The immediate context is not interesting for Quits,
1034 since they are asyncronous. */
1035 if (EQ (XCAR (data), Qquit))
1036 Vsignaling_function = Qnil;
1038 Vquit_flag = Qnil;
1039 Vinhibit_quit = Qt;
1041 /* Use user's specified output function if any. */
1042 if (!NILP (Vcommand_error_function))
1043 call3 (Vcommand_error_function, data,
1044 context ? build_string (context) : empty_unibyte_string,
1045 Vsignaling_function);
1046 /* If the window system or terminal frame hasn't been initialized
1047 yet, or we're not interactive, write the message to stderr and exit. */
1048 else if (!sf->glyphs_initialized_p
1049 /* The initial frame is a special non-displaying frame. It
1050 will be current in daemon mode when there are no frames
1051 to display, and in non-daemon mode before the real frame
1052 has finished initializing. If an error is thrown in the
1053 latter case while creating the frame, then the frame
1054 will never be displayed, so the safest thing to do is
1055 write to stderr and quit. In daemon mode, there are
1056 many other potential errors that do not prevent frames
1057 from being created, so continuing as normal is better in
1058 that case. */
1059 || (!IS_DAEMON && FRAME_INITIAL_P (sf))
1060 || noninteractive)
1062 print_error_message (data, Qexternal_debugging_output,
1063 context, Vsignaling_function);
1064 Fterpri (Qexternal_debugging_output);
1065 Fkill_emacs (make_number (-1));
1067 else
1069 clear_message (1, 0);
1070 Fdiscard_input ();
1071 message_log_maybe_newline ();
1072 bitch_at_user ();
1074 print_error_message (data, Qt, context, Vsignaling_function);
1077 Vsignaling_function = Qnil;
1080 Lisp_Object command_loop_1 (void);
1081 Lisp_Object command_loop_2 (Lisp_Object);
1082 Lisp_Object top_level_1 (Lisp_Object);
1084 /* Entry to editor-command-loop.
1085 This level has the catches for exiting/returning to editor command loop.
1086 It returns nil to exit recursive edit, t to abort it. */
1088 Lisp_Object
1089 command_loop (void)
1091 if (command_loop_level > 0 || minibuf_level > 0)
1093 Lisp_Object val;
1094 val = internal_catch (Qexit, command_loop_2, Qnil);
1095 executing_kbd_macro = Qnil;
1096 return val;
1098 else
1099 while (1)
1101 internal_catch (Qtop_level, top_level_1, Qnil);
1102 #if 0 /* This shouldn't be necessary anymore. --lorentey */
1103 /* Reset single_kboard in case top-level set it while
1104 evaluating an -f option, or we are stuck there for some
1105 other reason. */
1106 any_kboard_state ();
1107 #endif
1108 internal_catch (Qtop_level, command_loop_2, Qnil);
1109 executing_kbd_macro = Qnil;
1111 /* End of file in -batch run causes exit here. */
1112 if (noninteractive)
1113 Fkill_emacs (Qt);
1117 /* Here we catch errors in execution of commands within the
1118 editing loop, and reenter the editing loop.
1119 When there is an error, cmd_error runs and returns a non-nil
1120 value to us. A value of nil means that command_loop_1 itself
1121 returned due to end of file (or end of kbd macro). */
1123 Lisp_Object
1124 command_loop_2 (Lisp_Object ignore)
1126 register Lisp_Object val;
1129 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
1130 while (!NILP (val));
1132 return Qnil;
1135 static Lisp_Object
1136 top_level_2 (void)
1138 return Feval (Vtop_level);
1141 Lisp_Object
1142 top_level_1 (Lisp_Object ignore)
1144 /* On entry to the outer level, run the startup file */
1145 if (!NILP (Vtop_level))
1146 internal_condition_case (top_level_2, Qerror, cmd_error);
1147 else if (!NILP (Vpurify_flag))
1148 message ("Bare impure Emacs (standard Lisp code not loaded)");
1149 else
1150 message ("Bare Emacs (standard Lisp code not loaded)");
1151 return Qnil;
1154 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1155 doc: /* Exit all recursive editing levels.
1156 This also exits all active minibuffers. */)
1157 (void)
1159 #ifdef HAVE_WINDOW_SYSTEM
1160 if (display_hourglass_p)
1161 cancel_hourglass ();
1162 #endif
1164 /* Unblock input if we enter with input blocked. This may happen if
1165 redisplay traps e.g. during tool-bar update with input blocked. */
1166 while (INPUT_BLOCKED_P)
1167 UNBLOCK_INPUT;
1169 Fthrow (Qtop_level, Qnil);
1172 Lisp_Object Fexit_recursive_edit (void) NO_RETURN;
1173 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1174 doc: /* Exit from the innermost recursive edit or minibuffer. */)
1175 (void)
1177 if (command_loop_level > 0 || minibuf_level > 0)
1178 Fthrow (Qexit, Qnil);
1180 error ("No recursive edit is in progress");
1183 Lisp_Object Fabort_recursive_edit (void) NO_RETURN;
1184 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1185 doc: /* Abort the command that requested this recursive edit or minibuffer input. */)
1186 (void)
1188 if (command_loop_level > 0 || minibuf_level > 0)
1189 Fthrow (Qexit, Qt);
1191 error ("No recursive edit is in progress");
1194 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
1196 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
1197 of this function. */
1199 static Lisp_Object
1200 tracking_off (Lisp_Object old_value)
1202 do_mouse_tracking = old_value;
1203 if (NILP (old_value))
1205 /* Redisplay may have been preempted because there was input
1206 available, and it assumes it will be called again after the
1207 input has been processed. If the only input available was
1208 the sort that we have just disabled, then we need to call
1209 redisplay. */
1210 if (!readable_events (READABLE_EVENTS_DO_TIMERS_NOW))
1212 redisplay_preserve_echo_area (6);
1213 get_input_pending (&input_pending,
1214 READABLE_EVENTS_DO_TIMERS_NOW);
1217 return Qnil;
1220 DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
1221 doc: /* Evaluate BODY with mouse movement events enabled.
1222 Within a `track-mouse' form, mouse motion generates input events that
1223 you can read with `read-event'.
1224 Normally, mouse motion is ignored.
1225 usage: (track-mouse BODY...) */)
1226 (Lisp_Object args)
1228 int count = SPECPDL_INDEX ();
1229 Lisp_Object val;
1231 record_unwind_protect (tracking_off, do_mouse_tracking);
1233 do_mouse_tracking = Qt;
1235 val = Fprogn (args);
1236 return unbind_to (count, val);
1239 /* If mouse has moved on some frame, return one of those frames.
1241 Return 0 otherwise.
1243 If ignore_mouse_drag_p is non-zero, ignore (implicit) mouse movement
1244 after resizing the tool-bar window. */
1246 int ignore_mouse_drag_p;
1248 static FRAME_PTR
1249 some_mouse_moved (void)
1251 Lisp_Object tail, frame;
1253 if (ignore_mouse_drag_p)
1255 /* ignore_mouse_drag_p = 0; */
1256 return 0;
1259 FOR_EACH_FRAME (tail, frame)
1261 if (XFRAME (frame)->mouse_moved)
1262 return XFRAME (frame);
1265 return 0;
1268 #endif /* HAVE_MOUSE || HAVE_GPM */
1270 /* This is the actual command reading loop,
1271 sans error-handling encapsulation. */
1273 static int read_key_sequence (Lisp_Object *, int, Lisp_Object,
1274 int, int, int);
1275 void safe_run_hooks (Lisp_Object);
1276 static void adjust_point_for_property (EMACS_INT, int);
1278 /* Cancel hourglass from protect_unwind.
1279 ARG is not used. */
1280 #ifdef HAVE_WINDOW_SYSTEM
1281 static Lisp_Object
1282 cancel_hourglass_unwind (Lisp_Object arg)
1284 cancel_hourglass ();
1285 return Qnil;
1287 #endif
1289 /* FIXME: This is wrong rather than test window-system, we should call
1290 a new set-selection, which will then dispatch to x-set-selection, or
1291 tty-set-selection, or w32-set-selection, ... */
1292 EXFUN (Fwindow_system, 1);
1294 Lisp_Object
1295 command_loop_1 (void)
1297 Lisp_Object cmd;
1298 Lisp_Object keybuf[30];
1299 int i;
1300 int prev_modiff = 0;
1301 struct buffer *prev_buffer = NULL;
1302 #if 0 /* This shouldn't be necessary anymore. --lorentey */
1303 int was_locked = single_kboard;
1304 #endif
1305 int already_adjusted = 0;
1307 KVAR (current_kboard, Vprefix_arg) = Qnil;
1308 KVAR (current_kboard, Vlast_prefix_arg) = Qnil;
1309 Vdeactivate_mark = Qnil;
1310 waiting_for_input = 0;
1311 cancel_echoing ();
1313 this_command_key_count = 0;
1314 this_command_key_count_reset = 0;
1315 this_single_command_key_start = 0;
1317 if (NILP (Vmemory_full))
1319 /* Make sure this hook runs after commands that get errors and
1320 throw to top level. */
1321 /* Note that the value cell will never directly contain nil
1322 if the symbol is a local variable. */
1323 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1324 safe_run_hooks (Qpost_command_hook);
1326 /* If displaying a message, resize the echo area window to fit
1327 that message's size exactly. */
1328 if (!NILP (echo_area_buffer[0]))
1329 resize_echo_area_exactly ();
1331 if (!NILP (Vdeferred_action_list))
1332 safe_run_hooks (Qdeferred_action_function);
1335 /* Do this after running Vpost_command_hook, for consistency. */
1336 KVAR (current_kboard, Vlast_command) = Vthis_command;
1337 KVAR (current_kboard, Vreal_last_command) = real_this_command;
1338 if (!CONSP (last_command_event))
1339 KVAR (current_kboard, Vlast_repeatable_command) = real_this_command;
1341 while (1)
1343 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1344 Fkill_emacs (Qnil);
1346 /* Make sure the current window's buffer is selected. */
1347 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1348 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1350 /* Display any malloc warning that just came out. Use while because
1351 displaying one warning can cause another. */
1353 while (pending_malloc_warning)
1354 display_malloc_warning ();
1356 Vdeactivate_mark = Qnil;
1358 /* If minibuffer on and echo area in use,
1359 wait a short time and redraw minibuffer. */
1361 if (minibuf_level
1362 && !NILP (echo_area_buffer[0])
1363 && EQ (minibuf_window, echo_area_window)
1364 && NUMBERP (Vminibuffer_message_timeout))
1366 /* Bind inhibit-quit to t so that C-g gets read in
1367 rather than quitting back to the minibuffer. */
1368 int count = SPECPDL_INDEX ();
1369 specbind (Qinhibit_quit, Qt);
1371 sit_for (Vminibuffer_message_timeout, 0, 2);
1373 /* Clear the echo area. */
1374 message2 (0, 0, 0);
1375 safe_run_hooks (Qecho_area_clear_hook);
1377 unbind_to (count, Qnil);
1379 /* If a C-g came in before, treat it as input now. */
1380 if (!NILP (Vquit_flag))
1382 Vquit_flag = Qnil;
1383 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
1387 #if 0
1388 /* Select the frame that the last event came from. Usually,
1389 switch-frame events will take care of this, but if some lisp
1390 code swallows a switch-frame event, we'll fix things up here.
1391 Is this a good idea? */
1392 if (FRAMEP (internal_last_event_frame)
1393 && !EQ (internal_last_event_frame, selected_frame))
1394 Fselect_frame (internal_last_event_frame, Qnil);
1395 #endif
1396 /* If it has changed current-menubar from previous value,
1397 really recompute the menubar from the value. */
1398 if (! NILP (Vlucid_menu_bar_dirty_flag)
1399 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
1400 call0 (Qrecompute_lucid_menubar);
1402 before_command_key_count = this_command_key_count;
1403 before_command_echo_length = echo_length ();
1405 Vthis_command = Qnil;
1406 real_this_command = Qnil;
1407 Vthis_original_command = Qnil;
1408 Vthis_command_keys_shift_translated = Qnil;
1410 /* Read next key sequence; i gets its length. */
1411 i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
1412 Qnil, 0, 1, 1);
1414 /* A filter may have run while we were reading the input. */
1415 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
1416 Fkill_emacs (Qnil);
1417 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1418 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1420 ++num_input_keys;
1422 /* Now we have read a key sequence of length I,
1423 or else I is 0 and we found end of file. */
1425 if (i == 0) /* End of file -- happens only in */
1426 return Qnil; /* a kbd macro, at the end. */
1427 /* -1 means read_key_sequence got a menu that was rejected.
1428 Just loop around and read another command. */
1429 if (i == -1)
1431 cancel_echoing ();
1432 this_command_key_count = 0;
1433 this_command_key_count_reset = 0;
1434 this_single_command_key_start = 0;
1435 goto finalize;
1438 last_command_event = keybuf[i - 1];
1440 /* If the previous command tried to force a specific window-start,
1441 forget about that, in case this command moves point far away
1442 from that position. But also throw away beg_unchanged and
1443 end_unchanged information in that case, so that redisplay will
1444 update the whole window properly. */
1445 if (!NILP (XWINDOW (selected_window)->force_start))
1447 struct buffer *b;
1448 XWINDOW (selected_window)->force_start = Qnil;
1449 b = XBUFFER (XWINDOW (selected_window)->buffer);
1450 BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0;
1453 cmd = read_key_sequence_cmd;
1454 if (!NILP (Vexecuting_kbd_macro))
1456 if (!NILP (Vquit_flag))
1458 Vexecuting_kbd_macro = Qt;
1459 QUIT; /* Make some noise. */
1460 /* Will return since macro now empty. */
1464 /* Do redisplay processing after this command except in special
1465 cases identified below. */
1466 prev_buffer = current_buffer;
1467 prev_modiff = MODIFF;
1468 last_point_position = PT;
1469 last_point_position_window = selected_window;
1470 XSETBUFFER (last_point_position_buffer, prev_buffer);
1472 /* By default, we adjust point to a boundary of a region that
1473 has such a property that should be treated intangible
1474 (e.g. composition, display). But, some commands will set
1475 this variable differently. */
1476 Vdisable_point_adjustment = Qnil;
1478 /* Process filters and timers may have messed with deactivate-mark.
1479 reset it before we execute the command. */
1480 Vdeactivate_mark = Qnil;
1482 /* Remap command through active keymaps */
1483 Vthis_original_command = cmd;
1484 if (SYMBOLP (cmd))
1486 Lisp_Object cmd1;
1487 if (cmd1 = Fcommand_remapping (cmd, Qnil, Qnil), !NILP (cmd1))
1488 cmd = cmd1;
1491 /* Execute the command. */
1493 Vthis_command = cmd;
1494 real_this_command = cmd;
1495 safe_run_hooks (Qpre_command_hook);
1497 already_adjusted = 0;
1499 if (NILP (Vthis_command))
1501 /* nil means key is undefined. */
1502 Lisp_Object keys = Fvector (i, keybuf);
1503 keys = Fkey_description (keys, Qnil);
1504 bitch_at_user ();
1505 message_with_string ("%s is undefined", keys, 0);
1506 KVAR (current_kboard, defining_kbd_macro) = Qnil;
1507 update_mode_lines = 1;
1508 KVAR (current_kboard, Vprefix_arg) = Qnil;
1510 else
1512 /* Here for a command that isn't executed directly */
1514 #ifdef HAVE_WINDOW_SYSTEM
1515 int scount = SPECPDL_INDEX ();
1517 if (display_hourglass_p
1518 && NILP (Vexecuting_kbd_macro))
1520 record_unwind_protect (cancel_hourglass_unwind, Qnil);
1521 start_hourglass ();
1523 #endif
1525 if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */
1526 Fundo_boundary ();
1527 Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil);
1529 #ifdef HAVE_WINDOW_SYSTEM
1530 /* Do not check display_hourglass_p here, because
1531 Fcommand_execute could change it, but we should cancel
1532 hourglass cursor anyway.
1533 But don't cancel the hourglass within a macro
1534 just because a command in the macro finishes. */
1535 if (NILP (Vexecuting_kbd_macro))
1536 unbind_to (scount, Qnil);
1537 #endif
1539 KVAR (current_kboard, Vlast_prefix_arg) = Vcurrent_prefix_arg;
1541 safe_run_hooks (Qpost_command_hook);
1543 /* If displaying a message, resize the echo area window to fit
1544 that message's size exactly. */
1545 if (!NILP (echo_area_buffer[0]))
1546 resize_echo_area_exactly ();
1548 safe_run_hooks (Qdeferred_action_function);
1550 /* If there is a prefix argument,
1551 1) We don't want Vlast_command to be ``universal-argument''
1552 (that would be dumb), so don't set Vlast_command,
1553 2) we want to leave echoing on so that the prefix will be
1554 echoed as part of this key sequence, so don't call
1555 cancel_echoing, and
1556 3) we want to leave this_command_key_count non-zero, so that
1557 read_char will realize that it is re-reading a character, and
1558 not echo it a second time.
1560 If the command didn't actually create a prefix arg,
1561 but is merely a frame event that is transparent to prefix args,
1562 then the above doesn't apply. */
1563 if (NILP (KVAR (current_kboard, Vprefix_arg)) || CONSP (last_command_event))
1565 KVAR (current_kboard, Vlast_command) = Vthis_command;
1566 KVAR (current_kboard, Vreal_last_command) = real_this_command;
1567 if (!CONSP (last_command_event))
1568 KVAR (current_kboard, Vlast_repeatable_command) = real_this_command;
1569 cancel_echoing ();
1570 this_command_key_count = 0;
1571 this_command_key_count_reset = 0;
1572 this_single_command_key_start = 0;
1575 if (!NILP (BVAR (current_buffer, mark_active))
1576 && !NILP (Vrun_hooks))
1578 /* In Emacs 22, setting transient-mark-mode to `only' was a
1579 way of turning it on for just one command. This usage is
1580 obsolete, but support it anyway. */
1581 if (EQ (Vtransient_mark_mode, Qidentity))
1582 Vtransient_mark_mode = Qnil;
1583 else if (EQ (Vtransient_mark_mode, Qonly))
1584 Vtransient_mark_mode = Qidentity;
1586 if (!NILP (Vdeactivate_mark))
1587 /* If `select-active-regions' is non-nil, this call to
1588 `deactivate-mark' also sets the PRIMARY selection. */
1589 call0 (Qdeactivate_mark);
1590 else
1592 /* Even if not deactivating the mark, set PRIMARY if
1593 `select-active-regions' is non-nil. */
1594 if (!NILP (Fwindow_system (Qnil))
1595 /* Even if mark_active is non-nil, the actual buffer
1596 marker may not have been set yet (Bug#7044). */
1597 && XMARKER (BVAR (current_buffer, mark))->buffer
1598 && (EQ (Vselect_active_regions, Qonly)
1599 ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly)
1600 : (!NILP (Vselect_active_regions)
1601 && !NILP (Vtransient_mark_mode)))
1602 && !EQ (Vthis_command, Qhandle_switch_frame))
1604 EMACS_INT beg =
1605 XINT (Fmarker_position (BVAR (current_buffer, mark)));
1606 EMACS_INT end = PT;
1607 if (beg < end)
1608 call2 (Qx_set_selection, QPRIMARY,
1609 make_buffer_string (beg, end, 0));
1610 else if (beg > end)
1611 call2 (Qx_set_selection, QPRIMARY,
1612 make_buffer_string (end, beg, 0));
1613 /* Don't set empty selections. */
1616 if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1618 Lisp_Object hook = intern ("activate-mark-hook");
1619 Frun_hooks (1, &hook);
1623 Vsaved_region_selection = Qnil;
1626 finalize:
1628 if (current_buffer == prev_buffer
1629 && last_point_position != PT
1630 && NILP (Vdisable_point_adjustment)
1631 && NILP (Vglobal_disable_point_adjustment))
1633 if (last_point_position > BEGV
1634 && last_point_position < ZV
1635 && (composition_adjust_point (last_point_position,
1636 last_point_position)
1637 != last_point_position))
1638 /* The last point was temporarily set within a grapheme
1639 cluster to prevent automatic composition. To recover
1640 the automatic composition, we must update the
1641 display. */
1642 windows_or_buffers_changed++;
1643 if (!already_adjusted)
1644 adjust_point_for_property (last_point_position,
1645 MODIFF != prev_modiff);
1648 /* Install chars successfully executed in kbd macro. */
1650 if (!NILP (KVAR (current_kboard, defining_kbd_macro))
1651 && NILP (KVAR (current_kboard, Vprefix_arg)))
1652 finalize_kbd_macro_chars ();
1653 #if 0 /* This shouldn't be necessary anymore. --lorentey */
1654 if (!was_locked)
1655 any_kboard_state ();
1656 #endif
1660 /* Adjust point to a boundary of a region that has such a property
1661 that should be treated intangible. For the moment, we check
1662 `composition', `display' and `invisible' properties.
1663 LAST_PT is the last position of point. */
1665 static void
1666 adjust_point_for_property (EMACS_INT last_pt, int modified)
1668 EMACS_INT beg, end;
1669 Lisp_Object val, overlay, tmp;
1670 /* When called after buffer modification, we should temporarily
1671 suppress the point adjustment for automatic composition so that a
1672 user can keep inserting another character at point or keep
1673 deleting characters around point. */
1674 int check_composition = ! modified, check_display = 1, check_invisible = 1;
1675 EMACS_INT orig_pt = PT;
1677 /* FIXME: cycling is probably not necessary because these properties
1678 can't be usefully combined anyway. */
1679 while (check_composition || check_display || check_invisible)
1681 /* FIXME: check `intangible'. */
1682 if (check_composition
1683 && PT > BEGV && PT < ZV
1684 && (beg = composition_adjust_point (last_pt, PT)) != PT)
1686 SET_PT (beg);
1687 check_display = check_invisible = 1;
1689 check_composition = 0;
1690 if (check_display
1691 && PT > BEGV && PT < ZV
1692 && !NILP (val = get_char_property_and_overlay
1693 (make_number (PT), Qdisplay, Qnil, &overlay))
1694 && display_prop_intangible_p (val)
1695 && (!OVERLAYP (overlay)
1696 ? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil)
1697 : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)),
1698 end = OVERLAY_POSITION (OVERLAY_END (overlay))))
1699 && (beg < PT /* && end > PT <- It's always the case. */
1700 || (beg <= PT && STRINGP (val) && SCHARS (val) == 0)))
1702 xassert (end > PT);
1703 SET_PT (PT < last_pt
1704 ? (STRINGP (val) && SCHARS (val) == 0 ? beg - 1 : beg)
1705 : end);
1706 check_composition = check_invisible = 1;
1708 check_display = 0;
1709 if (check_invisible && PT > BEGV && PT < ZV)
1711 int inv, ellipsis = 0;
1712 beg = end = PT;
1714 /* Find boundaries `beg' and `end' of the invisible area, if any. */
1715 while (end < ZV
1716 #if 0
1717 /* FIXME: We should stop if we find a spot between
1718 two runs of `invisible' where inserted text would
1719 be visible. This is important when we have two
1720 invisible boundaries that enclose an area: if the
1721 area is empty, we need this test in order to make
1722 it possible to place point in the middle rather
1723 than skip both boundaries. However, this code
1724 also stops anywhere in a non-sticky text-property,
1725 which breaks (e.g.) Org mode. */
1726 && (val = get_pos_property (make_number (end),
1727 Qinvisible, Qnil),
1728 TEXT_PROP_MEANS_INVISIBLE (val))
1729 #endif
1730 && !NILP (val = get_char_property_and_overlay
1731 (make_number (end), Qinvisible, Qnil, &overlay))
1732 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1734 ellipsis = ellipsis || inv > 1
1735 || (OVERLAYP (overlay)
1736 && (!NILP (Foverlay_get (overlay, Qafter_string))
1737 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1738 tmp = Fnext_single_char_property_change
1739 (make_number (end), Qinvisible, Qnil, Qnil);
1740 end = NATNUMP (tmp) ? XFASTINT (tmp) : ZV;
1742 while (beg > BEGV
1743 #if 0
1744 && (val = get_pos_property (make_number (beg),
1745 Qinvisible, Qnil),
1746 TEXT_PROP_MEANS_INVISIBLE (val))
1747 #endif
1748 && !NILP (val = get_char_property_and_overlay
1749 (make_number (beg - 1), Qinvisible, Qnil, &overlay))
1750 && (inv = TEXT_PROP_MEANS_INVISIBLE (val)))
1752 ellipsis = ellipsis || inv > 1
1753 || (OVERLAYP (overlay)
1754 && (!NILP (Foverlay_get (overlay, Qafter_string))
1755 || !NILP (Foverlay_get (overlay, Qbefore_string))));
1756 tmp = Fprevious_single_char_property_change
1757 (make_number (beg), Qinvisible, Qnil, Qnil);
1758 beg = NATNUMP (tmp) ? XFASTINT (tmp) : BEGV;
1761 /* Move away from the inside area. */
1762 if (beg < PT && end > PT)
1764 SET_PT ((orig_pt == PT && (last_pt < beg || last_pt > end))
1765 /* We haven't moved yet (so we don't need to fear
1766 infinite-looping) and we were outside the range
1767 before (so either end of the range still corresponds
1768 to a move in the right direction): pretend we moved
1769 less than we actually did, so that we still have
1770 more freedom below in choosing which end of the range
1771 to go to. */
1772 ? (orig_pt = -1, PT < last_pt ? end : beg)
1773 /* We either have moved already or the last point
1774 was already in the range: we don't get to choose
1775 which end of the range we have to go to. */
1776 : (PT < last_pt ? beg : end));
1777 check_composition = check_display = 1;
1779 #if 0 /* This assertion isn't correct, because SET_PT may end up setting
1780 the point to something other than its argument, due to
1781 point-motion hooks, intangibility, etc. */
1782 xassert (PT == beg || PT == end);
1783 #endif
1785 /* Pretend the area doesn't exist if the buffer is not
1786 modified. */
1787 if (!modified && !ellipsis && beg < end)
1789 if (last_pt == beg && PT == end && end < ZV)
1790 (check_composition = check_display = 1, SET_PT (end + 1));
1791 else if (last_pt == end && PT == beg && beg > BEGV)
1792 (check_composition = check_display = 1, SET_PT (beg - 1));
1793 else if (PT == ((PT < last_pt) ? beg : end))
1794 /* We've already moved as far as we can. Trying to go
1795 to the other end would mean moving backwards and thus
1796 could lead to an infinite loop. */
1798 else if (val = get_pos_property (make_number (PT),
1799 Qinvisible, Qnil),
1800 TEXT_PROP_MEANS_INVISIBLE (val)
1801 && (val = get_pos_property
1802 (make_number (PT == beg ? end : beg),
1803 Qinvisible, Qnil),
1804 !TEXT_PROP_MEANS_INVISIBLE (val)))
1805 (check_composition = check_display = 1,
1806 SET_PT (PT == beg ? end : beg));
1809 check_invisible = 0;
1813 /* Subroutine for safe_run_hooks: run the hook HOOK. */
1815 static Lisp_Object
1816 safe_run_hooks_1 (void)
1818 return Frun_hooks (1, &Vinhibit_quit);
1821 /* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */
1823 static Lisp_Object
1824 safe_run_hooks_error (Lisp_Object data)
1826 Lisp_Object args[3];
1827 args[0] = build_string ("Error in %s: %s");
1828 args[1] = Vinhibit_quit;
1829 args[2] = data;
1830 Fmessage (3, args);
1831 return Fset (Vinhibit_quit, Qnil);
1834 /* If we get an error while running the hook, cause the hook variable
1835 to be nil. Also inhibit quits, so that C-g won't cause the hook
1836 to mysteriously evaporate. */
1838 void
1839 safe_run_hooks (Lisp_Object hook)
1841 int count = SPECPDL_INDEX ();
1842 specbind (Qinhibit_quit, hook);
1844 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
1846 unbind_to (count, Qnil);
1850 /* Nonzero means polling for input is temporarily suppressed. */
1852 int poll_suppress_count;
1854 /* Asynchronous timer for polling. */
1856 struct atimer *poll_timer;
1859 #ifdef POLL_FOR_INPUT
1861 /* Poll for input, so that we catch a C-g if it comes in. This
1862 function is called from x_make_frame_visible, see comment
1863 there. */
1865 void
1866 poll_for_input_1 (void)
1868 /* Tell ns_read_socket() it is being called asynchronously so it can avoid
1869 doing anything dangerous. */
1870 #ifdef HAVE_NS
1871 ++handling_signal;
1872 #endif
1873 if (interrupt_input_blocked == 0
1874 && !waiting_for_input)
1875 read_avail_input (0);
1876 #ifdef HAVE_NS
1877 --handling_signal;
1878 #endif
1881 /* Timer callback function for poll_timer. TIMER is equal to
1882 poll_timer. */
1884 static void
1885 poll_for_input (struct atimer *timer)
1887 if (poll_suppress_count == 0)
1889 #ifdef SYNC_INPUT
1890 interrupt_input_pending = 1;
1891 pending_signals = 1;
1892 #else
1893 poll_for_input_1 ();
1894 #endif
1898 #endif /* POLL_FOR_INPUT */
1900 /* Begin signals to poll for input, if they are appropriate.
1901 This function is called unconditionally from various places. */
1903 void
1904 start_polling (void)
1906 #ifdef POLL_FOR_INPUT
1907 /* XXX This condition was (read_socket_hook && !interrupt_input),
1908 but read_socket_hook is not global anymore. Let's pretend that
1909 it's always set. */
1910 if (!interrupt_input)
1912 /* Turn alarm handling on unconditionally. It might have
1913 been turned off in process.c. */
1914 turn_on_atimers (1);
1916 /* If poll timer doesn't exist, are we need one with
1917 a different interval, start a new one. */
1918 if (poll_timer == NULL
1919 || EMACS_SECS (poll_timer->interval) != polling_period)
1921 EMACS_TIME interval;
1923 if (poll_timer)
1924 cancel_atimer (poll_timer);
1926 EMACS_SET_SECS_USECS (interval, polling_period, 0);
1927 poll_timer = start_atimer (ATIMER_CONTINUOUS, interval,
1928 poll_for_input, NULL);
1931 /* Let the timer's callback function poll for input
1932 if this becomes zero. */
1933 --poll_suppress_count;
1935 #endif
1938 /* Nonzero if we are using polling to handle input asynchronously. */
1941 input_polling_used (void)
1943 #ifdef POLL_FOR_INPUT
1944 /* XXX This condition was (read_socket_hook && !interrupt_input),
1945 but read_socket_hook is not global anymore. Let's pretend that
1946 it's always set. */
1947 return !interrupt_input;
1948 #else
1949 return 0;
1950 #endif
1953 /* Turn off polling. */
1955 void
1956 stop_polling (void)
1958 #ifdef POLL_FOR_INPUT
1959 /* XXX This condition was (read_socket_hook && !interrupt_input),
1960 but read_socket_hook is not global anymore. Let's pretend that
1961 it's always set. */
1962 if (!interrupt_input)
1963 ++poll_suppress_count;
1964 #endif
1967 /* Set the value of poll_suppress_count to COUNT
1968 and start or stop polling accordingly. */
1970 void
1971 set_poll_suppress_count (int count)
1973 #ifdef POLL_FOR_INPUT
1974 if (count == 0 && poll_suppress_count != 0)
1976 poll_suppress_count = 1;
1977 start_polling ();
1979 else if (count != 0 && poll_suppress_count == 0)
1981 stop_polling ();
1983 poll_suppress_count = count;
1984 #endif
1987 /* Bind polling_period to a value at least N.
1988 But don't decrease it. */
1990 void
1991 bind_polling_period (int n)
1993 #ifdef POLL_FOR_INPUT
1994 int new = polling_period;
1996 if (n > new)
1997 new = n;
1999 stop_other_atimers (poll_timer);
2000 stop_polling ();
2001 specbind (Qpolling_period, make_number (new));
2002 /* Start a new alarm with the new period. */
2003 start_polling ();
2004 #endif
2007 /* Apply the control modifier to CHARACTER. */
2010 make_ctrl_char (int c)
2012 /* Save the upper bits here. */
2013 int upper = c & ~0177;
2015 if (! ASCII_BYTE_P (c))
2016 return c |= ctrl_modifier;
2018 c &= 0177;
2020 /* Everything in the columns containing the upper-case letters
2021 denotes a control character. */
2022 if (c >= 0100 && c < 0140)
2024 int oc = c;
2025 c &= ~0140;
2026 /* Set the shift modifier for a control char
2027 made from a shifted letter. But only for letters! */
2028 if (oc >= 'A' && oc <= 'Z')
2029 c |= shift_modifier;
2032 /* The lower-case letters denote control characters too. */
2033 else if (c >= 'a' && c <= 'z')
2034 c &= ~0140;
2036 /* Include the bits for control and shift
2037 only if the basic ASCII code can't indicate them. */
2038 else if (c >= ' ')
2039 c |= ctrl_modifier;
2041 /* Replace the high bits. */
2042 c |= (upper & ~ctrl_modifier);
2044 return c;
2047 /* Display the help-echo property of the character after the mouse pointer.
2048 Either show it in the echo area, or call show-help-function to display
2049 it by other means (maybe in a tooltip).
2051 If HELP is nil, that means clear the previous help echo.
2053 If HELP is a string, display that string. If HELP is a function,
2054 call it with OBJECT and POS as arguments; the function should
2055 return a help string or nil for none. For all other types of HELP,
2056 evaluate it to obtain a string.
2058 WINDOW is the window in which the help was generated, if any.
2059 It is nil if not in a window.
2061 If OBJECT is a buffer, POS is the position in the buffer where the
2062 `help-echo' text property was found.
2064 If OBJECT is an overlay, that overlay has a `help-echo' property,
2065 and POS is the position in the overlay's buffer under the mouse.
2067 If OBJECT is a string (an overlay string or a string displayed with
2068 the `display' property). POS is the position in that string under
2069 the mouse.
2071 Note: this function may only be called with HELP nil or a string
2072 from X code running asynchronously. */
2074 void
2075 show_help_echo (Lisp_Object help, Lisp_Object window, Lisp_Object object,
2076 Lisp_Object pos)
2078 if (!NILP (help) && !STRINGP (help))
2080 if (FUNCTIONP (help))
2082 Lisp_Object args[4];
2083 args[0] = help;
2084 args[1] = window;
2085 args[2] = object;
2086 args[3] = pos;
2087 help = safe_call (4, args);
2089 else
2090 help = safe_eval (help);
2092 if (!STRINGP (help))
2093 return;
2096 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
2097 if (!noninteractive && STRINGP (help))
2099 /* The mouse-fixup-help-message Lisp function can call
2100 mouse_position_hook, which resets the mouse_moved flags.
2101 This causes trouble if we are trying to read a mouse motion
2102 event (i.e., if we are inside a `track-mouse' form), so we
2103 restore the mouse_moved flag. */
2104 FRAME_PTR f = NILP (do_mouse_tracking) ? NULL : some_mouse_moved ();
2105 help = call1 (Qmouse_fixup_help_message, help);
2106 if (f)
2107 f->mouse_moved = 1;
2109 #endif
2111 if (STRINGP (help) || NILP (help))
2113 if (!NILP (Vshow_help_function))
2114 call1 (Vshow_help_function, help);
2115 help_echo_showing_p = STRINGP (help);
2121 /* Input of single characters from keyboard */
2123 Lisp_Object print_help (Lisp_Object object);
2124 static Lisp_Object kbd_buffer_get_event (KBOARD **kbp, int *used_mouse_menu,
2125 struct timeval *end_time);
2126 static void record_char (Lisp_Object c);
2128 static Lisp_Object help_form_saved_window_configs;
2129 static Lisp_Object
2130 read_char_help_form_unwind (Lisp_Object arg)
2132 Lisp_Object window_config = XCAR (help_form_saved_window_configs);
2133 help_form_saved_window_configs = XCDR (help_form_saved_window_configs);
2134 if (!NILP (window_config))
2135 Fset_window_configuration (window_config);
2136 return Qnil;
2139 #define STOP_POLLING \
2140 do { if (! polling_stopped_here) stop_polling (); \
2141 polling_stopped_here = 1; } while (0)
2143 #define RESUME_POLLING \
2144 do { if (polling_stopped_here) start_polling (); \
2145 polling_stopped_here = 0; } while (0)
2147 /* read a character from the keyboard; call the redisplay if needed */
2148 /* commandflag 0 means do not do auto-saving, but do do redisplay.
2149 -1 means do not do redisplay, but do do autosaving.
2150 1 means do both. */
2152 /* The arguments MAPS and NMAPS are for menu prompting.
2153 MAPS is an array of keymaps; NMAPS is the length of MAPS.
2155 PREV_EVENT is the previous input event, or nil if we are reading
2156 the first event of a key sequence (or not reading a key sequence).
2157 If PREV_EVENT is t, that is a "magic" value that says
2158 not to run input methods, but in other respects to act as if
2159 not reading a key sequence.
2161 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
2162 if we used a mouse menu to read the input, or zero otherwise. If
2163 USED_MOUSE_MENU is null, we don't dereference it.
2165 Value is -2 when we find input on another keyboard. A second call
2166 to read_char will read it.
2168 If END_TIME is non-null, it is a pointer to an EMACS_TIME
2169 specifying the maximum time to wait until. If no input arrives by
2170 that time, stop waiting and return nil.
2172 Value is t if we showed a menu and the user rejected it. */
2174 Lisp_Object
2175 read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event,
2176 int *used_mouse_menu, struct timeval *end_time)
2178 volatile Lisp_Object c;
2179 int jmpcount;
2180 jmp_buf local_getcjmp;
2181 jmp_buf save_jump;
2182 volatile int key_already_recorded = 0;
2183 Lisp_Object tem, save;
2184 volatile Lisp_Object previous_echo_area_message;
2185 volatile Lisp_Object also_record;
2186 volatile int reread;
2187 struct gcpro gcpro1, gcpro2;
2188 int polling_stopped_here = 0;
2189 struct kboard *orig_kboard = current_kboard;
2191 also_record = Qnil;
2193 #if 0 /* This was commented out as part of fixing echo for C-u left. */
2194 before_command_key_count = this_command_key_count;
2195 before_command_echo_length = echo_length ();
2196 #endif
2197 c = Qnil;
2198 previous_echo_area_message = Qnil;
2200 GCPRO2 (c, previous_echo_area_message);
2202 retry:
2204 reread = 0;
2205 if (CONSP (Vunread_post_input_method_events))
2207 c = XCAR (Vunread_post_input_method_events);
2208 Vunread_post_input_method_events
2209 = XCDR (Vunread_post_input_method_events);
2211 /* Undo what read_char_x_menu_prompt did when it unread
2212 additional keys returned by Fx_popup_menu. */
2213 if (CONSP (c)
2214 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2215 && NILP (XCDR (c)))
2216 c = XCAR (c);
2218 reread = 1;
2219 goto reread_first;
2222 if (unread_command_char != -1)
2224 XSETINT (c, unread_command_char);
2225 unread_command_char = -1;
2227 reread = 1;
2228 goto reread_first;
2231 if (CONSP (Vunread_command_events))
2233 int was_disabled = 0;
2235 c = XCAR (Vunread_command_events);
2236 Vunread_command_events = XCDR (Vunread_command_events);
2238 reread = 1;
2240 /* Undo what sit-for did when it unread additional keys
2241 inside universal-argument. */
2243 if (CONSP (c)
2244 && EQ (XCAR (c), Qt))
2246 reread = 0;
2247 c = XCDR (c);
2250 /* Undo what read_char_x_menu_prompt did when it unread
2251 additional keys returned by Fx_popup_menu. */
2252 if (CONSP (c)
2253 && EQ (XCDR (c), Qdisabled)
2254 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))))
2256 was_disabled = 1;
2257 c = XCAR (c);
2260 /* If the queued event is something that used the mouse,
2261 set used_mouse_menu accordingly. */
2262 if (used_mouse_menu
2263 /* Also check was_disabled so last-nonmenu-event won't return
2264 a bad value when submenus are involved. (Bug#447) */
2265 && (EQ (c, Qtool_bar) || EQ (c, Qmenu_bar) || was_disabled))
2266 *used_mouse_menu = 1;
2268 goto reread_for_input_method;
2271 if (CONSP (Vunread_input_method_events))
2273 c = XCAR (Vunread_input_method_events);
2274 Vunread_input_method_events = XCDR (Vunread_input_method_events);
2276 /* Undo what read_char_x_menu_prompt did when it unread
2277 additional keys returned by Fx_popup_menu. */
2278 if (CONSP (c)
2279 && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c)))
2280 && NILP (XCDR (c)))
2281 c = XCAR (c);
2282 reread = 1;
2283 goto reread_for_input_method;
2286 this_command_key_count_reset = 0;
2288 if (!NILP (Vexecuting_kbd_macro))
2290 /* We set this to Qmacro; since that's not a frame, nobody will
2291 try to switch frames on us, and the selected window will
2292 remain unchanged.
2294 Since this event came from a macro, it would be misleading to
2295 leave internal_last_event_frame set to wherever the last
2296 real event came from. Normally, a switch-frame event selects
2297 internal_last_event_frame after each command is read, but
2298 events read from a macro should never cause a new frame to be
2299 selected. */
2300 Vlast_event_frame = internal_last_event_frame = Qmacro;
2302 /* Exit the macro if we are at the end.
2303 Also, some things replace the macro with t
2304 to force an early exit. */
2305 if (EQ (Vexecuting_kbd_macro, Qt)
2306 || executing_kbd_macro_index >= XFASTINT (Flength (Vexecuting_kbd_macro)))
2308 XSETINT (c, -1);
2309 goto exit;
2312 c = Faref (Vexecuting_kbd_macro, make_number (executing_kbd_macro_index));
2313 if (STRINGP (Vexecuting_kbd_macro)
2314 && (XINT (c) & 0x80) && (XUINT (c) <= 0xff))
2315 XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
2317 executing_kbd_macro_index++;
2319 goto from_macro;
2322 if (!NILP (unread_switch_frame))
2324 c = unread_switch_frame;
2325 unread_switch_frame = Qnil;
2327 /* This event should make it into this_command_keys, and get echoed
2328 again, so we do not set `reread'. */
2329 goto reread_first;
2332 /* if redisplay was requested */
2333 if (commandflag >= 0)
2335 int echo_current = EQ (echo_message_buffer, echo_area_buffer[0]);
2337 /* If there is pending input, process any events which are not
2338 user-visible, such as X selection_request events. */
2339 if (input_pending
2340 || detect_input_pending_run_timers (0))
2341 swallow_events (0); /* may clear input_pending */
2343 /* Redisplay if no pending input. */
2344 while (!input_pending)
2346 if (help_echo_showing_p && !EQ (selected_window, minibuf_window))
2347 redisplay_preserve_echo_area (5);
2348 else
2349 redisplay ();
2351 if (!input_pending)
2352 /* Normal case: no input arrived during redisplay. */
2353 break;
2355 /* Input arrived and pre-empted redisplay.
2356 Process any events which are not user-visible. */
2357 swallow_events (0);
2358 /* If that cleared input_pending, try again to redisplay. */
2361 /* Prevent the redisplay we just did
2362 from messing up echoing of the input after the prompt. */
2363 if (commandflag == 0 && echo_current)
2364 echo_message_buffer = echo_area_buffer[0];
2368 /* Message turns off echoing unless more keystrokes turn it on again.
2370 The code in 20.x for the condition was
2372 1. echo_area_glyphs && *echo_area_glyphs
2373 2. && echo_area_glyphs != current_kboard->echobuf
2374 3. && ok_to_echo_at_next_pause != echo_area_glyphs
2376 (1) means there's a current message displayed
2378 (2) means it's not the message from echoing from the current
2379 kboard.
2381 (3) There's only one place in 20.x where ok_to_echo_at_next_pause
2382 is set to a non-null value. This is done in read_char and it is
2383 set to echo_area_glyphs after a call to echo_char. That means
2384 ok_to_echo_at_next_pause is either null or
2385 current_kboard->echobuf with the appropriate current_kboard at
2386 that time.
2388 So, condition (3) means in clear text ok_to_echo_at_next_pause
2389 must be either null, or the current message isn't from echoing at
2390 all, or it's from echoing from a different kboard than the
2391 current one. */
2393 if (/* There currently is something in the echo area. */
2394 !NILP (echo_area_buffer[0])
2395 && (/* And it's either not from echoing. */
2396 !EQ (echo_area_buffer[0], echo_message_buffer)
2397 /* Or it's an echo from a different kboard. */
2398 || echo_kboard != current_kboard
2399 /* Or we explicitly allow overwriting whatever there is. */
2400 || ok_to_echo_at_next_pause == NULL))
2401 cancel_echoing ();
2402 else
2403 echo_dash ();
2405 /* Try reading a character via menu prompting in the minibuf.
2406 Try this before the sit-for, because the sit-for
2407 would do the wrong thing if we are supposed to do
2408 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
2409 after a mouse event so don't try a minibuf menu. */
2410 c = Qnil;
2411 if (nmaps > 0 && INTERACTIVE
2412 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
2413 /* Don't bring up a menu if we already have another event. */
2414 && NILP (Vunread_command_events)
2415 && unread_command_char < 0
2416 && !detect_input_pending_run_timers (0))
2418 c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
2420 if (INTEGERP (c) && XINT (c) == -2)
2421 return c; /* wrong_kboard_jmpbuf */
2423 if (! NILP (c))
2425 key_already_recorded = 1;
2426 goto non_reread_1;
2430 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
2431 We will do that below, temporarily for short sections of code,
2432 when appropriate. local_getcjmp must be in effect
2433 around any call to sit_for or kbd_buffer_get_event;
2434 it *must not* be in effect when we call redisplay. */
2436 jmpcount = SPECPDL_INDEX ();
2437 if (_setjmp (local_getcjmp))
2439 /* Handle quits while reading the keyboard. */
2440 /* We must have saved the outer value of getcjmp here,
2441 so restore it now. */
2442 restore_getcjmp (save_jump);
2443 unbind_to (jmpcount, Qnil);
2444 XSETINT (c, quit_char);
2445 internal_last_event_frame = selected_frame;
2446 Vlast_event_frame = internal_last_event_frame;
2447 /* If we report the quit char as an event,
2448 don't do so more than once. */
2449 if (!NILP (Vinhibit_quit))
2450 Vquit_flag = Qnil;
2453 KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame));
2454 if (kb != current_kboard)
2456 Lisp_Object last = KVAR (kb, kbd_queue);
2457 /* We shouldn't get here if we were in single-kboard mode! */
2458 if (single_kboard)
2459 abort ();
2460 if (CONSP (last))
2462 while (CONSP (XCDR (last)))
2463 last = XCDR (last);
2464 if (!NILP (XCDR (last)))
2465 abort ();
2467 if (!CONSP (last))
2468 KVAR (kb, kbd_queue) = Fcons (c, Qnil);
2469 else
2470 XSETCDR (last, Fcons (c, Qnil));
2471 kb->kbd_queue_has_data = 1;
2472 current_kboard = kb;
2473 /* This is going to exit from read_char
2474 so we had better get rid of this frame's stuff. */
2475 UNGCPRO;
2476 return make_number (-2); /* wrong_kboard_jmpbuf */
2479 goto non_reread;
2482 /* Start idle timers if no time limit is supplied. We don't do it
2483 if a time limit is supplied to avoid an infinite recursion in the
2484 situation where an idle timer calls `sit-for'. */
2486 if (!end_time)
2487 timer_start_idle ();
2489 /* If in middle of key sequence and minibuffer not active,
2490 start echoing if enough time elapses. */
2492 if (minibuf_level == 0
2493 && !end_time
2494 && !current_kboard->immediate_echo
2495 && this_command_key_count > 0
2496 && ! noninteractive
2497 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
2498 && NILP (Fzerop (Vecho_keystrokes))
2499 && (/* No message. */
2500 NILP (echo_area_buffer[0])
2501 /* Or empty message. */
2502 || (BUF_BEG (XBUFFER (echo_area_buffer[0]))
2503 == BUF_Z (XBUFFER (echo_area_buffer[0])))
2504 /* Or already echoing from same kboard. */
2505 || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard)
2506 /* Or not echoing before and echoing allowed. */
2507 || (!echo_kboard && ok_to_echo_at_next_pause)))
2509 /* After a mouse event, start echoing right away.
2510 This is because we are probably about to display a menu,
2511 and we don't want to delay before doing so. */
2512 if (EVENT_HAS_PARAMETERS (prev_event))
2513 echo_now ();
2514 else
2516 Lisp_Object tem0;
2518 save_getcjmp (save_jump);
2519 restore_getcjmp (local_getcjmp);
2520 tem0 = sit_for (Vecho_keystrokes, 1, 1);
2521 restore_getcjmp (save_jump);
2522 if (EQ (tem0, Qt)
2523 && ! CONSP (Vunread_command_events))
2524 echo_now ();
2528 /* Maybe auto save due to number of keystrokes. */
2530 if (commandflag != 0
2531 && auto_save_interval > 0
2532 && num_nonmacro_input_events - last_auto_save > max (auto_save_interval, 20)
2533 && !detect_input_pending_run_timers (0))
2535 Fdo_auto_save (Qnil, Qnil);
2536 /* Hooks can actually change some buffers in auto save. */
2537 redisplay ();
2540 /* Try reading using an X menu.
2541 This is never confused with reading using the minibuf
2542 because the recursive call of read_char in read_char_minibuf_menu_prompt
2543 does not pass on any keymaps. */
2545 if (nmaps > 0 && INTERACTIVE
2546 && !NILP (prev_event)
2547 && EVENT_HAS_PARAMETERS (prev_event)
2548 && !EQ (XCAR (prev_event), Qmenu_bar)
2549 && !EQ (XCAR (prev_event), Qtool_bar)
2550 /* Don't bring up a menu if we already have another event. */
2551 && NILP (Vunread_command_events)
2552 && unread_command_char < 0)
2554 c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
2556 /* Now that we have read an event, Emacs is not idle. */
2557 if (!end_time)
2558 timer_stop_idle ();
2560 goto exit;
2563 /* Maybe autosave and/or garbage collect due to idleness. */
2565 if (INTERACTIVE && NILP (c))
2567 int delay_level;
2568 EMACS_INT buffer_size;
2570 /* Slow down auto saves logarithmically in size of current buffer,
2571 and garbage collect while we're at it. */
2572 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
2573 last_non_minibuf_size = Z - BEG;
2574 buffer_size = (last_non_minibuf_size >> 8) + 1;
2575 delay_level = 0;
2576 while (buffer_size > 64)
2577 delay_level++, buffer_size -= buffer_size >> 2;
2578 if (delay_level < 4) delay_level = 4;
2579 /* delay_level is 4 for files under around 50k, 7 at 100k,
2580 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
2582 /* Auto save if enough time goes by without input. */
2583 if (commandflag != 0
2584 && num_nonmacro_input_events > last_auto_save
2585 && INTEGERP (Vauto_save_timeout)
2586 && XINT (Vauto_save_timeout) > 0)
2588 Lisp_Object tem0;
2589 int timeout = delay_level * XFASTINT (Vauto_save_timeout) / 4;
2591 save_getcjmp (save_jump);
2592 restore_getcjmp (local_getcjmp);
2593 tem0 = sit_for (make_number (timeout), 1, 1);
2594 restore_getcjmp (save_jump);
2596 if (EQ (tem0, Qt)
2597 && ! CONSP (Vunread_command_events))
2599 Fdo_auto_save (Qnil, Qnil);
2601 /* If we have auto-saved and there is still no input
2602 available, garbage collect if there has been enough
2603 consing going on to make it worthwhile. */
2604 if (!detect_input_pending_run_timers (0)
2605 && consing_since_gc > gc_cons_threshold / 2)
2606 Fgarbage_collect ();
2608 redisplay ();
2613 /* Notify the caller if an autosave hook, or a timer, sentinel or
2614 filter in the sit_for calls above have changed the current
2615 kboard. This could happen if they use the minibuffer or start a
2616 recursive edit, like the fancy splash screen in server.el's
2617 filter. If this longjmp wasn't here, read_key_sequence would
2618 interpret the next key sequence using the wrong translation
2619 tables and function keymaps. */
2620 if (NILP (c) && current_kboard != orig_kboard)
2622 UNGCPRO;
2623 return make_number (-2); /* wrong_kboard_jmpbuf */
2626 /* If this has become non-nil here, it has been set by a timer
2627 or sentinel or filter. */
2628 if (CONSP (Vunread_command_events))
2630 c = XCAR (Vunread_command_events);
2631 Vunread_command_events = XCDR (Vunread_command_events);
2634 /* Read something from current KBOARD's side queue, if possible. */
2636 if (NILP (c))
2638 if (current_kboard->kbd_queue_has_data)
2640 if (!CONSP (KVAR (current_kboard, kbd_queue)))
2641 abort ();
2642 c = XCAR (KVAR (current_kboard, kbd_queue));
2643 KVAR (current_kboard, kbd_queue)
2644 = XCDR (KVAR (current_kboard, kbd_queue));
2645 if (NILP (KVAR (current_kboard, kbd_queue)))
2646 current_kboard->kbd_queue_has_data = 0;
2647 input_pending = readable_events (0);
2648 if (EVENT_HAS_PARAMETERS (c)
2649 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
2650 internal_last_event_frame = XCAR (XCDR (c));
2651 Vlast_event_frame = internal_last_event_frame;
2655 /* If current_kboard's side queue is empty check the other kboards.
2656 If one of them has data that we have not yet seen here,
2657 switch to it and process the data waiting for it.
2659 Note: if the events queued up for another kboard
2660 have already been seen here, and therefore are not a complete command,
2661 the kbd_queue_has_data field is 0, so we skip that kboard here.
2662 That's to avoid an infinite loop switching between kboards here. */
2663 if (NILP (c) && !single_kboard)
2665 KBOARD *kb;
2666 for (kb = all_kboards; kb; kb = kb->next_kboard)
2667 if (kb->kbd_queue_has_data)
2669 current_kboard = kb;
2670 /* This is going to exit from read_char
2671 so we had better get rid of this frame's stuff. */
2672 UNGCPRO;
2673 return make_number (-2); /* wrong_kboard_jmpbuf */
2677 wrong_kboard:
2679 STOP_POLLING;
2681 /* Finally, we read from the main queue,
2682 and if that gives us something we can't use yet, we put it on the
2683 appropriate side queue and try again. */
2685 if (NILP (c))
2687 KBOARD *kb IF_LINT (= NULL);
2689 if (end_time)
2691 EMACS_TIME now;
2692 EMACS_GET_TIME (now);
2693 if (EMACS_TIME_GE (now, *end_time))
2694 goto exit;
2697 /* Actually read a character, waiting if necessary. */
2698 save_getcjmp (save_jump);
2699 restore_getcjmp (local_getcjmp);
2700 if (!end_time)
2701 timer_start_idle ();
2702 c = kbd_buffer_get_event (&kb, used_mouse_menu, end_time);
2703 restore_getcjmp (save_jump);
2705 if (! NILP (c) && (kb != current_kboard))
2707 Lisp_Object last = KVAR (kb, kbd_queue);
2708 if (CONSP (last))
2710 while (CONSP (XCDR (last)))
2711 last = XCDR (last);
2712 if (!NILP (XCDR (last)))
2713 abort ();
2715 if (!CONSP (last))
2716 KVAR (kb, kbd_queue) = Fcons (c, Qnil);
2717 else
2718 XSETCDR (last, Fcons (c, Qnil));
2719 kb->kbd_queue_has_data = 1;
2720 c = Qnil;
2721 if (single_kboard)
2722 goto wrong_kboard;
2723 current_kboard = kb;
2724 /* This is going to exit from read_char
2725 so we had better get rid of this frame's stuff. */
2726 UNGCPRO;
2727 return make_number (-2);
2731 /* Terminate Emacs in batch mode if at eof. */
2732 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
2733 Fkill_emacs (make_number (1));
2735 if (INTEGERP (c))
2737 /* Add in any extra modifiers, where appropriate. */
2738 if ((extra_keyboard_modifiers & CHAR_CTL)
2739 || ((extra_keyboard_modifiers & 0177) < ' '
2740 && (extra_keyboard_modifiers & 0177) != 0))
2741 XSETINT (c, make_ctrl_char (XINT (c)));
2743 /* Transfer any other modifier bits directly from
2744 extra_keyboard_modifiers to c. Ignore the actual character code
2745 in the low 16 bits of extra_keyboard_modifiers. */
2746 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
2749 non_reread:
2751 if (!end_time)
2752 timer_stop_idle ();
2753 RESUME_POLLING;
2755 if (NILP (c))
2757 if (commandflag >= 0
2758 && !input_pending && !detect_input_pending_run_timers (0))
2759 redisplay ();
2761 goto wrong_kboard;
2764 non_reread_1:
2766 /* Buffer switch events are only for internal wakeups
2767 so don't show them to the user.
2768 Also, don't record a key if we already did. */
2769 if (BUFFERP (c) || key_already_recorded)
2770 goto exit;
2772 /* Process special events within read_char
2773 and loop around to read another event. */
2774 save = Vquit_flag;
2775 Vquit_flag = Qnil;
2776 tem = access_keymap (get_keymap (Vspecial_event_map, 0, 1), c, 0, 0, 1);
2777 Vquit_flag = save;
2779 if (!NILP (tem))
2781 struct buffer *prev_buffer = current_buffer;
2782 #if 0 /* This shouldn't be necessary anymore. --lorentey */
2783 int was_locked = single_kboard;
2784 int count = SPECPDL_INDEX ();
2785 record_single_kboard_state ();
2786 #endif
2788 last_input_event = c;
2789 Fcommand_execute (tem, Qnil, Fvector (1, &last_input_event), Qt);
2791 if (CONSP (c) && EQ (XCAR (c), Qselect_window) && !end_time)
2792 /* We stopped being idle for this event; undo that. This
2793 prevents automatic window selection (under
2794 mouse_autoselect_window from acting as a real input event, for
2795 example banishing the mouse under mouse-avoidance-mode. */
2796 timer_resume_idle ();
2798 #if 0 /* This shouldn't be necessary anymore. --lorentey */
2799 /* Resume allowing input from any kboard, if that was true before. */
2800 if (!was_locked)
2801 any_kboard_state ();
2802 unbind_to (count, Qnil);
2803 #endif
2805 if (current_buffer != prev_buffer)
2807 /* The command may have changed the keymaps. Pretend there
2808 is input in another keyboard and return. This will
2809 recalculate keymaps. */
2810 c = make_number (-2);
2811 goto exit;
2813 else
2814 goto retry;
2817 /* Handle things that only apply to characters. */
2818 if (INTEGERP (c))
2820 /* If kbd_buffer_get_event gave us an EOF, return that. */
2821 if (XINT (c) == -1)
2822 goto exit;
2824 if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table))
2825 && SCHARS (KVAR (current_kboard, Vkeyboard_translate_table)) > (unsigned) XFASTINT (c))
2826 || (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table))
2827 && XVECTOR (KVAR (current_kboard, Vkeyboard_translate_table))->size > (unsigned) XFASTINT (c))
2828 || (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table))
2829 && CHARACTERP (c)))
2831 Lisp_Object d;
2832 d = Faref (KVAR (current_kboard, Vkeyboard_translate_table), c);
2833 /* nil in keyboard-translate-table means no translation. */
2834 if (!NILP (d))
2835 c = d;
2839 /* If this event is a mouse click in the menu bar,
2840 return just menu-bar for now. Modify the mouse click event
2841 so we won't do this twice, then queue it up. */
2842 if (EVENT_HAS_PARAMETERS (c)
2843 && CONSP (XCDR (c))
2844 && CONSP (EVENT_START (c))
2845 && CONSP (XCDR (EVENT_START (c))))
2847 Lisp_Object posn;
2849 posn = POSN_POSN (EVENT_START (c));
2850 /* Handle menu-bar events:
2851 insert the dummy prefix event `menu-bar'. */
2852 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
2854 /* Change menu-bar to (menu-bar) as the event "position". */
2855 POSN_SET_POSN (EVENT_START (c), Fcons (posn, Qnil));
2857 also_record = c;
2858 Vunread_command_events = Fcons (c, Vunread_command_events);
2859 c = posn;
2863 /* Store these characters into recent_keys, the dribble file if any,
2864 and the keyboard macro being defined, if any. */
2865 record_char (c);
2866 if (! NILP (also_record))
2867 record_char (also_record);
2869 /* Wipe the echo area.
2870 But first, if we are about to use an input method,
2871 save the echo area contents for it to refer to. */
2872 if (INTEGERP (c)
2873 && ! NILP (Vinput_method_function)
2874 && (unsigned) XINT (c) >= ' '
2875 && (unsigned) XINT (c) != 127
2876 && (unsigned) XINT (c) < 256)
2878 previous_echo_area_message = Fcurrent_message ();
2879 Vinput_method_previous_message = previous_echo_area_message;
2882 /* Now wipe the echo area, except for help events which do their
2883 own stuff with the echo area. */
2884 if (!CONSP (c)
2885 || (!(EQ (Qhelp_echo, XCAR (c)))
2886 && !(EQ (Qswitch_frame, XCAR (c)))))
2888 if (!NILP (echo_area_buffer[0]))
2889 safe_run_hooks (Qecho_area_clear_hook);
2890 clear_message (1, 0);
2893 reread_for_input_method:
2894 from_macro:
2895 /* Pass this to the input method, if appropriate. */
2896 if (INTEGERP (c)
2897 && ! NILP (Vinput_method_function)
2898 /* Don't run the input method within a key sequence,
2899 after the first event of the key sequence. */
2900 && NILP (prev_event)
2901 && (unsigned) XINT (c) >= ' '
2902 && (unsigned) XINT (c) != 127
2903 && (unsigned) XINT (c) < 256)
2905 Lisp_Object keys;
2906 int key_count, key_count_reset;
2907 struct gcpro inner_gcpro1;
2908 int count = SPECPDL_INDEX ();
2910 /* Save the echo status. */
2911 int saved_immediate_echo = current_kboard->immediate_echo;
2912 struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause;
2913 Lisp_Object saved_echo_string = KVAR (current_kboard, echo_string);
2914 int saved_echo_after_prompt = current_kboard->echo_after_prompt;
2916 #if 0
2917 if (before_command_restore_flag)
2919 this_command_key_count = before_command_key_count_1;
2920 if (this_command_key_count < this_single_command_key_start)
2921 this_single_command_key_start = this_command_key_count;
2922 echo_truncate (before_command_echo_length_1);
2923 before_command_restore_flag = 0;
2925 #endif
2927 /* Save the this_command_keys status. */
2928 key_count = this_command_key_count;
2929 key_count_reset = this_command_key_count_reset;
2931 if (key_count > 0)
2932 keys = Fcopy_sequence (this_command_keys);
2933 else
2934 keys = Qnil;
2935 GCPRO1_VAR (keys, inner_gcpro);
2937 /* Clear out this_command_keys. */
2938 this_command_key_count = 0;
2939 this_command_key_count_reset = 0;
2941 /* Now wipe the echo area. */
2942 if (!NILP (echo_area_buffer[0]))
2943 safe_run_hooks (Qecho_area_clear_hook);
2944 clear_message (1, 0);
2945 echo_truncate (0);
2947 /* If we are not reading a key sequence,
2948 never use the echo area. */
2949 if (maps == 0)
2951 specbind (Qinput_method_use_echo_area, Qt);
2954 /* Call the input method. */
2955 tem = call1 (Vinput_method_function, c);
2957 tem = unbind_to (count, tem);
2959 /* Restore the saved echoing state
2960 and this_command_keys state. */
2961 this_command_key_count = key_count;
2962 this_command_key_count_reset = key_count_reset;
2963 if (key_count > 0)
2964 this_command_keys = keys;
2966 cancel_echoing ();
2967 ok_to_echo_at_next_pause = saved_ok_to_echo;
2968 KVAR (current_kboard, echo_string) = saved_echo_string;
2969 current_kboard->echo_after_prompt = saved_echo_after_prompt;
2970 if (saved_immediate_echo)
2971 echo_now ();
2973 UNGCPRO_VAR (inner_gcpro);
2975 /* The input method can return no events. */
2976 if (! CONSP (tem))
2978 /* Bring back the previous message, if any. */
2979 if (! NILP (previous_echo_area_message))
2980 message_with_string ("%s", previous_echo_area_message, 0);
2981 goto retry;
2983 /* It returned one event or more. */
2984 c = XCAR (tem);
2985 Vunread_post_input_method_events
2986 = nconc2 (XCDR (tem), Vunread_post_input_method_events);
2989 reread_first:
2991 /* Display help if not echoing. */
2992 if (CONSP (c) && EQ (XCAR (c), Qhelp_echo))
2994 /* (help-echo FRAME HELP WINDOW OBJECT POS). */
2995 Lisp_Object help, object, position, window, htem;
2997 htem = Fcdr (XCDR (c));
2998 help = Fcar (htem);
2999 htem = Fcdr (htem);
3000 window = Fcar (htem);
3001 htem = Fcdr (htem);
3002 object = Fcar (htem);
3003 htem = Fcdr (htem);
3004 position = Fcar (htem);
3006 show_help_echo (help, window, object, position);
3008 /* We stopped being idle for this event; undo that. */
3009 if (!end_time)
3010 timer_resume_idle ();
3011 goto retry;
3014 if ((! reread || this_command_key_count == 0
3015 || this_command_key_count_reset)
3016 && !end_time)
3019 /* Don't echo mouse motion events. */
3020 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
3021 && NILP (Fzerop (Vecho_keystrokes))
3022 && ! (EVENT_HAS_PARAMETERS (c)
3023 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
3025 echo_char (c);
3026 if (! NILP (also_record))
3027 echo_char (also_record);
3028 /* Once we reread a character, echoing can happen
3029 the next time we pause to read a new one. */
3030 ok_to_echo_at_next_pause = current_kboard;
3033 /* Record this character as part of the current key. */
3034 add_command_key (c);
3035 if (! NILP (also_record))
3036 add_command_key (also_record);
3039 last_input_event = c;
3040 num_input_events++;
3042 /* Process the help character specially if enabled */
3043 if (!NILP (Vhelp_form) && help_char_p (c))
3045 Lisp_Object tem0;
3046 int count = SPECPDL_INDEX ();
3048 help_form_saved_window_configs
3049 = Fcons (Fcurrent_window_configuration (Qnil),
3050 help_form_saved_window_configs);
3051 record_unwind_protect (read_char_help_form_unwind, Qnil);
3053 tem0 = Feval (Vhelp_form);
3054 if (STRINGP (tem0))
3055 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
3057 cancel_echoing ();
3060 c = read_char (0, 0, 0, Qnil, 0, NULL);
3061 if (EVENT_HAS_PARAMETERS (c)
3062 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_click))
3063 XSETCAR (help_form_saved_window_configs, Qnil);
3065 while (BUFFERP (c));
3066 /* Remove the help from the frame */
3067 unbind_to (count, Qnil);
3069 redisplay ();
3070 if (EQ (c, make_number (040)))
3072 cancel_echoing ();
3074 c = read_char (0, 0, 0, Qnil, 0, NULL);
3075 while (BUFFERP (c));
3079 exit:
3080 RESUME_POLLING;
3081 RETURN_UNGCPRO (c);
3084 /* Record a key that came from a mouse menu.
3085 Record it for echoing, for this-command-keys, and so on. */
3087 static void
3088 record_menu_key (Lisp_Object c)
3090 /* Wipe the echo area. */
3091 clear_message (1, 0);
3093 record_char (c);
3095 #if 0
3096 before_command_key_count = this_command_key_count;
3097 before_command_echo_length = echo_length ();
3098 #endif
3100 /* Don't echo mouse motion events. */
3101 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
3102 && NILP (Fzerop (Vecho_keystrokes)))
3104 echo_char (c);
3106 /* Once we reread a character, echoing can happen
3107 the next time we pause to read a new one. */
3108 ok_to_echo_at_next_pause = 0;
3111 /* Record this character as part of the current key. */
3112 add_command_key (c);
3114 /* Re-reading in the middle of a command */
3115 last_input_event = c;
3116 num_input_events++;
3119 /* Return 1 if should recognize C as "the help character". */
3122 help_char_p (Lisp_Object c)
3124 Lisp_Object tail;
3126 if (EQ (c, Vhelp_char))
3127 return 1;
3128 for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail))
3129 if (EQ (c, XCAR (tail)))
3130 return 1;
3131 return 0;
3134 /* Record the input event C in various ways. */
3136 static void
3137 record_char (Lisp_Object c)
3139 int recorded = 0;
3141 if (CONSP (c) && (EQ (XCAR (c), Qhelp_echo) || EQ (XCAR (c), Qmouse_movement)))
3143 /* To avoid filling recent_keys with help-echo and mouse-movement
3144 events, we filter out repeated help-echo events, only store the
3145 first and last in a series of mouse-movement events, and don't
3146 store repeated help-echo events which are only separated by
3147 mouse-movement events. */
3149 Lisp_Object ev1, ev2, ev3;
3150 int ix1, ix2, ix3;
3152 if ((ix1 = recent_keys_index - 1) < 0)
3153 ix1 = NUM_RECENT_KEYS - 1;
3154 ev1 = AREF (recent_keys, ix1);
3156 if ((ix2 = ix1 - 1) < 0)
3157 ix2 = NUM_RECENT_KEYS - 1;
3158 ev2 = AREF (recent_keys, ix2);
3160 if ((ix3 = ix2 - 1) < 0)
3161 ix3 = NUM_RECENT_KEYS - 1;
3162 ev3 = AREF (recent_keys, ix3);
3164 if (EQ (XCAR (c), Qhelp_echo))
3166 /* Don't record `help-echo' in recent_keys unless it shows some help
3167 message, and a different help than the previously recorded
3168 event. */
3169 Lisp_Object help, last_help;
3171 help = Fcar_safe (Fcdr_safe (XCDR (c)));
3172 if (!STRINGP (help))
3173 recorded = 1;
3174 else if (CONSP (ev1) && EQ (XCAR (ev1), Qhelp_echo)
3175 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev1))), EQ (last_help, help)))
3176 recorded = 1;
3177 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3178 && CONSP (ev2) && EQ (XCAR (ev2), Qhelp_echo)
3179 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev2))), EQ (last_help, help)))
3180 recorded = -1;
3181 else if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3182 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3183 && CONSP (ev3) && EQ (XCAR (ev3), Qhelp_echo)
3184 && (last_help = Fcar_safe (Fcdr_safe (XCDR (ev3))), EQ (last_help, help)))
3185 recorded = -2;
3187 else if (EQ (XCAR (c), Qmouse_movement))
3189 /* Only record one pair of `mouse-movement' on a window in recent_keys.
3190 So additional mouse movement events replace the last element. */
3191 Lisp_Object last_window, window;
3193 window = Fcar_safe (Fcar_safe (XCDR (c)));
3194 if (CONSP (ev1) && EQ (XCAR (ev1), Qmouse_movement)
3195 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev1))), EQ (last_window, window))
3196 && CONSP (ev2) && EQ (XCAR (ev2), Qmouse_movement)
3197 && (last_window = Fcar_safe (Fcar_safe (XCDR (ev2))), EQ (last_window, window)))
3199 ASET (recent_keys, ix1, c);
3200 recorded = 1;
3204 else
3205 store_kbd_macro_char (c);
3207 if (!recorded)
3209 total_keys++;
3210 ASET (recent_keys, recent_keys_index, c);
3211 if (++recent_keys_index >= NUM_RECENT_KEYS)
3212 recent_keys_index = 0;
3214 else if (recorded < 0)
3216 /* We need to remove one or two events from recent_keys.
3217 To do this, we simply put nil at those events and move the
3218 recent_keys_index backwards over those events. Usually,
3219 users will never see those nil events, as they will be
3220 overwritten by the command keys entered to see recent_keys
3221 (e.g. C-h l). */
3223 while (recorded++ < 0 && total_keys > 0)
3225 if (total_keys < NUM_RECENT_KEYS)
3226 total_keys--;
3227 if (--recent_keys_index < 0)
3228 recent_keys_index = NUM_RECENT_KEYS - 1;
3229 ASET (recent_keys, recent_keys_index, Qnil);
3233 num_nonmacro_input_events++;
3235 /* Write c to the dribble file. If c is a lispy event, write
3236 the event's symbol to the dribble file, in <brackets>. Bleaugh.
3237 If you, dear reader, have a better idea, you've got the source. :-) */
3238 if (dribble)
3240 BLOCK_INPUT;
3241 if (INTEGERP (c))
3243 if (XUINT (c) < 0x100)
3244 putc (XINT (c), dribble);
3245 else
3246 fprintf (dribble, " 0x%x", (int) XUINT (c));
3248 else
3250 Lisp_Object dribblee;
3252 /* If it's a structured event, take the event header. */
3253 dribblee = EVENT_HEAD (c);
3255 if (SYMBOLP (dribblee))
3257 putc ('<', dribble);
3258 fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
3259 SBYTES (SYMBOL_NAME (dribblee)),
3260 dribble);
3261 putc ('>', dribble);
3265 fflush (dribble);
3266 UNBLOCK_INPUT;
3270 Lisp_Object
3271 print_help (Lisp_Object object)
3273 struct buffer *old = current_buffer;
3274 Fprinc (object, Qnil);
3275 set_buffer_internal (XBUFFER (Vstandard_output));
3276 call0 (intern ("help-mode"));
3277 set_buffer_internal (old);
3278 return Qnil;
3281 /* Copy out or in the info on where C-g should throw to.
3282 This is used when running Lisp code from within get_char,
3283 in case get_char is called recursively.
3284 See read_process_output. */
3286 static void
3287 save_getcjmp (jmp_buf temp)
3289 memcpy (temp, getcjmp, sizeof getcjmp);
3292 static void
3293 restore_getcjmp (jmp_buf temp)
3295 memcpy (getcjmp, temp, sizeof getcjmp);
3298 /* Low level keyboard/mouse input.
3299 kbd_buffer_store_event places events in kbd_buffer, and
3300 kbd_buffer_get_event retrieves them. */
3302 /* Return true if there are any events in the queue that read-char
3303 would return. If this returns false, a read-char would block. */
3304 static int
3305 readable_events (int flags)
3307 if (flags & READABLE_EVENTS_DO_TIMERS_NOW)
3308 timer_check ();
3310 /* If the buffer contains only FOCUS_IN_EVENT events, and
3311 READABLE_EVENTS_FILTER_EVENTS is set, report it as empty. */
3312 if (kbd_fetch_ptr != kbd_store_ptr)
3314 if (flags & (READABLE_EVENTS_FILTER_EVENTS
3315 #ifdef USE_TOOLKIT_SCROLL_BARS
3316 | READABLE_EVENTS_IGNORE_SQUEEZABLES
3317 #endif
3320 struct input_event *event;
3322 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3323 ? kbd_fetch_ptr
3324 : kbd_buffer);
3328 if (!(
3329 #ifdef USE_TOOLKIT_SCROLL_BARS
3330 (flags & READABLE_EVENTS_FILTER_EVENTS) &&
3331 #endif
3332 event->kind == FOCUS_IN_EVENT)
3333 #ifdef USE_TOOLKIT_SCROLL_BARS
3334 && !((flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3335 && event->kind == SCROLL_BAR_CLICK_EVENT
3336 && event->part == scroll_bar_handle
3337 && event->modifiers == 0)
3338 #endif
3340 return 1;
3341 event++;
3342 if (event == kbd_buffer + KBD_BUFFER_SIZE)
3343 event = kbd_buffer;
3345 while (event != kbd_store_ptr);
3347 else
3348 return 1;
3351 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
3352 if (!(flags & READABLE_EVENTS_IGNORE_SQUEEZABLES)
3353 && !NILP (do_mouse_tracking) && some_mouse_moved ())
3354 return 1;
3355 #endif
3356 if (single_kboard)
3358 if (current_kboard->kbd_queue_has_data)
3359 return 1;
3361 else
3363 KBOARD *kb;
3364 for (kb = all_kboards; kb; kb = kb->next_kboard)
3365 if (kb->kbd_queue_has_data)
3366 return 1;
3368 return 0;
3371 /* Set this for debugging, to have a way to get out */
3372 int stop_character;
3374 static KBOARD *
3375 event_to_kboard (struct input_event *event)
3377 Lisp_Object frame;
3378 frame = event->frame_or_window;
3379 if (CONSP (frame))
3380 frame = XCAR (frame);
3381 else if (WINDOWP (frame))
3382 frame = WINDOW_FRAME (XWINDOW (frame));
3384 /* There are still some events that don't set this field.
3385 For now, just ignore the problem.
3386 Also ignore dead frames here. */
3387 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
3388 return 0;
3389 else
3390 return FRAME_KBOARD (XFRAME (frame));
3393 #ifdef subprocesses
3394 /* Return the number of slots occupied in kbd_buffer. */
3396 static int
3397 kbd_buffer_nr_stored (void)
3399 return kbd_fetch_ptr == kbd_store_ptr
3401 : (kbd_fetch_ptr < kbd_store_ptr
3402 ? kbd_store_ptr - kbd_fetch_ptr
3403 : ((kbd_buffer + KBD_BUFFER_SIZE) - kbd_fetch_ptr
3404 + (kbd_store_ptr - kbd_buffer)));
3406 #endif /* Store an event obtained at interrupt level into kbd_buffer, fifo */
3408 void
3409 kbd_buffer_store_event (register struct input_event *event)
3411 kbd_buffer_store_event_hold (event, 0);
3414 /* Store EVENT obtained at interrupt level into kbd_buffer, fifo.
3416 If HOLD_QUIT is 0, just stuff EVENT into the fifo.
3417 Else, if HOLD_QUIT.kind != NO_EVENT, discard EVENT.
3418 Else, if EVENT is a quit event, store the quit event
3419 in HOLD_QUIT, and return (thus ignoring further events).
3421 This is used in read_avail_input to postpone the processing
3422 of the quit event until all subsequent input events have been
3423 parsed (and discarded).
3426 void
3427 kbd_buffer_store_event_hold (register struct input_event *event,
3428 struct input_event *hold_quit)
3430 if (event->kind == NO_EVENT)
3431 abort ();
3433 if (hold_quit && hold_quit->kind != NO_EVENT)
3434 return;
3436 if (event->kind == ASCII_KEYSTROKE_EVENT)
3438 register int c = event->code & 0377;
3440 if (event->modifiers & ctrl_modifier)
3441 c = make_ctrl_char (c);
3443 c |= (event->modifiers
3444 & (meta_modifier | alt_modifier
3445 | hyper_modifier | super_modifier));
3447 if (c == quit_char)
3449 KBOARD *kb = FRAME_KBOARD (XFRAME (event->frame_or_window));
3450 struct input_event *sp;
3452 if (single_kboard && kb != current_kboard)
3454 KVAR (kb, kbd_queue)
3455 = Fcons (make_lispy_switch_frame (event->frame_or_window),
3456 Fcons (make_number (c), Qnil));
3457 kb->kbd_queue_has_data = 1;
3458 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3460 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3461 sp = kbd_buffer;
3463 if (event_to_kboard (sp) == kb)
3465 sp->kind = NO_EVENT;
3466 sp->frame_or_window = Qnil;
3467 sp->arg = Qnil;
3470 return;
3473 if (hold_quit)
3475 memcpy (hold_quit, event, sizeof (*event));
3476 return;
3479 /* If this results in a quit_char being returned to Emacs as
3480 input, set Vlast_event_frame properly. If this doesn't
3481 get returned to Emacs as an event, the next event read
3482 will set Vlast_event_frame again, so this is safe to do. */
3484 Lisp_Object focus;
3486 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
3487 if (NILP (focus))
3488 focus = event->frame_or_window;
3489 internal_last_event_frame = focus;
3490 Vlast_event_frame = focus;
3493 last_event_timestamp = event->timestamp;
3494 handle_interrupt ();
3495 return;
3498 if (c && c == stop_character)
3500 sys_suspend ();
3501 return;
3504 /* Don't insert two BUFFER_SWITCH_EVENT's in a row.
3505 Just ignore the second one. */
3506 else if (event->kind == BUFFER_SWITCH_EVENT
3507 && kbd_fetch_ptr != kbd_store_ptr
3508 && ((kbd_store_ptr == kbd_buffer
3509 ? kbd_buffer + KBD_BUFFER_SIZE - 1
3510 : kbd_store_ptr - 1)->kind) == BUFFER_SWITCH_EVENT)
3511 return;
3513 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
3514 kbd_store_ptr = kbd_buffer;
3516 /* Don't let the very last slot in the buffer become full,
3517 since that would make the two pointers equal,
3518 and that is indistinguishable from an empty buffer.
3519 Discard the event if it would fill the last slot. */
3520 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3522 *kbd_store_ptr = *event;
3523 ++kbd_store_ptr;
3524 #ifdef subprocesses
3525 if (kbd_buffer_nr_stored () > KBD_BUFFER_SIZE/2 && ! kbd_on_hold_p ())
3527 /* Don't read keyboard input until we have processed kbd_buffer.
3528 This happens when pasting text longer than KBD_BUFFER_SIZE/2. */
3529 hold_keyboard_input ();
3530 #ifdef SIGIO
3531 if (!noninteractive)
3532 signal (SIGIO, SIG_IGN);
3533 #endif
3534 stop_polling ();
3536 #endif /* subprocesses */
3539 /* If we're inside while-no-input, and this event qualifies
3540 as input, set quit-flag to cause an interrupt. */
3541 if (!NILP (Vthrow_on_input)
3542 && event->kind != FOCUS_IN_EVENT
3543 && event->kind != HELP_EVENT
3544 && event->kind != DEICONIFY_EVENT)
3546 Vquit_flag = Vthrow_on_input;
3547 /* If we're inside a function that wants immediate quits,
3548 do it now. */
3549 if (immediate_quit && NILP (Vinhibit_quit))
3551 immediate_quit = 0;
3552 sigfree ();
3553 QUIT;
3559 /* Put an input event back in the head of the event queue. */
3561 void
3562 kbd_buffer_unget_event (register struct input_event *event)
3564 if (kbd_fetch_ptr == kbd_buffer)
3565 kbd_fetch_ptr = kbd_buffer + KBD_BUFFER_SIZE;
3567 /* Don't let the very last slot in the buffer become full, */
3568 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
3570 --kbd_fetch_ptr;
3571 *kbd_fetch_ptr = *event;
3576 /* Generate a HELP_EVENT input_event and store it in the keyboard
3577 buffer.
3579 HELP is the help form.
3581 FRAME and WINDOW are the frame and window where the help is
3582 generated. OBJECT is the Lisp object where the help was found (a
3583 buffer, a string, an overlay, or nil if neither from a string nor
3584 from a buffer). POS is the position within OBJECT where the help
3585 was found. */
3587 void
3588 gen_help_event (Lisp_Object help, Lisp_Object frame, Lisp_Object window,
3589 Lisp_Object object, EMACS_INT pos)
3591 struct input_event event;
3593 EVENT_INIT (event);
3595 event.kind = HELP_EVENT;
3596 event.frame_or_window = frame;
3597 event.arg = object;
3598 event.x = WINDOWP (window) ? window : frame;
3599 event.y = help;
3600 event.code = pos;
3601 kbd_buffer_store_event (&event);
3605 /* Store HELP_EVENTs for HELP on FRAME in the input queue. */
3607 void
3608 kbd_buffer_store_help_event (Lisp_Object frame, Lisp_Object help)
3610 struct input_event event;
3612 event.kind = HELP_EVENT;
3613 event.frame_or_window = frame;
3614 event.arg = Qnil;
3615 event.x = Qnil;
3616 event.y = help;
3617 event.code = 0;
3618 kbd_buffer_store_event (&event);
3622 /* Discard any mouse events in the event buffer by setting them to
3623 NO_EVENT. */
3624 void
3625 discard_mouse_events (void)
3627 struct input_event *sp;
3628 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
3630 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3631 sp = kbd_buffer;
3633 if (sp->kind == MOUSE_CLICK_EVENT
3634 || sp->kind == WHEEL_EVENT
3635 || sp->kind == HORIZ_WHEEL_EVENT
3636 #ifdef HAVE_GPM
3637 || sp->kind == GPM_CLICK_EVENT
3638 #endif
3639 || sp->kind == SCROLL_BAR_CLICK_EVENT)
3641 sp->kind = NO_EVENT;
3647 /* Return non-zero if there are any real events waiting in the event
3648 buffer, not counting `NO_EVENT's.
3650 If DISCARD is non-zero, discard NO_EVENT events at the front of
3651 the input queue, possibly leaving the input queue empty if there
3652 are no real input events. */
3655 kbd_buffer_events_waiting (int discard)
3657 struct input_event *sp;
3659 for (sp = kbd_fetch_ptr;
3660 sp != kbd_store_ptr && sp->kind == NO_EVENT;
3661 ++sp)
3663 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
3664 sp = kbd_buffer;
3667 if (discard)
3668 kbd_fetch_ptr = sp;
3670 return sp != kbd_store_ptr && sp->kind != NO_EVENT;
3674 /* Clear input event EVENT. */
3676 static INLINE void
3677 clear_event (struct input_event *event)
3679 event->kind = NO_EVENT;
3683 /* Read one event from the event buffer, waiting if necessary.
3684 The value is a Lisp object representing the event.
3685 The value is nil for an event that should be ignored,
3686 or that was handled here.
3687 We always read and discard one event. */
3689 static Lisp_Object
3690 kbd_buffer_get_event (KBOARD **kbp,
3691 int *used_mouse_menu,
3692 struct timeval *end_time)
3694 register int c;
3695 Lisp_Object obj;
3697 #ifdef subprocesses
3698 if (kbd_on_hold_p () && kbd_buffer_nr_stored () < KBD_BUFFER_SIZE/4)
3700 /* Start reading input again, we have processed enough so we can
3701 accept new events again. */
3702 unhold_keyboard_input ();
3703 #ifdef SIGIO
3704 if (!noninteractive)
3705 signal (SIGIO, input_available_signal);
3706 #endif /* SIGIO */
3707 start_polling ();
3709 #endif /* subprocesses */
3711 if (noninteractive
3712 /* In case we are running as a daemon, only do this before
3713 detaching from the terminal. */
3714 || (IS_DAEMON && daemon_pipe[1] >= 0))
3716 c = getchar ();
3717 XSETINT (obj, c);
3718 *kbp = current_kboard;
3719 return obj;
3722 /* Wait until there is input available. */
3723 for (;;)
3725 /* Break loop if there's an unread command event. Needed in
3726 moused window autoselection which uses a timer to insert such
3727 events. */
3728 if (CONSP (Vunread_command_events))
3729 break;
3731 if (kbd_fetch_ptr != kbd_store_ptr)
3732 break;
3733 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
3734 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3735 break;
3736 #endif
3738 /* If the quit flag is set, then read_char will return
3739 quit_char, so that counts as "available input." */
3740 if (!NILP (Vquit_flag))
3741 quit_throw_to_read_char ();
3743 /* One way or another, wait until input is available; then, if
3744 interrupt handlers have not read it, read it now. */
3746 /* Note SIGIO has been undef'd if FIONREAD is missing. */
3747 #ifdef SIGIO
3748 gobble_input (0);
3749 #endif /* SIGIO */
3750 if (kbd_fetch_ptr != kbd_store_ptr)
3751 break;
3752 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
3753 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
3754 break;
3755 #endif
3756 if (end_time)
3758 EMACS_TIME duration;
3759 EMACS_GET_TIME (duration);
3760 if (EMACS_TIME_GE (duration, *end_time))
3761 return Qnil; /* finished waiting */
3762 else
3764 EMACS_SUB_TIME (duration, *end_time, duration);
3765 wait_reading_process_output (EMACS_SECS (duration),
3766 EMACS_USECS (duration),
3767 -1, 1, Qnil, NULL, 0);
3770 else
3771 wait_reading_process_output (0, 0, -1, 1, Qnil, NULL, 0);
3773 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
3774 /* Pass 1 for EXPECT since we just waited to have input. */
3775 read_avail_input (1);
3778 if (CONSP (Vunread_command_events))
3780 Lisp_Object first;
3781 first = XCAR (Vunread_command_events);
3782 Vunread_command_events = XCDR (Vunread_command_events);
3783 *kbp = current_kboard;
3784 return first;
3787 /* At this point, we know that there is a readable event available
3788 somewhere. If the event queue is empty, then there must be a
3789 mouse movement enabled and available. */
3790 if (kbd_fetch_ptr != kbd_store_ptr)
3792 struct input_event *event;
3794 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
3795 ? kbd_fetch_ptr
3796 : kbd_buffer);
3798 last_event_timestamp = event->timestamp;
3800 *kbp = event_to_kboard (event);
3801 if (*kbp == 0)
3802 *kbp = current_kboard; /* Better than returning null ptr? */
3804 obj = Qnil;
3806 /* These two kinds of events get special handling
3807 and don't actually appear to the command loop.
3808 We return nil for them. */
3809 if (event->kind == SELECTION_REQUEST_EVENT
3810 || event->kind == SELECTION_CLEAR_EVENT)
3812 #ifdef HAVE_X11
3813 struct input_event copy;
3815 /* Remove it from the buffer before processing it,
3816 since otherwise swallow_events will see it
3817 and process it again. */
3818 copy = *event;
3819 kbd_fetch_ptr = event + 1;
3820 input_pending = readable_events (0);
3821 x_handle_selection_event (&copy);
3822 #else
3823 /* We're getting selection request events, but we don't have
3824 a window system. */
3825 abort ();
3826 #endif
3829 #if defined (HAVE_NS)
3830 else if (event->kind == NS_TEXT_EVENT)
3832 if (event->code == KEY_NS_PUT_WORKING_TEXT)
3833 obj = Fcons (intern ("ns-put-working-text"), Qnil);
3834 else
3835 obj = Fcons (intern ("ns-unput-working-text"), Qnil);
3836 kbd_fetch_ptr = event + 1;
3837 if (used_mouse_menu)
3838 *used_mouse_menu = 1;
3840 #endif
3842 #if defined (HAVE_X11) || defined (HAVE_NTGUI) \
3843 || defined (HAVE_NS)
3844 else if (event->kind == DELETE_WINDOW_EVENT)
3846 /* Make an event (delete-frame (FRAME)). */
3847 obj = Fcons (event->frame_or_window, Qnil);
3848 obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
3849 kbd_fetch_ptr = event + 1;
3851 #endif
3852 #if defined (HAVE_X11) || defined (HAVE_NTGUI) \
3853 || defined (HAVE_NS)
3854 else if (event->kind == ICONIFY_EVENT)
3856 /* Make an event (iconify-frame (FRAME)). */
3857 obj = Fcons (event->frame_or_window, Qnil);
3858 obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
3859 kbd_fetch_ptr = event + 1;
3861 else if (event->kind == DEICONIFY_EVENT)
3863 /* Make an event (make-frame-visible (FRAME)). */
3864 obj = Fcons (event->frame_or_window, Qnil);
3865 obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
3866 kbd_fetch_ptr = event + 1;
3868 #endif
3869 else if (event->kind == BUFFER_SWITCH_EVENT)
3871 /* The value doesn't matter here; only the type is tested. */
3872 XSETBUFFER (obj, current_buffer);
3873 kbd_fetch_ptr = event + 1;
3875 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
3876 || defined(HAVE_NS) || defined (USE_GTK)
3877 else if (event->kind == MENU_BAR_ACTIVATE_EVENT)
3879 kbd_fetch_ptr = event + 1;
3880 input_pending = readable_events (0);
3881 if (FRAME_LIVE_P (XFRAME (event->frame_or_window)))
3882 x_activate_menubar (XFRAME (event->frame_or_window));
3884 #endif
3885 #if defined (WINDOWSNT)
3886 else if (event->kind == LANGUAGE_CHANGE_EVENT)
3888 /* Make an event (language-change (FRAME CHARSET LCID)). */
3889 obj = Fcons (event->frame_or_window, Qnil);
3890 obj = Fcons (Qlanguage_change, Fcons (obj, Qnil));
3891 kbd_fetch_ptr = event + 1;
3893 #endif
3894 else if (event->kind == SAVE_SESSION_EVENT)
3896 obj = Fcons (Qsave_session, Fcons (event->arg, Qnil));
3897 kbd_fetch_ptr = event + 1;
3899 /* Just discard these, by returning nil.
3900 With MULTI_KBOARD, these events are used as placeholders
3901 when we need to randomly delete events from the queue.
3902 (They shouldn't otherwise be found in the buffer,
3903 but on some machines it appears they do show up
3904 even without MULTI_KBOARD.) */
3905 /* On Windows NT/9X, NO_EVENT is used to delete extraneous
3906 mouse events during a popup-menu call. */
3907 else if (event->kind == NO_EVENT)
3908 kbd_fetch_ptr = event + 1;
3909 else if (event->kind == HELP_EVENT)
3911 Lisp_Object object, position, help, frame, window;
3913 frame = event->frame_or_window;
3914 object = event->arg;
3915 position = make_number (event->code);
3916 window = event->x;
3917 help = event->y;
3918 clear_event (event);
3920 kbd_fetch_ptr = event + 1;
3921 if (!WINDOWP (window))
3922 window = Qnil;
3923 obj = Fcons (Qhelp_echo,
3924 list5 (frame, help, window, object, position));
3926 else if (event->kind == FOCUS_IN_EVENT)
3928 /* Notification of a FocusIn event. The frame receiving the
3929 focus is in event->frame_or_window. Generate a
3930 switch-frame event if necessary. */
3931 Lisp_Object frame, focus;
3933 frame = event->frame_or_window;
3934 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
3935 if (FRAMEP (focus))
3936 frame = focus;
3938 if (!EQ (frame, internal_last_event_frame)
3939 && !EQ (frame, selected_frame))
3940 obj = make_lispy_switch_frame (frame);
3941 internal_last_event_frame = frame;
3942 kbd_fetch_ptr = event + 1;
3944 #ifdef HAVE_DBUS
3945 else if (event->kind == DBUS_EVENT)
3947 obj = make_lispy_event (event);
3948 kbd_fetch_ptr = event + 1;
3950 #endif
3951 else if (event->kind == CONFIG_CHANGED_EVENT)
3953 obj = make_lispy_event (event);
3954 kbd_fetch_ptr = event + 1;
3956 else
3958 /* If this event is on a different frame, return a switch-frame this
3959 time, and leave the event in the queue for next time. */
3960 Lisp_Object frame;
3961 Lisp_Object focus;
3963 frame = event->frame_or_window;
3964 if (CONSP (frame))
3965 frame = XCAR (frame);
3966 else if (WINDOWP (frame))
3967 frame = WINDOW_FRAME (XWINDOW (frame));
3969 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
3970 if (! NILP (focus))
3971 frame = focus;
3973 if (! EQ (frame, internal_last_event_frame)
3974 && !EQ (frame, selected_frame))
3975 obj = make_lispy_switch_frame (frame);
3976 internal_last_event_frame = frame;
3978 /* If we didn't decide to make a switch-frame event, go ahead
3979 and build a real event from the queue entry. */
3981 if (NILP (obj))
3983 obj = make_lispy_event (event);
3985 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
3986 || defined(HAVE_NS) || defined (USE_GTK)
3987 /* If this was a menu selection, then set the flag to inhibit
3988 writing to last_nonmenu_event. Don't do this if the event
3989 we're returning is (menu-bar), though; that indicates the
3990 beginning of the menu sequence, and we might as well leave
3991 that as the `event with parameters' for this selection. */
3992 if (used_mouse_menu
3993 && !EQ (event->frame_or_window, event->arg)
3994 && (event->kind == MENU_BAR_EVENT
3995 || event->kind == TOOL_BAR_EVENT))
3996 *used_mouse_menu = 1;
3997 #endif
3998 #ifdef HAVE_NS
3999 /* certain system events are non-key events */
4000 if (used_mouse_menu
4001 && event->kind == NS_NONKEY_EVENT)
4002 *used_mouse_menu = 1;
4003 #endif
4005 /* Wipe out this event, to catch bugs. */
4006 clear_event (event);
4007 kbd_fetch_ptr = event + 1;
4011 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
4012 /* Try generating a mouse motion event. */
4013 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
4015 FRAME_PTR f = some_mouse_moved ();
4016 Lisp_Object bar_window;
4017 enum scroll_bar_part part;
4018 Lisp_Object x, y;
4019 unsigned long t;
4021 *kbp = current_kboard;
4022 /* Note that this uses F to determine which terminal to look at.
4023 If there is no valid info, it does not store anything
4024 so x remains nil. */
4025 x = Qnil;
4027 /* XXX Can f or mouse_position_hook be NULL here? */
4028 if (f && FRAME_TERMINAL (f)->mouse_position_hook)
4029 (*FRAME_TERMINAL (f)->mouse_position_hook) (&f, 0, &bar_window,
4030 &part, &x, &y, &t);
4032 obj = Qnil;
4034 /* Decide if we should generate a switch-frame event. Don't
4035 generate switch-frame events for motion outside of all Emacs
4036 frames. */
4037 if (!NILP (x) && f)
4039 Lisp_Object frame;
4041 frame = FRAME_FOCUS_FRAME (f);
4042 if (NILP (frame))
4043 XSETFRAME (frame, f);
4045 if (! EQ (frame, internal_last_event_frame)
4046 && !EQ (frame, selected_frame))
4047 obj = make_lispy_switch_frame (frame);
4048 internal_last_event_frame = frame;
4051 /* If we didn't decide to make a switch-frame event, go ahead and
4052 return a mouse-motion event. */
4053 if (!NILP (x) && NILP (obj))
4054 obj = make_lispy_movement (f, bar_window, part, x, y, t);
4056 #endif /* HAVE_MOUSE || HAVE GPM */
4057 else
4058 /* We were promised by the above while loop that there was
4059 something for us to read! */
4060 abort ();
4062 input_pending = readable_events (0);
4064 Vlast_event_frame = internal_last_event_frame;
4066 return (obj);
4069 /* Process any events that are not user-visible,
4070 then return, without reading any user-visible events. */
4072 void
4073 swallow_events (int do_display)
4075 int old_timers_run;
4077 while (kbd_fetch_ptr != kbd_store_ptr)
4079 struct input_event *event;
4081 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
4082 ? kbd_fetch_ptr
4083 : kbd_buffer);
4085 last_event_timestamp = event->timestamp;
4087 /* These two kinds of events get special handling
4088 and don't actually appear to the command loop. */
4089 if (event->kind == SELECTION_REQUEST_EVENT
4090 || event->kind == SELECTION_CLEAR_EVENT)
4092 #ifdef HAVE_X11
4093 struct input_event copy;
4095 /* Remove it from the buffer before processing it,
4096 since otherwise swallow_events called recursively could see it
4097 and process it again. */
4098 copy = *event;
4099 kbd_fetch_ptr = event + 1;
4100 input_pending = readable_events (0);
4101 x_handle_selection_event (&copy);
4102 #else
4103 /* We're getting selection request events, but we don't have
4104 a window system. */
4105 abort ();
4106 #endif
4108 else
4109 break;
4112 old_timers_run = timers_run;
4113 get_input_pending (&input_pending, READABLE_EVENTS_DO_TIMERS_NOW);
4115 if (timers_run != old_timers_run && do_display)
4116 redisplay_preserve_echo_area (7);
4119 /* Record the start of when Emacs is idle,
4120 for the sake of running idle-time timers. */
4122 static void
4123 timer_start_idle (void)
4125 Lisp_Object timers;
4127 /* If we are already in the idle state, do nothing. */
4128 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4129 return;
4131 EMACS_GET_TIME (timer_idleness_start_time);
4133 timer_last_idleness_start_time = timer_idleness_start_time;
4135 /* Mark all idle-time timers as once again candidates for running. */
4136 for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers))
4138 Lisp_Object timer;
4140 timer = XCAR (timers);
4142 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4143 continue;
4144 XVECTOR (timer)->contents[0] = Qnil;
4148 /* Record that Emacs is no longer idle, so stop running idle-time timers. */
4150 static void
4151 timer_stop_idle (void)
4153 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
4156 /* Resume idle timer from last idle start time. */
4158 static void
4159 timer_resume_idle (void)
4161 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4162 return;
4164 timer_idleness_start_time = timer_last_idleness_start_time;
4167 /* This is only for debugging. */
4168 struct input_event last_timer_event;
4170 /* List of elisp functions to call, delayed because they were generated in
4171 a context where Elisp could not be safely run (e.g. redisplay, signal,
4172 ...). Each element has the form (FUN . ARGS). */
4173 Lisp_Object pending_funcalls;
4175 /* Check whether a timer has fired. To prevent larger problems we simply
4176 disregard elements that are not proper timers. Do not make a circular
4177 timer list for the time being.
4179 Returns the time to wait until the next timer fires. If a
4180 timer is triggering now, return zero.
4181 If no timer is active, return -1.
4183 If a timer is ripe, we run it, with quitting turned off.
4184 In that case we return 0 to indicate that a new timer_check_2 call
4185 should be done. */
4187 static EMACS_TIME
4188 timer_check_2 (void)
4190 EMACS_TIME nexttime;
4191 EMACS_TIME now, idleness_now;
4192 Lisp_Object timers, idle_timers, chosen_timer;
4193 struct gcpro gcpro1, gcpro2, gcpro3;
4195 EMACS_SET_SECS (nexttime, -1);
4196 EMACS_SET_USECS (nexttime, -1);
4198 /* Always consider the ordinary timers. */
4199 timers = Vtimer_list;
4200 /* Consider the idle timers only if Emacs is idle. */
4201 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4202 idle_timers = Vtimer_idle_list;
4203 else
4204 idle_timers = Qnil;
4205 chosen_timer = Qnil;
4206 GCPRO3 (timers, idle_timers, chosen_timer);
4208 /* First run the code that was delayed. */
4209 while (CONSP (pending_funcalls))
4211 Lisp_Object funcall = XCAR (pending_funcalls);
4212 pending_funcalls = XCDR (pending_funcalls);
4213 safe_call2 (Qapply, XCAR (funcall), XCDR (funcall));
4216 if (CONSP (timers) || CONSP (idle_timers))
4218 EMACS_GET_TIME (now);
4219 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4220 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
4223 while (CONSP (timers) || CONSP (idle_timers))
4225 Lisp_Object *vector;
4226 Lisp_Object timer = Qnil, idle_timer = Qnil;
4227 EMACS_TIME timer_time, idle_timer_time;
4228 EMACS_TIME difference, timer_difference, idle_timer_difference;
4230 /* Skip past invalid timers and timers already handled. */
4231 if (!NILP (timers))
4233 timer = XCAR (timers);
4234 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4236 timers = XCDR (timers);
4237 continue;
4239 vector = XVECTOR (timer)->contents;
4241 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
4242 || !INTEGERP (vector[3])
4243 || ! NILP (vector[0]))
4245 timers = XCDR (timers);
4246 continue;
4249 if (!NILP (idle_timers))
4251 timer = XCAR (idle_timers);
4252 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
4254 idle_timers = XCDR (idle_timers);
4255 continue;
4257 vector = XVECTOR (timer)->contents;
4259 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
4260 || !INTEGERP (vector[3])
4261 || ! NILP (vector[0]))
4263 idle_timers = XCDR (idle_timers);
4264 continue;
4268 /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
4269 based on the next ordinary timer.
4270 TIMER_DIFFERENCE is the distance in time from NOW to when
4271 this timer becomes ripe (negative if it's already ripe). */
4272 if (!NILP (timers))
4274 timer = XCAR (timers);
4275 vector = XVECTOR (timer)->contents;
4276 EMACS_SET_SECS (timer_time,
4277 (XINT (vector[1]) << 16) | (XINT (vector[2])));
4278 EMACS_SET_USECS (timer_time, XINT (vector[3]));
4279 EMACS_SUB_TIME (timer_difference, timer_time, now);
4282 /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
4283 based on the next idle timer. */
4284 if (!NILP (idle_timers))
4286 idle_timer = XCAR (idle_timers);
4287 vector = XVECTOR (idle_timer)->contents;
4288 EMACS_SET_SECS (idle_timer_time,
4289 (XINT (vector[1]) << 16) | (XINT (vector[2])));
4290 EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
4291 EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
4294 /* Decide which timer is the next timer,
4295 and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
4296 Also step down the list where we found that timer. */
4298 if (! NILP (timers) && ! NILP (idle_timers))
4300 EMACS_TIME temp;
4301 EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
4302 if (EMACS_TIME_NEG_P (temp))
4304 chosen_timer = timer;
4305 timers = XCDR (timers);
4306 difference = timer_difference;
4308 else
4310 chosen_timer = idle_timer;
4311 idle_timers = XCDR (idle_timers);
4312 difference = idle_timer_difference;
4315 else if (! NILP (timers))
4317 chosen_timer = timer;
4318 timers = XCDR (timers);
4319 difference = timer_difference;
4321 else
4323 chosen_timer = idle_timer;
4324 idle_timers = XCDR (idle_timers);
4325 difference = idle_timer_difference;
4327 vector = XVECTOR (chosen_timer)->contents;
4329 /* If timer is ripe, run it if it hasn't been run. */
4330 if (EMACS_TIME_NEG_P (difference)
4331 || (EMACS_SECS (difference) == 0
4332 && EMACS_USECS (difference) == 0))
4334 if (NILP (vector[0]))
4336 int count = SPECPDL_INDEX ();
4337 Lisp_Object old_deactivate_mark = Vdeactivate_mark;
4339 /* Mark the timer as triggered to prevent problems if the lisp
4340 code fails to reschedule it right. */
4341 vector[0] = Qt;
4343 specbind (Qinhibit_quit, Qt);
4345 call1 (Qtimer_event_handler, chosen_timer);
4346 Vdeactivate_mark = old_deactivate_mark;
4347 timers_run++;
4348 unbind_to (count, Qnil);
4350 /* Since we have handled the event,
4351 we don't need to tell the caller to wake up and do it. */
4352 /* But the caller must still wait for the next timer, so
4353 return 0 to indicate that. */
4356 EMACS_SET_SECS (nexttime, 0);
4357 EMACS_SET_USECS (nexttime, 0);
4359 else
4360 /* When we encounter a timer that is still waiting,
4361 return the amount of time to wait before it is ripe. */
4363 UNGCPRO;
4364 return difference;
4368 /* No timers are pending in the future. */
4369 /* Return 0 if we generated an event, and -1 if not. */
4370 UNGCPRO;
4371 return nexttime;
4375 /* Check whether a timer has fired. To prevent larger problems we simply
4376 disregard elements that are not proper timers. Do not make a circular
4377 timer list for the time being.
4379 Returns the time to wait until the next timer fires.
4380 If no timer is active, return -1.
4382 As long as any timer is ripe, we run it. */
4384 EMACS_TIME
4385 timer_check (void)
4387 EMACS_TIME nexttime;
4391 nexttime = timer_check_2 ();
4393 while (EMACS_SECS (nexttime) == 0 && EMACS_USECS (nexttime) == 0);
4395 return nexttime;
4398 DEFUN ("current-idle-time", Fcurrent_idle_time, Scurrent_idle_time, 0, 0, 0,
4399 doc: /* Return the current length of Emacs idleness, or nil.
4400 The value when Emacs is idle is a list of three integers. The first has
4401 the most significant 16 bits of the seconds, while the second has the least
4402 significant 16 bits. The third integer gives the microsecond count.
4404 The value when Emacs is not idle is nil.
4406 The microsecond count is zero on systems that do not provide
4407 resolution finer than a second. */)
4408 (void)
4410 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
4412 EMACS_TIME now, idleness_now;
4414 EMACS_GET_TIME (now);
4415 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
4417 return list3 (make_number ((EMACS_SECS (idleness_now) >> 16) & 0xffff),
4418 make_number ((EMACS_SECS (idleness_now) >> 0) & 0xffff),
4419 make_number (EMACS_USECS (idleness_now)));
4422 return Qnil;
4425 /* Caches for modify_event_symbol. */
4426 static Lisp_Object accent_key_syms;
4427 static Lisp_Object func_key_syms;
4428 static Lisp_Object mouse_syms;
4429 static Lisp_Object wheel_syms;
4430 static Lisp_Object drag_n_drop_syms;
4432 /* This is a list of keysym codes for special "accent" characters.
4433 It parallels lispy_accent_keys. */
4435 static const int lispy_accent_codes[] =
4437 #ifdef XK_dead_circumflex
4438 XK_dead_circumflex,
4439 #else
4441 #endif
4442 #ifdef XK_dead_grave
4443 XK_dead_grave,
4444 #else
4446 #endif
4447 #ifdef XK_dead_tilde
4448 XK_dead_tilde,
4449 #else
4451 #endif
4452 #ifdef XK_dead_diaeresis
4453 XK_dead_diaeresis,
4454 #else
4456 #endif
4457 #ifdef XK_dead_macron
4458 XK_dead_macron,
4459 #else
4461 #endif
4462 #ifdef XK_dead_degree
4463 XK_dead_degree,
4464 #else
4466 #endif
4467 #ifdef XK_dead_acute
4468 XK_dead_acute,
4469 #else
4471 #endif
4472 #ifdef XK_dead_cedilla
4473 XK_dead_cedilla,
4474 #else
4476 #endif
4477 #ifdef XK_dead_breve
4478 XK_dead_breve,
4479 #else
4481 #endif
4482 #ifdef XK_dead_ogonek
4483 XK_dead_ogonek,
4484 #else
4486 #endif
4487 #ifdef XK_dead_caron
4488 XK_dead_caron,
4489 #else
4491 #endif
4492 #ifdef XK_dead_doubleacute
4493 XK_dead_doubleacute,
4494 #else
4496 #endif
4497 #ifdef XK_dead_abovedot
4498 XK_dead_abovedot,
4499 #else
4501 #endif
4502 #ifdef XK_dead_abovering
4503 XK_dead_abovering,
4504 #else
4506 #endif
4507 #ifdef XK_dead_iota
4508 XK_dead_iota,
4509 #else
4511 #endif
4512 #ifdef XK_dead_belowdot
4513 XK_dead_belowdot,
4514 #else
4516 #endif
4517 #ifdef XK_dead_voiced_sound
4518 XK_dead_voiced_sound,
4519 #else
4521 #endif
4522 #ifdef XK_dead_semivoiced_sound
4523 XK_dead_semivoiced_sound,
4524 #else
4526 #endif
4527 #ifdef XK_dead_hook
4528 XK_dead_hook,
4529 #else
4531 #endif
4532 #ifdef XK_dead_horn
4533 XK_dead_horn,
4534 #else
4536 #endif
4539 /* This is a list of Lisp names for special "accent" characters.
4540 It parallels lispy_accent_codes. */
4542 static const char *const lispy_accent_keys[] =
4544 "dead-circumflex",
4545 "dead-grave",
4546 "dead-tilde",
4547 "dead-diaeresis",
4548 "dead-macron",
4549 "dead-degree",
4550 "dead-acute",
4551 "dead-cedilla",
4552 "dead-breve",
4553 "dead-ogonek",
4554 "dead-caron",
4555 "dead-doubleacute",
4556 "dead-abovedot",
4557 "dead-abovering",
4558 "dead-iota",
4559 "dead-belowdot",
4560 "dead-voiced-sound",
4561 "dead-semivoiced-sound",
4562 "dead-hook",
4563 "dead-horn",
4566 #ifdef HAVE_NTGUI
4567 #define FUNCTION_KEY_OFFSET 0x0
4569 const char *const lispy_function_keys[] =
4571 0, /* 0 */
4573 0, /* VK_LBUTTON 0x01 */
4574 0, /* VK_RBUTTON 0x02 */
4575 "cancel", /* VK_CANCEL 0x03 */
4576 0, /* VK_MBUTTON 0x04 */
4578 0, 0, 0, /* 0x05 .. 0x07 */
4580 "backspace", /* VK_BACK 0x08 */
4581 "tab", /* VK_TAB 0x09 */
4583 0, 0, /* 0x0A .. 0x0B */
4585 "clear", /* VK_CLEAR 0x0C */
4586 "return", /* VK_RETURN 0x0D */
4588 0, 0, /* 0x0E .. 0x0F */
4590 0, /* VK_SHIFT 0x10 */
4591 0, /* VK_CONTROL 0x11 */
4592 0, /* VK_MENU 0x12 */
4593 "pause", /* VK_PAUSE 0x13 */
4594 "capslock", /* VK_CAPITAL 0x14 */
4595 "kana", /* VK_KANA/VK_HANGUL 0x15 */
4596 0, /* 0x16 */
4597 "junja", /* VK_JUNJA 0x17 */
4598 "final", /* VK_FINAL 0x18 */
4599 "kanji", /* VK_KANJI/VK_HANJA 0x19 */
4600 0, /* 0x1A */
4601 "escape", /* VK_ESCAPE 0x1B */
4602 "convert", /* VK_CONVERT 0x1C */
4603 "non-convert", /* VK_NONCONVERT 0x1D */
4604 "accept", /* VK_ACCEPT 0x1E */
4605 "mode-change", /* VK_MODECHANGE 0x1F */
4606 0, /* VK_SPACE 0x20 */
4607 "prior", /* VK_PRIOR 0x21 */
4608 "next", /* VK_NEXT 0x22 */
4609 "end", /* VK_END 0x23 */
4610 "home", /* VK_HOME 0x24 */
4611 "left", /* VK_LEFT 0x25 */
4612 "up", /* VK_UP 0x26 */
4613 "right", /* VK_RIGHT 0x27 */
4614 "down", /* VK_DOWN 0x28 */
4615 "select", /* VK_SELECT 0x29 */
4616 "print", /* VK_PRINT 0x2A */
4617 "execute", /* VK_EXECUTE 0x2B */
4618 "snapshot", /* VK_SNAPSHOT 0x2C */
4619 "insert", /* VK_INSERT 0x2D */
4620 "delete", /* VK_DELETE 0x2E */
4621 "help", /* VK_HELP 0x2F */
4623 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
4625 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4627 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
4629 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
4631 0, 0, 0, 0, 0, 0, 0, 0, 0,
4632 0, 0, 0, 0, 0, 0, 0, 0, 0,
4633 0, 0, 0, 0, 0, 0, 0, 0,
4635 "lwindow", /* VK_LWIN 0x5B */
4636 "rwindow", /* VK_RWIN 0x5C */
4637 "apps", /* VK_APPS 0x5D */
4638 0, /* 0x5E */
4639 "sleep",
4640 "kp-0", /* VK_NUMPAD0 0x60 */
4641 "kp-1", /* VK_NUMPAD1 0x61 */
4642 "kp-2", /* VK_NUMPAD2 0x62 */
4643 "kp-3", /* VK_NUMPAD3 0x63 */
4644 "kp-4", /* VK_NUMPAD4 0x64 */
4645 "kp-5", /* VK_NUMPAD5 0x65 */
4646 "kp-6", /* VK_NUMPAD6 0x66 */
4647 "kp-7", /* VK_NUMPAD7 0x67 */
4648 "kp-8", /* VK_NUMPAD8 0x68 */
4649 "kp-9", /* VK_NUMPAD9 0x69 */
4650 "kp-multiply", /* VK_MULTIPLY 0x6A */
4651 "kp-add", /* VK_ADD 0x6B */
4652 "kp-separator", /* VK_SEPARATOR 0x6C */
4653 "kp-subtract", /* VK_SUBTRACT 0x6D */
4654 "kp-decimal", /* VK_DECIMAL 0x6E */
4655 "kp-divide", /* VK_DIVIDE 0x6F */
4656 "f1", /* VK_F1 0x70 */
4657 "f2", /* VK_F2 0x71 */
4658 "f3", /* VK_F3 0x72 */
4659 "f4", /* VK_F4 0x73 */
4660 "f5", /* VK_F5 0x74 */
4661 "f6", /* VK_F6 0x75 */
4662 "f7", /* VK_F7 0x76 */
4663 "f8", /* VK_F8 0x77 */
4664 "f9", /* VK_F9 0x78 */
4665 "f10", /* VK_F10 0x79 */
4666 "f11", /* VK_F11 0x7A */
4667 "f12", /* VK_F12 0x7B */
4668 "f13", /* VK_F13 0x7C */
4669 "f14", /* VK_F14 0x7D */
4670 "f15", /* VK_F15 0x7E */
4671 "f16", /* VK_F16 0x7F */
4672 "f17", /* VK_F17 0x80 */
4673 "f18", /* VK_F18 0x81 */
4674 "f19", /* VK_F19 0x82 */
4675 "f20", /* VK_F20 0x83 */
4676 "f21", /* VK_F21 0x84 */
4677 "f22", /* VK_F22 0x85 */
4678 "f23", /* VK_F23 0x86 */
4679 "f24", /* VK_F24 0x87 */
4681 0, 0, 0, 0, /* 0x88 .. 0x8B */
4682 0, 0, 0, 0, /* 0x8C .. 0x8F */
4684 "kp-numlock", /* VK_NUMLOCK 0x90 */
4685 "scroll", /* VK_SCROLL 0x91 */
4686 /* Not sure where the following block comes from.
4687 Windows headers have NEC and Fujitsu specific keys in
4688 this block, but nothing generic. */
4689 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
4690 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
4691 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
4692 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
4693 "kp-end", /* VK_NUMPAD_END 0x96 */
4694 "kp-home", /* VK_NUMPAD_HOME 0x97 */
4695 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
4696 "kp-up", /* VK_NUMPAD_UP 0x99 */
4697 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
4698 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
4699 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
4700 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
4702 0, 0, /* 0x9E .. 0x9F */
4705 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
4706 * Used only as parameters to GetAsyncKeyState and GetKeyState.
4707 * No other API or message will distinguish left and right keys this way.
4708 * 0xA0 .. 0xA5
4710 0, 0, 0, 0, 0, 0,
4712 /* Multimedia keys. These are handled as WM_APPCOMMAND, which allows us
4713 to enable them selectively, and gives access to a few more functions.
4714 See lispy_multimedia_keys below. */
4715 0, 0, 0, 0, 0, 0, 0, /* 0xA6 .. 0xAC Browser */
4716 0, 0, 0, /* 0xAD .. 0xAF Volume */
4717 0, 0, 0, 0, /* 0xB0 .. 0xB3 Media */
4718 0, 0, 0, 0, /* 0xB4 .. 0xB7 Apps */
4720 /* 0xB8 .. 0xC0 "OEM" keys - all seem to be punctuation. */
4721 0, 0, 0, 0, 0, 0, 0, 0, 0,
4723 /* 0xC1 - 0xDA unallocated, 0xDB-0xDF more OEM keys */
4724 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4725 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4727 0, /* 0xE0 */
4728 "ax", /* VK_OEM_AX 0xE1 */
4729 0, /* VK_OEM_102 0xE2 */
4730 "ico-help", /* VK_ICO_HELP 0xE3 */
4731 "ico-00", /* VK_ICO_00 0xE4 */
4732 0, /* VK_PROCESSKEY 0xE5 - used by IME */
4733 "ico-clear", /* VK_ICO_CLEAR 0xE6 */
4734 0, /* VK_PACKET 0xE7 - used to pass unicode chars */
4735 0, /* 0xE8 */
4736 "reset", /* VK_OEM_RESET 0xE9 */
4737 "jump", /* VK_OEM_JUMP 0xEA */
4738 "oem-pa1", /* VK_OEM_PA1 0xEB */
4739 "oem-pa2", /* VK_OEM_PA2 0xEC */
4740 "oem-pa3", /* VK_OEM_PA3 0xED */
4741 "wsctrl", /* VK_OEM_WSCTRL 0xEE */
4742 "cusel", /* VK_OEM_CUSEL 0xEF */
4743 "oem-attn", /* VK_OEM_ATTN 0xF0 */
4744 "finish", /* VK_OEM_FINISH 0xF1 */
4745 "copy", /* VK_OEM_COPY 0xF2 */
4746 "auto", /* VK_OEM_AUTO 0xF3 */
4747 "enlw", /* VK_OEM_ENLW 0xF4 */
4748 "backtab", /* VK_OEM_BACKTAB 0xF5 */
4749 "attn", /* VK_ATTN 0xF6 */
4750 "crsel", /* VK_CRSEL 0xF7 */
4751 "exsel", /* VK_EXSEL 0xF8 */
4752 "ereof", /* VK_EREOF 0xF9 */
4753 "play", /* VK_PLAY 0xFA */
4754 "zoom", /* VK_ZOOM 0xFB */
4755 "noname", /* VK_NONAME 0xFC */
4756 "pa1", /* VK_PA1 0xFD */
4757 "oem_clear", /* VK_OEM_CLEAR 0xFE */
4758 0 /* 0xFF */
4761 /* Some of these duplicate the "Media keys" on newer keyboards,
4762 but they are delivered to the application in a different way. */
4763 static const char *const lispy_multimedia_keys[] =
4766 "browser-back",
4767 "browser-forward",
4768 "browser-refresh",
4769 "browser-stop",
4770 "browser-search",
4771 "browser-favorites",
4772 "browser-home",
4773 "volume-mute",
4774 "volume-down",
4775 "volume-up",
4776 "media-next",
4777 "media-previous",
4778 "media-stop",
4779 "media-play-pause",
4780 "mail",
4781 "media-select",
4782 "app-1",
4783 "app-2",
4784 "bass-down",
4785 "bass-boost",
4786 "bass-up",
4787 "treble-down",
4788 "treble-up",
4789 "mic-volume-mute",
4790 "mic-volume-down",
4791 "mic-volume-up",
4792 "help",
4793 "find",
4794 "new",
4795 "open",
4796 "close",
4797 "save",
4798 "print",
4799 "undo",
4800 "redo",
4801 "copy",
4802 "cut",
4803 "paste",
4804 "mail-reply",
4805 "mail-forward",
4806 "mail-send",
4807 "spell-check",
4808 "toggle-dictate-command",
4809 "mic-toggle",
4810 "correction-list",
4811 "media-play",
4812 "media-pause",
4813 "media-record",
4814 "media-fast-forward",
4815 "media-rewind",
4816 "media-channel-up",
4817 "media-channel-down"
4820 #else /* not HAVE_NTGUI */
4822 /* This should be dealt with in XTread_socket now, and that doesn't
4823 depend on the client system having the Kana syms defined. See also
4824 the XK_kana_A case below. */
4825 #if 0
4826 #ifdef XK_kana_A
4827 static const char *const lispy_kana_keys[] =
4829 /* X Keysym value */
4830 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */
4831 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x410 .. 0x41f */
4832 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x420 .. 0x42f */
4833 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x430 .. 0x43f */
4834 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x440 .. 0x44f */
4835 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x450 .. 0x45f */
4836 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x460 .. 0x46f */
4837 0,0,0,0,0,0,0,0,0,0,0,0,0,0,"overline",0,
4838 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x480 .. 0x48f */
4839 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x490 .. 0x49f */
4840 0, "kana-fullstop", "kana-openingbracket", "kana-closingbracket",
4841 "kana-comma", "kana-conjunctive", "kana-WO", "kana-a",
4842 "kana-i", "kana-u", "kana-e", "kana-o",
4843 "kana-ya", "kana-yu", "kana-yo", "kana-tsu",
4844 "prolongedsound", "kana-A", "kana-I", "kana-U",
4845 "kana-E", "kana-O", "kana-KA", "kana-KI",
4846 "kana-KU", "kana-KE", "kana-KO", "kana-SA",
4847 "kana-SHI", "kana-SU", "kana-SE", "kana-SO",
4848 "kana-TA", "kana-CHI", "kana-TSU", "kana-TE",
4849 "kana-TO", "kana-NA", "kana-NI", "kana-NU",
4850 "kana-NE", "kana-NO", "kana-HA", "kana-HI",
4851 "kana-FU", "kana-HE", "kana-HO", "kana-MA",
4852 "kana-MI", "kana-MU", "kana-ME", "kana-MO",
4853 "kana-YA", "kana-YU", "kana-YO", "kana-RA",
4854 "kana-RI", "kana-RU", "kana-RE", "kana-RO",
4855 "kana-WA", "kana-N", "voicedsound", "semivoicedsound",
4856 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4e0 .. 0x4ef */
4857 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x4f0 .. 0x4ff */
4859 #endif /* XK_kana_A */
4860 #endif /* 0 */
4862 #define FUNCTION_KEY_OFFSET 0xff00
4864 /* You'll notice that this table is arranged to be conveniently
4865 indexed by X Windows keysym values. */
4866 static const char *const lispy_function_keys[] =
4868 /* X Keysym value */
4870 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */
4871 "backspace", "tab", "linefeed", "clear",
4872 0, "return", 0, 0,
4873 0, 0, 0, "pause", /* 0xff10...1f */
4874 0, 0, 0, 0, 0, 0, 0, "escape",
4875 0, 0, 0, 0,
4876 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */
4877 "romaji", "hiragana", "katakana", "hiragana-katakana",
4878 "zenkaku", "hankaku", "zenkaku-hankaku", "touroku",
4879 "massyo", "kana-lock", "kana-shift", "eisu-shift",
4880 "eisu-toggle", /* 0xff30...3f */
4881 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4882 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
4884 "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */
4885 "down", "prior", "next", "end",
4886 "begin", 0, 0, 0, 0, 0, 0, 0,
4887 "select", /* 0xff60 */ /* IsMiscFunctionKey */
4888 "print",
4889 "execute",
4890 "insert",
4891 0, /* 0xff64 */
4892 "undo",
4893 "redo",
4894 "menu",
4895 "find",
4896 "cancel",
4897 "help",
4898 "break", /* 0xff6b */
4900 0, 0, 0, 0,
4901 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */
4902 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */
4903 "kp-space", /* 0xff80 */ /* IsKeypadKey */
4904 0, 0, 0, 0, 0, 0, 0, 0,
4905 "kp-tab", /* 0xff89 */
4906 0, 0, 0,
4907 "kp-enter", /* 0xff8d */
4908 0, 0, 0,
4909 "kp-f1", /* 0xff91 */
4910 "kp-f2",
4911 "kp-f3",
4912 "kp-f4",
4913 "kp-home", /* 0xff95 */
4914 "kp-left",
4915 "kp-up",
4916 "kp-right",
4917 "kp-down",
4918 "kp-prior", /* kp-page-up */
4919 "kp-next", /* kp-page-down */
4920 "kp-end",
4921 "kp-begin",
4922 "kp-insert",
4923 "kp-delete",
4924 0, /* 0xffa0 */
4925 0, 0, 0, 0, 0, 0, 0, 0, 0,
4926 "kp-multiply", /* 0xffaa */
4927 "kp-add",
4928 "kp-separator",
4929 "kp-subtract",
4930 "kp-decimal",
4931 "kp-divide", /* 0xffaf */
4932 "kp-0", /* 0xffb0 */
4933 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
4934 0, /* 0xffba */
4935 0, 0,
4936 "kp-equal", /* 0xffbd */
4937 "f1", /* 0xffbe */ /* IsFunctionKey */
4938 "f2",
4939 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
4940 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
4941 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
4942 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
4943 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
4944 0, 0, 0, 0, 0, 0, 0, 0,
4945 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
4946 0, 0, 0, 0, 0, 0, 0, "delete"
4949 /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */
4950 #define ISO_FUNCTION_KEY_OFFSET 0xfe00
4952 static const char *const iso_lispy_function_keys[] =
4954 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */
4955 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */
4956 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe10 */
4957 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe18 */
4958 "iso-lefttab", /* 0xfe20 */
4959 "iso-move-line-up", "iso-move-line-down",
4960 "iso-partial-line-up", "iso-partial-line-down",
4961 "iso-partial-space-left", "iso-partial-space-right",
4962 "iso-set-margin-left", "iso-set-margin-right", /* 0xffe27, 28 */
4963 "iso-release-margin-left", "iso-release-margin-right",
4964 "iso-release-both-margins",
4965 "iso-fast-cursor-left", "iso-fast-cursor-right",
4966 "iso-fast-cursor-up", "iso-fast-cursor-down",
4967 "iso-continuous-underline", "iso-discontinuous-underline", /* 0xfe30, 31 */
4968 "iso-emphasize", "iso-center-object", "iso-enter", /* ... 0xfe34 */
4971 #endif /* not HAVE_NTGUI */
4973 Lisp_Object Vlispy_mouse_stem;
4975 static const char *const lispy_wheel_names[] =
4977 "wheel-up", "wheel-down", "wheel-left", "wheel-right"
4980 /* drag-n-drop events are generated when a set of selected files are
4981 dragged from another application and dropped onto an Emacs window. */
4982 static const char *const lispy_drag_n_drop_names[] =
4984 "drag-n-drop"
4987 /* Scroll bar parts. */
4988 Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
4989 Lisp_Object Qup, Qdown, Qbottom, Qend_scroll;
4990 Lisp_Object Qtop, Qratio;
4992 /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
4993 static Lisp_Object *const scroll_bar_parts[] = {
4994 &Qabove_handle, &Qhandle, &Qbelow_handle,
4995 &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio
4998 /* A vector, indexed by button number, giving the down-going location
4999 of currently depressed buttons, both scroll bar and non-scroll bar.
5001 The elements have the form
5002 (BUTTON-NUMBER MODIFIER-MASK . REST)
5003 where REST is the cdr of a position as it would be reported in the event.
5005 The make_lispy_event function stores positions here to tell the
5006 difference between click and drag events, and to store the starting
5007 location to be included in drag events. */
5009 static Lisp_Object button_down_location;
5011 /* Information about the most recent up-going button event: Which
5012 button, what location, and what time. */
5014 static int last_mouse_button;
5015 static int last_mouse_x;
5016 static int last_mouse_y;
5017 static unsigned long button_down_time;
5019 /* The number of clicks in this multiple-click. */
5021 int double_click_count;
5023 /* X and Y are frame-relative coordinates for a click or wheel event.
5024 Return a Lisp-style event list. */
5026 static Lisp_Object
5027 make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
5028 unsigned long t)
5030 enum window_part part;
5031 Lisp_Object posn = Qnil;
5032 Lisp_Object extra_info = Qnil;
5033 /* Coordinate pixel positions to return. */
5034 int xret = 0, yret = 0;
5035 /* The window under frame pixel coordinates (x,y) */
5036 Lisp_Object window = f
5037 ? window_from_coordinates (f, XINT (x), XINT (y), &part, 0)
5038 : Qnil;
5040 if (WINDOWP (window))
5042 /* It's a click in window window at frame coordinates (x,y) */
5043 struct window *w = XWINDOW (window);
5044 Lisp_Object string_info = Qnil;
5045 EMACS_INT textpos = -1;
5046 int col = -1, row = -1;
5047 int dx = -1, dy = -1;
5048 int width = -1, height = -1;
5049 Lisp_Object object = Qnil;
5051 /* Pixel coordinates relative to the window corner. */
5052 int wx = XINT (x) - WINDOW_LEFT_EDGE_X (w);
5053 int wy = XINT (y) - WINDOW_TOP_EDGE_Y (w);
5055 /* For text area clicks, return X, Y relative to the corner of
5056 this text area. Note that dX, dY etc are set below, by
5057 buffer_posn_from_coords. */
5058 if (part == ON_TEXT)
5060 xret = XINT (x) - window_box_left (w, TEXT_AREA);
5061 yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5063 /* For mode line and header line clicks, return X, Y relative to
5064 the left window edge. Use mode_line_string to look for a
5065 string on the click position. */
5066 else if (part == ON_MODE_LINE || part == ON_HEADER_LINE)
5068 Lisp_Object string;
5069 EMACS_INT charpos;
5071 posn = (part == ON_MODE_LINE) ? Qmode_line : Qheader_line;
5072 /* Note that mode_line_string takes COL, ROW as pixels and
5073 converts them to characters. */
5074 col = wx;
5075 row = wy;
5076 string = mode_line_string (w, part, &col, &row, &charpos,
5077 &object, &dx, &dy, &width, &height);
5078 if (STRINGP (string))
5079 string_info = Fcons (string, make_number (charpos));
5080 textpos = (w == XWINDOW (selected_window)
5081 && current_buffer == XBUFFER (w->buffer))
5082 ? PT : XMARKER (w->pointm)->charpos;
5084 xret = wx;
5085 yret = wy;
5087 /* For fringes and margins, Y is relative to the area's (and the
5088 window's) top edge, while X is meaningless. */
5089 else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN)
5091 Lisp_Object string;
5092 EMACS_INT charpos;
5094 posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin;
5095 col = wx;
5096 row = wy;
5097 string = marginal_area_string (w, part, &col, &row, &charpos,
5098 &object, &dx, &dy, &width, &height);
5099 if (STRINGP (string))
5100 string_info = Fcons (string, make_number (charpos));
5101 yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5103 else if (part == ON_LEFT_FRINGE)
5105 posn = Qleft_fringe;
5106 col = 0;
5107 dx = wx
5108 - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5109 ? 0 : window_box_width (w, LEFT_MARGIN_AREA));
5110 dy = yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5112 else if (part == ON_RIGHT_FRINGE)
5114 posn = Qright_fringe;
5115 col = 0;
5116 dx = wx
5117 - window_box_width (w, LEFT_MARGIN_AREA)
5118 - window_box_width (w, TEXT_AREA)
5119 - (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
5120 ? window_box_width (w, RIGHT_MARGIN_AREA)
5121 : 0);
5122 dy = yret = wy - WINDOW_HEADER_LINE_HEIGHT (w);
5124 else if (part == ON_VERTICAL_BORDER)
5126 posn = Qvertical_line;
5127 width = 1;
5128 dx = 0;
5129 dy = yret = wy;
5131 /* Nothing special for part == ON_SCROLL_BAR. */
5133 /* For clicks in the text area, fringes, or margins, call
5134 buffer_posn_from_coords to extract TEXTPOS, the buffer
5135 position nearest to the click. */
5136 if (textpos < 0)
5138 Lisp_Object string2, object2 = Qnil;
5139 struct display_pos p;
5140 int dx2, dy2;
5141 int width2, height2;
5142 /* The pixel X coordinate passed to buffer_posn_from_coords
5143 is the X coordinate relative to the text area for
5144 text-area and right-margin clicks, zero otherwise. */
5145 int x2
5146 = (part == ON_TEXT) ? xret
5147 : (part == ON_RIGHT_FRINGE || part == ON_RIGHT_MARGIN)
5148 ? (XINT (x) - window_box_left (w, TEXT_AREA))
5149 : 0;
5150 int y2 = wy;
5152 string2 = buffer_posn_from_coords (w, &x2, &y2, &p,
5153 &object2, &dx2, &dy2,
5154 &width2, &height2);
5155 textpos = CHARPOS (p.pos);
5156 if (col < 0) col = x2;
5157 if (row < 0) row = y2;
5158 if (dx < 0) dx = dx2;
5159 if (dy < 0) dy = dy2;
5160 if (width < 0) width = width2;
5161 if (height < 0) height = height2;
5163 if (NILP (posn))
5165 posn = make_number (textpos);
5166 if (STRINGP (string2))
5167 string_info = Fcons (string2,
5168 make_number (CHARPOS (p.string_pos)));
5170 if (NILP (object))
5171 object = object2;
5174 #ifdef HAVE_WINDOW_SYSTEM
5175 if (IMAGEP (object))
5177 Lisp_Object image_map, hotspot;
5178 if ((image_map = Fplist_get (XCDR (object), QCmap),
5179 !NILP (image_map))
5180 && (hotspot = find_hot_spot (image_map, dx, dy),
5181 CONSP (hotspot))
5182 && (hotspot = XCDR (hotspot), CONSP (hotspot)))
5183 posn = XCAR (hotspot);
5185 #endif
5187 /* Object info */
5188 extra_info
5189 = list3 (object,
5190 Fcons (make_number (dx), make_number (dy)),
5191 Fcons (make_number (width), make_number (height)));
5193 /* String info */
5194 extra_info = Fcons (string_info,
5195 Fcons (make_number (textpos),
5196 Fcons (Fcons (make_number (col),
5197 make_number (row)),
5198 extra_info)));
5200 else if (f != 0)
5201 XSETFRAME (window, f);
5202 else
5203 window = Qnil;
5205 return Fcons (window,
5206 Fcons (posn,
5207 Fcons (Fcons (make_number (xret),
5208 make_number (yret)),
5209 Fcons (make_number (t),
5210 extra_info))));
5213 /* Given a struct input_event, build the lisp event which represents
5214 it. If EVENT is 0, build a mouse movement event from the mouse
5215 movement buffer, which should have a movement event in it.
5217 Note that events must be passed to this function in the order they
5218 are received; this function stores the location of button presses
5219 in order to build drag events when the button is released. */
5221 static Lisp_Object
5222 make_lispy_event (struct input_event *event)
5224 int i;
5226 switch (SWITCH_ENUM_CAST (event->kind))
5228 /* A simple keystroke. */
5229 case ASCII_KEYSTROKE_EVENT:
5230 case MULTIBYTE_CHAR_KEYSTROKE_EVENT:
5232 Lisp_Object lispy_c;
5233 EMACS_INT c = event->code;
5234 if (event->kind == ASCII_KEYSTROKE_EVENT)
5236 c &= 0377;
5237 eassert (c == event->code);
5238 /* Turn ASCII characters into control characters
5239 when proper. */
5240 if (event->modifiers & ctrl_modifier)
5242 c = make_ctrl_char (c);
5243 event->modifiers &= ~ctrl_modifier;
5247 /* Add in the other modifier bits. The shift key was taken care
5248 of by the X code. */
5249 c |= (event->modifiers
5250 & (meta_modifier | alt_modifier
5251 | hyper_modifier | super_modifier | ctrl_modifier));
5252 /* Distinguish Shift-SPC from SPC. */
5253 if ((event->code) == 040
5254 && event->modifiers & shift_modifier)
5255 c |= shift_modifier;
5256 button_down_time = 0;
5257 XSETFASTINT (lispy_c, c);
5258 return lispy_c;
5261 #ifdef HAVE_NS
5262 /* NS_NONKEY_EVENTs are just like NON_ASCII_KEYSTROKE_EVENTs,
5263 except that they are non-key events (last-nonmenu-event is nil). */
5264 case NS_NONKEY_EVENT:
5265 #endif
5267 /* A function key. The symbol may need to have modifier prefixes
5268 tacked onto it. */
5269 case NON_ASCII_KEYSTROKE_EVENT:
5270 button_down_time = 0;
5272 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
5273 if (event->code == lispy_accent_codes[i])
5274 return modify_event_symbol (i,
5275 event->modifiers,
5276 Qfunction_key, Qnil,
5277 lispy_accent_keys, &accent_key_syms,
5278 (sizeof (lispy_accent_keys)
5279 / sizeof (lispy_accent_keys[0])));
5281 #if 0
5282 #ifdef XK_kana_A
5283 if (event->code >= 0x400 && event->code < 0x500)
5284 return modify_event_symbol (event->code - 0x400,
5285 event->modifiers & ~shift_modifier,
5286 Qfunction_key, Qnil,
5287 lispy_kana_keys, &func_key_syms,
5288 (sizeof (lispy_kana_keys)
5289 / sizeof (lispy_kana_keys[0])));
5290 #endif /* XK_kana_A */
5291 #endif /* 0 */
5293 #ifdef ISO_FUNCTION_KEY_OFFSET
5294 if (event->code < FUNCTION_KEY_OFFSET
5295 && event->code >= ISO_FUNCTION_KEY_OFFSET)
5296 return modify_event_symbol (event->code - ISO_FUNCTION_KEY_OFFSET,
5297 event->modifiers,
5298 Qfunction_key, Qnil,
5299 iso_lispy_function_keys, &func_key_syms,
5300 (sizeof (iso_lispy_function_keys)
5301 / sizeof (iso_lispy_function_keys[0])));
5302 #endif
5304 /* Handle system-specific or unknown keysyms. */
5305 if (event->code & (1 << 28)
5306 || event->code - FUNCTION_KEY_OFFSET < 0
5307 || (event->code - FUNCTION_KEY_OFFSET
5308 >= sizeof lispy_function_keys / sizeof *lispy_function_keys)
5309 || !lispy_function_keys[event->code - FUNCTION_KEY_OFFSET])
5311 /* We need to use an alist rather than a vector as the cache
5312 since we can't make a vector long enuf. */
5313 if (NILP (KVAR (current_kboard, system_key_syms)))
5314 KVAR (current_kboard, system_key_syms) = Fcons (Qnil, Qnil);
5315 return modify_event_symbol (event->code,
5316 event->modifiers,
5317 Qfunction_key,
5318 KVAR (current_kboard, Vsystem_key_alist),
5319 0, &KVAR (current_kboard, system_key_syms),
5320 (unsigned) -1);
5323 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
5324 event->modifiers,
5325 Qfunction_key, Qnil,
5326 lispy_function_keys, &func_key_syms,
5327 (sizeof (lispy_function_keys)
5328 / sizeof (lispy_function_keys[0])));
5330 #ifdef WINDOWSNT
5331 case MULTIMEDIA_KEY_EVENT:
5332 if (event->code < (sizeof (lispy_multimedia_keys)
5333 / sizeof (lispy_multimedia_keys[0]))
5334 && event->code > 0 && lispy_multimedia_keys[event->code])
5336 return modify_event_symbol (event->code, event->modifiers,
5337 Qfunction_key, Qnil,
5338 lispy_multimedia_keys, &func_key_syms,
5339 (sizeof (lispy_multimedia_keys)
5340 / sizeof (lispy_multimedia_keys[0])));
5342 return Qnil;
5343 #endif
5345 #ifdef HAVE_MOUSE
5346 /* A mouse click. Figure out where it is, decide whether it's
5347 a press, click or drag, and build the appropriate structure. */
5348 case MOUSE_CLICK_EVENT:
5349 #ifndef USE_TOOLKIT_SCROLL_BARS
5350 case SCROLL_BAR_CLICK_EVENT:
5351 #endif
5353 int button = event->code;
5354 int is_double;
5355 Lisp_Object position;
5356 Lisp_Object *start_pos_ptr;
5357 Lisp_Object start_pos;
5359 position = Qnil;
5361 /* Build the position as appropriate for this mouse click. */
5362 if (event->kind == MOUSE_CLICK_EVENT)
5364 struct frame *f = XFRAME (event->frame_or_window);
5365 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) && ! defined (HAVE_NS)
5366 int row, column;
5367 #endif
5369 /* Ignore mouse events that were made on frame that
5370 have been deleted. */
5371 if (! FRAME_LIVE_P (f))
5372 return Qnil;
5374 #if ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK) && ! defined (HAVE_NS)
5375 /* EVENT->x and EVENT->y are frame-relative pixel
5376 coordinates at this place. Under old redisplay, COLUMN
5377 and ROW are set to frame relative glyph coordinates
5378 which are then used to determine whether this click is
5379 in a menu (non-toolkit version). */
5380 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
5381 &column, &row, NULL, 1);
5383 /* In the non-toolkit version, clicks on the menu bar
5384 are ordinary button events in the event buffer.
5385 Distinguish them, and invoke the menu.
5387 (In the toolkit version, the toolkit handles the menu bar
5388 and Emacs doesn't know about it until after the user
5389 makes a selection.) */
5390 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
5391 && (event->modifiers & down_modifier))
5393 Lisp_Object items, item;
5394 int i;
5396 /* Find the menu bar item under `column'. */
5397 item = Qnil;
5398 items = FRAME_MENU_BAR_ITEMS (f);
5399 for (i = 0; i < XVECTOR (items)->size; i += 4)
5401 Lisp_Object pos, string;
5402 string = AREF (items, i + 1);
5403 pos = AREF (items, i + 3);
5404 if (NILP (string))
5405 break;
5406 if (column >= XINT (pos)
5407 && column < XINT (pos) + SCHARS (string))
5409 item = AREF (items, i);
5410 break;
5414 /* ELisp manual 2.4b says (x y) are window relative but
5415 code says they are frame-relative. */
5416 position
5417 = Fcons (event->frame_or_window,
5418 Fcons (Qmenu_bar,
5419 Fcons (Fcons (event->x, event->y),
5420 Fcons (make_number (event->timestamp),
5421 Qnil))));
5423 return Fcons (item, Fcons (position, Qnil));
5425 #endif /* not USE_X_TOOLKIT && not USE_GTK && not HAVE_NS */
5427 position = make_lispy_position (f, event->x, event->y,
5428 event->timestamp);
5430 #ifndef USE_TOOLKIT_SCROLL_BARS
5431 else
5433 /* It's a scrollbar click. */
5434 Lisp_Object window;
5435 Lisp_Object portion_whole;
5436 Lisp_Object part;
5438 window = event->frame_or_window;
5439 portion_whole = Fcons (event->x, event->y);
5440 part = *scroll_bar_parts[(int) event->part];
5442 position
5443 = Fcons (window,
5444 Fcons (Qvertical_scroll_bar,
5445 Fcons (portion_whole,
5446 Fcons (make_number (event->timestamp),
5447 Fcons (part, Qnil)))));
5449 #endif /* not USE_TOOLKIT_SCROLL_BARS */
5451 if (button >= ASIZE (button_down_location))
5453 button_down_location = larger_vector (button_down_location,
5454 button + 1, Qnil);
5455 mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
5458 start_pos_ptr = &AREF (button_down_location, button);
5459 start_pos = *start_pos_ptr;
5460 *start_pos_ptr = Qnil;
5463 /* On window-system frames, use the value of
5464 double-click-fuzz as is. On other frames, interpret it
5465 as a multiple of 1/8 characters. */
5466 struct frame *f;
5467 int fuzz;
5469 if (WINDOWP (event->frame_or_window))
5470 f = XFRAME (XWINDOW (event->frame_or_window)->frame);
5471 else if (FRAMEP (event->frame_or_window))
5472 f = XFRAME (event->frame_or_window);
5473 else
5474 abort ();
5476 if (FRAME_WINDOW_P (f))
5477 fuzz = double_click_fuzz;
5478 else
5479 fuzz = double_click_fuzz / 8;
5481 is_double = (button == last_mouse_button
5482 && (eabs (XINT (event->x) - last_mouse_x) <= fuzz)
5483 && (eabs (XINT (event->y) - last_mouse_y) <= fuzz)
5484 && button_down_time != 0
5485 && (EQ (Vdouble_click_time, Qt)
5486 || (INTEGERP (Vdouble_click_time)
5487 && ((int)(event->timestamp - button_down_time)
5488 < XINT (Vdouble_click_time)))));
5491 last_mouse_button = button;
5492 last_mouse_x = XINT (event->x);
5493 last_mouse_y = XINT (event->y);
5495 /* If this is a button press, squirrel away the location, so
5496 we can decide later whether it was a click or a drag. */
5497 if (event->modifiers & down_modifier)
5499 if (is_double)
5501 double_click_count++;
5502 event->modifiers |= ((double_click_count > 2)
5503 ? triple_modifier
5504 : double_modifier);
5506 else
5507 double_click_count = 1;
5508 button_down_time = event->timestamp;
5509 *start_pos_ptr = Fcopy_alist (position);
5510 ignore_mouse_drag_p = 0;
5513 /* Now we're releasing a button - check the co-ordinates to
5514 see if this was a click or a drag. */
5515 else if (event->modifiers & up_modifier)
5517 /* If we did not see a down before this up, ignore the up.
5518 Probably this happened because the down event chose a
5519 menu item. It would be an annoyance to treat the
5520 release of the button that chose the menu item as a
5521 separate event. */
5523 if (!CONSP (start_pos))
5524 return Qnil;
5526 event->modifiers &= ~up_modifier;
5529 Lisp_Object new_down, down;
5530 EMACS_INT xdiff = double_click_fuzz, ydiff = double_click_fuzz;
5532 /* The third element of every position
5533 should be the (x,y) pair. */
5534 down = Fcar (Fcdr (Fcdr (start_pos)));
5535 new_down = Fcar (Fcdr (Fcdr (position)));
5537 if (CONSP (down)
5538 && INTEGERP (XCAR (down)) && INTEGERP (XCDR (down)))
5540 xdiff = XINT (XCAR (new_down)) - XINT (XCAR (down));
5541 ydiff = XINT (XCDR (new_down)) - XINT (XCDR (down));
5544 if (ignore_mouse_drag_p)
5546 event->modifiers |= click_modifier;
5547 ignore_mouse_drag_p = 0;
5549 else if (xdiff < double_click_fuzz && xdiff > - double_click_fuzz
5550 && ydiff < double_click_fuzz && ydiff > - double_click_fuzz
5551 /* Maybe the mouse has moved a lot, caused scrolling, and
5552 eventually ended up at the same screen position (but
5553 not buffer position) in which case it is a drag, not
5554 a click. */
5555 /* FIXME: OTOH if the buffer position has changed
5556 because of a timer or process filter rather than
5557 because of mouse movement, it should be considered as
5558 a click. But mouse-drag-region completely ignores
5559 this case and it hasn't caused any real problem, so
5560 it's probably OK to ignore it as well. */
5561 && EQ (Fcar (Fcdr (start_pos)), Fcar (Fcdr (position))))
5562 /* Mouse hasn't moved (much). */
5563 event->modifiers |= click_modifier;
5564 else
5566 button_down_time = 0;
5567 event->modifiers |= drag_modifier;
5570 /* Don't check is_double; treat this as multiple
5571 if the down-event was multiple. */
5572 if (double_click_count > 1)
5573 event->modifiers |= ((double_click_count > 2)
5574 ? triple_modifier
5575 : double_modifier);
5578 else
5579 /* Every mouse event should either have the down_modifier or
5580 the up_modifier set. */
5581 abort ();
5584 /* Get the symbol we should use for the mouse click. */
5585 Lisp_Object head;
5587 head = modify_event_symbol (button,
5588 event->modifiers,
5589 Qmouse_click, Vlispy_mouse_stem,
5590 NULL,
5591 &mouse_syms,
5592 XVECTOR (mouse_syms)->size);
5593 if (event->modifiers & drag_modifier)
5594 return Fcons (head,
5595 Fcons (start_pos,
5596 Fcons (position,
5597 Qnil)));
5598 else if (event->modifiers & (double_modifier | triple_modifier))
5599 return Fcons (head,
5600 Fcons (position,
5601 Fcons (make_number (double_click_count),
5602 Qnil)));
5603 else
5604 return Fcons (head,
5605 Fcons (position,
5606 Qnil));
5610 case WHEEL_EVENT:
5611 case HORIZ_WHEEL_EVENT:
5613 Lisp_Object position;
5614 Lisp_Object head;
5616 /* Build the position as appropriate for this mouse click. */
5617 struct frame *f = XFRAME (event->frame_or_window);
5619 /* Ignore wheel events that were made on frame that have been
5620 deleted. */
5621 if (! FRAME_LIVE_P (f))
5622 return Qnil;
5624 position = make_lispy_position (f, event->x, event->y,
5625 event->timestamp);
5627 /* Set double or triple modifiers to indicate the wheel speed. */
5629 /* On window-system frames, use the value of
5630 double-click-fuzz as is. On other frames, interpret it
5631 as a multiple of 1/8 characters. */
5632 struct frame *fr;
5633 int fuzz;
5634 int symbol_num;
5635 int is_double;
5637 if (WINDOWP (event->frame_or_window))
5638 fr = XFRAME (XWINDOW (event->frame_or_window)->frame);
5639 else if (FRAMEP (event->frame_or_window))
5640 fr = XFRAME (event->frame_or_window);
5641 else
5642 abort ();
5644 fuzz = FRAME_WINDOW_P (fr)
5645 ? double_click_fuzz : double_click_fuzz / 8;
5647 if (event->modifiers & up_modifier)
5649 /* Emit a wheel-up event. */
5650 event->modifiers &= ~up_modifier;
5651 symbol_num = 0;
5653 else if (event->modifiers & down_modifier)
5655 /* Emit a wheel-down event. */
5656 event->modifiers &= ~down_modifier;
5657 symbol_num = 1;
5659 else
5660 /* Every wheel event should either have the down_modifier or
5661 the up_modifier set. */
5662 abort ();
5664 if (event->kind == HORIZ_WHEEL_EVENT)
5665 symbol_num += 2;
5667 is_double = (last_mouse_button == - (1 + symbol_num)
5668 && (eabs (XINT (event->x) - last_mouse_x) <= fuzz)
5669 && (eabs (XINT (event->y) - last_mouse_y) <= fuzz)
5670 && button_down_time != 0
5671 && (EQ (Vdouble_click_time, Qt)
5672 || (INTEGERP (Vdouble_click_time)
5673 && ((int)(event->timestamp - button_down_time)
5674 < XINT (Vdouble_click_time)))));
5675 if (is_double)
5677 double_click_count++;
5678 event->modifiers |= ((double_click_count > 2)
5679 ? triple_modifier
5680 : double_modifier);
5682 else
5684 double_click_count = 1;
5685 event->modifiers |= click_modifier;
5688 button_down_time = event->timestamp;
5689 /* Use a negative value to distinguish wheel from mouse button. */
5690 last_mouse_button = - (1 + symbol_num);
5691 last_mouse_x = XINT (event->x);
5692 last_mouse_y = XINT (event->y);
5694 /* Get the symbol we should use for the wheel event. */
5695 head = modify_event_symbol (symbol_num,
5696 event->modifiers,
5697 Qmouse_click,
5698 Qnil,
5699 lispy_wheel_names,
5700 &wheel_syms,
5701 ASIZE (wheel_syms));
5704 if (event->modifiers & (double_modifier | triple_modifier))
5705 return Fcons (head,
5706 Fcons (position,
5707 Fcons (make_number (double_click_count),
5708 Qnil)));
5709 else
5710 return Fcons (head,
5711 Fcons (position,
5712 Qnil));
5716 #ifdef USE_TOOLKIT_SCROLL_BARS
5718 /* We don't have down and up events if using toolkit scroll bars,
5719 so make this always a click event. Store in the `part' of
5720 the Lisp event a symbol which maps to the following actions:
5722 `above_handle' page up
5723 `below_handle' page down
5724 `up' line up
5725 `down' line down
5726 `top' top of buffer
5727 `bottom' bottom of buffer
5728 `handle' thumb has been dragged.
5729 `end-scroll' end of interaction with scroll bar
5731 The incoming input_event contains in its `part' member an
5732 index of type `enum scroll_bar_part' which we can use as an
5733 index in scroll_bar_parts to get the appropriate symbol. */
5735 case SCROLL_BAR_CLICK_EVENT:
5737 Lisp_Object position, head, window, portion_whole, part;
5739 window = event->frame_or_window;
5740 portion_whole = Fcons (event->x, event->y);
5741 part = *scroll_bar_parts[(int) event->part];
5743 position
5744 = Fcons (window,
5745 Fcons (Qvertical_scroll_bar,
5746 Fcons (portion_whole,
5747 Fcons (make_number (event->timestamp),
5748 Fcons (part, Qnil)))));
5750 /* Always treat scroll bar events as clicks. */
5751 event->modifiers |= click_modifier;
5752 event->modifiers &= ~up_modifier;
5754 if (event->code >= ASIZE (mouse_syms))
5755 mouse_syms = larger_vector (mouse_syms, event->code + 1, Qnil);
5757 /* Get the symbol we should use for the mouse click. */
5758 head = modify_event_symbol (event->code,
5759 event->modifiers,
5760 Qmouse_click,
5761 Vlispy_mouse_stem,
5762 NULL, &mouse_syms,
5763 XVECTOR (mouse_syms)->size);
5764 return Fcons (head, Fcons (position, Qnil));
5767 #endif /* USE_TOOLKIT_SCROLL_BARS */
5769 case DRAG_N_DROP_EVENT:
5771 FRAME_PTR f;
5772 Lisp_Object head, position;
5773 Lisp_Object files;
5775 f = XFRAME (event->frame_or_window);
5776 files = event->arg;
5778 /* Ignore mouse events that were made on frames that
5779 have been deleted. */
5780 if (! FRAME_LIVE_P (f))
5781 return Qnil;
5783 position = make_lispy_position (f, event->x, event->y,
5784 event->timestamp);
5786 head = modify_event_symbol (0, event->modifiers,
5787 Qdrag_n_drop, Qnil,
5788 lispy_drag_n_drop_names,
5789 &drag_n_drop_syms, 1);
5790 return Fcons (head,
5791 Fcons (position,
5792 Fcons (files,
5793 Qnil)));
5795 #endif /* HAVE_MOUSE */
5797 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \
5798 || defined(HAVE_NS) || defined (USE_GTK)
5799 case MENU_BAR_EVENT:
5800 if (EQ (event->arg, event->frame_or_window))
5801 /* This is the prefix key. We translate this to
5802 `(menu_bar)' because the code in keyboard.c for menu
5803 events, which we use, relies on this. */
5804 return Fcons (Qmenu_bar, Qnil);
5805 return event->arg;
5806 #endif
5808 case SELECT_WINDOW_EVENT:
5809 /* Make an event (select-window (WINDOW)). */
5810 return Fcons (Qselect_window,
5811 Fcons (Fcons (event->frame_or_window, Qnil),
5812 Qnil));
5814 case TOOL_BAR_EVENT:
5815 if (EQ (event->arg, event->frame_or_window))
5816 /* This is the prefix key. We translate this to
5817 `(tool_bar)' because the code in keyboard.c for tool bar
5818 events, which we use, relies on this. */
5819 return Fcons (Qtool_bar, Qnil);
5820 else if (SYMBOLP (event->arg))
5821 return apply_modifiers (event->modifiers, event->arg);
5822 return event->arg;
5824 case USER_SIGNAL_EVENT:
5825 /* A user signal. */
5827 char *name = find_user_signal_name (event->code);
5828 if (!name)
5829 abort ();
5830 return intern (name);
5833 case SAVE_SESSION_EVENT:
5834 return Qsave_session;
5836 #ifdef HAVE_DBUS
5837 case DBUS_EVENT:
5839 return Fcons (Qdbus_event, event->arg);
5841 #endif /* HAVE_DBUS */
5843 case CONFIG_CHANGED_EVENT:
5844 return Fcons (Qconfig_changed_event,
5845 Fcons (event->arg,
5846 Fcons (event->frame_or_window, Qnil)));
5847 #ifdef HAVE_GPM
5848 case GPM_CLICK_EVENT:
5850 FRAME_PTR f = XFRAME (event->frame_or_window);
5851 Lisp_Object head, position;
5852 Lisp_Object *start_pos_ptr;
5853 Lisp_Object start_pos;
5854 int button = event->code;
5856 if (button >= ASIZE (button_down_location))
5858 button_down_location = larger_vector (button_down_location,
5859 button + 1, Qnil);
5860 mouse_syms = larger_vector (mouse_syms, button + 1, Qnil);
5863 start_pos_ptr = &AREF (button_down_location, button);
5864 start_pos = *start_pos_ptr;
5866 position = make_lispy_position (f, event->x, event->y,
5867 event->timestamp);
5869 if (event->modifiers & down_modifier)
5870 *start_pos_ptr = Fcopy_alist (position);
5871 else if (event->modifiers & (up_modifier | drag_modifier))
5873 if (!CONSP (start_pos))
5874 return Qnil;
5875 event->modifiers &= ~up_modifier;
5878 head = modify_event_symbol (button,
5879 event->modifiers,
5880 Qmouse_click, Vlispy_mouse_stem,
5881 NULL,
5882 &mouse_syms,
5883 XVECTOR (mouse_syms)->size);
5885 if (event->modifiers & drag_modifier)
5886 return Fcons (head,
5887 Fcons (start_pos,
5888 Fcons (position,
5889 Qnil)));
5890 else if (event->modifiers & double_modifier)
5891 return Fcons (head,
5892 Fcons (position,
5893 Fcons (make_number (2),
5894 Qnil)));
5895 else if (event->modifiers & triple_modifier)
5896 return Fcons (head,
5897 Fcons (position,
5898 Fcons (make_number (3),
5899 Qnil)));
5900 else
5901 return Fcons (head,
5902 Fcons (position,
5903 Qnil));
5905 #endif /* HAVE_GPM */
5907 /* The 'kind' field of the event is something we don't recognize. */
5908 default:
5909 abort ();
5913 #if defined(HAVE_MOUSE) || defined(HAVE_GPM)
5915 static Lisp_Object
5916 make_lispy_movement (FRAME_PTR frame, Lisp_Object bar_window, enum scroll_bar_part part,
5917 Lisp_Object x, Lisp_Object y, unsigned long t)
5919 /* Is it a scroll bar movement? */
5920 if (frame && ! NILP (bar_window))
5922 Lisp_Object part_sym;
5924 part_sym = *scroll_bar_parts[(int) part];
5925 return Fcons (Qscroll_bar_movement,
5926 Fcons (list5 (bar_window,
5927 Qvertical_scroll_bar,
5928 Fcons (x, y),
5929 make_number (t),
5930 part_sym),
5931 Qnil));
5933 /* Or is it an ordinary mouse movement? */
5934 else
5936 Lisp_Object position;
5937 position = make_lispy_position (frame, x, y, t);
5938 return list2 (Qmouse_movement, position);
5942 #endif /* HAVE_MOUSE || HAVE GPM */
5944 /* Construct a switch frame event. */
5945 static Lisp_Object
5946 make_lispy_switch_frame (Lisp_Object frame)
5948 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
5951 /* Manipulating modifiers. */
5953 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
5955 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
5956 SYMBOL's name of the end of the modifiers; the string from this
5957 position is the unmodified symbol name.
5959 This doesn't use any caches. */
5961 static int
5962 parse_modifiers_uncached (Lisp_Object symbol, EMACS_INT *modifier_end)
5964 Lisp_Object name;
5965 EMACS_INT i;
5966 int modifiers;
5968 CHECK_SYMBOL (symbol);
5970 modifiers = 0;
5971 name = SYMBOL_NAME (symbol);
5973 for (i = 0; i+2 <= SBYTES (name); )
5975 EMACS_INT this_mod_end = 0;
5976 int this_mod = 0;
5978 /* See if the name continues with a modifier word.
5979 Check that the word appears, but don't check what follows it.
5980 Set this_mod and this_mod_end to record what we find. */
5982 switch (SREF (name, i))
5984 #define SINGLE_LETTER_MOD(BIT) \
5985 (this_mod_end = i + 1, this_mod = BIT)
5987 case 'A':
5988 SINGLE_LETTER_MOD (alt_modifier);
5989 break;
5991 case 'C':
5992 SINGLE_LETTER_MOD (ctrl_modifier);
5993 break;
5995 case 'H':
5996 SINGLE_LETTER_MOD (hyper_modifier);
5997 break;
5999 case 'M':
6000 SINGLE_LETTER_MOD (meta_modifier);
6001 break;
6003 case 'S':
6004 SINGLE_LETTER_MOD (shift_modifier);
6005 break;
6007 case 's':
6008 SINGLE_LETTER_MOD (super_modifier);
6009 break;
6011 #undef SINGLE_LETTER_MOD
6013 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6014 if (i + LEN + 1 <= SBYTES (name) \
6015 && ! strncmp (SSDATA (name) + i, NAME, LEN)) \
6017 this_mod_end = i + LEN; \
6018 this_mod = BIT; \
6021 case 'd':
6022 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6023 MULTI_LETTER_MOD (down_modifier, "down", 4);
6024 MULTI_LETTER_MOD (double_modifier, "double", 6);
6025 break;
6027 case 't':
6028 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6029 break;
6030 #undef MULTI_LETTER_MOD
6034 /* If we found no modifier, stop looking for them. */
6035 if (this_mod_end == 0)
6036 break;
6038 /* Check there is a dash after the modifier, so that it
6039 really is a modifier. */
6040 if (this_mod_end >= SBYTES (name)
6041 || SREF (name, this_mod_end) != '-')
6042 break;
6044 /* This modifier is real; look for another. */
6045 modifiers |= this_mod;
6046 i = this_mod_end + 1;
6049 /* Should we include the `click' modifier? */
6050 if (! (modifiers & (down_modifier | drag_modifier
6051 | double_modifier | triple_modifier))
6052 && i + 7 == SBYTES (name)
6053 && strncmp (SSDATA (name) + i, "mouse-", 6) == 0
6054 && ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9'))
6055 modifiers |= click_modifier;
6057 if (! (modifiers & (double_modifier | triple_modifier))
6058 && i + 6 < SBYTES (name)
6059 && strncmp (SSDATA (name) + i, "wheel-", 6) == 0)
6060 modifiers |= click_modifier;
6062 if (modifier_end)
6063 *modifier_end = i;
6065 return modifiers;
6068 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
6069 prepended to the string BASE[0..BASE_LEN-1].
6070 This doesn't use any caches. */
6071 static Lisp_Object
6072 apply_modifiers_uncached (int modifiers, char *base, int base_len, int base_len_byte)
6074 /* Since BASE could contain nulls, we can't use intern here; we have
6075 to use Fintern, which expects a genuine Lisp_String, and keeps a
6076 reference to it. */
6077 char *new_mods
6078 = (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
6079 int mod_len;
6082 char *p = new_mods;
6084 /* Only the event queue may use the `up' modifier; it should always
6085 be turned into a click or drag event before presented to lisp code. */
6086 if (modifiers & up_modifier)
6087 abort ();
6089 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
6090 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
6091 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
6092 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
6093 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
6094 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
6095 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
6096 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
6097 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
6098 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
6099 /* The click modifier is denoted by the absence of other modifiers. */
6101 *p = '\0';
6103 mod_len = p - new_mods;
6107 Lisp_Object new_name;
6109 new_name = make_uninit_multibyte_string (mod_len + base_len,
6110 mod_len + base_len_byte);
6111 memcpy (SDATA (new_name), new_mods, mod_len);
6112 memcpy (SDATA (new_name) + mod_len, base, base_len_byte);
6114 return Fintern (new_name, Qnil);
6119 static const char *const modifier_names[] =
6121 "up", "down", "drag", "click", "double", "triple", 0, 0,
6122 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
6123 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
6125 #define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
6127 static Lisp_Object modifier_symbols;
6129 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
6130 static Lisp_Object
6131 lispy_modifier_list (int modifiers)
6133 Lisp_Object modifier_list;
6134 int i;
6136 modifier_list = Qnil;
6137 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
6138 if (modifiers & (1<<i))
6139 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
6140 modifier_list);
6142 return modifier_list;
6146 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
6147 where UNMODIFIED is the unmodified form of SYMBOL,
6148 MASK is the set of modifiers present in SYMBOL's name.
6149 This is similar to parse_modifiers_uncached, but uses the cache in
6150 SYMBOL's Qevent_symbol_element_mask property, and maintains the
6151 Qevent_symbol_elements property. */
6153 #define KEY_TO_CHAR(k) (XINT (k) & ((1 << CHARACTERBITS) - 1))
6155 Lisp_Object
6156 parse_modifiers (Lisp_Object symbol)
6158 Lisp_Object elements;
6160 if (INTEGERP (symbol))
6161 return (Fcons (make_number (KEY_TO_CHAR (symbol)),
6162 Fcons (make_number (XINT (symbol) & CHAR_MODIFIER_MASK),
6163 Qnil)));
6164 else if (!SYMBOLP (symbol))
6165 return Qnil;
6167 elements = Fget (symbol, Qevent_symbol_element_mask);
6168 if (CONSP (elements))
6169 return elements;
6170 else
6172 EMACS_INT end;
6173 int modifiers = parse_modifiers_uncached (symbol, &end);
6174 Lisp_Object unmodified;
6175 Lisp_Object mask;
6177 unmodified = Fintern (make_string (SSDATA (SYMBOL_NAME (symbol)) + end,
6178 SBYTES (SYMBOL_NAME (symbol)) - end),
6179 Qnil);
6181 if (modifiers & ~INTMASK)
6182 abort ();
6183 XSETFASTINT (mask, modifiers);
6184 elements = Fcons (unmodified, Fcons (mask, Qnil));
6186 /* Cache the parsing results on SYMBOL. */
6187 Fput (symbol, Qevent_symbol_element_mask,
6188 elements);
6189 Fput (symbol, Qevent_symbol_elements,
6190 Fcons (unmodified, lispy_modifier_list (modifiers)));
6192 /* Since we know that SYMBOL is modifiers applied to unmodified,
6193 it would be nice to put that in unmodified's cache.
6194 But we can't, since we're not sure that parse_modifiers is
6195 canonical. */
6197 return elements;
6201 DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,
6202 Sevent_symbol_parse_modifiers, 1, 1, 0,
6203 doc: /* Parse the event symbol. For internal use. */)
6204 (Lisp_Object symbol)
6206 /* Fill the cache if needed. */
6207 parse_modifiers (symbol);
6208 /* Ignore the result (which is stored on Qevent_symbol_element_mask)
6209 and use the Lispier representation stored on Qevent_symbol_elements
6210 instead. */
6211 return Fget (symbol, Qevent_symbol_elements);
6214 /* Apply the modifiers MODIFIERS to the symbol BASE.
6215 BASE must be unmodified.
6217 This is like apply_modifiers_uncached, but uses BASE's
6218 Qmodifier_cache property, if present. It also builds
6219 Qevent_symbol_elements properties, since it has that info anyway.
6221 apply_modifiers copies the value of BASE's Qevent_kind property to
6222 the modified symbol. */
6223 static Lisp_Object
6224 apply_modifiers (int modifiers, Lisp_Object base)
6226 Lisp_Object cache, idx, entry, new_symbol;
6228 /* Mask out upper bits. We don't know where this value's been. */
6229 modifiers &= INTMASK;
6231 if (INTEGERP (base))
6232 return make_number (XINT (base) | modifiers);
6234 /* The click modifier never figures into cache indices. */
6235 cache = Fget (base, Qmodifier_cache);
6236 XSETFASTINT (idx, (modifiers & ~click_modifier));
6237 entry = assq_no_quit (idx, cache);
6239 if (CONSP (entry))
6240 new_symbol = XCDR (entry);
6241 else
6243 /* We have to create the symbol ourselves. */
6244 new_symbol = apply_modifiers_uncached (modifiers,
6245 SSDATA (SYMBOL_NAME (base)),
6246 SCHARS (SYMBOL_NAME (base)),
6247 SBYTES (SYMBOL_NAME (base)));
6249 /* Add the new symbol to the base's cache. */
6250 entry = Fcons (idx, new_symbol);
6251 Fput (base, Qmodifier_cache, Fcons (entry, cache));
6253 /* We have the parsing info now for free, so we could add it to
6254 the caches:
6255 XSETFASTINT (idx, modifiers);
6256 Fput (new_symbol, Qevent_symbol_element_mask,
6257 Fcons (base, Fcons (idx, Qnil)));
6258 Fput (new_symbol, Qevent_symbol_elements,
6259 Fcons (base, lispy_modifier_list (modifiers)));
6260 Sadly, this is only correct if `base' is indeed a base event,
6261 which is not necessarily the case. -stef */
6264 /* Make sure this symbol is of the same kind as BASE.
6266 You'd think we could just set this once and for all when we
6267 intern the symbol above, but reorder_modifiers may call us when
6268 BASE's property isn't set right; we can't assume that just
6269 because it has a Qmodifier_cache property it must have its
6270 Qevent_kind set right as well. */
6271 if (NILP (Fget (new_symbol, Qevent_kind)))
6273 Lisp_Object kind;
6275 kind = Fget (base, Qevent_kind);
6276 if (! NILP (kind))
6277 Fput (new_symbol, Qevent_kind, kind);
6280 return new_symbol;
6284 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
6285 return a symbol with the modifiers placed in the canonical order.
6286 Canonical order is alphabetical, except for down and drag, which
6287 always come last. The 'click' modifier is never written out.
6289 Fdefine_key calls this to make sure that (for example) C-M-foo
6290 and M-C-foo end up being equivalent in the keymap. */
6292 Lisp_Object
6293 reorder_modifiers (Lisp_Object symbol)
6295 /* It's hopefully okay to write the code this way, since everything
6296 will soon be in caches, and no consing will be done at all. */
6297 Lisp_Object parsed;
6299 parsed = parse_modifiers (symbol);
6300 return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))),
6301 XCAR (parsed));
6305 /* For handling events, we often want to produce a symbol whose name
6306 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
6307 to some base, like the name of a function key or mouse button.
6308 modify_event_symbol produces symbols of this sort.
6310 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
6311 is the name of the i'th symbol. TABLE_SIZE is the number of elements
6312 in the table.
6314 Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes
6315 into symbol names, or a string specifying a name stem used to
6316 construct a symbol name or the form `STEM-N', where N is the decimal
6317 representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is
6318 non-nil; otherwise NAME_TABLE is used.
6320 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
6321 persist between calls to modify_event_symbol that it can use to
6322 store a cache of the symbols it's generated for this NAME_TABLE
6323 before. The object stored there may be a vector or an alist.
6325 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
6327 MODIFIERS is a set of modifier bits (as given in struct input_events)
6328 whose prefixes should be applied to the symbol name.
6330 SYMBOL_KIND is the value to be placed in the event_kind property of
6331 the returned symbol.
6333 The symbols we create are supposed to have an
6334 `event-symbol-elements' property, which lists the modifiers present
6335 in the symbol's name. */
6337 static Lisp_Object
6338 modify_event_symbol (EMACS_INT symbol_num, unsigned int modifiers, Lisp_Object symbol_kind,
6339 Lisp_Object name_alist_or_stem, const char *const *name_table,
6340 Lisp_Object *symbol_table, unsigned int table_size)
6342 Lisp_Object value;
6343 Lisp_Object symbol_int;
6345 /* Get rid of the "vendor-specific" bit here. */
6346 XSETINT (symbol_int, symbol_num & 0xffffff);
6348 /* Is this a request for a valid symbol? */
6349 if (symbol_num < 0 || symbol_num >= table_size)
6350 return Qnil;
6352 if (CONSP (*symbol_table))
6353 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
6355 /* If *symbol_table doesn't seem to be initialized properly, fix that.
6356 *symbol_table should be a lisp vector TABLE_SIZE elements long,
6357 where the Nth element is the symbol for NAME_TABLE[N], or nil if
6358 we've never used that symbol before. */
6359 else
6361 if (! VECTORP (*symbol_table)
6362 || XVECTOR (*symbol_table)->size != table_size)
6364 Lisp_Object size;
6366 XSETFASTINT (size, table_size);
6367 *symbol_table = Fmake_vector (size, Qnil);
6370 value = XVECTOR (*symbol_table)->contents[symbol_num];
6373 /* Have we already used this symbol before? */
6374 if (NILP (value))
6376 /* No; let's create it. */
6377 if (CONSP (name_alist_or_stem))
6378 value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem));
6379 else if (STRINGP (name_alist_or_stem))
6381 int len = SBYTES (name_alist_or_stem);
6382 char *buf = (char *) alloca (len + 50);
6383 sprintf (buf, "%s-%ld", SDATA (name_alist_or_stem),
6384 (long) XINT (symbol_int) + 1);
6385 value = intern (buf);
6387 else if (name_table != 0 && name_table[symbol_num])
6388 value = intern (name_table[symbol_num]);
6390 #ifdef HAVE_WINDOW_SYSTEM
6391 if (NILP (value))
6393 char *name = x_get_keysym_name (symbol_num);
6394 if (name)
6395 value = intern (name);
6397 #endif
6399 if (NILP (value))
6401 char buf[20];
6402 sprintf (buf, "key-%ld", (long)symbol_num);
6403 value = intern (buf);
6406 if (CONSP (*symbol_table))
6407 *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table);
6408 else
6409 XVECTOR (*symbol_table)->contents[symbol_num] = value;
6411 /* Fill in the cache entries for this symbol; this also
6412 builds the Qevent_symbol_elements property, which the user
6413 cares about. */
6414 apply_modifiers (modifiers & click_modifier, value);
6415 Fput (value, Qevent_kind, symbol_kind);
6418 /* Apply modifiers to that symbol. */
6419 return apply_modifiers (modifiers, value);
6422 /* Convert a list that represents an event type,
6423 such as (ctrl meta backspace), into the usual representation of that
6424 event type as a number or a symbol. */
6426 DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
6427 doc: /* Convert the event description list EVENT-DESC to an event type.
6428 EVENT-DESC should contain one base event type (a character or symbol)
6429 and zero or more modifier names (control, meta, hyper, super, shift, alt,
6430 drag, down, double or triple). The base must be last.
6431 The return value is an event type (a character or symbol) which
6432 has the same base event type and all the specified modifiers. */)
6433 (Lisp_Object event_desc)
6435 Lisp_Object base;
6436 int modifiers = 0;
6437 Lisp_Object rest;
6439 base = Qnil;
6440 rest = event_desc;
6441 while (CONSP (rest))
6443 Lisp_Object elt;
6444 int this = 0;
6446 elt = XCAR (rest);
6447 rest = XCDR (rest);
6449 /* Given a symbol, see if it is a modifier name. */
6450 if (SYMBOLP (elt) && CONSP (rest))
6451 this = parse_solitary_modifier (elt);
6453 if (this != 0)
6454 modifiers |= this;
6455 else if (!NILP (base))
6456 error ("Two bases given in one event");
6457 else
6458 base = elt;
6462 /* Let the symbol A refer to the character A. */
6463 if (SYMBOLP (base) && SCHARS (SYMBOL_NAME (base)) == 1)
6464 XSETINT (base, SREF (SYMBOL_NAME (base), 0));
6466 if (INTEGERP (base))
6468 /* Turn (shift a) into A. */
6469 if ((modifiers & shift_modifier) != 0
6470 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
6472 XSETINT (base, XINT (base) - ('a' - 'A'));
6473 modifiers &= ~shift_modifier;
6476 /* Turn (control a) into C-a. */
6477 if (modifiers & ctrl_modifier)
6478 return make_number ((modifiers & ~ctrl_modifier)
6479 | make_ctrl_char (XINT (base)));
6480 else
6481 return make_number (modifiers | XINT (base));
6483 else if (SYMBOLP (base))
6484 return apply_modifiers (modifiers, base);
6485 else
6487 error ("Invalid base event");
6488 return Qnil;
6492 /* Try to recognize SYMBOL as a modifier name.
6493 Return the modifier flag bit, or 0 if not recognized. */
6496 parse_solitary_modifier (Lisp_Object symbol)
6498 Lisp_Object name = SYMBOL_NAME (symbol);
6500 switch (SREF (name, 0))
6502 #define SINGLE_LETTER_MOD(BIT) \
6503 if (SBYTES (name) == 1) \
6504 return BIT;
6506 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
6507 if (LEN == SBYTES (name) \
6508 && ! strncmp (SSDATA (name), NAME, LEN)) \
6509 return BIT;
6511 case 'A':
6512 SINGLE_LETTER_MOD (alt_modifier);
6513 break;
6515 case 'a':
6516 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
6517 break;
6519 case 'C':
6520 SINGLE_LETTER_MOD (ctrl_modifier);
6521 break;
6523 case 'c':
6524 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
6525 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
6526 break;
6528 case 'H':
6529 SINGLE_LETTER_MOD (hyper_modifier);
6530 break;
6532 case 'h':
6533 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
6534 break;
6536 case 'M':
6537 SINGLE_LETTER_MOD (meta_modifier);
6538 break;
6540 case 'm':
6541 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
6542 break;
6544 case 'S':
6545 SINGLE_LETTER_MOD (shift_modifier);
6546 break;
6548 case 's':
6549 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
6550 MULTI_LETTER_MOD (super_modifier, "super", 5);
6551 SINGLE_LETTER_MOD (super_modifier);
6552 break;
6554 case 'd':
6555 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
6556 MULTI_LETTER_MOD (down_modifier, "down", 4);
6557 MULTI_LETTER_MOD (double_modifier, "double", 6);
6558 break;
6560 case 't':
6561 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
6562 break;
6564 #undef SINGLE_LETTER_MOD
6565 #undef MULTI_LETTER_MOD
6568 return 0;
6571 /* Return 1 if EVENT is a list whose elements are all integers or symbols.
6572 Such a list is not valid as an event,
6573 but it can be a Lucid-style event type list. */
6576 lucid_event_type_list_p (Lisp_Object object)
6578 Lisp_Object tail;
6580 if (! CONSP (object))
6581 return 0;
6583 if (EQ (XCAR (object), Qhelp_echo)
6584 || EQ (XCAR (object), Qvertical_line)
6585 || EQ (XCAR (object), Qmode_line)
6586 || EQ (XCAR (object), Qheader_line))
6587 return 0;
6589 for (tail = object; CONSP (tail); tail = XCDR (tail))
6591 Lisp_Object elt;
6592 elt = XCAR (tail);
6593 if (! (INTEGERP (elt) || SYMBOLP (elt)))
6594 return 0;
6597 return NILP (tail);
6600 /* Store into *addr a value nonzero if terminal input chars are available.
6601 Serves the purpose of ioctl (0, FIONREAD, addr)
6602 but works even if FIONREAD does not exist.
6603 (In fact, this may actually read some input.)
6605 If READABLE_EVENTS_DO_TIMERS_NOW is set in FLAGS, actually run
6606 timer events that are ripe.
6607 If READABLE_EVENTS_FILTER_EVENTS is set in FLAGS, ignore internal
6608 events (FOCUS_IN_EVENT).
6609 If READABLE_EVENTS_IGNORE_SQUEEZABLES is set in FLAGS, ignore mouse
6610 movements and toolkit scroll bar thumb drags. */
6612 static void
6613 get_input_pending (int *addr, int flags)
6615 /* First of all, have we already counted some input? */
6616 *addr = (!NILP (Vquit_flag) || readable_events (flags));
6618 /* If input is being read as it arrives, and we have none, there is none. */
6619 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
6620 return;
6622 /* Try to read some input and see how much we get. */
6623 gobble_input (0);
6624 *addr = (!NILP (Vquit_flag) || readable_events (flags));
6627 /* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
6629 void
6630 gobble_input (int expected)
6632 #ifdef SIGIO
6633 if (interrupt_input)
6635 SIGMASKTYPE mask;
6636 mask = sigblock (sigmask (SIGIO));
6637 read_avail_input (expected);
6638 sigsetmask (mask);
6640 else
6641 #ifdef POLL_FOR_INPUT
6642 /* XXX This condition was (read_socket_hook && !interrupt_input),
6643 but read_socket_hook is not global anymore. Let's pretend that
6644 it's always set. */
6645 if (!interrupt_input && poll_suppress_count == 0)
6647 SIGMASKTYPE mask;
6648 mask = sigblock (sigmask (SIGALRM));
6649 read_avail_input (expected);
6650 sigsetmask (mask);
6652 else
6653 #endif
6654 #endif
6655 read_avail_input (expected);
6658 /* Put a BUFFER_SWITCH_EVENT in the buffer
6659 so that read_key_sequence will notice the new current buffer. */
6661 void
6662 record_asynch_buffer_change (void)
6664 struct input_event event;
6665 Lisp_Object tem;
6666 EVENT_INIT (event);
6668 event.kind = BUFFER_SWITCH_EVENT;
6669 event.frame_or_window = Qnil;
6670 event.arg = Qnil;
6672 /* We don't need a buffer-switch event unless Emacs is waiting for input.
6673 The purpose of the event is to make read_key_sequence look up the
6674 keymaps again. If we aren't in read_key_sequence, we don't need one,
6675 and the event could cause trouble by messing up (input-pending-p).
6676 Note: Fwaiting_for_user_input_p always returns nil when async
6677 subprocesses aren't supported. */
6678 tem = Fwaiting_for_user_input_p ();
6679 if (NILP (tem))
6680 return;
6682 /* Make sure no interrupt happens while storing the event. */
6683 #ifdef SIGIO
6684 if (interrupt_input)
6686 SIGMASKTYPE mask;
6687 mask = sigblock (sigmask (SIGIO));
6688 kbd_buffer_store_event (&event);
6689 sigsetmask (mask);
6691 else
6692 #endif
6694 stop_polling ();
6695 kbd_buffer_store_event (&event);
6696 start_polling ();
6700 /* Read any terminal input already buffered up by the system
6701 into the kbd_buffer, but do not wait.
6703 EXPECTED should be nonzero if the caller knows there is some input.
6705 Returns the number of keyboard chars read, or -1 meaning
6706 this is a bad time to try to read input. */
6708 static int
6709 read_avail_input (int expected)
6711 int nread = 0;
6712 int err = 0;
6713 struct terminal *t;
6715 /* Store pending user signal events, if any. */
6716 if (store_user_signal_events ())
6717 expected = 0;
6719 /* Loop through the available terminals, and call their input hooks. */
6720 t = terminal_list;
6721 while (t)
6723 struct terminal *next = t->next_terminal;
6725 if (t->read_socket_hook)
6727 int nr;
6728 struct input_event hold_quit;
6730 EVENT_INIT (hold_quit);
6731 hold_quit.kind = NO_EVENT;
6733 /* No need for FIONREAD or fcntl; just say don't wait. */
6734 while (nr = (*t->read_socket_hook) (t, expected, &hold_quit), nr > 0)
6736 nread += nr;
6737 expected = 0;
6740 if (nr == -1) /* Not OK to read input now. */
6742 err = 1;
6744 else if (nr == -2) /* Non-transient error. */
6746 /* The terminal device terminated; it should be closed. */
6748 /* Kill Emacs if this was our last terminal. */
6749 if (!terminal_list->next_terminal)
6750 /* Formerly simply reported no input, but that
6751 sometimes led to a failure of Emacs to terminate.
6752 SIGHUP seems appropriate if we can't reach the
6753 terminal. */
6754 /* ??? Is it really right to send the signal just to
6755 this process rather than to the whole process
6756 group? Perhaps on systems with FIONREAD Emacs is
6757 alone in its group. */
6758 kill (getpid (), SIGHUP);
6760 /* XXX Is calling delete_terminal safe here? It calls delete_frame. */
6762 Lisp_Object tmp;
6763 XSETTERMINAL (tmp, t);
6764 Fdelete_terminal (tmp, Qnoelisp);
6768 if (hold_quit.kind != NO_EVENT)
6769 kbd_buffer_store_event (&hold_quit);
6772 t = next;
6775 if (err && !nread)
6776 nread = -1;
6778 frame_make_pointer_visible ();
6780 return nread;
6783 static void
6784 decode_keyboard_code (struct tty_display_info *tty,
6785 struct coding_system *coding,
6786 unsigned char *buf, int nbytes)
6788 unsigned char *src = buf;
6789 const unsigned char *p;
6790 int i;
6792 if (nbytes == 0)
6793 return;
6794 if (tty->meta_key != 2)
6795 for (i = 0; i < nbytes; i++)
6796 buf[i] &= ~0x80;
6797 if (coding->carryover_bytes > 0)
6799 src = alloca (coding->carryover_bytes + nbytes);
6800 memcpy (src, coding->carryover, coding->carryover_bytes);
6801 memcpy (src + coding->carryover_bytes, buf, nbytes);
6802 nbytes += coding->carryover_bytes;
6804 coding->destination = alloca (nbytes * 4);
6805 coding->dst_bytes = nbytes * 4;
6806 decode_coding_c_string (coding, src, nbytes, Qnil);
6807 if (coding->produced_char == 0)
6808 return;
6809 for (i = 0, p = coding->destination; i < coding->produced_char; i++)
6811 struct input_event event_buf;
6813 EVENT_INIT (event_buf);
6814 event_buf.code = STRING_CHAR_ADVANCE (p);
6815 event_buf.kind =
6816 (ASCII_CHAR_P (event_buf.code)
6817 ? ASCII_KEYSTROKE_EVENT : MULTIBYTE_CHAR_KEYSTROKE_EVENT);
6818 /* See the comment in tty_read_avail_input. */
6819 event_buf.frame_or_window = tty->top_frame;
6820 event_buf.arg = Qnil;
6821 kbd_buffer_store_event (&event_buf);
6825 /* This is the tty way of reading available input.
6827 Note that each terminal device has its own `struct terminal' object,
6828 and so this function is called once for each individual termcap
6829 terminal. The first parameter indicates which terminal to read from. */
6832 tty_read_avail_input (struct terminal *terminal,
6833 int expected,
6834 struct input_event *hold_quit)
6836 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
6837 the kbd_buffer can really hold. That may prevent loss
6838 of characters on some systems when input is stuffed at us. */
6839 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
6840 int n_to_read, i;
6841 struct tty_display_info *tty = terminal->display_info.tty;
6842 int nread = 0;
6843 #ifdef subprocesses
6844 int buffer_free = KBD_BUFFER_SIZE - kbd_buffer_nr_stored () - 1;
6846 if (kbd_on_hold_p () || buffer_free <= 0)
6847 return 0;
6848 #endif /* subprocesses */
6850 if (!terminal->name) /* Don't read from a dead terminal. */
6851 return 0;
6853 if (terminal->type != output_termcap
6854 && terminal->type != output_msdos_raw)
6855 abort ();
6857 /* XXX I think the following code should be moved to separate hook
6858 functions in system-dependent files. */
6859 #ifdef WINDOWSNT
6860 return 0;
6861 #else /* not WINDOWSNT */
6862 if (! tty->term_initted) /* In case we get called during bootstrap. */
6863 return 0;
6865 if (! tty->input)
6866 return 0; /* The terminal is suspended. */
6868 #ifdef MSDOS
6869 n_to_read = dos_keysns ();
6870 if (n_to_read == 0)
6871 return 0;
6873 cbuf[0] = dos_keyread ();
6874 nread = 1;
6876 #else /* not MSDOS */
6877 #ifdef HAVE_GPM
6878 if (gpm_tty == tty)
6880 Gpm_Event event;
6881 struct input_event gpm_hold_quit;
6882 int gpm, fd = gpm_fd;
6884 EVENT_INIT (gpm_hold_quit);
6885 gpm_hold_quit.kind = NO_EVENT;
6887 /* gpm==1 if event received.
6888 gpm==0 if the GPM daemon has closed the connection, in which case
6889 Gpm_GetEvent closes gpm_fd and clears it to -1, which is why
6890 we save it in `fd' so close_gpm can remove it from the
6891 select masks.
6892 gpm==-1 if a protocol error or EWOULDBLOCK; the latter is normal. */
6893 while (gpm = Gpm_GetEvent (&event), gpm == 1) {
6894 nread += handle_one_term_event (tty, &event, &gpm_hold_quit);
6896 if (gpm == 0)
6897 /* Presumably the GPM daemon has closed the connection. */
6898 close_gpm (fd);
6899 if (gpm_hold_quit.kind != NO_EVENT)
6900 kbd_buffer_store_event (&gpm_hold_quit);
6901 if (nread)
6902 return nread;
6904 #endif /* HAVE_GPM */
6906 /* Determine how many characters we should *try* to read. */
6907 #ifdef FIONREAD
6908 /* Find out how much input is available. */
6909 if (ioctl (fileno (tty->input), FIONREAD, &n_to_read) < 0)
6911 if (! noninteractive)
6912 return -2; /* Close this terminal. */
6913 else
6914 n_to_read = 0;
6916 if (n_to_read == 0)
6917 return 0;
6918 if (n_to_read > sizeof cbuf)
6919 n_to_read = sizeof cbuf;
6920 #else /* no FIONREAD */
6921 #if defined (USG) || defined(CYGWIN)
6922 /* Read some input if available, but don't wait. */
6923 n_to_read = sizeof cbuf;
6924 fcntl (fileno (tty->input), F_SETFL, O_NDELAY);
6925 #else
6926 you lose;
6927 #endif
6928 #endif
6930 #ifdef subprocesses
6931 /* Don't read more than we can store. */
6932 if (n_to_read > buffer_free)
6933 n_to_read = buffer_free;
6934 #endif /* subprocesses */
6936 /* Now read; for one reason or another, this will not block.
6937 NREAD is set to the number of chars read. */
6940 nread = emacs_read (fileno (tty->input), (char *) cbuf, n_to_read);
6941 /* POSIX infers that processes which are not in the session leader's
6942 process group won't get SIGHUP's at logout time. BSDI adheres to
6943 this part standard and returns -1 from read (0) with errno==EIO
6944 when the control tty is taken away.
6945 Jeffrey Honig <jch@bsdi.com> says this is generally safe. */
6946 if (nread == -1 && errno == EIO)
6947 return -2; /* Close this terminal. */
6948 #if defined (AIX) && defined (_BSD)
6949 /* The kernel sometimes fails to deliver SIGHUP for ptys.
6950 This looks incorrect, but it isn't, because _BSD causes
6951 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
6952 and that causes a value other than 0 when there is no input. */
6953 if (nread == 0)
6954 return -2; /* Close this terminal. */
6955 #endif
6957 while (
6958 /* We used to retry the read if it was interrupted.
6959 But this does the wrong thing when O_NDELAY causes
6960 an EAGAIN error. Does anybody know of a situation
6961 where a retry is actually needed? */
6962 #if 0
6963 nread < 0 && (errno == EAGAIN
6964 #ifdef EFAULT
6965 || errno == EFAULT
6966 #endif
6967 #ifdef EBADSLT
6968 || errno == EBADSLT
6969 #endif
6971 #else
6973 #endif
6976 #ifndef FIONREAD
6977 #if defined (USG) || defined (CYGWIN)
6978 fcntl (fileno (tty->input), F_SETFL, 0);
6979 #endif /* USG or CYGWIN */
6980 #endif /* no FIONREAD */
6982 if (nread <= 0)
6983 return nread;
6985 #endif /* not MSDOS */
6986 #endif /* not WINDOWSNT */
6988 if (TERMINAL_KEYBOARD_CODING (terminal)->common_flags
6989 & CODING_REQUIRE_DECODING_MASK)
6991 struct coding_system *coding = TERMINAL_KEYBOARD_CODING (terminal);
6992 int from;
6994 /* Decode the key sequence except for those with meta
6995 modifiers. */
6996 for (i = from = 0; ; i++)
6997 if (i == nread || (tty->meta_key == 1 && (cbuf[i] & 0x80)))
6999 struct input_event buf;
7001 decode_keyboard_code (tty, coding, cbuf + from, i - from);
7002 if (i == nread)
7003 break;
7005 EVENT_INIT (buf);
7006 buf.kind = ASCII_KEYSTROKE_EVENT;
7007 buf.modifiers = meta_modifier;
7008 buf.code = cbuf[i] & ~0x80;
7009 /* See the comment below. */
7010 buf.frame_or_window = tty->top_frame;
7011 buf.arg = Qnil;
7012 kbd_buffer_store_event (&buf);
7013 from = i + 1;
7015 return nread;
7018 for (i = 0; i < nread; i++)
7020 struct input_event buf;
7021 EVENT_INIT (buf);
7022 buf.kind = ASCII_KEYSTROKE_EVENT;
7023 buf.modifiers = 0;
7024 if (tty->meta_key == 1 && (cbuf[i] & 0x80))
7025 buf.modifiers = meta_modifier;
7026 if (tty->meta_key != 2)
7027 cbuf[i] &= ~0x80;
7029 buf.code = cbuf[i];
7030 /* Set the frame corresponding to the active tty. Note that the
7031 value of selected_frame is not reliable here, redisplay tends
7032 to temporarily change it. */
7033 buf.frame_or_window = tty->top_frame;
7034 buf.arg = Qnil;
7036 kbd_buffer_store_event (&buf);
7037 /* Don't look at input that follows a C-g too closely.
7038 This reduces lossage due to autorepeat on C-g. */
7039 if (buf.kind == ASCII_KEYSTROKE_EVENT
7040 && buf.code == quit_char)
7041 break;
7044 return nread;
7047 static void
7048 handle_async_input (void)
7050 interrupt_input_pending = 0;
7051 #ifdef SYNC_INPUT
7052 pending_signals = pending_atimers;
7053 #endif
7054 /* Tell ns_read_socket() it is being called asynchronously so it can avoid
7055 doing anything dangerous. */
7056 #ifdef HAVE_NS
7057 ++handling_signal;
7058 #endif
7059 while (1)
7061 int nread;
7062 nread = read_avail_input (1);
7063 /* -1 means it's not ok to read the input now.
7064 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
7065 0 means there was no keyboard input available. */
7066 if (nread <= 0)
7067 break;
7069 #ifdef HAVE_NS
7070 --handling_signal;
7071 #endif
7074 void
7075 process_pending_signals (void)
7077 if (interrupt_input_pending)
7078 handle_async_input ();
7079 do_pending_atimers ();
7082 #ifdef SIGIO /* for entire page */
7083 /* Note SIGIO has been undef'd if FIONREAD is missing. */
7085 static void
7086 input_available_signal (int signo)
7088 /* Must preserve main program's value of errno. */
7089 int old_errno = errno;
7090 SIGNAL_THREAD_CHECK (signo);
7092 #ifdef SYNC_INPUT
7093 interrupt_input_pending = 1;
7094 pending_signals = 1;
7095 #endif
7097 if (input_available_clear_time)
7098 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
7100 #ifndef SYNC_INPUT
7101 handle_async_input ();
7102 #endif
7104 errno = old_errno;
7106 #endif /* SIGIO */
7108 /* Send ourselves a SIGIO.
7110 This function exists so that the UNBLOCK_INPUT macro in
7111 blockinput.h can have some way to take care of input we put off
7112 dealing with, without assuming that every file which uses
7113 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
7114 void
7115 reinvoke_input_signal (void)
7117 #ifdef SIGIO
7118 handle_async_input ();
7119 #endif
7124 /* User signal events. */
7126 struct user_signal_info
7128 /* Signal number. */
7129 int sig;
7131 /* Name of the signal. */
7132 char *name;
7134 /* Number of pending signals. */
7135 int npending;
7137 struct user_signal_info *next;
7140 /* List of user signals. */
7141 static struct user_signal_info *user_signals = NULL;
7143 void
7144 add_user_signal (int sig, const char *name)
7146 struct user_signal_info *p;
7148 for (p = user_signals; p; p = p->next)
7149 if (p->sig == sig)
7150 /* Already added. */
7151 return;
7153 p = xmalloc (sizeof (struct user_signal_info));
7154 p->sig = sig;
7155 p->name = xstrdup (name);
7156 p->npending = 0;
7157 p->next = user_signals;
7158 user_signals = p;
7160 signal (sig, handle_user_signal);
7163 static void
7164 handle_user_signal (int sig)
7166 int old_errno = errno;
7167 struct user_signal_info *p;
7169 SIGNAL_THREAD_CHECK (sig);
7171 for (p = user_signals; p; p = p->next)
7172 if (p->sig == sig)
7174 p->npending++;
7175 #ifdef SIGIO
7176 if (interrupt_input)
7177 kill (getpid (), SIGIO);
7178 else
7179 #endif
7181 /* Tell wait_reading_process_output that it needs to wake
7182 up and look around. */
7183 if (input_available_clear_time)
7184 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
7186 break;
7189 errno = old_errno;
7192 static char *
7193 find_user_signal_name (int sig)
7195 struct user_signal_info *p;
7197 for (p = user_signals; p; p = p->next)
7198 if (p->sig == sig)
7199 return p->name;
7201 return NULL;
7204 static int
7205 store_user_signal_events (void)
7207 struct user_signal_info *p;
7208 struct input_event buf;
7209 int nstored = 0;
7211 for (p = user_signals; p; p = p->next)
7212 if (p->npending > 0)
7214 SIGMASKTYPE mask;
7216 if (nstored == 0)
7218 memset (&buf, 0, sizeof buf);
7219 buf.kind = USER_SIGNAL_EVENT;
7220 buf.frame_or_window = selected_frame;
7222 nstored += p->npending;
7224 mask = sigblock (sigmask (p->sig));
7227 buf.code = p->sig;
7228 kbd_buffer_store_event (&buf);
7229 p->npending--;
7231 while (p->npending > 0);
7232 sigsetmask (mask);
7235 return nstored;
7239 static void menu_bar_item (Lisp_Object, Lisp_Object, Lisp_Object, void*);
7240 static Lisp_Object menu_bar_one_keymap_changed_items;
7242 /* These variables hold the vector under construction within
7243 menu_bar_items and its subroutines, and the current index
7244 for storing into that vector. */
7245 static Lisp_Object menu_bar_items_vector;
7246 static int menu_bar_items_index;
7249 static const char* separator_names[] = {
7250 "space",
7251 "no-line",
7252 "single-line",
7253 "double-line",
7254 "single-dashed-line",
7255 "double-dashed-line",
7256 "shadow-etched-in",
7257 "shadow-etched-out",
7258 "shadow-etched-in-dash",
7259 "shadow-etched-out-dash",
7260 "shadow-double-etched-in",
7261 "shadow-double-etched-out",
7262 "shadow-double-etched-in-dash",
7263 "shadow-double-etched-out-dash",
7267 /* Return non-zero if LABEL specifies a separator. */
7270 menu_separator_name_p (const char *label)
7272 if (!label)
7273 return 0;
7274 else if (strlen (label) > 3
7275 && strncmp (label, "--", 2) == 0
7276 && label[2] != '-')
7278 int i;
7279 label += 2;
7280 for (i = 0; separator_names[i]; ++i)
7281 if (strcmp (label, separator_names[i]) == 0)
7282 return 1;
7284 else
7286 /* It's a separator if it contains only dashes. */
7287 while (*label == '-')
7288 ++label;
7289 return (*label == 0);
7292 return 0;
7296 /* Return a vector of menu items for a menu bar, appropriate
7297 to the current buffer. Each item has three elements in the vector:
7298 KEY STRING MAPLIST.
7300 OLD is an old vector we can optionally reuse, or nil. */
7302 Lisp_Object
7303 menu_bar_items (Lisp_Object old)
7305 /* The number of keymaps we're scanning right now, and the number of
7306 keymaps we have allocated space for. */
7307 int nmaps;
7309 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
7310 in the current keymaps, or nil where it is not a prefix. */
7311 Lisp_Object *maps;
7313 Lisp_Object def, tail;
7315 Lisp_Object result;
7317 int mapno;
7318 Lisp_Object oquit;
7320 /* In order to build the menus, we need to call the keymap
7321 accessors. They all call QUIT. But this function is called
7322 during redisplay, during which a quit is fatal. So inhibit
7323 quitting while building the menus.
7324 We do this instead of specbind because (1) errors will clear it anyway
7325 and (2) this avoids risk of specpdl overflow. */
7326 oquit = Vinhibit_quit;
7327 Vinhibit_quit = Qt;
7329 if (!NILP (old))
7330 menu_bar_items_vector = old;
7331 else
7332 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
7333 menu_bar_items_index = 0;
7335 /* Build our list of keymaps.
7336 If we recognize a function key and replace its escape sequence in
7337 keybuf with its symbol, or if the sequence starts with a mouse
7338 click and we need to switch buffers, we jump back here to rebuild
7339 the initial keymaps from the current buffer. */
7341 Lisp_Object *tmaps;
7343 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7344 if (!NILP (Voverriding_local_map_menu_flag))
7346 /* Yes, use them (if non-nil) as well as the global map. */
7347 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
7348 nmaps = 0;
7349 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
7350 maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
7351 if (!NILP (Voverriding_local_map))
7352 maps[nmaps++] = Voverriding_local_map;
7354 else
7356 /* No, so use major and minor mode keymaps and keymap property.
7357 Note that menu-bar bindings in the local-map and keymap
7358 properties may not work reliable, as they are only
7359 recognized when the menu-bar (or mode-line) is updated,
7360 which does not normally happen after every command. */
7361 Lisp_Object tem;
7362 int nminor;
7363 nminor = current_minor_maps (NULL, &tmaps);
7364 maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
7365 nmaps = 0;
7366 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
7367 maps[nmaps++] = tem;
7368 memcpy (maps + nmaps, tmaps, nminor * sizeof (maps[0]));
7369 nmaps += nminor;
7370 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
7372 maps[nmaps++] = current_global_map;
7375 /* Look up in each map the dummy prefix key `menu-bar'. */
7377 result = Qnil;
7379 for (mapno = nmaps - 1; mapno >= 0; mapno--)
7380 if (!NILP (maps[mapno]))
7382 def = get_keymap (access_keymap (maps[mapno], Qmenu_bar, 1, 0, 1),
7383 0, 1);
7384 if (CONSP (def))
7386 menu_bar_one_keymap_changed_items = Qnil;
7387 map_keymap (def, menu_bar_item, Qnil, NULL, 1);
7391 /* Move to the end those items that should be at the end. */
7393 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail))
7395 int i;
7396 int end = menu_bar_items_index;
7398 for (i = 0; i < end; i += 4)
7399 if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i]))
7401 Lisp_Object tem0, tem1, tem2, tem3;
7402 /* Move the item at index I to the end,
7403 shifting all the others forward. */
7404 tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
7405 tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
7406 tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
7407 tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
7408 if (end > i + 4)
7409 memmove (&XVECTOR (menu_bar_items_vector)->contents[i],
7410 &XVECTOR (menu_bar_items_vector)->contents[i + 4],
7411 (end - i - 4) * sizeof (Lisp_Object));
7412 XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
7413 XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
7414 XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
7415 XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
7416 break;
7420 /* Add nil, nil, nil, nil at the end. */
7422 int i = menu_bar_items_index;
7423 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
7424 menu_bar_items_vector =
7425 larger_vector (menu_bar_items_vector, 2 * i, Qnil);
7426 /* Add this item. */
7427 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
7428 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
7429 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
7430 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
7431 menu_bar_items_index = i;
7434 Vinhibit_quit = oquit;
7435 return menu_bar_items_vector;
7438 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
7439 If there's already an item for KEY, add this DEF to it. */
7441 Lisp_Object item_properties;
7443 static void
7444 menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dummy2)
7446 struct gcpro gcpro1;
7447 int i;
7448 Lisp_Object tem;
7450 if (EQ (item, Qundefined))
7452 /* If a map has an explicit `undefined' as definition,
7453 discard any previously made menu bar item. */
7455 for (i = 0; i < menu_bar_items_index; i += 4)
7456 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
7458 if (menu_bar_items_index > i + 4)
7459 memmove (&XVECTOR (menu_bar_items_vector)->contents[i],
7460 &XVECTOR (menu_bar_items_vector)->contents[i + 4],
7461 (menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
7462 menu_bar_items_index -= 4;
7466 /* If this keymap has already contributed to this KEY,
7467 don't contribute to it a second time. */
7468 tem = Fmemq (key, menu_bar_one_keymap_changed_items);
7469 if (!NILP (tem) || NILP (item))
7470 return;
7472 menu_bar_one_keymap_changed_items
7473 = Fcons (key, menu_bar_one_keymap_changed_items);
7475 /* We add to menu_bar_one_keymap_changed_items before doing the
7476 parse_menu_item, so that if it turns out it wasn't a menu item,
7477 it still correctly hides any further menu item. */
7478 GCPRO1 (key);
7479 i = parse_menu_item (item, 1);
7480 UNGCPRO;
7481 if (!i)
7482 return;
7484 item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF];
7486 /* Find any existing item for this KEY. */
7487 for (i = 0; i < menu_bar_items_index; i += 4)
7488 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
7489 break;
7491 /* If we did not find this KEY, add it at the end. */
7492 if (i == menu_bar_items_index)
7494 /* If vector is too small, get a bigger one. */
7495 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
7496 menu_bar_items_vector = larger_vector (menu_bar_items_vector, 2 * i, Qnil);
7497 /* Add this item. */
7498 XVECTOR (menu_bar_items_vector)->contents[i++] = key;
7499 XVECTOR (menu_bar_items_vector)->contents[i++]
7500 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
7501 XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (item, Qnil);
7502 XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
7503 menu_bar_items_index = i;
7505 /* We did find an item for this KEY. Add ITEM to its list of maps. */
7506 else
7508 Lisp_Object old;
7509 old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
7510 /* If the new and the old items are not both keymaps,
7511 the lookup will only find `item'. */
7512 item = Fcons (item, KEYMAPP (item) && KEYMAPP (XCAR (old)) ? old : Qnil);
7513 XVECTOR (menu_bar_items_vector)->contents[i + 2] = item;
7517 /* This is used as the handler when calling menu_item_eval_property. */
7518 static Lisp_Object
7519 menu_item_eval_property_1 (Lisp_Object arg)
7521 /* If we got a quit from within the menu computation,
7522 quit all the way out of it. This takes care of C-] in the debugger. */
7523 if (CONSP (arg) && EQ (XCAR (arg), Qquit))
7524 Fsignal (Qquit, Qnil);
7526 return Qnil;
7529 /* Evaluate an expression and return the result (or nil if something
7530 went wrong). Used to evaluate dynamic parts of menu items. */
7531 Lisp_Object
7532 menu_item_eval_property (Lisp_Object sexpr)
7534 int count = SPECPDL_INDEX ();
7535 Lisp_Object val;
7536 specbind (Qinhibit_redisplay, Qt);
7537 val = internal_condition_case_1 (Feval, sexpr, Qerror,
7538 menu_item_eval_property_1);
7539 return unbind_to (count, val);
7542 /* This function parses a menu item and leaves the result in the
7543 vector item_properties.
7544 ITEM is a key binding, a possible menu item.
7545 INMENUBAR is > 0 when this is considered for an entry in a menu bar
7546 top level.
7547 INMENUBAR is < 0 when this is considered for an entry in a keyboard menu.
7548 parse_menu_item returns true if the item is a menu item and false
7549 otherwise. */
7552 parse_menu_item (Lisp_Object item, int inmenubar)
7554 Lisp_Object def, tem, item_string, start;
7555 Lisp_Object filter;
7556 Lisp_Object keyhint;
7557 int i;
7559 filter = Qnil;
7560 keyhint = Qnil;
7562 if (!CONSP (item))
7563 return 0;
7565 /* Create item_properties vector if necessary. */
7566 if (NILP (item_properties))
7567 item_properties
7568 = Fmake_vector (make_number (ITEM_PROPERTY_ENABLE + 1), Qnil);
7570 /* Initialize optional entries. */
7571 for (i = ITEM_PROPERTY_DEF; i < ITEM_PROPERTY_ENABLE; i++)
7572 ASET (item_properties, i, Qnil);
7573 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7575 /* Save the item here to protect it from GC. */
7576 ASET (item_properties, ITEM_PROPERTY_ITEM, item);
7578 item_string = XCAR (item);
7580 start = item;
7581 item = XCDR (item);
7582 if (STRINGP (item_string))
7584 /* Old format menu item. */
7585 ASET (item_properties, ITEM_PROPERTY_NAME, item_string);
7587 /* Maybe help string. */
7588 if (CONSP (item) && STRINGP (XCAR (item)))
7590 ASET (item_properties, ITEM_PROPERTY_HELP, XCAR (item));
7591 start = item;
7592 item = XCDR (item);
7595 /* Maybe an obsolete key binding cache. */
7596 if (CONSP (item) && CONSP (XCAR (item))
7597 && (NILP (XCAR (XCAR (item)))
7598 || VECTORP (XCAR (XCAR (item)))))
7599 item = XCDR (item);
7601 /* This is the real definition--the function to run. */
7602 ASET (item_properties, ITEM_PROPERTY_DEF, item);
7604 /* Get enable property, if any. */
7605 if (SYMBOLP (item))
7607 tem = Fget (item, Qmenu_enable);
7608 if (!NILP (Venable_disabled_menus_and_buttons))
7609 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7610 else if (!NILP (tem))
7611 ASET (item_properties, ITEM_PROPERTY_ENABLE, tem);
7614 else if (EQ (item_string, Qmenu_item) && CONSP (item))
7616 /* New format menu item. */
7617 ASET (item_properties, ITEM_PROPERTY_NAME, XCAR (item));
7618 start = XCDR (item);
7619 if (CONSP (start))
7621 /* We have a real binding. */
7622 ASET (item_properties, ITEM_PROPERTY_DEF, XCAR (start));
7624 item = XCDR (start);
7625 /* Is there an obsolete cache list with key equivalences. */
7626 if (CONSP (item) && CONSP (XCAR (item)))
7627 item = XCDR (item);
7629 /* Parse properties. */
7630 while (CONSP (item) && CONSP (XCDR (item)))
7632 tem = XCAR (item);
7633 item = XCDR (item);
7635 if (EQ (tem, QCenable))
7637 if (!NILP (Venable_disabled_menus_and_buttons))
7638 ASET (item_properties, ITEM_PROPERTY_ENABLE, Qt);
7639 else
7640 ASET (item_properties, ITEM_PROPERTY_ENABLE, XCAR (item));
7642 else if (EQ (tem, QCvisible))
7644 /* If got a visible property and that evaluates to nil
7645 then ignore this item. */
7646 tem = menu_item_eval_property (XCAR (item));
7647 if (NILP (tem))
7648 return 0;
7650 else if (EQ (tem, QChelp))
7651 ASET (item_properties, ITEM_PROPERTY_HELP, XCAR (item));
7652 else if (EQ (tem, QCfilter))
7653 filter = item;
7654 else if (EQ (tem, QCkey_sequence))
7656 tem = XCAR (item);
7657 if (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem))
7658 /* Be GC protected. Set keyhint to item instead of tem. */
7659 keyhint = item;
7661 else if (EQ (tem, QCkeys))
7663 tem = XCAR (item);
7664 if (CONSP (tem) || STRINGP (tem))
7665 ASET (item_properties, ITEM_PROPERTY_KEYEQ, tem);
7667 else if (EQ (tem, QCbutton) && CONSP (XCAR (item)))
7669 Lisp_Object type;
7670 tem = XCAR (item);
7671 type = XCAR (tem);
7672 if (EQ (type, QCtoggle) || EQ (type, QCradio))
7674 ASET (item_properties, ITEM_PROPERTY_SELECTED,
7675 XCDR (tem));
7676 ASET (item_properties, ITEM_PROPERTY_TYPE, type);
7679 item = XCDR (item);
7682 else if (inmenubar || !NILP (start))
7683 return 0;
7685 else
7686 return 0; /* not a menu item */
7688 /* If item string is not a string, evaluate it to get string.
7689 If we don't get a string, skip this item. */
7690 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
7691 if (!(STRINGP (item_string)))
7693 item_string = menu_item_eval_property (item_string);
7694 if (!STRINGP (item_string))
7695 return 0;
7696 ASET (item_properties, ITEM_PROPERTY_NAME, item_string);
7699 /* If got a filter apply it on definition. */
7700 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7701 if (!NILP (filter))
7703 def = menu_item_eval_property (list2 (XCAR (filter),
7704 list2 (Qquote, def)));
7706 ASET (item_properties, ITEM_PROPERTY_DEF, def);
7709 /* Enable or disable selection of item. */
7710 tem = AREF (item_properties, ITEM_PROPERTY_ENABLE);
7711 if (!EQ (tem, Qt))
7713 tem = menu_item_eval_property (tem);
7714 if (inmenubar && NILP (tem))
7715 return 0; /* Ignore disabled items in menu bar. */
7716 ASET (item_properties, ITEM_PROPERTY_ENABLE, tem);
7719 /* If we got no definition, this item is just unselectable text which
7720 is OK in a submenu but not in the menubar. */
7721 if (NILP (def))
7722 return (inmenubar ? 0 : 1);
7724 /* See if this is a separate pane or a submenu. */
7725 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7726 tem = get_keymap (def, 0, 1);
7727 /* For a subkeymap, just record its details and exit. */
7728 if (CONSP (tem))
7730 ASET (item_properties, ITEM_PROPERTY_MAP, tem);
7731 ASET (item_properties, ITEM_PROPERTY_DEF, tem);
7732 return 1;
7735 /* At the top level in the menu bar, do likewise for commands also.
7736 The menu bar does not display equivalent key bindings anyway.
7737 ITEM_PROPERTY_DEF is already set up properly. */
7738 if (inmenubar > 0)
7739 return 1;
7741 { /* This is a command. See if there is an equivalent key binding. */
7742 Lisp_Object keyeq = AREF (item_properties, ITEM_PROPERTY_KEYEQ);
7744 /* The previous code preferred :key-sequence to :keys, so we
7745 preserve this behavior. */
7746 if (STRINGP (keyeq) && !CONSP (keyhint))
7747 keyeq = concat2 (build_string (" "), Fsubstitute_command_keys (keyeq));
7748 else
7750 Lisp_Object prefix = keyeq;
7751 Lisp_Object keys = Qnil;
7753 if (CONSP (prefix))
7755 def = XCAR (prefix);
7756 prefix = XCDR (prefix);
7758 else
7759 def = AREF (item_properties, ITEM_PROPERTY_DEF);
7761 if (CONSP (keyhint) && !NILP (XCAR (keyhint)))
7763 keys = XCAR (keyhint);
7764 tem = Fkey_binding (keys, Qnil, Qnil, Qnil);
7766 /* We have a suggested key. Is it bound to the command? */
7767 if (NILP (tem)
7768 || (!EQ (tem, def)
7769 /* If the command is an alias for another
7770 (such as lmenu.el set it up), check if the
7771 original command matches the cached command. */
7772 && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))))
7773 keys = Qnil;
7776 if (NILP (keys))
7777 keys = Fwhere_is_internal (def, Qnil, Qt, Qnil, Qnil);
7779 if (!NILP (keys))
7781 tem = Fkey_description (keys, Qnil);
7782 if (CONSP (prefix))
7784 if (STRINGP (XCAR (prefix)))
7785 tem = concat2 (XCAR (prefix), tem);
7786 if (STRINGP (XCDR (prefix)))
7787 tem = concat2 (tem, XCDR (prefix));
7789 keyeq = concat2 (build_string (" "), tem);
7790 /* keyeq = concat3(build_string(" ("),tem,build_string(")")); */
7792 else
7793 keyeq = Qnil;
7796 /* If we have an equivalent key binding, use that. */
7797 ASET (item_properties, ITEM_PROPERTY_KEYEQ, keyeq);
7800 /* Include this when menu help is implemented.
7801 tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP];
7802 if (!(NILP (tem) || STRINGP (tem)))
7804 tem = menu_item_eval_property (tem);
7805 if (!STRINGP (tem))
7806 tem = Qnil;
7807 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem;
7811 /* Handle radio buttons or toggle boxes. */
7812 tem = AREF (item_properties, ITEM_PROPERTY_SELECTED);
7813 if (!NILP (tem))
7814 ASET (item_properties, ITEM_PROPERTY_SELECTED,
7815 menu_item_eval_property (tem));
7817 return 1;
7822 /***********************************************************************
7823 Tool-bars
7824 ***********************************************************************/
7826 /* A vector holding tool bar items while they are parsed in function
7827 tool_bar_items. Each item occupies TOOL_BAR_ITEM_NSCLOTS elements
7828 in the vector. */
7830 static Lisp_Object tool_bar_items_vector;
7832 /* A vector holding the result of parse_tool_bar_item. Layout is like
7833 the one for a single item in tool_bar_items_vector. */
7835 static Lisp_Object tool_bar_item_properties;
7837 /* Next free index in tool_bar_items_vector. */
7839 static int ntool_bar_items;
7841 /* The symbols `:image' and `:rtl'. */
7843 Lisp_Object QCimage;
7844 Lisp_Object Qrtl;
7846 /* Function prototypes. */
7848 static void init_tool_bar_items (Lisp_Object);
7849 static void process_tool_bar_item (Lisp_Object, Lisp_Object, Lisp_Object, void*);
7850 static int parse_tool_bar_item (Lisp_Object, Lisp_Object);
7851 static void append_tool_bar_item (void);
7854 /* Return a vector of tool bar items for keymaps currently in effect.
7855 Reuse vector REUSE if non-nil. Return in *NITEMS the number of
7856 tool bar items found. */
7858 Lisp_Object
7859 tool_bar_items (Lisp_Object reuse, int *nitems)
7861 Lisp_Object *maps;
7862 int nmaps, i;
7863 Lisp_Object oquit;
7864 Lisp_Object *tmaps;
7866 *nitems = 0;
7868 /* In order to build the menus, we need to call the keymap
7869 accessors. They all call QUIT. But this function is called
7870 during redisplay, during which a quit is fatal. So inhibit
7871 quitting while building the menus. We do this instead of
7872 specbind because (1) errors will clear it anyway and (2) this
7873 avoids risk of specpdl overflow. */
7874 oquit = Vinhibit_quit;
7875 Vinhibit_quit = Qt;
7877 /* Initialize tool_bar_items_vector and protect it from GC. */
7878 init_tool_bar_items (reuse);
7880 /* Build list of keymaps in maps. Set nmaps to the number of maps
7881 to process. */
7883 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7884 if (!NILP (Voverriding_local_map_menu_flag))
7886 /* Yes, use them (if non-nil) as well as the global map. */
7887 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
7888 nmaps = 0;
7889 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
7890 maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
7891 if (!NILP (Voverriding_local_map))
7892 maps[nmaps++] = Voverriding_local_map;
7894 else
7896 /* No, so use major and minor mode keymaps and keymap property.
7897 Note that tool-bar bindings in the local-map and keymap
7898 properties may not work reliable, as they are only
7899 recognized when the tool-bar (or mode-line) is updated,
7900 which does not normally happen after every command. */
7901 Lisp_Object tem;
7902 int nminor;
7903 nminor = current_minor_maps (NULL, &tmaps);
7904 maps = (Lisp_Object *) alloca ((nminor + 3) * sizeof (maps[0]));
7905 nmaps = 0;
7906 if (tem = get_local_map (PT, current_buffer, Qkeymap), !NILP (tem))
7907 maps[nmaps++] = tem;
7908 memcpy (maps + nmaps, tmaps, nminor * sizeof (maps[0]));
7909 nmaps += nminor;
7910 maps[nmaps++] = get_local_map (PT, current_buffer, Qlocal_map);
7913 /* Add global keymap at the end. */
7914 maps[nmaps++] = current_global_map;
7916 /* Process maps in reverse order and look up in each map the prefix
7917 key `tool-bar'. */
7918 for (i = nmaps - 1; i >= 0; --i)
7919 if (!NILP (maps[i]))
7921 Lisp_Object keymap;
7923 keymap = get_keymap (access_keymap (maps[i], Qtool_bar, 1, 0, 1), 0, 1);
7924 if (CONSP (keymap))
7925 map_keymap (keymap, process_tool_bar_item, Qnil, NULL, 1);
7928 Vinhibit_quit = oquit;
7929 *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS;
7930 return tool_bar_items_vector;
7934 /* Process the definition of KEY which is DEF. */
7936 static void
7937 process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void *args)
7939 int i;
7940 struct gcpro gcpro1, gcpro2;
7942 /* Protect KEY and DEF from GC because parse_tool_bar_item may call
7943 eval. */
7944 GCPRO2 (key, def);
7946 if (EQ (def, Qundefined))
7948 /* If a map has an explicit `undefined' as definition,
7949 discard any previously made item. */
7950 for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS)
7952 Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i;
7954 if (EQ (key, v[TOOL_BAR_ITEM_KEY]))
7956 if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS)
7957 memmove (v, v + TOOL_BAR_ITEM_NSLOTS,
7958 ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS)
7959 * sizeof (Lisp_Object)));
7960 ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS;
7961 break;
7965 else if (parse_tool_bar_item (key, def))
7966 /* Append a new tool bar item to tool_bar_items_vector. Accept
7967 more than one definition for the same key. */
7968 append_tool_bar_item ();
7970 UNGCPRO;
7974 /* Parse a tool bar item specification ITEM for key KEY and return the
7975 result in tool_bar_item_properties. Value is zero if ITEM is
7976 invalid.
7978 ITEM is a list `(menu-item CAPTION BINDING PROPS...)'.
7980 CAPTION is the caption of the item, If it's not a string, it is
7981 evaluated to get a string.
7983 BINDING is the tool bar item's binding. Tool-bar items with keymaps
7984 as binding are currently ignored.
7986 The following properties are recognized:
7988 - `:enable FORM'.
7990 FORM is evaluated and specifies whether the tool bar item is
7991 enabled or disabled.
7993 - `:visible FORM'
7995 FORM is evaluated and specifies whether the tool bar item is visible.
7997 - `:filter FUNCTION'
7999 FUNCTION is invoked with one parameter `(quote BINDING)'. Its
8000 result is stored as the new binding.
8002 - `:button (TYPE SELECTED)'
8004 TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated
8005 and specifies whether the button is selected (pressed) or not.
8007 - `:image IMAGES'
8009 IMAGES is either a single image specification or a vector of four
8010 image specifications. See enum tool_bar_item_images.
8012 - `:help HELP-STRING'.
8014 Gives a help string to display for the tool bar item.
8016 - `:label LABEL-STRING'.
8018 A text label to show with the tool bar button if labels are enabled. */
8020 static int
8021 parse_tool_bar_item (Lisp_Object key, Lisp_Object item)
8023 /* Access slot with index IDX of vector tool_bar_item_properties. */
8024 #define PROP(IDX) XVECTOR (tool_bar_item_properties)->contents[IDX]
8026 Lisp_Object filter = Qnil;
8027 Lisp_Object caption;
8028 int i, have_label = 0;
8030 /* Defininition looks like `(menu-item CAPTION BINDING PROPS...)'.
8031 Rule out items that aren't lists, don't start with
8032 `menu-item' or whose rest following `tool-bar-item' is not a
8033 list. */
8034 if (!CONSP (item))
8035 return 0;
8037 /* As an exception, allow old-style menu separators. */
8038 if (STRINGP (XCAR (item)))
8039 item = Fcons (XCAR (item), Qnil);
8040 else if (!EQ (XCAR (item), Qmenu_item)
8041 || (item = XCDR (item), !CONSP (item)))
8042 return 0;
8044 /* Create tool_bar_item_properties vector if necessary. Reset it to
8045 defaults. */
8046 if (VECTORP (tool_bar_item_properties))
8048 for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i)
8049 PROP (i) = Qnil;
8051 else
8052 tool_bar_item_properties
8053 = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil);
8055 /* Set defaults. */
8056 PROP (TOOL_BAR_ITEM_KEY) = key;
8057 PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
8059 /* Get the caption of the item. If the caption is not a string,
8060 evaluate it to get a string. If we don't get a string, skip this
8061 item. */
8062 caption = XCAR (item);
8063 if (!STRINGP (caption))
8065 caption = menu_item_eval_property (caption);
8066 if (!STRINGP (caption))
8067 return 0;
8069 PROP (TOOL_BAR_ITEM_CAPTION) = caption;
8071 /* If the rest following the caption is not a list, the menu item is
8072 either a separator, or invalid. */
8073 item = XCDR (item);
8074 if (!CONSP (item))
8076 if (menu_separator_name_p (SSDATA (caption)))
8078 PROP (TOOL_BAR_ITEM_TYPE) = Qt;
8079 #if !defined (USE_GTK) && !defined (HAVE_NS)
8080 /* If we use build_desired_tool_bar_string to render the
8081 tool bar, the separator is rendered as an image. */
8082 PROP (TOOL_BAR_ITEM_IMAGES)
8083 = menu_item_eval_property (Vtool_bar_separator_image_expression);
8084 PROP (TOOL_BAR_ITEM_ENABLED_P) = Qnil;
8085 PROP (TOOL_BAR_ITEM_SELECTED_P) = Qnil;
8086 PROP (TOOL_BAR_ITEM_CAPTION) = Qnil;
8087 #endif
8088 return 1;
8090 return 0;
8093 /* Store the binding. */
8094 PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item);
8095 item = XCDR (item);
8097 /* Ignore cached key binding, if any. */
8098 if (CONSP (item) && CONSP (XCAR (item)))
8099 item = XCDR (item);
8101 /* Process the rest of the properties. */
8102 for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item)))
8104 Lisp_Object ikey, value;
8106 ikey = XCAR (item);
8107 value = XCAR (XCDR (item));
8109 if (EQ (ikey, QCenable))
8111 /* `:enable FORM'. */
8112 if (!NILP (Venable_disabled_menus_and_buttons))
8113 PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt;
8114 else
8115 PROP (TOOL_BAR_ITEM_ENABLED_P) = value;
8117 else if (EQ (ikey, QCvisible))
8119 /* `:visible FORM'. If got a visible property and that
8120 evaluates to nil then ignore this item. */
8121 if (NILP (menu_item_eval_property (value)))
8122 return 0;
8124 else if (EQ (ikey, QChelp))
8125 /* `:help HELP-STRING'. */
8126 PROP (TOOL_BAR_ITEM_HELP) = value;
8127 else if (EQ (ikey, QCvert_only))
8128 /* `:vert-only t/nil'. */
8129 PROP (TOOL_BAR_ITEM_VERT_ONLY) = value;
8130 else if (EQ (ikey, QClabel))
8132 const char *bad_label = "!!?GARBLED ITEM?!!";
8133 /* `:label LABEL-STRING'. */
8134 PROP (TOOL_BAR_ITEM_LABEL) = STRINGP (value)
8135 ? value
8136 : make_string (bad_label, strlen (bad_label));
8137 have_label = 1;
8139 else if (EQ (ikey, QCfilter))
8140 /* ':filter FORM'. */
8141 filter = value;
8142 else if (EQ (ikey, QCbutton) && CONSP (value))
8144 /* `:button (TYPE . SELECTED)'. */
8145 Lisp_Object type, selected;
8147 type = XCAR (value);
8148 selected = XCDR (value);
8149 if (EQ (type, QCtoggle) || EQ (type, QCradio))
8151 PROP (TOOL_BAR_ITEM_SELECTED_P) = selected;
8152 PROP (TOOL_BAR_ITEM_TYPE) = type;
8155 else if (EQ (ikey, QCimage)
8156 && (CONSP (value)
8157 || (VECTORP (value) && XVECTOR (value)->size == 4)))
8158 /* Value is either a single image specification or a vector
8159 of 4 such specifications for the different button states. */
8160 PROP (TOOL_BAR_ITEM_IMAGES) = value;
8161 else if (EQ (ikey, Qrtl))
8162 /* ':rtl STRING' */
8163 PROP (TOOL_BAR_ITEM_RTL_IMAGE) = value;
8167 if (!have_label)
8169 /* Try to make one from caption and key. */
8170 Lisp_Object tkey = PROP (TOOL_BAR_ITEM_KEY);
8171 Lisp_Object tcapt = PROP (TOOL_BAR_ITEM_CAPTION);
8172 const char *label = SYMBOLP (tkey) ? SSDATA (SYMBOL_NAME (tkey)) : "";
8173 const char *capt = STRINGP (tcapt) ? SSDATA (tcapt) : "";
8174 EMACS_INT max_lbl = 2 * tool_bar_max_label_size;
8175 char *buf = (char *) xmalloc (max_lbl + 1);
8176 Lisp_Object new_lbl;
8177 size_t caption_len = strlen (capt);
8179 if (caption_len <= max_lbl && capt[0] != '\0')
8181 strcpy (buf, capt);
8182 while (caption_len > 0 && buf[caption_len - 1] == '.')
8183 caption_len--;
8184 buf[caption_len] = '\0';
8185 label = capt = buf;
8188 if (strlen (label) <= max_lbl && label[0] != '\0')
8190 int j;
8191 if (label != buf)
8192 strcpy (buf, label);
8194 for (j = 0; buf[j] != '\0'; ++j)
8195 if (buf[j] == '-')
8196 buf[j] = ' ';
8197 label = buf;
8199 else
8200 label = "";
8202 new_lbl = Fupcase_initials (make_string (label, strlen (label)));
8203 if (SCHARS (new_lbl) <= tool_bar_max_label_size)
8204 PROP (TOOL_BAR_ITEM_LABEL) = new_lbl;
8205 else
8206 PROP (TOOL_BAR_ITEM_LABEL) = make_string ("", 0);
8207 free (buf);
8210 /* If got a filter apply it on binding. */
8211 if (!NILP (filter))
8212 PROP (TOOL_BAR_ITEM_BINDING)
8213 = menu_item_eval_property (list2 (filter,
8214 list2 (Qquote,
8215 PROP (TOOL_BAR_ITEM_BINDING))));
8217 /* See if the binding is a keymap. Give up if it is. */
8218 if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1)))
8219 return 0;
8221 /* Enable or disable selection of item. */
8222 if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt))
8223 PROP (TOOL_BAR_ITEM_ENABLED_P)
8224 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P));
8226 /* Handle radio buttons or toggle boxes. */
8227 if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)))
8228 PROP (TOOL_BAR_ITEM_SELECTED_P)
8229 = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P));
8231 return 1;
8233 #undef PROP
8237 /* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector
8238 that can be reused. */
8240 static void
8241 init_tool_bar_items (Lisp_Object reuse)
8243 if (VECTORP (reuse))
8244 tool_bar_items_vector = reuse;
8245 else
8246 tool_bar_items_vector = Fmake_vector (make_number (64), Qnil);
8247 ntool_bar_items = 0;
8251 /* Append parsed tool bar item properties from
8252 tool_bar_item_properties */
8254 static void
8255 append_tool_bar_item (void)
8257 Lisp_Object *to, *from;
8259 /* Enlarge tool_bar_items_vector if necessary. */
8260 if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS
8261 >= XVECTOR (tool_bar_items_vector)->size)
8262 tool_bar_items_vector
8263 = larger_vector (tool_bar_items_vector,
8264 2 * XVECTOR (tool_bar_items_vector)->size, Qnil);
8266 /* Append entries from tool_bar_item_properties to the end of
8267 tool_bar_items_vector. */
8268 to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items;
8269 from = XVECTOR (tool_bar_item_properties)->contents;
8270 memcpy (to, from, TOOL_BAR_ITEM_NSLOTS * sizeof *to);
8271 ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
8278 /* Read a character using menus based on maps in the array MAPS.
8279 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
8280 Return t if we displayed a menu but the user rejected it.
8282 PREV_EVENT is the previous input event, or nil if we are reading
8283 the first event of a key sequence.
8285 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
8286 if we used a mouse menu to read the input, or zero otherwise. If
8287 USED_MOUSE_MENU is null, we don't dereference it.
8289 The prompting is done based on the prompt-string of the map
8290 and the strings associated with various map elements.
8292 This can be done with X menus or with menus put in the minibuf.
8293 These are done in different ways, depending on how the input will be read.
8294 Menus using X are done after auto-saving in read-char, getting the input
8295 event from Fx_popup_menu; menus using the minibuf use read_char recursively
8296 and do auto-saving in the inner call of read_char. */
8298 static Lisp_Object
8299 read_char_x_menu_prompt (int nmaps, Lisp_Object *maps, Lisp_Object prev_event,
8300 int *used_mouse_menu)
8302 int mapno;
8304 if (used_mouse_menu)
8305 *used_mouse_menu = 0;
8307 /* Use local over global Menu maps */
8309 if (! menu_prompting)
8310 return Qnil;
8312 /* Optionally disregard all but the global map. */
8313 if (inhibit_local_menu_bar_menus)
8315 maps += (nmaps - 1);
8316 nmaps = 1;
8319 #ifdef HAVE_MENUS
8320 /* If we got to this point via a mouse click,
8321 use a real menu for mouse selection. */
8322 if (EVENT_HAS_PARAMETERS (prev_event)
8323 && !EQ (XCAR (prev_event), Qmenu_bar)
8324 && !EQ (XCAR (prev_event), Qtool_bar))
8326 /* Display the menu and get the selection. */
8327 Lisp_Object *realmaps
8328 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
8329 Lisp_Object value;
8330 int nmaps1 = 0;
8332 /* Use the maps that are not nil. */
8333 for (mapno = 0; mapno < nmaps; mapno++)
8334 if (!NILP (maps[mapno]))
8335 realmaps[nmaps1++] = maps[mapno];
8337 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
8338 if (CONSP (value))
8340 Lisp_Object tem;
8342 record_menu_key (XCAR (value));
8344 /* If we got multiple events, unread all but
8345 the first.
8346 There is no way to prevent those unread events
8347 from showing up later in last_nonmenu_event.
8348 So turn symbol and integer events into lists,
8349 to indicate that they came from a mouse menu,
8350 so that when present in last_nonmenu_event
8351 they won't confuse things. */
8352 for (tem = XCDR (value); CONSP (tem); tem = XCDR (tem))
8354 record_menu_key (XCAR (tem));
8355 if (SYMBOLP (XCAR (tem))
8356 || INTEGERP (XCAR (tem)))
8357 XSETCAR (tem, Fcons (XCAR (tem), Qdisabled));
8360 /* If we got more than one event, put all but the first
8361 onto this list to be read later.
8362 Return just the first event now. */
8363 Vunread_command_events
8364 = nconc2 (XCDR (value), Vunread_command_events);
8365 value = XCAR (value);
8367 else if (NILP (value))
8368 value = Qt;
8369 if (used_mouse_menu)
8370 *used_mouse_menu = 1;
8371 return value;
8373 #endif /* HAVE_MENUS */
8374 return Qnil ;
8377 /* Buffer in use so far for the minibuf prompts for menu keymaps.
8378 We make this bigger when necessary, and never free it. */
8379 static char *read_char_minibuf_menu_text;
8380 /* Size of that buffer. */
8381 static int read_char_minibuf_menu_width;
8383 static Lisp_Object
8384 read_char_minibuf_menu_prompt (int commandflag, int nmaps, Lisp_Object *maps)
8386 int mapno;
8387 register Lisp_Object name;
8388 int nlength;
8389 /* FIXME: Use the minibuffer's frame width. */
8390 int width = FRAME_COLS (SELECTED_FRAME ()) - 4;
8391 int idx = -1;
8392 int nobindings = 1;
8393 Lisp_Object rest, vector;
8394 char *menu;
8396 vector = Qnil;
8397 name = Qnil;
8399 if (! menu_prompting)
8400 return Qnil;
8402 /* Get the menu name from the first map that has one (a prompt string). */
8403 for (mapno = 0; mapno < nmaps; mapno++)
8405 name = Fkeymap_prompt (maps[mapno]);
8406 if (!NILP (name))
8407 break;
8410 /* If we don't have any menus, just read a character normally. */
8411 if (!STRINGP (name))
8412 return Qnil;
8414 /* Make sure we have a big enough buffer for the menu text. */
8415 width = max (width, SBYTES (name));
8416 if (read_char_minibuf_menu_text == 0)
8418 read_char_minibuf_menu_width = width + 4;
8419 read_char_minibuf_menu_text = (char *) xmalloc (width + 4);
8421 else if (width + 4 > read_char_minibuf_menu_width)
8423 read_char_minibuf_menu_width = width + 4;
8424 read_char_minibuf_menu_text
8425 = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
8427 menu = read_char_minibuf_menu_text;
8429 /* Prompt string always starts with map's prompt, and a space. */
8430 strcpy (menu, SSDATA (name));
8431 nlength = SBYTES (name);
8432 menu[nlength++] = ':';
8433 menu[nlength++] = ' ';
8434 menu[nlength] = 0;
8436 /* Start prompting at start of first map. */
8437 mapno = 0;
8438 rest = maps[mapno];
8440 /* Present the documented bindings, a line at a time. */
8441 while (1)
8443 int notfirst = 0;
8444 int i = nlength;
8445 Lisp_Object obj;
8446 int ch;
8447 Lisp_Object orig_defn_macro;
8449 /* Loop over elements of map. */
8450 while (i < width)
8452 Lisp_Object elt;
8454 /* If reached end of map, start at beginning of next map. */
8455 if (NILP (rest))
8457 mapno++;
8458 /* At end of last map, wrap around to first map if just starting,
8459 or end this line if already have something on it. */
8460 if (mapno == nmaps)
8462 mapno = 0;
8463 if (notfirst || nobindings) break;
8465 rest = maps[mapno];
8468 /* Look at the next element of the map. */
8469 if (idx >= 0)
8470 elt = XVECTOR (vector)->contents[idx];
8471 else
8472 elt = Fcar_safe (rest);
8474 if (idx < 0 && VECTORP (elt))
8476 /* If we found a dense table in the keymap,
8477 advanced past it, but start scanning its contents. */
8478 rest = Fcdr_safe (rest);
8479 vector = elt;
8480 idx = 0;
8482 else
8484 /* An ordinary element. */
8485 Lisp_Object event, tem;
8487 if (idx < 0)
8489 event = Fcar_safe (elt); /* alist */
8490 elt = Fcdr_safe (elt);
8492 else
8494 XSETINT (event, idx); /* vector */
8497 /* Ignore the element if it has no prompt string. */
8498 if (INTEGERP (event) && parse_menu_item (elt, -1))
8500 /* 1 if the char to type matches the string. */
8501 int char_matches;
8502 Lisp_Object upcased_event, downcased_event;
8503 Lisp_Object desc = Qnil;
8504 Lisp_Object s
8505 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
8507 upcased_event = Fupcase (event);
8508 downcased_event = Fdowncase (event);
8509 char_matches = (XINT (upcased_event) == SREF (s, 0)
8510 || XINT (downcased_event) == SREF (s, 0));
8511 if (! char_matches)
8512 desc = Fsingle_key_description (event, Qnil);
8514 #if 0 /* It is redundant to list the equivalent key bindings because
8515 the prefix is what the user has already typed. */
8517 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ];
8518 if (!NILP (tem))
8519 /* Insert equivalent keybinding. */
8520 s = concat2 (s, tem);
8521 #endif
8523 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
8524 if (EQ (tem, QCradio) || EQ (tem, QCtoggle))
8526 /* Insert button prefix. */
8527 Lisp_Object selected
8528 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
8529 if (EQ (tem, QCradio))
8530 tem = build_string (NILP (selected) ? "(*) " : "( ) ");
8531 else
8532 tem = build_string (NILP (selected) ? "[X] " : "[ ] ");
8533 s = concat2 (tem, s);
8537 /* If we have room for the prompt string, add it to this line.
8538 If this is the first on the line, always add it. */
8539 if ((SCHARS (s) + i + 2
8540 + (char_matches ? 0 : SCHARS (desc) + 3))
8541 < width
8542 || !notfirst)
8544 int thiswidth;
8546 /* Punctuate between strings. */
8547 if (notfirst)
8549 strcpy (menu + i, ", ");
8550 i += 2;
8552 notfirst = 1;
8553 nobindings = 0 ;
8555 /* If the char to type doesn't match the string's
8556 first char, explicitly show what char to type. */
8557 if (! char_matches)
8559 /* Add as much of string as fits. */
8560 thiswidth = SCHARS (desc);
8561 if (thiswidth + i > width)
8562 thiswidth = width - i;
8563 memcpy (menu + i, SDATA (desc), thiswidth);
8564 i += thiswidth;
8565 strcpy (menu + i, " = ");
8566 i += 3;
8569 /* Add as much of string as fits. */
8570 thiswidth = SCHARS (s);
8571 if (thiswidth + i > width)
8572 thiswidth = width - i;
8573 memcpy (menu + i, SDATA (s), thiswidth);
8574 i += thiswidth;
8575 menu[i] = 0;
8577 else
8579 /* If this element does not fit, end the line now,
8580 and save the element for the next line. */
8581 strcpy (menu + i, "...");
8582 break;
8586 /* Move past this element. */
8587 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
8588 /* Handle reaching end of dense table. */
8589 idx = -1;
8590 if (idx >= 0)
8591 idx++;
8592 else
8593 rest = Fcdr_safe (rest);
8597 /* Prompt with that and read response. */
8598 message2_nolog (menu, strlen (menu),
8599 ! NILP (BVAR (current_buffer, enable_multibyte_characters)));
8601 /* Make believe its not a keyboard macro in case the help char
8602 is pressed. Help characters are not recorded because menu prompting
8603 is not used on replay.
8605 orig_defn_macro = KVAR (current_kboard, defining_kbd_macro);
8606 KVAR (current_kboard, defining_kbd_macro) = Qnil;
8608 obj = read_char (commandflag, 0, 0, Qt, 0, NULL);
8609 while (BUFFERP (obj));
8610 KVAR (current_kboard, defining_kbd_macro) = orig_defn_macro;
8612 if (!INTEGERP (obj))
8613 return obj;
8614 else if (XINT (obj) == -2)
8615 return obj;
8616 else
8617 ch = XINT (obj);
8619 if (! EQ (obj, menu_prompt_more_char)
8620 && (!INTEGERP (menu_prompt_more_char)
8621 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
8623 if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
8624 store_kbd_macro_char (obj);
8625 return obj;
8627 /* Help char - go round again */
8631 /* Reading key sequences. */
8633 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
8634 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
8635 keymap, or nil otherwise. Return the index of the first keymap in
8636 which KEY has any binding, or NMAPS if no map has a binding.
8638 If KEY is a meta ASCII character, treat it like meta-prefix-char
8639 followed by the corresponding non-meta character. Keymaps in
8640 CURRENT with non-prefix bindings for meta-prefix-char become nil in
8641 NEXT.
8643 If KEY has no bindings in any of the CURRENT maps, NEXT is left
8644 unmodified.
8646 NEXT may be the same array as CURRENT. */
8648 static int
8649 follow_key (Lisp_Object key, int nmaps, Lisp_Object *current, Lisp_Object *defs,
8650 Lisp_Object *next)
8652 int i, first_binding;
8654 first_binding = nmaps;
8655 for (i = nmaps - 1; i >= 0; i--)
8657 if (! NILP (current[i]))
8659 defs[i] = access_keymap (current[i], key, 1, 0, 1);
8660 if (! NILP (defs[i]))
8661 first_binding = i;
8663 else
8664 defs[i] = Qnil;
8667 /* Given the set of bindings we've found, produce the next set of maps. */
8668 if (first_binding < nmaps)
8669 for (i = 0; i < nmaps; i++)
8670 next[i] = NILP (defs[i]) ? Qnil : get_keymap (defs[i], 0, 1);
8672 return first_binding;
8675 /* Structure used to keep track of partial application of key remapping
8676 such as Vfunction_key_map and Vkey_translation_map. */
8677 typedef struct keyremap
8679 /* This is the map originally specified for this use. */
8680 Lisp_Object parent;
8681 /* This is a submap reached by looking up, in PARENT,
8682 the events from START to END. */
8683 Lisp_Object map;
8684 /* Positions [START, END) in the key sequence buffer
8685 are the key that we have scanned so far.
8686 Those events are the ones that we will replace
8687 if PAREHT maps them into a key sequence. */
8688 int start, end;
8689 } keyremap;
8691 /* Lookup KEY in MAP.
8692 MAP is a keymap mapping keys to key vectors or functions.
8693 If the mapping is a function and DO_FUNCTION is non-zero, then
8694 the function is called with PROMPT as parameter and its return
8695 value is used as the return value of this function (after checking
8696 that it is indeed a vector). */
8698 static Lisp_Object
8699 access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
8700 int do_funcall)
8702 Lisp_Object next;
8704 next = access_keymap (map, key, 1, 0, 1);
8706 /* Handle symbol with autoload definition. */
8707 if (SYMBOLP (next) && !NILP (Ffboundp (next))
8708 && CONSP (XSYMBOL (next)->function)
8709 && EQ (XCAR (XSYMBOL (next)->function), Qautoload))
8710 do_autoload (XSYMBOL (next)->function, next);
8712 /* Handle a symbol whose function definition is a keymap
8713 or an array. */
8714 if (SYMBOLP (next) && !NILP (Ffboundp (next))
8715 && (ARRAYP (XSYMBOL (next)->function)
8716 || KEYMAPP (XSYMBOL (next)->function)))
8717 next = XSYMBOL (next)->function;
8719 /* If the keymap gives a function, not an
8720 array, then call the function with one arg and use
8721 its value instead. */
8722 if (SYMBOLP (next) && !NILP (Ffboundp (next)) && do_funcall)
8724 Lisp_Object tem;
8725 tem = next;
8727 next = call1 (next, prompt);
8728 /* If the function returned something invalid,
8729 barf--don't ignore it.
8730 (To ignore it safely, we would need to gcpro a bunch of
8731 other variables.) */
8732 if (! (VECTORP (next) || STRINGP (next)))
8733 error ("Function %s returns invalid key sequence", tem);
8735 return next;
8738 /* Do one step of the key remapping used for function-key-map and
8739 key-translation-map:
8740 KEYBUF is the buffer holding the input events.
8741 BUFSIZE is its maximum size.
8742 FKEY is a pointer to the keyremap structure to use.
8743 INPUT is the index of the last element in KEYBUF.
8744 DOIT if non-zero says that the remapping can actually take place.
8745 DIFF is used to return the number of keys added/removed by the remapping.
8746 PARENT is the root of the keymap.
8747 PROMPT is the prompt to use if the remapping happens through a function.
8748 The return value is non-zero if the remapping actually took place. */
8750 static int
8751 keyremap_step (Lisp_Object *keybuf, int bufsize, volatile keyremap *fkey,
8752 int input, int doit, int *diff, Lisp_Object prompt)
8754 Lisp_Object next, key;
8756 key = keybuf[fkey->end++];
8758 if (KEYMAPP (fkey->parent))
8759 next = access_keymap_keyremap (fkey->map, key, prompt, doit);
8760 else
8761 next = Qnil;
8763 /* If keybuf[fkey->start..fkey->end] is bound in the
8764 map and we're in a position to do the key remapping, replace it with
8765 the binding and restart with fkey->start at the end. */
8766 if ((VECTORP (next) || STRINGP (next)) && doit)
8768 int len = XFASTINT (Flength (next));
8769 int i;
8771 *diff = len - (fkey->end - fkey->start);
8773 if (input + *diff >= bufsize)
8774 error ("Key sequence too long");
8776 /* Shift the keys that follow fkey->end. */
8777 if (*diff < 0)
8778 for (i = fkey->end; i < input; i++)
8779 keybuf[i + *diff] = keybuf[i];
8780 else if (*diff > 0)
8781 for (i = input - 1; i >= fkey->end; i--)
8782 keybuf[i + *diff] = keybuf[i];
8783 /* Overwrite the old keys with the new ones. */
8784 for (i = 0; i < len; i++)
8785 keybuf[fkey->start + i]
8786 = Faref (next, make_number (i));
8788 fkey->start = fkey->end += *diff;
8789 fkey->map = fkey->parent;
8791 return 1;
8794 fkey->map = get_keymap (next, 0, 1);
8796 /* If we no longer have a bound suffix, try a new position for
8797 fkey->start. */
8798 if (!CONSP (fkey->map))
8800 fkey->end = ++fkey->start;
8801 fkey->map = fkey->parent;
8803 return 0;
8806 /* Read a sequence of keys that ends with a non prefix character,
8807 storing it in KEYBUF, a buffer of size BUFSIZE.
8808 Prompt with PROMPT.
8809 Return the length of the key sequence stored.
8810 Return -1 if the user rejected a command menu.
8812 Echo starting immediately unless `prompt' is 0.
8814 Where a key sequence ends depends on the currently active keymaps.
8815 These include any minor mode keymaps active in the current buffer,
8816 the current buffer's local map, and the global map.
8818 If a key sequence has no other bindings, we check Vfunction_key_map
8819 to see if some trailing subsequence might be the beginning of a
8820 function key's sequence. If so, we try to read the whole function
8821 key, and substitute its symbolic name into the key sequence.
8823 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
8824 `double-' events into similar click events, if that would make them
8825 bound. We try to turn `triple-' events first into `double-' events,
8826 then into clicks.
8828 If we get a mouse click in a mode line, vertical divider, or other
8829 non-text area, we treat the click as if it were prefixed by the
8830 symbol denoting that area - `mode-line', `vertical-line', or
8831 whatever.
8833 If the sequence starts with a mouse click, we read the key sequence
8834 with respect to the buffer clicked on, not the current buffer.
8836 If the user switches frames in the midst of a key sequence, we put
8837 off the switch-frame event until later; the next call to
8838 read_char will return it.
8840 If FIX_CURRENT_BUFFER is nonzero, we restore current_buffer
8841 from the selected window's buffer. */
8843 static int
8844 read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
8845 int dont_downcase_last, int can_return_switch_frame,
8846 int fix_current_buffer)
8848 Lisp_Object from_string;
8849 int count = SPECPDL_INDEX ();
8851 /* How many keys there are in the current key sequence. */
8852 int t;
8854 /* The length of the echo buffer when we started reading, and
8855 the length of this_command_keys when we started reading. */
8856 int echo_start IF_LINT (= 0);
8857 int keys_start;
8859 /* The number of keymaps we're scanning right now, and the number of
8860 keymaps we have allocated space for. */
8861 int nmaps;
8862 int nmaps_allocated = 0;
8864 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
8865 the current keymaps. */
8866 Lisp_Object *defs = NULL;
8868 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
8869 in the current keymaps, or nil where it is not a prefix. */
8870 Lisp_Object *submaps = NULL;
8872 /* The local map to start out with at start of key sequence. */
8873 Lisp_Object orig_local_map;
8875 /* The map from the `keymap' property to start out with at start of
8876 key sequence. */
8877 Lisp_Object orig_keymap;
8879 /* 1 if we have already considered switching to the local-map property
8880 of the place where a mouse click occurred. */
8881 int localized_local_map = 0;
8883 /* The index in submaps[] of the first keymap that has a binding for
8884 this key sequence. In other words, the lowest i such that
8885 submaps[i] is non-nil. */
8886 int first_binding;
8887 /* Index of the first key that has no binding.
8888 It is useless to try fkey.start larger than that. */
8889 int first_unbound;
8891 /* If t < mock_input, then KEYBUF[t] should be read as the next
8892 input key.
8894 We use this to recover after recognizing a function key. Once we
8895 realize that a suffix of the current key sequence is actually a
8896 function key's escape sequence, we replace the suffix with the
8897 function key's binding from Vfunction_key_map. Now keybuf
8898 contains a new and different key sequence, so the echo area,
8899 this_command_keys, and the submaps and defs arrays are wrong. In
8900 this situation, we set mock_input to t, set t to 0, and jump to
8901 restart_sequence; the loop will read keys from keybuf up until
8902 mock_input, thus rebuilding the state; and then it will resume
8903 reading characters from the keyboard. */
8904 int mock_input = 0;
8906 /* If the sequence is unbound in submaps[], then
8907 keybuf[fkey.start..fkey.end-1] is a prefix in Vfunction_key_map,
8908 and fkey.map is its binding.
8910 These might be > t, indicating that all function key scanning
8911 should hold off until t reaches them. We do this when we've just
8912 recognized a function key, to avoid searching for the function
8913 key's again in Vfunction_key_map. */
8914 keyremap fkey;
8916 /* Likewise, for key_translation_map and input-decode-map. */
8917 keyremap keytran, indec;
8919 /* Non-zero if we are trying to map a key by changing an upper-case
8920 letter to lower case, or a shifted function key to an unshifted
8921 one. */
8922 int shift_translated = 0;
8924 /* If we receive a `switch-frame' or `select-window' event in the middle of
8925 a key sequence, we put it off for later.
8926 While we're reading, we keep the event here. */
8927 Lisp_Object delayed_switch_frame;
8929 /* See the comment below... */
8930 #if defined (GOBBLE_FIRST_EVENT)
8931 Lisp_Object first_event;
8932 #endif
8934 Lisp_Object original_uppercase IF_LINT (= Qnil);
8935 int original_uppercase_position = -1;
8937 /* Gets around Microsoft compiler limitations. */
8938 int dummyflag = 0;
8940 struct buffer *starting_buffer;
8942 /* List of events for which a fake prefix key has been generated. */
8943 Lisp_Object fake_prefixed_keys = Qnil;
8945 #if defined (GOBBLE_FIRST_EVENT)
8946 int junk;
8947 #endif
8949 struct gcpro outer_gcpro1;
8951 GCPRO1_VAR (fake_prefixed_keys, outer_gcpro);
8952 raw_keybuf_count = 0;
8954 last_nonmenu_event = Qnil;
8956 delayed_switch_frame = Qnil;
8958 if (INTERACTIVE)
8960 if (!NILP (prompt))
8962 /* Install the string STR as the beginning of the string of
8963 echoing, so that it serves as a prompt for the next
8964 character. */
8965 KVAR (current_kboard, echo_string) = prompt;
8966 current_kboard->echo_after_prompt = SCHARS (prompt);
8967 echo_now ();
8969 else if (cursor_in_echo_area
8970 && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
8971 && NILP (Fzerop (Vecho_keystrokes)))
8972 /* This doesn't put in a dash if the echo buffer is empty, so
8973 you don't always see a dash hanging out in the minibuffer. */
8974 echo_dash ();
8977 /* Record the initial state of the echo area and this_command_keys;
8978 we will need to restore them if we replay a key sequence. */
8979 if (INTERACTIVE)
8980 echo_start = echo_length ();
8981 keys_start = this_command_key_count;
8982 this_single_command_key_start = keys_start;
8984 #if defined (GOBBLE_FIRST_EVENT)
8985 /* This doesn't quite work, because some of the things that read_char
8986 does cannot safely be bypassed. It seems too risky to try to make
8987 this work right. */
8989 /* Read the first char of the sequence specially, before setting
8990 up any keymaps, in case a filter runs and switches buffers on us. */
8991 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
8992 &junk, NULL);
8993 #endif /* GOBBLE_FIRST_EVENT */
8995 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
8996 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
8997 from_string = Qnil;
8999 /* We jump here when we need to reinitialize fkey and keytran; this
9000 happens if we switch keyboards between rescans. */
9001 replay_entire_sequence:
9003 indec.map = indec.parent = KVAR (current_kboard, Vinput_decode_map);
9004 fkey.map = fkey.parent = KVAR (current_kboard, Vlocal_function_key_map);
9005 keytran.map = keytran.parent = Vkey_translation_map;
9006 indec.start = indec.end = 0;
9007 fkey.start = fkey.end = 0;
9008 keytran.start = keytran.end = 0;
9010 /* We jump here when the key sequence has been thoroughly changed, and
9011 we need to rescan it starting from the beginning. When we jump here,
9012 keybuf[0..mock_input] holds the sequence we should reread. */
9013 replay_sequence:
9015 starting_buffer = current_buffer;
9016 first_unbound = bufsize + 1;
9018 /* Build our list of keymaps.
9019 If we recognize a function key and replace its escape sequence in
9020 keybuf with its symbol, or if the sequence starts with a mouse
9021 click and we need to switch buffers, we jump back here to rebuild
9022 the initial keymaps from the current buffer. */
9023 nmaps = 0;
9025 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
9027 if (2 > nmaps_allocated)
9029 submaps = (Lisp_Object *) alloca (2 * sizeof (submaps[0]));
9030 defs = (Lisp_Object *) alloca (2 * sizeof (defs[0]));
9031 nmaps_allocated = 2;
9033 submaps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map);
9035 else if (!NILP (Voverriding_local_map))
9037 if (2 > nmaps_allocated)
9039 submaps = (Lisp_Object *) alloca (2 * sizeof (submaps[0]));
9040 defs = (Lisp_Object *) alloca (2 * sizeof (defs[0]));
9041 nmaps_allocated = 2;
9043 submaps[nmaps++] = Voverriding_local_map;
9045 else
9047 int nminor;
9048 int total;
9049 Lisp_Object *maps;
9051 nminor = current_minor_maps (0, &maps);
9052 total = nminor + (!NILP (orig_keymap) ? 3 : 2);
9054 if (total > nmaps_allocated)
9056 submaps = (Lisp_Object *) alloca (total * sizeof (submaps[0]));
9057 defs = (Lisp_Object *) alloca (total * sizeof (defs[0]));
9058 nmaps_allocated = total;
9061 if (!NILP (orig_keymap))
9062 submaps[nmaps++] = orig_keymap;
9064 memcpy (submaps + nmaps, maps, nminor * sizeof (submaps[0]));
9066 nmaps += nminor;
9068 submaps[nmaps++] = orig_local_map;
9070 submaps[nmaps++] = current_global_map;
9072 /* Find an accurate initial value for first_binding. */
9073 for (first_binding = 0; first_binding < nmaps; first_binding++)
9074 if (! NILP (submaps[first_binding]))
9075 break;
9077 /* Start from the beginning in keybuf. */
9078 t = 0;
9080 /* These are no-ops the first time through, but if we restart, they
9081 revert the echo area and this_command_keys to their original state. */
9082 this_command_key_count = keys_start;
9083 if (INTERACTIVE && t < mock_input)
9084 echo_truncate (echo_start);
9086 /* If the best binding for the current key sequence is a keymap, or
9087 we may be looking at a function key's escape sequence, keep on
9088 reading. */
9089 while (first_binding < nmaps
9090 /* Keep reading as long as there's a prefix binding. */
9091 ? !NILP (submaps[first_binding])
9092 /* Don't return in the middle of a possible function key sequence,
9093 if the only bindings we found were via case conversion.
9094 Thus, if ESC O a has a function-key-map translation
9095 and ESC o has a binding, don't return after ESC O,
9096 so that we can translate ESC O plus the next character. */
9097 : (/* indec.start < t || fkey.start < t || */ keytran.start < t))
9099 Lisp_Object key;
9100 int used_mouse_menu = 0;
9102 /* Where the last real key started. If we need to throw away a
9103 key that has expanded into more than one element of keybuf
9104 (say, a mouse click on the mode line which is being treated
9105 as [mode-line (mouse-...)], then we backtrack to this point
9106 of keybuf. */
9107 int last_real_key_start;
9109 /* These variables are analogous to echo_start and keys_start;
9110 while those allow us to restart the entire key sequence,
9111 echo_local_start and keys_local_start allow us to throw away
9112 just one key. */
9113 int echo_local_start IF_LINT (= 0);
9114 int keys_local_start, local_first_binding;
9116 eassert (indec.end == t || (indec.end > t && indec.end <= mock_input));
9117 eassert (indec.start <= indec.end);
9118 eassert (fkey.start <= fkey.end);
9119 eassert (keytran.start <= keytran.end);
9120 /* key-translation-map is applied *after* function-key-map
9121 which is itself applied *after* input-decode-map. */
9122 eassert (fkey.end <= indec.start);
9123 eassert (keytran.end <= fkey.start);
9125 if (/* first_unbound < indec.start && first_unbound < fkey.start && */
9126 first_unbound < keytran.start)
9127 { /* The prefix upto first_unbound has no binding and has
9128 no translation left to do either, so we know it's unbound.
9129 If we don't stop now, we risk staying here indefinitely
9130 (if the user keeps entering fkey or keytran prefixes
9131 like C-c ESC ESC ESC ESC ...) */
9132 int i;
9133 for (i = first_unbound + 1; i < t; i++)
9134 keybuf[i - first_unbound - 1] = keybuf[i];
9135 mock_input = t - first_unbound - 1;
9136 indec.end = indec.start -= first_unbound + 1;
9137 indec.map = indec.parent;
9138 fkey.end = fkey.start -= first_unbound + 1;
9139 fkey.map = fkey.parent;
9140 keytran.end = keytran.start -= first_unbound + 1;
9141 keytran.map = keytran.parent;
9142 goto replay_sequence;
9145 if (t >= bufsize)
9146 error ("Key sequence too long");
9148 if (INTERACTIVE)
9149 echo_local_start = echo_length ();
9150 keys_local_start = this_command_key_count;
9151 local_first_binding = first_binding;
9153 replay_key:
9154 /* These are no-ops, unless we throw away a keystroke below and
9155 jumped back up to replay_key; in that case, these restore the
9156 variables to their original state, allowing us to replay the
9157 loop. */
9158 if (INTERACTIVE && t < mock_input)
9159 echo_truncate (echo_local_start);
9160 this_command_key_count = keys_local_start;
9161 first_binding = local_first_binding;
9163 /* By default, assume each event is "real". */
9164 last_real_key_start = t;
9166 /* Does mock_input indicate that we are re-reading a key sequence? */
9167 if (t < mock_input)
9169 key = keybuf[t];
9170 add_command_key (key);
9171 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
9172 && NILP (Fzerop (Vecho_keystrokes)))
9173 echo_char (key);
9176 /* If not, we should actually read a character. */
9177 else
9180 KBOARD *interrupted_kboard = current_kboard;
9181 struct frame *interrupted_frame = SELECTED_FRAME ();
9182 key = read_char (NILP (prompt), nmaps,
9183 (Lisp_Object *) submaps, last_nonmenu_event,
9184 &used_mouse_menu, NULL);
9185 if ((INTEGERP (key) && XINT (key) == -2) /* wrong_kboard_jmpbuf */
9186 /* When switching to a new tty (with a new keyboard),
9187 read_char returns the new buffer, rather than -2
9188 (Bug#5095). This is because `terminal-init-xterm'
9189 calls read-char, which eats the wrong_kboard_jmpbuf
9190 return. Any better way to fix this? -- cyd */
9191 || (interrupted_kboard != current_kboard))
9193 int found = 0;
9194 struct kboard *k;
9196 for (k = all_kboards; k; k = k->next_kboard)
9197 if (k == interrupted_kboard)
9198 found = 1;
9200 if (!found)
9202 /* Don't touch interrupted_kboard when it's been
9203 deleted. */
9204 delayed_switch_frame = Qnil;
9205 goto replay_entire_sequence;
9208 if (!NILP (delayed_switch_frame))
9210 KVAR (interrupted_kboard, kbd_queue)
9211 = Fcons (delayed_switch_frame,
9212 KVAR (interrupted_kboard, kbd_queue));
9213 delayed_switch_frame = Qnil;
9216 while (t > 0)
9217 KVAR (interrupted_kboard, kbd_queue)
9218 = Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue));
9220 /* If the side queue is non-empty, ensure it begins with a
9221 switch-frame, so we'll replay it in the right context. */
9222 if (CONSP (KVAR (interrupted_kboard, kbd_queue))
9223 && (key = XCAR (KVAR (interrupted_kboard, kbd_queue)),
9224 !(EVENT_HAS_PARAMETERS (key)
9225 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
9226 Qswitch_frame))))
9228 Lisp_Object frame;
9229 XSETFRAME (frame, interrupted_frame);
9230 KVAR (interrupted_kboard, kbd_queue)
9231 = Fcons (make_lispy_switch_frame (frame),
9232 KVAR (interrupted_kboard, kbd_queue));
9234 mock_input = 0;
9235 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
9236 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
9237 goto replay_entire_sequence;
9241 /* read_char returns t when it shows a menu and the user rejects it.
9242 Just return -1. */
9243 if (EQ (key, Qt))
9245 unbind_to (count, Qnil);
9246 UNGCPRO_VAR (outer_gcpro);
9247 return -1;
9250 /* read_char returns -1 at the end of a macro.
9251 Emacs 18 handles this by returning immediately with a
9252 zero, so that's what we'll do. */
9253 if (INTEGERP (key) && XINT (key) == -1)
9255 t = 0;
9256 /* The Microsoft C compiler can't handle the goto that
9257 would go here. */
9258 dummyflag = 1;
9259 break;
9262 /* If the current buffer has been changed from under us, the
9263 keymap may have changed, so replay the sequence. */
9264 if (BUFFERP (key))
9266 timer_resume_idle ();
9268 mock_input = t;
9269 /* Reset the current buffer from the selected window
9270 in case something changed the former and not the latter.
9271 This is to be more consistent with the behavior
9272 of the command_loop_1. */
9273 if (fix_current_buffer)
9275 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
9276 Fkill_emacs (Qnil);
9277 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
9278 Fset_buffer (XWINDOW (selected_window)->buffer);
9281 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
9282 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
9283 goto replay_sequence;
9286 /* If we have a quit that was typed in another frame, and
9287 quit_throw_to_read_char switched buffers,
9288 replay to get the right keymap. */
9289 if (INTEGERP (key)
9290 && XINT (key) == quit_char
9291 && current_buffer != starting_buffer)
9293 GROW_RAW_KEYBUF;
9294 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
9295 keybuf[t++] = key;
9296 mock_input = t;
9297 Vquit_flag = Qnil;
9298 orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
9299 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
9300 goto replay_sequence;
9303 Vquit_flag = Qnil;
9305 if (EVENT_HAS_PARAMETERS (key)
9306 /* Either a `switch-frame' or a `select-window' event. */
9307 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame))
9309 /* If we're at the beginning of a key sequence, and the caller
9310 says it's okay, go ahead and return this event. If we're
9311 in the midst of a key sequence, delay it until the end. */
9312 if (t > 0 || !can_return_switch_frame)
9314 delayed_switch_frame = key;
9315 goto replay_key;
9319 GROW_RAW_KEYBUF;
9320 ASET (raw_keybuf, raw_keybuf_count, key);
9321 raw_keybuf_count++;
9324 /* Clicks in non-text areas get prefixed by the symbol
9325 in their CHAR-ADDRESS field. For example, a click on
9326 the mode line is prefixed by the symbol `mode-line'.
9328 Furthermore, key sequences beginning with mouse clicks
9329 are read using the keymaps of the buffer clicked on, not
9330 the current buffer. So we may have to switch the buffer
9331 here.
9333 When we turn one event into two events, we must make sure
9334 that neither of the two looks like the original--so that,
9335 if we replay the events, they won't be expanded again.
9336 If not for this, such reexpansion could happen either here
9337 or when user programs play with this-command-keys. */
9338 if (EVENT_HAS_PARAMETERS (key))
9340 Lisp_Object kind;
9341 Lisp_Object string;
9343 kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
9344 if (EQ (kind, Qmouse_click))
9346 Lisp_Object window, posn;
9348 window = POSN_WINDOW (EVENT_START (key));
9349 posn = POSN_POSN (EVENT_START (key));
9351 if (CONSP (posn)
9352 || (!NILP (fake_prefixed_keys)
9353 && !NILP (Fmemq (key, fake_prefixed_keys))))
9355 /* We're looking a second time at an event for which
9356 we generated a fake prefix key. Set
9357 last_real_key_start appropriately. */
9358 if (t > 0)
9359 last_real_key_start = t - 1;
9362 /* Key sequences beginning with mouse clicks are
9363 read using the keymaps in the buffer clicked on,
9364 not the current buffer. If we're at the
9365 beginning of a key sequence, switch buffers. */
9366 if (last_real_key_start == 0
9367 && WINDOWP (window)
9368 && BUFFERP (XWINDOW (window)->buffer)
9369 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
9371 XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key;
9372 keybuf[t] = key;
9373 mock_input = t + 1;
9375 /* Arrange to go back to the original buffer once we're
9376 done reading the key sequence. Note that we can't
9377 use save_excursion_{save,restore} here, because they
9378 save point as well as the current buffer; we don't
9379 want to save point, because redisplay may change it,
9380 to accommodate a Fset_window_start or something. We
9381 don't want to do this at the top of the function,
9382 because we may get input from a subprocess which
9383 wants to change the selected window and stuff (say,
9384 emacsclient). */
9385 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
9387 if (! FRAME_LIVE_P (XFRAME (selected_frame)))
9388 Fkill_emacs (Qnil);
9389 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
9390 orig_local_map = get_local_map (PT, current_buffer,
9391 Qlocal_map);
9392 orig_keymap = get_local_map (PT, current_buffer, Qkeymap);
9393 goto replay_sequence;
9396 /* For a mouse click, get the local text-property keymap
9397 of the place clicked on, rather than point. */
9398 if (last_real_key_start == 0
9399 && CONSP (XCDR (key))
9400 && ! localized_local_map)
9402 Lisp_Object map_here, start, pos;
9404 localized_local_map = 1;
9405 start = EVENT_START (key);
9407 if (CONSP (start) && POSN_INBUFFER_P (start))
9409 pos = POSN_BUFFER_POSN (start);
9410 if (INTEGERP (pos)
9411 && XINT (pos) >= BEGV
9412 && XINT (pos) <= ZV)
9414 map_here = get_local_map (XINT (pos),
9415 current_buffer, Qlocal_map);
9416 if (!EQ (map_here, orig_local_map))
9418 orig_local_map = map_here;
9419 ++localized_local_map;
9422 map_here = get_local_map (XINT (pos),
9423 current_buffer, Qkeymap);
9424 if (!EQ (map_here, orig_keymap))
9426 orig_keymap = map_here;
9427 ++localized_local_map;
9430 if (localized_local_map > 1)
9432 keybuf[t] = key;
9433 mock_input = t + 1;
9435 goto replay_sequence;
9441 /* Expand mode-line and scroll-bar events into two events:
9442 use posn as a fake prefix key. */
9443 if (SYMBOLP (posn)
9444 && (NILP (fake_prefixed_keys)
9445 || NILP (Fmemq (key, fake_prefixed_keys))))
9447 if (t + 1 >= bufsize)
9448 error ("Key sequence too long");
9450 keybuf[t] = posn;
9451 keybuf[t + 1] = key;
9452 mock_input = t + 2;
9454 /* Record that a fake prefix key has been generated
9455 for KEY. Don't modify the event; this would
9456 prevent proper action when the event is pushed
9457 back into unread-command-events. */
9458 fake_prefixed_keys = Fcons (key, fake_prefixed_keys);
9460 /* If on a mode line string with a local keymap,
9461 reconsider the key sequence with that keymap. */
9462 if (string = POSN_STRING (EVENT_START (key)),
9463 (CONSP (string) && STRINGP (XCAR (string))))
9465 Lisp_Object pos, map, map2;
9467 pos = XCDR (string);
9468 string = XCAR (string);
9469 if (XINT (pos) >= 0
9470 && XINT (pos) < SCHARS (string))
9472 map = Fget_text_property (pos, Qlocal_map, string);
9473 if (!NILP (map))
9474 orig_local_map = map;
9475 map2 = Fget_text_property (pos, Qkeymap, string);
9476 if (!NILP (map2))
9477 orig_keymap = map2;
9478 if (!NILP (map) || !NILP (map2))
9479 goto replay_sequence;
9483 goto replay_key;
9485 else if (NILP (from_string)
9486 && (string = POSN_STRING (EVENT_START (key)),
9487 (CONSP (string) && STRINGP (XCAR (string)))))
9489 /* For a click on a string, i.e. overlay string or a
9490 string displayed via the `display' property,
9491 consider `local-map' and `keymap' properties of
9492 that string. */
9493 Lisp_Object pos, map, map2;
9495 pos = XCDR (string);
9496 string = XCAR (string);
9497 if (XINT (pos) >= 0
9498 && XINT (pos) < SCHARS (string))
9500 map = Fget_text_property (pos, Qlocal_map, string);
9501 if (!NILP (map))
9502 orig_local_map = map;
9503 map2 = Fget_text_property (pos, Qkeymap, string);
9504 if (!NILP (map2))
9505 orig_keymap = map2;
9507 if (!NILP (map) || !NILP (map2))
9509 from_string = string;
9510 keybuf[t++] = key;
9511 mock_input = t;
9512 goto replay_sequence;
9517 else if (CONSP (XCDR (key))
9518 && CONSP (EVENT_START (key))
9519 && CONSP (XCDR (EVENT_START (key))))
9521 Lisp_Object posn;
9523 posn = POSN_POSN (EVENT_START (key));
9524 /* Handle menu-bar events:
9525 insert the dummy prefix event `menu-bar'. */
9526 if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar))
9528 if (t + 1 >= bufsize)
9529 error ("Key sequence too long");
9530 keybuf[t] = posn;
9531 keybuf[t+1] = key;
9533 /* Zap the position in key, so we know that we've
9534 expanded it, and don't try to do so again. */
9535 POSN_SET_POSN (EVENT_START (key),
9536 Fcons (posn, Qnil));
9538 mock_input = t + 2;
9539 goto replay_sequence;
9541 else if (CONSP (posn))
9543 /* We're looking at the second event of a
9544 sequence which we expanded before. Set
9545 last_real_key_start appropriately. */
9546 if (last_real_key_start == t && t > 0)
9547 last_real_key_start = t - 1;
9552 /* We have finally decided that KEY is something we might want
9553 to look up. */
9554 first_binding = (follow_key (key,
9555 nmaps - first_binding,
9556 submaps + first_binding,
9557 defs + first_binding,
9558 submaps + first_binding)
9559 + first_binding);
9561 /* If KEY wasn't bound, we'll try some fallbacks. */
9562 if (first_binding < nmaps)
9563 /* This is needed for the following scenario:
9564 event 0: a down-event that gets dropped by calling replay_key.
9565 event 1: some normal prefix like C-h.
9566 After event 0, first_unbound is 0, after event 1 indec.start,
9567 fkey.start, and keytran.start are all 1, so when we see that
9568 C-h is bound, we need to update first_unbound. */
9569 first_unbound = max (t + 1, first_unbound);
9570 else
9572 Lisp_Object head;
9574 /* Remember the position to put an upper bound on indec.start. */
9575 first_unbound = min (t, first_unbound);
9577 head = EVENT_HEAD (key);
9578 if (help_char_p (head) && t > 0)
9580 read_key_sequence_cmd = Vprefix_help_command;
9581 keybuf[t++] = key;
9582 last_nonmenu_event = key;
9583 /* The Microsoft C compiler can't handle the goto that
9584 would go here. */
9585 dummyflag = 1;
9586 break;
9589 if (SYMBOLP (head))
9591 Lisp_Object breakdown;
9592 int modifiers;
9594 breakdown = parse_modifiers (head);
9595 modifiers = XINT (XCAR (XCDR (breakdown)));
9596 /* Attempt to reduce an unbound mouse event to a simpler
9597 event that is bound:
9598 Drags reduce to clicks.
9599 Double-clicks reduce to clicks.
9600 Triple-clicks reduce to double-clicks, then to clicks.
9601 Down-clicks are eliminated.
9602 Double-downs reduce to downs, then are eliminated.
9603 Triple-downs reduce to double-downs, then to downs,
9604 then are eliminated. */
9605 if (modifiers & (down_modifier | drag_modifier
9606 | double_modifier | triple_modifier))
9608 while (modifiers & (down_modifier | drag_modifier
9609 | double_modifier | triple_modifier))
9611 Lisp_Object new_head, new_click;
9612 if (modifiers & triple_modifier)
9613 modifiers ^= (double_modifier | triple_modifier);
9614 else if (modifiers & double_modifier)
9615 modifiers &= ~double_modifier;
9616 else if (modifiers & drag_modifier)
9617 modifiers &= ~drag_modifier;
9618 else
9620 /* Dispose of this `down' event by simply jumping
9621 back to replay_key, to get another event.
9623 Note that if this event came from mock input,
9624 then just jumping back to replay_key will just
9625 hand it to us again. So we have to wipe out any
9626 mock input.
9628 We could delete keybuf[t] and shift everything
9629 after that to the left by one spot, but we'd also
9630 have to fix up any variable that points into
9631 keybuf, and shifting isn't really necessary
9632 anyway.
9634 Adding prefixes for non-textual mouse clicks
9635 creates two characters of mock input, and both
9636 must be thrown away. If we're only looking at
9637 the prefix now, we can just jump back to
9638 replay_key. On the other hand, if we've already
9639 processed the prefix, and now the actual click
9640 itself is giving us trouble, then we've lost the
9641 state of the keymaps we want to backtrack to, and
9642 we need to replay the whole sequence to rebuild
9645 Beyond that, only function key expansion could
9646 create more than two keys, but that should never
9647 generate mouse events, so it's okay to zero
9648 mock_input in that case too.
9650 FIXME: The above paragraph seems just plain
9651 wrong, if you consider things like
9652 xterm-mouse-mode. -stef
9654 Isn't this just the most wonderful code ever? */
9656 /* If mock_input > t + 1, the above simplification
9657 will actually end up dropping keys on the floor.
9658 This is probably OK for now, but even
9659 if mock_input <= t + 1, we need to adjust indec,
9660 fkey, and keytran.
9661 Typical case [header-line down-mouse-N]:
9662 mock_input = 2, t = 1, fkey.end = 1,
9663 last_real_key_start = 0. */
9664 if (indec.end > last_real_key_start)
9666 indec.end = indec.start
9667 = min (last_real_key_start, indec.start);
9668 indec.map = indec.parent;
9669 if (fkey.end > last_real_key_start)
9671 fkey.end = fkey.start
9672 = min (last_real_key_start, fkey.start);
9673 fkey.map = fkey.parent;
9674 if (keytran.end > last_real_key_start)
9676 keytran.end = keytran.start
9677 = min (last_real_key_start, keytran.start);
9678 keytran.map = keytran.parent;
9682 if (t == last_real_key_start)
9684 mock_input = 0;
9685 goto replay_key;
9687 else
9689 mock_input = last_real_key_start;
9690 goto replay_sequence;
9694 new_head
9695 = apply_modifiers (modifiers, XCAR (breakdown));
9696 new_click
9697 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
9699 /* Look for a binding for this new key. follow_key
9700 promises that it didn't munge submaps the
9701 last time we called it, since key was unbound. */
9702 first_binding
9703 = (follow_key (new_click,
9704 nmaps - local_first_binding,
9705 submaps + local_first_binding,
9706 defs + local_first_binding,
9707 submaps + local_first_binding)
9708 + local_first_binding);
9710 /* If that click is bound, go for it. */
9711 if (first_binding < nmaps)
9713 key = new_click;
9714 break;
9716 /* Otherwise, we'll leave key set to the drag event. */
9722 keybuf[t++] = key;
9723 /* Normally, last_nonmenu_event gets the previous key we read.
9724 But when a mouse popup menu is being used,
9725 we don't update last_nonmenu_event; it continues to hold the mouse
9726 event that preceded the first level of menu. */
9727 if (!used_mouse_menu)
9728 last_nonmenu_event = key;
9730 /* Record what part of this_command_keys is the current key sequence. */
9731 this_single_command_key_start = this_command_key_count - t;
9733 /* Look for this sequence in input-decode-map.
9734 Scan from indec.end until we find a bound suffix. */
9735 while (indec.end < t)
9737 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9738 int done, diff;
9740 GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
9741 done = keyremap_step (keybuf, bufsize, &indec, max (t, mock_input),
9742 1, &diff, prompt);
9743 UNGCPRO;
9744 if (done)
9746 mock_input = diff + max (t, mock_input);
9747 goto replay_sequence;
9751 if (first_binding < nmaps && NILP (submaps[first_binding])
9752 && indec.start >= t)
9753 /* There is a binding and it's not a prefix.
9754 (and it doesn't have any input-decode-map translation pending).
9755 There is thus no function-key in this sequence.
9756 Moving fkey.start is important in this case to allow keytran.start
9757 to go over the sequence before we return (since we keep the
9758 invariant that keytran.end <= fkey.start). */
9760 if (fkey.start < t)
9761 (fkey.start = fkey.end = t, fkey.map = fkey.parent);
9763 else
9764 /* If the sequence is unbound, see if we can hang a function key
9765 off the end of it. */
9766 /* Continue scan from fkey.end until we find a bound suffix. */
9767 while (fkey.end < indec.start)
9769 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9770 int done, diff;
9772 GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
9773 done = keyremap_step (keybuf, bufsize, &fkey,
9774 max (t, mock_input),
9775 /* If there's a binding (i.e.
9776 first_binding >= nmaps) we don't want
9777 to apply this function-key-mapping. */
9778 fkey.end + 1 == t && first_binding >= nmaps,
9779 &diff, prompt);
9780 UNGCPRO;
9781 if (done)
9783 mock_input = diff + max (t, mock_input);
9784 /* Adjust the input-decode-map counters. */
9785 indec.end += diff;
9786 indec.start += diff;
9788 goto replay_sequence;
9792 /* Look for this sequence in key-translation-map.
9793 Scan from keytran.end until we find a bound suffix. */
9794 while (keytran.end < fkey.start)
9796 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9797 int done, diff;
9799 GCPRO4 (indec.map, fkey.map, keytran.map, delayed_switch_frame);
9800 done = keyremap_step (keybuf, bufsize, &keytran, max (t, mock_input),
9801 1, &diff, prompt);
9802 UNGCPRO;
9803 if (done)
9805 mock_input = diff + max (t, mock_input);
9806 /* Adjust the function-key-map and input-decode-map counters. */
9807 indec.end += diff;
9808 indec.start += diff;
9809 fkey.end += diff;
9810 fkey.start += diff;
9812 goto replay_sequence;
9816 /* If KEY is not defined in any of the keymaps,
9817 and cannot be part of a function key or translation,
9818 and is an upper case letter
9819 use the corresponding lower-case letter instead. */
9820 if (first_binding >= nmaps
9821 && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t
9822 && INTEGERP (key)
9823 && ((CHARACTERP (make_number (XINT (key) & ~CHAR_MODIFIER_MASK))
9824 && uppercasep (XINT (key) & ~CHAR_MODIFIER_MASK))
9825 || (XINT (key) & shift_modifier)))
9827 Lisp_Object new_key;
9829 original_uppercase = key;
9830 original_uppercase_position = t - 1;
9832 if (XINT (key) & shift_modifier)
9833 XSETINT (new_key, XINT (key) & ~shift_modifier);
9834 else
9835 XSETINT (new_key, (downcase (XINT (key) & ~CHAR_MODIFIER_MASK)
9836 | (XINT (key) & CHAR_MODIFIER_MASK)));
9838 /* We have to do this unconditionally, regardless of whether
9839 the lower-case char is defined in the keymaps, because they
9840 might get translated through function-key-map. */
9841 keybuf[t - 1] = new_key;
9842 mock_input = max (t, mock_input);
9843 shift_translated = 1;
9845 goto replay_sequence;
9847 /* If KEY is not defined in any of the keymaps,
9848 and cannot be part of a function key or translation,
9849 and is a shifted function key,
9850 use the corresponding unshifted function key instead. */
9851 if (first_binding >= nmaps
9852 && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t)
9854 Lisp_Object breakdown = parse_modifiers (key);
9855 int modifiers
9856 = CONSP (breakdown) ? (XINT (XCAR (XCDR (breakdown)))) : 0;
9858 if (modifiers & shift_modifier
9859 /* Treat uppercase keys as shifted. */
9860 || (INTEGERP (key)
9861 && (KEY_TO_CHAR (key)
9862 < XCHAR_TABLE (BVAR (current_buffer, downcase_table))->size)
9863 && uppercasep (KEY_TO_CHAR (key))))
9865 Lisp_Object new_key
9866 = (modifiers & shift_modifier
9867 ? apply_modifiers (modifiers & ~shift_modifier,
9868 XCAR (breakdown))
9869 : make_number (downcase (KEY_TO_CHAR (key)) | modifiers));
9871 original_uppercase = key;
9872 original_uppercase_position = t - 1;
9874 /* We have to do this unconditionally, regardless of whether
9875 the lower-case char is defined in the keymaps, because they
9876 might get translated through function-key-map. */
9877 keybuf[t - 1] = new_key;
9878 mock_input = max (t, mock_input);
9879 /* Reset fkey (and consequently keytran) to apply
9880 function-key-map on the result, so that S-backspace is
9881 correctly mapped to DEL (via backspace). OTOH,
9882 input-decode-map doesn't need to go through it again. */
9883 fkey.start = fkey.end = 0;
9884 keytran.start = keytran.end = 0;
9885 shift_translated = 1;
9887 goto replay_sequence;
9891 if (!dummyflag)
9892 read_key_sequence_cmd = (first_binding < nmaps
9893 ? defs[first_binding]
9894 : Qnil);
9896 unread_switch_frame = delayed_switch_frame;
9897 unbind_to (count, Qnil);
9899 /* Don't downcase the last character if the caller says don't.
9900 Don't downcase it if the result is undefined, either. */
9901 if ((dont_downcase_last || first_binding >= nmaps)
9902 && t > 0
9903 && t - 1 == original_uppercase_position)
9905 keybuf[t - 1] = original_uppercase;
9906 shift_translated = 0;
9909 if (shift_translated)
9910 Vthis_command_keys_shift_translated = Qt;
9912 /* Occasionally we fabricate events, perhaps by expanding something
9913 according to function-key-map, or by adding a prefix symbol to a
9914 mouse click in the scroll bar or modeline. In this cases, return
9915 the entire generated key sequence, even if we hit an unbound
9916 prefix or a definition before the end. This means that you will
9917 be able to push back the event properly, and also means that
9918 read-key-sequence will always return a logical unit.
9920 Better ideas? */
9921 for (; t < mock_input; t++)
9923 if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes))
9924 && NILP (Fzerop (Vecho_keystrokes)))
9925 echo_char (keybuf[t]);
9926 add_command_key (keybuf[t]);
9929 UNGCPRO_VAR (outer_gcpro);
9930 return t;
9933 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0,
9934 doc: /* Read a sequence of keystrokes and return as a string or vector.
9935 The sequence is sufficient to specify a non-prefix command in the
9936 current local and global maps.
9938 First arg PROMPT is a prompt string. If nil, do not prompt specially.
9939 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos
9940 as a continuation of the previous key.
9942 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not
9943 convert the last event to lower case. (Normally any upper case event
9944 is converted to lower case if the original event is undefined and the lower
9945 case equivalent is defined.) A non-nil value is appropriate for reading
9946 a key sequence to be defined.
9948 A C-g typed while in this function is treated like any other character,
9949 and `quit-flag' is not set.
9951 If the key sequence starts with a mouse click, then the sequence is read
9952 using the keymaps of the buffer of the window clicked in, not the buffer
9953 of the selected window as normal.
9955 `read-key-sequence' drops unbound button-down events, since you normally
9956 only care about the click or drag events which follow them. If a drag
9957 or multi-click event is unbound, but the corresponding click event would
9958 be bound, `read-key-sequence' turns the event into a click event at the
9959 drag's starting position. This means that you don't have to distinguish
9960 between click and drag, double, or triple events unless you want to.
9962 `read-key-sequence' prefixes mouse events on mode lines, the vertical
9963 lines separating windows, and scroll bars with imaginary keys
9964 `mode-line', `vertical-line', and `vertical-scroll-bar'.
9966 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this
9967 function will process a switch-frame event if the user switches frames
9968 before typing anything. If the user switches frames in the middle of a
9969 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME
9970 is nil, then the event will be put off until after the current key sequence.
9972 `read-key-sequence' checks `function-key-map' for function key
9973 sequences, where they wouldn't conflict with ordinary bindings. See
9974 `function-key-map' for more details.
9976 The optional fifth argument CMD-LOOP, if non-nil, means
9977 that this key sequence is being read by something that will
9978 read commands one after another. It should be nil if the caller
9979 will read just one key sequence. */)
9980 (Lisp_Object prompt, Lisp_Object continue_echo, Lisp_Object dont_downcase_last, Lisp_Object can_return_switch_frame, Lisp_Object cmd_loop)
9982 Lisp_Object keybuf[30];
9983 register int i;
9984 struct gcpro gcpro1;
9985 int count = SPECPDL_INDEX ();
9987 if (!NILP (prompt))
9988 CHECK_STRING (prompt);
9989 QUIT;
9991 specbind (Qinput_method_exit_on_first_char,
9992 (NILP (cmd_loop) ? Qt : Qnil));
9993 specbind (Qinput_method_use_echo_area,
9994 (NILP (cmd_loop) ? Qt : Qnil));
9996 memset (keybuf, 0, sizeof keybuf);
9997 GCPRO1 (keybuf[0]);
9998 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
10000 if (NILP (continue_echo))
10002 this_command_key_count = 0;
10003 this_command_key_count_reset = 0;
10004 this_single_command_key_start = 0;
10007 #ifdef HAVE_WINDOW_SYSTEM
10008 if (display_hourglass_p)
10009 cancel_hourglass ();
10010 #endif
10012 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
10013 prompt, ! NILP (dont_downcase_last),
10014 ! NILP (can_return_switch_frame), 0);
10016 #if 0 /* The following is fine for code reading a key sequence and
10017 then proceeding with a lenghty computation, but it's not good
10018 for code reading keys in a loop, like an input method. */
10019 #ifdef HAVE_WINDOW_SYSTEM
10020 if (display_hourglass_p)
10021 start_hourglass ();
10022 #endif
10023 #endif
10025 if (i == -1)
10027 Vquit_flag = Qt;
10028 QUIT;
10030 UNGCPRO;
10031 return unbind_to (count, make_event_array (i, keybuf));
10034 DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,
10035 Sread_key_sequence_vector, 1, 5, 0,
10036 doc: /* Like `read-key-sequence' but always return a vector. */)
10037 (Lisp_Object prompt, Lisp_Object continue_echo, Lisp_Object dont_downcase_last, Lisp_Object can_return_switch_frame, Lisp_Object cmd_loop)
10039 Lisp_Object keybuf[30];
10040 register int i;
10041 struct gcpro gcpro1;
10042 int count = SPECPDL_INDEX ();
10044 if (!NILP (prompt))
10045 CHECK_STRING (prompt);
10046 QUIT;
10048 specbind (Qinput_method_exit_on_first_char,
10049 (NILP (cmd_loop) ? Qt : Qnil));
10050 specbind (Qinput_method_use_echo_area,
10051 (NILP (cmd_loop) ? Qt : Qnil));
10053 memset (keybuf, 0, sizeof keybuf);
10054 GCPRO1 (keybuf[0]);
10055 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
10057 if (NILP (continue_echo))
10059 this_command_key_count = 0;
10060 this_command_key_count_reset = 0;
10061 this_single_command_key_start = 0;
10064 #ifdef HAVE_WINDOW_SYSTEM
10065 if (display_hourglass_p)
10066 cancel_hourglass ();
10067 #endif
10069 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
10070 prompt, ! NILP (dont_downcase_last),
10071 ! NILP (can_return_switch_frame), 0);
10073 #ifdef HAVE_WINDOW_SYSTEM
10074 if (display_hourglass_p)
10075 start_hourglass ();
10076 #endif
10078 if (i == -1)
10080 Vquit_flag = Qt;
10081 QUIT;
10083 UNGCPRO;
10084 return unbind_to (count, Fvector (i, keybuf));
10087 DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0,
10088 doc: /* Execute CMD as an editor command.
10089 CMD must be a symbol that satisfies the `commandp' predicate.
10090 Optional second arg RECORD-FLAG non-nil
10091 means unconditionally put this command in `command-history'.
10092 Otherwise, that is done only if an arg is read using the minibuffer.
10093 The argument KEYS specifies the value to use instead of (this-command-keys)
10094 when reading the arguments; if it is nil, (this-command-keys) is used.
10095 The argument SPECIAL, if non-nil, means that this command is executing
10096 a special event, so ignore the prefix argument and don't clear it. */)
10097 (Lisp_Object cmd, Lisp_Object record_flag, Lisp_Object keys, Lisp_Object special)
10099 register Lisp_Object final;
10100 register Lisp_Object tem;
10101 Lisp_Object prefixarg;
10103 debug_on_next_call = 0;
10105 if (NILP (special))
10107 prefixarg = KVAR (current_kboard, Vprefix_arg);
10108 Vcurrent_prefix_arg = prefixarg;
10109 KVAR (current_kboard, Vprefix_arg) = Qnil;
10111 else
10112 prefixarg = Qnil;
10114 if (SYMBOLP (cmd))
10116 tem = Fget (cmd, Qdisabled);
10117 if (!NILP (tem))
10119 tem = Fsymbol_value (Qdisabled_command_function);
10120 if (!NILP (tem))
10121 return Frun_hooks (1, &Qdisabled_command_function);
10125 while (1)
10127 final = Findirect_function (cmd, Qnil);
10129 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
10131 struct gcpro gcpro1, gcpro2;
10133 GCPRO2 (cmd, prefixarg);
10134 do_autoload (final, cmd);
10135 UNGCPRO;
10137 else
10138 break;
10141 if (STRINGP (final) || VECTORP (final))
10143 /* If requested, place the macro in the command history. For
10144 other sorts of commands, call-interactively takes care of
10145 this. */
10146 if (!NILP (record_flag))
10148 Vcommand_history
10149 = Fcons (Fcons (Qexecute_kbd_macro,
10150 Fcons (final, Fcons (prefixarg, Qnil))),
10151 Vcommand_history);
10153 /* Don't keep command history around forever. */
10154 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
10156 tem = Fnthcdr (Vhistory_length, Vcommand_history);
10157 if (CONSP (tem))
10158 XSETCDR (tem, Qnil);
10162 return Fexecute_kbd_macro (final, prefixarg, Qnil);
10165 if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
10166 /* Don't call Fcall_interactively directly because we want to make
10167 sure the backtrace has an entry for `call-interactively'.
10168 For the same reason, pass `cmd' rather than `final'. */
10169 return call3 (Qcall_interactively, cmd, record_flag, keys);
10171 return Qnil;
10176 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
10177 1, 1, "P",
10178 doc: /* Read function name, then read its arguments and call it.
10180 To pass a numeric argument to the command you are invoking with, specify
10181 the numeric argument to this command.
10183 Noninteractively, the argument PREFIXARG is the prefix argument to
10184 give to the command you invoke, if it asks for an argument. */)
10185 (Lisp_Object prefixarg)
10187 Lisp_Object function;
10188 EMACS_INT saved_last_point_position;
10189 Lisp_Object saved_keys, saved_last_point_position_buffer;
10190 Lisp_Object bindings, value;
10191 struct gcpro gcpro1, gcpro2, gcpro3;
10192 #ifdef HAVE_WINDOW_SYSTEM
10193 /* The call to Fcompleting_read will start and cancel the hourglass,
10194 but if the hourglass was already scheduled, this means that no
10195 hourglass will be shown for the actual M-x command itself.
10196 So we restart it if it is already scheduled. Note that checking
10197 hourglass_shown_p is not enough, normally the hourglass is not shown,
10198 just scheduled to be shown. */
10199 int hstarted = hourglass_started ();
10200 #endif
10202 saved_keys = Fvector (this_command_key_count,
10203 XVECTOR (this_command_keys)->contents);
10204 saved_last_point_position_buffer = last_point_position_buffer;
10205 saved_last_point_position = last_point_position;
10206 GCPRO3 (saved_keys, prefixarg, saved_last_point_position_buffer);
10208 function = call0 (intern ("read-extended-command"));
10210 #ifdef HAVE_WINDOW_SYSTEM
10211 if (hstarted) start_hourglass ();
10212 #endif
10214 if (STRINGP (function) && SCHARS (function) == 0)
10215 error ("No command name given");
10217 /* Set this_command_keys to the concatenation of saved_keys and
10218 function, followed by a RET. */
10220 Lisp_Object *keys;
10221 int i;
10223 this_command_key_count = 0;
10224 this_command_key_count_reset = 0;
10225 this_single_command_key_start = 0;
10227 keys = XVECTOR (saved_keys)->contents;
10228 for (i = 0; i < XVECTOR (saved_keys)->size; i++)
10229 add_command_key (keys[i]);
10231 for (i = 0; i < SCHARS (function); i++)
10232 add_command_key (Faref (function, make_number (i)));
10234 add_command_key (make_number ('\015'));
10237 last_point_position = saved_last_point_position;
10238 last_point_position_buffer = saved_last_point_position_buffer;
10240 UNGCPRO;
10242 function = Fintern (function, Qnil);
10243 KVAR (current_kboard, Vprefix_arg) = prefixarg;
10244 Vthis_command = function;
10245 real_this_command = function;
10247 /* If enabled, show which key runs this command. */
10248 if (!NILP (Vsuggest_key_bindings)
10249 && NILP (Vexecuting_kbd_macro)
10250 && SYMBOLP (function))
10251 bindings = Fwhere_is_internal (function, Voverriding_local_map,
10252 Qt, Qnil, Qnil);
10253 else
10254 bindings = Qnil;
10256 value = Qnil;
10257 GCPRO3 (bindings, value, function);
10258 value = Fcommand_execute (function, Qt, Qnil, Qnil);
10260 /* If the command has a key binding, print it now. */
10261 if (!NILP (bindings)
10262 && ! (VECTORP (bindings) && EQ (Faref (bindings, make_number (0)),
10263 Qmouse_movement)))
10265 /* But first wait, and skip the message if there is input. */
10266 Lisp_Object waited;
10268 /* If this command displayed something in the echo area;
10269 wait a few seconds, then display our suggestion message. */
10270 if (NILP (echo_area_buffer[0]))
10271 waited = sit_for (make_number (0), 0, 2);
10272 else if (NUMBERP (Vsuggest_key_bindings))
10273 waited = sit_for (Vsuggest_key_bindings, 0, 2);
10274 else
10275 waited = sit_for (make_number (2), 0, 2);
10277 if (!NILP (waited) && ! CONSP (Vunread_command_events))
10279 Lisp_Object binding;
10280 char *newmessage;
10281 int message_p = push_message ();
10282 int count = SPECPDL_INDEX ();
10284 record_unwind_protect (pop_message_unwind, Qnil);
10285 binding = Fkey_description (bindings, Qnil);
10287 newmessage
10288 = (char *) alloca (SCHARS (SYMBOL_NAME (function))
10289 + SBYTES (binding)
10290 + 100);
10291 sprintf (newmessage, "You can run the command `%s' with %s",
10292 SDATA (SYMBOL_NAME (function)),
10293 SDATA (binding));
10294 message2_nolog (newmessage,
10295 strlen (newmessage),
10296 STRING_MULTIBYTE (binding));
10297 if (NUMBERP (Vsuggest_key_bindings))
10298 waited = sit_for (Vsuggest_key_bindings, 0, 2);
10299 else
10300 waited = sit_for (make_number (2), 0, 2);
10302 if (!NILP (waited) && message_p)
10303 restore_message ();
10305 unbind_to (count, Qnil);
10309 RETURN_UNGCPRO (value);
10313 /* Return nonzero if input events are pending. */
10316 detect_input_pending (void)
10318 if (!input_pending)
10319 get_input_pending (&input_pending, 0);
10321 return input_pending;
10324 /* Return nonzero if input events other than mouse movements are
10325 pending. */
10328 detect_input_pending_ignore_squeezables (void)
10330 if (!input_pending)
10331 get_input_pending (&input_pending, READABLE_EVENTS_IGNORE_SQUEEZABLES);
10333 return input_pending;
10336 /* Return nonzero if input events are pending, and run any pending timers. */
10339 detect_input_pending_run_timers (int do_display)
10341 int old_timers_run = timers_run;
10343 if (!input_pending)
10344 get_input_pending (&input_pending, READABLE_EVENTS_DO_TIMERS_NOW);
10346 if (old_timers_run != timers_run && do_display)
10348 redisplay_preserve_echo_area (8);
10349 /* The following fixes a bug when using lazy-lock with
10350 lazy-lock-defer-on-the-fly set to t, i.e. when fontifying
10351 from an idle timer function. The symptom of the bug is that
10352 the cursor sometimes doesn't become visible until the next X
10353 event is processed. --gerd. */
10355 Lisp_Object tail, frame;
10356 FOR_EACH_FRAME (tail, frame)
10357 if (FRAME_RIF (XFRAME (frame)))
10358 FRAME_RIF (XFRAME (frame))->flush_display (XFRAME (frame));
10362 return input_pending;
10365 /* This is called in some cases before a possible quit.
10366 It cases the next call to detect_input_pending to recompute input_pending.
10367 So calling this function unnecessarily can't do any harm. */
10369 void
10370 clear_input_pending (void)
10372 input_pending = 0;
10375 /* Return nonzero if there are pending requeued events.
10376 This isn't used yet. The hope is to make wait_reading_process_output
10377 call it, and return if it runs Lisp code that unreads something.
10378 The problem is, kbd_buffer_get_event needs to be fixed to know what
10379 to do in that case. It isn't trivial. */
10382 requeued_events_pending_p (void)
10384 return (!NILP (Vunread_command_events) || unread_command_char != -1);
10388 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
10389 doc: /* Return t if command input is currently available with no wait.
10390 Actually, the value is nil only if we can be sure that no input is available;
10391 if there is a doubt, the value is t. */)
10392 (void)
10394 if (!NILP (Vunread_command_events) || unread_command_char != -1
10395 || !NILP (Vunread_post_input_method_events)
10396 || !NILP (Vunread_input_method_events))
10397 return (Qt);
10399 get_input_pending (&input_pending,
10400 READABLE_EVENTS_DO_TIMERS_NOW
10401 | READABLE_EVENTS_FILTER_EVENTS);
10402 return input_pending > 0 ? Qt : Qnil;
10405 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
10406 doc: /* Return vector of last 300 events, not counting those from keyboard macros. */)
10407 (void)
10409 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
10410 Lisp_Object val;
10412 if (total_keys < NUM_RECENT_KEYS)
10413 return Fvector (total_keys, keys);
10414 else
10416 val = Fvector (NUM_RECENT_KEYS, keys);
10417 memcpy (XVECTOR (val)->contents, keys + recent_keys_index,
10418 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
10419 memcpy (XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
10420 keys, recent_keys_index * sizeof (Lisp_Object));
10421 return val;
10425 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
10426 doc: /* Return the key sequence that invoked this command.
10427 However, if the command has called `read-key-sequence', it returns
10428 the last key sequence that has been read.
10429 The value is a string or a vector.
10431 See also `this-command-keys-vector'. */)
10432 (void)
10434 return make_event_array (this_command_key_count,
10435 XVECTOR (this_command_keys)->contents);
10438 DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0,
10439 doc: /* Return the key sequence that invoked this command, as a vector.
10440 However, if the command has called `read-key-sequence', it returns
10441 the last key sequence that has been read.
10443 See also `this-command-keys'. */)
10444 (void)
10446 return Fvector (this_command_key_count,
10447 XVECTOR (this_command_keys)->contents);
10450 DEFUN ("this-single-command-keys", Fthis_single_command_keys,
10451 Sthis_single_command_keys, 0, 0, 0,
10452 doc: /* Return the key sequence that invoked this command.
10453 More generally, it returns the last key sequence read, either by
10454 the command loop or by `read-key-sequence'.
10455 Unlike `this-command-keys', this function's value
10456 does not include prefix arguments.
10457 The value is always a vector. */)
10458 (void)
10460 return Fvector (this_command_key_count
10461 - this_single_command_key_start,
10462 (XVECTOR (this_command_keys)->contents
10463 + this_single_command_key_start));
10466 DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,
10467 Sthis_single_command_raw_keys, 0, 0, 0,
10468 doc: /* Return the raw events that were read for this command.
10469 More generally, it returns the last key sequence read, either by
10470 the command loop or by `read-key-sequence'.
10471 Unlike `this-single-command-keys', this function's value
10472 shows the events before all translations (except for input methods).
10473 The value is always a vector. */)
10474 (void)
10476 return Fvector (raw_keybuf_count,
10477 (XVECTOR (raw_keybuf)->contents));
10480 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
10481 Sreset_this_command_lengths, 0, 0, 0,
10482 doc: /* Make the unread events replace the last command and echo.
10483 Used in `universal-argument-other-key'.
10485 `universal-argument-other-key' rereads the event just typed.
10486 It then gets translated through `function-key-map'.
10487 The translated event has to replace the real events,
10488 both in the value of (this-command-keys) and in echoing.
10489 To achieve this, `universal-argument-other-key' calls
10490 `reset-this-command-lengths', which discards the record of reading
10491 these events the first time. */)
10492 (void)
10494 this_command_key_count = before_command_key_count;
10495 if (this_command_key_count < this_single_command_key_start)
10496 this_single_command_key_start = this_command_key_count;
10498 echo_truncate (before_command_echo_length);
10500 /* Cause whatever we put into unread-command-events
10501 to echo as if it were being freshly read from the keyboard. */
10502 this_command_key_count_reset = 1;
10504 return Qnil;
10507 DEFUN ("clear-this-command-keys", Fclear_this_command_keys,
10508 Sclear_this_command_keys, 0, 1, 0,
10509 doc: /* Clear out the vector that `this-command-keys' returns.
10510 Also clear the record of the last 100 events, unless optional arg
10511 KEEP-RECORD is non-nil. */)
10512 (Lisp_Object keep_record)
10514 int i;
10516 this_command_key_count = 0;
10517 this_command_key_count_reset = 0;
10519 if (NILP (keep_record))
10521 for (i = 0; i < XVECTOR (recent_keys)->size; ++i)
10522 XVECTOR (recent_keys)->contents[i] = Qnil;
10523 total_keys = 0;
10524 recent_keys_index = 0;
10526 return Qnil;
10529 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
10530 doc: /* Return the current depth in recursive edits. */)
10531 (void)
10533 Lisp_Object temp;
10534 XSETFASTINT (temp, command_loop_level + minibuf_level);
10535 return temp;
10538 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
10539 "FOpen dribble file: ",
10540 doc: /* Start writing all keyboard characters to a dribble file called FILE.
10541 If FILE is nil, close any open dribble file. */)
10542 (Lisp_Object file)
10544 if (dribble)
10546 BLOCK_INPUT;
10547 fclose (dribble);
10548 UNBLOCK_INPUT;
10549 dribble = 0;
10551 if (!NILP (file))
10553 file = Fexpand_file_name (file, Qnil);
10554 dribble = fopen (SSDATA (file), "w");
10555 if (dribble == 0)
10556 report_file_error ("Opening dribble", Fcons (file, Qnil));
10558 return Qnil;
10561 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
10562 doc: /* Discard the contents of the terminal input buffer.
10563 Also end any kbd macro being defined. */)
10564 (void)
10566 if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
10568 /* Discard the last command from the macro. */
10569 Fcancel_kbd_macro_events ();
10570 end_kbd_macro ();
10573 update_mode_lines++;
10575 Vunread_command_events = Qnil;
10576 unread_command_char = -1;
10578 discard_tty_input ();
10580 kbd_fetch_ptr = kbd_store_ptr;
10581 input_pending = 0;
10583 return Qnil;
10586 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
10587 doc: /* Stop Emacs and return to superior process. You can resume later.
10588 If `cannot-suspend' is non-nil, or if the system doesn't support job
10589 control, run a subshell instead.
10591 If optional arg STUFFSTRING is non-nil, its characters are stuffed
10592 to be read as terminal input by Emacs's parent, after suspension.
10594 Before suspending, run the normal hook `suspend-hook'.
10595 After resumption run the normal hook `suspend-resume-hook'.
10597 Some operating systems cannot stop the Emacs process and resume it later.
10598 On such systems, Emacs starts a subshell instead of suspending. */)
10599 (Lisp_Object stuffstring)
10601 int count = SPECPDL_INDEX ();
10602 int old_height, old_width;
10603 int width, height;
10604 struct gcpro gcpro1;
10605 Lisp_Object hook;
10607 if (tty_list && tty_list->next)
10608 error ("There are other tty frames open; close them before suspending Emacs");
10610 if (!NILP (stuffstring))
10611 CHECK_STRING (stuffstring);
10613 /* Run the functions in suspend-hook. */
10614 hook = intern ("suspend-hook");
10615 Frun_hooks (1, &hook);
10617 GCPRO1 (stuffstring);
10618 get_tty_size (fileno (CURTTY ()->input), &old_width, &old_height);
10619 reset_all_sys_modes ();
10620 /* sys_suspend can get an error if it tries to fork a subshell
10621 and the system resources aren't available for that. */
10622 record_unwind_protect ((Lisp_Object (*) (Lisp_Object)) init_all_sys_modes,
10623 Qnil);
10624 stuff_buffered_input (stuffstring);
10625 if (cannot_suspend)
10626 sys_subshell ();
10627 else
10628 sys_suspend ();
10629 unbind_to (count, Qnil);
10631 /* Check if terminal/window size has changed.
10632 Note that this is not useful when we are running directly
10633 with a window system; but suspend should be disabled in that case. */
10634 get_tty_size (fileno (CURTTY ()->input), &width, &height);
10635 if (width != old_width || height != old_height)
10636 change_frame_size (SELECTED_FRAME (), height, width, 0, 0, 0);
10638 /* Run suspend-resume-hook. */
10639 hook = intern ("suspend-resume-hook");
10640 Frun_hooks (1, &hook);
10642 UNGCPRO;
10643 return Qnil;
10646 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
10647 Then in any case stuff anything Emacs has read ahead and not used. */
10649 void
10650 stuff_buffered_input (Lisp_Object stuffstring)
10652 #ifdef SIGTSTP /* stuff_char is defined if SIGTSTP. */
10653 register unsigned char *p;
10655 if (STRINGP (stuffstring))
10657 register EMACS_INT count;
10659 p = SDATA (stuffstring);
10660 count = SBYTES (stuffstring);
10661 while (count-- > 0)
10662 stuff_char (*p++);
10663 stuff_char ('\n');
10666 /* Anything we have read ahead, put back for the shell to read. */
10667 /* ?? What should this do when we have multiple keyboards??
10668 Should we ignore anything that was typed in at the "wrong" kboard?
10670 rms: we should stuff everything back into the kboard
10671 it came from. */
10672 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
10675 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
10676 kbd_fetch_ptr = kbd_buffer;
10677 if (kbd_fetch_ptr->kind == ASCII_KEYSTROKE_EVENT)
10678 stuff_char (kbd_fetch_ptr->code);
10680 clear_event (kbd_fetch_ptr);
10683 input_pending = 0;
10684 #endif /* SIGTSTP */
10687 void
10688 set_waiting_for_input (struct timeval *time_to_clear)
10690 input_available_clear_time = time_to_clear;
10692 /* Tell handle_interrupt to throw back to read_char, */
10693 waiting_for_input = 1;
10695 /* If handle_interrupt was called before and buffered a C-g,
10696 make it run again now, to avoid timing error. */
10697 if (!NILP (Vquit_flag))
10698 quit_throw_to_read_char ();
10701 void
10702 clear_waiting_for_input (void)
10704 /* Tell handle_interrupt not to throw back to read_char, */
10705 waiting_for_input = 0;
10706 input_available_clear_time = 0;
10709 /* The SIGINT handler.
10711 If we have a frame on the controlling tty, we assume that the
10712 SIGINT was generated by C-g, so we call handle_interrupt.
10713 Otherwise, the handler kills Emacs. */
10715 static void
10716 interrupt_signal (int signalnum) /* If we don't have an argument, some */
10717 /* compilers complain in signal calls. */
10719 /* Must preserve main program's value of errno. */
10720 int old_errno = errno;
10721 struct terminal *terminal;
10723 SIGNAL_THREAD_CHECK (signalnum);
10725 /* See if we have an active terminal on our controlling tty. */
10726 terminal = get_named_tty ("/dev/tty");
10727 if (!terminal)
10729 /* If there are no frames there, let's pretend that we are a
10730 well-behaving UN*X program and quit. */
10731 Fkill_emacs (Qnil);
10733 else
10735 /* Otherwise, the SIGINT was probably generated by C-g. */
10737 /* Set internal_last_event_frame to the top frame of the
10738 controlling tty, if we have a frame there. We disable the
10739 interrupt key on secondary ttys, so the SIGINT must have come
10740 from the controlling tty. */
10741 internal_last_event_frame = terminal->display_info.tty->top_frame;
10743 handle_interrupt ();
10746 errno = old_errno;
10749 /* This routine is called at interrupt level in response to C-g.
10751 It is called from the SIGINT handler or kbd_buffer_store_event.
10753 If `waiting_for_input' is non zero, then unless `echoing' is
10754 nonzero, immediately throw back to read_char.
10756 Otherwise it sets the Lisp variable quit-flag not-nil. This causes
10757 eval to throw, when it gets a chance. If quit-flag is already
10758 non-nil, it stops the job right away. */
10760 static void
10761 handle_interrupt (void)
10763 char c;
10765 cancel_echoing ();
10767 /* XXX This code needs to be revised for multi-tty support. */
10768 if (!NILP (Vquit_flag) && get_named_tty ("/dev/tty"))
10770 /* If SIGINT isn't blocked, don't let us be interrupted by
10771 another SIGINT, it might be harmful due to non-reentrancy
10772 in I/O functions. */
10773 sigblock (sigmask (SIGINT));
10775 fflush (stdout);
10776 reset_all_sys_modes ();
10778 #ifdef SIGTSTP /* Support possible in later USG versions */
10780 * On systems which can suspend the current process and return to the original
10781 * shell, this command causes the user to end up back at the shell.
10782 * The "Auto-save" and "Abort" questions are not asked until
10783 * the user elects to return to emacs, at which point he can save the current
10784 * job and either dump core or continue.
10786 sys_suspend ();
10787 #else
10788 /* Perhaps should really fork an inferior shell?
10789 But that would not provide any way to get back
10790 to the original shell, ever. */
10791 printf ("No support for stopping a process on this operating system;\n");
10792 printf ("you can continue or abort.\n");
10793 #endif /* not SIGTSTP */
10794 #ifdef MSDOS
10795 /* We must remain inside the screen area when the internal terminal
10796 is used. Note that [Enter] is not echoed by dos. */
10797 cursor_to (SELECTED_FRAME (), 0, 0);
10798 #endif
10799 /* It doesn't work to autosave while GC is in progress;
10800 the code used for auto-saving doesn't cope with the mark bit. */
10801 if (!gc_in_progress)
10803 printf ("Auto-save? (y or n) ");
10804 fflush (stdout);
10805 if (((c = getchar ()) & ~040) == 'Y')
10807 Fdo_auto_save (Qt, Qnil);
10808 #ifdef MSDOS
10809 printf ("\r\nAuto-save done");
10810 #else /* not MSDOS */
10811 printf ("Auto-save done\n");
10812 #endif /* not MSDOS */
10814 while (c != '\n') c = getchar ();
10816 else
10818 /* During GC, it must be safe to reenable quitting again. */
10819 Vinhibit_quit = Qnil;
10820 #ifdef MSDOS
10821 printf ("\r\n");
10822 #endif /* not MSDOS */
10823 printf ("Garbage collection in progress; cannot auto-save now\r\n");
10824 printf ("but will instead do a real quit after garbage collection ends\r\n");
10825 fflush (stdout);
10828 #ifdef MSDOS
10829 printf ("\r\nAbort? (y or n) ");
10830 #else /* not MSDOS */
10831 printf ("Abort (and dump core)? (y or n) ");
10832 #endif /* not MSDOS */
10833 fflush (stdout);
10834 if (((c = getchar ()) & ~040) == 'Y')
10835 abort ();
10836 while (c != '\n') c = getchar ();
10837 #ifdef MSDOS
10838 printf ("\r\nContinuing...\r\n");
10839 #else /* not MSDOS */
10840 printf ("Continuing...\n");
10841 #endif /* not MSDOS */
10842 fflush (stdout);
10843 init_all_sys_modes ();
10844 sigfree ();
10846 else
10848 /* If executing a function that wants to be interrupted out of
10849 and the user has not deferred quitting by binding `inhibit-quit'
10850 then quit right away. */
10851 if (immediate_quit && NILP (Vinhibit_quit))
10853 struct gl_state_s saved;
10854 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10856 immediate_quit = 0;
10857 sigfree ();
10858 saved = gl_state;
10859 GCPRO4 (saved.object, saved.global_code,
10860 saved.current_syntax_table, saved.old_prop);
10861 Fsignal (Qquit, Qnil);
10862 /* FIXME: AFAIK, `quit' can never return, so this code is dead! */
10863 gl_state = saved;
10864 UNGCPRO;
10866 else
10867 /* Else request quit when it's safe */
10868 Vquit_flag = Qt;
10871 /* TODO: The longjmp in this call throws the NS event loop integration off,
10872 and it seems to do fine without this. Probably some attention
10873 needs to be paid to the setting of waiting_for_input in
10874 wait_reading_process_output() under HAVE_NS because of the call
10875 to ns_select there (needed because otherwise events aren't picked up
10876 outside of polling since we don't get SIGIO like X and we don't have a
10877 separate event loop thread like W32. */
10878 #ifndef HAVE_NS
10879 if (waiting_for_input && !echoing)
10880 quit_throw_to_read_char ();
10881 #endif
10884 /* Handle a C-g by making read_char return C-g. */
10886 void
10887 quit_throw_to_read_char (void)
10889 sigfree ();
10890 /* Prevent another signal from doing this before we finish. */
10891 clear_waiting_for_input ();
10892 input_pending = 0;
10894 Vunread_command_events = Qnil;
10895 unread_command_char = -1;
10897 #if 0 /* Currently, sit_for is called from read_char without turning
10898 off polling. And that can call set_waiting_for_input.
10899 It seems to be harmless. */
10900 #ifdef POLL_FOR_INPUT
10901 /* May be > 1 if in recursive minibuffer. */
10902 if (poll_suppress_count == 0)
10903 abort ();
10904 #endif
10905 #endif
10906 if (FRAMEP (internal_last_event_frame)
10907 && !EQ (internal_last_event_frame, selected_frame))
10908 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
10909 0, 0, Qnil);
10911 _longjmp (getcjmp, 1);
10914 DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode, Sset_input_interrupt_mode, 1, 1, 0,
10915 doc: /* Set interrupt mode of reading keyboard input.
10916 If INTERRUPT is non-nil, Emacs will use input interrupts;
10917 otherwise Emacs uses CBREAK mode.
10919 See also `current-input-mode'. */)
10920 (Lisp_Object interrupt)
10922 int new_interrupt_input;
10923 #ifdef SIGIO
10924 /* Note SIGIO has been undef'd if FIONREAD is missing. */
10925 #ifdef HAVE_X_WINDOWS
10926 if (x_display_list != NULL)
10928 /* When using X, don't give the user a real choice,
10929 because we haven't implemented the mechanisms to support it. */
10930 new_interrupt_input = 1;
10932 else
10933 #endif /* HAVE_X_WINDOWS */
10934 new_interrupt_input = !NILP (interrupt);
10935 #else /* not SIGIO */
10936 new_interrupt_input = 0;
10937 #endif /* not SIGIO */
10939 if (new_interrupt_input != interrupt_input)
10941 #ifdef POLL_FOR_INPUT
10942 stop_polling ();
10943 #endif
10944 #ifndef DOS_NT
10945 /* this causes startup screen to be restored and messes with the mouse */
10946 reset_all_sys_modes ();
10947 interrupt_input = new_interrupt_input;
10948 init_all_sys_modes ();
10949 #else
10950 interrupt_input = new_interrupt_input;
10951 #endif
10953 #ifdef POLL_FOR_INPUT
10954 poll_suppress_count = 1;
10955 start_polling ();
10956 #endif
10958 return Qnil;
10961 DEFUN ("set-output-flow-control", Fset_output_flow_control, Sset_output_flow_control, 1, 2, 0,
10962 doc: /* Enable or disable ^S/^Q flow control for output to TERMINAL.
10963 If FLOW is non-nil, flow control is enabled and you cannot use C-s or
10964 C-q in key sequences.
10966 This setting only has an effect on tty terminals and only when
10967 Emacs reads input in CBREAK mode; see `set-input-interrupt-mode'.
10969 See also `current-input-mode'. */)
10970 (Lisp_Object flow, Lisp_Object terminal)
10972 struct terminal *t = get_terminal (terminal, 1);
10973 struct tty_display_info *tty;
10974 if (t == NULL || (t->type != output_termcap && t->type != output_msdos_raw))
10975 return Qnil;
10976 tty = t->display_info.tty;
10978 if (tty->flow_control != !NILP (flow))
10980 #ifndef DOS_NT
10981 /* this causes startup screen to be restored and messes with the mouse */
10982 reset_sys_modes (tty);
10983 #endif
10985 tty->flow_control = !NILP (flow);
10987 #ifndef DOS_NT
10988 init_sys_modes (tty);
10989 #endif
10991 return Qnil;
10994 DEFUN ("set-input-meta-mode", Fset_input_meta_mode, Sset_input_meta_mode, 1, 2, 0,
10995 doc: /* Enable or disable 8-bit input on TERMINAL.
10996 If META is t, Emacs will accept 8-bit input, and interpret the 8th
10997 bit as the Meta modifier.
10999 If META is nil, Emacs will ignore the top bit, on the assumption it is
11000 parity.
11002 Otherwise, Emacs will accept and pass through 8-bit input without
11003 specially interpreting the top bit.
11005 This setting only has an effect on tty terminal devices.
11007 Optional parameter TERMINAL specifies the tty terminal device to use.
11008 It may be a terminal object, a frame, or nil for the terminal used by
11009 the currently selected frame.
11011 See also `current-input-mode'. */)
11012 (Lisp_Object meta, Lisp_Object terminal)
11014 struct terminal *t = get_terminal (terminal, 1);
11015 struct tty_display_info *tty;
11016 int new_meta;
11018 if (t == NULL || (t->type != output_termcap && t->type != output_msdos_raw))
11019 return Qnil;
11020 tty = t->display_info.tty;
11022 if (NILP (meta))
11023 new_meta = 0;
11024 else if (EQ (meta, Qt))
11025 new_meta = 1;
11026 else
11027 new_meta = 2;
11029 if (tty->meta_key != new_meta)
11031 #ifndef DOS_NT
11032 /* this causes startup screen to be restored and messes with the mouse */
11033 reset_sys_modes (tty);
11034 #endif
11036 tty->meta_key = new_meta;
11038 #ifndef DOS_NT
11039 init_sys_modes (tty);
11040 #endif
11042 return Qnil;
11045 DEFUN ("set-quit-char", Fset_quit_char, Sset_quit_char, 1, 1, 0,
11046 doc: /* Specify character used for quitting.
11047 QUIT must be an ASCII character.
11049 This function only has an effect on the controlling tty of the Emacs
11050 process.
11052 See also `current-input-mode'. */)
11053 (Lisp_Object quit)
11055 struct terminal *t = get_named_tty ("/dev/tty");
11056 struct tty_display_info *tty;
11057 if (t == NULL || (t->type != output_termcap && t->type != output_msdos_raw))
11058 return Qnil;
11059 tty = t->display_info.tty;
11061 if (NILP (quit) || !INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400)
11062 error ("QUIT must be an ASCII character");
11064 #ifndef DOS_NT
11065 /* this causes startup screen to be restored and messes with the mouse */
11066 reset_sys_modes (tty);
11067 #endif
11069 /* Don't let this value be out of range. */
11070 quit_char = XINT (quit) & (tty->meta_key == 0 ? 0177 : 0377);
11072 #ifndef DOS_NT
11073 init_sys_modes (tty);
11074 #endif
11076 return Qnil;
11079 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
11080 doc: /* Set mode of reading keyboard input.
11081 First arg INTERRUPT non-nil means use input interrupts;
11082 nil means use CBREAK mode.
11083 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
11084 (no effect except in CBREAK mode).
11085 Third arg META t means accept 8-bit input (for a Meta key).
11086 META nil means ignore the top bit, on the assumption it is parity.
11087 Otherwise, accept 8-bit input and don't use the top bit for Meta.
11088 Optional fourth arg QUIT if non-nil specifies character to use for quitting.
11089 See also `current-input-mode'. */)
11090 (Lisp_Object interrupt, Lisp_Object flow, Lisp_Object meta, Lisp_Object quit)
11092 Fset_input_interrupt_mode (interrupt);
11093 Fset_output_flow_control (flow, Qnil);
11094 Fset_input_meta_mode (meta, Qnil);
11095 if (!NILP (quit))
11096 Fset_quit_char (quit);
11097 return Qnil;
11100 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
11101 doc: /* Return information about the way Emacs currently reads keyboard input.
11102 The value is a list of the form (INTERRUPT FLOW META QUIT), where
11103 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if
11104 nil, Emacs is using CBREAK mode.
11105 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
11106 terminal; this does not apply if Emacs uses interrupt-driven input.
11107 META is t if accepting 8-bit input with 8th bit as Meta flag.
11108 META nil means ignoring the top bit, on the assumption it is parity.
11109 META is neither t nor nil if accepting 8-bit input and using
11110 all 8 bits as the character code.
11111 QUIT is the character Emacs currently uses to quit.
11112 The elements of this list correspond to the arguments of
11113 `set-input-mode'. */)
11114 (void)
11116 Lisp_Object val[4];
11117 struct frame *sf = XFRAME (selected_frame);
11119 val[0] = interrupt_input ? Qt : Qnil;
11120 if (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf))
11122 val[1] = FRAME_TTY (sf)->flow_control ? Qt : Qnil;
11123 val[2] = (FRAME_TTY (sf)->meta_key == 2
11124 ? make_number (0)
11125 : (CURTTY ()->meta_key == 1 ? Qt : Qnil));
11127 else
11129 val[1] = Qnil;
11130 val[2] = Qt;
11132 XSETFASTINT (val[3], quit_char);
11134 return Flist (sizeof (val) / sizeof (val[0]), val);
11137 DEFUN ("posn-at-x-y", Fposn_at_x_y, Sposn_at_x_y, 2, 4, 0,
11138 doc: /* Return position information for pixel coordinates X and Y.
11139 By default, X and Y are relative to text area of the selected window.
11140 Optional third arg FRAME-OR-WINDOW non-nil specifies frame or window.
11141 If optional fourth arg WHOLE is non-nil, X is relative to the left
11142 edge of the window.
11144 The return value is similar to a mouse click position:
11145 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
11146 IMAGE (DX . DY) (WIDTH . HEIGHT))
11147 The `posn-' functions access elements of such lists. */)
11148 (Lisp_Object x, Lisp_Object y, Lisp_Object frame_or_window, Lisp_Object whole)
11150 CHECK_NATNUM (x);
11151 CHECK_NATNUM (y);
11153 if (NILP (frame_or_window))
11154 frame_or_window = selected_window;
11156 if (WINDOWP (frame_or_window))
11158 struct window *w;
11160 CHECK_LIVE_WINDOW (frame_or_window);
11162 w = XWINDOW (frame_or_window);
11163 XSETINT (x, (XINT (x)
11164 + WINDOW_LEFT_EDGE_X (w)
11165 + (NILP (whole)
11166 ? window_box_left_offset (w, TEXT_AREA)
11167 : 0)));
11168 XSETINT (y, WINDOW_TO_FRAME_PIXEL_Y (w, XINT (y)));
11169 frame_or_window = w->frame;
11172 CHECK_LIVE_FRAME (frame_or_window);
11174 return make_lispy_position (XFRAME (frame_or_window), x, y, 0);
11177 DEFUN ("posn-at-point", Fposn_at_point, Sposn_at_point, 0, 2, 0,
11178 doc: /* Return position information for buffer POS in WINDOW.
11179 POS defaults to point in WINDOW; WINDOW defaults to the selected window.
11181 Return nil if position is not visible in window. Otherwise,
11182 the return value is similar to that returned by `event-start' for
11183 a mouse click at the upper left corner of the glyph corresponding
11184 to the given buffer position:
11185 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
11186 IMAGE (DX . DY) (WIDTH . HEIGHT))
11187 The `posn-' functions access elements of such lists. */)
11188 (Lisp_Object pos, Lisp_Object window)
11190 Lisp_Object tem;
11192 if (NILP (window))
11193 window = selected_window;
11195 tem = Fpos_visible_in_window_p (pos, window, Qt);
11196 if (!NILP (tem))
11198 Lisp_Object x = XCAR (tem);
11199 Lisp_Object y = XCAR (XCDR (tem));
11201 /* Point invisible due to hscrolling? */
11202 if (XINT (x) < 0)
11203 return Qnil;
11204 tem = Fposn_at_x_y (x, y, window, Qnil);
11207 return tem;
11212 * Set up a new kboard object with reasonable initial values.
11214 void
11215 init_kboard (KBOARD *kb)
11217 KVAR (kb, Voverriding_terminal_local_map) = Qnil;
11218 KVAR (kb, Vlast_command) = Qnil;
11219 KVAR (kb, Vreal_last_command) = Qnil;
11220 KVAR (kb, Vkeyboard_translate_table) = Qnil;
11221 KVAR (kb, Vlast_repeatable_command) = Qnil;
11222 KVAR (kb, Vprefix_arg) = Qnil;
11223 KVAR (kb, Vlast_prefix_arg) = Qnil;
11224 KVAR (kb, kbd_queue) = Qnil;
11225 kb->kbd_queue_has_data = 0;
11226 kb->immediate_echo = 0;
11227 KVAR (kb, echo_string) = Qnil;
11228 kb->echo_after_prompt = -1;
11229 kb->kbd_macro_buffer = 0;
11230 kb->kbd_macro_bufsize = 0;
11231 KVAR (kb, defining_kbd_macro) = Qnil;
11232 KVAR (kb, Vlast_kbd_macro) = Qnil;
11233 kb->reference_count = 0;
11234 KVAR (kb, Vsystem_key_alist) = Qnil;
11235 KVAR (kb, system_key_syms) = Qnil;
11236 KVAR (kb, Vwindow_system) = Qt; /* Unset. */
11237 KVAR (kb, Vinput_decode_map) = Fmake_sparse_keymap (Qnil);
11238 KVAR (kb, Vlocal_function_key_map) = Fmake_sparse_keymap (Qnil);
11239 Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map);
11240 KVAR (kb, Vdefault_minibuffer_frame) = Qnil;
11244 * Destroy the contents of a kboard object, but not the object itself.
11245 * We use this just before deleting it, or if we're going to initialize
11246 * it a second time.
11248 static void
11249 wipe_kboard (KBOARD *kb)
11251 xfree (kb->kbd_macro_buffer);
11254 /* Free KB and memory referenced from it. */
11256 void
11257 delete_kboard (KBOARD *kb)
11259 KBOARD **kbp;
11261 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
11262 if (*kbp == NULL)
11263 abort ();
11264 *kbp = kb->next_kboard;
11266 /* Prevent a dangling reference to KB. */
11267 if (kb == current_kboard
11268 && FRAMEP (selected_frame)
11269 && FRAME_LIVE_P (XFRAME (selected_frame)))
11271 current_kboard = FRAME_KBOARD (XFRAME (selected_frame));
11272 single_kboard = 0;
11273 if (current_kboard == kb)
11274 abort ();
11277 wipe_kboard (kb);
11278 xfree (kb);
11281 void
11282 init_keyboard (void)
11284 /* This is correct before outermost invocation of the editor loop */
11285 command_loop_level = -1;
11286 immediate_quit = 0;
11287 quit_char = Ctl ('g');
11288 Vunread_command_events = Qnil;
11289 unread_command_char = -1;
11290 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
11291 total_keys = 0;
11292 recent_keys_index = 0;
11293 kbd_fetch_ptr = kbd_buffer;
11294 kbd_store_ptr = kbd_buffer;
11295 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
11296 do_mouse_tracking = Qnil;
11297 #endif
11298 input_pending = 0;
11299 interrupt_input_blocked = 0;
11300 interrupt_input_pending = 0;
11301 #ifdef SYNC_INPUT
11302 pending_signals = 0;
11303 #endif
11305 /* This means that command_loop_1 won't try to select anything the first
11306 time through. */
11307 internal_last_event_frame = Qnil;
11308 Vlast_event_frame = internal_last_event_frame;
11310 current_kboard = initial_kboard;
11311 /* Re-initialize the keyboard again. */
11312 wipe_kboard (current_kboard);
11313 init_kboard (current_kboard);
11314 /* A value of nil for Vwindow_system normally means a tty, but we also use
11315 it for the initial terminal since there is no window system there. */
11316 KVAR (current_kboard, Vwindow_system) = Qnil;
11318 if (!noninteractive)
11320 /* Before multi-tty support, these handlers used to be installed
11321 only if the current session was a tty session. Now an Emacs
11322 session may have multiple display types, so we always handle
11323 SIGINT. There is special code in interrupt_signal to exit
11324 Emacs on SIGINT when there are no termcap frames on the
11325 controlling terminal. */
11326 signal (SIGINT, interrupt_signal);
11327 #ifndef DOS_NT
11328 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
11329 SIGQUIT and we can't tell which one it will give us. */
11330 signal (SIGQUIT, interrupt_signal);
11331 #endif /* not DOS_NT */
11333 /* Note SIGIO has been undef'd if FIONREAD is missing. */
11334 #ifdef SIGIO
11335 if (!noninteractive)
11336 signal (SIGIO, input_available_signal);
11337 #endif /* SIGIO */
11339 /* Use interrupt input by default, if it works and noninterrupt input
11340 has deficiencies. */
11342 #ifdef INTERRUPT_INPUT
11343 interrupt_input = 1;
11344 #else
11345 interrupt_input = 0;
11346 #endif
11348 sigfree ();
11349 dribble = 0;
11351 if (keyboard_init_hook)
11352 (*keyboard_init_hook) ();
11354 #ifdef POLL_FOR_INPUT
11355 poll_timer = NULL;
11356 poll_suppress_count = 1;
11357 start_polling ();
11358 #endif
11361 /* This type's only use is in syms_of_keyboard, to initialize the
11362 event header symbols and put properties on them. */
11363 struct event_head {
11364 Lisp_Object *var;
11365 const char *name;
11366 Lisp_Object *kind;
11369 static const struct event_head head_table[] = {
11370 {&Qmouse_movement, "mouse-movement", &Qmouse_movement},
11371 {&Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement},
11372 {&Qswitch_frame, "switch-frame", &Qswitch_frame},
11373 {&Qdelete_frame, "delete-frame", &Qdelete_frame},
11374 {&Qiconify_frame, "iconify-frame", &Qiconify_frame},
11375 {&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible},
11376 /* `select-window' should be handled just like `switch-frame'
11377 in read_key_sequence. */
11378 {&Qselect_window, "select-window", &Qswitch_frame}
11381 void
11382 syms_of_keyboard (void)
11384 pending_funcalls = Qnil;
11385 staticpro (&pending_funcalls);
11387 Vlispy_mouse_stem = make_pure_c_string ("mouse");
11388 staticpro (&Vlispy_mouse_stem);
11390 /* Tool-bars. */
11391 QCimage = intern_c_string (":image");
11392 staticpro (&QCimage);
11394 staticpro (&Qhelp_echo);
11395 Qhelp_echo = intern_c_string ("help-echo");
11397 staticpro (&Qrtl);
11398 Qrtl = intern_c_string (":rtl");
11400 staticpro (&item_properties);
11401 item_properties = Qnil;
11403 staticpro (&tool_bar_item_properties);
11404 tool_bar_item_properties = Qnil;
11405 staticpro (&tool_bar_items_vector);
11406 tool_bar_items_vector = Qnil;
11408 staticpro (&real_this_command);
11409 real_this_command = Qnil;
11411 Qtimer_event_handler = intern_c_string ("timer-event-handler");
11412 staticpro (&Qtimer_event_handler);
11414 Qdisabled_command_function = intern_c_string ("disabled-command-function");
11415 staticpro (&Qdisabled_command_function);
11417 Qself_insert_command = intern_c_string ("self-insert-command");
11418 staticpro (&Qself_insert_command);
11420 Qforward_char = intern_c_string ("forward-char");
11421 staticpro (&Qforward_char);
11423 Qbackward_char = intern_c_string ("backward-char");
11424 staticpro (&Qbackward_char);
11426 Qdisabled = intern_c_string ("disabled");
11427 staticpro (&Qdisabled);
11429 Qundefined = intern_c_string ("undefined");
11430 staticpro (&Qundefined);
11432 Qpre_command_hook = intern_c_string ("pre-command-hook");
11433 staticpro (&Qpre_command_hook);
11435 Qpost_command_hook = intern_c_string ("post-command-hook");
11436 staticpro (&Qpost_command_hook);
11438 Qdeferred_action_function = intern_c_string ("deferred-action-function");
11439 staticpro (&Qdeferred_action_function);
11441 Qcommand_hook_internal = intern_c_string ("command-hook-internal");
11442 staticpro (&Qcommand_hook_internal);
11444 Qfunction_key = intern_c_string ("function-key");
11445 staticpro (&Qfunction_key);
11446 Qmouse_click = intern_c_string ("mouse-click");
11447 staticpro (&Qmouse_click);
11448 #if defined (WINDOWSNT)
11449 Qlanguage_change = intern_c_string ("language-change");
11450 staticpro (&Qlanguage_change);
11451 #endif
11452 Qdrag_n_drop = intern_c_string ("drag-n-drop");
11453 staticpro (&Qdrag_n_drop);
11455 Qsave_session = intern_c_string ("save-session");
11456 staticpro (&Qsave_session);
11458 #ifdef HAVE_DBUS
11459 Qdbus_event = intern_c_string ("dbus-event");
11460 staticpro (&Qdbus_event);
11461 #endif
11463 Qconfig_changed_event = intern_c_string ("config-changed-event");
11464 staticpro (&Qconfig_changed_event);
11466 Qmenu_enable = intern_c_string ("menu-enable");
11467 staticpro (&Qmenu_enable);
11468 QCenable = intern_c_string (":enable");
11469 staticpro (&QCenable);
11470 QCvisible = intern_c_string (":visible");
11471 staticpro (&QCvisible);
11472 QChelp = intern_c_string (":help");
11473 staticpro (&QChelp);
11474 QCfilter = intern_c_string (":filter");
11475 staticpro (&QCfilter);
11476 QCbutton = intern_c_string (":button");
11477 staticpro (&QCbutton);
11478 QCkeys = intern_c_string (":keys");
11479 staticpro (&QCkeys);
11480 QCkey_sequence = intern_c_string (":key-sequence");
11481 staticpro (&QCkey_sequence);
11482 QCtoggle = intern_c_string (":toggle");
11483 staticpro (&QCtoggle);
11484 QCradio = intern_c_string (":radio");
11485 staticpro (&QCradio);
11486 QClabel = intern_c_string (":label");
11487 staticpro (&QClabel);
11488 QCvert_only = intern_c_string (":vert-only");
11489 staticpro (&QCvert_only);
11491 Qmode_line = intern_c_string ("mode-line");
11492 staticpro (&Qmode_line);
11493 Qvertical_line = intern_c_string ("vertical-line");
11494 staticpro (&Qvertical_line);
11495 Qvertical_scroll_bar = intern_c_string ("vertical-scroll-bar");
11496 staticpro (&Qvertical_scroll_bar);
11497 Qmenu_bar = intern_c_string ("menu-bar");
11498 staticpro (&Qmenu_bar);
11500 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
11501 Qmouse_fixup_help_message = intern_c_string ("mouse-fixup-help-message");
11502 staticpro (&Qmouse_fixup_help_message);
11503 #endif
11505 Qabove_handle = intern_c_string ("above-handle");
11506 staticpro (&Qabove_handle);
11507 Qhandle = intern_c_string ("handle");
11508 staticpro (&Qhandle);
11509 Qbelow_handle = intern_c_string ("below-handle");
11510 staticpro (&Qbelow_handle);
11511 Qup = intern_c_string ("up");
11512 staticpro (&Qup);
11513 Qdown = intern_c_string ("down");
11514 staticpro (&Qdown);
11515 Qtop = intern_c_string ("top");
11516 staticpro (&Qtop);
11517 Qbottom = intern_c_string ("bottom");
11518 staticpro (&Qbottom);
11519 Qend_scroll = intern_c_string ("end-scroll");
11520 staticpro (&Qend_scroll);
11521 Qratio = intern_c_string ("ratio");
11522 staticpro (&Qratio);
11524 Qevent_kind = intern_c_string ("event-kind");
11525 staticpro (&Qevent_kind);
11526 Qevent_symbol_elements = intern_c_string ("event-symbol-elements");
11527 staticpro (&Qevent_symbol_elements);
11528 Qevent_symbol_element_mask = intern_c_string ("event-symbol-element-mask");
11529 staticpro (&Qevent_symbol_element_mask);
11530 Qmodifier_cache = intern_c_string ("modifier-cache");
11531 staticpro (&Qmodifier_cache);
11533 Qrecompute_lucid_menubar = intern_c_string ("recompute-lucid-menubar");
11534 staticpro (&Qrecompute_lucid_menubar);
11535 Qactivate_menubar_hook = intern_c_string ("activate-menubar-hook");
11536 staticpro (&Qactivate_menubar_hook);
11538 Qpolling_period = intern_c_string ("polling-period");
11539 staticpro (&Qpolling_period);
11541 Qinput_method_function = intern_c_string ("input-method-function");
11542 staticpro (&Qinput_method_function);
11544 Qx_set_selection = intern_c_string ("x-set-selection");
11545 staticpro (&Qx_set_selection);
11546 QPRIMARY = intern_c_string ("PRIMARY");
11547 staticpro (&QPRIMARY);
11548 Qhandle_switch_frame = intern_c_string ("handle-switch-frame");
11549 staticpro (&Qhandle_switch_frame);
11551 Qinput_method_exit_on_first_char = intern_c_string ("input-method-exit-on-first-char");
11552 staticpro (&Qinput_method_exit_on_first_char);
11553 Qinput_method_use_echo_area = intern_c_string ("input-method-use-echo-area");
11554 staticpro (&Qinput_method_use_echo_area);
11556 Fset (Qinput_method_exit_on_first_char, Qnil);
11557 Fset (Qinput_method_use_echo_area, Qnil);
11559 last_point_position_buffer = Qnil;
11560 last_point_position_window = Qnil;
11563 int i;
11564 int len = sizeof (head_table) / sizeof (head_table[0]);
11566 for (i = 0; i < len; i++)
11568 const struct event_head *p = &head_table[i];
11569 *p->var = intern_c_string (p->name);
11570 staticpro (p->var);
11571 Fput (*p->var, Qevent_kind, *p->kind);
11572 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
11576 button_down_location = Fmake_vector (make_number (5), Qnil);
11577 staticpro (&button_down_location);
11578 mouse_syms = Fmake_vector (make_number (5), Qnil);
11579 staticpro (&mouse_syms);
11580 wheel_syms = Fmake_vector (make_number (sizeof (lispy_wheel_names)
11581 / sizeof (lispy_wheel_names[0])),
11582 Qnil);
11583 staticpro (&wheel_syms);
11586 int i;
11587 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
11589 modifier_symbols = Fmake_vector (make_number (len), Qnil);
11590 for (i = 0; i < len; i++)
11591 if (modifier_names[i])
11592 XVECTOR (modifier_symbols)->contents[i] = intern_c_string (modifier_names[i]);
11593 staticpro (&modifier_symbols);
11596 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
11597 staticpro (&recent_keys);
11599 this_command_keys = Fmake_vector (make_number (40), Qnil);
11600 staticpro (&this_command_keys);
11602 raw_keybuf = Fmake_vector (make_number (30), Qnil);
11603 staticpro (&raw_keybuf);
11605 Qextended_command_history = intern_c_string ("extended-command-history");
11606 Fset (Qextended_command_history, Qnil);
11607 staticpro (&Qextended_command_history);
11609 accent_key_syms = Qnil;
11610 staticpro (&accent_key_syms);
11612 func_key_syms = Qnil;
11613 staticpro (&func_key_syms);
11615 drag_n_drop_syms = Qnil;
11616 staticpro (&drag_n_drop_syms);
11618 unread_switch_frame = Qnil;
11619 staticpro (&unread_switch_frame);
11621 internal_last_event_frame = Qnil;
11622 staticpro (&internal_last_event_frame);
11624 read_key_sequence_cmd = Qnil;
11625 staticpro (&read_key_sequence_cmd);
11627 menu_bar_one_keymap_changed_items = Qnil;
11628 staticpro (&menu_bar_one_keymap_changed_items);
11630 menu_bar_items_vector = Qnil;
11631 staticpro (&menu_bar_items_vector);
11633 help_form_saved_window_configs = Qnil;
11634 staticpro (&help_form_saved_window_configs);
11636 defsubr (&Scurrent_idle_time);
11637 defsubr (&Sevent_symbol_parse_modifiers);
11638 defsubr (&Sevent_convert_list);
11639 defsubr (&Sread_key_sequence);
11640 defsubr (&Sread_key_sequence_vector);
11641 defsubr (&Srecursive_edit);
11642 #if defined (HAVE_MOUSE) || defined (HAVE_GPM)
11643 defsubr (&Strack_mouse);
11644 #endif
11645 defsubr (&Sinput_pending_p);
11646 defsubr (&Scommand_execute);
11647 defsubr (&Srecent_keys);
11648 defsubr (&Sthis_command_keys);
11649 defsubr (&Sthis_command_keys_vector);
11650 defsubr (&Sthis_single_command_keys);
11651 defsubr (&Sthis_single_command_raw_keys);
11652 defsubr (&Sreset_this_command_lengths);
11653 defsubr (&Sclear_this_command_keys);
11654 defsubr (&Ssuspend_emacs);
11655 defsubr (&Sabort_recursive_edit);
11656 defsubr (&Sexit_recursive_edit);
11657 defsubr (&Srecursion_depth);
11658 defsubr (&Stop_level);
11659 defsubr (&Sdiscard_input);
11660 defsubr (&Sopen_dribble_file);
11661 defsubr (&Sset_input_interrupt_mode);
11662 defsubr (&Sset_output_flow_control);
11663 defsubr (&Sset_input_meta_mode);
11664 defsubr (&Sset_quit_char);
11665 defsubr (&Sset_input_mode);
11666 defsubr (&Scurrent_input_mode);
11667 defsubr (&Sexecute_extended_command);
11668 defsubr (&Sposn_at_point);
11669 defsubr (&Sposn_at_x_y);
11671 DEFVAR_LISP ("last-command-event", last_command_event,
11672 doc: /* Last input event that was part of a command. */);
11674 DEFVAR_LISP ("last-nonmenu-event", last_nonmenu_event,
11675 doc: /* Last input event in a command, except for mouse menu events.
11676 Mouse menus give back keys that don't look like mouse events;
11677 this variable holds the actual mouse event that led to the menu,
11678 so that you can determine whether the command was run by mouse or not. */);
11680 DEFVAR_LISP ("last-input-event", last_input_event,
11681 doc: /* Last input event. */);
11683 DEFVAR_LISP ("unread-command-events", Vunread_command_events,
11684 doc: /* List of events to be read as the command input.
11685 These events are processed first, before actual keyboard input.
11686 Events read from this list are not normally added to `this-command-keys',
11687 as they will already have been added once as they were read for the first time.
11688 An element of the form (t . EVENT) forces EVENT to be added to that list. */);
11689 Vunread_command_events = Qnil;
11691 DEFVAR_INT ("unread-command-char", unread_command_char,
11692 doc: /* If not -1, an object to be read as next command input event. */);
11694 DEFVAR_LISP ("unread-post-input-method-events", Vunread_post_input_method_events,
11695 doc: /* List of events to be processed as input by input methods.
11696 These events are processed before `unread-command-events'
11697 and actual keyboard input, but are not given to `input-method-function'. */);
11698 Vunread_post_input_method_events = Qnil;
11700 DEFVAR_LISP ("unread-input-method-events", Vunread_input_method_events,
11701 doc: /* List of events to be processed as input by input methods.
11702 These events are processed after `unread-command-events', but
11703 before actual keyboard input.
11704 If there's an active input method, the events are given to
11705 `input-method-function'. */);
11706 Vunread_input_method_events = Qnil;
11708 DEFVAR_LISP ("meta-prefix-char", meta_prefix_char,
11709 doc: /* Meta-prefix character code.
11710 Meta-foo as command input turns into this character followed by foo. */);
11711 XSETINT (meta_prefix_char, 033);
11713 DEFVAR_KBOARD ("last-command", Vlast_command,
11714 doc: /* The last command executed.
11715 Normally a symbol with a function definition, but can be whatever was found
11716 in the keymap, or whatever the variable `this-command' was set to by that
11717 command.
11719 The value `mode-exit' is special; it means that the previous command
11720 read an event that told it to exit, and it did so and unread that event.
11721 In other words, the present command is the event that made the previous
11722 command exit.
11724 The value `kill-region' is special; it means that the previous command
11725 was a kill command.
11727 `last-command' has a separate binding for each terminal device.
11728 See Info node `(elisp)Multiple Terminals'. */);
11730 DEFVAR_KBOARD ("real-last-command", Vreal_last_command,
11731 doc: /* Same as `last-command', but never altered by Lisp code. */);
11733 DEFVAR_KBOARD ("last-repeatable-command", Vlast_repeatable_command,
11734 doc: /* Last command that may be repeated.
11735 The last command executed that was not bound to an input event.
11736 This is the command `repeat' will try to repeat. */);
11738 DEFVAR_LISP ("this-command", Vthis_command,
11739 doc: /* The command now being executed.
11740 The command can set this variable; whatever is put here
11741 will be in `last-command' during the following command. */);
11742 Vthis_command = Qnil;
11744 DEFVAR_LISP ("this-command-keys-shift-translated",
11745 Vthis_command_keys_shift_translated,
11746 doc: /* Non-nil if the key sequence activating this command was shift-translated.
11747 Shift-translation occurs when there is no binding for the key sequence
11748 as entered, but a binding was found by changing an upper-case letter
11749 to lower-case, or a shifted function key to an unshifted one. */);
11750 Vthis_command_keys_shift_translated = Qnil;
11752 DEFVAR_LISP ("this-original-command", Vthis_original_command,
11753 doc: /* The command bound to the current key sequence before remapping.
11754 It equals `this-command' if the original command was not remapped through
11755 any of the active keymaps. Otherwise, the value of `this-command' is the
11756 result of looking up the original command in the active keymaps. */);
11757 Vthis_original_command = Qnil;
11759 DEFVAR_INT ("auto-save-interval", auto_save_interval,
11760 doc: /* *Number of input events between auto-saves.
11761 Zero means disable autosaving due to number of characters typed. */);
11762 auto_save_interval = 300;
11764 DEFVAR_LISP ("auto-save-timeout", Vauto_save_timeout,
11765 doc: /* *Number of seconds idle time before auto-save.
11766 Zero or nil means disable auto-saving due to idleness.
11767 After auto-saving due to this many seconds of idle time,
11768 Emacs also does a garbage collection if that seems to be warranted. */);
11769 XSETFASTINT (Vauto_save_timeout, 30);
11771 DEFVAR_LISP ("echo-keystrokes", Vecho_keystrokes,
11772 doc: /* *Nonzero means echo unfinished commands after this many seconds of pause.
11773 The value may be integer or floating point. */);
11774 Vecho_keystrokes = make_number (1);
11776 DEFVAR_INT ("polling-period", polling_period,
11777 doc: /* *Interval between polling for input during Lisp execution.
11778 The reason for polling is to make C-g work to stop a running program.
11779 Polling is needed only when using X windows and SIGIO does not work.
11780 Polling is automatically disabled in all other cases. */);
11781 polling_period = 2;
11783 DEFVAR_LISP ("double-click-time", Vdouble_click_time,
11784 doc: /* *Maximum time between mouse clicks to make a double-click.
11785 Measured in milliseconds. The value nil means disable double-click
11786 recognition; t means double-clicks have no time limit and are detected
11787 by position only. */);
11788 Vdouble_click_time = make_number (500);
11790 DEFVAR_INT ("double-click-fuzz", double_click_fuzz,
11791 doc: /* *Maximum mouse movement between clicks to make a double-click.
11792 On window-system frames, value is the number of pixels the mouse may have
11793 moved horizontally or vertically between two clicks to make a double-click.
11794 On non window-system frames, value is interpreted in units of 1/8 characters
11795 instead of pixels.
11797 This variable is also the threshold for motion of the mouse
11798 to count as a drag. */);
11799 double_click_fuzz = 3;
11801 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", inhibit_local_menu_bar_menus,
11802 doc: /* *Non-nil means inhibit local map menu bar menus. */);
11803 inhibit_local_menu_bar_menus = 0;
11805 DEFVAR_INT ("num-input-keys", num_input_keys,
11806 doc: /* Number of complete key sequences read as input so far.
11807 This includes key sequences read from keyboard macros.
11808 The number is effectively the number of interactive command invocations. */);
11809 num_input_keys = 0;
11811 DEFVAR_INT ("num-nonmacro-input-events", num_nonmacro_input_events,
11812 doc: /* Number of input events read from the keyboard so far.
11813 This does not include events generated by keyboard macros. */);
11814 num_nonmacro_input_events = 0;
11816 DEFVAR_LISP ("last-event-frame", Vlast_event_frame,
11817 doc: /* The frame in which the most recently read event occurred.
11818 If the last event came from a keyboard macro, this is set to `macro'. */);
11819 Vlast_event_frame = Qnil;
11821 /* This variable is set up in sysdep.c. */
11822 DEFVAR_LISP ("tty-erase-char", Vtty_erase_char,
11823 doc: /* The ERASE character as set by the user with stty. */);
11825 DEFVAR_LISP ("help-char", Vhelp_char,
11826 doc: /* Character to recognize as meaning Help.
11827 When it is read, do `(eval help-form)', and display result if it's a string.
11828 If the value of `help-form' is nil, this char can be read normally. */);
11829 XSETINT (Vhelp_char, Ctl ('H'));
11831 DEFVAR_LISP ("help-event-list", Vhelp_event_list,
11832 doc: /* List of input events to recognize as meaning Help.
11833 These work just like the value of `help-char' (see that). */);
11834 Vhelp_event_list = Qnil;
11836 DEFVAR_LISP ("help-form", Vhelp_form,
11837 doc: /* Form to execute when character `help-char' is read.
11838 If the form returns a string, that string is displayed.
11839 If `help-form' is nil, the help char is not recognized. */);
11840 Vhelp_form = Qnil;
11842 DEFVAR_LISP ("prefix-help-command", Vprefix_help_command,
11843 doc: /* Command to run when `help-char' character follows a prefix key.
11844 This command is used only when there is no actual binding
11845 for that character after that prefix key. */);
11846 Vprefix_help_command = Qnil;
11848 DEFVAR_LISP ("top-level", Vtop_level,
11849 doc: /* Form to evaluate when Emacs starts up.
11850 Useful to set before you dump a modified Emacs. */);
11851 Vtop_level = Qnil;
11853 DEFVAR_KBOARD ("keyboard-translate-table", Vkeyboard_translate_table,
11854 doc: /* Translate table for local keyboard input, or nil.
11855 If non-nil, the value should be a char-table. Each character read
11856 from the keyboard is looked up in this char-table. If the value found
11857 there is non-nil, then it is used instead of the actual input character.
11859 The value can also be a string or vector, but this is considered obsolete.
11860 If it is a string or vector of length N, character codes N and up are left
11861 untranslated. In a vector, an element which is nil means "no translation".
11863 This is applied to the characters supplied to input methods, not their
11864 output. See also `translation-table-for-input'.
11866 This variable has a separate binding for each terminal.
11867 See Info node `(elisp)Multiple Terminals'. */);
11869 DEFVAR_BOOL ("cannot-suspend", cannot_suspend,
11870 doc: /* Non-nil means to always spawn a subshell instead of suspending.
11871 \(Even if the operating system has support for stopping a process.\) */);
11872 cannot_suspend = 0;
11874 DEFVAR_BOOL ("menu-prompting", menu_prompting,
11875 doc: /* Non-nil means prompt with menus when appropriate.
11876 This is done when reading from a keymap that has a prompt string,
11877 for elements that have prompt strings.
11878 The menu is displayed on the screen
11879 if X menus were enabled at configuration
11880 time and the previous event was a mouse click prefix key.
11881 Otherwise, menu prompting uses the echo area. */);
11882 menu_prompting = 1;
11884 DEFVAR_LISP ("menu-prompt-more-char", menu_prompt_more_char,
11885 doc: /* Character to see next line of menu prompt.
11886 Type this character while in a menu prompt to rotate around the lines of it. */);
11887 XSETINT (menu_prompt_more_char, ' ');
11889 DEFVAR_INT ("extra-keyboard-modifiers", extra_keyboard_modifiers,
11890 doc: /* A mask of additional modifier keys to use with every keyboard character.
11891 Emacs applies the modifiers of the character stored here to each keyboard
11892 character it reads. For example, after evaluating the expression
11893 (setq extra-keyboard-modifiers ?\\C-x)
11894 all input characters will have the control modifier applied to them.
11896 Note that the character ?\\C-@, equivalent to the integer zero, does
11897 not count as a control character; rather, it counts as a character
11898 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero
11899 cancels any modification. */);
11900 extra_keyboard_modifiers = 0;
11902 DEFVAR_LISP ("deactivate-mark", Vdeactivate_mark,
11903 doc: /* If an editing command sets this to t, deactivate the mark afterward.
11904 The command loop sets this to nil before each command,
11905 and tests the value when the command returns.
11906 Buffer modification stores t in this variable. */);
11907 Vdeactivate_mark = Qnil;
11908 Qdeactivate_mark = intern_c_string ("deactivate-mark");
11909 staticpro (&Qdeactivate_mark);
11911 DEFVAR_LISP ("command-hook-internal", Vcommand_hook_internal,
11912 doc: /* Temporary storage of `pre-command-hook' or `post-command-hook'. */);
11913 Vcommand_hook_internal = Qnil;
11915 DEFVAR_LISP ("pre-command-hook", Vpre_command_hook,
11916 doc: /* Normal hook run before each command is executed.
11917 If an unhandled error happens in running this hook,
11918 the hook value is set to nil, since otherwise the error
11919 might happen repeatedly and make Emacs nonfunctional. */);
11920 Vpre_command_hook = Qnil;
11922 DEFVAR_LISP ("post-command-hook", Vpost_command_hook,
11923 doc: /* Normal hook run after each command is executed.
11924 If an unhandled error happens in running this hook,
11925 the hook value is set to nil, since otherwise the error
11926 might happen repeatedly and make Emacs nonfunctional. */);
11927 Vpost_command_hook = Qnil;
11929 #if 0
11930 DEFVAR_LISP ("echo-area-clear-hook", ...,
11931 doc: /* Normal hook run when clearing the echo area. */);
11932 #endif
11933 Qecho_area_clear_hook = intern_c_string ("echo-area-clear-hook");
11934 staticpro (&Qecho_area_clear_hook);
11935 Fset (Qecho_area_clear_hook, Qnil);
11937 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", Vlucid_menu_bar_dirty_flag,
11938 doc: /* Non-nil means menu bar, specified Lucid style, needs to be recomputed. */);
11939 Vlucid_menu_bar_dirty_flag = Qnil;
11941 DEFVAR_LISP ("menu-bar-final-items", Vmenu_bar_final_items,
11942 doc: /* List of menu bar items to move to the end of the menu bar.
11943 The elements of the list are event types that may have menu bar bindings. */);
11944 Vmenu_bar_final_items = Qnil;
11946 DEFVAR_LISP ("tool-bar-separator-image-expression", Vtool_bar_separator_image_expression,
11947 doc: /* Expression evaluating to the image spec for a tool-bar separator.
11948 This is used internally by graphical displays that do not render
11949 tool-bar separators natively. Otherwise it is unused (e.g. on GTK). */);
11950 Vtool_bar_separator_image_expression = Qnil;
11952 DEFVAR_KBOARD ("overriding-terminal-local-map",
11953 Voverriding_terminal_local_map,
11954 doc: /* Per-terminal keymap that overrides all other local keymaps.
11955 If this variable is non-nil, it is used as a keymap instead of the
11956 buffer's local map, and the minor mode keymaps and text property keymaps.
11957 It also replaces `overriding-local-map'.
11959 This variable is intended to let commands such as `universal-argument'
11960 set up a different keymap for reading the next command.
11962 `overriding-terminal-local-map' has a separate binding for each
11963 terminal device.
11964 See Info node `(elisp)Multiple Terminals'. */);
11966 DEFVAR_LISP ("overriding-local-map", Voverriding_local_map,
11967 doc: /* Keymap that overrides all other local keymaps.
11968 If this variable is non-nil, it is used as a keymap--replacing the
11969 buffer's local map, the minor mode keymaps, and char property keymaps. */);
11970 Voverriding_local_map = Qnil;
11972 DEFVAR_LISP ("overriding-local-map-menu-flag", Voverriding_local_map_menu_flag,
11973 doc: /* Non-nil means `overriding-local-map' applies to the menu bar.
11974 Otherwise, the menu bar continues to reflect the buffer's local map
11975 and the minor mode maps regardless of `overriding-local-map'. */);
11976 Voverriding_local_map_menu_flag = Qnil;
11978 DEFVAR_LISP ("special-event-map", Vspecial_event_map,
11979 doc: /* Keymap defining bindings for special events to execute at low level. */);
11980 Vspecial_event_map = Fcons (intern_c_string ("keymap"), Qnil);
11982 DEFVAR_LISP ("track-mouse", do_mouse_tracking,
11983 doc: /* *Non-nil means generate motion events for mouse motion. */);
11985 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
11986 doc: /* Alist of system-specific X windows key symbols.
11987 Each element should have the form (N . SYMBOL) where N is the
11988 numeric keysym code (sans the \"system-specific\" bit 1<<28)
11989 and SYMBOL is its name.
11991 `system-key-alist' has a separate binding for each terminal device.
11992 See Info node `(elisp)Multiple Terminals'. */);
11994 DEFVAR_KBOARD ("local-function-key-map", Vlocal_function_key_map,
11995 doc: /* Keymap that translates key sequences to key sequences during input.
11996 This is used mainly for mapping key sequences into some preferred
11997 key events (symbols).
11999 The `read-key-sequence' function replaces any subsequence bound by
12000 `local-function-key-map' with its binding. More precisely, when the
12001 active keymaps have no binding for the current key sequence but
12002 `local-function-key-map' binds a suffix of the sequence to a vector or
12003 string, `read-key-sequence' replaces the matching suffix with its
12004 binding, and continues with the new sequence.
12006 If the binding is a function, it is called with one argument (the prompt)
12007 and its return value (a key sequence) is used.
12009 The events that come from bindings in `local-function-key-map' are not
12010 themselves looked up in `local-function-key-map'.
12012 For example, suppose `local-function-key-map' binds `ESC O P' to [f1].
12013 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
12014 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix key,
12015 typing `ESC O P x' would return [f1 x].
12017 `local-function-key-map' has a separate binding for each terminal
12018 device. See Info node `(elisp)Multiple Terminals'. If you need to
12019 define a binding on all terminals, change `function-key-map'
12020 instead. Initially, `local-function-key-map' is an empty keymap that
12021 has `function-key-map' as its parent on all terminal devices. */);
12023 DEFVAR_KBOARD ("input-decode-map", Vinput_decode_map,
12024 doc: /* Keymap that decodes input escape sequences.
12025 This is used mainly for mapping ASCII function key sequences into
12026 real Emacs function key events (symbols).
12028 The `read-key-sequence' function replaces any subsequence bound by
12029 `input-decode-map' with its binding. Contrary to `function-key-map',
12030 this map applies its rebinding regardless of the presence of an ordinary
12031 binding. So it is more like `key-translation-map' except that it applies
12032 before `function-key-map' rather than after.
12034 If the binding is a function, it is called with one argument (the prompt)
12035 and its return value (a key sequence) is used.
12037 The events that come from bindings in `input-decode-map' are not
12038 themselves looked up in `input-decode-map'.
12040 This variable is keyboard-local. */);
12042 DEFVAR_LISP ("function-key-map", Vfunction_key_map,
12043 doc: /* The parent keymap of all `local-function-key-map' instances.
12044 Function key definitions that apply to all terminal devices should go
12045 here. If a mapping is defined in both the current
12046 `local-function-key-map' binding and this variable, then the local
12047 definition will take precendence. */);
12048 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
12050 DEFVAR_LISP ("key-translation-map", Vkey_translation_map,
12051 doc: /* Keymap of key translations that can override keymaps.
12052 This keymap works like `function-key-map', but comes after that,
12053 and its non-prefix bindings override ordinary bindings.
12054 Another difference is that it is global rather than keyboard-local. */);
12055 Vkey_translation_map = Fmake_sparse_keymap (Qnil);
12057 DEFVAR_LISP ("deferred-action-list", Vdeferred_action_list,
12058 doc: /* List of deferred actions to be performed at a later time.
12059 The precise format isn't relevant here; we just check whether it is nil. */);
12060 Vdeferred_action_list = Qnil;
12062 DEFVAR_LISP ("deferred-action-function", Vdeferred_action_function,
12063 doc: /* Function to call to handle deferred actions, after each command.
12064 This function is called with no arguments after each command
12065 whenever `deferred-action-list' is non-nil. */);
12066 Vdeferred_action_function = Qnil;
12068 DEFVAR_LISP ("suggest-key-bindings", Vsuggest_key_bindings,
12069 doc: /* *Non-nil means show the equivalent key-binding when M-x command has one.
12070 The value can be a length of time to show the message for.
12071 If the value is non-nil and not a number, we wait 2 seconds. */);
12072 Vsuggest_key_bindings = Qt;
12074 DEFVAR_LISP ("timer-list", Vtimer_list,
12075 doc: /* List of active absolute time timers in order of increasing time. */);
12076 Vtimer_list = Qnil;
12078 DEFVAR_LISP ("timer-idle-list", Vtimer_idle_list,
12079 doc: /* List of active idle-time timers in order of increasing time. */);
12080 Vtimer_idle_list = Qnil;
12082 DEFVAR_LISP ("input-method-function", Vinput_method_function,
12083 doc: /* If non-nil, the function that implements the current input method.
12084 It's called with one argument, a printing character that was just read.
12085 \(That means a character with code 040...0176.)
12086 Typically this function uses `read-event' to read additional events.
12087 When it does so, it should first bind `input-method-function' to nil
12088 so it will not be called recursively.
12090 The function should return a list of zero or more events
12091 to be used as input. If it wants to put back some events
12092 to be reconsidered, separately, by the input method,
12093 it can add them to the beginning of `unread-command-events'.
12095 The input method function can find in `input-method-previous-message'
12096 the previous echo area message.
12098 The input method function should refer to the variables
12099 `input-method-use-echo-area' and `input-method-exit-on-first-char'
12100 for guidance on what to do. */);
12101 Vinput_method_function = Qnil;
12103 DEFVAR_LISP ("input-method-previous-message",
12104 Vinput_method_previous_message,
12105 doc: /* When `input-method-function' is called, hold the previous echo area message.
12106 This variable exists because `read-event' clears the echo area
12107 before running the input method. It is nil if there was no message. */);
12108 Vinput_method_previous_message = Qnil;
12110 DEFVAR_LISP ("show-help-function", Vshow_help_function,
12111 doc: /* If non-nil, the function that implements the display of help.
12112 It's called with one argument, the help string to display. */);
12113 Vshow_help_function = Qnil;
12115 DEFVAR_LISP ("disable-point-adjustment", Vdisable_point_adjustment,
12116 doc: /* If non-nil, suppress point adjustment after executing a command.
12118 After a command is executed, if point is moved into a region that has
12119 special properties (e.g. composition, display), we adjust point to
12120 the boundary of the region. But, when a command sets this variable to
12121 non-nil, we suppress the point adjustment.
12123 This variable is set to nil before reading a command, and is checked
12124 just after executing the command. */);
12125 Vdisable_point_adjustment = Qnil;
12127 DEFVAR_LISP ("global-disable-point-adjustment",
12128 Vglobal_disable_point_adjustment,
12129 doc: /* *If non-nil, always suppress point adjustment.
12131 The default value is nil, in which case, point adjustment are
12132 suppressed only after special commands that set
12133 `disable-point-adjustment' (which see) to non-nil. */);
12134 Vglobal_disable_point_adjustment = Qnil;
12136 DEFVAR_LISP ("minibuffer-message-timeout", Vminibuffer_message_timeout,
12137 doc: /* *How long to display an echo-area message when the minibuffer is active.
12138 If the value is not a number, such messages don't time out. */);
12139 Vminibuffer_message_timeout = make_number (2);
12141 DEFVAR_LISP ("throw-on-input", Vthrow_on_input,
12142 doc: /* If non-nil, any keyboard input throws to this symbol.
12143 The value of that variable is passed to `quit-flag' and later causes a
12144 peculiar kind of quitting. */);
12145 Vthrow_on_input = Qnil;
12147 DEFVAR_LISP ("command-error-function", Vcommand_error_function,
12148 doc: /* If non-nil, function to output error messages.
12149 The arguments are the error data, a list of the form
12150 (SIGNALED-CONDITIONS . SIGNAL-DATA)
12151 such as just as `condition-case' would bind its variable to,
12152 the context (a string which normally goes at the start of the message),
12153 and the Lisp function within which the error was signaled. */);
12154 Vcommand_error_function = Qnil;
12156 DEFVAR_LISP ("enable-disabled-menus-and-buttons",
12157 Venable_disabled_menus_and_buttons,
12158 doc: /* If non-nil, don't ignore events produced by disabled menu items and tool-bar.
12160 Help functions bind this to allow help on disabled menu items
12161 and tool-bar buttons. */);
12162 Venable_disabled_menus_and_buttons = Qnil;
12164 DEFVAR_LISP ("select-active-regions",
12165 Vselect_active_regions,
12166 doc: /* If non-nil, an active region automatically sets the primary selection.
12167 If the value is `only', only temporarily active regions (usually made
12168 by mouse-dragging or shift-selection) set the window selection.
12170 This takes effect only when Transient Mark mode is enabled. */);
12171 Vselect_active_regions = Qt;
12173 DEFVAR_LISP ("saved-region-selection",
12174 Vsaved_region_selection,
12175 doc: /* Contents of active region prior to buffer modification.
12176 If `select-active-regions' is non-nil, Emacs sets this to the
12177 text in the region before modifying the buffer. The next
12178 `deactivate-mark' call uses this to set the window selection. */);
12179 Vsaved_region_selection = Qnil;
12181 /* Create the initial keyboard. */
12182 initial_kboard = (KBOARD *) xmalloc (sizeof (KBOARD));
12183 init_kboard (initial_kboard);
12184 /* Vwindow_system is left at t for now. */
12185 initial_kboard->next_kboard = all_kboards;
12186 all_kboards = initial_kboard;
12189 void
12190 keys_of_keyboard (void)
12192 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
12193 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
12194 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
12195 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
12196 initial_define_key (meta_map, 'x', "execute-extended-command");
12198 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
12199 "handle-delete-frame");
12200 initial_define_lispy_key (Vspecial_event_map, "ns-put-working-text",
12201 "ns-put-working-text");
12202 initial_define_lispy_key (Vspecial_event_map, "ns-unput-working-text",
12203 "ns-unput-working-text");
12204 /* Here we used to use `ignore-event' which would simple set prefix-arg to
12205 current-prefix-arg, as is done in `handle-switch-frame'.
12206 But `handle-switch-frame is not run from the special-map.
12207 Commands from that map are run in a special way that automatically
12208 preserves the prefix-arg. Restoring the prefix arg here is not just
12209 redundant but harmful:
12210 - C-u C-x v =
12211 - current-prefix-arg is set to non-nil, prefix-arg is set to nil.
12212 - after the first prompt, the exit-minibuffer-hook is run which may
12213 iconify a frame and thus push a `iconify-frame' event.
12214 - after running exit-minibuffer-hook, current-prefix-arg is
12215 restored to the non-nil value it had before the prompt.
12216 - we enter the second prompt.
12217 current-prefix-arg is non-nil, prefix-arg is nil.
12218 - before running the first real event, we run the special iconify-frame
12219 event, but we pass the `special' arg to execute-command so
12220 current-prefix-arg and prefix-arg are left untouched.
12221 - here we foolishly copy the non-nil current-prefix-arg to prefix-arg.
12222 - the next key event will have a spuriously non-nil current-prefix-arg. */
12223 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
12224 "ignore");
12225 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
12226 "ignore");
12227 /* Handling it at such a low-level causes read_key_sequence to get
12228 * confused because it doesn't realize that the current_buffer was
12229 * changed by read_char.
12231 * initial_define_lispy_key (Vspecial_event_map, "select-window",
12232 * "handle-select-window"); */
12233 initial_define_lispy_key (Vspecial_event_map, "save-session",
12234 "handle-save-session");
12236 #ifdef HAVE_DBUS
12237 /* Define a special event which is raised for dbus callback
12238 functions. */
12239 initial_define_lispy_key (Vspecial_event_map, "dbus-event",
12240 "dbus-handle-event");
12241 #endif
12243 initial_define_lispy_key (Vspecial_event_map, "config-changed-event",
12244 "ignore");
12247 /* Mark the pointers in the kboard objects.
12248 Called by the Fgarbage_collector. */
12249 void
12250 mark_kboards (void)
12252 KBOARD *kb;
12253 Lisp_Object *p;
12254 for (kb = all_kboards; kb; kb = kb->next_kboard)
12256 if (kb->kbd_macro_buffer)
12257 for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
12258 mark_object (*p);
12259 mark_object (KVAR (kb, Voverriding_terminal_local_map));
12260 mark_object (KVAR (kb, Vlast_command));
12261 mark_object (KVAR (kb, Vreal_last_command));
12262 mark_object (KVAR (kb, Vkeyboard_translate_table));
12263 mark_object (KVAR (kb, Vlast_repeatable_command));
12264 mark_object (KVAR (kb, Vprefix_arg));
12265 mark_object (KVAR (kb, Vlast_prefix_arg));
12266 mark_object (KVAR (kb, kbd_queue));
12267 mark_object (KVAR (kb, defining_kbd_macro));
12268 mark_object (KVAR (kb, Vlast_kbd_macro));
12269 mark_object (KVAR (kb, Vsystem_key_alist));
12270 mark_object (KVAR (kb, system_key_syms));
12271 mark_object (KVAR (kb, Vwindow_system));
12272 mark_object (KVAR (kb, Vinput_decode_map));
12273 mark_object (KVAR (kb, Vlocal_function_key_map));
12274 mark_object (KVAR (kb, Vdefault_minibuffer_frame));
12275 mark_object (KVAR (kb, echo_string));
12278 struct input_event *event;
12279 for (event = kbd_fetch_ptr; event != kbd_store_ptr; event++)
12281 if (event == kbd_buffer + KBD_BUFFER_SIZE)
12282 event = kbd_buffer;
12283 if (event->kind != SELECTION_REQUEST_EVENT
12284 && event->kind != SELECTION_CLEAR_EVENT)
12286 mark_object (event->x);
12287 mark_object (event->y);
12289 mark_object (event->frame_or_window);
12290 mark_object (event->arg);