use dynwind_begin and dynwind_end
[bpt/emacs.git] / src / callint.c
index 35411bf..a036f44 100644 (file)
@@ -29,7 +29,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "keymap.h"
 
 Lisp_Object Qminus, Qplus;
-static Lisp_Object Qcall_interactively;
+static Lisp_Object Qfuncall_interactively;
 static Lisp_Object Qcommand_debug_status;
 static Lisp_Object Qenable_recursive_minibuffers;
 
@@ -38,8 +38,8 @@ static Lisp_Object Qread_number;
 
 Lisp_Object Qmouse_leave_buffer_hook;
 
-static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif;
-Lisp_Object Qwhen;
+static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qif;
+Lisp_Object Qwhen, Qprogn;
 static Lisp_Object preserved_fns;
 
 /* Marker used within call-interactively to refer to point.  */
@@ -233,6 +233,43 @@ fix_command (Lisp_Object input, Lisp_Object values)
     }
 }
 
+/* Helper function to call `read-file-name' from C.  */
+
+static Lisp_Object
+read_file_name (Lisp_Object default_filename, Lisp_Object mustmatch,
+               Lisp_Object initial, Lisp_Object predicate)
+{
+  struct gcpro gcpro1;
+  Lisp_Object args[7];
+
+  GCPRO1 (default_filename);
+  args[0] = intern ("read-file-name");
+  args[1] = callint_message;
+  args[2] = Qnil;
+  args[3] = default_filename;
+  args[4] = mustmatch;
+  args[5] = initial;
+  args[6] = predicate;
+  RETURN_UNGCPRO (Ffuncall (7, args));
+}
+
+/* BEWARE: Calling this directly from C would defeat the purpose!  */
+DEFUN ("funcall-interactively", Ffuncall_interactively, Sfuncall_interactively,
+       1, MANY, 0, doc: /* Like `funcall' but marks the call as interactive.
+I.e. arrange that within the called function `called-interactively-p' will
+return non-nil.
+usage: (funcall-interactively FUNCTION &rest ARGUMENTS)  */)
+     (ptrdiff_t nargs, Lisp_Object *args)
+{
+  ptrdiff_t speccount = SPECPDL_INDEX ();
+  temporarily_switch_to_single_kboard (NULL);
+
+  /* Nothing special to do here, all the work is inside
+     `called-interactively-p'.  Which will look for us as a marker in the
+     backtrace.  */
+  return unbind_to (speccount, Ffuncall (nargs, args));
+}
+
 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
        doc: /* Call FUNCTION, providing args according to its interactive calling specs.
 Return the value FUNCTION returns.
@@ -260,7 +297,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
   Lisp_Object teml;
   Lisp_Object up_event;
   Lisp_Object enable;
-  ptrdiff_t speccount = SPECPDL_INDEX ();
+  dynwind_begin ();
 
   /* The index of the next element of this_command_keys to examine for
      the 'e' interactive code.  */
@@ -374,8 +411,15 @@ invoke it.  If KEYS is omitted or nil, the return value of
       Vreal_this_command = save_real_this_command;
       kset_last_command (current_kboard, save_last_command);
 
-      temporarily_switch_to_single_kboard (NULL);
-      return unbind_to (speccount, apply1 (function, specs));
+      {
+       Lisp_Object tem0, args[3];
+       args[0] = Qfuncall_interactively;
+       args[1] = function;
+       args[2] = specs;
+       tem0 = Fapply (3, args);
+        dynwind_end ();
+        return tem0;
+      }
     }
 
   /* Here if function specifies a string to control parsing the defaults.  */
@@ -446,10 +490,11 @@ invoke it.  If KEYS is omitted or nil, the return value of
       else break;
     }
 
-  /* Count the number of arguments, which is one plus the number of arguments
-     the interactive spec would have us give to the function.  */
+  /* Count the number of arguments, which is two (the function itself and
+     `funcall-interactively') plus the number of arguments the interactive spec
+     would have us give to the function.  */
   tem = string;
