XEmacs 21.2.20 "Yoko".
[chise/xemacs-chise.git.1] / src / event-stream.c
index b965a3f..b9fefe2 100644 (file)
@@ -47,9 +47,9 @@ Boston, MA 02111-1307, USA.  */
    sequence, without disturbing the key sequence composition, or the
    command builder structure representing it.
 
-   Someone should rethink univeral-argument and figure out how an
+   Someone should rethink universal-argument and figure out how an
    arbitrary command can influence the next command (universal-argument
-   or univeral-coding-system-argument) or the next key (hyperify).
+   or universal-coding-system-argument) or the next key (hyperify).
 
    Both C-h and Help in the middle of a key sequence should trigger
    prefix-help-command.  help-char is stupid.  Maybe we need
@@ -81,7 +81,6 @@ Boston, MA 02111-1307, USA.  */
 #include "keymap.h"
 #include "lstream.h"
 #include "macros.h"            /* for defining_keyboard_macro */
-#include "opaque.h"
 #include "process.h"
 #include "window.h"
 
@@ -102,8 +101,6 @@ static int auto_save_interval;
 
 Lisp_Object Qundefined_keystroke_sequence;
 
-Lisp_Object Qcommand_execute;
-
 Lisp_Object Qcommand_event_p;
 
 /* Hooks to run before and after each command.  */
@@ -249,7 +246,7 @@ Lisp_Object Vmenu_accelerator_modifiers;
 /* whether menu accelerators are enabled */
 Lisp_Object Vmenu_accelerator_enabled;
 
-/* keymap for auxillary menu accelerator functions */
+/* keymap for auxiliary menu accelerator functions */
 Lisp_Object Vmenu_accelerator_map;
 
 Lisp_Object Qmenu_force;
@@ -389,15 +386,15 @@ static Lisp_Object recursive_sit_for;
 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
 
 static Lisp_Object
-mark_command_builder (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_command_builder (Lisp_Object obj)
 {
   struct command_builder *builder = XCOMMAND_BUILDER (obj);
-  (markobj) (builder->prefix_events);
-  (markobj) (builder->current_events);
-  (markobj) (builder->most_current_event);
-  (markobj) (builder->last_non_munged_event);
-  (markobj) (builder->munge_me[0].first_mungeable_event);
-  (markobj) (builder->munge_me[1].first_mungeable_event);
+  mark_object (builder->prefix_events);
+  mark_object (builder->current_events);
+  mark_object (builder->most_current_event);
+  mark_object (builder->last_non_munged_event);
+  mark_object (builder->munge_me[0].first_mungeable_event);
+  mark_object (builder->munge_me[1].first_mungeable_event);
   return builder->console;
 }
 
@@ -413,7 +410,7 @@ finalize_command_builder (void *header, int for_disksave)
 
 DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder,
                                mark_command_builder, internal_object_printer,
-                              finalize_command_builder, 0, 0,
+                              finalize_command_builder, 0, 0, 0,
                               struct command_builder);
 \f
 static void
@@ -432,7 +429,7 @@ allocate_command_builder (Lisp_Object console)
 {
   Lisp_Object builder_obj;
   struct command_builder *builder =
-    alloc_lcrecord_type (struct command_builder, lrecord_command_builder);
+    alloc_lcrecord_type (struct command_builder, &lrecord_command_builder);
 
   builder->console = console;
   reset_command_builder_event_chain (builder);
@@ -781,9 +778,9 @@ maybe_kbd_translate (Lisp_Object event)
 
   if (XEVENT_TYPE (event) != key_press_event)
     return;
-  if (!HASHTABLEP (Vkeyboard_translate_table))
+  if (!HASH_TABLEP (Vkeyboard_translate_table))
     return;
-  if (EQ (Fhashtable_fullness (Vkeyboard_translate_table), Qzero))
+  if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero))
     return;
 
   c = event_to_character (XEVENT (event), 0, 0, 0);
