Make called-interactively-p work for edebug or advised code.

* lisp/subr.el (called-interactively-p-functions): New var.
(internal--called-interactively-p--get-frame): New macro.
(called-interactively-p, interactive-p): Rewrite in Lisp.
* lisp/emacs-lisp/nadvice.el (advice--called-interactively-skip): New fun.
(called-interactively-p-functions): Use it.
* lisp/emacs-lisp/edebug.el (edebug--called-interactively-skip): New fun.
(called-interactively-p-functions): Use it.
* lisp/allout.el (allout-called-interactively-p): Don't assume
called-interactively-p is a subr.
* src/eval.c (Finteractive_p, Fcalled_interactively_p, interactive_p): Remove.
(syms_of_eval): Remove corresponding defsubr.
* src/bytecode.c (exec_byte_code): `interactive-p' is now a Lisp function.
* test/automated/advice-tests.el (advice-tests--data): Remove.
(advice-tests): Move the tests directly here instead.
Add called-interactively-p tests.

2 files changed, 65 insertions, 0 deletions

diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 483ed64de20..12311711fe0 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -4268,6 +4268,21 @@ With prefix argument, make it a temporary breakpoint."
 
 ;;; Finalize Loading
 
+;; When edebugging a function, some of the sub-expressions are
+;; wrapped in (edebug-enter (lambda () ..)), so we need to teach
+;; called-interactively-p that calls within the inner lambda should refer to
+;; the outside function.
+(add-hook 'called-interactively-p-functions
+          #'edebug--called-interactively-skip)
+(defun edebug--called-interactively-skip (i frame1 frame2)
+  (when (and (eq (car-safe (nth 1 frame1)) 'lambda)
+             (eq (nth 1 (nth 1 frame1)) '())
+             (eq (nth 1 frame2) 'edebug-enter))
+    ;; `edebug-enter' calls itself on its first invocation.
+    (if (eq (nth 1 (internal--called-interactively-p--get-frame i))
+            'edebug-enter)
+        2 1)))
+
 ;; Finally, hook edebug into the rest of Emacs.
 ;; There are probably some other things that could go here.
 
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 540e0166ec2..d9c5316b1b8 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -402,6 +402,56 @@ of the piece of advice."
 			 (if (fboundp function-name)
 			     (symbol-function function-name))))))
 
+;; When code is advised, called-interactively-p needs to be taught to skip
+;; the advising frames.
+;; FIXME: This Major Ugly Hack won't handle calls to called-interactively-p
+;; done from the advised function if the deepest advice is an around advice!
+;; In other cases (calls from an advice or calls from the advised function when
+;; the deepest advice is not an around advice), it should hopefully get
+;; it right.
+(add-hook 'called-interactively-p-functions
+          #'advice--called-interactively-skip)
+(defun advice--called-interactively-skip (origi frame1 frame2)
+  (let* ((i origi)
+         (get-next-frame
+          (lambda ()
+            (setq frame1 frame2)
+            (setq frame2 (internal--called-interactively-p--get-frame i))
+            ;; (message "Advice Frame %d = %S" i frame2)
+            (setq i (1+ i)))))
+    (when (and (eq (nth 1 frame2) 'apply)
+               (progn
+                 (funcall get-next-frame)
+                 (advice--p (indirect-function (nth 1 frame2)))))
+      (funcall get-next-frame)
+      ;; If we now have the symbol, this was the head advice and
+      ;; we're done.
+      (while (advice--p (nth 1 frame1))
+        ;; This was an inner advice called from some earlier advice.
+        ;; The stack frames look different depending on the particular
+        ;; kind of the earlier advice.
+        (let ((inneradvice (nth 1 frame1)))
+          (if (and (eq (nth 1 frame2) 'apply)
+                   (progn
+                     (funcall get-next-frame)
+                     (advice--p (indirect-function
+                                 (nth 1 frame2)))))
+              ;; The earlier advice was something like a before/after
+              ;; advice where the "next" code is called directly by the
+              ;; advice--p object.
+              (funcall get-next-frame)
+            ;; It's apparently an around advice, where the "next" is
+            ;; called by the body of the advice in any way it sees fit,
+            ;; so we need to skip the frames of that body.
+            (while
+                (progn
+                  (funcall get-next-frame)
+                  (not (and (eq (nth 1 frame2) 'apply)
+                            (eq (nth 3 frame2) inneradvice)))))
+            (funcall get-next-frame)
+            (funcall get-next-frame))))
+      (- i origi 1))))
+
 
 (provide 'nadvice)
 ;;; nadvice.el ends here