Re: Simple defadvice's stopped working (commit daa84a03, Thu Nov 8 23:10:16 2012 -0500)

[Stefan Monnier <monnier@iro.umontreal.ca>]

>> My code can handle your example just fine.
>> The problem comes when an around advice is added after your advice, at
>> which point your advice won't work any more (not because your is an
>> around advice, but because it's "hidden" by another around advice).
> Which around advice is being added after my advice?

I don't know that there is any, but there could be.  In any case, you're
not using my code yet.  If you want to try it out, see below.
I think I got it to handle around advice now as well.


        Stefan


(eval-when-compile                      ;Poor man's macrolet.
  (defmacro interactive--get-next-frame ()
    `(progn
       (setq frame nextframe)
       (setq nextframe (backtrace-frame (setq i (1+ i))))
       ;; (message "Frame %d = %S" i nextframe)
       )))
(defun called-interactively-p (&optional kind)
  "Return t if the containing function was called by `call-interactively'.
If KIND is `interactive', then only return t 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 0)
          frame nextframe)
      (interactive--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
            (interactive--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
             ;; First comes the binding for to sm-called-interactively-p and
             ;; maybe also for interactive-p.
             (memq (nth 1 frame) '(interactive-p called-interactively-p))
             ;; Then may come special forms (for non-compiled code).
             (null (car frame))
             ;; In byte-compiled code, subexpressions of things like
             ;; condition-case are wrapped in a separate bytecode chunk.
             ;; FIXME: For lexical-binding code, this is much worse, because
             ;; the frames look like "byte-code -> funcall -> #[...]", which
             ;; is not a reliable signature.
             (eq (nth 1 frame) 'byte-code)
             ;; When edebugging a function, some of the sub-expressions are
             ;; wrapped in (lambda () ..).
             (when (and (eq (car-safe (nth 1 frame)) 'lambda)
                        (eq (nth 1 (nth 1 frame)) '())
                        (eq (nth 1 nextframe) 'edebug-enter))
               (interactive--get-next-frame)
               ;; `edebug-enter' calls itself on its first invocation.
               (when (eq (nth 1 nextframe) 'edebug-enter)
                 (interactive--get-next-frame))
               t)
             ;; When the code is advised, we also have a problem.
             ;; FIXME: The Major Ugly Hack below will not 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.
             (when (and (eq (nth 1 nextframe) 'apply) (fboundp 'advice--p)
                        (advice--p (indirect-function
                                    (nth 1 (backtrace-frame (1+ i))))))
               (interactive--get-next-frame)
               (interactive--get-next-frame)
               ;; If we now have the symbol, this was the head advice and
               ;; we're done.
               (while (advice--p (nth 1 frame))
                 ;; This was an inner advice called from some earlier advice.
                 ;; The stack frames look different depending on the particular
                 ;; kind of the earlier advice.
                 (if (and (eq (nth 1 nextframe) 'apply)
                          (advice--p (indirect-function
                                      (nth 1 (backtrace-frame (1+ i))))))
                     ;; The earlier advice was something like a before/after
                     ;; advice where the "next" code is called directly by the
                     ;; advice--p object.
                     (progn
                       (interactive--get-next-frame)
                       (interactive--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.
                   (let ((inneradvice (nth 1 frame))
                         (j i) framej)
                     (while
                         (progn
                           (setq framej (backtrace-frame (setq j (1+ j))))
                           (not (and (eq (nth 1 framej) 'apply)
                                     (eq (nth 3 framej) inneradvice)))))
                     (setq i j)
                     (interactive--get-next-frame)
                     (interactive--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) (subrp (indirect-function f)))) . ,_) . ,_) nil)
        ;; Somehow, I sometimes got `command-execute' rather than
        ;; `call-interactively' on my stacktrace !?
        ;;(`(,_ . (t command-execute . ,_)) t)
        (`(,_ . (t call-interactively . ,_)) t)))))