keyboard.c

/* Keyboard and mouse input; editor command loop.

Copyright (C) 1985-1989, 1993-1997, 1999-2011  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 3 of the License, 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.  If not, see <http://www.gnu.org/licenses/>.  */

#include <config.h>
#include <signal.h>
#include <stdio.h>
#include <setjmp.h>
#include "lisp.h"
#include "termchar.h"
#include "termopts.h"
#include "frame.h"
#include "termhooks.h"
#include "macros.h"
#include "keyboard.h"
#include "window.h"
#include "commands.h"
#include "buffer.h"
#include "character.h"
#include "disptab.h"
#include "dispextern.h"
#include "syntax.h"
#include "intervals.h"
#include "keymap.h"
#include "blockinput.h"
#include "puresize.h"
#include "systime.h"
#include "atimer.h"
#include "process.h"
#include <errno.h>

#ifdef HAVE_GTK_AND_PTHREAD
#include <pthread.h>
#endif
#ifdef MSDOS
#include "msdos.h"
#include <time.h>
#else /* not MSDOS */
#include <sys/ioctl.h>
#endif /* not MSDOS */

#include "syssignal.h"

#include <sys/types.h>
#include <unistd.h>
#include <fcntl.h>

/* This is to get the definitions of the XK_ symbols.  */
#ifdef HAVE_X_WINDOWS
#include "xterm.h"
#endif

#ifdef HAVE_NTGUI
#include "w32term.h"
#endif /* HAVE_NTGUI */

#ifdef HAVE_NS
#include "nsterm.h"
#endif

/* Variables for blockinput.h: */

/* Non-zero if interrupt input is blocked right now.  */
volatile int interrupt_input_blocked;

/* Nonzero means an input interrupt has arrived
   during the current critical section.  */
int interrupt_input_pending;

/* This var should be (interrupt_input_pending || pending_atimers).
   The QUIT macro checks this instead of interrupt_input_pending and
   pending_atimers separately, to reduce code size.  So, any code that
   changes interrupt_input_pending or pending_atimers should update
   this too.  */
#ifdef SYNC_INPUT
int pending_signals;
#endif

#define KBD_BUFFER_SIZE 4096

KBOARD *initial_kboard;
KBOARD *current_kboard;
KBOARD *all_kboards;
int single_kboard;

/* Non-nil disable property on a command means
   do not execute it; call disabled-command-function's value instead.  */
Lisp_Object Qdisabled, Qdisabled_command_function;

#define NUM_RECENT_KEYS (300)
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; /* Vector holds the last NUM_RECENT_KEYS keystrokes */

/* Vector holding the key sequence that invoked the current command.
   It is reused for each command, and it may be longer than the current
   sequence; this_command_key_count indicates how many elements
   actually mean something.
   It's easier to staticpro a single Lisp_Object than an array.  */
Lisp_Object this_command_keys;
int this_command_key_count;

/* 1 after calling Freset_this_command_lengths.
   Usually it is 0.  */
int this_command_key_count_reset;

/* This vector is used as a buffer to record the events that were actually read
   by read_key_sequence.  */
Lisp_Object raw_keybuf;
int raw_keybuf_count;

#define GROW_RAW_KEYBUF							\
 if (raw_keybuf_count == XVECTOR (raw_keybuf)->size)			\
   raw_keybuf = larger_vector (raw_keybuf, raw_keybuf_count * 2, Qnil)  \

/* Number of elements of this_command_keys
   that precede this key sequence.  */
int this_single_command_key_start;

/* Record values of this_command_key_count and echo_length ()
   before this command was read.  */
static int before_command_key_count;
static int before_command_echo_length;

/* 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.  */

int echoing;

/* Non-null means we can start echoing at the next input pause even
   though there is something in the echo area.  */

static struct kboard *ok_to_echo_at_next_pause;

/* The kboard last echoing, or null for none.  Reset to 0 in
   cancel_echoing.  If non-null, and a current echo area message
   exists, and echo_message_buffer is eq to the current message
   buffer, we know that the message comes from echo_kboard.  */

struct kboard *echo_kboard;

/* The buffer used for echoing.  Set in echo_now, reset in
   cancel_echoing.  */

Lisp_Object echo_message_buffer;

/* Nonzero means C-g should cause immediate error-signal.  */
int immediate_quit;

/* 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;

/* Current depth in recursive edits.  */
int command_loop_level;

/* If not Qnil, this is a switch-frame event which we decided to put
   off until the end of a key sequence.  This should be read as the
   next command input, after any unread_command_events.

   read_key_sequence uses this to delay switch-frame events until the
   end of the key sequence; Fread_char uses it to put off switch-frame
   events until a non-ASCII event is acceptable as input.  */
Lisp_Object unread_switch_frame;

/* Last size recorded for a current buffer which is not a minibuffer.  */
static EMACS_INT last_non_minibuf_size;

/* Total number of times read_char has returned.  */
int num_input_events;

/* Value of num_nonmacro_input_events as of last auto save.  */

int last_auto_save;

/* This is like Vthis_command, except that commands never set it.  */
Lisp_Object real_this_command;

/* The value of point when the last command was started.  */
EMACS_INT last_point_position;

/* The buffer that was current when the last command was started.  */
Lisp_Object last_point_position_buffer;

/* The window that was selected when the last command was started.  */
Lisp_Object last_point_position_window;

/* The frame in which the last input event occurred, or Qmacro if the
   last event came from a macro.  We use this to determine when to
   generate switch-frame events.  This may be cleared by functions
   like Fselect_frame, to make sure that a switch-frame event is
   generated by the next character.  */
Lisp_Object internal_last_event_frame;

/* The timestamp of the last input event we received from the X server.
   X Windows wants this for selection ownership.  */
unsigned long last_event_timestamp;

Lisp_Object Qx_set_selection, QPRIMARY, Qhandle_switch_frame;

Lisp_Object Qself_insert_command;
Lisp_Object Qforward_char;
Lisp_Object Qbackward_char;
Lisp_Object Qundefined;
Lisp_Object Qtimer_event_handler;

/* read_key_sequence stores here the command definition of the
   key sequence that it reads.  */
Lisp_Object read_key_sequence_cmd;

Lisp_Object Qinput_method_function;

Lisp_Object Qdeactivate_mark;

Lisp_Object Qrecompute_lucid_menubar, Qactivate_menubar_hook;

Lisp_Object Qecho_area_clear_hook;

/* Hooks to run before and after each command.  */
Lisp_Object Qpre_command_hook;
Lisp_Object Qpost_command_hook;
Lisp_Object Qcommand_hook_internal;

Lisp_Object Qdeferred_action_function;

Lisp_Object Qinput_method_exit_on_first_char;
Lisp_Object Qinput_method_use_echo_area;

/* File in which we write all commands we read.  */
FILE *dribble;

/* Nonzero if input is available.  */
int input_pending;

/* 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
   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 * volatile kbd_store_ptr;

/* The above pair of variables forms a "queue empty" flag.  When we
   enqueue a non-hook event, we increment kbd_store_ptr.  When we
   dequeue a non-hook event, we increment kbd_fetch_ptr.  We say that
   there is input available if the two pointers are not 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.  */

/* Symbols to head events.  */
Lisp_Object Qmouse_movement;
Lisp_Object Qscroll_bar_movement;
Lisp_Object Qswitch_frame;
Lisp_Object Qdelete_frame;
Lisp_Object Qiconify_frame;
Lisp_Object Qmake_frame_visible;
Lisp_Object Qselect_window;
Lisp_Object Qhelp_echo;

#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
Lisp_Object Qmouse_fixup_help_message;
#endif

/* Symbols to denote kinds of events.  */
Lisp_Object Qfunction_key;
Lisp_Object Qmouse_click;
#if defined (WINDOWSNT)
Lisp_Object Qlanguage_change;
#endif
Lisp_Object Qdrag_n_drop;
Lisp_Object Qsave_session;
#ifdef HAVE_DBUS
Lisp_Object Qdbus_event;
#endif
Lisp_Object Qconfig_changed_event;

/* Lisp_Object Qmouse_movement; - also an event header */

/* Properties of event headers.  */
Lisp_Object Qevent_kind;
Lisp_Object Qevent_symbol_elements;

/* menu and tool bar item parts */
Lisp_Object Qmenu_enable;
Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCkeys, QCkey_sequence;
Lisp_Object QCbutton, QCtoggle, QCradio, QClabel, QCvert_only;

/* An event header symbol HEAD may have a property named
   Qevent_symbol_element_mask, which is of the form (BASE MODIFIERS);
   BASE is the base, unmodified version of HEAD, and MODIFIERS is the
   mask of modifiers applied to it.  If present, this is used to help
   speed up parse_modifiers.  */
Lisp_Object Qevent_symbol_element_mask;

/* An unmodified event header BASE may have a property named
   Qmodifier_cache, which is an alist mapping modifier masks onto
   modified versions of BASE.  If present, this helps speed up
   apply_modifiers.  */
Lisp_Object Qmodifier_cache;

/* Symbols to use for parts of windows.  */
Lisp_Object Qmode_line;
Lisp_Object Qvertical_line;
Lisp_Object Qvertical_scroll_bar;
Lisp_Object Qmenu_bar;

Lisp_Object recursive_edit_unwind (Lisp_Object buffer), command_loop (void);
Lisp_Object Fthis_command_keys (void);
Lisp_Object Qextended_command_history;
EMACS_TIME timer_check (int do_it_now);

static void record_menu_key (Lisp_Object c);
static int echo_length (void);

Lisp_Object Qpolling_period;

/* Incremented whenever a timer is run.  */
int timers_run;

/* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
   happens.  */
EMACS_TIME *input_available_clear_time;

/* 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;

/* 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.  */
#if !defined (FIONREAD)
#ifdef SIGIO
#undef SIGIO
#endif
#endif

/* If we support a window system, turn on the code to poll periodically
   to detect C-g.  It isn't actually used when doing interrupt input.  */
#if defined(HAVE_WINDOW_SYSTEM) && !defined(USE_ASYNC_EVENTS)
#define POLL_FOR_INPUT
#endif

/* The time when Emacs started being idle.  */

static EMACS_TIME timer_idleness_start_time;

/* After Emacs stops being idle, this saves the last value
   of timer_idleness_start_time from when it was idle.  */

static EMACS_TIME timer_last_idleness_start_time;


/* Global variable declarations.  */

/* Flags for readable_events.  */
#define READABLE_EVENTS_DO_TIMERS_NOW		(1 << 0)
#define READABLE_EVENTS_FILTER_EVENTS		(1 << 1)
#define READABLE_EVENTS_IGNORE_SQUEEZABLES	(1 << 2)

/* Function for init_keyboard to call with no args (if nonzero).  */
void (*keyboard_init_hook) (void);

static int read_avail_input (int);
static void get_input_pending (int *, int);
static int readable_events (int);
static Lisp_Object read_char_x_menu_prompt (int, Lisp_Object *,
                                            Lisp_Object, int *);
static Lisp_Object read_char_minibuf_menu_prompt (int, int,
                                                  Lisp_Object *);
static Lisp_Object make_lispy_event (struct input_event *);
#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
static Lisp_Object make_lispy_movement (struct frame *, Lisp_Object,
                                        enum scroll_bar_part,
                                        Lisp_Object, Lisp_Object,
                                        unsigned long);
#endif
static Lisp_Object modify_event_symbol (EMACS_INT, unsigned, Lisp_Object,
                                        Lisp_Object, const char *const *,
                                        Lisp_Object *, unsigned);
