[MULTI_PERDISPLAY] (all_perdisplays): New var.
[emacs.git] / src / keyboard.c
blob980194eb6bf1f9ce638d79961cb1447abebf338e
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)
9 any later version.
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. */
21 #include <signal.h>
23 #include <config.h>
24 #include <stdio.h>
25 #undef NULL
26 #include "termchar.h"
27 #include "termopts.h"
28 #include "lisp.h"
29 #include "termhooks.h"
30 #include "macros.h"
31 #include "frame.h"
32 #include "window.h"
33 #include "commands.h"
34 #include "buffer.h"
35 #include "disptab.h"
36 #include "dispextern.h"
37 #include "keyboard.h"
38 #include "intervals.h"
39 #include "blockinput.h"
40 #include <setjmp.h>
41 #include <errno.h>
43 #ifdef MSDOS
44 #include "msdos.h"
45 #include <time.h>
46 #else /* not MSDOS */
47 #ifndef VMS
48 #include <sys/ioctl.h>
49 #endif
50 #endif /* not MSDOS */
52 #include "syssignal.h"
53 #include "systty.h"
55 /* This is to get the definitions of the XK_ symbols. */
56 #ifdef HAVE_X_WINDOWS
57 #include "xterm.h"
58 #endif
60 /* Include systime.h after xterm.h to avoid double inclusion of time.h. */
61 #include "systime.h"
63 extern int errno;
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. */
76 extern int input_fd;
78 #ifdef HAVE_X_WINDOWS
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 */
87 struct backtrace
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
94 unevalled args */
95 char evalargs;
98 #ifdef MULTI_PERDISPLAY
99 PERDISPLAY *current_perdisplay;
100 PERDISPLAY *all_perdisplays;
101 #else
102 PERDISPLAY the_only_perdisplay;
103 #endif
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. */
139 static int echoing;
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. */
145 int immediate_quit;
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
171 keystrokes.
173 FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
174 ASCII character. */
175 int quit_char;
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. */
190 int num_input_keys;
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. */
232 int num_input_chars;
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. */
244 int 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;
262 #ifdef MULTI_FRAME
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;
269 #endif
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. */
323 FILE *dribble;
325 /* Nonzero if input is available. */
326 int input_pending;
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. */
331 int meta_key;
333 extern char *pending_malloc_warning;
335 #ifdef HAVE_MOUSE
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! */
346 int mouse_moved;
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
382 apply_modifiers. */
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
400 happens. */
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. */
405 int interrupt_input;
407 /* Nonzero while interrupts are temporarily deferred during redisplay. */
408 int interrupts_deferred;
410 /* nonzero means use ^S/^Q for flow control. */
411 int flow_control;
413 /* Allow m- file to inhibit use of FIONREAD. */
414 #ifdef BROKEN_FIONREAD
415 #undef FIONREAD
416 #endif
418 /* We are unable to use interrupts if FIONREAD is not available,
419 so flush SIGIO so we won't try. */
420 #ifndef FIONREAD
421 #ifdef SIGIO
422 #undef SIGIO
423 #endif
424 #endif
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
430 #endif
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
451 to support it. */
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. */
461 echo_prompt (str)
462 char *str;
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;
474 echo ();
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. */
481 echo_char (c)
482 Lisp_Object c;
484 extern char *push_key_description ();
486 if (current_perdisplay->immediate_echo)
488 char *ptr = current_perdisplay->echoptr;
490 if (ptr != current_perdisplay->echobuf)
491 *ptr++ = ' ';
493 /* If someone has passed us a composite event, use its head symbol. */
494 c = EVENT_HEAD (c);
496 if (INTEGERP (c))
498 if (ptr - current_perdisplay->echobuf > ECHOBUFSIZE - 6)
499 return;
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)
507 > ECHOBUFSIZE)
508 return;
509 bcopy (name->data, ptr, name->size);
510 ptr += name->size;
513 if (current_perdisplay->echoptr == current_perdisplay->echobuf
514 && EQ (c, Vhelp_char))
516 strcpy (ptr, " (Type ? for further options)");
517 ptr += strlen (ptr);
520 *ptr = 0;
521 current_perdisplay->echoptr = ptr;
523 echo ();
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. */
530 echo_dash ()
532 if (!current_perdisplay->immediate_echo
533 && current_perdisplay->echoptr == current_perdisplay->echobuf)
534 return;
535 /* Do nothing if we just printed a prompt. */
536 if (current_perdisplay->echo_after_prompt
537 == current_perdisplay->echoptr - current_perdisplay->echobuf)
538 return;
539 /* Do nothing if not echoing at all. */
540 if (current_perdisplay->echoptr == 0)
541 return;
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;
548 echo ();
551 /* Display the current echo string, and begin echoing if not already
552 doing so. */
554 echo ()
556 if (!current_perdisplay->immediate_echo)
558 int i;
559 current_perdisplay->immediate_echo = 1;
561 for (i = 0; i < this_command_key_count; i++)
563 Lisp_Object c;
564 c = XVECTOR (this_command_keys)->contents[i];
565 if (! (EVENT_HAS_PARAMETERS (c)
566 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
567 echo_char (c);
569 echo_dash ();
572 echoing = 1;
573 message1_nolog (current_perdisplay->echobuf);
574 echoing = 0;
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. */
582 cancel_echoing ()
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. */
591 static int
592 echo_length ()
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. */
601 static void
602 echo_truncate (len)
603 int len;
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. */
612 static void
613 add_command_key (key)
614 Lisp_Object 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;
633 Lisp_Object
634 recursive_edit_1 ()
636 int count = specpdl_ptr - specpdl;
637 Lisp_Object val;
639 if (command_loop_level > 0)
641 specbind (Qstandard_output, Qt);
642 specbind (Qstandard_input, Qt);
645 val = command_loop ();
646 if (EQ (val, Qt))
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. */
654 record_auto_save ()
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;
677 Lisp_Object val;
679 command_loop_level++;
680 update_mode_lines = 1;
682 record_unwind_protect (recursive_edit_unwind,
683 (command_loop_level
684 && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
685 ? Fcurrent_buffer ()
686 : Qnil);
687 recursive_edit_1 ();
688 return unbind_to (count, Qnil);
691 Lisp_Object
692 recursive_edit_unwind (buffer)
693 Lisp_Object buffer;
695 if (!NILP (buffer))
696 Fset_buffer (buffer);
698 command_loop_level--;
699 update_mode_lines = 1;
700 return Qnil;
703 Lisp_Object
704 cmd_error (data)
705 Lisp_Object data;
707 Vstandard_output = Qt;
708 Vstandard_input = Qt;
709 Vexecuting_macro = Qnil;
710 if (!current_perdisplay)
711 abort ();
712 current_perdisplay->Vprefix_arg = Qnil;
713 cmd_error_internal (data, 0);
715 Vquit_flag = Qnil;
717 Vinhibit_quit = Qnil;
718 #ifdef MULTI_PERDISPLAY
719 current_perdisplay = 0;
720 #endif
722 return make_number (0);
725 cmd_error_internal (data, context)
726 Lisp_Object data;
727 char *context;
729 Lisp_Object errmsg, tail, errname, file_error;
730 Lisp_Object stream;
731 struct gcpro gcpro1;
732 int i;
734 Vquit_flag = Qnil;
735 Vinhibit_quit = Qt;
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)
742 || noninteractive)
743 stream = Qexternal_debugging_output;
744 else
746 Fdiscard_input ();
747 bitch_at_user ();
748 stream = Qt;
751 if (context != 0)
752 write_string_1 (context, -1, stream);
754 errname = Fcar (data);
756 if (EQ (errname, Qerror))
758 data = Fcdr (data);
759 if (!CONSP (data)) data = Qnil;
760 errmsg = Fcar (data);
761 file_error = Qnil;
763 else
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;
775 tail = Fcdr (data);
776 GCPRO1 (tail);
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);
785 else
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);
793 else
794 Fprin1 (Fcar (tail), stream);
796 UNGCPRO;
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)
801 || noninteractive)
803 Fterpri (stream);
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. */
816 Lisp_Object
817 command_loop ()
819 if (command_loop_level > 0 || minibuf_level > 0)
821 return internal_catch (Qexit, command_loop_2, Qnil);
823 else
824 while (1)
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. */
830 if (noninteractive)
831 Fkill_emacs (Qt);
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). */
841 Lisp_Object
842 command_loop_2 ()
844 register Lisp_Object val;
847 val = internal_condition_case (command_loop_1, Qerror, cmd_error);
848 while (!NILP (val));
850 return Qnil;
853 Lisp_Object
854 top_level_2 ()
856 return Feval (Vtop_level);
859 Lisp_Object
860 top_level_1 ()
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)");
867 else
868 message ("Bare Emacs (standard Lisp code not loaded)");
869 return Qnil;
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)
894 Fthrow (Qexit, Qt);
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 ();
906 Lisp_Object
907 command_loop_1 ()
909 Lisp_Object cmd, tem;
910 int lose;
911 int nonundocount;
912 Lisp_Object keybuf[30];
913 int i;
914 int no_redisplay;
915 int no_direct;
916 int prev_modiff;
917 struct buffer *prev_buffer;
918 PERDISPLAY *global_perdisplay = current_perdisplay;
920 Vdeactivate_mark = Qnil;
921 waiting_for_input = 0;
922 cancel_echoing ();
924 nonundocount = 0;
925 no_redisplay = 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;
941 while (1)
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 ();
953 no_direct = 0;
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;
970 no_direct = 1;
971 if (!NILP (Vquit_flag))
973 Vquit_flag = Qnil;
974 Vunread_command_events = Fcons (make_number (quit_char), Qnil);
978 #ifdef C_ALLOCA
979 alloca (0); /* Cause a garbage collection now */
980 /* Since we can free the most stuff here. */
981 #endif /* C_ALLOCA */
983 #if 0
984 #ifdef MULTI_FRAME
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);
992 #endif
993 #endif
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);
1003 ++num_input_keys;
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. */
1012 if (i == -1)
1014 cancel_echoing ();
1015 this_command_key_count = 0;
1016 goto finalize;
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. */
1042 no_redisplay = 0;
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. */
1051 this_command = cmd;
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. */
1060 bitch_at_user ();
1061 defining_kbd_macro = 0;
1062 update_mode_lines = 1;
1063 current_perdisplay->Vprefix_arg = Qnil;
1066 else
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);
1077 SET_PT (PT + 1);
1078 if ((dp
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)
1085 >= MODIFF)
1086 && (XFASTINT (XWINDOW (selected_window)->last_point)
1087 == PT - 1)
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);
1093 goto directly_done;
1095 else if (EQ (this_command, Qbackward_char) && PT > BEGV)
1097 struct Lisp_Vector *dp
1098 = window_display_table (XWINDOW (selected_window));
1099 SET_PT (PT - 1);
1100 lose = FETCH_CHAR (PT);
1101 if ((dp
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)
1108 >= MODIFF)
1109 && (XFASTINT (XWINDOW (selected_window)->last_point)
1110 == PT + 1)
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);
1116 goto directly_done;
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);
1123 int value;
1125 if (NILP (Vexecuting_macro)
1126 && !EQ (minibuf_window, selected_window))
1128 if (!nonundocount || nonundocount >= 20)
1130 Fundo_boundary ();
1131 nonundocount = 0;
1133 nonundocount++;
1135 lose = ((XFASTINT (XWINDOW (selected_window)->last_modified)
1136 < MODIFF)
1137 || (XFASTINT (XWINDOW (selected_window)->last_point)
1138 != PT)
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);
1145 if (value)
1146 lose = 1;
1147 if (value == 2)
1148 nonundocount = 0;
1150 if (!lose
1151 && (PT == ZV || FETCH_CHAR (PT) == '\n'))
1153 struct Lisp_Vector *dp
1154 = window_display_table (XWINDOW (selected_window));
1155 int lose = c;
1157 if (dp)
1159 Lisp_Object obj;
1161 obj = DISP_CHAR_VECTOR (dp, lose);
1162 if (NILP (obj))
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],
1172 INTEGERP (obj))
1173 /* Insist face not specified in glyph. */
1174 && (XINT (obj) & ((-1) << 8)) == 0)
1175 no_redisplay
1176 = direct_output_for_insert (XINT (obj));
1178 else
1180 if (lose >= 0x20 && lose <= 0x7e)
1181 no_redisplay = direct_output_for_insert (lose);
1184 goto directly_done;
1188 /* Here for a command that isn't executed directly */
1190 nonundocount = 0;
1191 if (NILP (current_perdisplay->Vprefix_arg))
1192 Fundo_boundary ();
1193 Fcommand_execute (this_command, Qnil);
1196 directly_done: ;
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
1211 cancel_echoing, and
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;
1218 cancel_echoing ();
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"));
1233 finalize:
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;
1241 #endif
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. */
1248 static void
1249 safe_run_hooks (hook)
1250 Lisp_Object hook;
1252 Lisp_Object value;
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);
1259 Fset (hook, Qnil);
1260 call1 (Vrun_hooks, Qcommand_hook_internal);
1261 Fset (hook, value);
1263 unbind_to (count, Qnil);
1266 /* Number of seconds between polling for input. */
1267 int polling_period;
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. */
1280 SIGTYPE
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);
1290 #endif
1292 /* Begin signals to poll for input, if they are appropriate.
1293 This function is called unconditionally from various places. */
1295 start_polling ()
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);
1308 #endif
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;
1318 #else
1319 return 0;
1320 #endif
1323 /* Turn off polling. */
1325 stop_polling ()
1327 #ifdef POLL_FOR_INPUT
1328 if (read_socket_hook && !interrupt_input)
1330 if (poll_suppress_count == 0)
1332 polling_for_input = 0;
1333 alarm (0);
1335 poll_suppress_count++;
1337 #endif
1340 /* Set the value of poll_suppress_count to COUNT
1341 and start or stop polling accordingly. */
1343 void
1344 set_poll_suppress_count (count)
1345 int count;
1347 #ifdef POLL_FOR_INPUT
1348 if (count == 0 && poll_suppress_count != 0)
1350 poll_suppress_count = 1;
1351 start_polling ();
1353 else if (count != 0 && poll_suppress_count == 0)
1355 stop_polling ();
1357 poll_suppress_count = count;
1358 #endif
1361 /* Bind polling_period to a value at least N.
1362 But don't decrease it. */
1364 bind_polling_period (n)
1365 int n;
1367 #ifdef POLL_FOR_INPUT
1368 int new = polling_period;
1370 if (n > new)
1371 new = n;
1373 stop_polling ();
1374 specbind (Qpolling_period, make_number (new));
1375 /* Start a new alarm with the new period. */
1376 start_polling ();
1377 #endif
1380 /* Applying the control modifier to CHARACTER. */
1382 make_ctrl_char (c)
1383 int c;
1385 /* Save the upper bits here. */
1386 int upper = c & ~0177;
1388 c &= 0177;
1390 /* Everything in the columns containing the upper-case letters
1391 denotes a control character. */
1392 if (c >= 0100 && c < 0140)
1394 int oc = c;
1395 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')
1404 c &= ~0140;
1406 /* Include the bits for control and shift
1407 only if the basic ASCII code can't indicate them. */
1408 else if (c >= ' ')
1409 c |= ctrl_modifier;
1411 /* Replace the high bits. */
1412 c |= (upper & ~ctrl_modifier);
1414 return c;
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.
1428 1 means do both. */
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. */
1442 Lisp_Object
1443 read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
1444 int commandflag;
1445 int nmaps;
1446 Lisp_Object *maps;
1447 Lisp_Object prev_event;
1448 int *used_mouse_menu;
1450 register Lisp_Object c;
1451 int count;
1452 jmp_buf save_jump;
1453 int key_already_recorded = 0;
1454 Lisp_Object also_record;
1455 also_record = Qnil;
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)
1463 goto reread_first;
1464 else
1465 goto reread;
1468 if (unread_command_char != -1)
1470 XSETINT (c, unread_command_char);
1471 unread_command_char = -1;
1473 if (this_command_key_count == 0)
1474 goto reread_first;
1475 else
1476 goto reread;
1479 if (!NILP (Vexecuting_macro))
1481 #ifdef MULTI_FRAME
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
1484 remain unchanged.
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
1491 selected. */
1492 Vlast_event_frame = internal_last_event_frame = Qmacro;
1493 #endif
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)))
1501 XSETINT (c, -1);
1502 return c;
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++;
1512 goto from_macro;
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. */
1522 goto reread_first;
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);
1534 stop_polling ();
1536 if (commandflag >= 0 && !input_pending && !detect_input_pending ())
1537 redisplay ();
1539 if (_setjmp (getcjmp))
1541 XSETINT (c, quit_char);
1542 #ifdef MULTI_FRAME
1543 XSETFRAME (internal_last_event_frame, selected_frame);
1544 Vlast_event_frame = internal_last_event_frame;
1545 #endif
1546 /* If we report the quit char as an event,
1547 don't do so more than once. */
1548 if (!NILP (Vinhibit_quit))
1549 Vquit_flag = Qnil;
1551 goto non_reread;
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)
1557 cancel_echoing ();
1558 else
1559 /* If already echoing, continue. */
1560 echo_dash ();
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. */
1567 c = Qnil;
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);
1576 if (! NILP (c))
1578 key_already_recorded = 1;
1579 goto non_reread;
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
1587 && ! noninteractive
1588 && echo_keystrokes > 0
1589 && (echo_area_glyphs == 0 || *echo_area_glyphs == 0))
1591 Lisp_Object tem0;
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))
1597 echo ();
1598 else
1600 tem0 = sit_for (echo_keystrokes, 0, 1, 1);
1601 if (EQ (tem0, Qt))
1602 echo ();
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 ())
1613 jmp_buf temp;
1614 save_getcjmp (temp);
1615 Fdo_auto_save (Qnil, Qnil);
1616 /* Hooks can actually change some buffers in auto save. */
1617 redisplay ();
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;
1641 delay_level = 0;
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)
1654 Lisp_Object tem0;
1655 int delay = delay_level * XFASTINT (Vauto_save_timeout) / 4;
1656 tem0 = sit_for (delay, 0, 1, 1);
1657 if (EQ (tem0, Qt))
1659 jmp_buf temp;
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. */
1672 redisplay ();
1677 /* Actually read a character, waiting if necessary. */
1678 while (NILP (c))
1680 c = kbd_buffer_get_event ();
1681 if (!NILP (c))
1682 break;
1683 if (commandflag >= 0 && !input_pending && !detect_input_pending ())
1685 prepare_menu_bars ();
1686 redisplay ();
1690 /* Terminate Emacs in batch mode if at eof. */
1691 if (noninteractive && INTEGERP (c) && XINT (c) < 0)
1692 Fkill_emacs (make_number (1));
1694 if (INTEGERP (c))
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));
1708 non_reread:
1710 restore_getcjmp (save_jump);
1712 start_polling ();
1714 /* Buffer switch events are only for internal wakeups
1715 so don't show them to the user. */
1716 if (BUFFERP (c))
1717 return c;
1719 if (key_already_recorded)
1720 return c;
1722 /* Wipe the echo area. */
1723 echo_area_glyphs = 0;
1725 /* Handle things that only apply to characters. */
1726 if (INTEGERP (c))
1728 /* If kbd_buffer_get_event gave us an EOF, return that. */
1729 if (XINT (c) == -1)
1730 return c;
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))
1745 Lisp_Object posn;
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);
1755 also_record = c;
1756 Vunread_command_events = Fcons (c, Vunread_command_events);
1757 c = posn;
1761 record_char (c);
1762 if (! NILP (also_record))
1763 record_char (also_record);
1765 from_macro:
1766 reread_first:
1768 /* Don't echo mouse motion events. */
1769 if (echo_keystrokes
1770 && ! (EVENT_HAS_PARAMETERS (c)
1771 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
1773 echo_char (c);
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 */
1784 reread:
1785 last_input_char = c;
1786 num_input_chars++;
1788 /* Process the help character specially if enabled */
1789 if (EQ (c, Vhelp_char) && !NILP (Vhelp_form))
1791 Lisp_Object tem0;
1792 count = specpdl_ptr - specpdl;
1794 record_unwind_protect (Fset_window_configuration,
1795 Fcurrent_window_configuration (Qnil));
1797 tem0 = Feval (Vhelp_form);
1798 if (STRINGP (tem0))
1799 internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
1801 cancel_echoing ();
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 ();
1808 redisplay ();
1809 if (EQ (c, make_number (040)))
1811 cancel_echoing ();
1813 c = read_char (0, 0, 0, Qnil, 0);
1814 while (BUFFERP (c));
1818 return c;
1821 /* Record the input event C in various ways. */
1823 static void
1824 record_char (c)
1825 Lisp_Object c;
1827 total_keys++;
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. :-) */
1835 if (dribble)
1837 if (INTEGERP (c))
1839 if (XUINT (c) < 0x100)
1840 putc (XINT (c), dribble);
1841 else
1842 fprintf (dribble, " 0x%x", XUINT (c));
1844 else
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,
1856 dribble);
1857 putc ('>', dribble);
1861 fflush (dribble);
1864 store_kbd_macro_char (c);
1866 num_nonmacro_input_chars++;
1869 Lisp_Object
1870 print_help (object)
1871 Lisp_Object object;
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);
1878 return Qnil;
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. */
1886 save_getcjmp (temp)
1887 jmp_buf temp;
1889 bcopy (getcjmp, temp, sizeof getcjmp);
1892 restore_getcjmp (temp)
1893 jmp_buf temp;
1895 bcopy (temp, getcjmp, sizeof getcjmp);
1899 #ifdef HAVE_MOUSE
1901 /* Restore mouse tracking enablement. See Ftrack_mouse for the only use
1902 of this function. */
1904 static Lisp_Object
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
1915 redisplay. */
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.")
1930 (args)
1931 Lisp_Object args;
1933 int count = specpdl_ptr - specpdl;
1934 Lisp_Object val;
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. */
1955 static PERDISPLAY *
1956 find_active_event_queue ()
1958 PERDISPLAY *perd;
1960 for (perd = all_perdisplays; perd; perd = perd->next_perdisplay)
1962 if (perd->kbd_fetch_ptr != perd->kbd_store_ptr)
1963 return perd;
1965 return 0;
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. */
1970 static int
1971 readable_events ()
1973 return find_active_event_queue () != NULL || MOUSE_ACTIVITY_AVAILABLE;
1976 /* Set this for debugging, to have a way to get out */
1977 int stop_character;
1979 /* Store an event obtained at interrupt level into kbd_buffer, fifo */
1981 void
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)
1988 abort ();
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));
2001 if (c == quit_char)
2003 extern SIGTYPE interrupt_signal ();
2005 #ifdef MULTI_FRAME
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. */
2011 Lisp_Object focus;
2013 focus = FRAME_FOCUS_FRAME (XFRAME (event->frame_or_window));
2014 if (NILP (focus))
2015 internal_last_event_frame = event->frame_or_window;
2016 else
2017 internal_last_event_frame = focus;
2018 Vlast_event_frame = internal_last_event_frame;
2020 #endif
2022 last_event_timestamp = event->timestamp;
2023 interrupt_signal ();
2024 return;
2027 if (c && c == stop_character)
2029 sys_suspend ();
2030 return;
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
2049 in this case. */
2050 bcopy (event, (char *) sp, sizeof (*event));
2052 else
2054 sp->code = event->code;
2055 sp->part = event->part;
2056 sp->frame_or_window = event->frame_or_window;
2057 sp->modifiers = event->modifiers;
2058 sp->x = event->x;
2059 sp->y = event->y;
2060 sp->timestamp = event->timestamp;
2062 (XVECTOR (perd->kbd_buffer_frame_or_window)->contents[perd->kbd_store_ptr
2063 - perd->kbd_buffer]
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. */
2076 static Lisp_Object
2077 kbd_buffer_get_event ()
2079 PERDISPLAY *perd;
2080 register int c;
2081 Lisp_Object obj;
2083 if (noninteractive)
2085 c = getchar ();
2086 XSETINT (obj, c);
2087 return obj;
2090 /* Wait until there is input available. */
2091 for (;;)
2093 perd = find_active_event_queue ();
2094 if (perd || MOUSE_ACTIVITY_AVAILABLE)
2095 break;
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. */
2105 #ifdef OLDVMS
2106 wait_for_kbd_input ();
2107 #else
2108 /* Note SIGIO has been undef'd if FIONREAD is missing. */
2109 #ifdef SIGIO
2110 gobble_input (0);
2111 #endif /* SIGIO */
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. */
2130 if (perd)
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;
2140 obj = Qnil;
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)
2147 #ifdef HAVE_X11
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 (&copy);
2154 #else
2155 /* We're getting selection request events, but we don't have
2156 a window system. */
2157 abort ();
2158 #endif
2161 else if (event->kind == selection_clear_event)
2163 #ifdef HAVE_X11
2164 x_handle_selection_clear (event);
2165 perd->kbd_fetch_ptr = event + 1;
2166 #else
2167 /* We're getting selection request events, but we don't have
2168 a window system. */
2169 abort ();
2170 #endif
2172 #ifdef HAVE_X11
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;
2194 #endif
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. */
2215 else
2217 #ifdef MULTI_FRAME
2218 Lisp_Object frame;
2219 Lisp_Object focus;
2221 frame = event->frame_or_window;
2222 if (WINDOWP (frame))
2223 frame = WINDOW_FRAME (XWINDOW (frame));
2225 focus = FRAME_FOCUS_FRAME (XFRAME (frame));
2226 if (! NILP (focus))
2227 frame = focus;
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. */
2238 if (NILP (obj))
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;
2250 #ifdef HAVE_MOUSE
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;
2257 Lisp_Object x, y;
2258 unsigned long time;
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. */
2263 x = Qnil;
2264 (*mouse_position_hook) (&f, &bar_window, &part, &x, &y, &time);
2266 obj = Qnil;
2268 #ifdef MULTI_FRAME
2269 /* Decide if we should generate a switch-frame event. Don't
2270 generate switch-frame events for motion outside of all Emacs
2271 frames. */
2272 if (!NILP (x) && f)
2274 Lisp_Object frame;
2276 frame = FRAME_FOCUS_FRAME (f);
2277 if (NILP (frame))
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;
2285 #endif
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 */
2293 else
2294 /* We were promised by the above while loop that there was
2295 something for us to read! */
2296 abort ();
2298 input_pending = readable_events ();
2300 #ifdef MULTI_FRAME
2301 Vlast_event_frame = internal_last_event_frame;
2302 #endif
2304 return (obj);
2307 /* Process any events that are not user-visible,
2308 then return, without reading any user-visible events. */
2310 void
2311 swallow_events ()
2313 PERDISPLAY *perd;
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)
2328 #ifdef HAVE_X11
2329 struct input_event copy;
2330 copy = *event;
2331 perd->kbd_fetch_ptr = event + 1;
2332 x_handle_selection_request (&copy);
2333 #else
2334 /* We're getting selection request events, but we don't have
2335 a window system. */
2336 abort ();
2337 #endif
2340 else if (event->kind == selection_clear_event)
2342 #ifdef HAVE_X11
2343 x_handle_selection_clear (event);
2344 perd->kbd_fetch_ptr = event + 1;
2345 #else
2346 /* We're getting selection request events, but we don't have
2347 a window system. */
2348 abort ();
2349 #endif
2351 else
2352 break;
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
2372 XK_dead_circumflex,
2373 #else
2375 #endif
2376 #ifdef XK_dead_grave
2377 XK_dead_grave,
2378 #else
2380 #endif
2381 #ifdef XK_dead_tilde
2382 XK_dead_tilde,
2383 #else
2385 #endif
2386 #ifdef XK_dead_diaeresis
2387 XK_dead_diaeresis,
2388 #else
2390 #endif
2391 #ifdef XK_dead_macron
2392 XK_dead_macron,
2393 #else
2395 #endif
2396 #ifdef XK_dead_degree
2397 XK_dead_degree,
2398 #else
2400 #endif
2401 #ifdef XK_dead_acute
2402 XK_dead_acute,
2403 #else
2405 #endif
2406 #ifdef XK_dead_cedilla
2407 XK_dead_cedilla,
2408 #else
2410 #endif
2411 #ifdef XK_dead_breve
2412 XK_dead_breve,
2413 #else
2415 #endif
2416 #ifdef XK_dead_ogonek
2417 XK_dead_ogonek,
2418 #else
2420 #endif
2421 #ifdef XK_dead_caron
2422 XK_dead_caron,
2423 #else
2425 #endif
2426 #ifdef XK_dead_doubleacute
2427 XK_dead_doubleacute,
2428 #else
2430 #endif
2431 #ifdef XK_dead_abovedot
2432 XK_dead_abovedot,
2433 #else
2435 #endif
2438 /* This is a list of Lisp names for special "accent" characters.
2439 It parallels lispy_accent_codes. */
2441 static char *lispy_accent_keys[] =
2443 "dead-circumflex",
2444 "dead-grave",
2445 "dead-tilde",
2446 "dead-diaeresis",
2447 "dead-macron",
2448 "dead-degree",
2449 "dead-acute",
2450 "dead-cedilla",
2451 "dead-breve",
2452 "dead-ogonek",
2453 "dead-caron",
2454 "dead-doubleacute",
2455 "dead-abovedot",
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 */
2465 "backspace",
2466 "tab",
2467 "linefeed",
2468 "clear",
2470 "return",
2471 0, 0,
2472 0, 0, 0, /* 0xff10 */
2473 "pause",
2474 0, 0, 0, 0, 0, 0, 0,
2475 "escape",
2476 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 */
2482 "left",
2483 "up",
2484 "right",
2485 "down",
2486 "prior",
2487 "next",
2488 "end",
2489 "begin",
2490 0, /* 0xff59 */
2491 0, 0, 0, 0, 0, 0,
2492 "select", /* 0xff60 */ /* IsMiscFunctionKey */
2493 "print",
2494 "execute",
2495 "insert",
2496 0, /* 0xff64 */
2497 "undo",
2498 "redo",
2499 "menu",
2500 "find",
2501 "cancel",
2502 "help",
2503 "break", /* 0xff6b */
2505 0, 0, 0, 0, 0, 0, 0, 0, "backtab", 0,
2506 0, /* 0xff76 */
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 */
2511 0, 0, 0,
2512 "kp-enter", /* 0xff8d */
2513 0, 0, 0,
2514 "kp-f1", /* 0xff91 */
2515 "kp-f2",
2516 "kp-f3",
2517 "kp-f4",
2518 "kp-home", /* 0xff95 */
2519 "kp-left",
2520 "kp-up",
2521 "kp-right",
2522 "kp-down",
2523 "kp-prior", /* kp-page-up */
2524 "kp-next", /* kp-page-down */
2525 "kp-end",
2526 "kp-begin",
2527 "kp-insert",
2528 "kp-delete",
2529 0, /* 0xffa0 */
2530 0, 0, 0, 0, 0, 0, 0, 0, 0,
2531 "kp-multiply", /* 0xffaa */
2532 "kp-add",
2533 "kp-separator",
2534 "kp-subtract",
2535 "kp-decimal",
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",
2539 0, /* 0xffba */
2540 0, 0,
2541 "kp-equal", /* 0xffbd */
2542 "f1", /* 0xffbe */ /* IsFunctionKey */
2543 "f2",
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. */
2610 static Lisp_Object
2611 make_lispy_event (event)
2612 struct input_event *event;
2614 int i;
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
2624 when proper. */
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);
2636 return lispy_c;
2639 /* A function key. The symbol may need to have modifier prefixes
2640 tacked onto it. */
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,
2647 event->modifiers,
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,
2661 event->modifiers,
2662 Qfunction_key, Vsystem_key_alist,
2663 0, &system_key_syms, 0xffffff);
2666 return modify_event_symbol (event->code - 0xff00,
2667 event->modifiers,
2668 Qfunction_key, Qnil,
2669 lispy_function_keys, &func_key_syms,
2670 (sizeof (lispy_function_keys)
2671 / sizeof (lispy_function_keys[0])));
2672 break;
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. */
2677 case mouse_click:
2678 case scroll_bar_click:
2680 int button = event->code;
2681 int is_double;
2682 Lisp_Object position;
2683 Lisp_Object *start_pos_ptr;
2684 Lisp_Object start_pos;
2686 if (button < 0 || button >= NUM_MOUSE_BUTTONS)
2687 abort ();
2689 /* Build the position as appropriate for this mouse click. */
2690 if (event->kind == mouse_click)
2692 int part;
2693 FRAME_PTR f = XFRAME (event->frame_or_window);
2694 Lisp_Object window;
2695 Lisp_Object posn;
2696 int row, column;
2698 /* Ignore mouse events that were made on frame that
2699 have been deleted. */
2700 if (! FRAME_LIVE_P (f))
2701 return Qnil;
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;
2717 int hpos;
2718 int i;
2720 /* Activate the menu bar on the down event. If the
2721 up event comes in before the menu code can deal with it,
2722 just ignore it. */
2723 if (! (event->modifiers & down_modifier))
2724 return Qnil;
2726 item = Qnil;
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];
2733 if (NILP (string))
2734 break;
2735 if (column >= XINT (pos)
2736 && column < XINT (pos) + XSTRING (string)->size)
2738 item = XVECTOR (items)->contents[i];
2739 break;
2743 position
2744 = Fcons (event->frame_or_window,
2745 Fcons (Qmenu_bar,
2746 Fcons (Fcons (event->x, event->y),
2747 Fcons (make_number (event->timestamp),
2748 Qnil))));
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;
2759 posn = Qnil;
2761 else
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);
2770 if (part == 1)
2771 posn = Qmode_line;
2772 else if (part == 2)
2773 posn = Qvertical_line;
2774 else
2775 XSETINT (posn,
2776 buffer_posn_from_coords (XWINDOW (window),
2777 column, row));
2780 position
2781 = Fcons (window,
2782 Fcons (posn,
2783 Fcons (Fcons (event->x, event->y),
2784 Fcons (make_number (event->timestamp),
2785 Qnil))));
2787 else
2789 Lisp_Object window;
2790 Lisp_Object portion_whole;
2791 Lisp_Object part;
2793 window = event->frame_or_window;
2794 portion_whole = Fcons (event->x, event->y);
2795 part = *scroll_bar_parts[(int) event->part];
2797 position =
2798 Fcons (window,
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)
2826 if (is_double)
2828 double_click_count++;
2829 event->modifiers |= ((double_click_count > 2)
2830 ? triple_modifier
2831 : double_modifier);
2833 else
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))
2851 return Qnil;
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;
2857 else
2858 #endif
2860 /* The third element of every position should be the (x,y)
2861 pair. */
2862 Lisp_Object down;
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;
2870 else
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)
2879 ? triple_modifier
2880 : double_modifier);
2883 else
2884 /* Every mouse event should either have the down_modifier or
2885 the up_modifier set. */
2886 abort ();
2889 /* Get the symbol we should use for the mouse click. */
2890 Lisp_Object head;
2892 head = modify_event_symbol (button,
2893 event->modifiers,
2894 Qmouse_click, Qnil,
2895 lispy_mouse_names, &mouse_syms,
2896 (sizeof (lispy_mouse_names)
2897 / sizeof (lispy_mouse_names[0])));
2898 if (event->modifiers & drag_modifier)
2899 return Fcons (head,
2900 Fcons (start_pos,
2901 Fcons (position,
2902 Qnil)));
2903 else if (event->modifiers & (double_modifier | triple_modifier))
2904 return Fcons (head,
2905 Fcons (position,
2906 Fcons (make_number (double_click_count),
2907 Qnil)));
2908 else
2909 return Fcons (head,
2910 Fcons (position,
2911 Qnil));
2914 #endif /* MULTI_FRAME or HAVE_MOUSE */
2916 /* The 'kind' field of the event is something we don't recognize. */
2917 default:
2918 abort ();
2922 #if defined (MULTI_FRAME) || defined (HAVE_MOUSE)
2924 static Lisp_Object
2925 make_lispy_movement (frame, bar_window, part, x, y, time)
2926 FRAME_PTR frame;
2927 Lisp_Object bar_window;
2928 enum scroll_bar_part part;
2929 Lisp_Object x, y;
2930 unsigned long time;
2932 #ifdef MULTI_FRAME
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),
2944 Fcons (part_sym,
2945 Qnil))))),
2946 Qnil)));
2949 /* Or is it an ordinary mouse movement? */
2950 else
2951 #endif /* MULTI_FRAME */
2953 int area;
2954 Lisp_Object window;
2955 Lisp_Object posn;
2956 int column, row;
2958 #ifdef MULTI_FRAME
2959 if (frame)
2960 #else
2961 if (1)
2962 #endif
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);
2968 else
2969 window = Qnil;
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);
2980 if (area == 1)
2981 posn = Qmode_line;
2982 else if (area == 2)
2983 posn = Qvertical_line;
2984 else
2985 XSETINT (posn,
2986 buffer_posn_from_coords (XWINDOW (window), column, row));
2988 #ifdef MULTI_FRAME
2989 else if (frame != 0)
2991 XSETFRAME (window, frame);
2992 posn = Qnil;
2994 #endif
2995 else
2997 window = Qnil;
2998 posn = Qnil;
2999 XSETFASTINT (x, 0);
3000 XSETFASTINT (y, 0);
3003 return Fcons (Qmouse_movement,
3004 Fcons (Fcons (window,
3005 Fcons (posn,
3006 Fcons (Fcons (x, y),
3007 Fcons (make_number (time),
3008 Qnil)))),
3009 Qnil));
3013 #endif /* neither MULTI_FRAME nor HAVE_MOUSE */
3015 /* Construct a switch frame event. */
3016 static Lisp_Object
3017 make_lispy_switch_frame (frame)
3018 Lisp_Object 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. */
3032 static int
3033 parse_modifiers_uncached (symbol, modifier_end)
3034 Lisp_Object symbol;
3035 int *modifier_end;
3037 struct Lisp_String *name;
3038 int i;
3039 int modifiers;
3041 CHECK_SYMBOL (symbol, 1);
3043 modifiers = 0;
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; \
3053 modifiers |= bit; \
3054 i += 2;
3056 case 'A':
3057 SINGLE_LETTER_MOD (alt_modifier);
3058 break;
3060 case 'C':
3061 SINGLE_LETTER_MOD (ctrl_modifier);
3062 break;
3064 case 'H':
3065 SINGLE_LETTER_MOD (hyper_modifier);
3066 break;
3068 case 'M':
3069 SINGLE_LETTER_MOD (meta_modifier);
3070 break;
3072 case 'S':
3073 SINGLE_LETTER_MOD (shift_modifier);
3074 break;
3076 case 's':
3077 SINGLE_LETTER_MOD (super_modifier);
3078 break;
3080 case 'd':
3081 if (i + 5 > name->size)
3082 goto no_more_modifiers;
3083 if (! strncmp (name->data + i, "drag-", 5))
3085 modifiers |= drag_modifier;
3086 i += 5;
3088 else if (! strncmp (name->data + i, "down-", 5))
3090 modifiers |= down_modifier;
3091 i += 5;
3093 else if (i + 7 <= name->size
3094 && ! strncmp (name->data + i, "double-", 7))
3096 modifiers |= double_modifier;
3097 i += 7;
3099 else
3100 goto no_more_modifiers;
3101 break;
3103 case 't':
3104 if (i + 7 > name->size)
3105 goto no_more_modifiers;
3106 if (! strncmp (name->data + i, "triple-", 7))
3108 modifiers |= triple_modifier;
3109 i += 7;
3111 else
3112 goto no_more_modifiers;
3113 break;
3115 default:
3116 goto no_more_modifiers;
3118 #undef SINGLE_LETTER_MOD
3120 no_more_modifiers:
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;
3130 if (modifier_end)
3131 *modifier_end = i;
3133 return modifiers;
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. */
3140 static Lisp_Object
3141 apply_modifiers_uncached (modifiers, base, base_len)
3142 int modifiers;
3143 char *base;
3144 int 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
3148 reference to it. */
3149 char *new_mods =
3150 (char *) alloca (sizeof ("A-C-H-M-S-s-down-drag-double-triple-"));
3151 int mod_len;
3154 char *p = new_mods;
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)
3159 abort ();
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. */
3173 *p = '\0';
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. */
3201 static Lisp_Object
3202 lispy_modifier_list (modifiers)
3203 int modifiers;
3205 Lisp_Object modifier_list;
3206 int i;
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],
3212 modifier_list);
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. */
3224 static Lisp_Object
3225 parse_modifiers (symbol)
3226 Lisp_Object symbol;
3228 Lisp_Object elements;
3230 elements = Fget (symbol, Qevent_symbol_element_mask);
3231 if (CONSP (elements))
3232 return elements;
3233 else
3235 int end;
3236 int modifiers = parse_modifiers_uncached (symbol, &end);
3237 Lisp_Object unmodified;
3238 Lisp_Object mask;
3240 unmodified = Fintern (make_string (XSYMBOL (symbol)->name->data + end,
3241 XSYMBOL (symbol)->name->size - end),
3242 Qnil);
3244 if (modifiers & ~((1<<VALBITS) - 1))
3245 abort ();
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,
3251 elements);
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
3258 canonical. */
3260 return elements;
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. */
3273 static Lisp_Object
3274 apply_modifiers (modifiers, base)
3275 int modifiers;
3276 Lisp_Object 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);
3288 if (CONSP (entry))
3289 new_symbol = XCONS (entry)->cdr;
3290 else
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)))
3318 Lisp_Object kind;
3320 kind = Fget (base, Qevent_kind);
3321 if (! NILP (kind))
3322 Fput (new_symbol, Qevent_kind, kind);
3325 return new_symbol;
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. */
3337 Lisp_Object
3338 reorder_modifiers (symbol)
3339 Lisp_Object 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. */
3343 Lisp_Object parsed;
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
3358 in the table.
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. */
3380 static Lisp_Object
3381 modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist,
3382 name_table, symbol_table, table_size)
3383 int symbol_num;
3384 unsigned modifiers;
3385 Lisp_Object symbol_kind;
3386 Lisp_Object name_alist;
3387 char **name_table;
3388 Lisp_Object *symbol_table;
3389 int table_size;
3391 Lisp_Object value;
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)
3398 return Qnil;
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. */
3407 else
3409 if (! VECTORP (*symbol_table)
3410 || XVECTOR (*symbol_table)->size != table_size)
3412 Lisp_Object 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? */
3422 if (NILP (value))
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]);
3430 if (NILP (value))
3432 char buf[20];
3433 sprintf (buf, "key-%d", symbol_num);
3434 value = intern (buf);
3437 if (CONSP (*symbol_table))
3438 *symbol_table = Fcons (value, *symbol_table);
3439 else
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
3444 cares about. */
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.) */
3459 static void
3460 get_input_pending (addr)
3461 int *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))
3468 return;
3470 /* Try to read some input and see how much we get. */
3471 gobble_input (0);
3472 *addr = !NILP (Vquit_flag) || readable_events ();
3475 /* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */
3478 gobble_input (expected)
3479 int expected;
3481 #ifndef VMS
3482 #ifdef SIGIO
3483 if (interrupt_input)
3485 SIGMASKTYPE mask;
3486 mask = sigblockx (SIGIO);
3487 read_avail_input (expected);
3488 sigsetmask (mask);
3490 else
3491 #ifdef POLL_FOR_INPUT
3492 if (read_socket_hook && !interrupt_input && poll_suppress_count == 0)
3494 SIGMASKTYPE mask;
3495 mask = sigblockx (SIGALRM);
3496 read_avail_input (expected);
3497 sigsetmask (mask);
3499 else
3500 #endif
3501 #endif
3502 read_avail_input (expected);
3503 #endif
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;
3512 Lisp_Object tem;
3514 event.kind = buffer_switch_event;
3515 event.frame_or_window = Qnil;
3517 #ifdef subprocesses
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 ();
3523 if (NILP (tem))
3524 return;
3525 #else
3526 /* We never need these events if we have no asynchronous subprocesses. */
3527 return;
3528 #endif
3530 /* Make sure no interrupt happens while storing the event. */
3531 #ifdef SIGIO
3532 if (interrupt_input)
3534 SIGMASKTYPE mask;
3535 mask = sigblockx (SIGIO);
3536 kbd_buffer_store_event (&event);
3537 sigsetmask (mask);
3539 else
3540 #endif
3542 stop_polling ();
3543 kbd_buffer_store_event (&event);
3544 start_polling ();
3548 #ifndef VMS
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. */
3562 static int
3563 read_avail_input (expected)
3564 int expected;
3566 struct input_event buf[KBD_BUFFER_SIZE];
3567 register int i;
3568 int nread;
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);
3574 else
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];
3580 int n_to_read;
3582 /* Determine how many characters we should *try* to read. */
3583 #ifdef WINDOWSNT
3584 return 0;
3585 #else /* not WINDOWSNT */
3586 #ifdef MSDOS
3587 n_to_read = dos_keysns ();
3588 if (n_to_read == 0)
3589 return 0;
3590 #else /* not MSDOS */
3591 #ifdef FIONREAD
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);
3601 if (n_to_read == 0)
3602 return 0;
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);
3610 #else
3611 you lose;
3612 #endif
3613 #endif
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. */
3621 #ifdef MSDOS
3622 cbuf[0] = dos_keyread();
3623 nread = 1;
3624 #else
3625 nread = read (input_fd, cbuf, n_to_read);
3626 #endif
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. */
3632 if (nread == 0)
3633 kill (0, SIGHUP);
3634 #endif
3636 while (
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? */
3641 #if 0
3642 nread < 0 && (errno == EAGAIN
3643 #ifdef EFAULT
3644 || errno == EFAULT
3645 #endif
3646 #ifdef EBADSLT
3647 || errno == EBADSLT
3648 #endif
3650 #else
3652 #endif
3655 #ifndef FIONREAD
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;
3666 if (meta_key != 2)
3667 cbuf[i] &= ~0x80;
3669 buf[i].code = cbuf[i];
3670 #ifdef MULTI_FRAME
3671 XSETFRAME (buf[i].frame_or_window, selected_frame);
3672 #else
3673 buf[i].frame_or_window = Qnil;
3674 #endif
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)
3686 break;
3689 return nread;
3691 #endif /* not VMS */
3693 #ifdef SIGIO /* for entire page */
3694 /* Note SIGIO has been undef'd if FIONREAD is missing. */
3696 SIGTYPE
3697 input_available_signal (signo)
3698 int signo;
3700 /* Must preserve main program's value of errno. */
3701 int old_errno = errno;
3702 #ifdef BSD4_1
3703 extern int select_alarmed;
3704 #endif
3706 #ifdef USG
3707 /* USG systems forget handlers when they are used;
3708 must reestablish each time */
3709 signal (signo, input_available_signal);
3710 #endif /* USG */
3712 #ifdef BSD4_1
3713 sigisheld (SIGIO);
3714 #endif
3716 if (input_available_clear_time)
3717 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
3719 while (1)
3721 int nread;
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. */
3726 if (nread <= 0)
3727 break;
3729 #ifdef BSD4_1
3730 select_alarmed = 1; /* Force the select emulator back to life */
3731 #endif
3734 #ifdef BSD4_1
3735 sigfree ();
3736 #endif
3737 errno = old_errno;
3739 #endif /* SIGIO */
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. */
3747 void
3748 reinvoke_input_signal ()
3750 #ifdef SIGIO
3751 kill (0, SIGIO);
3752 #endif
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. */
3761 Lisp_Object
3762 map_prompt (map)
3763 Lisp_Object map;
3765 while (CONSP (map))
3767 register Lisp_Object tem;
3768 tem = Fcar (map);
3769 if (STRINGP (tem))
3770 return tem;
3771 map = Fcdr (map);
3773 return Qnil;
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:
3787 KEY STRING MAPLIST.
3789 OLD is an old vector we can optionally reuse, or nil. */
3791 Lisp_Object
3792 menu_bar_items (old)
3793 Lisp_Object old;
3795 /* The number of keymaps we're scanning right now, and the number of
3796 keymaps we have allocated space for. */
3797 int nmaps;
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. */
3801 Lisp_Object *maps;
3803 Lisp_Object def, tem, tail;
3805 Lisp_Object result;
3807 int mapno;
3808 Lisp_Object oquit;
3810 int i;
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;
3821 Vinhibit_quit = Qt;
3823 if (!NILP (old))
3824 menu_bar_items_vector = old;
3825 else
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. */
3837 Lisp_Object *tmaps;
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. */
3845 nmaps = 1;
3846 maps = (Lisp_Object *) alloca (nmaps * sizeof (maps[0]));
3848 else
3850 /* Yes, and it is non-nil. Use it and the global map. */
3851 nmaps = 2;
3852 maps = (Lisp_Object *) alloca (nmaps * sizeof (maps[0]));
3853 maps[0] = Voverriding_local_map;
3856 else
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);
3864 #else
3865 maps[nmaps-2] = current_buffer->keymap;
3866 #endif
3868 maps[nmaps-1] = current_global_map;
3871 /* Look up in each map the dummy prefix key `menu-bar'. */
3873 result = Qnil;
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));
3879 else
3880 def = Qnil;
3882 tem = Fkeymapp (def);
3883 if (!NILP (tem))
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)
3891 int i;
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];
3903 if (end > i + 3)
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;
3910 break;
3914 /* Add nil, nil, nil at the end. */
3915 i = menu_bar_items_index;
3916 if (i + 3 > XVECTOR (menu_bar_items_vector)->size)
3918 Lisp_Object tem;
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;
3932 UNGCPRO;
3933 return menu_bar_items_vector;
3936 /* Scan one map KEYMAP, accumulating any menu items it defines
3937 in menu_bar_items_vector. */
3939 static void
3940 menu_bar_one_keymap (keymap)
3941 Lisp_Object 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;
3949 if (CONSP (item))
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;
3966 int c;
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. */
3987 static Lisp_Object
3988 menu_bar_item_1 (arg)
3989 Lisp_Object arg;
3991 return Qnil;
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. */
3997 static void
3998 menu_bar_item (key, item_string, def)
3999 Lisp_Object key, item_string, def;
4001 Lisp_Object tem;
4002 Lisp_Object enabled;
4003 int i;
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;
4018 return;
4021 /* If there's no definition for this key yet,
4022 just ignore `undefined'. */
4023 return;
4026 /* See if this entry is enabled. */
4027 enabled = Qt;
4029 if (SYMBOLP (def))
4031 /* No property, or nil, means enable.
4032 Otherwise, enable if value is not nil. */
4033 tem = Fget (def, Qmenu_enable);
4034 if (!NILP (tem))
4035 /* (condition-case nil (eval tem)
4036 (error nil)) */
4037 enabled = internal_condition_case_1 (Feval, tem, Qerror,
4038 menu_bar_item_1);
4041 /* Ignore this item if it's not enabled. */
4042 if (NILP (enabled))
4043 return;
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]))
4048 break;
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)
4056 Lisp_Object tem;
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. */
4070 else
4072 Lisp_Object old;
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. */
4098 static Lisp_Object
4099 read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu)
4100 int nmaps;
4101 Lisp_Object *maps;
4102 Lisp_Object prev_event;
4103 int *used_mouse_menu;
4105 int mapno;
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)
4115 return Qnil;
4117 /* Optionally disregard all but the global map. */
4118 if (inhibit_local_menu_bar_menus)
4120 maps += (nmaps - 1);
4121 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]);
4128 if (!NILP (name))
4129 break;
4132 /* If we don't have any menus, just read a character normally. */
4133 if (mapno >= nmaps)
4134 return Qnil;
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));
4144 Lisp_Object value;
4145 int nmaps1 = 0;
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));
4153 if (CONSP (value))
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))
4163 value = Qt;
4164 if (used_mouse_menu)
4165 *used_mouse_menu = 1;
4166 return value;
4168 #endif /* (HAVE_X_WINDOWS && HAVE_X_MENU) || MSDOS */
4169 return Qnil ;
4172 static Lisp_Object
4173 read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
4174 int commandflag ;
4175 int nmaps;
4176 Lisp_Object *maps;
4178 int mapno;
4179 register Lisp_Object name;
4180 int nlength;
4181 int width = FRAME_WIDTH (selected_frame) - 4;
4182 char *menu = (char *) alloca (width + 4);
4183 int idx = -1;
4184 int nobindings = 1;
4185 Lisp_Object rest, vector;
4187 if (! menu_prompting)
4188 return Qnil;
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]);
4194 if (!NILP (name))
4195 break;
4198 /* If we don't have any menus, just read a character normally. */
4199 if (mapno >= nmaps)
4200 return Qnil;
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++] = ' ';
4207 menu[nlength] = 0;
4209 /* Start prompting at start of first map. */
4210 mapno = 0;
4211 rest = maps[mapno];
4213 /* Present the documented bindings, a line at a time. */
4214 while (1)
4216 int notfirst = 0;
4217 int i = nlength;
4218 Lisp_Object obj;
4219 int ch;
4220 int orig_defn_macro ;
4222 /* Loop over elements of map. */
4223 while (i < width)
4225 Lisp_Object s, elt;
4227 /* If reached end of map, start at beginning of next map. */
4228 if (NILP (rest))
4230 mapno++;
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. */
4233 if (mapno == nmaps)
4235 mapno = 0;
4236 if (notfirst || nobindings) break;
4238 rest = maps[mapno];
4241 /* Look at the next element of the map. */
4242 if (idx >= 0)
4243 elt = XVECTOR (vector)->contents[idx];
4244 else
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);
4252 vector = elt;
4253 idx = 0;
4255 else
4257 /* An ordinary element. */
4258 if ( idx < 0 )
4259 s = Fcar_safe (Fcdr_safe (elt)); /* alist */
4260 else
4261 s = Fcar_safe(elt); /* vector */
4262 if (!STRINGP (s))
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
4268 || !notfirst)
4270 int thiswidth;
4272 /* Punctuate between strings. */
4273 if (notfirst)
4275 strcpy (menu + i, ", ");
4276 i += 2;
4278 notfirst = 1;
4279 nobindings = 0 ;
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);
4286 i += thiswidth;
4287 menu[i] = 0;
4289 else
4291 /* If this element does not fit, end the line now,
4292 and save the element for the next line. */
4293 strcpy (menu + i, "...");
4294 break;
4297 /* Move past this element. */
4298 if (idx >= 0 && idx + 1 >= XVECTOR (vector)->size)
4299 /* Handle reaching end of dense table. */
4300 idx = -1;
4301 if (idx >= 0)
4302 idx++;
4303 else
4304 rest = Fcdr_safe (rest);
4308 /* Prompt with that and read response. */
4309 message1 (menu);
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))
4323 return obj;
4324 else
4325 ch = XINT (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) ;
4333 return 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
4349 NEXT.
4351 If KEY has no bindings in any of the CURRENT maps, NEXT is left
4352 unmodified.
4354 NEXT may == CURRENT. */
4356 static int
4357 follow_key (key, nmaps, current, defs, next)
4358 Lisp_Object key;
4359 Lisp_Object *current, *defs, *next;
4360 int nmaps;
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]))
4371 next[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
4376 disappear. */
4377 next[i] = get_keymap_1 (next[i], 0, 1);
4379 else
4380 next[i] = Qnil;
4382 current = next;
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]))
4393 first_binding = i;
4395 else
4396 defs[i] = Qnil;
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.
4409 Prompt with PROMPT.
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,
4427 then into clicks.
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
4432 whatever.
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. */
4441 static int
4442 read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last)
4443 Lisp_Object *keybuf;
4444 int bufsize;
4445 Lisp_Object prompt;
4446 int dont_downcase_last;
4448 int count = specpdl_ptr - specpdl;
4450 /* How many keys there are in the current key sequence. */
4451 int t;
4453 /* The length of the echo buffer when we started reading, and
4454 the length of this_command_keys when we started reading. */
4455 int echo_start;
4456 int keys_start;
4458 /* The number of keymaps we're scanning right now, and the number of
4459 keymaps we have allocated space for. */
4460 int nmaps;
4461 int nmaps_allocated = 0;
4463 /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
4464 the current keymaps. */
4465 Lisp_Object *defs;
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. */
4481 int first_binding;
4483 /* If t < mock_input, then KEYBUF[t] should be read as the next
4484 input key.
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. */
4496 int mock_input = 0;
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;
4520 #endif
4522 Lisp_Object original_uppercase;
4523 int original_uppercase_position = -1;
4525 /* Gets around Microsoft compiler limitations. */
4526 int dummyflag = 0;
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;
4535 int junk;
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;
4551 if (INTERACTIVE)
4553 if (!NILP (prompt))
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. */
4558 echo_dash ();
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. */
4563 if (INTERACTIVE)
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
4570 this work right. */
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,
4575 &junk);
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. */
4583 replay_sequence:
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. */
4595 Lisp_Object *maps;
4597 if (!NILP (Voverriding_local_map))
4599 nmaps = 2;
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;
4608 else
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;
4620 #else
4621 submaps[nmaps-2] = current_buffer->keymap;
4622 #endif
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]))
4630 break;
4632 /* Start from the beginning in keybuf. */
4633 t = 0;
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
4643 reading. */
4644 while ((first_binding < nmaps && ! NILP (submaps[first_binding]))
4645 || (first_binding >= nmaps
4646 && fkey_start < t
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. */
4658 Lisp_Object key;
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
4665 of keybuf. */
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
4671 just one key. */
4672 int echo_local_start, keys_local_start, local_first_binding;
4674 if (t >= bufsize)
4675 error ("key sequence too long");
4677 if (INTERACTIVE)
4678 echo_local_start = echo_length ();
4679 keys_local_start = this_command_key_count;
4680 local_first_binding = first_binding;
4682 replay_key:
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
4686 loop. */
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? */
4696 if (t < mock_input)
4698 key = keybuf[t];
4699 add_command_key (key);
4700 if (echo_keystrokes)
4701 echo_char (key);
4704 /* If not, we should actually read a character. */
4705 else
4707 struct buffer *buf = current_buffer;
4709 key = read_char (NILP (prompt), nmaps, submaps, last_nonmenu_event,
4710 &used_mouse_menu);
4712 /* read_char returns t when it shows a menu and the user rejects it.
4713 Just return -1. */
4714 if (EQ (key, Qt))
4715 return -1;
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)
4722 t = 0;
4723 /* The Microsoft C compiler can't handle the goto that
4724 would go here. */
4725 dummyflag = 1;
4726 break;
4729 /* If the current buffer has been changed from under us, the
4730 keymap may have changed, so replay the sequence. */
4731 if (BUFFERP (key))
4733 mock_input = t;
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)
4742 keybuf[t++] = key;
4743 mock_input = t;
4744 Vquit_flag = Qnil;
4745 goto replay_sequence;
4748 Vquit_flag = Qnil;
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
4758 here.
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))
4767 Lisp_Object kind;
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));
4776 if (CONSP (posn))
4778 /* We're looking at the second event of a
4779 sequence which we expanded before. Set
4780 last_real_key_start appropriately. */
4781 if (t > 0)
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
4790 && WINDOWP (window)
4791 && BUFFERP (XWINDOW (window)->buffer)
4792 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
4794 keybuf[t] = key;
4795 mock_input = t + 1;
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,
4806 emacsclient). */
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);
4825 if (INTEGERP (pos))
4827 map_here = get_local_map (XINT (pos), current_buffer);
4828 if (!EQ (map_here, orig_local_map))
4830 orig_local_map = map_here;
4831 keybuf[t] = key;
4832 mock_input = t + 1;
4834 goto replay_sequence;
4840 /* Expand mode-line and scroll-bar events into two events:
4841 use posn as a fake prefix key. */
4842 if (SYMBOLP (posn))
4844 if (t + 1 >= bufsize)
4845 error ("key sequence too long");
4846 keybuf[t] = posn;
4847 keybuf[t+1] = key;
4848 mock_input = t + 2;
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);
4854 goto replay_key;
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. */
4862 if (t > 0)
4864 delayed_switch_frame = key;
4865 goto replay_key;
4868 else if (CONSP (XCONS (key)->cdr)
4869 && CONSP (EVENT_START (key))
4870 && CONSP (XCONS (EVENT_START (key))->cdr))
4872 Lisp_Object posn;
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);
4888 keybuf[t] = posn;
4889 keybuf[t+1] = key;
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);
4896 mock_input = t + 2;
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
4911 to look up. */
4912 first_binding = (follow_key (key,
4913 nmaps - first_binding,
4914 submaps + first_binding,
4915 defs + first_binding,
4916 submaps + first_binding)
4917 + first_binding);
4919 /* If KEY wasn't bound, we'll try some fallbacks. */
4920 if (first_binding >= nmaps)
4922 Lisp_Object head;
4924 head = EVENT_HEAD (key);
4925 if (EQ (head, Vhelp_char))
4927 read_key_sequence_cmd = Vprefix_help_command;
4928 keybuf[t++] = key;
4929 last_nonmenu_event = key;
4930 /* The Microsoft C compiler can't handle the goto that
4931 would go here. */
4932 dummyflag = 1;
4933 break;
4936 if (SYMBOLP (head))
4938 Lisp_Object breakdown;
4939 int modifiers;
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;
4965 else
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
4973 mock input.
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
4979 anyway.
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)
5000 mock_input = 0;
5001 goto replay_key;
5003 else
5005 mock_input = last_real_key_start;
5006 goto replay_sequence;
5010 new_head
5011 = apply_modifiers (modifiers, XCONS (breakdown)->car);
5012 new_click
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. */
5018 first_binding
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)
5029 key = new_click;
5030 break;
5032 /* Otherwise, we'll leave key set to the drag event. */
5038 keybuf[t++] = key;
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
5051 && t >= mock_input)
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)
5060 Lisp_Object key;
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)
5067 fkey_next
5068 = get_keymap_1
5069 (get_keyelt
5070 (access_keymap (fkey_map, meta_prefix_char, 1, 0)),
5071 0, 1);
5072 XSETFASTINT (key, XFASTINT (key) & ~meta_modifier);
5074 else
5075 fkey_next = fkey_map;
5077 fkey_next
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))
5085 fkey_next = Qnil;
5086 #endif
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))
5092 && fkey_end == t)
5094 struct gcpro gcpro1, gcpro2, gcpro3;
5095 Lisp_Object tem;
5096 tem = fkey_next;
5098 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
5099 fkey_next = call1 (fkey_next, prompt);
5100 UNGCPRO;
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))
5116 && fkey_end == t)
5118 int len = XFASTINT (Flength (fkey_next));
5120 t = fkey_start + len;
5121 if (t >= bufsize)
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))
5130 int i;
5132 for (i = 0; i < len; i++)
5133 XSETFASTINT (keybuf[fkey_start + i],
5134 XSTRING (fkey_next)->data[i]);
5137 mock_input = t;
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
5151 fkey_start. */
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)
5168 Lisp_Object key;
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)
5175 keytran_next
5176 = get_keymap_1
5177 (get_keyelt
5178 (access_keymap (keytran_map, meta_prefix_char, 1, 0)),
5179 0, 1);
5180 XSETFASTINT (key, XFASTINT (key) & ~meta_modifier);
5182 else
5183 keytran_next = keytran_map;
5185 keytran_next
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;
5195 Lisp_Object tem;
5196 tem = keytran_next;
5198 GCPRO3 (fkey_map, keytran_map, delayed_switch_frame);
5199 keytran_next = call1 (keytran_next, prompt);
5200 UNGCPRO;
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;
5221 if (t >= bufsize)
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))
5230 int i;
5232 for (i = 0; i < len; i++)
5233 XSETFASTINT (keybuf[keytran_start + i],
5234 XSTRING (keytran_next)->data[i]);
5237 mock_input = t;
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
5252 keytran_start. */
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
5268 && INTEGERP (key)
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);
5279 else
5280 XSETINT (key, (DOWNCASE (XINT (key) & 0x3ffff)
5281 | (XINT (key) & ~0x3ffff)));
5283 keybuf[t - 1] = key;
5284 mock_input = t;
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
5293 && SYMBOLP (key))
5295 Lisp_Object breakdown;
5296 int modifiers;
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;
5310 mock_input = t;
5311 goto replay_sequence;
5316 if (!dummyflag)
5317 read_key_sequence_cmd = (first_binding < nmaps
5318 ? defs[first_binding]
5319 : Qnil);
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.
5335 Better ideas? */
5336 for (; t < mock_input; t++)
5338 if (echo_keystrokes)
5339 echo_char (keybuf[t]);
5340 add_command_key (keybuf[t]);
5343 return 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\
5369 ""\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)
5388 #endif
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];
5396 register int i;
5397 struct gcpro gcpro1, gcpro2;
5399 if (!NILP (prompt))
5400 CHECK_STRING (prompt, 0);
5401 QUIT;
5403 bzero (keybuf, sizeof keybuf);
5404 GCPRO1 (keybuf[0]);
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));
5413 if (i == -1)
5415 Vquit_flag = Qt;
5416 QUIT;
5418 UNGCPRO;
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.")
5428 (cmd, record)
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;
5442 if (SYMBOLP (cmd))
5444 tem = Fget (cmd, Qdisabled);
5445 if (!NILP (tem) && !NILP (Vrun_hooks))
5446 return call1 (Vrun_hooks, Qdisabled_command_hook);
5449 while (1)
5451 final = Findirect_function (cmd);
5453 if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
5454 do_autoload (final, cmd);
5455 else
5456 break;
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
5463 this. */
5464 if (!NILP (record))
5465 Vcommand_history
5466 = Fcons (Fcons (Qexecute_kbd_macro,
5467 Fcons (final, Fcons (prefixarg, Qnil))),
5468 Vcommand_history);
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;
5484 return tem;
5486 return Qnil;
5489 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
5490 1, 1, "P",
5491 "Read function name, then read its arguments and call it.")
5492 (prefixarg)
5493 Lisp_Object prefixarg;
5495 Lisp_Object function;
5496 char buf[40];
5497 Lisp_Object saved_keys;
5498 struct gcpro gcpro1;
5500 saved_keys = Fvector (this_command_key_count,
5501 XVECTOR (this_command_keys)->contents);
5502 buf[0] = 0;
5503 GCPRO1 (saved_keys);
5505 if (EQ (prefixarg, Qminus))
5506 strcpy (buf, "- ");
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
5522 history list. */
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;
5531 Lisp_Object *keys;
5532 int i;
5533 Lisp_Object tem;
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);
5552 UNGCPRO;
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 ()
5564 if (!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 ()
5575 input_pending = 0;
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)
5584 return (Qt);
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;
5594 Lisp_Object val;
5596 if (total_keys < NUM_RECENT_KEYS)
5597 return Fvector (total_keys, keys);
5598 else
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));
5604 bcopy (keys,
5605 XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
5606 recent_keys_index * sizeof (Lisp_Object));
5607 return val;
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.")
5624 Lisp_Object temp;
5625 XSETFASTINT (temp, command_loop_level + minibuf_level);
5626 return temp;
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.")
5633 (file)
5634 Lisp_Object file;
5636 if (NILP (file))
5638 if (dribble)
5640 fclose (dribble);
5641 dribble = 0;
5644 else
5646 file = Fexpand_file_name (file, Qnil);
5647 dribble = fopen (XSTRING (file)->data, "w");
5649 return Qnil;
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
5667 with that? */
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);
5671 input_pending = 0;
5673 return 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.")
5688 (stuffstring)
5689 Lisp_Object stuffstring;
5691 Lisp_Object tem;
5692 int count = specpdl_ptr - specpdl;
5693 int old_height, old_width;
5694 int width, height;
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);
5707 reset_sys_modes ();
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);
5712 if (cannot_suspend)
5713 sys_subshell ();
5714 else
5715 sys_suspend ();
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"));
5729 UNGCPRO;
5730 return Qnil;
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. */
5740 #ifdef BSD
5741 #ifndef BSD4_1
5742 register unsigned char *p;
5743 PERDISPLAY *perd;
5745 if (STRINGP (stuffstring))
5747 register int count;
5749 p = XSTRING (stuffstring)->data;
5750 count = XSTRING (stuffstring)->size;
5751 while (count-- > 0)
5752 stuff_char (*p++);
5753 stuff_char ('\n');
5755 /* Anything we have read ahead, put back for the shell to read. */
5756 #ifndef MULTI_PERDISPLAY
5757 perd = &the_only_perdisplay;
5758 #else
5759 /* ?? What should this do when we have multiple keyboards?? */
5760 perd = current_perdisplay;
5761 if (!perd)
5762 return;
5763 #endif
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
5772 - perd->kbd_buffer]
5773 = Qnil);
5774 perd->kbd_fetch_ptr++;
5776 input_pending = 0;
5777 #endif
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. */
5814 SIGTYPE
5815 interrupt_signal ()
5817 char c;
5818 /* Must preserve main program's value of errno. */
5819 int old_errno = errno;
5821 #ifdef USG
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);
5829 #endif /* USG */
5831 cancel_echoing ();
5833 if (!NILP (Vquit_flag) && FRAME_TERMCAP_P (selected_frame))
5835 fflush (stdout);
5836 reset_sys_modes ();
5837 sigfree ();
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.
5846 sys_suspend ();
5847 #else
5848 #ifdef VMS
5849 if (sys_suspend () == -1)
5851 printf ("Not running as a subprocess;\n");
5852 printf ("you can continue or abort.\n");
5854 #else /* not VMS */
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 */
5862 #ifdef MSDOS
5863 /* We must remain inside the screen area when the internal terminal
5864 is used. Note that [Enter] is not echoed by dos. */
5865 cursor_to (0, 0);
5866 #endif
5867 printf ("Auto-save? (y or n) ");
5868 fflush (stdout);
5869 if (((c = getchar ()) & ~040) == 'Y')
5871 Fdo_auto_save (Qt, Qnil);
5872 #ifdef MSDOS
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 ();
5879 #ifdef MSDOS
5880 printf ("\r\nAbort? (y or n) ");
5881 #else /* not MSDOS */
5882 #ifdef VMS
5883 printf ("Abort (and enter debugger)? (y or n) ");
5884 #else /* not VMS */
5885 printf ("Abort (and dump core)? (y or n) ");
5886 #endif /* not VMS */
5887 #endif /* not MSDOS */
5888 fflush (stdout);
5889 if (((c = getchar ()) & ~040) == 'Y')
5890 abort ();
5891 while (c != '\n') c = getchar ();
5892 #ifdef MSDOS
5893 printf ("\r\nContinuing...\r\n");
5894 #else /* not MSDOS */
5895 printf ("Continuing...\n");
5896 #endif /* not MSDOS */
5897 fflush (stdout);
5898 init_sys_modes ();
5900 else
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))
5907 immediate_quit = 0;
5908 sigfree ();
5909 Fsignal (Qquit, Qnil);
5911 else
5912 /* Else request quit when it's safe */
5913 Vquit_flag = Qt;
5916 if (waiting_for_input && !echoing)
5917 quit_throw_to_read_char ();
5919 errno = old_errno;
5922 /* Handle a C-g by making read_char return C-g. */
5924 quit_throw_to_read_char ()
5926 quit_error_check ();
5927 sigfree ();
5928 /* Prevent another signal from doing this before we finish. */
5929 clear_waiting_for_input ();
5930 input_pending = 0;
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)
5938 abort ();
5939 #endif
5940 #ifdef MULTI_FRAME
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));
5944 #endif
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;
5963 if (!NILP (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
5968 stop_polling ();
5969 #endif
5971 reset_sys_modes ();
5972 #ifdef SIGIO
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. */
5977 else
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. */
5984 #ifdef VMS
5985 interrupt_input = 1;
5986 #endif
5987 flow_control = !NILP (flow);
5988 if (NILP (meta))
5989 meta_key = 0;
5990 else if (EQ (meta, Qt))
5991 meta_key = 1;
5992 else
5993 meta_key = 2;
5994 if (!NILP (quit))
5995 /* Don't let this value be out of range. */
5996 quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
5998 init_sys_modes ();
6000 #ifdef POLL_FOR_INPUT
6001 poll_suppress_count = 1;
6002 start_polling ();
6003 #endif
6004 return Qnil;
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\
6020 `set-input-mode'.")
6023 Lisp_Object val[4];
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.
6037 void
6038 init_perdisplay (perd)
6039 PERDISPLAY *perd;
6041 perd->Vprefix_arg = Qnil;
6042 perd->Vcurrent_prefix_arg = Qnil;
6043 perd->kbd_buffer
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
6055 * it a second time.
6057 void
6058 wipe_perdisplay (perd)
6059 PERDISPLAY *perd;
6061 xfree (perd->kbd_buffer);
6064 init_keyboard ()
6066 /* This is correct before outermost invocation of the editor loop */
6067 command_loop_level = -1;
6068 immediate_quit = 0;
6069 quit_char = Ctl ('g');
6070 Vunread_command_events = Qnil;
6071 unread_command_char = -1;
6072 total_keys = 0;
6073 recent_keys_index = 0;
6074 #ifdef HAVE_MOUSE
6075 do_mouse_tracking = Qnil;
6076 #endif
6077 input_pending = 0;
6079 #ifdef MULTI_FRAME
6080 /* This means that command_loop_1 won't try to select anything the first
6081 time through. */
6082 internal_last_event_frame = Qnil;
6083 Vlast_event_frame = internal_last_event_frame;
6084 #endif
6086 #ifndef MULTI_PERDISPLAY
6087 if (initialized)
6088 wipe_perdisplay (&the_only_perdisplay);
6089 init_perdisplay (&the_only_perdisplay);
6090 #endif
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. */
6102 #ifdef SIGIO
6103 if (!noninteractive)
6104 signal (SIGIO, input_available_signal);
6105 #endif /* SIGIO */
6107 /* Use interrupt input by default, if it works and noninterrupt input
6108 has deficiencies. */
6110 #ifdef INTERRUPT_INPUT
6111 interrupt_input = 1;
6112 #else
6113 interrupt_input = 0;
6114 #endif
6116 /* Our VMS input only works by interrupts, as of now. */
6117 #ifdef VMS
6118 interrupt_input = 1;
6119 #endif
6121 sigfree ();
6122 dribble = 0;
6124 if (keyboard_init_hook)
6125 (*keyboard_init_hook) ();
6127 #ifdef POLL_FOR_INPUT
6128 poll_suppress_count = 1;
6129 start_polling ();
6130 #endif
6133 /* This type's only use is in syms_of_keyboard, to initialize the
6134 event header symbols and put properties on them. */
6135 struct event_head {
6136 Lisp_Object *var;
6137 char *name;
6138 Lisp_Object *kind;
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,
6150 syms_of_keyboard ()
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]));
6228 p++)
6230 *p->var = intern (p->name);
6231 staticpro (p->var);
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);
6241 int i;
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);
6270 mouse_syms = Qnil;
6271 staticpro (&mouse_syms);
6273 unread_switch_frame = Qnil;
6274 staticpro (&unread_switch_frame);
6276 defsubr (&Sread_key_sequence);
6277 defsubr (&Srecursive_edit);
6278 #ifdef HAVE_MOUSE
6279 defsubr (&Strack_mouse);
6280 #endif
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\
6333 command exit.\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.");
6366 polling_period = 2;
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.");
6381 num_input_keys = 0;
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.");
6398 Vhelp_form = Qnil;
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.");
6409 Vtop_level = Qnil;
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.");
6426 cannot_suspend = 0;
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.");
6436 menu_prompting = 1;
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;
6506 #ifdef HAVE_MOUSE
6507 DEFVAR_LISP ("track-mouse", &do_mouse_tracking,
6508 "*Non-nil means generate motion events for mouse motion.");
6509 #endif
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.");
6548 keys_of_keyboard ()
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");