* lisp/emacs-lisp/cl.el (dolist, dotimes, declare): Use advice-add to

override the default.
* lisp/emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Rewrite without using
cl--dotimes/dolist.
* lisp/subr.el (dolist, dotimes, declare): Redefine them normally, even when
`cl' is loaded.

* lisp/emacs-lisp/nadvice.el (advice--normalize): New function, extracted
from add-advice.
(advice--strip-macro): New function.
(advice--defalias-fset): Use them to handle macros.
(advice-add): Use them.
(advice-member-p): Correctly handle macros.

7 files changed, 91 insertions, 59 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6ab2880f09f..92f3343db64 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,21 @@
 2012-11-13  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+        * emacs-lisp/cl.el (dolist, dotimes, declare): Use advice-add to
+        override the default.
+        * emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Rewrite without using
+        cl--dotimes/dolist.
+        * subr.el (dolist, dotimes, declare): Redefine them normally, even when
+        `cl' is loaded.
+
+        * emacs-lisp/nadvice.el (advice--normalize): New function, extracted
+        from add-advice.
+        (advice--strip-macro): New function.
+        (advice--defalias-fset): Use them to handle macros.
+        (advice-add): Use them.
+        (advice-member-p): Correctly handle macros.
+
+2012-11-13  Stefan Monnier  <monnier@iro.umontreal.ca>
+
         * emacs-lisp/gv.el (gv-define-simple-setter): One more fix (bug#12871).
 
 2012-11-13  Wolfgang Jenkner  <wjenkner@inode.at>
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index bf99af2f7e6..eb58d17c02e 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'.
 ;;;;;;  cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
 ;;;;;;  cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
 ;;;;;;  cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
-;;;;;;  "cl-macs" "cl-macs.el" "a7228877484d2b39e1c2bee40b011734")
+;;;;;;  "cl-macs" "cl-macs.el" "c7ad09a74a1d2969406e7e2aaf3812fc")
 ;;; Generated autoloads from cl-macs.el
 
 (autoload 'cl--compiler-macro-list* "cl-macs" "\
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index b28f8f7f9e9..3c46c40242d 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1547,9 +1547,9 @@ An implicit nil block is established around the loop.
 \(fn (VAR LIST [RESULT]) BODY...)"
   (declare (debug ((symbolp form &optional form) cl-declarations body))
            (indent 1))
-  `(cl-block nil
-     (,(if (eq 'cl-dolist (symbol-function 'dolist)) 'cl--dolist 'dolist)
-      ,spec ,@body)))
+  (let ((loop `(dolist ,spec ,@body)))
+    (if (advice-member-p #'cl--wrap-in-nil-block 'dolist)
+        loop `(cl-block nil ,loop))))
 
 ;;;###autoload
 (defmacro cl-dotimes (spec &rest body)
@@ -1560,9 +1560,9 @@ nil.
 
 \(fn (VAR COUNT [RESULT]) BODY...)"
   (declare (debug cl-dolist) (indent 1))
-  `(cl-block nil
-     (,(if (eq 'cl-dotimes (symbol-function 'dotimes)) 'cl--dotimes 'dotimes)
-      ,spec ,@body)))
+  (let ((loop `(dotimes ,spec ,@body)))
+    (if (advice-member-p #'cl--wrap-in-nil-block 'dotimes)
+        loop `(cl-block nil ,loop))))
 
 ;;;###autoload
 (defmacro cl-do-symbols (spec &rest body)
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 016967bc713..40d12358b17 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -107,14 +107,6 @@
                ))
   (defvaralias var (intern (format "cl-%s" var))))
 
-;; Before overwriting subr.el's `dotimes' and `dolist', let's remember
-;; them under a different name, so we can use them in our implementation
-;; of `dotimes' and `dolist'.
-(unless (fboundp 'cl--dotimes)
-  (defalias 'cl--dotimes (symbol-function 'dotimes) "The non-CL `dotimes'."))
-(unless (fboundp 'cl--dolist)
-  (defalias 'cl--dolist (symbol-function 'dolist) "The non-CL `dolist'."))
-
 (dolist (fun '(
                (get* . cl-get)
                (random* . cl-random)
@@ -228,7 +220,6 @@
                remf
                psetf
                (define-setf-method . define-setf-expander)
-               declare
                the
                locally
                multiple-value-setq
@@ -239,8 +230,6 @@
                psetq
                do-all-symbols
                do-symbols
-               dotimes
-               dolist
                do*
                do
                loop
@@ -322,6 +311,15 @@
                (intern (format "cl-%s" fun)))))
     (defalias fun new)))
 
