From 0e4857b7d84f958f66e726ed57b824427b272681 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 27 May 2014 20:09:14 -0400 Subject: [PATCH] * 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. --- etc/NEWS | 4 ++++ lisp/ChangeLog | 10 ++++++++ lisp/simple.el | 17 +++----------- lisp/subr.el | 14 ++++++++---- src/callint.c | 62 +++++++++++++++++++++++++++++++++----------------- 5 files changed, 67 insertions(+), 40 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 20112451a37..59efd14f59f 100644 --- a/etc/NEWS +++ b/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. +++ diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2658fc0554d..8845b77b3b7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2014-05-28 Stefan Monnier + + * 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 * register.el (register-read-with-preview): Don't burp on diff --git a/lisp/simple.el b/lisp/simple.el index e5b0203866c..7bc961b2051 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -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) diff --git a/lisp/subr.el b/lisp/subr.el index fef33e726c3..a72a026f195 100644 --- a/lisp/subr.el +++ b/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 # without going through the - ;; `call-interactively' symbol (bug#3984). - (`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t) - (`(,_ . (t call-interactively . ,_)) t))))) + ;; In case # 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. diff --git a/src/callint.c b/src/callint.c index 54f04cdee17..24baedf3873 100644 --- a/src/callint.c +++ b/src/callint.c @@ -29,7 +29,7 @@ along with GNU Emacs. If not, see . */ #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); } -- 2.39.2