]> code.delx.au - gnu-emacs/blobdiff - src/callint.c
*** empty log message ***
[gnu-emacs] / src / callint.c
index a1c28ca1b13e2f18d9141be37eb3a5a9f0a4e542..da88693cd7882fa302f2d50c0ff9cb6cacc5c367 100644 (file)
@@ -1,5 +1,5 @@
 /* Call a Lisp function interactively.
 /* Call a Lisp function interactively.
-   Copyright (C) 1985, 86, 93, 94, 95, 1997, 2000, 2002
+   Copyright (C) 1985, 86, 93, 94, 95, 1997, 2000, 02, 03, 2004
    Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
    Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -41,6 +41,7 @@ Lisp_Object Qcall_interactively;
 Lisp_Object Vcommand_history;
 
 extern Lisp_Object Vhistory_length;
 Lisp_Object Vcommand_history;
 
 extern Lisp_Object Vhistory_length;
+extern Lisp_Object Vthis_original_command, real_this_command;
 
 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
 Lisp_Object Qenable_recursive_minibuffers;
 
 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
 Lisp_Object Qenable_recursive_minibuffers;
@@ -51,7 +52,7 @@ Lisp_Object Vmark_even_if_inactive;
 
 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
 
 
 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
 
-Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion;
+Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
 static Lisp_Object preserved_fns;
 
 /* Marker used within call-interactively to refer to point.  */
 static Lisp_Object preserved_fns;
 
 /* Marker used within call-interactively to refer to point.  */
@@ -109,6 +110,7 @@ P -- Prefix arg in raw form.  Does not do I/O.
 r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O.
 s -- Any string.  Does not inherit the current input method.
 S -- Any symbol.
 r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O.
 s -- Any string.  Does not inherit the current input method.
 S -- Any symbol.
+U -- Mouse up event discarded by a previous k or K argument.
 v -- Variable name: symbol that is user-variable-p.
 x -- Lisp expression read but not evaluated.
 X -- Lisp expression read and evaluated.
 v -- Variable name: symbol that is user-variable-p.
 x -- Lisp expression read but not evaluated.
 X -- Lisp expression read and evaluated.
@@ -174,6 +176,74 @@ check_mark (for_region)
     Fsignal (Qmark_inactive, Qnil);
 }
 
     Fsignal (Qmark_inactive, Qnil);
 }
 
+/* If the list of args INPUT was produced with an explicit call to
+   `list', look for elements that were computed with
+   (region-beginning) or (region-end), and put those expressions into
+   VALUES instead of the present values.
+
+   This function doesn't return a value because it modifies elements
+   of VALUES to do its job.  */
+
+static void
+fix_command (input, values)
+     Lisp_Object input, values;
+{
+  if (CONSP (input))
+    {
+      Lisp_Object car;
+
+      car = XCAR (input);
+      /* Skip through certain special forms.  */
+      while (EQ (car, Qlet) || EQ (car, Qletx)
+            || EQ (car, Qsave_excursion)
+            || EQ (car, Qprogn))
+       {
+         while (CONSP (XCDR (input)))
+           input = XCDR (input);
+         input = XCAR (input);
+         if (!CONSP (input))
+           break;
+         car = XCAR (input);
+       }
+      if (EQ (car, Qlist))
+       {
+         Lisp_Object intail, valtail;
+         for (intail = Fcdr (input), valtail = values;
+              CONSP (valtail);
+              intail = Fcdr (intail), valtail = XCDR (valtail))
+           {
+             Lisp_Object elt;
+             elt = Fcar (intail);
+             if (CONSP (elt))
+               {
+                 Lisp_Object presflag, carelt;
+                 carelt = Fcar (elt);
+                 /* If it is (if X Y), look at Y.  */
+                 if (EQ (carelt, Qif)
+                     && EQ (Fnthcdr (make_number (3), elt), Qnil))
+                   elt = Fnth (make_number (2), elt);
+                 /* If it is (when ... Y), look at Y.  */
+                 else if (EQ (carelt, Qwhen))
+                   {
+                     while (CONSP (XCDR (elt)))
+                       elt = XCDR (elt);
+                     elt = Fcar (elt);
+                   }
+
+                 /* If the function call we're looking at
+                    is a special preserved one, copy the
+                    whole expression for this argument.  */
+                 if (CONSP (elt))
+                   {
+                     presflag = Fmemq (Fcar (elt), preserved_fns);
+                     if (!NILP (presflag))
+                       Fsetcar (valtail, Fcar (intail));
+                   }
+               }
+           }
+       }
+    }
+}
 
 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
        doc: /* Call FUNCTION, reading args according to its interactive calling specs.
 
 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
        doc: /* Call FUNCTION, reading args according to its interactive calling specs.
@@ -187,7 +257,8 @@ Optional second arg RECORD-FLAG non-nil
 means unconditionally put this command in the command-history.
 Otherwise, this is done only if an arg is read using the minibuffer.
 Optional third arg KEYS, if given, specifies the sequence of events to
 means unconditionally put this command in the command-history.
 Otherwise, this is done only if an arg is read using the minibuffer.
 Optional third arg KEYS, if given, specifies the sequence of events to
-supply if the command inquires which events were used to invoke it.  */)
+supply if the command inquires which events were used to invoke it.
+If KEYS is omitted or nil, the return value of `this-command-keys' is used.  */)
      (function, record_flag, keys)
      Lisp_Object function, record_flag, keys;
 {
      (function, record_flag, keys)
      Lisp_Object function, record_flag, keys;
 {
@@ -196,7 +267,9 @@ supply if the command inquires which events were used to invoke it.  */)
   Lisp_Object fun;
   Lisp_Object funcar;
   Lisp_Object specs;
   Lisp_Object fun;
   Lisp_Object funcar;
   Lisp_Object specs;
+  Lisp_Object filter_specs;
   Lisp_Object teml;
   Lisp_Object teml;
+  Lisp_Object up_event;
   Lisp_Object enable;
   int speccount = SPECPDL_INDEX ();
 
   Lisp_Object enable;
   int speccount = SPECPDL_INDEX ();
 
@@ -218,8 +291,17 @@ supply if the command inquires which events were used to invoke it.  */)
   char prompt1[100];
   char *tem1;
   int arg_from_tty = 0;
   char prompt1[100];
   char *tem1;
   int arg_from_tty = 0;
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
   int key_count;
   int key_count;
+  int record_then_fail = 0;
+
+  Lisp_Object save_this_command, save_last_command;
+  Lisp_Object save_this_original_command, save_real_this_command;
+
+  save_this_command = Vthis_command;
+  save_this_original_command = Vthis_original_command;
+  save_real_this_command = real_this_command;
+  save_last_command = current_kboard->Vlast_command;
 
   if (NILP (keys))
     keys = this_command_keys, key_count = this_command_key_count;
 
   if (NILP (keys))
     keys = this_command_keys, key_count = this_command_key_count;
@@ -243,6 +325,13 @@ supply if the command inquires which events were used to invoke it.  */)
 
   specs = Qnil;
   string = 0;
 
   specs = Qnil;
   string = 0;
+  /* The idea of FILTER_SPECS is to provide away to
+     specify how to represent the arguments in command history.
+     The feature is not fully implemented.  */
+  filter_specs = Qnil;
+
+  /* If k or K discard an up-event, save it here so it can be retrieved with U */
+  up_event = Qnil;
 
   /* Decode the kind of function.  Either handle it and return,
      or go to `lose' if not interactive, or go to `retry'
 
   /* Decode the kind of function.  Either handle it and return,
      or go to `lose' if not interactive, or go to `retry'
@@ -264,26 +353,19 @@ supply if the command inquires which events were used to invoke it.  */)
        goto lose;
       specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
     }
        goto lose;
       specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
     }
-  else if (!CONSP (fun))
-    goto lose;
-  else if (funcar = XCAR (fun), EQ (funcar, Qautoload))
+  else
     {
     {
+      Lisp_Object form;
       GCPRO2 (function, prefix_arg);
       GCPRO2 (function, prefix_arg);
-      do_autoload (fun, function);
+      form = Finteractive_form (function);
       UNGCPRO;
       UNGCPRO;
-      goto retry;
-    }
-  else if (EQ (funcar, Qlambda))
-    {
-      specs = Fassq (Qinteractive, Fcdr (XCDR (fun)));
-      if (NILP (specs))
+      if (CONSP (form))
+       specs = filter_specs = Fcar (XCDR (form));
+      else
        goto lose;
        goto lose;
-      specs = Fcar (Fcdr (specs));
     }
     }
