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