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