-  else
-    goto lose;
 
 
-  /* If either specs or string is set to a string, use it.  */
+  /* If either SPECS or STRING is set to a string, use it.  */
   if (STRINGP (specs))
     {
       /* Make a copy of string so that if a GC relocates specs,
   if (STRINGP (specs))
     {
       /* Make a copy of string so that if a GC relocates specs,
@@ -298,51 +380,17 @@ supply if the command inquires which events were used to invoke it.  */)
       i = num_input_events;
       input = specs;
       /* Compute the arg values using the user's expression.  */
       i = num_input_events;
       input = specs;
       /* Compute the arg values using the user's expression.  */
+      GCPRO2 (input, filter_specs);
       specs = Feval (specs);
       specs = Feval (specs);
+      UNGCPRO;
       if (i != num_input_events || !NILP (record_flag))
        {
          /* We should record this command on the command history.  */
       if (i != num_input_events || !NILP (record_flag))
        {
          /* We should record this command on the command history.  */
-         Lisp_Object values, car;
+         Lisp_Object values;
          /* Make a copy of the list of values, for the command history,
             and turn them into things we can eval.  */
          values = quotify_args (Fcopy_sequence (specs));
          /* Make a copy of the list of values, for the command history,
             and turn them into things we can eval.  */
          values = quotify_args (Fcopy_sequence (specs));
-         /* If the list of args was produced with an explicit call to `list',
-            look for elements that were computed with (region-beginning)
-            or (region-end), and put those expressions into VALUES
-            instead of the present values.  */
-         if (CONSP (input))
-           {
-             car = XCAR (input);
-             /* Skip through certain special forms.  */
-             while (EQ (car, Qlet) || EQ (car, Qletx)
-                    || EQ (car, Qsave_excursion))
-               {
-                 while (CONSP (XCDR (input)))
-                   input = XCDR (input);
-                 input = XCAR (input);
-                 if (!CONSP (input))
-                   break;
-                 car = XCAR (input);
-               }
-             if (EQ (car, Qlist))
-               {
-                 Lisp_Object intail, valtail;
-                 for (intail = Fcdr (input), valtail = values;
-                      CONSP (valtail);
-                      intail = Fcdr (intail), valtail = Fcdr (valtail))
-                   {
-                     Lisp_Object elt;
-                     elt = Fcar (intail);
-                     if (CONSP (elt))
-                       {
-                         Lisp_Object presflag;
-                         presflag = Fmemq (Fcar (elt), preserved_fns);
-                         if (!NILP (presflag))
-                           Fsetcar (valtail, Fcar (intail));
-                       }
-                   }
-               }
-           }
+         fix_command (input, values);
          Vcommand_history
            = Fcons (Fcons (function, values), Vcommand_history);
 
          Vcommand_history
            = Fcons (Fcons (function, values), Vcommand_history);
 
@@ -354,6 +402,12 @@ supply if the command inquires which events were used to invoke it.  */)
                XSETCDR (teml, Qnil);
            }
        }
                XSETCDR (teml, Qnil);
            }
        }
+
+      Vthis_command = save_this_command;
+      Vthis_original_command = save_this_original_command;
+      real_this_command= save_real_this_command;
+      current_kboard->Vlast_command = save_last_command;
+
       single_kboard_state ();
       return apply1 (function, specs);
     }
       single_kboard_state ();
       return apply1 (function, specs);
     }
@@ -364,7 +418,7 @@ supply if the command inquires which events were used to invoke it.  */)
   for (next_event = 0; next_event < key_count; next_event++)
     if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
       break;
   for (next_event = 0; next_event < key_count; next_event++)
     if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
       break;
-  
+
   /* Handle special starting chars `*' and `@'.  Also `-'.  */
   /* Note that `+' is reserved for user extensions.  */
   while (1)
   /* Handle special starting chars `*' and `@'.  Also `-'.  */
   /* Note that `+' is reserved for user extensions.  */
   while (1)