-  for (nargs = 1; *tem; )
+  for (nargs = 2; *tem; )
     {
       /* 'r' specifications ("point and mark as 2 numeric args")
         produce *two* arguments.  */
@@ -488,13 +533,13 @@ invoke it.  If KEYS is omitted or nil, the return value of
     specbind (Qenable_recursive_minibuffers, Qt);
 
   tem = string;
-  for (i = 1; *tem; i++)
+  for (i = 2; *tem; i++)
     {
-      visargs[0] = make_string (tem + 1, strcspn (tem + 1, "\n"));
-      if (strchr (SSDATA (visargs[0]), '%'))
-       callint_message = Fformat (i, visargs);
+      visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n"));
+      if (strchr (SSDATA (visargs[1]), '%'))
+       callint_message = Fformat (i - 1, visargs + 1);
       else
-       callint_message = visargs[0];
+       callint_message = visargs[1];
 
       switch (*tem)
        {
@@ -551,25 +596,21 @@ invoke it.  If KEYS is omitted or nil, the return value of
          break;
 
        case 'D':               /* Directory name.  */
-         args[i] = Fread_file_name (callint_message, Qnil,
-                                    BVAR (current_buffer, directory), Qlambda, Qnil,
-                                    Qfile_directory_p);
+         args[i] = read_file_name (BVAR (current_buffer, directory), Qlambda, Qnil,
+                                   Qfile_directory_p);
          break;
 
        case 'f':               /* Existing file name.  */
-         args[i] = Fread_file_name (callint_message,
-                                    Qnil, Qnil, Qlambda, Qnil, Qnil);
+         args[i] = read_file_name (Qnil, Qlambda, Qnil, Qnil);
          break;
 
        case 'F':               /* Possibly nonexistent file name.  */
-         args[i] = Fread_file_name (callint_message,
-                                    Qnil, Qnil, Qnil, Qnil, Qnil);
+         args[i] = read_file_name (Qnil, Qnil, Qnil, Qnil);
          break;
 
        case 'G':               /* Possibly nonexistent file name,
                                   default to directory alone.  */
-         args[i] = Fread_file_name (callint_message,
-                                    Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
+         args[i] = read_file_name (Qnil, Qnil, empty_unibyte_string, Qnil);
          break;
 
        case 'i':               /* Ignore an argument -- Does not do I/O.  */
@@ -578,7 +619,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
 
        case 'k':               /* Key sequence.  */
          {
-           ptrdiff_t speccount1 = SPECPDL_INDEX ();
+           dynwind_begin ();
            specbind (Qcursor_in_echo_area, Qt);
            /* Prompt in `minibuffer-prompt' face.  */
            Fput_text_property (make_number (0),
@@ -586,7 +627,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
                                Qface, Qminibuffer_prompt, callint_message);
            args[i] = Fread_key_sequence (callint_message,
                                          Qnil, Qnil, Qnil, Qnil);
-           unbind_to (speccount1, Qnil);
+           dynwind_end ();
            teml = args[i];
            visargs[i] = Fkey_description (teml, Qnil);
 
@@ -610,7 +651,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
 
        case 'K':               /* Key sequence to be defined.  */
          {
-           ptrdiff_t speccount1 = SPECPDL_INDEX ();
+           dynwind_begin ();
            specbind (Qcursor_in_echo_area, Qt);
            /* Prompt in `minibuffer-prompt' face.  */
            Fput_text_property (make_number (0),
@@ -620,7 +661,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
                                                 Qnil, Qt, Qnil, Qnil);
            teml = args[i];
            visargs[i] = Fkey_description (teml, Qnil);
-           unbind_to (speccount1, Qnil);
+           dynwind_end ();
 
            /* If the key sequence ends with a down-event,
               discard the following up-event.  */
@@ -785,25 +826,26 @@ invoke it.  If KEYS is omitted or nil, the return value of
       if (tem) tem++;
       else tem = "";
     }
-  unbind_to (speccount, Qnil);
+  dynwind_end ();
 
   QUIT;
 
-  args[0] = function;
+  args[0] = Qfuncall_interactively;
+  args[1] = function;
 
   if (arg_from_tty || !NILP (record_flag))
     {
       /* We don't need `visargs' any more, so let's recycle it since we need
         an array of just the same size.  */
-      visargs[0] = function;
-      for (i = 1; i < nargs; i++)
+      visargs[1] = function;
+      for (i = 2; i < nargs; i++)
        {
          if (varies[i] > 0)
            visargs[i] = list1 (intern (callint_argfuns[varies[i]]));
          else
            visargs[i] = quotify_arg (args[i]);
        }
-      Vcommand_history = Fcons (Flist (nargs, visargs),
+      Vcommand_history = Fcons (Flist (nargs - 1, visargs + 1),
                                Vcommand_history);
       /* Don't keep command history around forever.  */
       if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
@@ -816,7 +858,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
 
   /* If we used a marker to hold point, mark, or an end of the region,
      temporarily, convert it to an integer now.  */
-  for (i = 1; i < nargs; i++)
+  for (i = 2; i < nargs; i++)
     if (varies[i] >= 1 && varies[i] <= 4)
       XSETINT (args[i], marker_position (args[i]));
 
@@ -829,13 +871,10 @@ invoke it.  If KEYS is omitted or nil, the return value of
   kset_last_command (current_kboard, save_last_command);
 
   {
-    Lisp_Object val;
-    specbind (Qcommand_debug_status, Qnil);
-
-    temporarily_switch_to_single_kboard (NULL);
-    val = Ffuncall (nargs, args);
+    Lisp_Object val = Ffuncall (nargs, args);
     UNGCPRO;
-    return unbind_to (speccount, val);
+    dynwind_end ();
+    return val;
   }
 }
 
@@ -865,6 +904,8 @@ Its numeric meaning is what you would get from `(interactive "p")'.  */)
 void
 syms_of_callint (void)
 {
+#include "callint.x"
+
   point_marker = Fmake_marker ();
   staticpro (&point_marker);
 
@@ -888,7 +929,7 @@ syms_of_callint (void)
   DEFSYM (Qplus, "+");
   DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
   DEFSYM (Qread_number, "read-number");
-  DEFSYM (Qcall_interactively, "call-interactively");
+  DEFSYM (Qfuncall_interactively, "funcall-interactively");
   DEFSYM (Qcommand_debug_status, "command-debug-status");
   DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
   DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
@@ -943,8 +984,4 @@ behave as if the mark were still active.  */);
 Its purpose is to give temporary modes such as Isearch mode
 a way to turn themselves off when a mouse command switches windows.  */);
   Vmouse_leave_buffer_hook = Qnil;
-
-  defsubr (&Sinteractive);
-  defsubr (&Scall_interactively);
-  defsubr (&Sprefix_numeric_value);
 }