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