@@ -375,7 +429,22 @@ supply if the command inquires which events were used to invoke it.  */)
        {
          string++;
          if (!NILP (current_buffer->read_only))
        {
          string++;
          if (!NILP (current_buffer->read_only))
-           Fbarf_if_buffer_read_only ();
+           {
+             if (!NILP (record_flag))
+               {
+                 unsigned char *p = string;
+                 while (*p)
+                   {
+                     if (! (*p == 'r' || *p == 'p' || *p == 'P'
+                            || *p == '\n'))
+                       Fbarf_if_buffer_read_only ();
+                     p++;
+                   }
+                 record_then_fail = 1;
+               }
+             else
+               Fbarf_if_buffer_read_only ();
+           }
        }
       /* Ignore this for semi-compatibility with Lucid.  */
       else if (*string == '-')
        }
       /* Ignore this for semi-compatibility with Lucid.  */
       else if (*string == '-')
@@ -384,7 +453,9 @@ supply if the command inquires which events were used to invoke it.  */)
        {
          Lisp_Object event;
 
        {
          Lisp_Object event;
 
-         event = XVECTOR (keys)->contents[next_event];
+         event = (next_event < key_count
+                  ? XVECTOR (keys)->contents[next_event]
+                  : Qnil);
          if (EVENT_HAS_PARAMETERS (event)
              && (event = XCDR (event), CONSP (event))
              && (event = XCAR (event), CONSP (event))
          if (EVENT_HAS_PARAMETERS (event)
              && (event = XCDR (event), CONSP (event))
              && (event = XCAR (event), CONSP (event))
@@ -398,7 +469,7 @@ supply if the command inquires which events were used to invoke it.  */)
              if (!NILP (Vmouse_leave_buffer_hook))
                call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
 
              if (!NILP (Vmouse_leave_buffer_hook))
                call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
 
-             Fselect_window (event);
+             Fselect_window (event, Qnil);
            }
          string++;
        }
            }
          string++;
        }
@@ -433,7 +504,7 @@ supply if the command inquires which events were used to invoke it.  */)
       varies[i] = 0;
     }
 
       varies[i] = 0;
     }
 
-  GCPRO4 (prefix_arg, function, *args, *visargs);
+  GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
   gcpro3.nvars = (count + 1);
   gcpro4.nvars = (count + 1);
 
   gcpro3.nvars = (count + 1);
   gcpro4.nvars = (count + 1);
 
@@ -547,7 +618,7 @@ supply if the command inquires which events were used to invoke it.  */)
                                          Qnil, Qnil, Qnil, Qnil);
            unbind_to (speccount1, Qnil);
            teml = args[i];
                                          Qnil, Qnil, Qnil, Qnil);
            unbind_to (speccount1, Qnil);
            teml = args[i];
-           visargs[i] = Fkey_description (teml);
+           visargs[i] = Fkey_description (teml, Qnil);
 
            /* If the key sequence ends with a down-event,
               discard the following up-event.  */
 
            /* If the key sequence ends with a down-event,
               discard the following up-event.  */
@@ -562,7 +633,7 @@ supply if the command inquires which events were used to invoke it.  */)
                /* Ignore first element, which is the base key.  */
                tem2 = Fmemq (intern ("down"), Fcdr (teml));
                if (! NILP (tem2))
                /* Ignore first element, which is the base key.  */
                tem2 = Fmemq (intern ("down"), Fcdr (teml));
                if (! NILP (tem2))
-                 Fread_event (Qnil, Qnil);
+                 up_event = Fread_event (Qnil, Qnil);
              }
          }
          break;
              }
          }
          break;
@@ -574,7 +645,7 @@ supply if the command inquires which events were used to invoke it.  */)
            args[i] = Fread_key_sequence (build_string (callint_message),
                                          Qnil, Qt, Qnil, Qnil);
            teml = args[i];
            args[i] = Fread_key_sequence (build_string (callint_message),
                                          Qnil, Qt, Qnil, Qnil);
            teml = args[i];
-           visargs[i] = Fkey_description (teml);
+           visargs[i] = Fkey_description (teml, Qnil);
            unbind_to (speccount1, Qnil);
 
            /* If the key sequence ends with a down-event,
            unbind_to (speccount1, Qnil);
 
            /* If the key sequence ends with a down-event,
@@ -590,11 +661,21 @@ supply if the command inquires which events were used to invoke it.  */)
                /* Ignore first element, which is the base key.  */
                tem2 = Fmemq (intern ("down"), Fcdr (teml));
                if (! NILP (tem2))
                /* Ignore first element, which is the base key.  */
                tem2 = Fmemq (intern ("down"), Fcdr (teml));
                if (! NILP (tem2))