@@ -896,7 +893,7 @@ execute_help_form (struct command_builder *command_builder,
 
   help = Feval (Vhelp_form);
   if (STRINGP (help))
-    internal_with_output_to_temp_buffer ("*Help*",
+    internal_with_output_to_temp_buffer (build_string ("*Help*"),
                                         print_help, help, Qnil);
   Fnext_command_event (event, Qnil);
   /* Remove the help from the frame */
@@ -985,7 +982,7 @@ Actually, the value is nil only if we can be sure that no input is available.
    used to indicate an absence of a timer. */
 static int low_level_timeout_id_tick;
 
-struct low_level_timeout_blocktype
+static struct low_level_timeout_blocktype
 {
   Blocktype_declare (struct low_level_timeout);
 } *the_low_level_timeout_blocktype;
@@ -1101,38 +1098,39 @@ pop_low_level_timeout (struct low_level_timeout **timeout_list,
 
 static int timeout_id_tick;
 
-/* Since timeout structures contain Lisp_Objects, they need to be GC'd
-   properly.  The opaque data type provides a convenient way of doing
-   this without having to create a new Lisp object, since we can
-   provide our own mark function. */
-
-struct timeout
-{
-  int id; /* Id we use to identify the timeout over its lifetime */
-  int interval_id; /* Id for this particular interval; this may
-                     be different each time the timeout is
-                     signalled.*/
-  Lisp_Object function, object; /* Function and object associated
-                                  with timeout. */
-  EMACS_TIME next_signal_time;  /* Absolute time when the timeout
-                                  is next going to be signalled. */
-  unsigned int resignal_msecs;  /* How far after the next timeout
-                                  should the one after that
-                                  occur? */
-};
-
 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
 
 static Lisp_Object Vtimeout_free_list;
 
 static Lisp_Object
-mark_timeout (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_timeout (Lisp_Object obj)
 {
-  struct timeout *tm = (struct timeout *) XOPAQUE_DATA (obj);
-  (markobj) (tm->function);
+  struct Lisp_Timeout *tm = XTIMEOUT (obj);
+  mark_object (tm->function);
   return tm->object;
 }
 
+/* Should never, ever be called. (except by an external debugger) */
+static void
+print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+  CONST struct Lisp_Timeout *t = XTIMEOUT (obj);
+  char buf[64];
+
+  sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (timeout) 0x%lx>",
+          (unsigned long) t);
+  write_c_string (buf, printcharfun);
+}
+
+static const struct lrecord_description timeout_description[] = {
+  { XD_LISP_OBJECT, offsetof(struct Lisp_Timeout, function), 2 },
+  { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
+                              mark_timeout, print_timeout,
+                              0, 0, 0, timeout_description, struct Lisp_Timeout);
+
 /* Generate a timeout and return its ID. */
 
 int
@@ -1141,8 +1139,8 @@ event_stream_generate_wakeup (unsigned int milliseconds,
                              Lisp_Object function, Lisp_Object object,
                              int async_p)
 {
-  Lisp_Object op = allocate_managed_opaque (Vtimeout_free_list, 0);
-  struct timeout *timeout = (struct timeout *) XOPAQUE_DATA (op);
+  Lisp_Object op = allocate_managed_lcrecord (Vtimeout_free_list);
+  struct Lisp_Timeout *timeout = XTIMEOUT (op);
   EMACS_TIME current_time;
   EMACS_TIME interval;
 
@@ -1191,7 +1189,7 @@ event_stream_resignal_wakeup (int interval_id, int async_p,
                              Lisp_Object *function, Lisp_Object *object)
 {
   Lisp_Object op = Qnil, rest;
-  struct timeout *timeout;
+  struct Lisp_Timeout *timeout;
   Lisp_Object *timeout_list;
   struct gcpro gcpro1;
   int id;
@@ -1204,16 +1202,16 @@ event_stream_resignal_wakeup (int interval_id, int async_p,
   /* Find the timeout on the list of pending ones. */
   LIST_LOOP (rest, *timeout_list)
     {
-      timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest));
+      timeout = XTIMEOUT (XCAR (rest));
       if (timeout->interval_id == interval_id)
        break;
     }
 
   assert (!NILP (rest));
   op = XCAR (rest);
-  timeout = (struct timeout *) XOPAQUE_DATA (op);
+  timeout = XTIMEOUT (op);
   /* We make sure to snarf the data out of the timeout object before
-     we free it with free_managed_opaque(). */
+     we free it with free_managed_lcrecord(). */
   id = timeout->id;
   *function = timeout->function;
   *object = timeout->object;
@@ -1255,7 +1253,7 @@ event_stream_resignal_wakeup (int interval_id, int async_p,
       *timeout_list = noseeum_cons (op, *timeout_list);
     }
   else
-    free_managed_opaque (Vtimeout_free_list, op);
+    free_managed_lcrecord (Vtimeout_free_list, op);
 
   UNGCPRO;
   return id;
@@ -1264,7 +1262,7 @@ event_stream_resignal_wakeup (int interval_id, int async_p,
 void
 event_stream_disable_wakeup (int id, int async_p)
 {
-  struct timeout *timeout = 0;
+  struct Lisp_Timeout *timeout = 0;
   Lisp_Object rest;
   Lisp_Object *timeout_list;
 
@@ -1276,7 +1274,7 @@ event_stream_disable_wakeup (int id, int async_p)
   /* Find the timeout on the list of pending ones, if it's still there. */
   LIST_LOOP (rest, *timeout_list)
     {
-      timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest));
+      timeout = XTIMEOUT (XCAR (rest));
       if (timeout->id == id)
        break;
     }
@@ -1292,14 +1290,14 @@ event_stream_disable_wakeup (int id, int async_p)
        event_stream_remove_async_timeout (timeout->interval_id);
       else
        event_stream_remove_timeout (timeout->interval_id);
-      free_managed_opaque (Vtimeout_free_list, op);
+      free_managed_lcrecord (Vtimeout_free_list, op);
     }
 }
 
 static int
 event_stream_wakeup_pending_p (int id, int async_p)
 {
-  struct timeout *timeout;
+  struct Lisp_Timeout *timeout;
   Lisp_Object rest;
   Lisp_Object timeout_list;
   int found = 0;
@@ -1313,7 +1311,7 @@ event_stream_wakeup_pending_p (int id, int async_p)
   /* Find the element on the list of pending ones, if it's still there. */
   LIST_LOOP (rest, timeout_list)
     {
-      timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest));
+      timeout = XTIMEOUT (XCAR (rest));
       if (timeout->id == id)
        {
          found = 1;
@@ -1813,7 +1811,7 @@ investigate_frame_change (void)
                * get here and have it be non-nil.
                */
               if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
-                old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);              
+                old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);
               else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
                 old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
 
@@ -2324,7 +2322,6 @@ The returned event will be one of the following types:
     XCAR (XCDR (XCDR (Vlast_command_event_time)))
       = make_int (EMACS_USECS (t));
   }
