From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: dick.r.chiang@gmail.com Newsgroups: gmane.emacs.bugs Subject: bug#61244: 30.0.50; [PATCH] Promote called-interactively-p Date: Thu, 02 Feb 2023 16:32:32 -0500 Message-ID: <87sffnzrbj.fsf@dick> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="26340"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.14 (Gnus v5.14) To: 61244@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Feb 03 00:45:27 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pNjGg-0006dD-Pk for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 03 Feb 2023 00:45:26 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pNjGL-0004fA-05; Thu, 02 Feb 2023 18:45:05 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pNjGJ-0004ey-DF for bug-gnu-emacs@gnu.org; Thu, 02 Feb 2023 18:45:03 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pNjGJ-000518-4e for bug-gnu-emacs@gnu.org; Thu, 02 Feb 2023 18:45:03 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pNjGI-0001dk-M4 for bug-gnu-emacs@gnu.org; Thu, 02 Feb 2023 18:45:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: dick.r.chiang@gmail.com Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 02 Feb 2023 23:45:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 61244 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs Original-Received: via spool by submit@debbugs.gnu.org id=B.16753814416201 (code B ref -1); Thu, 02 Feb 2023 23:45:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 2 Feb 2023 23:44:01 +0000 Original-Received: from localhost ([127.0.0.1]:36141 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pNjFG-0001bi-TE for submit@debbugs.gnu.org; Thu, 02 Feb 2023 18:44:01 -0500 Original-Received: from lists.gnu.org ([209.51.188.17]:41096) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pNhCI-0003ze-0I for submit@debbugs.gnu.org; Thu, 02 Feb 2023 16:32:48 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pNhCB-0003L1-Lz for bug-gnu-emacs@gnu.org; Thu, 02 Feb 2023 16:32:44 -0500 Original-Received: from mail-qt1-x82c.google.com ([2607:f8b0:4864:20::82c]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pNhC7-00007H-1d for bug-gnu-emacs@gnu.org; Thu, 02 Feb 2023 16:32:39 -0500 Original-Received: by mail-qt1-x82c.google.com with SMTP id m26so3518851qtp.9 for ; Thu, 02 Feb 2023 13:32:34 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=mime-version:user-agent:message-id:date:subject:to:from:from:to:cc :subject:date:message-id:reply-to; bh=xvd5Bz4zomCS5ibrieZCMbTdO1v24DdjFUa1lCOKxKo=; b=Gb1DpJQ3ndsJMqWxxwR3hLkzrq/ChwzKC04wjX+1xc9BocdUH07unjM7nxQk1WD9tF Vzs3ZVC060hCMQd4LGwFRHDFFw0Q22j3b5vOIc9usNqfj3UaSvmf7r57dbnH/A1A4GU8 4tb/Up9uNToWkTUvJMDmJaqw4uAIvcWyhcu+fjEnfUe3m6cU53DHTsWePkxDv62QWCZX r4AVR1HKd+T5kEqSXUYF2Yvy2/nQIjpWQTc09BNEH/GSdX3FzZwh7+3fRFE8pVTQPRbu W/mLv0lGipGD5WvoOyJnzmsF0KQRkihXQUoROfZ0cJaToYhbxZ56bd2od8xAN512Fljw 4qhQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=mime-version:user-agent:message-id:date:subject:to:from :x-gm-message-state:from:to:cc:subject:date:message-id:reply-to; bh=xvd5Bz4zomCS5ibrieZCMbTdO1v24DdjFUa1lCOKxKo=; b=lnZ0qzdf3hraJ+5xYZCuFkQ4ULHk1OIYER9O44yOEGVbkiz8UdORQlrK7gtZHl4ZOE LJ1ha+E4Dh+FwK0XBFqDeY+5MyvXhRvQQCuHNucpaQBcZBjg5WHEi0pxqbyQlik5lb41 egBzZCW4+eJLkLvWLryIArLJayOs10IOWKfupCLhS8aTozOn1RiNZkcLS9EowZ7Uf49X 0KDpg9FOphQmlw2weRF4NXtwA0T46wt7apTaqsuw2bGjtDBVVcztty0Sun4gbDxYAwD6 R8WxAqxyC641N+tdrgU9MyS2fhts/D66pQFbwtEKh+8agqMjsbplUEIiOpho22oaZMz8 LlFw== X-Gm-Message-State: AO0yUKUw6M97/d7AHjAFvCOWVuUICHI1bhUhCWenqvOH5S1jNYAV8nqH sbtMzuizkXjYHlcqQgOdQ5/9+fNcFzY= X-Google-Smtp-Source: AK7set9dzhGyh2KcC+4h9Jce5t+XcRiVkbjSPzIuXPhV/wGHja26b2J1ilXqkayhPbjozfEpmo4wIQ== X-Received: by 2002:ac8:5a4b:0:b0:3b6:8881:6b07 with SMTP id o11-20020ac85a4b000000b003b688816b07mr12795663qta.48.1675373553331; Thu, 02 Feb 2023 13:32:33 -0800 (PST) Original-Received: from localhost (ool-45763be4.dyn.optonline.net. [69.118.59.228]) by smtp.gmail.com with ESMTPSA id g15-20020ac87f4f000000b003b86b99690fsm333972qtk.62.2023.02.02.13.32.32 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 02 Feb 2023 13:32:32 -0800 (PST) Received-SPF: pass client-ip=2607:f8b0:4864:20::82c; envelope-from=dick.r.chiang@gmail.com; helo=mail-qt1-x82c.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Mailman-Approved-At: Thu, 02 Feb 2023 18:43:58 -0500 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list 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-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:254701 Archived-At: --=-=-= Content-Type: text/plain FUD surrounding `called-interactively-p` continues to saddle functions with an incongruous "interactive-p" optional argument. `called-interactively-p` is safe enough, and if not, no one is going to miss whatever trivial behaviors hinge on its correctness. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Promote-called-interactively-p.patch >From 0e638368eeef35136b2c8126e2a2e0e8fd0aa47d Mon Sep 17 00:00:00 2001 From: dickmao Date: Thu, 2 Feb 2023 16:20:04 -0500 Subject: [PATCH] Promote called-interactively-p * doc/lispref/commands.texi (Distinguish Interactive): Promote. * lisp/subr.el (called-interactively-p): Clarify. (interactive-p): Alias. * src/callint.c (Ffuncall_interactively): Clarify. * test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el (edebug-test-code-called-interactively-p): Test. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-keymap): Test. (edebug-tests-call-interactively-instrumented-func): Test. (edebug-tests-called-interactively-p): Test. * test/lisp/emacs-lisp/nadvice-tests.el (advice-test-called-interactively-p-filter-args): Fix. (advice-test-called-interactively-p-around-careful): Test. --- doc/lispref/commands.texi | 96 +++++------ lisp/subr.el | 152 +++++++----------- src/callint.c | 12 +- .../edebug-resources/edebug-test-code.el | 4 + test/lisp/emacs-lisp/edebug-tests.el | 16 ++ test/lisp/emacs-lisp/nadvice-tests.el | 15 +- 6 files changed, 135 insertions(+), 160 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index dc78adc4520..b02b6ba470a 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -906,61 +906,15 @@ Distinguish Interactive @cindex distinguish interactive calls @cindex is this call interactive - Sometimes a command should display additional visual feedback (such -as an informative message in the echo area) for interactive calls -only. There are three ways to do this. The recommended way to test -whether the function was called using @code{call-interactively} is to -give it an optional argument @code{print-message} and use the -@code{interactive} spec to make it non-@code{nil} in interactive -calls. Here's an example: - -@example -(defun foo (&optional print-message) - (interactive "p") - (when print-message - (message "foo"))) -@end example - -@noindent -We use @code{"p"} because the numeric prefix argument is never -@code{nil}. Defined in this way, the function does display the -message when called from a keyboard macro. - - The above method with the additional argument is usually best, -because it allows callers to say ``treat this call as interactive''. -But you can also do the job by testing @code{called-interactively-p}. - -@defun called-interactively-p kind -This function returns @code{t} when the calling function was called -using @code{call-interactively}. - -The argument @var{kind} should be either the symbol @code{interactive} -or the symbol @code{any}. If it is @code{interactive}, then -@code{called-interactively-p} returns @code{t} only if the call was -made directly by the user---e.g., if the user typed a key sequence -bound to the calling function, but @emph{not} if the user ran a -keyboard macro that called the function (@pxref{Keyboard Macros}). If -@var{kind} is @code{any}, @code{called-interactively-p} returns -@code{t} for any kind of interactive call, including keyboard macros. - -If in doubt, use @code{any}; the only known proper use of -@code{interactive} is if you need to decide whether to display a -helpful message while a function is running. - -A function is never considered to be called interactively if it was -called via Lisp evaluation (or with @code{apply} or @code{funcall}). -@end defun - -@noindent -Here is an example of using @code{called-interactively-p}: + Generally, use @code{called-interactively-p} to determine whether +the current function's context is interactive. @example @group (defun foo () (interactive) - (when (called-interactively-p 'any) - (message "Interactive!") - 'foo-called-interactively)) + (when (called-interactively-p) + (message "Interactive!"))) @end group @group @@ -975,14 +929,13 @@ Distinguish Interactive @end example @noindent -Here is another example that contrasts direct and indirect calls to -@code{called-interactively-p}. +Contrast direct and indirect calls to @code{called-interactively-p}. @example @group (defun bar () (interactive) - (message "%s" (list (foo) (called-interactively-p 'any)))) + (message "%s" (list (foo) (called-interactively-p)))) @end group @group @@ -991,6 +944,43 @@ Distinguish Interactive @end group @end example + While the call site of @code{called-interactively-p} may lexically +reside within the body of the subject function, nothing in the Lisp +runtime links one to the other. When @code{called-interactively-p} is +invoked, tracing the stack frame of the subject function is fraught +given how many intervening function calls could result from arbitrary +macro expansions, special forms, and advices including those for +debugging instrumentation. The heuristics applied cannot guarantee a +correct result under all conceivable conditions. + + What is guaranteed is a function's lexical environment. If +distinguishing interactive is critical, instead add to the subject +function an optional argument with interactive spec @code{p} (or +another code that cannot take on a @code{nil} value). This argument +is thus assured to be non-@code{nil} when the subject function assigns +arguments via the @code{interactive} form. For example the following +function: + +@example +(defun foo (bar) + (interactive (list "bar")) + (called-interactively-p)) +@end example + +@noindent +could be rewritten + +@example +(defun foo (bar &optional interactive-p) + (interactive "i\np") + (when interactive-p + (setq bar "bar")) + interactive-p) +@end example + +@noindent +at the cost of obfuscation. + @node Command Loop Info @section Information from the Command Loop @cindex command loop variables diff --git a/lisp/subr.el b/lisp/subr.el index f909b63aabe..3a213fc56c8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6061,103 +6061,61 @@ internal--funcall-interactively (symbol-function 'funcall-interactively)) (defun called-interactively-p (&optional kind) - "Return t if the containing function was called by `call-interactively'. -If KIND is `interactive', then return t only if the call was made -interactively by the user, i.e. not in `noninteractive' mode nor -when `executing-kbd-macro'. -If KIND is `any', on the other hand, it will return t for any kind of -interactive call, including being called as the binding of a key or -from a keyboard macro, even in `noninteractive' mode. - -This function is very brittle, it may fail to return the intended result when -the code is debugged, advised, or instrumented in some form. Some macros and -special forms (such as `condition-case') may also sometimes wrap their bodies -in a `lambda', so any call to `called-interactively-p' from those bodies will -indicate whether that lambda (rather than the surrounding function) was called -interactively. - -Instead of using this function, it is cleaner and more reliable to give your -function an extra optional argument whose `interactive' spec specifies -non-nil unconditionally (\"p\" is a good way to do this), or via -\(not (or executing-kbd-macro noninteractive)). - -The only known proper use of `interactive' for KIND is in deciding -whether to display a helpful message, or how to display it. If you're -thinking of using it for any other purpose, it is quite likely that -you're making a mistake. Think: what do you want to do when the -command is called from a keyboard macro?" - (declare (advertised-calling-convention (kind) "23.1")) - (when (not (and (eq kind 'interactive) - (or executing-kbd-macro noninteractive))) - (let* ((i 1) ;; 0 is the called-interactively-p frame. - frame nextframe - (get-next-frame - (lambda () - (setq frame nextframe) - (setq nextframe (backtrace-frame i 'called-interactively-p)) - ;; (message "Frame %d = %S" i nextframe) - (setq i (1+ i))))) - (funcall get-next-frame) ;; Get the first frame. - (while - ;; FIXME: The edebug and advice handling should be made modular and - ;; provided directly by edebug.el and nadvice.el. - (progn - ;; frame =(backtrace-frame i-2) - ;; nextframe=(backtrace-frame i-1) - (funcall get-next-frame) - ;; `pcase' would be a fairly good fit here, but it sometimes moves - ;; branches within local functions, which then messes up the - ;; `backtrace-frame' data we get, - (or - ;; Skip special forms (from non-compiled code). - (and frame (null (car frame))) - ;; Skip also `interactive-p' (because we don't want to know if - ;; interactive-p was called interactively but if it's caller was). - (eq (nth 1 frame) 'interactive-p) - ;; Skip package-specific stack-frames. - (let ((skip (run-hook-with-args-until-success - 'called-interactively-p-functions - i frame nextframe))) - (pcase skip - ('nil nil) - (0 t) - (_ (setq i (+ i skip -1)) (funcall get-next-frame))))))) - ;; Now `frame' should be "the function from which we were called". - (pcase (cons frame nextframe) - ;; No subr calls `interactive-p', so we can rule that out. - (`((,_ ,(pred (lambda (f) (subr-primitive-p (indirect-function f)))) . ,_) . ,_) nil) - ;; 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. -This means that the function was called with `call-interactively' -\(which includes being called as the binding of a key) -and input is currently coming from the keyboard (not a keyboard macro), -and Emacs is not running in batch mode (`noninteractive' is nil). - -The only known proper use of `interactive-p' is in deciding whether to -display a helpful message, or how to display it. If you're thinking -of using it for any other purpose, it is quite likely that you're -making a mistake. Think: what do you want to do when the command is -called from a keyboard macro or in batch mode? - -To test whether your function was called with `call-interactively', -either (i) add an extra optional argument and give it an `interactive' -spec that specifies non-nil unconditionally (such as \"p\"); or (ii) -use `called-interactively-p'. - -To test whether a function can be called interactively, use -`commandp'." - ;; Kept around for now. See discussion at: - ;; https://lists.gnu.org/r/emacs-devel/2020-08/msg00564.html - (declare (obsolete called-interactively-p "23.2")) - (called-interactively-p 'interactive)) + "Return t if the containing function was called interactively. +Be warned the function may yield an incorrect result when the +containing function is advised or instrumented for debugging, or +when the call to `called-interactively-p' is enclosed in +macros or special forms which wrap it in a lambda closure. + +If knowing the calling context is critical, one must modify the +containing function's lexical environment as described in Info +node `(elisp)Distinguish Interactive'. + +If KIND is \\='interactive, the function returns nil if either +`executing-kbd-macro' or `noninteractive' is true. The KIND +argument is deprecated in favor of checking those conditions +outside this function." + (let ((kind-exception (and (eq kind 'interactive) + (or noninteractive executing-kbd-macro)))) + (unless kind-exception + ;; Call stack grows down with decreasing I. + ;; Walk up stack until containing function's frame reached. + (let* ((i 0) + (child (backtrace-frame i 'called-interactively-p)) + (parent (backtrace-frame (1+ i) 'called-interactively-p)) + (walk-up-stack + (lambda () + (setq i (1+ i) + child parent + parent (backtrace-frame (1+ i) 'called-interactively-p))))) + (while (progn (funcall walk-up-stack) + (or + ;; Skip special forms from non-compiled code. + (and child (null (car child))) + ;; Skip package-specific stack-frames. + (let ((skip (run-hook-with-args-until-success + 'called-interactively-p-functions + (+ i 2) child parent))) + (pcase skip + ('nil nil) + (0 t) + (_ (setq i (1- (+ i skip))) + (funcall walk-up-stack))))))) + ;; CHILD should now be containing function. + (pcase (cons child parent) + ;; checks if CHILD is built-in primitive (never interactive). + (`((,_ ,(pred (lambda (f) (subr-primitive-p (indirect-function f)))) . ,_) . ,_) + nil) + ;; checks if PARENT is `funcall_interactively'. + (`(,_ . (t ,(pred (lambda (f) + (eq internal--funcall-interactively + (indirect-function f)))) + . ,_)) + t)))))) + +(define-obsolete-function-alias 'interactive-p + #'called-interactively-p "23.2" + "Keep alias (https://lists.gnu.org/r/emacs-devel/2020-08/msg00564.html)") (defun internal-push-keymap (keymap symbol) (let ((map (symbol-value symbol))) diff --git a/src/callint.c b/src/callint.c index d8d2b278458..6259f7d0caa 100644 --- a/src/callint.c +++ b/src/callint.c @@ -233,20 +233,16 @@ read_file_name (Lisp_Object default_filename, Lisp_Object mustmatch, mustmatch, initial, predicate); } -/* 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. + 1, MANY, 0, doc: /* Differentiate from `funcall' to indicate interactive call. +The function `called-interactively-p' looks for this very function token. +This primitive should not be called from C since its very purpose +is to appear as a literal token in the lisp call stack. usage: (funcall-interactively FUNCTION &rest ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { specpdl_ref 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)); } diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el index b0211c915e6..b033fdddcd8 100644 --- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el +++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el @@ -33,6 +33,10 @@ edebug-test-code-fac (* n (edebug-test-code-fac (1- n)))!mult! 1)) +(defun edebug-test-code-called-interactively-p () + (interactive) + !start!(called-interactively-p)) + (defun edebug-test-code-concat (a b flag) !start!(if flag!flag! !then-start!(concat a!then-a! b!then-b!)!then-concat! diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index de2fff5ef19..72ea5874cae 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -56,6 +56,7 @@ edebug-tests-failure-in-post-command (defvar-keymap edebug-tests-keymap :doc "Keys used by the keyboard macros in Edebug's tests." "@" 'edebug-tests-call-instrumented-func + "#" 'edebug-tests-call-interactively-instrumented-func "C-u" 'universal-argument "C-p" 'previous-line "C-n" 'next-line @@ -268,6 +269,13 @@ edebug-tests-setup-@ edebug-tests-args args) (setq edebug-tests-@-result 'no-result))) +(defun edebug-tests-call-interactively-instrumented-func () + "Call interactively `edebug-tests-func' and save results." + (interactive) + (let ((result (call-interactively edebug-tests-func))) + (should (eq edebug-tests-@-result 'no-result)) + (setq edebug-tests-@-result result))) + (defun edebug-tests-call-instrumented-func () "Call `edebug-tests-func' with `edebug-tests-args' and save the results." (interactive) @@ -440,6 +448,14 @@ edebug-tests-stop-point-at-start-of-first-instrumented-function "SPC" (edebug-tests-should-be-at "fac" "step") "g" (should (equal edebug-tests-@-result 1))))) +(ert-deftest edebug-tests-called-interactively-p () + "`called-interactively-p' still works under edebug." + (edebug-tests-with-normal-env + (edebug-tests-setup-@ "called-interactively-p" '() t) + (edebug-tests-run-kbd-macro + "#" (edebug-tests-should-be-at "called-interactively-p" "start") + "g" (should (equal edebug-tests-@-result t))))) + (ert-deftest edebug-tests-step-showing-evaluation-results () "Edebug prints expression evaluation results to the echo area." (edebug-tests-with-normal-env diff --git a/test/lisp/emacs-lisp/nadvice-tests.el b/test/lisp/emacs-lisp/nadvice-tests.el index 748d42f2120..77df743a3e2 100644 --- a/test/lisp/emacs-lisp/nadvice-tests.el +++ b/test/lisp/emacs-lisp/nadvice-tests.el @@ -145,9 +145,8 @@ advice-test-called-interactively-p-around (ert-deftest advice-test-called-interactively-p-filter-args () "Check interaction between filter-args advice and called-interactively-p." - :expected-result :failed (defun sm-test7.3 () (interactive) (cons 1 (called-interactively-p))) - (advice-add 'sm-test7.3 :filter-args #'list) + (advice-add 'sm-test7.3 :filter-args #'identity) (should (equal (sm-test7.3) '(1 . nil))) (should (equal (call-interactively 'sm-test7.3) '(1 . t)))) @@ -163,6 +162,18 @@ advice-test-call-interactively (advice-remove 'call-interactively #'ignore) (should (eq (symbol-function 'call-interactively) old))))) +(ert-deftest advice-test-called-interactively-p-around-careful () + "Like sm-test7.2 but defensively preserve interactive context." + (defun sm-test7.5 () (interactive) (cons 1 (called-interactively-p))) + (advice-add 'sm-test7.5 :around + (lambda (f &rest args) + (list (cons 1 (called-interactively-p)) + (if (called-interactively-p) + (call-interactively f) + (apply f args))))) + (should (equal (sm-test7.5) '((1 . nil) (1 . nil)))) + (should (equal (call-interactively 'sm-test7.5) '((1 . t) (1 . t))))) + (ert-deftest advice-test-interactive () "Check handling of interactive spec." (defun sm-test8 (a) (interactive "p") a) -- 2.38.1 --=-=-= Content-Type: text/plain In Commercial Emacs 0.3.1snapshot b8701a3 in dev (upstream 30.0.50, x86_64-pc-linux-gnu) built on dick Repository revision: b8701a32dad52e26fcf72ce39c9b631c777a1927 Repository branch: dev Windowing system distributor 'The X.Org Foundation', version 11.0.12101003 System Description: Ubuntu 22.04.1 LTS Configured using: 'configure WERROR_CFLAGS=-Werror --prefix=/home/dick/.local --with-tree-sitter CC=gcc-10 PKG_CONFIG_PATH=/home/dick/.local/lib/pkgconfig CXX=gcc-10' Configured features: CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GSETTINGS HARFBUZZ JPEG JSON TREE_SITTER LCMS2 LIBSELINUX LIBSYSTEMD LIBXML2 MODULES NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB Important settings: value of $LANG: en_US.UTF-8 locale-coding-system: utf-8-unix Major mode: Magit Log Minor modes in effect: global-git-commit-mode: t shell-dirtrack-mode: t server-mode: t projectile-mode: t global-xlsp-mode: t global-hl-line-mode: t hl-line-mode: t global-auto-revert-mode: t flx-ido-mode: t winner-mode: t override-global-mode: t tooltip-mode: t global-eldoc-mode: t show-paren-mode: t mouse-wheel-mode: t file-name-shadow-mode: t global-font-lock-mode: t font-lock-mode: t blink-cursor-mode: t buffer-read-only: t column-number-mode: t line-number-mode: t transient-mark-mode: t auto-composition-mode: t auto-encryption-mode: t auto-compression-mode: t Load-path shadows: /home/dick/gomacro-mode/gomacro-mode hides /home/dick/.emacs.d/elpa/gomacro-mode-20200326.1103/gomacro-mode /home/dick/org-gcal.el/org-gcal hides /home/dick/.emacs.d/elpa/org-gcal-0.3/org-gcal /home/dick/.emacs.d/elpa/request-deferred-0.2.0/request-deferred hides /home/dick/.emacs.d/elpa/request-0.3.3/request-deferred /home/dick/.emacs.d/elpa/go-rename-20190805.2101/go-rename hides /home/dick/.emacs.d/elpa/go-mode-1.6.0/go-rename /home/dick/.emacs.d/elpa/go-guru-20181012.330/go-guru hides /home/dick/.emacs.d/elpa/go-mode-1.6.0/go-guru /home/dick/.emacs.d/elpa/chess-2.0.5/_pkg hides /home/dick/.local/share/emacs/site-lisp/_pkg /home/dick/.emacs.d/elpa/chess-2.0.5/chess-pos hides /home/dick/.local/share/emacs/site-lisp/chess-pos /home/dick/.emacs.d/elpa/chess-2.0.5/chess-module hides /home/dick/.local/share/emacs/site-lisp/chess-module /home/dick/.emacs.d/elpa/chess-2.0.5/chess-ucb hides /home/dick/.local/share/emacs/site-lisp/chess-ucb /home/dick/.emacs.d/elpa/chess-2.0.5/chess-scid hides /home/dick/.local/share/emacs/site-lisp/chess-scid /home/dick/.emacs.d/elpa/chess-2.0.5/chess-puzzle hides /home/dick/.local/share/emacs/site-lisp/chess-puzzle /home/dick/.emacs.d/elpa/chess-2.0.5/chess-irc hides /home/dick/.local/share/emacs/site-lisp/chess-irc /home/dick/.emacs.d/elpa/chess-2.0.5/chess-network hides /home/dick/.local/share/emacs/site-lisp/chess-network /home/dick/.emacs.d/elpa/chess-2.0.5/chess-autosave hides /home/dick/.local/share/emacs/site-lisp/chess-autosave /home/dick/.emacs.d/elpa/chess-2.0.5/chess-engine hides /home/dick/.local/share/emacs/site-lisp/chess-engine /home/dick/.emacs.d/elpa/chess-2.0.5/chess-tutorial hides /home/dick/.local/share/emacs/site-lisp/chess-tutorial /home/dick/.emacs.d/elpa/chess-2.0.5/chess-german hides /home/dick/.local/share/emacs/site-lisp/chess-german /home/dick/.emacs.d/elpa/chess-2.0.5/chess-file hides /home/dick/.local/share/emacs/site-lisp/chess-file /home/dick/.emacs.d/elpa/chess-2.0.5/chess-random hides /home/dick/.local/share/emacs/site-lisp/chess-random /home/dick/.emacs.d/elpa/chess-2.0.5/chess-stockfish hides /home/dick/.local/share/emacs/site-lisp/chess-stockfish /home/dick/.emacs.d/elpa/chess-2.0.5/chess-pgn hides /home/dick/.local/share/emacs/site-lisp/chess-pgn /home/dick/.emacs.d/elpa/chess-2.0.5/chess-kibitz hides /home/dick/.local/share/emacs/site-lisp/chess-kibitz /home/dick/.emacs.d/elpa/chess-2.0.5/chess-eco hides /home/dick/.local/share/emacs/site-lisp/chess-eco /home/dick/.emacs.d/elpa/chess-2.0.5/chess-display hides /home/dick/.local/share/emacs/site-lisp/chess-display /home/dick/.emacs.d/elpa/chess-2.0.5/chess-var hides /home/dick/.local/share/emacs/site-lisp/chess-var /home/dick/.emacs.d/elpa/chess-2.0.5/chess-test hides /home/dick/.local/share/emacs/site-lisp/chess-test /home/dick/.emacs.d/elpa/chess-2.0.5/chess-ply hides /home/dick/.local/share/emacs/site-lisp/chess-ply /home/dick/.emacs.d/elpa/chess-2.0.5/chess-message hides /home/dick/.local/share/emacs/site-lisp/chess-message /home/dick/.emacs.d/elpa/chess-2.0.5/chess-ics1 hides /home/dick/.local/share/emacs/site-lisp/chess-ics1 /home/dick/.emacs.d/elpa/chess-2.0.5/chess-phalanx hides /home/dick/.local/share/emacs/site-lisp/chess-phalanx /home/dick/.emacs.d/elpa/chess-2.0.5/chess-game hides /home/dick/.local/share/emacs/site-lisp/chess-game /home/dick/.emacs.d/elpa/chess-2.0.5/chess-log hides /home/dick/.local/share/emacs/site-lisp/chess-log /home/dick/.emacs.d/elpa/chess-2.0.5/chess-plain hides /home/dick/.local/share/emacs/site-lisp/chess-plain /home/dick/.emacs.d/elpa/chess-2.0.5/chess-perft hides /home/dick/.local/share/emacs/site-lisp/chess-perft /home/dick/.emacs.d/elpa/chess-2.0.5/chess-glaurung hides /home/dick/.local/share/emacs/site-lisp/chess-glaurung /home/dick/.emacs.d/elpa/chess-2.0.5/chess-ai hides /home/dick/.local/share/emacs/site-lisp/chess-ai /home/dick/.emacs.d/elpa/chess-2.0.5/chess-fruit hides /home/dick/.local/share/emacs/site-lisp/chess-fruit /home/dick/.emacs.d/elpa/chess-2.0.5/chess-uci hides /home/dick/.local/share/emacs/site-lisp/chess-uci /home/dick/.emacs.d/elpa/chess-2.0.5/chess-epd hides /home/dick/.local/share/emacs/site-lisp/chess-epd /home/dick/.emacs.d/elpa/chess-2.0.5/chess-database hides /home/dick/.local/share/emacs/site-lisp/chess-database /home/dick/.emacs.d/elpa/chess-2.0.5/chess-link hides /home/dick/.local/share/emacs/site-lisp/chess-link /home/dick/.emacs.d/elpa/chess-2.0.5/chess-transport hides /home/dick/.local/share/emacs/site-lisp/chess-transport /home/dick/.emacs.d/elpa/chess-2.0.5/chess-none hides /home/dick/.local/share/emacs/site-lisp/chess-none /home/dick/.emacs.d/elpa/chess-2.0.5/chess-polyglot hides /home/dick/.local/share/emacs/site-lisp/chess-polyglot /home/dick/.emacs.d/elpa/chess-2.0.5/chess-crafty hides /home/dick/.local/share/emacs/site-lisp/chess-crafty /home/dick/.emacs.d/elpa/chess-2.0.5/chess-chat hides /home/dick/.local/share/emacs/site-lisp/chess-chat /home/dick/.emacs.d/elpa/chess-2.0.5/chess hides /home/dick/.local/share/emacs/site-lisp/chess /home/dick/.emacs.d/elpa/chess-2.0.5/chess-images hides /home/dick/.local/share/emacs/site-lisp/chess-images /home/dick/.emacs.d/elpa/chess-2.0.5/chess-gnuchess hides /home/dick/.local/share/emacs/site-lisp/chess-gnuchess /home/dick/.emacs.d/elpa/chess-2.0.5/chess-fen hides /home/dick/.local/share/emacs/site-lisp/chess-fen /home/dick/.emacs.d/elpa/chess-2.0.5/chess-ics hides /home/dick/.local/share/emacs/site-lisp/chess-ics /home/dick/.emacs.d/elpa/chess-2.0.5/chess-ics2 hides /home/dick/.local/share/emacs/site-lisp/chess-ics2 /home/dick/.emacs.d/elpa/chess-2.0.5/chess-common hides /home/dick/.local/share/emacs/site-lisp/chess-common /home/dick/.emacs.d/elpa/chess-2.0.5/chess-input hides /home/dick/.local/share/emacs/site-lisp/chess-input /home/dick/.emacs.d/elpa/chess-2.0.5/chess-announce hides /home/dick/.local/share/emacs/site-lisp/chess-announce /home/dick/.emacs.d/elpa/chess-2.0.5/chess-clock hides /home/dick/.local/share/emacs/site-lisp/chess-clock /home/dick/.emacs.d/elpa/chess-2.0.5/chess-sound hides /home/dick/.local/share/emacs/site-lisp/chess-sound /home/dick/.emacs.d/elpa/chess-2.0.5/chess-sjeng hides /home/dick/.local/share/emacs/site-lisp/chess-sjeng /home/dick/.emacs.d/elpa/chess-2.0.5/chess-algebraic hides /home/dick/.local/share/emacs/site-lisp/chess-algebraic /home/dick/.emacs.d/elpa/transient-0.3.7snapshot/transient hides /home/dick/.local/share/emacs/0.3.1/lisp/transient /home/dick/.emacs.d/elpa/use-package-20200520.2305/use-package-bind-key hides /home/dick/.local/share/emacs/0.3.1/lisp/use-package/use-package-bind-key /home/dick/.emacs.d/elpa/use-package-20200520.2305/use-package-lint hides /home/dick/.local/share/emacs/0.3.1/lisp/use-package/use-package-lint /home/dick/.emacs.d/elpa/use-package-20200520.2305/use-package-core hides /home/dick/.local/share/emacs/0.3.1/lisp/use-package/use-package-core /home/dick/.emacs.d/elpa/use-package-20200520.2305/use-package-ensure hides /home/dick/.local/share/emacs/0.3.1/lisp/use-package/use-package-ensure /home/dick/.emacs.d/elpa/bind-key-20161218.1520/bind-key hides /home/dick/.local/share/emacs/0.3.1/lisp/use-package/bind-key /home/dick/.emacs.d/elpa/use-package-20200520.2305/use-package-jump hides /home/dick/.local/share/emacs/0.3.1/lisp/use-package/use-package-jump /home/dick/.emacs.d/elpa/use-package-20200520.2305/use-package-diminish hides /home/dick/.local/share/emacs/0.3.1/lisp/use-package/use-package-diminish /home/dick/.emacs.d/elpa/use-package-20200520.2305/use-package hides /home/dick/.local/share/emacs/0.3.1/lisp/use-package/use-package /home/dick/.emacs.d/elpa/use-package-20200520.2305/use-package-delight hides /home/dick/.local/share/emacs/0.3.1/lisp/use-package/use-package-delight /home/dick/.emacs.d/elpa/eglot-1.8/eglot hides /home/dick/.local/share/emacs/0.3.1/lisp/progmodes/eglot /home/dick/.emacs.d/elpa/soap-client-3.1.5/soap-client hides /home/dick/.local/share/emacs/0.3.1/lisp/net/soap-client /home/dick/.emacs.d/elpa/soap-client-3.1.5/soap-inspect hides /home/dick/.local/share/emacs/0.3.1/lisp/net/soap-inspect /home/dick/.emacs.d/elpa/let-alist-1.0.6/let-alist hides /home/dick/.local/share/emacs/0.3.1/lisp/emacs-lisp/let-alist Features: (shadow bbdb-message footnote emacsbug company-oddmuse company-keywords company-etags company-gtags company-dabbrev-code company-dabbrev company-files company-clang company-cmake company-semantic company-template company-bbdb cc-mode cc-fonts cc-guess cc-menus cc-cmds cc-styles cc-align cc-engine cc-vars cc-defs texinfo texinfo-loaddefs git-rebase vc tramp-archive tramp-gvfs tramp-cache time-stamp zeroconf tramp tramp-loaddefs trampver tramp-integration cus-start files-x tramp-compat ls-lisp shr-color qp goto-addr gravatar dns magit-extras mule-util jka-compr face-remap magit-patch-changelog magit-patch magit-submodule magit-obsolete magit-blame magit-stash magit-reflog magit-bisect magit-push magit-pull magit-fetch magit-clone magit-remote magit-commit magit-sequence magit-notes magit-worktree magit-tag magit-merge magit-branch magit-reset magit-files magit-refs magit-status magit magit-repos magit-apply magit-wip magit-log which-func imenu magit-diff smerge-mode diff git-commit log-edit pcvs-util add-log magit-core magit-autorevert magit-margin magit-transient magit-process with-editor shell pcomplete server magit-mode transient magit-git magit-base magit-section format-spec misearch multi-isearch vc-git diff-mode vc-dispatcher tree-sitter bug-reference vc-svn elpaso elpaso-admin elpaso-milky elpaso-defs shortdoc cal-menu calendar cal-loaddefs gnus-html url-queue help-fns radix-tree sort smiley flow-fill mm-archive mail-extr textsec uni-scripts idna-mapping ucs-normalize uni-confusable textsec-check gnus-async gnus-ml gnus-notifications gnus-fun notifications gnus-kill gnus-dup disp-table utf-7 url-cache benchmark nnrss nnfolder nndiscourse rbenv nnhackernews nntwitter nntwitter-api bbdb-gnus gnus-demon nntp nnmairix nnml nnreddit gnus-topic url-http url-auth url-gw network-stream nsm request virtualenvwrapper gud s dash json-rpc python compat gnus-score score-mode gnus-bcklg gnus-srvr gnus-cite anaphora bbdb-mua bbdb-com crm bbdb bbdb-site timezone gnus-delay gnus-draft gnus-cache gnus-agent gnus-msg gnus-art mm-uu mml2015 mm-view mml-smime smime gnutls dig gnus-sum shr pixel-fill kinsoku url-file svg dom nndraft nnmh gnus-group mm-url gnus-undo use-package use-package-ensure use-package-delight use-package-diminish gnus-start gnus-dbus dbus xml gnus-cloud nnimap nnmail mail-source utf7 nnoo parse-time iso8601 gnus-spec gnus-int gnus-range message sendmail yank-media puny dired-x dired dired-loaddefs rfc822 mml mml-sec epa epg rfc6068 epg-config mm-decode mm-bodies mm-encode mail-parse rfc2231 rfc2047 rfc2045 ietf-drums mailabbrev gmm-utils mailheader gnus-win paredit-ext paredit inf-ruby ruby-mode smie haskell-interactive-mode haskell-presentation-mode haskell-process haskell-session haskell-compile haskell-mode haskell-cabal haskell-utils haskell-font-lock haskell-indentation haskell-string haskell-sort-imports haskell-lexeme rx haskell-align-imports haskell-complete-module haskell-ghc-support noutline outline flymake-proc flymake etags fileloop generator dabbrev haskell-customize solarized-theme solarized-definitions projectile lisp-mnt ibuf-ext ibuffer ibuffer-loaddefs thingatpt grep compile comint ansi-osc ansi-color gnus nnheader range mail-utils mm-util mail-prsvr gnus-util text-property-search time-date xlsp xlsp-xref xlsp-server xlsp-company company-capf company xlsp-handle-notification xlsp-handle-request xlsp-struct xlsp-utils jsonrpc pcase warnings hl-line autorevert filenotify flx-ido flx google-translate-default-ui google-translate-core-ui facemenu color ido google-translate-core google-translate-tk google-translate-backend auto-complete advice popup cus-edit pp cus-load icons wid-edit emms-player-mplayer emms-player-simple emms emms-compat winner edmacro kmacro cl-extra help-mode xref project ring use-package-bind-key bind-key easy-mmode use-package-core derived company-go-autoloads wordnut-autoloads quelpa-autoloads haskell-mode-autoloads xlsp-autoloads debbugs-autoloads eglot-autoloads emacsql-autoloads corfu-autoloads elpaso-disc-autoloads elpaso-autoloads find-func sml-mode-autoloads json-reformat-autoloads typescript-mode-autoloads projectile-autoloads nnreddit-autoloads json-snatcher-autoloads yasnippet-autoloads tornado-template-mode-autoloads flycheck-autoloads request-autoloads lsp-mode-autoloads lv-autoloads lsp-bridge-autoloads posframe-autoloads magit-autoloads magit-section-autoloads cask-autoloads epl-autoloads markdown-mode-autoloads go-mode-autoloads dash-autoloads company-autoloads git-commit-autoloads info compat-autoloads package browse-url url url-proxy url-privacy url-expand url-methods url-history url-cookie generate-lisp-file url-domsuf url-util mailcap url-handlers url-parse auth-source cl-seq eieio eieio-core cl-macs password-cache json subr-x map byte-opt gv bytecomp byte-compile cldefs url-vars cl-loaddefs cl-lib rmc iso-transl tooltip cconv eldoc paren electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe tabulated-list replace newcomment text-mode lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu timer select scroll-bar mouse jit-lock font-lock syntax font-core term/tty-colors frame minibuffer nadvice seq simple cl-generic indonesian philippine cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european ethiopic indian cyrillic chinese composite emoji-zwj charscript charprop case-table epa-hook jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs theme-loaddefs faces cus-face macroexp files window text-properties overlay sha1 md5 base64 format env code-pages mule custom widget keymap hashtable-print-readable backquote threads dbusbind inotify lcms2 dynamic-setting system-font-setting font-render-setting cairo move-toolbar gtk x-toolkit xinput2 x multi-tty make-network-process emacs) Memory information: ((conses 16 1137562 104422) (symbols 48 48318 2) (strings 32 221450 44809) (string-bytes 1 6892398) (vectors 16 136619) (vector-slots 8 3121891 105090) (floats 8 1271 1705) (intervals 56 19769 1249) (buffers 984 46)) --=-=-=--