-                 Fread_event (Qnil, Qnil);
+                 up_event = Fread_event (Qnil, Qnil);
              }
          }
          break;
 
              }
          }
          break;
 
+       case 'U':               /* Up event from last k or K */
+         if (!NILP (up_event))
+           {
+             args[i] = Fmake_vector (make_number (1), up_event);
+             up_event = Qnil;
+             teml = args[i];
+             visargs[i] = Fkey_description (teml, Qnil);
+           }
+         break;
+
        case 'e':               /* The invoking event.  */
          if (next_event >= key_count)
            error ("%s must be bound to an event with parameters",
        case 'e':               /* The invoking event.  */
          if (next_event >= key_count)
            error ("%s must be bound to an event with parameters",
@@ -716,7 +797,7 @@ supply if the command inquires which events were used to invoke it.  */)
              args[i] = Qnil;
              varies[i] = -1;
            }
              args[i] = Qnil;
              varies[i] = -1;
            }
-         else 
+         else
            {
              args[i]
                = Fread_non_nil_coding_system (build_string (callint_message));
            {
              args[i]
                = Fread_non_nil_coding_system (build_string (callint_message));
@@ -780,6 +861,14 @@ supply if the command inquires which events were used to invoke it.  */)
     if (varies[i] >= 1 && varies[i] <= 4)
       XSETINT (args[i], marker_position (args[i]));
 
     if (varies[i] >= 1 && varies[i] <= 4)
       XSETINT (args[i], marker_position (args[i]));
 
+  if (record_then_fail)
+    Fbarf_if_buffer_read_only ();
+
+  Vthis_command = save_this_command;
+  Vthis_original_command = save_this_original_command;
+  real_this_command= save_real_this_command;
+  current_kboard->Vlast_command = save_last_command;
+
   single_kboard_state ();
 
   {
   single_kboard_state ();
 
   {
@@ -790,7 +879,7 @@ supply if the command inquires which events were used to invoke it.  */)
     UNGCPRO;
     return unbind_to (speccount, val);
   }
     UNGCPRO;
     return unbind_to (speccount, val);
   }
-}  
+}
 
 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
        1, 1, 0,
 
 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
        1, 1, 0,
@@ -801,7 +890,7 @@ Its numeric meaning is what you would get from `(interactive "p")'.  */)
      Lisp_Object raw;
 {
   Lisp_Object val;
      Lisp_Object raw;
 {
   Lisp_Object val;
-  
+
   if (NILP (raw))
     XSETFASTINT (val, 1);
   else if (EQ (raw, Qminus))
   if (NILP (raw))
     XSETFASTINT (val, 1);
   else if (EQ (raw, Qminus))
@@ -832,10 +921,16 @@ syms_of_callint ()
   staticpro (&Qlist);
   Qlet = intern ("let");
   staticpro (&Qlet);
   staticpro (&Qlist);
   Qlet = intern ("let");
   staticpro (&Qlet);
+  Qif = intern ("if");
+  staticpro (&Qif);
+  Qwhen = intern ("when");
+  staticpro (&Qwhen);
   Qletx = intern ("let*");
   staticpro (&Qletx);
   Qsave_excursion = intern ("save-excursion");
   staticpro (&Qsave_excursion);
   Qletx = intern ("let*");
   staticpro (&Qletx);
   Qsave_excursion = intern ("save-excursion");
   staticpro (&Qsave_excursion);
+  Qprogn = intern ("progn");
+  staticpro (&Qprogn);
 
   Qminus = intern ("-");
   staticpro (&Qminus);
 
   Qminus = intern ("-");
   staticpro (&Qminus);
@@ -911,3 +1006,6 @@ a way to turn themselves off when a mouse command switches windows.  */);
   defsubr (&Scall_interactively);
   defsubr (&Sprefix_numeric_value);
 }
   defsubr (&Scall_interactively);
   defsubr (&Sprefix_numeric_value);
 }
+
+/* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
+   (do not change this comment) */