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. */
29 #include "termhooks.h"
36 #include "dispextern.h"
38 #include "intervals.h"
39 #include "blockinput.h"
48 #include <sys/ioctl.h>
50 #endif /* not MSDOS */
52 #include "syssignal.h"
55 /* This is to get the definitions of the XK_ symbols. */
60 /* Include systime.h after xterm.h to avoid double inclusion of time.h. */
65 /* Variables for blockinput.h: */
67 /* Non-zero if interrupt input is blocked right now. */
68 int interrupt_input_blocked
;
70 /* Nonzero means an input interrupt has arrived
71 during the current critical section. */
72 int interrupt_input_pending
;
75 /* File descriptor to use for input. */
79 /* Make all keyboard buffers much bigger when using X windows. */
80 #define KBD_BUFFER_SIZE 4096
81 #else /* No X-windows, character input */
82 #define KBD_BUFFER_SIZE 256
83 #endif /* No X-windows */
85 /* Following definition copied from eval.c */
89 struct backtrace
*next
;
90 Lisp_Object
*function
;
91 Lisp_Object
*args
; /* Points to vector of args. */
92 int nargs
; /* length of vector. If nargs is UNEVALLED,
93 args points to slot holding list of
98 #ifdef MULTI_PERDISPLAY
99 PERDISPLAY
*current_perdisplay
;
100 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
;
285 /* read_key_sequence stores here the command definition of the
286 key sequence that it reads. */
287 Lisp_Object read_key_sequence_cmd
;
289 /* Form to evaluate (if non-nil) when Emacs is started. */
290 Lisp_Object Vtop_level
;
292 /* User-supplied string to translate input characters through. */
293 Lisp_Object Vkeyboard_translate_table
;
295 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
296 extern Lisp_Object Vfunction_key_map
;
298 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
299 Lisp_Object Vkey_translation_map
;
301 /* Non-nil means deactivate the mark at end of this command. */
302 Lisp_Object Vdeactivate_mark
;
304 /* Menu bar specified in Lucid Emacs fashion. */
306 Lisp_Object Vlucid_menu_bar_dirty_flag
;
307 Lisp_Object Qrecompute_lucid_menubar
, Qactivate_menubar_hook
;
309 /* Hooks to run before and after each command. */
310 Lisp_Object Qpre_command_hook
, Qpost_command_hook
;
311 Lisp_Object Vpre_command_hook
, Vpost_command_hook
;
312 Lisp_Object Qcommand_hook_internal
, Vcommand_hook_internal
;
314 /* List of deferred actions to be performed at a later time.
315 The precise format isn't relevant here; we just check whether it is nil. */
316 Lisp_Object Vdeferred_action_list
;
318 /* Function to call to handle deferred actions, when there are any. */
319 Lisp_Object Vdeferred_action_function
;
320 Lisp_Object Qdeferred_action_function
;
322 /* File in which we write all commands we read. */
325 /* Nonzero if input is available. */
328 /* 1 if should obey 0200 bit in input chars as "Meta", 2 if should
329 keep 0200 bit in input chars. 0 to ignore the 0200 bit. */
333 extern char *pending_malloc_warning
;
336 /* If this flag is a frame, we check mouse_moved to see when the
337 mouse moves, and motion events will appear in the input stream.
338 Otherwise, mouse motion is ignored. */
339 static Lisp_Object do_mouse_tracking
;
341 /* The window system handling code should set this if the mouse has
342 moved since the last call to the mouse_position_hook. Calling that
343 hook should clear this. Code assumes that if this is set, it can
344 call mouse_position_hook to get the promised position, so don't set
345 it unless you're prepared to substantiate the claim! */
348 #define MOUSE_ACTIVITY_AVAILABLE (FRAMEP (do_mouse_tracking) && mouse_moved)
349 #else /* Not HAVE_MOUSE. */
350 #define MOUSE_ACTIVITY_AVAILABLE 0
351 #endif /* HAVE_MOUSE. */
353 /* Symbols to head events. */
354 Lisp_Object Qmouse_movement
;
355 Lisp_Object Qscroll_bar_movement
;
356 Lisp_Object Qswitch_frame
;
357 Lisp_Object Qdelete_frame
;
358 Lisp_Object Qiconify_frame
;
359 Lisp_Object Qmake_frame_visible
;
361 /* Symbols to denote kinds of events. */
362 Lisp_Object Qfunction_key
;
363 Lisp_Object Qmouse_click
;
364 /* Lisp_Object Qmouse_movement; - also an event header */
366 /* Properties of event headers. */
367 Lisp_Object Qevent_kind
;
368 Lisp_Object Qevent_symbol_elements
;
370 Lisp_Object Qmenu_enable
;
372 /* An event header symbol HEAD may have a property named
373 Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
374 BASE is the base, unmodified version of HEAD, and MODIFIERS is the
375 mask of modifiers applied to it. If present, this is used to help
376 speed up parse_modifiers. */
377 Lisp_Object Qevent_symbol_element_mask
;
379 /* An unmodified event header BASE may have a property named
380 Qmodifier_cache, which is an alist mapping modifier masks onto
381 modified versions of BASE. If present, this helps speed up
383 Lisp_Object Qmodifier_cache
;
385 /* Symbols to use for parts of windows. */
386 Lisp_Object Qmode_line
;
387 Lisp_Object Qvertical_line
;
388 Lisp_Object Qvertical_scroll_bar
;
389 Lisp_Object Qmenu_bar
;
391 extern Lisp_Object Qmenu_enable
;
393 Lisp_Object
recursive_edit_unwind (), command_loop ();
394 Lisp_Object
Fthis_command_keys ();
395 Lisp_Object Qextended_command_history
;
397 Lisp_Object Qpolling_period
;
399 /* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
401 EMACS_TIME
*input_available_clear_time
;
403 /* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
404 Default is 1 if INTERRUPT_INPUT is defined. */
407 /* Nonzero while interrupts are temporarily deferred during redisplay. */
408 int interrupts_deferred
;
410 /* nonzero means use ^S/^Q for flow control. */
413 /* Allow m- file to inhibit use of FIONREAD. */
414 #ifdef BROKEN_FIONREAD
418 /* We are unable to use interrupts if FIONREAD is not available,
419 so flush SIGIO so we won't try. */
426 /* If we support X Windows, turn on the code to poll periodically
427 to detect C-g. It isn't actually used when doing interrupt input. */
428 #ifdef HAVE_X_WINDOWS
429 #define POLL_FOR_INPUT
432 /* Global variable declarations. */
434 /* Function for init_keyboard to call with no args (if nonzero). */
435 void (*keyboard_init_hook
) ();
437 static int read_avail_input ();
438 static void get_input_pending ();
439 static int readable_events ();
440 static Lisp_Object
read_char_x_menu_prompt ();
441 static Lisp_Object
read_char_minibuf_menu_prompt ();
442 static Lisp_Object
make_lispy_event ();
443 static Lisp_Object
make_lispy_movement ();
444 static Lisp_Object
modify_event_symbol ();
445 static Lisp_Object
make_lispy_switch_frame ();
447 /* > 0 if we are to echo keystrokes. */
448 static int echo_keystrokes
;
450 /* Nonzero means don't try to suspend even if the operating system seems
452 static int cannot_suspend
;
454 #define min(a,b) ((a)<(b)?(a):(b))
455 #define max(a,b) ((a)>(b)?(a):(b))
457 /* Install the string STR as the beginning of the string of echoing,
458 so that it serves as a prompt for the next character.
459 Also start echoing. */
464 int len
= strlen (str
);
466 if (len
> ECHOBUFSIZE
- 4)
467 len
= ECHOBUFSIZE
- 4;
468 bcopy (str
, current_perdisplay
->echobuf
, len
);
469 current_perdisplay
->echoptr
= current_perdisplay
->echobuf
+ len
;
470 *current_perdisplay
->echoptr
= '\0';
472 current_perdisplay
->echo_after_prompt
= len
;
477 /* Add C to the echo string, if echoing is going on.
478 C can be a character, which is printed prettily ("M-C-x" and all that
479 jazz), or a symbol, whose name is printed. */
484 extern char *push_key_description ();
486 if (current_perdisplay
->immediate_echo
)
488 char *ptr
= current_perdisplay
->echoptr
;
490 if (ptr
!= current_perdisplay
->echobuf
)
493 /* If someone has passed us a composite event, use its head symbol. */
498 if (ptr
- current_perdisplay
->echobuf
> ECHOBUFSIZE
- 6)
501 ptr
= push_key_description (XINT (c
), ptr
);
503 else if (SYMBOLP (c
))
505 struct Lisp_String
*name
= XSYMBOL (c
)->name
;
506 if (((ptr
- current_perdisplay
->echobuf
) + name
->size
+ 4)
509 bcopy (name
->data
, ptr
, name
->size
);
513 if (current_perdisplay
->echoptr
== current_perdisplay
->echobuf
514 && EQ (c
, Vhelp_char
))
516 strcpy (ptr
, " (Type ? for further options)");
521 current_perdisplay
->echoptr
= ptr
;
527 /* Temporarily add a dash to the end of the echo string if it's not
528 empty, so that it serves as a mini-prompt for the very next character. */
532 if (!current_perdisplay
->immediate_echo
533 && current_perdisplay
->echoptr
== current_perdisplay
->echobuf
)
535 /* Do nothing if we just printed a prompt. */
536 if (current_perdisplay
->echo_after_prompt
537 == current_perdisplay
->echoptr
- current_perdisplay
->echobuf
)
539 /* Do nothing if not echoing at all. */
540 if (current_perdisplay
->echoptr
== 0)
543 /* Put a dash at the end of the buffer temporarily,
544 but make it go away when the next character is added. */
545 current_perdisplay
->echoptr
[0] = '-';
546 current_perdisplay
->echoptr
[1] = 0;
551 /* Display the current echo string, and begin echoing if not already
556 if (!current_perdisplay
->immediate_echo
)
559 current_perdisplay
->immediate_echo
= 1;
561 for (i
= 0; i
< this_command_key_count
; i
++)
564 c
= XVECTOR (this_command_keys
)->contents
[i
];
565 if (! (EVENT_HAS_PARAMETERS (c
)
566 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c
)), Qmouse_movement
)))
573 message1_nolog (current_perdisplay
->echobuf
);
576 if (waiting_for_input
&& !NILP (Vquit_flag
))
577 quit_throw_to_read_char ();
580 /* Turn off echoing, for the start of a new command. */
584 current_perdisplay
->immediate_echo
= 0;
585 current_perdisplay
->echoptr
= current_perdisplay
->echobuf
;
586 current_perdisplay
->echo_after_prompt
= -1;
589 /* Return the length of the current echo string. */
594 return current_perdisplay
->echoptr
- current_perdisplay
->echobuf
;
597 /* Truncate the current echo message to its first LEN chars.
598 This and echo_char get used by read_key_sequence when the user
599 switches frames while entering a key sequence. */
605 current_perdisplay
->echobuf
[len
] = '\0';
606 current_perdisplay
->echoptr
= current_perdisplay
->echobuf
+ len
;
607 truncate_echo_area (len
);
611 /* Functions for manipulating this_command_keys. */
613 add_command_key (key
)
616 int size
= XVECTOR (this_command_keys
)->size
;
618 if (this_command_key_count
>= size
)
620 Lisp_Object new_keys
;
622 new_keys
= Fmake_vector (make_number (size
* 2), Qnil
);
623 bcopy (XVECTOR (this_command_keys
)->contents
,
624 XVECTOR (new_keys
)->contents
,
625 size
* sizeof (Lisp_Object
));
627 this_command_keys
= new_keys
;
630 XVECTOR (this_command_keys
)->contents
[this_command_key_count
++] = key
;
636 int count
= specpdl_ptr
- specpdl
;
639 if (command_loop_level
> 0)
641 specbind (Qstandard_output
, Qt
);
642 specbind (Qstandard_input
, Qt
);
645 val
= command_loop ();
647 Fsignal (Qquit
, Qnil
);
649 return unbind_to (count
, Qnil
);
652 /* When an auto-save happens, record the "time", and don't do again soon. */
656 last_auto_save
= num_nonmacro_input_chars
;
659 /* Make an auto save happen as soon as possible at command level. */
661 force_auto_save_soon ()
663 last_auto_save
= - auto_save_interval
- 1;
665 record_asynch_buffer_change ();
668 DEFUN ("recursive-edit", Frecursive_edit
, Srecursive_edit
, 0, 0, "",
669 "Invoke the editor command loop recursively.\n\
670 To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
671 that tells this function to return.\n\
672 Alternately, `(throw 'exit t)' makes this function signal an error.\n\
673 This function is called by the editor initialization to begin editing.")
676 int count
= specpdl_ptr
- specpdl
;
679 command_loop_level
++;
680 update_mode_lines
= 1;
682 record_unwind_protect (recursive_edit_unwind
,
684 && current_buffer
!= XBUFFER (XWINDOW (selected_window
)->buffer
))
688 return unbind_to (count
, Qnil
);
692 recursive_edit_unwind (buffer
)
696 Fset_buffer (buffer
);
698 command_loop_level
--;
699 update_mode_lines
= 1;
707 Vstandard_output
= Qt
;
708 Vstandard_input
= Qt
;
709 Vexecuting_macro
= Qnil
;
710 if (!current_perdisplay
)
712 current_perdisplay
->Vprefix_arg
= Qnil
;
713 cmd_error_internal (data
, 0);
717 Vinhibit_quit
= Qnil
;
718 #ifdef MULTI_PERDISPLAY
719 current_perdisplay
= 0;
722 return make_number (0);
725 cmd_error_internal (data
, context
)
729 Lisp_Object errmsg
, tail
, errname
, file_error
;
736 echo_area_glyphs
= 0;
738 /* If the window system or terminal frame hasn't been initialized
739 yet, or we're not interactive, it's best to dump this message out
740 to stderr and exit. */
741 if (! FRAME_MESSAGE_BUF (selected_frame
)
743 stream
= Qexternal_debugging_output
;
752 write_string_1 (context
, -1, stream
);
754 errname
= Fcar (data
);
756 if (EQ (errname
, Qerror
))
759 if (!CONSP (data
)) data
= Qnil
;
760 errmsg
= Fcar (data
);
765 errmsg
= Fget (errname
, Qerror_message
);
766 file_error
= Fmemq (Qfile_error
,
767 Fget (errname
, Qerror_conditions
));
770 /* Print an error message including the data items.
771 This is done by printing it into a scratch buffer
772 and then making a copy of the text in the buffer. */
774 if (!CONSP (data
)) data
= Qnil
;
778 /* For file-error, make error message by concatenating
779 all the data items. They are all strings. */
780 if (!NILP (file_error
) && !NILP (tail
))
781 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
783 if (STRINGP (errmsg
))
784 Fprinc (errmsg
, stream
);
786 write_string_1 ("peculiar error", -1, stream
);
788 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
790 write_string_1 (i
? ", " : ": ", 2, stream
);
791 if (!NILP (file_error
))
792 Fprinc (Fcar (tail
), stream
);
794 Fprin1 (Fcar (tail
), stream
);
798 /* If the window system or terminal frame hasn't been initialized
799 yet, or we're in -batch mode, this error should cause Emacs to exit. */
800 if (! FRAME_MESSAGE_BUF (selected_frame
)
804 Fkill_emacs (make_number (-1));
808 Lisp_Object
command_loop_1 ();
809 Lisp_Object
command_loop_2 ();
810 Lisp_Object
top_level_1 ();
812 /* Entry to editor-command-loop.
813 This level has the catches for exiting/returning to editor command loop.
814 It returns nil to exit recursive edit, t to abort it. */
819 if (command_loop_level
> 0 || minibuf_level
> 0)
821 return internal_catch (Qexit
, command_loop_2
, Qnil
);
826 internal_catch (Qtop_level
, top_level_1
, Qnil
);
827 internal_catch (Qtop_level
, command_loop_2
, Qnil
);
829 /* End of file in -batch run causes exit here. */
835 /* Here we catch errors in execution of commands within the
836 editing loop, and reenter the editing loop.
837 When there is an error, cmd_error runs and returns a non-nil
838 value to us. A value of nil means that cmd_loop_1 itself
839 returned due to end of file (or end of kbd macro). */
844 register Lisp_Object val
;
847 val
= internal_condition_case (command_loop_1
, Qerror
, cmd_error
);
856 return Feval (Vtop_level
);
862 /* On entry to the outer level, run the startup file */
863 if (!NILP (Vtop_level
))
864 internal_condition_case (top_level_2
, Qerror
, cmd_error
);
865 else if (!NILP (Vpurify_flag
))
866 message ("Bare impure Emacs (standard Lisp code not loaded)");
868 message ("Bare Emacs (standard Lisp code not loaded)");
872 DEFUN ("top-level", Ftop_level
, Stop_level
, 0, 0, "",
873 "Exit all recursive editing levels.")
876 Fthrow (Qtop_level
, Qnil
);
879 DEFUN ("exit-recursive-edit", Fexit_recursive_edit
, Sexit_recursive_edit
, 0, 0, "",
880 "Exit from the innermost recursive edit or minibuffer.")
883 if (command_loop_level
> 0 || minibuf_level
> 0)
884 Fthrow (Qexit
, Qnil
);
886 error ("No recursive edit is in progress");
889 DEFUN ("abort-recursive-edit", Fabort_recursive_edit
, Sabort_recursive_edit
, 0, 0, "",
890 "Abort the command that requested this recursive edit or minibuffer input.")
893 if (command_loop_level
> 0 || minibuf_level
> 0)
896 error ("No recursive edit is in progress");
899 /* This is the actual command reading loop,
900 sans error-handling encapsulation. */
902 Lisp_Object
Fcommand_execute ();
903 static int read_key_sequence ();
904 static void safe_run_hooks ();
909 Lisp_Object cmd
, tem
;
912 Lisp_Object keybuf
[30];
917 struct buffer
*prev_buffer
;
918 PERDISPLAY
*global_perdisplay
= current_perdisplay
;
920 Vdeactivate_mark
= Qnil
;
921 waiting_for_input
= 0;
926 this_command_key_count
= 0;
928 /* Make sure this hook runs after commands that get errors and
929 throw to top level. */
930 /* Note that the value cell will never directly contain nil
931 if the symbol is a local variable. */
932 if (!NILP (XSYMBOL (Qpost_command_hook
)->value
) && !NILP (Vrun_hooks
))
933 safe_run_hooks (Qpost_command_hook
);
935 if (!NILP (Vdeferred_action_list
))
936 call0 (Vdeferred_action_function
);
938 /* Do this after running Vpost_command_hook, for consistency. */
939 last_command
= this_command
;
943 /* Make sure the current window's buffer is selected. */
944 if (XBUFFER (XWINDOW (selected_window
)->buffer
) != current_buffer
)
945 set_buffer_internal (XBUFFER (XWINDOW (selected_window
)->buffer
));
947 /* Display any malloc warning that just came out. Use while because
948 displaying one warning can cause another. */
950 while (pending_malloc_warning
)
951 display_malloc_warning ();
955 Vdeactivate_mark
= Qnil
;
957 /* If minibuffer on and echo area in use,
958 wait 2 sec and redraw minibuffer. */
960 if (minibuf_level
&& echo_area_glyphs
)
962 /* Bind inhibit-quit to t so that C-g gets read in
963 rather than quitting back to the minibuffer. */
964 int count
= specpdl_ptr
- specpdl
;
965 specbind (Qinhibit_quit
, Qt
);
966 Fsit_for (make_number (2), Qnil
, Qnil
);
967 unbind_to (count
, Qnil
);
969 echo_area_glyphs
= 0;
971 if (!NILP (Vquit_flag
))
974 Vunread_command_events
= Fcons (make_number (quit_char
), Qnil
);
979 alloca (0); /* Cause a garbage collection now */
980 /* Since we can free the most stuff here. */
981 #endif /* C_ALLOCA */
985 /* Select the frame that the last event came from. Usually,
986 switch-frame events will take care of this, but if some lisp
987 code swallows a switch-frame event, we'll fix things up here.
988 Is this a good idea? */
989 if (FRAMEP (internal_last_event_frame
)
990 && XFRAME (internal_last_event_frame
) != selected_frame
)
991 Fselect_frame (internal_last_event_frame
, Qnil
);
994 /* If it has changed current-menubar from previous value,
995 really recompute the menubar from the value. */
996 if (! NILP (Vlucid_menu_bar_dirty_flag
)
997 && !NILP (Ffboundp (Qrecompute_lucid_menubar
)))
998 call0 (Qrecompute_lucid_menubar
);
1000 /* Read next key sequence; i gets its length. */
1001 i
= read_key_sequence (keybuf
, sizeof keybuf
/ sizeof keybuf
[0], Qnil
, 0);
1005 /* Now we have read a key sequence of length I,
1006 or else I is 0 and we found end of file. */
1008 if (i
== 0) /* End of file -- happens only in */
1009 return Qnil
; /* a kbd macro, at the end. */
1010 /* -1 means read_key_sequence got a menu that was rejected.
1011 Just loop around and read another command. */
1015 this_command_key_count
= 0;
1019 last_command_char
= keybuf
[i
- 1];
1021 /* If the previous command tried to force a specific window-start,
1022 forget about that, in case this command moves point far away
1023 from that position. */
1024 XWINDOW (selected_window
)->force_start
= Qnil
;
1026 cmd
= read_key_sequence_cmd
;
1027 if (!NILP (Vexecuting_macro
))
1029 if (!NILP (Vquit_flag
))
1031 Vexecuting_macro
= Qt
;
1032 QUIT
; /* Make some noise. */
1033 /* Will return since macro now empty. */
1037 /* Do redisplay processing after this command except in special
1038 cases identified below that set no_redisplay to 1.
1039 (actually, there's currently no way to prevent the redisplay,
1040 and no_redisplay is ignored.
1041 Perhaps someday we will really implement it. */
1044 prev_buffer
= current_buffer
;
1045 prev_modiff
= MODIFF
;
1046 last_point_position
= PT
;
1047 XSETBUFFER (last_point_position_buffer
, prev_buffer
);
1049 /* Execute the command. */
1052 /* Note that the value cell will never directly contain nil
1053 if the symbol is a local variable. */
1054 if (!NILP (XSYMBOL (Qpre_command_hook
)->value
) && !NILP (Vrun_hooks
))
1055 safe_run_hooks (Qpre_command_hook
);
1057 if (NILP (this_command
))
1059 /* nil means key is undefined. */
1061 defining_kbd_macro
= 0;
1062 update_mode_lines
= 1;
1063 current_perdisplay
->Vprefix_arg
= Qnil
;
1068 if (NILP (current_perdisplay
->Vprefix_arg
) && ! no_direct
)
1070 /* Recognize some common commands in common situations and
1071 do them directly. */
1072 if (EQ (this_command
, Qforward_char
) && PT
< ZV
)
1074 struct Lisp_Vector
*dp
1075 = window_display_table (XWINDOW (selected_window
));
1076 lose
= FETCH_CHAR (PT
);
1079 ? (VECTORP (DISP_CHAR_VECTOR (dp
, lose
))
1080 ? XVECTOR (DISP_CHAR_VECTOR (dp
, lose
))->size
== 1
1081 : (NILP (DISP_CHAR_VECTOR (dp
, lose
))
1082 && (lose
>= 0x20 && lose
< 0x7f)))
1083 : (lose
>= 0x20 && lose
< 0x7f))
1084 && (XFASTINT (XWINDOW (selected_window
)->last_modified
)
1086 && (XFASTINT (XWINDOW (selected_window
)->last_point
)
1088 && !windows_or_buffers_changed
1089 && EQ (current_buffer
->selective_display
, Qnil
)
1090 && !detect_input_pending ()
1091 && NILP (Vexecuting_macro
))
1092 no_redisplay
= direct_output_forward_char (1);
1095 else if (EQ (this_command
, Qbackward_char
) && PT
> BEGV
)
1097 struct Lisp_Vector
*dp
1098 = window_display_table (XWINDOW (selected_window
));
1100 lose
= FETCH_CHAR (PT
);
1102 ? (VECTORP (DISP_CHAR_VECTOR (dp
, lose
))
1103 ? XVECTOR (DISP_CHAR_VECTOR (dp
, lose
))->size
== 1
1104 : (NILP (DISP_CHAR_VECTOR (dp
, lose
))
1105 && (lose
>= 0x20 && lose
< 0x7f)))
1106 : (lose
>= 0x20 && lose
< 0x7f))
1107 && (XFASTINT (XWINDOW (selected_window
)->last_modified
)
1109 && (XFASTINT (XWINDOW (selected_window
)->last_point
)
1111 && !windows_or_buffers_changed
1112 && EQ (current_buffer
->selective_display
, Qnil
)
1113 && !detect_input_pending ()
1114 && NILP (Vexecuting_macro
))
1115 no_redisplay
= direct_output_forward_char (-1);
1118 else if (EQ (this_command
, Qself_insert_command
)
1119 /* Try this optimization only on ascii keystrokes. */
1120 && INTEGERP (last_command_char
))
1122 unsigned char c
= XINT (last_command_char
);
1125 if (NILP (Vexecuting_macro
)
1126 && !EQ (minibuf_window
, selected_window
))
1128 if (!nonundocount
|| nonundocount
>= 20)
1135 lose
= ((XFASTINT (XWINDOW (selected_window
)->last_modified
)
1137 || (XFASTINT (XWINDOW (selected_window
)->last_point
)
1139 || MODIFF
<= SAVE_MODIFF
1140 || windows_or_buffers_changed
1141 || !EQ (current_buffer
->selective_display
, Qnil
)
1142 || detect_input_pending ()
1143 || !NILP (Vexecuting_macro
));
1144 value
= internal_self_insert (c
, 0);
1151 && (PT
== ZV
|| FETCH_CHAR (PT
) == '\n'))
1153 struct Lisp_Vector
*dp
1154 = window_display_table (XWINDOW (selected_window
));
1161 obj
= DISP_CHAR_VECTOR (dp
, lose
);
1164 /* Do it only for char codes
1165 that by default display as themselves. */
1166 if (lose
>= 0x20 && lose
<= 0x7e)
1167 no_redisplay
= direct_output_for_insert (lose
);
1169 else if (VECTORP (obj
)
1170 && XVECTOR (obj
)->size
== 1
1171 && (obj
= XVECTOR (obj
)->contents
[0],
1173 /* Insist face not specified in glyph. */
1174 && (XINT (obj
) & ((-1) << 8)) == 0)
1176 = direct_output_for_insert (XINT (obj
));
1180 if (lose
>= 0x20 && lose
<= 0x7e)
1181 no_redisplay
= direct_output_for_insert (lose
);
1188 /* Here for a command that isn't executed directly */
1191 if (NILP (current_perdisplay
->Vprefix_arg
))
1193 Fcommand_execute (this_command
, Qnil
);
1198 /* Note that the value cell will never directly contain nil
1199 if the symbol is a local variable. */
1200 if (!NILP (XSYMBOL (Qpost_command_hook
)->value
) && !NILP (Vrun_hooks
))
1201 safe_run_hooks (Qpost_command_hook
);
1203 if (!NILP (Vdeferred_action_list
))
1204 safe_run_hooks (Qdeferred_action_function
);
1206 /* If there is a prefix argument,
1207 1) We don't want last_command to be ``universal-argument''
1208 (that would be dumb), so don't set last_command,
1209 2) we want to leave echoing on so that the prefix will be
1210 echoed as part of this key sequence, so don't call
1212 3) we want to leave this_command_key_count non-zero, so that
1213 read_char will realize that it is re-reading a character, and
1214 not echo it a second time. */
1215 if (NILP (current_perdisplay
->Vprefix_arg
))
1217 last_command
= this_command
;
1219 this_command_key_count
= 0;
1222 if (!NILP (current_buffer
->mark_active
) && !NILP (Vrun_hooks
))
1224 if (!NILP (Vdeactivate_mark
) && !NILP (Vtransient_mark_mode
))
1226 current_buffer
->mark_active
= Qnil
;
1227 call1 (Vrun_hooks
, intern ("deactivate-mark-hook"));
1229 else if (current_buffer
!= prev_buffer
|| MODIFF
!= prev_modiff
)
1230 call1 (Vrun_hooks
, intern ("activate-mark-hook"));
1234 /* Install chars successfully executed in kbd macro. */
1236 if (defining_kbd_macro
&& NILP (current_perdisplay
->Vprefix_arg
))
1237 finalize_kbd_macro_chars ();
1239 #ifdef MULTI_PERDISPLAY
1240 current_perdisplay
= global_perdisplay
;
1245 /* If we get an error while running the hook, cause the hook variable
1246 to be nil. Also inhibit quits, so that C-g won't cause the hook
1247 to mysteriously evaporate. */
1249 safe_run_hooks (hook
)
1253 int count
= specpdl_ptr
- specpdl
;
1254 specbind (Qinhibit_quit
, Qt
);
1256 /* We read and set the variable with functions,
1257 in case it's buffer-local. */
1258 value
= Vcommand_hook_internal
= Fsymbol_value (hook
);
1260 call1 (Vrun_hooks
, Qcommand_hook_internal
);
1263 unbind_to (count
, Qnil
);
1266 /* Number of seconds between polling for input. */
1269 /* Nonzero means polling for input is temporarily suppressed. */
1270 int poll_suppress_count
;
1272 /* Nonzero if polling_for_input is actually being used. */
1273 int polling_for_input
;
1275 #ifdef POLL_FOR_INPUT
1277 /* Handle an alarm once each second and read pending input
1278 so as to handle a C-g if it comces in. */
1281 input_poll_signal ()
1283 if (interrupt_input_blocked
== 0
1284 && !waiting_for_input
)
1285 read_avail_input (0);
1286 signal (SIGALRM
, input_poll_signal
);
1287 alarm (polling_period
);
1292 /* Begin signals to poll for input, if they are appropriate.
1293 This function is called unconditionally from various places. */
1297 #ifdef POLL_FOR_INPUT
1298 if (read_socket_hook
&& !interrupt_input
)
1300 poll_suppress_count
--;
1301 if (poll_suppress_count
== 0)
1303 signal (SIGALRM
, input_poll_signal
);
1304 polling_for_input
= 1;
1305 alarm (polling_period
);
1311 /* Nonzero if we are using polling to handle input asynchronously. */
1314 input_polling_used ()
1316 #ifdef POLL_FOR_INPUT
1317 return read_socket_hook
&& !interrupt_input
;
1323 /* Turn off polling. */
1327 #ifdef POLL_FOR_INPUT
1328 if (read_socket_hook
&& !interrupt_input
)
1330 if (poll_suppress_count
== 0)
1332 polling_for_input
= 0;
1335 poll_suppress_count
++;
1340 /* Set the value of poll_suppress_count to COUNT
1341 and start or stop polling accordingly. */
1344 set_poll_suppress_count (count
)
1347 #ifdef POLL_FOR_INPUT
1348 if (count
== 0 && poll_suppress_count
!= 0)
1350 poll_suppress_count
= 1;
1353 else if (count
!= 0 && poll_suppress_count
== 0)
1357 poll_suppress_count
= count
;
1361 /* Bind polling_period to a value at least N.
1362 But don't decrease it. */
1364 bind_polling_period (n
)
1367 #ifdef POLL_FOR_INPUT
1368 int new = polling_period
;
1374 specbind (Qpolling_period
, make_number (new));
1375 /* Start a new alarm with the new period. */
1380 /* Applying the control modifier to CHARACTER. */
1385 /* Save the upper bits here. */
1386 int upper
= c
& ~0177;
1390 /* Everything in the columns containing the upper-case letters
1391 denotes a control character. */
1392 if (c
>= 0100 && c
< 0140)
1396 /* Set the shift modifier for a control char
1397 made from a shifted letter. But only for letters! */
1398 if (oc
>= 'A' && oc
<= 'Z')
1399 c
|= shift_modifier
;
1402 /* The lower-case letters denote control characters too. */
1403 else if (c
>= 'a' && c
<= 'z')
1406 /* Include the bits for control and shift
1407 only if the basic ASCII code can't indicate them. */
1411 /* Replace the high bits. */
1412 c
|= (upper
& ~ctrl_modifier
);
1419 /* Input of single characters from keyboard */
1421 Lisp_Object
print_help ();
1422 static Lisp_Object
kbd_buffer_get_event ();
1423 static void record_char ();
1425 /* read a character from the keyboard; call the redisplay if needed */
1426 /* commandflag 0 means do not do auto-saving, but do do redisplay.
1427 -1 means do not do redisplay, but do do autosaving.
1430 /* The arguments MAPS and NMAPS are for menu prompting.
1431 MAPS is an array of keymaps; NMAPS is the length of MAPS.
1433 PREV_EVENT is the previous input event, or nil if we are reading
1434 the first event of a key sequence.
1436 If USED_MOUSE_MENU is non-zero, then we set *USED_MOUSE_MENU to 1
1437 if we used a mouse menu to read the input, or zero otherwise. If
1438 USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone.
1440 Value is t if we showed a menu and the user rejected it. */
1443 read_char (commandflag
, nmaps
, maps
, prev_event
, used_mouse_menu
)
1447 Lisp_Object prev_event
;
1448 int *used_mouse_menu
;
1450 register Lisp_Object c
;
1453 int key_already_recorded
= 0;
1454 Lisp_Object also_record
;
1457 if (CONSP (Vunread_command_events
))
1459 c
= XCONS (Vunread_command_events
)->car
;
1460 Vunread_command_events
= XCONS (Vunread_command_events
)->cdr
;
1462 if (this_command_key_count
== 0)
1468 if (unread_command_char
!= -1)
1470 XSETINT (c
, unread_command_char
);
1471 unread_command_char
= -1;
1473 if (this_command_key_count
== 0)
1479 if (!NILP (Vexecuting_macro
))
1482 /* We set this to Qmacro; since that's not a frame, nobody will
1483 try to switch frames on us, and the selected window will
1486 Since this event came from a macro, it would be misleading to
1487 leave internal_last_event_frame set to wherever the last
1488 real event came from. Normally, a switch-frame event selects
1489 internal_last_event_frame after each command is read, but
1490 events read from a macro should never cause a new frame to be
1492 Vlast_event_frame
= internal_last_event_frame
= Qmacro
;
1495 /* Exit the macro if we are at the end.
1496 Also, some things replace the macro with t
1497 to force an early exit. */
1498 if (EQ (Vexecuting_macro
, Qt
)
1499 || executing_macro_index
>= XFASTINT (Flength (Vexecuting_macro
)))
1505 c
= Faref (Vexecuting_macro
, make_number (executing_macro_index
));
1506 if (STRINGP (Vexecuting_macro
)
1507 && (XINT (c
) & 0x80))
1508 XSETFASTINT (c
, CHAR_META
| (XINT (c
) & ~0x80));
1510 executing_macro_index
++;
1515 if (!NILP (unread_switch_frame
))
1517 c
= unread_switch_frame
;
1518 unread_switch_frame
= Qnil
;
1520 /* This event should make it into this_command_keys, and get echoed
1521 again, so we go to reread_first, rather than reread. */
1525 /* Don't bother updating menu bars while doing mouse tracking.
1526 We get events very rapidly then, and the menu bar won't be changing.
1527 We do update the menu bar once on entry to Ftrack_mouse. */
1528 if (commandflag
> 0 && !input_pending
&& !detect_input_pending ())
1529 prepare_menu_bars ();
1531 /* Save outer setjmp data, in case called recursively. */
1532 save_getcjmp (save_jump
);
1536 if (commandflag
>= 0 && !input_pending
&& !detect_input_pending ())
1539 if (_setjmp (getcjmp
))
1541 XSETINT (c
, quit_char
);
1543 XSETFRAME (internal_last_event_frame
, selected_frame
);
1544 Vlast_event_frame
= internal_last_event_frame
;
1546 /* If we report the quit char as an event,
1547 don't do so more than once. */
1548 if (!NILP (Vinhibit_quit
))
1554 /* Message turns off echoing unless more keystrokes turn it on again. */
1555 if (echo_area_glyphs
&& *echo_area_glyphs
1556 && echo_area_glyphs
!= current_perdisplay
->echobuf
)
1559 /* If already echoing, continue. */
1562 /* Try reading a character via menu prompting in the minibuf.
1563 Try this before the sit-for, because the sit-for
1564 would do the wrong thing if we are supposed to do
1565 menu prompting. If EVENT_HAS_PARAMETERS then we are reading
1566 after a mouse event so don't try a minibuf menu. */
1568 if (nmaps
> 0 && INTERACTIVE
1569 && !NILP (prev_event
) && ! EVENT_HAS_PARAMETERS (prev_event
)
1570 /* Don't bring up a menu if we already have another event. */
1571 && NILP (Vunread_command_events
)
1572 && unread_command_char
< 0
1573 && !detect_input_pending ())
1575 c
= read_char_minibuf_menu_prompt (commandflag
, nmaps
, maps
);
1578 key_already_recorded
= 1;
1583 /* If in middle of key sequence and minibuffer not active,
1584 start echoing if enough time elapses. */
1585 if (minibuf_level
== 0 && !current_perdisplay
->immediate_echo
1586 && this_command_key_count
> 0
1588 && echo_keystrokes
> 0
1589 && (echo_area_glyphs
== 0 || *echo_area_glyphs
== 0))
1593 /* After a mouse event, start echoing right away.
1594 This is because we are probably about to display a menu,
1595 and we don't want to delay before doing so. */
1596 if (EVENT_HAS_PARAMETERS (prev_event
))
1600 tem0
= sit_for (echo_keystrokes
, 0, 1, 1);
1606 /* Maybe auto save due to number of keystrokes or idle time. */
1608 if (commandflag
!= 0
1609 && auto_save_interval
> 0
1610 && num_nonmacro_input_chars
- last_auto_save
> max (auto_save_interval
, 20)
1611 && !detect_input_pending ())
1614 save_getcjmp (temp
);
1615 Fdo_auto_save (Qnil
, Qnil
);
1616 /* Hooks can actually change some buffers in auto save. */
1618 restore_getcjmp (temp
);
1621 /* Try reading using an X menu.
1622 This is never confused with reading using the minibuf
1623 because the recursive call of read_char in read_char_minibuf_menu_prompt
1624 does not pass on any keymaps. */
1625 if (nmaps
> 0 && INTERACTIVE
1626 && !NILP (prev_event
) && EVENT_HAS_PARAMETERS (prev_event
)
1627 /* Don't bring up a menu if we already have another event. */
1628 && NILP (Vunread_command_events
)
1629 && unread_command_char
< 0)
1630 c
= read_char_x_menu_prompt (nmaps
, maps
, prev_event
, used_mouse_menu
);
1632 /* Slow down auto saves logarithmically in size of current buffer,
1633 and garbage collect while we're at it. */
1634 if (INTERACTIVE
&& NILP (c
))
1636 int delay_level
, buffer_size
;
1638 if (! MINI_WINDOW_P (XWINDOW (selected_window
)))
1639 last_non_minibuf_size
= Z
- BEG
;
1640 buffer_size
= (last_non_minibuf_size
>> 8) + 1;
1642 while (buffer_size
> 64)
1643 delay_level
++, buffer_size
-= buffer_size
>> 2;
1644 if (delay_level
< 4) delay_level
= 4;
1645 /* delay_level is 4 for files under around 50k, 7 at 100k,
1646 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
1648 /* Auto save if enough time goes by without input. */
1649 if (commandflag
!= 0
1650 && num_nonmacro_input_chars
> last_auto_save
1651 && INTEGERP (Vauto_save_timeout
)
1652 && XINT (Vauto_save_timeout
) > 0)
1655 int delay
= delay_level
* XFASTINT (Vauto_save_timeout
) / 4;
1656 tem0
= sit_for (delay
, 0, 1, 1);
1660 save_getcjmp (temp
);
1661 Fdo_auto_save (Qnil
, Qnil
);
1662 restore_getcjmp (temp
);
1664 /* If we have auto-saved and there is still no input
1665 available, garbage collect if there has been enough
1666 consing going on to make it worthwhile. */
1667 if (!detect_input_pending ()
1668 && consing_since_gc
> gc_cons_threshold
/ 2)
1669 Fgarbage_collect ();
1670 /* prepare_menu_bars isn't safe here, but it should
1671 also be unnecessary. */
1677 /* Actually read a character, waiting if necessary. */
1680 c
= kbd_buffer_get_event ();
1683 if (commandflag
>= 0 && !input_pending
&& !detect_input_pending ())
1685 prepare_menu_bars ();
1690 /* Terminate Emacs in batch mode if at eof. */
1691 if (noninteractive
&& INTEGERP (c
) && XINT (c
) < 0)
1692 Fkill_emacs (make_number (1));
1696 /* Add in any extra modifiers, where appropriate. */
1697 if ((extra_keyboard_modifiers
& CHAR_CTL
)
1698 || ((extra_keyboard_modifiers
& 0177) < ' '
1699 && (extra_keyboard_modifiers
& 0177) != 0))
1700 XSETINT (c
, make_ctrl_char (XINT (c
)));
1702 /* Transfer any other modifier bits directly from
1703 extra_keyboard_modifiers to c. Ignore the actual character code
1704 in the low 16 bits of extra_keyboard_modifiers. */
1705 XSETINT (c
, XINT (c
) | (extra_keyboard_modifiers
& ~0xff7f & ~CHAR_CTL
));
1710 restore_getcjmp (save_jump
);
1714 /* Buffer switch events are only for internal wakeups
1715 so don't show them to the user. */
1719 if (key_already_recorded
)
1722 /* Wipe the echo area. */
1723 echo_area_glyphs
= 0;
1725 /* Handle things that only apply to characters. */
1728 /* If kbd_buffer_get_event gave us an EOF, return that. */
1732 if (STRINGP (Vkeyboard_translate_table
)
1733 && XSTRING (Vkeyboard_translate_table
)->size
> XFASTINT (c
))
1734 XSETINT (c
, XSTRING (Vkeyboard_translate_table
)->data
[XFASTINT (c
)]);
1737 /* If this event is a mouse click in the menu bar,
1738 return just menu-bar for now. Modify the mouse click event
1739 so we won't do this twice, then queue it up. */
1740 if (EVENT_HAS_PARAMETERS (c
)
1741 && CONSP (XCONS (c
)->cdr
)
1742 && CONSP (EVENT_START (c
))
1743 && CONSP (XCONS (EVENT_START (c
))->cdr
))
1747 posn
= POSN_BUFFER_POSN (EVENT_START (c
));
1748 /* Handle menu-bar events:
1749 insert the dummy prefix event `menu-bar'. */
1750 if (EQ (posn
, Qmenu_bar
))
1752 /* Change menu-bar to (menu-bar) as the event "position". */
1753 POSN_BUFFER_POSN (EVENT_START (c
)) = Fcons (posn
, Qnil
);
1756 Vunread_command_events
= Fcons (c
, Vunread_command_events
);
1762 if (! NILP (also_record
))
1763 record_char (also_record
);
1768 /* Don't echo mouse motion events. */
1770 && ! (EVENT_HAS_PARAMETERS (c
)
1771 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c
)), Qmouse_movement
)))
1774 if (! NILP (also_record
))
1775 echo_char (also_record
);
1778 /* Record this character as part of the current key. */
1779 add_command_key (c
);
1780 if (! NILP (also_record
))
1781 add_command_key (also_record
);
1783 /* Re-reading in the middle of a command */
1785 last_input_char
= c
;
1788 /* Process the help character specially if enabled */
1789 if (EQ (c
, Vhelp_char
) && !NILP (Vhelp_form
))
1792 count
= specpdl_ptr
- specpdl
;
1794 record_unwind_protect (Fset_window_configuration
,
1795 Fcurrent_window_configuration (Qnil
));
1797 tem0
= Feval (Vhelp_form
);
1799 internal_with_output_to_temp_buffer ("*Help*", print_help
, tem0
);
1803 c
= read_char (0, 0, 0, Qnil
, 0);
1804 while (BUFFERP (c
));
1805 /* Remove the help from the frame */
1806 unbind_to (count
, Qnil
);
1807 prepare_menu_bars ();
1809 if (EQ (c
, make_number (040)))
1813 c
= read_char (0, 0, 0, Qnil
, 0);
1814 while (BUFFERP (c
));
1821 /* Record the input event C in various ways. */
1828 XVECTOR (recent_keys
)->contents
[recent_keys_index
] = c
;
1829 if (++recent_keys_index
>= NUM_RECENT_KEYS
)
1830 recent_keys_index
= 0;
1832 /* Write c to the dribble file. If c is a lispy event, write
1833 the event's symbol to the dribble file, in <brackets>. Bleaugh.
1834 If you, dear reader, have a better idea, you've got the source. :-) */
1839 if (XUINT (c
) < 0x100)
1840 putc (XINT (c
), dribble
);
1842 fprintf (dribble
, " 0x%x", XUINT (c
));
1846 Lisp_Object dribblee
;
1848 /* If it's a structured event, take the event header. */
1849 dribblee
= EVENT_HEAD (c
);
1851 if (SYMBOLP (dribblee
))
1853 putc ('<', dribble
);
1854 fwrite (XSYMBOL (dribblee
)->name
->data
, sizeof (char),
1855 XSYMBOL (dribblee
)->name
->size
,
1857 putc ('>', dribble
);
1864 store_kbd_macro_char (c
);
1866 num_nonmacro_input_chars
++;
1873 struct buffer
*old
= current_buffer
;
1874 Fprinc (object
, Qnil
);
1875 set_buffer_internal (XBUFFER (Vstandard_output
));
1876 call0 (intern ("help-mode"));
1877 set_buffer_internal (old
);
1881 /* Copy out or in the info on where C-g should throw to.
1882 This is used when running Lisp code from within get_char,
1883 in case get_char is called recursively.
1884 See read_process_output. */
1889 bcopy (getcjmp
, temp
, sizeof getcjmp
);
1892 restore_getcjmp (temp
)
1895 bcopy (temp
, getcjmp
, sizeof getcjmp
);
1901 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
1902 of this function. */
1905 tracking_off (old_value
)
1906 Lisp_Object old_value
;
1908 do_mouse_tracking
= old_value
;
1909 if (NILP (old_value
))
1911 /* Redisplay may have been preempted because there was input
1912 available, and it assumes it will be called again after the
1913 input has been processed. If the only input available was
1914 the sort that we have just disabled, then we need to call
1916 if (!readable_events ())
1918 prepare_menu_bars ();
1919 redisplay_preserve_echo_area ();
1920 get_input_pending (&input_pending
);
1925 DEFUN ("track-mouse", Ftrack_mouse
, Strack_mouse
, 0, UNEVALLED
, 0,
1926 "Evaluate BODY with mouse movement events enabled.\n\
1927 Within a `track-mouse' form, mouse motion generates input events that\n\
1928 you can read with `read-event'.\n\
1929 Normally, mouse motion is ignored.")
1933 int count
= specpdl_ptr
- specpdl
;
1936 record_unwind_protect (tracking_off
, do_mouse_tracking
);
1938 if (!input_pending
&& !detect_input_pending ())
1939 prepare_menu_bars ();
1941 XSETFRAME (do_mouse_tracking
, selected_frame
);
1943 val
= Fprogn (args
);
1944 return unbind_to (count
, val
);
1947 #endif /* HAVE_MOUSE */
1949 /* Low level keyboard/mouse input.
1950 kbd_buffer_store_event places events in kbd_buffer, and
1951 kbd_buffer_get_event retrieves them.
1952 mouse_moved indicates when the mouse has moved again, and
1953 *mouse_position_hook provides the mouse position. */
1956 find_active_event_queue ()
1960 for (perd
= all_perdisplays
; perd
; perd
= perd
->next_perdisplay
)
1962 if (perd
->kbd_fetch_ptr
!= perd
->kbd_store_ptr
)
1968 /* Return true iff there are any events in the queue that read-char
1969 would return. If this returns false, a read-char would block. */
1973 return find_active_event_queue () != NULL
|| MOUSE_ACTIVITY_AVAILABLE
;
1976 /* Set this for debugging, to have a way to get out */
1979 /* Store an event obtained at interrupt level into kbd_buffer, fifo */
1982 kbd_buffer_store_event (event
)
1983 register struct input_event
*event
;
1985 PERDISPLAY
*perd
= get_perdisplay (XFRAME (event
->frame_or_window
));
1987 if (event
->kind
== no_event
)
1990 if (event
->kind
== ascii_keystroke
)
1992 register int c
= event
->code
& 0377;
1994 if (event
->modifiers
& ctrl_modifier
)
1995 c
= make_ctrl_char (c
);
1997 c
|= (event
->modifiers
1998 & (meta_modifier
| alt_modifier
1999 | hyper_modifier
| super_modifier
));
2003 extern SIGTYPE
interrupt_signal ();
2006 /* If this results in a quit_char being returned to Emacs as
2007 input, set Vlast_event_frame properly. If this doesn't
2008 get returned to Emacs as an event, the next event read
2009 will set Vlast_event_frame again, so this is safe to do. */
2013 focus
= FRAME_FOCUS_FRAME (XFRAME (event
->frame_or_window
));
2015 internal_last_event_frame
= event
->frame_or_window
;
2017 internal_last_event_frame
= focus
;
2018 Vlast_event_frame
= internal_last_event_frame
;
2022 last_event_timestamp
= event
->timestamp
;
2023 interrupt_signal ();
2027 if (c
&& c
== stop_character
)
2034 if (perd
->kbd_store_ptr
- perd
->kbd_buffer
== KBD_BUFFER_SIZE
)
2035 perd
->kbd_store_ptr
= perd
->kbd_buffer
;
2037 /* Don't let the very last slot in the buffer become full,
2038 since that would make the two pointers equal,
2039 and that is indistinguishable from an empty buffer.
2040 Discard the event if it would fill the last slot. */
2041 if (perd
->kbd_fetch_ptr
- 1 != perd
->kbd_store_ptr
)
2043 volatile struct input_event
*sp
= perd
->kbd_store_ptr
;
2044 sp
->kind
= event
->kind
;
2045 if (event
->kind
== selection_request_event
)
2047 /* We must not use the ordinary copying code for this case,
2048 since `part' is an enum and copying it might not copy enough
2050 bcopy (event
, (char *) sp
, sizeof (*event
));
2054 sp
->code
= event
->code
;
2055 sp
->part
= event
->part
;
2056 sp
->frame_or_window
= event
->frame_or_window
;
2057 sp
->modifiers
= event
->modifiers
;
2060 sp
->timestamp
= event
->timestamp
;
2062 (XVECTOR (perd
->kbd_buffer_frame_or_window
)->contents
[perd
->kbd_store_ptr
2064 = event
->frame_or_window
);
2066 perd
->kbd_store_ptr
++;
2070 /* Read one event from the event buffer, waiting if necessary.
2071 The value is a Lisp object representing the event.
2072 The value is nil for an event that should be ignored,
2073 or that was handled here.
2074 We always read and discard one event. */
2077 kbd_buffer_get_event ()
2090 /* Wait until there is input available. */
2093 perd
= find_active_event_queue ();
2094 if (perd
|| MOUSE_ACTIVITY_AVAILABLE
)
2097 /* If the quit flag is set, then read_char will return
2098 quit_char, so that counts as "available input." */
2099 if (!NILP (Vquit_flag
))
2100 quit_throw_to_read_char ();
2102 /* One way or another, wait until input is available; then, if
2103 interrupt handlers have not read it, read it now. */
2106 wait_for_kbd_input ();
2108 /* Note SIGIO has been undef'd if FIONREAD is missing. */
2112 perd
= find_active_event_queue ();
2113 if (!(perd
|| MOUSE_ACTIVITY_AVAILABLE
))
2115 Lisp_Object minus_one
;
2117 XSETINT (minus_one
, -1);
2118 wait_reading_process_input (0, 0, minus_one
, 1);
2120 if (!interrupt_input
&& find_active_event_queue () == NULL
)
2121 /* Pass 1 for EXPECT since we just waited to have input. */
2122 read_avail_input (1);
2124 #endif /* not VMS */
2127 /* At this point, we know that there is a readable event available
2128 somewhere. If the event queue is empty, then there must be a
2129 mouse movement enabled and available. */
2132 struct input_event
*event
;
2134 event
= ((perd
->kbd_fetch_ptr
< perd
->kbd_buffer
+ KBD_BUFFER_SIZE
)
2135 ? perd
->kbd_fetch_ptr
2136 : perd
->kbd_buffer
);
2138 last_event_timestamp
= event
->timestamp
;
2142 /* These two kinds of events get special handling
2143 and don't actually appear to the command loop.
2144 We return nil for them. */
2145 if (event
->kind
== selection_request_event
)
2148 struct input_event copy
= *event
;
2149 /* Remove it from the buffer before processing it,
2150 since otherwise swallow_events will see it
2151 and process it again. */
2152 perd
->kbd_fetch_ptr
= event
+ 1;
2153 x_handle_selection_request (©
);
2155 /* We're getting selection request events, but we don't have
2161 else if (event
->kind
== selection_clear_event
)
2164 x_handle_selection_clear (event
);
2165 perd
->kbd_fetch_ptr
= event
+ 1;
2167 /* We're getting selection request events, but we don't have
2173 else if (event
->kind
== delete_window_event
)
2175 /* Make an event (delete-frame (FRAME)). */
2176 obj
= Fcons (event
->frame_or_window
, Qnil
);
2177 obj
= Fcons (Qdelete_frame
, Fcons (obj
, Qnil
));
2178 perd
->kbd_fetch_ptr
= event
+ 1;
2180 else if (event
->kind
== iconify_event
)
2182 /* Make an event (iconify-frame (FRAME)). */
2183 obj
= Fcons (event
->frame_or_window
, Qnil
);
2184 obj
= Fcons (Qiconify_frame
, Fcons (obj
, Qnil
));
2185 perd
->kbd_fetch_ptr
= event
+ 1;
2187 else if (event
->kind
== deiconify_event
)
2189 /* Make an event (make-frame-visible (FRAME)). */
2190 obj
= Fcons (event
->frame_or_window
, Qnil
);
2191 obj
= Fcons (Qmake_frame_visible
, Fcons (obj
, Qnil
));
2192 perd
->kbd_fetch_ptr
= event
+ 1;
2195 else if (event
->kind
== menu_bar_event
)
2197 /* The event value is in the frame_or_window slot. */
2198 obj
= event
->frame_or_window
;
2199 perd
->kbd_fetch_ptr
= event
+ 1;
2201 else if (event
->kind
== buffer_switch_event
)
2203 /* The value doesn't matter here; only the type is tested. */
2204 XSETBUFFER (obj
, current_buffer
);
2205 perd
->kbd_fetch_ptr
= event
+ 1;
2207 /* Just discard these, by returning nil.
2208 (They shouldn't be found in the buffer,
2209 but on some machines it appears they do show up.) */
2210 else if (event
->kind
== no_event
)
2211 perd
->kbd_fetch_ptr
= event
+ 1;
2213 /* If this event is on a different frame, return a switch-frame this
2214 time, and leave the event in the queue for next time. */
2221 frame
= event
->frame_or_window
;
2222 if (WINDOWP (frame
))
2223 frame
= WINDOW_FRAME (XWINDOW (frame
));
2225 focus
= FRAME_FOCUS_FRAME (XFRAME (frame
));
2229 if (! EQ (frame
, internal_last_event_frame
)
2230 && XFRAME (frame
) != selected_frame
)
2231 obj
= make_lispy_switch_frame (frame
);
2232 internal_last_event_frame
= frame
;
2233 #endif /* MULTI_FRAME */
2235 /* If we didn't decide to make a switch-frame event, go ahead
2236 and build a real event from the queue entry. */
2240 obj
= make_lispy_event (event
);
2242 /* Wipe out this event, to catch bugs. */
2243 event
->kind
= no_event
;
2244 XVECTOR (perd
->kbd_buffer_frame_or_window
)->contents
[event
- perd
->kbd_buffer
] = Qnil
;
2246 perd
->kbd_fetch_ptr
= event
+ 1;
2251 /* Try generating a mouse motion event. */
2252 else if (FRAMEP (do_mouse_tracking
) && mouse_moved
)
2254 FRAME_PTR f
= XFRAME (do_mouse_tracking
);
2255 Lisp_Object bar_window
;
2256 enum scroll_bar_part part
;
2260 /* Note that this uses F to determine which display to look at.
2261 If there is no valid info, it does not store anything
2262 so x remains nil. */
2264 (*mouse_position_hook
) (&f
, &bar_window
, &part
, &x
, &y
, &time
);
2269 /* Decide if we should generate a switch-frame event. Don't
2270 generate switch-frame events for motion outside of all Emacs
2276 frame
= FRAME_FOCUS_FRAME (f
);
2278 XSETFRAME (frame
, f
);
2280 if (! EQ (frame
, internal_last_event_frame
)
2281 && XFRAME (frame
) != selected_frame
)
2282 obj
= make_lispy_switch_frame (frame
);
2283 internal_last_event_frame
= frame
;
2287 /* If we didn't decide to make a switch-frame event, go ahead and
2288 return a mouse-motion event. */
2289 if (!NILP (x
) && NILP (obj
))
2290 obj
= make_lispy_movement (f
, bar_window
, part
, x
, y
, time
);
2292 #endif /* HAVE_MOUSE */
2294 /* We were promised by the above while loop that there was
2295 something for us to read! */
2298 input_pending
= readable_events ();
2301 Vlast_event_frame
= internal_last_event_frame
;
2307 /* Process any events that are not user-visible,
2308 then return, without reading any user-visible events. */
2314 while ((perd
= find_active_event_queue ()) != NULL
)
2316 struct input_event
*event
;
2318 event
= ((perd
->kbd_fetch_ptr
< perd
->kbd_buffer
+ KBD_BUFFER_SIZE
)
2319 ? perd
->kbd_fetch_ptr
2320 : perd
->kbd_buffer
);
2322 last_event_timestamp
= event
->timestamp
;
2324 /* These two kinds of events get special handling
2325 and don't actually appear to the command loop. */
2326 if (event
->kind
== selection_request_event
)
2329 struct input_event copy
;
2331 perd
->kbd_fetch_ptr
= event
+ 1;
2332 x_handle_selection_request (©
);
2334 /* We're getting selection request events, but we don't have
2340 else if (event
->kind
== selection_clear_event
)
2343 x_handle_selection_clear (event
);
2344 perd
->kbd_fetch_ptr
= event
+ 1;
2346 /* We're getting selection request events, but we don't have
2355 get_input_pending (&input_pending
);
2358 /* Caches for modify_event_symbol. */
2359 static Lisp_Object accent_key_syms
;
2360 static Lisp_Object system_key_syms
;
2361 static Lisp_Object func_key_syms
;
2362 static Lisp_Object mouse_syms
;
2364 Lisp_Object Vsystem_key_alist
;
2366 /* This is a list of keysym codes for special "accent" characters.
2367 It parallels lispy_accent_keys. */
2369 static int lispy_accent_codes
[] =
2371 #ifdef XK_dead_circumflex
2376 #ifdef XK_dead_grave
2381 #ifdef XK_dead_tilde
2386 #ifdef XK_dead_diaeresis
2391 #ifdef XK_dead_macron
2396 #ifdef XK_dead_degree
2401 #ifdef XK_dead_acute
2406 #ifdef XK_dead_cedilla
2411 #ifdef XK_dead_breve
2416 #ifdef XK_dead_ogonek
2421 #ifdef XK_dead_caron
2426 #ifdef XK_dead_doubleacute
2427 XK_dead_doubleacute
,
2431 #ifdef XK_dead_abovedot
2438 /* This is a list of Lisp names for special "accent" characters.
2439 It parallels lispy_accent_codes. */
2441 static char *lispy_accent_keys
[] =
2458 /* You'll notice that this table is arranged to be conveniently
2459 indexed by X Windows keysym values. */
2460 static char *lispy_function_keys
[] =
2462 /* X Keysym value */
2464 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00 */
2472 0, 0, 0, /* 0xff10 */
2474 0, 0, 0, 0, 0, 0, 0,
2477 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff20...2f */
2478 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff30...3f */
2479 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */
2481 "home", /* 0xff50 */ /* IsCursorKey */
2492 "select", /* 0xff60 */ /* IsMiscFunctionKey */
2503 "break", /* 0xff6b */
2505 0, 0, 0, 0, 0, 0, 0, 0, "backtab", 0,
2507 0, 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff7f */
2508 "kp-space", /* 0xff80 */ /* IsKeypadKey */
2509 0, 0, 0, 0, 0, 0, 0, 0,
2510 "kp-tab", /* 0xff89 */
2512 "kp-enter", /* 0xff8d */
2514 "kp-f1", /* 0xff91 */
2518 "kp-home", /* 0xff95 */
2523 "kp-prior", /* kp-page-up */
2524 "kp-next", /* kp-page-down */
2530 0, 0, 0, 0, 0, 0, 0, 0, 0,
2531 "kp-multiply", /* 0xffaa */
2536 "kp-divide", /* 0xffaf */
2537 "kp-0", /* 0xffb0 */
2538 "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
2541 "kp-equal", /* 0xffbd */
2542 "f1", /* 0xffbe */ /* IsFunctionKey */
2544 "f3", "f4", "f5", "f6", "f7", "f8", "f9", "f10", /* 0xffc0 */
2545 "f11", "f12", "f13", "f14", "f15", "f16", "f17", "f18",
2546 "f19", "f20", "f21", "f22", "f23", "f24", "f25", "f26", /* 0xffd0 */
2547 "f27", "f28", "f29", "f30", "f31", "f32", "f33", "f34",
2548 "f35", 0, 0, 0, 0, 0, 0, 0, /* 0xffe0 */
2549 0, 0, 0, 0, 0, 0, 0, 0,
2550 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfff0 */
2551 0, 0, 0, 0, 0, 0, 0, "delete"
2554 static char *lispy_mouse_names
[] =
2556 "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5"
2559 /* Scroll bar parts. */
2560 Lisp_Object Qabove_handle
, Qhandle
, Qbelow_handle
;
2562 /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */
2563 Lisp_Object
*scroll_bar_parts
[] = {
2564 &Qabove_handle
, &Qhandle
, &Qbelow_handle
2568 /* A vector, indexed by button number, giving the down-going location
2569 of currently depressed buttons, both scroll bar and non-scroll bar.
2571 The elements have the form
2572 (BUTTON-NUMBER MODIFIER-MASK . REST)
2573 where REST is the cdr of a position as it would be reported in the event.
2575 The make_lispy_event function stores positions here to tell the
2576 difference between click and drag events, and to store the starting
2577 location to be included in drag events. */
2579 static Lisp_Object button_down_location
;
2581 /* Information about the most recent up-going button event: Which
2582 button, what location, and what time. */
2584 static int last_mouse_button
;
2585 static int last_mouse_x
;
2586 static int last_mouse_y
;
2587 static unsigned long button_down_time
;
2589 /* The maximum time between clicks to make a double-click,
2590 or Qnil to disable double-click detection,
2591 or Qt for no time limit. */
2592 Lisp_Object Vdouble_click_time
;
2594 /* The number of clicks in this multiple-click. */
2596 int double_click_count
;
2598 #ifdef USE_X_TOOLKIT
2599 extern Lisp_Object
map_event_to_object ();
2600 #endif /* USE_X_TOOLKIT */
2602 /* Given a struct input_event, build the lisp event which represents
2603 it. If EVENT is 0, build a mouse movement event from the mouse
2604 movement buffer, which should have a movement event in it.
2606 Note that events must be passed to this function in the order they
2607 are received; this function stores the location of button presses
2608 in order to build drag events when the button is released. */
2611 make_lispy_event (event
)
2612 struct input_event
*event
;
2616 switch (SWITCH_ENUM_CAST (event
->kind
))
2618 /* A simple keystroke. */
2619 case ascii_keystroke
:
2621 Lisp_Object lispy_c
;
2622 int c
= event
->code
& 0377;
2623 /* Turn ASCII characters into control characters
2625 if (event
->modifiers
& ctrl_modifier
)
2626 c
= make_ctrl_char (c
);
2628 /* Add in the other modifier bits. We took care of ctrl_modifier
2629 just above, and the shift key was taken care of by the X code,
2630 and applied to control characters by make_ctrl_char. */
2631 c
|= (event
->modifiers
2632 & (meta_modifier
| alt_modifier
2633 | hyper_modifier
| super_modifier
));
2634 button_down_time
= 0;
2635 XSETFASTINT (lispy_c
, c
);
2639 /* A function key. The symbol may need to have modifier prefixes
2641 case non_ascii_keystroke
:
2642 button_down_time
= 0;
2644 for (i
= 0; i
< sizeof (lispy_accent_codes
) / sizeof (int); i
++)
2645 if (event
->code
== lispy_accent_codes
[i
])
2646 return modify_event_symbol (i
,
2648 Qfunction_key
, Qnil
,
2649 lispy_accent_keys
, &accent_key_syms
,
2650 (sizeof (lispy_accent_keys
)
2651 / sizeof (lispy_accent_keys
[0])));
2653 /* Handle system-specific keysyms. */
2654 if (event
->code
& (1 << 28))
2656 /* We need to use an alist rather than a vector as the cache
2657 since we can't make a vector long enuf. */
2658 if (NILP (system_key_syms
))
2659 system_key_syms
= Fcons (Qnil
, Qnil
);
2660 return modify_event_symbol (event
->code
& 0xffffff,
2662 Qfunction_key
, Vsystem_key_alist
,
2663 0, &system_key_syms
, 0xffffff);
2666 return modify_event_symbol (event
->code
- 0xff00,
2668 Qfunction_key
, Qnil
,
2669 lispy_function_keys
, &func_key_syms
,
2670 (sizeof (lispy_function_keys
)
2671 / sizeof (lispy_function_keys
[0])));
2674 #if defined (MULTI_FRAME) || defined (HAVE_MOUSE)
2675 /* A mouse click. Figure out where it is, decide whether it's
2676 a press, click or drag, and build the appropriate structure. */
2678 case scroll_bar_click
:
2680 int button
= event
->code
;
2682 Lisp_Object position
;
2683 Lisp_Object
*start_pos_ptr
;
2684 Lisp_Object start_pos
;
2686 if (button
< 0 || button
>= NUM_MOUSE_BUTTONS
)
2689 /* Build the position as appropriate for this mouse click. */
2690 if (event
->kind
== mouse_click
)
2693 FRAME_PTR f
= XFRAME (event
->frame_or_window
);
2698 /* Ignore mouse events that were made on frame that
2699 have been deleted. */
2700 if (! FRAME_LIVE_P (f
))
2703 pixel_to_glyph_coords (f
, XINT (event
->x
), XINT (event
->y
),
2704 &column
, &row
, 0, 1);
2706 #ifndef USE_X_TOOLKIT
2707 /* In the non-toolkit version, clicks on the menu bar
2708 are ordinary button events in the event buffer.
2709 Distinguish them, and invoke the menu.
2711 (In the toolkit version, the toolkit handles the menu bar
2712 and Emacs doesn't know about it until after the user
2713 makes a selection.) */
2714 if (row
>= 0 && row
< FRAME_MENU_BAR_LINES (f
))
2716 Lisp_Object items
, item
;
2720 /* Activate the menu bar on the down event. If the
2721 up event comes in before the menu code can deal with it,
2723 if (! (event
->modifiers
& down_modifier
))
2727 items
= FRAME_MENU_BAR_ITEMS (f
);
2728 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
2730 Lisp_Object pos
, string
;
2731 string
= XVECTOR (items
)->contents
[i
+ 1];
2732 pos
= XVECTOR (items
)->contents
[i
+ 2];
2735 if (column
>= XINT (pos
)
2736 && column
< XINT (pos
) + XSTRING (string
)->size
)
2738 item
= XVECTOR (items
)->contents
[i
];
2744 = Fcons (event
->frame_or_window
,
2746 Fcons (Fcons (event
->x
, event
->y
),
2747 Fcons (make_number (event
->timestamp
),
2750 return Fcons (item
, Fcons (position
, Qnil
));
2752 #endif /* not USE_X_TOOLKIT */
2754 window
= window_from_coordinates (f
, column
, row
, &part
);
2756 if (!WINDOWP (window
))
2758 window
= event
->frame_or_window
;
2763 int pixcolumn
, pixrow
;
2764 column
-= XINT (XWINDOW (window
)->left
);
2765 row
-= XINT (XWINDOW (window
)->top
);
2766 glyph_to_pixel_coords (f
, column
, row
, &pixcolumn
, &pixrow
);
2767 XSETINT (event
->x
, pixcolumn
);
2768 XSETINT (event
->y
, pixrow
);
2773 posn
= Qvertical_line
;
2776 buffer_posn_from_coords (XWINDOW (window
),
2783 Fcons (Fcons (event
->x
, event
->y
),
2784 Fcons (make_number (event
->timestamp
),
2790 Lisp_Object portion_whole
;
2793 window
= event
->frame_or_window
;
2794 portion_whole
= Fcons (event
->x
, event
->y
);
2795 part
= *scroll_bar_parts
[(int) event
->part
];
2799 Fcons (Qvertical_scroll_bar
,
2800 Fcons (portion_whole
,
2801 Fcons (make_number (event
->timestamp
),
2802 Fcons (part
, Qnil
)))));
2805 start_pos_ptr
= &XVECTOR (button_down_location
)->contents
[button
];
2807 start_pos
= *start_pos_ptr
;
2808 *start_pos_ptr
= Qnil
;
2810 is_double
= (button
== last_mouse_button
2811 && XINT (event
->x
) == last_mouse_x
2812 && XINT (event
->y
) == last_mouse_y
2813 && button_down_time
!= 0
2814 && (EQ (Vdouble_click_time
, Qt
)
2815 || (INTEGERP (Vdouble_click_time
)
2816 && ((int)(event
->timestamp
- button_down_time
)
2817 < XINT (Vdouble_click_time
)))));
2818 last_mouse_button
= button
;
2819 last_mouse_x
= XINT (event
->x
);
2820 last_mouse_y
= XINT (event
->y
);
2822 /* If this is a button press, squirrel away the location, so
2823 we can decide later whether it was a click or a drag. */
2824 if (event
->modifiers
& down_modifier
)
2828 double_click_count
++;
2829 event
->modifiers
|= ((double_click_count
> 2)
2834 double_click_count
= 1;
2835 button_down_time
= event
->timestamp
;
2836 *start_pos_ptr
= Fcopy_alist (position
);
2839 /* Now we're releasing a button - check the co-ordinates to
2840 see if this was a click or a drag. */
2841 else if (event
->modifiers
& up_modifier
)
2843 /* If we did not see a down before this up,
2844 ignore the up. Probably this happened because
2845 the down event chose a menu item.
2846 It would be an annoyance to treat the release
2847 of the button that chose the menu item
2848 as a separate event. */
2850 if (!CONSP (start_pos
))
2853 event
->modifiers
&= ~up_modifier
;
2854 #if 0 /* Formerly we treated an up with no down as a click event. */
2855 if (!CONSP (start_pos
))
2856 event
->modifiers
|= click_modifier
;
2860 /* The third element of every position should be the (x,y)
2864 down
= Fnth (make_number (2), start_pos
);
2865 if (EQ (event
->x
, XCONS (down
)->car
)
2866 && EQ (event
->y
, XCONS (down
)->cdr
))
2868 event
->modifiers
|= click_modifier
;
2872 button_down_time
= 0;
2873 event
->modifiers
|= drag_modifier
;
2875 /* Don't check is_double; treat this as multiple
2876 if the down-event was multiple. */
2877 if (double_click_count
> 1)
2878 event
->modifiers
|= ((double_click_count
> 2)
2884 /* Every mouse event should either have the down_modifier or
2885 the up_modifier set. */
2889 /* Get the symbol we should use for the mouse click. */
2892 head
= modify_event_symbol (button
,
2895 lispy_mouse_names
, &mouse_syms
,
2896 (sizeof (lispy_mouse_names
)
2897 / sizeof (lispy_mouse_names
[0])));
2898 if (event
->modifiers
& drag_modifier
)
2903 else if (event
->modifiers
& (double_modifier
| triple_modifier
))
2906 Fcons (make_number (double_click_count
),
2914 #endif /* MULTI_FRAME or HAVE_MOUSE */
2916 /* The 'kind' field of the event is something we don't recognize. */
2922 #if defined (MULTI_FRAME) || defined (HAVE_MOUSE)
2925 make_lispy_movement (frame
, bar_window
, part
, x
, y
, time
)
2927 Lisp_Object bar_window
;
2928 enum scroll_bar_part part
;
2933 /* Is it a scroll bar movement? */
2934 if (frame
&& ! NILP (bar_window
))
2936 Lisp_Object part_sym
;
2938 part_sym
= *scroll_bar_parts
[(int) part
];
2939 return Fcons (Qscroll_bar_movement
,
2940 (Fcons (Fcons (bar_window
,
2941 Fcons (Qvertical_scroll_bar
,
2942 Fcons (Fcons (x
, y
),
2943 Fcons (make_number (time
),
2949 /* Or is it an ordinary mouse movement? */
2951 #endif /* MULTI_FRAME */
2964 /* It's in a frame; which window on that frame? */
2965 pixel_to_glyph_coords (frame
, XINT (x
), XINT (y
), &column
, &row
, 0, 1);
2966 window
= window_from_coordinates (frame
, column
, row
, &area
);
2971 if (WINDOWP (window
))
2973 int pixcolumn
, pixrow
;
2974 column
-= XINT (XWINDOW (window
)->left
);
2975 row
-= XINT (XWINDOW (window
)->top
);
2976 glyph_to_pixel_coords (frame
, column
, row
, &pixcolumn
, &pixrow
);
2977 XSETINT (x
, pixcolumn
);
2978 XSETINT (y
, pixrow
);
2983 posn
= Qvertical_line
;
2986 buffer_posn_from_coords (XWINDOW (window
), column
, row
));
2989 else if (frame
!= 0)
2991 XSETFRAME (window
, frame
);
3003 return Fcons (Qmouse_movement
,
3004 Fcons (Fcons (window
,
3006 Fcons (Fcons (x
, y
),
3007 Fcons (make_number (time
),
3013 #endif /* neither MULTI_FRAME nor HAVE_MOUSE */
3015 /* Construct a switch frame event. */
3017 make_lispy_switch_frame (frame
)
3020 return Fcons (Qswitch_frame
, Fcons (frame
, Qnil
));
3023 /* Manipulating modifiers. */
3025 /* Parse the name of SYMBOL, and return the set of modifiers it contains.
3027 If MODIFIER_END is non-zero, set *MODIFIER_END to the position in
3028 SYMBOL's name of the end of the modifiers; the string from this
3029 position is the unmodified symbol name.
3031 This doesn't use any caches. */
3033 parse_modifiers_uncached (symbol
, modifier_end
)
3037 struct Lisp_String
*name
;
3041 CHECK_SYMBOL (symbol
, 1);
3044 name
= XSYMBOL (symbol
)->name
;
3047 for (i
= 0; i
+2 <= name
->size
; )
3048 switch (name
->data
[i
])
3050 #define SINGLE_LETTER_MOD(bit) \
3051 if (name->data[i+1] != '-') \
3052 goto no_more_modifiers; \
3057 SINGLE_LETTER_MOD (alt_modifier
);
3061 SINGLE_LETTER_MOD (ctrl_modifier
);
3065 SINGLE_LETTER_MOD (hyper_modifier
);
3069 SINGLE_LETTER_MOD (meta_modifier
);
3073 SINGLE_LETTER_MOD (shift_modifier
);
3077 SINGLE_LETTER_MOD (super_modifier
);
3081 if (i
+ 5 > name
->size
)
3082 goto no_more_modifiers
;
3083 if (! strncmp (name
->data
+ i
, "drag-", 5))
3085 modifiers
|= drag_modifier
;
3088 else if (! strncmp (name
->data
+ i
, "down-", 5))
3090 modifiers
|= down_modifier
;
3093 else if (i
+ 7 <= name
->size
3094 && ! strncmp (name
->data
+ i
, "double-", 7))
3096 modifiers
|= double_modifier
;
3100 goto no_more_modifiers
;
3104 if (i
+ 7 > name
->size
)
3105 goto no_more_modifiers
;
3106 if (! strncmp (name
->data
+ i
, "triple-", 7))
3108 modifiers
|= triple_modifier
;
3112 goto no_more_modifiers
;
3116 goto no_more_modifiers
;
3118 #undef SINGLE_LETTER_MOD
3122 /* Should we include the `click' modifier? */
3123 if (! (modifiers
& (down_modifier
| drag_modifier
3124 | double_modifier
| triple_modifier
))
3125 && i
+ 7 == name
->size
3126 && strncmp (name
->data
+ i
, "mouse-", 6) == 0
3127 && ('0' <= name
->data
[i
+ 6] && name
->data
[i
+ 6] <= '9'))
3128 modifiers
|= click_modifier
;
3137 /* Return a symbol whose name is the modifier prefixes for MODIFIERS
3138 prepended to the string BASE[0..BASE_LEN-1].
3139 This doesn't use any caches. */
3141 apply_modifiers_uncached (modifiers
, base
, base_len
)
3146 /* Since BASE could contain nulls, we can't use intern here; we have
3147 to use Fintern, which expects a genuine Lisp_String, and keeps a
3150 (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
3156 /* Only the event queue may use the `up' modifier; it should always
3157 be turned into a click or drag event before presented to lisp code. */
3158 if (modifiers
& up_modifier
)
3161 if (modifiers
& alt_modifier
) { *p
++ = 'A'; *p
++ = '-'; }
3162 if (modifiers
& ctrl_modifier
) { *p
++ = 'C'; *p
++ = '-'; }
3163 if (modifiers
& hyper_modifier
) { *p
++ = 'H'; *p
++ = '-'; }
3164 if (modifiers
& meta_modifier
) { *p
++ = 'M'; *p
++ = '-'; }
3165 if (modifiers
& shift_modifier
) { *p
++ = 'S'; *p
++ = '-'; }
3166 if (modifiers
& super_modifier
) { *p
++ = 's'; *p
++ = '-'; }
3167 if (modifiers
& double_modifier
) { strcpy (p
, "double-"); p
+= 7; }
3168 if (modifiers
& triple_modifier
) { strcpy (p
, "triple-"); p
+= 7; }
3169 if (modifiers
& down_modifier
) { strcpy (p
, "down-"); p
+= 5; }
3170 if (modifiers
& drag_modifier
) { strcpy (p
, "drag-"); p
+= 5; }
3171 /* The click modifier is denoted by the absence of other modifiers. */
3175 mod_len
= p
- new_mods
;
3179 Lisp_Object new_name
;
3181 new_name
= make_uninit_string (mod_len
+ base_len
);
3182 bcopy (new_mods
, XSTRING (new_name
)->data
, mod_len
);
3183 bcopy (base
, XSTRING (new_name
)->data
+ mod_len
, base_len
);
3185 return Fintern (new_name
, Qnil
);
3190 static char *modifier_names
[] =
3192 "up", "down", "drag", "click", "double", "triple", 0, 0,
3193 0, 0, 0, 0, 0, 0, 0, 0,
3194 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
3196 #define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
3198 static Lisp_Object modifier_symbols
;
3200 /* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
3202 lispy_modifier_list (modifiers
)
3205 Lisp_Object modifier_list
;
3208 modifier_list
= Qnil
;
3209 for (i
= 0; (1<<i
) <= modifiers
&& i
< NUM_MOD_NAMES
; i
++)
3210 if (modifiers
& (1<<i
))
3211 modifier_list
= Fcons (XVECTOR (modifier_symbols
)->contents
[i
],
3214 return modifier_list
;
3218 /* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
3219 where UNMODIFIED is the unmodified form of SYMBOL,
3220 MASK is the set of modifiers present in SYMBOL's name.
3221 This is similar to parse_modifiers_uncached, but uses the cache in
3222 SYMBOL's Qevent_symbol_element_mask property, and maintains the
3223 Qevent_symbol_elements property. */
3225 parse_modifiers (symbol
)
3228 Lisp_Object elements
;
3230 elements
= Fget (symbol
, Qevent_symbol_element_mask
);
3231 if (CONSP (elements
))
3236 int modifiers
= parse_modifiers_uncached (symbol
, &end
);
3237 Lisp_Object unmodified
;
3240 unmodified
= Fintern (make_string (XSYMBOL (symbol
)->name
->data
+ end
,
3241 XSYMBOL (symbol
)->name
->size
- end
),
3244 if (modifiers
& ~((1<<VALBITS
) - 1))
3246 XSETFASTINT (mask
, modifiers
);
3247 elements
= Fcons (unmodified
, Fcons (mask
, Qnil
));
3249 /* Cache the parsing results on SYMBOL. */
3250 Fput (symbol
, Qevent_symbol_element_mask
,
3252 Fput (symbol
, Qevent_symbol_elements
,
3253 Fcons (unmodified
, lispy_modifier_list (modifiers
)));
3255 /* Since we know that SYMBOL is modifiers applied to unmodified,
3256 it would be nice to put that in unmodified's cache.
3257 But we can't, since we're not sure that parse_modifiers is
3264 /* Apply the modifiers MODIFIERS to the symbol BASE.
3265 BASE must be unmodified.
3267 This is like apply_modifiers_uncached, but uses BASE's
3268 Qmodifier_cache property, if present. It also builds
3269 Qevent_symbol_elements properties, since it has that info anyway.
3271 apply_modifiers copies the value of BASE's Qevent_kind property to
3272 the modified symbol. */
3274 apply_modifiers (modifiers
, base
)
3278 Lisp_Object cache
, index
, entry
, new_symbol
;
3280 /* Mask out upper bits. We don't know where this value's been. */
3281 modifiers
&= (1<<VALBITS
) - 1;
3283 /* The click modifier never figures into cache indices. */
3284 cache
= Fget (base
, Qmodifier_cache
);
3285 XSETFASTINT (index
, (modifiers
& ~click_modifier
));
3286 entry
= assq_no_quit (index
, cache
);
3289 new_symbol
= XCONS (entry
)->cdr
;
3292 /* We have to create the symbol ourselves. */
3293 new_symbol
= apply_modifiers_uncached (modifiers
,
3294 XSYMBOL (base
)->name
->data
,
3295 XSYMBOL (base
)->name
->size
);
3297 /* Add the new symbol to the base's cache. */
3298 entry
= Fcons (index
, new_symbol
);
3299 Fput (base
, Qmodifier_cache
, Fcons (entry
, cache
));
3301 /* We have the parsing info now for free, so add it to the caches. */
3302 XSETFASTINT (index
, modifiers
);
3303 Fput (new_symbol
, Qevent_symbol_element_mask
,
3304 Fcons (base
, Fcons (index
, Qnil
)));
3305 Fput (new_symbol
, Qevent_symbol_elements
,
3306 Fcons (base
, lispy_modifier_list (modifiers
)));
3309 /* Make sure this symbol is of the same kind as BASE.
3311 You'd think we could just set this once and for all when we
3312 intern the symbol above, but reorder_modifiers may call us when
3313 BASE's property isn't set right; we can't assume that just
3314 because it has a Qmodifier_cache property it must have its
3315 Qevent_kind set right as well. */
3316 if (NILP (Fget (new_symbol
, Qevent_kind
)))
3320 kind
= Fget (base
, Qevent_kind
);
3322 Fput (new_symbol
, Qevent_kind
, kind
);
3329 /* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
3330 return a symbol with the modifiers placed in the canonical order.
3331 Canonical order is alphabetical, except for down and drag, which
3332 always come last. The 'click' modifier is never written out.
3334 Fdefine_key calls this to make sure that (for example) C-M-foo
3335 and M-C-foo end up being equivalent in the keymap. */
3338 reorder_modifiers (symbol
)
3341 /* It's hopefully okay to write the code this way, since everything
3342 will soon be in caches, and no consing will be done at all. */
3345 parsed
= parse_modifiers (symbol
);
3346 return apply_modifiers (XCONS (XCONS (parsed
)->cdr
)->car
,
3347 XCONS (parsed
)->car
);
3351 /* For handling events, we often want to produce a symbol whose name
3352 is a series of modifier key prefixes ("M-", "C-", etcetera) attached
3353 to some base, like the name of a function key or mouse button.
3354 modify_event_symbol produces symbols of this sort.
3356 NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
3357 is the name of the i'th symbol. TABLE_SIZE is the number of elements
3360 Alternatively, NAME_ALIST is an alist mapping codes into symbol names.
3361 NAME_ALIST is used if it is non-nil; otherwise NAME_TABLE is used.
3363 SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
3364 persist between calls to modify_event_symbol that it can use to
3365 store a cache of the symbols it's generated for this NAME_TABLE
3366 before. The object stored there may be a vector or an alist.
3368 SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
3370 MODIFIERS is a set of modifier bits (as given in struct input_events)
3371 whose prefixes should be applied to the symbol name.
3373 SYMBOL_KIND is the value to be placed in the event_kind property of
3374 the returned symbol.
3376 The symbols we create are supposed to have an
3377 `event-symbol-elements' property, which lists the modifiers present
3378 in the symbol's name. */
3381 modify_event_symbol (symbol_num
, modifiers
, symbol_kind
, name_alist
,
3382 name_table
, symbol_table
, table_size
)
3385 Lisp_Object symbol_kind
;
3386 Lisp_Object name_alist
;
3388 Lisp_Object
*symbol_table
;
3392 Lisp_Object symbol_int
;
3394 XSETINT (symbol_int
, symbol_num
);
3396 /* Is this a request for a valid symbol? */
3397 if (symbol_num
< 0 || symbol_num
>= table_size
)
3400 if (CONSP (*symbol_table
))
3401 value
= Fcdr (assq_no_quit (symbol_int
, *symbol_table
));
3403 /* If *symbol_table doesn't seem to be initialized properly, fix that.
3404 *symbol_table should be a lisp vector TABLE_SIZE elements long,
3405 where the Nth element is the symbol for NAME_TABLE[N], or nil if
3406 we've never used that symbol before. */
3409 if (! VECTORP (*symbol_table
)
3410 || XVECTOR (*symbol_table
)->size
!= table_size
)
3414 XSETFASTINT (size
, table_size
);
3415 *symbol_table
= Fmake_vector (size
, Qnil
);
3418 value
= XVECTOR (*symbol_table
)->contents
[symbol_num
];
3421 /* Have we already used this symbol before? */
3424 /* No; let's create it. */
3425 if (!NILP (name_alist
))
3426 value
= Fcdr_safe (Fassq (symbol_int
, name_alist
));
3427 else if (name_table
[symbol_num
])
3428 value
= intern (name_table
[symbol_num
]);
3433 sprintf (buf
, "key-%d", symbol_num
);
3434 value
= intern (buf
);
3437 if (CONSP (*symbol_table
))
3438 *symbol_table
= Fcons (value
, *symbol_table
);
3440 XVECTOR (*symbol_table
)->contents
[symbol_num
] = value
;
3442 /* Fill in the cache entries for this symbol; this also
3443 builds the Qevent_symbol_elements property, which the user
3445 apply_modifiers (modifiers
& click_modifier
, value
);
3446 Fput (value
, Qevent_kind
, symbol_kind
);
3449 /* Apply modifiers to that symbol. */
3450 return apply_modifiers (modifiers
, value
);
3454 /* Store into *addr a value nonzero if terminal input chars are available.
3455 Serves the purpose of ioctl (0, FIONREAD, addr)
3456 but works even if FIONREAD does not exist.
3457 (In fact, this may actually read some input.) */
3460 get_input_pending (addr
)
3463 /* First of all, have we already counted some input? */
3464 *addr
= !NILP (Vquit_flag
) || readable_events ();
3466 /* If input is being read as it arrives, and we have none, there is none. */
3467 if (*addr
> 0 || (interrupt_input
&& ! interrupts_deferred
))
3470 /* Try to read some input and see how much we get. */
3472 *addr
= !NILP (Vquit_flag
) || readable_events ();
3475 /* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
3478 gobble_input (expected
)
3483 if (interrupt_input
)
3486 mask
= sigblockx (SIGIO
);
3487 read_avail_input (expected
);
3491 #ifdef POLL_FOR_INPUT
3492 if (read_socket_hook
&& !interrupt_input
&& poll_suppress_count
== 0)
3495 mask
= sigblockx (SIGALRM
);
3496 read_avail_input (expected
);
3502 read_avail_input (expected
);
3506 /* Put a buffer_switch_event in the buffer
3507 so that read_key_sequence will notice the new current buffer. */
3509 record_asynch_buffer_change ()
3511 struct input_event event
;
3514 event
.kind
= buffer_switch_event
;
3515 event
.frame_or_window
= Qnil
;
3518 /* We don't need a buffer-switch event unless Emacs is waiting for input.
3519 The purpose of the event is to make read_key_sequence look up the
3520 keymaps again. If we aren't in read_key_sequence, we don't need one,
3521 and the event could cause trouble by messing up (input-pending-p). */
3522 tem
= Fwaiting_for_user_input_p ();
3526 /* We never need these events if we have no asynchronous subprocesses. */
3530 /* Make sure no interrupt happens while storing the event. */
3532 if (interrupt_input
)
3535 mask
= sigblockx (SIGIO
);
3536 kbd_buffer_store_event (&event
);
3543 kbd_buffer_store_event (&event
);
3550 /* Read any terminal input already buffered up by the system
3551 into the kbd_buffer, but do not wait.
3553 EXPECTED should be nonzero if the caller knows there is some input.
3555 Except on VMS, all input is read by this function.
3556 If interrupt_input is nonzero, this function MUST be called
3557 only when SIGIO is blocked.
3559 Returns the number of keyboard chars read, or -1 meaning
3560 this is a bad time to try to read input. */
3563 read_avail_input (expected
)
3566 struct input_event buf
[KBD_BUFFER_SIZE
];
3570 if (read_socket_hook
)
3571 /* No need for FIONREAD or fcntl; just say don't wait. */
3572 nread
= (*read_socket_hook
) (input_fd
, buf
, KBD_BUFFER_SIZE
,
3573 expected
, expected
);
3576 /* Using KBD_BUFFER_SIZE - 1 here avoids reading more than
3577 the kbd_buffer can really hold. That may prevent loss
3578 of characters on some systems when input is stuffed at us. */
3579 unsigned char cbuf
[KBD_BUFFER_SIZE
- 1];
3582 /* Determine how many characters we should *try* to read. */
3585 #else /* not WINDOWSNT */
3587 n_to_read
= dos_keysns ();
3590 #else /* not MSDOS */
3592 /* Find out how much input is available. */
3593 if (ioctl (input_fd
, FIONREAD
, &n_to_read
) < 0)
3594 /* Formerly simply reported no input, but that sometimes led to
3595 a failure of Emacs to terminate.
3596 SIGHUP seems appropriate if we can't reach the terminal. */
3597 /* ??? Is it really right to send the signal just to this process
3598 rather than to the whole process group?
3599 Perhaps on systems with FIONREAD Emacs is alone in its group. */
3600 kill (getpid (), SIGHUP
);
3603 if (n_to_read
> sizeof cbuf
)
3604 n_to_read
= sizeof cbuf
;
3605 #else /* no FIONREAD */
3606 #if defined(USG) || defined(DGUX)
3607 /* Read some input if available, but don't wait. */
3608 n_to_read
= sizeof cbuf
;
3609 fcntl (input_fd
, F_SETFL
, O_NDELAY
);
3614 #endif /* not MSDOS */
3615 #endif /* not WINDOWSNT */
3617 /* Now read; for one reason or another, this will not block.
3618 NREAD is set to the number of chars read. */
3622 cbuf
[0] = dos_keyread();
3625 nread
= read (input_fd
, cbuf
, n_to_read
);
3627 #if defined (AIX) && (! defined (aix386) && defined (_BSD))
3628 /* The kernel sometimes fails to deliver SIGHUP for ptys.
3629 This looks incorrect, but it isn't, because _BSD causes
3630 O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
3631 and that causes a value other than 0 when there is no input. */
3637 /* We used to retry the read if it was interrupted.
3638 But this does the wrong thing when O_NDELAY causes
3639 an EAGAIN error. Does anybody know of a situation
3640 where a retry is actually needed? */
3642 nread
< 0 && (errno
== EAGAIN
3656 #if defined (USG) || defined (DGUX)
3657 fcntl (input_fd
, F_SETFL
, 0);
3658 #endif /* USG or DGUX */
3659 #endif /* no FIONREAD */
3660 for (i
= 0; i
< nread
; i
++)
3662 buf
[i
].kind
= ascii_keystroke
;
3663 buf
[i
].modifiers
= 0;
3664 if (meta_key
== 1 && (cbuf
[i
] & 0x80))
3665 buf
[i
].modifiers
= meta_modifier
;
3669 buf
[i
].code
= cbuf
[i
];
3671 XSETFRAME (buf
[i
].frame_or_window
, selected_frame
);
3673 buf
[i
].frame_or_window
= Qnil
;
3678 /* Scan the chars for C-g and store them in kbd_buffer. */
3679 for (i
= 0; i
< nread
; i
++)
3681 kbd_buffer_store_event (&buf
[i
]);
3682 /* Don't look at input that follows a C-g too closely.
3683 This reduces lossage due to autorepeat on C-g. */
3684 if (buf
[i
].kind
== ascii_keystroke
3685 && buf
[i
].code
== quit_char
)
3691 #endif /* not VMS */
3693 #ifdef SIGIO /* for entire page */
3694 /* Note SIGIO has been undef'd if FIONREAD is missing. */
3697 input_available_signal (signo
)
3700 /* Must preserve main program's value of errno. */
3701 int old_errno
= errno
;
3703 extern int select_alarmed
;
3707 /* USG systems forget handlers when they are used;
3708 must reestablish each time */
3709 signal (signo
, input_available_signal
);
3716 if (input_available_clear_time
)
3717 EMACS_SET_SECS_USECS (*input_available_clear_time
, 0, 0);
3722 nread
= read_avail_input (1);
3723 /* -1 means it's not ok to read the input now.
3724 UNBLOCK_INPUT will read it later; now, avoid infinite loop.
3725 0 means there was no keyboard input available. */
3730 select_alarmed
= 1; /* Force the select emulator back to life */
3741 /* Send ourselves a SIGIO.
3743 This function exists so that the UNBLOCK_INPUT macro in
3744 blockinput.h can have some way to take care of input we put off
3745 dealing with, without assuming that every file which uses
3746 UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */
3748 reinvoke_input_signal ()
3757 /* Return the prompt-string of a sparse keymap.
3758 This is the first element which is a string.
3759 Return nil if there is none. */
3767 register Lisp_Object tem
;
3776 static void menu_bar_item ();
3777 static void menu_bar_one_keymap ();
3779 /* These variables hold the vector under construction within
3780 menu_bar_items and its subroutines, and the current index
3781 for storing into that vector. */
3782 static Lisp_Object menu_bar_items_vector
;
3783 static int menu_bar_items_index
;
3785 /* Return a vector of menu items for a menu bar, appropriate
3786 to the current buffer. Each item has three elements in the vector:
3789 OLD is an old vector we can optionally reuse, or nil. */
3792 menu_bar_items (old
)
3795 /* The number of keymaps we're scanning right now, and the number of
3796 keymaps we have allocated space for. */
3799 /* maps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
3800 in the current keymaps, or nil where it is not a prefix. */
3803 Lisp_Object def
, tem
, tail
;
3812 struct gcpro gcpro1
;
3814 /* In order to build the menus, we need to call the keymap
3815 accessors. They all call QUIT. But this function is called
3816 during redisplay, during which a quit is fatal. So inhibit
3817 quitting while building the menus.
3818 We do this instead of specbind because (1) errors will clear it anyway
3819 and (2) this avoids risk of specpdl overflow. */
3820 oquit
= Vinhibit_quit
;
3824 menu_bar_items_vector
= old
;
3826 menu_bar_items_vector
= Fmake_vector (make_number (24), Qnil
);
3827 menu_bar_items_index
= 0;
3829 GCPRO1 (menu_bar_items_vector
);
3831 /* Build our list of keymaps.
3832 If we recognize a function key and replace its escape sequence in
3833 keybuf with its symbol, or if the sequence starts with a mouse
3834 click and we need to switch buffers, we jump back here to rebuild
3835 the initial keymaps from the current buffer. */
3839 /* Should overriding-local-map apply, here? */
3840 if (!NILP (Voverriding_local_map_menu_flag
))
3842 if (NILP (Voverriding_local_map
))
3844 /* Yes, and it is nil. Use just global map. */
3846 maps
= (Lisp_Object
*) alloca (nmaps
* sizeof (maps
[0]));
3850 /* Yes, and it is non-nil. Use it and the global map. */
3852 maps
= (Lisp_Object
*) alloca (nmaps
* sizeof (maps
[0]));
3853 maps
[0] = Voverriding_local_map
;
3858 /* No, so use major and minor mode keymaps. */
3859 nmaps
= current_minor_maps (0, &tmaps
) + 2;
3860 maps
= (Lisp_Object
*) alloca (nmaps
* sizeof (maps
[0]));
3861 bcopy (tmaps
, maps
, (nmaps
- 2) * sizeof (maps
[0]));
3862 #ifdef USE_TEXT_PROPERTIES
3863 maps
[nmaps
-2] = get_local_map (PT
, current_buffer
);
3865 maps
[nmaps
-2] = current_buffer
->keymap
;
3868 maps
[nmaps
-1] = current_global_map
;
3871 /* Look up in each map the dummy prefix key `menu-bar'. */
3875 for (mapno
= nmaps
- 1; mapno
>= 0; mapno
--)
3877 if (! NILP (maps
[mapno
]))
3878 def
= get_keyelt (access_keymap (maps
[mapno
], Qmenu_bar
, 1, 0));
3882 tem
= Fkeymapp (def
);
3884 menu_bar_one_keymap (def
);
3887 /* Move to the end those items that should be at the end. */
3889 for (tail
= Vmenu_bar_final_items
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3892 int end
= menu_bar_items_index
;
3894 for (i
= 0; i
< end
; i
+= 3)
3895 if (EQ (XCONS (tail
)->car
, XVECTOR (menu_bar_items_vector
)->contents
[i
]))
3897 Lisp_Object tem0
, tem1
, tem2
;
3898 /* Move the item at index I to the end,
3899 shifting all the others forward. */
3900 tem0
= XVECTOR (menu_bar_items_vector
)->contents
[i
+ 0];
3901 tem1
= XVECTOR (menu_bar_items_vector
)->contents
[i
+ 1];
3902 tem2
= XVECTOR (menu_bar_items_vector
)->contents
[i
+ 2];
3904 bcopy (&XVECTOR (menu_bar_items_vector
)->contents
[i
+ 3],
3905 &XVECTOR (menu_bar_items_vector
)->contents
[i
],
3906 (end
- i
- 3) * sizeof (Lisp_Object
));
3907 XVECTOR (menu_bar_items_vector
)->contents
[end
- 3] = tem0
;
3908 XVECTOR (menu_bar_items_vector
)->contents
[end
- 2] = tem1
;
3909 XVECTOR (menu_bar_items_vector
)->contents
[end
- 1] = tem2
;
3914 /* Add nil, nil, nil at the end. */
3915 i
= menu_bar_items_index
;
3916 if (i
+ 3 > XVECTOR (menu_bar_items_vector
)->size
)
3919 int newsize
= 2 * i
;
3920 tem
= Fmake_vector (make_number (2 * i
), Qnil
);
3921 bcopy (XVECTOR (menu_bar_items_vector
)->contents
,
3922 XVECTOR (tem
)->contents
, i
* sizeof (Lisp_Object
));
3923 menu_bar_items_vector
= tem
;
3925 /* Add this item. */
3926 XVECTOR (menu_bar_items_vector
)->contents
[i
++] = Qnil
;
3927 XVECTOR (menu_bar_items_vector
)->contents
[i
++] = Qnil
;
3928 XVECTOR (menu_bar_items_vector
)->contents
[i
++] = Qnil
;
3929 menu_bar_items_index
= i
;
3931 Vinhibit_quit
= oquit
;
3933 return menu_bar_items_vector
;
3936 /* Scan one map KEYMAP, accumulating any menu items it defines
3937 in menu_bar_items_vector. */
3940 menu_bar_one_keymap (keymap
)
3943 Lisp_Object tail
, item
, key
, binding
, item_string
, table
;
3945 /* Loop over all keymap entries that have menu strings. */
3946 for (tail
= keymap
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
3948 item
= XCONS (tail
)->car
;
3951 key
= XCONS (item
)->car
;
3952 binding
= XCONS (item
)->cdr
;
3953 if (CONSP (binding
))
3955 item_string
= XCONS (binding
)->car
;
3956 if (STRINGP (item_string
))
3957 menu_bar_item (key
, item_string
, Fcdr (binding
));
3959 else if (EQ (binding
, Qundefined
))
3960 menu_bar_item (key
, Qnil
, binding
);
3962 else if (VECTORP (item
))
3964 /* Loop over the char values represented in the vector. */
3965 int len
= XVECTOR (item
)->size
;
3967 for (c
= 0; c
< len
; c
++)
3969 Lisp_Object character
;
3970 XSETFASTINT (character
, c
);
3971 binding
= XVECTOR (item
)->contents
[c
];
3972 if (CONSP (binding
))
3974 item_string
= XCONS (binding
)->car
;
3975 if (STRINGP (item_string
))
3976 menu_bar_item (key
, item_string
, Fcdr (binding
));
3978 else if (EQ (binding
, Qundefined
))
3979 menu_bar_item (key
, Qnil
, binding
);
3985 /* This is used as the handler when calling internal_condition_case_1. */
3988 menu_bar_item_1 (arg
)
3994 /* Add one item to menu_bar_items_vector, for KEY, ITEM_STRING and DEF.
3995 If there's already an item for KEY, add this DEF to it. */
3998 menu_bar_item (key
, item_string
, def
)
3999 Lisp_Object key
, item_string
, def
;
4002 Lisp_Object enabled
;
4005 if (EQ (def
, Qundefined
))
4007 /* If a map has an explicit `undefined' as definition,
4008 discard any previously made menu bar item. */
4010 for (i
= 0; i
< menu_bar_items_index
; i
+= 3)
4011 if (EQ (key
, XVECTOR (menu_bar_items_vector
)->contents
[i
]))
4013 if (menu_bar_items_index
> i
+ 3)
4014 bcopy (&XVECTOR (menu_bar_items_vector
)->contents
[i
+ 3],
4015 &XVECTOR (menu_bar_items_vector
)->contents
[i
],
4016 (menu_bar_items_index
- i
- 3) * sizeof (Lisp_Object
));
4017 menu_bar_items_index
-= 3;
4021 /* If there's no definition for this key yet,
4022 just ignore `undefined'. */
4026 /* See if this entry is enabled. */
4031 /* No property, or nil, means enable.
4032 Otherwise, enable if value is not nil. */
4033 tem
= Fget (def
, Qmenu_enable
);
4035 /* (condition-case nil (eval tem)
4037 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
4041 /* Ignore this item if it's not enabled. */
4045 /* Find any existing item for this KEY. */
4046 for (i
= 0; i
< menu_bar_items_index
; i
+= 3)
4047 if (EQ (key
, XVECTOR (menu_bar_items_vector
)->contents
[i
]))
4050 /* If we did not find this KEY, add it at the end. */
4051 if (i
== menu_bar_items_index
)
4053 /* If vector is too small, get a bigger one. */
4054 if (i
+ 3 > XVECTOR (menu_bar_items_vector
)->size
)
4057 int newsize
= 2 * i
;
4058 tem
= Fmake_vector (make_number (2 * i
), Qnil
);
4059 bcopy (XVECTOR (menu_bar_items_vector
)->contents
,
4060 XVECTOR (tem
)->contents
, i
* sizeof (Lisp_Object
));
4061 menu_bar_items_vector
= tem
;
4063 /* Add this item. */
4064 XVECTOR (menu_bar_items_vector
)->contents
[i
++] = key
;
4065 XVECTOR (menu_bar_items_vector
)->contents
[i
++] = item_string
;
4066 XVECTOR (menu_bar_items_vector
)->contents
[i
++] = Fcons (def
, Qnil
);
4067 menu_bar_items_index
= i
;
4069 /* We did find an item for this KEY. Add DEF to its list of maps. */
4073 old
= XVECTOR (menu_bar_items_vector
)->contents
[i
+ 2];
4074 XVECTOR (menu_bar_items_vector
)->contents
[i
+ 2] = Fcons (def
, old
);
4078 /* Read a character using menus based on maps in the array MAPS.
4079 NMAPS is the length of MAPS. Return nil if there are no menus in the maps.
4080 Return t if we displayed a menu but the user rejected it.
4082 PREV_EVENT is the previous input event, or nil if we are reading
4083 the first event of a key sequence.
4085 If USED_MOUSE_MENU is non-zero, then we set *USED_MOUSE_MENU to 1
4086 if we used a mouse menu to read the input, or zero otherwise. If
4087 USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone.
4089 The prompting is done based on the prompt-string of the map
4090 and the strings associated with various map elements.
4092 This can be done with X menus or with menus put in the minibuf.
4093 These are done in different ways, depending on how the input will be read.
4094 Menus using X are done after auto-saving in read-char, getting the input
4095 event from Fx_popup_menu; menus using the minibuf use read_char recursively
4096 and do auto-saving in the inner call of read_char. */
4099 read_char_x_menu_prompt (nmaps
, maps
, prev_event
, used_mouse_menu
)
4102 Lisp_Object prev_event
;
4103 int *used_mouse_menu
;
4106 register Lisp_Object name
;
4107 Lisp_Object rest
, vector
;
4109 if (used_mouse_menu
)
4110 *used_mouse_menu
= 0;
4112 /* Use local over global Menu maps */
4114 if (! menu_prompting
)
4117 /* Optionally disregard all but the global map. */
4118 if (inhibit_local_menu_bar_menus
)
4120 maps
+= (nmaps
- 1);
4124 /* Get the menu name from the first map that has one (a prompt string). */
4125 for (mapno
= 0; mapno
< nmaps
; mapno
++)
4127 name
= map_prompt (maps
[mapno
]);
4132 /* If we don't have any menus, just read a character normally. */
4136 #if (defined (HAVE_X_WINDOWS) && defined (HAVE_X_MENU)) || defined (MSDOS)
4137 /* If we got to this point via a mouse click,
4138 use a real menu for mouse selection. */
4139 if (EVENT_HAS_PARAMETERS (prev_event
))
4141 /* Display the menu and get the selection. */
4142 Lisp_Object
*realmaps
4143 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
4147 /* Use the maps that are not nil. */
4148 for (mapno
= 0; mapno
< nmaps
; mapno
++)
4149 if (!NILP (maps
[mapno
]))
4150 realmaps
[nmaps1
++] = maps
[mapno
];
4152 value
= Fx_popup_menu (prev_event
, Flist (nmaps1
, realmaps
));
4155 /* If we got more than one event, put all but the first
4156 onto this list to be read later.
4157 Return just the first event now. */
4158 Vunread_command_events
4159 = nconc2 (XCONS (value
)->cdr
, Vunread_command_events
);
4160 value
= XCONS (value
)->car
;
4162 else if (NILP (value
))
4164 if (used_mouse_menu
)
4165 *used_mouse_menu
= 1;
4168 #endif /* (HAVE_X_WINDOWS && HAVE_X_MENU) || MSDOS */
4173 read_char_minibuf_menu_prompt (commandflag
, nmaps
, maps
)
4179 register Lisp_Object name
;
4181 int width
= FRAME_WIDTH (selected_frame
) - 4;
4182 char *menu
= (char *) alloca (width
+ 4);
4185 Lisp_Object rest
, vector
;
4187 if (! menu_prompting
)
4190 /* Get the menu name from the first map that has one (a prompt string). */
4191 for (mapno
= 0; mapno
< nmaps
; mapno
++)
4193 name
= map_prompt (maps
[mapno
]);
4198 /* If we don't have any menus, just read a character normally. */
4202 /* Prompt string always starts with map's prompt, and a space. */
4203 strcpy (menu
, XSTRING (name
)->data
);
4204 nlength
= XSTRING (name
)->size
;
4205 menu
[nlength
++] = ':';
4206 menu
[nlength
++] = ' ';
4209 /* Start prompting at start of first map. */
4213 /* Present the documented bindings, a line at a time. */
4220 int orig_defn_macro
;
4222 /* Loop over elements of map. */
4227 /* If reached end of map, start at beginning of next map. */
4231 /* At end of last map, wrap around to first map if just starting,
4232 or end this line if already have something on it. */
4236 if (notfirst
|| nobindings
) break;
4241 /* Look at the next element of the map. */
4243 elt
= XVECTOR (vector
)->contents
[idx
];
4245 elt
= Fcar_safe (rest
);
4247 if (idx
< 0 && VECTORP (elt
))
4249 /* If we found a dense table in the keymap,
4250 advanced past it, but start scanning its contents. */
4251 rest
= Fcdr_safe (rest
);
4257 /* An ordinary element. */
4259 s
= Fcar_safe (Fcdr_safe (elt
)); /* alist */
4261 s
= Fcar_safe(elt
); /* vector */
4263 /* Ignore the element if it has no prompt string. */
4265 /* If we have room for the prompt string, add it to this line.
4266 If this is the first on the line, always add it. */
4267 else if (XSTRING (s
)->size
+ i
+ 2 < width
4272 /* Punctuate between strings. */
4275 strcpy (menu
+ i
, ", ");
4281 /* Add as much of string as fits. */
4282 thiswidth
= XSTRING (s
)->size
;
4283 if (thiswidth
+ i
> width
)
4284 thiswidth
= width
- i
;
4285 bcopy (XSTRING (s
)->data
, menu
+ i
, thiswidth
);
4291 /* If this element does not fit, end the line now,
4292 and save the element for the next line. */
4293 strcpy (menu
+ i
, "...");
4297 /* Move past this element. */
4298 if (idx
>= 0 && idx
+ 1 >= XVECTOR (vector
)->size
)
4299 /* Handle reaching end of dense table. */
4304 rest
= Fcdr_safe (rest
);
4308 /* Prompt with that and read response. */
4311 /* Make believe its not a keyboard macro in case the help char
4312 is pressed. Help characters are not recorded because menu prompting
4313 is not used on replay.
4315 orig_defn_macro
= defining_kbd_macro
;
4316 defining_kbd_macro
= 0 ;
4318 obj
= read_char (commandflag
, 0, 0, Qnil
, 0);
4319 while (BUFFERP (obj
));
4320 defining_kbd_macro
= orig_defn_macro
;
4322 if (!INTEGERP (obj
))
4327 if (! EQ (obj
, menu_prompt_more_char
)
4328 && (!INTEGERP (menu_prompt_more_char
)
4329 || ! EQ (obj
, make_number (Ctl (XINT (menu_prompt_more_char
))))))
4331 if ( defining_kbd_macro
)
4332 store_kbd_macro_char(obj
) ;
4335 /* Help char - go round again */
4339 /* Reading key sequences. */
4341 /* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
4342 in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
4343 keymap, or nil otherwise. Return the index of the first keymap in
4344 which KEY has any binding, or NMAPS if no map has a binding.
4346 If KEY is a meta ASCII character, treat it like meta-prefix-char
4347 followed by the corresponding non-meta character. Keymaps in
4348 CURRENT with non-prefix bindings for meta-prefix-char become nil in
4351 If KEY has no bindings in any of the CURRENT maps, NEXT is left
4354 NEXT may == CURRENT. */
4357 follow_key (key
, nmaps
, current
, defs
, next
)
4359 Lisp_Object
*current
, *defs
, *next
;
4362 int i
, first_binding
;
4364 /* If KEY is a meta ASCII character, treat it like meta-prefix-char
4365 followed by the corresponding non-meta character. */
4366 if (INTEGERP (key
) && (XINT (key
) & CHAR_META
))
4368 for (i
= 0; i
< nmaps
; i
++)
4369 if (! NILP (current
[i
]))
4372 get_keyelt (access_keymap (current
[i
], meta_prefix_char
, 1, 0));
4374 /* Note that since we pass the resulting bindings through
4375 get_keymap_1, non-prefix bindings for meta-prefix-char
4377 next
[i
] = get_keymap_1 (next
[i
], 0, 1);
4383 XSETINT (key
, XFASTINT (key
) & ~CHAR_META
);
4386 first_binding
= nmaps
;
4387 for (i
= nmaps
- 1; i
>= 0; i
--)
4389 if (! NILP (current
[i
]))
4391 defs
[i
] = get_keyelt (access_keymap (current
[i
], key
, 1, 0));
4392 if (! NILP (defs
[i
]))
4399 /* Given the set of bindings we've found, produce the next set of maps. */
4400 if (first_binding
< nmaps
)
4401 for (i
= 0; i
< nmaps
; i
++)
4402 next
[i
] = NILP (defs
[i
]) ? Qnil
: get_keymap_1 (defs
[i
], 0, 1);
4404 return first_binding
;
4407 /* Read a sequence of keys that ends with a non prefix character,
4408 storing it in KEYBUF, a buffer of size BUFSIZE.
4410 Return the length of the key sequence stored.
4411 Return -1 if the user rejected a command menu.
4413 Echo starting immediately unless `prompt' is 0.
4415 Where a key sequence ends depends on the currently active keymaps.
4416 These include any minor mode keymaps active in the current buffer,
4417 the current buffer's local map, and the global map.
4419 If a key sequence has no other bindings, we check Vfunction_key_map
4420 to see if some trailing subsequence might be the beginning of a
4421 function key's sequence. If so, we try to read the whole function
4422 key, and substitute its symbolic name into the key sequence.
4424 We ignore unbound `down-' mouse clicks. We turn unbound `drag-' and
4425 `double-' events into similar click events, if that would make them
4426 bound. We try to turn `triple-' events first into `double-' events,
4429 If we get a mouse click in a mode line, vertical divider, or other
4430 non-text area, we treat the click as if it were prefixed by the
4431 symbol denoting that area - `mode-line', `vertical-line', or
4434 If the sequence starts with a mouse click, we read the key sequence
4435 with respect to the buffer clicked on, not the current buffer.
4437 If the user switches frames in the midst of a key sequence, we put
4438 off the switch-frame event until later; the next call to
4439 read_char will return it. */
4442 read_key_sequence (keybuf
, bufsize
, prompt
, dont_downcase_last
)
4443 Lisp_Object
*keybuf
;
4446 int dont_downcase_last
;
4448 int count
= specpdl_ptr
- specpdl
;
4450 /* How many keys there are in the current key sequence. */
4453 /* The length of the echo buffer when we started reading, and
4454 the length of this_command_keys when we started reading. */
4458 /* The number of keymaps we're scanning right now, and the number of
4459 keymaps we have allocated space for. */
4461 int nmaps_allocated
= 0;
4463 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
4464 the current keymaps. */
4467 /* submaps[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
4468 in the current keymaps, or nil where it is not a prefix. */
4469 Lisp_Object
*submaps
;
4471 /* The local map to start out with at start of key sequence. */
4472 Lisp_Object orig_local_map
;
4474 /* 1 if we have already considered switching to the local-map property
4475 of the place where a mouse click occurred. */
4476 int localized_local_map
= 0;
4478 /* The index in defs[] of the first keymap that has a binding for
4479 this key sequence. In other words, the lowest i such that
4480 defs[i] is non-nil. */
4483 /* If t < mock_input, then KEYBUF[t] should be read as the next
4486 We use this to recover after recognizing a function key. Once we
4487 realize that a suffix of the current key sequence is actually a
4488 function key's escape sequence, we replace the suffix with the
4489 function key's binding from Vfunction_key_map. Now keybuf
4490 contains a new and different key sequence, so the echo area,
4491 this_command_keys, and the submaps and defs arrays are wrong. In
4492 this situation, we set mock_input to t, set t to 0, and jump to
4493 restart_sequence; the loop will read keys from keybuf up until
4494 mock_input, thus rebuilding the state; and then it will resume
4495 reading characters from the keyboard. */
4498 /* If the sequence is unbound in submaps[], then
4499 keybuf[fkey_start..fkey_end-1] is a prefix in Vfunction_key_map,
4500 and fkey_map is its binding.
4502 These might be > t, indicating that all function key scanning
4503 should hold off until t reaches them. We do this when we've just
4504 recognized a function key, to avoid searching for the function
4505 key's again in Vfunction_key_map. */
4506 int fkey_start
= 0, fkey_end
= 0;
4507 Lisp_Object fkey_map
;
4509 /* Likewise, for key_translation_map. */
4510 int keytran_start
= 0, keytran_end
= 0;
4511 Lisp_Object keytran_map
;
4513 /* If we receive a ``switch-frame'' event in the middle of a key sequence,
4514 we put it off for later. While we're reading, we keep the event here. */
4515 Lisp_Object delayed_switch_frame
;
4517 /* See the comment below... */
4518 #if defined (GOBBLE_FIRST_EVENT)
4519 Lisp_Object first_event
;
4522 Lisp_Object original_uppercase
;
4523 int original_uppercase_position
= -1;
4525 /* Gets around Microsoft compiler limitations. */
4528 struct buffer
*starting_buffer
;
4530 /* Nonzero if we seem to have got the beginning of a binding
4531 in function_key_map. */
4532 int function_key_possible
= 0;
4533 int key_translation_possible
= 0;
4537 last_nonmenu_event
= Qnil
;
4539 delayed_switch_frame
= Qnil
;
4540 fkey_map
= Vfunction_key_map
;
4541 keytran_map
= Vkey_translation_map
;
4543 /* If there is no function-key-map, turn off function key scanning. */
4544 if (NILP (Fkeymapp (Vfunction_key_map
)))
4545 fkey_start
= fkey_end
= bufsize
+ 1;
4547 /* If there is no key-translation-map, turn off scanning. */
4548 if (NILP (Fkeymapp (Vkey_translation_map
)))
4549 keytran_start
= keytran_end
= bufsize
+ 1;
4554 echo_prompt (XSTRING (prompt
)->data
);
4555 else if (cursor_in_echo_area
&& echo_keystrokes
)
4556 /* This doesn't put in a dash if the echo buffer is empty, so
4557 you don't always see a dash hanging out in the minibuffer. */
4561 /* Record the initial state of the echo area and this_command_keys;
4562 we will need to restore them if we replay a key sequence. */
4564 echo_start
= echo_length ();
4565 keys_start
= this_command_key_count
;
4567 #if defined (GOBBLE_FIRST_EVENT)
4568 /* This doesn't quite work, because some of the things that read_char
4569 does cannot safely be bypassed. It seems too risky to try to make
4572 /* Read the first char of the sequence specially, before setting
4573 up any keymaps, in case a filter runs and switches buffers on us. */
4574 first_event
= read_char (NILP (prompt
), 0, submaps
, last_nonmenu_event
,
4576 #endif /* GOBBLE_FIRST_EVENT */
4578 orig_local_map
= get_local_map (PT
, current_buffer
);
4580 /* We jump here when the key sequence has been thoroughly changed, and
4581 we need to rescan it starting from the beginning. When we jump here,
4582 keybuf[0..mock_input] holds the sequence we should reread. */
4585 starting_buffer
= current_buffer
;
4586 function_key_possible
= 0;
4587 key_translation_possible
= 0;
4589 /* Build our list of keymaps.
4590 If we recognize a function key and replace its escape sequence in
4591 keybuf with its symbol, or if the sequence starts with a mouse
4592 click and we need to switch buffers, we jump back here to rebuild
4593 the initial keymaps from the current buffer. */
4597 if (!NILP (Voverriding_local_map
))
4600 if (nmaps
> nmaps_allocated
)
4602 submaps
= (Lisp_Object
*) alloca (nmaps
* sizeof (submaps
[0]));
4603 defs
= (Lisp_Object
*) alloca (nmaps
* sizeof (defs
[0]));
4604 nmaps_allocated
= nmaps
;
4606 submaps
[0] = Voverriding_local_map
;
4610 nmaps
= current_minor_maps (0, &maps
) + 2;
4611 if (nmaps
> nmaps_allocated
)
4613 submaps
= (Lisp_Object
*) alloca (nmaps
* sizeof (submaps
[0]));
4614 defs
= (Lisp_Object
*) alloca (nmaps
* sizeof (defs
[0]));
4615 nmaps_allocated
= nmaps
;
4617 bcopy (maps
, submaps
, (nmaps
- 2) * sizeof (submaps
[0]));
4618 #ifdef USE_TEXT_PROPERTIES
4619 submaps
[nmaps
-2] = orig_local_map
;
4621 submaps
[nmaps
-2] = current_buffer
->keymap
;
4624 submaps
[nmaps
-1] = current_global_map
;
4627 /* Find an accurate initial value for first_binding. */
4628 for (first_binding
= 0; first_binding
< nmaps
; first_binding
++)
4629 if (! NILP (submaps
[first_binding
]))
4632 /* Start from the beginning in keybuf. */
4635 /* These are no-ops the first time through, but if we restart, they
4636 revert the echo area and this_command_keys to their original state. */
4637 this_command_key_count
= keys_start
;
4638 if (INTERACTIVE
&& t
< mock_input
)
4639 echo_truncate (echo_start
);
4641 /* If the best binding for the current key sequence is a keymap, or
4642 we may be looking at a function key's escape sequence, keep on
4644 while ((first_binding
< nmaps
&& ! NILP (submaps
[first_binding
]))
4645 || (first_binding
>= nmaps
4647 /* mock input is never part of a function key's sequence. */
4648 && mock_input
<= fkey_start
)
4649 || (first_binding
>= nmaps
4650 && keytran_start
< t
&& key_translation_possible
)
4651 /* Don't return in the middle of a possible function key sequence,
4652 if the only bindings we found were via case conversion.
4653 Thus, if ESC O a has a function-key-map translation
4654 and ESC o has a binding, don't return after ESC O,
4655 so that we can translate ESC O plus the next character. */
4659 int used_mouse_menu
= 0;
4661 /* Where the last real key started. If we need to throw away a
4662 key that has expanded into more than one element of keybuf
4663 (say, a mouse click on the mode line which is being treated
4664 as [mode-line (mouse-...)], then we backtrack to this point
4666 int last_real_key_start
;
4668 /* These variables are analogous to echo_start and keys_start;
4669 while those allow us to restart the entire key sequence,
4670 echo_local_start and keys_local_start allow us to throw away
4672 int echo_local_start
, keys_local_start
, local_first_binding
;
4675 error ("key sequence too long");
4678 echo_local_start
= echo_length ();
4679 keys_local_start
= this_command_key_count
;
4680 local_first_binding
= first_binding
;
4683 /* These are no-ops, unless we throw away a keystroke below and
4684 jumped back up to replay_key; in that case, these restore the
4685 variables to their original state, allowing us to replay the
4687 if (INTERACTIVE
&& t
< mock_input
)
4688 echo_truncate (echo_local_start
);
4689 this_command_key_count
= keys_local_start
;
4690 first_binding
= local_first_binding
;
4692 /* By default, assume each event is "real". */
4693 last_real_key_start
= t
;
4695 /* Does mock_input indicate that we are re-reading a key sequence? */
4699 add_command_key (key
);
4700 if (echo_keystrokes
)
4704 /* If not, we should actually read a character. */
4707 struct buffer
*buf
= current_buffer
;
4709 key
= read_char (NILP (prompt
), nmaps
, submaps
, last_nonmenu_event
,
4712 /* read_char returns t when it shows a menu and the user rejects it.
4717 /* read_char returns -1 at the end of a macro.
4718 Emacs 18 handles this by returning immediately with a
4719 zero, so that's what we'll do. */
4720 if (INTEGERP (key
) && XINT (key
) == -1)
4723 /* The Microsoft C compiler can't handle the goto that
4729 /* If the current buffer has been changed from under us, the
4730 keymap may have changed, so replay the sequence. */
4734 goto replay_sequence
;
4737 /* If we have a quit that was typed in another frame, and
4738 quit_throw_to_read_char switched buffers,
4739 replay to get the right keymap. */
4740 if (XINT (key
) == quit_char
&& current_buffer
!= starting_buffer
)
4745 goto replay_sequence
;
4751 /* Clicks in non-text areas get prefixed by the symbol
4752 in their CHAR-ADDRESS field. For example, a click on
4753 the mode line is prefixed by the symbol `mode-line'.
4755 Furthermore, key sequences beginning with mouse clicks
4756 are read using the keymaps of the buffer clicked on, not
4757 the current buffer. So we may have to switch the buffer
4760 When we turn one event into two events, we must make sure
4761 that neither of the two looks like the original--so that,
4762 if we replay the events, they won't be expanded again.
4763 If not for this, such reexpansion could happen either here
4764 or when user programs play with this-command-keys. */
4765 if (EVENT_HAS_PARAMETERS (key
))
4769 kind
= EVENT_HEAD_KIND (EVENT_HEAD (key
));
4770 if (EQ (kind
, Qmouse_click
))
4772 Lisp_Object window
, posn
;
4774 window
= POSN_WINDOW (EVENT_START (key
));
4775 posn
= POSN_BUFFER_POSN (EVENT_START (key
));
4778 /* We're looking at the second event of a
4779 sequence which we expanded before. Set
4780 last_real_key_start appropriately. */
4782 last_real_key_start
= t
- 1;
4785 /* Key sequences beginning with mouse clicks are
4786 read using the keymaps in the buffer clicked on,
4787 not the current buffer. If we're at the
4788 beginning of a key sequence, switch buffers. */
4789 if (last_real_key_start
== 0
4791 && BUFFERP (XWINDOW (window
)->buffer
)
4792 && XBUFFER (XWINDOW (window
)->buffer
) != current_buffer
)
4797 /* Arrange to go back to the original buffer once we're
4798 done reading the key sequence. Note that we can't
4799 use save_excursion_{save,restore} here, because they
4800 save point as well as the current buffer; we don't
4801 want to save point, because redisplay may change it,
4802 to accommodate a Fset_window_start or something. We
4803 don't want to do this at the top of the function,
4804 because we may get input from a subprocess which
4805 wants to change the selected window and stuff (say,
4807 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
4809 set_buffer_internal (XBUFFER (XWINDOW (window
)->buffer
));
4810 orig_local_map
= get_local_map (PT
, current_buffer
);
4811 goto replay_sequence
;
4813 /* For a mouse click, get the local text-property keymap
4814 of the place clicked on, rather than point. */
4815 if (last_real_key_start
== 0 && CONSP (XCONS (key
)->cdr
)
4816 && ! localized_local_map
)
4818 Lisp_Object map_here
, start
, pos
;
4820 localized_local_map
= 1;
4821 start
= EVENT_START (key
);
4822 if (CONSP (start
) && CONSP (XCONS (start
)->cdr
))
4824 pos
= POSN_BUFFER_POSN (start
);
4827 map_here
= get_local_map (XINT (pos
), current_buffer
);
4828 if (!EQ (map_here
, orig_local_map
))
4830 orig_local_map
= map_here
;
4834 goto replay_sequence
;
4840 /* Expand mode-line and scroll-bar events into two events:
4841 use posn as a fake prefix key. */
4844 if (t
+ 1 >= bufsize
)
4845 error ("key sequence too long");
4850 /* Zap the position in key, so we know that we've
4851 expanded it, and don't try to do so again. */
4852 POSN_BUFFER_POSN (EVENT_START (key
))
4853 = Fcons (posn
, Qnil
);
4857 else if (EQ (kind
, Qswitch_frame
))
4859 /* If we're at the beginning of a key sequence, go
4860 ahead and return this event. If we're in the
4861 midst of a key sequence, delay it until the end. */
4864 delayed_switch_frame
= key
;
4868 else if (CONSP (XCONS (key
)->cdr
)
4869 && CONSP (EVENT_START (key
))
4870 && CONSP (XCONS (EVENT_START (key
))->cdr
))
4874 posn
= POSN_BUFFER_POSN (EVENT_START (key
));
4875 /* Handle menu-bar events:
4876 insert the dummy prefix event `menu-bar'. */
4877 if (EQ (posn
, Qmenu_bar
))
4879 if (t
+ 1 >= bufsize
)
4880 error ("key sequence too long");
4881 /* Run the Lucid hook. */
4882 if (!NILP (Vrun_hooks
))
4883 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
4884 /* If it has changed current-menubar from previous value,
4885 really recompute the menubar from the value. */
4886 if (! NILP (Vlucid_menu_bar_dirty_flag
))
4887 call0 (Qrecompute_lucid_menubar
);
4891 /* Zap the position in key, so we know that we've
4892 expanded it, and don't try to do so again. */
4893 POSN_BUFFER_POSN (EVENT_START (key
))
4894 = Fcons (posn
, Qnil
);
4897 goto replay_sequence
;
4899 else if (CONSP (posn
))
4901 /* We're looking at the second event of a
4902 sequence which we expanded before. Set
4903 last_real_key_start appropriately. */
4904 if (last_real_key_start
== t
&& t
> 0)
4905 last_real_key_start
= t
- 1;
4910 /* We have finally decided that KEY is something we might want
4912 first_binding
= (follow_key (key
,
4913 nmaps
- first_binding
,
4914 submaps
+ first_binding
,
4915 defs
+ first_binding
,
4916 submaps
+ first_binding
)
4919 /* If KEY wasn't bound, we'll try some fallbacks. */
4920 if (first_binding
>= nmaps
)
4924 head
= EVENT_HEAD (key
);
4925 if (EQ (head
, Vhelp_char
))
4927 read_key_sequence_cmd
= Vprefix_help_command
;
4929 last_nonmenu_event
= key
;
4930 /* The Microsoft C compiler can't handle the goto that
4938 Lisp_Object breakdown
;
4941 breakdown
= parse_modifiers (head
);
4942 modifiers
= XINT (XCONS (XCONS (breakdown
)->cdr
)->car
);
4943 /* Attempt to reduce an unbound mouse event to a simpler
4944 event that is bound:
4945 Drags reduce to clicks.
4946 Double-clicks reduce to clicks.
4947 Triple-clicks reduce to double-clicks, then to clicks.
4948 Down-clicks are eliminated.
4949 Double-downs reduce to downs, then are eliminated.
4950 Triple-downs reduce to double-downs, then to downs,
4951 then are eliminated. */
4952 if (modifiers
& (down_modifier
| drag_modifier
4953 | double_modifier
| triple_modifier
))
4955 while (modifiers
& (down_modifier
| drag_modifier
4956 | double_modifier
| triple_modifier
))
4958 Lisp_Object new_head
, new_click
;
4959 if (modifiers
& triple_modifier
)
4960 modifiers
^= (double_modifier
| triple_modifier
);
4961 else if (modifiers
& double_modifier
)
4962 modifiers
&= ~double_modifier
;
4963 else if (modifiers
& drag_modifier
)
4964 modifiers
&= ~drag_modifier
;
4967 /* Dispose of this `down' event by simply jumping
4968 back to replay_key, to get another event.
4970 Note that if this event came from mock input,
4971 then just jumping back to replay_key will just
4972 hand it to us again. So we have to wipe out any
4975 We could delete keybuf[t] and shift everything
4976 after that to the left by one spot, but we'd also
4977 have to fix up any variable that points into
4978 keybuf, and shifting isn't really necessary
4981 Adding prefixes for non-textual mouse clicks
4982 creates two characters of mock input, and both
4983 must be thrown away. If we're only looking at
4984 the prefix now, we can just jump back to
4985 replay_key. On the other hand, if we've already
4986 processed the prefix, and now the actual click
4987 itself is giving us trouble, then we've lost the
4988 state of the keymaps we want to backtrack to, and
4989 we need to replay the whole sequence to rebuild
4992 Beyond that, only function key expansion could
4993 create more than two keys, but that should never
4994 generate mouse events, so it's okay to zero
4995 mock_input in that case too.
4997 Isn't this just the most wonderful code ever? */
4998 if (t
== last_real_key_start
)
5005 mock_input
= last_real_key_start
;
5006 goto replay_sequence
;
5011 = apply_modifiers (modifiers
, XCONS (breakdown
)->car
);
5013 = Fcons (new_head
, Fcons (EVENT_START (key
), Qnil
));
5015 /* Look for a binding for this new key. follow_key
5016 promises that it didn't munge submaps the
5017 last time we called it, since key was unbound. */
5019 = (follow_key (new_click
,
5020 nmaps
- local_first_binding
,
5021 submaps
+ local_first_binding
,
5022 defs
+ local_first_binding
,
5023 submaps
+ local_first_binding
)
5024 + local_first_binding
);
5026 /* If that click is bound, go for it. */
5027 if (first_binding
< nmaps
)
5032 /* Otherwise, we'll leave key set to the drag event. */
5039 /* Normally, last_nonmenu_event gets the previous key we read.
5040 But when a mouse popup menu is being used,
5041 we don't update last_nonmenu_event; it continues to hold the mouse
5042 event that preceded the first level of menu. */
5043 if (!used_mouse_menu
)
5044 last_nonmenu_event
= key
;
5046 /* If the sequence is unbound, see if we can hang a function key
5047 off the end of it. We only want to scan real keyboard input
5048 for function key sequences, so if mock_input says that we're
5049 re-reading old events, don't examine it. */
5050 if (first_binding
>= nmaps
5053 Lisp_Object fkey_next
;
5055 /* Continue scan from fkey_end until we find a bound suffix.
5056 If we fail, increment fkey_start
5057 and start fkey_end from there. */
5058 while (fkey_end
< t
)
5062 key
= keybuf
[fkey_end
++];
5063 /* Look up meta-characters by prefixing them
5064 with meta_prefix_char. I hate this. */
5065 if (INTEGERP (key
) && XINT (key
) & meta_modifier
)
5070 (access_keymap (fkey_map
, meta_prefix_char
, 1, 0)),
5072 XSETFASTINT (key
, XFASTINT (key
) & ~meta_modifier
);
5075 fkey_next
= fkey_map
;
5078 = get_keyelt (access_keymap (fkey_next
, key
, 1, 0));
5080 #if 0 /* I didn't turn this on, because it might cause trouble
5081 for the mapping of return into C-m and tab into C-i. */
5082 /* Optionally don't map function keys into other things.
5083 This enables the user to redefine kp- keys easily. */
5084 if (SYMBOLP (key
) && !NILP (Vinhibit_function_key_mapping
))
5088 /* If the function key map gives a function, not an
5089 array, then call the function with no args and use
5090 its value instead. */
5091 if (SYMBOLP (fkey_next
) && ! NILP (Ffboundp (fkey_next
))
5094 struct gcpro gcpro1
, gcpro2
, gcpro3
;
5098 GCPRO3 (fkey_map
, keytran_map
, delayed_switch_frame
);
5099 fkey_next
= call1 (fkey_next
, prompt
);
5101 /* If the function returned something invalid,
5102 barf--don't ignore it.
5103 (To ignore it safely, we would need to gcpro a bunch of
5104 other variables.) */
5105 if (! (VECTORP (fkey_next
) || STRINGP (fkey_next
)))
5106 error ("Function in function-key-map returns invalid key sequence");
5109 function_key_possible
= ! NILP (fkey_next
);
5111 /* If keybuf[fkey_start..fkey_end] is bound in the
5112 function key map and it's a suffix of the current
5113 sequence (i.e. fkey_end == t), replace it with
5114 the binding and restart with fkey_start at the end. */
5115 if ((VECTORP (fkey_next
) || STRINGP (fkey_next
))
5118 int len
= XFASTINT (Flength (fkey_next
));
5120 t
= fkey_start
+ len
;
5122 error ("key sequence too long");
5124 if (VECTORP (fkey_next
))
5125 bcopy (XVECTOR (fkey_next
)->contents
,
5126 keybuf
+ fkey_start
,
5127 (t
- fkey_start
) * sizeof (keybuf
[0]));
5128 else if (STRINGP (fkey_next
))
5132 for (i
= 0; i
< len
; i
++)
5133 XSETFASTINT (keybuf
[fkey_start
+ i
],
5134 XSTRING (fkey_next
)->data
[i
]);
5138 fkey_start
= fkey_end
= t
;
5139 fkey_map
= Vfunction_key_map
;
5141 /* Do pass the results through key-translation-map. */
5142 keytran_start
= keytran_end
= 0;
5143 keytran_map
= Vkey_translation_map
;
5145 goto replay_sequence
;
5148 fkey_map
= get_keymap_1 (fkey_next
, 0, 1);
5150 /* If we no longer have a bound suffix, try a new positions for
5152 if (NILP (fkey_map
))
5154 fkey_end
= ++fkey_start
;
5155 fkey_map
= Vfunction_key_map
;
5156 function_key_possible
= 0;
5161 /* Look for this sequence in key-translation-map. */
5163 Lisp_Object keytran_next
;
5165 /* Scan from keytran_end until we find a bound suffix. */
5166 while (keytran_end
< t
)
5170 key
= keybuf
[keytran_end
++];
5171 /* Look up meta-characters by prefixing them
5172 with meta_prefix_char. I hate this. */
5173 if (INTEGERP (key
) && XINT (key
) & meta_modifier
)
5178 (access_keymap (keytran_map
, meta_prefix_char
, 1, 0)),
5180 XSETFASTINT (key
, XFASTINT (key
) & ~meta_modifier
);
5183 keytran_next
= keytran_map
;
5186 = get_keyelt (access_keymap (keytran_next
, key
, 1, 0));
5188 /* If the key translation map gives a function, not an
5189 array, then call the function with no args and use
5190 its value instead. */
5191 if (SYMBOLP (keytran_next
) && ! NILP (Ffboundp (keytran_next
))
5192 && keytran_end
== t
)
5194 struct gcpro gcpro1
, gcpro2
, gcpro3
;
5198 GCPRO3 (fkey_map
, keytran_map
, delayed_switch_frame
);
5199 keytran_next
= call1 (keytran_next
, prompt
);
5201 /* If the function returned something invalid,
5202 barf--don't ignore it.
5203 (To ignore it safely, we would need to gcpro a bunch of
5204 other variables.) */
5205 if (! (VECTORP (keytran_next
) || STRINGP (keytran_next
)))
5206 error ("Function in key-translation-map returns invalid key sequence");
5209 key_translation_possible
= ! NILP (keytran_next
);
5211 /* If keybuf[keytran_start..keytran_end] is bound in the
5212 key translation map and it's a suffix of the current
5213 sequence (i.e. keytran_end == t), replace it with
5214 the binding and restart with keytran_start at the end. */
5215 if ((VECTORP (keytran_next
) || STRINGP (keytran_next
))
5216 && keytran_end
== t
)
5218 int len
= XFASTINT (Flength (keytran_next
));
5220 t
= keytran_start
+ len
;
5222 error ("key sequence too long");
5224 if (VECTORP (keytran_next
))
5225 bcopy (XVECTOR (keytran_next
)->contents
,
5226 keybuf
+ keytran_start
,
5227 (t
- keytran_start
) * sizeof (keybuf
[0]));
5228 else if (STRINGP (keytran_next
))
5232 for (i
= 0; i
< len
; i
++)
5233 XSETFASTINT (keybuf
[keytran_start
+ i
],
5234 XSTRING (keytran_next
)->data
[i
]);
5238 keytran_start
= keytran_end
= t
;
5239 keytran_map
= Vkey_translation_map
;
5241 /* Don't pass the results of key-translation-map
5242 through function-key-map. */
5243 fkey_start
= fkey_end
= t
;
5244 fkey_map
= Vkey_translation_map
;
5246 goto replay_sequence
;
5249 keytran_map
= get_keymap_1 (keytran_next
, 0, 1);
5251 /* If we no longer have a bound suffix, try a new positions for
5253 if (NILP (keytran_map
))
5255 keytran_end
= ++keytran_start
;
5256 keytran_map
= Vkey_translation_map
;
5257 key_translation_possible
= 0;
5262 /* If KEY is not defined in any of the keymaps,
5263 and cannot be part of a function key or translation,
5264 and is an upper case letter
5265 use the corresponding lower-case letter instead. */
5266 if (first_binding
== nmaps
&& ! function_key_possible
5267 && ! key_translation_possible
5269 && ((((XINT (key
) & 0x3ffff)
5270 < XSTRING (current_buffer
->downcase_table
)->size
)
5271 && UPPERCASEP (XINT (key
) & 0x3ffff))
5272 || (XINT (key
) & shift_modifier
)))
5274 original_uppercase
= key
;
5275 original_uppercase_position
= t
- 1;
5277 if (XINT (key
) & shift_modifier
)
5278 XSETINT (key
, XINT (key
) & ~shift_modifier
);
5280 XSETINT (key
, (DOWNCASE (XINT (key
) & 0x3ffff)
5281 | (XINT (key
) & ~0x3ffff)));
5283 keybuf
[t
- 1] = key
;
5285 goto replay_sequence
;
5287 /* If KEY is not defined in any of the keymaps,
5288 and cannot be part of a function key or translation,
5289 and is a shifted function key,
5290 use the corresponding unshifted function key instead. */
5291 if (first_binding
== nmaps
&& ! function_key_possible
5292 && ! key_translation_possible
5295 Lisp_Object breakdown
;
5298 original_uppercase
= key
;
5299 original_uppercase_position
= t
- 1;
5301 breakdown
= parse_modifiers (key
);
5302 modifiers
= XINT (XCONS (XCONS (breakdown
)->cdr
)->car
);
5303 if (modifiers
& shift_modifier
)
5305 modifiers
&= ~shift_modifier
;
5306 key
= apply_modifiers (make_number (modifiers
),
5307 XCONS (breakdown
)->car
);
5309 keybuf
[t
- 1] = key
;
5311 goto replay_sequence
;
5317 read_key_sequence_cmd
= (first_binding
< nmaps
5318 ? defs
[first_binding
]
5321 unread_switch_frame
= delayed_switch_frame
;
5322 unbind_to (count
, Qnil
);
5324 if (dont_downcase_last
&& t
- 1 == original_uppercase_position
)
5325 keybuf
[t
- 1] = original_uppercase
;
5327 /* Occasionally we fabricate events, perhaps by expanding something
5328 according to function-key-map, or by adding a prefix symbol to a
5329 mouse click in the scroll bar or modeline. In this cases, return
5330 the entire generated key sequence, even if we hit an unbound
5331 prefix or a definition before the end. This means that you will
5332 be able to push back the event properly, and also means that
5333 read-key-sequence will always return a logical unit.
5336 for (; t
< mock_input
; t
++)
5338 if (echo_keystrokes
)
5339 echo_char (keybuf
[t
]);
5340 add_command_key (keybuf
[t
]);
5346 #if 0 /* This doc string is too long for some compilers.
5347 This commented-out definition serves for DOC. */
5348 DEFUN ("read-key-sequence", Fread_key_sequence
, Sread_key_sequence
, 1, 2, 0,
5349 "Read a sequence of keystrokes and return as a string or vector.\n\
5350 The sequence is sufficient to specify a non-prefix command in the\n\
5351 current local and global maps.\n\
5353 First arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
5354 Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echos\n\
5355 as a continuation of the previous key.\n\
5357 The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not\n\
5358 convert the last event to lower case. (Normally any upper case event\n\
5359 is converted to lower case if the original event is undefined and the lower\n\
5360 case equivalent is defined.) A non-nil value is appropriate for reading\n\
5361 a key sequence to be defined.\n\
5363 A C-g typed while in this function is treated like any other character,\n\
5364 and `quit-flag' is not set.\n\
5366 If the key sequence starts with a mouse click, then the sequence is read\n\
5367 using the keymaps of the buffer of the window clicked in, not the buffer\n\
5368 of the selected window as normal.\n\
5370 `read-key-sequence' drops unbound button-down events, since you normally\n\
5371 only care about the click or drag events which follow them. If a drag\n\
5372 or multi-click event is unbound, but the corresponding click event would\n\
5373 be bound, `read-key-sequence' turns the event into a click event at the\n\
5374 drag's starting position. This means that you don't have to distinguish\n\
5375 between click and drag, double, or triple events unless you want to.\n\
5377 `read-key-sequence' prefixes mouse events on mode lines, the vertical\n\
5378 lines separating windows, and scroll bars with imaginary keys\n\
5379 `mode-line', `vertical-line', and `vertical-scroll-bar'.\n\
5381 If the user switches frames in the middle of a key sequence, the\n\
5382 frame-switch event is put off until after the current key sequence.\n\
5384 `read-key-sequence' checks `function-key-map' for function key\n\
5385 sequences, where they wouldn't conflict with ordinary bindings. See\n\
5386 `function-key-map' for more details.")
5387 (prompt
, continue_echo
)
5390 DEFUN ("read-key-sequence", Fread_key_sequence
, Sread_key_sequence
, 1, 3, 0,
5392 (prompt
, continue_echo
, dont_downcase_last
)
5393 Lisp_Object prompt
, continue_echo
, dont_downcase_last
;
5395 Lisp_Object keybuf
[30];
5397 struct gcpro gcpro1
, gcpro2
;
5400 CHECK_STRING (prompt
, 0);
5403 bzero (keybuf
, sizeof keybuf
);
5405 gcpro1
.nvars
= (sizeof keybuf
/sizeof (keybuf
[0]));
5407 if (NILP (continue_echo
))
5408 this_command_key_count
= 0;
5410 i
= read_key_sequence (keybuf
, (sizeof keybuf
/sizeof (keybuf
[0])),
5411 prompt
, ! NILP (dont_downcase_last
));
5419 return make_event_array (i
, keybuf
);
5422 DEFUN ("command-execute", Fcommand_execute
, Scommand_execute
, 1, 2, 0,
5423 "Execute CMD as an editor command.\n\
5424 CMD must be a symbol that satisfies the `commandp' predicate.\n\
5425 Optional second arg RECORD-FLAG non-nil\n\
5426 means unconditionally put this command in `command-history'.\n\
5427 Otherwise, that is done only if an arg is read using the minibuffer.")
5429 Lisp_Object cmd
, record
;
5431 register Lisp_Object final
;
5432 register Lisp_Object tem
;
5433 Lisp_Object prefixarg
;
5434 struct backtrace backtrace
;
5435 extern int debug_on_next_call
;
5437 prefixarg
= current_perdisplay
->Vprefix_arg
;
5438 current_perdisplay
->Vprefix_arg
= Qnil
;
5439 current_perdisplay
->Vcurrent_prefix_arg
= prefixarg
;
5440 debug_on_next_call
= 0;
5444 tem
= Fget (cmd
, Qdisabled
);
5445 if (!NILP (tem
) && !NILP (Vrun_hooks
))
5446 return call1 (Vrun_hooks
, Qdisabled_command_hook
);
5451 final
= Findirect_function (cmd
);
5453 if (CONSP (final
) && (tem
= Fcar (final
), EQ (tem
, Qautoload
)))
5454 do_autoload (final
, cmd
);
5459 if (STRINGP (final
) || VECTORP (final
))
5461 /* If requested, place the macro in the command history. For
5462 other sorts of commands, call-interactively takes care of
5466 = Fcons (Fcons (Qexecute_kbd_macro
,
5467 Fcons (final
, Fcons (prefixarg
, Qnil
))),
5470 return Fexecute_kbd_macro (final
, prefixarg
);
5472 if (CONSP (final
) || SUBRP (final
) || COMPILEDP (final
))
5474 backtrace
.next
= backtrace_list
;
5475 backtrace_list
= &backtrace
;
5476 backtrace
.function
= &Qcall_interactively
;
5477 backtrace
.args
= &cmd
;
5478 backtrace
.nargs
= 1;
5479 backtrace
.evalargs
= 0;
5481 tem
= Fcall_interactively (cmd
, record
);
5483 backtrace_list
= backtrace
.next
;
5489 DEFUN ("execute-extended-command", Fexecute_extended_command
, Sexecute_extended_command
,
5491 "Read function name, then read its arguments and call it.")
5493 Lisp_Object prefixarg
;
5495 Lisp_Object function
;
5497 Lisp_Object saved_keys
;
5498 struct gcpro gcpro1
;
5500 saved_keys
= Fvector (this_command_key_count
,
5501 XVECTOR (this_command_keys
)->contents
);
5503 GCPRO1 (saved_keys
);
5505 if (EQ (prefixarg
, Qminus
))
5507 else if (CONSP (prefixarg
) && XINT (XCONS (prefixarg
)->car
) == 4)
5508 strcpy (buf
, "C-u ");
5509 else if (CONSP (prefixarg
) && INTEGERP (XCONS (prefixarg
)->car
))
5510 sprintf (buf
, "%d ", XINT (XCONS (prefixarg
)->car
));
5511 else if (INTEGERP (prefixarg
))
5512 sprintf (buf
, "%d ", XINT (prefixarg
));
5514 /* This isn't strictly correct if execute-extended-command
5515 is bound to anything else. Perhaps it should use
5516 this_command_keys? */
5517 strcat (buf
, "M-x ");
5519 /* Prompt with buf, and then read a string, completing from and
5520 restricting to the set of all defined commands. Don't provide
5521 any initial input. Save the command read on the extended-command
5523 function
= Fcompleting_read (build_string (buf
),
5524 Vobarray
, Qcommandp
,
5525 Qt
, Qnil
, Qextended_command_history
);
5527 /* Set this_command_keys to the concatenation of saved_keys and
5528 function, followed by a RET. */
5530 struct Lisp_String
*str
;
5535 this_command_key_count
= 0;
5537 keys
= XVECTOR (saved_keys
)->contents
;
5538 for (i
= 0; i
< XVECTOR (saved_keys
)->size
; i
++)
5539 add_command_key (keys
[i
]);
5541 str
= XSTRING (function
);
5542 for (i
= 0; i
< str
->size
; i
++)
5544 XSETFASTINT (tem
, str
->data
[i
]);
5545 add_command_key (tem
);
5548 XSETFASTINT (tem
, '\015');
5549 add_command_key (tem
);
5554 function
= Fintern (function
, Qnil
);
5555 current_perdisplay
->Vprefix_arg
= prefixarg
;
5556 this_command
= function
;
5558 return Fcommand_execute (function
, Qt
);
5562 detect_input_pending ()
5565 get_input_pending (&input_pending
);
5567 return input_pending
;
5570 /* This is called in some cases before a possible quit.
5571 It cases the next call to detect_input_pending to recompute input_pending.
5572 So calling this function unnecessarily can't do any harm. */
5573 clear_input_pending ()
5578 DEFUN ("input-pending-p", Finput_pending_p
, Sinput_pending_p
, 0, 0, 0,
5579 "T if command input is currently available with no waiting.\n\
5580 Actually, the value is nil only if we can be sure that no input is available.")
5583 if (!NILP (Vunread_command_events
) || unread_command_char
!= -1)
5586 return detect_input_pending () ? Qt
: Qnil
;
5589 DEFUN ("recent-keys", Frecent_keys
, Srecent_keys
, 0, 0, 0,
5590 "Return vector of last 100 events, not counting those from keyboard macros.")
5593 Lisp_Object
*keys
= XVECTOR (recent_keys
)->contents
;
5596 if (total_keys
< NUM_RECENT_KEYS
)
5597 return Fvector (total_keys
, keys
);
5600 val
= Fvector (NUM_RECENT_KEYS
, keys
);
5601 bcopy (keys
+ recent_keys_index
,
5602 XVECTOR (val
)->contents
,
5603 (NUM_RECENT_KEYS
- recent_keys_index
) * sizeof (Lisp_Object
));
5605 XVECTOR (val
)->contents
+ NUM_RECENT_KEYS
- recent_keys_index
,
5606 recent_keys_index
* sizeof (Lisp_Object
));
5611 DEFUN ("this-command-keys", Fthis_command_keys
, Sthis_command_keys
, 0, 0, 0,
5612 "Return the key sequence that invoked this command.\n\
5613 The value is a string or a vector.")
5616 return make_event_array (this_command_key_count
,
5617 XVECTOR (this_command_keys
)->contents
);
5620 DEFUN ("recursion-depth", Frecursion_depth
, Srecursion_depth
, 0, 0, 0,
5621 "Return the current depth in recursive edits.")
5625 XSETFASTINT (temp
, command_loop_level
+ minibuf_level
);
5629 DEFUN ("open-dribble-file", Fopen_dribble_file
, Sopen_dribble_file
, 1, 1,
5630 "FOpen dribble file: ",
5631 "Start writing all keyboard characters to a dribble file called FILE.\n\
5632 If FILE is nil, close any open dribble file.")
5646 file
= Fexpand_file_name (file
, Qnil
);
5647 dribble
= fopen (XSTRING (file
)->data
, "w");
5652 DEFUN ("discard-input", Fdiscard_input
, Sdiscard_input
, 0, 0, 0,
5653 "Discard the contents of the terminal input buffer.\n\
5654 Also cancel any kbd macro being defined.")
5657 defining_kbd_macro
= 0;
5658 update_mode_lines
++;
5660 Vunread_command_events
= Qnil
;
5661 unread_command_char
= -1;
5663 discard_tty_input ();
5665 /* Without the cast, GCC complains that this assignment loses the
5666 volatile qualifier of kbd_store_ptr. Is there anything wrong
5668 current_perdisplay
->kbd_fetch_ptr
5669 = (struct input_event
*) current_perdisplay
->kbd_store_ptr
;
5670 Ffillarray (current_perdisplay
->kbd_buffer_frame_or_window
, Qnil
);
5676 DEFUN ("suspend-emacs", Fsuspend_emacs
, Ssuspend_emacs
, 0, 1, "",
5677 "Stop Emacs and return to superior process. You can resume later.\n\
5678 If `cannot-suspend' is non-nil, or if the system doesn't support job\n\
5679 control, run a subshell instead.\n\n\
5680 If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
5681 to be read as terminal input by Emacs's parent, after suspension.\n\
5683 Before suspending, run the normal hook `suspend-hook'.\n\
5684 After resumption run the normal hook `suspend-resume-hook'.\n\
5686 Some operating systems cannot stop the Emacs process and resume it later.\n\
5687 On such systems, Emacs starts a subshell instead of suspending.")
5689 Lisp_Object stuffstring
;
5692 int count
= specpdl_ptr
- specpdl
;
5693 int old_height
, old_width
;
5695 struct gcpro gcpro1
, gcpro2
;
5696 extern init_sys_modes ();
5698 if (!NILP (stuffstring
))
5699 CHECK_STRING (stuffstring
, 0);
5701 /* Run the functions in suspend-hook. */
5702 if (!NILP (Vrun_hooks
))
5703 call1 (Vrun_hooks
, intern ("suspend-hook"));
5705 GCPRO1 (stuffstring
);
5706 get_frame_size (&old_width
, &old_height
);
5708 /* sys_suspend can get an error if it tries to fork a subshell
5709 and the system resources aren't available for that. */
5710 record_unwind_protect (init_sys_modes
, 0);
5711 stuff_buffered_input (stuffstring
);
5716 unbind_to (count
, Qnil
);
5718 /* Check if terminal/window size has changed.
5719 Note that this is not useful when we are running directly
5720 with a window system; but suspend should be disabled in that case. */
5721 get_frame_size (&width
, &height
);
5722 if (width
!= old_width
|| height
!= old_height
)
5723 change_frame_size (selected_frame
, height
, width
, 0, 0);
5725 /* Run suspend-resume-hook. */
5726 if (!NILP (Vrun_hooks
))
5727 call1 (Vrun_hooks
, intern ("suspend-resume-hook"));
5733 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
5734 Then in any case stuff anything Emacs has read ahead and not used. */
5736 stuff_buffered_input (stuffstring
)
5737 Lisp_Object stuffstring
;
5739 /* stuff_char works only in BSD, versions 4.2 and up. */
5742 register unsigned char *p
;
5745 if (STRINGP (stuffstring
))
5749 p
= XSTRING (stuffstring
)->data
;
5750 count
= XSTRING (stuffstring
)->size
;
5755 /* Anything we have read ahead, put back for the shell to read. */
5756 #ifndef MULTI_PERDISPLAY
5757 perd
= &the_only_perdisplay
;
5759 /* ?? What should this do when we have multiple keyboards?? */
5760 perd
= current_perdisplay
;
5764 while (perd
->kbd_fetch_ptr
!= perd
->kbd_store_ptr
)
5766 if (perd
->kbd_fetch_ptr
== perd
->kbd_buffer
+ KBD_BUFFER_SIZE
)
5767 perd
->kbd_fetch_ptr
= perd
->kbd_buffer
;
5768 if (perd
->kbd_fetch_ptr
->kind
== ascii_keystroke
)
5769 stuff_char (perd
->kbd_fetch_ptr
->code
);
5770 perd
->kbd_fetch_ptr
->kind
= no_event
;
5771 (XVECTOR (perd
->kbd_buffer_frame_or_window
)->contents
[perd
->kbd_fetch_ptr
5774 perd
->kbd_fetch_ptr
++;
5778 #endif /* BSD and not BSD4_1 */
5781 set_waiting_for_input (time_to_clear
)
5782 EMACS_TIME
*time_to_clear
;
5784 input_available_clear_time
= time_to_clear
;
5786 /* Tell interrupt_signal to throw back to read_char, */
5787 waiting_for_input
= 1;
5789 /* If interrupt_signal was called before and buffered a C-g,
5790 make it run again now, to avoid timing error. */
5791 if (!NILP (Vquit_flag
))
5792 quit_throw_to_read_char ();
5795 clear_waiting_for_input ()
5797 /* Tell interrupt_signal not to throw back to read_char, */
5798 waiting_for_input
= 0;
5799 input_available_clear_time
= 0;
5802 /* This routine is called at interrupt level in response to C-G.
5803 If interrupt_input, this is the handler for SIGINT.
5804 Otherwise, it is called from kbd_buffer_store_event,
5805 in handling SIGIO or SIGTINT.
5807 If `waiting_for_input' is non zero, then unless `echoing' is nonzero,
5808 immediately throw back to read_char.
5810 Otherwise it sets the Lisp variable quit-flag not-nil.
5811 This causes eval to throw, when it gets a chance.
5812 If quit-flag is already non-nil, it stops the job right away. */
5818 /* Must preserve main program's value of errno. */
5819 int old_errno
= errno
;
5822 if (!read_socket_hook
&& NILP (Vwindow_system
))
5824 /* USG systems forget handlers when they are used;
5825 must reestablish each time */
5826 signal (SIGINT
, interrupt_signal
);
5827 signal (SIGQUIT
, interrupt_signal
);
5833 if (!NILP (Vquit_flag
) && FRAME_TERMCAP_P (selected_frame
))
5838 #ifdef SIGTSTP /* Support possible in later USG versions */
5840 * On systems which can suspend the current process and return to the original
5841 * shell, this command causes the user to end up back at the shell.
5842 * The "Auto-save" and "Abort" questions are not asked until
5843 * the user elects to return to emacs, at which point he can save the current
5844 * job and either dump core or continue.
5849 if (sys_suspend () == -1)
5851 printf ("Not running as a subprocess;\n");
5852 printf ("you can continue or abort.\n");
5855 /* Perhaps should really fork an inferior shell?
5856 But that would not provide any way to get back
5857 to the original shell, ever. */
5858 printf ("No support for stopping a process on this operating system;\n");
5859 printf ("you can continue or abort.\n");
5860 #endif /* not VMS */
5861 #endif /* not SIGTSTP */
5863 /* We must remain inside the screen area when the internal terminal
5864 is used. Note that [Enter] is not echoed by dos. */
5867 printf ("Auto-save? (y or n) ");
5869 if (((c
= getchar ()) & ~040) == 'Y')
5871 Fdo_auto_save (Qt
, Qnil
);
5873 printf ("\r\nAuto-save done");
5874 #else /* not MSDOS */
5875 printf ("Auto-save done\n");
5876 #endif /* not MSDOS */
5878 while (c
!= '\n') c
= getchar ();
5880 printf ("\r\nAbort? (y or n) ");
5881 #else /* not MSDOS */
5883 printf ("Abort (and enter debugger)? (y or n) ");
5885 printf ("Abort (and dump core)? (y or n) ");
5886 #endif /* not VMS */
5887 #endif /* not MSDOS */
5889 if (((c
= getchar ()) & ~040) == 'Y')
5891 while (c
!= '\n') c
= getchar ();
5893 printf ("\r\nContinuing...\r\n");
5894 #else /* not MSDOS */
5895 printf ("Continuing...\n");
5896 #endif /* not MSDOS */
5902 /* If executing a function that wants to be interrupted out of
5903 and the user has not deferred quitting by binding `inhibit-quit'
5904 then quit right away. */
5905 if (immediate_quit
&& NILP (Vinhibit_quit
))
5909 Fsignal (Qquit
, Qnil
);
5912 /* Else request quit when it's safe */
5916 if (waiting_for_input
&& !echoing
)
5917 quit_throw_to_read_char ();
5922 /* Handle a C-g by making read_char return C-g. */
5924 quit_throw_to_read_char ()
5926 quit_error_check ();
5928 /* Prevent another signal from doing this before we finish. */
5929 clear_waiting_for_input ();
5932 Vunread_command_events
= Qnil
;
5933 unread_command_char
= -1;
5935 #ifdef POLL_FOR_INPUT
5936 /* May be > 1 if in recursive minibuffer. */
5937 if (poll_suppress_count
== 0)
5941 if (FRAMEP (internal_last_event_frame
)
5942 && XFRAME (internal_last_event_frame
) != selected_frame
)
5943 Fhandle_switch_frame (make_lispy_switch_frame (internal_last_event_frame
));
5946 _longjmp (getcjmp
, 1);
5949 DEFUN ("set-input-mode", Fset_input_mode
, Sset_input_mode
, 3, 4, 0,
5950 "Set mode of reading keyboard input.\n\
5951 First arg INTERRUPT non-nil means use input interrupts;\n\
5952 nil means use CBREAK mode.\n\
5953 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal\n\
5954 (no effect except in CBREAK mode).\n\
5955 Third arg META t means accept 8-bit input (for a Meta key).\n\
5956 META nil means ignore the top bit, on the assumption it is parity.\n\
5957 Otherwise, accept 8-bit input and don't use the top bit for Meta.\n\
5958 Optional fourth arg QUIT if non-nil specifies character to use for quitting.\n\
5959 See also `current-input-mode'.")
5960 (interrupt
, flow
, meta
, quit
)
5961 Lisp_Object interrupt
, flow
, meta
, quit
;
5964 && (!INTEGERP (quit
) || XINT (quit
) < 0 || XINT (quit
) > 0400))
5965 error ("set-input-mode: QUIT must be an ASCII character");
5967 #ifdef POLL_FOR_INPUT
5973 /* Note SIGIO has been undef'd if FIONREAD is missing. */
5974 #ifdef NO_SOCK_SIGIO
5975 if (read_socket_hook
)
5976 interrupt_input
= 0; /* No interrupts if reading from a socket. */
5978 #endif /* NO_SOCK_SIGIO */
5979 interrupt_input
= !NILP (interrupt
);
5980 #else /* not SIGIO */
5981 interrupt_input
= 0;
5982 #endif /* not SIGIO */
5983 /* Our VMS input only works by interrupts, as of now. */
5985 interrupt_input
= 1;
5987 flow_control
= !NILP (flow
);
5990 else if (EQ (meta
, Qt
))
5995 /* Don't let this value be out of range. */
5996 quit_char
= XINT (quit
) & (meta_key
? 0377 : 0177);
6000 #ifdef POLL_FOR_INPUT
6001 poll_suppress_count
= 1;
6007 DEFUN ("current-input-mode", Fcurrent_input_mode
, Scurrent_input_mode
, 0, 0, 0,
6008 "Return information about the way Emacs currently reads keyboard input.\n\
6009 The value is a list of the form (INTERRUPT FLOW META QUIT), where\n\
6010 INTERRUPT is non-nil if Emacs is using interrupt-driven input; if\n\
6011 nil, Emacs is using CBREAK mode.\n\
6012 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the\n\
6013 terminal; this does not apply if Emacs uses interrupt-driven input.\n\
6014 META is t if accepting 8-bit input with 8th bit as Meta flag.\n\
6015 META nil means ignoring the top bit, on the assumption it is parity.\n\
6016 META is neither t nor nil if accepting 8-bit input and using\n\
6017 all 8 bits as the character code.\n\
6018 QUIT is the character Emacs currently uses to quit.\n\
6019 The elements of this list correspond to the arguments of\n\
6025 val
[0] = interrupt_input
? Qt
: Qnil
;
6026 val
[1] = flow_control
? Qt
: Qnil
;
6027 val
[2] = meta_key
== 2 ? make_number (0) : meta_key
== 1 ? Qt
: Qnil
;
6028 XSETFASTINT (val
[3], quit_char
);
6030 return Flist (sizeof (val
) / sizeof (val
[0]), val
);
6035 * Set up a perdisplay object with reasonable initial values.
6038 init_perdisplay (perd
)
6041 perd
->Vprefix_arg
= Qnil
;
6042 perd
->Vcurrent_prefix_arg
= Qnil
;
6044 = (struct input_event
*)xmalloc (KBD_BUFFER_SIZE
6045 * sizeof (struct input_event
));
6046 perd
->kbd_fetch_ptr
= perd
->kbd_buffer
;
6047 perd
->kbd_store_ptr
= perd
->kbd_buffer
;
6048 perd
->kbd_buffer_frame_or_window
6049 = Fmake_vector (make_number (KBD_BUFFER_SIZE
), Qnil
);
6053 * Destroy the contents of a perdisplay object, but not the object itself.
6054 * We use this just before deleteing it, or if we're going to initialize
6058 wipe_perdisplay (perd
)
6061 xfree (perd
->kbd_buffer
);
6066 /* This is correct before outermost invocation of the editor loop */
6067 command_loop_level
= -1;
6069 quit_char
= Ctl ('g');
6070 Vunread_command_events
= Qnil
;
6071 unread_command_char
= -1;
6073 recent_keys_index
= 0;
6075 do_mouse_tracking
= Qnil
;
6080 /* This means that command_loop_1 won't try to select anything the first
6082 internal_last_event_frame
= Qnil
;
6083 Vlast_event_frame
= internal_last_event_frame
;
6086 #ifndef MULTI_PERDISPLAY
6088 wipe_perdisplay (&the_only_perdisplay
);
6089 init_perdisplay (&the_only_perdisplay
);
6092 if (!noninteractive
&& !read_socket_hook
&& NILP (Vwindow_system
))
6094 signal (SIGINT
, interrupt_signal
);
6095 #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
6096 /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
6097 SIGQUIT and we can't tell which one it will give us. */
6098 signal (SIGQUIT
, interrupt_signal
);
6099 #endif /* HAVE_TERMIO */
6101 /* Note SIGIO has been undef'd if FIONREAD is missing. */
6103 if (!noninteractive
)
6104 signal (SIGIO
, input_available_signal
);
6107 /* Use interrupt input by default, if it works and noninterrupt input
6108 has deficiencies. */
6110 #ifdef INTERRUPT_INPUT
6111 interrupt_input
= 1;
6113 interrupt_input
= 0;
6116 /* Our VMS input only works by interrupts, as of now. */
6118 interrupt_input
= 1;
6124 if (keyboard_init_hook
)
6125 (*keyboard_init_hook
) ();
6127 #ifdef POLL_FOR_INPUT
6128 poll_suppress_count
= 1;
6133 /* This type's only use is in syms_of_keyboard, to initialize the
6134 event header symbols and put properties on them. */
6141 struct event_head head_table
[] = {
6142 &Qmouse_movement
, "mouse-movement", &Qmouse_movement
,
6143 &Qscroll_bar_movement
, "scroll-bar-movement", &Qmouse_movement
,
6144 &Qswitch_frame
, "switch-frame", &Qswitch_frame
,
6145 &Qdelete_frame
, "delete-frame", &Qdelete_frame
,
6146 &Qiconify_frame
, "iconify-frame", &Qiconify_frame
,
6147 &Qmake_frame_visible
, "make-frame-visible", &Qmake_frame_visible
,
6152 Qdisabled_command_hook
= intern ("disabled-command-hook");
6153 staticpro (&Qdisabled_command_hook
);
6155 Qself_insert_command
= intern ("self-insert-command");
6156 staticpro (&Qself_insert_command
);
6158 Qforward_char
= intern ("forward-char");
6159 staticpro (&Qforward_char
);
6161 Qbackward_char
= intern ("backward-char");
6162 staticpro (&Qbackward_char
);
6164 Qdisabled
= intern ("disabled");
6165 staticpro (&Qdisabled
);
6167 Qundefined
= intern ("undefined");
6168 staticpro (&Qundefined
);
6170 Qpre_command_hook
= intern ("pre-command-hook");
6171 staticpro (&Qpre_command_hook
);
6173 Qpost_command_hook
= intern ("post-command-hook");
6174 staticpro (&Qpost_command_hook
);
6176 Qdeferred_action_function
= intern ("deferred-action-function");
6177 staticpro (&Qdeferred_action_function
);
6179 Qcommand_hook_internal
= intern ("command-hook-internal");
6180 staticpro (&Qcommand_hook_internal
);
6182 Qfunction_key
= intern ("function-key");
6183 staticpro (&Qfunction_key
);
6184 Qmouse_click
= intern ("mouse-click");
6185 staticpro (&Qmouse_click
);
6187 Qmenu_enable
= intern ("menu-enable");
6188 staticpro (&Qmenu_enable
);
6190 Qmode_line
= intern ("mode-line");
6191 staticpro (&Qmode_line
);
6192 Qvertical_line
= intern ("vertical-line");
6193 staticpro (&Qvertical_line
);
6194 Qvertical_scroll_bar
= intern ("vertical-scroll-bar");
6195 staticpro (&Qvertical_scroll_bar
);
6196 Qmenu_bar
= intern ("menu-bar");
6197 staticpro (&Qmenu_bar
);
6199 Qabove_handle
= intern ("above-handle");
6200 staticpro (&Qabove_handle
);
6201 Qhandle
= intern ("handle");
6202 staticpro (&Qhandle
);
6203 Qbelow_handle
= intern ("below-handle");
6204 staticpro (&Qbelow_handle
);
6206 Qevent_kind
= intern ("event-kind");
6207 staticpro (&Qevent_kind
);
6208 Qevent_symbol_elements
= intern ("event-symbol-elements");
6209 staticpro (&Qevent_symbol_elements
);
6210 Qevent_symbol_element_mask
= intern ("event-symbol-element-mask");
6211 staticpro (&Qevent_symbol_element_mask
);
6212 Qmodifier_cache
= intern ("modifier-cache");
6213 staticpro (&Qmodifier_cache
);
6215 Qrecompute_lucid_menubar
= intern ("recompute-lucid-menubar");
6216 staticpro (&Qrecompute_lucid_menubar
);
6217 Qactivate_menubar_hook
= intern ("activate-menubar-hook");
6218 staticpro (&Qactivate_menubar_hook
);
6220 Qpolling_period
= intern ("polling-period");
6221 staticpro (&Qpolling_period
);
6224 struct event_head
*p
;
6226 for (p
= head_table
;
6227 p
< head_table
+ (sizeof (head_table
) / sizeof (head_table
[0]));
6230 *p
->var
= intern (p
->name
);
6232 Fput (*p
->var
, Qevent_kind
, *p
->kind
);
6233 Fput (*p
->var
, Qevent_symbol_elements
, Fcons (*p
->var
, Qnil
));
6237 button_down_location
= Fmake_vector (make_number (NUM_MOUSE_BUTTONS
), Qnil
);
6238 staticpro (&button_down_location
);
6242 int len
= sizeof (modifier_names
) / sizeof (modifier_names
[0]);
6244 modifier_symbols
= Fmake_vector (make_number (len
), Qnil
);
6245 for (i
= 0; i
< len
; i
++)
6246 if (modifier_names
[i
])
6247 XVECTOR (modifier_symbols
)->contents
[i
] = intern (modifier_names
[i
]);
6248 staticpro (&modifier_symbols
);
6251 recent_keys
= Fmake_vector (make_number (NUM_RECENT_KEYS
), Qnil
);
6252 staticpro (&recent_keys
);
6254 this_command_keys
= Fmake_vector (make_number (40), Qnil
);
6255 staticpro (&this_command_keys
);
6257 Qextended_command_history
= intern ("extended-command-history");
6258 Fset (Qextended_command_history
, Qnil
);
6259 staticpro (&Qextended_command_history
);
6261 accent_key_syms
= Qnil
;
6262 staticpro (&accent_key_syms
);
6264 func_key_syms
= Qnil
;
6265 staticpro (&func_key_syms
);
6267 system_key_syms
= Qnil
;
6268 staticpro (&system_key_syms
);
6271 staticpro (&mouse_syms
);
6273 unread_switch_frame
= Qnil
;
6274 staticpro (&unread_switch_frame
);
6276 defsubr (&Sread_key_sequence
);
6277 defsubr (&Srecursive_edit
);
6279 defsubr (&Strack_mouse
);
6281 defsubr (&Sinput_pending_p
);
6282 defsubr (&Scommand_execute
);
6283 defsubr (&Srecent_keys
);
6284 defsubr (&Sthis_command_keys
);
6285 defsubr (&Ssuspend_emacs
);
6286 defsubr (&Sabort_recursive_edit
);
6287 defsubr (&Sexit_recursive_edit
);
6288 defsubr (&Srecursion_depth
);
6289 defsubr (&Stop_level
);
6290 defsubr (&Sdiscard_input
);
6291 defsubr (&Sopen_dribble_file
);
6292 defsubr (&Sset_input_mode
);
6293 defsubr (&Scurrent_input_mode
);
6294 defsubr (&Sexecute_extended_command
);
6296 DEFVAR_LISP ("last-command-char", &last_command_char
,
6297 "Last input event that was part of a command.");
6299 DEFVAR_LISP_NOPRO ("last-command-event", &last_command_char
,
6300 "Last input event that was part of a command.");
6302 DEFVAR_LISP ("last-nonmenu-event", &last_nonmenu_event
,
6303 "Last input event in a command, except for mouse menu events.\n\
6304 Mouse menus give back keys that don't look like mouse events;\n\
6305 this variable holds the actual mouse event that led to the menu,\n\
6306 so that you can determine whether the command was run by mouse or not.");
6308 DEFVAR_LISP ("last-input-char", &last_input_char
,
6309 "Last input event.");
6311 DEFVAR_LISP_NOPRO ("last-input-event", &last_input_char
,
6312 "Last input event.");
6314 DEFVAR_LISP ("unread-command-events", &Vunread_command_events
,
6315 "List of objects to be read as next command input events.");
6317 DEFVAR_INT ("unread-command-char", &unread_command_char
,
6318 "If not -1, an object to be read as next command input event.");
6320 DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char
,
6321 "Meta-prefix character code. Meta-foo as command input\n\
6322 turns into this character followed by foo.");
6323 XSETINT (meta_prefix_char
, 033);
6325 DEFVAR_LISP ("last-command", &last_command
,
6326 "The last command executed. Normally a symbol with a function definition,\n\
6327 but can be whatever was found in the keymap, or whatever the variable\n\
6328 `this-command' was set to by that command.\n\
6330 The value `mode-exit' is special; it means that the previous command\n\
6331 read an event that told it to exit, and it did so and unread that event.\n\
6332 In other words, the present command is the event that made the previous\n\
6335 The value `kill-region' is special; it means that the previous command\n\
6336 was a kill command.");
6337 last_command
= Qnil
;
6339 DEFVAR_LISP ("this-command", &this_command
,
6340 "The command now being executed.\n\
6341 The command can set this variable; whatever is put here\n\
6342 will be in `last-command' during the following command.");
6343 this_command
= Qnil
;
6345 DEFVAR_INT ("auto-save-interval", &auto_save_interval
,
6346 "*Number of keyboard input characters between auto-saves.\n\
6347 Zero means disable autosaving due to number of characters typed.");
6348 auto_save_interval
= 300;
6350 DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout
,
6351 "*Number of seconds idle time before auto-save.\n\
6352 Zero or nil means disable auto-saving due to idleness.\n\
6353 After auto-saving due to this many seconds of idle time,\n\
6354 Emacs also does a garbage collection if that seems to be warranted.");
6355 XSETFASTINT (Vauto_save_timeout
, 30);
6357 DEFVAR_INT ("echo-keystrokes", &echo_keystrokes
,
6358 "*Nonzero means echo unfinished commands after this many seconds of pause.");
6359 echo_keystrokes
= 1;
6361 DEFVAR_INT ("polling-period", &polling_period
,
6362 "*Interval between polling for input during Lisp execution.\n\
6363 The reason for polling is to make C-g work to stop a running program.\n\
6364 Polling is needed only when using X windows and SIGIO does not work.\n\
6365 Polling is automatically disabled in all other cases.");
6368 DEFVAR_LISP ("double-click-time", &Vdouble_click_time
,
6369 "*Maximum time between mouse clicks to make a double-click.\n\
6370 Measured in milliseconds. nil means disable double-click recognition;\n\
6371 t means double-clicks have no time limit and are detected\n\
6372 by position only.");
6373 Vdouble_click_time
= make_number (500);
6375 DEFVAR_BOOL ("inhibit-local-menu-bar-menus", &inhibit_local_menu_bar_menus
,
6376 "*Non-nil means inhibit local map menu bar menus.");
6377 inhibit_local_menu_bar_menus
= 0;
6379 DEFVAR_INT ("num-input-keys", &num_input_keys
,
6380 "Number of complete keys read from the keyboard so far.");
6383 DEFVAR_LISP ("last-event-frame", &Vlast_event_frame
,
6384 "The frame in which the most recently read event occurred.\n\
6385 If the last event came from a keyboard macro, this is set to `macro'.");
6386 Vlast_event_frame
= Qnil
;
6388 DEFVAR_LISP ("help-char", &Vhelp_char
,
6389 "Character to recognize as meaning Help.\n\
6390 When it is read, do `(eval help-form)', and display result if it's a string.\n\
6391 If the value of `help-form' is nil, this char can be read normally.");
6392 XSETINT (Vhelp_char
, Ctl ('H'));
6394 DEFVAR_LISP ("help-form", &Vhelp_form
,
6395 "Form to execute when character `help-char' is read.\n\
6396 If the form returns a string, that string is displayed.\n\
6397 If `help-form' is nil, the help char is not recognized.");
6400 DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command
,
6401 "Command to run when `help-char' character follows a prefix key.\n\
6402 This command is used only when there is no actual binding\n\
6403 for that character after that prefix key.");
6404 Vprefix_help_command
= Qnil
;
6406 DEFVAR_LISP ("top-level", &Vtop_level
,
6407 "Form to evaluate when Emacs starts up.\n\
6408 Useful to set before you dump a modified Emacs.");
6411 DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table
,
6412 "String used as translate table for keyboard input, or nil.\n\
6413 Each character is looked up in this string and the contents used instead.\n\
6414 If string is of length N, character codes N and up are untranslated.");
6415 Vkeyboard_translate_table
= Qnil
;
6417 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
6418 "Keymap of key translations that can override keymaps.\n\
6419 This keymap works like `function-key-map', but comes after that,\n\
6420 and applies even for keys that have ordinary bindings.");
6421 Vkey_translation_map
= Qnil
;
6423 DEFVAR_BOOL ("cannot-suspend", &cannot_suspend
,
6424 "Non-nil means to always spawn a subshell instead of suspending,\n\
6425 even if the operating system has support for stopping a process.");
6428 DEFVAR_BOOL ("menu-prompting", &menu_prompting
,
6429 "Non-nil means prompt with menus when appropriate.\n\
6430 This is done when reading from a keymap that has a prompt string,\n\
6431 for elements that have prompt strings.\n\
6432 The menu is displayed on the screen\n\
6433 if X menus were enabled at configuration\n\
6434 time and the previous event was a mouse click prefix key.\n\
6435 Otherwise, menu prompting uses the echo area.");
6438 DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char
,
6439 "Character to see next line of menu prompt.\n\
6440 Type this character while in a menu prompt to rotate around the lines of it.");
6441 XSETINT (menu_prompt_more_char
, ' ');
6443 DEFVAR_INT ("extra-keyboard-modifiers", &extra_keyboard_modifiers
,
6444 "A mask of additional modifier keys to use with every keyboard character.\n\
6445 Emacs applies the modifiers of the character stored here to each keyboard\n\
6446 character it reads. For example, after evaluating the expression\n\
6447 (setq extra-keyboard-modifiers ?\\C-x)\n\
6448 all input characters will have the control modifier applied to them.\n\
6450 Note that the character ?\\C-@, equivalent to the integer zero, does\n\
6451 not count as a control character; rather, it counts as a character\n\
6452 with no modifiers; thus, setting `extra-keyboard-modifiers' to zero\n\
6453 cancels any modification.");
6454 extra_keyboard_modifiers
= 0;
6456 DEFVAR_LISP ("deactivate-mark", &Vdeactivate_mark
,
6457 "If an editing command sets this to t, deactivate the mark afterward.\n\
6458 The command loop sets this to nil before each command,\n\
6459 and tests the value when the command returns.\n\
6460 Buffer modification stores t in this variable.");
6461 Vdeactivate_mark
= Qnil
;
6463 DEFVAR_LISP ("command-hook-internal", &Vcommand_hook_internal
,
6464 "Temporary storage of pre-command-hook or post-command-hook.");
6465 Vcommand_hook_internal
= Qnil
;
6467 DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook
,
6468 "Normal hook run before each command is executed.\n\
6469 While the hook is run, its value is temporarily set to nil\n\
6470 to avoid an unbreakable infinite loop if a hook function gets an error.\n\
6471 As a result, a hook function cannot straightforwardly alter the value of\n\
6472 `pre-command-hook'. See the Emacs Lisp manual for a way of\n\
6473 implementing hook functions that alter the set of hook functions.");
6474 Vpre_command_hook
= Qnil
;
6476 DEFVAR_LISP ("post-command-hook", &Vpost_command_hook
,
6477 "Normal hook run after each command is executed.\n\
6478 While the hook is run, its value is temporarily set to nil\n\
6479 to avoid an unbreakable infinite loop if a hook function gets an error.\n\
6480 As a result, a hook function cannot straightforwardly alter the value of\n\
6481 `post-command-hook'. See the Emacs Lisp manual for a way of\n\
6482 implementing hook functions that alter the set of hook functions.");
6483 Vpost_command_hook
= Qnil
;
6485 DEFVAR_LISP ("lucid-menu-bar-dirty-flag", &Vlucid_menu_bar_dirty_flag
,
6486 "t means menu bar, specified Lucid style, needs to be recomputed.");
6487 Vlucid_menu_bar_dirty_flag
= Qnil
;
6489 DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items
,
6490 "List of menu bar items to move to the end of the menu bar.\n\
6491 The elements of the list are event types that may have menu bar bindings.");
6492 Vmenu_bar_final_items
= Qnil
;
6494 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map
,
6495 "Keymap that overrides all other local keymaps.\n\
6496 If this variable is non-nil, it is used as a keymap instead of the\n\
6497 buffer's local map, and the minor mode keymaps and text property keymaps.");
6498 Voverriding_local_map
= Qnil
;
6500 DEFVAR_LISP ("overriding-local-map-menu-flag", &Voverriding_local_map_menu_flag
,
6501 "Non-nil means `overriding-local-map' applies to the menu bar.\n\
6502 Otherwise, the menu bar continues to reflect the buffer's local map\n\
6503 and the minor mode maps regardless of `overriding-local-map'.");
6504 Voverriding_local_map_menu_flag
= Qnil
;
6507 DEFVAR_LISP ("track-mouse", &do_mouse_tracking
,
6508 "*Non-nil means generate motion events for mouse motion.");
6511 DEFVAR_LISP ("system-key-alist", &Vsystem_key_alist
,
6512 "Alist of system-specific X windows key symbols.\n\
6513 Each element should have the form (N . SYMBOL) where N is the\n\
6514 numeric keysym code (sans the \"system-specific\" bit 1<<28)\n\
6515 and SYMBOL is its name.");
6516 Vsystem_key_alist
= Qnil
;
6518 DEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list
,
6519 "List of deferred actions to be performed at a later time.\n\
6520 The precise format isn't relevant here; we just check whether it is nil.");
6521 Vdeferred_action_list
= Qnil
;
6523 DEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function
,
6524 "Function to call to handle deferred actions, after each command.\n\
6525 This function is called with no arguments after each command\n\
6526 whenever `deferred-action-list' is non-nil.");
6527 Vdeferred_action_function
= Qnil
;
6529 DEFVAR_DISPLAY ("prefix-arg", Vprefix_arg
,
6530 "The value of the prefix argument for the next editing command.\n\
6531 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
6532 or a list whose car is a number for just one or more C-U's\n\
6533 or nil if no argument has been specified.\n\
6535 You cannot examine this variable to find the argument for this command\n\
6536 since it has been set to nil by the time you can look.\n\
6537 Instead, you should use the variable `current-prefix-arg', although\n\
6538 normally commands can get this prefix argument with (interactive \"P\").");
6540 DEFVAR_DISPLAY ("current-prefix-arg", Vcurrent_prefix_arg
,
6541 "The value of the prefix argument for this editing command.\n\
6542 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
6543 or a list whose car is a number for just one or more C-U's\n\
6544 or nil if no argument has been specified.\n\
6545 This is what `(interactive \"P\")' returns.");
6550 initial_define_key (global_map
, Ctl ('Z'), "suspend-emacs");
6551 initial_define_key (control_x_map
, Ctl ('Z'), "suspend-emacs");
6552 initial_define_key (meta_map
, Ctl ('C'), "exit-recursive-edit");
6553 initial_define_key (global_map
, Ctl (']'), "abort-recursive-edit");
6554 initial_define_key (meta_map
, 'x', "execute-extended-command");