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.
This commit is contained in:
Stefan Monnier 2012-11-19 23:24:09 -05:00
parent b0636be7f9
commit 23ba2705e2
10 changed files with 336 additions and 186 deletions

View file

@ -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.

View file

@ -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