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