static Lisp_Object make_lispy_switch_frame (Lisp_Object);
static void save_getcjmp (jmp_buf);
static void restore_getcjmp (jmp_buf);
static Lisp_Object apply_modifiers (int, Lisp_Object);
static void clear_event (struct input_event *);
static Lisp_Object restore_kboard_configuration (Lisp_Object);
static SIGTYPE interrupt_signal (int signalnum);
#ifdef SIGIO
static SIGTYPE input_available_signal (int signo);
#endif
static void handle_interrupt (void);
static void timer_start_idle (void);
static void timer_stop_idle (void);
static void timer_resume_idle (void);
static SIGTYPE handle_user_signal (int);
static char *find_user_signal_name (int);
static int store_user_signal_events (void);


/* 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.  */

void
echo_char (Lisp_Object c)
{
  if (current_kboard->immediate_echo)
    {
      int size = KEY_DESCRIPTION_SIZE + 100;
      char *buffer = (char *) alloca (size);
      char *ptr = buffer;
      Lisp_Object echo_string;

      echo_string = current_kboard->echo_string;

      /* If someone has passed us a composite event, use its head symbol.  */
      c = EVENT_HEAD (c);

      if (INTEGERP (c))
	{
	  ptr = push_key_description (XINT (c), ptr, 1);
	}
      else if (SYMBOLP (c))
	{
	  Lisp_Object name = SYMBOL_NAME (c);
	  int nbytes = SBYTES (name);

	  if (size - (ptr - buffer) < nbytes)
	    {
	      int offset = ptr - buffer;
	      size = max (2 * size, size + nbytes);
	      buffer = (char *) alloca (size);
	      ptr = buffer + offset;
	    }

	  ptr += copy_text (SDATA (name), (unsigned char *) ptr, nbytes,
			    STRING_MULTIBYTE (name), 1);
	}

      if ((NILP (echo_string) || SCHARS (echo_string) == 0)
	  && help_char_p (c))
	{
	  const char *text = " (Type ? for further options)";
	  int len = strlen (text);

	  if (size - (ptr - buffer) < len)
	    {
	      int offset = ptr - buffer;
	      size += len;
	      buffer = (char *) alloca (size);
	      ptr = buffer + offset;
	    }

	  memcpy (ptr, text, len);
	  ptr += len;
	}

      /* Replace a dash from echo_dash with a space, otherwise
	 add a space at the end as a separator between keys.  */
      if (STRINGP (echo_string)
	  && SCHARS (echo_string) > 1)
	{
	  Lisp_Object last_char, prev_char, idx;

	  idx = make_number (SCHARS (echo_string) - 2);
	  prev_char = Faref (echo_string, idx);

	  idx = make_number (SCHARS (echo_string) - 1);
	  last_char = Faref (echo_string, idx);

	  /* We test PREV_CHAR to make sure this isn't the echoing
	     of a minus-sign.  */
	  if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
	    Faset (echo_string, idx, make_number (' '));
	  else
	    echo_string = concat2 (echo_string, build_string (" "));
	}
      else if (STRINGP (echo_string))
	echo_string = concat2 (echo_string, build_string (" "));

      current_kboard->echo_string
	= concat2 (echo_string, make_string (buffer, ptr - buffer));

      echo_now ();
    }
}

/* 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.  */

