From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.bugs Subject: bug#17446: 24.4.50; What is the situation around `called-interactively-p'? Date: Fri, 09 May 2014 17:02:20 -0400 Message-ID: References: <87tx8z6sp2.fsf@gmail.com> <819a6ab8-db8e-4176-a778-02218f08e7af@default> <6e5610f3-d741-4d61-903c-a8f3aa8f46fd@default> <87siojasqx.fsf@web.de> <87r442x00n.fsf@gmail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1399669413 26359 80.91.229.3 (9 May 2014 21:03:33 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 9 May 2014 21:03:33 +0000 (UTC) Cc: Michael Heerdegen , 17446@debbugs.gnu.org To: Thierry Volpiatto Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri May 09 23:03:25 2014 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Wirww-0002XC-B0 for geb-bug-gnu-emacs@m.gmane.org; Fri, 09 May 2014 23:03:22 +0200 Original-Received: from localhost ([::1]:54416 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Wirwv-00068h-PN for geb-bug-gnu-emacs@m.gmane.org; Fri, 09 May 2014 17:03:22 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:34534) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Wirwm-00068X-7B for bug-gnu-emacs@gnu.org; Fri, 09 May 2014 17:03:19 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Wirwd-0005QN-0s for bug-gnu-emacs@gnu.org; Fri, 09 May 2014 17:03:12 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:40004) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Wirwc-0005QJ-UE for bug-gnu-emacs@gnu.org; Fri, 09 May 2014 17:03:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1Wirwc-0005U0-Bz for bug-gnu-emacs@gnu.org; Fri, 09 May 2014 17:03:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 09 May 2014 21:03:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 17446 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 17446-submit@debbugs.gnu.org id=B17446.139966935121034 (code B ref 17446); Fri, 09 May 2014 21:03:02 +0000 Original-Received: (at 17446) by debbugs.gnu.org; 9 May 2014 21:02:31 +0000 Original-Received: from localhost ([127.0.0.1]:57355 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Wirw6-0005TA-3k for submit@debbugs.gnu.org; Fri, 09 May 2014 17:02:30 -0400 Original-Received: from ironport2-out.teksavvy.com ([206.248.154.181]:36601) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Wirw3-0005Sr-KN for 17446@debbugs.gnu.org; Fri, 09 May 2014 17:02:28 -0400 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: ArYGAIDvNVNMCqwB/2dsb2JhbABZgwaDSr0vgw6BFxd0giUBAQEBAgFWIwULCzQSFBgNJIgECNIZF456B4Q4BKkZgWqDTCGBLCQ X-IPAS-Result: ArYGAIDvNVNMCqwB/2dsb2JhbABZgwaDSr0vgw6BFxd0giUBAQEBAgFWIwULCzQSFBgNJIgECNIZF456B4Q4BKkZgWqDTCGBLCQ X-IronPort-AV: E=Sophos;i="4.97,753,1389762000"; d="scan'208";a="62152928" Original-Received: from 76-10-172-1.dsl.teksavvy.com (HELO pastel.home) ([76.10.172.1]) by ironport2-out.teksavvy.com with ESMTP/TLS/ADH-AES256-SHA; 09 May 2014 17:02:21 -0400 Original-Received: by pastel.home (Postfix, from userid 20848) id 33CA260321; Fri, 9 May 2014 17:02:21 -0400 (EDT) In-Reply-To: (Stefan Monnier's message of "Fri, 09 May 2014 15:50:03 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.4.50 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:88841 Archived-At: > Right, I'm thinking of introducing a new `funcall-interactively' which > is just like `funcall' except that the called function will see its > `called-interactively-p' returning non-nil. How 'bout the patch below, Stefan === modified file 'lisp/simple.el' --- lisp/simple.el 2014-05-01 23:25:28 +0000 +++ lisp/simple.el 2014-05-09 20:42:04 +0000 @@ -1503,24 +1503,13 @@ ;; 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) === modified file 'lisp/subr.el' --- lisp/subr.el 2014-04-09 01:48:07 +0000 +++ lisp/subr.el 2014-05-09 20:24:34 +0000 @@ -3832,7 +3832,8 @@ (byte-compile-log-warning msg)) (run-with-timer 0 nil (lambda (msg) - (message "%s" msg)) msg)))) + (message "%s" msg)) + msg)))) ;; Finally, run any other hook. (run-hook-with-args 'after-load-functions abs-file)) @@ -4149,7 +4150,8 @@ 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'. @@ -4225,8 +4227,8 @@ (`((,_ ,(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))))) + (`(,_ . (t ,(pred (eq internal--funcall-interactively)) . ,_)) t) + (`(,_ . (t funcall-interactively . ,_)) t))))) (defun interactive-p () "Return t if the containing function was run directly by user input. === modified file 'src/callint.c' --- src/callint.c 2014-04-22 07:04:34 +0000 +++ src/callint.c 2014-05-09 20:47:17 +0000 @@ -29,7 +29,7 @@ #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 @@ } } +/* 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ /* 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 @@ 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 @@ 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 @@ defsubr (&Sinteractive); defsubr (&Scall_interactively); + defsubr (&Sfuncall_interactively); defsubr (&Sprefix_numeric_value); }