XEmacs 21.2.32 "Kastor & Polydeukes".
[chise/xemacs-chise.git.1] / src / console.c
index 7190364..ab147bc 100644 (file)
@@ -53,6 +53,7 @@ Lisp_Object Qsuspend_resume_hook;
    list of consoles and stores into each console that does not say
    it has a local value.  */
 Lisp_Object Vconsole_defaults;
+static void *console_defaults_saved_slots;
 
 /* This structure marks which slots in a console have corresponding
    default values in console_defaults.
@@ -69,7 +70,7 @@ Lisp_Object Vconsole_defaults;
    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
+  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.
@@ -87,6 +88,7 @@ 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;
+static void *console_local_symbols_saved_slots;
 
 DEFINE_CONSOLE_TYPE (dead);
 
@@ -96,19 +98,19 @@ console_type_entry_dynarr *the_console_type_entry_dynarr;
 
 \f
 static Lisp_Object
-mark_console (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_console (Lisp_Object obj)
 {
   struct console *con = XCONSOLE (obj);
 
-#define MARKED_SLOT(x) ((markobj) (con->x));
+#define MARKED_SLOT(x) mark_object (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));
+      mark_object (con->conmeths->symbol);
+      MAYBE_CONMETH (con, mark_console, (con));
     }
 
   return Qnil;
@@ -127,7 +129,7 @@ print_console (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
   sprintf (buf, "#<%s-console", !CONSOLE_LIVE_P (con) ? "dead" :
           CONSOLE_TYPE_NAME (con));
   write_c_string (buf, printcharfun);
-  if (CONSOLE_LIVE_P (con))
+  if (CONSOLE_LIVE_P (con) && !NILP (CONSOLE_CONNECTION (con)))
     {
       write_c_string (" on ", printcharfun);
       print_internal (CONSOLE_CONNECTION (con), printcharfun, 1);
@@ -137,14 +139,14 @@ print_console (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 }
 
 DEFINE_LRECORD_IMPLEMENTATION ("console", console,
-                              mark_console, print_console, 0, 0, 0,
+                              mark_console, print_console, 0, 0, 0, 0,
                               struct console);
 \f
 static struct console *
 allocate_console (void)
 {
   Lisp_Object console;
-  struct console *con = alloc_lcrecord_type (struct console, lrecord_console);
+  struct console *con = alloc_lcrecord_type (struct console, &lrecord_console);
   struct gcpro gcpro1;
 
   copy_lcrecord (con, XCONSOLE (Vconsole_defaults));
@@ -285,7 +287,7 @@ void
 set_console_last_nonminibuf_frame (struct console *con,
                                   Lisp_Object frame)
 {
-  con->_last_nonminibuf_frame = frame;
+  con->last_nonminibuf_frame = frame;
 }
 
 DEFUN ("consolep", Fconsolep, 1, 1, 0, /*
@@ -353,16 +355,24 @@ 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);
+  if (HAS_CONTYPE_METH_P (meths, semi_canonicalize_console_connection))
+    return CONTYPE_METH (meths, semi_canonicalize_console_connection,
+                        (name, errb));
+  else
+    return CONTYPE_METH_OR_GIVEN (meths, 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);
+  if (HAS_CONTYPE_METH_P (meths, canonicalize_console_connection))
+    return CONTYPE_METH (meths, canonicalize_console_connection,
+                        (name, errb));
+  else
+    return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_console_connection,
+                                 (name, errb), name);
 }
 
 static Lisp_Object
@@ -486,7 +496,7 @@ create_console (Lisp_Object name, Lisp_Object type, Lisp_Object connection,
   /* 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)))
+  if (CONMETH_OR_GIVEN (con, initially_selected_for_input, (con), 0))
     event_stream_select_console (con);
 
   UNGCPRO;
@@ -876,7 +886,9 @@ stuff_buffered_input (Lisp_Object stuffstring)
       Extcount count;
       Extbyte *p;
 
-      GET_STRING_EXT_DATA_ALLOCA (stuffstring, FORMAT_KEYBOARD, p, count);
+      TO_EXTERNAL_FORMAT (LISP_STRING, stuffstring,
+                         ALLOCA, (p, count),
+                         Qkeyboard);
       while (count-- > 0)
        stuff_char (XCONSOLE (Vcontrolling_terminal), *p++);
       stuff_char (XCONSOLE (Vcontrolling_terminal), '\n');
@@ -1061,6 +1073,8 @@ The elements of this list correspond to the arguments of
 void
 syms_of_console (void)
 {
+  INIT_LRECORD_IMPLEMENTATION (console);
+
   DEFSUBR (Fvalid_console_type_p);
   DEFSUBR (Fconsole_type_list);
   DEFSUBR (Fcdfw_console);
@@ -1096,10 +1110,45 @@ syms_of_console (void)
   defsymbol (&Qsuspend_resume_hook, "suspend-resume-hook");
 }
 
+static const struct lrecord_description cte_description_1[] = {
+  { XD_LISP_OBJECT, offsetof (console_type_entry, symbol) },
+  { XD_STRUCT_PTR,  offsetof (console_type_entry, meths), 1, &console_methods_description },
+  { XD_END }
+};
+
+static const struct struct_description cte_description = {
+  sizeof (console_type_entry),
+  cte_description_1
+};
+
+static const struct lrecord_description cted_description_1[] = {
+  XD_DYNARR_DESC (console_type_entry_dynarr, &cte_description),
+  { XD_END }
+};
+
+const struct struct_description cted_description = {
+  sizeof (console_type_entry_dynarr),
+  cted_description_1
+};
+
+static const struct lrecord_description console_methods_description_1[] = {
+  { XD_LISP_OBJECT, offsetof (struct console_methods, symbol) },
+  { XD_LISP_OBJECT, offsetof (struct console_methods, predicate_symbol) },
+  { XD_LISP_OBJECT, offsetof (struct console_methods, image_conversion_list) },
+  { XD_END }
+};
+
+const struct struct_description console_methods_description = {
+  sizeof (struct console_methods),
+  console_methods_description_1
+};
+
+
 void
 console_type_create (void)
 {
   the_console_type_entry_dynarr = Dynarr_new (console_type_entry);
+  dumpstruct(&the_console_type_entry_dynarr, &cted_description);
 
   Vconsole_type_list = Qnil;
   staticpro (&Vconsole_type_list);
@@ -1114,8 +1163,19 @@ console_type_create (void)
 }
 
 void
+reinit_vars_of_console (void)
+{
+  staticpro_nodump (&Vconsole_list);
+  Vconsole_list = Qnil;
+  staticpro_nodump (&Vselected_console);
+  Vselected_console = Qnil;
+}
+
+void
 vars_of_console (void)
 {
+  reinit_vars_of_console ();
+
   DEFVAR_LISP ("create-console-hook", &Vcreate_console_hook /*
 Function or functions to call when a console is created.
 One argument, the newly-created console.
@@ -1131,103 +1191,82 @@ 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         \
-  = { { { symbol_value_forward_lheader_initializer,                    \
-    (struct lcrecord_header *) &(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         \
-  = { { { symbol_value_forward_lheader_initializer,                    \
-    (struct lcrecord_header *) &(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         \
-  = { { { symbol_value_forward_lheader_initializer,                    \
-    (struct lcrecord_header *) &(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         \
-  = { { { symbol_value_forward_lheader_initializer,                    \
-    (struct lcrecord_header *) &(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         \
-  = { { { symbol_value_forward_lheader_initializer,                    \
-    (struct lcrecord_header *) &(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         \
-  = { { { symbol_value_forward_lheader_initializer,                    \
-    (struct lcrecord_header *) &(console_local_flags.field_name), 69 },        \
-     SYMVAL_DEFAULT_CONSOLE_FORWARD }, magicfun };                     \
-     defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C));            \
+/* The docstrings for DEFVAR_* are recorded externally by make-docfile.  */
+#define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magicfun) do { \
+  static const struct symbol_value_forward I_hate_C =                          \
+  { /* struct symbol_value_forward */                                          \
+    { /* struct symbol_value_magic */                                          \
+      { /* struct lcrecord_header */                                           \
+       { /* struct lrecord_header */                                           \
+         lrecord_type_symbol_value_forward, /* lrecord_type_index */           \
+         1, /* mark bit */                                                     \
+         1, /* c_readonly bit */                                               \
+         1  /* lisp_readonly bit */                                            \
+       },                                                                      \
+       0, /* next */                                                           \
+       0, /* uid  */                                                           \
+       0  /* free */                                                           \
+      },                                                                       \
+      &(console_local_flags.field_name),                                       \
+      forward_type                                                             \
+    },                                                                         \
+    magicfun                                                                   \
+  };                                                                           \
+                                                                               \
+  {                                                                            \
+    int offset = ((char *)symbol_value_forward_forward (&I_hate_C)             \
+                 - (char *)&console_local_flags);                              \
+                                                                               \
+    defvar_magic (lname, &I_hate_C);                                           \
+                                                                               \
+    *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols)))     \
+      = intern (lname);                                                                \
+  }                                                                            \
 } 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);