void
echo_dash (void)
{
  /* Do nothing if not echoing at all.  */
  if (NILP (current_kboard->echo_string))
    return;

  if (this_command_key_count == 0)
    return;

  if (!current_kboard->immediate_echo
      && SCHARS (current_kboard->echo_string) == 0)
    return;

  /* Do nothing if we just printed a prompt.  */
  if (current_kboard->echo_after_prompt
      == SCHARS (current_kboard->echo_string))
    return;

  /* Do nothing if we have already put a dash at the end.  */
  if (SCHARS (current_kboard->echo_string) > 1)
    {
      Lisp_Object last_char, prev_char, idx;

      idx = make_number (SCHARS (current_kboard->echo_string) - 2);
      prev_char = Faref (current_kboard->echo_string, idx);

      idx = make_number (SCHARS (current_kboard->echo_string) - 1);
      last_char = Faref (current_kboard->echo_string, idx);

      if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
	return;
    }

  /* Put a dash at the end of the buffer temporarily,
     but make it go away when the next character is added.  */
  current_kboard->echo_string = concat2 (current_kboard->echo_string,
					 build_string ("-"));
  echo_now ();
}

/* Display the current echo string, and begin echoing if not already
   doing so.  */

void
echo_now (void)
{
  if (!current_kboard->immediate_echo)
    {
      int i;
      current_kboard->immediate_echo = 1;

      for (i = 0; i < this_command_key_count; i++)
	{
	  Lisp_Object c;

	  /* Set before_command_echo_length to the value that would
	     have been saved before the start of this subcommand in
	     command_loop_1, if we had already been echoing then.  */
	  if (i == this_single_command_key_start)
	    before_command_echo_length = echo_length ();

	  c = XVECTOR (this_command_keys)->contents[i];
	  if (! (EVENT_HAS_PARAMETERS (c)
		 && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement)))
	    echo_char (c);
	}

      /* Set before_command_echo_length to the value that would
	 have been saved before the start of this subcommand in
	 command_loop_1, if we had already been echoing then.  */
      if (this_command_key_count == this_single_command_key_start)
	before_command_echo_length = echo_length ();

      /* Put a dash at the end to invite the user to type more.  */
      echo_dash ();
    }

  echoing = 1;
  message3_nolog (current_kboard->echo_string,
		  SBYTES (current_kboard->echo_string),
		  STRING_MULTIBYTE (current_kboard->echo_string));
  echoing = 0;

  /* Record in what buffer we echoed, and from which kboard.  */
  echo_message_buffer = echo_area_buffer[0];
  echo_kboard = current_kboard;

  if (waiting_for_input && !NILP (Vquit_flag))
    quit_throw_to_read_char ();
}

/* Turn off echoing, for the start of a new command.  */

void
cancel_echoing (void)
{
  current_kboard->immediate_echo = 0;
  current_kboard->echo_after_prompt = -1;
  current_kboard->echo_string = Qnil;
  ok_to_echo_at_next_pause = NULL;
  echo_kboard = NULL;
  echo_message_buffer = Qnil;
}

/* Return the length of the current echo string.  */

static int
echo_length (void)
{
  return (STRINGP (current_kboard->echo_string)
	  ? SCHARS (current_kboard->echo_string)
	  : 0);
}

/* Truncate the current echo message to its first LEN chars.
   This and echo_char get used by read_key_sequence when the user
   switches frames while entering a key sequence.  */

static void
echo_truncate (EMACS_INT nchars)
{
  if (STRINGP (current_kboard->echo_string))
    current_kboard->echo_string
      = Fsubstring (current_kboard->echo_string,
		    make_number (0), make_number (nchars));
  truncate_echo_area (nchars);
}


/* Functions for manipulating this_command_keys.  */
static void
add_command_key (Lisp_Object key)
{
#if 0 /* Not needed after we made Freset_this_command_lengths
	 do the job immediately.  */
  /* If reset-this-command-length was called recently, obey it now.
     See the doc string of that function for an explanation of why.  */
  if (before_command_restore_flag)
    {
      this_command_key_count = before_command_key_count_1;
      if (this_command_key_count < this_single_command_key_start)
	this_single_command_key_start = this_command_key_count;
      echo_truncate (before_command_echo_length_1);
      before_command_restore_flag = 0;
    }
#endif

  if (this_command_key_count >= ASIZE (this_command_keys))
    this_command_keys = larger_vector (this_command_keys,
				       2 * ASIZE (this_command_keys),
				       Qnil);

  ASET (this_command_keys, this_command_key_count, key);
  ++this_command_key_count;
}


