1 /* Keyboard and mouse input; editor command loop.
2 Copyright (C) 1985,86,87,88,89,93,94,95 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* Allow config.h to undefine symbols found here. */
28 #include "termhooks.h"
35 #include "dispextern.h"
37 #include "intervals.h"
38 #include "blockinput.h"
47 #include <sys/ioctl.h>
49 #endif /* not MSDOS */
51 #include "syssignal.h"
54 /* This is to get the definitions of the XK_ symbols. */
59 /* Include systime.h after xterm.h to avoid double inclusion of time.h. */
64 /* Variables for blockinput.h: */
66 /* Non-zero if interrupt input is blocked right now. */
67 int interrupt_input_blocked
;
69 /* Nonzero means an input interrupt has arrived
70 during the current critical section. */
71 int interrupt_input_pending
;
74 /* File descriptor to use for input. */
78 /* Make all keyboard buffers much bigger when using X windows. */
79 #define KBD_BUFFER_SIZE 4096
80 #else /* No X-windows, character input */
81 #define KBD_BUFFER_SIZE 256
82 #endif /* No X-windows */
84 /* Following definition copied from eval.c */
88 struct backtrace
*next
;
89 Lisp_Object
*function
;
90 Lisp_Object
*args
; /* Points to vector of args. */
91 int nargs
; /* length of vector. If nargs is UNEVALLED,
92 args points to slot holding list of
97 #ifdef MULTI_PERDISPLAY
98 PERDISPLAY
*current_perdisplay
;
99 PERDISPLAY
*all_perdisplays
;
102 PERDISPLAY the_only_perdisplay
;
105 /* Non-nil disable property on a command means
106 do not execute it; call disabled-command-hook's value instead. */
107 Lisp_Object Qdisabled
, Qdisabled_command_hook
;
109 #define NUM_RECENT_KEYS (100)
110 int recent_keys_index
; /* Index for storing next element into recent_keys */
111 int total_keys
; /* Total number of elements stored into recent_keys */
112 Lisp_Object recent_keys
; /* A vector, holding the last 100 keystrokes */
114 /* Vector holding the key sequence that invoked the current command.
115 It is reused for each command, and it may be longer than the current
116 sequence; this_command_key_count indicates how many elements
117 actually mean something.
118 It's easier to staticpro a single Lisp_Object than an array. */
119 Lisp_Object this_command_keys
;
120 int this_command_key_count
;
122 extern int minbuf_level
;
124 extern struct backtrace
*backtrace_list
;
126 /* Nonzero means do menu prompting. */
127 static int menu_prompting
;
129 /* Character to see next line of menu prompt. */
130 static Lisp_Object menu_prompt_more_char
;
132 /* For longjmp to where kbd input is being done. */
133 static jmp_buf getcjmp
;
135 /* True while doing kbd input. */
136 int waiting_for_input
;
138 /* True while displaying for echoing. Delays C-g throwing. */
141 /* Nonzero means disregard local maps for the menu bar. */
142 static int inhibit_local_menu_bar_menus
;
144 /* Nonzero means C-g should cause immediate error-signal. */
147 /* Character to recognize as the help char. */
148 Lisp_Object Vhelp_char
;
150 /* Form to execute when help char is typed. */
151 Lisp_Object Vhelp_form
;
153 /* Command to run when the help character follows a prefix key. */
154 Lisp_Object Vprefix_help_command
;
156 /* List of items that should move to the end of the menu bar. */
157 Lisp_Object Vmenu_bar_final_items
;
159 /* Character that causes a quit. Normally C-g.
161 If we are running on an ordinary terminal, this must be an ordinary
162 ASCII char, since we want to make it our interrupt character.
164 If we are not running on an ordinary terminal, it still needs to be
165 an ordinary ASCII char. This character needs to be recognized in
166 the input interrupt handler. At this point, the keystroke is
167 represented as a struct input_event, while the desired quit
168 character is specified as a lispy event. The mapping from struct
169 input_events to lispy events cannot run in an interrupt handler,
170 and the reverse mapping is difficult for anything but ASCII
173 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
177 extern Lisp_Object current_global_map
;
178 extern int minibuf_level
;
180 /* If non-nil, this is a map that overrides all other local maps. */
181 Lisp_Object Voverriding_local_map
;
183 /* If non-nil, Voverriding_local_map applies to the menu bar. */
184 Lisp_Object Voverriding_local_map_menu_flag
;
186 /* Current depth in recursive edits. */
187 int command_loop_level
;
189 /* Total number of times command_loop has read a key sequence. */
192 /* Last input character read as a command. */
193 Lisp_Object last_command_char
;
195 /* Last input character read as a command, not counting menus
196 reached by the mouse. */
197 Lisp_Object last_nonmenu_event
;
199 /* Last input character read for any purpose. */
200 Lisp_Object last_input_char
;
202 /* If not Qnil, a list of objects to be read as subsequent command input. */
203 Lisp_Object Vunread_command_events
;
205 /* If not -1, an event to be read as subsequent command input. */
206 int unread_command_char
;
208 /* If not Qnil, this is a switch-frame event which we decided to put
209 off until the end of a key sequence. This should be read as the
210 next command input, after any unread_command_events.
212 read_key_sequence uses this to delay switch-frame events until the
213 end of the key sequence; Fread_char uses it to put off switch-frame
214 events until a non-ASCII event is acceptable as input. */
215 Lisp_Object unread_switch_frame
;
217 /* A mask of extra modifier bits to put into every keyboard char. */
218 int extra_keyboard_modifiers
;
220 /* Char to use as prefix when a meta character is typed in.
221 This is bound on entry to minibuffer in case ESC is changed there. */
223 Lisp_Object meta_prefix_char
;
225 /* Last size recorded for a current buffer which is not a minibuffer. */
226 static int last_non_minibuf_size
;
228 /* Number of idle seconds before an auto-save and garbage collection. */
229 static Lisp_Object Vauto_save_timeout
;
231 /* Total number of times read_char has returned. */
234 /* Total number of times read_char has returned, outside of macros. */
235 int num_nonmacro_input_chars
;
237 /* Auto-save automatically when this many characters have been typed
238 since the last time. */
240 static int auto_save_interval
;
242 /* Value of num_nonmacro_input_chars as of last auto save. */
246 /* Last command executed by the editor command loop, not counting
247 commands that set the prefix argument. */
249 Lisp_Object last_command
;
251 /* The command being executed by the command loop.
252 Commands may set this, and the value set will be copied into last_command
253 instead of the actual command. */
254 Lisp_Object this_command
;
256 /* The value of point when the last command was executed. */
257 int last_point_position
;
259 /* The buffer that was current when the last command was started. */
260 Lisp_Object last_point_position_buffer
;
263 /* The frame in which the last input event occurred, or Qmacro if the
264 last event came from a macro. We use this to determine when to
265 generate switch-frame events. This may be cleared by functions
266 like Fselect_frame, to make sure that a switch-frame event is
267 generated by the next character. */
268 Lisp_Object internal_last_event_frame
;
271 /* A user-visible version of the above, intended to allow users to
272 figure out where the last event came from, if the event doesn't
273 carry that information itself (i.e. if it was a character). */
274 Lisp_Object Vlast_event_frame
;
276 /* The timestamp of the last input event we received from the X server.
277 X Windows wants this for selection ownership. */
278 unsigned long last_event_timestamp
;
280 Lisp_Object Qself_insert_command
;
281 Lisp_Object Qforward_char
;
282 Lisp_Object Qbackward_char
;
283 Lisp_Object Qundefined
;
284 Lisp_Object Quniversal_argument
, Qdigit_argument
, Qnegative_argument
;
286 /* read_key_sequence stores here the command definition of the
287 key sequence that it reads. */
288 Lisp_Object read_key_sequence_cmd
;
290 /* Form to evaluate (if non-nil) when Emacs is started. */
291 Lisp_Object Vtop_level
;
293 /* User-supplied string to translate input characters through. */
294 Lisp_Object Vkeyboard_translate_table
;
296 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
297 extern Lisp_Object Vfunction_key_map
;
299 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
300 Lisp_Object Vkey_translation_map
;
302 /* Non-nil means deactivate the mark at end of this command. */
303 Lisp_Object Vdeactivate_mark
;
305 /* Menu bar specified in Lucid Emacs fashion. */
307 Lisp_Object Vlucid_menu_bar_dirty_flag
;
308 Lisp_Object Qrecompute_lucid_menubar
, Qactivate_menubar_hook
;
310 /* Hooks to run before and after each command. */
311 Lisp_Object Qpre_command_hook
, Qpost_command_hook
;
312 Lisp_Object Vpre_command_hook
, Vpost_command_hook
;
313 Lisp_Object Qcommand_hook_internal
, Vcommand_hook_internal
;
315 /* List of deferred actions to be performed at a later time.
316 The precise format isn't relevant here; we just check whether it is nil. */
317 Lisp_Object Vdeferred_action_list
;
319 /* Function to call to handle deferred actions, when there are any. */
320 Lisp_Object Vdeferred_action_function
;
321 Lisp_Object Qdeferred_action_function
;
323 /* File in which we write all commands we read. */
326 /* Nonzero if input is available. */
329 /* 1 if should obey 0200 bit in input chars as "Meta", 2 if should
330 keep 0200 bit in input chars. 0 to ignore the 0200 bit. */
334 extern char *pending_malloc_warning
;
336 /* Circular buffer for pre-read keyboard input. */
337 static struct input_event kbd_buffer
[KBD_BUFFER_SIZE
];
339 /* Vector to GCPRO the frames and windows mentioned in kbd_buffer.
341 The interrupt-level event handlers will never enqueue an event on a
342 frame which is not in Vframe_list, and once an event is dequeued,
343 internal_last_event_frame or the event itself points to the frame.
346 But while the event is sitting in the queue, it's completely
347 unprotected. Suppose the user types one command which will run for
348 a while and then delete a frame, and then types another event at
349 the frame that will be deleted, before the command gets around to
350 it. Suppose there are no references to this frame elsewhere in
351 Emacs, and a GC occurs before the second event is dequeued. Now we
352 have an event referring to a freed frame, which will crash Emacs
355 Similar things happen when an event on a scroll bar is enqueued; the
356 window may be deleted while the event is in the queue.
358 So, we use this vector to protect the frame_or_window field in the
359 event queue. That way, they'll be dequeued as dead frames or
360 windows, but still valid lisp objects.
362 If kbd_buffer[i].kind != no_event, then
363 (XVECTOR (kbd_buffer_frame_or_window)->contents[i]
364 == kbd_buffer[i].frame_or_window. */
365 static Lisp_Object kbd_buffer_frame_or_window
;
367 /* Pointer to next available character in kbd_buffer.
368 If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
369 This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the the
370 next available char is in kbd_buffer[0]. */
371 static struct input_event
*kbd_fetch_ptr
;
373 /* Pointer to next place to store character in kbd_buffer. This
374 may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
375 character should go in kbd_buffer[0]. */
376 static volatile struct input_event
*kbd_store_ptr
;
378 /* The above pair of variables forms a "queue empty" flag. When we
379 enqueue a non-hook event, we increment kbd_store_ptr. When we
380 dequeue a non-hook event, we increment kbd_fetch_ptr. We say that
381 there is input available iff the two pointers are not equal.
383 Why not just have a flag set and cleared by the enqueuing and
384 dequeuing functions? Such a flag could be screwed up by interrupts
385 at inopportune times. */
388 /* If this flag is a frame, we check mouse_moved to see when the
389 mouse moves, and motion events will appear in the input stream.
390 Otherwise, mouse motion is ignored. */
391 static Lisp_Object do_mouse_tracking
;
393 /* The window system handling code should set this if the mouse has
394 moved since the last call to the mouse_position_hook. Calling that
395 hook should clear this. Code assumes that if this is set, it can
396 call mouse_position_hook to get the promised position, so don't set
397 it unless you're prepared to substantiate the claim! */
399 #endif /* HAVE_MOUSE. */
401 /* Symbols to head events. */
402 Lisp_Object Qmouse_movement
;
403 Lisp_Object Qscroll_bar_movement
;
404 Lisp_Object Qswitch_frame
;
405 Lisp_Object Qdelete_frame
;
406 Lisp_Object Qiconify_frame
;
407 Lisp_Object Qmake_frame_visible
;
409 /* Symbols to denote kinds of events. */
410 Lisp_Object Qfunction_key
;
411 Lisp_Object Qmouse_click
;
412 /* Lisp_Object Qmouse_movement; - also an event header */
414 /* Properties of event headers. */
415 Lisp_Object Qevent_kind
;
416 Lisp_Object Qevent_symbol_elements
;
418 Lisp_Object Qmenu_enable
;
420 /* An event header symbol HEAD may have a property named
421 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
422 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
423 mask of modifiers applied to it. If present, this is used to help
424 speed up parse_modifiers. */
425 Lisp_Object Qevent_symbol_element_mask
;
427 /* An unmodified event header BASE may have a property named
428 Qmodifier_cache, which is an alist mapping modifier masks onto
429 modified versions of BASE. If present, this helps speed up
431 Lisp_Object Qmodifier_cache
;
433 /* Symbols to use for parts of windows. */
434 Lisp_Object Qmode_line
;
435 Lisp_Object Qvertical_line
;
436 Lisp_Object Qvertical_scroll_bar
;
437 Lisp_Object Qmenu_bar
;
439 extern Lisp_Object Qmenu_enable
;
441 Lisp_Object
recursive_edit_unwind (), command_loop ();
442 Lisp_Object
Fthis_command_keys ();
443 Lisp_Object Qextended_command_history
;
445 Lisp_Object Qpolling_period
;
447 /* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
449 EMACS_TIME
*input_available_clear_time
;
451 /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
452 Default is 1 if INTERRUPT_INPUT is defined. */
455 /* Nonzero while interrupts are temporarily deferred during redisplay. */
456 int interrupts_deferred
;
458 /* nonzero means use ^S/^Q for flow control. */
461 /* Allow m- file to inhibit use of FIONREAD. */
462 #ifdef BROKEN_FIONREAD
466 /* We are unable to use interrupts if FIONREAD is not available,
467 so flush SIGIO so we won't try. */
474 /* If we support X Windows, turn on the code to poll periodically
475 to detect C-g. It isn't actually used when doing interrupt input. */
476 #ifdef HAVE_X_WINDOWS
477 #define POLL_FOR_INPUT
480 /* Global variable declarations. */
482 /* Function for init_keyboard to call with no args (if nonzero). */
483 void (*keyboard_init_hook
) ();
485 static int read_avail_input ();
486 static void get_input_pending ();
487 static int readable_events ();
488 static Lisp_Object
read_char_x_menu_prompt ();
489 static Lisp_Object
read_char_minibuf_menu_prompt ();
490 static Lisp_Object
make_lispy_event ();
491 static Lisp_Object
make_lispy_movement ();
492 static Lisp_Object
modify_event_symbol ();
493 static Lisp_Object
make_lispy_switch_frame ();
495 /* > 0 if we are to echo keystrokes. */
496 static int echo_keystrokes
;
498 /* Nonzero means don't try to suspend even if the operating system seems
500 static int cannot_suspend
;
502 #define min(a,b) ((a)<(b)?(a):(b))
503 #define max(a,b) ((a)>(b)?(a):(b))
505 /* Install the string STR as the beginning of the string of echoing,
506 so that it serves as a prompt for the next character.
507 Also start echoing. */
512 int len
= strlen (str
);
514 if (len
> ECHOBUFSIZE
- 4)
515 len
= ECHOBUFSIZE
- 4;
516 bcopy (str
, current_perdisplay
->echobuf
, len
);
517 current_perdisplay
->echoptr
= current_perdisplay
->echobuf
+ len
;
518 *current_perdisplay
->echoptr
= '\0';
520 current_perdisplay
->echo_after_prompt
= len
;
525 /* Add C to the echo string, if echoing is going on.
526 C can be a character, which is printed prettily ("M-C-x" and all that
527 jazz), or a symbol, whose name is printed. */
532 extern char *push_key_description ();
534 if (current_perdisplay
->immediate_echo
)
536 char *ptr
= current_perdisplay
->echoptr
;
538 if (ptr
!= current_perdisplay
->echobuf
)
541 /* If someone has passed us a composite event, use its head symbol. */
546 if (ptr
- current_perdisplay
->echobuf
> ECHOBUFSIZE
- 6)
549 ptr
= push_key_description (XINT (c
), ptr
);
551 else if (SYMBOLP (c
))
553 struct Lisp_String
*name
= XSYMBOL (c
)->name
;
554 if (((ptr
- current_perdisplay
->echobuf
) + name
->size
+ 4)
557 bcopy (name
->data
, ptr
, name
->size
);
561 if (current_perdisplay
->echoptr
== current_perdisplay
->echobuf
562 && EQ (c
, Vhelp_char
))
564 strcpy (ptr
, " (Type ? for further options)");
569 current_perdisplay
->echoptr
= ptr
;
575 /* Temporarily add a dash to the end of the echo string if it's not
576 empty, so that it serves as a mini-prompt for the very next character. */
580 if (!current_perdisplay
->immediate_echo
581 && current_perdisplay
->echoptr
== current_perdisplay
->echobuf
)
583 /* Do nothing if we just printed a prompt. */
584 if (current_perdisplay
->echo_after_prompt
585 == current_perdisplay
->echoptr
- current_perdisplay
->echobuf
)
587 /* Do nothing if not echoing at all. */
588 if (current_perdisplay
->echoptr
== 0)
591 /* Put a dash at the end of the buffer temporarily,
592 but make it go away when the next character is added. */
593 current_perdisplay
->echoptr
[0] = '-';
594 current_perdisplay
->echoptr
[1] = 0;
599 /* Display the current echo string, and begin echoing if not already
604 if (!current_perdisplay
->immediate_echo
)
607 current_perdisplay
->immediate_echo
= 1;
609 for (i
= 0; i
< this_command_key_count
; i
++)
612 c
= XVECTOR (this_command_keys
)->contents
[i
];
613 if (! (EVENT_HAS_PARAMETERS (c
)
614 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c
)), Qmouse_movement
)))
621 message1_nolog (current_perdisplay
->echobuf
);
624 if (waiting_for_input
&& !NILP (Vquit_flag
))
625 quit_throw_to_read_char ();
628 /* Turn off echoing, for the start of a new command. */
632 current_perdisplay
->immediate_echo
= 0;
633 current_perdisplay
->echoptr
= current_perdisplay
->echobuf
;
634 current_perdisplay
->echo_after_prompt
= -1;
637 /* Return the length of the current echo string. */
642 return current_perdisplay
->echoptr
- current_perdisplay
->echobuf
;
645 /* Truncate the current echo message to its first LEN chars.
646 This and echo_char get used by read_key_sequence when the user
647 switches frames while entering a key sequence. */
653 current_perdisplay
->echobuf
[len
] = '\0';
654 current_perdisplay
->echoptr
= current_perdisplay
->echobuf
+ len
;
655 truncate_echo_area (len
);
659 /* Functions for manipulating this_command_keys. */
661 add_command_key (key
)
664 int size
= XVECTOR (this_command_keys
)->size
;
666 if (this_command_key_count
>= size
)
668 Lisp_Object new_keys
;
670 new_keys
= Fmake_vector (make_number (size
* 2), Qnil
);
671 bcopy (XVECTOR (this_command_keys
)->contents
,
672 XVECTOR (new_keys
)->contents
,
673 size
* sizeof (Lisp_Object
));
675 this_command_keys
= new_keys
;
678 XVECTOR (this_command_keys
)->contents
[this_command_key_count
++] = key
;
684 int count
= specpdl_ptr
- specpdl
;
687 if (command_loop_level
> 0)
689 specbind (Qstandard_output
, Qt
);
690 specbind (Qstandard_input
, Qt
);
693 val
= command_loop ();
695 Fsignal (Qquit
, Qnil
);
697 return unbind_to (count
, Qnil
);
700 /* When an auto-save happens, record the "time", and don't do again soon. */
704 last_auto_save
= num_nonmacro_input_chars
;
707 /* Make an auto save happen as soon as possible at command level. */
709 force_auto_save_soon ()
711 last_auto_save
= - auto_save_interval
- 1;
713 record_asynch_buffer_change ();
716 DEFUN ("recursive-edit", Frecursive_edit
, Srecursive_edit
, 0, 0, "",
717 "Invoke the editor command loop recursively.\n\
718 To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
719 that tells this function to return.\n\
720 Alternately, `(throw 'exit t)' makes this function signal an error.\n\
721 This function is called by the editor initialization to begin editing.")
724 int count
= specpdl_ptr
- specpdl
;
727 command_loop_level
++;
728 update_mode_lines
= 1;
730 record_unwind_protect (recursive_edit_unwind
,
732 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
736 return unbind_to (count
, Qnil
);
740 recursive_edit_unwind (buffer
)
744 Fset_buffer (buffer
);
746 command_loop_level
--;
747 update_mode_lines
= 1;
751 #ifdef MULTI_PERDISPLAY
755 if (CONSP (Vunread_command_events
))
756 current_perdisplay
->kbd_queue
757 = nconc2 (Vunread_command_events
, current_perdisplay
->kbd_queue
);
758 Vunread_command_events
= Qnil
;
759 current_perdisplay
= 0;
768 Vstandard_output
= Qt
;
769 Vstandard_input
= Qt
;
770 Vexecuting_macro
= Qnil
;
771 if (current_perdisplay
)
776 cmd_error_internal (data
, 0);
780 Vinhibit_quit
= Qnil
;
781 #ifdef MULTI_PERDISPLAY
782 if (current_perdisplay
)
786 return make_number (0);
789 cmd_error_internal (data
, context
)
793 Lisp_Object errmsg
, tail
, errname
, file_error
;
800 echo_area_glyphs
= 0;
802 /* If the window system or terminal frame hasn't been initialized
803 yet, or we're not interactive, it's best to dump this message out
804 to stderr and exit. */
805 if (! FRAME_MESSAGE_BUF (selected_frame
)
807 stream
= Qexternal_debugging_output
;
816 write_string_1 (context
, -1, stream
);
818 errname
= Fcar (data
);
820 if (EQ (errname
, Qerror
))
823 if (!CONSP (data
)) data
= Qnil
;
824 errmsg
= Fcar (data
);
829 errmsg
= Fget (errname
, Qerror_message
);
830 file_error
= Fmemq (Qfile_error
,
831 Fget (errname
, Qerror_conditions
));
834 /* Print an error message including the data items.
835 This is done by printing it into a scratch buffer
836 and then making a copy of the text in the buffer. */
838 if (!CONSP (data
)) data
= Qnil
;
842 /* For file-error, make error message by concatenating
843 all the data items. They are all strings. */
844 if (!NILP (file_error
) && !NILP (tail
))
845 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
847 if (STRINGP (errmsg
))
848 Fprinc (errmsg
, stream
);
850 write_string_1 ("peculiar error", -1, stream
);
852 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
854 write_string_1 (i
? ", " : ": ", 2, stream
);
855 if (!NILP (file_error
))
856 Fprinc (Fcar (tail
), stream
);
858 Fprin1 (Fcar (tail
), stream
);
862 /* If the window system or terminal frame hasn't been initialized
863 yet, or we're in -batch mode, this error should cause Emacs to exit. */
864 if (! FRAME_MESSAGE_BUF (selected_frame
)
868 Fkill_emacs (make_number (-1));
872 Lisp_Object
command_loop_1 ();
873 Lisp_Object
command_loop_2 ();
874 Lisp_Object
top_level_1 ();
876 /* Entry to editor-command-loop.
877 This level has the catches for exiting/returning to editor command loop.
878 It returns nil to exit recursive edit, t to abort it. */
883 if (command_loop_level
> 0 || minibuf_level
> 0)
885 return internal_catch (Qexit
, command_loop_2
, Qnil
);
890 internal_catch (Qtop_level
, top_level_1
, Qnil
);
891 internal_catch (Qtop_level
, command_loop_2
, Qnil
);
893 /* End of file in -batch run causes exit here. */
899 /* Here we catch errors in execution of commands within the
900 editing loop, and reenter the editing loop.
901 When there is an error, cmd_error runs and returns a non-nil
902 value to us. A value of nil means that cmd_loop_1 itself
903 returned due to end of file (or end of kbd macro). */
908 register Lisp_Object val
;
911 val
= internal_condition_case (command_loop_1
, Qerror
, cmd_error
);
920 return Feval (Vtop_level
);
926 /* On entry to the outer level, run the startup file */
927 if (!NILP (Vtop_level
))
928 internal_condition_case (top_level_2
, Qerror
, cmd_error
);
929 else if (!NILP (Vpurify_flag
))
930 message ("Bare impure Emacs (standard Lisp code not loaded)");
932 message ("Bare Emacs (standard Lisp code not loaded)");
936 DEFUN ("top-level", Ftop_level
, Stop_level
, 0, 0, "",
937 "Exit all recursive editing levels.")
940 Fthrow (Qtop_level
, Qnil
);
943 DEFUN ("exit-recursive-edit", Fexit_recursive_edit
, Sexit_recursive_edit
, 0, 0, "",
944 "Exit from the innermost recursive edit or minibuffer.")
947 if (command_loop_level
> 0 || minibuf_level
> 0)
948 Fthrow (Qexit
, Qnil
);
950 error ("No recursive edit is in progress");
953 DEFUN ("abort-recursive-edit", Fabort_recursive_edit
, Sabort_recursive_edit
, 0, 0, "",
954 "Abort the command that requested this recursive edit or minibuffer input.")
957 if (command_loop_level
> 0 || minibuf_level
> 0)
960 error ("No recursive edit is in progress");
966 if (!current_perdisplay
)
968 current_perdisplay
->prefix_factor
= Qnil
;
969 current_perdisplay
->prefix_value
= Qnil
;
970 current_perdisplay
->prefix_sign
= 1;
971 current_perdisplay
->prefix_partial
= 0;
976 finalize_prefix_arg ()
978 if (!NILP (current_perdisplay
->prefix_factor
))
979 Vprefix_arg
= Fcons (current_perdisplay
->prefix_factor
, Qnil
);
980 else if (NILP (current_perdisplay
->prefix_value
))
981 Vprefix_arg
= (current_perdisplay
->prefix_sign
> 0 ? Qnil
: Qminus
);
982 else if (current_perdisplay
->prefix_sign
> 0)
983 Vprefix_arg
= current_perdisplay
->prefix_value
;
985 XSETINT (Vprefix_arg
, -XINT (current_perdisplay
->prefix_value
));
986 current_perdisplay
->prefix_partial
= 0;
990 describe_prefix_arg ()
992 if (INTEGERP (Vprefix_arg
))
993 message ("Arg: %d", Vprefix_arg
);
994 else if (CONSP (Vprefix_arg
))
995 message ("Arg: [%d]", XCONS (Vprefix_arg
)->car
);
996 else if (EQ (Vprefix_arg
, Qminus
))
1000 /* This is the actual command reading loop,
1001 sans error-handling encapsulation. */
1003 Lisp_Object
Fcommand_execute ();
1004 static int read_key_sequence ();
1005 static void safe_run_hooks ();
1010 Lisp_Object cmd
, tem
;
1013 Lisp_Object keybuf
[30];
1018 struct buffer
*prev_buffer
;
1019 #ifdef MULTI_PERDISPLAY
1020 int was_locked
= display_locked
;
1023 Vdeactivate_mark
= Qnil
;
1024 waiting_for_input
= 0;
1025 if (current_perdisplay
)
1030 this_command_key_count
= 0;
1032 /* Make sure this hook runs after commands that get errors and
1033 throw to top level. */
1034 /* Note that the value cell will never directly contain nil
1035 if the symbol is a local variable. */
1036 if (!NILP (XSYMBOL (Qpost_command_hook
)->value
) && !NILP (Vrun_hooks
))
1037 safe_run_hooks (Qpost_command_hook
);
1039 if (!NILP (Vdeferred_action_list
))
1040 call0 (Vdeferred_action_function
);
1042 /* Do this after running Vpost_command_hook, for consistency. */
1043 last_command
= this_command
;
1047 /* Make sure the current window's buffer is selected. */
1048 if (XBUFFER (XWINDOW (selected_window
)->buffer
) != current_buffer
)
1049 set_buffer_internal (XBUFFER (XWINDOW (selected_window
)->buffer
));
1051 /* Display any malloc warning that just came out. Use while because
1052 displaying one warning can cause another. */
1054 while (pending_malloc_warning
)
1055 display_malloc_warning ();
1059 Vdeactivate_mark
= Qnil
;
1061 /* If minibuffer on and echo area in use,
1062 wait 2 sec and redraw minibuffer. */
1064 if (minibuf_level
&& echo_area_glyphs
)
1066 /* Bind inhibit-quit to t so that C-g gets read in
1067 rather than quitting back to the minibuffer. */
1068 int count
= specpdl_ptr
- specpdl
;
1069 specbind (Qinhibit_quit
, Qt
);
1070 Fsit_for (make_number (2), Qnil
, Qnil
);
1071 unbind_to (count
, Qnil
);
1073 echo_area_glyphs
= 0;
1075 if (!NILP (Vquit_flag
))
1078 Vunread_command_events
= Fcons (make_number (quit_char
), Qnil
);
1083 alloca (0); /* Cause a garbage collection now */
1084 /* Since we can free the most stuff here. */
1085 #endif /* C_ALLOCA */
1089 /* Select the frame that the last event came from. Usually,
1090 switch-frame events will take care of this, but if some lisp
1091 code swallows a switch-frame event, we'll fix things up here.
1092 Is this a good idea? */
1093 if (FRAMEP (internal_last_event_frame
)
1094 && XFRAME (internal_last_event_frame
) != selected_frame
)
1095 Fselect_frame (internal_last_event_frame
, Qnil
);
1098 /* If it has changed current-menubar from previous value,
1099 really recompute the menubar from the value. */
1100 if (! NILP (Vlucid_menu_bar_dirty_flag
)
1101 && !NILP (Ffboundp (Qrecompute_lucid_menubar
)))
1102 call0 (Qrecompute_lucid_menubar
);
1104 /* Read next key sequence; i gets its length. */
1105 i
= read_key_sequence (keybuf
, sizeof keybuf
/ sizeof keybuf
[0],
1110 /* Now we have read a key sequence of length I,
1111 or else I is 0 and we found end of file. */
1113 if (i
== 0) /* End of file -- happens only in */
1114 return Qnil
; /* a kbd macro, at the end. */
1115 /* -1 means read_key_sequence got a menu that was rejected.
1116 Just loop around and read another command. */
1120 this_command_key_count
= 0;
1124 last_command_char
= keybuf
[i
- 1];
1126 /* If the previous command tried to force a specific window-start,
1127 forget about that, in case this command moves point far away
1128 from that position. */
1129 XWINDOW (selected_window
)->force_start
= Qnil
;
1131 cmd
= read_key_sequence_cmd
;
1132 if (!NILP (Vexecuting_macro
))
1134 if (!NILP (Vquit_flag
))
1136 Vexecuting_macro
= Qt
;
1137 QUIT
; /* Make some noise. */
1138 /* Will return since macro now empty. */
1142 /* Do redisplay processing after this command except in special
1143 cases identified below that set no_redisplay to 1.
1144 (actually, there's currently no way to prevent the redisplay,
1145 and no_redisplay is ignored.
1146 Perhaps someday we will really implement it.) */
1149 prev_buffer
= current_buffer
;
1150 prev_modiff
= MODIFF
;
1151 last_point_position
= PT
;
1152 XSETBUFFER (last_point_position_buffer
, prev_buffer
);
1154 /* If we're building a prefix argument, override minus and digits. */
1155 if (current_perdisplay
->prefix_partial
&& i
== 1 && NATNUMP (keybuf
[0]))
1157 if (XFASTINT (keybuf
[0]) == '-'
1158 && NILP (current_perdisplay
->prefix_value
))
1159 cmd
= Qnegative_argument
;
1160 else if (XFASTINT (keybuf
[0]) >= '0' && XFASTINT (keybuf
[0]) <= '9')
1161 cmd
= Qdigit_argument
;
1164 /* Execute the command. */
1167 /* Note that the value cell will never directly contain nil
1168 if the symbol is a local variable. */
1169 if (!NILP (XSYMBOL (Qpre_command_hook
)->value
) && !NILP (Vrun_hooks
))
1170 safe_run_hooks (Qpre_command_hook
);
1172 if (NILP (this_command
))
1174 /* nil means key is undefined. */
1176 current_perdisplay
->defining_kbd_macro
= Qnil
;
1177 update_mode_lines
= 1;
1178 clear_prefix_arg ();
1182 if (EQ (cmd
, Quniversal_argument
))
1184 if (!current_perdisplay
->prefix_partial
)
1187 XSETFASTINT (current_perdisplay
->prefix_factor
, 4);
1188 current_perdisplay
->prefix_value
= Qnil
;
1189 current_perdisplay
->prefix_sign
= 1;
1190 current_perdisplay
->prefix_partial
= 1;
1192 else if (!NILP (current_perdisplay
->prefix_factor
))
1194 /* Subsequent C-u */
1195 XSETINT (current_perdisplay
->prefix_factor
,
1196 XINT (current_perdisplay
->prefix_factor
) * 4);
1200 /* Terminating C-u */
1201 finalize_prefix_arg ();
1202 describe_prefix_arg ();
1206 else if (EQ (cmd
, Qnegative_argument
))
1208 current_perdisplay
->prefix_factor
= Qnil
;
1209 current_perdisplay
->prefix_sign
*= -1;
1210 current_perdisplay
->prefix_partial
= 1;
1213 else if (EQ (cmd
, Qdigit_argument
) && INTEGERP (keybuf
[0]))
1215 current_perdisplay
->prefix_factor
= Qnil
;
1216 if (NILP (current_perdisplay
->prefix_value
))
1217 XSETFASTINT (current_perdisplay
->prefix_value
, 0);
1218 XSETINT (current_perdisplay
->prefix_value
,
1219 (XINT (current_perdisplay
->prefix_value
) * 10
1220 + (XINT (keybuf
[0]) & 0177) - '0'));
1221 current_perdisplay
->prefix_partial
= 1;
1224 if (current_perdisplay
->prefix_partial
)
1225 finalize_prefix_arg ();
1227 if (NILP (Vprefix_arg
) && ! no_direct
)
1229 /* Recognize some common commands in common situations and
1230 do them directly. */
1231 if (EQ (this_command
, Qforward_char
) && PT
< ZV
)
1233 struct Lisp_Vector
*dp
1234 = window_display_table (XWINDOW (selected_window
));
1235 lose
= FETCH_CHAR (PT
);
1238 ? (VECTORP (DISP_CHAR_VECTOR (dp
, lose
))
1239 ? XVECTOR (DISP_CHAR_VECTOR (dp
, lose
))->size
== 1
1240 : (NILP (DISP_CHAR_VECTOR (dp
, lose
))
1241 && (lose
>= 0x20 && lose
< 0x7f)))
1242 : (lose
>= 0x20 && lose
< 0x7f))
1243 && (XFASTINT (XWINDOW (selected_window
)->last_modified
)
1245 && (XFASTINT (XWINDOW (selected_window
)->last_point
)
1247 && !windows_or_buffers_changed
1248 && EQ (current_buffer
->selective_display
, Qnil
)
1249 && !detect_input_pending ()
1250 && NILP (Vexecuting_macro
))
1251 no_redisplay
= direct_output_forward_char (1);
1254 else if (EQ (this_command
, Qbackward_char
) && PT
> BEGV
)
1256 struct Lisp_Vector
*dp
1257 = window_display_table (XWINDOW (selected_window
));
1259 lose
= FETCH_CHAR (PT
);
1261 ? (VECTORP (DISP_CHAR_VECTOR (dp
, lose
))
1262 ? XVECTOR (DISP_CHAR_VECTOR (dp
, lose
))->size
== 1
1263 : (NILP (DISP_CHAR_VECTOR (dp
, lose
))
1264 && (lose
>= 0x20 && lose
< 0x7f)))
1265 : (lose
>= 0x20 && lose
< 0x7f))
1266 && (XFASTINT (XWINDOW (selected_window
)->last_modified
)
1268 && (XFASTINT (XWINDOW (selected_window
)->last_point
)
1270 && !windows_or_buffers_changed
1271 && EQ (current_buffer
->selective_display
, Qnil
)
1272 && !detect_input_pending ()
1273 && NILP (Vexecuting_macro
))
1274 no_redisplay
= direct_output_forward_char (-1);
1277 else if (EQ (this_command
, Qself_insert_command
)
1278 /* Try this optimization only on ascii keystrokes. */
1279 && INTEGERP (last_command_char
))
1281 unsigned char c
= XINT (last_command_char
);
1284 if (NILP (Vexecuting_macro
)
1285 && !EQ (minibuf_window
, selected_window
))
1287 if (!nonundocount
|| nonundocount
>= 20)
1294 lose
= ((XFASTINT (XWINDOW (selected_window
)->last_modified
)
1296 || (XFASTINT (XWINDOW (selected_window
)->last_point
)
1298 || MODIFF
<= SAVE_MODIFF
1299 || windows_or_buffers_changed
1300 || !EQ (current_buffer
->selective_display
, Qnil
)
1301 || detect_input_pending ()
1302 || !NILP (Vexecuting_macro
));
1303 value
= internal_self_insert (c
, 0);
1310 && (PT
== ZV
|| FETCH_CHAR (PT
) == '\n'))
1312 struct Lisp_Vector
*dp
1313 = window_display_table (XWINDOW (selected_window
));
1320 obj
= DISP_CHAR_VECTOR (dp
, lose
);
1323 /* Do it only for char codes
1324 that by default display as themselves. */
1325 if (lose
>= 0x20 && lose
<= 0x7e)
1326 no_redisplay
= direct_output_for_insert (lose
);
1328 else if (VECTORP (obj
)
1329 && XVECTOR (obj
)->size
== 1
1330 && (obj
= XVECTOR (obj
)->contents
[0],
1332 /* Insist face not specified in glyph. */
1333 && (XINT (obj
) & ((-1) << 8)) == 0)
1335 = direct_output_for_insert (XINT (obj
));
1339 if (lose
>= 0x20 && lose
<= 0x7e)
1340 no_redisplay
= direct_output_for_insert (lose
);
1347 /* Here for a command that isn't executed directly */
1350 if (NILP (Vprefix_arg
))
1352 Fcommand_execute (this_command
, Qnil
);
1357 /* Note that the value cell will never directly contain nil
1358 if the symbol is a local variable. */
1359 if (!NILP (XSYMBOL (Qpost_command_hook
)->value
) && !NILP (Vrun_hooks
))
1360 safe_run_hooks (Qpost_command_hook
);
1362 if (!NILP (Vdeferred_action_list
))
1363 safe_run_hooks (Qdeferred_action_function
);
1365 /* If there is a prefix argument,
1366 1) We don't want last_command to be ``universal-argument''
1367 (that would be dumb), so don't set last_command,
1368 2) we want to leave echoing on so that the prefix will be
1369 echoed as part of this key sequence, so don't call
1371 3) we want to leave this_command_key_count non-zero, so that
1372 read_char will realize that it is re-reading a character, and
1373 not echo it a second time. */
1374 if (NILP (Vprefix_arg
))
1376 last_command
= this_command
;
1378 this_command_key_count
= 0;
1381 if (!NILP (current_buffer
->mark_active
) && !NILP (Vrun_hooks
))
1383 if (!NILP (Vdeactivate_mark
) && !NILP (Vtransient_mark_mode
))
1385 current_buffer
->mark_active
= Qnil
;
1386 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
1388 else if (current_buffer
!= prev_buffer
|| MODIFF
!= prev_modiff
)
1389 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
1393 /* Install chars successfully executed in kbd macro. */
1395 if (!NILP (current_perdisplay
->defining_kbd_macro
) && NILP (Vprefix_arg
))
1396 finalize_kbd_macro_chars ();
1398 #ifdef MULTI_PERDISPLAY
1405 /* If we get an error while running the hook, cause the hook variable
1406 to be nil. Also inhibit quits, so that C-g won't cause the hook
1407 to mysteriously evaporate. */
1409 safe_run_hooks (hook
)
1413 int count
= specpdl_ptr
- specpdl
;
1414 specbind (Qinhibit_quit
, Qt
);
1416 /* We read and set the variable with functions,
1417 in case it's buffer-local. */
1418 value
= Vcommand_hook_internal
= Fsymbol_value (hook
);
1420 call1 (Vrun_hooks
, Qcommand_hook_internal
);
1423 unbind_to (count
, Qnil
);
1426 /* Number of seconds between polling for input. */
1429 /* Nonzero means polling for input is temporarily suppressed. */
1430 int poll_suppress_count
;
1432 /* Nonzero if polling_for_input is actually being used. */
1433 int polling_for_input
;
1435 #ifdef POLL_FOR_INPUT
1437 /* Handle an alarm once each second and read pending input
1438 so as to handle a C-g if it comces in. */
1441 input_poll_signal (signalnum
) /* If we don't have an argument, */
1442 int signalnum
; /* some compilers complain in signal calls. */
1444 if (interrupt_input_blocked
== 0
1445 && !waiting_for_input
)
1446 read_avail_input (0);
1447 signal (SIGALRM
, input_poll_signal
);
1448 alarm (polling_period
);
1453 /* Begin signals to poll for input, if they are appropriate.
1454 This function is called unconditionally from various places. */
1458 #ifdef POLL_FOR_INPUT
1459 if (read_socket_hook
&& !interrupt_input
)
1461 poll_suppress_count
--;
1462 if (poll_suppress_count
== 0)
1464 signal (SIGALRM
, input_poll_signal
);
1465 polling_for_input
= 1;
1466 alarm (polling_period
);
1472 /* Nonzero if we are using polling to handle input asynchronously. */
1475 input_polling_used ()
1477 #ifdef POLL_FOR_INPUT
1478 return read_socket_hook
&& !interrupt_input
;
1484 /* Turn off polling. */
1488 #ifdef POLL_FOR_INPUT
1489 if (read_socket_hook
&& !interrupt_input
)
1491 if (poll_suppress_count
== 0)
1493 polling_for_input
= 0;
1496 poll_suppress_count
++;
1501 /* Set the value of poll_suppress_count to COUNT
1502 and start or stop polling accordingly. */
1505 set_poll_suppress_count (count
)
1508 #ifdef POLL_FOR_INPUT
1509 if (count
== 0 && poll_suppress_count
!= 0)
1511 poll_suppress_count
= 1;
1514 else if (count
!= 0 && poll_suppress_count
== 0)
1518 poll_suppress_count
= count
;
1522 /* Bind polling_period to a value at least N.
1523 But don't decrease it. */
1525 bind_polling_period (n
)
1528 #ifdef POLL_FOR_INPUT
1529 int new = polling_period
;
1535 specbind (Qpolling_period
, make_number (new));
1536 /* Start a new alarm with the new period. */
1541 /* Apply the control modifier to CHARACTER. */
1547 /* Save the upper bits here. */
1548 int upper
= c
& ~0177;
1552 /* Everything in the columns containing the upper-case letters
1553 denotes a control character. */
1554 if (c
>= 0100 && c
< 0140)
1558 /* Set the shift modifier for a control char
1559 made from a shifted letter. But only for letters! */
1560 if (oc
>= 'A' && oc
<= 'Z')
1561 c
|= shift_modifier
;
1564 /* The lower-case letters denote control characters too. */
1565 else if (c
>= 'a' && c
<= 'z')
1568 /* Include the bits for control and shift
1569 only if the basic ASCII code can't indicate them. */
1573 /* Replace the high bits. */
1574 c
|= (upper
& ~ctrl_modifier
);
1581 /* Input of single characters from keyboard */
1583 Lisp_Object
print_help ();
1584 static Lisp_Object
kbd_buffer_get_event ();
1585 static void record_char ();
1587 #ifdef MULTI_PERDISPLAY
1588 static jmp_buf wrong_display_jmpbuf
;
1591 /* read a character from the keyboard; call the redisplay if needed */
1592 /* commandflag 0 means do not do auto-saving, but do do redisplay.
1593 -1 means do not do redisplay, but do do autosaving.
1596 /* The arguments MAPS and NMAPS are for menu prompting.
1597 MAPS is an array of keymaps; NMAPS is the length of MAPS.
1599 PREV_EVENT is the previous input event, or nil if we are reading
1600 the first event of a key sequence.
1602 If USED_MOUSE_MENU is non-zero, then we set *USED_MOUSE_MENU to 1
1603 if we used a mouse menu to read the input, or zero otherwise. If
1604 USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone.
1606 Value is t if we showed a menu and the user rejected it. */
1609 read_char (commandflag
, nmaps
, maps
, prev_event
, used_mouse_menu
)
1613 Lisp_Object prev_event
;
1614 int *used_mouse_menu
;
1616 register Lisp_Object c
;
1619 int key_already_recorded
= 0;
1620 Lisp_Object also_record
;
1623 if (CONSP (Vunread_command_events
))
1625 c
= XCONS (Vunread_command_events
)->car
;
1626 Vunread_command_events
= XCONS (Vunread_command_events
)->cdr
;
1628 if (this_command_key_count
== 0)
1634 if (unread_command_char
!= -1)
1636 XSETINT (c
, unread_command_char
);
1637 unread_command_char
= -1;
1639 if (this_command_key_count
== 0)
1645 if (!NILP (Vexecuting_macro
))
1648 /* We set this to Qmacro; since that's not a frame, nobody will
1649 try to switch frames on us, and the selected window will
1652 Since this event came from a macro, it would be misleading to
1653 leave internal_last_event_frame set to wherever the last
1654 real event came from. Normally, a switch-frame event selects
1655 internal_last_event_frame after each command is read, but
1656 events read from a macro should never cause a new frame to be
1658 Vlast_event_frame
= internal_last_event_frame
= Qmacro
;
1661 /* Exit the macro if we are at the end.
1662 Also, some things replace the macro with t
1663 to force an early exit. */
1664 if (EQ (Vexecuting_macro
, Qt
)
1665 || executing_macro_index
>= XFASTINT (Flength (Vexecuting_macro
)))
1671 c
= Faref (Vexecuting_macro
, make_number (executing_macro_index
));
1672 if (STRINGP (Vexecuting_macro
)
1673 && (XINT (c
) & 0x80))
1674 XSETFASTINT (c
, CHAR_META
| (XINT (c
) & ~0x80));
1676 executing_macro_index
++;
1681 if (!NILP (unread_switch_frame
))
1683 c
= unread_switch_frame
;
1684 unread_switch_frame
= Qnil
;
1686 /* This event should make it into this_command_keys, and get echoed
1687 again, so we go to reread_first, rather than reread. */
1691 /* Don't bother updating menu bars while doing mouse tracking.
1692 We get events very rapidly then, and the menu bar won't be changing.
1693 We do update the menu bar once on entry to Ftrack_mouse. */
1694 if (commandflag
> 0 && !input_pending
&& !detect_input_pending ())
1695 prepare_menu_bars ();
1697 /* Save outer setjmp data, in case called recursively. */
1698 save_getcjmp (save_jump
);
1702 if (commandflag
>= 0 && !input_pending
&& !detect_input_pending ())
1705 if (_setjmp (getcjmp
))
1707 XSETINT (c
, quit_char
);
1709 XSETFRAME (internal_last_event_frame
, selected_frame
);
1710 Vlast_event_frame
= internal_last_event_frame
;
1712 /* If we report the quit char as an event,
1713 don't do so more than once. */
1714 if (!NILP (Vinhibit_quit
))
1720 if (current_perdisplay
)
1722 /* Message turns off echoing unless more keystrokes turn it on again. */
1723 if (echo_area_glyphs
&& *echo_area_glyphs
1724 && echo_area_glyphs
!= current_perdisplay
->echobuf
)
1727 /* If already echoing, continue. */
1731 /* Try reading a character via menu prompting in the minibuf.
1732 Try this before the sit-for, because the sit-for
1733 would do the wrong thing if we are supposed to do
1734 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
1735 after a mouse event so don't try a minibuf menu. */
1737 if (nmaps
> 0 && INTERACTIVE
1738 && !NILP (prev_event
) && ! EVENT_HAS_PARAMETERS (prev_event
)
1739 /* Don't bring up a menu if we already have another event. */
1740 && NILP (Vunread_command_events
)
1741 && unread_command_char
< 0
1742 && !detect_input_pending ())
1744 c
= read_char_minibuf_menu_prompt (commandflag
, nmaps
, maps
);
1747 key_already_recorded
= 1;
1752 /* If in middle of key sequence and minibuffer not active,
1753 start echoing if enough time elapses. */
1754 if (current_perdisplay
1755 && minibuf_level
== 0
1756 && !current_perdisplay
->immediate_echo
1757 && this_command_key_count
> 0
1759 && echo_keystrokes
> 0
1760 && (echo_area_glyphs
== 0 || *echo_area_glyphs
== 0))
1764 /* After a mouse event, start echoing right away.
1765 This is because we are probably about to display a menu,
1766 and we don't want to delay before doing so. */
1767 if (EVENT_HAS_PARAMETERS (prev_event
))
1771 tem0
= sit_for (echo_keystrokes
, 0, 1, 1);
1777 /* Maybe auto save due to number of keystrokes or idle time. */
1779 if (commandflag
!= 0
1780 && auto_save_interval
> 0
1781 && num_nonmacro_input_chars
- last_auto_save
> max (auto_save_interval
, 20)
1782 && !detect_input_pending ())
1785 save_getcjmp (temp
);
1786 Fdo_auto_save (Qnil
, Qnil
);
1787 /* Hooks can actually change some buffers in auto save. */
1789 restore_getcjmp (temp
);
1792 /* Try reading using an X menu.
1793 This is never confused with reading using the minibuf
1794 because the recursive call of read_char in read_char_minibuf_menu_prompt
1795 does not pass on any keymaps. */
1796 if (nmaps
> 0 && INTERACTIVE
1797 && !NILP (prev_event
) && EVENT_HAS_PARAMETERS (prev_event
)
1798 /* Don't bring up a menu if we already have another event. */
1799 && NILP (Vunread_command_events
)
1800 && unread_command_char
< 0)
1801 c
= read_char_x_menu_prompt (nmaps
, maps
, prev_event
, used_mouse_menu
);
1803 /* Slow down auto saves logarithmically in size of current buffer,
1804 and garbage collect while we're at it. */
1805 if (INTERACTIVE
&& NILP (c
))
1807 int delay_level
, buffer_size
;
1809 if (! MINI_WINDOW_P (XWINDOW (selected_window
)))
1810 last_non_minibuf_size
= Z
- BEG
;
1811 buffer_size
= (last_non_minibuf_size
>> 8) + 1;
1813 while (buffer_size
> 64)
1814 delay_level
++, buffer_size
-= buffer_size
>> 2;
1815 if (delay_level
< 4) delay_level
= 4;
1816 /* delay_level is 4 for files under around 50k, 7 at 100k,
1817 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
1819 /* Auto save if enough time goes by without input. */
1820 if (commandflag
!= 0
1821 && num_nonmacro_input_chars
> last_auto_save
1822 && INTEGERP (Vauto_save_timeout
)
1823 && XINT (Vauto_save_timeout
) > 0)
1826 int delay
= delay_level
* XFASTINT (Vauto_save_timeout
) / 4;
1827 tem0
= sit_for (delay
, 0, 1, 1);
1831 save_getcjmp (temp
);
1832 Fdo_auto_save (Qnil
, Qnil
);
1833 restore_getcjmp (temp
);
1835 /* If we have auto-saved and there is still no input
1836 available, garbage collect if there has been enough
1837 consing going on to make it worthwhile. */
1838 if (!detect_input_pending ()
1839 && consing_since_gc
> gc_cons_threshold
/ 2)
1840 Fgarbage_collect ();
1841 /* prepare_menu_bars isn't safe here, but it should
1842 also be unnecessary. */
1851 /* Check for something on one of the side queues. Give priority to
1852 the current display, but if we're not locked, then check the other
1853 displays as well. */
1854 if (current_perdisplay
&& CONSP (current_perdisplay
->kbd_queue
))
1855 perd
= current_perdisplay
;
1856 else if (!display_locked
)
1858 for (perd
= all_perdisplays
; perd
; perd
= perd
->next_perdisplay
)
1859 if (CONSP (perd
->kbd_queue
))
1865 /* If we found something on a side queue, use that.
1866 Otherwise, read from the main queue, and if that gives us
1867 something we can't use yet, put it on the side queue and
1871 c
= XCONS (perd
->kbd_queue
)->car
;
1872 perd
->kbd_queue
= XCONS (perd
->kbd_queue
)->cdr
;
1873 input_pending
= readable_events ();
1875 if (EVENT_HAS_PARAMETERS (c
)
1876 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c
)), Qswitch_frame
))
1877 internal_last_event_frame
= XCONS (XCONS (c
)->cdr
)->car
;
1878 Vlast_event_frame
= internal_last_event_frame
;
1884 /* Actually read a character, waiting if necessary. */
1885 while (c
= kbd_buffer_get_event (&perd
), NILP (c
))
1887 if (commandflag
>= 0
1888 && !input_pending
&& !detect_input_pending ())
1890 prepare_menu_bars ();
1894 if (display_locked
&& perd
!= current_perdisplay
)
1896 Lisp_Object
*tailp
= &perd
->kbd_queue
;
1897 while (CONSP (*tailp
))
1898 tailp
= &XCONS (*tailp
)->cdr
;
1901 *tailp
= Fcons (c
, Qnil
);
1905 #ifdef MULTI_PERDISPLAY
1906 if (!current_perdisplay
)
1907 current_perdisplay
= perd
;
1908 if (perd
!= current_perdisplay
)
1910 /* We shouldn't get here if we were locked onto one display! */
1913 perd
->kbd_queue
= Fcons (c
, perd
->kbd_queue
);
1914 current_perdisplay
= perd
;
1915 longjmp (wrong_display_jmpbuf
, 1);
1919 /* Terminate Emacs in batch mode if at eof. */
1920 if (noninteractive
&& INTEGERP (c
) && XINT (c
) < 0)
1921 Fkill_emacs (make_number (1));
1925 /* Add in any extra modifiers, where appropriate. */
1926 if ((extra_keyboard_modifiers
& CHAR_CTL
)
1927 || ((extra_keyboard_modifiers
& 0177) < ' '
1928 && (extra_keyboard_modifiers
& 0177) != 0))
1929 XSETINT (c
, make_ctrl_char (XINT (c
)));
1931 /* Transfer any other modifier bits directly from
1932 extra_keyboard_modifiers to c. Ignore the actual character code
1933 in the low 16 bits of extra_keyboard_modifiers. */
1934 XSETINT (c
, XINT (c
) | (extra_keyboard_modifiers
& ~0xff7f & ~CHAR_CTL
));
1939 restore_getcjmp (save_jump
);
1943 /* Buffer switch events are only for internal wakeups
1944 so don't show them to the user. */
1948 if (key_already_recorded
)
1951 /* Wipe the echo area. */
1952 echo_area_glyphs
= 0;
1954 /* Handle things that only apply to characters. */
1957 /* If kbd_buffer_get_event gave us an EOF, return that. */
1961 if (STRINGP (Vkeyboard_translate_table
)
1962 && XSTRING (Vkeyboard_translate_table
)->size
> XFASTINT (c
))
1963 XSETINT (c
, XSTRING (Vkeyboard_translate_table
)->data
[XFASTINT (c
)]);
1966 /* If this event is a mouse click in the menu bar,
1967 return just menu-bar for now. Modify the mouse click event
1968 so we won't do this twice, then queue it up. */
1969 if (EVENT_HAS_PARAMETERS (c
)
1970 && CONSP (XCONS (c
)->cdr
)
1971 && CONSP (EVENT_START (c
))
1972 && CONSP (XCONS (EVENT_START (c
))->cdr
))
1976 posn
= POSN_BUFFER_POSN (EVENT_START (c
));
1977 /* Handle menu-bar events:
1978 insert the dummy prefix event `menu-bar'. */
1979 if (EQ (posn
, Qmenu_bar
))
1981 /* Change menu-bar to (menu-bar) as the event "position". */
1982 POSN_BUFFER_POSN (EVENT_START (c
)) = Fcons (posn
, Qnil
);
1985 Vunread_command_events
= Fcons (c
, Vunread_command_events
);
1991 if (! NILP (also_record
))
1992 record_char (also_record
);
1997 /* Don't echo mouse motion events. */
1999 && ! (EVENT_HAS_PARAMETERS (c
)
2000 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c
)), Qmouse_movement
)))
2003 if (! NILP (also_record
))
2004 echo_char (also_record
);
2007 /* Record this character as part of the current key. */
2008 add_command_key (c
);
2009 if (! NILP (also_record
))
2010 add_command_key (also_record
);
2012 /* Re-reading in the middle of a command */
2014 last_input_char
= c
;
2017 /* Process the help character specially if enabled */
2018 if (EQ (c
, Vhelp_char
) && !NILP (Vhelp_form
))
2021 count
= specpdl_ptr
- specpdl
;
2023 record_unwind_protect (Fset_window_configuration
,
2024 Fcurrent_window_configuration (Qnil
));
2026 tem0
= Feval (Vhelp_form
);
2028 internal_with_output_to_temp_buffer ("*Help*", print_help
, tem0
);
2032 c
= read_char (0, 0, 0, Qnil
, 0);
2033 while (BUFFERP (c
));
2034 /* Remove the help from the frame */
2035 unbind_to (count
, Qnil
);
2036 prepare_menu_bars ();
2038 if (EQ (c
, make_number (040)))
2042 c
= read_char (0, 0, 0, Qnil
, 0);
2043 while (BUFFERP (c
));
2050 /* Record the input event C in various ways. */
2057 XVECTOR (recent_keys
)->contents
[recent_keys_index
] = c
;
2058 if (++recent_keys_index
>= NUM_RECENT_KEYS
)
2059 recent_keys_index
= 0;
2061 /* Write c to the dribble file. If c is a lispy event, write
2062 the event's symbol to the dribble file, in <brackets>. Bleaugh.
2063 If you, dear reader, have a better idea, you've got the source. :-) */
2068 if (XUINT (c
) < 0x100)
2069 putc (XINT (c
), dribble
);
2071 fprintf (dribble
, " 0x%x", XUINT (c
));
2075 Lisp_Object dribblee
;
2077 /* If it's a structured event, take the event header. */
2078 dribblee
= EVENT_HEAD (c
);
2080 if (SYMBOLP (dribblee
))
2082 putc ('<', dribble
);
2083 fwrite (XSYMBOL (dribblee
)->name
->data
, sizeof (char),
2084 XSYMBOL (dribblee
)->name
->size
,
2086 putc ('>', dribble
);
2093 store_kbd_macro_char (c
);
2095 num_nonmacro_input_chars
++;
2102 struct buffer
*old
= current_buffer
;
2103 Fprinc (object
, Qnil
);
2104 set_buffer_internal (XBUFFER (Vstandard_output
));
2105 call0 (intern ("help-mode"));
2106 set_buffer_internal (old
);
2110 /* Copy out or in the info on where C-g should throw to.
2111 This is used when running Lisp code from within get_char,
2112 in case get_char is called recursively.
2113 See read_process_output. */
2118 bcopy (getcjmp
, temp
, sizeof getcjmp
);
2121 restore_getcjmp (temp
)
2124 bcopy (temp
, getcjmp
, sizeof getcjmp
);
2130 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
2131 of this function. */
2134 tracking_off (old_value
)
2135 Lisp_Object old_value
;
2137 do_mouse_tracking
= old_value
;
2138 if (NILP (old_value
))
2140 /* Redisplay may have been preempted because there was input
2141 available, and it assumes it will be called again after the
2142 input has been processed. If the only input available was
2143 the sort that we have just disabled, then we need to call
2145 if (!readable_events ())
2147 prepare_menu_bars ();
2148 redisplay_preserve_echo_area ();
2149 get_input_pending (&input_pending
);
2154 DEFUN ("track-mouse", Ftrack_mouse
, Strack_mouse
, 0, UNEVALLED
, 0,
2155 "Evaluate BODY with mouse movement events enabled.\n\
2156 Within a `track-mouse' form, mouse motion generates input events that\n\
2157 you can read with `read-event'.\n\
2158 Normally, mouse motion is ignored.")
2162 int count
= specpdl_ptr
- specpdl
;
2165 record_unwind_protect (tracking_off
, do_mouse_tracking
);
2167 if (!input_pending
&& !detect_input_pending ())
2168 prepare_menu_bars ();
2170 XSETFRAME (do_mouse_tracking
, selected_frame
);
2172 val
= Fprogn (args
);
2173 return unbind_to (count
, val
);
2176 #endif /* HAVE_MOUSE */
2178 /* Low level keyboard/mouse input.
2179 kbd_buffer_store_event places events in kbd_buffer, and
2180 kbd_buffer_get_event retrieves them.
2181 mouse_moved indicates when the mouse has moved again, and
2182 *mouse_position_hook provides the mouse position. */
2184 /* Return true iff there are any events in the queue that read-char
2185 would return. If this returns false, a read-char would block. */
2189 if (kbd_fetch_ptr
!= kbd_store_ptr
)
2192 if (FRAMEP (do_mouse_tracking
) && mouse_moved
)
2197 if (CONSP (current_perdisplay
->kbd_queue
))
2203 for (perd
= all_perdisplays
; perd
; perd
= perd
->next_perdisplay
)
2204 if (CONSP (perd
->kbd_queue
))
2210 /* Set this for debugging, to have a way to get out */
2213 /* Store an event obtained at interrupt level into kbd_buffer, fifo */
2216 kbd_buffer_store_event (event
)
2217 register struct input_event
*event
;
2219 if (event
->kind
== no_event
)
2222 if (event
->kind
== ascii_keystroke
)
2224 register int c
= event
->code
& 0377;
2226 if (event
->modifiers
& ctrl_modifier
)
2227 c
= make_ctrl_char (c
);
2229 c
|= (event
->modifiers
2230 & (meta_modifier
| alt_modifier
2231 | hyper_modifier
| super_modifier
));
2235 extern SIGTYPE
interrupt_signal ();
2238 /* If this results in a quit_char being returned to Emacs as
2239 input, set Vlast_event_frame properly. If this doesn't
2240 get returned to Emacs as an event, the next event read
2241 will set Vlast_event_frame again, so this is safe to do. */
2245 focus
= FRAME_FOCUS_FRAME (XFRAME (event
->frame_or_window
));
2247 focus
= event
->frame_or_window
;
2248 internal_last_event_frame
= focus
;
2249 Vlast_event_frame
= focus
;
2253 last_event_timestamp
= event
->timestamp
;
2254 interrupt_signal ();
2258 if (c
&& c
== stop_character
)
2265 if (kbd_store_ptr
- kbd_buffer
== KBD_BUFFER_SIZE
)
2266 kbd_store_ptr
= kbd_buffer
;
2268 /* Don't let the very last slot in the buffer become full,
2269 since that would make the two pointers equal,
2270 and that is indistinguishable from an empty buffer.
2271 Discard the event if it would fill the last slot. */
2272 if (kbd_fetch_ptr
- 1 != kbd_store_ptr
)
2274 volatile struct input_event
*sp
= kbd_store_ptr
;
2275 sp
->kind
= event
->kind
;
2276 if (event
->kind
== selection_request_event
)
2278 /* We must not use the ordinary copying code for this case,
2279 since `part' is an enum and copying it might not copy enough
2281 bcopy (event
, (char *) sp
, sizeof (*event
));
2285 sp
->code
= event
->code
;
2286 sp
->part
= event
->part
;
2287 sp
->frame_or_window
= event
->frame_or_window
;
2288 sp
->modifiers
= event
->modifiers
;
2291 sp
->timestamp
= event
->timestamp
;
2293 (XVECTOR (kbd_buffer_frame_or_window
)->contents
[kbd_store_ptr
2295 = event
->frame_or_window
);
2301 /* Read one event from the event buffer, waiting if necessary.
2302 The value is a Lisp object representing the event.
2303 The value is nil for an event that should be ignored,
2304 or that was handled here.
2305 We always read and discard one event. */
2308 kbd_buffer_get_event (PERDISPLAY
**perdp
)
2317 *perdp
= all_perdisplays
; /* There'd better be exactly one! */
2321 /* Wait until there is input available. */
2324 if (kbd_fetch_ptr
!= kbd_store_ptr
)
2327 if (FRAMEP (do_mouse_tracking
) && mouse_moved
)
2331 /* If the quit flag is set, then read_char will return
2332 quit_char, so that counts as "available input." */
2333 if (!NILP (Vquit_flag
))
2334 quit_throw_to_read_char ();
2336 /* One way or another, wait until input is available; then, if
2337 interrupt handlers have not read it, read it now. */
2340 wait_for_kbd_input ();
2342 /* Note SIGIO has been undef'd if FIONREAD is missing. */
2346 if (kbd_fetch_ptr
!= kbd_store_ptr
)
2349 if (FRAMEP (do_mouse_tracking
) && mouse_moved
)
2353 Lisp_Object minus_one
;
2355 XSETINT (minus_one
, -1);
2356 wait_reading_process_input (0, 0, minus_one
, 1);
2358 if (!interrupt_input
&& kbd_fetch_ptr
== kbd_store_ptr
)
2359 /* Pass 1 for EXPECT since we just waited to have input. */
2360 read_avail_input (1);
2362 #endif /* not VMS */
2365 /* At this point, we know that there is a readable event available
2366 somewhere. If the event queue is empty, then there must be a
2367 mouse movement enabled and available. */
2368 if (kbd_fetch_ptr
!= kbd_store_ptr
)
2370 struct input_event
*event
;
2372 event
= ((kbd_fetch_ptr
< kbd_buffer
+ KBD_BUFFER_SIZE
)
2376 last_event_timestamp
= event
->timestamp
;
2380 frame
= event
->frame_or_window
;
2382 frame
= XCONS (frame
)->car
;
2383 else if (WINDOWP (frame
))
2384 frame
= WINDOW_FRAME (XWINDOW (frame
));
2385 /* There are still some events that don't set this field.
2386 For now, just ignore the problem. */
2387 if (!FRAMEP (frame
))
2388 *perdp
= all_perdisplays
;
2390 *perdp
= get_perdisplay (XFRAME (frame
));
2395 /* These two kinds of events get special handling
2396 and don't actually appear to the command loop.
2397 We return nil for them. */
2398 if (event
->kind
== selection_request_event
)
2401 struct input_event copy
= *event
;
2402 /* Remove it from the buffer before processing it,
2403 since otherwise swallow_events will see it
2404 and process it again. */
2405 kbd_fetch_ptr
= event
+ 1;
2406 x_handle_selection_request (©
);
2408 /* We're getting selection request events, but we don't have
2414 else if (event
->kind
== selection_clear_event
)
2417 x_handle_selection_clear (event
);
2418 kbd_fetch_ptr
= event
+ 1;
2420 /* We're getting selection request events, but we don't have
2426 else if (event
->kind
== delete_window_event
)
2428 /* Make an event (delete-frame (FRAME)). */
2429 obj
= Fcons (event
->frame_or_window
, Qnil
);
2430 obj
= Fcons (Qdelete_frame
, Fcons (obj
, Qnil
));
2431 kbd_fetch_ptr
= event
+ 1;
2433 else if (event
->kind
== iconify_event
)
2435 /* Make an event (iconify-frame (FRAME)). */
2436 obj
= Fcons (event
->frame_or_window
, Qnil
);
2437 obj
= Fcons (Qiconify_frame
, Fcons (obj
, Qnil
));
2438 kbd_fetch_ptr
= event
+ 1;
2440 else if (event
->kind
== deiconify_event
)
2442 /* Make an event (make-frame-visible (FRAME)). */
2443 obj
= Fcons (event
->frame_or_window
, Qnil
);
2444 obj
= Fcons (Qmake_frame_visible
, Fcons (obj
, Qnil
));
2445 kbd_fetch_ptr
= event
+ 1;
2448 else if (event
->kind
== menu_bar_event
)
2450 /* The event value is in the cdr of the frame_or_window slot. */
2451 if (!CONSP (event
->frame_or_window
))
2453 obj
= XCONS (event
->frame_or_window
)->cdr
;
2454 kbd_fetch_ptr
= event
+ 1;
2456 else if (event
->kind
== buffer_switch_event
)
2458 /* The value doesn't matter here; only the type is tested. */
2459 XSETBUFFER (obj
, current_buffer
);
2460 kbd_fetch_ptr
= event
+ 1;
2462 /* Just discard these, by returning nil.
2463 (They shouldn't be found in the buffer,
2464 but on some machines it appears they do show up.) */
2465 else if (event
->kind
== no_event
)
2466 kbd_fetch_ptr
= event
+ 1;
2468 /* If this event is on a different frame, return a switch-frame this
2469 time, and leave the event in the queue for next time. */
2476 frame
= event
->frame_or_window
;
2477 if (WINDOWP (frame
))
2478 frame
= WINDOW_FRAME (XWINDOW (frame
));
2480 focus
= FRAME_FOCUS_FRAME (XFRAME (frame
));
2484 if (! EQ (frame
, internal_last_event_frame
)
2485 && XFRAME (frame
) != selected_frame
)
2486 obj
= make_lispy_switch_frame (frame
);
2487 internal_last_event_frame
= frame
;
2488 #endif /* MULTI_FRAME */
2490 /* If we didn't decide to make a switch-frame event, go ahead
2491 and build a real event from the queue entry. */
2495 obj
= make_lispy_event (event
);
2497 /* Wipe out this event, to catch bugs. */
2498 event
->kind
= no_event
;
2499 XVECTOR (kbd_buffer_frame_or_window
)->contents
[event
- kbd_buffer
] = Qnil
;
2501 kbd_fetch_ptr
= event
+ 1;
2506 /* Try generating a mouse motion event. */
2507 else if (FRAMEP (do_mouse_tracking
) && mouse_moved
)
2509 FRAME_PTR f
= XFRAME (do_mouse_tracking
);
2510 Lisp_Object bar_window
;
2511 enum scroll_bar_part part
;
2515 if (!current_perdisplay
)
2518 *perdp
= current_perdisplay
;
2519 /* Note that this uses F to determine which display to look at.
2520 If there is no valid info, it does not store anything
2521 so x remains nil. */
2523 (*mouse_position_hook
) (&f
, &bar_window
, &part
, &x
, &y
, &time
);
2528 /* Decide if we should generate a switch-frame event. Don't
2529 generate switch-frame events for motion outside of all Emacs
2535 frame
= FRAME_FOCUS_FRAME (f
);
2537 XSETFRAME (frame
, f
);
2539 if (! EQ (frame
, internal_last_event_frame
)
2540 && XFRAME (frame
) != selected_frame
)
2541 obj
= make_lispy_switch_frame (frame
);
2542 internal_last_event_frame
= frame
;
2546 /* If we didn't decide to make a switch-frame event, go ahead and
2547 return a mouse-motion event. */
2548 if (!NILP (x
) && NILP (obj
))
2549 obj
= make_lispy_movement (f
, bar_window
, part
, x
, y
, time
);
2551 #endif /* HAVE_MOUSE */
2553 /* We were promised by the above while loop that there was
2554 something for us to read! */
2557 input_pending
= readable_events ();
2560 Vlast_event_frame
= internal_last_event_frame
;
2566 /* Process any events that are not user-visible,
2567 then return, without reading any user-visible events. */
2572 while (kbd_fetch_ptr
!= kbd_store_ptr
)
2574 struct input_event
*event
;
2576 event
= ((kbd_fetch_ptr
< kbd_buffer
+ KBD_BUFFER_SIZE
)
2580 last_event_timestamp
= event
->timestamp
;
2582 /* These two kinds of events get special handling
2583 and don't actually appear to the command loop. */
2584 if (event
->kind
== selection_request_event
)
2587 struct input_event copy
;
2589 kbd_fetch_ptr
= event
+ 1;
2590 x_handle_selection_request (©
);
2592 /* We're getting selection request events, but we don't have
2598 else if (event
->kind
== selection_clear_event
)
2601 x_handle_selection_clear (event
);
2602 kbd_fetch_ptr
= event
+ 1;
2604 /* We're getting selection request events, but we don't have
2613 get_input_pending (&input_pending
);
2616 /* Caches for modify_event_symbol. */
2617 static Lisp_Object accent_key_syms
;
2618 static Lisp_Object system_key_syms
;
2619 static Lisp_Object func_key_syms
;
2620 static Lisp_Object mouse_syms
;
2622 Lisp_Object Vsystem_key_alist
;
2624 /* This is a list of keysym codes for special "accent" characters.
2625 It parallels lispy_accent_keys. */
2627 static int lispy_accent_codes
[] =
2629 #ifdef XK_dead_circumflex
2634 #ifdef XK_dead_grave
2639 #ifdef XK_dead_tilde
2644 #ifdef XK_dead_diaeresis
2649 #ifdef XK_dead_macron
2654 #ifdef XK_dead_degree
2659 #ifdef XK_dead_acute
2664 #ifdef XK_dead_cedilla
2669 #ifdef XK_dead_breve
2674 #ifdef XK_dead_ogonek
2679 #ifdef XK_dead_caron
2684 #ifdef XK_dead_doubleacute
2685 XK_dead_doubleacute
,
2689 #ifdef XK_dead_abovedot
2696 /* This is a list of Lisp names for special "accent" characters.
2697 It parallels lispy_accent_codes. */
2699 static char *lispy_accent_keys
[] =
2716 /* You'll notice that this table is arranged to be conveniently
2717 indexed by X Windows keysym values. */
2718 static char *lispy_function_keys
[] =
2720 /* X Keysym value */
2722 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00 */
2730 0, 0, 0, /* 0xff10 */
2732 0, 0, 0, 0, 0, 0, 0,
2735 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff20...2f */
2736 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff30...3f */
2737 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
2739 "home", /* 0xff50 */ /* IsCursorKey */
2750 "select", /* 0xff60 */ /* IsMiscFunctionKey */
2761 "break", /* 0xff6b */
2763 0, 0, 0, 0, 0, 0, 0, 0, "backtab", 0,
2765 0, 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff7f */
2766 "kp-space", /* 0xff80 */ /* IsKeypadKey */
2767 0, 0, 0, 0, 0, 0, 0, 0,
2768 "kp-tab", /* 0xff89 */
2770 "kp-enter", /* 0xff8d */
2772 "kp-f1", /* 0xff91 */
2776 "kp-home", /* 0xff95 */
2781 "kp-prior", /* kp-page-up */
2782 "kp-next", /* kp-page-down */
2788 0, 0, 0, 0, 0, 0, 0, 0, 0,
2789 "kp-multiply", /* 0xffaa */
2794 "kp-divide", /* 0xffaf */
2795 "kp-0", /* 0xffb0 */
2796 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
2799 "kp-equal", /* 0xffbd */
2800 "f1", /* 0xffbe */ /* IsFunctionKey */
2802 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
2803 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
2804 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
2805 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
2806 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
2807 0, 0, 0, 0, 0, 0, 0, 0,
2808 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
2809 0, 0, 0, 0, 0, 0, 0, "delete"
2812 static char *lispy_mouse_names
[] =
2814 "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5"
2817 /* Scroll bar parts. */
2818 Lisp_Object Qabove_handle
, Qhandle
, Qbelow_handle
;
2820 /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
2821 Lisp_Object
*scroll_bar_parts
[] = {
2822 &Qabove_handle
, &Qhandle
, &Qbelow_handle
2826 /* A vector, indexed by button number, giving the down-going location
2827 of currently depressed buttons, both scroll bar and non-scroll bar.
2829 The elements have the form
2830 (BUTTON-NUMBER MODIFIER-MASK . REST)
2831 where REST is the cdr of a position as it would be reported in the event.
2833 The make_lispy_event function stores positions here to tell the
2834 difference between click and drag events, and to store the starting
2835 location to be included in drag events. */
2837 static Lisp_Object button_down_location
;
2839 /* Information about the most recent up-going button event: Which
2840 button, what location, and what time. */
2842 static int last_mouse_button
;
2843 static int last_mouse_x
;
2844 static int last_mouse_y
;
2845 static unsigned long button_down_time
;
2847 /* The maximum time between clicks to make a double-click,
2848 or Qnil to disable double-click detection,
2849 or Qt for no time limit. */
2850 Lisp_Object Vdouble_click_time
;
2852 /* The number of clicks in this multiple-click. */
2854 int double_click_count
;
2856 #ifdef USE_X_TOOLKIT
2857 extern Lisp_Object
map_event_to_object ();
2858 #endif /* USE_X_TOOLKIT */
2860 /* Given a struct input_event, build the lisp event which represents
2861 it. If EVENT is 0, build a mouse movement event from the mouse
2862 movement buffer, which should have a movement event in it.
2864 Note that events must be passed to this function in the order they
2865 are received; this function stores the location of button presses
2866 in order to build drag events when the button is released. */
2869 make_lispy_event (event
)
2870 struct input_event
*event
;
2874 switch (SWITCH_ENUM_CAST (event
->kind
))
2876 /* A simple keystroke. */
2877 case ascii_keystroke
:
2879 Lisp_Object lispy_c
;
2880 int c
= event
->code
& 0377;
2881 /* Turn ASCII characters into control characters
2883 if (event
->modifiers
& ctrl_modifier
)
2884 c
= make_ctrl_char (c
);
2886 /* Add in the other modifier bits. We took care of ctrl_modifier
2887 just above, and the shift key was taken care of by the X code,
2888 and applied to control characters by make_ctrl_char. */
2889 c
|= (event
->modifiers
2890 & (meta_modifier
| alt_modifier
2891 | hyper_modifier
| super_modifier
));
2892 button_down_time
= 0;
2893 XSETFASTINT (lispy_c
, c
);
2897 /* A function key. The symbol may need to have modifier prefixes
2899 case non_ascii_keystroke
:
2900 button_down_time
= 0;
2902 for (i
= 0; i
< sizeof (lispy_accent_codes
) / sizeof (int); i
++)
2903 if (event
->code
== lispy_accent_codes
[i
])
2904 return modify_event_symbol (i
,
2906 Qfunction_key
, Qnil
,
2907 lispy_accent_keys
, &accent_key_syms
,
2908 (sizeof (lispy_accent_keys
)
2909 / sizeof (lispy_accent_keys
[0])));
2911 /* Handle system-specific keysyms. */
2912 if (event
->code
& (1 << 28))
2914 /* We need to use an alist rather than a vector as the cache
2915 since we can't make a vector long enuf. */
2916 if (NILP (system_key_syms
))
2917 system_key_syms
= Fcons (Qnil
, Qnil
);
2918 return modify_event_symbol (event
->code
& 0xffffff,
2920 Qfunction_key
, Vsystem_key_alist
,
2921 0, &system_key_syms
, 0xffffff);
2924 return modify_event_symbol (event
->code
- 0xff00,
2926 Qfunction_key
, Qnil
,
2927 lispy_function_keys
, &func_key_syms
,
2928 (sizeof (lispy_function_keys
)
2929 / sizeof (lispy_function_keys
[0])));
2932 #if defined (MULTI_FRAME) || defined (HAVE_MOUSE)
2933 /* A mouse click. Figure out where it is, decide whether it's
2934 a press, click or drag, and build the appropriate structure. */
2936 case scroll_bar_click
:
2938 int button
= event
->code
;
2940 Lisp_Object position
;
2941 Lisp_Object
*start_pos_ptr
;
2942 Lisp_Object start_pos
;
2944 if (button
< 0 || button
>= NUM_MOUSE_BUTTONS
)
2947 /* Build the position as appropriate for this mouse click. */
2948 if (event
->kind
== mouse_click
)
2951 FRAME_PTR f
= XFRAME (event
->frame_or_window
);
2956 /* Ignore mouse events that were made on frame that
2957 have been deleted. */
2958 if (! FRAME_LIVE_P (f
))
2961 pixel_to_glyph_coords (f
, XINT (event
->x
), XINT (event
->y
),
2962 &column
, &row
, 0, 1);
2964 #ifndef USE_X_TOOLKIT
2965 /* In the non-toolkit version, clicks on the menu bar
2966 are ordinary button events in the event buffer.
2967 Distinguish them, and invoke the menu.
2969 (In the toolkit version, the toolkit handles the menu bar
2970 and Emacs doesn't know about it until after the user
2971 makes a selection.) */
2972 if (row
>= 0 && row
< FRAME_MENU_BAR_LINES (f
))
2974 Lisp_Object items
, item
;
2978 /* Activate the menu bar on the down event. If the
2979 up event comes in before the menu code can deal with it,
2981 if (! (event
->modifiers
& down_modifier
))
2985 items
= FRAME_MENU_BAR_ITEMS (f
);
2986 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
2988 Lisp_Object pos
, string
;
2989 string
= XVECTOR (items
)->contents
[i
+ 1];
2990 pos
= XVECTOR (items
)->contents
[i
+ 2];
2993 if (column
>= XINT (pos
)
2994 && column
< XINT (pos
) + XSTRING (string
)->size
)
2996 item
= XVECTOR (items
)->contents
[i
];
3002 = Fcons (event
->frame_or_window
,
3004 Fcons (Fcons (event
->x
, event
->y
),
3005 Fcons (make_number (event
->timestamp
),
3008 return Fcons (item
, Fcons (position
, Qnil
));
3010 #endif /* not USE_X_TOOLKIT */
3012 window
= window_from_coordinates (f
, column
, row
, &part
);
3014 if (!WINDOWP (window
))
3016 window
= event
->frame_or_window
;
3021 int pixcolumn
, pixrow
;
3022 column
-= XINT (XWINDOW (window
)->left
);
3023 row
-= XINT (XWINDOW (window
)->top
);
3024 glyph_to_pixel_coords (f
, column
, row
, &pixcolumn
, &pixrow
);
3025 XSETINT (event
->x
, pixcolumn
);
3026 XSETINT (event
->y
, pixrow
);
3031 posn
= Qvertical_line
;
3034 buffer_posn_from_coords (XWINDOW (window
),
3041 Fcons (Fcons (event
->x
, event
->y
),
3042 Fcons (make_number (event
->timestamp
),
3048 Lisp_Object portion_whole
;
3051 window
= event
->frame_or_window
;
3052 portion_whole
= Fcons (event
->x
, event
->y
);
3053 part
= *scroll_bar_parts
[(int) event
->part
];
3057 Fcons (Qvertical_scroll_bar
,
3058 Fcons (portion_whole
,
3059 Fcons (make_number (event
->timestamp
),
3060 Fcons (part
, Qnil
)))));
3063 start_pos_ptr
= &XVECTOR (button_down_location
)->contents
[button
];
3065 start_pos
= *start_pos_ptr
;
3066 *start_pos_ptr
= Qnil
;
3068 is_double
= (button
== last_mouse_button
3069 && XINT (event
->x
) == last_mouse_x
3070 && XINT (event
->y
) == last_mouse_y
3071 && button_down_time
!= 0
3072 && (EQ (Vdouble_click_time
, Qt
)
3073 || (INTEGERP (Vdouble_click_time
)
3074 && ((int)(event
->timestamp
- button_down_time
)
3075 < XINT (Vdouble_click_time
)))));
3076 last_mouse_button
= button
;
3077 last_mouse_x
= XINT (event
->x
);
3078 last_mouse_y
= XINT (event
->y
);
3080 /* If this is a button press, squirrel away the location, so
3081 we can decide later whether it was a click or a drag. */
3082 if (event
->modifiers
& down_modifier
)
3086 double_click_count
++;
3087 event
->modifiers
|= ((double_click_count
> 2)
3092 double_click_count
= 1;
3093 button_down_time
= event
->timestamp
;
3094 *start_pos_ptr
= Fcopy_alist (position
);
3097 /* Now we're releasing a button - check the co-ordinates to
3098 see if this was a click or a drag. */
3099 else if (event
->modifiers
& up_modifier
)
3101 /* If we did not see a down before this up,
3102 ignore the up. Probably this happened because
3103 the down event chose a menu item.
3104 It would be an annoyance to treat the release
3105 of the button that chose the menu item
3106 as a separate event. */
3108 if (!CONSP (start_pos
))
3111 event
->modifiers
&= ~up_modifier
;
3112 #if 0 /* Formerly we treated an up with no down as a click event. */
3113 if (!CONSP (start_pos
))
3114 event
->modifiers
|= click_modifier
;
3118 /* The third element of every position should be the (x,y)
3122 down
= Fnth (make_number (2), start_pos
);
3123 if (EQ (event
->x
, XCONS (down
)->car
)
3124 && EQ (event
->y
, XCONS (down
)->cdr
))
3126 event
->modifiers
|= click_modifier
;
3130 button_down_time
= 0;
3131 event
->modifiers
|= drag_modifier
;
3133 /* Don't check is_double; treat this as multiple
3134 if the down-event was multiple. */
3135 if (double_click_count
> 1)
3136 event
->modifiers
|= ((double_click_count
> 2)
3142 /* Every mouse event should either have the down_modifier or
3143 the up_modifier set. */
3147 /* Get the symbol we should use for the mouse click. */
3150 head
= modify_event_symbol (button
,
3153 lispy_mouse_names
, &mouse_syms
,
3154 (sizeof (lispy_mouse_names
)
3155 / sizeof (lispy_mouse_names
[0])));
3156 if (event
->modifiers
& drag_modifier
)
3161 else if (event
->modifiers
& (double_modifier
| triple_modifier
))
3164 Fcons (make_number (double_click_count
),
3172 #endif /* MULTI_FRAME or HAVE_MOUSE */
3174 /* The 'kind' field of the event is something we don't recognize. */
3180 #if defined (MULTI_FRAME) || defined (HAVE_MOUSE)
3183 make_lispy_movement (frame
, bar_window
, part
, x
, y
, time
)
3185 Lisp_Object bar_window
;
3186 enum scroll_bar_part part
;
3191 /* Is it a scroll bar movement? */
3192 if (frame
&& ! NILP (bar_window
))
3194 Lisp_Object part_sym
;
3196 part_sym
= *scroll_bar_parts
[(int) part
];
3197 return Fcons (Qscroll_bar_movement
,
3198 (Fcons (Fcons (bar_window
,
3199 Fcons (Qvertical_scroll_bar
,
3200 Fcons (Fcons (x
, y
),
3201 Fcons (make_number (time
),
3207 /* Or is it an ordinary mouse movement? */
3209 #endif /* MULTI_FRAME */
3222 /* It's in a frame; which window on that frame? */
3223 pixel_to_glyph_coords (frame
, XINT (x
), XINT (y
), &column
, &row
, 0, 1);
3224 window
= window_from_coordinates (frame
, column
, row
, &area
);
3229 if (WINDOWP (window
))
3231 int pixcolumn
, pixrow
;
3232 column
-= XINT (XWINDOW (window
)->left
);
3233 row
-= XINT (XWINDOW (window
)->top
);
3234 glyph_to_pixel_coords (frame
, column
, row
, &pixcolumn
, &pixrow
);
3235 XSETINT (x
, pixcolumn
);
3236 XSETINT (y
, pixrow
);
3241 posn
= Qvertical_line
;
3244 buffer_posn_from_coords (XWINDOW (window
), column
, row
));
3247 else if (frame
!= 0)
3249 XSETFRAME (window
, frame
);
3261 return Fcons (Qmouse_movement
,
3262 Fcons (Fcons (window
,
3264 Fcons (Fcons (x
, y
),
3265 Fcons (make_number (time
),
3271 #endif /* neither MULTI_FRAME nor HAVE_MOUSE */
3273 /* Construct a switch frame event. */
3275 make_lispy_switch_frame (frame
)
3278 return Fcons (Qswitch_frame
, Fcons (frame
, Qnil
));
3281 /* Manipulating modifiers. */
3283 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
3285 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
3286 SYMBOL's name of the end of the modifiers; the string from this
3287 position is the unmodified symbol name.
3289 If MODIFIER_END is -1, parse *only* a modifier; expect
3290 the symbol name to be just one modifier, with no dash.
3292 This doesn't use any caches. */
3295 parse_modifiers_uncached (symbol
, modifier_end
)
3299 struct Lisp_String
*name
;
3302 int just_one
= ((int *) (-1) == modifier_end
);
3304 CHECK_SYMBOL (symbol
, 1);
3307 name
= XSYMBOL (symbol
)->name
;
3309 for (i
= 0; i
+2 <= name
->size
; )
3311 int this_mod_end
= 0;
3314 /* See if the name continues with a modifier word.
3315 Check that the word appears, but don't check what follows it.
3316 Set this_mod and this_mod_end to record what we find. */
3318 switch (name
->data
[i
])
3320 #define SINGLE_LETTER_MOD(BIT) \
3321 (this_mod_end = i + 1, this_mod = BIT)
3323 #define MULTI_LETTER_MOD(BIT, NAME, LEN) \
3324 if (i + LEN <= name->size \
3325 && ! strncmp (name->data + i, NAME, LEN)) \
3327 this_mod_end = i + LEN; \
3333 SINGLE_LETTER_MOD (alt_modifier
);
3337 MULTI_LETTER_MOD (alt_modifier
, "alt", 3);
3341 SINGLE_LETTER_MOD (ctrl_modifier
);
3345 MULTI_LETTER_MOD (ctrl_modifier
, "ctrl", 4);
3346 MULTI_LETTER_MOD (ctrl_modifier
, "control", 7);
3350 SINGLE_LETTER_MOD (hyper_modifier
);
3354 MULTI_LETTER_MOD (hyper_modifier
, "hyper", 5);
3358 SINGLE_LETTER_MOD (meta_modifier
);
3362 MULTI_LETTER_MOD (meta_modifier
, "meta", 4);
3366 SINGLE_LETTER_MOD (shift_modifier
);
3370 MULTI_LETTER_MOD (shift_modifier
, "shift", 5);
3371 MULTI_LETTER_MOD (super_modifier
, "super", 5);
3372 SINGLE_LETTER_MOD (super_modifier
);
3376 MULTI_LETTER_MOD (drag_modifier
, "drag", 4);
3377 MULTI_LETTER_MOD (down_modifier
, "down", 4);
3378 MULTI_LETTER_MOD (double_modifier
, "double", 6);
3382 MULTI_LETTER_MOD (triple_modifier
, "triple", 6);
3385 #undef SINGLE_LETTER_MOD
3386 #undef MULTI_LETTER_MOD
3389 /* If we are looking for just a modifier, return now.
3390 Return 0 if we didn't find one; return the
3391 modifier bit if we did find one. */
3394 if (this_mod_end
== name
->size
)
3400 /* If we found no modifier, stop looking for them. */
3401 if (this_mod_end
== 0)
3404 /* Check there is a dash after the modifier, so that it
3405 really is a modifier. */
3406 if (this_mod_end
>= name
->size
|| name
->data
[this_mod_end
] != '-')
3409 /* This modifier is real; look for another. */
3410 modifiers
|= this_mod
;
3411 i
= this_mod_end
+ 1;
3414 /* Should we include the `click' modifier? */
3415 if (! (modifiers
& (down_modifier
| drag_modifier
3416 | double_modifier
| triple_modifier
))
3417 && i
+ 7 == name
->size
3418 && strncmp (name
->data
+ i
, "mouse-", 6) == 0
3419 && ('0' <= name
->data
[i
+ 6] && name
->data
[i
+ 6] <= '9'))
3420 modifiers
|= click_modifier
;
3428 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
3429 prepended to the string BASE[0..BASE_LEN-1].
3430 This doesn't use any caches. */
3432 apply_modifiers_uncached (modifiers
, base
, base_len
)
3437 /* Since BASE could contain nulls, we can't use intern here; we have
3438 to use Fintern, which expects a genuine Lisp_String, and keeps a
3441 (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
3447 /* Only the event queue may use the `up' modifier; it should always
3448 be turned into a click or drag event before presented to lisp code. */
3449 if (modifiers
& up_modifier
)
3452 if (modifiers
& alt_modifier
) { *p
++ = 'A'; *p
++ = '-'; }
3453 if (modifiers
& ctrl_modifier
) { *p
++ = 'C'; *p
++ = '-'; }
3454 if (modifiers
& hyper_modifier
) { *p
++ = 'H'; *p
++ = '-'; }
3455 if (modifiers
& meta_modifier
) { *p
++ = 'M'; *p
++ = '-'; }
3456 if (modifiers
& shift_modifier
) { *p
++ = 'S'; *p
++ = '-'; }
3457 if (modifiers
& super_modifier
) { *p
++ = 's'; *p
++ = '-'; }
3458 if (modifiers
& double_modifier
) { strcpy (p
, "double-"); p
+= 7; }
3459 if (modifiers
& triple_modifier
) { strcpy (p
, "triple-"); p
+= 7; }
3460 if (modifiers
& down_modifier
) { strcpy (p
, "down-"); p
+= 5; }
3461 if (modifiers
& drag_modifier
) { strcpy (p
, "drag-"); p
+= 5; }
3462 /* The click modifier is denoted by the absence of other modifiers. */
3466 mod_len
= p
- new_mods
;
3470 Lisp_Object new_name
;
3472 new_name
= make_uninit_string (mod_len
+ base_len
);
3473 bcopy (new_mods
, XSTRING (new_name
)->data
, mod_len
);
3474 bcopy (base
, XSTRING (new_name
)->data
+ mod_len
, base_len
);
3476 return Fintern (new_name
, Qnil
);
3481 static char *modifier_names
[] =
3483 "up", "down", "drag", "click", "double", "triple", 0, 0,
3484 0, 0, 0, 0, 0, 0, 0, 0,
3485 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
3487 #define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
3489 static Lisp_Object modifier_symbols
;
3491 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
3493 lispy_modifier_list (modifiers
)
3496 Lisp_Object modifier_list
;
3499 modifier_list
= Qnil
;
3500 for (i
= 0; (1<<i
) <= modifiers
&& i
< NUM_MOD_NAMES
; i
++)
3501 if (modifiers
& (1<<i
))
3502 modifier_list
= Fcons (XVECTOR (modifier_symbols
)->contents
[i
],
3505 return modifier_list
;
3509 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
3510 where UNMODIFIED is the unmodified form of SYMBOL,
3511 MASK is the set of modifiers present in SYMBOL's name.
3512 This is similar to parse_modifiers_uncached, but uses the cache in
3513 SYMBOL's Qevent_symbol_element_mask property, and maintains the
3514 Qevent_symbol_elements property. */
3516 parse_modifiers (symbol
)
3519 Lisp_Object elements
;
3521 elements
= Fget (symbol
, Qevent_symbol_element_mask
);
3522 if (CONSP (elements
))
3527 int modifiers
= parse_modifiers_uncached (symbol
, &end
);
3528 Lisp_Object unmodified
;
3531 unmodified
= Fintern (make_string (XSYMBOL (symbol
)->name
->data
+ end
,
3532 XSYMBOL (symbol
)->name
->size
- end
),
3535 if (modifiers
& ~((1<<VALBITS
) - 1))
3537 XSETFASTINT (mask
, modifiers
);
3538 elements
= Fcons (unmodified
, Fcons (mask
, Qnil
));
3540 /* Cache the parsing results on SYMBOL. */
3541 Fput (symbol
, Qevent_symbol_element_mask
,
3543 Fput (symbol
, Qevent_symbol_elements
,
3544 Fcons (unmodified
, lispy_modifier_list (modifiers
)));
3546 /* Since we know that SYMBOL is modifiers applied to unmodified,
3547 it would be nice to put that in unmodified's cache.
3548 But we can't, since we're not sure that parse_modifiers is
3555 /* Apply the modifiers MODIFIERS to the symbol BASE.
3556 BASE must be unmodified.
3558 This is like apply_modifiers_uncached, but uses BASE's
3559 Qmodifier_cache property, if present. It also builds
3560 Qevent_symbol_elements properties, since it has that info anyway.
3562 apply_modifiers copies the value of BASE's Qevent_kind property to
3563 the modified symbol. */
3565 apply_modifiers (modifiers
, base
)
3569 Lisp_Object cache
, index
, entry
, new_symbol
;
3571 /* Mask out upper bits. We don't know where this value's been. */
3572 modifiers
&= (1<<VALBITS
) - 1;
3574 /* The click modifier never figures into cache indices. */
3575 cache
= Fget (base
, Qmodifier_cache
);
3576 XSETFASTINT (index
, (modifiers
& ~click_modifier
));
3577 entry
= assq_no_quit (index
, cache
);
3580 new_symbol
= XCONS (entry
)->cdr
;
3583 /* We have to create the symbol ourselves. */
3584 new_symbol
= apply_modifiers_uncached (modifiers
,
3585 XSYMBOL (base
)->name
->data
,
3586 XSYMBOL (base
)->name
->size
);
3588 /* Add the new symbol to the base's cache. */
3589 entry
= Fcons (index
, new_symbol
);
3590 Fput (base
, Qmodifier_cache
, Fcons (entry
, cache
));
3592 /* We have the parsing info now for free, so add it to the caches. */
3593 XSETFASTINT (index
, modifiers
);
3594 Fput (new_symbol
, Qevent_symbol_element_mask
,
3595 Fcons (base
, Fcons (index
, Qnil
)));
3596 Fput (new_symbol
, Qevent_symbol_elements
,
3597 Fcons (base
, lispy_modifier_list (modifiers
)));
3600 /* Make sure this symbol is of the same kind as BASE.
3602 You'd think we could just set this once and for all when we
3603 intern the symbol above, but reorder_modifiers may call us when
3604 BASE's property isn't set right; we can't assume that just
3605 because it has a Qmodifier_cache property it must have its
3606 Qevent_kind set right as well. */
3607 if (NILP (Fget (new_symbol
, Qevent_kind
)))
3611 kind
= Fget (base
, Qevent_kind
);
3613 Fput (new_symbol
, Qevent_kind
, kind
);
3620 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
3621 return a symbol with the modifiers placed in the canonical order.
3622 Canonical order is alphabetical, except for down and drag, which
3623 always come last. The 'click' modifier is never written out.
3625 Fdefine_key calls this to make sure that (for example) C-M-foo
3626 and M-C-foo end up being equivalent in the keymap. */
3629 reorder_modifiers (symbol
)
3632 /* It's hopefully okay to write the code this way, since everything
3633 will soon be in caches, and no consing will be done at all. */
3636 parsed
= parse_modifiers (symbol
);
3637 return apply_modifiers (XCONS (XCONS (parsed
)->cdr
)->car
,
3638 XCONS (parsed
)->car
);
3642 /* For handling events, we often want to produce a symbol whose name
3643 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
3644 to some base, like the name of a function key or mouse button.
3645 modify_event_symbol produces symbols of this sort.
3647 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
3648 is the name of the i'th symbol. TABLE_SIZE is the number of elements
3651 Alternatively, NAME_ALIST is an alist mapping codes into symbol names.
3652 NAME_ALIST is used if it is non-nil; otherwise NAME_TABLE is used.
3654 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
3655 persist between calls to modify_event_symbol that it can use to
3656 store a cache of the symbols it's generated for this NAME_TABLE
3657 before. The object stored there may be a vector or an alist.
3659 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
3661 MODIFIERS is a set of modifier bits (as given in struct input_events)
3662 whose prefixes should be applied to the symbol name.
3664 SYMBOL_KIND is the value to be placed in the event_kind property of
3665 the returned symbol.
3667 The symbols we create are supposed to have an
3668 `event-symbol-elements' property, which lists the modifiers present
3669 in the symbol's name. */
3672 modify_event_symbol (symbol_num
, modifiers
, symbol_kind
, name_alist
,
3673 name_table
, symbol_table
, table_size
)
3676 Lisp_Object symbol_kind
;
3677 Lisp_Object name_alist
;
3679 Lisp_Object
*symbol_table
;
3683 Lisp_Object symbol_int
;
3685 XSETINT (symbol_int
, symbol_num
);
3687 /* Is this a request for a valid symbol? */
3688 if (symbol_num
< 0 || symbol_num
>= table_size
)
3691 if (CONSP (*symbol_table
))
3692 value
= Fcdr (assq_no_quit (symbol_int
, *symbol_table
));
3694 /* If *symbol_table doesn't seem to be initialized properly, fix that.
3695 *symbol_table should be a lisp vector TABLE_SIZE elements long,
3696 where the Nth element is the symbol for NAME_TABLE[N], or nil if
3697 we've never used that symbol before. */
3700 if (! VECTORP (*symbol_table
)
3701 || XVECTOR (*symbol_table
)->size
!= table_size
)
3705 XSETFASTINT (size
, table_size
);
3706 *symbol_table
= Fmake_vector (size
, Qnil
);
3709 value
= XVECTOR (*symbol_table
)->contents
[symbol_num
];
3712 /* Have we already used this symbol before? */
3715 /* No; let's create it. */
3716 if (!NILP (name_alist
))
3717 value
= Fcdr_safe (Fassq (symbol_int
, name_alist
));
3718 else if (name_table
[symbol_num
])
3719 value
= intern (name_table
[symbol_num
]);
3724 sprintf (buf
, "key-%d", symbol_num
);
3725 value
= intern (buf
);
3728 if (CONSP (*symbol_table
))
3729 *symbol_table
= Fcons (value
, *symbol_table
);
3731 XVECTOR (*symbol_table
)->contents
[symbol_num
] = value
;
3733 /* Fill in the cache entries for this symbol; this also
3734 builds the Qevent_symbol_elements property, which the user
3736 apply_modifiers (modifiers
& click_modifier
, value
);
3737 Fput (value
, Qevent_kind
, symbol_kind
);
3740 /* Apply modifiers to that symbol. */
3741 return apply_modifiers (modifiers
, value
);
3744 /* Convert a list that represents an event type,
3745 such as (ctrl meta backspace), into the usual representation of that
3746 event type as a number or a symbol. */
3749 convert_event_type_list (event
)
3758 while (CONSP (rest
))
3763 elt
= XCONS (rest
)->car
;
3766 this = parse_modifiers_uncached (elt
, -1);
3770 else if (!NILP (base
))
3771 error ("Two bases given in one event");
3775 rest
= XCONS (rest
)->cdr
;
3778 if (INTEGERP (base
))
3780 if (modifiers
& ctrl_modifier
)
3781 return make_number ((modifiers
& ~ ctrl_modifier
)
3782 | make_ctrl_char (XINT (base
)));
3784 return make_number (modifiers
| XINT (base
));
3786 else if (SYMBOLP (base
))
3787 return apply_modifiers (modifiers
, base
);
3789 error ("Invalid base event");
3792 /* Return 1 if EVENT is a list whose elements are all integers or symbols.
3793 Such a list is not valid as an event,
3794 but it can be a Lucid-style event type list. */
3797 lucid_event_type_list_p (object
)
3802 if (! CONSP (object
))
3805 for (tail
= object
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3808 elt
= XCONS (tail
)->car
;
3809 if (! (INTEGERP (elt
) || SYMBOLP (elt
)))
3818 /* Store into *addr a value nonzero if terminal input chars are available.
3819 Serves the purpose of ioctl (0, FIONREAD, addr)
3820 but works even if FIONREAD does not exist.
3821 (In fact, this may actually read some input.) */
3824 get_input_pending (addr
)
3827 /* First of all, have we already counted some input? */
3828 *addr
= !NILP (Vquit_flag
) || readable_events ();
3830 /* If input is being read as it arrives, and we have none, there is none. */
3831 if (*addr
> 0 || (interrupt_input
&& ! interrupts_deferred
))
3834 /* Try to read some input and see how much we get. */
3836 *addr
= !NILP (Vquit_flag
) || readable_events ();
3839 /* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
3842 gobble_input (expected
)
3847 if (interrupt_input
)
3850 mask
= sigblockx (SIGIO
);
3851 read_avail_input (expected
);
3855 #ifdef POLL_FOR_INPUT
3856 if (read_socket_hook
&& !interrupt_input
&& poll_suppress_count
== 0)
3859 mask
= sigblockx (SIGALRM
);
3860 read_avail_input (expected
);
3866 read_avail_input (expected
);
3870 /* Put a buffer_switch_event in the buffer
3871 so that read_key_sequence will notice the new current buffer. */
3873 record_asynch_buffer_change ()
3875 struct input_event event
;
3878 event
.kind
= buffer_switch_event
;
3879 event
.frame_or_window
= Qnil
;
3882 /* We don't need a buffer-switch event unless Emacs is waiting for input.
3883 The purpose of the event is to make read_key_sequence look up the
3884 keymaps again. If we aren't in read_key_sequence, we don't need one,
3885 and the event could cause trouble by messing up (input-pending-p). */
3886 tem
= Fwaiting_for_user_input_p ();
3890 /* We never need these events if we have no asynchronous subprocesses. */
3894 /* Make sure no interrupt happens while storing the event. */
3896 if (interrupt_input
)
3899 mask
= sigblockx (SIGIO
);
3900 kbd_buffer_store_event (&event
);
3907 kbd_buffer_store_event (&event
);
3914 /* Read any terminal input already buffered up by the system
3915 into the kbd_buffer, but do not wait.
3917 EXPECTED should be nonzero if the caller knows there is some input.
3919 Except on VMS, all input is read by this function.
3920 If interrupt_input is nonzero, this function MUST be called
3921 only when SIGIO is blocked.
3923 Returns the number of keyboard chars read, or -1 meaning
3924 this is a bad time to try to read input. */
3927 read_avail_input (expected
)
3930 struct input_event buf
[KBD_BUFFER_SIZE
];
3934 if (read_socket_hook
)
3935 /* No need for FIONREAD or fcntl; just say don't wait. */
3936 nread
= (*read_socket_hook
) (input_fd
, buf
, KBD_BUFFER_SIZE
,
3937 expected
, expected
);
3940 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
3941 the kbd_buffer can really hold. That may prevent loss
3942 of characters on some systems when input is stuffed at us. */
3943 unsigned char cbuf
[KBD_BUFFER_SIZE
- 1];
3946 /* Determine how many characters we should *try* to read. */
3949 #else /* not WINDOWSNT */
3951 n_to_read
= dos_keysns ();
3954 #else /* not MSDOS */
3956 /* Find out how much input is available. */
3957 if (ioctl (input_fd
, FIONREAD
, &n_to_read
) < 0)
3958 /* Formerly simply reported no input, but that sometimes led to
3959 a failure of Emacs to terminate.
3960 SIGHUP seems appropriate if we can't reach the terminal. */
3961 /* ??? Is it really right to send the signal just to this process
3962 rather than to the whole process group?
3963 Perhaps on systems with FIONREAD Emacs is alone in its group. */
3964 kill (getpid (), SIGHUP
);
3967 if (n_to_read
> sizeof cbuf
)
3968 n_to_read
= sizeof cbuf
;
3969 #else /* no FIONREAD */
3970 #if defined(USG) || defined(DGUX)
3971 /* Read some input if available, but don't wait. */
3972 n_to_read
= sizeof cbuf
;
3973 fcntl (input_fd
, F_SETFL
, O_NDELAY
);
3978 #endif /* not MSDOS */
3979 #endif /* not WINDOWSNT */
3981 /* Now read; for one reason or another, this will not block.
3982 NREAD is set to the number of chars read. */
3986 cbuf
[0] = dos_keyread();
3989 nread
= read (input_fd
, cbuf
, n_to_read
);
3991 #if defined (AIX) && (! defined (aix386) && defined (_BSD))
3992 /* The kernel sometimes fails to deliver SIGHUP for ptys.
3993 This looks incorrect, but it isn't, because _BSD causes
3994 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
3995 and that causes a value other than 0 when there is no input. */
4001 /* We used to retry the read if it was interrupted.
4002 But this does the wrong thing when O_NDELAY causes
4003 an EAGAIN error. Does anybody know of a situation
4004 where a retry is actually needed? */
4006 nread
< 0 && (errno
== EAGAIN
4020 #if defined (USG) || defined (DGUX)
4021 fcntl (input_fd
, F_SETFL
, 0);
4022 #endif /* USG or DGUX */
4023 #endif /* no FIONREAD */
4024 for (i
= 0; i
< nread
; i
++)
4026 buf
[i
].kind
= ascii_keystroke
;
4027 buf
[i
].modifiers
= 0;
4028 if (meta_key
== 1 && (cbuf
[i
] & 0x80))
4029 buf
[i
].modifiers
= meta_modifier
;
4033 buf
[i
].code
= cbuf
[i
];
4035 XSETFRAME (buf
[i
].frame_or_window
, selected_frame
);
4037 buf
[i
].frame_or_window
= Qnil
;
4042 /* Scan the chars for C-g and store them in kbd_buffer. */
4043 for (i
= 0; i
< nread
; i
++)
4045 kbd_buffer_store_event (&buf
[i
]);
4046 /* Don't look at input that follows a C-g too closely.
4047 This reduces lossage due to autorepeat on C-g. */
4048 if (buf
[i
].kind
== ascii_keystroke
4049 && buf
[i
].code
== quit_char
)
4055 #endif /* not VMS */
4057 #ifdef SIGIO /* for entire page */
4058 /* Note SIGIO has been undef'd if FIONREAD is missing. */
4061 input_available_signal (signo
)
4064 /* Must preserve main program's value of errno. */
4065 int old_errno
= errno
;
4067 extern int select_alarmed
;
4071 /* USG systems forget handlers when they are used;
4072 must reestablish each time */
4073 signal (signo
, input_available_signal
);
4080 if (input_available_clear_time
)
4081 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
4086 nread
= read_avail_input (1);
4087 /* -1 means it's not ok to read the input now.
4088 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
4089 0 means there was no keyboard input available. */
4094 select_alarmed
= 1; /* Force the select emulator back to life */
4105 /* Send ourselves a SIGIO.
4107 This function exists so that the UNBLOCK_INPUT macro in
4108 blockinput.h can have some way to take care of input we put off
4109 dealing with, without assuming that every file which uses
4110 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
4112 reinvoke_input_signal ()
4121 /* Return the prompt-string of a sparse keymap.
4122 This is the first element which is a string.
4123 Return nil if there is none. */
4131 register Lisp_Object tem
;
4140 static void menu_bar_item ();
4141 static void menu_bar_one_keymap ();
4143 /* These variables hold the vector under construction within
4144 menu_bar_items and its subroutines, and the current index
4145 for storing into that vector. */
4146 static Lisp_Object menu_bar_items_vector
;
4147 static int menu_bar_items_index
;
4149 /* Return a vector of menu items for a menu bar, appropriate
4150 to the current buffer. Each item has three elements in the vector:
4153 OLD is an old vector we can optionally reuse, or nil. */
4156 menu_bar_items (old
)
4159 /* The number of keymaps we're scanning right now, and the number of
4160 keymaps we have allocated space for. */
4163 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
4164 in the current keymaps, or nil where it is not a prefix. */
4167 Lisp_Object def
, tem
, tail
;
4176 struct gcpro gcpro1
;
4178 /* In order to build the menus, we need to call the keymap
4179 accessors. They all call QUIT. But this function is called
4180 during redisplay, during which a quit is fatal. So inhibit
4181 quitting while building the menus.
4182 We do this instead of specbind because (1) errors will clear it anyway
4183 and (2) this avoids risk of specpdl overflow. */
4184 oquit
= Vinhibit_quit
;
4188 menu_bar_items_vector
= old
;
4190 menu_bar_items_vector
= Fmake_vector (make_number (24), Qnil
);
4191 menu_bar_items_index
= 0;
4193 GCPRO1 (menu_bar_items_vector
);
4195 /* Build our list of keymaps.
4196 If we recognize a function key and replace its escape sequence in
4197 keybuf with its symbol, or if the sequence starts with a mouse
4198 click and we need to switch buffers, we jump back here to rebuild
4199 the initial keymaps from the current buffer. */
4203 /* Should overriding-local-map apply, here? */
4204 if (!NILP (Voverriding_local_map_menu_flag
))
4206 if (NILP (Voverriding_local_map
))
4208 /* Yes, and it is nil. Use just global map. */
4210 maps
= (Lisp_Object
*) alloca (nmaps
* sizeof (maps
[0]));
4214 /* Yes, and it is non-nil. Use it and the global map. */
4216 maps
= (Lisp_Object
*) alloca (nmaps
* sizeof (maps
[0]));
4217 maps
[0] = Voverriding_local_map
;
4222 /* No, so use major and minor mode keymaps. */
4223 nmaps
= current_minor_maps (0, &tmaps
) + 2;
4224 maps
= (Lisp_Object
*) alloca (nmaps
* sizeof (maps
[0]));
4225 bcopy (tmaps
, maps
, (nmaps
- 2) * sizeof (maps
[0]));
4226 #ifdef USE_TEXT_PROPERTIES
4227 maps
[nmaps
-2] = get_local_map (PT
, current_buffer
);
4229 maps
[nmaps
-2] = current_buffer
->keymap
;
4232 maps
[nmaps
-1] = current_global_map
;
4235 /* Look up in each map the dummy prefix key `menu-bar'. */
4239 for (mapno
= nmaps
- 1; mapno
>= 0; mapno
--)
4241 if (! NILP (maps
[mapno
]))
4242 def
= get_keyelt (access_keymap (maps
[mapno
], Qmenu_bar
, 1, 0));
4246 tem
= Fkeymapp (def
);
4248 menu_bar_one_keymap (def
);
4251 /* Move to the end those items that should be at the end. */
4253 for (tail
= Vmenu_bar_final_items
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4256 int end
= menu_bar_items_index
;
4258 for (i
= 0; i
< end
; i
+= 3)
4259 if (EQ (XCONS (tail
)->car
, XVECTOR (menu_bar_items_vector
)->contents
[i
]))
4261 Lisp_Object tem0
, tem1
, tem2
;
4262 /* Move the item at index I to the end,
4263 shifting all the others forward. */
4264 tem0
= XVECTOR (menu_bar_items_vector
)->contents
[i
+ 0];
4265 tem1
= XVECTOR (menu_bar_items_vector
)->contents
[i
+ 1];
4266 tem2
= XVECTOR (menu_bar_items_vector
)->contents
[i
+ 2];
4268 bcopy (&XVECTOR (menu_bar_items_vector
)->contents
[i
+ 3],
4269 &XVECTOR (menu_bar_items_vector
)->contents
[i
],
4270 (end
- i
- 3) * sizeof (Lisp_Object
));
4271 XVECTOR (menu_bar_items_vector
)->contents
[end
- 3] = tem0
;
4272 XVECTOR (menu_bar_items_vector
)->contents
[end
- 2] = tem1
;
4273 XVECTOR (menu_bar_items_vector
)->contents
[end
- 1] = tem2
;
4278 /* Add nil, nil, nil at the end. */
4279 i
= menu_bar_items_index
;
4280 if (i
+ 3 > XVECTOR (menu_bar_items_vector
)->size
)
4283 int newsize
= 2 * i
;
4284 tem
= Fmake_vector (make_number (2 * i
), Qnil
);
4285 bcopy (XVECTOR (menu_bar_items_vector
)->contents
,
4286 XVECTOR (tem
)->contents
, i
* sizeof (Lisp_Object
));
4287 menu_bar_items_vector
= tem
;
4289 /* Add this item. */
4290 XVECTOR (menu_bar_items_vector
)->contents
[i
++] = Qnil
;
4291 XVECTOR (menu_bar_items_vector
)->contents
[i
++] = Qnil
;
4292 XVECTOR (menu_bar_items_vector
)->contents
[i
++] = Qnil
;
4293 menu_bar_items_index
= i
;
4295 Vinhibit_quit
= oquit
;
4297 return menu_bar_items_vector
;
4300 /* Scan one map KEYMAP, accumulating any menu items it defines
4301 in menu_bar_items_vector. */
4304 menu_bar_one_keymap (keymap
)
4307 Lisp_Object tail
, item
, key
, binding
, item_string
, table
;
4309 /* Loop over all keymap entries that have menu strings. */
4310 for (tail
= keymap
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4312 item
= XCONS (tail
)->car
;
4315 key
= XCONS (item
)->car
;
4316 binding
= XCONS (item
)->cdr
;
4317 if (CONSP (binding
))
4319 item_string
= XCONS (binding
)->car
;
4320 if (STRINGP (item_string
))
4321 menu_bar_item (key
, item_string
, Fcdr (binding
));
4323 else if (EQ (binding
, Qundefined
))
4324 menu_bar_item (key
, Qnil
, binding
);
4326 else if (VECTORP (item
))
4328 /* Loop over the char values represented in the vector. */
4329 int len
= XVECTOR (item
)->size
;
4331 for (c
= 0; c
< len
; c
++)
4333 Lisp_Object character
;
4334 XSETFASTINT (character
, c
);
4335 binding
= XVECTOR (item
)->contents
[c
];
4336 if (CONSP (binding
))
4338 item_string
= XCONS (binding
)->car
;
4339 if (STRINGP (item_string
))
4340 menu_bar_item (key
, item_string
, Fcdr (binding
));
4342 else if (EQ (binding
, Qundefined
))
4343 menu_bar_item (key
, Qnil
, binding
);
4349 /* This is used as the handler when calling internal_condition_case_1. */
4352 menu_bar_item_1 (arg
)
4358 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
4359 If there's already an item for KEY, add this DEF to it. */
4362 menu_bar_item (key
, item_string
, def
)
4363 Lisp_Object key
, item_string
, def
;
4366 Lisp_Object enabled
;
4369 if (EQ (def
, Qundefined
))
4371 /* If a map has an explicit `undefined' as definition,
4372 discard any previously made menu bar item. */
4374 for (i
= 0; i
< menu_bar_items_index
; i
+= 3)
4375 if (EQ (key
, XVECTOR (menu_bar_items_vector
)->contents
[i
]))
4377 if (menu_bar_items_index
> i
+ 3)
4378 bcopy (&XVECTOR (menu_bar_items_vector
)->contents
[i
+ 3],
4379 &XVECTOR (menu_bar_items_vector
)->contents
[i
],
4380 (menu_bar_items_index
- i
- 3) * sizeof (Lisp_Object
));
4381 menu_bar_items_index
-= 3;
4385 /* If there's no definition for this key yet,
4386 just ignore `undefined'. */
4390 /* See if this entry is enabled. */
4395 /* No property, or nil, means enable.
4396 Otherwise, enable if value is not nil. */
4397 tem
= Fget (def
, Qmenu_enable
);
4399 /* (condition-case nil (eval tem)
4401 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
4405 /* Ignore this item if it's not enabled. */
4409 /* Find any existing item for this KEY. */
4410 for (i
= 0; i
< menu_bar_items_index
; i
+= 3)
4411 if (EQ (key
, XVECTOR (menu_bar_items_vector
)->contents
[i
]))
4414 /* If we did not find this KEY, add it at the end. */
4415 if (i
== menu_bar_items_index
)
4417 /* If vector is too small, get a bigger one. */
4418 if (i
+ 3 > XVECTOR (menu_bar_items_vector
)->size
)
4421 int newsize
= 2 * i
;
4422 tem
= Fmake_vector (make_number (2 * i
), Qnil
);
4423 bcopy (XVECTOR (menu_bar_items_vector
)->contents
,
4424 XVECTOR (tem
)->contents
, i
* sizeof (Lisp_Object
));
4425 menu_bar_items_vector
= tem
;
4427 /* Add this item. */
4428 XVECTOR (menu_bar_items_vector
)->contents
[i
++] = key
;
4429 XVECTOR (menu_bar_items_vector
)->contents
[i
++] = item_string
;
4430 XVECTOR (menu_bar_items_vector
)->contents
[i
++] = Fcons (def
, Qnil
);
4431 menu_bar_items_index
= i
;
4433 /* We did find an item for this KEY. Add DEF to its list of maps. */
4437 old
= XVECTOR (menu_bar_items_vector
)->contents
[i
+ 2];
4438 XVECTOR (menu_bar_items_vector
)->contents
[i
+ 2] = Fcons (def
, old
);
4442 /* Read a character using menus based on maps in the array MAPS.
4443 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
4444 Return t if we displayed a menu but the user rejected it.
4446 PREV_EVENT is the previous input event, or nil if we are reading
4447 the first event of a key sequence.
4449 If USED_MOUSE_MENU is non-zero, then we set *USED_MOUSE_MENU to 1
4450 if we used a mouse menu to read the input, or zero otherwise. If
4451 USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone.
4453 The prompting is done based on the prompt-string of the map
4454 and the strings associated with various map elements.
4456 This can be done with X menus or with menus put in the minibuf.
4457 These are done in different ways, depending on how the input will be read.
4458 Menus using X are done after auto-saving in read-char, getting the input
4459 event from Fx_popup_menu; menus using the minibuf use read_char recursively
4460 and do auto-saving in the inner call of read_char. */
4463 read_char_x_menu_prompt (nmaps
, maps
, prev_event
, used_mouse_menu
)
4466 Lisp_Object prev_event
;
4467 int *used_mouse_menu
;
4470 register Lisp_Object name
;
4471 Lisp_Object rest
, vector
;
4473 if (used_mouse_menu
)
4474 *used_mouse_menu
= 0;
4476 /* Use local over global Menu maps */
4478 if (! menu_prompting
)
4481 /* Optionally disregard all but the global map. */
4482 if (inhibit_local_menu_bar_menus
)
4484 maps
+= (nmaps
- 1);
4488 /* Get the menu name from the first map that has one (a prompt string). */
4489 for (mapno
= 0; mapno
< nmaps
; mapno
++)
4491 name
= map_prompt (maps
[mapno
]);
4496 /* If we don't have any menus, just read a character normally. */
4500 #if (defined (HAVE_X_WINDOWS) && defined (HAVE_X_MENU)) || defined (MSDOS)
4501 /* If we got to this point via a mouse click,
4502 use a real menu for mouse selection. */
4503 if (EVENT_HAS_PARAMETERS (prev_event
))
4505 /* Display the menu and get the selection. */
4506 Lisp_Object
*realmaps
4507 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
4511 /* Use the maps that are not nil. */
4512 for (mapno
= 0; mapno
< nmaps
; mapno
++)
4513 if (!NILP (maps
[mapno
]))
4514 realmaps
[nmaps1
++] = maps
[mapno
];
4516 value
= Fx_popup_menu (prev_event
, Flist (nmaps1
, realmaps
));
4519 /* If we got more than one event, put all but the first
4520 onto this list to be read later.
4521 Return just the first event now. */
4522 Vunread_command_events
4523 = nconc2 (XCONS (value
)->cdr
, Vunread_command_events
);
4524 value
= XCONS (value
)->car
;
4526 else if (NILP (value
))
4528 if (used_mouse_menu
)
4529 *used_mouse_menu
= 1;
4532 #endif /* (HAVE_X_WINDOWS && HAVE_X_MENU) || MSDOS */
4537 read_char_minibuf_menu_prompt (commandflag
, nmaps
, maps
)
4543 register Lisp_Object name
;
4545 int width
= FRAME_WIDTH (selected_frame
) - 4;
4546 char *menu
= (char *) alloca (width
+ 4);
4549 Lisp_Object rest
, vector
;
4551 if (! menu_prompting
)
4554 /* Get the menu name from the first map that has one (a prompt string). */
4555 for (mapno
= 0; mapno
< nmaps
; mapno
++)
4557 name
= map_prompt (maps
[mapno
]);
4562 /* If we don't have any menus, just read a character normally. */
4566 /* Prompt string always starts with map's prompt, and a space. */
4567 strcpy (menu
, XSTRING (name
)->data
);
4568 nlength
= XSTRING (name
)->size
;
4569 menu
[nlength
++] = ':';
4570 menu
[nlength
++] = ' ';
4573 /* Start prompting at start of first map. */
4577 /* Present the documented bindings, a line at a time. */
4584 Lisp_Object orig_defn_macro
;
4586 /* Loop over elements of map. */
4591 /* If reached end of map, start at beginning of next map. */
4595 /* At end of last map, wrap around to first map if just starting,
4596 or end this line if already have something on it. */
4600 if (notfirst
|| nobindings
) break;
4605 /* Look at the next element of the map. */
4607 elt
= XVECTOR (vector
)->contents
[idx
];
4609 elt
= Fcar_safe (rest
);
4611 if (idx
< 0 && VECTORP (elt
))
4613 /* If we found a dense table in the keymap,
4614 advanced past it, but start scanning its contents. */
4615 rest
= Fcdr_safe (rest
);
4621 /* An ordinary element. */
4623 s
= Fcar_safe (Fcdr_safe (elt
)); /* alist */
4625 s
= Fcar_safe(elt
); /* vector */
4627 /* Ignore the element if it has no prompt string. */
4629 /* If we have room for the prompt string, add it to this line.
4630 If this is the first on the line, always add it. */
4631 else if (XSTRING (s
)->size
+ i
+ 2 < width
4636 /* Punctuate between strings. */
4639 strcpy (menu
+ i
, ", ");
4645 /* Add as much of string as fits. */
4646 thiswidth
= XSTRING (s
)->size
;
4647 if (thiswidth
+ i
> width
)
4648 thiswidth
= width
- i
;
4649 bcopy (XSTRING (s
)->data
, menu
+ i
, thiswidth
);
4655 /* If this element does not fit, end the line now,
4656 and save the element for the next line. */
4657 strcpy (menu
+ i
, "...");
4661 /* Move past this element. */
4662 if (idx
>= 0 && idx
+ 1 >= XVECTOR (vector
)->size
)
4663 /* Handle reaching end of dense table. */
4668 rest
= Fcdr_safe (rest
);
4672 /* Prompt with that and read response. */
4675 /* Make believe its not a keyboard macro in case the help char
4676 is pressed. Help characters are not recorded because menu prompting
4677 is not used on replay.
4679 orig_defn_macro
= current_perdisplay
->defining_kbd_macro
;
4680 current_perdisplay
->defining_kbd_macro
= Qnil
;
4682 obj
= read_char (commandflag
, 0, 0, Qnil
, 0);
4683 while (BUFFERP (obj
));
4684 current_perdisplay
->defining_kbd_macro
= orig_defn_macro
;
4686 if (!INTEGERP (obj
))
4691 if (! EQ (obj
, menu_prompt_more_char
)
4692 && (!INTEGERP (menu_prompt_more_char
)
4693 || ! EQ (obj
, make_number (Ctl (XINT (menu_prompt_more_char
))))))
4695 if (!NILP (current_perdisplay
->defining_kbd_macro
))
4696 store_kbd_macro_char (obj
);
4699 /* Help char - go round again */
4703 /* Reading key sequences. */
4705 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
4706 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
4707 keymap, or nil otherwise. Return the index of the first keymap in
4708 which KEY has any binding, or NMAPS if no map has a binding.
4710 If KEY is a meta ASCII character, treat it like meta-prefix-char
4711 followed by the corresponding non-meta character. Keymaps in
4712 CURRENT with non-prefix bindings for meta-prefix-char become nil in
4715 If KEY has no bindings in any of the CURRENT maps, NEXT is left
4718 NEXT may == CURRENT. */
4721 follow_key (key
, nmaps
, current
, defs
, next
)
4723 Lisp_Object
*current
, *defs
, *next
;
4726 int i
, first_binding
;
4728 /* If KEY is a meta ASCII character, treat it like meta-prefix-char
4729 followed by the corresponding non-meta character. */
4730 if (INTEGERP (key
) && (XINT (key
) & CHAR_META
))
4732 for (i
= 0; i
< nmaps
; i
++)
4733 if (! NILP (current
[i
]))
4736 get_keyelt (access_keymap (current
[i
], meta_prefix_char
, 1, 0));
4738 /* Note that since we pass the resulting bindings through
4739 get_keymap_1, non-prefix bindings for meta-prefix-char
4741 next
[i
] = get_keymap_1 (next
[i
], 0, 1);
4747 XSETINT (key
, XFASTINT (key
) & ~CHAR_META
);
4750 first_binding
= nmaps
;
4751 for (i
= nmaps
- 1; i
>= 0; i
--)
4753 if (! NILP (current
[i
]))
4755 defs
[i
] = get_keyelt (access_keymap (current
[i
], key
, 1, 0));
4756 if (! NILP (defs
[i
]))
4763 /* Given the set of bindings we've found, produce the next set of maps. */
4764 if (first_binding
< nmaps
)
4765 for (i
= 0; i
< nmaps
; i
++)
4766 next
[i
] = NILP (defs
[i
]) ? Qnil
: get_keymap_1 (defs
[i
], 0, 1);
4768 return first_binding
;
4771 /* Read a sequence of keys that ends with a non prefix character,
4772 storing it in KEYBUF, a buffer of size BUFSIZE.
4774 Return the length of the key sequence stored.
4775 Return -1 if the user rejected a command menu.
4777 Echo starting immediately unless `prompt' is 0.
4779 Where a key sequence ends depends on the currently active keymaps.
4780 These include any minor mode keymaps active in the current buffer,
4781 the current buffer's local map, and the global map.
4783 If a key sequence has no other bindings, we check Vfunction_key_map
4784 to see if some trailing subsequence might be the beginning of a
4785 function key's sequence. If so, we try to read the whole function
4786 key, and substitute its symbolic name into the key sequence.
4788 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
4789 `double-' events into similar click events, if that would make them
4790 bound. We try to turn `triple-' events first into `double-' events,
4793 If we get a mouse click in a mode line, vertical divider, or other
4794 non-text area, we treat the click as if it were prefixed by the
4795 symbol denoting that area - `mode-line', `vertical-line', or
4798 If the sequence starts with a mouse click, we read the key sequence
4799 with respect to the buffer clicked on, not the current buffer.
4801 If the user switches frames in the midst of a key sequence, we put
4802 off the switch-frame event until later; the next call to
4803 read_char will return it. */
4806 read_key_sequence (keybuf
, bufsize
, prompt
, dont_downcase_last
,
4807 can_return_switch_frame
)
4808 Lisp_Object
*keybuf
;
4811 int dont_downcase_last
;
4812 int can_return_switch_frame
;
4814 int count
= specpdl_ptr
- specpdl
;
4816 /* How many keys there are in the current key sequence. */
4819 /* The length of the echo buffer when we started reading, and
4820 the length of this_command_keys when we started reading. */
4824 /* The number of keymaps we're scanning right now, and the number of
4825 keymaps we have allocated space for. */
4827 int nmaps_allocated
= 0;
4829 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
4830 the current keymaps. */
4833 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
4834 in the current keymaps, or nil where it is not a prefix. */
4835 Lisp_Object
*submaps
;
4837 /* The local map to start out with at start of key sequence. */
4838 Lisp_Object orig_local_map
;
4840 /* 1 if we have already considered switching to the local-map property
4841 of the place where a mouse click occurred. */
4842 int localized_local_map
= 0;
4844 /* The index in defs[] of the first keymap that has a binding for
4845 this key sequence. In other words, the lowest i such that
4846 defs[i] is non-nil. */
4849 /* If t < mock_input, then KEYBUF[t] should be read as the next
4852 We use this to recover after recognizing a function key. Once we
4853 realize that a suffix of the current key sequence is actually a
4854 function key's escape sequence, we replace the suffix with the
4855 function key's binding from Vfunction_key_map. Now keybuf
4856 contains a new and different key sequence, so the echo area,
4857 this_command_keys, and the submaps and defs arrays are wrong. In
4858 this situation, we set mock_input to t, set t to 0, and jump to
4859 restart_sequence; the loop will read keys from keybuf up until
4860 mock_input, thus rebuilding the state; and then it will resume
4861 reading characters from the keyboard. */
4864 /* If the sequence is unbound in submaps[], then
4865 keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map,
4866 and fkey_map is its binding.
4868 These might be > t, indicating that all function key scanning
4869 should hold off until t reaches them. We do this when we've just
4870 recognized a function key, to avoid searching for the function
4871 key's again in Vfunction_key_map. */
4872 int fkey_start
= 0, fkey_end
= 0;
4873 Lisp_Object fkey_map
;
4875 /* Likewise, for key_translation_map. */
4876 int keytran_start
= 0, keytran_end
= 0;
4877 Lisp_Object keytran_map
;
4879 /* If we receive a ``switch-frame'' event in the middle of a key sequence,
4880 we put it off for later. While we're reading, we keep the event here. */
4881 Lisp_Object delayed_switch_frame
;
4883 /* See the comment below... */
4884 #if defined (GOBBLE_FIRST_EVENT)
4885 Lisp_Object first_event
;
4888 Lisp_Object original_uppercase
;
4889 int original_uppercase_position
= -1;
4891 /* Gets around Microsoft compiler limitations. */
4894 struct buffer
*starting_buffer
;
4896 /* Nonzero if we seem to have got the beginning of a binding
4897 in function_key_map. */
4898 int function_key_possible
= 0;
4899 int key_translation_possible
= 0;
4903 last_nonmenu_event
= Qnil
;
4905 delayed_switch_frame
= Qnil
;
4906 fkey_map
= Vfunction_key_map
;
4907 keytran_map
= Vkey_translation_map
;
4909 /* If there is no function-key-map, turn off function key scanning. */
4910 if (NILP (Fkeymapp (Vfunction_key_map
)))
4911 fkey_start
= fkey_end
= bufsize
+ 1;
4913 /* If there is no key-translation-map, turn off scanning. */
4914 if (NILP (Fkeymapp (Vkey_translation_map
)))
4915 keytran_start
= keytran_end
= bufsize
+ 1;
4920 echo_prompt (XSTRING (prompt
)->data
);
4921 else if (cursor_in_echo_area
&& echo_keystrokes
)
4922 /* This doesn't put in a dash if the echo buffer is empty, so
4923 you don't always see a dash hanging out in the minibuffer. */
4927 /* Record the initial state of the echo area and this_command_keys;
4928 we will need to restore them if we replay a key sequence. */
4930 echo_start
= (current_perdisplay
? echo_length () : 0);
4931 keys_start
= this_command_key_count
;
4933 #if defined (GOBBLE_FIRST_EVENT)
4934 /* This doesn't quite work, because some of the things that read_char
4935 does cannot safely be bypassed. It seems too risky to try to make
4938 /* Read the first char of the sequence specially, before setting
4939 up any keymaps, in case a filter runs and switches buffers on us. */
4940 first_event
= read_char (NILP (prompt
), 0, submaps
, last_nonmenu_event
,
4942 #endif /* GOBBLE_FIRST_EVENT */
4944 orig_local_map
= get_local_map (PT
, current_buffer
);
4946 /* We jump here when the key sequence has been thoroughly changed, and
4947 we need to rescan it starting from the beginning. When we jump here,
4948 keybuf[0..mock_input] holds the sequence we should reread. */
4951 starting_buffer
= current_buffer
;
4952 function_key_possible
= 0;
4953 key_translation_possible
= 0;
4955 /* Build our list of keymaps.
4956 If we recognize a function key and replace its escape sequence in
4957 keybuf with its symbol, or if the sequence starts with a mouse
4958 click and we need to switch buffers, we jump back here to rebuild
4959 the initial keymaps from the current buffer. */
4963 if (!NILP (Voverriding_local_map
))
4966 if (nmaps
> nmaps_allocated
)
4968 submaps
= (Lisp_Object
*) alloca (nmaps
* sizeof (submaps
[0]));
4969 defs
= (Lisp_Object
*) alloca (nmaps
* sizeof (defs
[0]));
4970 nmaps_allocated
= nmaps
;
4972 submaps
[0] = Voverriding_local_map
;
4976 nmaps
= current_minor_maps (0, &maps
) + 2;
4977 if (nmaps
> nmaps_allocated
)
4979 submaps
= (Lisp_Object
*) alloca (nmaps
* sizeof (submaps
[0]));
4980 defs
= (Lisp_Object
*) alloca (nmaps
* sizeof (defs
[0]));
4981 nmaps_allocated
= nmaps
;
4983 bcopy (maps
, submaps
, (nmaps
- 2) * sizeof (submaps
[0]));
4984 #ifdef USE_TEXT_PROPERTIES
4985 submaps
[nmaps
-2] = orig_local_map
;
4987 submaps
[nmaps
-2] = current_buffer
->keymap
;
4990 submaps
[nmaps
-1] = current_global_map
;
4993 /* Find an accurate initial value for first_binding. */
4994 for (first_binding
= 0; first_binding
< nmaps
; first_binding
++)
4995 if (! NILP (submaps
[first_binding
]))
4998 /* Start from the beginning in keybuf. */
5001 /* These are no-ops the first time through, but if we restart, they
5002 revert the echo area and this_command_keys to their original state. */
5003 this_command_key_count
= keys_start
;
5004 if (INTERACTIVE
&& t
< mock_input
&& current_perdisplay
)
5005 echo_truncate (echo_start
);
5007 /* If the best binding for the current key sequence is a keymap, or
5008 we may be looking at a function key's escape sequence, keep on
5010 while ((first_binding
< nmaps
&& ! NILP (submaps
[first_binding
]))
5011 || (first_binding
>= nmaps
5013 /* mock input is never part of a function key's sequence. */
5014 && mock_input
<= fkey_start
)
5015 || (first_binding
>= nmaps
5016 && keytran_start
< t
&& key_translation_possible
)
5017 /* Don't return in the middle of a possible function key sequence,
5018 if the only bindings we found were via case conversion.
5019 Thus, if ESC O a has a function-key-map translation
5020 and ESC o has a binding, don't return after ESC O,
5021 so that we can translate ESC O plus the next character. */
5025 int used_mouse_menu
= 0;
5027 /* Where the last real key started. If we need to throw away a
5028 key that has expanded into more than one element of keybuf
5029 (say, a mouse click on the mode line which is being treated
5030 as [mode-line (mouse-...)], then we backtrack to this point
5032 int last_real_key_start
;
5034 /* These variables are analogous to echo_start and keys_start;
5035 while those allow us to restart the entire key sequence,
5036 echo_local_start and keys_local_start allow us to throw away
5038 int echo_local_start
, keys_local_start
, local_first_binding
;
5041 error ("key sequence too long");
5044 echo_local_start
= echo_length ();
5045 keys_local_start
= this_command_key_count
;
5046 local_first_binding
= first_binding
;
5049 /* These are no-ops, unless we throw away a keystroke below and
5050 jumped back up to replay_key; in that case, these restore the
5051 variables to their original state, allowing us to replay the
5053 if (INTERACTIVE
&& t
< mock_input
)
5054 echo_truncate (echo_local_start
);
5055 this_command_key_count
= keys_local_start
;
5056 first_binding
= local_first_binding
;
5058 /* By default, assume each event is "real". */
5059 last_real_key_start
= t
;
5061 /* Does mock_input indicate that we are re-reading a key sequence? */
5065 add_command_key (key
);
5066 if (echo_keystrokes
)
5070 /* If not, we should actually read a character. */
5073 struct buffer
*buf
= current_buffer
;
5076 #ifdef MULTI_PERDISPLAY
5077 PERDISPLAY
*interrupted_perdisplay
= current_perdisplay
;
5078 if (setjmp (wrong_display_jmpbuf
))
5081 interrupted_perdisplay
->kbd_queue
5082 = Fcons (keybuf
[--t
], interrupted_perdisplay
->kbd_queue
);
5084 orig_local_map
= get_local_map (PT
, current_buffer
);
5085 goto replay_sequence
;
5088 key
= read_char (NILP (prompt
), nmaps
, submaps
, last_nonmenu_event
,
5092 /* read_char returns t when it shows a menu and the user rejects it.
5097 /* read_char returns -1 at the end of a macro.
5098 Emacs 18 handles this by returning immediately with a
5099 zero, so that's what we'll do. */
5100 if (INTEGERP (key
) && XINT (key
) == -1)
5103 /* The Microsoft C compiler can't handle the goto that
5109 /* If the current buffer has been changed from under us, the
5110 keymap may have changed, so replay the sequence. */
5114 orig_local_map
= get_local_map (PT
, current_buffer
);
5115 goto replay_sequence
;
5118 /* If we have a quit that was typed in another frame, and
5119 quit_throw_to_read_char switched buffers,
5120 replay to get the right keymap. */
5121 if (XINT (key
) == quit_char
&& current_buffer
!= starting_buffer
)
5126 orig_local_map
= get_local_map (PT
, current_buffer
);
5127 goto replay_sequence
;
5133 /* Clicks in non-text areas get prefixed by the symbol
5134 in their CHAR-ADDRESS field. For example, a click on
5135 the mode line is prefixed by the symbol `mode-line'.
5137 Furthermore, key sequences beginning with mouse clicks
5138 are read using the keymaps of the buffer clicked on, not
5139 the current buffer. So we may have to switch the buffer
5142 When we turn one event into two events, we must make sure
5143 that neither of the two looks like the original--so that,
5144 if we replay the events, they won't be expanded again.
5145 If not for this, such reexpansion could happen either here
5146 or when user programs play with this-command-keys. */
5147 if (EVENT_HAS_PARAMETERS (key
))
5151 kind
= EVENT_HEAD_KIND (EVENT_HEAD (key
));
5152 if (EQ (kind
, Qmouse_click
))
5154 Lisp_Object window
, posn
;
5156 window
= POSN_WINDOW (EVENT_START (key
));
5157 posn
= POSN_BUFFER_POSN (EVENT_START (key
));
5160 /* We're looking at the second event of a
5161 sequence which we expanded before. Set
5162 last_real_key_start appropriately. */
5164 last_real_key_start
= t
- 1;
5167 /* Key sequences beginning with mouse clicks are
5168 read using the keymaps in the buffer clicked on,
5169 not the current buffer. If we're at the
5170 beginning of a key sequence, switch buffers. */
5171 if (last_real_key_start
== 0
5173 && BUFFERP (XWINDOW (window
)->buffer
)
5174 && XBUFFER (XWINDOW (window
)->buffer
) != current_buffer
)
5179 /* Arrange to go back to the original buffer once we're
5180 done reading the key sequence. Note that we can't
5181 use save_excursion_{save,restore} here, because they
5182 save point as well as the current buffer; we don't
5183 want to save point, because redisplay may change it,
5184 to accommodate a Fset_window_start or something. We
5185 don't want to do this at the top of the function,
5186 because we may get input from a subprocess which
5187 wants to change the selected window and stuff (say,
5189 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
5191 set_buffer_internal (XBUFFER (XWINDOW (window
)->buffer
));
5192 orig_local_map
= get_local_map (PT
, current_buffer
);
5193 goto replay_sequence
;
5195 /* For a mouse click, get the local text-property keymap
5196 of the place clicked on, rather than point. */
5197 if (last_real_key_start
== 0 && CONSP (XCONS (key
)->cdr
)
5198 && ! localized_local_map
)
5200 Lisp_Object map_here
, start
, pos
;
5202 localized_local_map
= 1;
5203 start
= EVENT_START (key
);
5204 if (CONSP (start
) && CONSP (XCONS (start
)->cdr
))
5206 pos
= POSN_BUFFER_POSN (start
);
5209 map_here
= get_local_map (XINT (pos
), current_buffer
);
5210 if (!EQ (map_here
, orig_local_map
))
5212 orig_local_map
= map_here
;
5216 goto replay_sequence
;
5222 /* Expand mode-line and scroll-bar events into two events:
5223 use posn as a fake prefix key. */
5226 if (t
+ 1 >= bufsize
)
5227 error ("key sequence too long");
5232 /* Zap the position in key, so we know that we've
5233 expanded it, and don't try to do so again. */
5234 POSN_BUFFER_POSN (EVENT_START (key
))
5235 = Fcons (posn
, Qnil
);
5239 else if (EQ (kind
, Qswitch_frame
))
5241 /* If we're at the beginning of a key sequence, and the caller
5242 says it's okay, go ahead and return this event. If we're
5243 in the midst of a key sequence, delay it until the end. */
5244 if (t
> 0 || !can_return_switch_frame
)
5246 delayed_switch_frame
= key
;
5250 else if (CONSP (XCONS (key
)->cdr
)
5251 && CONSP (EVENT_START (key
))
5252 && CONSP (XCONS (EVENT_START (key
))->cdr
))
5256 posn
= POSN_BUFFER_POSN (EVENT_START (key
));
5257 /* Handle menu-bar events:
5258 insert the dummy prefix event `menu-bar'. */
5259 if (EQ (posn
, Qmenu_bar
))
5261 if (t
+ 1 >= bufsize
)
5262 error ("key sequence too long");
5263 /* Run the Lucid hook. */
5264 if (!NILP (Vrun_hooks
))
5265 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
5266 /* If it has changed current-menubar from previous value,
5267 really recompute the menubar from the value. */
5268 if (! NILP (Vlucid_menu_bar_dirty_flag
))
5269 call0 (Qrecompute_lucid_menubar
);
5273 /* Zap the position in key, so we know that we've
5274 expanded it, and don't try to do so again. */
5275 POSN_BUFFER_POSN (EVENT_START (key
))
5276 = Fcons (posn
, Qnil
);
5279 goto replay_sequence
;
5281 else if (CONSP (posn
))
5283 /* We're looking at the second event of a
5284 sequence which we expanded before. Set
5285 last_real_key_start appropriately. */
5286 if (last_real_key_start
== t
&& t
> 0)
5287 last_real_key_start
= t
- 1;
5292 /* We have finally decided that KEY is something we might want
5294 first_binding
= (follow_key (key
,
5295 nmaps
- first_binding
,
5296 submaps
+ first_binding
,
5297 defs
+ first_binding
,
5298 submaps
+ first_binding
)
5301 /* If KEY wasn't bound, we'll try some fallbacks. */
5302 if (first_binding
>= nmaps
)
5306 head
= EVENT_HEAD (key
);
5307 if (EQ (head
, Vhelp_char
))
5309 read_key_sequence_cmd
= Vprefix_help_command
;
5311 last_nonmenu_event
= key
;
5312 /* The Microsoft C compiler can't handle the goto that
5320 Lisp_Object breakdown
;
5323 breakdown
= parse_modifiers (head
);
5324 modifiers
= XINT (XCONS (XCONS (breakdown
)->cdr
)->car
);
5325 /* Attempt to reduce an unbound mouse event to a simpler
5326 event that is bound:
5327 Drags reduce to clicks.
5328 Double-clicks reduce to clicks.
5329 Triple-clicks reduce to double-clicks, then to clicks.
5330 Down-clicks are eliminated.
5331 Double-downs reduce to downs, then are eliminated.
5332 Triple-downs reduce to double-downs, then to downs,
5333 then are eliminated. */
5334 if (modifiers
& (down_modifier
| drag_modifier
5335 | double_modifier
| triple_modifier
))
5337 while (modifiers
& (down_modifier
| drag_modifier
5338 | double_modifier
| triple_modifier
))
5340 Lisp_Object new_head
, new_click
;
5341 if (modifiers
& triple_modifier
)
5342 modifiers
^= (double_modifier
| triple_modifier
);
5343 else if (modifiers
& double_modifier
)
5344 modifiers
&= ~double_modifier
;
5345 else if (modifiers
& drag_modifier
)
5346 modifiers
&= ~drag_modifier
;
5349 /* Dispose of this `down' event by simply jumping
5350 back to replay_key, to get another event.
5352 Note that if this event came from mock input,
5353 then just jumping back to replay_key will just
5354 hand it to us again. So we have to wipe out any
5357 We could delete keybuf[t] and shift everything
5358 after that to the left by one spot, but we'd also
5359 have to fix up any variable that points into
5360 keybuf, and shifting isn't really necessary
5363 Adding prefixes for non-textual mouse clicks
5364 creates two characters of mock input, and both
5365 must be thrown away. If we're only looking at
5366 the prefix now, we can just jump back to
5367 replay_key. On the other hand, if we've already
5368 processed the prefix, and now the actual click
5369 itself is giving us trouble, then we've lost the
5370 state of the keymaps we want to backtrack to, and
5371 we need to replay the whole sequence to rebuild
5374 Beyond that, only function key expansion could
5375 create more than two keys, but that should never
5376 generate mouse events, so it's okay to zero
5377 mock_input in that case too.
5379 Isn't this just the most wonderful code ever? */
5380 if (t
== last_real_key_start
)
5387 mock_input
= last_real_key_start
;
5388 goto replay_sequence
;
5393 = apply_modifiers (modifiers
, XCONS (breakdown
)->car
);
5395 = Fcons (new_head
, Fcons (EVENT_START (key
), Qnil
));
5397 /* Look for a binding for this new key. follow_key
5398 promises that it didn't munge submaps the
5399 last time we called it, since key was unbound. */
5401 = (follow_key (new_click
,
5402 nmaps
- local_first_binding
,
5403 submaps
+ local_first_binding
,
5404 defs
+ local_first_binding
,
5405 submaps
+ local_first_binding
)
5406 + local_first_binding
);
5408 /* If that click is bound, go for it. */
5409 if (first_binding
< nmaps
)
5414 /* Otherwise, we'll leave key set to the drag event. */
5421 /* Normally, last_nonmenu_event gets the previous key we read.
5422 But when a mouse popup menu is being used,
5423 we don't update last_nonmenu_event; it continues to hold the mouse
5424 event that preceded the first level of menu. */
5425 if (!used_mouse_menu
)
5426 last_nonmenu_event
= key
;
5428 /* If the sequence is unbound, see if we can hang a function key
5429 off the end of it. We only want to scan real keyboard input
5430 for function key sequences, so if mock_input says that we're
5431 re-reading old events, don't examine it. */
5432 if (first_binding
>= nmaps
5435 Lisp_Object fkey_next
;
5437 /* Continue scan from fkey_end until we find a bound suffix.
5438 If we fail, increment fkey_start
5439 and start fkey_end from there. */
5440 while (fkey_end
< t
)
5444 key
= keybuf
[fkey_end
++];
5445 /* Look up meta-characters by prefixing them
5446 with meta_prefix_char. I hate this. */
5447 if (INTEGERP (key
) && XINT (key
) & meta_modifier
)
5452 (access_keymap (fkey_map
, meta_prefix_char
, 1, 0)),
5454 XSETFASTINT (key
, XFASTINT (key
) & ~meta_modifier
);
5457 fkey_next
= fkey_map
;
5460 = get_keyelt (access_keymap (fkey_next
, key
, 1, 0));
5462 #if 0 /* I didn't turn this on, because it might cause trouble
5463 for the mapping of return into C-m and tab into C-i. */
5464 /* Optionally don't map function keys into other things.
5465 This enables the user to redefine kp- keys easily. */
5466 if (SYMBOLP (key
) && !NILP (Vinhibit_function_key_mapping
))
5470 /* If the function key map gives a function, not an
5471 array, then call the function with no args and use
5472 its value instead. */
5473 if (SYMBOLP (fkey_next
) && ! NILP (Ffboundp (fkey_next
))
5476 struct gcpro gcpro1
, gcpro2
, gcpro3
;
5480 GCPRO3 (fkey_map
, keytran_map
, delayed_switch_frame
);
5481 fkey_next
= call1 (fkey_next
, prompt
);
5483 /* If the function returned something invalid,
5484 barf--don't ignore it.
5485 (To ignore it safely, we would need to gcpro a bunch of
5486 other variables.) */
5487 if (! (VECTORP (fkey_next
) || STRINGP (fkey_next
)))
5488 error ("Function in function-key-map returns invalid key sequence");
5491 function_key_possible
= ! NILP (fkey_next
);
5493 /* If keybuf[fkey_start..fkey_end] is bound in the
5494 function key map and it's a suffix of the current
5495 sequence (i.e. fkey_end == t), replace it with
5496 the binding and restart with fkey_start at the end. */
5497 if ((VECTORP (fkey_next
) || STRINGP (fkey_next
))
5500 int len
= XFASTINT (Flength (fkey_next
));
5502 t
= fkey_start
+ len
;
5504 error ("key sequence too long");
5506 if (VECTORP (fkey_next
))
5507 bcopy (XVECTOR (fkey_next
)->contents
,
5508 keybuf
+ fkey_start
,
5509 (t
- fkey_start
) * sizeof (keybuf
[0]));
5510 else if (STRINGP (fkey_next
))
5514 for (i
= 0; i
< len
; i
++)
5515 XSETFASTINT (keybuf
[fkey_start
+ i
],
5516 XSTRING (fkey_next
)->data
[i
]);
5520 fkey_start
= fkey_end
= t
;
5521 fkey_map
= Vfunction_key_map
;
5523 /* Do pass the results through key-translation-map. */
5524 keytran_start
= keytran_end
= 0;
5525 keytran_map
= Vkey_translation_map
;
5527 goto replay_sequence
;
5530 fkey_map
= get_keymap_1 (fkey_next
, 0, 1);
5532 /* If we no longer have a bound suffix, try a new positions for
5534 if (NILP (fkey_map
))
5536 fkey_end
= ++fkey_start
;
5537 fkey_map
= Vfunction_key_map
;
5538 function_key_possible
= 0;
5543 /* Look for this sequence in key-translation-map. */
5545 Lisp_Object keytran_next
;
5547 /* Scan from keytran_end until we find a bound suffix. */
5548 while (keytran_end
< t
)
5552 key
= keybuf
[keytran_end
++];
5553 /* Look up meta-characters by prefixing them
5554 with meta_prefix_char. I hate this. */
5555 if (INTEGERP (key
) && XINT (key
) & meta_modifier
)
5560 (access_keymap (keytran_map
, meta_prefix_char
, 1, 0)),
5562 XSETFASTINT (key
, XFASTINT (key
) & ~meta_modifier
);
5565 keytran_next
= keytran_map
;
5568 = get_keyelt (access_keymap (keytran_next
, key
, 1, 0));
5570 /* If the key translation map gives a function, not an
5571 array, then call the function with no args and use
5572 its value instead. */
5573 if (SYMBOLP (keytran_next
) && ! NILP (Ffboundp (keytran_next
))
5574 && keytran_end
== t
)
5576 struct gcpro gcpro1
, gcpro2
, gcpro3
;
5580 GCPRO3 (fkey_map
, keytran_map
, delayed_switch_frame
);
5581 keytran_next
= call1 (keytran_next
, prompt
);
5583 /* If the function returned something invalid,
5584 barf--don't ignore it.
5585 (To ignore it safely, we would need to gcpro a bunch of
5586 other variables.) */
5587 if (! (VECTORP (keytran_next
) || STRINGP (keytran_next
)))
5588 error ("Function in key-translation-map returns invalid key sequence");
5591 key_translation_possible
= ! NILP (keytran_next
);
5593 /* If keybuf[keytran_start..keytran_end] is bound in the
5594 key translation map and it's a suffix of the current
5595 sequence (i.e. keytran_end == t), replace it with
5596 the binding and restart with keytran_start at the end. */
5597 if ((VECTORP (keytran_next
) || STRINGP (keytran_next
))
5598 && keytran_end
== t
)
5600 int len
= XFASTINT (Flength (keytran_next
));
5602 t
= keytran_start
+ len
;
5604 error ("key sequence too long");
5606 if (VECTORP (keytran_next
))
5607 bcopy (XVECTOR (keytran_next
)->contents
,
5608 keybuf
+ keytran_start
,
5609 (t
- keytran_start
) * sizeof (keybuf
[0]));
5610 else if (STRINGP (keytran_next
))
5614 for (i
= 0; i
< len
; i
++)
5615 XSETFASTINT (keybuf
[keytran_start
+ i
],
5616 XSTRING (keytran_next
)->data
[i
]);
5620 keytran_start
= keytran_end
= t
;
5621 keytran_map
= Vkey_translation_map
;
5623 /* Don't pass the results of key-translation-map
5624 through function-key-map. */
5625 fkey_start
= fkey_end
= t
;
5626 fkey_map
= Vkey_translation_map
;
5628 goto replay_sequence
;
5631 keytran_map
= get_keymap_1 (keytran_next
, 0, 1);
5633 /* If we no longer have a bound suffix, try a new positions for
5635 if (NILP (keytran_map
))
5637 keytran_end
= ++keytran_start
;
5638 keytran_map
= Vkey_translation_map
;
5639 key_translation_possible
= 0;
5644 /* If KEY is not defined in any of the keymaps,
5645 and cannot be part of a function key or translation,
5646 and is an upper case letter
5647 use the corresponding lower-case letter instead. */
5648 if (first_binding
== nmaps
&& ! function_key_possible
5649 && ! key_translation_possible
5651 && ((((XINT (key
) & 0x3ffff)
5652 < XSTRING (current_buffer
->downcase_table
)->size
)
5653 && UPPERCASEP (XINT (key
) & 0x3ffff))
5654 || (XINT (key
) & shift_modifier
)))
5656 original_uppercase
= key
;
5657 original_uppercase_position
= t
- 1;
5659 if (XINT (key
) & shift_modifier
)
5660 XSETINT (key
, XINT (key
) & ~shift_modifier
);
5662 XSETINT (key
, (DOWNCASE (XINT (key
) & 0x3ffff)
5663 | (XINT (key
) & ~0x3ffff)));
5665 keybuf
[t
- 1] = key
;
5667 goto replay_sequence
;
5669 /* If KEY is not defined in any of the keymaps,
5670 and cannot be part of a function key or translation,
5671 and is a shifted function key,
5672 use the corresponding unshifted function key instead. */
5673 if (first_binding
== nmaps
&& ! function_key_possible
5674 && ! key_translation_possible
5677 Lisp_Object breakdown
;
5680 original_uppercase
= key
;
5681 original_uppercase_position
= t
- 1;
5683 breakdown
= parse_modifiers (key
);
5684 modifiers
= XINT (XCONS (XCONS (breakdown
)->cdr
)->car
);
5685 if (modifiers
& shift_modifier
)
5687 modifiers
&= ~shift_modifier
;
5688 key
= apply_modifiers (make_number (modifiers
),
5689 XCONS (breakdown
)->car
);
5691 keybuf
[t
- 1] = key
;
5693 goto replay_sequence
;
5699 read_key_sequence_cmd
= (first_binding
< nmaps
5700 ? defs
[first_binding
]
5703 unread_switch_frame
= delayed_switch_frame
;
5704 unbind_to (count
, Qnil
);
5706 if (dont_downcase_last
&& t
- 1 == original_uppercase_position
)
5707 keybuf
[t
- 1] = original_uppercase
;
5709 /* Occasionally we fabricate events, perhaps by expanding something
5710 according to function-key-map, or by adding a prefix symbol to a
5711 mouse click in the scroll bar or modeline. In this cases, return
5712 the entire generated key sequence, even if we hit an unbound
5713 prefix or a definition before the end. This means that you will
5714 be able to push back the event properly, and also means that
5715 read-key-sequence will always return a logical unit.
5718 for (; t
< mock_input
; t
++)
5720 if (echo_keystrokes
)
5721 echo_char (keybuf
[t
]);
5722 add_command_key (keybuf
[t
]);
5728 #if 0 /* This doc string is too long for some compilers.
5729 This commented-out definition serves for DOC. */
5730 DEFUN ("read-key-sequence", Fread_key_sequence
, Sread_key_sequence
, 1, 4, 0,
5731 "Read a sequence of keystrokes and return as a string or vector.\n\
5732 The sequence is sufficient to specify a non-prefix command in the\n\
5733 current local and global maps.\n\
5735 First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
5736 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\
5737 as a continuation of the previous key.\n\
5739 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not\n\
5740 convert the last event to lower case. (Normally any upper case event\n\
5741 is converted to lower case if the original event is undefined and the lower\n\
5742 case equivalent is defined.) A non-nil value is appropriate for reading\n\
5743 a key sequence to be defined.\n\
5745 A C-g typed while in this function is treated like any other character,\n\
5746 and `quit-flag' is not set.\n\
5748 If the key sequence starts with a mouse click, then the sequence is read\n\
5749 using the keymaps of the buffer of the window clicked in, not the buffer\n\
5750 of the selected window as normal.\n\
5752 `read-key-sequence' drops unbound button-down events, since you normally\n\
5753 only care about the click or drag events which follow them. If a drag\n\
5754 or multi-click event is unbound, but the corresponding click event would\n\
5755 be bound, `read-key-sequence' turns the event into a click event at the\n\
5756 drag's starting position. This means that you don't have to distinguish\n\
5757 between click and drag, double, or triple events unless you want to.\n\
5759 `read-key-sequence' prefixes mouse events on mode lines, the vertical\n\
5760 lines separating windows, and scroll bars with imaginary keys\n\
5761 `mode-line', `vertical-line', and `vertical-scroll-bar'.\n\
5763 Optional fourth argument CAN-RETURN-SWITCH-FRAME non-nil means that this\n\
5764 function will process a switch-frame event if the user switches frames\n\
5765 before typing anything. If the user switches frames in the middle of a\n\
5766 key sequence, or at the start of the sequence but CAN-RETURN-SWITCH-FRAME\n\
5767 is nil, then the event will be put off until after the current key sequence.\n\
5769 `read-key-sequence' checks `function-key-map' for function key\n\
5770 sequences, where they wouldn't conflict with ordinary bindings. See\n\
5771 `function-key-map' for more details.")
5772 (prompt
, continue_echo
)
5775 DEFUN ("read-key-sequence", Fread_key_sequence
, Sread_key_sequence
, 1, 4, 0,
5777 (prompt
, continue_echo
, dont_downcase_last
, can_return_switch_frame
)
5778 Lisp_Object prompt
, continue_echo
, dont_downcase_last
;
5779 Lisp_Object can_return_switch_frame
;
5781 Lisp_Object keybuf
[30];
5783 struct gcpro gcpro1
, gcpro2
;
5786 CHECK_STRING (prompt
, 0);
5789 bzero (keybuf
, sizeof keybuf
);
5791 gcpro1
.nvars
= (sizeof keybuf
/sizeof (keybuf
[0]));
5793 if (NILP (continue_echo
))
5794 this_command_key_count
= 0;
5796 i
= read_key_sequence (keybuf
, (sizeof keybuf
/sizeof (keybuf
[0])),
5797 prompt
, ! NILP (dont_downcase_last
),
5798 ! NILP (can_return_switch_frame
));
5806 return make_event_array (i
, keybuf
);
5809 DEFUN ("command-execute", Fcommand_execute
, Scommand_execute
, 1, 2, 0,
5810 "Execute CMD as an editor command.\n\
5811 CMD must be a symbol that satisfies the `commandp' predicate.\n\
5812 Optional second arg RECORD-FLAG non-nil\n\
5813 means unconditionally put this command in `command-history'.\n\
5814 Otherwise, that is done only if an arg is read using the minibuffer.")
5816 Lisp_Object cmd
, record
;
5818 register Lisp_Object final
;
5819 register Lisp_Object tem
;
5820 Lisp_Object prefixarg
;
5821 struct backtrace backtrace
;
5822 extern int debug_on_next_call
;
5824 prefixarg
= Vprefix_arg
;
5825 clear_prefix_arg ();
5826 Vcurrent_prefix_arg
= prefixarg
;
5827 debug_on_next_call
= 0;
5831 tem
= Fget (cmd
, Qdisabled
);
5832 if (!NILP (tem
) && !NILP (Vrun_hooks
))
5833 return call1 (Vrun_hooks
, Qdisabled_command_hook
);
5838 final
= Findirect_function (cmd
);
5840 if (CONSP (final
) && (tem
= Fcar (final
), EQ (tem
, Qautoload
)))
5841 do_autoload (final
, cmd
);
5846 if (STRINGP (final
) || VECTORP (final
))
5848 /* If requested, place the macro in the command history. For
5849 other sorts of commands, call-interactively takes care of
5853 = Fcons (Fcons (Qexecute_kbd_macro
,
5854 Fcons (final
, Fcons (prefixarg
, Qnil
))),
5857 return Fexecute_kbd_macro (final
, prefixarg
);
5859 if (CONSP (final
) || SUBRP (final
) || COMPILEDP (final
))
5861 backtrace
.next
= backtrace_list
;
5862 backtrace_list
= &backtrace
;
5863 backtrace
.function
= &Qcall_interactively
;
5864 backtrace
.args
= &cmd
;
5865 backtrace
.nargs
= 1;
5866 backtrace
.evalargs
= 0;
5868 tem
= Fcall_interactively (cmd
, record
);
5870 backtrace_list
= backtrace
.next
;
5876 DEFUN ("execute-extended-command", Fexecute_extended_command
, Sexecute_extended_command
,
5878 "Read function name, then read its arguments and call it.")
5880 Lisp_Object prefixarg
;
5882 Lisp_Object function
;
5884 Lisp_Object saved_keys
;
5885 struct gcpro gcpro1
;
5887 saved_keys
= Fvector (this_command_key_count
,
5888 XVECTOR (this_command_keys
)->contents
);
5890 GCPRO1 (saved_keys
);
5892 if (EQ (prefixarg
, Qminus
))
5894 else if (CONSP (prefixarg
) && XINT (XCONS (prefixarg
)->car
) == 4)
5895 strcpy (buf
, "C-u ");
5896 else if (CONSP (prefixarg
) && INTEGERP (XCONS (prefixarg
)->car
))
5897 sprintf (buf
, "%d ", XINT (XCONS (prefixarg
)->car
));
5898 else if (INTEGERP (prefixarg
))
5899 sprintf (buf
, "%d ", XINT (prefixarg
));
5901 /* This isn't strictly correct if execute-extended-command
5902 is bound to anything else. Perhaps it should use
5903 this_command_keys? */
5904 strcat (buf
, "M-x ");
5906 /* Prompt with buf, and then read a string, completing from and
5907 restricting to the set of all defined commands. Don't provide
5908 any initial input. Save the command read on the extended-command
5910 function
= Fcompleting_read (build_string (buf
),
5911 Vobarray
, Qcommandp
,
5912 Qt
, Qnil
, Qextended_command_history
);
5914 /* Set this_command_keys to the concatenation of saved_keys and
5915 function, followed by a RET. */
5917 struct Lisp_String
*str
;
5922 this_command_key_count
= 0;
5924 keys
= XVECTOR (saved_keys
)->contents
;
5925 for (i
= 0; i
< XVECTOR (saved_keys
)->size
; i
++)
5926 add_command_key (keys
[i
]);
5928 str
= XSTRING (function
);
5929 for (i
= 0; i
< str
->size
; i
++)
5931 XSETFASTINT (tem
, str
->data
[i
]);
5932 add_command_key (tem
);
5935 XSETFASTINT (tem
, '\015');
5936 add_command_key (tem
);
5941 function
= Fintern (function
, Qnil
);
5942 Vprefix_arg
= prefixarg
;
5943 this_command
= function
;
5945 return Fcommand_execute (function
, Qt
);
5949 detect_input_pending ()
5952 get_input_pending (&input_pending
);
5954 return input_pending
;
5957 /* This is called in some cases before a possible quit.
5958 It cases the next call to detect_input_pending to recompute input_pending.
5959 So calling this function unnecessarily can't do any harm. */
5960 clear_input_pending ()
5965 DEFUN ("input-pending-p", Finput_pending_p
, Sinput_pending_p
, 0, 0, 0,
5966 "T if command input is currently available with no waiting.\n\
5967 Actually, the value is nil only if we can be sure that no input is available.")
5970 if (!NILP (Vunread_command_events
) || unread_command_char
!= -1)
5973 return detect_input_pending () ? Qt
: Qnil
;
5976 DEFUN ("recent-keys", Frecent_keys
, Srecent_keys
, 0, 0, 0,
5977 "Return vector of last 100 events, not counting those from keyboard macros.")
5980 Lisp_Object
*keys
= XVECTOR (recent_keys
)->contents
;
5983 if (total_keys
< NUM_RECENT_KEYS
)
5984 return Fvector (total_keys
, keys
);
5987 val
= Fvector (NUM_RECENT_KEYS
, keys
);
5988 bcopy (keys
+ recent_keys_index
,
5989 XVECTOR (val
)->contents
,
5990 (NUM_RECENT_KEYS
- recent_keys_index
) * sizeof (Lisp_Object
));
5992 XVECTOR (val
)->contents
+ NUM_RECENT_KEYS
- recent_keys_index
,
5993 recent_keys_index
* sizeof (Lisp_Object
));
5998 DEFUN ("this-command-keys", Fthis_command_keys
, Sthis_command_keys
, 0, 0, 0,
5999 "Return the key sequence that invoked this command.\n\
6000 The value is a string or a vector.")
6003 return make_event_array (this_command_key_count
,
6004 XVECTOR (this_command_keys
)->contents
);
6007 DEFUN ("recursion-depth", Frecursion_depth
, Srecursion_depth
, 0, 0, 0,
6008 "Return the current depth in recursive edits.")
6012 XSETFASTINT (temp
, command_loop_level
+ minibuf_level
);
6016 DEFUN ("open-dribble-file", Fopen_dribble_file
, Sopen_dribble_file
, 1, 1,
6017 "FOpen dribble file: ",
6018 "Start writing all keyboard characters to a dribble file called FILE.\n\
6019 If FILE is nil, close any open dribble file.")
6033 file
= Fexpand_file_name (file
, Qnil
);
6034 dribble
= fopen (XSTRING (file
)->data
, "w");
6039 DEFUN ("discard-input", Fdiscard_input
, Sdiscard_input
, 0, 0, 0,
6040 "Discard the contents of the terminal input buffer.\n\
6041 Also cancel any kbd macro being defined.")
6044 current_perdisplay
->defining_kbd_macro
= Qnil
;
6045 update_mode_lines
++;
6047 Vunread_command_events
= Qnil
;
6048 unread_command_char
= -1;
6050 discard_tty_input ();
6052 /* Without the cast, GCC complains that this assignment loses the
6053 volatile qualifier of kbd_store_ptr. Is there anything wrong
6055 kbd_fetch_ptr
= (struct input_event
*) kbd_store_ptr
;
6056 Ffillarray (kbd_buffer_frame_or_window
, Qnil
);
6062 DEFUN ("suspend-emacs", Fsuspend_emacs
, Ssuspend_emacs
, 0, 1, "",
6063 "Stop Emacs and return to superior process. You can resume later.\n\
6064 If `cannot-suspend' is non-nil, or if the system doesn't support job\n\
6065 control, run a subshell instead.\n\n\
6066 If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
6067 to be read as terminal input by Emacs's parent, after suspension.\n\
6069 Before suspending, run the normal hook `suspend-hook'.\n\
6070 After resumption run the normal hook `suspend-resume-hook'.\n\
6072 Some operating systems cannot stop the Emacs process and resume it later.\n\
6073 On such systems, Emacs starts a subshell instead of suspending.")
6075 Lisp_Object stuffstring
;
6078 int count
= specpdl_ptr
- specpdl
;
6079 int old_height
, old_width
;
6081 struct gcpro gcpro1
, gcpro2
;
6082 extern init_sys_modes ();
6084 if (!NILP (stuffstring
))
6085 CHECK_STRING (stuffstring
, 0);
6087 /* Run the functions in suspend-hook. */
6088 if (!NILP (Vrun_hooks
))
6089 call1 (Vrun_hooks
, intern ("suspend-hook"));
6091 GCPRO1 (stuffstring
);
6092 get_frame_size (&old_width
, &old_height
);
6094 /* sys_suspend can get an error if it tries to fork a subshell
6095 and the system resources aren't available for that. */
6096 record_unwind_protect (init_sys_modes
, 0);
6097 stuff_buffered_input (stuffstring
);
6102 unbind_to (count
, Qnil
);
6104 /* Check if terminal/window size has changed.
6105 Note that this is not useful when we are running directly
6106 with a window system; but suspend should be disabled in that case. */
6107 get_frame_size (&width
, &height
);
6108 if (width
!= old_width
|| height
!= old_height
)
6109 change_frame_size (selected_frame
, height
, width
, 0, 0);
6111 /* Run suspend-resume-hook. */
6112 if (!NILP (Vrun_hooks
))
6113 call1 (Vrun_hooks
, intern ("suspend-resume-hook"));
6119 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
6120 Then in any case stuff anything Emacs has read ahead and not used. */
6122 stuff_buffered_input (stuffstring
)
6123 Lisp_Object stuffstring
;
6125 /* stuff_char works only in BSD, versions 4.2 and up. */
6128 register unsigned char *p
;
6130 if (STRINGP (stuffstring
))
6134 p
= XSTRING (stuffstring
)->data
;
6135 count
= XSTRING (stuffstring
)->size
;
6140 /* Anything we have read ahead, put back for the shell to read. */
6141 /* ?? What should this do when we have multiple keyboards??
6142 Should we ignore anything that was typed in at the "wrong" display? */
6143 for (; kbd_fetch_ptr
!= kbd_store_ptr
; kbd_fetch_ptr
++)
6145 if (kbd_fetch_ptr
== kbd_buffer
+ KBD_BUFFER_SIZE
)
6146 kbd_fetch_ptr
= kbd_buffer
;
6147 if (kbd_fetch_ptr
->kind
== ascii_keystroke
)
6148 stuff_char (kbd_fetch_ptr
->code
);
6149 kbd_fetch_ptr
->kind
= no_event
;
6150 (XVECTOR (kbd_buffer_frame_or_window
)->contents
[kbd_fetch_ptr
6156 #endif /* BSD and not BSD4_1 */
6159 set_waiting_for_input (time_to_clear
)
6160 EMACS_TIME
*time_to_clear
;
6162 input_available_clear_time
= time_to_clear
;
6164 /* Tell interrupt_signal to throw back to read_char, */
6165 waiting_for_input
= 1;
6167 /* If interrupt_signal was called before and buffered a C-g,
6168 make it run again now, to avoid timing error. */
6169 if (!NILP (Vquit_flag
))
6170 quit_throw_to_read_char ();
6173 clear_waiting_for_input ()
6175 /* Tell interrupt_signal not to throw back to read_char, */
6176 waiting_for_input
= 0;
6177 input_available_clear_time
= 0;
6180 /* This routine is called at interrupt level in response to C-G.
6181 If interrupt_input, this is the handler for SIGINT.
6182 Otherwise, it is called from kbd_buffer_store_event,
6183 in handling SIGIO or SIGTINT.
6185 If `waiting_for_input' is non zero, then unless `echoing' is nonzero,
6186 immediately throw back to read_char.
6188 Otherwise it sets the Lisp variable quit-flag not-nil.
6189 This causes eval to throw, when it gets a chance.
6190 If quit-flag is already non-nil, it stops the job right away. */
6193 interrupt_signal (signalnum
) /* If we don't have an argument, */
6194 int signalnum
; /* some compilers complain in signal calls. */
6197 /* Must preserve main program's value of errno. */
6198 int old_errno
= errno
;
6201 if (!read_socket_hook
&& NILP (Vwindow_system
))
6203 /* USG systems forget handlers when they are used;
6204 must reestablish each time */
6205 signal (SIGINT
, interrupt_signal
);
6206 signal (SIGQUIT
, interrupt_signal
);
6212 if (!NILP (Vquit_flag
) && FRAME_TERMCAP_P (selected_frame
))
6217 #ifdef SIGTSTP /* Support possible in later USG versions */
6219 * On systems which can suspend the current process and return to the original
6220 * shell, this command causes the user to end up back at the shell.
6221 * The "Auto-save" and "Abort" questions are not asked until
6222 * the user elects to return to emacs, at which point he can save the current
6223 * job and either dump core or continue.
6228 if (sys_suspend () == -1)
6230 printf ("Not running as a subprocess;\n");
6231 printf ("you can continue or abort.\n");
6234 /* Perhaps should really fork an inferior shell?
6235 But that would not provide any way to get back
6236 to the original shell, ever. */
6237 printf ("No support for stopping a process on this operating system;\n");
6238 printf ("you can continue or abort.\n");
6239 #endif /* not VMS */
6240 #endif /* not SIGTSTP */
6242 /* We must remain inside the screen area when the internal terminal
6243 is used. Note that [Enter] is not echoed by dos. */
6246 printf ("Auto-save? (y or n) ");
6248 if (((c
= getchar ()) & ~040) == 'Y')
6250 Fdo_auto_save (Qt
, Qnil
);
6252 printf ("\r\nAuto-save done");
6253 #else /* not MSDOS */
6254 printf ("Auto-save done\n");
6255 #endif /* not MSDOS */
6257 while (c
!= '\n') c
= getchar ();
6259 printf ("\r\nAbort? (y or n) ");
6260 #else /* not MSDOS */
6262 printf ("Abort (and enter debugger)? (y or n) ");
6264 printf ("Abort (and dump core)? (y or n) ");
6265 #endif /* not VMS */
6266 #endif /* not MSDOS */
6268 if (((c
= getchar ()) & ~040) == 'Y')
6270 while (c
!= '\n') c
= getchar ();
6272 printf ("\r\nContinuing...\r\n");
6273 #else /* not MSDOS */
6274 printf ("Continuing...\n");
6275 #endif /* not MSDOS */
6281 /* If executing a function that wants to be interrupted out of
6282 and the user has not deferred quitting by binding `inhibit-quit'
6283 then quit right away. */
6284 if (immediate_quit
&& NILP (Vinhibit_quit
))
6288 Fsignal (Qquit
, Qnil
);
6291 /* Else request quit when it's safe */
6295 if (waiting_for_input
&& !echoing
)
6296 quit_throw_to_read_char ();
6301 /* Handle a C-g by making read_char return C-g. */
6303 quit_throw_to_read_char ()
6305 quit_error_check ();
6307 /* Prevent another signal from doing this before we finish. */
6308 clear_waiting_for_input ();
6311 Vunread_command_events
= Qnil
;
6312 unread_command_char
= -1;
6314 #ifdef POLL_FOR_INPUT
6315 /* May be > 1 if in recursive minibuffer. */
6316 if (poll_suppress_count
== 0)
6320 if (FRAMEP (internal_last_event_frame
)
6321 && XFRAME (internal_last_event_frame
) != selected_frame
)
6322 Fhandle_switch_frame (make_lispy_switch_frame (internal_last_event_frame
));
6325 _longjmp (getcjmp
, 1);
6328 DEFUN ("set-input-mode", Fset_input_mode
, Sset_input_mode
, 3, 4, 0,
6329 "Set mode of reading keyboard input.\n\
6330 First arg INTERRUPT non-nil means use input interrupts;\n\
6331 nil means use CBREAK mode.\n\
6332 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
6333 (no effect except in CBREAK mode).\n\
6334 Third arg META t means accept 8-bit input (for a Meta key).\n\
6335 META nil means ignore the top bit, on the assumption it is parity.\n\
6336 Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\
6337 Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\
6338 See also `current-input-mode'.")
6339 (interrupt
, flow
, meta
, quit
)
6340 Lisp_Object interrupt
, flow
, meta
, quit
;
6343 && (!INTEGERP (quit
) || XINT (quit
) < 0 || XINT (quit
) > 0400))
6344 error ("set-input-mode: QUIT must be an ASCII character");
6346 #ifdef POLL_FOR_INPUT
6352 /* Note SIGIO has been undef'd if FIONREAD is missing. */
6353 #ifdef NO_SOCK_SIGIO
6354 if (read_socket_hook
)
6355 interrupt_input
= 0; /* No interrupts if reading from a socket. */
6357 #endif /* NO_SOCK_SIGIO */
6358 interrupt_input
= !NILP (interrupt
);
6359 #else /* not SIGIO */
6360 interrupt_input
= 0;
6361 #endif /* not SIGIO */
6362 /* Our VMS input only works by interrupts, as of now. */
6364 interrupt_input
= 1;
6366 flow_control
= !NILP (flow
);
6369 else if (EQ (meta
, Qt
))
6374 /* Don't let this value be out of range. */
6375 quit_char
= XINT (quit
) & (meta_key
? 0377 : 0177);
6379 #ifdef POLL_FOR_INPUT
6380 poll_suppress_count
= 1;
6386 DEFUN ("current-input-mode", Fcurrent_input_mode
, Scurrent_input_mode
, 0, 0, 0,
6387 "Return information about the way Emacs currently reads keyboard input.\n\
6388 The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\
6389 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\
6390 nil, Emacs is using CBREAK mode.\n\
6391 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\
6392 terminal; this does not apply if Emacs uses interrupt-driven input.\n\
6393 META is t if accepting 8-bit input with 8th bit as Meta flag.\n\
6394 META nil means ignoring the top bit, on the assumption it is parity.\n\
6395 META is neither t nor nil if accepting 8-bit input and using\n\
6396 all 8 bits as the character code.\n\
6397 QUIT is the character Emacs currently uses to quit.\n\
6398 The elements of this list correspond to the arguments of\n\
6404 val
[0] = interrupt_input
? Qt
: Qnil
;
6405 val
[1] = flow_control
? Qt
: Qnil
;
6406 val
[2] = meta_key
== 2 ? make_number (0) : meta_key
== 1 ? Qt
: Qnil
;
6407 XSETFASTINT (val
[3], quit_char
);
6409 return Flist (sizeof (val
) / sizeof (val
[0]), val
);
6414 * Set up a perdisplay object with reasonable initial values.
6417 init_perdisplay (perd
)
6420 perd
->prefix_factor
= Qnil
;
6421 perd
->prefix_value
= Qnil
;
6422 perd
->prefix_sign
= 1;
6423 perd
->prefix_partial
= 0;
6424 perd
->kbd_queue
= Qnil
;
6425 perd
->immediate_echo
= 0;
6426 perd
->echoptr
= perd
->echobuf
;
6427 perd
->echo_after_prompt
= -1;
6428 perd
->kbd_macro_buffer
= 0;
6429 perd
->kbd_macro_bufsize
= 0;
6430 perd
->defining_kbd_macro
= Qnil
;
6434 * Destroy the contents of a perdisplay object, but not the object itself.
6435 * We use this just before deleteing it, or if we're going to initialize
6439 wipe_perdisplay (perd
)
6442 if (perd
->kbd_macro_buffer
)
6443 xfree (perd
->kbd_macro_buffer
);
6448 /* This is correct before outermost invocation of the editor loop */
6449 command_loop_level
= -1;
6451 quit_char
= Ctl ('g');
6452 Vunread_command_events
= Qnil
;
6453 unread_command_char
= -1;
6455 recent_keys_index
= 0;
6456 kbd_fetch_ptr
= kbd_buffer
;
6457 kbd_store_ptr
= kbd_buffer
;
6458 kbd_buffer_frame_or_window
6459 = Fmake_vector (make_number (KBD_BUFFER_SIZE
), Qnil
);
6461 do_mouse_tracking
= Qnil
;
6466 /* This means that command_loop_1 won't try to select anything the first
6468 internal_last_event_frame
= Qnil
;
6469 Vlast_event_frame
= internal_last_event_frame
;
6472 #ifndef MULTI_PERDISPLAY
6474 wipe_perdisplay (&the_only_perdisplay
);
6475 init_perdisplay (&the_only_perdisplay
);
6479 Ffillarray (kbd_buffer_frame_or_window
, Qnil
);
6481 kbd_buffer_frame_or_window
6482 = Fmake_vector (make_number (KBD_BUFFER_SIZE
), Qnil
);
6483 if (!noninteractive
&& !read_socket_hook
&& NILP (Vwindow_system
))
6485 signal (SIGINT
, interrupt_signal
);
6486 #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
6487 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
6488 SIGQUIT and we can't tell which one it will give us. */
6489 signal (SIGQUIT
, interrupt_signal
);
6490 #endif /* HAVE_TERMIO */
6492 /* Note SIGIO has been undef'd if FIONREAD is missing. */
6494 if (!noninteractive
)
6495 signal (SIGIO
, input_available_signal
);
6498 /* Use interrupt input by default, if it works and noninterrupt input
6499 has deficiencies. */
6501 #ifdef INTERRUPT_INPUT
6502 interrupt_input
= 1;
6504 interrupt_input
= 0;
6507 /* Our VMS input only works by interrupts, as of now. */
6509 interrupt_input
= 1;
6515 if (keyboard_init_hook
)
6516 (*keyboard_init_hook
) ();
6518 #ifdef POLL_FOR_INPUT
6519 poll_suppress_count
= 1;
6524 /* This type's only use is in syms_of_keyboard, to initialize the
6525 event header symbols and put properties on them. */
6532 struct event_head head_table
[] = {
6533 &Qmouse_movement
, "mouse-movement", &Qmouse_movement
,
6534 &Qscroll_bar_movement
, "scroll-bar-movement", &Qmouse_movement
,
6535 &Qswitch_frame
, "switch-frame", &Qswitch_frame
,
6536 &Qdelete_frame
, "delete-frame", &Qdelete_frame
,
6537 &Qiconify_frame
, "iconify-frame", &Qiconify_frame
,
6538 &Qmake_frame_visible
, "make-frame-visible", &Qmake_frame_visible
,
6543 Qdisabled_command_hook
= intern ("disabled-command-hook");
6544 staticpro (&Qdisabled_command_hook
);
6546 Qself_insert_command
= intern ("self-insert-command");
6547 staticpro (&Qself_insert_command
);
6549 Qforward_char
= intern ("forward-char");
6550 staticpro (&Qforward_char
);
6552 Qbackward_char
= intern ("backward-char");
6553 staticpro (&Qbackward_char
);
6555 Qdisabled
= intern ("disabled");
6556 staticpro (&Qdisabled
);
6558 Qundefined
= intern ("undefined");
6559 staticpro (&Qundefined
);
6561 Quniversal_argument
= intern ("universal-argument");
6562 staticpro (&Quniversal_argument
);
6564 Qdigit_argument
= intern ("digit-argument");
6565 staticpro (&Qdigit_argument
);
6567 Qnegative_argument
= intern ("negative-argument");
6568 staticpro (&Qnegative_argument
);
6570 Qpre_command_hook
= intern ("pre-command-hook");
6571 staticpro (&Qpre_command_hook
);
6573 Qpost_command_hook
= intern ("post-command-hook");
6574 staticpro (&Qpost_command_hook
);
6576 Qdeferred_action_function
= intern ("deferred-action-function");
6577 staticpro (&Qdeferred_action_function
);
6579 Qcommand_hook_internal
= intern ("command-hook-internal");
6580 staticpro (&Qcommand_hook_internal
);
6582 Qfunction_key
= intern ("function-key");
6583 staticpro (&Qfunction_key
);
6584 Qmouse_click
= intern ("mouse-click");
6585 staticpro (&Qmouse_click
);
6587 Qmenu_enable
= intern ("menu-enable");
6588 staticpro (&Qmenu_enable
);
6590 Qmode_line
= intern ("mode-line");
6591 staticpro (&Qmode_line
);
6592 Qvertical_line
= intern ("vertical-line");
6593 staticpro (&Qvertical_line
);
6594 Qvertical_scroll_bar
= intern ("vertical-scroll-bar");
6595 staticpro (&Qvertical_scroll_bar
);
6596 Qmenu_bar
= intern ("menu-bar");
6597 staticpro (&Qmenu_bar
);
6599 Qabove_handle
= intern ("above-handle");
6600 staticpro (&Qabove_handle
);
6601 Qhandle
= intern ("handle");
6602 staticpro (&Qhandle
);
6603 Qbelow_handle
= intern ("below-handle");
6604 staticpro (&Qbelow_handle
);
6606 Qevent_kind
= intern ("event-kind");
6607 staticpro (&Qevent_kind
);
6608 Qevent_symbol_elements
= intern ("event-symbol-elements");
6609 staticpro (&Qevent_symbol_elements
);
6610 Qevent_symbol_element_mask
= intern ("event-symbol-element-mask");
6611 staticpro (&Qevent_symbol_element_mask
);
6612 Qmodifier_cache
= intern ("modifier-cache");
6613 staticpro (&Qmodifier_cache
);
6615 Qrecompute_lucid_menubar
= intern ("recompute-lucid-menubar");
6616 staticpro (&Qrecompute_lucid_menubar
);
6617 Qactivate_menubar_hook
= intern ("activate-menubar-hook");
6618 staticpro (&Qactivate_menubar_hook
);
6620 Qpolling_period
= intern ("polling-period");
6621 staticpro (&Qpolling_period
);
6624 struct event_head
*p
;
6626 for (p
= head_table
;
6627 p
< head_table
+ (sizeof (head_table
) / sizeof (head_table
[0]));
6630 *p
->var
= intern (p
->name
);
6632 Fput (*p
->var
, Qevent_kind
, *p
->kind
);
6633 Fput (*p
->var
, Qevent_symbol_elements
, Fcons (*p
->var
, Qnil
));
6637 button_down_location
= Fmake_vector (make_number (NUM_MOUSE_BUTTONS
), Qnil
);
6638 staticpro (&button_down_location
);
6642 int len
= sizeof (modifier_names
) / sizeof (modifier_names
[0]);
6644 modifier_symbols
= Fmake_vector (make_number (len
), Qnil
);
6645 for (i
= 0; i
< len
; i
++)
6646 if (modifier_names
[i
])
6647 XVECTOR (modifier_symbols
)->contents
[i
] = intern (modifier_names
[i
]);
6648 staticpro (&modifier_symbols
);
6651 recent_keys
= Fmake_vector (make_number (NUM_RECENT_KEYS
), Qnil
);
6652 staticpro (&recent_keys
);
6654 this_command_keys
= Fmake_vector (make_number (40), Qnil
);
6655 staticpro (&this_command_keys
);
6657 Qextended_command_history
= intern ("extended-command-history");
6658 Fset (Qextended_command_history
, Qnil
);
6659 staticpro (&Qextended_command_history
);
6661 kbd_buffer_frame_or_window
6662 = Fmake_vector (make_number (KBD_BUFFER_SIZE
), Qnil
);
6663 staticpro (&kbd_buffer_frame_or_window
);
6665 accent_key_syms
= Qnil
;
6666 staticpro (&accent_key_syms
);
6668 func_key_syms
= Qnil
;
6669 staticpro (&func_key_syms
);
6671 system_key_syms
= Qnil
;
6672 staticpro (&system_key_syms
);
6675 staticpro (&mouse_syms
);
6677 unread_switch_frame
= Qnil
;
6678 staticpro (&unread_switch_frame
);
6680 defsubr (&Sread_key_sequence
);
6681 defsubr (&Srecursive_edit
);
6683 defsubr (&Strack_mouse
);
6685 defsubr (&Sinput_pending_p
);
6686 defsubr (&Scommand_execute
);
6687 defsubr (&Srecent_keys
);
6688 defsubr (&Sthis_command_keys
);
6689 defsubr (&Ssuspend_emacs
);
6690 defsubr (&Sabort_recursive_edit
);
6691 defsubr (&Sexit_recursive_edit
);
6692 defsubr (&Srecursion_depth
);
6693 defsubr (&Stop_level
);
6694 defsubr (&Sdiscard_input
);
6695 defsubr (&Sopen_dribble_file
);
6696 defsubr (&Sset_input_mode
);
6697 defsubr (&Scurrent_input_mode
);
6698 defsubr (&Sexecute_extended_command
);
6700 DEFVAR_LISP ("last-command-char", &last_command_char
,
6701 "Last input event that was part of a command.");
6703 DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char
,
6704 "Last input event that was part of a command.");
6706 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event
,
6707 "Last input event in a command, except for mouse menu events.\n\
6708 Mouse menus give back keys that don't look like mouse events;\n\
6709 this variable holds the actual mouse event that led to the menu,\n\
6710 so that you can determine whether the command was run by mouse or not.");
6712 DEFVAR_LISP ("last-input-char", &last_input_char
,
6713 "Last input event.");
6715 DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char
,
6716 "Last input event.");
6718 DEFVAR_LISP ("unread-command-events", &Vunread_command_events
,
6719 "List of objects to be read as next command input events.");
6721 DEFVAR_INT ("unread-command-char", &unread_command_char
,
6722 "If not -1, an object to be read as next command input event.");
6724 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char
,
6725 "Meta-prefix character code. Meta-foo as command input\n\
6726 turns into this character followed by foo.");
6727 XSETINT (meta_prefix_char
, 033);
6729 DEFVAR_LISP ("last-command", &last_command
,
6730 "The last command executed. Normally a symbol with a function definition,\n\
6731 but can be whatever was found in the keymap, or whatever the variable\n\
6732 `this-command' was set to by that command.\n\
6734 The value `mode-exit' is special; it means that the previous command\n\
6735 read an event that told it to exit, and it did so and unread that event.\n\
6736 In other words, the present command is the event that made the previous\n\
6739 The value `kill-region' is special; it means that the previous command\n\
6740 was a kill command.");
6741 last_command
= Qnil
;
6743 DEFVAR_LISP ("this-command", &this_command
,
6744 "The command now being executed.\n\
6745 The command can set this variable; whatever is put here\n\
6746 will be in `last-command' during the following command.");
6747 this_command
= Qnil
;
6749 DEFVAR_INT ("auto-save-interval", &auto_save_interval
,
6750 "*Number of keyboard input characters between auto-saves.\n\
6751 Zero means disable autosaving due to number of characters typed.");
6752 auto_save_interval
= 300;
6754 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout
,
6755 "*Number of seconds idle time before auto-save.\n\
6756 Zero or nil means disable auto-saving due to idleness.\n\
6757 After auto-saving due to this many seconds of idle time,\n\
6758 Emacs also does a garbage collection if that seems to be warranted.");
6759 XSETFASTINT (Vauto_save_timeout
, 30);
6761 DEFVAR_INT ("echo-keystrokes", &echo_keystrokes
,
6762 "*Nonzero means echo unfinished commands after this many seconds of pause.");
6763 echo_keystrokes
= 1;
6765 DEFVAR_INT ("polling-period", &polling_period
,
6766 "*Interval between polling for input during Lisp execution.\n\
6767 The reason for polling is to make C-g work to stop a running program.\n\
6768 Polling is needed only when using X windows and SIGIO does not work.\n\
6769 Polling is automatically disabled in all other cases.");
6772 DEFVAR_LISP ("double-click-time", &Vdouble_click_time
,
6773 "*Maximum time between mouse clicks to make a double-click.\n\
6774 Measured in milliseconds. nil means disable double-click recognition;\n\
6775 t means double-clicks have no time limit and are detected\n\
6776 by position only.");
6777 Vdouble_click_time
= make_number (500);
6779 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus
,
6780 "*Non-nil means inhibit local map menu bar menus.");
6781 inhibit_local_menu_bar_menus
= 0;
6783 DEFVAR_INT ("num-input-keys", &num_input_keys
,
6784 "Number of complete keys read from the keyboard so far.");
6787 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame
,
6788 "The frame in which the most recently read event occurred.\n\
6789 If the last event came from a keyboard macro, this is set to `macro'.");
6790 Vlast_event_frame
= Qnil
;
6792 DEFVAR_LISP ("help-char", &Vhelp_char
,
6793 "Character to recognize as meaning Help.\n\
6794 When it is read, do `(eval help-form)', and display result if it's a string.\n\
6795 If the value of `help-form' is nil, this char can be read normally.");
6796 XSETINT (Vhelp_char
, Ctl ('H'));
6798 DEFVAR_LISP ("help-form", &Vhelp_form
,
6799 "Form to execute when character `help-char' is read.\n\
6800 If the form returns a string, that string is displayed.\n\
6801 If `help-form' is nil, the help char is not recognized.");
6804 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command
,
6805 "Command to run when `help-char' character follows a prefix key.\n\
6806 This command is used only when there is no actual binding\n\
6807 for that character after that prefix key.");
6808 Vprefix_help_command
= Qnil
;
6810 DEFVAR_LISP ("top-level", &Vtop_level
,
6811 "Form to evaluate when Emacs starts up.\n\
6812 Useful to set before you dump a modified Emacs.");
6815 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table
,
6816 "String used as translate table for keyboard input, or nil.\n\
6817 Each character is looked up in this string and the contents used instead.\n\
6818 If string is of length N, character codes N and up are untranslated.");
6819 Vkeyboard_translate_table
= Qnil
;
6821 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
6822 "Keymap of key translations that can override keymaps.\n\
6823 This keymap works like `function-key-map', but comes after that,\n\
6824 and applies even for keys that have ordinary bindings.");
6825 Vkey_translation_map
= Qnil
;
6827 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend
,
6828 "Non-nil means to always spawn a subshell instead of suspending,\n\
6829 even if the operating system has support for stopping a process.");
6832 DEFVAR_BOOL ("menu-prompting", &menu_prompting
,
6833 "Non-nil means prompt with menus when appropriate.\n\
6834 This is done when reading from a keymap that has a prompt string,\n\
6835 for elements that have prompt strings.\n\
6836 The menu is displayed on the screen\n\
6837 if X menus were enabled at configuration\n\
6838 time and the previous event was a mouse click prefix key.\n\
6839 Otherwise, menu prompting uses the echo area.");
6842 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char
,
6843 "Character to see next line of menu prompt.\n\
6844 Type this character while in a menu prompt to rotate around the lines of it.");
6845 XSETINT (menu_prompt_more_char
, ' ');
6847 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers
,
6848 "A mask of additional modifier keys to use with every keyboard character.\n\
6849 Emacs applies the modifiers of the character stored here to each keyboard\n\
6850 character it reads. For example, after evaluating the expression\n\
6851 (setq extra-keyboard-modifiers ?\\C-x)\n\
6852 all input characters will have the control modifier applied to them.\n\
6854 Note that the character ?\\C-@, equivalent to the integer zero, does\n\
6855 not count as a control character; rather, it counts as a character\n\
6856 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero\n\
6857 cancels any modification.");
6858 extra_keyboard_modifiers
= 0;
6860 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark
,
6861 "If an editing command sets this to t, deactivate the mark afterward.\n\
6862 The command loop sets this to nil before each command,\n\
6863 and tests the value when the command returns.\n\
6864 Buffer modification stores t in this variable.");
6865 Vdeactivate_mark
= Qnil
;
6867 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal
,
6868 "Temporary storage of pre-command-hook or post-command-hook.");
6869 Vcommand_hook_internal
= Qnil
;
6871 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook
,
6872 "Normal hook run before each command is executed.\n\
6873 While the hook is run, its value is temporarily set to nil\n\
6874 to avoid an unbreakable infinite loop if a hook function gets an error.\n\
6875 As a result, a hook function cannot straightforwardly alter the value of\n\
6876 `pre-command-hook'. See the Emacs Lisp manual for a way of\n\
6877 implementing hook functions that alter the set of hook functions.");
6878 Vpre_command_hook
= Qnil
;
6880 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook
,
6881 "Normal hook run after each command is executed.\n\
6882 While the hook is run, its value is temporarily set to nil\n\
6883 to avoid an unbreakable infinite loop if a hook function gets an error.\n\
6884 As a result, a hook function cannot straightforwardly alter the value of\n\
6885 `post-command-hook'. See the Emacs Lisp manual for a way of\n\
6886 implementing hook functions that alter the set of hook functions.");
6887 Vpost_command_hook
= Qnil
;
6889 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag
,
6890 "t means menu bar, specified Lucid style, needs to be recomputed.");
6891 Vlucid_menu_bar_dirty_flag
= Qnil
;
6893 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items
,
6894 "List of menu bar items to move to the end of the menu bar.\n\
6895 The elements of the list are event types that may have menu bar bindings.");
6896 Vmenu_bar_final_items
= Qnil
;
6898 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map
,
6899 "Keymap that overrides all other local keymaps.\n\
6900 If this variable is non-nil, it is used as a keymap instead of the\n\
6901 buffer's local map, and the minor mode keymaps and text property keymaps.");
6902 Voverriding_local_map
= Qnil
;
6904 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag
,
6905 "Non-nil means `overriding-local-map' applies to the menu bar.\n\
6906 Otherwise, the menu bar continues to reflect the buffer's local map\n\
6907 and the minor mode maps regardless of `overriding-local-map'.");
6908 Voverriding_local_map_menu_flag
= Qnil
;
6911 DEFVAR_LISP ("track-mouse", &do_mouse_tracking
,
6912 "*Non-nil means generate motion events for mouse motion.");
6915 DEFVAR_LISP ("system-key-alist", &Vsystem_key_alist
,
6916 "Alist of system-specific X windows key symbols.\n\
6917 Each element should have the form (N . SYMBOL) where N is the\n\
6918 numeric keysym code (sans the \"system-specific\" bit 1<<28)\n\
6919 and SYMBOL is its name.");
6920 Vsystem_key_alist
= Qnil
;
6922 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list
,
6923 "List of deferred actions to be performed at a later time.\n\
6924 The precise format isn't relevant here; we just check whether it is nil.");
6925 Vdeferred_action_list
= Qnil
;
6927 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function
,
6928 "Function to call to handle deferred actions, after each command.\n\
6929 This function is called with no arguments after each command\n\
6930 whenever `deferred-action-list' is non-nil.");
6931 Vdeferred_action_function
= Qnil
;
6936 initial_define_key (global_map
, Ctl ('Z'), "suspend-emacs");
6937 initial_define_key (control_x_map
, Ctl ('Z'), "suspend-emacs");
6938 initial_define_key (meta_map
, Ctl ('C'), "exit-recursive-edit");
6939 initial_define_key (global_map
, Ctl (']'), "abort-recursive-edit");
6940 initial_define_key (meta_map
, 'x', "execute-extended-command");