--- /dev/null
+/* Keyboard and mouse input; editor command loop.
+ Copyright (C) 1985, 1986, 1987, 1988, 1989 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 1, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING. If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+/* Allow config.h to undefine symbols found here. */
+#include <signal.h>
+
+#include "config.h"
+#include <stdio.h>
+#undef NULL
+#include "termchar.h"
+#include "termopts.h"
+#include "lisp.h"
+#include "termhooks.h"
+#include "macros.h"
+#include "screen.h"
+#include "window.h"
+#include "commands.h"
+#include "buffer.h"
+#include "disptab.h"
+#include "keyboard.h"
+#include <setjmp.h>
+#include <errno.h>
+
+#include "emacssignal.h"
+
+extern int errno;
+
+/* Get FIONREAD, if it is available. */
+#ifdef USG
+#include <termio.h>
+#include <fcntl.h>
+#else /* not USG */
+#ifndef VMS
+#include <sys/ioctl.h>
+#endif /* not VMS */
+#endif /* not USG */
+
+/* UNIPLUS systems may have FIONREAD. */
+#ifdef UNIPLUS
+#include <sys.ioctl.h>
+#endif
+
+#ifdef HAVE_X_WINDOWS
+extern Lisp_Object Vmouse_grabbed;
+
+/* Make all keyboard buffers much bigger when using X windows. */
+#define KBD_BUFFER_SIZE 4096
+#else /* No X-windows, character input */
+#define KBD_BUFFER_SIZE 256
+#endif /* No X-windows */
+
+/* Following definition copied from eval.c */
+
+struct backtrace
+ {
+ struct backtrace *next;
+ Lisp_Object *function;
+ Lisp_Object *args; /* Points to vector of args. */
+ int nargs; /* length of vector. If nargs is UNEVALLED,
+ args points to slot holding list of
+ unevalled args */
+ char evalargs;
+ };
+
+/* Non-nil disable property on a command means
+ do not execute it; call disabled-command-hook's value instead. */
+Lisp_Object Qdisabled, Vdisabled_command_hook;
+
+#define NUM_RECENT_KEYS (100)
+int recent_keys_index; /* Index for storing next element into recent_keys */
+int total_keys; /* Total number of elements stored into recent_keys */
+Lisp_Object recent_keys[NUM_RECENT_KEYS]; /* Holds last 100 keystrokes */
+
+/* Buffer holding the key that invoked the current command. */
+Lisp_Object *this_command_keys;
+int this_command_key_count; /* Size in use. */
+int this_command_keys_size; /* Size allocated. */
+
+extern int minbuf_level;
+
+extern struct backtrace *backtrace_list;
+
+/* Nonzero means do menu prompting. */
+static int menu_prompting;
+
+/* Character to see next line of menu prompt. */
+static Lisp_Object menu_prompt_more_char;
+
+/* For longjmp to where kbd input is being done. */
+static jmp_buf getcjmp;
+
+/* True while doing kbd input. */
+int waiting_for_input;
+
+/* True while displaying for echoing. Delays C-g throwing. */
+static int echoing;
+
+/* Nonzero means C-G should cause immediate error-signal. */
+int immediate_quit;
+
+/* Character to recognize as the help char. */
+Lisp_Object help_char;
+
+/* Form to execute when help char is typed. */
+Lisp_Object Vhelp_form;
+
+/* Character that causes a quit. Normally C-g.
+
+ If we are running on an ordinary terminal, this must be an ordinary
+ ASCII char, since we want to make it our interrupt character.
+
+ If we are not running on an ordinary terminal, it still needs to be
+ an ordinary ASCII char. This character needs to be recognized in
+ the input interrupt handler. At this point, the keystroke is
+ represented as a struct input_event, while the desired quit
+ character is specified as a lispy event. The mapping from struct
+ input_events to lispy events cannot run in an interrupt handler,
+ and the reverse mapping is difficult for anything but ASCII
+ keystrokes.
+
+ FOR THESE ELABORATE AND UNSATISFYING REASONS, quit_char must be an
+ ASCII character. */
+int quit_char;
+
+extern Lisp_Object current_global_map;
+extern int minibuf_level;
+
+/* Current depth in recursive edits. */
+int command_loop_level;
+
+/* Total number of times command_loop has read a key sequence. */
+int num_input_keys;
+
+/* Last input character read as a command. */
+Lisp_Object last_command_char;
+
+/* Last input character read for any purpose. */
+Lisp_Object last_input_char;
+
+/* If not Qnil, an object to be read as the next command input. */
+Lisp_Object unread_command_char;
+
+/* Char to use as prefix when a meta character is typed in.
+ This is bound on entry to minibuffer in case ESC is changed there. */
+
+Lisp_Object meta_prefix_char;
+
+/* Last size recorded for a current buffer which is not a minibuffer. */
+static int last_non_minibuf_size;
+
+/* Number of idle seconds before an auto-save. */
+static Lisp_Object Vauto_save_timeout;
+
+/* Total number of times read_char has returned. */
+int num_input_chars;
+
+/* Auto-save automatically when this many characters have been typed
+ since the last time. */
+
+static int auto_save_interval;
+
+/* Value of num_input_chars as of last auto save. */
+
+int last_auto_save;
+
+/* Last command executed by the editor command loop, not counting
+ commands that set the prefix argument. */
+
+Lisp_Object last_command;
+
+/* The command being executed by the command loop.
+ Commands may set this, and the value set will be copied into last_command
+ instead of the actual command. */
+Lisp_Object this_command;
+
+#ifndef HAVE_X11
+/* Window of last mouse click. */
+extern Lisp_Object Vmouse_window;
+
+/* List containing details of last mouse click. */
+extern Lisp_Object Vmouse_event;
+#endif /* defined HAVE_X11 */
+
+/* Hook to call on each mouse event after running its definition. */
+Lisp_Object Vmouse_event_function;
+
+/* Hook to call when mouse leaves screen. */
+Lisp_Object Vmouse_left_hook;
+
+/* Hook to call when a screen is mapped. */
+Lisp_Object Vmap_screen_hook;
+
+/* Hook to call when a screen is unmapped. */
+Lisp_Object Vunmap_screen_hook;
+
+/* Handler for non-grabbed (no keys depressed) mouse motion. */
+Lisp_Object Vmouse_motion_handler;
+
+/* The screen in which the last input event occurred.
+ command_loop_1 will select this screen before running the
+ command bound to an event sequence, and read_key_sequence will
+ toss the existing prefix if the user starts typing at a
+ new screen. */
+Lisp_Object Vlast_event_screen;
+
+/* X Windows wants this for selection ownership. */
+unsigned long last_event_timestamp;
+
+Lisp_Object Qself_insert_command;
+Lisp_Object Qforward_char;
+Lisp_Object Qbackward_char;
+
+/* read_key_sequence stores here the command definition of the
+ key sequence that it reads. */
+Lisp_Object read_key_sequence_cmd;
+
+/* Form to evaluate (if non-nil) when Emacs is started. */
+Lisp_Object Vtop_level;
+
+/* User-supplied string to translate input characters through. */
+Lisp_Object Vkeyboard_translate_table;
+
+/* Keymap mapping ASCII function key sequences onto their preferred forms. */
+extern Lisp_Object Vfunction_key_map;
+
+/* File in which we write all commands we read. */
+FILE *dribble;
+
+/* Nonzero if input is available. */
+int input_pending;
+
+/* Nonzero if should obey 0200 bit in input chars as "Meta". */
+int meta_key;
+
+extern char *pending_malloc_warning;
+
+/* Circular buffer for pre-read keyboard input. */
+static struct input_event kbd_buffer[KBD_BUFFER_SIZE];
+
+/* Pointer to next available character in kbd_buffer.
+ If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty.
+ This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the the
+ next available char is in kbd_buffer[0]. */
+static struct input_event *kbd_fetch_ptr;
+
+/* Pointer to next place to store character in kbd_buffer. This
+ may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next
+ character should go in kbd_buffer[0]. */
+static struct input_event *kbd_store_ptr;
+
+/* The above pair of variables forms a "queue empty" flag. When we
+ enqueue a non-hook event, we increment kbd_write_count. When we
+ dequeue a non-hook event, we increment kbd_read_count. We say that
+ there is input available iff the two counters are equal.
+
+ Why not just have a flag set and cleared by the enqueuing and
+ dequeuing functions? Such a flag could be screwed up by interrupts
+ at inopportune times. */
+
+/* If this flag is non-zero, mouse movement events will appear in the
+ input stream. If is zero, mouse movement will be ignored. */
+int do_mouse_tracking;
+
+/* The window system handling code should set this if the mouse has
+ moved since the last call to the mouse_position_hook. Calling that
+ hook should clear this. Code assumes that if this is set, it can
+ call mouse_position_hook to get the promised position, so don't set
+ it unless you're prepared to substantiate the claim! */
+int mouse_moved;
+
+/* True iff there is an event in kbd_buffer, or if mouse tracking is
+ enabled and there is a new mouse position in the mouse movement
+ buffer. Note that if this is false, that doesn't mean that there
+ is readable input; all the events in the queue might be button-up
+ events, and do_mouse_tracking might be off. */
+#define EVENT_QUEUES_EMPTY \
+ ((kbd_fetch_ptr == kbd_store_ptr) && (!do_mouse_tracking || !mouse_moved))
+
+
+/* Symbols to head events. */
+Lisp_Object Qmouse_movement;
+
+Lisp_Object Qvscrollbar_part;
+Lisp_Object Qvslider_part;
+Lisp_Object Qvthumbup_part;
+Lisp_Object Qvthumbdown_part;
+
+Lisp_Object Qhscrollbar_part;
+Lisp_Object Qhslider_part;
+Lisp_Object Qhthumbleft_part;
+Lisp_Object Qhthumbright_part;
+
+/* Symbols to denote kinds of events. */
+Lisp_Object Qfunction_key;
+Lisp_Object Qmouse_click;
+/* Lisp_Object Qmouse_movement; - also an event header */
+Lisp_Object Qscrollbar_click;
+
+/* Properties of event headers. */
+Lisp_Object Qevent_kind;
+Lisp_Object Qevent_unmodified;
+
+/* Symbols to use for non-text mouse positions. */
+Lisp_Object Qmode_line;
+Lisp_Object Qvertical_split;
+
+
+/* Address (if not 0) of word to zero out if a SIGIO interrupt happens. */
+long *input_available_clear_word;
+
+/* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
+ Default is 1 if INTERRUPT_INPUT is defined. */
+int interrupt_input;
+
+/* Nonzero while interrupts are temporarily deferred during redisplay. */
+int interrupts_deferred;
+
+/* nonzero means use ^S/^Q for flow control. */
+int flow_control;
+
+#ifndef BSD4_1
+#define sigfree() sigsetmask (SIGEMPTYMASK)
+#define sigholdx(sig) sigsetmask (sigmask (sig))
+#define sigblockx(sig) sigblock (sigmask (sig))
+#define sigunblockx(sig) sigblock (SIGEMPTYMASK)
+#define sigpausex(sig) sigpause (0)
+#endif /* not BSD4_1 */
+
+#ifdef BSD4_1
+#define SIGIO SIGTINT
+/* sigfree and sigholdx are in sysdep.c */
+#define sigblockx(sig) sighold (sig)
+#define sigunblockx(sig) sigrelse (sig)
+#define sigpausex(sig) sigpause (sig)
+#endif /* BSD4_1 */
+
+/* Allow m- file to inhibit use of FIONREAD. */
+#ifdef BROKEN_FIONREAD
+#undef FIONREAD
+#endif
+
+/* We are unable to use interrupts if FIONREAD is not available,
+ so flush SIGIO so we won't try. */
+#ifndef FIONREAD
+#ifdef SIGIO
+#undef SIGIO
+#endif
+#endif
+
+/* If we support X Windows, and won't get an interrupt when input
+ arrives from the server, poll periodically so we can detect C-g. */
+#ifdef HAVE_X_WINDOWS
+#ifndef SIGIO
+#define POLL_FOR_INPUT
+#endif
+#endif
+\f
+/* Global variable declarations. */
+
+/* Function for init_keyboard to call with no args (if nonzero). */
+void (*keyboard_init_hook) ();
+
+static int read_avail_input ();
+static void get_input_pending ();
+
+/* > 0 if we are to echo keystrokes. */
+static int echo_keystrokes;
+
+/* Nonzero means echo each character as typed. */
+static int immediate_echo;
+
+/* The text we're echoing in the modeline - partial key sequences,
+ usually. '\0'-terminated. */
+static char echobuf[100];
+
+/* Where to append more text to echobuf if we want to. */
+static char *echoptr;
+
+#define min(a,b) ((a)<(b)?(a):(b))
+#define max(a,b) ((a)>(b)?(a):(b))
+
+/* Install the string STR as the beginning of the string of echoing,
+ so that it serves as a prompt for the next character.
+ Also start echoing. */
+
+echo_prompt (str)
+ char *str;
+{
+ int len = strlen (str);
+ if (len > sizeof echobuf - 4)
+ len = sizeof echobuf - 4;
+ bcopy (str, echobuf, len + 1);
+ echoptr = echobuf + len;
+
+ echo ();
+}
+
+/* Add C to the echo string, if echoing is going on.
+ C can be a character, which is printed prettily ("M-C-x" and all that
+ jazz), or a symbol, whose name is printed. */
+
+echo_char (c)
+ Lisp_Object c;
+{
+ extern char *push_key_description ();
+
+ if (immediate_echo)
+ {
+ char *ptr = echoptr;
+
+ if (ptr != echobuf)
+ *ptr++ = ' ';
+
+ /* If someone has passed us a composite event, use its head symbol. */
+ if (EVENT_HAS_PARAMETERS (c))
+ c = EVENT_HEAD (c);
+
+ if (XTYPE (c) == Lisp_Int)
+ {
+ if (ptr - echobuf > sizeof echobuf - 6)
+ return;
+
+ ptr = push_key_description (c, ptr);
+ }
+ else if (XTYPE (c) == Lisp_Symbol)
+ {
+ struct Lisp_String *name = XSYMBOL (c)->name;
+ if (((ptr - echobuf) + name->size + 4) > sizeof echobuf)
+ return;
+ bcopy (name->data, ptr, name->size);
+ ptr += name->size;
+ }
+
+ if (echoptr == echobuf && c == help_char)
+ {
+ strcpy (ptr, " (Type ? for further options)");
+ ptr += strlen (ptr);
+ }
+
+ *ptr = 0;
+ echoptr = ptr;
+
+ echo ();
+ }
+}
+
+/* Temporarily add a dash to the end of the echo string if it's not
+ empty, so that it serves as a mini-prompt for the very next character. */
+
+echo_dash ()
+{
+ if (!immediate_echo && echoptr == echobuf)
+ return;
+
+ /* Put a dash at the end of the buffer temporarily,
+ but make it go away when the next character is added. */
+ echoptr[0] = '-';
+ echoptr[1] = 0;
+
+ echo ();
+}
+
+/* Display the current echo string, and begin echoing if not already
+ doing so. */
+
+echo ()
+{
+ if (!immediate_echo)
+ {
+ int i;
+ immediate_echo = 1;
+
+ for (i = 0; i < this_command_key_count; i++)
+ echo_char (this_command_keys[i]);
+ echo_dash ();
+ }
+
+ echoing = 1;
+ message1 (echobuf);
+ echoing = 0;
+
+ if (waiting_for_input && !NILP (Vquit_flag))
+ quit_throw_to_read_char ();
+}
+
+/* Turn off echoing, for the start of a new command. */
+
+cancel_echoing ()
+{
+ immediate_echo = 0;
+ echoptr = echobuf;
+}
+
+/* Return the length of the current echo string. */
+
+static int
+echo_length ()
+{
+ return echoptr - echobuf;
+}
+
+/* Truncate the current echo message to its first LEN chars.
+ This and echo_char get used by read_key_sequence when the user
+ switches screens while entering a key sequence. */
+
+static void
+echo_truncate (len)
+ int len;
+{
+ echobuf[len] = '\0';
+ echoptr = echobuf + strlen (echobuf);
+}
+
+\f
+/* Functions for manipulating this_command_keys. */
+static void
+add_command_key (key)
+ Lisp_Object key;
+{
+ if (this_command_key_count == this_command_keys_size)
+ {
+ this_command_keys_size *= 2;
+ this_command_keys
+ = (Lisp_Object *) xrealloc (this_command_keys,
+ (this_command_keys_size
+ * sizeof (Lisp_Object)));
+ }
+ this_command_keys[this_command_key_count++] = key;
+}
+\f
+Lisp_Object
+recursive_edit_1 ()
+{
+ int count = specpdl_ptr - specpdl;
+ Lisp_Object val;
+
+ if (command_loop_level > 0)
+ {
+ specbind (Qstandard_output, Qt);
+ specbind (Qstandard_input, Qt);
+ }
+
+ val = command_loop ();
+ if (EQ (val, Qt))
+ Fsignal (Qquit, Qnil);
+
+ unbind_to (count);
+ return Qnil;
+}
+
+/* When an auto-save happens, record the "time", and don't do again soon. */
+record_auto_save ()
+{
+ last_auto_save = num_input_chars;
+}
+\f
+Lisp_Object recursive_edit_unwind (), command_loop ();
+
+DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
+ "Invoke the editor command loop recursively.\n\
+To get out of the recursive edit, a command can do `(throw 'exit nil)';\n\
+that tells this function to return.\n\
+Alternately, `(throw 'exit t)' makes this function signal an error.\n\
+This function is called by the editor initialization to begin editing.")
+ ()
+{
+ int count = specpdl_ptr - specpdl;
+ Lisp_Object val;
+
+ command_loop_level++;
+ update_mode_lines = 1;
+
+ record_unwind_protect (recursive_edit_unwind,
+ (command_loop_level
+ && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
+ ? Fcurrent_buffer ()
+ : Qnil);
+ recursive_edit_1 ();
+ return unbind_to (count, Qnil);
+}
+
+Lisp_Object
+recursive_edit_unwind (buffer)
+ Lisp_Object buffer;
+{
+ if (!NILP (buffer))
+ Fset_buffer (buffer);
+
+ command_loop_level--;
+ update_mode_lines = 1;
+ return Qnil;
+}
+\f
+Lisp_Object
+cmd_error (data)
+ Lisp_Object data;
+{
+ Lisp_Object errmsg, tail, errname, file_error;
+ Lisp_Object stream;
+ struct gcpro gcpro1;
+ int i;
+
+ Vquit_flag = Qnil;
+ Vinhibit_quit = Qt;
+ Vstandard_output = Qt;
+ Vstandard_input = Qt;
+ Vexecuting_macro = Qnil;
+ echo_area_glyphs = 0;
+
+ /* If the window system or terminal screen hasn't been initialized
+ yet, or we're not interactive, it's best to dump this message out
+ to stderr and exit. */
+ if (! SCREEN_MESSAGE_BUF (selected_screen)
+ || noninteractive)
+ stream = Qexternal_debugging_output;
+ else
+ {
+ Fdiscard_input ();
+ bitch_at_user ();
+ stream = Qt;
+ }
+
+ errname = Fcar (data);
+
+ if (EQ (errname, Qerror))
+ {
+ data = Fcdr (data);
+ if (!CONSP (data)) data = Qnil;
+ errmsg = Fcar (data);
+ file_error = Qnil;
+ }
+ else
+ {
+ errmsg = Fget (errname, Qerror_message);
+ file_error = Fmemq (Qfile_error,
+ Fget (errname, Qerror_conditions));
+ }
+
+ /* Print an error message including the data items.
+ This is done by printing it into a scratch buffer
+ and then making a copy of the text in the buffer. */
+
+ if (!CONSP (data)) data = Qnil;
+ tail = Fcdr (data);
+ GCPRO1 (tail);
+
+ /* For file-error, make error message by concatenating
+ all the data items. They are all strings. */
+ if (!NILP (file_error) && !NILP (tail))
+ errmsg = XCONS (tail)->car, tail = XCONS (tail)->cdr;
+
+ if (XTYPE (errmsg) == Lisp_String)
+ Fprinc (errmsg, stream);
+ else
+ write_string_1 ("peculiar error", -1, stream);
+
+ for (i = 0; CONSP (tail); tail = Fcdr (tail), i++)
+ {
+ write_string_1 (i ? ", " : ": ", 2, stream);
+ if (!NILP (file_error))
+ Fprinc (Fcar (tail), stream);
+ else
+ Fprin1 (Fcar (tail), stream);
+ }
+ UNGCPRO;
+
+ /* If the window system or terminal screen hasn't been initialized
+ yet, or we're in -batch mode, this error should cause Emacs to exit. */
+ if (! SCREEN_MESSAGE_BUF (selected_screen)
+ || noninteractive)
+ {
+ Fterpri (stream);
+ Fkill_emacs (make_number (-1));
+ }
+
+ Vquit_flag = Qnil;
+
+ Vinhibit_quit = Qnil;
+ return make_number (0);
+}
+\f
+Lisp_Object command_loop_1 ();
+Lisp_Object command_loop_2 ();
+Lisp_Object top_level_1 ();
+
+/* Entry to editor-command-loop.
+ This level has the catches for exiting/returning to editor command loop.
+ It returns nil to exit recursive edit, t to abort it. */
+
+Lisp_Object
+command_loop ()
+{
+ if (command_loop_level > 0 || minibuf_level > 0)
+ {
+ return internal_catch (Qexit, command_loop_2, Qnil);
+ }
+ else
+ while (1)
+ {
+ internal_catch (Qtop_level, top_level_1, Qnil);
+ internal_catch (Qtop_level, command_loop_2, Qnil);
+
+ /* End of file in -batch run causes exit here. */
+ if (noninteractive)
+ Fkill_emacs (Qt);
+ }
+}
+
+/* Here we catch errors in execution of commands within the
+ editing loop, and reenter the editing loop.
+ When there is an error, cmd_error runs and returns a non-nil
+ value to us. A value of nil means that cmd_loop_1 itself
+ returned due to end of file (or end of kbd macro). */
+
+Lisp_Object
+command_loop_2 ()
+{
+ register Lisp_Object val;
+
+ do
+ val = internal_condition_case (command_loop_1, Qerror, cmd_error);
+ while (!NILP (val));
+
+ return Qnil;
+}
+
+Lisp_Object
+top_level_2 ()
+{
+ return Feval (Vtop_level);
+}
+
+Lisp_Object
+top_level_1 ()
+{
+ /* On entry to the outer level, run the startup file */
+ if (!NILP (Vtop_level))
+ internal_condition_case (top_level_2, Qerror, cmd_error);
+ else if (!NILP (Vpurify_flag))
+ message ("Bare impure Emacs (standard Lisp code not loaded)");
+ else
+ message ("Bare Emacs (standard Lisp code not loaded)");
+ return Qnil;
+}
+
+DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "",
+ "Exit all recursive editing levels.")
+ ()
+{
+ Fthrow (Qtop_level, Qnil);
+}
+
+DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "",
+ "Exit from the innermost recursive edit or minibuffer.")
+ ()
+{
+ if (command_loop_level > 0 || minibuf_level > 0)
+ Fthrow (Qexit, Qnil);
+
+ error ("No recursive edit is in progress");
+}
+
+DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, 0, "",
+ "Abort the command that requested this recursive edit or minibuffer input.")
+ ()
+{
+ if (command_loop_level > 0 || minibuf_level > 0)
+ Fthrow (Qexit, Qt);
+
+ error ("No recursive edit is in progress");
+}
+\f
+/* This is the actual command reading loop,
+ sans error-handling encapsulation. */
+
+Lisp_Object Fcommand_execute ();
+static int read_key_sequence ();
+
+Lisp_Object
+command_loop_1 ()
+{
+ Lisp_Object cmd;
+ int lose;
+ int nonundocount;
+ Lisp_Object keybuf[30];
+ int i;
+ int no_redisplay;
+ int no_direct;
+
+ Vprefix_arg = Qnil;
+ waiting_for_input = 0;
+ cancel_echoing ();
+
+ /* Don't clear out last_command at the beginning of a macro. */
+ if (XTYPE (Vexecuting_macro) != Lisp_String)
+ last_command = Qt;
+
+ nonundocount = 0;
+ no_redisplay = 0;
+ this_command_key_count = 0;
+
+ while (1)
+ {
+ /* Install chars successfully executed in kbd macro. */
+
+ if (defining_kbd_macro && NILP (Vprefix_arg))
+ finalize_kbd_macro_chars ();
+
+ /* Make sure the current window's buffer is selected. */
+ if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)
+ set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer));
+
+ /* Display any malloc warning that just came out. Use while because
+ displaying one warning can cause another. */
+
+ while (pending_malloc_warning)
+ display_malloc_warning ();
+
+ no_direct = 0;
+
+ /* If minibuffer on and echo area in use,
+ wait 2 sec and redraw minibufer. */
+
+ if (minibuf_level && echo_area_glyphs)
+ {
+ Fsit_for (make_number (2), Qnil, Qnil);
+ echo_area_glyphs = 0;
+ no_direct = 1;
+ if (!NILP (Vquit_flag))
+ {
+ Vquit_flag = Qnil;
+ unread_command_char = make_number (quit_char);
+ }
+ }
+
+#ifdef C_ALLOCA
+ alloca (0); /* Cause a garbage collection now */
+ /* Since we can free the most stuff here. */
+#endif /* C_ALLOCA */
+
+ /* Read next key sequence; i gets its length. */
+ i = read_key_sequence (keybuf, (sizeof keybuf / sizeof (keybuf[0])), 0);
+
+ ++num_input_keys;
+
+#ifdef MULTI_SCREEN
+ /* Select the screen that the key sequence came from. */
+ if (XTYPE (Vlast_event_screen) == Lisp_Screen
+ && XSCREEN (Vlast_event_screen) != selected_screen)
+ Fselect_screen (Vlast_event_screen, Qnil);
+#endif
+
+ /* Now we have read a key sequence of length I,
+ or else I is 0 and we found end of file. */
+
+ if (i == 0) /* End of file -- happens only in */
+ return Qnil; /* a kbd macro, at the end. */
+
+#if 0
+#ifdef HAVE_X_WINDOWS
+ if (SCREEN_IS_X (selected_screen))
+ {
+ if (i == -1) /* Mouse event */
+ {
+ nonundocount = 0;
+ if (NILP (Vprefix_arg) && NILP (Vexecuting_macro) &&
+ !EQ (minibuf_window, selected_window))
+ Fundo_boundary ();
+
+ if (defining_kbd_macro)
+ {
+ /* Be nice if this worked... */
+ }
+ Fexecute_mouse_event (read_key_sequence_cmd);
+ no_redisplay = 0;
+ goto directly_done;
+ }
+
+ if (i == -2) /* Lisp Symbol */
+ {
+ nonundocount = 0;
+ if (NILP (Vprefix_arg) && NILP (Vexecuting_macro) &&
+ !EQ (minibuf_window, selected_window))
+ Fundo_boundary ();
+
+ goto directly_done;
+ }
+ }
+#endif /* HAVE_X_WINDOWS */
+#endif
+
+ last_command_char = keybuf[i - 1];
+
+ cmd = read_key_sequence_cmd;
+ if (!NILP (Vexecuting_macro))
+ {
+ if (!NILP (Vquit_flag))
+ {
+ Vexecuting_macro = Qt;
+ QUIT; /* Make some noise. */
+ /* Will return since macro now empty. */
+ }
+ }
+
+ /* Do redisplay processing after this command except in special
+ cases identified below that set no_redisplay to 1. */
+ no_redisplay = 0;
+
+ /* Execute the command. */
+
+ if (NILP (cmd))
+ {
+ /* nil means key is undefined. */
+ bitch_at_user ();
+ defining_kbd_macro = 0;
+ update_mode_lines = 1;
+ Vprefix_arg = Qnil;
+ }
+ else
+ {
+ this_command = cmd;
+ if (NILP (Vprefix_arg) && ! no_direct)
+ {
+ /* Recognize some common commands in common situations and
+ do them directly. */
+ if (EQ (cmd, Qforward_char) && point < ZV)
+ {
+ struct Lisp_Vector *dp
+ = window_display_table (XWINDOW (selected_window));
+ lose = FETCH_CHAR (point);
+ SET_PT (point + 1);
+ if (((dp == 0 && lose >= 040 && lose < 0177)
+ ||
+ (dp && (XTYPE (dp->contents[lose]) != Lisp_String
+ || XSTRING (dp->contents[lose])->size == sizeof (GLYPH))))
+ && (SCREEN_CURSOR_X (selected_screen)
+ != SCREEN_WIDTH (selected_screen) - 1)
+ && (XFASTINT (XWINDOW (selected_window)->last_modified)
+ >= MODIFF)
+ && (XFASTINT (XWINDOW (selected_window)->last_point)
+ == point - 1)
+ && !windows_or_buffers_changed
+ && EQ (current_buffer->selective_display, Qnil)
+ && !detect_input_pending ()
+ && NILP (Vexecuting_macro))
+ no_redisplay = direct_output_forward_char (1);
+ goto directly_done;
+ }
+ else if (EQ (cmd, Qbackward_char) && point > BEGV)
+ {
+ struct Lisp_Vector *dp
+ = window_display_table (XWINDOW (selected_window));
+ SET_PT (point - 1);
+ lose = FETCH_CHAR (point);
+ if (((dp == 0 && lose >= 040 && lose < 0177)
+ ||
+ (dp && (XTYPE (dp->contents[lose]) != Lisp_String
+ || XSTRING (dp->contents[lose])->size == sizeof (GLYPH))))
+ && (SCREEN_CURSOR_X (selected_screen) != 0)
+ && (XFASTINT (XWINDOW (selected_window)->last_modified)
+ >= MODIFF)
+ && (XFASTINT (XWINDOW (selected_window)->last_point)
+ == point + 1)
+ && !windows_or_buffers_changed
+ && EQ (current_buffer->selective_display, Qnil)
+ && !detect_input_pending ()
+ && NILP (Vexecuting_macro))
+ no_redisplay = direct_output_forward_char (-1);
+ goto directly_done;
+ }
+ else if (EQ (cmd, Qself_insert_command)
+ /* Try this optimization only on ascii keystrokes. */
+ && XTYPE (last_command_char) == Lisp_Int)
+ {
+ unsigned char c = XINT (last_command_char);
+
+ if (NILP (Vexecuting_macro) &&
+ !EQ (minibuf_window, selected_window))
+ {
+ if (!nonundocount || nonundocount >= 20)
+ {
+ Fundo_boundary ();
+ nonundocount = 0;
+ }
+ nonundocount++;
+ }
+ lose = (XFASTINT (XWINDOW (selected_window)->last_modified)
+ < MODIFF)
+ || (XFASTINT (XWINDOW (selected_window)->last_point)
+ != point)
+ || MODIFF <= current_buffer->save_modified
+ || windows_or_buffers_changed
+ || !EQ (current_buffer->selective_display, Qnil)
+ || detect_input_pending ()
+ || !NILP (Vexecuting_macro);
+ if (internal_self_insert (c, 0))
+ {
+ lose = 1;
+ nonundocount = 0;
+ }
+ if (!lose &&
+ (point == ZV || FETCH_CHAR (point) == '\n'))
+ {
+ struct Lisp_Vector *dp
+ = window_display_table (XWINDOW (selected_window));
+
+ if (dp == 0 || XTYPE (dp->contents[c]) != Lisp_String)
+ no_redisplay = direct_output_for_insert (c);
+ else if (XSTRING (dp->contents[c])->size
+ == sizeof (GLYPH))
+ no_redisplay =
+ direct_output_for_insert (*(GLYPH *)XSTRING (dp->contents[c])->data);
+ }
+ goto directly_done;
+ }
+ }
+
+ /* Here for a command that isn't executed directly */
+
+ nonundocount = 0;
+ if (NILP (Vprefix_arg))
+ Fundo_boundary ();
+ Fcommand_execute (cmd, Qnil);
+
+ directly_done: ;
+ }
+
+ /* If there is a prefix argument,
+ 1) We don't want last_command to be ``universal-argument''
+ (that would be dumb), so don't set last_command,
+ 2) we want to leave echoing on so that the prefix will be
+ echoed as part of this key sequence, so don't call
+ cancel_echoing, and
+ 3) we want to leave this_command_key_count non-zero, so that
+ read_char will realize that it is re-reading a character, and
+ not echo it a second time. */
+ if (NILP (Vprefix_arg))
+ {
+ last_command = this_command;
+ cancel_echoing ();
+ this_command_key_count = 0;
+ }
+ }
+}
+\f
+/* Number of seconds between polling for input. */
+int polling_period;
+
+/* Nonzero means polling for input is temporarily suppresed. */
+int poll_suppress_count;
+
+#ifdef POLL_FOR_INPUT
+int polling_for_input;
+
+/* Handle an alarm once each second and read pending input
+ so as to handle a C-g if it comces in. */
+
+SIGTYPE
+input_poll_signal ()
+{
+#ifdef HAVE_X_WINDOWS
+ extern int x_input_blocked;
+ if (x_input_blocked == 0)
+#endif
+ if (!waiting_for_input)
+ read_avail_input (0);
+ signal (SIGALRM, input_poll_signal);
+ alarm (polling_period);
+}
+
+#endif
+
+/* Begin signals to poll for input, if they are appropriate.
+ This function is called unconditionally from various places. */
+
+start_polling ()
+{
+#ifdef POLL_FOR_INPUT
+ if (read_socket_hook)
+ {
+ poll_suppress_count--;
+ if (poll_suppress_count == 0)
+ {
+ signal (SIGALRM, input_poll_signal);
+ polling_for_input = 1;
+ alarm (polling_period);
+ }
+ }
+#endif
+}
+
+/* Turn off polling. */
+
+stop_polling ()
+{
+#ifdef POLL_FOR_INPUT
+ if (read_socket_hook)
+ {
+ if (poll_suppress_count == 0)
+ {
+ polling_for_input = 0;
+ alarm (0);
+ }
+ poll_suppress_count++;
+ }
+#endif
+}
+\f
+/* Input of single characters from keyboard */
+
+Lisp_Object print_help ();
+static Lisp_Object kbd_buffer_get_event ();
+
+/* read a character from the keyboard; call the redisplay if needed */
+/* commandflag 0 means do not do auto-saving, but do do redisplay.
+ -1 means do not do redisplay, but do do autosaving.
+ 1 means do both. */
+
+Lisp_Object
+read_char (commandflag)
+ int commandflag;
+{
+ register Lisp_Object c;
+ int count;
+ jmp_buf save_jump;
+
+ if (!NILP (unread_command_char))
+ {
+ c = unread_command_char;
+ unread_command_char = Qnil;
+
+#if 0 /* We're not handling mouse keys specially anymore. */
+ if (!EQ (XTYPE (obj), Lisp_Int)) /* Mouse thing */
+ {
+ num_input_chars++;
+ last_input_char = 0;
+ return obj;
+ }
+#endif
+
+ if (this_command_key_count == 0)
+ goto reread_first;
+ else
+ goto reread;
+ }
+
+ if (!NILP (Vexecuting_macro))
+ {
+ if (executing_macro_index >= Flength (Vexecuting_macro))
+ {
+ XSET (c, Lisp_Int, -1);
+ return c;
+ }
+
+ c = Faref (Vexecuting_macro, make_number (executing_macro_index));
+ executing_macro_index++;
+
+ goto from_macro;
+ }
+
+ /* Save outer setjmp data, in case called recursively. */
+ bcopy (getcjmp, save_jump, sizeof getcjmp);
+
+ stop_polling ();
+
+ if (commandflag >= 0 && !input_pending && !detect_input_pending ())
+ redisplay ();
+
+ if (_setjmp (getcjmp))
+ {
+ XSET (c, Lisp_Int, quit_char);
+
+ /* Returning quit_char from this function represents a
+ resolution to the quit request, so clear the quit flag.
+ This prevents us from returning quit_char many times
+ for the same quit request. */
+ Vquit_flag = Qnil;
+
+ waiting_for_input = 0;
+ input_available_clear_word = 0;
+
+ goto non_reread;
+ }
+
+ /* Message turns off echoing unless more keystrokes turn it on again. */
+ if (echo_area_glyphs && *echo_area_glyphs && echo_area_glyphs != echobuf)
+ cancel_echoing ();
+ else
+ /* If already echoing, continue. */
+ echo_dash ();
+
+ /* If in middle of key sequence and minibuffer not active,
+ start echoing if enough time elapses. */
+ if (minibuf_level == 0 && !immediate_echo && this_command_key_count > 0
+ && echo_keystrokes > 0
+ && (echo_area_glyphs == 0 || *echo_area_glyphs == 0))
+ {
+ Lisp_Object tem0;
+
+ tem0 = Fsit_for (make_number (echo_keystrokes), Qnil, Qt);
+ if (EQ (tem0, Qt))
+ echo ();
+ }
+
+ /* Maybe auto save due to number of keystrokes or idle time. */
+
+ if (commandflag != 0
+ && auto_save_interval > 0
+ && num_input_chars - last_auto_save > max (auto_save_interval, 20)
+ && !detect_input_pending ())
+ {
+ jmp_buf temp;
+ save_getcjmp (temp);
+ Fdo_auto_save (Qnil, Qnil);
+ restore_getcjmp (temp);
+ }
+
+ /* Slow down auto saves logarithmically in size of current buffer,
+ and garbage collect while we're at it. */
+ {
+ int delay_level, buffer_size;
+
+ if (! MINI_WINDOW_P (XWINDOW (selected_window)))
+ last_non_minibuf_size = Z - BEG;
+ buffer_size = (last_non_minibuf_size >> 8) + 1;
+ delay_level = 0;
+ while (buffer_size > 64)
+ delay_level++, buffer_size -= buffer_size >> 2;
+ if (delay_level < 4) delay_level = 4;
+ /* delay_level is 4 for files under around 50k, 7 at 100k,
+ 9 at 200k, 11 at 300k, and 12 at 500k. It is 15 at 1 meg. */
+
+ /* Auto save if enough time goes by without input. */
+ if (commandflag != 0
+ && num_input_chars > last_auto_save
+ && XTYPE (Vauto_save_timeout) == Lisp_Int
+ && XINT (Vauto_save_timeout) > 0)
+ {
+ Lisp_Object tem0;
+ int delay = delay_level * XFASTINT (Vauto_save_timeout) / 4;
+ tem0 = Fsit_for (make_number (delay), Qnil, Qt);
+ if (EQ (tem0, Qt))
+ {
+ jmp_buf temp;
+ save_getcjmp (temp);
+ Fdo_auto_save (Qnil, Qnil);
+ restore_getcjmp (temp);
+
+ /* If we have auto-saved and there is still no input
+ available, garbage collect if there has been enough
+ consing going on to make it worthwhile. */
+ if (!detect_input_pending ()
+ && consing_since_gc > gc_cons_threshold / 2)
+ Fgarbage_collect ();
+ }
+ }
+ }
+
+ /* Actually read a character, waiting if necessary. */
+ c = kbd_buffer_get_event ();
+
+ if (NILP (c))
+ abort (); /* Don't think this can happen. */
+
+#if 0 /* I think that all the different kinds of events should be
+ handled together now... */
+ if (XTYPE (c) != Lisp_Int)
+ {
+ start_polling ();
+ return c;
+ }
+ c = XINT (obj);
+#endif
+
+ /* Terminate Emacs in batch mode if at eof. */
+ if (noninteractive && c < 0)
+ Fkill_emacs (make_number (1));
+
+ non_reread:
+
+ bcopy (save_jump, getcjmp, sizeof getcjmp);
+
+ start_polling ();
+
+ echo_area_glyphs = 0;
+
+ /* Handle things that only apply to characters. */
+ if (XTYPE (c) == Lisp_Int)
+ {
+ /* If kbd_buffer_get_event gave us an EOF, return that. */
+ if (XINT (c) < 0)
+ return c;
+
+ /* Strip the high bits, and maybe the meta bit too. */
+ XSETINT (c, c & (meta_key ? 0377 : 0177));
+
+ if (XTYPE (Vkeyboard_translate_table) == Lisp_String
+ && XSTRING (Vkeyboard_translate_table)->size > XINT (c))
+ XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[c]);
+ }
+
+ total_keys++;
+ recent_keys[recent_keys_index] = c;
+ if (++recent_keys_index >= (sizeof (recent_keys)/sizeof(recent_keys[0])))
+ recent_keys_index = 0;
+
+ /* Write c to the dribble file. If c is a lispy event, write
+ the event's symbol to the dribble file, in <brackets>. Bleaugh.
+ If you, dear reader, have a better idea, you've got the source. :-) */
+ if (dribble)
+ {
+ if (XTYPE (c) == Lisp_Int)
+ putc (c, dribble);
+ else
+ {
+ Lisp_Object dribblee = c;
+
+ /* If it's a structured event, take the event header. */
+ if (EVENT_HAS_PARAMETERS (dribblee))
+ dribblee = EVENT_HEAD (dribblee);
+
+ if (XTYPE (c) == Lisp_Symbol)
+ {
+ putc ('<', dribble);
+ fwrite (XSYMBOL (c)->name->data, sizeof (char),
+ XSYMBOL (c)->name->size,
+ dribble);
+ putc ('>', dribble);
+ }
+ }
+
+ fflush (dribble);
+ }
+
+ store_kbd_macro_char (c);
+
+ from_macro:
+ reread_first:
+ echo_char (c);
+
+ /* Record this character as part of the current key. */
+ add_command_key (c);
+
+ /* Re-reading in the middle of a command */
+ reread:
+ last_input_char = c;
+ num_input_chars++;
+
+ /* Process the help character specially if enabled */
+ if (EQ (c, help_char) && !NILP (Vhelp_form))
+ {
+ Lisp_Object tem0;
+ count = specpdl_ptr - specpdl;
+
+ record_unwind_protect (Fset_window_configuration,
+ Fcurrent_window_configuration (Qnil));
+
+ tem0 = Feval (Vhelp_form);
+ if (XTYPE (tem0) == Lisp_String)
+ internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
+
+ cancel_echoing ();
+ c = read_char (0);
+ /* Remove the help from the screen */
+ unbind_to (count, Qnil);
+ redisplay ();
+ if (EQ (c, make_number (040)))
+ {
+ cancel_echoing ();
+ c = read_char (0);
+ }
+ }
+
+ return c;
+}
+
+Lisp_Object
+print_help (object)
+ Lisp_Object object;
+{
+ Fprinc (object, Qnil);
+ return Qnil;
+}
+
+/* Copy out or in the info on where C-g should throw to.
+ This is used when running Lisp code from within get_char,
+ in case get_char is called recursively.
+ See read_process_output. */
+
+save_getcjmp (temp)
+ jmp_buf temp;
+{
+ bcopy (getcjmp, temp, sizeof getcjmp);
+}
+
+restore_getcjmp (temp)
+ jmp_buf temp;
+{
+ bcopy (temp, getcjmp, sizeof getcjmp);
+}
+
+\f
+/* Low level keyboard/mouse input.
+ kbd_buffer_store_event places events in kbd_buffer, and
+ kbd_buffer_get_event retrieves them.
+ mouse_moved indicates when the mouse has moved again, and
+ *mouse_position_hook provides the mouse position. */
+
+/* Set this for debugging, to have a way to get out */
+int stop_character;
+
+extern int screen_garbaged;
+
+/* Return true iff there are any events in the queue that read-char
+ would return. If this returns false, a read-char would block. */
+static int
+readable_events ()
+{
+ struct input_event *ep;
+
+ if (EVENT_QUEUES_EMPTY)
+ return 0;
+
+ if (do_mouse_tracking)
+ return 1;
+
+ /* Mouse tracking is disabled, so we need to actually scan the
+ input queue to see if any events are currently readable. */
+ for (ep = kbd_fetch_ptr; ep != kbd_store_ptr; ep++)
+ {
+ if (ep == kbd_buffer + KBD_BUFFER_SIZE)
+ ep = kbd_buffer;
+
+ /* Skip button-up events. */
+ if ((ep->kind == mouse_click || ep->kind == scrollbar_click)
+ && (ep->modifiers & up_modifier))
+ continue;
+
+ return 1;
+ }
+
+ return 0;
+}
+
+
+/* Restore mouse tracking enablement. See Ftrack_mouse for the only use
+ of this function. */
+static Lisp_Object
+tracking_off (old_value)
+ Lisp_Object old_value;
+{
+ if (! XFASTINT (old_value))
+ {
+ do_mouse_tracking = 0;
+
+ /* Redisplay may have been preempted because there was input
+ available, and it assumes it will be called again after the
+ input has been processed. If the only input available was
+ the sort that we have just disabled, then we need to call
+ redisplay. */
+ if (!readable_events ())
+ {
+ redisplay_preserve_echo_area ();
+ get_input_pending (&input_pending);
+ }
+ }
+}
+
+DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
+ "Evaluate BODY with mouse movement and button release events enabled.\n\
+Within a track-mouse, read-event reports mouse movement and button releases;\n\
+otherwise, they are ignored.")
+ (args)
+ Lisp_Object args;
+{
+ int count = specpdl_ptr - specpdl;
+ Lisp_Object val;
+
+ XSET (val, Lisp_Int, do_mouse_tracking);
+ record_unwind_protect (tracking_off, val);
+
+ do_mouse_tracking = 1;
+
+ val = Fprogn (args);
+ return unbind_to (count, val);
+}
+
+/* Store an event obtained at interrupt level into kbd_buffer, fifo */
+
+void
+kbd_buffer_store_event (event)
+ register struct input_event *event;
+{
+ if (event->kind == no_event)
+ abort ();
+
+ if (event->kind == ascii_keystroke)
+ {
+ register int c = XFASTINT (event->code) & 0377;
+
+ if (c == quit_char
+ || ((c == (0200 | quit_char)) && !meta_key))
+ {
+ /* If this results in a quit_char being returned to Emacs as
+ input, set last-event-screen properly. If this doesn't
+ get returned to Emacs as an event, the next event read
+ will set Vlast_event_screen again, so this is safe to do. */
+ extern SIGTYPE interrupt_signal ();
+ XSET (Vlast_event_screen, Lisp_Screen, event->screen);
+ last_event_timestamp = XINT (event->timestamp);
+ interrupt_signal ();
+ return;
+ }
+
+ if (c && c == stop_character)
+ {
+ sys_suspend ();
+ return;
+ }
+
+ XSET (event->code, Lisp_Int, c);
+ }
+
+ if (kbd_store_ptr - kbd_buffer == KBD_BUFFER_SIZE)
+ kbd_store_ptr = kbd_buffer;
+
+ /* Don't let the very last slot in the buffer become full,
+ since that would make the two pointers equal,
+ and that is indistinguishable from an empty buffer.
+ Discard the event if it would fill the last slot. */
+ if (kbd_fetch_ptr - 1 != kbd_store_ptr)
+ {
+ kbd_store_ptr->kind = event->kind;
+ kbd_store_ptr->code = event->code;
+ kbd_store_ptr->part = event->part;
+ kbd_store_ptr->screen = event->screen;
+ kbd_store_ptr->modifiers = event->modifiers;
+ kbd_store_ptr->x = event->x;
+ kbd_store_ptr->y = event->y;
+ kbd_store_ptr->timestamp = event->timestamp;
+
+ kbd_store_ptr++;
+ }
+}
+
+static Lisp_Object make_lispy_event ();
+static Lisp_Object make_lispy_movement ();
+static Lisp_Object modify_event_symbol ();
+
+static Lisp_Object
+kbd_buffer_get_event ()
+{
+ register int c;
+ Lisp_Object obj;
+
+ if (noninteractive)
+ {
+ c = getchar ();
+ XSET (obj, Lisp_Int, c);
+ return obj;
+ }
+
+ /* Wait until there is input available. */
+ for (;;)
+ {
+
+ /* Process or toss any events that we don't want to return as
+ input. The fact that we remove undesirable events here
+ allows us to use EVENT_QUEUES_EMPTY in the rest of this loop. */
+ if (! do_mouse_tracking)
+ while (kbd_fetch_ptr != kbd_store_ptr)
+ {
+ if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
+ kbd_fetch_ptr = kbd_buffer;
+
+ if (kbd_fetch_ptr->kind == mouse_click
+ || kbd_fetch_ptr->kind == scrollbar_click)
+ {
+ if ((kbd_fetch_ptr->modifiers & up_modifier) == 0)
+ break;
+ }
+ else
+ break;
+
+ kbd_fetch_ptr++;
+ }
+
+ if (!EVENT_QUEUES_EMPTY)
+ break;
+
+ /* If the quit flag is set, then read_char will return
+ quit_char, so that counts as "available input." */
+ if (!NILP (Vquit_flag))
+ quit_throw_to_read_char ();
+
+ /* One way or another, wait until input is available; then, if
+ interrupt handlers have not read it, read it now. */
+
+#ifdef OLDVMS
+ wait_for_kbd_input ();
+#else
+/* Note SIGIO has been undef'd if FIONREAD is missing. */
+#ifdef SIGIO
+ gobble_input (0);
+#endif /* SIGIO */
+ if (EVENT_QUEUES_EMPTY)
+ {
+#ifdef subprocesses
+ wait_reading_process_input (0, 0, -1, 1);
+#else
+/* Note SIGIO has been undef'd if FIONREAD is missing. */
+#ifdef SIGIO
+ if (interrupt_input)
+ {
+ sigblockx (SIGIO);
+ set_waiting_for_input (0);
+ while (EVENT_QUEUES_EMPTY)
+ sigpausex (SIGIO);
+ clear_waiting_for_input ();
+ sigunblockx (SIGIO);
+ }
+#else
+ interrupt_input = 0;
+#endif /* not SIGIO */
+#endif /* subprocesses */
+
+ if (!interrupt_input && EVENT_QUEUES_EMPTY)
+ {
+ read_avail_input (0);
+ }
+ }
+#endif /* not VMS */
+ }
+
+ /* At this point, we know that there is a readable event available
+ somewhere. If the event queue is empty, then there must be a
+ mouse movement enabled and available. */
+ if (kbd_fetch_ptr != kbd_store_ptr)
+ {
+ if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
+ kbd_fetch_ptr = kbd_buffer;
+ XSET (Vlast_event_screen, Lisp_Screen, kbd_fetch_ptr->screen);
+ last_event_timestamp = XINT (kbd_fetch_ptr->timestamp);
+ obj = make_lispy_event (kbd_fetch_ptr);
+ kbd_fetch_ptr->kind = no_event;
+ kbd_fetch_ptr++;
+ if (XTYPE (obj) == Lisp_Int)
+ XSET (obj, Lisp_Int, XINT (obj) & (meta_key ? 0377 : 0177));
+ }
+ else if (do_mouse_tracking && mouse_moved)
+ {
+ SCREEN_PTR screen;
+ Lisp_Object x, y, time;
+
+ (*mouse_position_hook) (&screen, &x, &y, &time);
+ XSET (Vlast_event_screen, Lisp_Screen, screen);
+
+ obj = make_lispy_movement (screen, x, y, time);
+ }
+ else
+ /* We were promised by the above while loop that there was
+ something for us to read! */
+ abort ();
+
+ input_pending = readable_events ();
+
+ return (obj);
+}
+
+/* Caches for modify_event_symbol. */
+static Lisp_Object func_key_syms;
+static Lisp_Object mouse_syms;
+
+/* You'll notice that this table is arranged to be conveniently
+ indexed by X Windows keysym values. */
+static char *lispy_function_keys[] =
+ {
+ /* X Keysym value */
+
+ "home", /* 0xff50 */ /* IsCursorKey */
+ "left",
+ "up",
+ "right",
+ "down",
+ "prior",
+ "next",
+ "end",
+ "begin",
+ 0, /* 0xff59 */
+ 0, 0, 0, 0, 0, 0,
+ "select", /* 0xff60 */ /* IsMiscFunctionKey */
+ "print",
+ "execute",
+ "insert",
+ 0, /* 0xff64 */
+ "undo",
+ "redo",
+ "menu",
+ "find",
+ "cancel",
+ "help",
+ "break", /* 0xff6b */
+
+ /* Here are some keys found mostly on HP keyboards. The X event
+ handling code will strip bit 29, which flags vendor-specific
+ keysyms. */
+ "reset", /* 0x1000ff6c */
+ "system",
+ "user",
+ "clearline",
+ "insertline",
+ "deleteline",
+ "insertchar",
+ "deletechar",
+ "backtab",
+ "kp_backtab", /* 0x1000ff75 */
+ 0, /* 0xff76 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff7f */
+ "kp-space", /* 0xff80 */ /* IsKeypadKey */
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ "kp-tab", /* 0xff89 */
+ 0, 0, 0,
+ "kp-enter", /* 0xff8d */
+ 0, 0, 0,
+ "kp-f1", /* 0xff91 */
+ "kp-f2",
+ "kp-f3",
+ "kp-f4",
+ 0, /* 0xff95 */
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ "kp-multiply", /* 0xffaa */
+ "kp-add",
+ "kp-separator",
+ "kp-subtract",
+ "kp-decimal",
+ "kp-divide", /* 0xffaf */
+ "kp-0", /* 0xffb0 */
+ "kp-1", "kp-2", "kp-3", "kp-4", "kp-5", "kp-6", "kp-7", "kp-8", "kp-9",
+ 0, /* 0xffba */
+ 0, 0,
+ "kp-equal", /* 0xffbd */
+ "f1", /* 0xffbe */ /* IsFunctionKey */
+ "f2", "f3", "f4",
+ "f5", "f6", "f7", "f8", "f9", "f10", "f11", "f12",
+ "f13", "f14", "f15", "f16", "f17", "f18", "f19", "f20",
+ "f21", "f22", "f23", "f24", "f25", "f26", "f27", "f28",
+ "f29", "f30", "f31", "f32", "f33", "f34", "f35" /* 0xffe0 */
+ };
+
+static char *lispy_mouse_names[] =
+{
+ "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5"
+};
+
+/* Given a struct input_event, build the lisp event which represents
+ it. If EVENT is 0, build a mouse movement event from the mouse
+ movement buffer, which should have a movement event in it. */
+
+static Lisp_Object
+make_lispy_event (event)
+ struct input_event *event;
+{
+#ifdef SWITCH_ENUM_BUG
+ switch ((int) event->kind)
+#else
+ switch (event->kind)
+#endif
+ {
+
+ /* A simple keystroke. */
+ case ascii_keystroke:
+ return event->code;
+ break;
+
+ /* A function key. The symbol may need to have modifier prefixes
+ tacked onto it. */
+ case non_ascii_keystroke:
+ return modify_event_symbol (XFASTINT (event->code), event->modifiers,
+ Qfunction_key,
+ lispy_function_keys, &func_key_syms,
+ (sizeof (lispy_function_keys)
+ / sizeof (lispy_function_keys[0])));
+ break;
+
+ /* A mouse click - build a list of the relevant information. */
+ case mouse_click:
+ {
+ int part;
+ Lisp_Object window =
+ window_from_coordinates (event->screen,
+ XINT (event->x), XINT (event->y),
+ &part);
+ Lisp_Object posn;
+
+ if (XTYPE (window) != Lisp_Window)
+ posn = Qnil;
+ else
+ {
+ XSETINT (event->x, (XINT (event->x)
+ - XINT (XWINDOW (window)->left)));
+ XSETINT (event->y, (XINT (event->y)
+ - XINT (XWINDOW (window)->top)));
+
+ if (part == 1)
+ posn = Qmode_line;
+ else if (part == 2)
+ posn = Qvertical_split;
+ else
+ XSET (posn, Lisp_Int,
+ buffer_posn_from_coords (XWINDOW (window),
+ XINT (event->x),
+ XINT (event->y)));
+ }
+
+ return Fcons (modify_event_symbol (XFASTINT (event->code) - 1,
+ event->modifiers,
+ Qmouse_click,
+ lispy_mouse_names, &mouse_syms,
+ (sizeof (lispy_mouse_names)
+ / sizeof (lispy_mouse_names[0]))),
+ Fcons (window,
+ Fcons (posn,
+ Fcons (Fcons (event->x, event->y),
+ Fcons (event->timestamp,
+ Qnil)))));
+ }
+
+ /* A scrollbar click. Build a list containing the relevant
+ information. */
+ case scrollbar_click:
+ {
+ Lisp_Object button
+ = modify_event_symbol (XFASTINT (event->code) - 1,
+ event->modifiers,
+ Qmouse_click,
+ lispy_mouse_names, &mouse_syms,
+ (sizeof (lispy_mouse_names)
+ / sizeof (lispy_mouse_names[0])));
+ return Fcons (event->part,
+ Fcons (SCREEN_SELECTED_WINDOW (event->screen),
+ Fcons (button,
+ Fcons (Fcons (event->x, event->y),
+ Fcons (event->timestamp,
+ Qnil)))));
+ }
+
+ /* The 'kind' field of the event is something we don't recognize. */
+ default:
+ abort();
+ }
+}
+
+static Lisp_Object
+make_lispy_movement (screen, x, y, time)
+ SCREEN_PTR screen;
+ Lisp_Object x, y;
+ Lisp_Object time;
+{
+ Lisp_Object window;
+ int ix, iy;
+ Lisp_Object posn;
+ int part;
+
+ ix = XINT (x);
+ iy = XINT (y);
+ window = (screen
+ ? window_from_coordinates (screen, ix, iy, &part)
+ : Qnil);
+ if (XTYPE (window) != Lisp_Window)
+ posn = Qnil;
+ else
+ {
+ ix -= XINT (XWINDOW (window)->left);
+ iy -= XINT (XWINDOW (window)->top);
+ if (part == 1)
+ posn = Qmode_line;
+ else if (part == 2)
+ posn = Qvertical_split;
+ else
+ XSET (posn, Lisp_Int, buffer_posn_from_coords (XWINDOW (window),
+ ix, iy));
+ }
+
+ XSETINT (x, ix);
+ XSETINT (y, iy);
+ return Fcons (Qmouse_movement,
+ Fcons (window,
+ Fcons (posn,
+ Fcons (Fcons (x, y),
+ Fcons (time, Qnil)))));
+}
+
+
+
+/* Place the written representation of MODIFIERS in BUF, '\0'-terminated,
+ and return its length. */
+
+static int
+format_modifiers (modifiers, buf)
+ int modifiers;
+ char *buf;
+{
+ char *p = buf;
+
+ if (modifiers & meta_modifier) { *p++ = 'M'; *p++ = '-'; }
+ if (modifiers & ctrl_modifier) { *p++ = 'C'; *p++ = '-'; }
+ if (modifiers & shift_modifier) { *p++ = 'S'; *p++ = '-'; }
+ if (modifiers & up_modifier) { *p++ = 'U'; *p++ = '-'; }
+ *p = '\0';
+
+ return p - buf;
+}
+
+
+/* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
+ return a symbol with the modifiers placed in the canonical order.
+
+ Fdefine_key calls this to make sure that (for example) C-M-foo
+ and M-C-foo end up being equivalent in the keymap. */
+
+Lisp_Object
+reorder_modifiers (symbol)
+ Lisp_Object symbol;
+{
+ struct Lisp_String *name;
+ int i;
+ int modifiers;
+ int not_canonical;
+
+ CHECK_SYMBOL (symbol, 1);
+
+ modifiers = 0;
+ name = XSYMBOL (symbol)->name;
+
+ /* Special case for things with only one modifier, which is
+ (hopefully) the vast majority of cases. */
+ if (! (name->size >= 4 && name->data[1] == '-' && name->data[3] == '-'))
+ return symbol;
+
+ for (i = 0; i + 1 < name->size && name->data[i + 1] == '-'; i += 2)
+ switch (name->data[i])
+ {
+ case 'M':
+ not_canonical |= (modifiers & (meta_modifier|ctrl_modifier
+ |shift_modifier|up_modifier));
+ modifiers |= meta_modifier;
+ break;
+
+ case 'C':
+ not_canonical |= (modifiers &
+ (ctrl_modifier|shift_modifier|up_modifier));
+ modifiers |= ctrl_modifier;
+ break;
+
+ case 'S':
+ not_canonical |= (modifiers & (shift_modifier|up_modifier));
+ modifiers |= shift_modifier;
+ break;
+
+ case 'U':
+ not_canonical |= (modifiers & (up_modifier));
+ modifiers |= up_modifier;
+ break;
+
+ default:
+ goto no_more_modifiers;
+ }
+ no_more_modifiers:
+
+ if (!not_canonical)
+ return symbol;
+
+ /* The modifiers were out of order, so find a new symbol with the
+ mods in order. Since the symbol name could contain nulls, we can't
+ use intern here; we have to use Fintern, which expects a genuine
+ Lisp_String, and keeps a reference to it. */
+ {
+ char *new_mods = (char *) alloca (sizeof ("C-M-S-U-"));
+ int len = format_modifiers (modifiers, new_mods);
+ Lisp_Object new_name = make_uninit_string (len + name->size - i);
+
+ bcopy (new_mods, XSTRING (new_name)->data, len);
+ bcopy (name->data + i, XSTRING (new_name)->data + len, name->size - i);
+
+ return Fintern (new_name, Qnil);
+ }
+}
+
+
+/* For handling events, we often want to produce a symbol whose name
+ is a series of modifier key prefixes ("M-", "C-", etcetera) attached
+ to some base, like the name of a function key or mouse button.
+ modify_event_symbol produces symbols of this sort.
+
+ NAME_TABLE should point to an array of strings, such that NAME_TABLE[i]
+ is the name of the i'th symbol. TABLE_SIZE is the number of elements
+ in the table.
+
+ SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will
+ persist between calls to modify_event_symbol that it can use to
+ store a cache of the symbols it's generated for this NAME_TABLE
+ before.
+
+ SYMBOL_NUM is the number of the base name we want from NAME_TABLE.
+
+ MODIFIERS is a set of modifier bits (as given in struct input_events)
+ whose prefixes should be applied to the symbol name.
+
+ SYMBOL_KIND is the value to be placed in the event_kind property of
+ the returned symbol. */
+
+static Lisp_Object
+modify_event_symbol (symbol_num, modifiers, symbol_kind, name_table,
+ symbol_table, table_size)
+ int symbol_num;
+ unsigned modifiers;
+ Lisp_Object symbol_kind;
+ char **name_table;
+ Lisp_Object *symbol_table;
+ int table_size;
+{
+ Lisp_Object *slot, *unmodified_slot;
+
+ /* Is this a request for a valid symbol? */
+ if (symbol_num < 0 || symbol_num >= table_size
+ || modifiers >= NUM_MODIFIER_COMBOS)
+ abort ();
+
+ /* If *symbol_table is not a vector of the appropriate size,
+ set it to one. */
+ if (XTYPE (*symbol_table) != Lisp_Vector
+ || XVECTOR (*symbol_table)->size != table_size)
+ *symbol_table = Fmake_vector (make_number (table_size), Qnil);
+
+ unmodified_slot = slot = & XVECTOR (*symbol_table)->contents[symbol_num];
+
+ /* If there are modifier keys, there had better be a vector in
+ this symbol's position of the symbol_table. */
+ if (modifiers != 0)
+ {
+ Lisp_Object slot_contents = *slot;
+
+ /* If there isn't the right sort of vector there, put one in. */
+ if (XTYPE (slot_contents) != Lisp_Vector
+ || XVECTOR (slot_contents)->size != NUM_MODIFIER_COMBOS)
+ {
+ *slot = Fmake_vector (make_number (NUM_MODIFIER_COMBOS), Qnil);
+
+ /* Make sure that the vector has an entry for the unmodified
+ symbol, so we can put it on the event_unmodified property. */
+ if (! NILP (slot_contents))
+ XVECTOR (*slot)->contents[0] = slot_contents;
+ else
+ XVECTOR (*slot)->contents[0] = intern (name_table [symbol_num]);
+ }
+ }
+
+ /* If this entry has been filled in with a modified symbol vector,
+ point to the appropriate slot within that. */
+ if (XTYPE (*slot) == Lisp_Vector)
+ {
+ unmodified_slot = & XVECTOR (*slot)->contents[0];
+ slot = & XVECTOR (*slot)->contents[modifiers];
+ }
+
+ /* Make sure we have an unmodified version of the symbol in its
+ proper place? */
+ if (NILP (*unmodified_slot))
+ {
+ *unmodified_slot = intern (name_table [symbol_num]);
+ Fput (*unmodified_slot, Qevent_kind, symbol_kind);
+ Fput (*unmodified_slot, Qevent_unmodified, *unmodified_slot);
+ }
+
+ /* Have we already created a symbol for this combination of modifiers? */
+ if (NILP (*slot))
+ {
+ /* No, let's create one. */
+ char *modified_name
+ = (char *) alloca (sizeof ("C-M-S-U-")
+ + strlen (name_table [symbol_num]));
+
+ strcpy (modified_name + format_modifiers (modifiers, modified_name),
+ name_table [symbol_num]);
+
+ *slot = intern (modified_name);
+ Fput (*slot, Qevent_kind, symbol_kind);
+ Fput (*slot, Qevent_unmodified, *unmodified_slot);
+ }
+
+ return *slot;
+}
+\f
+DEFUN ("mouse-click-p", Fmouse_click_p, Smouse_click_p, 1, 1, 0,
+ "Return non-nil iff OBJECT is a representation of a mouse event.\n\
+A mouse event is a list of five elements whose car is a symbol of the\n\
+form <MODIFIERS>mouse-<DIGIT>. I hope this is a temporary hack.")
+ (object)
+ Lisp_Object object;
+{
+ if (EVENT_HAS_PARAMETERS (object)
+ && EQ (EVENT_HEAD_KIND (EVENT_HEAD (object)),
+ Qmouse_click))
+ return Qt;
+ else
+ return Qnil;
+}
+\f
+/* Store into *addr a value nonzero if terminal input chars are available.
+ Serves the purpose of ioctl (0, FIONREAD, addr)
+ but works even if FIONREAD does not exist.
+ (In fact, this may actually read some input.) */
+
+static void
+get_input_pending (addr)
+ int *addr;
+{
+ /* First of all, have we already counted some input? */
+ *addr = !NILP (Vquit_flag) || readable_events ();
+
+ /* If input is being read as it arrives, and we have none, there is none. */
+ if (*addr > 0 || (interrupt_input && ! interrupts_deferred))
+ return;
+
+ /* Try to read some input and see how much we get. */
+ gobble_input (0);
+ *addr = !NILP (Vquit_flag) || readable_events ();
+}
+
+/* Interface to read_avail_input, blocking SIGIO if necessary. */
+
+int
+gobble_input (expected)
+ int expected;
+{
+#ifndef VMS
+#ifdef SIGIO
+ if (interrupt_input)
+ {
+ SIGMASKTYPE mask = sigblockx (SIGIO);
+ read_avail_input (expected);
+ sigsetmask (mask);
+ }
+ else
+#endif
+ read_avail_input (expected);
+#endif
+}
+\f
+#ifndef VMS
+
+/* Read any terminal input already buffered up by the system
+ into the kbd_buffer, but do not wait.
+
+ EXPECTED should be nonzero if the caller knows there is some input.
+
+ Except on VMS, all input is read by this function.
+ If interrupt_input is nonzero, this function MUST be called
+ only when SIGIO is blocked.
+
+ Returns the number of keyboard chars read, or -1 meaning
+ this is a bad time to try to read input. */
+
+static int
+read_avail_input (expected)
+ int expected;
+{
+ struct input_event buf[KBD_BUFFER_SIZE];
+ register int i;
+ int nread;
+
+ if (read_socket_hook)
+ /* No need for FIONREAD or fcntl; just say don't wait. */
+ nread = (*read_socket_hook) (0, buf, KBD_BUFFER_SIZE, expected, expected);
+ else
+ {
+ unsigned char cbuf[KBD_BUFFER_SIZE];
+
+#ifdef FIONREAD
+ /* Find out how much input is available. */
+ if (ioctl (0, FIONREAD, &nread) < 0)
+ /* Formerly simply reported no input, but that sometimes led to
+ a failure of Emacs to terminate.
+ SIGHUP seems appropriate if we can't reach the terminal. */
+ kill (getpid (), SIGHUP);
+ if (nread == 0)
+ return 0;
+ if (nread > sizeof cbuf)
+ nread = sizeof cbuf;
+#else /* no FIONREAD */
+#ifdef USG
+ /* Read some input if available, but don't wait. */
+ nread = sizeof cbuf;
+ fcntl (fileno (stdin), F_SETFL, O_NDELAY);
+#else
+ you lose;
+#endif
+#endif
+
+ /* Now read; for one reason or another, this will not block. */
+ while (1)
+ {
+ nread = read (fileno (stdin), cbuf, nread);
+#ifdef AIX
+ /* The kernel sometimes fails to deliver SIGHUP for ptys.
+ This looks incorrect, but it isn't, because _BSD causes
+ O_NDELAY to be defined in fcntl.h as O_NONBLOCK,
+ and that causes a value other than 0 when there is no input. */
+ if (nread == 0)
+ kill (SIGHUP, 0);
+#endif
+ /* Retry the read if it is interrupted. */
+ if (nread >= 0
+ || ! (errno == EAGAIN || errno == EFAULT
+#ifdef EBADSLT
+ || errno == EBADSLT
+#endif
+ ))
+ break;
+ }
+
+#ifndef FIONREAD
+#ifdef USG
+ fcntl (fileno (stdin), F_SETFL, 0);
+#endif /* USG */
+#endif /* no FIONREAD */
+ for (i = 0; i < nread; i++)
+ {
+ buf[i].kind = ascii_keystroke;
+ XSET (buf[i].code, Lisp_Int, cbuf[i]);
+ buf[i].screen = selected_screen;
+ }
+ }
+
+ /* Scan the chars for C-g and store them in kbd_buffer. */
+ for (i = 0; i < nread; i++)
+ {
+ kbd_buffer_store_event (&buf[i]);
+ /* Don't look at input that follows a C-g too closely.
+ This reduces lossage due to autorepeat on C-g. */
+ if (buf[i].kind == ascii_keystroke
+ && XINT(buf[i].code) == quit_char)
+ break;
+ }
+
+ return nread;
+}
+#endif /* not VMS */
+\f
+#ifdef SIGIO /* for entire page */
+/* Note SIGIO has been undef'd if FIONREAD is missing. */
+
+input_available_signal (signo)
+ int signo;
+{
+ /* Must preserve main program's value of errno. */
+ int old_errno = errno;
+#ifdef BSD4_1
+ extern int select_alarmed;
+#endif
+
+#ifdef USG
+ /* USG systems forget handlers when they are used;
+ must reestablish each time */
+ signal (signo, input_available_signal);
+#endif /* USG */
+
+#ifdef BSD4_1
+ sigisheld (SIGIO);
+#endif
+
+ if (input_available_clear_word)
+ *input_available_clear_word = 0;
+
+ while (1)
+ {
+ int nread;
+ nread = read_avail_input (1);
+ /* -1 means it's not ok to read the input now.
+ UNBLOCK_INPUT will read it later; now, avoid infinite loop.
+ 0 means there was no keyboard input available. */
+ if (nread <= 0)
+ break;
+
+#ifdef BSD4_1
+ select_alarmed = 1; /* Force the select emulator back to life */
+#endif
+ }
+
+#ifdef BSD4_1
+ sigfree ();
+#endif
+ errno = old_errno;
+}
+#endif /* SIGIO */
+\f
+/* Return the prompt-string of a sparse keymap.
+ This is the first element which is a string.
+ Return nil if there is none. */
+
+Lisp_Object
+map_prompt (map)
+ Lisp_Object map;
+{
+ while (CONSP (map))
+ {
+ register Lisp_Object tem;
+ tem = Fcar (map);
+ if (XTYPE (tem) == Lisp_String)
+ return tem;
+ map = Fcdr (map);
+ }
+ return Qnil;
+}
+
+static int echo_flag;
+static int echo_now;
+
+/* Read a character like read_char but optionally prompt based on maps
+ LOCAL and GLOBAL.
+
+ The prompting is done based on the prompt-string of the map
+ and the strings associated with various map elements. */
+
+Lisp_Object
+read_char_menu_prompt (prompt, local, global)
+ int prompt;
+ Lisp_Object local, global;
+{
+ register Lisp_Object rest, name;
+ Lisp_Object hmap;
+ int nlength;
+ int width = SCREEN_WIDTH (selected_screen) - 4;
+ char *menu = (char *) alloca (width);
+
+ /* Use local over global Menu maps */
+
+ if (menu_prompting)
+ return read_char (!prompt);
+
+ /* We can't get prompt strings from dense keymaps. */
+ if (CONSP (local)
+ && EQ (Fcar (local), Qkeymap)
+ && !(CONSP (XCONS (local)->cdr)
+ && XTYPE (XCONS (XCONS (local)->cdr)->car) == Lisp_Vector))
+ hmap = local;
+ else if (CONSP (global)
+ && EQ (Fcar (global), Qkeymap)
+ && !(CONSP (XCONS (global)->cdr)
+ && XTYPE (XCONS (XCONS (global)->cdr)->car) == Lisp_Vector))
+ hmap = global;
+ else
+ return read_char (!prompt);
+
+ /* Get the map's prompt string. */
+ name = map_prompt (hmap);
+ if (NILP (name))
+ return read_char (!prompt);
+
+ /* Prompt string always starts with map's prompt, and a space. */
+ strcpy (menu, XSTRING (name)->data);
+ nlength = XSTRING (name)->size;
+ menu[nlength++] = ' ';
+ menu[nlength] = 0;
+
+ /* Start prompting at start of map. */
+ rest = hmap; /* Current menu item */
+
+ /* Present the documented bindings, a line at a time. */
+ while (1)
+ {
+ int notfirst = 0;
+ int i = nlength;
+ Lisp_Object obj;
+ int ch;
+
+ /* If reached end of map, start at beginning. */
+ if (NILP (Fcdr (rest))) rest = hmap;
+
+ /* Loop over elements of map. */
+ while (!NILP (rest) && i < width)
+ {
+ Lisp_Object s;
+
+ /* Look for conses whose cadrs are strings. */
+ s = Fcar_safe (Fcdr_safe (Fcar_safe (rest)));
+ if (XTYPE (s) != Lisp_String)
+ /* Ignore all other elements. */
+ ;
+ /* If first such element, or enough room, add string to prompt. */
+ else if (XSTRING (s)->size + i < width
+ || !notfirst)
+ {
+ int thiswidth;
+
+ /* Punctuate between strings. */
+ if (notfirst)
+ {
+ strcpy (menu + i, ", ");
+ i += 2;
+ }
+ notfirst = 1;
+
+ /* Add as much of string as fits. */
+ thiswidth = XSTRING (s)->size;
+ if (thiswidth + i > width)
+ thiswidth = width - i;
+ bcopy (XSTRING (s)->data, menu + i, thiswidth);
+ i += thiswidth;
+ }
+ else
+ {
+ /* If some elts don't fit, show there are more. */
+ strcpy (menu + i, "...");
+ break;
+ }
+
+ /* Move past this element. */
+ rest = Fcdr_safe (rest);
+ }
+
+ /* Prompt with that and read response. */
+ message1 (menu);
+ obj = read_char (1);
+
+ if (XTYPE (obj) != Lisp_Int)
+ return obj;
+ else
+ ch = XINT (obj);
+
+ if (obj != menu_prompt_more_char
+ && (XTYPE (menu_prompt_more_char) != Lisp_Int
+ || obj != make_number (Ctl (XINT (menu_prompt_more_char)))))
+ return obj;
+ }
+}
+
+\f
+/* Reading key sequences. */
+
+/* Follow KEY in the maps in CURRENT[0..NMAPS-1], placing its bindings
+ in DEFS[0..NMAPS-1]. Set NEXT[i] to DEFS[i] if DEFS[i] is a
+ keymap, or nil otherwise. Return the index of the first keymap in
+ which KEY has any binding, or NMAPS if no map has a binding.
+
+ If KEY is a meta ASCII character, treat it like meta-prefix-char
+ followed by the corresponding non-meta character. Keymaps in
+ CURRENT with non-prefix bindings for meta-prefix-char become nil in
+ NEXT.
+
+ When KEY is not defined in any of the keymaps, if it is an upper
+ case letter and there are bindings for the corresponding lower-case
+ letter, return the bindings for the lower-case letter.
+
+ NEXT may == CURRENT. */
+
+static int
+follow_key (key, nmaps, current, defs, next)
+ Lisp_Object key;
+ Lisp_Object *current, *defs, *next;
+ int nmaps;
+{
+ int i, first_binding;
+
+ /* If KEY is a meta ASCII character, treat it like meta-prefix-char
+ followed by the corresponding non-meta character. */
+ if (XTYPE (key) == Lisp_Int
+ && XINT (key) >= 0200)
+ {
+ for (i = 0; i < nmaps; i++)
+ if (! NILP (current[i]))
+ {
+ next[i] = get_keyelt (access_keymap (current[i],
+ meta_prefix_char));
+
+ /* Note that since we pass the resulting bindings through
+ get_keymap_1, non-prefix bindings for meta-prefix-char
+ disappear. */
+ next[i] = get_keymap_1 (next[i], 0);
+ }
+ else
+ next[i] = Qnil;
+
+ current = next;
+ XSET (key, Lisp_Int, XFASTINT (key) & 0177);
+ }
+
+ first_binding = nmaps;
+ for (i = nmaps - 1; i >= 0; i--)
+ {
+ if (! NILP (current[i]))
+ {
+ defs[i] = get_keyelt (access_keymap (current[i], key));
+ if (! NILP (defs[i]))
+ first_binding = i;
+ }
+ else
+ defs[i] = Qnil;
+ }
+
+ /* When KEY is not defined in any of the keymaps, if it is an upper
+ case letter and there are bindings for the corresponding
+ lower-case letter, return the bindings for the lower-case letter. */
+ if (first_binding == nmaps
+ && XTYPE (key) == Lisp_Int
+ && UPPERCASEP (XINT (key)))
+ {
+ XSETINT (key, DOWNCASE (XINT (key)));
+
+ first_binding = nmaps;
+ for (i = nmaps - 1; i >= 0; i--)
+ {
+ if (! NILP (current[i]))
+ {
+ defs[i] = get_keyelt (access_keymap (current[i], key));
+ if (! NILP (defs[i]))
+ first_binding = i;
+ }
+ else
+ defs[i] = Qnil;
+ }
+ }
+
+ /* Given the set of bindings we've found, produce the next set of maps. */
+ for (i = 0; i < nmaps; i++)
+ next[i] = NILP (defs[i]) ? Qnil : get_keymap_1 (defs[i], 0);
+
+ return first_binding;
+}
+
+/* Read a sequence of keys that ends with a non prefix character
+ according to the keymaps in KEYMAPS[0..nmaps-1]. Keymaps appearing
+ earlier in KEYMAPS take precidence over those appearing later.
+
+ Store the sequence in KEYBUF, a buffer of size BUFSIZE. Prompt
+ with PROMPT. Echo starting immediately unless `prompt' is 0.
+ Return the length of the key sequence stored.
+
+ If the user switches screens in the midst of a key sequence, we
+ throw away any prefix we have read so far, and start afresh. For
+ mouse clicks, we look up the click in the keymap of the buffer
+ clicked on, throwing away any prefix if it is not the same buffer
+ we used to be reading from. */
+
+static int
+read_key_sequence (keybuf, bufsize, prompt)
+ Lisp_Object *keybuf;
+ int bufsize;
+ Lisp_Object prompt;
+{
+ /* How many keys there are in the current key sequence. */
+ int t;
+
+ /* The buffer that the most recently read event was typed at. This
+ helps us read mouse clicks according to the buffer clicked in,
+ and notice when the mouse has moved from one screen to another. */
+ struct buffer *last_event_buffer = current_buffer;
+
+ /* The length of the echo buffer when we started reading, and
+ the length of this_command_keys when we started reading. */
+ int echo_start;
+ int keys_start = this_command_key_count;
+
+ /* The number of keymaps we're scanning right now, and the number of
+ keymaps we have allocated space for. */
+ int nmaps;
+ int nmaps_allocated = 0;
+
+ /* current[0..nmaps-1] are the prefix definitions of KEYBUF[0..t-1]
+ in the current keymaps, or nil where it is not a prefix. */
+ Lisp_Object *current;
+
+ /* defs[0..nmaps-1] are the definitions of KEYBUF[0..t-1] in
+ the current keymaps. */
+ Lisp_Object *defs;
+
+ /* The lowest i such that defs[i] is non-nil. */
+ int first_binding;
+
+ /* If mock_input > t, then KEYBUF[t] should be read as the next
+ input key. */
+ int mock_input = 0;
+
+ /* If the sequence is unbound in current[], keymap[fkey_start..fkey_end-1]
+ is a prefix in Vfunction_key_map, and fkey_map is its binding.
+ These might be > t, indicating that all function key scanning should
+ hold off until t reaches them. */
+ int fkey_start = 0, fkey_end = 0;
+ Lisp_Object fkey_map = Vfunction_key_map;
+
+ if (INTERACTIVE)
+ {
+ if (prompt)
+ echo_prompt (prompt);
+ else if (cursor_in_echo_area)
+ /* This doesn't put in a dash if the echo buffer is empty, so
+ you don't always see a dash hanging out in the minibuffer. */
+ echo_dash ();
+ echo_start = echo_length ();
+ }
+
+ /* If there is no function key map, turn of function key scanning. */
+ if (NILP (Fkeymapp (Vfunction_key_map)))
+ fkey_start = fkey_end = bufsize + 1;
+
+ restart:
+ t = 0;
+ this_command_key_count = keys_start;
+
+ {
+ Lisp_Object *maps;
+
+ nmaps = current_minor_maps (0, &maps) + 2;
+ if (nmaps > nmaps_allocated)
+ {
+ current = (Lisp_Object *) alloca (nmaps * sizeof (current[0]));
+ defs = (Lisp_Object *) alloca (nmaps * sizeof (defs[0]));
+ nmaps_allocated = nmaps;
+ }
+ bcopy (maps, current, (nmaps - 2) * sizeof (current[0]));
+ current[nmaps-2] = last_event_buffer->keymap;
+ current[nmaps-1] = global_map;
+ }
+
+ /* Find an accurate initial value for first_binding. */
+ for (first_binding = 0; first_binding < nmaps; first_binding++)
+ if (! NILP (current[first_binding]))
+ break;
+
+ while ((first_binding < nmaps && ! NILP (current[first_binding]))
+ || (first_binding >= nmaps && fkey_start < t))
+ {
+ Lisp_Object key;
+
+ if (t >= bufsize)
+ error ("key sequence too long");
+
+ /* Are we reading keys stuffed into keybuf? */
+ if (t < mock_input)
+ {
+ key = keybuf[t];
+ add_command_key (key);
+ echo_char (key);
+ }
+ /* Otherwise, we should actually read a character. */
+ else
+ {
+ struct buffer *buf;
+
+ if (!prompt && INTERACTIVE)
+ key = read_char_menu_prompt (prompt, Qnil, Qnil);
+ else
+ key = read_char (!prompt);
+
+ /* The above routines return -1 at the end of a macro.
+ Emacs 18 handles this by returning immediately with a
+ zero, so that's what we'll do. */
+ if (XTYPE (key) == Lisp_Int && XINT (key) < 0)
+ return 0;
+
+ Vquit_flag = Qnil;
+
+ /* What buffer was this event typed/moused at? */
+ if (XTYPE (key) == Lisp_Int || XTYPE (key) == Lisp_Symbol)
+ buf = (XBUFFER
+ (XWINDOW
+ (SCREEN_SELECTED_WINDOW
+ (XSCREEN (Vlast_event_screen)))->buffer));
+ else if (EVENT_HAS_PARAMETERS (key))
+ {
+ Lisp_Object window = EVENT_WINDOW (key);
+
+ if (NILP (window))
+ abort ();
+
+ buf = XBUFFER (XWINDOW (window)->buffer);
+ }
+ else
+ abort ();
+
+ /* If this event came to a different buffer than the one
+ we're currently in, switch buffers and start a new key
+ sequence, starting with key. */
+ if (buf != last_event_buffer)
+ {
+ last_event_buffer = buf;
+ Fselect_screen (Vlast_event_screen, Qnil);
+
+ /* Arrange to read key as the next event. */
+ keybuf[0] = key;
+ mock_input = 1;
+
+ /* Truncate the key sequence in the echo area. */
+ if (INTERACTIVE)
+ echo_truncate (echo_start);
+
+ goto restart;
+ }
+ }
+
+ first_binding = (follow_key (key,
+ nmaps - first_binding,
+ current + first_binding,
+ defs + first_binding,
+ current + first_binding)
+ + first_binding);
+ keybuf[t++] = key;
+
+ /* If the sequence is unbound, see if we can hang a function key
+ off the end of it. Don't reread the expansion of a function key. */
+ if (first_binding >= nmaps
+ && t > mock_input)
+ {
+ Lisp_Object fkey_next;
+
+ /* Scan from fkey_end until we find a bound suffix. */
+ while (fkey_end < t)
+ {
+ fkey_next =
+ get_keyelt (access_keymap (fkey_map, keybuf[fkey_end++]));
+
+ /* If keybuf[fkey_start..fkey_next] is bound in the
+ function key map and it's a suffix, replace it with
+ the binding and restart. */
+ if (XTYPE (fkey_next) == Lisp_Vector
+ && fkey_end == t)
+ {
+ t = fkey_start + XVECTOR (fkey_next)->size;
+ if (t >= bufsize)
+ error ("key sequence too long");
+
+ bcopy (XVECTOR (fkey_next)->contents,
+ keybuf + fkey_start,
+ (t - fkey_start) * sizeof (keybuf[0]));
+
+ mock_input = t;
+ fkey_start = fkey_end = t;
+
+ /* Truncate the key sequence in the echo area. */
+ if (INTERACTIVE)
+ echo_truncate (echo_start);
+
+ goto restart;
+ }
+
+ fkey_map = get_keymap_1 (fkey_next, 0);
+
+ /* If we no longer have a bound suffix, advance
+ the start of the function key suffix and continue
+ scanning from there. */
+ if (NILP (fkey_map))
+ {
+ fkey_end = ++fkey_start;
+ fkey_map = Vfunction_key_map;
+ }
+ }
+ }
+ }
+
+ read_key_sequence_cmd = (first_binding < nmaps
+ ? defs[first_binding]
+ : Qnil);
+
+ return t;
+}
+
+DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 1, 0,
+ "Read a sequence of keystrokes and return as a string or vector.\n\
+The sequence is sufficient to specify a non-prefix command in the\n\
+current local and global maps.\n\
+\n\
+Arg PROMPT is a prompt string. If nil, do not prompt specially.\n\
+\n\
+If Emacs is running on multiple screens, switching between screens in\n\
+the midst of a keystroke will toss any prefix typed so far. A C-g\n\
+typed while in this function is treated like any other character, and\n\
+`quit-flag' is not set.")
+ (prompt)
+ Lisp_Object prompt;
+{
+ Lisp_Object keybuf[30];
+ register int i;
+ struct gcpro gcpro1, gcpro2;
+
+ if (!NILP (prompt))
+ CHECK_STRING (prompt, 0);
+ QUIT;
+
+ bzero (keybuf, sizeof keybuf);
+ GCPRO1 (keybuf[0]);
+ gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0]));
+
+ this_command_key_count = 0;
+ i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])),
+ NILP (prompt) ? 0 : XSTRING (prompt)->data);
+
+ UNGCPRO;
+ return make_array (i, keybuf);
+}
+\f
+DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 2, 0,
+ "Execute CMD as an editor command.\n\
+CMD must be a symbol that satisfies the `commandp' predicate.\n\
+Optional second arg RECORD-FLAG non-nil\n\
+means unconditionally put this command in `command-history'.\n\
+Otherwise, that is done only if an arg is read using the minibuffer.")
+ (cmd, record)
+ Lisp_Object cmd, record;
+{
+ register Lisp_Object final;
+ register Lisp_Object tem;
+ Lisp_Object prefixarg;
+ struct backtrace backtrace;
+ extern int debug_on_next_call;
+
+ prefixarg = Vprefix_arg, Vprefix_arg = Qnil;
+ Vcurrent_prefix_arg = prefixarg;
+ debug_on_next_call = 0;
+
+ if (XTYPE (cmd) == Lisp_Symbol)
+ {
+ tem = Fget (cmd, Qdisabled);
+ if (!NILP (tem))
+ return call1 (Vrun_hooks, Vdisabled_command_hook);
+ }
+
+ while (1)
+ {
+ final = cmd;
+ while (XTYPE (final) == Lisp_Symbol)
+ {
+ if (EQ (Qunbound, XSYMBOL (final)->function))
+ Fsymbol_function (final); /* Get an error! */
+ final = XSYMBOL (final)->function;
+ }
+
+ if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
+ do_autoload (final, cmd);
+ else
+ break;
+ }
+
+ if (XTYPE (final) == Lisp_String
+ || XTYPE (final) == Lisp_Vector)
+ {
+ /* If requested, place the macro in the command history. For
+ other sorts of commands, call-interactively takes care of
+ this. */
+ if (!NILP (record))
+ Vcommand_history
+ = Fcons (Fcons (Qexecute_kbd_macro,
+ Fcons (final, Fcons (prefixarg, Qnil))),
+ Vcommand_history);
+
+ return Fexecute_kbd_macro (final, prefixarg);
+ }
+ if (CONSP (final) || XTYPE (final) == Lisp_Subr
+ || XTYPE (final) == Lisp_Compiled)
+ {
+ backtrace.next = backtrace_list;
+ backtrace_list = &backtrace;
+ backtrace.function = &Qcall_interactively;
+ backtrace.args = &cmd;
+ backtrace.nargs = 1;
+ backtrace.evalargs = 0;
+
+ tem = Fcall_interactively (cmd, record);
+
+ backtrace_list = backtrace.next;
+ return tem;
+ }
+ return Qnil;
+}
+\f
+#if 0
+DEFUN ("execute-mouse-event", Fexecute_mouse_event, Sexecute_mouse_event,
+ 1, 1, 0,
+ "Execute the definition of the mouse-click event EVENT.\n\
+The handler function is found by looking the event's key sequence up\n\
+in the buffer's local mouse map and in `global-mouse-map'.\n\
+\n\
+After running the handler, call the value of `mouse-event-function'\n\
+with EVENT as arg.")
+ (event)
+ Lisp_Object event;
+{
+ Lisp_Object tem;
+ Lisp_Object mouse_cmd;
+ Lisp_Object keyseq, window, screen_part, pos, time;
+
+#ifndef HAVE_X11
+ Vmouse_event = event;
+#endif
+
+ if (EQ (event, Qnil))
+ {
+ bitch_at_user ();
+ return Qnil;
+ }
+
+ CHECK_CONS (event, 0);
+ pos = Fcar (event);
+ window = Fcar (Fcdr (event));
+ screen_part = Fcar (Fcdr (Fcdr (event)));
+ keyseq = Fcar (Fcdr (Fcdr (Fcdr (event))));
+ time = Fcar (Fcdr (Fcdr (Fcdr (Fcdr (event)))));
+ CHECK_STRING (keyseq, 0);
+ CHECK_WINDOW (window, 0);
+
+ /* Look up KEYSEQ in the buffer's local mouse map, then in global one. */
+
+ mouse_cmd = Qnil;
+
+ if (!NILP (XWINDOW (window)->buffer))
+ {
+ Lisp_Object local_map;
+
+ local_map = XBUFFER (XWINDOW (window)->buffer)->mouse_map;
+ tem = Fkeymapp (local_map);
+ if (!NILP (tem))
+ mouse_cmd = Flookup_key (local_map, keyseq);
+ /* A number as value means the key is too long; treat as undefined. */
+ if (XTYPE (mouse_cmd) == Lisp_Int)
+ mouse_cmd = Qnil;
+ }
+
+ tem = Fkeymapp (Vglobal_mouse_map);
+ if (NILP (mouse_cmd) && !NILP (tem))
+ mouse_cmd = Flookup_key (Vglobal_mouse_map, keyseq);
+ if (XTYPE (mouse_cmd) == Lisp_Int)
+ mouse_cmd = Qnil;
+
+ if (NILP (mouse_cmd))
+ {
+ /* This button/shift combination is not defined.
+ If it is a button-down event, ring the bell. */
+#ifdef HAVE_X11
+ if (XSTRING (keyseq)->data[XSTRING (keyseq)->size - 1] & 0x18 == 0)
+#else
+ if (XSTRING (keyseq)->data[XSTRING (keyseq)->size - 1] & 4 == 0)
+#endif
+ bitch_at_user ();
+ }
+ else
+ {
+ SCREEN_PTR s = XSCREEN (WINDOW_SCREEN (XWINDOW (window)));
+
+#ifndef HAVE_X11
+ Vmouse_window = s->selected_window;
+#endif /* HAVE_X11 */
+ /* It's defined; call the definition. */
+ Vprefix_arg = Qnil;
+ if (!NILP (screen_part))
+ {
+ /* For a scroll-bar click, set the prefix arg
+ to the number of lines down from the top the click was.
+ Many scroll commands want to scroll by this many lines. */
+ Lisp_Object position;
+ Lisp_Object length;
+ Lisp_Object offset;
+
+ position = Fcar (pos);
+ length = Fcar (Fcdr (pos));
+ offset = Fcar (Fcdr (Fcdr (pos)));
+
+ if (XINT (length) != 0)
+ XSET (Vprefix_arg, Lisp_Int,
+ (SCREEN_HEIGHT (s) * (XINT (position) + XINT (offset))
+ / (XINT (length) + 2 * XINT (offset))));
+ }
+ Fcommand_execute (mouse_cmd, Qnil);
+ }
+
+ if (!NILP (Vmouse_event_function)) /* Not `event' so no need for GCPRO */
+ call1 (Vmouse_event_function, Vmouse_event);
+ return Qnil;
+}
+#endif
+\f
+DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
+ 1, 1, "P",
+ "Read function name, then read its arguments and call it.")
+ (prefixarg)
+ Lisp_Object prefixarg;
+{
+ Lisp_Object function;
+ char buf[40];
+ Lisp_Object saved_keys;
+ struct gcpro gcpro1;
+
+ saved_keys = Fthis_command_keys ();
+ buf[0] = 0;
+ GCPRO1 (saved_keys);
+
+ if (EQ (prefixarg, Qminus))
+ strcpy (buf, "- ");
+ else if (CONSP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4)
+ strcpy (buf, "C-u ");
+ else if (CONSP (prefixarg) && XTYPE (XCONS (prefixarg)->car) == Lisp_Int)
+ sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car));
+ else if (XTYPE (prefixarg) == Lisp_Int)
+ sprintf (buf, "%d ", XINT (prefixarg));
+
+ /* This isn't strictly correct if execute-extended-command
+ is bound to anything else. Perhaps it should use
+ this_command_keys? */
+ strcat (buf, "M-x ");
+
+ /* Prompt with buf, and then read a string, completing from and
+ restricting to the set of all defined commands. Don't provide
+ any initial input. The last Qnil says not to perform a
+ peculiar hack on the initial input. */
+ function = Fcompleting_read (build_string (buf),
+ Vobarray, Qcommandp,
+ Qt, Qnil, Qnil);
+
+ /* Add the text read to this_command_keys. */
+ {
+ struct Lisp_String *func_str = XSTRING (function);
+ int i;
+ Lisp_Object tem;
+
+ for (i = 0; i < func_str->size; i++)
+ {
+ XSET (tem, Lisp_Int, func_str->data[i]);
+ add_command_key (tem);
+ }
+ }
+
+ UNGCPRO;
+
+ function = Fintern (function, Vobarray);
+ Vprefix_arg = prefixarg;
+ this_command = function;
+
+ return Fcommand_execute (function, Qt);
+}
+\f
+
+detect_input_pending ()
+{
+ if (!input_pending)
+ get_input_pending (&input_pending);
+
+ return input_pending;
+}
+
+DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
+ "T if command input is currently available with no waiting.\n\
+Actually, the value is nil only if we can be sure that no input is available.")
+ ()
+{
+ if (!NILP (unread_command_char))
+ return (Qt);
+
+ return detect_input_pending () ? Qt : Qnil;
+}
+
+DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0,
+ "Return vector of last 100 chars read from terminal.")
+ ()
+{
+ Lisp_Object val;
+
+ if (total_keys < NUM_RECENT_KEYS)
+ return Fvector (total_keys, recent_keys);
+ else
+ {
+ val = Fvector (NUM_RECENT_KEYS, recent_keys);
+ bcopy (recent_keys + recent_keys_index,
+ XVECTOR (val)->contents,
+ (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object));
+ bcopy (recent_keys,
+ XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index,
+ recent_keys_index * sizeof (Lisp_Object));
+ return val;
+ }
+}
+
+DEFUN ("this-command-keys", Fthis_command_keys, Sthis_command_keys, 0, 0, 0,
+ "Return string of the keystrokes that invoked this command.")
+ ()
+{
+ return make_array (this_command_key_count, this_command_keys);
+}
+
+DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0,
+ "Return the current depth in recursive edits.")
+ ()
+{
+ Lisp_Object temp;
+ XFASTINT (temp) = command_loop_level + minibuf_level;
+ return temp;
+}
+
+DEFUN ("open-dribble-file", Fopen_dribble_file, Sopen_dribble_file, 1, 1,
+ "FOpen dribble file: ",
+ "Start writing all keyboard characters to FILE.")
+ (file)
+ Lisp_Object file;
+{
+ if (NILP (file))
+ {
+ fclose (dribble);
+ dribble = 0;
+ }
+ else
+ {
+ file = Fexpand_file_name (file, Qnil);
+ dribble = fopen (XSTRING (file)->data, "w");
+ }
+ return Qnil;
+}
+
+DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0,
+ "Discard the contents of the terminal input buffer.\n\
+Also cancel any kbd macro being defined.")
+ ()
+{
+ defining_kbd_macro = 0;
+ update_mode_lines++;
+
+#if 0
+ unread_command_char = make_number (-1);
+#endif
+ unread_command_char = Qnil;
+
+ discard_tty_input ();
+
+ kbd_fetch_ptr = kbd_store_ptr;
+ input_pending = 0;
+
+ return Qnil;
+}
+\f
+DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "",
+ "Stop Emacs and return to superior process. You can resume later.\n\
+On systems that don't have job control, run a subshell instead.\n\n\
+If optional arg STUFFSTRING is non-nil, its characters are stuffed\n\
+to be read as terminal input by Emacs's superior shell.\n\
+Before suspending, if `suspend-hook' is bound and value is non-nil\n\
+call the value as a function of no args. Don't suspend if it returns non-nil.\n\
+Otherwise, suspend normally and after resumption call\n\
+`suspend-resume-hook' if that is bound and non-nil.\n\
+\n\
+Some operating systems cannot stop the Emacs process and resume it later.\n\
+On such systems, Emacs will start a subshell and wait for it to exit.")
+ (stuffstring)
+ Lisp_Object stuffstring;
+{
+ register Lisp_Object tem;
+ int count = specpdl_ptr - specpdl;
+ int old_height, old_width;
+ int width, height;
+ struct gcpro gcpro1;
+ extern init_sys_modes ();
+
+ if (!NILP (stuffstring))
+ CHECK_STRING (stuffstring, 0);
+ GCPRO1 (stuffstring);
+
+ /* Call value of suspend-hook
+ if it is bound and value is non-nil. */
+ if (!NILP (Vrun_hooks))
+ {
+ tem = call1 (Vrun_hooks, intern ("suspend-hook"));
+ if (!EQ (tem, Qnil)) return Qnil;
+ }
+
+ get_screen_size (&old_width, &old_height);
+ reset_sys_modes ();
+ /* sys_suspend can get an error if it tries to fork a subshell
+ and the system resources aren't available for that. */
+ record_unwind_protect (init_sys_modes, 0);
+ stuff_buffered_input (stuffstring);
+ sys_suspend ();
+ unbind_to (count, Qnil);
+
+ /* Check if terminal/window size has changed.
+ Note that this is not useful when we are running directly
+ with a window system; but suspend should be disabled in that case. */
+ get_screen_size (&width, &height);
+ if (width != old_width || height != old_height)
+ change_screen_size (height, width, 0);
+
+ /* Call value of suspend-resume-hook
+ if it is bound and value is non-nil. */
+ if (!NILP (Vrun_hooks))
+ call1 (Vrun_hooks, intern ("suspend-resume-hook"));
+
+ UNGCPRO;
+ return Qnil;
+}
+
+/* If STUFFSTRING is a string, stuff its contents as pending terminal input.
+ Then in any case stuff anthing Emacs has read ahead and not used. */
+
+stuff_buffered_input (stuffstring)
+ Lisp_Object stuffstring;
+{
+ register unsigned char *p;
+
+/* stuff_char works only in BSD, versions 4.2 and up. */
+#ifdef BSD
+#ifndef BSD4_1
+ if (XTYPE (stuffstring) == Lisp_String)
+ {
+ register int count;
+
+ p = XSTRING (stuffstring)->data;
+ count = XSTRING (stuffstring)->size;
+ while (count-- > 0)
+ stuff_char (*p++);
+ stuff_char ('\n');
+ }
+ /* Anything we have read ahead, put back for the shell to read. */
+ while (kbd_fetch_ptr != kbd_store_ptr)
+ {
+ if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
+ kbd_fetch_ptr = kbd_buffer;
+ if (kbd_fetch_ptr->kind == ascii_keystroke)
+ stuff_char (XINT (kbd_fetch_ptr->code));
+ kbd_fetch_ptr++;
+ }
+ input_pending = 0;
+#endif
+#endif /* BSD and not BSD4_1 */
+}
+\f
+set_waiting_for_input (word_to_clear)
+ long *word_to_clear;
+{
+ input_available_clear_word = word_to_clear;
+
+ /* Tell interrupt_signal to throw back to read_char, */
+ waiting_for_input = 1;
+
+ /* If interrupt_signal was called before and buffered a C-g,
+ make it run again now, to avoid timing error. */
+ if (!NILP (Vquit_flag))
+ quit_throw_to_read_char ();
+
+ /* If alarm has gone off already, echo now. */
+ if (echo_flag)
+ {
+ echo ();
+ echo_flag = 0;
+ }
+}
+
+clear_waiting_for_input ()
+{
+ /* Tell interrupt_signal not to throw back to read_char, */
+ waiting_for_input = 0;
+ input_available_clear_word = 0;
+}
+
+/* This routine is called at interrupt level in response to C-G.
+ If interrupt_input, this is the handler for SIGINT.
+ Otherwise, it is called from kbd_buffer_store_event,
+ in handling SIGIO or SIGTINT.
+
+ If `waiting_for_input' is non zero, then unless `echoing' is nonzero,
+ immediately throw back to read_char.
+
+ Otherwise it sets the Lisp variable quit-flag not-nil.
+ This causes eval to throw, when it gets a chance.
+ If quit-flag is already non-nil, it stops the job right away. */
+
+SIGTYPE
+interrupt_signal ()
+{
+ char c;
+ /* Must preserve main program's value of errno. */
+ int old_errno = errno;
+ extern Lisp_Object Vwindow_system;
+
+#ifdef USG
+ /* USG systems forget handlers when they are used;
+ must reestablish each time */
+ signal (SIGINT, interrupt_signal);
+ signal (SIGQUIT, interrupt_signal);
+#endif /* USG */
+
+ cancel_echoing ();
+
+ if (!NILP (Vquit_flag) && SCREEN_IS_TERMCAP (selected_screen))
+ {
+ fflush (stdout);
+ reset_sys_modes ();
+ sigfree ();
+#ifdef SIGTSTP /* Support possible in later USG versions */
+/*
+ * On systems which can suspend the current process and return to the original
+ * shell, this command causes the user to end up back at the shell.
+ * The "Auto-save" and "Abort" questions are not asked until
+ * the user elects to return to emacs, at which point he can save the current
+ * job and either dump core or continue.
+ */
+ sys_suspend ();
+#else
+#ifdef VMS
+ if (sys_suspend () == -1)
+ {
+ printf ("Not running as a subprocess;\n");
+ printf ("you can continue or abort.\n");
+ }
+#else /* not VMS */
+ /* Perhaps should really fork an inferior shell?
+ But that would not provide any way to get back
+ to the original shell, ever. */
+ printf ("No support for stopping a process on this operating system;\n");
+ printf ("you can continue or abort.\n");
+#endif /* not VMS */
+#endif /* not SIGTSTP */
+ printf ("Auto-save? (y or n) ");
+ fflush (stdout);
+ if (((c = getchar ()) & ~040) == 'Y')
+ Fdo_auto_save (Qnil, Qnil);
+ while (c != '\n') c = getchar ();
+#ifdef VMS
+ printf ("Abort (and enter debugger)? (y or n) ");
+#else /* not VMS */
+ printf ("Abort (and dump core)? (y or n) ");
+#endif /* not VMS */
+ fflush (stdout);
+ if (((c = getchar ()) & ~040) == 'Y')
+ abort ();
+ while (c != '\n') c = getchar ();
+ printf ("Continuing...\n");
+ fflush (stdout);
+ init_sys_modes ();
+ }
+ else
+ {
+ /* If executing a function that wants to be interrupted out of
+ and the user has not deferred quitting by binding `inhibit-quit'
+ then quit right away. */
+ if (immediate_quit && NILP (Vinhibit_quit))
+ {
+ immediate_quit = 0;
+ sigfree ();
+ Fsignal (Qquit, Qnil);
+ }
+ else
+ /* Else request quit when it's safe */
+ Vquit_flag = Qt;
+ }
+
+ if (waiting_for_input && !echoing)
+ quit_throw_to_read_char ();
+
+ errno = old_errno;
+}
+
+/* Handle a C-g by making read_char return C-g. */
+
+quit_throw_to_read_char ()
+{
+ quit_error_check ();
+ sigfree ();
+ /* Prevent another signal from doing this before we finish. */
+ waiting_for_input = 0;
+ input_pending = 0;
+
+#if 0
+ unread_command_char = make_number (-1);
+#endif
+ unread_command_char = Qnil;
+
+ _longjmp (getcjmp, 1);
+}
+\f
+DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 4, 0,
+ "Set mode of reading keyboard input.\n\
+First arg non-nil means use input interrupts; nil means use CBREAK mode.\n\
+Second arg non-nil means use ^S/^Q flow control for output to terminal\n\
+ (no effect except in CBREAK mode).\n\
+Third arg non-nil means accept 8-bit input (for a Meta key).\n\
+ Otherwise, the top bit is ignored, on the assumption it is parity.\n\
+Optional fourth arg non-nil specifies character to use for quitting.")
+ (interrupt, flow, meta, quit)
+ Lisp_Object interrupt, flow, meta, quit;
+{
+ if (!NILP (quit)
+ && (XTYPE (quit) != Lisp_Int
+ || XINT (quit) < 0 || XINT (quit) > 0400))
+ error ("set-input-mode: QUIT must be an ASCII character.");
+
+ reset_sys_modes ();
+#ifdef SIGIO
+/* Note SIGIO has been undef'd if FIONREAD is missing. */
+#ifdef NO_SOCK_SIGIO
+ if (read_socket_hook)
+ interrupt_input = 0; /* No interrupts if reading from a socket. */
+ else
+#endif /* NO_SOCK_SIGIO */
+ interrupt_input = !NILP (interrupt);
+#else /* not SIGIO */
+ interrupt_input = 0;
+#endif /* not SIGIO */
+/* Our VMS input only works by interrupts, as of now. */
+#ifdef VMS
+ interrupt_input = 1;
+#endif
+ flow_control = !NILP (flow);
+ meta_key = !NILP (meta);
+ if (!NILP (quit))
+ /* Don't let this value be out of range. */
+ quit_char = XINT (quit) & (meta_key ? 0377 : 0177);
+
+ init_sys_modes ();
+ return Qnil;
+}
+\f
+init_keyboard ()
+{
+ this_command_keys_size = 40;
+ this_command_keys =
+ (Lisp_Object *) xmalloc (this_command_keys_size * sizeof (Lisp_Object));
+
+ /* This is correct before outermost invocation of the editor loop */
+ command_loop_level = -1;
+ immediate_quit = 0;
+ quit_char = Ctl ('g');
+ unread_command_char = Qnil;
+ recent_keys_index = 0;
+ total_keys = 0;
+ kbd_fetch_ptr = kbd_buffer;
+ kbd_store_ptr = kbd_buffer;
+ do_mouse_tracking = 0;
+ input_pending = 0;
+
+ if (!noninteractive)
+ {
+ signal (SIGINT, interrupt_signal);
+#ifdef HAVE_TERMIO
+ /* For systems with SysV TERMIO, C-g is set up for both SIGINT and
+ SIGQUIT and we can't tell which one it will give us. */
+ signal (SIGQUIT, interrupt_signal);
+#endif /* HAVE_TERMIO */
+/* Note SIGIO has been undef'd if FIONREAD is missing. */
+#ifdef SIGIO
+ signal (SIGIO, input_available_signal);
+#endif SIGIO
+ }
+
+/* Use interrupt input by default, if it works and noninterrupt input
+ has deficiencies. */
+
+#ifdef INTERRUPT_INPUT
+ interrupt_input = 1;
+#else
+ interrupt_input = 0;
+#endif
+
+/* Our VMS input only works by interrupts, as of now. */
+#ifdef VMS
+ interrupt_input = 1;
+#endif
+
+ sigfree ();
+ dribble = 0;
+
+ if (keyboard_init_hook)
+ (*keyboard_init_hook) ();
+
+#ifdef POLL_FOR_INPUT
+ poll_suppress_count = 1;
+ start_polling ();
+#endif
+}
+
+/* This type's only use is in syms_of_keyboard, to initialize the
+ event header symbols and put properties on them. */
+struct event_head {
+ Lisp_Object *var;
+ char *name;
+ Lisp_Object *kind;
+};
+
+struct event_head head_table[] = {
+ &Qmouse_movement, "mouse-movement", &Qmouse_movement,
+ &Qvscrollbar_part, "vscrollbar-part", &Qscrollbar_click,
+ &Qvslider_part, "vslider-part", &Qscrollbar_click,
+ &Qvthumbup_part, "vthumbup-part", &Qscrollbar_click,
+ &Qvthumbdown_part, "vthumbdown-part", &Qscrollbar_click,
+ &Qhscrollbar_part, "hscrollbar-part", &Qscrollbar_click,
+ &Qhslider_part, "hslider-part", &Qscrollbar_click,
+ &Qhthumbleft_part, "hthumbleft-part", &Qscrollbar_click,
+ &Qhthumbright_part,"hthumbright-part", &Qscrollbar_click
+};
+
+syms_of_keyboard ()
+{
+ Qself_insert_command = intern ("self-insert-command");
+ staticpro (&Qself_insert_command);
+
+ Qforward_char = intern ("forward-char");
+ staticpro (&Qforward_char);
+
+ Qbackward_char = intern ("backward-char");
+ staticpro (&Qbackward_char);
+
+ Qdisabled = intern ("disabled");
+ staticpro (&Qdisabled);
+
+ Qfunction_key = intern ("function-key");
+ staticpro (&Qfunction_key);
+ Qmouse_movement = intern ("mouse-click");
+ staticpro (&Qmouse_click);
+ Qmouse_movement = intern ("scrollbar-click");
+ staticpro (&Qmouse_movement);
+
+ Qmode_line = intern ("mode-line");
+ staticpro (&Qmode_line);
+ Qvertical_split = intern ("vertical-split");
+ staticpro (&Qvertical_split);
+
+ Qevent_kind = intern ("event-type");
+ staticpro (&Qevent_kind);
+ Qevent_unmodified = intern ("event-unmodified");
+ staticpro (&Qevent_unmodified);
+
+ {
+ struct event_head *p;
+
+ for (p = head_table;
+ p < head_table + (sizeof (head_table) / sizeof (head_table[0]));
+ p++)
+ {
+ *p->var = intern (p->name);
+ staticpro (p->var);
+ Fput (*p->var, Qevent_kind, *p->kind);
+ Fput (*p->var, Qevent_unmodified, *p->var);
+ }
+ }
+
+ func_key_syms = Qnil;
+ staticpro (&func_key_syms);
+
+ mouse_syms = Qnil;
+ staticpro (&mouse_syms);
+
+ defsubr (&Sread_key_sequence);
+ defsubr (&Srecursive_edit);
+ defsubr (&Strack_mouse);
+ defsubr (&Smouse_click_p);
+ defsubr (&Sinput_pending_p);
+ defsubr (&Scommand_execute);
+ defsubr (&Srecent_keys);
+ defsubr (&Sthis_command_keys);
+ defsubr (&Ssuspend_emacs);
+ defsubr (&Sabort_recursive_edit);
+ defsubr (&Sexit_recursive_edit);
+ defsubr (&Srecursion_depth);
+ defsubr (&Stop_level);
+ defsubr (&Sdiscard_input);
+ defsubr (&Sopen_dribble_file);
+ defsubr (&Sset_input_mode);
+ defsubr (&Sexecute_extended_command);
+
+ DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook,
+ "Value is called instead of any command that is disabled\n\
+(has a non-nil `disabled' property).");
+
+ DEFVAR_LISP ("last-command-char", &last_command_char,
+ "Last terminal input key that was part of a command.");
+
+ DEFVAR_LISP ("last-input-char", &last_input_char,
+ "Last terminal input key.");
+
+ DEFVAR_LISP ("unread-command-char", &unread_command_char,
+ "Object to be read as next input from input stream, or nil if none.");
+
+ DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char,
+ "Meta-prefix character code. Meta-foo as command input\n\
+turns into this character followed by foo.");
+ XSET (meta_prefix_char, Lisp_Int, 033);
+
+ DEFVAR_LISP ("last-command", &last_command,
+ "The last command executed. Normally a symbol with a function definition,\n\
+but can be whatever was found in the keymap, or whatever the variable\n\
+`this-command' was set to by that command.");
+ last_command = Qnil;
+
+ DEFVAR_LISP ("this-command", &this_command,
+ "The command now being executed.\n\
+The command can set this variable; whatever is put here\n\
+will be in `last-command' during the following command.");
+ this_command = Qnil;
+
+ DEFVAR_INT ("auto-save-interval", &auto_save_interval,
+ "*Number of keyboard input characters between auto-saves.\n\
+Zero means disable autosaving due to number of characters typed.");
+ auto_save_interval = 300;
+
+ DEFVAR_LISP ("auto-save-timeout", &Vauto_save_timeout,
+ "*Number of seconds idle time before auto-save.\n\
+Zero or nil means disable auto-saving due to idleness.");
+ XFASTINT (Vauto_save_timeout) = 30;
+
+ DEFVAR_INT ("echo-keystrokes", &echo_keystrokes,
+ "*Nonzero means echo unfinished commands after this many seconds of pause.");
+ echo_keystrokes = 1;
+
+ DEFVAR_INT ("polling-period", &polling_period,
+ "*Interval between polling for input during Lisp execution.\n\
+The reason for polling is to make C-g work to stop a running program.\n\
+Polling is needed only when using X windows and SIGIO does not work.\n\
+Polling is automatically disabled in all other cases.");
+ polling_period = 2;
+
+ DEFVAR_INT ("num-input-keys", &num_input_keys,
+ "*Number of complete keys read from the keyboard so far.");
+ num_input_keys = 0;
+
+ DEFVAR_LISP ("last-event-screen", &Vlast_event_screen,
+ "*The screen in which the most recently read event occurred.");
+ Vlast_event_screen = Qnil;
+
+ DEFVAR_LISP ("help-char", &help_char,
+ "Character to recognize as meaning Help.\n\
+When it is read, do `(eval help-form)', and display result if it's a string.\n\
+If the value of `help-form' is nil, this char can be read normally.");
+ XSET (help_char, Lisp_Int, Ctl ('H'));
+
+ DEFVAR_LISP ("help-form", &Vhelp_form,
+ "Form to execute when character help-char is read.\n\
+If the form returns a string, that string is displayed.\n\
+If `help-form' is nil, the help char is not recognized.");
+ Vhelp_form = Qnil;
+
+ DEFVAR_LISP ("top-level", &Vtop_level,
+ "Form to evaluate when Emacs starts up.\n\
+Useful to set before you dump a modified Emacs.");
+ Vtop_level = Qnil;
+
+ DEFVAR_LISP ("keyboard-translate-table", &Vkeyboard_translate_table,
+ "String used as translate table for keyboard input, or nil.\n\
+Each character is looked up in this string and the contents used instead.\n\
+If string is of length N, character codes N and up are untranslated.");
+ Vkeyboard_translate_table = Qnil;
+
+#ifdef HAVE_X_WINDOWS
+ DEFVAR_LISP ("mouse-event-function", &Vmouse_event_function,
+ "Function to call for each mouse event, after the event's definition.\n\
+Called, if non-nil, with one argument, which is the event-list.\n\
+See the variable `mouse-event' for the format of this list.");
+ Vmouse_event_function = Qnil;
+
+ DEFVAR_LISP ("mouse-left-hook", &Vmouse_left_hook,
+ "Function to call when mouse leaves window. No arguments.");
+ Vmouse_left_hook = Qnil;
+
+ DEFVAR_LISP ("map-screen-hook", &Vmap_screen_hook,
+ "Function to call when screen is mapped. No arguments.");
+ Vmap_screen_hook = Qnil;
+
+ DEFVAR_LISP ("unmap-screen-hook", &Vunmap_screen_hook,
+ "Function to call when screen is unmapped. No arguments.");
+ Vunmap_screen_hook = Qnil;
+
+ DEFVAR_LISP ("mouse-motion-handler", &Vmouse_motion_handler,
+ "Handler for motion events. No arguments.");
+ Vmouse_motion_handler = Qnil;
+#endif
+
+ DEFVAR_BOOL ("menu-prompting", &menu_prompting,
+ "Non-nil means prompt with menus in echo area when appropriate.\n\
+This is done when reading from a keymap that has a prompt string,\n\
+for elements that have prompt strings.");
+ menu_prompting = 1;
+
+ DEFVAR_LISP ("menu-prompt-more-char", &menu_prompt_more_char,
+ "Character to see next line of menu prompt.\n\
+Type this character while in a menu prompt to rotate around the lines of it.");
+ XSET (menu_prompt_more_char, Lisp_Int, ' ');
+}
+
+keys_of_keyboard ()
+{
+ initial_define_key (global_map, Ctl ('Z'), "suspend-emacs");
+ initial_define_key (control_x_map, Ctl ('Z'), "suspend-emacs");
+ initial_define_key (meta_map, Ctl ('C'), "exit-recursive-edit");
+ initial_define_key (global_map, Ctl (']'), "abort-recursive-edit");
+ initial_define_key (meta_map, 'x', "execute-extended-command");
+}