-}
+#define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun)                \
+       DEFVAR_CONSOLE_LOCAL_1 (lname, field_name,                      \
+                               SYMVAL_SELECTED_CONSOLE_FORWARD, magicfun)
+#define DEFVAR_CONSOLE_LOCAL(lname, field_name)                                \
+       DEFVAR_CONSOLE_LOCAL_MAGIC (lname, field_name, 0)
+#define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun)  \
+       DEFVAR_CONSOLE_LOCAL_1 (lname, field_name,                      \
+                               SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, magicfun)
+#define DEFVAR_CONST_CONSOLE_LOCAL(lname, field_name)                  \
+       DEFVAR_CONST_CONSOLE_LOCAL_MAGIC (lname, field_name, 0)
+
+#define DEFVAR_CONSOLE_DEFAULTS_MAGIC(lname, field_name, magicfun)     \
+       DEFVAR_SYMVAL_FWD(lname, &(console_local_flags.field_name),     \
+                         SYMVAL_DEFAULT_CONSOLE_FORWARD, magicfun)
+#define DEFVAR_CONSOLE_DEFAULTS(lname, field_name)                     \
+       DEFVAR_CONSOLE_DEFAULTS_MAGIC (lname, field_name, 0)
 
 static void
 nuke_all_console_slots (struct console *con, Lisp_Object zap)
 {
   zero_lcrecord (con);
 
-#define MARKED_SLOT(x) con->x = (zap);
+#define MARKED_SLOT(x) con->x = zap
 #include "conslots.h"
 #undef MARKED_SLOT
 }
 
