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