]> code.delx.au - gnu-emacs/blobdiff - src/callint.c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
[gnu-emacs] / src / callint.c
index 5368ba84cf7fa586eba2d4de4830cff361c03e23..c0699b44fb8463076a270d27f619b8c5f8298656 100644 (file)
@@ -41,7 +41,7 @@ Lisp_Object Vmark_even_if_inactive;
 
 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
 
-Lisp_Object Qlist;
+Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion;
 static Lisp_Object preserved_fns;
 
 /* Marker used within call-interactively to refer to point.  */
@@ -164,7 +164,7 @@ check_mark ()
 }
 
 
-DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 2, 0,
+DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
   "Call FUNCTION, reading args according to its interactive calling specs.\n\
 Return the value FUNCTION returns.\n\
 The function contains a specification of how to do the argument reading.\n\
@@ -175,8 +175,8 @@ See `interactive'.\n\
 Optional second arg RECORD-FLAG non-nil\n\
 means unconditionally put this command in the command-history.\n\
 Otherwise, this is done only if an arg is read using the minibuffer.")
-  (function, record)
-     Lisp_Object function, record;
+  (function, record_flag, keys)
+     Lisp_Object function, record_flag, keys;
 {
   Lisp_Object *args, *visargs;
   unsigned char **argstrings;
@@ -206,6 +206,15 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
   char *tem1;
   int arg_from_tty = 0;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+  int key_count;
+
+  if (NILP (keys))
+    keys = this_command_keys, key_count = this_command_key_count;
+  else
+    {
+      CHECK_VECTOR (keys, 3);
+      key_count = XVECTOR (keys)->size;
+    }
 
   /* Save this now, since use of minibuffer will clobber it. */
   prefix_arg = Vcurrent_prefix_arg;
@@ -282,7 +291,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
       input = specs;
       /* Compute the arg values using the user's expression.  */
       specs = Feval (specs);
-      if (i != num_input_chars || !NILP (record))
+      if (i != num_input_chars || !NILP (record_flag))
        {
          /* We should record this command on the command history.  */
          Lisp_Object values, car;
@@ -293,22 +302,36 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
             look for elements that were computed with (region-beginning)
             or (region-end), and put those expressions into VALUES
             instead of the present values.  */
-         car = Fcar (input);
-         if (EQ (car, Qlist))
+         if (CONSP (input))
            {
-             Lisp_Object intail, valtail;
-             for (intail = Fcdr (input), valtail = values;
-                  CONSP (valtail);
-                  intail = Fcdr (intail), valtail = Fcdr (valtail))
+             car = XCONS (input)->car;
+             /* Skip through certain special forms.  */
+             while (EQ (car, Qlet) || EQ (car, Qletx)
+                    || EQ (car, Qsave_excursion))
                {
-                 Lisp_Object elt;
-                 elt = Fcar (intail);
-                 if (CONSP (elt))
+                 while (CONSP (XCONS (input)->cdr))
+                   input = XCONS (input)->cdr;
+                 input = XCONS (input)->car;
+                 if (!CONSP (input))
+                   break;
+                 car = XCONS (input)->car;
+               }
+             if (EQ (car, Qlist))
+               {
+                 Lisp_Object intail, valtail;
+                 for (intail = Fcdr (input), valtail = values;
+                      CONSP (valtail);
+                      intail = Fcdr (intail), valtail = Fcdr (valtail))
                    {
-                     Lisp_Object presflag;
-                     presflag = Fmemq (Fcar (elt), preserved_fns);
-                     if (!NILP (presflag))
-                       Fsetcar (valtail, Fcar (intail));
+                     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));
+                       }
                    }
                }
            }
@@ -322,9 +345,8 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
   /* Here if function specifies a string to control parsing the defaults */
 
   /* Set next_event to point to the first event with parameters.  */
-  for (next_event = 0; next_event < this_command_key_count; next_event++)
-    if (EVENT_HAS_PARAMETERS
-       (XVECTOR (this_command_keys)->contents[next_event]))
+  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 `-'.  */
@@ -346,7 +368,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
        {
          Lisp_Object event;
 
-         event = XVECTOR (this_command_keys)->contents[next_event];
+         event = XVECTOR (keys)->contents[next_event];
          if (EVENT_HAS_PARAMETERS (event)
              && (event = XCONS (event)->cdr, CONSP (event))
              && (event = XCONS (event)->car, CONSP (event))
@@ -457,8 +479,9 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
          break;
 
         case 'c':              /* Character */
-         message1 (callint_message);
+         message1_nolog (callint_message);
          args[i] = Fread_char ();
+         message1_nolog ((char *) 0);
          /* Passing args[i] directly stimulates compiler bug */
          teml = args[i];
          visargs[i] = Fchar_to_string (teml);
@@ -509,18 +532,18 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
          break;
 
        case 'e':               /* The invoking event.  */
-         if (next_event >= this_command_key_count)
+         if (next_event >= key_count)
            error ("%s must be bound to an event with parameters",
                   (SYMBOLP (function)
                    ? (char *) XSYMBOL (function)->name->data
                    : "command"));
-         args[i] = XVECTOR (this_command_keys)->contents[next_event++];
+         args[i] = XVECTOR (keys)->contents[next_event++];
          varies[i] = -1;
 
          /* Find the next parameterized event.  */
-         while (next_event < this_command_key_count
+         while (next_event < key_count
                 && ! (EVENT_HAS_PARAMETERS
-                      (XVECTOR (this_command_keys)->contents[next_event])))
+                      (XVECTOR (keys)->contents[next_event])))
            next_event++;
 
          break;
@@ -543,13 +566,13 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
          break;
 
        case 'P':               /* Prefix arg in raw form.  Does no I/O.  */
-       have_prefix_arg:
          args[i] = prefix_arg;
          /* visargs[i] = Qnil; */
          varies[i] = -1;
          break;
 
        case 'p':               /* Prefix arg converted to number.  No I/O. */
+       have_prefix_arg:
          args[i] = Fprefix_numeric_value (prefix_arg);
          /* visargs[i] = Qnil; */
          varies[i] = -1;
@@ -619,7 +642,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
 
   args[0] = function;
 
-  if (arg_from_tty || !NILP (record))
+  if (arg_from_tty || !NILP (record_flag))
     {
       visargs[0] = function;
       for (i = 1; i < count + 1; i++)
@@ -653,7 +676,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
 
 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
   1, 1, 0,
-  "Return numeric meaning of raw prefix argument ARG.\n\
+  "Return numeric meaning of raw prefix argument RAW.\n\
 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
 Its numeric meaning is what you would get from `(interactive \"p\")'.")
   (raw)
@@ -688,6 +711,12 @@ syms_of_callint ()
 
   Qlist = intern ("list");
   staticpro (&Qlist);
+  Qlet = intern ("let");
+  staticpro (&Qlet);
+  Qletx = intern ("let*");
+  staticpro (&Qletx);
+  Qsave_excursion = intern ("save-excursion");
+  staticpro (&Qsave_excursion);
 
   Qminus = intern ("-");
   staticpro (&Qminus);