/* Call a Lisp function interactively.
- Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2013 Free Software
+ Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2014 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
#include "keymap.h"
Lisp_Object Qminus, Qplus;
-Lisp_Object Qcall_interactively;
+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, 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. */
if (CONSP (exp)
|| (SYMBOLP (exp)
&& !NILP (exp) && !EQ (exp, Qt)))
- return Fcons (Qquote, Fcons (exp, Qnil));
+ return list2 (Qquote, exp);
return exp;
}
}
}
+/* 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.
`this-command-keys-vector' is used. */)
(Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
{
+ /* `args' will contain the array of arguments to pass to the function.
+ `visargs' will contain the same list but in a nicer form, so that if we
+ pass it to `Fformat' it will be understandable to a human. */
Lisp_Object *args, *visargs;
Lisp_Object specs;
Lisp_Object filter_specs;
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. */
specs = Qnil;
string = 0;
- /* The idea of FILTER_SPECS is to provide away to
+ /* The idea of FILTER_SPECS is to provide a way to
specify how to represent the arguments in command history.
The feature is not fully implemented. */
filter_specs = Qnil;
/* 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 = alloca (SBYTES (specs) + 1);
- memcpy (string, SSDATA (specs), SBYTES (specs) + 1);
- }
+ /* Make a copy of string so that if a GC relocates specs,
+ `string' will still be valid. */
+ string = xlispstrdupa (specs);
else
{
Lisp_Object input;
/* Compute the arg values using the user's expression. */
GCPRO2 (input, filter_specs);
specs = Feval (specs,
- CONSP (funval) && EQ (Qclosure, XCAR (funval))
- ? Qt : Qnil);
+ CONSP (funval) && EQ (Qclosure, XCAR (funval))
+ ? CAR_SAFE (XCDR (funval)) : Qnil);
UNGCPRO;
if (events != num_input_events || !NILP (record_flag))
{
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. */
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. */
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)
{
make_number (SCHARS (callint_message)),
Qface, Qminibuffer_prompt, callint_message);
args[i] = Fread_char (callint_message, Qnil, Qnil);
- message1_nolog ((char *) 0);
+ message1_nolog (0);
/* Passing args[i] directly stimulates compiler bug. */
teml = args[i];
/* See bug#8479. */
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. */
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),
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);
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),
make_number (SCHARS (callint_message)),
Qface, Qminibuffer_prompt, callint_message);
- args[i] = Fread_key_sequence (callint_message,
- Qnil, Qt, Qnil, Qnil);
+ args[i] = Fread_key_sequence_vector (callint_message,
+ 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. */
if (!NILP (prefix_arg))
goto have_prefix_arg;
case 'n': /* Read number from minibuffer. */
- {
- bool first = 1;
- do
- {
- Lisp_Object str;
- if (! first)
- {
- message ("Please enter a number.");
- sit_for (make_number (1), 0, 0);
- }
- first = 0;
-
- str = Fread_from_minibuffer (callint_message,
- Qnil, Qnil, Qnil, Qnil, Qnil,
- Qnil);
- if (! STRINGP (str) || SCHARS (str) == 0)
- args[i] = Qnil;
- else
- args[i] = Fread (str);
- }
- while (! NUMBERP (args[i]));
- }
- visargs[i] = args[i];
+ args[i] = call1 (Qread_number, callint_message);
+ /* Passing args[i] directly stimulates compiler bug. */
+ teml = args[i];
+ visargs[i] = Fnumber_to_string (teml);
break;
case 'P': /* Prefix arg in raw form. Does no I/O. */
break;
case 'x': /* Lisp expression read but not evaluated. */
- args[i] = Fread_minibuffer (callint_message, Qnil);
+ args[i] = call1 (intern ("read-minibuffer"), callint_message);
visargs[i] = last_minibuf_string;
break;
case 'X': /* Lisp expression read and evaluated. */
- args[i] = Feval_minibuffer (callint_message, Qnil);
+ args[i] = call1 (intern ("eval-minibuffer"), callint_message);
visargs[i] = last_minibuf_string;
break;
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))
{
- visargs[0] = function;
- for (i = 1; i < nargs; i++)
+ /* We don't need `visargs' any more, so let's recycle it since we need
+ an array of just the same size. */
+ visargs[1] = function;
+ for (i = 2; i < nargs; i++)
{
if (varies[i] > 0)
- visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
+ 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)
/* 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]));
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;
}
}
void
syms_of_callint (void)
{
+#include "callint.x"
+
point_marker = Fmake_marker ();
staticpro (&point_marker);
DEFSYM (Qminus, "-");
DEFSYM (Qplus, "+");
DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
- DEFSYM (Qcall_interactively, "call-interactively");
+ DEFSYM (Qread_number, "read-number");
+ 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");
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);
}
HCoop / bpt / emacs.git / blobdiff