--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/console.c	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,1320 @@
+/* The console object.
+   Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1996 Ben Wing.
+
+This file is part of XEmacs.
+
+XEmacs 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 2, or (at your option) any
+later version.
+
+XEmacs 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 XEmacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+/* Written by Ben Wing. */
+
+#include <config.h>
+#include "lisp.h"
+
+#include "buffer.h"
+#include "console-tty.h"
+#include "events.h"
+#include "frame.h"
+#include "redisplay.h"
+#include "sysdep.h"
+#include "window.h"
+
+Lisp_Object Vconsole_list, Vselected_console;
+
+Lisp_Object Vcreate_console_hook, Vdelete_console_hook;
+
+Lisp_Object Qconsolep, Qconsole_live_p;
+Lisp_Object Qcreate_console_hook;
+Lisp_Object Qdelete_console_hook;
+
+Lisp_Object Qsuspend_hook;
+Lisp_Object Qsuspend_resume_hook;
+
+/* This structure holds the default values of the console-local
+   variables defined with DEFVAR_CONSOLE_LOCAL, that have special
+   slots in each console.  The default value occupies the same slot
+   in this structure as an individual console's value occupies in
+   that console.  Setting the default value also goes through the alist
+   of consoles and stores into each console that does not say it has a
+   local value.  */
+Lisp_Object Vconsole_defaults;
+
+/* This structure marks which slots in a console have corresponding
+   default values in console_defaults.
+   Each such slot has a nonzero value in this structure.
+   The value has only one nonzero bit.
+
+   When a console has its own local value for a slot,
+   the bit for that slot (found in the same slot in this structure)
+   is turned on in the console's local_var_flags slot.
+
+   If a slot in this structure is 0, then there is a DEFVAR_CONSOLE_LOCAL
+   for the slot, but there is no default value for it; the corresponding
+   slot in console_defaults is not used except to initialize newly-created
+   consoles.
+
+   If a slot is -1, then there is a DEFVAR_CONSOLE_LOCAL for it
+   as well as a default value which is used to initialize newly-created
+   consoles and as a reset-value when local-vars are killed.
+
+   If a slot is -2, there is no DEFVAR_CONSOLE_LOCAL for it. 
+   (The slot is always local, but there's no lisp variable for it.)
+   The default value is only used to initialize newly-creation consoles. 
+   
+   If a slot is -3, then there is no DEFVAR_CONSOLE_LOCAL for it but
+   there is a default which is used to initialize newly-creation
+   consoles and as a reset-value when local-vars are killed.
+
+   
+   */
+struct console console_local_flags;
+
+/* This structure holds the names of symbols whose values may be
+   console-local.  It is indexed and accessed in the same way as the above. */
+static Lisp_Object Vconsole_local_symbols;
+
+DEFINE_CONSOLE_TYPE (dead);
+
+Lisp_Object Vconsole_type_list;
+
+MAC_DEFINE (struct console *, MTconsole_data)
+MAC_DEFINE (struct console_methods *, MTcontype_meth_or_given)
+
+console_type_entry_dynarr *the_console_type_entry_dynarr;
+
+
+static Lisp_Object mark_console (Lisp_Object, void (*) (Lisp_Object));
+static void print_console (Lisp_Object, Lisp_Object, int);
+DEFINE_LRECORD_IMPLEMENTATION ("console", console,
+			       mark_console, print_console, 0, 0, 0,
+			       struct console);
+
+static Lisp_Object
+mark_console (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+  struct console *con = XCONSOLE (obj);
+
+#define MARKED_SLOT(x) ((markobj) (con->x));
+#include "conslots.h"
+#undef MARKED_SLOT
+
+  /* Can be zero for Vconsole_defaults, Vconsole_local_symbols */
+  if (con->conmeths)
+    {
+      ((markobj) (con->conmeths->symbol));
+      MAYBE_CONMETH (con, mark_console, (con, markobj));
+    }
+
+  return Qnil;
+}
+
+static void
+print_console (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+  struct console *con = XCONSOLE (obj);
+  char buf[256];
+
+  if (print_readably)
+    error ("printing unreadable object #<console %s 0x%x>",
+	   string_data (XSTRING (con->name)), con->header.uid);
+
+  sprintf (buf, "#<%s-console", !CONSOLE_LIVE_P (con) ? "dead" :
+	   CONSOLE_TYPE_NAME (con));
+  write_c_string (buf, printcharfun);
+  if (CONSOLE_LIVE_P (con))
+    {
+      write_c_string (" on ", printcharfun);
+      print_internal (CONSOLE_CONNECTION (con), printcharfun, 1);
+    }
+  sprintf (buf, " 0x%x>", con->header.uid);
+  write_c_string (buf, printcharfun);
+}
+
+
+static struct console *
+allocate_console (void)
+{
+  Lisp_Object console = Qnil;
+  struct console *con = alloc_lcrecord (sizeof (struct console),
+					lrecord_console);
+  struct gcpro gcpro1;
+
+  copy_lcrecord (con, XCONSOLE (Vconsole_defaults));
+
+  XSETCONSOLE (console, con);
+  GCPRO1 (console);
+
+  con->quit_char = 7; /* C-g */
+  con->command_builder = allocate_command_builder (console);
+  con->function_key_map = Fmake_sparse_keymap (Qnil);
+
+  UNGCPRO;
+  return con;
+}
+
+struct console *
+decode_console (Lisp_Object console)
+{
+  if (NILP (console))
+    console = Fselected_console ();
+  /* quietly accept devices and frames for the console arg */
+  if (DEVICEP (console) || FRAMEP (console))
+    console = DEVICE_CONSOLE (decode_device (console));
+  CHECK_LIVE_CONSOLE (console);
+  return XCONSOLE (console);
+}
+
+
+struct console_methods *
+decode_console_type (Lisp_Object type, Error_behavior errb)
+{
+  int i;
+
+  for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
+    {
+      if (EQ (type, Dynarr_at (the_console_type_entry_dynarr, i).symbol))
+	return Dynarr_at (the_console_type_entry_dynarr, i).meths;
+    }
+
+  maybe_signal_simple_error ("Invalid console type", type, Qconsole, errb);
+
+  return 0;
+}
+
+int
+valid_console_type_p (Lisp_Object type)
+{
+  if (decode_console_type (type, ERROR_ME_NOT))
+    return 1;
+  return 0;
+}
+
+DEFUN ("valid-console-type-p", Fvalid_console_type_p, Svalid_console_type_p,
+       1, 1, 0 /*
+Given a CONSOLE-TYPE, return t if it is valid.
+Valid types are 'x, 'tty, and 'stream.
+*/ )
+     (console_type)
+     Lisp_Object console_type;
+{
+  if (valid_console_type_p (console_type))
+    return Qt;
+  else
+    return Qnil;
+}
+
+DEFUN ("console-type-list", Fconsole_type_list, Sconsole_type_list,
+       0, 0, 0 /*
+Return a list of valid console types.
+*/ )
+     ()
+{
+  return Fcopy_sequence (Vconsole_type_list);
+}
+
+DEFUN ("cdfw-console", Fcdfw_console, Scdfw_console, 1, 1, 0 /*
+Given a console, device, frame, or window, return the associated console.
+Return nil otherwise.
+*/ )
+     (obj)
+     Lisp_Object obj;
+{
+  return CDFW_CONSOLE (obj);
+}
+
+
+DEFUN ("selected-console", Fselected_console, Sselected_console, 0, 0, 0 /*
+Return the console which is currently active.
+*/ )
+     ()
+{
+  return Vselected_console;
+}
+
+/* Called from selected_device_1(), called from selected_frame_1(),
+   called from Fselect_window() */
+void
+select_console_1 (Lisp_Object console)
+{
+  /* perhaps this should do something more complicated */
+  Vselected_console = console;
+
+  /* #### Schedule this to be removed in 19.14 */
+#ifdef HAVE_X_WINDOWS
+  if (CONSOLE_X_P (XCONSOLE (console)))
+    Vwindow_system = Qx;
+  else
+#endif
+#ifdef HAVE_NEXTSTEP
+  if (CONSOLE_NS_P (XCONSOLE (console)))
+    Vwindow_system = Qns;
+  else
+#endif
+    Vwindow_system = Qnil;
+}
+
+DEFUN ("select-console", Fselect_console, Sselect_console, 1, 1, 0 /*
+Select the console CONSOLE.
+Subsequent editing commands apply to its selected device, selected frame,
+and selected window.  The selection of CONSOLE lasts until the next time
+the user does something to select a different console, or until the next
+time this function is called.
+*/ )
+  (console)
+     Lisp_Object console;
+{
+  CHECK_LIVE_CONSOLE (console);
+
+  /* select the console's selected frame's selected window.  This will call
+     selected_frame_1(). */
+  if (!NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (console))))
+    Fselect_window (FRAME_SELECTED_WINDOW (XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (console)))))));
+  else
+    error ("Can't select a console with no devices");
+  return Qnil;
+}
+
+void
+set_console_last_nonminibuf_frame (struct console *con,
+				   Lisp_Object frame)
+{
+  con->_last_nonminibuf_frame = frame;
+}
+
+DEFUN ("consolep", Fconsolep, Sconsolep, 1, 1, 0 /*
+Return non-nil if OBJECT is a console.
+*/ )
+     (object)
+     Lisp_Object object;
+{
+  if (!CONSOLEP (object))
+    return Qnil;
+  return Qt;
+}
+
+DEFUN ("console-live-p", Fconsole_live_p, Sconsole_live_p, 1, 1, 0 /*
+Return non-nil if OBJECT is a console that has not been deleted.
+*/ )
+     (object)
+     Lisp_Object object;
+{
+  if (!CONSOLEP (object) || !CONSOLE_LIVE_P (XCONSOLE (object)))
+    return Qnil;
+  return Qt;
+}
+
+DEFUN ("console-type", Fconsole_type, Sconsole_type, 0, 1, 0 /*
+Return the type of the specified console (e.g. `x' or `tty').
+Value is `tty' for a tty console (a character-only terminal),
+`x' for a console that is an X display,
+`ns' for a console that is a NeXTstep connection (not yet implemeted),
+`win32' for a console that is a Windows or Windows NT connection (not yet
+  implemented),
+`pc' for a console that is a direct-write MS-DOS connection (not yet
+  implemented),
+`stream' for a stream console (which acts like a stdio stream), and
+`dead' for a deleted console.
+*/ )
+     (console)
+     Lisp_Object console;
+{
+  /* don't call decode_console() because we want to allow for dead
+     consoles. */
+  if (NILP (console))
+    console = Fselected_console ();
+  CHECK_CONSOLE (console);
+  return CONSOLE_TYPE (XCONSOLE (console));
+}
+
+DEFUN ("console-name", Fconsole_name, Sconsole_name, 0, 1, 0 /*
+Return the name of the specified console.
+*/ )
+     (console)
+     Lisp_Object console;
+{
+  return CONSOLE_NAME (decode_console (console));
+}
+
+DEFUN ("console-connection", Fconsole_connection, Sconsole_connection,
+       0, 1, 0 /*
+Return the connection of the specified console.
+CONSOLE defaults to the selected console if omitted.
+*/ )
+     (console)
+     Lisp_Object console;
+{
+  return CONSOLE_CONNECTION (decode_console (console));
+}
+
+Lisp_Object
+make_console (struct console *c)
+{
+  Lisp_Object console = Qnil;
+  XSETCONSOLE (console, c);
+  return console;
+}
+
+static Lisp_Object
+semi_canonicalize_console_connection (struct console_methods *meths,
+				      Lisp_Object name, Error_behavior errb)
+{
+  return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_console_connection,
+				(name, errb), name);
+}
+
+static Lisp_Object
+canonicalize_console_connection (struct console_methods *meths,
+				 Lisp_Object name, Error_behavior errb)
+{
+  return CONTYPE_METH_OR_GIVEN (meths, canonicalize_console_connection,
+				(name, errb), name);
+}
+
+static Lisp_Object
+find_console_of_type (struct console_methods *meths, Lisp_Object canon)
+{
+  Lisp_Object concons;
+
+  CONSOLE_LOOP (concons)
+    {
+      Lisp_Object console = XCAR (concons);
+
+      if (EQ (CONMETH_TYPE (meths), CONSOLE_TYPE (XCONSOLE (console)))
+	  && !NILP (Fequal (CONSOLE_CANON_CONNECTION (XCONSOLE (console)),
+			    canon)))
+	return console;
+    }
+
+  return Qnil;
+}
+
+DEFUN ("find-console", Ffind_console, Sfind_console, 1, 2, 0 /*
+Look for an existing console attached to connection CONNECTION.
+Return the console if found; otherwise, return nil.
+
+If TYPE is specified, only return consoles of that type; otherwise,
+return consoles of any type. (It is possible, although unlikely,
+that two consoles of different types could have the same connection
+name; in such a case, the first console found is returned.)
+*/ )
+  (connection, type)
+     Lisp_Object connection, type;
+{
+  Lisp_Object canon = Qnil;
+  struct gcpro gcpro1;
+
+  GCPRO1 (canon);
+
+  if (!NILP (type))
+    {
+      struct console_methods *conmeths = decode_console_type (type,
+							      ERROR_ME);
+      canon = canonicalize_console_connection (conmeths, connection,
+					       ERROR_ME_NOT);
+      if (UNBOUNDP (canon))
+	RETURN_UNGCPRO (Qnil);
+
+      RETURN_UNGCPRO (find_console_of_type (conmeths, canon));
+    }
+  else
+    {
+      int i;
+
+      for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
+	{
+	  struct console_methods *conmeths =
+	    Dynarr_at (the_console_type_entry_dynarr, i).meths;
+	  canon = canonicalize_console_connection (conmeths, connection,
+						   ERROR_ME_NOT);
+	  if (!UNBOUNDP (canon))
+	    {
+	      Lisp_Object console = find_console_of_type (conmeths, canon);
+	      if (!NILP (console))
+		RETURN_UNGCPRO (console);
+	    }
+	}
+
+      RETURN_UNGCPRO (Qnil);
+    }
+}
+
+DEFUN ("get-console", Fget_console, Sget_console, 1, 2, 0 /*
+Look for an existing console attached to connection CONNECTION.
+Return the console if found; otherwise, signal an error.
+
+If TYPE is specified, only return consoles of that type; otherwise,
+return consoles of any type. (It is possible, although unlikely,
+that two consoles of different types could have the same connection
+name; in such a case, the first console found is returned.)
+*/ )
+  (connection, type)
+     Lisp_Object connection, type;
+{
+  Lisp_Object console = Ffind_console (connection, type);
+  if (NILP (console))
+    {
+      if (NILP (type))
+	signal_simple_error ("No such console", connection);
+      else
+	signal_simple_error_2 ("No such console", type, connection);
+    }
+  return console;
+}
+
+Lisp_Object
+create_console (Lisp_Object name, Lisp_Object type, Lisp_Object connection,
+		Lisp_Object props)
+{
+  /* This function can GC */
+  struct console *con;
+  Lisp_Object console = Qnil;
+  struct gcpro gcpro1;
+
+  GCPRO1 (console);
+
+  console = Ffind_console (connection, type);
+  if (!NILP (console))
+    RETURN_UNGCPRO (console);
+
+  con = allocate_console ();
+  XSETCONSOLE (console, con);
+
+  con->conmeths = decode_console_type (type, ERROR_ME);
+
+  CONSOLE_NAME (con) = name;
+  CONSOLE_CONNECTION (con) =
+    semi_canonicalize_console_connection (con->conmeths, connection,
+					  ERROR_ME);
+  CONSOLE_CANON_CONNECTION (con) =
+    canonicalize_console_connection (con->conmeths, connection,
+				     ERROR_ME);
+
+  MAYBE_CONMETH (con, init_console, (con, props));
+
+  /* Do it this way so that the console list is in order of creation */
+  Vconsole_list = nconc2 (Vconsole_list, Fcons (console, Qnil));
+
+  if (CONMETH (con, initially_selected_for_input, (con)))
+    event_stream_select_console (con);
+
+  UNGCPRO;
+  return console;
+}
+
+void
+add_entry_to_console_type_list (Lisp_Object symbol,
+				struct console_methods *meths)
+{
+  struct console_type_entry entry;
+
+  entry.symbol = symbol;
+  entry.meths = meths;
+  Dynarr_add (the_console_type_entry_dynarr, entry);
+  Vconsole_type_list = Fcons (symbol, Vconsole_type_list);
+}
+
+/* find a console other than the selected one.  Prefer non-stream
+   consoles over stream consoles. */
+
+static Lisp_Object
+find_other_console (Lisp_Object console)
+{
+  Lisp_Object concons;
+
+  /* look for a non-stream console */
+  CONSOLE_LOOP (concons)
+    {
+      Lisp_Object con = XCAR (concons);
+      if (!CONSOLE_STREAM_P (XCONSOLE (con))
+	  && !EQ (con, console)
+	  && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))
+	  && !NILP (DEVICE_SELECTED_FRAME 
+		    (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))))))
+	break;
+    }
+  if (!NILP (concons))
+    return XCAR (concons);
+
+  /* OK, now look for a stream console */
+  CONSOLE_LOOP (concons)
+    {
+      Lisp_Object con = XCAR (concons);
+      if (!EQ (con, console)
+	  && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))
+	  && !NILP (DEVICE_SELECTED_FRAME 
+		    (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))))))
+	break;
+    }
+  if (!NILP (concons))
+    return XCAR (concons);
+
+  /* Sorry, there ain't none */
+  return Qnil;
+}
+
+static int
+find_nonminibuffer_frame_not_on_console_predicate (Lisp_Object frame,
+						   void *closure)
+{
+  Lisp_Object console;
+
+  VOID_TO_LISP (console, closure);
+  if (FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
+    return 0;
+  if (EQ (console, FRAME_CONSOLE (XFRAME (frame))))
+    return 0;
+  return 1;
+}
+
+static Lisp_Object
+find_nonminibuffer_frame_not_on_console (Lisp_Object console)
+{
+  return find_some_frame (find_nonminibuffer_frame_not_on_console_predicate,
+			  LISP_TO_VOID (console));
+}
+
+/* Delete console CON.
+
+   If FORCE is non-zero, allow deletion of the only frame.
+
+   If CALLED_FROM_KILL_EMACS is non-zero, then, if
+   deleting the last console, just delete it,
+   instead of calling `save-buffers-kill-emacs'.
+
+   If FROM_IO_ERROR is non-zero, then the console is gone due
+   to an I/O error.  This affects what happens if we exit
+   (we do an emergency exit instead of `save-buffers-kill-emacs'.)
+*/
+
+void
+delete_console_internal (struct console *con, int force,
+			 int called_from_kill_emacs, int from_io_error) 
+{
+  /* This function can GC */
+  Lisp_Object console = Qnil;
+  struct gcpro gcpro1;
+
+  /* OK to delete an already-deleted console. */
+  if (!CONSOLE_LIVE_P (con))
+    return;
+
+  XSETCONSOLE (console, con);
+  GCPRO1 (console);
+
+  if (!called_from_kill_emacs)
+    {
+      int down_we_go = 0;
+
+      if ((XINT (Flength (Vconsole_list)) == 1)
+	  /* if we just created the console, it might not be listed,
+	     or something ... */
+	  && !NILP (memq_no_quit (console, Vconsole_list)))
+	down_we_go = 1;
+      /* If there aren't any nonminibuffer frames that would
+	 be left, then exit. */
+      else if (NILP (find_nonminibuffer_frame_not_on_console (console)))
+	down_we_go = 1;
+
+      if (down_we_go)
+	{
+	  if (!force)
+	    error ("Attempt to delete the only frame");
+	  else if (from_io_error)
+	    {
+	      /* Mayday mayday!  We're going down! */
+	      stderr_out ("  Autosaving and exiting...\n");
+	      Vwindow_system = Qnil; /* let it lie! */
+	      preparing_for_armageddon = 1;
+	      Fkill_emacs (make_int (70));
+	    }
+	  else
+	    {
+	      call0 (Qsave_buffers_kill_emacs);
+	      UNGCPRO;
+	      /* If we get here, the user said they didn't want
+		 to exit, so don't. */
+	      return;
+	    }
+	}
+    }
+
+  /* Breathe a sigh of relief.  We're still alive. */
+
+  {
+    Lisp_Object frmcons, devcons;
+
+    /* First delete all frames without their own minibuffers,
+       to avoid errors coming from attempting to delete a frame
+       that is a surrogate for another frame.
+
+       We don't set "called_from_delete_console" because we want the
+       device to go ahead and get deleted if we delete the last frame
+       on a device.  We won't run into trouble here because for any
+       frame without a minibuffer, there has to be another one on
+       the same console with a minibuffer, and we're not deleting that,
+       so delete_console_internal() won't get recursively called.
+
+       WRONG!  With surrogate minibuffers this isn't true.  Frames
+       with only a minibuffer are not enough to prevent
+       delete_frame_internal from triggering a device deletion. */
+    CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con)
+      {
+	struct frame *f = XFRAME (XCAR (frmcons));
+	/* delete_frame_internal() might do anything such as run hooks,
+	   so be defensive. */
+	if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f))
+	  delete_frame_internal (f, 1, 1, from_io_error);
+
+	if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't
+				      go ahead and delete anything */
+	  {
+	    UNGCPRO;
+	    return;
+	  }
+      }
+
+    CONSOLE_DEVICE_LOOP (devcons, con)
+      {
+	struct device *d = XDEVICE (XCAR (devcons));
+	/* delete_device_internal() might do anything such as run hooks,
+	   so be defensive. */
+	if (DEVICE_LIVE_P (d))
+	  delete_device_internal (d, 1, 1, from_io_error);
+	if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't
+				      go ahead and delete anything */
+	  {
+	    UNGCPRO;
+	    return;
+	  }
+      }
+  }
+  
+  CONSOLE_SELECTED_DEVICE (con) = Qnil;
+  
+  /* try to select another console */
+  
+  if (EQ (console, Fselected_console ()))
+    {
+      Lisp_Object other_dev = find_other_console (console);
+      if (!NILP (other_dev))
+	Fselect_console (other_dev);
+      else
+	{
+	  /* necessary? */
+	  Vselected_console = Qnil;
+	  Vwindow_system = Qnil;
+	}
+    }
+
+  if (con->input_enabled)
+    event_stream_unselect_console (con);
+  
+  MAYBE_CONMETH (con, delete_console, (con));
+
+  Vconsole_list = delq_no_quit (console, Vconsole_list);
+  RESET_CHANGED_SET_FLAGS;
+  con->conmeths = dead_console_methods;
+
+  UNGCPRO;
+}
+
+void
+io_error_delete_console (Lisp_Object console)
+{
+  delete_console_internal (XCONSOLE (console), 1, 0, 1);
+}
+
+DEFUN ("delete-console", Fdelete_console, Sdelete_console, 1, 2, 0 /*
+Delete CONSOLE, permanently eliminating it from use.
+Normally, you cannot delete the last non-minibuffer-only frame (you must
+use `save-buffers-kill-emacs' or `kill-emacs').  However, if optional
+second argument FORCE is non-nil, you can delete the last frame. (This
+will automatically call `save-buffers-kill-emacs'.)
+*/ )
+     (console, force)
+     Lisp_Object console, force;
+{
+  CHECK_CONSOLE (console);
+  delete_console_internal (XCONSOLE (console), !NILP (force), 0, 0);
+  return Qnil;
+}
+
+DEFUN ("console-list", Fconsole_list, Sconsole_list, 0, 0, 0 /*
+Return a list of all consoles.
+*/ )
+     ()
+{
+  return Fcopy_sequence (Vconsole_list);
+}
+
+DEFUN ("console-device-list", Fconsole_device_list, Sconsole_device_list,
+       0, 1, 0 /*
+Return a list of all devices on CONSOLE.
+If CONSOLE is nil, the selected console will be used.
+*/ )
+  (console)
+     Lisp_Object console;
+{
+  return Fcopy_sequence (CONSOLE_DEVICE_LIST (decode_console (console)));
+}
+
+DEFUN ("console-enable-input", Fconsole_enable_input, Sconsole_enable_input,
+       1, 1, 0 /*
+Enable input on console CONSOLE.
+*/ )
+  (console)
+     Lisp_Object console;
+{
+  struct console *con = decode_console (console);
+  if (!con->input_enabled)
+    event_stream_select_console (con);
+  return Qnil;
+}
+
+DEFUN ("console-disable-input", Fconsole_disable_input,
+       Sconsole_disable_input,
+       1, 1, 0 /*
+Disable input on console CONSOLE.
+*/ )
+  (console)
+     Lisp_Object console;
+{
+  struct console *con = decode_console (console);
+  if (con->input_enabled)
+    event_stream_unselect_console (con);
+  return Qnil;
+}
+
+DEFUN ("console-on-window-system-p", Fconsole_on_window_system_p,
+       Sconsole_on_window_system_p, 0, 1, 0 /*
+Return non-nil if this console is on a window system.
+This generally means that there is support for the mouse, the menubar,
+the toolbar, glyphs, etc.
+*/ )
+     (console)
+     Lisp_Object console;
+{
+  struct console *con = decode_console (console);
+
+  if (EQ (CONSOLE_TYPE (con), Qtty) || EQ (CONSOLE_TYPE (con), Qstream))
+    return Qnil;
+  return Qt;
+}
+
+
+
+/**********************************************************************/
+/*               Miscellaneous low-level functions                    */
+/**********************************************************************/
+
+static Lisp_Object
+unwind_init_sys_modes (Lisp_Object console)
+{
+  reinit_initial_console ();
+
+  if (!no_redraw_on_reenter)
+    {
+      if (CONSOLEP (console) && CONSOLE_LIVE_P (XCONSOLE (console)))
+	MARK_FRAME_CHANGED
+	  (XFRAME (DEVICE_SELECTED_FRAME
+		   (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (console))))));
+    }
+  return Qnil;
+}
+
+DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_emacs, 0, 1, "" /*
+Stop Emacs and return to superior process.  You can resume later.
+On systems that don't have job control, run a subshell instead.
+
+If optional arg STUFFSTRING is non-nil, its characters are stuffed
+to be read as terminal input by Emacs's superior shell.
+Before suspending, if `suspend-hook' is bound and value is non-nil
+call the value as a function of no args.  Don't suspend if it returns non-nil.
+Otherwise, suspend normally and after resumption call
+`suspend-resume-hook' if that is bound and non-nil.
+
+Some operating systems cannot stop the Emacs process and resume it later.
+On such systems, Emacs will start a subshell and wait for it to exit.
+*/ )
+  (stuffstring)
+     Lisp_Object stuffstring;
+{
+  int speccount = specpdl_depth ();
+  struct gcpro gcpro1;
+
+  if (!NILP (stuffstring))
+    CHECK_STRING (stuffstring);
+  GCPRO1 (stuffstring);
+
+  /* There used to be a check that the initial console is TTY.
+     This is bogus.  Even checking to see whether any console
+     is a controlling terminal is not correct -- maybe
+     the user used the -t option or something.  If we want to
+     suspend, then we suspend.  Period. */
+
+  /* Call value of suspend-hook. */
+  run_hook (Qsuspend_hook);
+
+  reset_initial_console ();
+  /* 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 (unwind_init_sys_modes, Vcontrolling_terminal);
+  stuff_buffered_input (stuffstring);
+  sys_suspend ();
+  /* the console is un-reset inside of the unwind-protect. */
+  unbind_to (speccount, Qnil);
+
+#ifdef SIGWINCH
+  /* It is possible that a size change occurred while we were
+     suspended.  Assume one did just to be safe.  It won't hurt
+     anything if one didn't. */
+  asynch_device_change_pending++;
+#endif
+
+  /* Call value of suspend-resume-hook
+     if it is bound and value is non-nil.  */
+  run_hook (Qsuspend_resume_hook);
+  
+  UNGCPRO;
+  return Qnil;
+}
+
+/* If STUFFSTRING is a string, stuff its contents as pending terminal input.
+   Then in any case stuff anything Emacs has read ahead and not used.  */
+
+void
+stuff_buffered_input (Lisp_Object stuffstring)
+{
+/* stuff_char works only in BSD, versions 4.2 and up.  */
+#if defined (BSD)
+  if (!CONSOLEP (Vcontrolling_terminal) ||
+      !CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal)))
+    return;
+
+  if (STRINGP (stuffstring))
+    {
+      Extcount count;
+      Extbyte *p;
+
+      GET_STRING_EXT_DATA_ALLOCA (stuffstring, FORMAT_KEYBOARD, p, count);
+      while (count-- > 0)
+	stuff_char (XCONSOLE (Vcontrolling_terminal), *p++);
+      stuff_char (XCONSOLE (Vcontrolling_terminal), '\n');
+    }
+  /* Anything we have read ahead, put back for the shell to read.  */
+# if 0 /* oh, who cares about this silliness */
+  while (kbd_fetch_ptr != kbd_store_ptr)
+    {
+      if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
+	kbd_fetch_ptr = kbd_buffer;
+      stuff_char (XCONSOLE (Vcontrolling_terminal), *kbd_fetch_ptr++);
+    }
+# endif
+#endif /* BSD */
+}
+
+DEFUN ("set-input-mode", Fset_input_mode, Sset_input_mode, 3, 5, 0 /*
+Set mode of reading keyboard input.
+First arg is ignored, for backward compatibility.
+Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
+ (no effect except in CBREAK mode).
+Third arg META t means accept 8-bit input (for a Meta key).
+ META nil means ignore the top bit, on the assumption it is parity.
+ Otherwise, accept 8-bit input and don't use the top bit for Meta.
+First three arguments only apply to TTY consoles.
+Optional fourth arg QUIT if non-nil specifies character to use for quitting.
+Optional fifth arg CONSOLE specifies console to make changes to; nil means
+ the selected console.
+See also `current-input-mode'.
+*/ )
+  (ignored, flow, meta, quit, console)
+     Lisp_Object ignored, flow, meta, quit, console;
+{
+  struct console *con = decode_console (console);
+  int meta_key = 1;
+
+  if (CONSOLE_TTY_P (con))
+    {
+      if (NILP (meta))
+	meta_key = 0;
+      else if (EQ (meta, Qt))
+	meta_key = 1;
+      else
+	meta_key = 2;
+    }
+
+  if (!NILP (quit))
+    {
+      CHECK_CHAR_COERCE_INT (quit);
+      CONSOLE_QUIT_CHAR (con) =
+	((unsigned int) XCHAR (quit)) & (meta_key ? 0377 : 0177);
+    }
+
+  if (CONSOLE_TTY_P (con))
+    {
+      reset_one_console (con);
+      TTY_FLAGS (con).flow_control = !NILP (flow);
+      TTY_FLAGS (con).meta_key = meta_key;
+      init_one_console (con);
+    }
+
+  return Qnil;
+}
+
+DEFUN ("current-input-mode", Fcurrent_input_mode, Scurrent_input_mode,
+       0, 1, 0 /*
+Return information about the way Emacs currently reads keyboard input.
+Optional arg CONSOLE specifies console to return information about; nil means
+ the selected console.
+The value is a list of the form (nil FLOW META QUIT), where
+  FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
+    terminal; this does not apply if Emacs uses interrupt-driven input.
+  META is t if accepting 8-bit input with 8th bit as Meta flag.
+    META nil means ignoring the top bit, on the assumption it is parity.
+    META is neither t nor nil if accepting 8-bit input and using
+    all 8 bits as the character code.
+  QUIT is the character Emacs currently uses to quit.
+FLOW, and META are only meaningful for TTY consoles.
+The elements of this list correspond to the arguments of
+`set-input-mode'.
+*/ )
+  (console)
+     Lisp_Object console;
+{
+  Lisp_Object val[4];
+  struct console *con = decode_console (console);
+ 
+  val[0] = Qnil;
+  val[1] = CONSOLE_TTY_P (con) && TTY_FLAGS (con).flow_control ? Qt : Qnil;
+  val[2] = (!CONSOLE_TTY_P (con) || TTY_FLAGS (con).meta_key == 1) ?
+    Qt : TTY_FLAGS (con).meta_key == 2 ? make_int (0) : Qnil;
+  val[3] = make_char (CONSOLE_QUIT_CHAR (con));
+ 
+  return Flist (sizeof (val) / sizeof (val[0]), val);
+}
+
+
+/************************************************************************/
+/*                            initialization                            */
+/************************************************************************/
+
+void
+syms_of_console (void)
+{
+  defsubr (&Svalid_console_type_p);
+  defsubr (&Sconsole_type_list);
+  defsubr (&Scdfw_console);
+  defsubr (&Sselected_console);
+  defsubr (&Sselect_console);
+  defsubr (&Sconsolep);
+  defsubr (&Sconsole_live_p);
+  defsubr (&Sconsole_type);
+  defsubr (&Sconsole_name);
+  defsubr (&Sconsole_connection);
+  defsubr (&Sfind_console);
+  defsubr (&Sget_console);
+  defsubr (&Sdelete_console);
+  defsubr (&Sconsole_list);
+  defsubr (&Sconsole_device_list);
+  defsubr (&Sconsole_enable_input);
+  defsubr (&Sconsole_disable_input);
+  defsubr (&Sconsole_on_window_system_p);
+
+  defsubr (&Ssuspend_emacs);
+  defsubr (&Sset_input_mode);
+  defsubr (&Scurrent_input_mode);
+
+  defsymbol (&Qconsolep, "consolep");
+  defsymbol (&Qconsole_live_p, "console-live-p");
+
+  defsymbol (&Qcreate_console_hook, "create-console-hook");
+  defsymbol (&Qdelete_console_hook, "delete-console-hook");
+
+  defsymbol (&Qsuspend_hook, "suspend-hook");
+  defsymbol (&Qsuspend_resume_hook, "suspend-resume-hook");
+}
+
+void
+console_type_create (void)
+{
+  the_console_type_entry_dynarr = Dynarr_new (struct console_type_entry);
+
+  Vconsole_type_list = Qnil;
+  staticpro (&Vconsole_type_list);
+
+  /* Initialize the dead console type */
+  INITIALIZE_CONSOLE_TYPE (dead, "dead", "console-dead-p");
+
+  /* then reset the console-type lists, because `dead' is not really
+     a valid console type */
+  Dynarr_reset (the_console_type_entry_dynarr);
+  Vconsole_type_list = Qnil;
+}
+
+void
+vars_of_console (void)
+{
+  DEFVAR_LISP ("create-console-hook", &Vcreate_console_hook /*
+Function or functions to call when a console is created.
+One argument, the newly-created console.
+This is called after the first frame has been created, but before
+  calling the `create-device-hook' or `create-frame-hook'.
+Note that in general the console will not be selected.
+*/ );
+  Vcreate_console_hook = Qnil;
+
+  DEFVAR_LISP ("delete-console-hook", &Vdelete_console_hook /*
+Function or functions to call when a console is deleted.
+One argument, the to-be-deleted console.
+*/ );
+  Vdelete_console_hook = Qnil;
+
+  staticpro (&Vconsole_list);
+  Vconsole_list = Qnil;
+  staticpro (&Vselected_console);
+  Vselected_console = Qnil;
+
+#ifdef HAVE_WINDOW_SYSTEM
+  Fprovide (intern ("window-system"));
+#endif
+}
+
+/* DOC is ignored because it is snagged and recorded externally 
+ *  by make-docfile */
+/* Declaring this stuff as const produces 'Cannot reinitialize' messages
+   from SunPro C's fix-and-continue feature (a way neato feature that
+   makes debugging unbelievably more bearable) */
+#define DEFVAR_CONSOLE_LOCAL(lname, field_name)				\
+ do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C	\
+       = { { { { lrecord_symbol_value_forward },			\
+               (void *) &(console_local_flags.field_name), 69 },	\
+             SYMVAL_SELECTED_CONSOLE_FORWARD }, 0 };			\
+      defvar_console_local ((lname), &I_hate_C);			\
+ } while (0)
+
+#define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun)	\
+ do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C	\
+       = { { { { lrecord_symbol_value_forward },			\
+               (void *) &(console_local_flags.field_name), 69 },	\
+             SYMVAL_SELECTED_CONSOLE_FORWARD }, magicfun };		\
+      defvar_console_local ((lname), &I_hate_C);			\
+ } while (0)
+
+#define DEFVAR_CONST_CONSOLE_LOCAL(lname, field_name)			\
+ do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C	\
+       = { { { { lrecord_symbol_value_forward },			\
+               (void *) &(console_local_flags.field_name), 69 },	\
+             SYMVAL_CONST_SELECTED_CONSOLE_FORWARD }, 0 };		\
+      defvar_console_local ((lname), &I_hate_C);			\
+ } while (0)
+
+#define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun)	\
+ do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C	\
+       = { { { { lrecord_symbol_value_forward },			\
+               (void *) &(console_local_flags.field_name), 69 },	\
+             SYMVAL_CONST_SELECTED_CONSOLE_FORWARD }, magicfun };	\
+      defvar_console_local ((lname), &I_hate_C);			\
+ } while (0)
+
+#define DEFVAR_CONSOLE_DEFAULTS(lname, field_name)			\
+ do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C	\
+       = { { { { lrecord_symbol_value_forward },			\
+               (void *) &(console_local_flags.field_name), 69 },	\
+             SYMVAL_DEFAULT_CONSOLE_FORWARD }, 0 };			\
+      defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C));		\
+ } while (0)
+
+#define DEFVAR_CONSOLE_DEFAULTS_MAGIC(lname, field_name, magicfun)	\
+ do { static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C	\
+       = { { { { lrecord_symbol_value_forward },			\
+               (void *) &(console_local_flags.field_name), 69 },	\
+             SYMVAL_DEFAULT_CONSOLE_FORWARD }, magicfun };		\
+      defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C));		\
+ } while (0)
+
+static void
+defvar_console_local (CONST char *namestring, 
+		       CONST struct symbol_value_forward *m)
+{
+  int offset = ((char *)symbol_value_forward_forward (m)
+                - (char *)&console_local_flags);
+
+  defvar_mumble (namestring, m, sizeof (*m));
+
+  *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols))) 
+    = intern (namestring);
+}
+
+static void
+nuke_all_console_slots (struct console *con, Lisp_Object zap)
+{
+  zero_lcrecord (con);
+
+#define MARKED_SLOT(x)	con->x = (zap);
+#include "conslots.h"
+#undef MARKED_SLOT
+}
+
+void
+complex_vars_of_console (void)
+{
+  /* Make sure all markable slots in console_defaults
+     are initialized reasonably, so mark_console won't choke.
+   */
+  struct console *defs = alloc_lcrecord (sizeof (struct console),
+					 lrecord_console);
+  struct console *syms = alloc_lcrecord (sizeof (struct console),
+					 lrecord_console);
+
+  staticpro (&Vconsole_defaults);
+  staticpro (&Vconsole_local_symbols);
+  XSETCONSOLE (Vconsole_defaults, defs);
+  XSETCONSOLE (Vconsole_local_symbols, syms);
+  
+  nuke_all_console_slots (syms, Qnil);
+  nuke_all_console_slots (defs, Qnil);
+  
+  /* Set up the non-nil default values of various console slots.
+     Must do these before making the first console.
+     */
+  /* #### Anything needed here? */
+  
+  {
+    /*  0 means var is always local.  Default used only at creation.
+     * -1 means var is always local.  Default used only at reset and
+     *    creation.
+     * -2 means there's no lisp variable corresponding to this slot
+     *    and the default is only used at creation.
+     * -3 means no Lisp variable.  Default used only at reset and creation.
+     * >0 is mask.  Var is local if ((console->local_var_flags & mask) != 0)
+     *              Otherwise default is used.
+     *
+     * #### We don't currently ever reset console variables, so there
+     * is no current distinction between 0 and -1, and between -2 and -3.
+     */
+    Lisp_Object always_local_resettable = make_int (-1);
+
+#if 0 /* not used */
+    Lisp_Object always_local_no_default = make_int (0);
+    Lisp_Object resettable = make_int (-3);
+#endif
+    
+    /* Assign the local-flags to the slots that have default values.
+       The local flag is a bit that is used in the console
+       to say that it has its own local value for the slot.
+       The local flag bits are in the local_var_flags slot of the
+       console.  */
+    
+    nuke_all_console_slots (&console_local_flags, make_int (-2));
+    console_local_flags.defining_kbd_macro = always_local_resettable;
+    console_local_flags.last_kbd_macro = always_local_resettable;
+    console_local_flags.prefix_arg = always_local_resettable;
+    console_local_flags.default_minibuffer_frame = always_local_resettable;
+    console_local_flags.overriding_terminal_local_map =
+      always_local_resettable;
+    
+    console_local_flags.function_key_map = make_int (1);
+    
+    /* #### Warning, 0x4000000 (that's six zeroes) is the largest number
+       currently allowable due to the XINT() handling of this value.
+       With some rearrangement you can get 4 more bits. */
+  }
+
+  DEFVAR_CONSOLE_DEFAULTS ("default-function-key-map", function_key_map /*
+Default value of `function-key-map' for consoles that don't override it.
+This is the same as (default-value 'function-key-map).
+*/ );
+
+  DEFVAR_CONSOLE_LOCAL ("function-key-map", function_key_map /*
+Keymap mapping ASCII function key sequences onto their preferred forms.
+This allows Emacs to recognize function keys sent from ASCII
+terminals at any point in a key sequence.
+
+The `read-key-sequence' function replaces any subsequence bound by
+`function-key-map' with its binding.  More precisely, when the active
+keymaps have no binding for the current key sequence but
+`function-key-map' binds a suffix of the sequence to a vector or string,
+`read-key-sequence' replaces the matching suffix with its binding, and
+continues with the new sequence.
+
+The events that come from bindings in `function-key-map' are not
+themselves looked up in `function-key-map'.
+
+For example, suppose `function-key-map' binds `ESC O P' to [f1].
+Typing `ESC O P' to `read-key-sequence' would return
+\[#<keypress-event f1>].  Typing `C-x ESC O P' would return
+\[#<keypress-event control-X> #<keypress-event f1>].  If [f1]
+were a prefix key, typing `ESC O P x' would return
+\[#<keypress-event f1> #<keypress-event x>].
+*/ );
+
+  /* While this should be CONST it can't be because some things
+     (i.e. edebug) do maninpulate it. */
+  DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /*
+Non-nil while a console macro is being defined.  Don't set this!
+*/ );
+
+  DEFVAR_CONSOLE_LOCAL ("last-kbd-macro", last_kbd_macro /*
+Last kbd macro defined, as a vector of events; nil if none defined.
+*/ );
+
+  DEFVAR_CONSOLE_LOCAL ("prefix-arg", prefix_arg /*
+The value of the prefix argument for the next editing command.
+It may be a number, or the symbol `-' for just a minus sign as arg,
+or a list whose car is a number for just one or more C-U's
+or nil if no argument has been specified.
+
+You cannot examine this variable to find the argument for this command
+since it has been set to nil by the time you can look.
+Instead, you should use the variable `current-prefix-arg', although
+normally commands can get this prefix argument with (interactive \"P\").
+*/ );
+
+  DEFVAR_CONSOLE_LOCAL ("default-minibuffer-frame",
+			default_minibuffer_frame /*
+Minibufferless frames use this frame's minibuffer.
+
+Emacs cannot create minibufferless frames unless this is set to an
+appropriate surrogate.
+
+XEmacs consults this variable only when creating minibufferless
+frames; once the frame is created, it sticks with its assigned
+minibuffer, no matter what this variable is set to.  This means that
+this variable doesn't necessarily say anything meaningful about the
+current set of frames, or where the minibuffer is currently being
+displayed.
+*/ );
+
+  DEFVAR_CONSOLE_LOCAL ("overriding-terminal-local-map",
+			overriding_terminal_local_map /*
+Keymap that overrides all other local keymaps, for the selected console only.
+If this variable is non-nil, it is used as a keymap instead of the
+buffer's local map, and the minor mode keymaps and text property keymaps.
+*/ );
+
+  /* Check for DEFVAR_CONSOLE_LOCAL without initializing the corresponding
+     slot of console_local_flags and vice-versa.  Must be done after all
+     DEFVAR_CONSOLE_LOCAL() calls. */
+#define MARKED_SLOT(slot)					\
+  if ((XINT (console_local_flags.slot) != -2 &&			\
+         XINT (console_local_flags.slot) != -3)			\
+      != !(NILP (XCONSOLE (Vconsole_local_symbols)->slot)))	\
+  abort ()
+#include "conslots.h"
+#undef MARKED_SLOT
+}