-
   /* If this key came from the keyboard or from a keyboard macro, then
      it goes into the recent-keys and this-command-keys vectors.
      If this key came from the keyboard, and we're defining a keyboard
@@ -2370,7 +2367,7 @@ echo area while this function is waiting for an event.
 The event returned will be a keyboard, mouse press, or mouse release event.
 If there are non-command events available (mouse motion, sub-process output,
 etc) then these will be executed (with `dispatch-event') and discarded.  This
-function is provided as a convenience; it is rougly equivalent to the lisp code
+function is provided as a convenience; it is roughly equivalent to the lisp code
 
        (while (progn
                 (next-event event prompt)
@@ -2510,7 +2507,7 @@ A user event is a key press, button press, button release, or
    All of these routines install timeouts, so we clear the installed
    timeout as well.
 
-   Note: It's very easy to break the desired behaviours of these
+   Note: It's very easy to break the desired behaviors of these
    3 routines.  If you make any changes to anything in this area, run
    the regression tests at the bottom of the file.  -- dmoore */
 
@@ -2774,7 +2771,7 @@ If sit-for is called from within a process filter function or timer
   if (noninteractive || !NILP (Vexecuting_macro))
     return Qnil;
 
-  /* Recusive call from a filter function or timeout handler. */
+  /* Recursive call from a filter function or timeout handler. */
   if (!NILP(recursive_sit_for))
     {
       if (!event_stream_event_pending_p (1) && NILP (nodisplay))
@@ -4002,7 +3999,7 @@ Set the maximum number of events to be stored internally.
 /* Vthis_command_keys having value Qnil means that the next time
    push_this_command_keys is called, it should start over.
    The times at which the command-keys are reset
-   (instead of merely being augmented) are pretty conterintuitive.
+   (instead of merely being augmented) are pretty counterintuitive.
    (More specifically:
 
    -- We do not reset this-command-keys when we finish reading a
@@ -4353,7 +4350,7 @@ execute_command_event (struct command_builder *command_builder,
       ;
     else
 #endif
-      if (!NILP (con->prefix_arg))
+    if (!NILP (con->prefix_arg))
       {
        /* Commands that set the prefix arg don't update last-command, don't
           reset the echoing state, and don't go into keyboard macros unless
@@ -4910,7 +4907,6 @@ syms_of_event_stream (void)
 
   deferror (&Qundefined_keystroke_sequence, "undefined-keystroke-sequence",
             "Undefined keystroke sequence", Qerror);
-  defsymbol (&Qcommand_execute, "command-execute");
 
   DEFSUBR (Frecent_keys);
   DEFSUBR (Frecent_keys_ring_size);
@@ -4967,32 +4963,36 @@ syms_of_event_stream (void)
 }
 
 void
-vars_of_event_stream (void)
+reinit_vars_of_event_stream (void)
 {
-#ifdef HAVE_X_WINDOWS
-  vars_of_event_Xt ();
-#endif
-#if defined(HAVE_TTY) && (defined (DEBUG_TTY_EVENT_STREAM) || !defined (HAVE_X_WINDOWS))
-  vars_of_event_tty ();
-#endif
-#ifdef HAVE_MS_WINDOWS
-  vars_of_event_mswindows ();
-#endif
-
   recent_keys_ring_index = 0;
   recent_keys_ring_size = 100;
+  num_input_chars = 0;
+  Vtimeout_free_list = make_lcrecord_list (sizeof (struct Lisp_Timeout),
+                                          &lrecord_timeout);
+  staticpro_nodump (&Vtimeout_free_list);
+  the_low_level_timeout_blocktype =
+    Blocktype_new (struct low_level_timeout_blocktype);
+  something_happened = 0;
+  recursive_sit_for = Qnil;
+}
+
+void
+vars_of_event_stream (void)
+{
+  reinit_vars_of_event_stream ();
   Vrecent_keys_ring = Qnil;
   staticpro (&Vrecent_keys_ring);
 
   Vthis_command_keys = Qnil;
   staticpro (&Vthis_command_keys);
   Vthis_command_keys_tail = Qnil;
-
-  num_input_chars = 0;
+  pdump_wire (&Vthis_command_keys_tail);
 
   command_event_queue = Qnil;
   staticpro (&command_event_queue);
   command_event_queue_tail = Qnil;
+  pdump_wire (&command_event_queue_tail);
 
   Vlast_selected_frame = Qnil;
   staticpro (&Vlast_selected_frame);
@@ -5003,20 +5003,9 @@ vars_of_event_stream (void)
   pending_async_timeout_list = Qnil;
   staticpro (&pending_async_timeout_list);
 
-  Vtimeout_free_list = make_opaque_list (sizeof (struct timeout),
-                                        mark_timeout);
-  staticpro (&Vtimeout_free_list);
-
-  the_low_level_timeout_blocktype =
-    Blocktype_new (struct low_level_timeout_blocktype);
-
-  something_happened = 0;
-
   last_point_position_buffer = Qnil;
   staticpro (&last_point_position_buffer);
 
-  recursive_sit_for = Qnil;
-
   DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /*
 *Nonzero means echo unfinished commands after this many seconds of pause.
 */ );
