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