Lisp_Object
recursive_edit_1 (void)
{
  int count = SPECPDL_INDEX ();
  Lisp_Object val;

  if (command_loop_level > 0)
    {
      specbind (Qstandard_output, Qt);
      specbind (Qstandard_input, Qt);
    }

#ifdef HAVE_WINDOW_SYSTEM
  /* The command loop has started an hourglass timer, so we have to
     cancel it here, otherwise it will fire because the recursive edit
     can take some time.  Do not check for display_hourglass_p here,
     because it could already be nil.  */
    cancel_hourglass ();
#endif

  /* This function may have been called from a debugger called from
     within redisplay, for instance by Edebugging a function called
     from fontification-functions.  We want to allow redisplay in
     the debugging session.

     The recursive edit is left with a `(throw exit ...)'.  The `exit'
     tag is not caught anywhere in redisplay, i.e. when we leave the
     recursive edit, the original redisplay leading to the recursive
     edit will be unwound.  The outcome should therefore be safe.  */
  specbind (Qinhibit_redisplay, Qnil);
  redisplaying_p = 0;

  val = command_loop ();
  if (EQ (val, Qt))
    Fsignal (Qquit, Qnil);
  /* Handle throw from read_minibuf when using minibuffer
     while it's active but we're in another window.  */
  if (STRINGP (val))
    xsignal1 (Qerror, val);

  return unbind_to (count, Qnil);
}

/* When an auto-save happens, record the "time", and don't do again soon.  */

void
record_auto_save (void)
{
  last_auto_save = num_nonmacro_input_events;
}

/* Make an auto save happen as soon as possible at command level.  */

void
force_auto_save_soon (void)
{
  last_auto_save = - auto_save_interval - 1;

  record_asynch_buffer_change ();
}

DEFUN ("recursive-edit", Frecursive_edit, Srecursive_edit, 0, 0, "",
       doc: /* Invoke the editor command loop recursively.
To get out of the recursive edit, a command can do `(throw 'exit nil)';
that tells this function to return.
Alternatively, `(throw 'exit t)' makes this function signal an error.
This function is called by the editor initialization to begin editing.  */)
  (void)
{
  int count = SPECPDL_INDEX ();
  Lisp_Object buffer;

  /* If we enter while input is blocked, don't lock up here.
     This may happen through the debugger during redisplay.  */
  if (INPUT_BLOCKED_P)
    return Qnil;

  command_loop_level++;
  update_mode_lines = 1;

  if (command_loop_level
      && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))
    buffer = Fcurrent_buffer ();
  else
    buffer = Qnil;

  /* If we leave recursive_edit_1 below with a `throw' for instance,
     like it is done in the splash screen display, we have to
     make sure that we restore single_kboard as command_loop_1
     would have done if it were left normally.  */
  if (command_loop_level > 0)
    temporarily_switch_to_single_kboard (SELECTED_FRAME ());
  record_unwind_protect (recursive_edit_unwind, buffer);

  recursive_edit_1 ();
  return unbind_to (count, Qnil);
}

Lisp_Object
recursive_edit_unwind (Lisp_Object buffer)
{
  if (BUFFERP (buffer))
    Fset_buffer (buffer);

  command_loop_level--;
  update_mode_lines = 1;
  return Qnil;
}


#if 0  /* These two functions are now replaced with
          temporarily_switch_to_single_kboard. */
static void
any_kboard_state ()
{
#if 0 /* Theory: if there's anything in Vunread_command_events,
	 it will right away be read by read_key_sequence,
	 and then if we do switch KBOARDS, it will go into the side
	 queue then.  So we don't need to do anything special here -- rms.  */
  if (CONSP (Vunread_command_events))
    {
      current_kboard->kbd_queue
	= nconc2 (Vunread_command_events, current_kboard->kbd_queue);
      current_kboard->kbd_queue_has_data = 1;
    }
  Vunread_command_events = Qnil;
#endif
  single_kboard = 0;
}

