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