@@ -5058,7 +5047,7 @@ Errors running the hook are caught and ignored.
 *Variable to control XEmacs behavior with respect to focus changing.
 If this variable is set to t, then XEmacs will not gratuitously change
 the keyboard focus.  XEmacs cannot in general detect when this mode is
-use by the window manager, so it is up to the user to set it.
+used by the window manager, so it is up to the user to set it.
 */ );
   focus_follows_mouse = 0;
 
@@ -5340,7 +5329,8 @@ See also menu-accelerator-modifiers and menu-accelerator-prefix.
 void
 complex_vars_of_event_stream (void)
 {
-  Vkeyboard_translate_table = Fmake_hashtable (make_int (100), Qnil);
+  Vkeyboard_translate_table =
+    make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
 
   DEFVAR_LISP ("menu-accelerator-map", &Vmenu_accelerator_map /*
 Keymap for use when the menubar is active.
@@ -5384,8 +5374,7 @@ init_event_stream (void)
   if (initialized)
     {
 #ifdef HAVE_UNIXOID_EVENT_LOOP
-      /*      if (strcmp (display_use, "mswindows") != 0)*/
-       init_event_unixoid ();
+      init_event_unixoid ();
 #endif
 #ifdef HAVE_X_WINDOWS
       if (!strcmp (display_use, "x"))
@@ -5400,12 +5389,14 @@ init_event_stream (void)
          {
            /* For TTY's, use the Xt event loop if we can; it allows
               us to later open an X connection. */
-#if defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
+#if defined (HAVE_MS_WINDOWS) && (!defined (HAVE_TTY) \
+                || (defined (HAVE_MSG_SELECT) \
+           && !defined (DEBUG_TTY_EVENT_STREAM)))
+           init_event_mswindows_late ();
+#elif defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
            init_event_Xt_late ();
 #elif defined (HAVE_TTY)
            init_event_tty_late ();
-#elif defined (HAVE_MS_WINDOWS)
-           init_event_mswindows_late ();
 #endif
          }
       init_interrupts_late ();
@@ -5464,7 +5455,7 @@ with the read-key-sequence:
  (tst)^Jabc^G  ==>  ((quit) 97) with no signal, and "bc" inserted in buffer
 
 ; with sit-for only do the 2nd test.
-; Do all 3 tests with (accept-proccess-output nil 20)
+; Do all 3 tests with (accept-process-output nil 20)
 
 Do this:
   (setq enable-recursive-minibuffers t