-void
-complex_vars_of_console (void)
+static void
+common_init_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_type (struct console, lrecord_console);
-  struct console *syms = alloc_lcrecord_type (struct console, lrecord_console);
+  struct console *defs = alloc_lcrecord_type (struct console, &lrecord_console);
+  struct console *syms = alloc_lcrecord_type (struct console, &lrecord_console);
 
-  staticpro (&Vconsole_defaults);
-  staticpro (&Vconsole_local_symbols);
+  staticpro_nodump (&Vconsole_defaults);
+  staticpro_nodump (&Vconsole_local_symbols);
   XSETCONSOLE (Vconsole_defaults, defs);
   XSETCONSOLE (Vconsole_local_symbols, syms);
 
@@ -1282,6 +1321,53 @@ complex_vars_of_console (void)
        currently allowable due to the XINT() handling of this value.
        With some rearrangement you can get 4 more bits. */
   }
+}
+
+
+#define CONSOLE_SLOTS_SIZE (offsetof (struct console, CONSOLE_SLOTS_LAST_NAME) - offsetof (struct console, CONSOLE_SLOTS_FIRST_NAME) + sizeof (Lisp_Object))
+#define CONSOLE_SLOTS_COUNT (CONSOLE_SLOTS_SIZE / sizeof (Lisp_Object))
+
+void
+reinit_complex_vars_of_console (void)
+{
+  struct console *defs, *syms;
+
+  common_init_complex_vars_of_console ();
+
+  defs = XCONSOLE (Vconsole_defaults);
+  syms = XCONSOLE (Vconsole_local_symbols);
+  memcpy (&defs->CONSOLE_SLOTS_FIRST_NAME,
+         console_defaults_saved_slots,
+         CONSOLE_SLOTS_SIZE);
+  memcpy (&syms->CONSOLE_SLOTS_FIRST_NAME,
+         console_local_symbols_saved_slots,
+         CONSOLE_SLOTS_SIZE);
+}
+
+
+static const struct lrecord_description console_slots_description_1[] = {
+  { XD_LISP_OBJECT_ARRAY, 0, CONSOLE_SLOTS_COUNT },
+  { XD_END }
+};
+
+static const struct struct_description console_slots_description = {
+  CONSOLE_SLOTS_SIZE,
+  console_slots_description_1
+};
+
+void
+complex_vars_of_console (void)
+{
+  struct console *defs, *syms;
+
+  common_init_complex_vars_of_console ();
+
+  defs = XCONSOLE (Vconsole_defaults);
+  syms = XCONSOLE (Vconsole_local_symbols);
+  console_defaults_saved_slots      = &defs->CONSOLE_SLOTS_FIRST_NAME;
+  console_local_symbols_saved_slots = &syms->CONSOLE_SLOTS_FIRST_NAME;
+  dumpstruct (&console_defaults_saved_slots,      &console_slots_description);
+  dumpstruct (&console_local_symbols_saved_slots, &console_slots_description);
 
   DEFVAR_CONSOLE_DEFAULTS ("default-function-key-map", function_key_map /*
 Default value of `function-key-map' for consoles that don't override it.
@@ -1312,7 +1398,7 @@ were a prefix key, typing `ESC O P x' would return
 */ );
 
 #ifdef HAVE_TTY
-  /* ### Should this somehow go to TTY data?  How do we make it
+  /* #### Should this somehow go to TTY data?  How do we make it
      accessible from Lisp, then?  */
   DEFVAR_CONSOLE_LOCAL ("tty-erase-char", tty_erase_char /*
 The ERASE character as set by the user with stty.
@@ -1321,14 +1407,14 @@ consoles, for example), it is set to nil.
 */ );
 #endif
 
-  /* While this should be CONST it can't be because some things
+  /* While this should be const it can't be because some things
      (i.e. edebug) do manipulate it. */
   DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /*
-Non-nil while a console macro is being defined.  Don't set this!
+Non-nil while a keyboard 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.
+Last keyboard macro defined, as a vector of events; nil if none defined.
 */ );
 
   DEFVAR_CONSOLE_LOCAL ("prefix-arg", prefix_arg /*