+(defun cl--wrap-in-nil-block (fun &rest args)
+  `(cl-block nil ,(apply fun args)))
+(advice-add 'dolist :around #'cl--wrap-in-nil-block)
+(advice-add 'dotimes :around #'cl--wrap-in-nil-block)
+
+(defun cl--pass-args-to-cl-declare (&rest specs)
+   (macroexpand `(cl-declare ,@specs)))
+(advice-add 'declare :after #'cl--pass-args-to-cl-declare)
+
 ;;; Features provided a bit differently in Elisp.
 
 ;; First, the old lexical-let is now better served by `lexical-binding', tho
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 020a2f89bdb..ca1ebf3cad2 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -230,23 +230,49 @@ of the piece of advice."
         (advice--make-1 (aref old 1) (aref old 3)
                         first nrest props)))))
 
+(defun advice--normalize (symbol def)
+  (cond
+   ((special-form-p def)
+    ;; Not worth the trouble trying to handle this, I think.
+    (error "add-advice failure: %S is a special form" symbol))
+   ((and (symbolp def)
+         (eq 'macro (car-safe (ignore-errors (indirect-function def)))))
+    (let ((newval (cons 'macro (cdr (indirect-function def)))))
+      (put symbol 'advice--saved-rewrite (cons def newval))
+      newval))
+   ;; `f' might be a pure (hence read-only) cons!
+   ((and (eq 'macro (car-safe def))
+         (not (ignore-errors (setcdr def (cdr def)) t)))
+    (cons 'macro (cdr def)))
+   (t def)))
+
+(defsubst advice--strip-macro (x)
+  (if (eq 'macro (car-safe x)) (cdr x) x))
+
 (defun advice--defalias-fset (fsetfun symbol newdef)
-  (let* ((olddef (if (fboundp symbol) (symbol-function symbol)))
+  (when (get symbol 'advice--saved-rewrite)
+    (put symbol 'advice--saved-rewrite nil))
+  (setq newdef (advice--normalize symbol newdef))
+  (let* ((olddef (advice--strip-macro
+                  (if (fboundp symbol) (symbol-function symbol))))
          (oldadv
           (cond
-             ((null (get symbol 'advice--pending))
-              (or olddef
-                  (progn
-                    (message "Delayed advice activation failed for %s: no data"
-                             symbol)
-                    nil)))
-             ((or (not olddef) (autoloadp olddef))
-              (prog1 (get symbol 'advice--pending)
-                (put symbol 'advice--pending nil)))
+           ((null (get symbol 'advice--pending))
+            (or olddef
+                (progn
+                  (message "Delayed advice activation failed for %s: no data"
+                           symbol)
+                  nil)))
+           ((or (not olddef) (autoloadp olddef))
+            (prog1 (get symbol 'advice--pending)
+              (put symbol 'advice--pending nil)))
            (t (message "Dropping left-over advice--pending for %s" symbol)
               (put symbol 'advice--pending nil)
               olddef))))
-    (funcall (or fsetfun #'fset) symbol (advice--subst-main oldadv newdef))))
+    (let* ((snewdef (advice--strip-macro newdef))
+           (snewadv (advice--subst-main oldadv snewdef)))
+      (funcall (or fsetfun #'fset) symbol
+               (if (eq snewdef newdef) snewadv (cons 'macro snewadv))))))
     
 
 ;;;###autoload
@@ -269,29 +295,18 @@ is defined as a macro, alias, command, ..."
   ;;   simplest way is to make advice.el build one ad-Advice-foo function for
   ;;   each advised function which is advice-added/removed whenever ad-activate
   ;;   ad-deactivate is called.
-  (let ((f (and (fboundp symbol) (symbol-function symbol))))
-    (cond
-     ((special-form-p f)
-      ;; Not worth the trouble trying to handle this, I think.
-      (error "add-advice failure: %S is a special form" symbol))
-     ((and (symbolp f)
-           (eq 'macro (car-safe (ignore-errors (indirect-function f)))))
-      (let ((newval (cons 'macro (cdr (indirect-function f)))))
-        (put symbol 'advice--saved-rewrite (cons f newval))
-        (fset symbol newval)))
-     ;; `f' might be a pure (hence read-only) cons!
-     ((and (eq 'macro (car-safe f)) (not (ignore-errors (setcdr f (cdr f)) t)))
-      (fset symbol (cons 'macro (cdr f))))
-     ))
-  (let ((f (and (fboundp symbol) (symbol-function symbol))))
+  (let* ((f (and (fboundp symbol) (symbol-function symbol)))
+         (nf (advice--normalize symbol f)))
+    (unless (eq f nf) ;; Most importantly, if nf == nil!
+      (fset symbol nf))
     (add-function where (cond
-                         ((eq (car-safe f) 'macro) (cdr f))
+                         ((eq (car-safe nf) 'macro) (cdr nf))
                          ;; If the function is not yet defined, we can't yet
                          ;; install the advice.
                          ;; FIXME: If it's an autoloaded command, we also
                          ;; have a problem because we need to load the
                          ;; command to build the interactive-form.
-                         ((or (not f) (and (autoloadp f))) ;; (commandp f)
+                         ((or (not nf) (and (autoloadp nf))) ;; (commandp nf)
                           (get symbol 'advice--pending))
                          (t (symbol-function symbol)))
                   function props)
@@ -316,7 +331,7 @@ of the piece of advice."
                        function)
       (unless (advice--p
                (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol)))
-        ;; Not adviced any more.
+        ;; Not advised any more.
         (remove-function (get symbol 'defalias-fset-function)
                          #'advice--defalias-fset)
         (if (eq (symbol-function symbol)
@@ -335,13 +350,15 @@ of the piece of advice."
 ;;       (setq def (advice--cdr def)))))
 
 ;;;###autoload
-(defun advice-member-p (function symbol)
-  "Return non-nil if advice FUNCTION has been added to function SYMBOL.
-Instead of FUNCTION being the actual function, it can also be the `name'
+(defun advice-member-p (advice function-name)
+  "Return non-nil if ADVICE has been added to FUNCTION-NAME.
+Instead of ADVICE being the actual function, it can also be the `name'
 of the piece of advice."
-  (advice--member-p function
-                    (or (get symbol 'advice--pending)
-                        (if (fboundp symbol) (symbol-function symbol)))))
+  (advice--member-p advice
+                    (or (get function-name 'advice--pending)
+                        (advice--strip-macro
+                         (if (fboundp function-name)
+                             (symbol-function function-name))))))
 
 
 (provide 'nadvice)
diff --git a/lisp/subr.el b/lisp/subr.el
index ebfcfbc0930..b0ac2dd2106 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -195,11 +195,6 @@ value of last one, or nil if there are none.
   (declare (indent 1) (debug t))
   (cons 'if (cons cond (cons nil body))))
 
-(if (null (featurep 'cl))
-    (progn
-  ;; If we reload subr.el after having loaded CL, be careful not to
-  ;; overwrite CL's extended definition of `dolist', `dotimes', `declare'.
-
 (defmacro dolist (spec &rest body)
   "Loop over a list.
 Evaluate BODY with VAR bound to each car from LIST, in turn.
@@ -279,7 +274,6 @@ The possible values of SPECS are specified by
 `defun-declarations-alist' and `macro-declarations-alist'."
   ;; FIXME: edebug spec should pay attention to defun-declarations-alist.
   nil)
-))
 
 (defmacro ignore-errors (&rest body)
   "Execute BODY; if an error occurs, return nil.
diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el
index cac10e9602f..9f9719fdcfc 100644
--- a/test/automated/advice-tests.el
+++ b/test/automated/advice-tests.el
@@ -50,6 +50,13 @@
     ((ad-activate 'sm-test2)
      (sm-test2 6) 20)
     ((null (get 'sm-test2 'defalias-fset-function)) t)
+
+    ((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)))
+
     ))
 
 (ert-deftest advice-tests ()