* src/callint.c (Ffuncall_interactively): New function.
(Qfuncall_interactively): New var. (Qcall_interactively): Remove. (Fcall_interactively): Use it. (syms_of_callint): Defsubr it. * lisp/subr.el (internal--funcall-interactively): New. (internal--call-interactively): Remove. (called-interactively-p): Detect funcall-interactively instead of call-interactively. * lisp/simple.el (repeat-complex-command): Use funcall-interactively. (repeat-complex-command--called-interactively-skip): Remove.
This commit is contained in:
Stefan Monnier
parent
9da43ddc9d
commit
0e4857b7d8
5 changed files with 67 additions and 40 deletions
4
etc/NEWS
4
etc/NEWS
|
|
@ -123,6 +123,10 @@ active region handling.
|
|||
|
||||
* Lisp Changes in Emacs 24.5
|
||||
|
||||
** New function `funcall-interactively', which works like `funcall'
|
||||
but makes `called-interactively-p' treat the function as (you guessed it)
|
||||
called interactively.
|
||||
|
||||
** New function `function-put' to use instead of `put' for function properties.
|
||||
|
||||
+++
|
||||
|
|
|
|||
|
|
@ -1,3 +1,13 @@
|
|||
2014-05-28 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* subr.el (internal--funcall-interactively): New.
|
||||
(internal--call-interactively): Remove.
|
||||
(called-interactively-p): Detect funcall-interactively instead of
|
||||
call-interactively.
|
||||
|
||||
* simple.el (repeat-complex-command): Use funcall-interactively.
|
||||
(repeat-complex-command--called-interactively-skip): Remove.
|
||||
|
||||
2014-05-27 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* register.el (register-read-with-preview): Don't burp on
|
||||
|
|
|
|||
|
|
@ -1503,24 +1503,13 @@ to get different commands to edit and resubmit."
|
|||
;; add it to the history.
|
||||
(or (equal newcmd (car command-history))
|
||||
(setq command-history (cons newcmd command-history)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
;; Trick called-interactively-p into thinking that `newcmd' is
|
||||
;; an interactive call (bug#14136).
|
||||
(add-hook 'called-interactively-p-functions
|
||||
#'repeat-complex-command--called-interactively-skip)
|
||||
(eval newcmd))
|
||||
(remove-hook 'called-interactively-p-functions
|
||||
#'repeat-complex-command--called-interactively-skip)))
|
||||
(apply #'funcall-interactively
|
||||
(car newcmd)
|
||||
(mapcar (lambda (e) (eval e t)) (cdr newcmd))))
|
||||
(if command-history
|
||||
(error "Argument %d is beyond length of command history" arg)
|
||||
(error "There are no previous complex commands to repeat")))))
|
||||
|
||||
(defun repeat-complex-command--called-interactively-skip (i _frame1 frame2)
|
||||
(and (eq 'eval (cadr frame2))
|
||||
(eq 'repeat-complex-command
|
||||
(cadr (backtrace-frame i #'called-interactively-p)))
|
||||
1))
|
||||
|
||||
(defvar extended-command-history nil)
|
||||
|
||||
|
|
|
|||
14
lisp/subr.el
14
lisp/subr.el
|
|
@ -4162,7 +4162,8 @@ I is the index of the frame after FRAME2. It should return nil
|
|||
if those frames don't seem special and otherwise, it should return
|
||||
the number of frames to skip (minus 1).")
|
||||
|
||||
(defconst internal--call-interactively (symbol-function 'call-interactively))
|
||||
(defconst internal--funcall-interactively
|
||||
(symbol-function 'funcall-interactively))
|
||||
|
||||
(defun called-interactively-p (&optional kind)
|
||||
"Return t if the containing function was called by `call-interactively'.
|
||||
|
|
@ -4236,10 +4237,13 @@ command is called from a keyboard macro?"
|
|||
(pcase (cons frame nextframe)
|
||||
;; No subr calls `interactive-p', so we can rule that out.
|
||||
(`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil)
|
||||
;; In case #<subr call-interactively> without going through the
|
||||
;; `call-interactively' symbol (bug#3984).
|
||||
(`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t)
|
||||
(`(,_ . (t call-interactively . ,_)) t)))))
|
||||
;; In case #<subr funcall-interactively> without going through the
|
||||
;; `funcall-interactively' symbol (bug#3984).
|
||||
(`(,_ . (t ,(pred (lambda (f)
|
||||
(eq internal--funcall-interactively
|
||||
(indirect-function f))))
|
||||
. ,_))
|
||||
t)))))
|
||||
|
||||
(defun interactive-p ()
|
||||
"Return t if the containing function was run directly by user input.
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
@ -233,6 +233,22 @@ fix_command (Lisp_Object input, Lisp_Object values)
|
|||
}
|
||||
}
|
||||
|
||||
/* 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. */)
|
||||
(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.
|
||||
|
|
@ -374,8 +390,13 @@ 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 args[3];
|
||||
args[0] = Qfuncall_interactively;
|
||||
args[1] = function;
|
||||
args[2] = specs;
|
||||
return unbind_to (speccount, Fapply (3, args));
|
||||
}
|
||||
}
|
||||
|
||||
/* Here if function specifies a string to control parsing the defaults. */
|
||||
|
|
@ -446,10 +467,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 +510,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]), '%'))
|
||||
visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n"));
|
||||
if (strchr (SSDATA (visargs[1]), '%'))
|
||||
callint_message = Fformat (i, visargs);
|
||||
else
|
||||
callint_message = visargs[0];
|
||||
callint_message = visargs[1];
|
||||
|
||||
switch (*tem)
|
||||
{
|
||||
|
|
@ -789,21 +811,22 @@ invoke it. If KEYS is omitted or nil, the return value of
|
|||
|
||||
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 +839,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,11 +852,7 @@ 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);
|
||||
}
|
||||
|
|
@ -888,7 +907,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");
|
||||
|
|
@ -946,5 +965,6 @@ a way to turn themselves off when a mouse command switches windows. */);
|
|||
|
||||
defsubr (&Sinteractive);
|
||||
defsubr (&Scall_interactively);
|
||||
defsubr (&Sfuncall_interactively);
|
||||
defsubr (&Sprefix_numeric_value);
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue