emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] /srv/bzr/emacs/trunk r110955: Make called-interactively-p


From: Stefan Monnier
Subject: [Emacs-diffs] /srv/bzr/emacs/trunk r110955: Make called-interactively-p work for edebug or advised code.
Date: Mon, 19 Nov 2012 23:24:09 -0500
User-agent: Bazaar (2.5.0)

------------------------------------------------------------
revno: 110955
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Mon 2012-11-19 23:24:09 -0500
message:
  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.
modified:
  lisp/ChangeLog
  lisp/allout.el
  lisp/emacs-lisp/edebug.el
  lisp/emacs-lisp/nadvice.el
  lisp/subr.el
  src/ChangeLog
  src/bytecode.c
  src/eval.c
  test/ChangeLog
  test/automated/advice-tests.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-11-20 00:57:23 +0000
+++ b/lisp/ChangeLog    2012-11-20 04:24:09 +0000
@@ -1,3 +1,15 @@
+2012-11-20  Stefan Monnier  <address@hidden>
+
+       * subr.el (called-interactively-p-functions): New var.
+       (internal--called-interactively-p--get-frame): New macro.
+       (called-interactively-p, interactive-p): Rewrite in Lisp.
+       * emacs-lisp/nadvice.el (advice--called-interactively-skip): New fun.
+       (called-interactively-p-functions): Use it.
+       * emacs-lisp/edebug.el (edebug--called-interactively-skip): New fun.
+       (called-interactively-p-functions): Use it.
+       * allout.el (allout-called-interactively-p): Don't assume
+       called-interactively-p is a subr.
+
 2012-11-20  Glenn Morris  <address@hidden>
 
        * profiler.el (profiler-report-mode-map): Add a menu.

=== modified file 'lisp/allout.el'
--- a/lisp/allout.el    2012-09-25 04:13:02 +0000
+++ b/lisp/allout.el    2012-11-20 04:24:09 +0000
@@ -1657,10 +1657,9 @@
 (defmacro allout-called-interactively-p ()
   "A version of `called-interactively-p' independent of Emacs version."
   ;; ... to ease maintenance of allout without betraying deprecation.
-  (if (equal (subr-arity (symbol-function 'called-interactively-p))
-             '(0 . 0))
-      '(called-interactively-p)
-    '(called-interactively-p 'interactive)))
+  (if (ignore-errors (called-interactively-p 'interactive) t)
+      '(called-interactively-p 'interactive)
+    '(called-interactively-p)))
 ;;;_   = allout-inhibit-aberrance-doublecheck nil
 ;; In some exceptional moments, disparate topic depths need to be allowed
 ;; momentarily, eg when one topic is being yanked into another and they're

=== modified file 'lisp/emacs-lisp/edebug.el'
--- a/lisp/emacs-lisp/edebug.el 2012-10-08 06:42:29 +0000
+++ b/lisp/emacs-lisp/edebug.el 2012-11-20 04:24:09 +0000
@@ -4268,6 +4268,21 @@
 
 ;;; 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.
 

=== modified file 'lisp/emacs-lisp/nadvice.el'
--- a/lisp/emacs-lisp/nadvice.el        2012-11-15 03:30:25 +0000
+++ b/lisp/emacs-lisp/nadvice.el        2012-11-20 04:24:09 +0000
@@ -402,6 +402,56 @@
                         (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

=== modified file 'lisp/subr.el'
--- a/lisp/subr.el      2012-11-18 01:52:36 +0000
+++ b/lisp/subr.el      2012-11-20 04:24:09 +0000
@@ -1191,8 +1191,6 @@
 (make-obsolete 'unfocus-frame "it does nothing." "22.1")
 (make-obsolete 'make-variable-frame-local
               "explicitly check for a frame-parameter instead." "22.2")
-(make-obsolete 'interactive-p 'called-interactively-p "23.2")
-(set-advertised-calling-convention 'called-interactively-p '(kind) "23.1")
 (set-advertised-calling-convention
  'all-completions '(string collection &optional predicate) "23.1")
 (set-advertised-calling-convention 'unintern '(name obarray) "23.3")
@@ -3963,6 +3961,152 @@
   (put symbol 'abortfunc (or abortfunc 'kill-buffer))
   (put symbol 'hookvar (or hookvar 'mail-send-hook)))
 
+(defvar called-interactively-p-functions nil
+  "Special hook called to skip special frames in `called-interactively-p'.
+The functions are called with 3 arguments: (I FRAME1 FRAME2),
+where FRAME1 is a \"current frame\", FRAME2 is the next frame,
+I is the index of the frame after FRAME2.  It should return nil
+if those frames don't seem special and otherwise, it should return
+the number of frames to skip (minus 1).")
+
+(defmacro internal--called-interactively-p--get-frame (n)
+  ;; `sym' will hold a global variable, which will be used kind of like C's
+  ;; "static" variables.
+  (let ((sym (make-symbol "base-index")))
+    `(progn
+       (defvar ,sym
+         (let ((i 1))
+           (while (not (eq (nth 1 (backtrace-frame i))
+                           'called-interactively-p))
+             (setq i (1+ i)))
+           i))
+       ;; (unless (eq (nth 1 (backtrace-frame ,sym)) 'called-interactively-p)
+       ;;   (error "called-interactively-p: %s is out-of-sync!" ,sym))
+       (backtrace-frame (+ ,sym ,n)))))
+
+(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 1) ;; 0 is the called-interactively-p frame.
+           frame nextframe
+           (get-next-frame
+            (lambda ()
+              (setq frame nextframe)
+              (setq nextframe (internal--called-interactively-p--get-frame i))
+              ;; (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)
+             ;; and `byte-code' (idem; this appears in subexpressions of things
+             ;; like condition-case, which 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.
+             (memq (nth 1 frame) '(interactive-p 'byte-code))
+             ;; 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) (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)))))
+
+(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'."
+  (declare (obsolete called-interactively-p "23.2"))
+  (called-interactively-p 'interactive))
+
+(defun function-arity (f &optional num)
+  "Return the (MIN . MAX) arity of F.
+If the maximum arity is infinite, MAX is `many'.
+F can be a function or a macro.
+If NUM is non-nil, return non-nil iff F can be called with NUM args."
+  (if (symbolp f) (setq f (indirect-function f)))
+  (if (eq (car-safe f) 'macro) (setq f (cdr f)))
+  (let ((res
+        (if (subrp f)
+            (let ((x (subr-arity f)))
+              (if (eq (cdr x) 'unevalled) (cons (car x) 'many)))
+          (let* ((args (if (consp f) (cadr f) (aref f 0)))
+                 (max (length args))
+                 (opt (memq '&optional args))
+                 (rest (memq '&rest args))
+                 (min (- max (length opt))))
+            (if opt
+                (cons min (if rest 'many (1- max)))
+              (if rest
+                  (cons (- max (length rest)) 'many)
+                (cons min max)))))))
+    (if (not num)
+       res
+      (and (>= num (car res))
+          (or (eq 'many (cdr res)) (<= num (cdr res)))))))
+
 (defun set-temporary-overlay-map (map &optional keep-pred)
   "Set MAP as a temporary keymap taking precedence over most other keymaps.
 Note that this does NOT take precedence over the \"overriding\" maps

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2012-11-19 01:39:37 +0000
+++ b/src/ChangeLog     2012-11-20 04:24:09 +0000
@@ -1,3 +1,9 @@
+2012-11-20  Stefan Monnier  <address@hidden>
+
+       * eval.c (Finteractive_p, Fcalled_interactively_p, interactive_p): 
Remove.
+       (syms_of_eval): Remove corresponding defsubr.
+       * bytecode.c (exec_byte_code): `interactive-p' is now a Lisp function.
+
 2012-11-19  Daniel Colascione  <address@hidden>
 
        * w32fns.c (Fx_file_dialog):
@@ -17,10 +23,10 @@
        windows.h gets included before w32term.h uses some of its
        features, see below.
 
-       * w32term.h (LOCALE_ENUMPROCA, LOCALE_ENUMPROCW) [_MSC_VER]: New
-       typedefs.
-       (EnumSystemLocalesA, EnumSystemLocalesW) [_MSC_VER]: New
-       prototypes.
+       * w32term.h (LOCALE_ENUMPROCA, LOCALE_ENUMPROCW) [_MSC_VER]:
+       New typedefs.
+       (EnumSystemLocalesA, EnumSystemLocalesW) [_MSC_VER]:
+       New prototypes.
        (EnumSystemLocales) [_MSC_VER]: Define if undefined.  (Bug#12878)
 
 2012-11-18  Jan Djärv  <address@hidden>
@@ -312,8 +318,8 @@
        * xdisp.c (try_scrolling): Fix correction of aggressive-scroll
        amount when the scroll margins are too large.  When scrolling
        backwards in the buffer, give up if cannot reach point or the
-       scroll margin within a reasonable number of screen lines.  Fixes
-       point position in window under scroll-up/down-aggressively when
+       scroll margin within a reasonable number of screen lines.
+       Fixes point position in window under scroll-up/down-aggressively when
        point is positioned many lines beyond the window top/bottom.
        (Bug#12811)
 

=== modified file 'src/bytecode.c'
--- a/src/bytecode.c    2012-09-24 22:47:51 +0000
+++ b/src/bytecode.c    2012-11-20 04:24:09 +0000
@@ -1579,7 +1579,9 @@
          NEXT;
 
        CASE (Binteractive_p):  /* Obsolete since 24.1.  */
-         PUSH (Finteractive_p ());
+         BEFORE_POTENTIAL_GC ();
+         PUSH (call0 (intern ("interactive-p")));
+         AFTER_POTENTIAL_GC ();
          NEXT;
 
        CASE (Bforward_char):

=== modified file 'src/eval.c'
--- a/src/eval.c        2012-11-16 17:20:23 +0000
+++ b/src/eval.c        2012-11-20 04:24:09 +0000
@@ -489,102 +489,6 @@
 }
 
 
-DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
-       doc: /* 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?
-
-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'.  */)
-  (void)
-{
-  return (INTERACTIVE && interactive_p ()) ? Qt : Qnil;
-}
-
-
-DEFUN ("called-interactively-p", Fcalled_interactively_p, 
Scalled_interactively_p, 0, 1, 0,
-       doc: /* 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, or in `noninteractive' mode.
-
-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?
-
-Instead of using this function, it is sometimes cleaner 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)).  */)
-  (Lisp_Object kind)
-{
-  return (((INTERACTIVE || !EQ (kind, intern ("interactive")))
-          && interactive_p ())
-         ? Qt : Qnil);
-}
-
-
-/* Return true if function in which this appears was called using
-   call-interactively and is not a built-in.  */
-
-static bool
-interactive_p (void)
-{
-  struct backtrace *btp;
-  Lisp_Object fun;
-
-  btp = backtrace_list;
-
-  /* If this isn't a byte-compiled function, there may be a frame at
-     the top for Finteractive_p.  If so, skip it.  */
-  fun = Findirect_function (btp->function, Qnil);
-  if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
-                     || XSUBR (fun) == &Scalled_interactively_p))
-    btp = btp->next;
-
-  /* If we're running an Emacs 18-style byte-compiled function, there
-     may be a frame for Fbytecode at the top level.  In any version of
-     Emacs there can be Fbytecode frames for subexpressions evaluated
-     inside catch and condition-case.  Skip past them.
-
-     If this isn't a byte-compiled function, then we may now be
-     looking at several frames for special forms.  Skip past them.  */
-  while (btp
-        && (EQ (btp->function, Qbytecode)
-            || btp->nargs == UNEVALLED))
-    btp = btp->next;
-
-  /* `btp' now points at the frame of the innermost function that isn't
-     a special form, ignoring frames for Finteractive_p and/or
-     Fbytecode at the top.  If this frame is for a built-in function
-     (such as load or eval-region) return false.  */
-  fun = Findirect_function (btp->function, Qnil);
-  if (SUBRP (fun))
-    return 0;
-
-  /* `btp' points to the frame of a Lisp function that called interactive-p.
-     Return t if that function was called interactively.  */
-  if (btp && btp->next && EQ (btp->next->function, Qcall_interactively))
-    return 1;
-  return 0;
-}
-
-
 DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
        doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
 Aliased variables always have the same value; setting one sets the other.
@@ -696,8 +600,9 @@
              if (EQ ((--pdl)->symbol, sym) && !pdl->func
                  && EQ (pdl->old_value, Qunbound))
                {
-                 message_with_string ("Warning: defvar ignored because %s is 
let-bound",
-                                      SYMBOL_NAME (sym), 1);
+                 message_with_string
+                   ("Warning: defvar ignored because %s is let-bound",
+                    SYMBOL_NAME (sym), 1);
                  break;
                }
            }
@@ -717,8 +622,8 @@
     /* A simple (defvar foo) with lexical scoping does "nothing" except
        declare that var to be dynamically scoped *locally* (i.e. within
        the current file or let-block).  */
-    Vinternal_interpreter_environment =
-      Fcons (sym, Vinternal_interpreter_environment);
+    Vinternal_interpreter_environment
+      = Fcons (sym, Vinternal_interpreter_environment);
   else
     {
       /* Simple (defvar <var>) should not count as a definition at all.
@@ -3551,8 +3456,6 @@
   defsubr (&Sunwind_protect);
   defsubr (&Scondition_case);
   defsubr (&Ssignal);
-  defsubr (&Sinteractive_p);
-  defsubr (&Scalled_interactively_p);
   defsubr (&Scommandp);
   defsubr (&Sautoload);
   defsubr (&Sautoload_do_load);

=== modified file 'test/ChangeLog'
--- a/test/ChangeLog    2012-11-19 17:24:12 +0000
+++ b/test/ChangeLog    2012-11-20 04:24:09 +0000
@@ -1,3 +1,9 @@
+2012-11-20  Stefan Monnier  <address@hidden>
+
+       * automated/advice-tests.el (advice-tests--data): Remove.
+       (advice-tests): Move the tests directly here instead.
+       Add called-interactively-p tests.
+
 2012-11-19  Stefan Monnier  <address@hidden>
 
        * automated/ert-x-tests.el: Use cl-lib.

=== modified file 'test/automated/advice-tests.el'
--- a/test/automated/advice-tests.el    2012-11-16 18:02:39 +0000
+++ b/test/automated/advice-tests.el    2012-11-20 04:24:09 +0000
@@ -21,81 +21,94 @@
 
 ;;; Code:
 
-(defvar advice-tests--data
-  '(((defun sm-test1 (x) (+ x 4))
-     (sm-test1 6) 10)
-    ((advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
-     (sm-test1 6) 50)
-    ((defun sm-test1 (x) (+ x 14))
-     (sm-test1 6) 100)
-    ((null (get 'sm-test1 'defalias-fset-function)) nil)
-    ((advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
-     (sm-test1 6) 20)
-    ((null (get 'sm-test1 'defalias-fset-function)) t)
+(ert-deftest advice-tests ()
+  "Test advice code."
+  (with-temp-buffer
+    (defun sm-test1 (x) (+ x 4))
+    (should (equal (sm-test1 6) 10))
+    (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5)))
+    (should (equal (sm-test1 6) 50))
+    (defun sm-test1 (x) (+ x 14))
+    (should (equal (sm-test1 6) 100))
+    (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil))
+    (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5)))
+    (should (equal (sm-test1 6) 20))
+    (should (equal (null (get 'sm-test1 'defalias-fset-function)) t))
 
-    ((defun sm-test2 (x) (+ x 4))
-     (sm-test2 6) 10)
-    ((defadvice sm-test2 (around sm-test activate)
+    (defun sm-test2 (x) (+ x 4))
+    (should (equal (sm-test2 6) 10))
+    (defadvice sm-test2 (around sm-test activate)
        ad-do-it (setq ad-return-value (* ad-return-value 5)))
-     (sm-test2 6) 50)
-    ((ad-deactivate 'sm-test2)
-     (sm-test2 6) 10)
-    ((ad-activate 'sm-test2)
-     (sm-test2 6) 50)
-    ((defun sm-test2 (x) (+ x 14))
-     (sm-test2 6) 100)
-    ((null (get 'sm-test2 'defalias-fset-function)) nil)
-    ((ad-remove-advice 'sm-test2 'around 'sm-test)
-     (sm-test2 6) 100)
-    ((ad-activate 'sm-test2)
-     (sm-test2 6) 20)
-    ((null (get 'sm-test2 'defalias-fset-function)) t)
+    (should (equal (sm-test2 6) 50))
+    (ad-deactivate 'sm-test2)
+    (should (equal (sm-test2 6) 10))
+    (ad-activate 'sm-test2)
+    (should (equal (sm-test2 6) 50))
+    (defun sm-test2 (x) (+ x 14))
+    (should (equal (sm-test2 6) 100))
+    (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil))
+    (ad-remove-advice 'sm-test2 'around 'sm-test)
+    (should (equal (sm-test2 6) 100))
+    (ad-activate 'sm-test2)
+    (should (equal (sm-test2 6) 20))
+    (should (equal (null (get 'sm-test2 'defalias-fset-function)) t))
 
-    ((advice-add 'sm-test3 :around
+    (advice-add 'sm-test3 :around
                 (lambda (f &rest args) `(toto ,(apply f args)))
                 '((name . wrap-with-toto)))
      (defmacro sm-test3 (x) `(call-test3 ,x))
-     (macroexpand '(sm-test3 56)) (toto (call-test3 56)))
+    (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56))))
 
-    ((defadvice sm-test4 (around wrap-with-toto activate)
+    (defadvice sm-test4 (around wrap-with-toto activate)
        ad-do-it (setq ad-return-value `(toto ,ad-return-value)))
      (defmacro sm-test4 (x) `(call-test4 ,x))
-     (macroexpand '(sm-test4 56)) (toto (call-test4 56)))
-    ((defmacro sm-test4 (x) `(call-testq ,x))
-     (macroexpand '(sm-test4 56)) (toto (call-testq 56)))
+    (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56))))
+    (defmacro sm-test4 (x) `(call-testq ,x))
+    (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56))))
 
     ;; Combining old style and new style advices.
-    ((defun sm-test5 (x) (+ x 4))
-     (sm-test5 6) 10)
-    ((advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5)))
-     (sm-test5 6) 50)
-    ((defadvice sm-test5 (around test activate)
+    (defun sm-test5 (x) (+ x 4))
+    (should (equal (sm-test5 6) 10))
+    (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5)))
+    (should (equal (sm-test5 6) 50))
+    (defadvice sm-test5 (around test activate)
        ad-do-it (setq ad-return-value (+ ad-return-value 0.1)))
-     (sm-test5 5) 45.1)
-    ((ad-deactivate 'sm-test5)
-     (sm-test5 6) 50)
-    ((ad-activate 'sm-test5)
-     (sm-test5 6) 50.1)
-    ((defun sm-test5 (x) (+ x 14))
-     (sm-test5 6) 100.1)
-    ((advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5)))
-     (sm-test5 6) 20.1)
+    (should (equal (sm-test5 5) 45.1))
+    (ad-deactivate 'sm-test5)
+    (should (equal (sm-test5 6) 50))
+    (ad-activate 'sm-test5)
+    (should (equal (sm-test5 6) 50.1))
+    (defun sm-test5 (x) (+ x 14))
+    (should (equal (sm-test5 6) 100.1))
+    (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5)))
+    (should (equal (sm-test5 6) 20.1))
 
     ;; This used to signal an error (bug#12858).
-    ((autoload 'sm-test6 "foo")
+    (autoload 'sm-test6 "foo")
      (defadvice sm-test6 (around test activate)
        ad-do-it)
-     t t)
 
+    ;; Check interaction between advice and called-interactively-p.
+    (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4))
+    (advice-add 'sm-test7 :around
+                (lambda (f &rest args)
+                  (list (cons 1 (called-interactively-p)) (apply f args))))
+    (should (equal (sm-test7) '((1 . nil) 11)))
+    (should (equal (call-interactively 'sm-test7) '((1 . t) 11)))
+    (let ((smi 7))
+      (advice-add 'sm-test7 :before
+                  (lambda (&rest args)
+                    (setq smi (called-interactively-p))))
+      (should (equal (list (sm-test7) smi)
+                     '(((1 . nil) 11) nil)))
+      (should (equal (list (call-interactively 'sm-test7) smi)
+                      '(((1 . t) 11) t))))
+    (advice-add 'sm-test7 :around
+                (lambda (f &rest args)
+                  (cons (cons 2 (called-interactively-p)) (apply f args))))
+    (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11)))
     ))
 
-(ert-deftest advice-tests ()
-  "Test advice code."
-  (with-temp-buffer
-    (dolist (test advice-tests--data)
-      (let ((res (eval `(progn ,@(butlast test)))))
-        (should (equal (car (last test)) res))))))
-
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End:


reply via email to

[Prev in Thread] Current Thread [Next in Thread]