XEmacs 21.2.28 "Hermes".
[chise/xemacs-chise.git.1] / src / event-stream.c
index 81f5f02..5680725 100644 (file)
@@ -259,6 +259,8 @@ Lisp_Object Qmenu_right;
 Lisp_Object Qmenu_select;
 Lisp_Object Qmenu_escape;
 
+Lisp_Object Qself_insert_defer_undo;
+
 /* this is in keymap.c */
 extern Lisp_Object Fmake_keymap (Lisp_Object name);
 
@@ -382,7 +384,6 @@ static Lisp_Object recursive_sit_for;
   XRECORD (x, command_builder, struct command_builder)
 #define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
-#define GC_COMMAND_BUILDERP(x) GC_RECORDP (x, command_builder)
 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
 
 static Lisp_Object
@@ -507,7 +508,7 @@ event_stream_event_pending_p (int user)
 }
 
 static int
-maybe_read_quit_event (struct Lisp_Event *event)
+maybe_read_quit_event (Lisp_Event *event)
 {
   /* A C-g that came from `sigint_happened' will always come from the
      controlling terminal.  If that doesn't exist, however, then the
@@ -534,7 +535,7 @@ maybe_read_quit_event (struct Lisp_Event *event)
 }
 
 void
-event_stream_next_event (struct Lisp_Event *event)
+event_stream_next_event (Lisp_Event *event)
 {
   Lisp_Object event_obj;
 
@@ -578,7 +579,7 @@ event_stream_next_event (struct Lisp_Event *event)
 }
 
 void
-event_stream_handle_magic_event (struct Lisp_Event *event)
+event_stream_handle_magic_event (Lisp_Event *event)
 {
   check_event_stream_ok (EVENT_STREAM_READ);
   event_stream->handle_magic_event_cb (event);
@@ -621,7 +622,7 @@ event_stream_unselect_console (struct console *con)
 }
 
 void
-event_stream_select_process (struct Lisp_Process *proc)
+event_stream_select_process (Lisp_Process *proc)
 {
   check_event_stream_ok (EVENT_STREAM_PROCESS);
   if (!get_process_selected_p (proc))
@@ -632,7 +633,7 @@ event_stream_select_process (struct Lisp_Process *proc)
 }
 
 void
-event_stream_unselect_process (struct Lisp_Process *proc)
+event_stream_unselect_process (Lisp_Process *proc)
 {
   check_event_stream_ok (EVENT_STREAM_PROCESS);
   if (get_process_selected_p (proc))
@@ -796,7 +797,7 @@ maybe_kbd_translate (Lisp_Object event)
        }
       else if (CHARP (traduit))
        {
-         struct Lisp_Event ev2;
+         Lisp_Event ev2;
 
          /* This used to call Fcharacter_to_event() directly into EVENT,
             but that can eradicate timestamps and other such stuff.
@@ -1105,7 +1106,7 @@ static Lisp_Object Vtimeout_free_list;
 static Lisp_Object
 mark_timeout (Lisp_Object obj)
 {
-  struct Lisp_Timeout *tm = XTIMEOUT (obj);
+  Lisp_Timeout *tm = XTIMEOUT (obj);
   mark_object (tm->function);
   return tm->object;
 }
@@ -1114,7 +1115,7 @@ mark_timeout (Lisp_Object obj)
 static void
 print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 {
-  CONST struct Lisp_Timeout *t = XTIMEOUT (obj);
+  CONST Lisp_Timeout *t = XTIMEOUT (obj);
   char buf[64];
 
   sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (timeout) 0x%lx>",
@@ -1123,13 +1124,14 @@ print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 }
 
 static const struct lrecord_description timeout_description[] = {
-  { XD_LISP_OBJECT, offsetof(struct Lisp_Timeout, function), 2 },
+  { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) },
+  { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) },
   { XD_END }
 };
 
 DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
                               mark_timeout, print_timeout,
-                              0, 0, 0, timeout_description, struct Lisp_Timeout);
+                              0, 0, 0, timeout_description, Lisp_Timeout);
 
 /* Generate a timeout and return its ID. */
 
@@ -1140,7 +1142,7 @@ event_stream_generate_wakeup (unsigned int milliseconds,
                              int async_p)
 {
   Lisp_Object op = allocate_managed_lcrecord (Vtimeout_free_list);
-  struct Lisp_Timeout *timeout = XTIMEOUT (op);
+  Lisp_Timeout *timeout = XTIMEOUT (op);
   EMACS_TIME current_time;
   EMACS_TIME interval;
 
@@ -1189,7 +1191,7 @@ event_stream_resignal_wakeup (int interval_id, int async_p,
                              Lisp_Object *function, Lisp_Object *object)
 {
   Lisp_Object op = Qnil, rest;
-  struct Lisp_Timeout *timeout;
+  Lisp_Timeout *timeout;
   Lisp_Object *timeout_list;
   struct gcpro gcpro1;
   int id;
@@ -1262,7 +1264,7 @@ event_stream_resignal_wakeup (int interval_id, int async_p,
 void
 event_stream_disable_wakeup (int id, int async_p)
 {
-  struct Lisp_Timeout *timeout = 0;
+  Lisp_Timeout *timeout = 0;
   Lisp_Object rest;
   Lisp_Object *timeout_list;
 
@@ -1297,7 +1299,7 @@ event_stream_disable_wakeup (int id, int async_p)
 static int
 event_stream_wakeup_pending_p (int id, int async_p)
 {
-  struct Lisp_Timeout *timeout;
+  Lisp_Timeout *timeout;
   Lisp_Object rest;
   Lisp_Object timeout_list;
   int found = 0;
@@ -2014,7 +2016,7 @@ next_event_internal (Lisp_Object target_event, int allow_queued)
     }
   else
     {
-      struct Lisp_Event *e = XEVENT (target_event);
+      Lisp_Event *e = XEVENT (target_event);
 
       /* The command_event_queue was empty.  Wait for an event. */
       event_stream_next_event (e);
@@ -3036,7 +3038,7 @@ execute_internal_event (Lisp_Object event)
 
     case timeout_event:
       {
-       struct Lisp_Event *e = XEVENT (event);
+       Lisp_Event *e = XEVENT (event);
        if (!NILP (e->event.timeout.function))
          call1 (e->event.timeout.function,
                 e->event.timeout.object);
@@ -3098,20 +3100,15 @@ command_builder_find_leaf_1 (struct command_builder *builder)
 static void
 menu_move_up (void)
 {
-  widget_value *current, *prev;
-  widget_value *entries;
+  widget_value *current = lw_get_entries (False);
+  widget_value *entries = lw_get_entries (True);
+  widget_value *prev    = NULL;
 
-  current = lw_get_entries (False);
-  entries = lw_get_entries (True);
-  prev = NULL;
-  if (current != entries)
+  while (entries != current)
     {
-      while (entries != current)
-       {
-         if (entries->name /*&& entries->enabled*/) prev = entries;
-         entries = entries->next;
-         assert (entries);
-       }
+      if (entries->name /*&& entries->enabled*/) prev = entries;
+      entries = entries->next;
+      assert (entries);
     }
 
   if (!prev)
@@ -3140,11 +3137,8 @@ menu_move_up (void)
 static void
 menu_move_down (void)
 {
-  widget_value *current;
-  widget_value *new;
-
-  current = lw_get_entries (False);
-  new = current;
+  widget_value *current = lw_get_entries (False);
+  widget_value *new = current;
 
   while (new->next)
     {
@@ -3177,11 +3171,9 @@ menu_move_left (void)
   int l = level;
   widget_value *current;
 
-  while (level >= 3)
-    {
-      --level;
-      lw_pop_menu ();
-    }
+  while (level-- >= 3)
+    lw_pop_menu ();
+
   menu_move_up ();
   current = lw_get_entries (False);
   if (l > 2 && current->contents)
@@ -3195,11 +3187,9 @@ menu_move_right (void)
   int l = level;
   widget_value *current;
 
-  while (level >= 3)
-    {
-      --level;
-      lw_pop_menu ();
-    }
+  while (level-- >= 3)
+    lw_pop_menu ();
+
   menu_move_down ();
   current = lw_get_entries (False);
   if (l > 2 && current->contents)
@@ -3780,7 +3770,7 @@ command_builder_find_leaf (struct command_builder *builder,
           || (CHAR_OR_CHAR_INTP (key->keysym)
               && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z')))
         {
-          struct Lisp_Event terminal_copy = *XEVENT (terminal);
+          Lisp_Event terminal_copy = *XEVENT (terminal);
 
           if (key->modifiers & MOD_SHIFT)
             key->modifiers &= (~ MOD_SHIFT);
@@ -4173,7 +4163,7 @@ lookup_command_event (struct command_builder *command_builder,
     if (EVENTP (recent)
        && event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char))
       {
-       struct Lisp_Event *e;
+       Lisp_Event *e;
        /* When we see a sequence like "ESC x", pretend we really saw "M-x".
           DoubleThink the recent-keys and this-command-keys as well. */
 
@@ -4240,7 +4230,7 @@ lookup_command_event (struct command_builder *command_builder,
          }
        else if (!NILP (Vquit_flag)) {
          Lisp_Object quit_event = Fmake_event(Qnil, Qnil);
-         struct Lisp_Event *e = XEVENT (quit_event);
+         Lisp_Event *e = XEVENT (quit_event);
          /* if quit happened during menu acceleration, pretend we read it */
          struct console *con = XCONSOLE (Fselected_console ());
          int ch = CONSOLE_QUIT_CHAR (con);
@@ -4411,7 +4401,7 @@ post_command_hook (void)
 #if 0
   /* If the last command deleted the frame, `win' might be nil.
      It seems safest to do nothing in this case. */
-  /* ### This doesn't really fix the problem,
+  /* #### This doesn't really fix the problem,
      if delete-frame is called by some hook */
   if (NILP (win))
     return;
@@ -4490,7 +4480,7 @@ Magic events are handled as necessary.
 {
   /* This function can GC */
   struct command_builder *command_builder;
-  struct Lisp_Event *ev;
+  Lisp_Event *ev;
   Lisp_Object console;
   Lisp_Object channel;
 
@@ -4604,15 +4594,35 @@ Magic events are handled as necessary.
          }
        else /* key sequence is bound to a command */
          {
+           int magic_undo = 0;
+           int magic_undo_count = 20;
+
            Vthis_command = leaf;
+
            /* Don't push an undo boundary if the command set the prefix arg,
               or if we are executing a keyboard macro, or if in the
               minibuffer.  If the command we are about to execute is
               self-insert, it's tricky: up to 20 consecutive self-inserts may
               be done without an undo boundary.  This counter is reset as
               soon as a command other than self-insert-command is executed.
-              */
-           if (! EQ (leaf, Qself_insert_command))
+
+              Programmers can also use the `self-insert-undo-magic'
+              property to install that behaviour on functions other
+              than `self-insert-command', or to change the magic
+              number 20 to something else.  */
+
+           if (SYMBOLP (leaf))
+             {
+               Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil);
+               if (NATNUMP (prop))
+                 magic_undo = 1, magic_undo_count = XINT (prop);
+               else if (!NILP (prop))
+                 magic_undo = 1;
+               else if (EQ (leaf, Qself_insert_command))
+                 magic_undo = 1;
+             }
+
+           if (!magic_undo)
              command_builder->self_insert_countdown = 0;
            if (NILP (XCONSOLE (console)->prefix_arg)
                && NILP (Vexecuting_macro)
@@ -4626,10 +4636,10 @@ Magic events are handled as necessary.
                && command_builder->self_insert_countdown == 0)
              Fundo_boundary ();
 
-           if (EQ (leaf, Qself_insert_command))
+           if (magic_undo)
              {
                if (--command_builder->self_insert_countdown < 0)
-                 command_builder->self_insert_countdown = 20;
+                 command_builder->self_insert_countdown = magic_undo_count;
              }
            execute_command_event
               (command_builder,
@@ -4815,7 +4825,7 @@ That is not right.
 
 Calling this function directs the translated event to replace
 the original event, so that only one version of the event actually
-appears in the echo area and in the value of `this-command-keys.'.
+appears in the echo area and in the value of `this-command-keys'.
 */
        ())
 {
@@ -4957,6 +4967,7 @@ syms_of_event_stream (void)
   defsymbol (&Qmenu_select, "menu-select");
   defsymbol (&Qmenu_escape, "menu-escape");
 
+  defsymbol (&Qself_insert_defer_undo, "self-insert-defer-undo");
   defsymbol (&Qcancel_mode_internal, "cancel-mode-internal");
 }
 
@@ -4966,7 +4977,7 @@ reinit_vars_of_event_stream (void)
   recent_keys_ring_index = 0;
   recent_keys_ring_size = 100;
   num_input_chars = 0;
-  Vtimeout_free_list = make_lcrecord_list (sizeof (struct Lisp_Timeout),
+  Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout),
                                           &lrecord_timeout);
   staticpro_nodump (&Vtimeout_free_list);
   the_low_level_timeout_blocktype =