]> code.delx.au - gnu-emacs/blobdiff - src/callint.c
Update copyright year to 2015
[gnu-emacs] / src / callint.c
index 9e40cc01a6298564da59171d13d89e74f0494f75..200c9ed9d7d534b491624d669063e46f850c3dc3 100644 (file)
@@ -1,5 +1,5 @@
 /* Call a Lisp function interactively.
-   Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2014 Free Software
+   Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2015 Free Software
    Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -233,6 +233,26 @@ 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.
@@ -277,6 +297,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
   Lisp_Object teml;
   Lisp_Object up_event;
   Lisp_Object enable;
+  USE_SAFE_ALLOCA;
   ptrdiff_t speccount = SPECPDL_INDEX ();
 
   /* The index of the next element of this_command_keys to examine for
@@ -346,12 +367,8 @@ invoke it.  If KEYS is omitted or nil, the return value of
       wrong_type_argument (Qcommandp, function);
   }
 
-  /* If SPECS is set to a string, use it as an interactive prompt.  */
-  if (STRINGP (specs))
-    /* Make a copy of string so that if a GC relocates specs,
-       `string' will still be valid.  */
-    string = xlispstrdupa (specs);
-  else
+  /* If SPECS is not a string, invent one.  */
+  if (! STRINGP (specs))
     {
       Lisp_Object input;
       Lisp_Object funval = Findirect_function (function, Qt);
@@ -396,10 +413,16 @@ invoke it.  If KEYS is omitted or nil, the return value of
        args[0] = Qfuncall_interactively;
        args[1] = function;
        args[2] = specs;
-       return unbind_to (speccount, Fapply (3, args));
+       Lisp_Object result = unbind_to (speccount, Fapply (3, args));
+       SAFE_FREE ();
+       return result;
       }
     }
 
+  /* SPECS is set to a string; use it as an interactive prompt.
+     Copy it so that STRING will be valid even if a GC relocates SPECS.  */
+  SAFE_ALLOCA_STRING (string, specs);
+
   /* Here if function specifies a string to control parsing the defaults.  */
 
   /* Set next_event to point to the first event with parameters.  */
@@ -425,13 +448,13 @@ invoke it.  If KEYS is omitted or nil, the return value of
                    {
                      if (! (*p == 'r' || *p == 'p' || *p == 'P'
                             || *p == '\n'))
-                       Fbarf_if_buffer_read_only ();
+                       Fbarf_if_buffer_read_only (Qnil);
                      p++;
                    }
                  record_then_fail = 1;
                }
              else
-               Fbarf_if_buffer_read_only ();
+               Fbarf_if_buffer_read_only (Qnil);
            }
        }
       /* Ignore this for semi-compatibility with Lucid.  */
@@ -487,14 +510,15 @@ invoke it.  If KEYS is omitted or nil, the return value of
        break;
     }
 
-  if (min (MOST_POSITIVE_FIXNUM,
-          min (PTRDIFF_MAX, SIZE_MAX) / word_size)
-      < nargs)
+  if (MOST_POSITIVE_FIXNUM < min (PTRDIFF_MAX, SIZE_MAX) / word_size
+      && MOST_POSITIVE_FIXNUM < nargs)
     memory_full (SIZE_MAX);
 
-  args = alloca (nargs * sizeof *args);
-  visargs = alloca (nargs * sizeof *visargs);
-  varies = alloca (nargs * sizeof *varies);
+  /* Allocate them all at one go.  This wastes a bit of memory, but
+     it's OK to trade space for speed.  */
+  SAFE_NALLOCA (args, 3, nargs);
+  visargs = args + nargs;
+  varies = (signed char *) (visargs + nargs);
 
   for (i = 0; i < nargs; i++)
     {
@@ -515,7 +539,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
     {
       visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n"));
       if (strchr (SSDATA (visargs[1]), '%'))
-       callint_message = Fformat (i, visargs);
+       callint_message = Fformat (i - 1, visargs + 1);
       else
        callint_message = visargs[1];
 
@@ -574,25 +598,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.  */
@@ -845,7 +865,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
       XSETINT (args[i], marker_position (args[i]));
 
   if (record_then_fail)
-    Fbarf_if_buffer_read_only ();
+    Fbarf_if_buffer_read_only (Qnil);
 
   Vthis_command = save_this_command;
   Vthis_original_command = save_this_original_command;
@@ -855,7 +875,9 @@ invoke it.  If KEYS is omitted or nil, the return value of
   {
     Lisp_Object val = Ffuncall (nargs, args);
     UNGCPRO;
-    return unbind_to (speccount, val);
+    val = unbind_to (speccount, val);
+    SAFE_FREE ();
+    return val;
   }
 }