/* 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.
#include "window.h"
#include "keymap.h"
-Lisp_Object Qminus, Qplus;
-static Lisp_Object Qfuncall_interactively;
-static Lisp_Object Qcommand_debug_status;
-static Lisp_Object Qenable_recursive_minibuffers;
-
-static Lisp_Object Qhandle_shift_selection;
-static Lisp_Object Qread_number;
-
-Lisp_Object Qmouse_leave_buffer_hook;
-
-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. */
Emacs first calls the function `handle-shift-selection'.
You may use `@', `*', and `^' together. They are processed in the
order that they appear, before reading any arguments.
-usage: (interactive &optional ARGS) */)
+usage: (interactive &optional ARGS) */
+ attributes: const)
(Lisp_Object args)
{
return Qnil;
}
}
+/* 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. */)
+return non-nil.
+usage: (funcall-interactively FUNCTION &rest ARGUMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t speccount = SPECPDL_INDEX ();
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
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);
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. */
{
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. */
error ("Attempt to select inactive minibuffer window");
/* If the current buffer wants to clean up, let it. */
- Frun_hooks (1, &Qmouse_leave_buffer_hook);
+ run_hook (Qmouse_leave_buffer_hook);
Fselect_window (w, Qnil);
}
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++)
- {
- args[i] = Qnil;
- visargs[i] = Qnil;
- varies[i] = 0;
- }
+ memset (args, 0, nargs * (2 * word_size + 1));
+ if (NIL_IS_NONZERO)
+ memsetnil (args, nargs * 2);
GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
gcpro3.nvars = nargs;
{
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];
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. */
argument if no prefix. */
if (NILP (prefix_arg))
{
- args[i] = Qnil;
+ /* args[i] = Qnil; */
varies[i] = -1;
}
else
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;
{
Lisp_Object val = Ffuncall (nargs, args);
UNGCPRO;
- return unbind_to (speccount, val);
+ val = unbind_to (speccount, val);
+ SAFE_FREE ();
+ return val;
}
}