(ispell-check-comments): Default is now t.
[bpt/emacs.git] / src / keyboard.c
1 /* Keyboard and mouse input; editor command loop.
2 Copyright (C) 1985,86,87,88,89,93,94,95,96 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Allow config.h to undefine symbols found here. */
22 #include <signal.h>
23
24 #include <config.h>
25 #include <stdio.h>
26 #include "termchar.h"
27 #include "termopts.h"
28 #include "lisp.h"
29 #include "termhooks.h"
30 #include "macros.h"
31 #include "frame.h"
32 #include "window.h"
33 #include "commands.h"
34 #include "buffer.h"
35 #include "disptab.h"
36 #include "dispextern.h"
37 #include "keyboard.h"
38 #include "intervals.h"
39 #include "blockinput.h"
40 #include <setjmp.h>
41 #include <errno.h>
42
43 #ifdef MSDOS
44 #include "msdos.h"
45 #include <time.h>
46 #else /* not MSDOS */
47 #ifndef VMS
48 #include <sys/ioctl.h>
49 #endif
50 #endif /* not MSDOS */
51
52 #include "syssignal.h"
53 #include "systty.h"
54
55 /* This is to get the definitions of the XK_ symbols. */
56 #ifdef HAVE_X_WINDOWS
57 #include "xterm.h"
58 #endif
59
60 #ifdef HAVE_NTGUI
61 #include "w32term.h"
62 #endif /* HAVE_NTGUI */
63
64 /* Include systime.h after xterm.h to avoid double inclusion of time.h. */
65 #include "systime.h"
66
67 extern int errno;
68
69 /* Variables for blockinput.h: */
70
71 /* Non-zero if interrupt input is blocked right now. */
72 int interrupt_input_blocked;
73
74 /* Nonzero means an input interrupt has arrived
75 during the current critical section. */
76 int interrupt_input_pending;
77
78
79 /* File descriptor to use for input. */
80 extern int input_fd;
81
82 #ifdef HAVE_WINDOW_SYSTEM
83 /* Make all keyboard buffers much bigger when using X windows. */
84 #define KBD_BUFFER_SIZE 4096
85 #else /* No X-windows, character input */
86 #define KBD_BUFFER_SIZE 256
87 #endif /* No X-windows */
88
89 /* Following definition copied from eval.c */
90
91 struct backtrace
92 {
93 struct backtrace *next;
94 Lisp_Object *function;
95 Lisp_Object *args; /* Points to vector of args. */
96 int nargs; /* length of vector. If nargs is UNEVALLED,
97 args points to slot holding list of
98 unevalled args */
99 char evalargs;
100 };
101
102 #ifdef MULTI_KBOARD
103 KBOARD *initial_kboard;
104 KBOARD *current_kboard;
105 KBOARD *all_kboards;
106 int single_kboard;
107 #else
108 KBOARD the_only_kboard;
109 #endif
110
111 /* Non-nil disable property on a command means
112 do not execute it; call disabled-command-hook's value instead. */
113 Lisp_Object Qdisabled, Qdisabled_command_hook;
114
115 #define NUM_RECENT_KEYS (100)
116 int recent_keys_index; /* Index for storing next element into recent_keys */
117 int total_keys; /* Total number of elements stored into recent_keys */
118 Lisp_Object recent_keys; /* A vector, holding the last 100 keystrokes */
119
120 /* Vector holding the key sequence that invoked the current command.
121 It is reused for each command, and it may be longer than the current
122 sequence; this_command_key_count indicates how many elements
123 actually mean something.
124 It's easier to staticpro a single Lisp_Object than an array. */
125 Lisp_Object this_command_keys;
126 int this_command_key_count;
127
128 /* Number of elements of this_command_keys
129 that precede this key sequence. */
130 int this_single_command_key_start;
131
132 /* Record values of this_command_key_count and echo_length ()
133 before this command was read. */
134 static int before_command_key_count;
135 static int before_command_echo_length;
136 /* Values of before_command_key_count and before_command_echo_length
137 saved by reset-this-command-lengths. */
138 static int before_command_key_count_1;
139 static int before_command_echo_length_1;
140 /* Flag set by reset-this-command-lengths,
141 saying to reset the lengths when add_command_key is called. */
142 static int before_command_restore_flag;
143
144 extern int minbuf_level;
145
146 extern struct backtrace *backtrace_list;
147
148 /* Nonzero means do menu prompting. */
149 static int menu_prompting;
150
151 /* Character to see next line of menu prompt. */
152 static Lisp_Object menu_prompt_more_char;
153
154 /* For longjmp to where kbd input is being done. */
155 static jmp_buf getcjmp;
156
157 /* True while doing kbd input. */
158 int waiting_for_input;
159
160 /* True while displaying for echoing. Delays C-g throwing. */
161 static int echoing;
162
163 /* True means we can start echoing at the next input pause
164 even though there is something in the echo area. */
165 static char *ok_to_echo_at_next_pause;
166
167 /* Nonzero means disregard local maps for the menu bar. */
168 static int inhibit_local_menu_bar_menus;
169
170 /* Nonzero means C-g should cause immediate error-signal. */
171 int immediate_quit;
172
173 /* Character to recognize as the help char. */
174 Lisp_Object Vhelp_char;
175
176 /* List of other event types to recognize as meaning "help". */
177 Lisp_Object Vhelp_event_list;
178
179 /* Form to execute when help char is typed. */
180 Lisp_Object Vhelp_form;
181
182 /* Command to run when the help character follows a prefix key. */
183 Lisp_Object Vprefix_help_command;
184
185 /* List of items that should move to the end of the menu bar. */
186 Lisp_Object Vmenu_bar_final_items;
187
188 /* Non-nil means show the equivalent key-binding for
189 any M-x command that has one.
190 The value can be a length of time to show the message for.
191 If the value is non-nil and not a number, we wait 2 seconds. */
192 Lisp_Object Vsuggest_key_bindings;
193
194 /* Character that causes a quit. Normally C-g.
195
196 If we are running on an ordinary terminal, this must be an ordinary
197 ASCII char, since we want to make it our interrupt character.
198
199 If we are not running on an ordinary terminal, it still needs to be
200 an ordinary ASCII char. This character needs to be recognized in
201 the input interrupt handler. At this point, the keystroke is
202 represented as a struct input_event, while the desired quit
203 character is specified as a lispy event. The mapping from struct
204 input_events to lispy events cannot run in an interrupt handler,
205 and the reverse mapping is difficult for anything but ASCII
206 keystrokes.
207
208 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
209 ASCII character. */
210 int quit_char;
211
212 extern Lisp_Object current_global_map;
213 extern int minibuf_level;
214
215 /* If non-nil, this is a map that overrides all other local maps. */
216 Lisp_Object Voverriding_local_map;
217
218 /* If non-nil, Voverriding_local_map applies to the menu bar. */
219 Lisp_Object Voverriding_local_map_menu_flag;
220
221 /* Keymap that defines special misc events that should
222 be processed immediately at a low level. */
223 Lisp_Object Vspecial_event_map;
224
225 /* Current depth in recursive edits. */
226 int command_loop_level;
227
228 /* Total number of times command_loop has read a key sequence. */
229 int num_input_keys;
230
231 /* Last input character read as a command. */
232 Lisp_Object last_command_char;
233
234 /* Last input character read as a command, not counting menus
235 reached by the mouse. */
236 Lisp_Object last_nonmenu_event;
237
238 /* Last input character read for any purpose. */
239 Lisp_Object last_input_char;
240
241 /* If not Qnil, a list of objects to be read as subsequent command input. */
242 Lisp_Object Vunread_command_events;
243
244 /* If not -1, an event to be read as subsequent command input. */
245 int unread_command_char;
246
247 /* If not Qnil, this is a switch-frame event which we decided to put
248 off until the end of a key sequence. This should be read as the
249 next command input, after any unread_command_events.
250
251 read_key_sequence uses this to delay switch-frame events until the
252 end of the key sequence; Fread_char uses it to put off switch-frame
253 events until a non-ASCII event is acceptable as input. */
254 Lisp_Object unread_switch_frame;
255
256 /* A mask of extra modifier bits to put into every keyboard char. */
257 int extra_keyboard_modifiers;
258
259 /* Char to use as prefix when a meta character is typed in.
260 This is bound on entry to minibuffer in case ESC is changed there. */
261
262 Lisp_Object meta_prefix_char;
263
264 /* Last size recorded for a current buffer which is not a minibuffer. */
265 static int last_non_minibuf_size;
266
267 /* Number of idle seconds before an auto-save and garbage collection. */
268 static Lisp_Object Vauto_save_timeout;
269
270 /* Total number of times read_char has returned. */
271 int num_input_chars;
272
273 /* Total number of times read_char has returned, outside of macros. */
274 int num_nonmacro_input_chars;
275
276 /* Auto-save automatically when this many characters have been typed
277 since the last time. */
278
279 static int auto_save_interval;
280
281 /* Value of num_nonmacro_input_chars as of last auto save. */
282
283 int last_auto_save;
284
285 /* The command being executed by the command loop.
286 Commands may set this, and the value set will be copied into
287 current_kboard->Vlast_command instead of the actual command. */
288 Lisp_Object this_command;
289
290 /* The value of point when the last command was executed. */
291 int last_point_position;
292
293 /* The buffer that was current when the last command was started. */
294 Lisp_Object last_point_position_buffer;
295
296 #ifdef MULTI_FRAME
297 /* The frame in which the last input event occurred, or Qmacro if the
298 last event came from a macro. We use this to determine when to
299 generate switch-frame events. This may be cleared by functions
300 like Fselect_frame, to make sure that a switch-frame event is
301 generated by the next character. */
302 Lisp_Object internal_last_event_frame;
303 #endif
304
305 /* A user-visible version of the above, intended to allow users to
306 figure out where the last event came from, if the event doesn't
307 carry that information itself (i.e. if it was a character). */
308 Lisp_Object Vlast_event_frame;
309
310 /* The timestamp of the last input event we received from the X server.
311 X Windows wants this for selection ownership. */
312 unsigned long last_event_timestamp;
313
314 Lisp_Object Qself_insert_command;
315 Lisp_Object Qforward_char;
316 Lisp_Object Qbackward_char;
317 Lisp_Object Qundefined;
318
319 /* read_key_sequence stores here the command definition of the
320 key sequence that it reads. */
321 Lisp_Object read_key_sequence_cmd;
322
323 /* Form to evaluate (if non-nil) when Emacs is started. */
324 Lisp_Object Vtop_level;
325
326 /* User-supplied string to translate input characters through. */
327 Lisp_Object Vkeyboard_translate_table;
328
329 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
330 extern Lisp_Object Vfunction_key_map;
331
332 /* Another keymap that maps key sequences into key sequences.
333 This one takes precedence over ordinary definitions. */
334 extern Lisp_Object Vkey_translation_map;
335
336 /* Non-nil means deactivate the mark at end of this command. */
337 Lisp_Object Vdeactivate_mark;
338
339 /* Menu bar specified in Lucid Emacs fashion. */
340
341 Lisp_Object Vlucid_menu_bar_dirty_flag;
342 Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;
343
344 /* Hooks to run before and after each command. */
345 Lisp_Object Qpre_command_hook, Vpre_command_hook;
346 Lisp_Object Qpost_command_hook, Vpost_command_hook;
347 Lisp_Object Qcommand_hook_internal, Vcommand_hook_internal;
348 /* Hook run after a command if there's no more input soon. */
349 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
350
351 /* Delay time in microseconds before running post-command-idle-hook. */
352 int post_command_idle_delay;
353
354 /* List of deferred actions to be performed at a later time.
355 The precise format isn't relevant here; we just check whether it is nil. */
356 Lisp_Object Vdeferred_action_list;
357
358 /* Function to call to handle deferred actions, when there are any. */
359 Lisp_Object Vdeferred_action_function;
360 Lisp_Object Qdeferred_action_function;
361
362 /* File in which we write all commands we read. */
363 FILE *dribble;
364
365 /* Nonzero if input is available. */
366 int input_pending;
367
368 /* 1 if should obey 0200 bit in input chars as "Meta", 2 if should
369 keep 0200 bit in input chars. 0 to ignore the 0200 bit. */
370
371 int meta_key;
372
373 extern char *pending_malloc_warning;
374
375 /* Circular buffer for pre-read keyboard input. */
376 static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
377
378 /* Vector to GCPRO the frames and windows mentioned in kbd_buffer.
379
380 The interrupt-level event handlers will never enqueue an event on a
381 frame which is not in Vframe_list, and once an event is dequeued,
382 internal_last_event_frame or the event itself points to the frame.
383 So that's all fine.
384
385 But while the event is sitting in the queue, it's completely
386 unprotected. Suppose the user types one command which will run for
387 a while and then delete a frame, and then types another event at
388 the frame that will be deleted, before the command gets around to
389 it. Suppose there are no references to this frame elsewhere in
390 Emacs, and a GC occurs before the second event is dequeued. Now we
391 have an event referring to a freed frame, which will crash Emacs
392 when it is dequeued.
393
394 Similar things happen when an event on a scroll bar is enqueued; the
395 window may be deleted while the event is in the queue.
396
397 So, we use this vector to protect the frame_or_window field in the
398 event queue. That way, they'll be dequeued as dead frames or
399 windows, but still valid lisp objects.
400
401 If kbd_buffer[i].kind != no_event, then
402 (XVECTOR (kbd_buffer_frame_or_window)->contents[i]
403 == kbd_buffer[i].frame_or_window. */
404 static Lisp_Object kbd_buffer_frame_or_window;
405
406 /* Pointer to next available character in kbd_buffer.
407 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
408 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the the
409 next available char is in kbd_buffer[0]. */
410 static struct input_event *kbd_fetch_ptr;
411
412 /* Pointer to next place to store character in kbd_buffer. This
413 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
414 character should go in kbd_buffer[0]. */
415 static volatile struct input_event *kbd_store_ptr;
416
417 /* The above pair of variables forms a "queue empty" flag. When we
418 enqueue a non-hook event, we increment kbd_store_ptr. When we
419 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
420 there is input available iff the two pointers are not equal.
421
422 Why not just have a flag set and cleared by the enqueuing and
423 dequeuing functions? Such a flag could be screwed up by interrupts
424 at inopportune times. */
425
426 /* If this flag is non-nil, we check mouse_moved to see when the
427 mouse moves, and motion events will appear in the input stream.
428 Otherwise, mouse motion is ignored. */
429 static Lisp_Object do_mouse_tracking;
430
431 /* Symbols to head events. */
432 Lisp_Object Qmouse_movement;
433 Lisp_Object Qscroll_bar_movement;
434 Lisp_Object Qswitch_frame;
435 Lisp_Object Qdelete_frame;
436 Lisp_Object Qiconify_frame;
437 Lisp_Object Qmake_frame_visible;
438
439 /* Symbols to denote kinds of events. */
440 Lisp_Object Qfunction_key;
441 Lisp_Object Qmouse_click;
442 Lisp_Object Qtimer_event;
443 /* Lisp_Object Qmouse_movement; - also an event header */
444
445 /* Properties of event headers. */
446 Lisp_Object Qevent_kind;
447 Lisp_Object Qevent_symbol_elements;
448
449 Lisp_Object Qmenu_enable;
450
451 /* An event header symbol HEAD may have a property named
452 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
453 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
454 mask of modifiers applied to it. If present, this is used to help
455 speed up parse_modifiers. */
456 Lisp_Object Qevent_symbol_element_mask;
457
458 /* An unmodified event header BASE may have a property named
459 Qmodifier_cache, which is an alist mapping modifier masks onto
460 modified versions of BASE. If present, this helps speed up
461 apply_modifiers. */
462 Lisp_Object Qmodifier_cache;
463
464 /* Symbols to use for parts of windows. */
465 Lisp_Object Qmode_line;
466 Lisp_Object Qvertical_line;
467 Lisp_Object Qvertical_scroll_bar;
468 Lisp_Object Qmenu_bar;
469
470 extern Lisp_Object Qmenu_enable;
471
472 Lisp_Object recursive_edit_unwind (), command_loop ();
473 Lisp_Object Fthis_command_keys ();
474 Lisp_Object Qextended_command_history;
475 EMACS_TIME timer_check ();
476
477 extern char *x_get_keysym_name ();
478
479 Lisp_Object Qpolling_period;
480
481 /* List of absolute timers. Appears in order of next scheduled event. */
482 Lisp_Object Vtimer_list;
483
484 /* List of idle time timers. Appears in order of next scheduled event. */
485 Lisp_Object Vtimer_idle_list;
486
487 /* Incremented whenever a timer is run. */
488 int timers_run;
489
490 extern Lisp_Object Vprint_level, Vprint_length;
491
492 /* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
493 happens. */
494 EMACS_TIME *input_available_clear_time;
495
496 /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
497 Default is 1 if INTERRUPT_INPUT is defined. */
498 int interrupt_input;
499
500 /* Nonzero while interrupts are temporarily deferred during redisplay. */
501 int interrupts_deferred;
502
503 /* Nonzero means use ^S/^Q for flow control. */
504 int flow_control;
505
506 /* Allow m- file to inhibit use of FIONREAD. */
507 #ifdef BROKEN_FIONREAD
508 #undef FIONREAD
509 #endif
510
511 /* We are unable to use interrupts if FIONREAD is not available,
512 so flush SIGIO so we won't try. */
513 #ifndef FIONREAD
514 #ifdef SIGIO
515 #undef SIGIO
516 #endif
517 #endif
518
519 /* If we support a window system, turn on the code to poll periodically
520 to detect C-g. It isn't actually used when doing interrupt input. */
521 #ifdef HAVE_WINDOW_SYSTEM
522 #define POLL_FOR_INPUT
523 #endif
524
525 /* Non-nil enables Column Number mode. */
526 Lisp_Object Vcolumn_number_mode;
527 \f
528 /* Global variable declarations. */
529
530 /* Function for init_keyboard to call with no args (if nonzero). */
531 void (*keyboard_init_hook) ();
532
533 static int read_avail_input ();
534 static void get_input_pending ();
535 static int readable_events ();
536 static Lisp_Object read_char_x_menu_prompt ();
537 static Lisp_Object read_char_minibuf_menu_prompt ();
538 static Lisp_Object make_lispy_event ();
539 #ifdef HAVE_MOUSE
540 static Lisp_Object make_lispy_movement ();
541 #endif
542 static Lisp_Object modify_event_symbol ();
543 static Lisp_Object make_lispy_switch_frame ();
544 static int parse_solitary_modifier ();
545
546 /* > 0 if we are to echo keystrokes. */
547 static int echo_keystrokes;
548
549 /* Nonzero means don't try to suspend even if the operating system seems
550 to support it. */
551 static int cannot_suspend;
552
553 #define min(a,b) ((a)<(b)?(a):(b))
554 #define max(a,b) ((a)>(b)?(a):(b))
555
556 /* Install the string STR as the beginning of the string of echoing,
557 so that it serves as a prompt for the next character.
558 Also start echoing. */
559
560 echo_prompt (str)
561 char *str;
562 {
563 int len = strlen (str);
564
565 if (len > ECHOBUFSIZE - 4)
566 len = ECHOBUFSIZE - 4;
567 bcopy (str, current_kboard->echobuf, len);
568 current_kboard->echoptr = current_kboard->echobuf + len;
569 *current_kboard->echoptr = '\0';
570
571 current_kboard->echo_after_prompt = len;
572
573 echo_now ();
574 }
575
576 /* Add C to the echo string, if echoing is going on.
577 C can be a character, which is printed prettily ("M-C-x" and all that
578 jazz), or a symbol, whose name is printed. */
579
580 echo_char (c)
581 Lisp_Object c;
582 {
583 extern char *push_key_description ();
584
585 if (current_kboard->immediate_echo)
586 {
587 char *ptr = current_kboard->echoptr;
588
589 if (ptr != current_kboard->echobuf)
590 *ptr++ = ' ';
591
592 /* If someone has passed us a composite event, use its head symbol. */
593 c = EVENT_HEAD (c);
594
595 if (INTEGERP (c))
596 {
597 if (ptr - current_kboard->echobuf > ECHOBUFSIZE - 6)
598 return;
599
600 ptr = push_key_description (XINT (c), ptr);
601 }
602 else if (SYMBOLP (c))
603 {
604 struct Lisp_String *name = XSYMBOL (c)->name;
605 if ((ptr - current_kboard->echobuf) + name->size + 4 > ECHOBUFSIZE)
606 return;
607 bcopy (name->data, ptr, name->size);
608 ptr += name->size;
609 }
610
611 if (current_kboard->echoptr == current_kboard->echobuf
612 && help_char_p (c))
613 {
614 strcpy (ptr, " (Type ? for further options)");
615 ptr += strlen (ptr);
616 }
617
618 *ptr = 0;
619 current_kboard->echoptr = ptr;
620
621 echo_now ();
622 }
623 }
624
625 /* Temporarily add a dash to the end of the echo string if it's not
626 empty, so that it serves as a mini-prompt for the very next character. */
627
628 echo_dash ()
629 {
630 if (!current_kboard->immediate_echo
631 && current_kboard->echoptr == current_kboard->echobuf)
632 return;
633 /* Do nothing if we just printed a prompt. */
634 if (current_kboard->echo_after_prompt
635 == current_kboard->echoptr - current_kboard->echobuf)
636 return;
637 /* Do nothing if not echoing at all. */
638 if (current_kboard->echoptr == 0)
639 return;
640
641 /* Put a dash at the end of the buffer temporarily,
642 but make it go away when the next character is added. */
643 current_kboard->echoptr[0] = '-';
644 current_kboard->echoptr[1] = 0;
645
646 echo_now ();
647 }
648
649 /* Display the current echo string, and begin echoing if not already
650 doing so. */
651
652 echo_now ()
653 {
654 if (!current_kboard->immediate_echo)
655 {
656 int i;
657 current_kboard->immediate_echo = 1;
658
659 for (i = 0; i < this_command_key_count; i++)
660 {
661 Lisp_Object c;
662 c = XVECTOR (this_command_keys)->contents[i];
663 if (! (EVENT_HAS_PARAMETERS (c)
664 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
665 echo_char (c);
666 }
667 echo_dash ();
668 }
669
670 echoing = 1;
671 message1_nolog (current_kboard->echobuf);
672 echoing = 0;
673
674 if (waiting_for_input && !NILP (Vquit_flag))
675 quit_throw_to_read_char ();
676 }
677
678 /* Turn off echoing, for the start of a new command. */
679
680 cancel_echoing ()
681 {
682 current_kboard->immediate_echo = 0;
683 current_kboard->echoptr = current_kboard->echobuf;
684 current_kboard->echo_after_prompt = -1;
685 ok_to_echo_at_next_pause = 0;
686 }
687
688 /* Return the length of the current echo string. */
689
690 static int
691 echo_length ()
692 {
693 return current_kboard->echoptr - current_kboard->echobuf;
694 }
695
696 /* Truncate the current echo message to its first LEN chars.
697 This and echo_char get used by read_key_sequence when the user
698 switches frames while entering a key sequence. */
699
700 static void
701 echo_truncate (len)
702 int len;
703 {
704 current_kboard->echobuf[len] = '\0';
705 current_kboard->echoptr = current_kboard->echobuf + len;
706 truncate_echo_area (len);
707 }
708
709 \f
710 /* Functions for manipulating this_command_keys. */
711 static void
712 add_command_key (key)
713 Lisp_Object key;
714 {
715 int size = XVECTOR (this_command_keys)->size;
716
717 /* If reset-this-command-length was called recently, obey it now.
718 See the doc string of that function for an explanation of why. */
719 if (before_command_restore_flag)
720 {
721 this_command_key_count = before_command_key_count_1;
722 if (this_command_key_count < this_single_command_key_start)
723 this_single_command_key_start = this_command_key_count;
724 echo_truncate (before_command_echo_length_1);
725 before_command_restore_flag = 0;
726 }
727
728 if (this_command_key_count >= size)
729 {
730 Lisp_Object new_keys;
731
732 new_keys = Fmake_vector (make_number (size * 2), Qnil);
733 bcopy (XVECTOR (this_command_keys)->contents,
734 XVECTOR (new_keys)->contents,
735 size * sizeof (Lisp_Object));
736
737 this_command_keys = new_keys;
738 }
739
740 XVECTOR (this_command_keys)->contents[this_command_key_count++] = key;
741 }
742 \f
743 Lisp_Object
744 recursive_edit_1 ()
745 {
746 int count = specpdl_ptr - specpdl;
747 Lisp_Object val;
748
749 if (command_loop_level > 0)
750 {
751 specbind (Qstandard_output, Qt);
752 specbind (Qstandard_input, Qt);
753 }
754
755 val = command_loop ();
756 if (EQ (val, Qt))
757 Fsignal (Qquit, Qnil);
758
759 return unbind_to (count, Qnil);
760 }
761
762 /* When an auto-save happens, record the "time", and don't do again soon. */
763
764 record_auto_save ()
765 {
766 last_auto_save = num_nonmacro_input_chars;
767 }
768
769 /* Make an auto save happen as soon as possible at command level. */
770
771 force_auto_save_soon ()
772 {
773 last_auto_save = - auto_save_interval - 1;
774
775 record_asynch_buffer_change ();
776 }
777 \f
778 DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
779 "Invoke the editor command loop recursively.\n\
780 To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
781 that tells this function to return.\n\
782 Alternately, `(throw 'exit t)' makes this function signal an error.\n\
783 This function is called by the editor initialization to begin editing.")
784 ()
785 {
786 int count = specpdl_ptr - specpdl;
787 Lisp_Object val;
788
789 command_loop_level++;
790 update_mode_lines = 1;
791
792 record_unwind_protect (recursive_edit_unwind,
793 (command_loop_level
794 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
795 ? Fcurrent_buffer ()
796 : Qnil);
797 recursive_edit_1 ();
798 return unbind_to (count, Qnil);
799 }
800
801 Lisp_Object
802 recursive_edit_unwind (buffer)
803 Lisp_Object buffer;
804 {
805 if (!NILP (buffer))
806 Fset_buffer (buffer);
807
808 command_loop_level--;
809 update_mode_lines = 1;
810 return Qnil;
811 }
812 \f
813 static void
814 any_kboard_state ()
815 {
816 #ifdef MULTI_KBOARD
817 #if 0 /* Theory: if there's anything in Vunread_command_events,
818 it will right away be read by read_key_sequence,
819 and then if we do switch KBOARDS, it will go into the side
820 queue then. So we don't need to do anything special here -- rms. */
821 if (CONSP (Vunread_command_events))
822 {
823 current_kboard->kbd_queue
824 = nconc2 (Vunread_command_events, current_kboard->kbd_queue);
825 current_kboard->kbd_queue_has_data = 1;
826 }
827 Vunread_command_events = Qnil;
828 #endif
829 single_kboard = 0;
830 #endif
831 }
832
833 /* Switch to the single-kboard state, making current_kboard
834 the only KBOARD from which further input is accepted. */
835
836 void
837 single_kboard_state ()
838 {
839 #ifdef MULTI_KBOARD
840 single_kboard = 1;
841 #endif
842 }
843
844 /* Maintain a stack of kboards, so other parts of Emacs
845 can switch temporarily to the kboard of a given frame
846 and then revert to the previous status. */
847
848 struct kboard_stack
849 {
850 KBOARD *kboard;
851 struct kboard_stack *next;
852 };
853
854 static struct kboard_stack *kboard_stack;
855
856 void
857 push_frame_kboard (f)
858 FRAME_PTR f;
859 {
860 #ifdef MULTI_KBOARD
861 struct kboard_stack *p
862 = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));
863
864 p->next = kboard_stack;
865 p->kboard = current_kboard;
866 kboard_stack = p;
867
868 current_kboard = FRAME_KBOARD (f);
869 #endif
870 }
871
872 void
873 pop_frame_kboard ()
874 {
875 #ifdef MULTI_KBOARD
876 struct kboard_stack *p = kboard_stack;
877 current_kboard = p->kboard;
878 kboard_stack = p->next;
879 xfree (p);
880 #endif
881 }
882 \f
883 /* Handle errors that are not handled at inner levels
884 by printing an error message and returning to the editor command loop. */
885
886 Lisp_Object
887 cmd_error (data)
888 Lisp_Object data;
889 {
890 Lisp_Object old_level, old_length;
891
892 Vstandard_output = Qt;
893 Vstandard_input = Qt;
894 Vexecuting_macro = Qnil;
895 current_kboard->Vprefix_arg = Qnil;
896 cancel_echoing ();
897
898 /* Avoid unquittable loop if data contains a circular list. */
899 old_level = Vprint_level;
900 old_length = Vprint_length;
901 XSETFASTINT (Vprint_level, 10);
902 XSETFASTINT (Vprint_length, 10);
903 cmd_error_internal (data, NULL);
904 Vprint_level = old_level;
905 Vprint_length = old_length;
906
907 Vquit_flag = Qnil;
908
909 Vinhibit_quit = Qnil;
910 #ifdef MULTI_KBOARD
911 any_kboard_state ();
912 #endif
913
914 return make_number (0);
915 }
916
917 cmd_error_internal (data, context)
918 Lisp_Object data;
919 char *context;
920 {
921 Lisp_Object stream;
922
923 Vquit_flag = Qnil;
924 Vinhibit_quit = Qt;
925 echo_area_glyphs = 0;
926
927 /* If the window system or terminal frame hasn't been initialized
928 yet, or we're not interactive, it's best to dump this message out
929 to stderr and exit. */
930 if (! FRAME_MESSAGE_BUF (selected_frame)
931 || noninteractive)
932 stream = Qexternal_debugging_output;
933 else
934 {
935 Fdiscard_input ();
936 bitch_at_user ();
937 stream = Qt;
938 }
939
940 if (context != 0)
941 write_string_1 (context, -1, stream);
942
943 print_error_message (data, stream);
944
945 /* If the window system or terminal frame hasn't been initialized
946 yet, or we're in -batch mode, this error should cause Emacs to exit. */
947 if (! FRAME_MESSAGE_BUF (selected_frame)
948 || noninteractive)
949 {
950 Fterpri (stream);
951 Fkill_emacs (make_number (-1));
952 }
953 }
954 \f
955 Lisp_Object command_loop_1 ();
956 Lisp_Object command_loop_2 ();
957 Lisp_Object top_level_1 ();
958
959 /* Entry to editor-command-loop.
960 This level has the catches for exiting/returning to editor command loop.
961 It returns nil to exit recursive edit, t to abort it. */
962
963 Lisp_Object
964 command_loop ()
965 {
966 if (command_loop_level > 0 || minibuf_level > 0)
967 {
968 return internal_catch (Qexit, command_loop_2, Qnil);
969 }
970 else
971 while (1)
972 {
973 internal_catch (Qtop_level, top_level_1, Qnil);
974 internal_catch (Qtop_level, command_loop_2, Qnil);
975
976 /* End of file in -batch run causes exit here. */
977 if (noninteractive)
978 Fkill_emacs (Qt);
979 }
980 }
981
982 /* Here we catch errors in execution of commands within the
983 editing loop, and reenter the editing loop.
984 When there is an error, cmd_error runs and returns a non-nil
985 value to us. A value of nil means that cmd_loop_1 itself
986 returned due to end of file (or end of kbd macro). */
987
988 Lisp_Object
989 command_loop_2 ()
990 {
991 register Lisp_Object val;
992
993 do
994 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
995 while (!NILP (val));
996
997 return Qnil;
998 }
999
1000 Lisp_Object
1001 top_level_2 ()
1002 {
1003 return Feval (Vtop_level);
1004 }
1005
1006 Lisp_Object
1007 top_level_1 ()
1008 {
1009 /* On entry to the outer level, run the startup file */
1010 if (!NILP (Vtop_level))
1011 internal_condition_case (top_level_2, Qerror, cmd_error);
1012 else if (!NILP (Vpurify_flag))
1013 message ("Bare impure Emacs (standard Lisp code not loaded)");
1014 else
1015 message ("Bare Emacs (standard Lisp code not loaded)");
1016 return Qnil;
1017 }
1018
1019 DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
1020 "Exit all recursive editing levels.")
1021 ()
1022 {
1023 Fthrow (Qtop_level, Qnil);
1024 }
1025
1026 DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
1027 "Exit from the innermost recursive edit or minibuffer.")
1028 ()
1029 {
1030 if (command_loop_level > 0 || minibuf_level > 0)
1031 Fthrow (Qexit, Qnil);
1032
1033 error ("No recursive edit is in progress");
1034 }
1035
1036 DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
1037 "Abort the command that requested this recursive edit or minibuffer input.")
1038 ()
1039 {
1040 if (command_loop_level > 0 || minibuf_level > 0)
1041 Fthrow (Qexit, Qt);
1042
1043 error ("No recursive edit is in progress");
1044 }
1045 \f
1046 /* This is the actual command reading loop,
1047 sans error-handling encapsulation. */
1048
1049 Lisp_Object Fcommand_execute ();
1050 static int read_key_sequence ();
1051 void safe_run_hooks ();
1052
1053 Lisp_Object
1054 command_loop_1 ()
1055 {
1056 Lisp_Object cmd, tem;
1057 int lose;
1058 int nonundocount;
1059 Lisp_Object keybuf[30];
1060 int i;
1061 int no_redisplay;
1062 int no_direct;
1063 int prev_modiff;
1064 struct buffer *prev_buffer;
1065 #ifdef MULTI_KBOARD
1066 int was_locked = single_kboard;
1067 #endif
1068
1069 current_kboard->Vprefix_arg = Qnil;
1070 Vdeactivate_mark = Qnil;
1071 waiting_for_input = 0;
1072 cancel_echoing ();
1073
1074 nonundocount = 0;
1075 no_redisplay = 0;
1076 this_command_key_count = 0;
1077 this_single_command_key_start = 0;
1078
1079 /* Make sure this hook runs after commands that get errors and
1080 throw to top level. */
1081 /* Note that the value cell will never directly contain nil
1082 if the symbol is a local variable. */
1083 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1084 safe_run_hooks (Qpost_command_hook);
1085
1086 if (!NILP (Vdeferred_action_list))
1087 call0 (Vdeferred_action_function);
1088
1089 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1090 {
1091 if (NILP (Vunread_command_events)
1092 && NILP (Vexecuting_macro)
1093 && !NILP (sit_for (0, post_command_idle_delay, 0, 1)))
1094 safe_run_hooks (Qpost_command_idle_hook);
1095 }
1096
1097 /* Do this after running Vpost_command_hook, for consistency. */
1098 current_kboard->Vlast_command = this_command;
1099
1100 while (1)
1101 {
1102 /* Make sure the current window's buffer is selected. */
1103 if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
1104 set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
1105
1106 /* Display any malloc warning that just came out. Use while because
1107 displaying one warning can cause another. */
1108
1109 while (pending_malloc_warning)
1110 display_malloc_warning ();
1111
1112 no_direct = 0;
1113
1114 Vdeactivate_mark = Qnil;
1115
1116 /* If minibuffer on and echo area in use,
1117 wait 2 sec and redraw minibuffer. */
1118
1119 if (minibuf_level && echo_area_glyphs
1120 && EQ (minibuf_window, echo_area_window))
1121 {
1122 /* Bind inhibit-quit to t so that C-g gets read in
1123 rather than quitting back to the minibuffer. */
1124 int count = specpdl_ptr - specpdl;
1125 specbind (Qinhibit_quit, Qt);
1126
1127 Fsit_for (make_number (2), Qnil, Qnil);
1128 /* Clear the echo area. */
1129 message2 (0);
1130
1131 unbind_to (count, Qnil);
1132
1133 /* If a C-g came in before, treat it as input now. */
1134 if (!NILP (Vquit_flag))
1135 {
1136 Vquit_flag = Qnil;
1137 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
1138 }
1139 }
1140
1141 #ifdef C_ALLOCA
1142 alloca (0); /* Cause a garbage collection now */
1143 /* Since we can free the most stuff here. */
1144 #endif /* C_ALLOCA */
1145
1146 #if 0
1147 #ifdef MULTI_FRAME
1148 /* Select the frame that the last event came from. Usually,
1149 switch-frame events will take care of this, but if some lisp
1150 code swallows a switch-frame event, we'll fix things up here.
1151 Is this a good idea? */
1152 if (FRAMEP (internal_last_event_frame)
1153 && XFRAME (internal_last_event_frame) != selected_frame)
1154 Fselect_frame (internal_last_event_frame, Qnil);
1155 #endif
1156 #endif
1157 /* If it has changed current-menubar from previous value,
1158 really recompute the menubar from the value. */
1159 if (! NILP (Vlucid_menu_bar_dirty_flag)
1160 && !NILP (Ffboundp (Qrecompute_lucid_menubar)))
1161 call0 (Qrecompute_lucid_menubar);
1162
1163 before_command_key_count = this_command_key_count;
1164 before_command_echo_length = echo_length ();
1165
1166 this_command = Qnil;
1167
1168 /* Read next key sequence; i gets its length. */
1169 i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0],
1170 Qnil, 0, 1);
1171
1172 ++num_input_keys;
1173
1174 /* Now we have read a key sequence of length I,
1175 or else I is 0 and we found end of file. */
1176
1177 if (i == 0) /* End of file -- happens only in */
1178 return Qnil; /* a kbd macro, at the end. */
1179 /* -1 means read_key_sequence got a menu that was rejected.
1180 Just loop around and read another command. */
1181 if (i == -1)
1182 {
1183 cancel_echoing ();
1184 this_command_key_count = 0;
1185 this_single_command_key_start = 0;
1186 goto finalize;
1187 }
1188
1189 last_command_char = keybuf[i - 1];
1190
1191 /* If the previous command tried to force a specific window-start,
1192 forget about that, in case this command moves point far away
1193 from that position. But also throw away beg_unchanged and
1194 end_unchanged information in that case, so that redisplay will
1195 update the whole window properly. */
1196 if (!NILP (XWINDOW (selected_window)->force_start))
1197 {
1198 XWINDOW (selected_window)->force_start = Qnil;
1199 beg_unchanged = end_unchanged = 0;
1200 }
1201
1202 cmd = read_key_sequence_cmd;
1203 if (!NILP (Vexecuting_macro))
1204 {
1205 if (!NILP (Vquit_flag))
1206 {
1207 Vexecuting_macro = Qt;
1208 QUIT; /* Make some noise. */
1209 /* Will return since macro now empty. */
1210 }
1211 }
1212
1213 /* Do redisplay processing after this command except in special
1214 cases identified below that set no_redisplay to 1.
1215 (actually, there's currently no way to prevent the redisplay,
1216 and no_redisplay is ignored.
1217 Perhaps someday we will really implement it.) */
1218 no_redisplay = 0;
1219
1220 prev_buffer = current_buffer;
1221 prev_modiff = MODIFF;
1222 last_point_position = PT;
1223 XSETBUFFER (last_point_position_buffer, prev_buffer);
1224
1225 /* Execute the command. */
1226
1227 this_command = cmd;
1228 /* Note that the value cell will never directly contain nil
1229 if the symbol is a local variable. */
1230 if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks))
1231 safe_run_hooks (Qpre_command_hook);
1232
1233 if (NILP (this_command))
1234 {
1235 /* nil means key is undefined. */
1236 bitch_at_user ();
1237 current_kboard->defining_kbd_macro = Qnil;
1238 update_mode_lines = 1;
1239 current_kboard->Vprefix_arg = Qnil;
1240 }
1241 else
1242 {
1243 if (NILP (current_kboard->Vprefix_arg) && ! no_direct)
1244 {
1245 /* Recognize some common commands in common situations and
1246 do them directly. */
1247 if (EQ (this_command, Qforward_char) && PT < ZV)
1248 {
1249 struct Lisp_Char_Table *dp
1250 = window_display_table (XWINDOW (selected_window));
1251 lose = FETCH_CHAR (PT);
1252 SET_PT (PT + 1);
1253 if ((dp
1254 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1255 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1256 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1257 && (lose >= 0x20 && lose < 0x7f)))
1258 : (lose >= 0x20 && lose < 0x7f))
1259 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1260 >= MODIFF)
1261 && (XFASTINT (XWINDOW (selected_window)->last_point)
1262 == PT - 1)
1263 && !windows_or_buffers_changed
1264 && EQ (current_buffer->selective_display, Qnil)
1265 && !detect_input_pending ()
1266 && NILP (Vcolumn_number_mode)
1267 && NILP (Vexecuting_macro))
1268 no_redisplay = direct_output_forward_char (1);
1269 goto directly_done;
1270 }
1271 else if (EQ (this_command, Qbackward_char) && PT > BEGV)
1272 {
1273 struct Lisp_Char_Table *dp
1274 = window_display_table (XWINDOW (selected_window));
1275 SET_PT (PT - 1);
1276 lose = FETCH_CHAR (PT);
1277 if ((dp
1278 ? (VECTORP (DISP_CHAR_VECTOR (dp, lose))
1279 ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1
1280 : (NILP (DISP_CHAR_VECTOR (dp, lose))
1281 && (lose >= 0x20 && lose < 0x7f)))
1282 : (lose >= 0x20 && lose < 0x7f))
1283 && (XFASTINT (XWINDOW (selected_window)->last_modified)
1284 >= MODIFF)
1285 && (XFASTINT (XWINDOW (selected_window)->last_point)
1286 == PT + 1)
1287 && !windows_or_buffers_changed
1288 && EQ (current_buffer->selective_display, Qnil)
1289 && !detect_input_pending ()
1290 && NILP (Vcolumn_number_mode)
1291 && NILP (Vexecuting_macro))
1292 no_redisplay = direct_output_forward_char (-1);
1293 goto directly_done;
1294 }
1295 else if (EQ (this_command, Qself_insert_command)
1296 /* Try this optimization only on ascii keystrokes. */
1297 && INTEGERP (last_command_char))
1298 {
1299 unsigned char c = XINT (last_command_char);
1300 int value;
1301
1302 if (NILP (Vexecuting_macro)
1303 && !EQ (minibuf_window, selected_window))
1304 {
1305 if (!nonundocount || nonundocount >= 20)
1306 {
1307 Fundo_boundary ();
1308 nonundocount = 0;
1309 }
1310 nonundocount++;
1311 }
1312 lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
1313 < MODIFF)
1314 || (XFASTINT (XWINDOW (selected_window)->last_point)
1315 != PT)
1316 || MODIFF <= SAVE_MODIFF
1317 || windows_or_buffers_changed
1318 || !EQ (current_buffer->selective_display, Qnil)
1319 || detect_input_pending ()
1320 || !NILP (Vcolumn_number_mode)
1321 || !NILP (Vexecuting_macro));
1322 value = internal_self_insert (c, 0);
1323 if (value)
1324 lose = 1;
1325 if (value == 2)
1326 nonundocount = 0;
1327
1328 if (!lose
1329 && (PT == ZV || FETCH_CHAR (PT) == '\n'))
1330 {
1331 struct Lisp_Char_Table *dp
1332 = window_display_table (XWINDOW (selected_window));
1333 int lose = c;
1334
1335 if (dp)
1336 {
1337 Lisp_Object obj;
1338
1339 obj = DISP_CHAR_VECTOR (dp, lose);
1340 if (NILP (obj))
1341 {
1342 /* Do it only for char codes
1343 that by default display as themselves. */
1344 if (lose >= 0x20 && lose <= 0x7e)
1345 no_redisplay = direct_output_for_insert (lose);
1346 }
1347 else if (VECTORP (obj)
1348 && XVECTOR (obj)->size == 1
1349 && (obj = XVECTOR (obj)->contents[0],
1350 INTEGERP (obj))
1351 /* Insist face not specified in glyph. */
1352 && (XINT (obj) & ((-1) << 8)) == 0)
1353 no_redisplay
1354 = direct_output_for_insert (XINT (obj));
1355 }
1356 else
1357 {
1358 if (lose >= 0x20 && lose <= 0x7e)
1359 no_redisplay = direct_output_for_insert (lose);
1360 }
1361 }
1362 goto directly_done;
1363 }
1364 }
1365
1366 /* Here for a command that isn't executed directly */
1367
1368 nonundocount = 0;
1369 if (NILP (current_kboard->Vprefix_arg))
1370 Fundo_boundary ();
1371 Fcommand_execute (this_command, Qnil, Qnil, Qnil);
1372
1373 }
1374 directly_done: ;
1375
1376 /* Note that the value cell will never directly contain nil
1377 if the symbol is a local variable. */
1378 if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks))
1379 safe_run_hooks (Qpost_command_hook);
1380
1381 if (!NILP (Vdeferred_action_list))
1382 safe_run_hooks (Qdeferred_action_function);
1383
1384 if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks))
1385 {
1386 if (NILP (Vunread_command_events)
1387 && NILP (Vexecuting_macro)
1388 && !NILP (sit_for (0, post_command_idle_delay, 0, 1)))
1389 safe_run_hooks (Qpost_command_idle_hook);
1390 }
1391
1392 /* If there is a prefix argument,
1393 1) We don't want Vlast_command to be ``universal-argument''
1394 (that would be dumb), so don't set Vlast_command,
1395 2) we want to leave echoing on so that the prefix will be
1396 echoed as part of this key sequence, so don't call
1397 cancel_echoing, and
1398 3) we want to leave this_command_key_count non-zero, so that
1399 read_char will realize that it is re-reading a character, and
1400 not echo it a second time.
1401
1402 If the command didn't actually create a prefix arg,
1403 but is merely a frame event that is transparent to prefix args,
1404 then the above doesn't apply. */
1405 if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_char))
1406 {
1407 current_kboard->Vlast_command = this_command;
1408 cancel_echoing ();
1409 this_command_key_count = 0;
1410 this_single_command_key_start = 0;
1411 }
1412
1413 if (!NILP (current_buffer->mark_active) && !NILP (Vrun_hooks))
1414 {
1415 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
1416 {
1417 current_buffer->mark_active = Qnil;
1418 call1 (Vrun_hooks, intern ("deactivate-mark-hook"));
1419 }
1420 else if (current_buffer != prev_buffer || MODIFF != prev_modiff)
1421 call1 (Vrun_hooks, intern ("activate-mark-hook"));
1422 }
1423
1424 finalize:
1425 /* Install chars successfully executed in kbd macro. */
1426
1427 if (!NILP (current_kboard->defining_kbd_macro)
1428 && NILP (current_kboard->Vprefix_arg))
1429 finalize_kbd_macro_chars ();
1430
1431 #ifdef MULTI_KBOARD
1432 if (!was_locked)
1433 any_kboard_state ();
1434 #endif
1435 }
1436 }
1437
1438 /* Subroutine for safe_run_hooks: run the hook HOOK. */
1439
1440 static Lisp_Object
1441 safe_run_hooks_1 (hook)
1442 Lisp_Object hook;
1443 {
1444 return call1 (Vrun_hooks, Vinhibit_quit);
1445 }
1446
1447 /* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */
1448
1449 static Lisp_Object
1450 safe_run_hooks_error (data)
1451 Lisp_Object data;
1452 {
1453 Fset (Vinhibit_quit, Qnil);
1454 }
1455
1456 /* If we get an error while running the hook, cause the hook variable
1457 to be nil. Also inhibit quits, so that C-g won't cause the hook
1458 to mysteriously evaporate. */
1459
1460 void
1461 safe_run_hooks (hook)
1462 Lisp_Object hook;
1463 {
1464 Lisp_Object value;
1465 int count = specpdl_ptr - specpdl;
1466 specbind (Qinhibit_quit, hook);
1467
1468 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
1469
1470 unbind_to (count, Qnil);
1471 }
1472 \f
1473 /* Number of seconds between polling for input. */
1474 int polling_period;
1475
1476 /* Nonzero means polling for input is temporarily suppressed. */
1477 int poll_suppress_count;
1478
1479 /* Nonzero if polling_for_input is actually being used. */
1480 int polling_for_input;
1481
1482 #ifdef POLL_FOR_INPUT
1483
1484 /* Handle an alarm once each second and read pending input
1485 so as to handle a C-g if it comces in. */
1486
1487 SIGTYPE
1488 input_poll_signal (signalnum) /* If we don't have an argument, */
1489 int signalnum; /* some compilers complain in signal calls. */
1490 {
1491 /* This causes the call to start_polling at the end
1492 to do its job. It also arranges for a quit or error
1493 from within read_avail_input to resume polling. */
1494 poll_suppress_count++;
1495 if (interrupt_input_blocked == 0
1496 && !waiting_for_input)
1497 read_avail_input (0);
1498 /* Turn on the SIGALRM handler and request another alarm. */
1499 start_polling ();
1500 }
1501
1502 #endif
1503
1504 /* Begin signals to poll for input, if they are appropriate.
1505 This function is called unconditionally from various places. */
1506
1507 start_polling ()
1508 {
1509 #ifdef POLL_FOR_INPUT
1510 if (read_socket_hook && !interrupt_input)
1511 {
1512 poll_suppress_count--;
1513 if (poll_suppress_count == 0)
1514 {
1515 signal (SIGALRM, input_poll_signal);
1516 polling_for_input = 1;
1517 alarm (polling_period);
1518 }
1519 }
1520 #endif
1521 }
1522
1523 /* Nonzero if we are using polling to handle input asynchronously. */
1524
1525 int
1526 input_polling_used ()
1527 {
1528 #ifdef POLL_FOR_INPUT
1529 return read_socket_hook && !interrupt_input;
1530 #else
1531 return 0;
1532 #endif
1533 }
1534
1535 /* Turn off polling. */
1536
1537 stop_polling ()
1538 {
1539 #ifdef POLL_FOR_INPUT
1540 if (read_socket_hook && !interrupt_input)
1541 {
1542 if (poll_suppress_count == 0)
1543 {
1544 polling_for_input = 0;
1545 alarm (0);
1546 }
1547 poll_suppress_count++;
1548 }
1549 #endif
1550 }
1551
1552 /* Set the value of poll_suppress_count to COUNT
1553 and start or stop polling accordingly. */
1554
1555 void
1556 set_poll_suppress_count (count)
1557 int count;
1558 {
1559 #ifdef POLL_FOR_INPUT
1560 if (count == 0 && poll_suppress_count != 0)
1561 {
1562 poll_suppress_count = 1;
1563 start_polling ();
1564 }
1565 else if (count != 0 && poll_suppress_count == 0)
1566 {
1567 stop_polling ();
1568 }
1569 poll_suppress_count = count;
1570 #endif
1571 }
1572
1573 /* Bind polling_period to a value at least N.
1574 But don't decrease it. */
1575
1576 bind_polling_period (n)
1577 int n;
1578 {
1579 #ifdef POLL_FOR_INPUT
1580 int new = polling_period;
1581
1582 if (n > new)
1583 new = n;
1584
1585 stop_polling ();
1586 specbind (Qpolling_period, make_number (new));
1587 /* Start a new alarm with the new period. */
1588 start_polling ();
1589 #endif
1590 }
1591 \f
1592 /* Apply the control modifier to CHARACTER. */
1593
1594 int
1595 make_ctrl_char (c)
1596 int c;
1597 {
1598 /* Save the upper bits here. */
1599 int upper = c & ~0177;
1600
1601 c &= 0177;
1602
1603 /* Everything in the columns containing the upper-case letters
1604 denotes a control character. */
1605 if (c >= 0100 && c < 0140)
1606 {
1607 int oc = c;
1608 c &= ~0140;
1609 /* Set the shift modifier for a control char
1610 made from a shifted letter. But only for letters! */
1611 if (oc >= 'A' && oc <= 'Z')
1612 c |= shift_modifier;
1613 }
1614
1615 /* The lower-case letters denote control characters too. */
1616 else if (c >= 'a' && c <= 'z')
1617 c &= ~0140;
1618
1619 /* Include the bits for control and shift
1620 only if the basic ASCII code can't indicate them. */
1621 else if (c >= ' ')
1622 c |= ctrl_modifier;
1623
1624 /* Replace the high bits. */
1625 c |= (upper & ~ctrl_modifier);
1626
1627 return c;
1628 }
1629
1630
1631 \f
1632 /* Input of single characters from keyboard */
1633
1634 Lisp_Object print_help ();
1635 static Lisp_Object kbd_buffer_get_event ();
1636 static void record_char ();
1637
1638 #ifdef MULTI_KBOARD
1639 static jmp_buf wrong_kboard_jmpbuf;
1640 #endif
1641
1642 /* read a character from the keyboard; call the redisplay if needed */
1643 /* commandflag 0 means do not do auto-saving, but do do redisplay.
1644 -1 means do not do redisplay, but do do autosaving.
1645 1 means do both. */
1646
1647 /* The arguments MAPS and NMAPS are for menu prompting.
1648 MAPS is an array of keymaps; NMAPS is the length of MAPS.
1649
1650 PREV_EVENT is the previous input event, or nil if we are reading
1651 the first event of a key sequence.
1652
1653 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
1654 if we used a mouse menu to read the input, or zero otherwise. If
1655 USED_MOUSE_MENU is null, we don't dereference it.
1656
1657 Value is t if we showed a menu and the user rejected it. */
1658
1659 Lisp_Object
1660 read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
1661 int commandflag;
1662 int nmaps;
1663 Lisp_Object *maps;
1664 Lisp_Object prev_event;
1665 int *used_mouse_menu;
1666 {
1667 register Lisp_Object c;
1668 int count;
1669 jmp_buf local_getcjmp;
1670 jmp_buf save_jump;
1671 int key_already_recorded = 0;
1672 Lisp_Object tem, save;
1673 Lisp_Object also_record;
1674 also_record = Qnil;
1675
1676 before_command_key_count = this_command_key_count;
1677 before_command_echo_length = echo_length ();
1678
1679 retry:
1680
1681 if (CONSP (Vunread_command_events))
1682 {
1683 c = XCONS (Vunread_command_events)->car;
1684 Vunread_command_events = XCONS (Vunread_command_events)->cdr;
1685
1686 /* Undo what read_char_x_menu_prompt did when it unread
1687 additional keys returned by Fx_popup_menu. */
1688 if (CONSP (c)
1689 && (SYMBOLP (XCONS (c)->car) || INTEGERP (XCONS (c)->car))
1690 && NILP (XCONS (c)->cdr))
1691 c = XCONS (c)->car;
1692
1693 if (this_command_key_count == 0)
1694 goto reread_first;
1695 else
1696 goto reread;
1697 }
1698
1699 if (unread_command_char != -1)
1700 {
1701 XSETINT (c, unread_command_char);
1702 unread_command_char = -1;
1703
1704 if (this_command_key_count == 0)
1705 goto reread_first;
1706 else
1707 goto reread;
1708 }
1709
1710 /* If there is no function key translated before
1711 reset-this-command-lengths takes effect, forget about it. */
1712 before_command_restore_flag = 0;
1713
1714 if (!NILP (Vexecuting_macro))
1715 {
1716 #ifdef MULTI_FRAME
1717 /* We set this to Qmacro; since that's not a frame, nobody will
1718 try to switch frames on us, and the selected window will
1719 remain unchanged.
1720
1721 Since this event came from a macro, it would be misleading to
1722 leave internal_last_event_frame set to wherever the last
1723 real event came from. Normally, a switch-frame event selects
1724 internal_last_event_frame after each command is read, but
1725 events read from a macro should never cause a new frame to be
1726 selected. */
1727 Vlast_event_frame = internal_last_event_frame = Qmacro;
1728 #endif
1729
1730 /* Exit the macro if we are at the end.
1731 Also, some things replace the macro with t
1732 to force an early exit. */
1733 if (EQ (Vexecuting_macro, Qt)
1734 || executing_macro_index >= XFASTINT (Flength (Vexecuting_macro)))
1735 {
1736 XSETINT (c, -1);
1737 return c;
1738 }
1739
1740 c = Faref (Vexecuting_macro, make_number (executing_macro_index));
1741 if (STRINGP (Vexecuting_macro)
1742 && (XINT (c) & 0x80))
1743 XSETFASTINT (c, CHAR_META | (XINT (c) & ~0x80));
1744
1745 executing_macro_index++;
1746
1747 goto from_macro;
1748 }
1749
1750 if (!NILP (unread_switch_frame))
1751 {
1752 c = unread_switch_frame;
1753 unread_switch_frame = Qnil;
1754
1755 /* This event should make it into this_command_keys, and get echoed
1756 again, so we go to reread_first, rather than reread. */
1757 goto reread_first;
1758 }
1759
1760 if (commandflag >= 0 && !input_pending
1761 && !detect_input_pending_run_timers (0))
1762 redisplay ();
1763
1764 /* Message turns off echoing unless more keystrokes turn it on again. */
1765 if (echo_area_glyphs && *echo_area_glyphs
1766 && echo_area_glyphs != current_kboard->echobuf
1767 && ok_to_echo_at_next_pause != echo_area_glyphs)
1768 cancel_echoing ();
1769 else
1770 /* If already echoing, continue. */
1771 echo_dash ();
1772
1773 /* Try reading a character via menu prompting in the minibuf.
1774 Try this before the sit-for, because the sit-for
1775 would do the wrong thing if we are supposed to do
1776 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
1777 after a mouse event so don't try a minibuf menu. */
1778 c = Qnil;
1779 if (nmaps > 0 && INTERACTIVE
1780 && !NILP (prev_event) && ! EVENT_HAS_PARAMETERS (prev_event)
1781 /* Don't bring up a menu if we already have another event. */
1782 && NILP (Vunread_command_events)
1783 && unread_command_char < 0
1784 && !detect_input_pending_run_timers (0))
1785 {
1786 c = read_char_minibuf_menu_prompt (commandflag, nmaps, maps);
1787 if (! NILP (c))
1788 {
1789 key_already_recorded = 1;
1790 goto non_reread_1;
1791 }
1792 }
1793
1794 /* Make a longjmp point for quits to use, but don't alter getcjmp just yet.
1795 We will do that below, temporarily for short sections of code,
1796 when appropriate. local_getcjmp must be in effect
1797 around any call to sit_for or kbd_buffer_get_event;
1798 it *must not* be in effect when we call redisplay. */
1799
1800 if (_setjmp (local_getcjmp))
1801 {
1802 XSETINT (c, quit_char);
1803 #ifdef MULTI_FRAME
1804 XSETFRAME (internal_last_event_frame, selected_frame);
1805 Vlast_event_frame = internal_last_event_frame;
1806 #endif
1807 /* If we report the quit char as an event,
1808 don't do so more than once. */
1809 if (!NILP (Vinhibit_quit))
1810 Vquit_flag = Qnil;
1811
1812 #ifdef MULTI_KBOARD
1813 {
1814 KBOARD *kb = FRAME_KBOARD (selected_frame);
1815 if (kb != current_kboard)
1816 {
1817 Lisp_Object *tailp = &kb->kbd_queue;
1818 /* We shouldn't get here if we were in single-kboard mode! */
1819 if (single_kboard)
1820 abort ();
1821 while (CONSP (*tailp))
1822 tailp = &XCONS (*tailp)->cdr;
1823 if (!NILP (*tailp))
1824 abort ();
1825 *tailp = Fcons (c, Qnil);
1826 kb->kbd_queue_has_data = 1;
1827 current_kboard = kb;
1828 longjmp (wrong_kboard_jmpbuf, 1);
1829 }
1830 }
1831 #endif
1832 goto non_reread;
1833 }
1834
1835 timer_start_idle ();
1836
1837 /* If in middle of key sequence and minibuffer not active,
1838 start echoing if enough time elapses. */
1839
1840 if (minibuf_level == 0 && !current_kboard->immediate_echo
1841 && this_command_key_count > 0
1842 && ! noninteractive
1843 && echo_keystrokes > 0
1844 && (echo_area_glyphs == 0 || *echo_area_glyphs == 0
1845 || ok_to_echo_at_next_pause == echo_area_glyphs))
1846 {
1847 Lisp_Object tem0;
1848
1849 /* After a mouse event, start echoing right away.
1850 This is because we are probably about to display a menu,
1851 and we don't want to delay before doing so. */
1852 if (EVENT_HAS_PARAMETERS (prev_event))
1853 echo_now ();
1854 else
1855 {
1856 save_getcjmp (save_jump);
1857 restore_getcjmp (local_getcjmp);
1858 tem0 = sit_for (echo_keystrokes, 0, 1, 1);
1859 restore_getcjmp (save_jump);
1860 if (EQ (tem0, Qt))
1861 echo_now ();
1862 }
1863 }
1864
1865 /* Maybe auto save due to number of keystrokes. */
1866
1867 if (commandflag != 0
1868 && auto_save_interval > 0
1869 && num_nonmacro_input_chars - last_auto_save > max (auto_save_interval, 20)
1870 && !detect_input_pending_run_timers (0))
1871 {
1872 Fdo_auto_save (Qnil, Qnil);
1873 /* Hooks can actually change some buffers in auto save. */
1874 redisplay ();
1875 }
1876
1877 /* Try reading using an X menu.
1878 This is never confused with reading using the minibuf
1879 because the recursive call of read_char in read_char_minibuf_menu_prompt
1880 does not pass on any keymaps. */
1881
1882 if (nmaps > 0 && INTERACTIVE
1883 && !NILP (prev_event)
1884 && EVENT_HAS_PARAMETERS (prev_event)
1885 && !EQ (XCONS (prev_event)->car, Qmenu_bar)
1886 /* Don't bring up a menu if we already have another event. */
1887 && NILP (Vunread_command_events)
1888 && unread_command_char < 0)
1889 c = read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu);
1890
1891 /* Maybe autosave and/or garbage collect due to idleness. */
1892
1893 if (INTERACTIVE && NILP (c))
1894 {
1895 int delay_level, buffer_size;
1896
1897 /* Slow down auto saves logarithmically in size of current buffer,
1898 and garbage collect while we're at it. */
1899 if (! MINI_WINDOW_P (XWINDOW (selected_window)))
1900 last_non_minibuf_size = Z - BEG;
1901 buffer_size = (last_non_minibuf_size >> 8) + 1;
1902 delay_level = 0;
1903 while (buffer_size > 64)
1904 delay_level++, buffer_size -= buffer_size >> 2;
1905 if (delay_level < 4) delay_level = 4;
1906 /* delay_level is 4 for files under around 50k, 7 at 100k,
1907 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
1908
1909 /* Auto save if enough time goes by without input. */
1910 if (commandflag != 0
1911 && num_nonmacro_input_chars > last_auto_save
1912 && INTEGERP (Vauto_save_timeout)
1913 && XINT (Vauto_save_timeout) > 0)
1914 {
1915 Lisp_Object tem0;
1916
1917 save_getcjmp (save_jump);
1918 restore_getcjmp (local_getcjmp);
1919 tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4,
1920 0, 1, 1);
1921 restore_getcjmp (save_jump);
1922
1923 if (EQ (tem0, Qt))
1924 {
1925 Fdo_auto_save (Qnil, Qnil);
1926
1927 /* If we have auto-saved and there is still no input
1928 available, garbage collect if there has been enough
1929 consing going on to make it worthwhile. */
1930 if (!detect_input_pending_run_timers (0)
1931 && consing_since_gc > gc_cons_threshold / 2)
1932 Fgarbage_collect ();
1933
1934 redisplay ();
1935 }
1936 }
1937 }
1938
1939 /* Read something from current KBOARD's side queue, if possible. */
1940
1941 if (NILP (c))
1942 {
1943 if (current_kboard->kbd_queue_has_data)
1944 {
1945 if (!CONSP (current_kboard->kbd_queue))
1946 abort ();
1947 c = XCONS (current_kboard->kbd_queue)->car;
1948 current_kboard->kbd_queue
1949 = XCONS (current_kboard->kbd_queue)->cdr;
1950 if (NILP (current_kboard->kbd_queue))
1951 current_kboard->kbd_queue_has_data = 0;
1952 input_pending = readable_events (0);
1953 #ifdef MULTI_FRAME
1954 if (EVENT_HAS_PARAMETERS (c)
1955 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame))
1956 internal_last_event_frame = XCONS (XCONS (c)->cdr)->car;
1957 Vlast_event_frame = internal_last_event_frame;
1958 #endif
1959 }
1960 }
1961
1962 #ifdef MULTI_KBOARD
1963 /* If current_kboard's side queue is empty check the other kboards.
1964 If one of them has data that we have not yet seen here,
1965 switch to it and process the data waiting for it.
1966
1967 Note: if the events queued up for another kboard
1968 have already been seen here, and therefore are not a complete command,
1969 the kbd_queue_has_data field is 0, so we skip that kboard here.
1970 That's to avoid an infinite loop switching between kboards here. */
1971 if (NILP (c) && !single_kboard)
1972 {
1973 KBOARD *kb;
1974 for (kb = all_kboards; kb; kb = kb->next_kboard)
1975 if (kb->kbd_queue_has_data)
1976 {
1977 current_kboard = kb;
1978 longjmp (wrong_kboard_jmpbuf, 1);
1979 }
1980 }
1981 #endif
1982
1983 wrong_kboard:
1984
1985 stop_polling ();
1986
1987 /* Finally, we read from the main queue,
1988 and if that gives us something we can't use yet, we put it on the
1989 appropriate side queue and try again. */
1990
1991 if (NILP (c))
1992 {
1993 KBOARD *kb;
1994
1995 /* Actually read a character, waiting if necessary. */
1996 save_getcjmp (save_jump);
1997 restore_getcjmp (local_getcjmp);
1998 c = kbd_buffer_get_event (&kb, used_mouse_menu);
1999 restore_getcjmp (save_jump);
2000
2001 #ifdef MULTI_KBOARD
2002 if (! NILP (c) && (kb != current_kboard))
2003 {
2004 Lisp_Object *tailp = &kb->kbd_queue;
2005 while (CONSP (*tailp))
2006 tailp = &XCONS (*tailp)->cdr;
2007 if (!NILP (*tailp))
2008 abort ();
2009 *tailp = Fcons (c, Qnil);
2010 kb->kbd_queue_has_data = 1;
2011 c = Qnil;
2012 if (single_kboard)
2013 goto wrong_kboard;
2014 current_kboard = kb;
2015 longjmp (wrong_kboard_jmpbuf, 1);
2016 }
2017 #endif
2018 }
2019
2020 /* Terminate Emacs in batch mode if at eof. */
2021 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
2022 Fkill_emacs (make_number (1));
2023
2024 if (INTEGERP (c))
2025 {
2026 /* Add in any extra modifiers, where appropriate. */
2027 if ((extra_keyboard_modifiers & CHAR_CTL)
2028 || ((extra_keyboard_modifiers & 0177) < ' '
2029 && (extra_keyboard_modifiers & 0177) != 0))
2030 XSETINT (c, make_ctrl_char (XINT (c)));
2031
2032 /* Transfer any other modifier bits directly from
2033 extra_keyboard_modifiers to c. Ignore the actual character code
2034 in the low 16 bits of extra_keyboard_modifiers. */
2035 XSETINT (c, XINT (c) | (extra_keyboard_modifiers & ~0xff7f & ~CHAR_CTL));
2036 }
2037
2038 non_reread:
2039
2040 /* Now that we have read an event, Emacs is not idle--
2041 unless the event was a timer event (not used now). */
2042 if (! (CONSP (c) && EQ (XCONS (c)->car, Qtimer_event)))
2043 timer_stop_idle ();
2044
2045 start_polling ();
2046
2047 if (NILP (c))
2048 {
2049 if (commandflag >= 0
2050 && !input_pending && !detect_input_pending_run_timers (0))
2051 redisplay ();
2052
2053 goto wrong_kboard;
2054 }
2055
2056 non_reread_1:
2057
2058 /* Buffer switch events are only for internal wakeups
2059 so don't show them to the user. */
2060 if (BUFFERP (c))
2061 return c;
2062
2063 if (key_already_recorded)
2064 return c;
2065
2066 /* Process special events within read_char
2067 and loop around to read another event. */
2068 save = Vquit_flag;
2069 Vquit_flag = Qnil;
2070 tem = get_keyelt (access_keymap (get_keymap_1 (Vspecial_event_map, 0, 0),
2071 c, 0, 0), 1);
2072 Vquit_flag = save;
2073
2074 if (!NILP (tem))
2075 {
2076 int was_locked = single_kboard;
2077
2078 last_input_char = c;
2079 Fcommand_execute (tem, Qnil, Fvector (1, &last_input_char), Qt);
2080
2081 /* Resume allowing input from any kboard, if that was true before. */
2082 if (!was_locked)
2083 any_kboard_state ();
2084
2085 goto retry;
2086 }
2087
2088 /* Wipe the echo area. */
2089 echo_area_glyphs = 0;
2090
2091 /* Handle things that only apply to characters. */
2092 if (INTEGERP (c))
2093 {
2094 /* If kbd_buffer_get_event gave us an EOF, return that. */
2095 if (XINT (c) == -1)
2096 return c;
2097
2098 if (STRINGP (Vkeyboard_translate_table)
2099 && XSTRING (Vkeyboard_translate_table)->size > XFASTINT (c))
2100 XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[XFASTINT (c)]);
2101 else if ((VECTORP (Vkeyboard_translate_table)
2102 && XVECTOR (Vkeyboard_translate_table)->size > XFASTINT (c))
2103 || CHAR_TABLE_P (Vkeyboard_translate_table))
2104 {
2105 Lisp_Object d;
2106 d = Faref (Vkeyboard_translate_table, c);
2107 /* nil in keyboard-translate-table means no translation. */
2108 if (!NILP (d))
2109 c = d;
2110 }
2111 }
2112
2113 /* If this event is a mouse click in the menu bar,
2114 return just menu-bar for now. Modify the mouse click event
2115 so we won't do this twice, then queue it up. */
2116 if (EVENT_HAS_PARAMETERS (c)
2117 && CONSP (XCONS (c)->cdr)
2118 && CONSP (EVENT_START (c))
2119 && CONSP (XCONS (EVENT_START (c))->cdr))
2120 {
2121 Lisp_Object posn;
2122
2123 posn = POSN_BUFFER_POSN (EVENT_START (c));
2124 /* Handle menu-bar events:
2125 insert the dummy prefix event `menu-bar'. */
2126 if (EQ (posn, Qmenu_bar))
2127 {
2128 /* Change menu-bar to (menu-bar) as the event "position". */
2129 POSN_BUFFER_POSN (EVENT_START (c)) = Fcons (posn, Qnil);
2130
2131 also_record = c;
2132 Vunread_command_events = Fcons (c, Vunread_command_events);
2133 c = posn;
2134 }
2135 }
2136
2137 record_char (c);
2138 if (! NILP (also_record))
2139 record_char (also_record);
2140
2141 from_macro:
2142 reread_first:
2143 before_command_key_count = this_command_key_count;
2144 before_command_echo_length = echo_length ();
2145
2146 /* Don't echo mouse motion events. */
2147 if (echo_keystrokes
2148 && ! (EVENT_HAS_PARAMETERS (c)
2149 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
2150 {
2151 echo_char (c);
2152 if (! NILP (also_record))
2153 echo_char (also_record);
2154 /* Once we reread a character, echoing can happen
2155 the next time we pause to read a new one. */
2156 ok_to_echo_at_next_pause = echo_area_glyphs;
2157 }
2158
2159 /* Record this character as part of the current key. */
2160 add_command_key (c);
2161 if (! NILP (also_record))
2162 add_command_key (also_record);
2163
2164 /* Re-reading in the middle of a command */
2165 reread:
2166 last_input_char = c;
2167 num_input_chars++;
2168
2169 /* Process the help character specially if enabled */
2170 if (!NILP (Vhelp_form) && help_char_p (c))
2171 {
2172 Lisp_Object tem0;
2173 count = specpdl_ptr - specpdl;
2174
2175 record_unwind_protect (Fset_window_configuration,
2176 Fcurrent_window_configuration (Qnil));
2177
2178 tem0 = Feval (Vhelp_form);
2179 if (STRINGP (tem0))
2180 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
2181
2182 cancel_echoing ();
2183 do
2184 c = read_char (0, 0, 0, Qnil, 0);
2185 while (BUFFERP (c));
2186 /* Remove the help from the frame */
2187 unbind_to (count, Qnil);
2188
2189 redisplay ();
2190 if (EQ (c, make_number (040)))
2191 {
2192 cancel_echoing ();
2193 do
2194 c = read_char (0, 0, 0, Qnil, 0);
2195 while (BUFFERP (c));
2196 }
2197 }
2198
2199 return c;
2200 }
2201
2202 /* Return 1 if should recognize C as "the help character". */
2203
2204 int
2205 help_char_p (c)
2206 Lisp_Object c;
2207 {
2208 Lisp_Object tail;
2209
2210 if (EQ (c, Vhelp_char))
2211 return 1;
2212 for (tail = Vhelp_event_list; CONSP (tail); tail = XCONS (tail)->cdr)
2213 if (EQ (c, XCONS (tail)->car))
2214 return 1;
2215 return 0;
2216 }
2217
2218 /* Record the input event C in various ways. */
2219
2220 static void
2221 record_char (c)
2222 Lisp_Object c;
2223 {
2224 total_keys++;
2225 XVECTOR (recent_keys)->contents[recent_keys_index] = c;
2226 if (++recent_keys_index >= NUM_RECENT_KEYS)
2227 recent_keys_index = 0;
2228
2229 /* Write c to the dribble file. If c is a lispy event, write
2230 the event's symbol to the dribble file, in <brackets>. Bleaugh.
2231 If you, dear reader, have a better idea, you've got the source. :-) */
2232 if (dribble)
2233 {
2234 if (INTEGERP (c))
2235 {
2236 if (XUINT (c) < 0x100)
2237 putc (XINT (c), dribble);
2238 else
2239 fprintf (dribble, " 0x%x", (int) XUINT (c));
2240 }
2241 else
2242 {
2243 Lisp_Object dribblee;
2244
2245 /* If it's a structured event, take the event header. */
2246 dribblee = EVENT_HEAD (c);
2247
2248 if (SYMBOLP (dribblee))
2249 {
2250 putc ('<', dribble);
2251 fwrite (XSYMBOL (dribblee)->name->data, sizeof (char),
2252 XSYMBOL (dribblee)->name->size,
2253 dribble);
2254 putc ('>', dribble);
2255 }
2256 }
2257
2258 fflush (dribble);
2259 }
2260
2261 store_kbd_macro_char (c);
2262
2263 num_nonmacro_input_chars++;
2264 }
2265
2266 Lisp_Object
2267 print_help (object)
2268 Lisp_Object object;
2269 {
2270 struct buffer *old = current_buffer;
2271 Fprinc (object, Qnil);
2272 set_buffer_internal (XBUFFER (Vstandard_output));
2273 call0 (intern ("help-mode"));
2274 set_buffer_internal (old);
2275 return Qnil;
2276 }
2277
2278 /* Copy out or in the info on where C-g should throw to.
2279 This is used when running Lisp code from within get_char,
2280 in case get_char is called recursively.
2281 See read_process_output. */
2282
2283 save_getcjmp (temp)
2284 jmp_buf temp;
2285 {
2286 bcopy (getcjmp, temp, sizeof getcjmp);
2287 }
2288
2289 restore_getcjmp (temp)
2290 jmp_buf temp;
2291 {
2292 bcopy (temp, getcjmp, sizeof getcjmp);
2293 }
2294 \f
2295 #ifdef HAVE_MOUSE
2296
2297 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
2298 of this function. */
2299
2300 static Lisp_Object
2301 tracking_off (old_value)
2302 Lisp_Object old_value;
2303 {
2304 do_mouse_tracking = old_value;
2305 if (NILP (old_value))
2306 {
2307 /* Redisplay may have been preempted because there was input
2308 available, and it assumes it will be called again after the
2309 input has been processed. If the only input available was
2310 the sort that we have just disabled, then we need to call
2311 redisplay. */
2312 if (!readable_events (1))
2313 {
2314 redisplay_preserve_echo_area ();
2315 get_input_pending (&input_pending, 1);
2316 }
2317 }
2318 }
2319
2320 DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
2321 "Evaluate BODY with mouse movement events enabled.\n\
2322 Within a `track-mouse' form, mouse motion generates input events that\n\
2323 you can read with `read-event'.\n\
2324 Normally, mouse motion is ignored.")
2325 (args)
2326 Lisp_Object args;
2327 {
2328 int count = specpdl_ptr - specpdl;
2329 Lisp_Object val;
2330
2331 record_unwind_protect (tracking_off, do_mouse_tracking);
2332
2333 do_mouse_tracking = Qt;
2334
2335 val = Fprogn (args);
2336 return unbind_to (count, val);
2337 }
2338
2339 /* If mouse has moved on some frame, return one of those frames.
2340 Return 0 otherwise. */
2341
2342 static FRAME_PTR
2343 some_mouse_moved ()
2344 {
2345 Lisp_Object tail, frame;
2346
2347 FOR_EACH_FRAME (tail, frame)
2348 {
2349 if (XFRAME (frame)->mouse_moved)
2350 return XFRAME (frame);
2351 }
2352
2353 return 0;
2354 }
2355
2356 #endif /* HAVE_MOUSE */
2357 \f
2358 /* Low level keyboard/mouse input.
2359 kbd_buffer_store_event places events in kbd_buffer, and
2360 kbd_buffer_get_event retrieves them. */
2361
2362 /* Return true iff there are any events in the queue that read-char
2363 would return. If this returns false, a read-char would block. */
2364 static int
2365 readable_events (do_timers_now)
2366 int do_timers_now;
2367 {
2368 if (do_timers_now)
2369 timer_check (do_timers_now);
2370
2371 if (kbd_fetch_ptr != kbd_store_ptr)
2372 return 1;
2373 #ifdef HAVE_MOUSE
2374 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
2375 return 1;
2376 #endif
2377 if (single_kboard)
2378 {
2379 if (current_kboard->kbd_queue_has_data)
2380 return 1;
2381 }
2382 else
2383 {
2384 KBOARD *kb;
2385 for (kb = all_kboards; kb; kb = kb->next_kboard)
2386 if (kb->kbd_queue_has_data)
2387 return 1;
2388 }
2389 return 0;
2390 }
2391
2392 /* Set this for debugging, to have a way to get out */
2393 int stop_character;
2394
2395 #ifdef MULTI_KBOARD
2396 static KBOARD *
2397 event_to_kboard (event)
2398 struct input_event *event;
2399 {
2400 Lisp_Object frame;
2401 frame = event->frame_or_window;
2402 if (CONSP (frame))
2403 frame = XCONS (frame)->car;
2404 else if (WINDOWP (frame))
2405 frame = WINDOW_FRAME (XWINDOW (frame));
2406
2407 /* There are still some events that don't set this field.
2408 For now, just ignore the problem.
2409 Also ignore dead frames here. */
2410 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
2411 return 0;
2412 else
2413 return FRAME_KBOARD (XFRAME (frame));
2414 }
2415 #endif
2416
2417 /* Store an event obtained at interrupt level into kbd_buffer, fifo */
2418
2419 void
2420 kbd_buffer_store_event (event)
2421 register struct input_event *event;
2422 {
2423 if (event->kind == no_event)
2424 abort ();
2425
2426 if (event->kind == ascii_keystroke)
2427 {
2428 register int c = event->code & 0377;
2429
2430 if (event->modifiers & ctrl_modifier)
2431 c = make_ctrl_char (c);
2432
2433 c |= (event->modifiers
2434 & (meta_modifier | alt_modifier
2435 | hyper_modifier | super_modifier));
2436
2437 if (c == quit_char)
2438 {
2439 extern SIGTYPE interrupt_signal ();
2440 #ifdef MULTI_KBOARD
2441 KBOARD *kb;
2442 struct input_event *sp;
2443
2444 if (single_kboard
2445 && (kb = FRAME_KBOARD (XFRAME (event->frame_or_window)),
2446 kb != current_kboard))
2447 {
2448 kb->kbd_queue
2449 = Fcons (make_lispy_switch_frame (event->frame_or_window),
2450 Fcons (make_number (c), Qnil));
2451 kb->kbd_queue_has_data = 1;
2452 for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++)
2453 {
2454 if (sp == kbd_buffer + KBD_BUFFER_SIZE)
2455 sp = kbd_buffer;
2456
2457 if (event_to_kboard (sp) == kb)
2458 {
2459 sp->kind = no_event;
2460 sp->frame_or_window = Qnil;
2461 }
2462 }
2463 return;
2464 }
2465 #endif
2466
2467 #ifdef MULTI_FRAME
2468 /* If this results in a quit_char being returned to Emacs as
2469 input, set Vlast_event_frame properly. If this doesn't
2470 get returned to Emacs as an event, the next event read
2471 will set Vlast_event_frame again, so this is safe to do. */
2472 {
2473 Lisp_Object focus;
2474
2475 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
2476 if (NILP (focus))
2477 focus = event->frame_or_window;
2478 internal_last_event_frame = focus;
2479 Vlast_event_frame = focus;
2480 }
2481 #endif
2482
2483 last_event_timestamp = event->timestamp;
2484 interrupt_signal ();
2485 return;
2486 }
2487
2488 if (c && c == stop_character)
2489 {
2490 sys_suspend ();
2491 return;
2492 }
2493 }
2494 /* Don't insert two buffer_switch_event's in a row.
2495 Just ignore the second one. */
2496 else if (event->kind == buffer_switch_event
2497 && kbd_fetch_ptr != kbd_store_ptr
2498 && kbd_store_ptr->kind == buffer_switch_event)
2499 return;
2500
2501 if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
2502 kbd_store_ptr = kbd_buffer;
2503
2504 /* Don't let the very last slot in the buffer become full,
2505 since that would make the two pointers equal,
2506 and that is indistinguishable from an empty buffer.
2507 Discard the event if it would fill the last slot. */
2508 if (kbd_fetch_ptr - 1 != kbd_store_ptr)
2509 {
2510 volatile struct input_event *sp = kbd_store_ptr;
2511 sp->kind = event->kind;
2512 if (event->kind == selection_request_event)
2513 {
2514 /* We must not use the ordinary copying code for this case,
2515 since `part' is an enum and copying it might not copy enough
2516 in this case. */
2517 bcopy (event, (char *) sp, sizeof (*event));
2518 }
2519 else
2520 {
2521 sp->code = event->code;
2522 sp->part = event->part;
2523 sp->frame_or_window = event->frame_or_window;
2524 sp->modifiers = event->modifiers;
2525 sp->x = event->x;
2526 sp->y = event->y;
2527 sp->timestamp = event->timestamp;
2528 }
2529 (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_store_ptr
2530 - kbd_buffer]
2531 = event->frame_or_window);
2532
2533 kbd_store_ptr++;
2534 }
2535 }
2536 \f
2537 /* Read one event from the event buffer, waiting if necessary.
2538 The value is a Lisp object representing the event.
2539 The value is nil for an event that should be ignored,
2540 or that was handled here.
2541 We always read and discard one event. */
2542
2543 static Lisp_Object
2544 kbd_buffer_get_event (kbp, used_mouse_menu)
2545 KBOARD **kbp;
2546 int *used_mouse_menu;
2547 {
2548 register int c;
2549 Lisp_Object obj;
2550 EMACS_TIME next_timer_delay;
2551
2552 if (noninteractive)
2553 {
2554 c = getchar ();
2555 XSETINT (obj, c);
2556 *kbp = current_kboard;
2557 return obj;
2558 }
2559
2560 /* Wait until there is input available. */
2561 for (;;)
2562 {
2563 if (kbd_fetch_ptr != kbd_store_ptr)
2564 break;
2565 #ifdef HAVE_MOUSE
2566 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
2567 break;
2568 #endif
2569
2570 /* If the quit flag is set, then read_char will return
2571 quit_char, so that counts as "available input." */
2572 if (!NILP (Vquit_flag))
2573 quit_throw_to_read_char ();
2574
2575 /* One way or another, wait until input is available; then, if
2576 interrupt handlers have not read it, read it now. */
2577
2578 #ifdef OLDVMS
2579 wait_for_kbd_input ();
2580 #else
2581 /* Note SIGIO has been undef'd if FIONREAD is missing. */
2582 #ifdef SIGIO
2583 gobble_input (0);
2584 #endif /* SIGIO */
2585 if (kbd_fetch_ptr != kbd_store_ptr)
2586 break;
2587 #ifdef HAVE_MOUSE
2588 if (!NILP (do_mouse_tracking) && some_mouse_moved ())
2589 break;
2590 #endif
2591 {
2592 Lisp_Object minus_one;
2593
2594 XSETINT (minus_one, -1);
2595 wait_reading_process_input (0, 0, minus_one, 1);
2596
2597 if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
2598 /* Pass 1 for EXPECT since we just waited to have input. */
2599 read_avail_input (1);
2600 }
2601 #endif /* not VMS */
2602 }
2603
2604 /* At this point, we know that there is a readable event available
2605 somewhere. If the event queue is empty, then there must be a
2606 mouse movement enabled and available. */
2607 if (kbd_fetch_ptr != kbd_store_ptr)
2608 {
2609 struct input_event *event;
2610
2611 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
2612 ? kbd_fetch_ptr
2613 : kbd_buffer);
2614
2615 last_event_timestamp = event->timestamp;
2616
2617 #ifdef MULTI_KBOARD
2618 *kbp = event_to_kboard (event);
2619 if (*kbp == 0)
2620 *kbp = current_kboard; /* Better than returning null ptr? */
2621 #else
2622 *kbp = &the_only_kboard;
2623 #endif
2624
2625 obj = Qnil;
2626
2627 /* These two kinds of events get special handling
2628 and don't actually appear to the command loop.
2629 We return nil for them. */
2630 if (event->kind == selection_request_event)
2631 {
2632 #ifdef HAVE_X11
2633 struct input_event copy;
2634
2635 /* Remove it from the buffer before processing it,
2636 since otherwise swallow_events will see it
2637 and process it again. */
2638 copy = *event;
2639 kbd_fetch_ptr = event + 1;
2640 input_pending = readable_events (0);
2641 x_handle_selection_request (&copy);
2642 #else
2643 /* We're getting selection request events, but we don't have
2644 a window system. */
2645 abort ();
2646 #endif
2647 }
2648
2649 else if (event->kind == selection_clear_event)
2650 {
2651 #ifdef HAVE_X11
2652 struct input_event copy;
2653
2654 /* Remove it from the buffer before processing it. */
2655 copy = *event;
2656 kbd_fetch_ptr = event + 1;
2657 input_pending = readable_events (0);
2658 x_handle_selection_clear (&copy);
2659 #else
2660 /* We're getting selection request events, but we don't have
2661 a window system. */
2662 abort ();
2663 #endif
2664 }
2665 #if defined (HAVE_X11) || defined (HAVE_NTGUI)
2666 else if (event->kind == delete_window_event)
2667 {
2668 /* Make an event (delete-frame (FRAME)). */
2669 obj = Fcons (event->frame_or_window, Qnil);
2670 obj = Fcons (Qdelete_frame, Fcons (obj, Qnil));
2671 kbd_fetch_ptr = event + 1;
2672 }
2673 else if (event->kind == iconify_event)
2674 {
2675 /* Make an event (iconify-frame (FRAME)). */
2676 obj = Fcons (event->frame_or_window, Qnil);
2677 obj = Fcons (Qiconify_frame, Fcons (obj, Qnil));
2678 kbd_fetch_ptr = event + 1;
2679 }
2680 else if (event->kind == deiconify_event)
2681 {
2682 /* Make an event (make-frame-visible (FRAME)). */
2683 obj = Fcons (event->frame_or_window, Qnil);
2684 obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil));
2685 kbd_fetch_ptr = event + 1;
2686 }
2687 #endif
2688 else if (event->kind == buffer_switch_event)
2689 {
2690 /* The value doesn't matter here; only the type is tested. */
2691 XSETBUFFER (obj, current_buffer);
2692 kbd_fetch_ptr = event + 1;
2693 }
2694 #ifdef USE_X_TOOLKIT
2695 else if (event->kind == menu_bar_activate_event)
2696 {
2697 kbd_fetch_ptr = event + 1;
2698 input_pending = readable_events (0);
2699 x_activate_menubar (XFRAME (event->frame_or_window));
2700 }
2701 #endif
2702 /* Just discard these, by returning nil.
2703 With MULTI_KBOARD, these events are used as placeholders
2704 when we need to randomly delete events from the queue.
2705 (They shouldn't otherwise be found in the buffer,
2706 but on some machines it appears they do show up
2707 even without MULTI_KBOARD.) */
2708 else if (event->kind == no_event)
2709 kbd_fetch_ptr = event + 1;
2710
2711 /* If this event is on a different frame, return a switch-frame this
2712 time, and leave the event in the queue for next time. */
2713 else
2714 {
2715 #ifdef MULTI_FRAME
2716 Lisp_Object frame;
2717 Lisp_Object focus;
2718
2719 frame = event->frame_or_window;
2720 if (CONSP (frame))
2721 frame = XCONS (frame)->car;
2722 else if (WINDOWP (frame))
2723 frame = WINDOW_FRAME (XWINDOW (frame));
2724
2725 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
2726 if (! NILP (focus))
2727 frame = focus;
2728
2729 if (! EQ (frame, internal_last_event_frame)
2730 && XFRAME (frame) != selected_frame)
2731 obj = make_lispy_switch_frame (frame);
2732 internal_last_event_frame = frame;
2733 #endif /* MULTI_FRAME */
2734
2735 /* If we didn't decide to make a switch-frame event, go ahead
2736 and build a real event from the queue entry. */
2737
2738 if (NILP (obj))
2739 {
2740 obj = make_lispy_event (event);
2741 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI)
2742 /* If this was a menu selection, then set the flag to inhibit
2743 writing to last_nonmenu_event. Don't do this if the event
2744 we're returning is (menu-bar), though; that indicates the
2745 beginning of the menu sequence, and we might as well leave
2746 that as the `event with parameters' for this selection. */
2747 if (event->kind == menu_bar_event
2748 && !(CONSP (obj) && EQ (XCONS (obj)->car, Qmenu_bar))
2749 && used_mouse_menu)
2750 *used_mouse_menu = 1;
2751 #endif
2752
2753 /* Wipe out this event, to catch bugs. */
2754 event->kind = no_event;
2755 XVECTOR (kbd_buffer_frame_or_window)->contents[event - kbd_buffer] = Qnil;
2756
2757 kbd_fetch_ptr = event + 1;
2758 }
2759 }
2760 }
2761 #ifdef HAVE_MOUSE
2762 /* Try generating a mouse motion event. */
2763 else if (!NILP (do_mouse_tracking) && some_mouse_moved ())
2764 {
2765 FRAME_PTR f = some_mouse_moved ();
2766 Lisp_Object bar_window;
2767 enum scroll_bar_part part;
2768 Lisp_Object x, y;
2769 unsigned long time;
2770
2771 *kbp = current_kboard;
2772 /* Note that this uses F to determine which display to look at.
2773 If there is no valid info, it does not store anything
2774 so x remains nil. */
2775 x = Qnil;
2776 (*mouse_position_hook) (&f, 0, &bar_window, &part, &x, &y, &time);
2777
2778 obj = Qnil;
2779
2780 #ifdef MULTI_FRAME
2781 /* Decide if we should generate a switch-frame event. Don't
2782 generate switch-frame events for motion outside of all Emacs
2783 frames. */
2784 if (!NILP (x) && f)
2785 {
2786 Lisp_Object frame;
2787
2788 frame = FRAME_FOCUS_FRAME (f);
2789 if (NILP (frame))
2790 XSETFRAME (frame, f);
2791
2792 if (! EQ (frame, internal_last_event_frame)
2793 && XFRAME (frame) != selected_frame)
2794 obj = make_lispy_switch_frame (frame);
2795 internal_last_event_frame = frame;
2796 }
2797 #endif
2798
2799 /* If we didn't decide to make a switch-frame event, go ahead and
2800 return a mouse-motion event. */
2801 if (!NILP (x) && NILP (obj))
2802 obj = make_lispy_movement (f, bar_window, part, x, y, time);
2803 }
2804 #endif /* HAVE_MOUSE */
2805 else
2806 /* We were promised by the above while loop that there was
2807 something for us to read! */
2808 abort ();
2809
2810 input_pending = readable_events (0);
2811
2812 #ifdef MULTI_FRAME
2813 Vlast_event_frame = internal_last_event_frame;
2814 #endif
2815
2816 return (obj);
2817 }
2818 \f
2819 /* Process any events that are not user-visible,
2820 then return, without reading any user-visible events. */
2821
2822 void
2823 swallow_events (do_display)
2824 int do_display;
2825 {
2826 int old_timers_run;
2827
2828 while (kbd_fetch_ptr != kbd_store_ptr)
2829 {
2830 struct input_event *event;
2831
2832 event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE)
2833 ? kbd_fetch_ptr
2834 : kbd_buffer);
2835
2836 last_event_timestamp = event->timestamp;
2837
2838 /* These two kinds of events get special handling
2839 and don't actually appear to the command loop. */
2840 if (event->kind == selection_request_event)
2841 {
2842 #ifdef HAVE_X11
2843 struct input_event copy;
2844
2845 /* Remove it from the buffer before processing it,
2846 since otherwise swallow_events called recursively could see it
2847 and process it again. */
2848 copy = *event;
2849 kbd_fetch_ptr = event + 1;
2850 input_pending = readable_events (0);
2851 x_handle_selection_request (&copy);
2852 #else
2853 /* We're getting selection request events, but we don't have
2854 a window system. */
2855 abort ();
2856 #endif
2857 }
2858
2859 else if (event->kind == selection_clear_event)
2860 {
2861 #ifdef HAVE_X11
2862 struct input_event copy;
2863
2864 /* Remove it from the buffer before processing it, */
2865 copy = *event;
2866
2867 kbd_fetch_ptr = event + 1;
2868 input_pending = readable_events (0);
2869 x_handle_selection_clear (&copy);
2870 #else
2871 /* We're getting selection request events, but we don't have
2872 a window system. */
2873 abort ();
2874 #endif
2875 }
2876 /* Note that timer_event is currently never used. */
2877 else if (event->kind == timer_event)
2878 {
2879 Lisp_Object tem, lisp_event;
2880 int was_locked = single_kboard;
2881
2882 tem = get_keymap_1 (Vspecial_event_map, 0, 0);
2883 tem = get_keyelt (access_keymap (tem, Qtimer_event, 0, 0),
2884 1);
2885 lisp_event = Fcons (Qtimer_event,
2886 Fcons (Fcdr (event->frame_or_window), Qnil));
2887 kbd_fetch_ptr = event + 1;
2888 if (kbd_fetch_ptr == kbd_store_ptr)
2889 input_pending = 0;
2890 Fcommand_execute (tem, Qnil, Fvector (1, &lisp_event), Qt);
2891 timers_run++;
2892 if (do_display)
2893 redisplay_preserve_echo_area ();
2894
2895 /* Resume allowing input from any kboard, if that was true before. */
2896 if (!was_locked)
2897 any_kboard_state ();
2898 }
2899 else
2900 break;
2901 }
2902
2903 old_timers_run = timers_run;
2904 get_input_pending (&input_pending, 1);
2905
2906 if (timers_run != old_timers_run && do_display)
2907 redisplay_preserve_echo_area ();
2908 }
2909 \f
2910 static EMACS_TIME timer_idleness_start_time;
2911
2912 /* Record the start of when Emacs is idle,
2913 for the sake of running idle-time timers. */
2914
2915 timer_start_idle ()
2916 {
2917 Lisp_Object timers;
2918
2919 /* If we are already in the idle state, do nothing. */
2920 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
2921 return;
2922
2923 EMACS_GET_TIME (timer_idleness_start_time);
2924
2925 /* Mark all idle-time timers as once again candidates for running. */
2926 for (timers = Vtimer_idle_list; CONSP (timers); timers = XCONS (timers)->cdr)
2927 {
2928 Lisp_Object timer;
2929
2930 timer = XCONS (timers)->car;
2931
2932 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
2933 continue;
2934 XVECTOR (timer)->contents[0] = Qnil;
2935 }
2936 }
2937
2938 /* Record that Emacs is no longer idle, so stop running idle-time timers. */
2939
2940 timer_stop_idle ()
2941 {
2942 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
2943 }
2944
2945 /* This is only for debugging. */
2946 struct input_event last_timer_event;
2947
2948 /* Check whether a timer has fired. To prevent larger problems we simply
2949 disregard elements that are not proper timers. Do not make a circular
2950 timer list for the time being.
2951
2952 Returns the number of seconds to wait until the next timer fires. If a
2953 timer is triggering now, return zero seconds.
2954 If no timer is active, return -1 seconds.
2955
2956 If a timer is ripe, we run it, with quitting turned off.
2957
2958 DO_IT_NOW is now ignored. It used to mean that we should
2959 run the timer directly instead of queueing a timer-event.
2960 Now we always run timers directly. */
2961
2962 EMACS_TIME
2963 timer_check (do_it_now)
2964 int do_it_now;
2965 {
2966 EMACS_TIME nexttime;
2967 EMACS_TIME now, idleness_now;
2968 Lisp_Object timers, idle_timers, chosen_timer;
2969 /* Nonzero if we generate some events. */
2970 int events_generated = 0;
2971 struct gcpro gcpro1, gcpro2, gcpro3;
2972
2973 EMACS_SET_SECS (nexttime, -1);
2974 EMACS_SET_USECS (nexttime, -1);
2975
2976 /* Always consider the ordinary timers. */
2977 timers = Vtimer_list;
2978 /* Consider the idle timers only if Emacs is idle. */
2979 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
2980 idle_timers = Vtimer_idle_list;
2981 else
2982 idle_timers = Qnil;
2983 chosen_timer = Qnil;
2984 GCPRO3 (timers, idle_timers, chosen_timer);
2985
2986 if (CONSP (timers) || CONSP (idle_timers))
2987 {
2988 EMACS_GET_TIME (now);
2989 if (! EMACS_TIME_NEG_P (timer_idleness_start_time))
2990 EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time);
2991 }
2992
2993 while (CONSP (timers) || CONSP (idle_timers))
2994 {
2995 int triggertime = EMACS_SECS (now);
2996 Lisp_Object *vector;
2997 Lisp_Object timer, idle_timer;
2998 EMACS_TIME timer_time, idle_timer_time;
2999 EMACS_TIME difference, timer_difference, idle_timer_difference;
3000
3001 /* Skip past invalid timers and timers already handled. */
3002 if (!NILP (timers))
3003 {
3004 timer = XCONS (timers)->car;
3005 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3006 {
3007 timers = XCONS (timers)->cdr;
3008 continue;
3009 }
3010 vector = XVECTOR (timer)->contents;
3011
3012 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
3013 || !INTEGERP (vector[3])
3014 || ! NILP (vector[0]))
3015 {
3016 timers = XCONS (timers)->cdr;
3017 continue;
3018 }
3019 }
3020 if (!NILP (idle_timers))
3021 {
3022 timer = XCONS (idle_timers)->car;
3023 if (!VECTORP (timer) || XVECTOR (timer)->size != 8)
3024 {
3025 idle_timers = XCONS (idle_timers)->cdr;
3026 continue;
3027 }
3028 vector = XVECTOR (timer)->contents;
3029
3030 if (!INTEGERP (vector[1]) || !INTEGERP (vector[2])
3031 || !INTEGERP (vector[3])
3032 || ! NILP (vector[0]))
3033 {
3034 idle_timers = XCONS (idle_timers)->cdr;
3035 continue;
3036 }
3037 }
3038
3039 /* Set TIMER, TIMER_TIME and TIMER_DIFFERENCE
3040 based on the next ordinary timer.
3041 TIMER_DIFFERENCE is the distance in time from NOW to when
3042 this timer becomes ripe (negative if it's already ripe). */
3043 if (!NILP (timers))
3044 {
3045 timer = XCONS (timers)->car;
3046 vector = XVECTOR (timer)->contents;
3047 EMACS_SET_SECS (timer_time,
3048 (XINT (vector[1]) << 16) | (XINT (vector[2])));
3049 EMACS_SET_USECS (timer_time, XINT (vector[3]));
3050 EMACS_SUB_TIME (timer_difference, timer_time, now);
3051 }
3052
3053 /* Set IDLE_TIMER, IDLE_TIMER_TIME and IDLE_TIMER_DIFFERENCE
3054 based on the next idle timer. */
3055 if (!NILP (idle_timers))
3056 {
3057 idle_timer = XCONS (idle_timers)->car;
3058 vector = XVECTOR (idle_timer)->contents;
3059 EMACS_SET_SECS (idle_timer_time,
3060 (XINT (vector[1]) << 16) | (XINT (vector[2])));
3061 EMACS_SET_USECS (idle_timer_time, XINT (vector[3]));
3062 EMACS_SUB_TIME (idle_timer_difference, idle_timer_time, idleness_now);
3063 }
3064
3065 /* Decide which timer is the next timer,
3066 and set CHOSEN_TIMER, VECTOR and DIFFERENCE accordingly.
3067 Also step down the list where we found that timer. */
3068
3069 if (! NILP (timers) && ! NILP (idle_timers))
3070 {
3071 EMACS_TIME temp;
3072 EMACS_SUB_TIME (temp, timer_difference, idle_timer_difference);
3073 if (EMACS_TIME_NEG_P (temp))
3074 {
3075 chosen_timer = timer;
3076 timers = XCONS (timers)->cdr;
3077 difference = timer_difference;
3078 }
3079 else
3080 {
3081 chosen_timer = idle_timer;
3082 idle_timers = XCONS (idle_timers)->cdr;
3083 difference = idle_timer_difference;
3084 }
3085 }
3086 else if (! NILP (timers))
3087 {
3088 chosen_timer = timer;
3089 timers = XCONS (timers)->cdr;
3090 difference = timer_difference;
3091 }
3092 else
3093 {
3094 chosen_timer = idle_timer;
3095 idle_timers = XCONS (idle_timers)->cdr;
3096 difference = idle_timer_difference;
3097 }
3098 vector = XVECTOR (chosen_timer)->contents;
3099
3100 /* If timer is rupe, run it if it hasn't been run. */
3101 if (EMACS_TIME_NEG_P (difference)
3102 || (EMACS_SECS (difference) == 0
3103 && EMACS_USECS (difference) == 0))
3104 {
3105 if (NILP (vector[0]))
3106 {
3107 /* Mark the timer as triggered to prevent problems if the lisp
3108 code fails to reschedule it right. */
3109 vector[0] = Qt;
3110
3111 /* Run the timer or queue a timer event. */
3112 if (1)
3113 {
3114 Lisp_Object tem, event;
3115 int was_locked = single_kboard;
3116 int count = specpdl_ptr - specpdl;
3117
3118 specbind (Qinhibit_quit, Qt);
3119
3120 tem = get_keymap_1 (Vspecial_event_map, 0, 0);
3121 tem = get_keyelt (access_keymap (tem, Qtimer_event, 0, 0),
3122 1);
3123 event = Fcons (Qtimer_event, Fcons (chosen_timer, Qnil));
3124 Fcommand_execute (tem, Qnil, Fvector (1, &event), Qt);
3125 timers_run++;
3126
3127 unbind_to (count, Qnil);
3128
3129 /* Resume allowing input from any kboard, if that was true before. */
3130 if (!was_locked)
3131 any_kboard_state ();
3132
3133 /* Since we have handled the event,
3134 we don't need to tell the caller to wake up and do it. */
3135 }
3136 #if 0
3137 else
3138 {
3139 /* Generate a timer event so the caller will handle it. */
3140 struct input_event event;
3141
3142 event.kind = timer_event;
3143 event.modifiers = 0;
3144 event.x = event.y = Qnil;
3145 event.timestamp = triggertime;
3146 /* Store the timer in the frame slot. */
3147 event.frame_or_window
3148 = Fcons (Fselected_frame (), chosen_timer);
3149 kbd_buffer_store_event (&event);
3150
3151 last_timer_event = event;
3152
3153 /* Tell caller to handle this event right away. */
3154 events_generated = 1;
3155 EMACS_SET_SECS (nexttime, 0);
3156 EMACS_SET_USECS (nexttime, 0);
3157
3158 /* Don't queue more than one event at once.
3159 When Emacs is ready for another, it will
3160 queue the next one. */
3161 UNGCPRO;
3162 return nexttime;
3163 }
3164 #endif /* 0 */
3165 }
3166 }
3167 else
3168 /* When we encounter a timer that is still waiting,
3169 return the amount of time to wait before it is ripe. */
3170 {
3171 UNGCPRO;
3172 /* But if we generated an event,
3173 tell the caller to handle it now. */
3174 if (events_generated)
3175 return nexttime;
3176 return difference;
3177 }
3178 }
3179
3180 /* No timers are pending in the future. */
3181 /* Return 0 if we generated an event, and -1 if not. */
3182 UNGCPRO;
3183 return nexttime;
3184 }
3185 \f
3186 /* Caches for modify_event_symbol. */
3187 static Lisp_Object accent_key_syms;
3188 static Lisp_Object func_key_syms;
3189 static Lisp_Object mouse_syms;
3190
3191 /* This is a list of keysym codes for special "accent" characters.
3192 It parallels lispy_accent_keys. */
3193
3194 static int lispy_accent_codes[] =
3195 {
3196 #ifdef XK_dead_circumflex
3197 XK_dead_circumflex,
3198 #else
3199 0,
3200 #endif
3201 #ifdef XK_dead_grave
3202 XK_dead_grave,
3203 #else
3204 0,
3205 #endif
3206 #ifdef XK_dead_tilde
3207 XK_dead_tilde,
3208 #else
3209 0,
3210 #endif
3211 #ifdef XK_dead_diaeresis
3212 XK_dead_diaeresis,
3213 #else
3214 0,
3215 #endif
3216 #ifdef XK_dead_macron
3217 XK_dead_macron,
3218 #else
3219 0,
3220 #endif
3221 #ifdef XK_dead_degree
3222 XK_dead_degree,
3223 #else
3224 0,
3225 #endif
3226 #ifdef XK_dead_acute
3227 XK_dead_acute,
3228 #else
3229 0,
3230 #endif
3231 #ifdef XK_dead_cedilla
3232 XK_dead_cedilla,
3233 #else
3234 0,
3235 #endif
3236 #ifdef XK_dead_breve
3237 XK_dead_breve,
3238 #else
3239 0,
3240 #endif
3241 #ifdef XK_dead_ogonek
3242 XK_dead_ogonek,
3243 #else
3244 0,
3245 #endif
3246 #ifdef XK_dead_caron
3247 XK_dead_caron,
3248 #else
3249 0,
3250 #endif
3251 #ifdef XK_dead_doubleacute
3252 XK_dead_doubleacute,
3253 #else
3254 0,
3255 #endif
3256 #ifdef XK_dead_abovedot
3257 XK_dead_abovedot,
3258 #else
3259 0,
3260 #endif
3261 };
3262
3263 /* This is a list of Lisp names for special "accent" characters.
3264 It parallels lispy_accent_codes. */
3265
3266 static char *lispy_accent_keys[] =
3267 {
3268 "dead-circumflex",
3269 "dead-grave",
3270 "dead-tilde",
3271 "dead-diaeresis",
3272 "dead-macron",
3273 "dead-degree",
3274 "dead-acute",
3275 "dead-cedilla",
3276 "dead-breve",
3277 "dead-ogonek",
3278 "dead-caron",
3279 "dead-doubleacute",
3280 "dead-abovedot",
3281 };
3282
3283 #ifdef HAVE_NTGUI
3284 #define FUNCTION_KEY_OFFSET 0x0
3285
3286 char *lispy_function_keys[] =
3287 {
3288 0, /* 0 */
3289
3290 0, /* VK_LBUTTON 0x01 */
3291 0, /* VK_RBUTTON 0x02 */
3292 "cancel", /* VK_CANCEL 0x03 */
3293 0, /* VK_MBUTTON 0x04 */
3294
3295 0, 0, 0, /* 0x05 .. 0x07 */
3296
3297 "backspace", /* VK_BACK 0x08 */
3298 "tab", /* VK_TAB 0x09 */
3299
3300 0, 0, /* 0x0A .. 0x0B */
3301
3302 "clear", /* VK_CLEAR 0x0C */
3303 "return", /* VK_RETURN 0x0D */
3304
3305 0, 0, /* 0x0E .. 0x0F */
3306
3307 "shift", /* VK_SHIFT 0x10 */
3308 "control", /* VK_CONTROL 0x11 */
3309 "menu", /* VK_MENU 0x12 */
3310 "pause", /* VK_PAUSE 0x13 */
3311 "capital", /* VK_CAPITAL 0x14 */
3312
3313 0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */
3314
3315 0, /* VK_ESCAPE 0x1B */
3316
3317 0, 0, 0, 0, /* 0x1C .. 0x1F */
3318
3319 0, /* VK_SPACE 0x20 */
3320 "prior", /* VK_PRIOR 0x21 */
3321 "next", /* VK_NEXT 0x22 */
3322 "end", /* VK_END 0x23 */
3323 "home", /* VK_HOME 0x24 */
3324 "left", /* VK_LEFT 0x25 */
3325 "up", /* VK_UP 0x26 */
3326 "right", /* VK_RIGHT 0x27 */
3327 "down", /* VK_DOWN 0x28 */
3328 "select", /* VK_SELECT 0x29 */
3329 "print", /* VK_PRINT 0x2A */
3330 "execute", /* VK_EXECUTE 0x2B */
3331 "snapshot", /* VK_SNAPSHOT 0x2C */
3332 "insert", /* VK_INSERT 0x2D */
3333 "delete", /* VK_DELETE 0x2E */
3334 "help", /* VK_HELP 0x2F */
3335
3336 /* VK_0 thru VK_9 are the same as ASCII '0' thru '9' (0x30 - 0x39) */
3337
3338 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3339
3340 0, 0, 0, 0, 0, 0, 0, /* 0x3A .. 0x40 */
3341
3342 /* VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' (0x41 - 0x5A) */
3343
3344 0, 0, 0, 0, 0, 0, 0, 0, 0,
3345 0, 0, 0, 0, 0, 0, 0, 0, 0,
3346 0, 0, 0, 0, 0, 0, 0, 0,
3347
3348 "lwindow", /* VK_LWIN 0x5B */
3349 "rwindow", /* VK_RWIN 0x5C */
3350 "apps", /* VK_APPS 0x5D */
3351
3352 0, 0, /* 0x5E .. 0x5F */
3353
3354 "kp-0", /* VK_NUMPAD0 0x60 */
3355 "kp-1", /* VK_NUMPAD1 0x61 */
3356 "kp-2", /* VK_NUMPAD2 0x62 */
3357 "kp-3", /* VK_NUMPAD3 0x63 */
3358 "kp-4", /* VK_NUMPAD4 0x64 */
3359 "kp-5", /* VK_NUMPAD5 0x65 */
3360 "kp-6", /* VK_NUMPAD6 0x66 */
3361 "kp-7", /* VK_NUMPAD7 0x67 */
3362 "kp-8", /* VK_NUMPAD8 0x68 */
3363 "kp-9", /* VK_NUMPAD9 0x69 */
3364 "kp-multiply", /* VK_MULTIPLY 0x6A */
3365 "kp-add", /* VK_ADD 0x6B */
3366 "kp-separator", /* VK_SEPARATOR 0x6C */
3367 "kp-subtract", /* VK_SUBTRACT 0x6D */
3368 "kp-decimal", /* VK_DECIMAL 0x6E */
3369 "kp-divide", /* VK_DIVIDE 0x6F */
3370 "f1", /* VK_F1 0x70 */
3371 "f2", /* VK_F2 0x71 */
3372 "f3", /* VK_F3 0x72 */
3373 "f4", /* VK_F4 0x73 */
3374 "f5", /* VK_F5 0x74 */
3375 "f6", /* VK_F6 0x75 */
3376 "f7", /* VK_F7 0x76 */
3377 "f8", /* VK_F8 0x77 */
3378 "f9", /* VK_F9 0x78 */
3379 "f10", /* VK_F10 0x79 */
3380 "f11", /* VK_F11 0x7A */
3381 "f12", /* VK_F12 0x7B */
3382 "f13", /* VK_F13 0x7C */
3383 "f14", /* VK_F14 0x7D */
3384 "f15", /* VK_F15 0x7E */
3385 "f16", /* VK_F16 0x7F */
3386 "f17", /* VK_F17 0x80 */
3387 "f18", /* VK_F18 0x81 */
3388 "f19", /* VK_F19 0x82 */
3389 "f20", /* VK_F20 0x83 */
3390 "f21", /* VK_F21 0x84 */
3391 "f22", /* VK_F22 0x85 */
3392 "f23", /* VK_F23 0x86 */
3393 "f24", /* VK_F24 0x87 */
3394
3395 0, 0, 0, 0, /* 0x88 .. 0x8B */
3396 0, 0, 0, 0, /* 0x8C .. 0x8F */
3397
3398 "kp-numlock", /* VK_NUMLOCK 0x90 */
3399 "scroll", /* VK_SCROLL 0x91 */
3400
3401 "kp-space", /* VK_NUMPAD_CLEAR 0x92 */
3402 "kp-enter", /* VK_NUMPAD_ENTER 0x93 */
3403 "kp-prior", /* VK_NUMPAD_PRIOR 0x94 */
3404 "kp-next", /* VK_NUMPAD_NEXT 0x95 */
3405 "kp-end", /* VK_NUMPAD_END 0x96 */
3406 "kp-home", /* VK_NUMPAD_HOME 0x97 */
3407 "kp-left", /* VK_NUMPAD_LEFT 0x98 */
3408 "kp-up", /* VK_NUMPAD_UP 0x99 */
3409 "kp-right", /* VK_NUMPAD_RIGHT 0x9A */
3410 "kp-down", /* VK_NUMPAD_DOWN 0x9B */
3411 "kp-insert", /* VK_NUMPAD_INSERT 0x9C */
3412 "kp-delete", /* VK_NUMPAD_DELETE 0x9D */
3413
3414 0, 0, /* 0x9E .. 0x9F */
3415
3416 /*
3417 * VK_L* & VK_R* - left and right Alt, Ctrl and Shift virtual keys.
3418 * Used only as parameters to GetAsyncKeyState() and GetKeyState().
3419 * No other API or message will distinguish left and right keys this way.
3420 */
3421 /* 0xA0 .. 0xEF */
3422
3423 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3424 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3425 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3426 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3427 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
3428
3429 /* 0xF0 .. 0xF5 */
3430
3431 0, 0, 0, 0, 0, 0,
3432
3433 "attn", /* VK_ATTN 0xF6 */
3434 "crsel", /* VK_CRSEL 0xF7 */
3435 "exsel", /* VK_EXSEL 0xF8 */
3436 "ereof", /* VK_EREOF 0xF9 */
3437 "play", /* VK_PLAY 0xFA */
3438 "zoom", /* VK_ZOOM 0xFB */
3439 "noname", /* VK_NONAME 0xFC */
3440 "pa1", /* VK_PA1 0xFD */
3441 "oem_clear", /* VK_OEM_CLEAR 0xFE */
3442 };
3443
3444 #else
3445
3446 #define FUNCTION_KEY_OFFSET 0xff00
3447
3448 /* You'll notice that this table is arranged to be conveniently
3449 indexed by X Windows keysym values. */
3450 static char *lispy_function_keys[] =
3451 {
3452 /* X Keysym value */
3453
3454 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00 */
3455 "backspace",
3456 "tab",
3457 "linefeed",
3458 "clear",
3459 0,
3460 "return",
3461 0, 0,
3462 0, 0, 0, /* 0xff10 */
3463 "pause",
3464 0, 0, 0, 0, 0, 0, 0,
3465 "escape",
3466 0, 0, 0, 0,
3467 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff20...2f */
3468 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff30...3f */
3469 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
3470
3471 "home", /* 0xff50 */ /* IsCursorKey */
3472 "left",
3473 "up",
3474 "right",
3475 "down",
3476 "prior",
3477 "next",
3478 "end",
3479 "begin",
3480 0, /* 0xff59 */
3481 0, 0, 0, 0, 0, 0,
3482 "select", /* 0xff60 */ /* IsMiscFunctionKey */
3483 "print",
3484 "execute",
3485 "insert",
3486 0, /* 0xff64 */
3487 "undo",
3488 "redo",
3489 "menu",
3490 "find",
3491 "cancel",
3492 "help",
3493 "break", /* 0xff6b */
3494
3495 0, 0, 0, 0, 0, 0, 0, 0, "backtab", 0,
3496 0, /* 0xff76 */
3497 0, 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff7f */
3498 "kp-space", /* 0xff80 */ /* IsKeypadKey */
3499 0, 0, 0, 0, 0, 0, 0, 0,
3500 "kp-tab", /* 0xff89 */
3501 0, 0, 0,
3502 "kp-enter", /* 0xff8d */
3503 0, 0, 0,
3504 "kp-f1", /* 0xff91 */
3505 "kp-f2",
3506 "kp-f3",
3507 "kp-f4",
3508 "kp-home", /* 0xff95 */
3509 "kp-left",
3510 "kp-up",
3511 "kp-right",
3512 "kp-down",
3513 "kp-prior", /* kp-page-up */
3514 "kp-next", /* kp-page-down */
3515 "kp-end",
3516 "kp-begin",
3517 "kp-insert",
3518 "kp-delete",
3519 0, /* 0xffa0 */
3520 0, 0, 0, 0, 0, 0, 0, 0, 0,
3521 "kp-multiply", /* 0xffaa */
3522 "kp-add",
3523 "kp-separator",
3524 "kp-subtract",
3525 "kp-decimal",
3526 "kp-divide", /* 0xffaf */
3527 "kp-0", /* 0xffb0 */
3528 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
3529 0, /* 0xffba */
3530 0, 0,
3531 "kp-equal", /* 0xffbd */
3532 "f1", /* 0xffbe */ /* IsFunctionKey */
3533 "f2",
3534 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
3535 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
3536 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
3537 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
3538 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
3539 0, 0, 0, 0, 0, 0, 0, 0,
3540 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
3541 0, 0, 0, 0, 0, 0, 0, "delete"
3542 };
3543
3544 #endif /* HAVE_NTGUI */
3545
3546 static char *lispy_mouse_names[] =
3547 {
3548 "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5"
3549 };
3550
3551 /* Scroll bar parts. */
3552 Lisp_Object Qabove_handle, Qhandle, Qbelow_handle;
3553 Lisp_Object Qup, Qdown;
3554
3555 /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
3556 Lisp_Object *scroll_bar_parts[] = {
3557 &Qabove_handle, &Qhandle, &Qbelow_handle,
3558 &Qup, &Qdown,
3559 };
3560
3561
3562 /* A vector, indexed by button number, giving the down-going location
3563 of currently depressed buttons, both scroll bar and non-scroll bar.
3564
3565 The elements have the form
3566 (BUTTON-NUMBER MODIFIER-MASK . REST)
3567 where REST is the cdr of a position as it would be reported in the event.
3568
3569 The make_lispy_event function stores positions here to tell the
3570 difference between click and drag events, and to store the starting
3571 location to be included in drag events. */
3572
3573 static Lisp_Object button_down_location;
3574
3575 /* Information about the most recent up-going button event: Which
3576 button, what location, and what time. */
3577
3578 static int last_mouse_button;
3579 static int last_mouse_x;
3580 static int last_mouse_y;
3581 static unsigned long button_down_time;
3582
3583 /* The maximum time between clicks to make a double-click,
3584 or Qnil to disable double-click detection,
3585 or Qt for no time limit. */
3586 Lisp_Object Vdouble_click_time;
3587
3588 /* The number of clicks in this multiple-click. */
3589
3590 int double_click_count;
3591
3592 /* Given a struct input_event, build the lisp event which represents
3593 it. If EVENT is 0, build a mouse movement event from the mouse
3594 movement buffer, which should have a movement event in it.
3595
3596 Note that events must be passed to this function in the order they
3597 are received; this function stores the location of button presses
3598 in order to build drag events when the button is released. */
3599
3600 static Lisp_Object
3601 make_lispy_event (event)
3602 struct input_event *event;
3603 {
3604 int i;
3605
3606 switch (SWITCH_ENUM_CAST (event->kind))
3607 {
3608 /* A simple keystroke. */
3609 case ascii_keystroke:
3610 {
3611 Lisp_Object lispy_c;
3612 int c = event->code & 0377;
3613 /* Turn ASCII characters into control characters
3614 when proper. */
3615 if (event->modifiers & ctrl_modifier)
3616 c = make_ctrl_char (c);
3617
3618 /* Add in the other modifier bits. We took care of ctrl_modifier
3619 just above, and the shift key was taken care of by the X code,
3620 and applied to control characters by make_ctrl_char. */
3621 c |= (event->modifiers
3622 & (meta_modifier | alt_modifier
3623 | hyper_modifier | super_modifier));
3624 button_down_time = 0;
3625 XSETFASTINT (lispy_c, c);
3626 return lispy_c;
3627 }
3628
3629 /* A function key. The symbol may need to have modifier prefixes
3630 tacked onto it. */
3631 case non_ascii_keystroke:
3632 button_down_time = 0;
3633
3634 for (i = 0; i < sizeof (lispy_accent_codes) / sizeof (int); i++)
3635 if (event->code == lispy_accent_codes[i])
3636 return modify_event_symbol (i,
3637 event->modifiers,
3638 Qfunction_key, Qnil,
3639 lispy_accent_keys, &accent_key_syms,
3640 (sizeof (lispy_accent_keys)
3641 / sizeof (lispy_accent_keys[0])));
3642
3643 /* Handle system-specific keysyms. */
3644 if (event->code & (1 << 28))
3645 {
3646 /* We need to use an alist rather than a vector as the cache
3647 since we can't make a vector long enuf. */
3648 if (NILP (current_kboard->system_key_syms))
3649 current_kboard->system_key_syms = Fcons (Qnil, Qnil);
3650 return modify_event_symbol (event->code,
3651 event->modifiers,
3652 Qfunction_key,
3653 current_kboard->Vsystem_key_alist,
3654 0, &current_kboard->system_key_syms,
3655 (unsigned)-1);
3656 }
3657
3658 return modify_event_symbol (event->code - FUNCTION_KEY_OFFSET,
3659 event->modifiers,
3660 Qfunction_key, Qnil,
3661 lispy_function_keys, &func_key_syms,
3662 (sizeof (lispy_function_keys)
3663 / sizeof (lispy_function_keys[0])));
3664 break;
3665
3666 /* Note that timer_event is currently never used. */
3667 case timer_event:
3668 return Fcons (Qtimer_event, Fcons (Fcdr (event->frame_or_window), Qnil));
3669
3670 #ifdef HAVE_MOUSE
3671 /* A mouse click. Figure out where it is, decide whether it's
3672 a press, click or drag, and build the appropriate structure. */
3673 case mouse_click:
3674 case scroll_bar_click:
3675 {
3676 int button = event->code;
3677 int is_double;
3678 Lisp_Object position;
3679 Lisp_Object *start_pos_ptr;
3680 Lisp_Object start_pos;
3681
3682 if (button < 0 || button >= NUM_MOUSE_BUTTONS)
3683 abort ();
3684
3685 /* Build the position as appropriate for this mouse click. */
3686 if (event->kind == mouse_click)
3687 {
3688 int part;
3689 FRAME_PTR f = XFRAME (event->frame_or_window);
3690 Lisp_Object window;
3691 Lisp_Object posn;
3692 int row, column;
3693
3694 /* Ignore mouse events that were made on frame that
3695 have been deleted. */
3696 if (! FRAME_LIVE_P (f))
3697 return Qnil;
3698
3699 pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y),
3700 &column, &row, NULL, 1);
3701
3702 #ifndef USE_X_TOOLKIT
3703 /* In the non-toolkit version, clicks on the menu bar
3704 are ordinary button events in the event buffer.
3705 Distinguish them, and invoke the menu.
3706
3707 (In the toolkit version, the toolkit handles the menu bar
3708 and Emacs doesn't know about it until after the user
3709 makes a selection.) */
3710 if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
3711 && (event->modifiers & down_modifier))
3712 {
3713 Lisp_Object items, item;
3714 int hpos;
3715 int i;
3716
3717 #if 0
3718 /* Activate the menu bar on the down event. If the
3719 up event comes in before the menu code can deal with it,
3720 just ignore it. */
3721 if (! (event->modifiers & down_modifier))
3722 return Qnil;
3723 #endif
3724
3725 item = Qnil;
3726 items = FRAME_MENU_BAR_ITEMS (f);
3727 for (i = 0; i < XVECTOR (items)->size; i += 4)
3728 {
3729 Lisp_Object pos, string;
3730 string = XVECTOR (items)->contents[i + 1];
3731 pos = XVECTOR (items)->contents[i + 3];
3732 if (NILP (string))
3733 break;
3734 if (column >= XINT (pos)
3735 && column < XINT (pos) + XSTRING (string)->size)
3736 {
3737 item = XVECTOR (items)->contents[i];
3738 break;
3739 }
3740 }
3741
3742 position
3743 = Fcons (event->frame_or_window,
3744 Fcons (Qmenu_bar,
3745 Fcons (Fcons (event->x, event->y),
3746 Fcons (make_number (event->timestamp),
3747 Qnil))));
3748
3749 return Fcons (item, Fcons (position, Qnil));
3750 }
3751 #endif /* not USE_X_TOOLKIT */
3752
3753 window = window_from_coordinates (f, column, row, &part);
3754
3755 if (!WINDOWP (window))
3756 {
3757 window = event->frame_or_window;
3758 posn = Qnil;
3759 }
3760 else
3761 {
3762 int pixcolumn, pixrow;
3763 column -= XINT (XWINDOW (window)->left);
3764 row -= XINT (XWINDOW (window)->top);
3765 glyph_to_pixel_coords (f, column, row, &pixcolumn, &pixrow);
3766 XSETINT (event->x, pixcolumn);
3767 XSETINT (event->y, pixrow);
3768
3769 if (part == 1)
3770 posn = Qmode_line;
3771 else if (part == 2)
3772 posn = Qvertical_line;
3773 else
3774 XSETINT (posn,
3775 buffer_posn_from_coords (XWINDOW (window),
3776 column, row));
3777 }
3778
3779 position
3780 = Fcons (window,
3781 Fcons (posn,
3782 Fcons (Fcons (event->x, event->y),
3783 Fcons (make_number (event->timestamp),
3784 Qnil))));
3785 }
3786 else
3787 {
3788 Lisp_Object window;
3789 Lisp_Object portion_whole;
3790 Lisp_Object part;
3791
3792 window = event->frame_or_window;
3793 portion_whole = Fcons (event->x, event->y);
3794 part = *scroll_bar_parts[(int) event->part];
3795
3796 position
3797 = Fcons (window,
3798 Fcons (Qvertical_scroll_bar,
3799 Fcons (portion_whole,
3800 Fcons (make_number (event->timestamp),
3801 Fcons (part, Qnil)))));
3802 }
3803
3804 start_pos_ptr = &XVECTOR (button_down_location)->contents[button];
3805
3806 start_pos = *start_pos_ptr;
3807 *start_pos_ptr = Qnil;
3808
3809 is_double = (button == last_mouse_button
3810 && XINT (event->x) == last_mouse_x
3811 && XINT (event->y) == last_mouse_y
3812 && button_down_time != 0
3813 && (EQ (Vdouble_click_time, Qt)
3814 || (INTEGERP (Vdouble_click_time)
3815 && ((int)(event->timestamp - button_down_time)
3816 < XINT (Vdouble_click_time)))));
3817 last_mouse_button = button;
3818 last_mouse_x = XINT (event->x);
3819 last_mouse_y = XINT (event->y);
3820
3821 /* If this is a button press, squirrel away the location, so
3822 we can decide later whether it was a click or a drag. */
3823 if (event->modifiers & down_modifier)
3824 {
3825 if (is_double)
3826 {
3827 double_click_count++;
3828 event->modifiers |= ((double_click_count > 2)
3829 ? triple_modifier
3830 : double_modifier);
3831 }
3832 else
3833 double_click_count = 1;
3834 button_down_time = event->timestamp;
3835 *start_pos_ptr = Fcopy_alist (position);
3836 }
3837
3838 /* Now we're releasing a button - check the co-ordinates to
3839 see if this was a click or a drag. */
3840 else if (event->modifiers & up_modifier)
3841 {
3842 /* If we did not see a down before this up,
3843 ignore the up. Probably this happened because
3844 the down event chose a menu item.
3845 It would be an annoyance to treat the release
3846 of the button that chose the menu item
3847 as a separate event. */
3848
3849 if (!CONSP (start_pos))
3850 return Qnil;
3851
3852 event->modifiers &= ~up_modifier;
3853 #if 0 /* Formerly we treated an up with no down as a click event. */
3854 if (!CONSP (start_pos))
3855 event->modifiers |= click_modifier;
3856 else
3857 #endif
3858 {
3859 /* The third element of every position should be the (x,y)
3860 pair. */
3861 Lisp_Object down;
3862
3863 down = Fnth (make_number (2), start_pos);
3864 if (EQ (event->x, XCONS (down)->car)
3865 && EQ (event->y, XCONS (down)->cdr))
3866 {
3867 event->modifiers |= click_modifier;
3868 }
3869 else
3870 {
3871 button_down_time = 0;
3872 event->modifiers |= drag_modifier;
3873 }
3874 /* Don't check is_double; treat this as multiple
3875 if the down-event was multiple. */
3876 if (double_click_count > 1)
3877 event->modifiers |= ((double_click_count > 2)
3878 ? triple_modifier
3879 : double_modifier);
3880 }
3881 }
3882 else
3883 /* Every mouse event should either have the down_modifier or
3884 the up_modifier set. */
3885 abort ();
3886
3887 {
3888 /* Get the symbol we should use for the mouse click. */
3889 Lisp_Object head;
3890
3891 head = modify_event_symbol (button,
3892 event->modifiers,
3893 Qmouse_click, Qnil,
3894 lispy_mouse_names, &mouse_syms,
3895 (sizeof (lispy_mouse_names)
3896 / sizeof (lispy_mouse_names[0])));
3897 if (event->modifiers & drag_modifier)
3898 return Fcons (head,
3899 Fcons (start_pos,
3900 Fcons (position,
3901 Qnil)));
3902 else if (event->modifiers & (double_modifier | triple_modifier))
3903 return Fcons (head,
3904 Fcons (position,
3905 Fcons (make_number (double_click_count),
3906 Qnil)));
3907 else
3908 return Fcons (head,
3909 Fcons (position,
3910 Qnil));
3911 }
3912 }
3913
3914 #ifdef WINDOWSNT
3915 case win32_scroll_bar_click:
3916 {
3917 int button = event->code;
3918 int is_double;
3919 Lisp_Object position;
3920 Lisp_Object *start_pos_ptr;
3921 Lisp_Object start_pos;
3922
3923 if (button < 0 || button >= NUM_MOUSE_BUTTONS)
3924 abort ();
3925
3926 {
3927 Lisp_Object window;
3928 Lisp_Object portion_whole;
3929 Lisp_Object part;
3930
3931 window = event->frame_or_window;
3932 portion_whole = Fcons (event->x, event->y);
3933 part = *scroll_bar_parts[(int) event->part];
3934
3935 position =
3936 Fcons (window,
3937 Fcons (Qvertical_scroll_bar,
3938 Fcons (portion_whole,
3939 Fcons (make_number (event->timestamp),
3940 Fcons (part, Qnil)))));
3941 }
3942
3943 /* Always treat Win32 scroll bar events as clicks. */
3944 event->modifiers |= click_modifier;
3945
3946 {
3947 /* Get the symbol we should use for the mouse click. */
3948 Lisp_Object head;
3949
3950 head = modify_event_symbol (button,
3951 event->modifiers,
3952 Qmouse_click, Qnil,
3953 lispy_mouse_names, &mouse_syms,
3954 (sizeof (lispy_mouse_names)
3955 / sizeof (lispy_mouse_names[0])));
3956 return Fcons (head,
3957 Fcons (position,
3958 Qnil));
3959 }
3960 }
3961 #endif
3962
3963 #endif /* HAVE_MOUSE */
3964
3965 #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI)
3966 case menu_bar_event:
3967 /* The event value is in the cdr of the frame_or_window slot. */
3968 if (!CONSP (event->frame_or_window))
3969 abort ();
3970 return XCONS (event->frame_or_window)->cdr;
3971 #endif
3972
3973 /* The 'kind' field of the event is something we don't recognize. */
3974 default:
3975 abort ();
3976 }
3977 }
3978
3979 #ifdef HAVE_MOUSE
3980
3981 static Lisp_Object
3982 make_lispy_movement (frame, bar_window, part, x, y, time)
3983 FRAME_PTR frame;
3984 Lisp_Object bar_window;
3985 enum scroll_bar_part part;
3986 Lisp_Object x, y;
3987 unsigned long time;
3988 {
3989 #ifdef MULTI_FRAME
3990 /* Is it a scroll bar movement? */
3991 if (frame && ! NILP (bar_window))
3992 {
3993 Lisp_Object part_sym;
3994
3995 part_sym = *scroll_bar_parts[(int) part];
3996 return Fcons (Qscroll_bar_movement,
3997 (Fcons (Fcons (bar_window,
3998 Fcons (Qvertical_scroll_bar,
3999 Fcons (Fcons (x, y),
4000 Fcons (make_number (time),
4001 Fcons (part_sym,
4002 Qnil))))),
4003 Qnil)));
4004 }
4005
4006 /* Or is it an ordinary mouse movement? */
4007 else
4008 #endif /* MULTI_FRAME */
4009 {
4010 int area;
4011 Lisp_Object window;
4012 Lisp_Object posn;
4013 int column, row;
4014
4015 #ifdef MULTI_FRAME
4016 if (frame)
4017 #else
4018 if (1)
4019 #endif
4020 {
4021 /* It's in a frame; which window on that frame? */
4022 pixel_to_glyph_coords (frame, XINT (x), XINT (y), &column, &row,
4023 NULL, 1);
4024 window = window_from_coordinates (frame, column, row, &area);
4025 }
4026 else
4027 window = Qnil;
4028
4029 if (WINDOWP (window))
4030 {
4031 int pixcolumn, pixrow;
4032 column -= XINT (XWINDOW (window)->left);
4033 row -= XINT (XWINDOW (window)->top);
4034 glyph_to_pixel_coords (frame, column, row, &pixcolumn, &pixrow);
4035 XSETINT (x, pixcolumn);
4036 XSETINT (y, pixrow);
4037
4038 if (area == 1)
4039 posn = Qmode_line;
4040 else if (area == 2)
4041 posn = Qvertical_line;
4042 else
4043 XSETINT (posn,
4044 buffer_posn_from_coords (XWINDOW (window), column, row));
4045 }
4046 #ifdef MULTI_FRAME
4047 else if (frame != 0)
4048 {
4049 XSETFRAME (window, frame);
4050 posn = Qnil;
4051 }
4052 #endif
4053 else
4054 {
4055 window = Qnil;
4056 posn = Qnil;
4057 XSETFASTINT (x, 0);
4058 XSETFASTINT (y, 0);
4059 }
4060
4061 return Fcons (Qmouse_movement,
4062 Fcons (Fcons (window,
4063 Fcons (posn,
4064 Fcons (Fcons (x, y),
4065 Fcons (make_number (time),
4066 Qnil)))),
4067 Qnil));
4068 }
4069 }
4070
4071 #endif /* HAVE_MOUSE */
4072
4073 /* Construct a switch frame event. */
4074 static Lisp_Object
4075 make_lispy_switch_frame (frame)
4076 Lisp_Object frame;
4077 {
4078 return Fcons (Qswitch_frame, Fcons (frame, Qnil));
4079 }
4080 \f
4081 /* Manipulating modifiers. */
4082
4083 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
4084
4085 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
4086 SYMBOL's name of the end of the modifiers; the string from this
4087 position is the unmodified symbol name.
4088
4089 This doesn't use any caches. */
4090
4091 static int
4092 parse_modifiers_uncached (symbol, modifier_end)
4093 Lisp_Object symbol;
4094 int *modifier_end;
4095 {
4096 struct Lisp_String *name;
4097 int i;
4098 int modifiers;
4099
4100 CHECK_SYMBOL (symbol, 1);
4101
4102 modifiers = 0;
4103 name = XSYMBOL (symbol)->name;
4104
4105 for (i = 0; i+2 <= name->size; )
4106 {
4107 int this_mod_end = 0;
4108 int this_mod = 0;
4109
4110 /* See if the name continues with a modifier word.
4111 Check that the word appears, but don't check what follows it.
4112 Set this_mod and this_mod_end to record what we find. */
4113
4114 switch (name->data[i])
4115 {
4116 #define SINGLE_LETTER_MOD(BIT) \
4117 (this_mod_end = i + 1, this_mod = BIT)
4118
4119 case 'A':
4120 SINGLE_LETTER_MOD (alt_modifier);
4121 break;
4122
4123 case 'C':
4124 SINGLE_LETTER_MOD (ctrl_modifier);
4125 break;
4126
4127 case 'H':
4128 SINGLE_LETTER_MOD (hyper_modifier);
4129 break;
4130
4131 case 'M':
4132 SINGLE_LETTER_MOD (meta_modifier);
4133 break;
4134
4135 case 'S':
4136 SINGLE_LETTER_MOD (shift_modifier);
4137 break;
4138
4139 case 's':
4140 SINGLE_LETTER_MOD (super_modifier);
4141 break;
4142
4143 #undef SINGLE_LETTER_MOD
4144 }
4145
4146 /* If we found no modifier, stop looking for them. */
4147 if (this_mod_end == 0)
4148 break;
4149
4150 /* Check there is a dash after the modifier, so that it
4151 really is a modifier. */
4152 if (this_mod_end >= name->size || name->data[this_mod_end] != '-')
4153 break;
4154
4155 /* This modifier is real; look for another. */
4156 modifiers |= this_mod;
4157 i = this_mod_end + 1;
4158 }
4159
4160 /* Should we include the `click' modifier? */
4161 if (! (modifiers & (down_modifier | drag_modifier
4162 | double_modifier | triple_modifier))
4163 && i + 7 == name->size
4164 && strncmp (name->data + i, "mouse-", 6) == 0
4165 && ('0' <= name->data[i + 6] && name->data[i + 6] <= '9'))
4166 modifiers |= click_modifier;
4167
4168 if (modifier_end)
4169 *modifier_end = i;
4170
4171 return modifiers;
4172 }
4173
4174 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
4175 prepended to the string BASE[0..BASE_LEN-1].
4176 This doesn't use any caches. */
4177 static Lisp_Object
4178 apply_modifiers_uncached (modifiers, base, base_len)
4179 int modifiers;
4180 char *base;
4181 int base_len;
4182 {
4183 /* Since BASE could contain nulls, we can't use intern here; we have
4184 to use Fintern, which expects a genuine Lisp_String, and keeps a
4185 reference to it. */
4186 char *new_mods =
4187 (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
4188 int mod_len;
4189
4190 {
4191 char *p = new_mods;
4192
4193 /* Only the event queue may use the `up' modifier; it should always
4194 be turned into a click or drag event before presented to lisp code. */
4195 if (modifiers & up_modifier)
4196 abort ();
4197
4198 if (modifiers & alt_modifier) { *p++ = 'A'; *p++ = '-'; }
4199 if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
4200 if (modifiers & hyper_modifier) { *p++ = 'H'; *p++ = '-'; }
4201 if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
4202 if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
4203 if (modifiers & super_modifier) { *p++ = 's'; *p++ = '-'; }
4204 if (modifiers & double_modifier) { strcpy (p, "double-"); p += 7; }
4205 if (modifiers & triple_modifier) { strcpy (p, "triple-"); p += 7; }
4206 if (modifiers & down_modifier) { strcpy (p, "down-"); p += 5; }
4207 if (modifiers & drag_modifier) { strcpy (p, "drag-"); p += 5; }
4208 /* The click modifier is denoted by the absence of other modifiers. */
4209
4210 *p = '\0';
4211
4212 mod_len = p - new_mods;
4213 }
4214
4215 {
4216 Lisp_Object new_name;
4217
4218 new_name = make_uninit_string (mod_len + base_len);
4219 bcopy (new_mods, XSTRING (new_name)->data, mod_len);
4220 bcopy (base, XSTRING (new_name)->data + mod_len, base_len);
4221
4222 return Fintern (new_name, Qnil);
4223 }
4224 }
4225
4226
4227 static char *modifier_names[] =
4228 {
4229 "up", "down", "drag", "click", "double", "triple", 0, 0,
4230 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
4231 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
4232 };
4233 #define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
4234
4235 static Lisp_Object modifier_symbols;
4236
4237 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
4238 static Lisp_Object
4239 lispy_modifier_list (modifiers)
4240 int modifiers;
4241 {
4242 Lisp_Object modifier_list;
4243 int i;
4244
4245 modifier_list = Qnil;
4246 for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
4247 if (modifiers & (1<<i))
4248 modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
4249 modifier_list);
4250
4251 return modifier_list;
4252 }
4253
4254
4255 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
4256 where UNMODIFIED is the unmodified form of SYMBOL,
4257 MASK is the set of modifiers present in SYMBOL's name.
4258 This is similar to parse_modifiers_uncached, but uses the cache in
4259 SYMBOL's Qevent_symbol_element_mask property, and maintains the
4260 Qevent_symbol_elements property. */
4261
4262 static Lisp_Object
4263 parse_modifiers (symbol)
4264 Lisp_Object symbol;
4265 {
4266 Lisp_Object elements;
4267
4268 elements = Fget (symbol, Qevent_symbol_element_mask);
4269 if (CONSP (elements))
4270 return elements;
4271 else
4272 {
4273 int end;
4274 int modifiers = parse_modifiers_uncached (symbol, &end);
4275 Lisp_Object unmodified;
4276 Lisp_Object mask;
4277
4278 unmodified = Fintern (make_string (XSYMBOL (symbol)->name->data + end,
4279 XSYMBOL (symbol)->name->size - end),
4280 Qnil);
4281
4282 if (modifiers & ~(((EMACS_INT)1 << VALBITS) - 1))
4283 abort ();
4284 XSETFASTINT (mask, modifiers);
4285 elements = Fcons (unmodified, Fcons (mask, Qnil));
4286
4287 /* Cache the parsing results on SYMBOL. */
4288 Fput (symbol, Qevent_symbol_element_mask,
4289 elements);
4290 Fput (symbol, Qevent_symbol_elements,
4291 Fcons (unmodified, lispy_modifier_list (modifiers)));
4292
4293 /* Since we know that SYMBOL is modifiers applied to unmodified,
4294 it would be nice to put that in unmodified's cache.
4295 But we can't, since we're not sure that parse_modifiers is
4296 canonical. */
4297
4298 return elements;
4299 }
4300 }
4301
4302 /* Apply the modifiers MODIFIERS to the symbol BASE.
4303 BASE must be unmodified.
4304
4305 This is like apply_modifiers_uncached, but uses BASE's
4306 Qmodifier_cache property, if present. It also builds
4307 Qevent_symbol_elements properties, since it has that info anyway.
4308
4309 apply_modifiers copies the value of BASE's Qevent_kind property to
4310 the modified symbol. */
4311 static Lisp_Object
4312 apply_modifiers (modifiers, base)
4313 int modifiers;
4314 Lisp_Object base;
4315 {
4316 Lisp_Object cache, index, entry, new_symbol;
4317
4318 /* Mask out upper bits. We don't know where this value's been. */
4319 modifiers &= ((EMACS_INT)1 << VALBITS) - 1;
4320
4321 /* The click modifier never figures into cache indices. */
4322 cache = Fget (base, Qmodifier_cache);
4323 XSETFASTINT (index, (modifiers & ~click_modifier));
4324 entry = assq_no_quit (index, cache);
4325
4326 if (CONSP (entry))
4327 new_symbol = XCONS (entry)->cdr;
4328 else
4329 {
4330 /* We have to create the symbol ourselves. */
4331 new_symbol = apply_modifiers_uncached (modifiers,
4332 XSYMBOL (base)->name->data,
4333 XSYMBOL (base)->name->size);
4334
4335 /* Add the new symbol to the base's cache. */
4336 entry = Fcons (index, new_symbol);
4337 Fput (base, Qmodifier_cache, Fcons (entry, cache));
4338
4339 /* We have the parsing info now for free, so add it to the caches. */
4340 XSETFASTINT (index, modifiers);
4341 Fput (new_symbol, Qevent_symbol_element_mask,
4342 Fcons (base, Fcons (index, Qnil)));
4343 Fput (new_symbol, Qevent_symbol_elements,
4344 Fcons (base, lispy_modifier_list (modifiers)));
4345 }
4346
4347 /* Make sure this symbol is of the same kind as BASE.
4348
4349 You'd think we could just set this once and for all when we
4350 intern the symbol above, but reorder_modifiers may call us when
4351 BASE's property isn't set right; we can't assume that just
4352 because it has a Qmodifier_cache property it must have its
4353 Qevent_kind set right as well. */
4354 if (NILP (Fget (new_symbol, Qevent_kind)))
4355 {
4356 Lisp_Object kind;
4357
4358 kind = Fget (base, Qevent_kind);
4359 if (! NILP (kind))
4360 Fput (new_symbol, Qevent_kind, kind);
4361 }
4362
4363 return new_symbol;
4364 }
4365
4366
4367 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
4368 return a symbol with the modifiers placed in the canonical order.
4369 Canonical order is alphabetical, except for down and drag, which
4370 always come last. The 'click' modifier is never written out.
4371
4372 Fdefine_key calls this to make sure that (for example) C-M-foo
4373 and M-C-foo end up being equivalent in the keymap. */
4374
4375 Lisp_Object
4376 reorder_modifiers (symbol)
4377 Lisp_Object symbol;
4378 {
4379 /* It's hopefully okay to write the code this way, since everything
4380 will soon be in caches, and no consing will be done at all. */
4381 Lisp_Object parsed;
4382
4383 parsed = parse_modifiers (symbol);
4384 return apply_modifiers ((int) XINT (XCONS (XCONS (parsed)->cdr)->car),
4385 XCONS (parsed)->car);
4386 }
4387
4388
4389 /* For handling events, we often want to produce a symbol whose name
4390 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
4391 to some base, like the name of a function key or mouse button.
4392 modify_event_symbol produces symbols of this sort.
4393
4394 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
4395 is the name of the i'th symbol. TABLE_SIZE is the number of elements
4396 in the table.
4397
4398 Alternatively, NAME_ALIST is an alist mapping codes into symbol names.
4399 NAME_ALIST is used if it is non-nil; otherwise NAME_TABLE is used.
4400
4401 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
4402 persist between calls to modify_event_symbol that it can use to
4403 store a cache of the symbols it's generated for this NAME_TABLE
4404 before. The object stored there may be a vector or an alist.
4405
4406 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
4407
4408 MODIFIERS is a set of modifier bits (as given in struct input_events)
4409 whose prefixes should be applied to the symbol name.
4410
4411 SYMBOL_KIND is the value to be placed in the event_kind property of
4412 the returned symbol.
4413
4414 The symbols we create are supposed to have an
4415 `event-symbol-elements' property, which lists the modifiers present
4416 in the symbol's name. */
4417
4418 static Lisp_Object
4419 modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist,
4420 name_table, symbol_table, table_size)
4421 int symbol_num;
4422 unsigned modifiers;
4423 Lisp_Object symbol_kind;
4424 Lisp_Object name_alist;
4425 char **name_table;
4426 Lisp_Object *symbol_table;
4427 unsigned int table_size;
4428 {
4429 Lisp_Object value;
4430 Lisp_Object symbol_int;
4431
4432 /* Get rid of the "vendor-specific" bit here. */
4433 XSETINT (symbol_int, symbol_num & 0xffffff);
4434
4435 /* Is this a request for a valid symbol? */
4436 if (symbol_num < 0 || symbol_num >= table_size)
4437 return Qnil;
4438
4439 if (CONSP (*symbol_table))
4440 value = Fcdr (assq_no_quit (symbol_int, *symbol_table));
4441
4442 /* If *symbol_table doesn't seem to be initialized properly, fix that.
4443 *symbol_table should be a lisp vector TABLE_SIZE elements long,
4444 where the Nth element is the symbol for NAME_TABLE[N], or nil if
4445 we've never used that symbol before. */
4446 else
4447 {
4448 if (! VECTORP (*symbol_table)
4449 || XVECTOR (*symbol_table)->size != table_size)
4450 {
4451 Lisp_Object size;
4452
4453 XSETFASTINT (size, table_size);
4454 *symbol_table = Fmake_vector (size, Qnil);
4455 }
4456
4457 value = XVECTOR (*symbol_table)->contents[symbol_num];
4458 }
4459
4460 /* Have we already used this symbol before? */
4461 if (NILP (value))
4462 {
4463 /* No; let's create it. */
4464 if (!NILP (name_alist))
4465 value = Fcdr_safe (Fassq (symbol_int, name_alist));
4466 else if (name_table[symbol_num])
4467 value = intern (name_table[symbol_num]);
4468
4469 #ifdef HAVE_WINDOW_SYSTEM
4470 if (NILP (value))
4471 {
4472 char *name = x_get_keysym_name (symbol_num);
4473 if (name)
4474 value = intern (name);
4475 }
4476 #endif
4477
4478 if (NILP (value))
4479 {
4480 char buf[20];
4481 sprintf (buf, "key-%d", symbol_num);
4482 value = intern (buf);
4483 }
4484
4485 if (CONSP (*symbol_table))
4486 *symbol_table = Fcons (value, *symbol_table);
4487 else
4488 XVECTOR (*symbol_table)->contents[symbol_num] = value;
4489
4490 /* Fill in the cache entries for this symbol; this also
4491 builds the Qevent_symbol_elements property, which the user
4492 cares about. */
4493 apply_modifiers (modifiers & click_modifier, value);
4494 Fput (value, Qevent_kind, symbol_kind);
4495 }
4496
4497 /* Apply modifiers to that symbol. */
4498 return apply_modifiers (modifiers, value);
4499 }
4500 \f
4501 /* Convert a list that represents an event type,
4502 such as (ctrl meta backspace), into the usual representation of that
4503 event type as a number or a symbol. */
4504
4505 DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
4506 "Convert the event description list EVENT-DESC to an event type.\n\
4507 EVENT-DESC should contain one base event type (a character or symbol)\n\
4508 and zero or more modifier names (control, meta, hyper, super, shift, alt,\n\
4509 drag, down, double or triple). The base must be last.\n\
4510 The return value is an event type (a character or symbol) which\n\
4511 has the same base event type and all the specified modifiers.")
4512 (event_desc)
4513 Lisp_Object event_desc;
4514 {
4515 Lisp_Object base;
4516 int modifiers = 0;
4517 Lisp_Object rest;
4518
4519 base = Qnil;
4520 rest = event_desc;
4521 while (CONSP (rest))
4522 {
4523 Lisp_Object elt;
4524 int this = 0;
4525
4526 elt = XCONS (rest)->car;
4527 rest = XCONS (rest)->cdr;
4528
4529 /* Given a symbol, see if it is a modifier name. */
4530 if (SYMBOLP (elt) && CONSP (rest))
4531 this = parse_solitary_modifier (elt);
4532
4533 if (this != 0)
4534 modifiers |= this;
4535 else if (!NILP (base))
4536 error ("Two bases given in one event");
4537 else
4538 base = elt;
4539
4540 }
4541
4542 /* Let the symbol A refer to the character A. */
4543 if (SYMBOLP (base) && XSYMBOL (base)->name->size == 1)
4544 XSETINT (base, XSYMBOL (base)->name->data[0]);
4545
4546 if (INTEGERP (base))
4547 {
4548 /* Turn (shift a) into A. */
4549 if ((modifiers & shift_modifier) != 0
4550 && (XINT (base) >= 'a' && XINT (base) <= 'z'))
4551 {
4552 XSETINT (base, XINT (base) - ('a' - 'A'));
4553 modifiers &= ~shift_modifier;
4554 }
4555
4556 /* Turn (control a) into C-a. */
4557 if (modifiers & ctrl_modifier)
4558 return make_number ((modifiers & ~ctrl_modifier)
4559 | make_ctrl_char (XINT (base)));
4560 else
4561 return make_number (modifiers | XINT (base));
4562 }
4563 else if (SYMBOLP (base))
4564 return apply_modifiers (modifiers, base);
4565 else
4566 error ("Invalid base event");
4567 }
4568
4569 /* Try to recognize SYMBOL as a modifier name.
4570 Return the modifier flag bit, or 0 if not recognized. */
4571
4572 static int
4573 parse_solitary_modifier (symbol)
4574 Lisp_Object symbol;
4575 {
4576 struct Lisp_String *name = XSYMBOL (symbol)->name;
4577
4578 switch (name->data[0])
4579 {
4580 #define SINGLE_LETTER_MOD(BIT) \
4581 if (name->size == 1) \
4582 return BIT;
4583
4584 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
4585 if (LEN == name->size \
4586 && ! strncmp (name->data, NAME, LEN)) \
4587 return BIT;
4588
4589 case 'A':
4590 SINGLE_LETTER_MOD (alt_modifier);
4591 break;
4592
4593 case 'a':
4594 MULTI_LETTER_MOD (alt_modifier, "alt", 3);
4595 break;
4596
4597 case 'C':
4598 SINGLE_LETTER_MOD (ctrl_modifier);
4599 break;
4600
4601 case 'c':
4602 MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
4603 MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
4604 break;
4605
4606 case 'H':
4607 SINGLE_LETTER_MOD (hyper_modifier);
4608 break;
4609
4610 case 'h':
4611 MULTI_LETTER_MOD (hyper_modifier, "hyper", 5);
4612 break;
4613
4614 case 'M':
4615 SINGLE_LETTER_MOD (meta_modifier);
4616 break;
4617
4618 case 'm':
4619 MULTI_LETTER_MOD (meta_modifier, "meta", 4);
4620 break;
4621
4622 case 'S':
4623 SINGLE_LETTER_MOD (shift_modifier);
4624 break;
4625
4626 case 's':
4627 MULTI_LETTER_MOD (shift_modifier, "shift", 5);
4628 MULTI_LETTER_MOD (super_modifier, "super", 5);
4629 SINGLE_LETTER_MOD (super_modifier);
4630 break;
4631
4632 case 'd':
4633 MULTI_LETTER_MOD (drag_modifier, "drag", 4);
4634 MULTI_LETTER_MOD (down_modifier, "down", 4);
4635 MULTI_LETTER_MOD (double_modifier, "double", 6);
4636 break;
4637
4638 case 't':
4639 MULTI_LETTER_MOD (triple_modifier, "triple", 6);
4640 break;
4641
4642 #undef SINGLE_LETTER_MOD
4643 #undef MULTI_LETTER_MOD
4644 }
4645
4646 return 0;
4647 }
4648
4649 /* Return 1 if EVENT is a list whose elements are all integers or symbols.
4650 Such a list is not valid as an event,
4651 but it can be a Lucid-style event type list. */
4652
4653 int
4654 lucid_event_type_list_p (object)
4655 Lisp_Object object;
4656 {
4657 Lisp_Object tail;
4658
4659 if (! CONSP (object))
4660 return 0;
4661
4662 for (tail = object; CONSP (tail); tail = XCONS (tail)->cdr)
4663 {
4664 Lisp_Object elt;
4665 elt = XCONS (tail)->car;
4666 if (! (INTEGERP (elt) || SYMBOLP (elt)))
4667 return 0;
4668 }
4669
4670 return NILP (tail);
4671 }
4672 \f
4673 /* Store into *addr a value nonzero if terminal input chars are available.
4674 Serves the purpose of ioctl (0, FIONREAD, addr)
4675 but works even if FIONREAD does not exist.
4676 (In fact, this may actually read some input.)
4677
4678 If DO_TIMERS_NOW is nonzero, actually run timer events that are ripe. */
4679
4680 static void
4681 get_input_pending (addr, do_timers_now)
4682 int *addr;
4683 int do_timers_now;
4684 {
4685 /* First of all, have we already counted some input? */
4686 *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
4687
4688 /* If input is being read as it arrives, and we have none, there is none. */
4689 if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
4690 return;
4691
4692 /* Try to read some input and see how much we get. */
4693 gobble_input (0);
4694 *addr = !NILP (Vquit_flag) || readable_events (do_timers_now);
4695 }
4696
4697 /* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
4698
4699 int
4700 gobble_input (expected)
4701 int expected;
4702 {
4703 #ifndef VMS
4704 #ifdef SIGIO
4705 if (interrupt_input)
4706 {
4707 SIGMASKTYPE mask;
4708 mask = sigblockx (SIGIO);
4709 read_avail_input (expected);
4710 sigsetmask (mask);
4711 }
4712 else
4713 #ifdef POLL_FOR_INPUT
4714 if (read_socket_hook && !interrupt_input && poll_suppress_count == 0)
4715 {
4716 SIGMASKTYPE mask;
4717 mask = sigblockx (SIGALRM);
4718 read_avail_input (expected);
4719 sigsetmask (mask);
4720 }
4721 else
4722 #endif
4723 #endif
4724 read_avail_input (expected);
4725 #endif
4726 }
4727
4728 /* Put a buffer_switch_event in the buffer
4729 so that read_key_sequence will notice the new current buffer. */
4730
4731 record_asynch_buffer_change ()
4732 {
4733 struct input_event event;
4734 Lisp_Object tem;
4735
4736 event.kind = buffer_switch_event;
4737 event.frame_or_window = Qnil;
4738
4739 #ifdef subprocesses
4740 /* We don't need a buffer-switch event unless Emacs is waiting for input.
4741 The purpose of the event is to make read_key_sequence look up the
4742 keymaps again. If we aren't in read_key_sequence, we don't need one,
4743 and the event could cause trouble by messing up (input-pending-p). */
4744 tem = Fwaiting_for_user_input_p ();
4745 if (NILP (tem))
4746 return;
4747 #else
4748 /* We never need these events if we have no asynchronous subprocesses. */
4749 return;
4750 #endif
4751
4752 /* Make sure no interrupt happens while storing the event. */
4753 #ifdef SIGIO
4754 if (interrupt_input)
4755 {
4756 SIGMASKTYPE mask;
4757 mask = sigblockx (SIGIO);
4758 kbd_buffer_store_event (&event);
4759 sigsetmask (mask);
4760 }
4761 else
4762 #endif
4763 {
4764 stop_polling ();
4765 kbd_buffer_store_event (&event);
4766 start_polling ();
4767 }
4768 }
4769 \f
4770 #ifndef VMS
4771
4772 /* Read any terminal input already buffered up by the system
4773 into the kbd_buffer, but do not wait.
4774
4775 EXPECTED should be nonzero if the caller knows there is some input.
4776
4777 Except on VMS, all input is read by this function.
4778 If interrupt_input is nonzero, this function MUST be called
4779 only when SIGIO is blocked.
4780
4781 Returns the number of keyboard chars read, or -1 meaning
4782 this is a bad time to try to read input. */
4783
4784 static int
4785 read_avail_input (expected)
4786 int expected;
4787 {
4788 struct input_event buf[KBD_BUFFER_SIZE];
4789 register int i;
4790 int nread;
4791
4792 if (read_socket_hook)
4793 /* No need for FIONREAD or fcntl; just say don't wait. */
4794 nread = (*read_socket_hook) (input_fd, buf, KBD_BUFFER_SIZE,
4795 expected, expected);
4796 else
4797 {
4798 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
4799 the kbd_buffer can really hold. That may prevent loss
4800 of characters on some systems when input is stuffed at us. */
4801 unsigned char cbuf[KBD_BUFFER_SIZE - 1];
4802 int n_to_read;
4803
4804 /* Determine how many characters we should *try* to read. */
4805 #ifdef WINDOWSNT
4806 return 0;
4807 #else /* not WINDOWSNT */
4808 #ifdef MSDOS
4809 n_to_read = dos_keysns ();
4810 if (n_to_read == 0)
4811 return 0;
4812 #else /* not MSDOS */
4813 #ifdef FIONREAD
4814 /* Find out how much input is available. */
4815 if (ioctl (input_fd, FIONREAD, &n_to_read) < 0)
4816 /* Formerly simply reported no input, but that sometimes led to
4817 a failure of Emacs to terminate.
4818 SIGHUP seems appropriate if we can't reach the terminal. */
4819 /* ??? Is it really right to send the signal just to this process
4820 rather than to the whole process group?
4821 Perhaps on systems with FIONREAD Emacs is alone in its group. */
4822 kill (getpid (), SIGHUP);
4823 if (n_to_read == 0)
4824 return 0;
4825 if (n_to_read > sizeof cbuf)
4826 n_to_read = sizeof cbuf;
4827 #else /* no FIONREAD */
4828 #if defined (USG) || defined (DGUX)
4829 /* Read some input if available, but don't wait. */
4830 n_to_read = sizeof cbuf;
4831 fcntl (input_fd, F_SETFL, O_NDELAY);
4832 #else
4833 you lose;
4834 #endif
4835 #endif
4836 #endif /* not MSDOS */
4837 #endif /* not WINDOWSNT */
4838
4839 /* Now read; for one reason or another, this will not block.
4840 NREAD is set to the number of chars read. */
4841 do
4842 {
4843 #ifdef MSDOS
4844 cbuf[0] = dos_keyread ();
4845 nread = 1;
4846 #else
4847 nread = read (input_fd, cbuf, n_to_read);
4848 #endif
4849 #if defined (AIX) && (! defined (aix386) && defined (_BSD))
4850 /* The kernel sometimes fails to deliver SIGHUP for ptys.
4851 This looks incorrect, but it isn't, because _BSD causes
4852 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
4853 and that causes a value other than 0 when there is no input. */
4854 if (nread == 0)
4855 kill (0, SIGHUP);
4856 #endif
4857 }
4858 while (
4859 /* We used to retry the read if it was interrupted.
4860 But this does the wrong thing when O_NDELAY causes
4861 an EAGAIN error. Does anybody know of a situation
4862 where a retry is actually needed? */
4863 #if 0
4864 nread < 0 && (errno == EAGAIN
4865 #ifdef EFAULT
4866 || errno == EFAULT
4867 #endif
4868 #ifdef EBADSLT
4869 || errno == EBADSLT
4870 #endif
4871 )
4872 #else
4873 0
4874 #endif
4875 );
4876
4877 #ifndef FIONREAD
4878 #if defined (USG) || defined (DGUX)
4879 fcntl (input_fd, F_SETFL, 0);
4880 #endif /* USG or DGUX */
4881 #endif /* no FIONREAD */
4882 for (i = 0; i < nread; i++)
4883 {
4884 buf[i].kind = ascii_keystroke;
4885 buf[i].modifiers = 0;
4886 if (meta_key == 1 && (cbuf[i] & 0x80))
4887 buf[i].modifiers = meta_modifier;
4888 if (meta_key != 2)
4889 cbuf[i] &= ~0x80;
4890
4891 buf[i].code = cbuf[i];
4892 #ifdef MULTI_FRAME
4893 XSETFRAME (buf[i].frame_or_window, selected_frame);
4894 #else
4895 buf[i].frame_or_window = Qnil;
4896 #endif
4897 }
4898 }
4899
4900 /* Scan the chars for C-g and store them in kbd_buffer. */
4901 for (i = 0; i < nread; i++)
4902 {
4903 kbd_buffer_store_event (&buf[i]);
4904 /* Don't look at input that follows a C-g too closely.
4905 This reduces lossage due to autorepeat on C-g. */
4906 if (buf[i].kind == ascii_keystroke
4907 && buf[i].code == quit_char)
4908 break;
4909 }
4910
4911 return nread;
4912 }
4913 #endif /* not VMS */
4914 \f
4915 #ifdef SIGIO /* for entire page */
4916 /* Note SIGIO has been undef'd if FIONREAD is missing. */
4917
4918 SIGTYPE
4919 input_available_signal (signo)
4920 int signo;
4921 {
4922 /* Must preserve main program's value of errno. */
4923 int old_errno = errno;
4924 #ifdef BSD4_1
4925 extern int select_alarmed;
4926 #endif
4927
4928 #ifdef USG
4929 /* USG systems forget handlers when they are used;
4930 must reestablish each time */
4931 signal (signo, input_available_signal);
4932 #endif /* USG */
4933
4934 #ifdef BSD4_1
4935 sigisheld (SIGIO);
4936 #endif
4937
4938 if (input_available_clear_time)
4939 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
4940
4941 while (1)
4942 {
4943 int nread;
4944 nread = read_avail_input (1);
4945 /* -1 means it's not ok to read the input now.
4946 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
4947 0 means there was no keyboard input available. */
4948 if (nread <= 0)
4949 break;
4950
4951 #ifdef BSD4_1
4952 select_alarmed = 1; /* Force the select emulator back to life */
4953 #endif
4954 }
4955
4956 #ifdef BSD4_1
4957 sigfree ();
4958 #endif
4959 errno = old_errno;
4960 }
4961 #endif /* SIGIO */
4962
4963 /* Send ourselves a SIGIO.
4964
4965 This function exists so that the UNBLOCK_INPUT macro in
4966 blockinput.h can have some way to take care of input we put off
4967 dealing with, without assuming that every file which uses
4968 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
4969 void
4970 reinvoke_input_signal ()
4971 {
4972 #ifdef SIGIO
4973 kill (getpid (), SIGIO);
4974 #endif
4975 }
4976
4977
4978 \f
4979 /* Return the prompt-string of a sparse keymap.
4980 This is the first element which is a string.
4981 Return nil if there is none. */
4982
4983 Lisp_Object
4984 map_prompt (map)
4985 Lisp_Object map;
4986 {
4987 while (CONSP (map))
4988 {
4989 register Lisp_Object tem;
4990 tem = Fcar (map);
4991 if (STRINGP (tem))
4992 return tem;
4993 map = Fcdr (map);
4994 }
4995 return Qnil;
4996 }
4997
4998 static void menu_bar_item ();
4999 static void menu_bar_one_keymap ();
5000
5001 /* These variables hold the vector under construction within
5002 menu_bar_items and its subroutines, and the current index
5003 for storing into that vector. */
5004 static Lisp_Object menu_bar_items_vector;
5005 static int menu_bar_items_index;
5006
5007 /* Return a vector of menu items for a menu bar, appropriate
5008 to the current buffer. Each item has three elements in the vector:
5009 KEY STRING MAPLIST.
5010
5011 OLD is an old vector we can optionally reuse, or nil. */
5012
5013 Lisp_Object
5014 menu_bar_items (old)
5015 Lisp_Object old;
5016 {
5017 /* The number of keymaps we're scanning right now, and the number of
5018 keymaps we have allocated space for. */
5019 int nmaps;
5020
5021 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
5022 in the current keymaps, or nil where it is not a prefix. */
5023 Lisp_Object *maps;
5024
5025 Lisp_Object def, tem, tail;
5026
5027 Lisp_Object result;
5028
5029 int mapno;
5030 Lisp_Object oquit;
5031
5032 int i;
5033
5034 struct gcpro gcpro1;
5035
5036 /* In order to build the menus, we need to call the keymap
5037 accessors. They all call QUIT. But this function is called
5038 during redisplay, during which a quit is fatal. So inhibit
5039 quitting while building the menus.
5040 We do this instead of specbind because (1) errors will clear it anyway
5041 and (2) this avoids risk of specpdl overflow. */
5042 oquit = Vinhibit_quit;
5043 Vinhibit_quit = Qt;
5044
5045 if (!NILP (old))
5046 menu_bar_items_vector = old;
5047 else
5048 menu_bar_items_vector = Fmake_vector (make_number (24), Qnil);
5049 menu_bar_items_index = 0;
5050
5051 GCPRO1 (menu_bar_items_vector);
5052
5053 /* Build our list of keymaps.
5054 If we recognize a function key and replace its escape sequence in
5055 keybuf with its symbol, or if the sequence starts with a mouse
5056 click and we need to switch buffers, we jump back here to rebuild
5057 the initial keymaps from the current buffer. */
5058 {
5059 Lisp_Object *tmaps;
5060
5061 /* Should overriding-terminal-local-map and overriding-local-map apply? */
5062 if (!NILP (Voverriding_local_map_menu_flag))
5063 {
5064 /* Yes, use them (if non-nil) as well as the global map. */
5065 maps = (Lisp_Object *) alloca (3 * sizeof (maps[0]));
5066 nmaps = 0;
5067 if (!NILP (current_kboard->Voverriding_terminal_local_map))
5068 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
5069 if (!NILP (Voverriding_local_map))
5070 maps[nmaps++] = Voverriding_local_map;
5071 }
5072 else
5073 {
5074 /* No, so use major and minor mode keymaps. */
5075 nmaps = current_minor_maps (NULL, &tmaps);
5076 maps = (Lisp_Object *) alloca ((nmaps + 2) * sizeof (maps[0]));
5077 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
5078 #ifdef USE_TEXT_PROPERTIES
5079 maps[nmaps++] = get_local_map (PT, current_buffer);
5080 #else
5081 maps[nmaps++] = current_buffer->keymap;
5082 #endif
5083 }
5084 maps[nmaps++] = current_global_map;
5085 }
5086
5087 /* Look up in each map the dummy prefix key `menu-bar'. */
5088
5089 result = Qnil;
5090
5091 for (mapno = nmaps - 1; mapno >= 0; mapno--)
5092 {
5093 if (! NILP (maps[mapno]))
5094 def = get_keyelt (access_keymap (maps[mapno], Qmenu_bar, 1, 0));
5095 else
5096 def = Qnil;
5097
5098 tem = Fkeymapp (def);
5099 if (!NILP (tem))
5100 menu_bar_one_keymap (def);
5101 }
5102
5103 /* Move to the end those items that should be at the end. */
5104
5105 for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCONS (tail)->cdr)
5106 {
5107 int i;
5108 int end = menu_bar_items_index;
5109
5110 for (i = 0; i < end; i += 4)
5111 if (EQ (XCONS (tail)->car, XVECTOR (menu_bar_items_vector)->contents[i]))
5112 {
5113 Lisp_Object tem0, tem1, tem2, tem3;
5114 /* Move the item at index I to the end,
5115 shifting all the others forward. */
5116 tem0 = XVECTOR (menu_bar_items_vector)->contents[i + 0];
5117 tem1 = XVECTOR (menu_bar_items_vector)->contents[i + 1];
5118 tem2 = XVECTOR (menu_bar_items_vector)->contents[i + 2];
5119 tem3 = XVECTOR (menu_bar_items_vector)->contents[i + 3];
5120 if (end > i + 4)
5121 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
5122 &XVECTOR (menu_bar_items_vector)->contents[i],
5123 (end - i - 4) * sizeof (Lisp_Object));
5124 XVECTOR (menu_bar_items_vector)->contents[end - 4] = tem0;
5125 XVECTOR (menu_bar_items_vector)->contents[end - 3] = tem1;
5126 XVECTOR (menu_bar_items_vector)->contents[end - 2] = tem2;
5127 XVECTOR (menu_bar_items_vector)->contents[end - 1] = tem3;
5128 break;
5129 }
5130 }
5131
5132 /* Add nil, nil, nil at the end. */
5133 i = menu_bar_items_index;
5134 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
5135 {
5136 Lisp_Object tem;
5137 int newsize = 2 * i;
5138 tem = Fmake_vector (make_number (2 * i), Qnil);
5139 bcopy (XVECTOR (menu_bar_items_vector)->contents,
5140 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
5141 menu_bar_items_vector = tem;
5142 }
5143 /* Add this item. */
5144 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
5145 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
5146 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
5147 XVECTOR (menu_bar_items_vector)->contents[i++] = Qnil;
5148 menu_bar_items_index = i;
5149
5150 Vinhibit_quit = oquit;
5151 UNGCPRO;
5152 return menu_bar_items_vector;
5153 }
5154 \f
5155 /* Scan one map KEYMAP, accumulating any menu items it defines
5156 in menu_bar_items_vector. */
5157
5158 static void
5159 menu_bar_one_keymap (keymap)
5160 Lisp_Object keymap;
5161 {
5162 Lisp_Object tail, item, key, binding, item_string, table;
5163
5164 /* Loop over all keymap entries that have menu strings. */
5165 for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr)
5166 {
5167 item = XCONS (tail)->car;
5168 if (CONSP (item))
5169 {
5170 key = XCONS (item)->car;
5171 binding = XCONS (item)->cdr;
5172 if (CONSP (binding))
5173 {
5174 item_string = XCONS (binding)->car;
5175 if (STRINGP (item_string))
5176 menu_bar_item (key, item_string, Fcdr (binding));
5177 }
5178 else if (EQ (binding, Qundefined))
5179 menu_bar_item (key, Qnil, binding);
5180 }
5181 else if (VECTORP (item))
5182 {
5183 /* Loop over the char values represented in the vector. */
5184 int len = XVECTOR (item)->size;
5185 int c;
5186 for (c = 0; c < len; c++)
5187 {
5188 Lisp_Object character;
5189 XSETFASTINT (character, c);
5190 binding = XVECTOR (item)->contents[c];
5191 if (CONSP (binding))
5192 {
5193 item_string = XCONS (binding)->car;
5194 if (STRINGP (item_string))
5195 menu_bar_item (key, item_string, Fcdr (binding));
5196 }
5197 else if (EQ (binding, Qundefined))
5198 menu_bar_item (key, Qnil, binding);
5199 }
5200 }
5201 }
5202 }
5203
5204 /* This is used as the handler when calling internal_condition_case_1. */
5205
5206 static Lisp_Object
5207 menu_bar_item_1 (arg)
5208 Lisp_Object arg;
5209 {
5210 return Qnil;
5211 }
5212
5213 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
5214 If there's already an item for KEY, add this DEF to it. */
5215
5216 static void
5217 menu_bar_item (key, item_string, def)
5218 Lisp_Object key, item_string, def;
5219 {
5220 Lisp_Object tem;
5221 Lisp_Object enabled;
5222 int i;
5223
5224 if (EQ (def, Qundefined))
5225 {
5226 /* If a map has an explicit `undefined' as definition,
5227 discard any previously made menu bar item. */
5228
5229 for (i = 0; i < menu_bar_items_index; i += 4)
5230 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
5231 {
5232 if (menu_bar_items_index > i + 4)
5233 bcopy (&XVECTOR (menu_bar_items_vector)->contents[i + 4],
5234 &XVECTOR (menu_bar_items_vector)->contents[i],
5235 (menu_bar_items_index - i - 4) * sizeof (Lisp_Object));
5236 menu_bar_items_index -= 4;
5237 return;
5238 }
5239
5240 /* If there's no definition for this key yet,
5241 just ignore `undefined'. */
5242 return;
5243 }
5244
5245 /* See if this entry is enabled. */
5246 enabled = Qt;
5247
5248 if (SYMBOLP (def))
5249 {
5250 /* No property, or nil, means enable.
5251 Otherwise, enable if value is not nil. */
5252 tem = Fget (def, Qmenu_enable);
5253 if (!NILP (tem))
5254 /* (condition-case nil (eval tem)
5255 (error nil)) */
5256 enabled = internal_condition_case_1 (Feval, tem, Qerror,
5257 menu_bar_item_1);
5258 }
5259
5260 /* Ignore this item if it's not enabled. */
5261 if (NILP (enabled))
5262 return;
5263
5264 /* Find any existing item for this KEY. */
5265 for (i = 0; i < menu_bar_items_index; i += 4)
5266 if (EQ (key, XVECTOR (menu_bar_items_vector)->contents[i]))
5267 break;
5268
5269 /* If we did not find this KEY, add it at the end. */
5270 if (i == menu_bar_items_index)
5271 {
5272 /* If vector is too small, get a bigger one. */
5273 if (i + 4 > XVECTOR (menu_bar_items_vector)->size)
5274 {
5275 Lisp_Object tem;
5276 int newsize = 2 * i;
5277 tem = Fmake_vector (make_number (2 * i), Qnil);
5278 bcopy (XVECTOR (menu_bar_items_vector)->contents,
5279 XVECTOR (tem)->contents, i * sizeof (Lisp_Object));
5280 menu_bar_items_vector = tem;
5281 }
5282 /* Add this item. */
5283 XVECTOR (menu_bar_items_vector)->contents[i++] = key;
5284 XVECTOR (menu_bar_items_vector)->contents[i++] = item_string;
5285 XVECTOR (menu_bar_items_vector)->contents[i++] = Fcons (def, Qnil);
5286 XVECTOR (menu_bar_items_vector)->contents[i++] = make_number (0);
5287 menu_bar_items_index = i;
5288 }
5289 /* We did find an item for this KEY. Add DEF to its list of maps. */
5290 else
5291 {
5292 Lisp_Object old;
5293 old = XVECTOR (menu_bar_items_vector)->contents[i + 2];
5294 XVECTOR (menu_bar_items_vector)->contents[i + 2] = Fcons (def, old);
5295 }
5296 }
5297 \f
5298 /* Read a character using menus based on maps in the array MAPS.
5299 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
5300 Return t if we displayed a menu but the user rejected it.
5301
5302 PREV_EVENT is the previous input event, or nil if we are reading
5303 the first event of a key sequence.
5304
5305 If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1
5306 if we used a mouse menu to read the input, or zero otherwise. If
5307 USED_MOUSE_MENU is null, we don't dereference it.
5308
5309 The prompting is done based on the prompt-string of the map
5310 and the strings associated with various map elements.
5311
5312 This can be done with X menus or with menus put in the minibuf.
5313 These are done in different ways, depending on how the input will be read.
5314 Menus using X are done after auto-saving in read-char, getting the input
5315 event from Fx_popup_menu; menus using the minibuf use read_char recursively
5316 and do auto-saving in the inner call of read_char. */
5317
5318 static Lisp_Object
5319 read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
5320 int nmaps;
5321 Lisp_Object *maps;
5322 Lisp_Object prev_event;
5323 int *used_mouse_menu;
5324 {
5325 int mapno;
5326 register Lisp_Object name;
5327 Lisp_Object rest, vector;
5328
5329 if (used_mouse_menu)
5330 *used_mouse_menu = 0;
5331
5332 /* Use local over global Menu maps */
5333
5334 if (! menu_prompting)
5335 return Qnil;
5336
5337 /* Optionally disregard all but the global map. */
5338 if (inhibit_local_menu_bar_menus)
5339 {
5340 maps += (nmaps - 1);
5341 nmaps = 1;
5342 }
5343
5344 /* Get the menu name from the first map that has one (a prompt string). */
5345 for (mapno = 0; mapno < nmaps; mapno++)
5346 {
5347 name = map_prompt (maps[mapno]);
5348 if (!NILP (name))
5349 break;
5350 }
5351
5352 /* If we don't have any menus, just read a character normally. */
5353 if (mapno >= nmaps)
5354 return Qnil;
5355
5356 #ifdef HAVE_MENUS
5357 /* If we got to this point via a mouse click,
5358 use a real menu for mouse selection. */
5359 if (EVENT_HAS_PARAMETERS (prev_event)
5360 && !EQ (XCONS (prev_event)->car, Qmenu_bar))
5361 {
5362 /* Display the menu and get the selection. */
5363 Lisp_Object *realmaps
5364 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
5365 Lisp_Object value;
5366 int nmaps1 = 0;
5367
5368 /* Use the maps that are not nil. */
5369 for (mapno = 0; mapno < nmaps; mapno++)
5370 if (!NILP (maps[mapno]))
5371 realmaps[nmaps1++] = maps[mapno];
5372
5373 value = Fx_popup_menu (prev_event, Flist (nmaps1, realmaps));
5374 if (CONSP (value))
5375 {
5376 Lisp_Object tem;
5377
5378 /* If we got multiple events, unread all but
5379 the first.
5380 There is no way to prevent those unread events
5381 from showing up later in last_nonmenu_event.
5382 So turn symbol and integer events into lists,
5383 to indicate that they came from a mouse menu,
5384 so that when present in last_nonmenu_event
5385 they won't confuse things. */
5386 for (tem = XCONS (value)->cdr; !NILP (tem);
5387 tem = XCONS (tem)->cdr)
5388 if (SYMBOLP (XCONS (tem)->car)
5389 || INTEGERP (XCONS (tem)->car))
5390 XCONS (tem)->car
5391 = Fcons (XCONS (tem)->car, Qnil);
5392
5393 /* If we got more than one event, put all but the first
5394 onto this list to be read later.
5395 Return just the first event now. */
5396 Vunread_command_events
5397 = nconc2 (XCONS (value)->cdr, Vunread_command_events);
5398 value = XCONS (value)->car;
5399 }
5400 else if (NILP (value))
5401 value = Qt;
5402 if (used_mouse_menu)
5403 *used_mouse_menu = 1;
5404 return value;
5405 }
5406 #endif /* HAVE_MENUS */
5407 return Qnil ;
5408 }
5409
5410 /* Buffer in use so far for the minibuf prompts for menu keymaps.
5411 We make this bigger when necessary, and never free it. */
5412 static char *read_char_minibuf_menu_text;
5413 /* Size of that buffer. */
5414 static int read_char_minibuf_menu_width;
5415
5416 static Lisp_Object
5417 read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
5418 int commandflag ;
5419 int nmaps;
5420 Lisp_Object *maps;
5421 {
5422 int mapno;
5423 register Lisp_Object name;
5424 int nlength;
5425 int width = FRAME_WIDTH (selected_frame) - 4;
5426 int idx = -1;
5427 int nobindings = 1;
5428 Lisp_Object rest, vector;
5429 char *menu;
5430
5431 if (! menu_prompting)
5432 return Qnil;
5433
5434 /* Make sure we have a big enough buffer for the menu text. */
5435 if (read_char_minibuf_menu_text == 0)
5436 {
5437 read_char_minibuf_menu_width = width + 4;
5438 read_char_minibuf_menu_text = (char *) xmalloc (width + 4);
5439 }
5440 else if (width + 4 > read_char_minibuf_menu_width)
5441 {
5442 read_char_minibuf_menu_width = width + 4;
5443 read_char_minibuf_menu_text
5444 = (char *) xrealloc (read_char_minibuf_menu_text, width + 4);
5445 }
5446 menu = read_char_minibuf_menu_text;
5447
5448 /* Get the menu name from the first map that has one (a prompt string). */
5449 for (mapno = 0; mapno < nmaps; mapno++)
5450 {
5451 name = map_prompt (maps[mapno]);
5452 if (!NILP (name))
5453 break;
5454 }
5455
5456 /* If we don't have any menus, just read a character normally. */
5457 if (mapno >= nmaps)
5458 return Qnil;
5459
5460 /* Prompt string always starts with map's prompt, and a space. */
5461 strcpy (menu, XSTRING (name)->data);
5462 nlength = XSTRING (name)->size;
5463 menu[nlength++] = ':';
5464 menu[nlength++] = ' ';
5465 menu[nlength] = 0;
5466
5467 /* Start prompting at start of first map. */
5468 mapno = 0;
5469 rest = maps[mapno];
5470
5471 /* Present the documented bindings, a line at a time. */
5472 while (1)
5473 {
5474 int notfirst = 0;
5475 int i = nlength;
5476 Lisp_Object obj;
5477 int ch;
5478 Lisp_Object orig_defn_macro;
5479
5480 /* Loop over elements of map. */
5481 while (i < width)
5482 {
5483 Lisp_Object s, elt;
5484
5485 /* If reached end of map, start at beginning of next map. */
5486 if (NILP (rest))
5487 {
5488 mapno++;
5489 /* At end of last map, wrap around to first map if just starting,
5490 or end this line if already have something on it. */
5491 if (mapno == nmaps)
5492 {
5493 mapno = 0;
5494 if (notfirst || nobindings) break;
5495 }
5496 rest = maps[mapno];
5497 }
5498
5499 /* Look at the next element of the map. */
5500 if (idx >= 0)
5501 elt = XVECTOR (vector)->contents[idx];
5502 else
5503 elt = Fcar_safe (rest);
5504
5505 if (idx < 0 && VECTORP (elt))
5506 {
5507 /* If we found a dense table in the keymap,
5508 advanced past it, but start scanning its contents. */
5509 rest = Fcdr_safe (rest);
5510 vector = elt;
5511 idx = 0;
5512 }
5513 else
5514 {
5515 /* An ordinary element. */
5516 Lisp_Object event;
5517
5518 if (idx < 0)
5519 {
5520 s = Fcar_safe (Fcdr_safe (elt)); /* alist */
5521 event = Fcar_safe (elt);
5522 }
5523 else
5524 {
5525 s = Fcar_safe (elt); /* vector */
5526 XSETINT (event, idx);
5527 }
5528
5529 /* Ignore the element if it has no prompt string. */
5530 if (STRINGP (s) && INTEGERP (event))
5531 {
5532 /* 1 if the char to type matches the string. */
5533 int char_matches;
5534 Lisp_Object upcased_event, downcased_event;
5535 Lisp_Object desc;
5536
5537 upcased_event = Fupcase (event);
5538 downcased_event = Fdowncase (event);
5539 char_matches = (XINT (upcased_event) == XSTRING (s)->data[0]
5540 || XINT (downcased_event) == XSTRING (s)->data[0]);
5541 if (! char_matches)
5542 desc = Fsingle_key_description (event);
5543
5544 /* If we have room for the prompt string, add it to this line.
5545 If this is the first on the line, always add it. */
5546 if ((XSTRING (s)->size + i + 2
5547 + (char_matches ? 0 : XSTRING (desc)->size + 3))
5548 < width
5549 || !notfirst)
5550 {
5551 int thiswidth;
5552
5553 /* Punctuate between strings. */
5554 if (notfirst)
5555 {
5556 strcpy (menu + i, ", ");
5557 i += 2;
5558 }
5559 notfirst = 1;
5560 nobindings = 0 ;
5561
5562 /* If the char to type doesn't match the string's
5563 first char, explicitly show what char to type. */
5564 if (! char_matches)
5565 {
5566 /* Add as much of string as fits. */
5567 thiswidth = XSTRING (desc)->size;
5568 if (thiswidth + i > width)
5569 thiswidth = width - i;
5570 bcopy (XSTRING (desc)->data, menu + i, thiswidth);
5571 i += thiswidth;
5572 strcpy (menu + i, " = ");
5573 i += 3;
5574 }
5575
5576 /* Add as much of string as fits. */
5577 thiswidth = XSTRING (s)->size;
5578 if (thiswidth + i > width)
5579 thiswidth = width - i;
5580 bcopy (XSTRING (s)->data, menu + i, thiswidth);
5581 i += thiswidth;
5582 menu[i] = 0;
5583 }
5584 else
5585 {
5586 /* If this element does not fit, end the line now,
5587 and save the element for the next line. */
5588 strcpy (menu + i, "...");
5589 break;
5590 }
5591 }
5592
5593 /* Move past this element. */
5594 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
5595 /* Handle reaching end of dense table. */
5596 idx = -1;
5597 if (idx >= 0)
5598 idx++;
5599 else
5600 rest = Fcdr_safe (rest);
5601 }
5602 }
5603
5604 /* Prompt with that and read response. */
5605 message1 (menu);
5606
5607 /* Make believe its not a keyboard macro in case the help char
5608 is pressed. Help characters are not recorded because menu prompting
5609 is not used on replay.
5610 */
5611 orig_defn_macro = current_kboard->defining_kbd_macro;
5612 current_kboard->defining_kbd_macro = Qnil;
5613 do
5614 obj = read_char (commandflag, 0, 0, Qnil, 0);
5615 while (BUFFERP (obj));
5616 current_kboard->defining_kbd_macro = orig_defn_macro;
5617
5618 if (!INTEGERP (obj))
5619 return obj;
5620 else
5621 ch = XINT (obj);
5622
5623 if (! EQ (obj, menu_prompt_more_char)
5624 && (!INTEGERP (menu_prompt_more_char)
5625 || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char))))))
5626 {
5627 if (!NILP (current_kboard->defining_kbd_macro))
5628 store_kbd_macro_char (obj);
5629 return obj;
5630 }
5631 /* Help char - go round again */
5632 }
5633 }
5634 \f
5635 /* Reading key sequences. */
5636
5637 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
5638 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
5639 keymap, or nil otherwise. Return the index of the first keymap in
5640 which KEY has any binding, or NMAPS if no map has a binding.
5641
5642 If KEY is a meta ASCII character, treat it like meta-prefix-char
5643 followed by the corresponding non-meta character. Keymaps in
5644 CURRENT with non-prefix bindings for meta-prefix-char become nil in
5645 NEXT.
5646
5647 If KEY has no bindings in any of the CURRENT maps, NEXT is left
5648 unmodified.
5649
5650 NEXT may be the same array as CURRENT. */
5651
5652 static int
5653 follow_key (key, nmaps, current, defs, next)
5654 Lisp_Object key;
5655 Lisp_Object *current, *defs, *next;
5656 int nmaps;
5657 {
5658 int i, first_binding;
5659 int did_meta = 0;
5660
5661 /* If KEY is a meta ASCII character, treat it like meta-prefix-char
5662 followed by the corresponding non-meta character.
5663 Put the results into DEFS, since we are going to alter that anyway.
5664 Do not alter CURRENT or NEXT. */
5665 if (INTEGERP (key) && (XINT (key) & CHAR_META))
5666 {
5667 for (i = 0; i < nmaps; i++)
5668 if (! NILP (current[i]))
5669 {
5670 Lisp_Object def;
5671 def = get_keyelt (access_keymap (current[i],
5672 meta_prefix_char, 1, 0));
5673
5674 /* Note that since we pass the resulting bindings through
5675 get_keymap_1, non-prefix bindings for meta-prefix-char
5676 disappear. */
5677 defs[i] = get_keymap_1 (def, 0, 1);
5678 }
5679 else
5680 defs[i] = Qnil;
5681
5682 did_meta = 1;
5683 XSETINT (key, XFASTINT (key) & ~CHAR_META);
5684 }
5685
5686 first_binding = nmaps;
5687 for (i = nmaps - 1; i >= 0; i--)
5688 {
5689 if (! NILP (current[i]))
5690 {
5691 Lisp_Object map;
5692 if (did_meta)
5693 map = defs[i];
5694 else
5695 map = current[i];
5696
5697 defs[i] = get_keyelt (access_keymap (map, key, 1, 0));
5698 if (! NILP (defs[i]))
5699 first_binding = i;
5700 }
5701 else
5702 defs[i] = Qnil;
5703 }
5704
5705 /* Given the set of bindings we've found, produce the next set of maps. */
5706 if (first_binding < nmaps)
5707 for (i = 0; i < nmaps; i++)
5708 next[i] = NILP (defs[i]) ? Qnil : get_keymap_1 (defs[i], 0, 1);
5709
5710 return first_binding;
5711 }
5712
5713 /* Read a sequence of keys that ends with a non prefix character,
5714 storing it in KEYBUF, a buffer of size BUFSIZE.
5715 Prompt with PROMPT.
5716 Return the length of the key sequence stored.
5717 Return -1 if the user rejected a command menu.
5718
5719 Echo starting immediately unless `prompt' is 0.
5720
5721 Where a key sequence ends depends on the currently active keymaps.
5722 These include any minor mode keymaps active in the current buffer,
5723 the current buffer's local map, and the global map.
5724
5725 If a key sequence has no other bindings, we check Vfunction_key_map
5726 to see if some trailing subsequence might be the beginning of a
5727 function key's sequence. If so, we try to read the whole function
5728 key, and substitute its symbolic name into the key sequence.
5729
5730 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
5731 `double-' events into similar click events, if that would make them
5732 bound. We try to turn `triple-' events first into `double-' events,
5733 then into clicks.
5734
5735 If we get a mouse click in a mode line, vertical divider, or other
5736 non-text area, we treat the click as if it were prefixed by the
5737 symbol denoting that area - `mode-line', `vertical-line', or
5738 whatever.
5739
5740 If the sequence starts with a mouse click, we read the key sequence
5741 with respect to the buffer clicked on, not the current buffer.
5742
5743 If the user switches frames in the midst of a key sequence, we put
5744 off the switch-frame event until later; the next call to
5745 read_char will return it. */
5746
5747 static int
5748 read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
5749 can_return_switch_frame)
5750 Lisp_Object *keybuf;
5751 int bufsize;
5752 Lisp_Object prompt;
5753 int dont_downcase_last;
5754 int can_return_switch_frame;
5755 {
5756 int count = specpdl_ptr - specpdl;
5757
5758 /* How many keys there are in the current key sequence. */
5759 int t;
5760
5761 /* The length of the echo buffer when we started reading, and
5762 the length of this_command_keys when we started reading. */
5763 int echo_start;
5764 int keys_start;
5765
5766 /* The number of keymaps we're scanning right now, and the number of
5767 keymaps we have allocated space for. */
5768 int nmaps;
5769 int nmaps_allocated = 0;
5770
5771 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
5772 the current keymaps. */
5773 Lisp_Object *defs;
5774
5775 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
5776 in the current keymaps, or nil where it is not a prefix. */
5777 Lisp_Object *submaps;
5778
5779 /* The local map to start out with at start of key sequence. */
5780 Lisp_Object orig_local_map;
5781
5782 /* 1 if we have already considered switching to the local-map property
5783 of the place where a mouse click occurred. */
5784 int localized_local_map = 0;
5785
5786 /* The index in defs[] of the first keymap that has a binding for
5787 this key sequence. In other words, the lowest i such that
5788 defs[i] is non-nil. */
5789 int first_binding;
5790
5791 /* If t < mock_input, then KEYBUF[t] should be read as the next
5792 input key.
5793
5794 We use this to recover after recognizing a function key. Once we
5795 realize that a suffix of the current key sequence is actually a
5796 function key's escape sequence, we replace the suffix with the
5797 function key's binding from Vfunction_key_map. Now keybuf
5798 contains a new and different key sequence, so the echo area,
5799 this_command_keys, and the submaps and defs arrays are wrong. In
5800 this situation, we set mock_input to t, set t to 0, and jump to
5801 restart_sequence; the loop will read keys from keybuf up until
5802 mock_input, thus rebuilding the state; and then it will resume
5803 reading characters from the keyboard. */
5804 int mock_input = 0;
5805
5806 /* If the sequence is unbound in submaps[], then
5807 keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map,
5808 and fkey_map is its binding.
5809
5810 These might be > t, indicating that all function key scanning
5811 should hold off until t reaches them. We do this when we've just
5812 recognized a function key, to avoid searching for the function
5813 key's again in Vfunction_key_map. */
5814 int fkey_start = 0, fkey_end = 0;
5815 Lisp_Object fkey_map;
5816
5817 /* Likewise, for key_translation_map. */
5818 int keytran_start = 0, keytran_end = 0;
5819 Lisp_Object keytran_map;
5820
5821 /* If we receive a ``switch-frame'' event in the middle of a key sequence,
5822 we put it off for later. While we're reading, we keep the event here. */
5823 Lisp_Object delayed_switch_frame;
5824
5825 /* See the comment below... */
5826 #if defined (GOBBLE_FIRST_EVENT)
5827 Lisp_Object first_event;
5828 #endif
5829
5830 Lisp_Object original_uppercase;
5831 int original_uppercase_position = -1;
5832
5833 /* Gets around Microsoft compiler limitations. */
5834 int dummyflag = 0;
5835
5836 struct buffer *starting_buffer;
5837
5838 /* Nonzero if we seem to have got the beginning of a binding
5839 in function_key_map. */
5840 int function_key_possible = 0;
5841 int key_translation_possible = 0;
5842
5843 /* Save the status of key translation before each step,
5844 so that we can restore this after downcasing. */
5845 Lisp_Object prev_fkey_map;
5846 Lisp_Object prev_fkey_start;
5847 Lisp_Object prev_fkey_end;
5848
5849 Lisp_Object prev_keytran_map;
5850 Lisp_Object prev_keytran_start;
5851 Lisp_Object prev_keytran_end;
5852
5853 int junk;
5854
5855 last_nonmenu_event = Qnil;
5856
5857 delayed_switch_frame = Qnil;
5858 fkey_map = Vfunction_key_map;
5859 keytran_map = Vkey_translation_map;
5860
5861 /* If there is no function-key-map, turn off function key scanning. */
5862 if (NILP (Fkeymapp (Vfunction_key_map)))
5863 fkey_start = fkey_end = bufsize + 1;
5864
5865 /* If there is no key-translation-map, turn off scanning. */
5866 if (NILP (Fkeymapp (Vkey_translation_map)))
5867 keytran_start = keytran_end = bufsize + 1;
5868
5869 if (INTERACTIVE)
5870 {
5871 if (!NILP (prompt))
5872 echo_prompt (XSTRING (prompt)->data);
5873 else if (cursor_in_echo_area && echo_keystrokes)
5874 /* This doesn't put in a dash if the echo buffer is empty, so
5875 you don't always see a dash hanging out in the minibuffer. */
5876 echo_dash ();
5877 }
5878
5879 /* Record the initial state of the echo area and this_command_keys;
5880 we will need to restore them if we replay a key sequence. */
5881 if (INTERACTIVE)
5882 echo_start = echo_length ();
5883 keys_start = this_command_key_count;
5884 this_single_command_key_start = keys_start;
5885
5886 #if defined (GOBBLE_FIRST_EVENT)
5887 /* This doesn't quite work, because some of the things that read_char
5888 does cannot safely be bypassed. It seems too risky to try to make
5889 this work right. */
5890
5891 /* Read the first char of the sequence specially, before setting
5892 up any keymaps, in case a filter runs and switches buffers on us. */
5893 first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
5894 &junk);
5895 #endif /* GOBBLE_FIRST_EVENT */
5896
5897 orig_local_map = get_local_map (PT, current_buffer);
5898
5899 /* We jump here when the key sequence has been thoroughly changed, and
5900 we need to rescan it starting from the beginning. When we jump here,
5901 keybuf[0..mock_input] holds the sequence we should reread. */
5902 replay_sequence:
5903
5904 starting_buffer = current_buffer;
5905 function_key_possible = 0;
5906 key_translation_possible = 0;
5907
5908 /* Build our list of keymaps.
5909 If we recognize a function key and replace its escape sequence in
5910 keybuf with its symbol, or if the sequence starts with a mouse
5911 click and we need to switch buffers, we jump back here to rebuild
5912 the initial keymaps from the current buffer. */
5913 {
5914 Lisp_Object *maps;
5915
5916 if (!NILP (current_kboard->Voverriding_terminal_local_map)
5917 || !NILP (Voverriding_local_map))
5918 {
5919 if (3 > nmaps_allocated)
5920 {
5921 submaps = (Lisp_Object *) alloca (3 * sizeof (submaps[0]));
5922 defs = (Lisp_Object *) alloca (3 * sizeof (defs[0]));
5923 nmaps_allocated = 3;
5924 }
5925 nmaps = 0;
5926 if (!NILP (current_kboard->Voverriding_terminal_local_map))
5927 submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
5928 if (!NILP (Voverriding_local_map))
5929 submaps[nmaps++] = Voverriding_local_map;
5930 }
5931 else
5932 {
5933 nmaps = current_minor_maps (0, &maps);
5934 if (nmaps + 2 > nmaps_allocated)
5935 {
5936 submaps = (Lisp_Object *) alloca ((nmaps+2) * sizeof (submaps[0]));
5937 defs = (Lisp_Object *) alloca ((nmaps+2) * sizeof (defs[0]));
5938 nmaps_allocated = nmaps + 2;
5939 }
5940 bcopy (maps, submaps, nmaps * sizeof (submaps[0]));
5941 #ifdef USE_TEXT_PROPERTIES
5942 submaps[nmaps++] = orig_local_map;
5943 #else
5944 submaps[nmaps++] = current_buffer->keymap;
5945 #endif
5946 }
5947 submaps[nmaps++] = current_global_map;
5948 }
5949
5950 /* Find an accurate initial value for first_binding. */
5951 for (first_binding = 0; first_binding < nmaps; first_binding++)
5952 if (! NILP (submaps[first_binding]))
5953 break;
5954
5955 /* Start from the beginning in keybuf. */
5956 t = 0;
5957
5958 /* These are no-ops the first time through, but if we restart, they
5959 revert the echo area and this_command_keys to their original state. */
5960 this_command_key_count = keys_start;
5961 if (INTERACTIVE && t < mock_input)
5962 echo_truncate (echo_start);
5963
5964 /* If the best binding for the current key sequence is a keymap, or
5965 we may be looking at a function key's escape sequence, keep on
5966 reading. */
5967 while ((first_binding < nmaps && ! NILP (submaps[first_binding]))
5968 || (first_binding >= nmaps
5969 && fkey_start < t
5970 /* mock input is never part of a function key's sequence. */
5971 && mock_input <= fkey_start)
5972 || (first_binding >= nmaps
5973 && keytran_start < t && key_translation_possible)
5974 /* Don't return in the middle of a possible function key sequence,
5975 if the only bindings we found were via case conversion.
5976 Thus, if ESC O a has a function-key-map translation
5977 and ESC o has a binding, don't return after ESC O,
5978 so that we can translate ESC O plus the next character. */
5979 )
5980 {
5981 Lisp_Object key;
5982 int used_mouse_menu = 0;
5983
5984 /* Where the last real key started. If we need to throw away a
5985 key that has expanded into more than one element of keybuf
5986 (say, a mouse click on the mode line which is being treated
5987 as [mode-line (mouse-...)], then we backtrack to this point
5988 of keybuf. */
5989 int last_real_key_start;
5990
5991 /* These variables are analogous to echo_start and keys_start;
5992 while those allow us to restart the entire key sequence,
5993 echo_local_start and keys_local_start allow us to throw away
5994 just one key. */
5995 int echo_local_start, keys_local_start, local_first_binding;
5996
5997 if (t >= bufsize)
5998 error ("Key sequence too long");
5999
6000 if (INTERACTIVE)
6001 echo_local_start = echo_length ();
6002 keys_local_start = this_command_key_count;
6003 local_first_binding = first_binding;
6004
6005 replay_key:
6006 /* These are no-ops, unless we throw away a keystroke below and
6007 jumped back up to replay_key; in that case, these restore the
6008 variables to their original state, allowing us to replay the
6009 loop. */
6010 if (INTERACTIVE && t < mock_input)
6011 echo_truncate (echo_local_start);
6012 this_command_key_count = keys_local_start;
6013 first_binding = local_first_binding;
6014
6015 /* By default, assume each event is "real". */
6016 last_real_key_start = t;
6017
6018 /* Does mock_input indicate that we are re-reading a key sequence? */
6019 if (t < mock_input)
6020 {
6021 key = keybuf[t];
6022 add_command_key (key);
6023 if (echo_keystrokes)
6024 echo_char (key);
6025 }
6026
6027 /* If not, we should actually read a character. */
6028 else
6029 {
6030 struct buffer *buf = current_buffer;
6031
6032 {
6033 #ifdef MULTI_KBOARD
6034 KBOARD *interrupted_kboard = current_kboard;
6035 struct frame *interrupted_frame = selected_frame;
6036 if (setjmp (wrong_kboard_jmpbuf))
6037 {
6038 if (!NILP (delayed_switch_frame))
6039 {
6040 interrupted_kboard->kbd_queue
6041 = Fcons (delayed_switch_frame,
6042 interrupted_kboard->kbd_queue);
6043 delayed_switch_frame = Qnil;
6044 }
6045 while (t > 0)
6046 interrupted_kboard->kbd_queue
6047 = Fcons (keybuf[--t], interrupted_kboard->kbd_queue);
6048
6049 /* If the side queue is non-empty, ensure it begins with a
6050 switch-frame, so we'll replay it in the right context. */
6051 if (CONSP (interrupted_kboard->kbd_queue)
6052 && (key = XCONS (interrupted_kboard->kbd_queue)->car,
6053 !(EVENT_HAS_PARAMETERS (key)
6054 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)),
6055 Qswitch_frame))))
6056 {
6057 Lisp_Object frame;
6058 XSETFRAME (frame, interrupted_frame);
6059 interrupted_kboard->kbd_queue
6060 = Fcons (make_lispy_switch_frame (frame),
6061 interrupted_kboard->kbd_queue);
6062 }
6063 mock_input = 0;
6064 orig_local_map = get_local_map (PT, current_buffer);
6065 goto replay_sequence;
6066 }
6067 #endif
6068 key = read_char (NILP (prompt), nmaps, submaps, last_nonmenu_event,
6069 &used_mouse_menu);
6070 }
6071
6072 /* read_char returns t when it shows a menu and the user rejects it.
6073 Just return -1. */
6074 if (EQ (key, Qt))
6075 return -1;
6076
6077 /* read_char returns -1 at the end of a macro.
6078 Emacs 18 handles this by returning immediately with a
6079 zero, so that's what we'll do. */
6080 if (INTEGERP (key) && XINT (key) == -1)
6081 {
6082 t = 0;
6083 /* The Microsoft C compiler can't handle the goto that
6084 would go here. */
6085 dummyflag = 1;
6086 break;
6087 }
6088
6089 /* If the current buffer has been changed from under us, the
6090 keymap may have changed, so replay the sequence. */
6091 if (BUFFERP (key))
6092 {
6093 mock_input = t;
6094 orig_local_map = get_local_map (PT, current_buffer);
6095 goto replay_sequence;
6096 }
6097
6098 /* If we have a quit that was typed in another frame, and
6099 quit_throw_to_read_char switched buffers,
6100 replay to get the right keymap. */
6101 if (XINT (key) == quit_char && current_buffer != starting_buffer)
6102 {
6103 keybuf[t++] = key;
6104 mock_input = t;
6105 Vquit_flag = Qnil;
6106 orig_local_map = get_local_map (PT, current_buffer);
6107 goto replay_sequence;
6108 }
6109
6110 Vquit_flag = Qnil;
6111 }
6112
6113 /* Clicks in non-text areas get prefixed by the symbol
6114 in their CHAR-ADDRESS field. For example, a click on
6115 the mode line is prefixed by the symbol `mode-line'.
6116
6117 Furthermore, key sequences beginning with mouse clicks
6118 are read using the keymaps of the buffer clicked on, not
6119 the current buffer. So we may have to switch the buffer
6120 here.
6121
6122 When we turn one event into two events, we must make sure
6123 that neither of the two looks like the original--so that,
6124 if we replay the events, they won't be expanded again.
6125 If not for this, such reexpansion could happen either here
6126 or when user programs play with this-command-keys. */
6127 if (EVENT_HAS_PARAMETERS (key))
6128 {
6129 Lisp_Object kind;
6130
6131 kind = EVENT_HEAD_KIND (EVENT_HEAD (key));
6132 if (EQ (kind, Qmouse_click))
6133 {
6134 Lisp_Object window, posn;
6135
6136 window = POSN_WINDOW (EVENT_START (key));
6137 posn = POSN_BUFFER_POSN (EVENT_START (key));
6138 if (CONSP (posn))
6139 {
6140 /* We're looking at the second event of a
6141 sequence which we expanded before. Set
6142 last_real_key_start appropriately. */
6143 if (t > 0)
6144 last_real_key_start = t - 1;
6145 }
6146
6147 /* Key sequences beginning with mouse clicks are
6148 read using the keymaps in the buffer clicked on,
6149 not the current buffer. If we're at the
6150 beginning of a key sequence, switch buffers. */
6151 if (last_real_key_start == 0
6152 && WINDOWP (window)
6153 && BUFFERP (XWINDOW (window)->buffer)
6154 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
6155 {
6156 keybuf[t] = key;
6157 mock_input = t + 1;
6158
6159 /* Arrange to go back to the original buffer once we're
6160 done reading the key sequence. Note that we can't
6161 use save_excursion_{save,restore} here, because they
6162 save point as well as the current buffer; we don't
6163 want to save point, because redisplay may change it,
6164 to accommodate a Fset_window_start or something. We
6165 don't want to do this at the top of the function,
6166 because we may get input from a subprocess which
6167 wants to change the selected window and stuff (say,
6168 emacsclient). */
6169 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
6170
6171 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
6172 orig_local_map = get_local_map (PT, current_buffer);
6173 goto replay_sequence;
6174 }
6175 /* For a mouse click, get the local text-property keymap
6176 of the place clicked on, rather than point. */
6177 if (last_real_key_start == 0 && CONSP (XCONS (key)->cdr)
6178 && ! localized_local_map)
6179 {
6180 Lisp_Object map_here, start, pos;
6181
6182 localized_local_map = 1;
6183 start = EVENT_START (key);
6184 if (CONSP (start) && CONSP (XCONS (start)->cdr))
6185 {
6186 pos = POSN_BUFFER_POSN (start);
6187 if (INTEGERP (pos)
6188 && XINT (pos) >= BEG && XINT (pos) <= Z)
6189 {
6190 map_here = get_local_map (XINT (pos), current_buffer);
6191 if (!EQ (map_here, orig_local_map))
6192 {
6193 orig_local_map = map_here;
6194 keybuf[t] = key;
6195 mock_input = t + 1;
6196
6197 goto replay_sequence;
6198 }
6199 }
6200 }
6201 }
6202
6203 /* Expand mode-line and scroll-bar events into two events:
6204 use posn as a fake prefix key. */
6205 if (SYMBOLP (posn))
6206 {
6207 if (t + 1 >= bufsize)
6208 error ("Key sequence too long");
6209 keybuf[t] = posn;
6210 keybuf[t+1] = key;
6211 mock_input = t + 2;
6212
6213 /* Zap the position in key, so we know that we've
6214 expanded it, and don't try to do so again. */
6215 POSN_BUFFER_POSN (EVENT_START (key))
6216 = Fcons (posn, Qnil);
6217 goto replay_key;
6218 }
6219 }
6220 else if (EQ (kind, Qswitch_frame))
6221 {
6222 /* If we're at the beginning of a key sequence, and the caller
6223 says it's okay, go ahead and return this event. If we're
6224 in the midst of a key sequence, delay it until the end. */
6225 if (t > 0 || !can_return_switch_frame)
6226 {
6227 delayed_switch_frame = key;
6228 goto replay_key;
6229 }
6230 }
6231 else if (CONSP (XCONS (key)->cdr)
6232 && CONSP (EVENT_START (key))
6233 && CONSP (XCONS (EVENT_START (key))->cdr))
6234 {
6235 Lisp_Object posn;
6236
6237 posn = POSN_BUFFER_POSN (EVENT_START (key));
6238 /* Handle menu-bar events:
6239 insert the dummy prefix event `menu-bar'. */
6240 if (EQ (posn, Qmenu_bar))
6241 {
6242 if (t + 1 >= bufsize)
6243 error ("Key sequence too long");
6244 keybuf[t] = posn;
6245 keybuf[t+1] = key;
6246
6247 /* Zap the position in key, so we know that we've
6248 expanded it, and don't try to do so again. */
6249 POSN_BUFFER_POSN (EVENT_START (key))
6250 = Fcons (posn, Qnil);
6251
6252 mock_input = t + 2;
6253 goto replay_sequence;
6254 }
6255 else if (CONSP (posn))
6256 {
6257 /* We're looking at the second event of a
6258 sequence which we expanded before. Set
6259 last_real_key_start appropriately. */
6260 if (last_real_key_start == t && t > 0)
6261 last_real_key_start = t - 1;
6262 }
6263 }
6264 }
6265
6266 /* We have finally decided that KEY is something we might want
6267 to look up. */
6268 first_binding = (follow_key (key,
6269 nmaps - first_binding,
6270 submaps + first_binding,
6271 defs + first_binding,
6272 submaps + first_binding)
6273 + first_binding);
6274
6275 /* If KEY wasn't bound, we'll try some fallbacks. */
6276 if (first_binding >= nmaps)
6277 {
6278 Lisp_Object head;
6279
6280 head = EVENT_HEAD (key);
6281 if (help_char_p (head) && t > 0)
6282 {
6283 read_key_sequence_cmd = Vprefix_help_command;
6284 keybuf[t++] = key;
6285 last_nonmenu_event = key;
6286 /* The Microsoft C compiler can't handle the goto that
6287 would go here. */
6288 dummyflag = 1;
6289 break;
6290 }
6291
6292 if (SYMBOLP (head))
6293 {
6294 Lisp_Object breakdown;
6295 int modifiers;
6296
6297 breakdown = parse_modifiers (head);
6298 modifiers = XINT (XCONS (XCONS (breakdown)->cdr)->car);
6299 /* Attempt to reduce an unbound mouse event to a simpler
6300 event that is bound:
6301 Drags reduce to clicks.
6302 Double-clicks reduce to clicks.
6303 Triple-clicks reduce to double-clicks, then to clicks.
6304 Down-clicks are eliminated.
6305 Double-downs reduce to downs, then are eliminated.
6306 Triple-downs reduce to double-downs, then to downs,
6307 then are eliminated. */
6308 if (modifiers & (down_modifier | drag_modifier
6309 | double_modifier | triple_modifier))
6310 {
6311 while (modifiers & (down_modifier | drag_modifier
6312 | double_modifier | triple_modifier))
6313 {
6314 Lisp_Object new_head, new_click;
6315 if (modifiers & triple_modifier)
6316 modifiers ^= (double_modifier | triple_modifier);
6317 else if (modifiers & double_modifier)
6318 modifiers &= ~double_modifier;
6319 else if (modifiers & drag_modifier)
6320 modifiers &= ~drag_modifier;
6321 else
6322 {
6323 /* Dispose of this `down' event by simply jumping
6324 back to replay_key, to get another event.
6325
6326 Note that if this event came from mock input,
6327 then just jumping back to replay_key will just
6328 hand it to us again. So we have to wipe out any
6329 mock input.
6330
6331 We could delete keybuf[t] and shift everything
6332 after that to the left by one spot, but we'd also
6333 have to fix up any variable that points into
6334 keybuf, and shifting isn't really necessary
6335 anyway.
6336
6337 Adding prefixes for non-textual mouse clicks
6338 creates two characters of mock input, and both
6339 must be thrown away. If we're only looking at
6340 the prefix now, we can just jump back to
6341 replay_key. On the other hand, if we've already
6342 processed the prefix, and now the actual click
6343 itself is giving us trouble, then we've lost the
6344 state of the keymaps we want to backtrack to, and
6345 we need to replay the whole sequence to rebuild
6346 it.
6347
6348 Beyond that, only function key expansion could
6349 create more than two keys, but that should never
6350 generate mouse events, so it's okay to zero
6351 mock_input in that case too.
6352
6353 Isn't this just the most wonderful code ever? */
6354 if (t == last_real_key_start)
6355 {
6356 mock_input = 0;
6357 goto replay_key;
6358 }
6359 else
6360 {
6361 mock_input = last_real_key_start;
6362 goto replay_sequence;
6363 }
6364 }
6365
6366 new_head
6367 = apply_modifiers (modifiers, XCONS (breakdown)->car);
6368 new_click
6369 = Fcons (new_head, Fcons (EVENT_START (key), Qnil));
6370
6371 /* Look for a binding for this new key. follow_key
6372 promises that it didn't munge submaps the
6373 last time we called it, since key was unbound. */
6374 first_binding
6375 = (follow_key (new_click,
6376 nmaps - local_first_binding,
6377 submaps + local_first_binding,
6378 defs + local_first_binding,
6379 submaps + local_first_binding)
6380 + local_first_binding);
6381
6382 /* If that click is bound, go for it. */
6383 if (first_binding < nmaps)
6384 {
6385 key = new_click;
6386 break;
6387 }
6388 /* Otherwise, we'll leave key set to the drag event. */
6389 }
6390 }
6391 }
6392 }
6393
6394 keybuf[t++] = key;
6395 /* Normally, last_nonmenu_event gets the previous key we read.
6396 But when a mouse popup menu is being used,
6397 we don't update last_nonmenu_event; it continues to hold the mouse
6398 event that preceded the first level of menu. */
6399 if (!used_mouse_menu)
6400 last_nonmenu_event = key;
6401
6402 /* Record what part of this_command_keys is the current key sequence. */
6403 this_single_command_key_start = this_command_key_count - t;
6404
6405 prev_fkey_map = fkey_map;
6406 prev_fkey_start = fkey_start;
6407 prev_fkey_end = fkey_end;
6408
6409 prev_keytran_map = keytran_map;
6410 prev_keytran_start = keytran_start;
6411 prev_keytran_end = keytran_end;
6412
6413 /* If the sequence is unbound, see if we can hang a function key
6414 off the end of it. We only want to scan real keyboard input
6415 for function key sequences, so if mock_input says that we're
6416 re-reading old events, don't examine it. */
6417 if (first_binding >= nmaps
6418 && t >= mock_input)
6419 {
6420 Lisp_Object fkey_next;
6421
6422 /* Continue scan from fkey_end until we find a bound suffix.
6423 If we fail, increment fkey_start
6424 and start fkey_end from there. */
6425 while (fkey_end < t)
6426 {
6427 Lisp_Object key;
6428
6429 key = keybuf[fkey_end++];
6430 /* Look up meta-characters by prefixing them
6431 with meta_prefix_char. I hate this. */
6432 if (INTEGERP (key) && XINT (key) & meta_modifier)
6433 {
6434 fkey_next
6435 = get_keymap_1
6436 (get_keyelt
6437 (access_keymap (fkey_map, meta_prefix_char, 1, 0)),
6438 0, 1);
6439 XSETFASTINT (key, XFASTINT (key) & ~meta_modifier);
6440 }
6441 else
6442 fkey_next = fkey_map;
6443
6444 fkey_next
6445 = get_keyelt (access_keymap (fkey_next, key, 1, 0));
6446
6447 #if 0 /* I didn't turn this on, because it might cause trouble
6448 for the mapping of return into C-m and tab into C-i. */
6449 /* Optionally don't map function keys into other things.
6450 This enables the user to redefine kp- keys easily. */
6451 if (SYMBOLP (key) && !NILP (Vinhibit_function_key_mapping))
6452 fkey_next = Qnil;
6453 #endif
6454
6455 /* If the function key map gives a function, not an
6456 array, then call the function with no args and use
6457 its value instead. */
6458 if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next))
6459 && fkey_end == t)
6460 {
6461 struct gcpro gcpro1, gcpro2, gcpro3;
6462 Lisp_Object tem;
6463 tem = fkey_next;
6464
6465 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
6466 fkey_next = call1 (fkey_next, prompt);
6467 UNGCPRO;
6468 /* If the function returned something invalid,
6469 barf--don't ignore it.
6470 (To ignore it safely, we would need to gcpro a bunch of
6471 other variables.) */
6472 if (! (VECTORP (fkey_next) || STRINGP (fkey_next)))
6473 error ("Function in key-translation-map returns invalid key sequence");
6474 }
6475
6476 function_key_possible = ! NILP (fkey_next);
6477
6478 /* If keybuf[fkey_start..fkey_end] is bound in the
6479 function key map and it's a suffix of the current
6480 sequence (i.e. fkey_end == t), replace it with
6481 the binding and restart with fkey_start at the end. */
6482 if ((VECTORP (fkey_next) || STRINGP (fkey_next))
6483 && fkey_end == t)
6484 {
6485 int len = XFASTINT (Flength (fkey_next));
6486
6487 t = fkey_start + len;
6488 if (t >= bufsize)
6489 error ("Key sequence too long");
6490
6491 if (VECTORP (fkey_next))
6492 bcopy (XVECTOR (fkey_next)->contents,
6493 keybuf + fkey_start,
6494 (t - fkey_start) * sizeof (keybuf[0]));
6495 else if (STRINGP (fkey_next))
6496 {
6497 int i;
6498
6499 for (i = 0; i < len; i++)
6500 XSETFASTINT (keybuf[fkey_start + i],
6501 XSTRING (fkey_next)->data[i]);
6502 }
6503
6504 mock_input = t;
6505 fkey_start = fkey_end = t;
6506 fkey_map = Vfunction_key_map;
6507
6508 /* Do pass the results through key-translation-map. */
6509 keytran_start = keytran_end = 0;
6510 keytran_map = Vkey_translation_map;
6511
6512 goto replay_sequence;
6513 }
6514
6515 fkey_map = get_keymap_1 (fkey_next, 0, 1);
6516
6517 /* If we no longer have a bound suffix, try a new positions for
6518 fkey_start. */
6519 if (NILP (fkey_map))
6520 {
6521 fkey_end = ++fkey_start;
6522 fkey_map = Vfunction_key_map;
6523 function_key_possible = 0;
6524 }
6525 }
6526 }
6527
6528 /* Look for this sequence in key-translation-map. */
6529 {
6530 Lisp_Object keytran_next;
6531
6532 /* Scan from keytran_end until we find a bound suffix. */
6533 while (keytran_end < t)
6534 {
6535 Lisp_Object key;
6536
6537 key = keybuf[keytran_end++];
6538 /* Look up meta-characters by prefixing them
6539 with meta_prefix_char. I hate this. */
6540 if (INTEGERP (key) && XINT (key) & meta_modifier)
6541 {
6542 keytran_next
6543 = get_keymap_1
6544 (get_keyelt
6545 (access_keymap (keytran_map, meta_prefix_char, 1, 0)),
6546 0, 1);
6547 XSETFASTINT (key, XFASTINT (key) & ~meta_modifier);
6548 }
6549 else
6550 keytran_next = keytran_map;
6551
6552 keytran_next
6553 = get_keyelt (access_keymap (keytran_next, key, 1, 0));
6554
6555 /* If the key translation map gives a function, not an
6556 array, then call the function with no args and use
6557 its value instead. */
6558 if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next))
6559 && keytran_end == t)
6560 {
6561 struct gcpro gcpro1, gcpro2, gcpro3;
6562 Lisp_Object tem;
6563 tem = keytran_next;
6564
6565 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
6566 keytran_next = call1 (keytran_next, prompt);
6567 UNGCPRO;
6568 /* If the function returned something invalid,
6569 barf--don't ignore it.
6570 (To ignore it safely, we would need to gcpro a bunch of
6571 other variables.) */
6572 if (! (VECTORP (keytran_next) || STRINGP (keytran_next)))
6573 error ("Function in key-translation-map returns invalid key sequence");
6574 }
6575
6576 key_translation_possible = ! NILP (keytran_next);
6577
6578 /* If keybuf[keytran_start..keytran_end] is bound in the
6579 key translation map and it's a suffix of the current
6580 sequence (i.e. keytran_end == t), replace it with
6581 the binding and restart with keytran_start at the end. */
6582 if ((VECTORP (keytran_next) || STRINGP (keytran_next))
6583 && keytran_end == t)
6584 {
6585 int len = XFASTINT (Flength (keytran_next));
6586
6587 t = keytran_start + len;
6588 if (t >= bufsize)
6589 error ("Key sequence too long");
6590
6591 if (VECTORP (keytran_next))
6592 bcopy (XVECTOR (keytran_next)->contents,
6593 keybuf + keytran_start,
6594 (t - keytran_start) * sizeof (keybuf[0]));
6595 else if (STRINGP (keytran_next))
6596 {
6597 int i;
6598
6599 for (i = 0; i < len; i++)
6600 XSETFASTINT (keybuf[keytran_start + i],
6601 XSTRING (keytran_next)->data[i]);
6602 }
6603
6604 mock_input = t;
6605 keytran_start = keytran_end = t;
6606 keytran_map = Vkey_translation_map;
6607
6608 /* Don't pass the results of key-translation-map
6609 through function-key-map. */
6610 fkey_start = fkey_end = t;
6611 fkey_map = Vkey_translation_map;
6612
6613 goto replay_sequence;
6614 }
6615
6616 keytran_map = get_keymap_1 (keytran_next, 0, 1);
6617
6618 /* If we no longer have a bound suffix, try a new positions for
6619 keytran_start. */
6620 if (NILP (keytran_map))
6621 {
6622 keytran_end = ++keytran_start;
6623 keytran_map = Vkey_translation_map;
6624 key_translation_possible = 0;
6625 }
6626 }
6627 }
6628
6629 /* If KEY is not defined in any of the keymaps,
6630 and cannot be part of a function key or translation,
6631 and is an upper case letter
6632 use the corresponding lower-case letter instead. */
6633 if (first_binding == nmaps && ! function_key_possible
6634 && ! key_translation_possible
6635 && INTEGERP (key)
6636 && ((((XINT (key) & 0x3ffff)
6637 < XSTRING (current_buffer->downcase_table)->size)
6638 && UPPERCASEP (XINT (key) & 0x3ffff))
6639 || (XINT (key) & shift_modifier)))
6640 {
6641 Lisp_Object new_key;
6642
6643 original_uppercase = key;
6644 original_uppercase_position = t - 1;
6645
6646 if (XINT (key) & shift_modifier)
6647 XSETINT (new_key, XINT (key) & ~shift_modifier);
6648 else
6649 XSETINT (new_key, (DOWNCASE (XINT (key) & 0x3ffff)
6650 | (XINT (key) & ~0x3ffff)));
6651
6652 /* We have to do this unconditionally, regardless of whether
6653 the lower-case char is defined in the keymaps, because they
6654 might get translated through function-key-map. */
6655 keybuf[t - 1] = new_key;
6656 mock_input = t;
6657
6658 fkey_map = prev_fkey_map;
6659 fkey_start = prev_fkey_start;
6660 fkey_end = prev_fkey_end;
6661
6662 keytran_map = prev_keytran_map;
6663 keytran_start = prev_keytran_start;
6664 keytran_end = prev_keytran_end;
6665
6666 goto replay_sequence;
6667 }
6668 /* If KEY is not defined in any of the keymaps,
6669 and cannot be part of a function key or translation,
6670 and is a shifted function key,
6671 use the corresponding unshifted function key instead. */
6672 if (first_binding == nmaps && ! function_key_possible
6673 && ! key_translation_possible
6674 && SYMBOLP (key))
6675 {
6676 Lisp_Object breakdown;
6677 int modifiers;
6678
6679 breakdown = parse_modifiers (key);
6680 modifiers = XINT (XCONS (XCONS (breakdown)->cdr)->car);
6681 if (modifiers & shift_modifier)
6682 {
6683 Lisp_Object new_key;
6684
6685 original_uppercase = key;
6686 original_uppercase_position = t - 1;
6687
6688 modifiers &= ~shift_modifier;
6689 new_key = apply_modifiers (modifiers,
6690 XCONS (breakdown)->car);
6691
6692 keybuf[t - 1] = new_key;
6693 mock_input = t;
6694
6695 fkey_map = prev_fkey_map;
6696 fkey_start = prev_fkey_start;
6697 fkey_end = prev_fkey_end;
6698
6699 keytran_map = prev_keytran_map;
6700 keytran_start = prev_keytran_start;
6701 keytran_end = prev_keytran_end;
6702
6703 goto replay_sequence;
6704 }
6705 }
6706 }
6707
6708 if (!dummyflag)
6709 read_key_sequence_cmd = (first_binding < nmaps
6710 ? defs[first_binding]
6711 : Qnil);
6712
6713 unread_switch_frame = delayed_switch_frame;
6714 unbind_to (count, Qnil);
6715
6716 /* Don't downcase the last character if the caller says don't.
6717 Don't downcase it if the result is undefined, either. */
6718 if ((dont_downcase_last || first_binding >= nmaps)
6719 && t - 1 == original_uppercase_position)
6720 keybuf[t - 1] = original_uppercase;
6721
6722 /* Occasionally we fabricate events, perhaps by expanding something
6723 according to function-key-map, or by adding a prefix symbol to a
6724 mouse click in the scroll bar or modeline. In this cases, return
6725 the entire generated key sequence, even if we hit an unbound
6726 prefix or a definition before the end. This means that you will
6727 be able to push back the event properly, and also means that
6728 read-key-sequence will always return a logical unit.
6729
6730 Better ideas? */
6731 for (; t < mock_input; t++)
6732 {
6733 if (echo_keystrokes)
6734 echo_char (keybuf[t]);
6735 add_command_key (keybuf[t]);
6736 }
6737
6738 return t;
6739 }
6740
6741 #if 0 /* This doc string is too long for some compilers.
6742 This commented-out definition serves for DOC. */
6743 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0,
6744 "Read a sequence of keystrokes and return as a string or vector.\n\
6745 The sequence is sufficient to specify a non-prefix command in the\n\
6746 current local and global maps.\n\
6747 \n\
6748 First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
6749 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\
6750 as a continuation of the previous key.\n\
6751 \n\
6752 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not\n\
6753 convert the last event to lower case. (Normally any upper case event\n\
6754 is converted to lower case if the original event is undefined and the lower\n\
6755 case equivalent is defined.) A non-nil value is appropriate for reading\n\
6756 a key sequence to be defined.\n\
6757 \n\
6758 A C-g typed while in this function is treated like any other character,\n\
6759 and `quit-flag' is not set.\n\
6760 \n\
6761 If the key sequence starts with a mouse click, then the sequence is read\n\
6762 using the keymaps of the buffer of the window clicked in, not the buffer\n\
6763 of the selected window as normal.\n\
6764 ""\n\
6765 `read-key-sequence' drops unbound button-down events, since you normally\n\
6766 only care about the click or drag events which follow them. If a drag\n\
6767 or multi-click event is unbound, but the corresponding click event would\n\
6768 be bound, `read-key-sequence' turns the event into a click event at the\n\
6769 drag's starting position. This means that you don't have to distinguish\n\
6770 between click and drag, double, or triple events unless you want to.\n\
6771 \n\
6772 `read-key-sequence' prefixes mouse events on mode lines, the vertical\n\
6773 lines separating windows, and scroll bars with imaginary keys\n\
6774 `mode-line', `vertical-line', and `vertical-scroll-bar'.\n\
6775 \n\
6776 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this\n\
6777 function will process a switch-frame event if the user switches frames\n\
6778 before typing anything. If the user switches frames in the middle of a\n\
6779 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME\n\
6780 is nil, then the event will be put off until after the current key sequence.\n\
6781 \n\
6782 `read-key-sequence' checks `function-key-map' for function key\n\
6783 sequences, where they wouldn't conflict with ordinary bindings. See\n\
6784 `function-key-map' for more details.")
6785 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame)
6786 #endif
6787
6788 DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0,
6789 0)
6790 (prompt, continue_echo, dont_downcase_last, can_return_switch_frame)
6791 Lisp_Object prompt, continue_echo, dont_downcase_last;
6792 Lisp_Object can_return_switch_frame;
6793 {
6794 Lisp_Object keybuf[30];
6795 register int i;
6796 struct gcpro gcpro1, gcpro2;
6797
6798 if (!NILP (prompt))
6799 CHECK_STRING (prompt, 0);
6800 QUIT;
6801
6802 bzero (keybuf, sizeof keybuf);
6803 GCPRO1 (keybuf[0]);
6804 gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
6805
6806 if (NILP (continue_echo))
6807 {
6808 this_command_key_count = 0;
6809 this_single_command_key_start = 0;
6810 }
6811
6812 i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
6813 prompt, ! NILP (dont_downcase_last),
6814 ! NILP (can_return_switch_frame));
6815
6816 if (i == -1)
6817 {
6818 Vquit_flag = Qt;
6819 QUIT;
6820 }
6821 UNGCPRO;
6822 return make_event_array (i, keybuf);
6823 }
6824 \f
6825 DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0,
6826 "Execute CMD as an editor command.\n\
6827 CMD must be a symbol that satisfies the `commandp' predicate.\n\
6828 Optional second arg RECORD-FLAG non-nil\n\
6829 means unconditionally put this command in `command-history'.\n\
6830 Otherwise, that is done only if an arg is read using the minibuffer.\n\
6831 The argument KEYS specifies the value to use instead of (this-command-keys)\n\
6832 when reading the arguments; if it is nil, (this-command-keys) is used.\n\
6833 The argument SPECIAL, if non-nil, means that this command is executing\n\
6834 a special event, so ignore the prefix argument and don't clear it.")
6835 (cmd, record_flag, keys, special)
6836 Lisp_Object cmd, record_flag, keys, special;
6837 {
6838 register Lisp_Object final;
6839 register Lisp_Object tem;
6840 Lisp_Object prefixarg;
6841 struct backtrace backtrace;
6842 extern int debug_on_next_call;
6843
6844 debug_on_next_call = 0;
6845
6846 if (NILP (special))
6847 {
6848 prefixarg = current_kboard->Vprefix_arg;
6849 Vcurrent_prefix_arg = prefixarg;
6850 current_kboard->Vprefix_arg = Qnil;
6851 }
6852 else
6853 prefixarg = Qnil;
6854
6855 if (SYMBOLP (cmd))
6856 {
6857 tem = Fget (cmd, Qdisabled);
6858 if (!NILP (tem) && !NILP (Vrun_hooks))
6859 {
6860 tem = Fsymbol_value (Qdisabled_command_hook);
6861 if (!NILP (tem))
6862 return call1 (Vrun_hooks, Qdisabled_command_hook);
6863 }
6864 }
6865
6866 while (1)
6867 {
6868 final = Findirect_function (cmd);
6869
6870 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
6871 do_autoload (final, cmd);
6872 else
6873 break;
6874 }
6875
6876 if (STRINGP (final) || VECTORP (final))
6877 {
6878 /* If requested, place the macro in the command history. For
6879 other sorts of commands, call-interactively takes care of
6880 this. */
6881 if (!NILP (record_flag))
6882 Vcommand_history
6883 = Fcons (Fcons (Qexecute_kbd_macro,
6884 Fcons (final, Fcons (prefixarg, Qnil))),
6885 Vcommand_history);
6886
6887 return Fexecute_kbd_macro (final, prefixarg);
6888 }
6889 if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
6890 {
6891 backtrace.next = backtrace_list;
6892 backtrace_list = &backtrace;
6893 backtrace.function = &Qcall_interactively;
6894 backtrace.args = &cmd;
6895 backtrace.nargs = 1;
6896 backtrace.evalargs = 0;
6897
6898 tem = Fcall_interactively (cmd, record_flag, keys);
6899
6900 backtrace_list = backtrace.next;
6901 return tem;
6902 }
6903 return Qnil;
6904 }
6905 \f
6906 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
6907 1, 1, "P",
6908 "Read function name, then read its arguments and call it.")
6909 (prefixarg)
6910 Lisp_Object prefixarg;
6911 {
6912 Lisp_Object function;
6913 char buf[40];
6914 Lisp_Object saved_keys;
6915 struct gcpro gcpro1;
6916
6917 saved_keys = Fvector (this_command_key_count,
6918 XVECTOR (this_command_keys)->contents);
6919 buf[0] = 0;
6920 GCPRO1 (saved_keys);
6921
6922 if (EQ (prefixarg, Qminus))
6923 strcpy (buf, "- ");
6924 else if (CONSP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4)
6925 strcpy (buf, "C-u ");
6926 else if (CONSP (prefixarg) && INTEGERP (XCONS (prefixarg)->car))
6927 {
6928 if (sizeof (int) == sizeof (EMACS_INT))
6929 sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car));
6930 else if (sizeof (long) == sizeof (EMACS_INT))
6931 sprintf (buf, "%ld ", XINT (XCONS (prefixarg)->car));
6932 else
6933 abort ();
6934 }
6935 else if (INTEGERP (prefixarg))
6936 {
6937 if (sizeof (int) == sizeof (EMACS_INT))
6938 sprintf (buf, "%d ", XINT (prefixarg));
6939 else if (sizeof (long) == sizeof (EMACS_INT))
6940 sprintf (buf, "%ld ", XINT (prefixarg));
6941 else
6942 abort ();
6943 }
6944
6945 /* This isn't strictly correct if execute-extended-command
6946 is bound to anything else. Perhaps it should use
6947 this_command_keys? */
6948 strcat (buf, "M-x ");
6949
6950 /* Prompt with buf, and then read a string, completing from and
6951 restricting to the set of all defined commands. Don't provide
6952 any initial input. Save the command read on the extended-command
6953 history list. */
6954 function = Fcompleting_read (build_string (buf),
6955 Vobarray, Qcommandp,
6956 Qt, Qnil, Qextended_command_history);
6957
6958 if (STRINGP (function) && XSTRING (function)->size == 0)
6959 error ("No command name given");
6960
6961 /* Set this_command_keys to the concatenation of saved_keys and
6962 function, followed by a RET. */
6963 {
6964 struct Lisp_String *str;
6965 Lisp_Object *keys;
6966 int i;
6967 Lisp_Object tem;
6968
6969 this_command_key_count = 0;
6970 this_single_command_key_start = 0;
6971
6972 keys = XVECTOR (saved_keys)->contents;
6973 for (i = 0; i < XVECTOR (saved_keys)->size; i++)
6974 add_command_key (keys[i]);
6975
6976 str = XSTRING (function);
6977 for (i = 0; i < str->size; i++)
6978 {
6979 XSETFASTINT (tem, str->data[i]);
6980 add_command_key (tem);
6981 }
6982
6983 XSETFASTINT (tem, '\015');
6984 add_command_key (tem);
6985 }
6986
6987 UNGCPRO;
6988
6989 function = Fintern (function, Qnil);
6990 current_kboard->Vprefix_arg = prefixarg;
6991 this_command = function;
6992
6993 /* If enabled, show which key runs this command. */
6994 if (!NILP (Vsuggest_key_bindings)
6995 && SYMBOLP (function))
6996 {
6997 Lisp_Object bindings;
6998
6999 bindings = Fwhere_is_internal (function, Voverriding_local_map,
7000 Qt, Qnil);
7001
7002 if (!NILP (bindings))
7003 {
7004 message ("You can run the command `%s' by typing %s",
7005 XSYMBOL (function)->name->data,
7006 XSTRING (Fkey_description (bindings))->data);
7007 Fsit_for ((NUMBERP (Vsuggest_key_bindings)
7008 ? Vsuggest_key_bindings : make_number (2)),
7009 Qnil, Qnil);
7010 }
7011 }
7012
7013 return Fcommand_execute (function, Qt, Qnil, Qnil);
7014 }
7015
7016 /* Find the set of keymaps now active.
7017 Store into *MAPS_P a vector holding the various maps
7018 and return the number of them. The vector was malloc'd
7019 and the caller should free it. */
7020
7021 int
7022 current_active_maps (maps_p)
7023 Lisp_Object **maps_p;
7024 {
7025 Lisp_Object *tmaps, *maps;
7026 int nmaps;
7027
7028 /* Should overriding-terminal-local-map and overriding-local-map apply? */
7029 if (!NILP (Voverriding_local_map_menu_flag))
7030 {
7031 /* Yes, use them (if non-nil) as well as the global map. */
7032 maps = (Lisp_Object *) xmalloc (3 * sizeof (maps[0]));
7033 nmaps = 0;
7034 if (!NILP (current_kboard->Voverriding_terminal_local_map))
7035 maps[nmaps++] = current_kboard->Voverriding_terminal_local_map;
7036 if (!NILP (Voverriding_local_map))
7037 maps[nmaps++] = Voverriding_local_map;
7038 }
7039 else
7040 {
7041 /* No, so use major and minor mode keymaps. */
7042 nmaps = current_minor_maps (NULL, &tmaps);
7043 maps = (Lisp_Object *) xmalloc ((nmaps + 2) * sizeof (maps[0]));
7044 bcopy (tmaps, maps, nmaps * sizeof (maps[0]));
7045 #ifdef USE_TEXT_PROPERTIES
7046 maps[nmaps++] = get_local_map (PT, current_buffer);
7047 #else
7048 maps[nmaps++] = current_buffer->keymap;
7049 #endif
7050 }
7051 maps[nmaps++] = current_global_map;
7052
7053 *maps_p = maps;
7054 return nmaps;
7055 }
7056 \f
7057 /* Return nonzero if input events are pending. */
7058
7059 detect_input_pending ()
7060 {
7061 if (!input_pending)
7062 get_input_pending (&input_pending, 0);
7063
7064 return input_pending;
7065 }
7066
7067 /* Return nonzero if input events are pending.
7068 Execute timers immediately; don't make events for them. */
7069
7070 detect_input_pending_run_timers (do_display)
7071 int do_display;
7072 {
7073 int old_timers_run = timers_run;
7074
7075 if (!input_pending)
7076 get_input_pending (&input_pending, 1);
7077
7078 if (old_timers_run != timers_run && do_display)
7079 redisplay_preserve_echo_area ();
7080
7081 return input_pending;
7082 }
7083
7084 /* This is called in some cases before a possible quit.
7085 It cases the next call to detect_input_pending to recompute input_pending.
7086 So calling this function unnecessarily can't do any harm. */
7087 clear_input_pending ()
7088 {
7089 input_pending = 0;
7090 }
7091
7092 DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
7093 "T if command input is currently available with no waiting.\n\
7094 Actually, the value is nil only if we can be sure that no input is available.")
7095 ()
7096 {
7097 if (!NILP (Vunread_command_events) || unread_command_char != -1)
7098 return (Qt);
7099
7100 get_input_pending (&input_pending, 1);
7101 return input_pending > 0 ? Qt : Qnil;
7102 }
7103
7104 DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
7105 "Return vector of last 100 events, not counting those from keyboard macros.")
7106 ()
7107 {
7108 Lisp_Object *keys = XVECTOR (recent_keys)->contents;
7109 Lisp_Object val;
7110
7111 if (total_keys < NUM_RECENT_KEYS)
7112 return Fvector (total_keys, keys);
7113 else
7114 {
7115 val = Fvector (NUM_RECENT_KEYS, keys);
7116 bcopy (keys + recent_keys_index,
7117 XVECTOR (val)->contents,
7118 (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
7119 bcopy (keys,
7120 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
7121 recent_keys_index * sizeof (Lisp_Object));
7122 return val;
7123 }
7124 }
7125
7126 DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
7127 "Return the key sequence that invoked this command.\n\
7128 The value is a string or a vector.")
7129 ()
7130 {
7131 return make_event_array (this_command_key_count,
7132 XVECTOR (this_command_keys)->contents);
7133 }
7134
7135 DEFUN ("this-single-command-keys", Fthis_single_command_keys,
7136 Sthis_single_command_keys, 0, 0, 0,
7137 "Return the key sequence that invoked this command.\n\
7138 Unlike `this-command-keys', this function's value\n\
7139 does not include prefix arguments.\n\
7140 The value is a string or a vector.")
7141 ()
7142 {
7143 return make_event_array (this_command_key_count
7144 - this_single_command_key_start,
7145 (XVECTOR (this_command_keys)->contents
7146 + this_single_command_key_start));
7147 }
7148
7149 DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,
7150 Sreset_this_command_lengths, 0, 0, 0,
7151 "Used for complicated reasons in `universal-argument-other-key'.\n\
7152 \n\
7153 `universal-argument-other-key' rereads the event just typed.\n\
7154 It then gets translated through `function-key-map'.\n\
7155 The translated event gets included in the echo area and in\n\
7156 the value of `this-command-keys' in addition to the raw original event.\n\
7157 That is not right.\n\
7158 \n\
7159 Calling this function directs the translated event to replace\n\
7160 the original event, so that only one version of the event actually\n\
7161 appears in the echo area and in the value of `this-command-keys.'.")
7162 ()
7163 {
7164 before_command_restore_flag = 1;
7165 before_command_key_count_1 = before_command_key_count;
7166 before_command_echo_length_1 = before_command_echo_length;
7167 }
7168
7169 DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
7170 "Return the current depth in recursive edits.")
7171 ()
7172 {
7173 Lisp_Object temp;
7174 XSETFASTINT (temp, command_loop_level + minibuf_level);
7175 return temp;
7176 }
7177
7178 DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
7179 "FOpen dribble file: ",
7180 "Start writing all keyboard characters to a dribble file called FILE.\n\
7181 If FILE is nil, close any open dribble file.")
7182 (file)
7183 Lisp_Object file;
7184 {
7185 if (dribble)
7186 {
7187 fclose (dribble);
7188 dribble = 0;
7189 }
7190 if (!NILP (file))
7191 {
7192 file = Fexpand_file_name (file, Qnil);
7193 dribble = fopen (XSTRING (file)->data, "w");
7194 if (dribble == 0)
7195 report_file_error ("Opening dribble", Fcons (file, Qnil));
7196 }
7197 return Qnil;
7198 }
7199
7200 DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
7201 "Discard the contents of the terminal input buffer.\n\
7202 Also cancel any kbd macro being defined.")
7203 ()
7204 {
7205 current_kboard->defining_kbd_macro = Qnil;
7206 update_mode_lines++;
7207
7208 Vunread_command_events = Qnil;
7209 unread_command_char = -1;
7210
7211 discard_tty_input ();
7212
7213 /* Without the cast, GCC complains that this assignment loses the
7214 volatile qualifier of kbd_store_ptr. Is there anything wrong
7215 with that? */
7216 kbd_fetch_ptr = (struct input_event *) kbd_store_ptr;
7217 Ffillarray (kbd_buffer_frame_or_window, Qnil);
7218 input_pending = 0;
7219
7220 return Qnil;
7221 }
7222 \f
7223 DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
7224 "Stop Emacs and return to superior process. You can resume later.\n\
7225 If `cannot-suspend' is non-nil, or if the system doesn't support job\n\
7226 control, run a subshell instead.\n\n\
7227 If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
7228 to be read as terminal input by Emacs's parent, after suspension.\n\
7229 \n\
7230 Before suspending, run the normal hook `suspend-hook'.\n\
7231 After resumption run the normal hook `suspend-resume-hook'.\n\
7232 \n\
7233 Some operating systems cannot stop the Emacs process and resume it later.\n\
7234 On such systems, Emacs starts a subshell instead of suspending.")
7235 (stuffstring)
7236 Lisp_Object stuffstring;
7237 {
7238 Lisp_Object tem;
7239 int count = specpdl_ptr - specpdl;
7240 int old_height, old_width;
7241 int width, height;
7242 struct gcpro gcpro1, gcpro2;
7243 extern init_sys_modes ();
7244
7245 if (!NILP (stuffstring))
7246 CHECK_STRING (stuffstring, 0);
7247
7248 /* Run the functions in suspend-hook. */
7249 if (!NILP (Vrun_hooks))
7250 call1 (Vrun_hooks, intern ("suspend-hook"));
7251
7252 GCPRO1 (stuffstring);
7253 get_frame_size (&old_width, &old_height);
7254 reset_sys_modes ();
7255 /* sys_suspend can get an error if it tries to fork a subshell
7256 and the system resources aren't available for that. */
7257 record_unwind_protect (init_sys_modes, 0);
7258 stuff_buffered_input (stuffstring);
7259 if (cannot_suspend)
7260 sys_subshell ();
7261 else
7262 sys_suspend ();
7263 unbind_to (count, Qnil);
7264
7265 /* Check if terminal/window size has changed.
7266 Note that this is not useful when we are running directly
7267 with a window system; but suspend should be disabled in that case. */
7268 get_frame_size (&width, &height);
7269 if (width != old_width || height != old_height)
7270 change_frame_size (selected_frame, height, width, 0, 0);
7271
7272 /* Run suspend-resume-hook. */
7273 if (!NILP (Vrun_hooks))
7274 call1 (Vrun_hooks, intern ("suspend-resume-hook"));
7275
7276 UNGCPRO;
7277 return Qnil;
7278 }
7279
7280 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
7281 Then in any case stuff anything Emacs has read ahead and not used. */
7282
7283 stuff_buffered_input (stuffstring)
7284 Lisp_Object stuffstring;
7285 {
7286 /* stuff_char works only in BSD, versions 4.2 and up. */
7287 #ifdef BSD
7288 #ifndef BSD4_1
7289 register unsigned char *p;
7290
7291 if (STRINGP (stuffstring))
7292 {
7293 register int count;
7294
7295 p = XSTRING (stuffstring)->data;
7296 count = XSTRING (stuffstring)->size;
7297 while (count-- > 0)
7298 stuff_char (*p++);
7299 stuff_char ('\n');
7300 }
7301 /* Anything we have read ahead, put back for the shell to read. */
7302 /* ?? What should this do when we have multiple keyboards??
7303 Should we ignore anything that was typed in at the "wrong" kboard? */
7304 for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++)
7305 {
7306 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
7307 kbd_fetch_ptr = kbd_buffer;
7308 if (kbd_fetch_ptr->kind == ascii_keystroke)
7309 stuff_char (kbd_fetch_ptr->code);
7310 kbd_fetch_ptr->kind = no_event;
7311 (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_fetch_ptr
7312 - kbd_buffer]
7313 = Qnil);
7314 }
7315 input_pending = 0;
7316 #endif
7317 #endif /* BSD and not BSD4_1 */
7318 }
7319 \f
7320 set_waiting_for_input (time_to_clear)
7321 EMACS_TIME *time_to_clear;
7322 {
7323 input_available_clear_time = time_to_clear;
7324
7325 /* Tell interrupt_signal to throw back to read_char, */
7326 waiting_for_input = 1;
7327
7328 /* If interrupt_signal was called before and buffered a C-g,
7329 make it run again now, to avoid timing error. */
7330 if (!NILP (Vquit_flag))
7331 quit_throw_to_read_char ();
7332 }
7333
7334 clear_waiting_for_input ()
7335 {
7336 /* Tell interrupt_signal not to throw back to read_char, */
7337 waiting_for_input = 0;
7338 input_available_clear_time = 0;
7339 }
7340
7341 /* This routine is called at interrupt level in response to C-G.
7342 If interrupt_input, this is the handler for SIGINT.
7343 Otherwise, it is called from kbd_buffer_store_event,
7344 in handling SIGIO or SIGTINT.
7345
7346 If `waiting_for_input' is non zero, then unless `echoing' is nonzero,
7347 immediately throw back to read_char.
7348
7349 Otherwise it sets the Lisp variable quit-flag not-nil.
7350 This causes eval to throw, when it gets a chance.
7351 If quit-flag is already non-nil, it stops the job right away. */
7352
7353 SIGTYPE
7354 interrupt_signal (signalnum) /* If we don't have an argument, */
7355 int signalnum; /* some compilers complain in signal calls. */
7356 {
7357 char c;
7358 /* Must preserve main program's value of errno. */
7359 int old_errno = errno;
7360
7361 #ifdef USG
7362 if (!read_socket_hook && NILP (Vwindow_system))
7363 {
7364 /* USG systems forget handlers when they are used;
7365 must reestablish each time */
7366 signal (SIGINT, interrupt_signal);
7367 signal (SIGQUIT, interrupt_signal);
7368 }
7369 #endif /* USG */
7370
7371 cancel_echoing ();
7372
7373 if (!NILP (Vquit_flag) && FRAME_TERMCAP_P (selected_frame))
7374 {
7375 fflush (stdout);
7376 reset_sys_modes ();
7377 sigfree ();
7378 #ifdef SIGTSTP /* Support possible in later USG versions */
7379 /*
7380 * On systems which can suspend the current process and return to the original
7381 * shell, this command causes the user to end up back at the shell.
7382 * The "Auto-save" and "Abort" questions are not asked until
7383 * the user elects to return to emacs, at which point he can save the current
7384 * job and either dump core or continue.
7385 */
7386 sys_suspend ();
7387 #else
7388 #ifdef VMS
7389 if (sys_suspend () == -1)
7390 {
7391 printf ("Not running as a subprocess;\n");
7392 printf ("you can continue or abort.\n");
7393 }
7394 #else /* not VMS */
7395 /* Perhaps should really fork an inferior shell?
7396 But that would not provide any way to get back
7397 to the original shell, ever. */
7398 printf ("No support for stopping a process on this operating system;\n");
7399 printf ("you can continue or abort.\n");
7400 #endif /* not VMS */
7401 #endif /* not SIGTSTP */
7402 #ifdef MSDOS
7403 /* We must remain inside the screen area when the internal terminal
7404 is used. Note that [Enter] is not echoed by dos. */
7405 cursor_to (0, 0);
7406 #endif
7407 /* It doesn't work to autosave while GC is in progress;
7408 the code used for auto-saving doesn't cope with the mark bit. */
7409 if (!gc_in_progress)
7410 {
7411 printf ("Auto-save? (y or n) ");
7412 fflush (stdout);
7413 if (((c = getchar ()) & ~040) == 'Y')
7414 {
7415 Fdo_auto_save (Qt, Qnil);
7416 #ifdef MSDOS
7417 printf ("\r\nAuto-save done");
7418 #else /* not MSDOS */
7419 printf ("Auto-save done\n");
7420 #endif /* not MSDOS */
7421 }
7422 while (c != '\n') c = getchar ();
7423 }
7424 else
7425 {
7426 /* During GC, it must be safe to reenable quitting again. */
7427 Vinhibit_quit = Qnil;
7428 #ifdef MSDOS
7429 printf ("\r\n");
7430 #endif /* not MSDOS */
7431 printf ("Garbage collection in progress; cannot auto-save now\r\n");
7432 printf ("but will instead do a real quit after garbage collection ends\r\n");
7433 fflush (stdout);
7434 }
7435
7436 #ifdef MSDOS
7437 printf ("\r\nAbort? (y or n) ");
7438 #else /* not MSDOS */
7439 #ifdef VMS
7440 printf ("Abort (and enter debugger)? (y or n) ");
7441 #else /* not VMS */
7442 printf ("Abort (and dump core)? (y or n) ");
7443 #endif /* not VMS */
7444 #endif /* not MSDOS */
7445 fflush (stdout);
7446 if (((c = getchar ()) & ~040) == 'Y')
7447 abort ();
7448 while (c != '\n') c = getchar ();
7449 #ifdef MSDOS
7450 printf ("\r\nContinuing...\r\n");
7451 #else /* not MSDOS */
7452 printf ("Continuing...\n");
7453 #endif /* not MSDOS */
7454 fflush (stdout);
7455 init_sys_modes ();
7456 }
7457 else
7458 {
7459 /* If executing a function that wants to be interrupted out of
7460 and the user has not deferred quitting by binding `inhibit-quit'
7461 then quit right away. */
7462 if (immediate_quit && NILP (Vinhibit_quit))
7463 {
7464 immediate_quit = 0;
7465 sigfree ();
7466 Fsignal (Qquit, Qnil);
7467 }
7468 else
7469 /* Else request quit when it's safe */
7470 Vquit_flag = Qt;
7471 }
7472
7473 if (waiting_for_input && !echoing)
7474 quit_throw_to_read_char ();
7475
7476 errno = old_errno;
7477 }
7478
7479 /* Handle a C-g by making read_char return C-g. */
7480
7481 quit_throw_to_read_char ()
7482 {
7483 quit_error_check ();
7484 sigfree ();
7485 /* Prevent another signal from doing this before we finish. */
7486 clear_waiting_for_input ();
7487 input_pending = 0;
7488
7489 Vunread_command_events = Qnil;
7490 unread_command_char = -1;
7491
7492 #if 0 /* Currently, sit_for is called from read_char without turning
7493 off polling. And that can call set_waiting_for_input.
7494 It seems to be harmless. */
7495 #ifdef POLL_FOR_INPUT
7496 /* May be > 1 if in recursive minibuffer. */
7497 if (poll_suppress_count == 0)
7498 abort ();
7499 #endif
7500 #endif
7501 #ifdef MULTI_FRAME
7502 if (FRAMEP (internal_last_event_frame)
7503 && XFRAME (internal_last_event_frame) != selected_frame)
7504 do_switch_frame (make_lispy_switch_frame (internal_last_event_frame),
7505 Qnil, 0);
7506 #endif
7507
7508 _longjmp (getcjmp, 1);
7509 }
7510 \f
7511 DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
7512 "Set mode of reading keyboard input.\n\
7513 First arg INTERRUPT non-nil means use input interrupts;\n\
7514 nil means use CBREAK mode.\n\
7515 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
7516 (no effect except in CBREAK mode).\n\
7517 Third arg META t means accept 8-bit input (for a Meta key).\n\
7518 META nil means ignore the top bit, on the assumption it is parity.\n\
7519 Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\
7520 Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\
7521 See also `current-input-mode'.")
7522 (interrupt, flow, meta, quit)
7523 Lisp_Object interrupt, flow, meta, quit;
7524 {
7525 if (!NILP (quit)
7526 && (!INTEGERP (quit) || XINT (quit) < 0 || XINT (quit) > 0400))
7527 error ("set-input-mode: QUIT must be an ASCII character");
7528
7529 #ifdef POLL_FOR_INPUT
7530 stop_polling ();
7531 #endif
7532
7533 #ifndef MSDOS
7534 /* this causes startup screen to be restored and messes with the mouse */
7535 reset_sys_modes ();
7536 #endif
7537
7538 #ifdef SIGIO
7539 /* Note SIGIO has been undef'd if FIONREAD is missing. */
7540 if (read_socket_hook)
7541 {
7542 /* When using X, don't give the user a real choice,
7543 because we haven't implemented the mechanisms to support it. */
7544 #ifdef NO_SOCK_SIGIO
7545 interrupt_input = 0;
7546 #else /* not NO_SOCK_SIGIO */
7547 interrupt_input = 1;
7548 #endif /* NO_SOCK_SIGIO */
7549 }
7550 else
7551 interrupt_input = !NILP (interrupt);
7552 #else /* not SIGIO */
7553 interrupt_input = 0;
7554 #endif /* not SIGIO */
7555
7556 /* Our VMS input only works by interrupts, as of now. */
7557 #ifdef VMS
7558 interrupt_input = 1;
7559 #endif
7560
7561 flow_control = !NILP (flow);
7562 if (NILP (meta))
7563 meta_key = 0;
7564 else if (EQ (meta, Qt))
7565 meta_key = 1;
7566 else
7567 meta_key = 2;
7568 if (!NILP (quit))
7569 /* Don't let this value be out of range. */
7570 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
7571
7572 #ifndef MSDOS
7573 init_sys_modes ();
7574 #endif
7575
7576 #ifdef POLL_FOR_INPUT
7577 poll_suppress_count = 1;
7578 start_polling ();
7579 #endif
7580 return Qnil;
7581 }
7582
7583 DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode, 0, 0, 0,
7584 "Return information about the way Emacs currently reads keyboard input.\n\
7585 The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\
7586 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\
7587 nil, Emacs is using CBREAK mode.\n\
7588 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\
7589 terminal; this does not apply if Emacs uses interrupt-driven input.\n\
7590 META is t if accepting 8-bit input with 8th bit as Meta flag.\n\
7591 META nil means ignoring the top bit, on the assumption it is parity.\n\
7592 META is neither t nor nil if accepting 8-bit input and using\n\
7593 all 8 bits as the character code.\n\
7594 QUIT is the character Emacs currently uses to quit.\n\
7595 The elements of this list correspond to the arguments of\n\
7596 `set-input-mode'.")
7597 ()
7598 {
7599 Lisp_Object val[4];
7600
7601 val[0] = interrupt_input ? Qt : Qnil;
7602 val[1] = flow_control ? Qt : Qnil;
7603 val[2] = meta_key == 2 ? make_number (0) : meta_key == 1 ? Qt : Qnil;
7604 XSETFASTINT (val[3], quit_char);
7605
7606 return Flist (sizeof (val) / sizeof (val[0]), val);
7607 }
7608
7609 \f
7610 /*
7611 * Set up a new kboard object with reasonable initial values.
7612 */
7613 void
7614 init_kboard (kb)
7615 KBOARD *kb;
7616 {
7617 kb->Voverriding_terminal_local_map = Qnil;
7618 kb->Vlast_command = Qnil;
7619 kb->Vprefix_arg = Qnil;
7620 kb->kbd_queue = Qnil;
7621 kb->kbd_queue_has_data = 0;
7622 kb->immediate_echo = 0;
7623 kb->echoptr = kb->echobuf;
7624 kb->echo_after_prompt = -1;
7625 kb->kbd_macro_buffer = 0;
7626 kb->kbd_macro_bufsize = 0;
7627 kb->defining_kbd_macro = Qnil;
7628 kb->Vlast_kbd_macro = Qnil;
7629 kb->reference_count = 0;
7630 kb->Vsystem_key_alist = Qnil;
7631 kb->system_key_syms = Qnil;
7632 kb->Vdefault_minibuffer_frame = Qnil;
7633 }
7634
7635 /*
7636 * Destroy the contents of a kboard object, but not the object itself.
7637 * We use this just before deleting it, or if we're going to initialize
7638 * it a second time.
7639 */
7640 static void
7641 wipe_kboard (kb)
7642 KBOARD *kb;
7643 {
7644 if (kb->kbd_macro_buffer)
7645 xfree (kb->kbd_macro_buffer);
7646 }
7647
7648 #ifdef MULTI_KBOARD
7649 void
7650 delete_kboard (kb)
7651 KBOARD *kb;
7652 {
7653 KBOARD **kbp;
7654 for (kbp = &all_kboards; *kbp != kb; kbp = &(*kbp)->next_kboard)
7655 if (*kbp == NULL)
7656 abort ();
7657 *kbp = kb->next_kboard;
7658 wipe_kboard (kb);
7659 xfree (kb);
7660 }
7661 #endif
7662
7663 init_keyboard ()
7664 {
7665 /* This is correct before outermost invocation of the editor loop */
7666 command_loop_level = -1;
7667 immediate_quit = 0;
7668 quit_char = Ctl ('g');
7669 Vunread_command_events = Qnil;
7670 unread_command_char = -1;
7671 EMACS_SET_SECS_USECS (timer_idleness_start_time, -1, -1);
7672 total_keys = 0;
7673 recent_keys_index = 0;
7674 kbd_fetch_ptr = kbd_buffer;
7675 kbd_store_ptr = kbd_buffer;
7676 kbd_buffer_frame_or_window
7677 = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil);
7678 #ifdef HAVE_MOUSE
7679 do_mouse_tracking = Qnil;
7680 #endif
7681 input_pending = 0;
7682
7683 #ifdef MULTI_FRAME
7684 /* This means that command_loop_1 won't try to select anything the first
7685 time through. */
7686 internal_last_event_frame = Qnil;
7687 Vlast_event_frame = internal_last_event_frame;
7688 #endif
7689
7690 #ifdef MULTI_KBOARD
7691 current_kboard = initial_kboard;
7692 #endif
7693 wipe_kboard (current_kboard);
7694 init_kboard (current_kboard);
7695
7696 if (initialized)
7697 Ffillarray (kbd_buffer_frame_or_window, Qnil);
7698
7699 kbd_buffer_frame_or_window
7700 = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil);
7701 if (!noninteractive && !read_socket_hook && NILP (Vwindow_system))
7702 {
7703 signal (SIGINT, interrupt_signal);
7704 #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
7705 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
7706 SIGQUIT and we can't tell which one it will give us. */
7707 signal (SIGQUIT, interrupt_signal);
7708 #endif /* HAVE_TERMIO */
7709 }
7710 /* Note SIGIO has been undef'd if FIONREAD is missing. */
7711 #ifdef SIGIO
7712 if (!noninteractive)
7713 signal (SIGIO, input_available_signal);
7714 #endif /* SIGIO */
7715
7716 /* Use interrupt input by default, if it works and noninterrupt input
7717 has deficiencies. */
7718
7719 #ifdef INTERRUPT_INPUT
7720 interrupt_input = 1;
7721 #else
7722 interrupt_input = 0;
7723 #endif
7724
7725 /* Our VMS input only works by interrupts, as of now. */
7726 #ifdef VMS
7727 interrupt_input = 1;
7728 #endif
7729
7730 sigfree ();
7731 dribble = 0;
7732
7733 if (keyboard_init_hook)
7734 (*keyboard_init_hook) ();
7735
7736 #ifdef POLL_FOR_INPUT
7737 poll_suppress_count = 1;
7738 start_polling ();
7739 #endif
7740 }
7741
7742 /* This type's only use is in syms_of_keyboard, to initialize the
7743 event header symbols and put properties on them. */
7744 struct event_head {
7745 Lisp_Object *var;
7746 char *name;
7747 Lisp_Object *kind;
7748 };
7749
7750 struct event_head head_table[] = {
7751 &Qmouse_movement, "mouse-movement", &Qmouse_movement,
7752 &Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement,
7753 &Qswitch_frame, "switch-frame", &Qswitch_frame,
7754 &Qdelete_frame, "delete-frame", &Qdelete_frame,
7755 &Qiconify_frame, "iconify-frame", &Qiconify_frame,
7756 &Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible,
7757 };
7758
7759 syms_of_keyboard ()
7760 {
7761 Qdisabled_command_hook = intern ("disabled-command-hook");
7762 staticpro (&Qdisabled_command_hook);
7763
7764 Qself_insert_command = intern ("self-insert-command");
7765 staticpro (&Qself_insert_command);
7766
7767 Qforward_char = intern ("forward-char");
7768 staticpro (&Qforward_char);
7769
7770 Qbackward_char = intern ("backward-char");
7771 staticpro (&Qbackward_char);
7772
7773 Qdisabled = intern ("disabled");
7774 staticpro (&Qdisabled);
7775
7776 Qundefined = intern ("undefined");
7777 staticpro (&Qundefined);
7778
7779 Qpre_command_hook = intern ("pre-command-hook");
7780 staticpro (&Qpre_command_hook);
7781
7782 Qpost_command_hook = intern ("post-command-hook");
7783 staticpro (&Qpost_command_hook);
7784
7785 Qpost_command_idle_hook = intern ("post-command-idle-hook");
7786 staticpro (&Qpost_command_idle_hook);
7787
7788 Qdeferred_action_function = intern ("deferred-action-function");
7789 staticpro (&Qdeferred_action_function);
7790
7791 Qcommand_hook_internal = intern ("command-hook-internal");
7792 staticpro (&Qcommand_hook_internal);
7793
7794 Qfunction_key = intern ("function-key");
7795 staticpro (&Qfunction_key);
7796 Qmouse_click = intern ("mouse-click");
7797 staticpro (&Qmouse_click);
7798 Qtimer_event = intern ("timer-event");
7799 staticpro (&Qtimer_event);
7800
7801 Qmenu_enable = intern ("menu-enable");
7802 staticpro (&Qmenu_enable);
7803
7804 Qmode_line = intern ("mode-line");
7805 staticpro (&Qmode_line);
7806 Qvertical_line = intern ("vertical-line");
7807 staticpro (&Qvertical_line);
7808 Qvertical_scroll_bar = intern ("vertical-scroll-bar");
7809 staticpro (&Qvertical_scroll_bar);
7810 Qmenu_bar = intern ("menu-bar");
7811 staticpro (&Qmenu_bar);
7812
7813 Qabove_handle = intern ("above-handle");
7814 staticpro (&Qabove_handle);
7815 Qhandle = intern ("handle");
7816 staticpro (&Qhandle);
7817 Qbelow_handle = intern ("below-handle");
7818 staticpro (&Qbelow_handle);
7819 Qup = intern ("up");
7820 staticpro (&Qup);
7821 Qdown = intern ("down");
7822 staticpro (&Qdown);
7823
7824 Qevent_kind = intern ("event-kind");
7825 staticpro (&Qevent_kind);
7826 Qevent_symbol_elements = intern ("event-symbol-elements");
7827 staticpro (&Qevent_symbol_elements);
7828 Qevent_symbol_element_mask = intern ("event-symbol-element-mask");
7829 staticpro (&Qevent_symbol_element_mask);
7830 Qmodifier_cache = intern ("modifier-cache");
7831 staticpro (&Qmodifier_cache);
7832
7833 Qrecompute_lucid_menubar = intern ("recompute-lucid-menubar");
7834 staticpro (&Qrecompute_lucid_menubar);
7835 Qactivate_menubar_hook = intern ("activate-menubar-hook");
7836 staticpro (&Qactivate_menubar_hook);
7837
7838 Qpolling_period = intern ("polling-period");
7839 staticpro (&Qpolling_period);
7840
7841 {
7842 struct event_head *p;
7843
7844 for (p = head_table;
7845 p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
7846 p++)
7847 {
7848 *p->var = intern (p->name);
7849 staticpro (p->var);
7850 Fput (*p->var, Qevent_kind, *p->kind);
7851 Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil));
7852 }
7853 }
7854
7855 button_down_location = Fmake_vector (make_number (NUM_MOUSE_BUTTONS), Qnil);
7856 staticpro (&button_down_location);
7857
7858 {
7859 int i;
7860 int len = sizeof (modifier_names) / sizeof (modifier_names[0]);
7861
7862 modifier_symbols = Fmake_vector (make_number (len), Qnil);
7863 for (i = 0; i < len; i++)
7864 if (modifier_names[i])
7865 XVECTOR (modifier_symbols)->contents[i] = intern (modifier_names[i]);
7866 staticpro (&modifier_symbols);
7867 }
7868
7869 recent_keys = Fmake_vector (make_number (NUM_RECENT_KEYS), Qnil);
7870 staticpro (&recent_keys);
7871
7872 this_command_keys = Fmake_vector (make_number (40), Qnil);
7873 staticpro (&this_command_keys);
7874
7875 Qextended_command_history = intern ("extended-command-history");
7876 Fset (Qextended_command_history, Qnil);
7877 staticpro (&Qextended_command_history);
7878
7879 kbd_buffer_frame_or_window
7880 = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil);
7881 staticpro (&kbd_buffer_frame_or_window);
7882
7883 accent_key_syms = Qnil;
7884 staticpro (&accent_key_syms);
7885
7886 func_key_syms = Qnil;
7887 staticpro (&func_key_syms);
7888
7889 mouse_syms = Qnil;
7890 staticpro (&mouse_syms);
7891
7892 unread_switch_frame = Qnil;
7893 staticpro (&unread_switch_frame);
7894
7895 defsubr (&Sevent_convert_list);
7896 defsubr (&Sread_key_sequence);
7897 defsubr (&Srecursive_edit);
7898 #ifdef HAVE_MOUSE
7899 defsubr (&Strack_mouse);
7900 #endif
7901 defsubr (&Sinput_pending_p);
7902 defsubr (&Scommand_execute);
7903 defsubr (&Srecent_keys);
7904 defsubr (&Sthis_command_keys);
7905 defsubr (&Sthis_single_command_keys);
7906 defsubr (&Sreset_this_command_lengths);
7907 defsubr (&Ssuspend_emacs);
7908 defsubr (&Sabort_recursive_edit);
7909 defsubr (&Sexit_recursive_edit);
7910 defsubr (&Srecursion_depth);
7911 defsubr (&Stop_level);
7912 defsubr (&Sdiscard_input);
7913 defsubr (&Sopen_dribble_file);
7914 defsubr (&Sset_input_mode);
7915 defsubr (&Scurrent_input_mode);
7916 defsubr (&Sexecute_extended_command);
7917
7918 DEFVAR_LISP ("last-command-char", &last_command_char,
7919 "Last input event that was part of a command.");
7920
7921 DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char,
7922 "Last input event that was part of a command.");
7923
7924 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event,
7925 "Last input event in a command, except for mouse menu events.\n\
7926 Mouse menus give back keys that don't look like mouse events;\n\
7927 this variable holds the actual mouse event that led to the menu,\n\
7928 so that you can determine whether the command was run by mouse or not.");
7929
7930 DEFVAR_LISP ("last-input-char", &last_input_char,
7931 "Last input event.");
7932
7933 DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char,
7934 "Last input event.");
7935
7936 DEFVAR_LISP ("unread-command-events", &Vunread_command_events,
7937 "List of objects to be read as next command input events.");
7938
7939 DEFVAR_INT ("unread-command-char", &unread_command_char,
7940 "If not -1, an object to be read as next command input event.");
7941
7942 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
7943 "Meta-prefix character code. Meta-foo as command input\n\
7944 turns into this character followed by foo.");
7945 XSETINT (meta_prefix_char, 033);
7946
7947 DEFVAR_KBOARD ("last-command", Vlast_command,
7948 "The last command executed. Normally a symbol with a function definition,\n\
7949 but can be whatever was found in the keymap, or whatever the variable\n\
7950 `this-command' was set to by that command.\n\
7951 \n\
7952 The value `mode-exit' is special; it means that the previous command\n\
7953 read an event that told it to exit, and it did so and unread that event.\n\
7954 In other words, the present command is the event that made the previous\n\
7955 command exit.\n\
7956 \n\
7957 The value `kill-region' is special; it means that the previous command\n\
7958 was a kill command.");
7959
7960 DEFVAR_LISP ("this-command", &this_command,
7961 "The command now being executed.\n\
7962 The command can set this variable; whatever is put here\n\
7963 will be in `last-command' during the following command.");
7964 this_command = Qnil;
7965
7966 DEFVAR_INT ("auto-save-interval", &auto_save_interval,
7967 "*Number of keyboard input characters between auto-saves.\n\
7968 Zero means disable autosaving due to number of characters typed.");
7969 auto_save_interval = 300;
7970
7971 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
7972 "*Number of seconds idle time before auto-save.\n\
7973 Zero or nil means disable auto-saving due to idleness.\n\
7974 After auto-saving due to this many seconds of idle time,\n\
7975 Emacs also does a garbage collection if that seems to be warranted.");
7976 XSETFASTINT (Vauto_save_timeout, 30);
7977
7978 DEFVAR_INT ("echo-keystrokes", &echo_keystrokes,
7979 "*Nonzero means echo unfinished commands after this many seconds of pause.");
7980 echo_keystrokes = 1;
7981
7982 DEFVAR_INT ("polling-period", &polling_period,
7983 "*Interval between polling for input during Lisp execution.\n\
7984 The reason for polling is to make C-g work to stop a running program.\n\
7985 Polling is needed only when using X windows and SIGIO does not work.\n\
7986 Polling is automatically disabled in all other cases.");
7987 polling_period = 2;
7988
7989 DEFVAR_LISP ("double-click-time", &Vdouble_click_time,
7990 "*Maximum time between mouse clicks to make a double-click.\n\
7991 Measured in milliseconds. nil means disable double-click recognition;\n\
7992 t means double-clicks have no time limit and are detected\n\
7993 by position only.");
7994 Vdouble_click_time = make_number (500);
7995
7996 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus,
7997 "*Non-nil means inhibit local map menu bar menus.");
7998 inhibit_local_menu_bar_menus = 0;
7999
8000 DEFVAR_INT ("num-input-keys", &num_input_keys,
8001 "Number of complete keys read from the keyboard so far.");
8002 num_input_keys = 0;
8003
8004 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame,
8005 "The frame in which the most recently read event occurred.\n\
8006 If the last event came from a keyboard macro, this is set to `macro'.");
8007 Vlast_event_frame = Qnil;
8008
8009 DEFVAR_LISP ("help-char", &Vhelp_char,
8010 "Character to recognize as meaning Help.\n\
8011 When it is read, do `(eval help-form)', and display result if it's a string.\n\
8012 If the value of `help-form' is nil, this char can be read normally.");
8013 XSETINT (Vhelp_char, Ctl ('H'));
8014
8015 DEFVAR_LISP ("help-event-list", &Vhelp_event_list,
8016 "List of input events to recognize as meaning Help.\n\
8017 These work just like the value of `help-char' (see that).");
8018 Vhelp_event_list = Qnil;
8019
8020 DEFVAR_LISP ("help-form", &Vhelp_form,
8021 "Form to execute when character `help-char' is read.\n\
8022 If the form returns a string, that string is displayed.\n\
8023 If `help-form' is nil, the help char is not recognized.");
8024 Vhelp_form = Qnil;
8025
8026 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command,
8027 "Command to run when `help-char' character follows a prefix key.\n\
8028 This command is used only when there is no actual binding\n\
8029 for that character after that prefix key.");
8030 Vprefix_help_command = Qnil;
8031
8032 DEFVAR_LISP ("top-level", &Vtop_level,
8033 "Form to evaluate when Emacs starts up.\n\
8034 Useful to set before you dump a modified Emacs.");
8035 Vtop_level = Qnil;
8036
8037 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
8038 "Translate table for keyboard input, or nil.\n\
8039 Each character is looked up in this string and the contents used instead.\n\
8040 The value may be a string, a vector, or a char-table.\n\
8041 If it is a string or vector of length N,\n\
8042 character codes N and up are untranslated.\n\
8043 In a vector or a char-table, an element which is nil means \"no translation\".");
8044 Vkeyboard_translate_table = Qnil;
8045
8046 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend,
8047 "Non-nil means to always spawn a subshell instead of suspending,\n\
8048 even if the operating system has support for stopping a process.");
8049 cannot_suspend = 0;
8050
8051 DEFVAR_BOOL ("menu-prompting", &menu_prompting,
8052 "Non-nil means prompt with menus when appropriate.\n\
8053 This is done when reading from a keymap that has a prompt string,\n\
8054 for elements that have prompt strings.\n\
8055 The menu is displayed on the screen\n\
8056 if X menus were enabled at configuration\n\
8057 time and the previous event was a mouse click prefix key.\n\
8058 Otherwise, menu prompting uses the echo area.");
8059 menu_prompting = 1;
8060
8061 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
8062 "Character to see next line of menu prompt.\n\
8063 Type this character while in a menu prompt to rotate around the lines of it.");
8064 XSETINT (menu_prompt_more_char, ' ');
8065
8066 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers,
8067 "A mask of additional modifier keys to use with every keyboard character.\n\
8068 Emacs applies the modifiers of the character stored here to each keyboard\n\
8069 character it reads. For example, after evaluating the expression\n\
8070 (setq extra-keyboard-modifiers ?\\C-x)\n\
8071 all input characters will have the control modifier applied to them.\n\
8072 \n\
8073 Note that the character ?\\C-@, equivalent to the integer zero, does\n\
8074 not count as a control character; rather, it counts as a character\n\
8075 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero\n\
8076 cancels any modification.");
8077 extra_keyboard_modifiers = 0;
8078
8079 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark,
8080 "If an editing command sets this to t, deactivate the mark afterward.\n\
8081 The command loop sets this to nil before each command,\n\
8082 and tests the value when the command returns.\n\
8083 Buffer modification stores t in this variable.");
8084 Vdeactivate_mark = Qnil;
8085
8086 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal,
8087 "Temporary storage of pre-command-hook or post-command-hook.");
8088 Vcommand_hook_internal = Qnil;
8089
8090 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook,
8091 "Normal hook run before each command is executed.\n\
8092 Errors running the hook are caught and ignored.");
8093 Vpre_command_hook = Qnil;
8094
8095 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook,
8096 "Normal hook run after each command is executed.\n\
8097 Errors running the hook are caught and ignored.");
8098 Vpost_command_hook = Qnil;
8099
8100 DEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook,
8101 "Normal hook run after each command is executed, if idle.\n\
8102 Errors running the hook are caught and ignored.\n\
8103 This feature is obsolete; use idle timers instead. See `etc/NEWS'.");
8104 Vpost_command_idle_hook = Qnil;
8105
8106 DEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay,
8107 "Delay time before running `post-command-idle-hook'.\n\
8108 This is measured in microseconds.");
8109 post_command_idle_delay = 100000;
8110
8111 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag,
8112 "t means menu bar, specified Lucid style, needs to be recomputed.");
8113 Vlucid_menu_bar_dirty_flag = Qnil;
8114
8115 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items,
8116 "List of menu bar items to move to the end of the menu bar.\n\
8117 The elements of the list are event types that may have menu bar bindings.");
8118 Vmenu_bar_final_items = Qnil;
8119
8120 DEFVAR_KBOARD ("overriding-terminal-local-map",
8121 Voverriding_terminal_local_map,
8122 "Keymap that overrides all other local keymaps.\n\
8123 If this variable is non-nil, it is used as a keymap instead of the\n\
8124 buffer's local map, and the minor mode keymaps and text property keymaps.");
8125
8126 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map,
8127 "Keymap that overrides all other local keymaps.\n\
8128 If this variable is non-nil, it is used as a keymap instead of the\n\
8129 buffer's local map, and the minor mode keymaps and text property keymaps.");
8130 Voverriding_local_map = Qnil;
8131
8132 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag,
8133 "Non-nil means `overriding-local-map' applies to the menu bar.\n\
8134 Otherwise, the menu bar continues to reflect the buffer's local map\n\
8135 and the minor mode maps regardless of `overriding-local-map'.");
8136 Voverriding_local_map_menu_flag = Qnil;
8137
8138 DEFVAR_LISP ("special-event-map", &Vspecial_event_map,
8139 "Keymap defining bindings for special events to execute at low level.");
8140 Vspecial_event_map = Fcons (intern ("keymap"), Qnil);
8141
8142 DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
8143 "*Non-nil means generate motion events for mouse motion.");
8144
8145 DEFVAR_KBOARD ("system-key-alist", Vsystem_key_alist,
8146 "Alist of system-specific X windows key symbols.\n\
8147 Each element should have the form (N . SYMBOL) where N is the\n\
8148 numeric keysym code (sans the \"system-specific\" bit 1<<28)\n\
8149 and SYMBOL is its name.");
8150
8151 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list,
8152 "List of deferred actions to be performed at a later time.\n\
8153 The precise format isn't relevant here; we just check whether it is nil.");
8154 Vdeferred_action_list = Qnil;
8155
8156 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function,
8157 "Function to call to handle deferred actions, after each command.\n\
8158 This function is called with no arguments after each command\n\
8159 whenever `deferred-action-list' is non-nil.");
8160 Vdeferred_action_function = Qnil;
8161
8162 DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings,
8163 "Non-nil means show the equivalent key-binding when M-x command has one.\n\
8164 The value can be a length of time to show the message for.\n\
8165 If the value is non-nil and not a number, we wait 2 seconds.");
8166 Vsuggest_key_bindings = Qt;
8167
8168 DEFVAR_LISP ("column-number-mode", &Vcolumn_number_mode,
8169 "Non-nil enables display of the current column number in the mode line.");
8170 Vcolumn_number_mode = Qnil;
8171
8172 DEFVAR_LISP ("timer-list", &Vtimer_list,
8173 "List of active absolute time timers in order of increasing time");
8174 Vtimer_list = Qnil;
8175
8176 DEFVAR_LISP ("timer-idle-list", &Vtimer_idle_list,
8177 "List of active idle-time timers in order of increasing time");
8178 Vtimer_idle_list = Qnil;
8179 }
8180
8181 keys_of_keyboard ()
8182 {
8183 initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
8184 initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
8185 initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
8186 initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
8187 initial_define_key (meta_map, 'x', "execute-extended-command");
8188
8189 initial_define_lispy_key (Vspecial_event_map, "delete-frame",
8190 "handle-delete-frame");
8191 initial_define_lispy_key (Vspecial_event_map, "iconify-frame",
8192 "ignore-event");
8193 initial_define_lispy_key (Vspecial_event_map, "make-frame-visible",
8194 "ignore-event");
8195 }