/* Switch to the single-kboard state, making current_kboard
   the only KBOARD from which further input is accepted.  */

void
single_kboard_state ()
{
  single_kboard = 1;
}
#endif

/* If we're in single_kboard state for kboard KBOARD,
   get out of it.  */

void
not_single_kboard_state (KBOARD *kboard)
{
  if (kboard == current_kboard)
    single_kboard = 0;
}

/* Maintain a stack of kboards, so other parts of Emacs
   can switch temporarily to the kboard of a given frame
   and then revert to the previous status.  */

struct kboard_stack
{
  KBOARD *kboard;
  struct kboard_stack *next;
};

static struct kboard_stack *kboard_stack;

void
push_kboard (struct kboard *k)
{
  struct kboard_stack *p
    = (struct kboard_stack *) xmalloc (sizeof (struct kboard_stack));

  p->next = kboard_stack;
  p->kboard = current_kboard;
  kboard_stack = p;

  current_kboard = k;
}

void
pop_kboard (void)
{
  struct terminal *t;
  struct kboard_stack *p = kboard_stack;
  int found = 0;
  for (t = terminal_list; t; t = t->next_terminal)
    {
      if (t->kboard == p->kboard)
        {
          current_kboard = p->kboard;
          found = 1;
          break;
        }
    }
  if (!found)
    {
      /* The terminal we remembered has been deleted.  */
      current_kboard = FRAME_KBOARD (SELECTED_FRAME ());
      single_kboard = 0;
    }
  kboard_stack = p->next;
  xfree (p);
}

/* Switch to single_kboard mode, making current_kboard the only KBOARD
  from which further input is accepted.  If F is non-nil, set its
  KBOARD as the current keyboard.

  This function uses record_unwind_protect to return to the previous
  state later.

  If Emacs is already in single_kboard mode, and F's keyboard is
  locked, then this function will throw an errow.  */

void
temporarily_switch_to_single_kboard (struct frame *f)
{
  int was_locked = single_kboard;
  if (was_locked)
    {
      if (f != NULL && FRAME_KBOARD (f) != current_kboard)
        /* We can not switch keyboards while in single_kboard mode.
           In rare cases, Lisp code may call `recursive-edit' (or
           `read-minibuffer' or `y-or-n-p') after it switched to a
           locked frame.  For example, this is likely to happen
           when server.el connects to a new terminal while Emacs is in
           single_kboard mode.  It is best to throw an error instead
           of presenting the user with a frozen screen.  */
        error ("Terminal %d is locked, cannot read from it",
               FRAME_TERMINAL (f)->id);
      else
        /* This call is unnecessary, but helps
           `restore_kboard_configuration' discover if somebody changed
           `current_kboard' behind our back.  */
        push_kboard (current_kboard);
    }
  else if (f != NULL)
    current_kboard = FRAME_KBOARD (f);
  single_kboard = 1;
  record_unwind_protect (restore_kboard_configuration,
                         (was_locked ? Qt : Qnil));
}

#if 0 /* This function is not needed anymore.  */
void
record_single_kboard_state ()
{
  if (single_kboard)
    push_kboard (current_kboard);
  record_unwind_protect (restore_kboard_configuration,
                         (single_kboard ? Qt : Qnil));
}
#endif

static Lisp_Object
restore_kboard_configuration (Lisp_Object was_locked)
{
  if (NILP (was_locked))
    single_kboard = 0;
  else
    {
      struct kboard *prev = current_kboard;
      single_kboard = 1;
      pop_kboard ();
      /* The pop should not change the kboard.  */
      if (single_kboard && current_kboard != prev)
        abort ();
    }
  return Qnil;
}