- (when (fboundp symbol)
- (let ((f (symbol-function symbol)))
- ;; Can't use the `if' place here, because the body is too large,
- ;; resulting in use of code that only works with lexical-scoping.
- (remove-function (if (eq (car-safe f) 'macro)
- (cdr f)
- (symbol-function symbol))
- function)
- (unless (advice--p
- (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol)))
- ;; Not advised any more.
- (remove-function (get symbol 'defalias-fset-function)
- #'advice--defalias-fset)
- (if (eq (symbol-function symbol)
- (cdr (get symbol 'advice--saved-rewrite)))
- (fset symbol (car (get symbol 'advice--saved-rewrite))))))
- nil))
-
-;; (defun advice-mapc (fun symbol)
-;; "Apply FUN to every function added as advice to SYMBOL.
-;; FUN is called with a two arguments: the function that was added, and the
-;; properties alist that was specified when it was added."
-;; (let ((def (or (get symbol 'advice--pending)
-;; (if (fboundp symbol) (symbol-function symbol)))))
-;; (while (advice--p def)
-;; (funcall fun (advice--car def) (advice--props def))
-;; (setq def (advice--cdr def)))))
+ (let ((f (symbol-function symbol)))
+ (remove-function (cond ;This is `advice--symbol-function' but as a "place".
+ ((get symbol 'advice--pending)
+ (get symbol 'advice--pending))
+ ((eq (car-safe f) 'macro) (cdr f))
+ (t (symbol-function symbol)))
+ function)
+ (unless (advice--p (advice--symbol-function symbol))
+ (remove-function (get symbol 'defalias-fset-function)
+ #'advice--defalias-fset)
+ (let ((asr (get symbol 'advice--saved-rewrite)))
+ (and asr (eq (cdr-safe (symbol-function symbol))
+ (cdr asr))
+ (fset symbol (car (get symbol 'advice--saved-rewrite)))))))
+ nil)
+
+;;;###autoload
+(defmacro define-advice (symbol args &rest body)
+ "Define an advice and add it to function named SYMBOL.
+See `advice-add' and `add-function' for explanation on the
+arguments. Note if NAME is nil the advice is anonymous;
+otherwise it is named `SYMBOL@NAME'.
+
+\(fn SYMBOL (WHERE LAMBDA-LIST &optional NAME DEPTH) &rest BODY)"
+ (declare (indent 2) (doc-string 3) (debug (sexp sexp body)))
+ (or (listp args) (signal 'wrong-type-argument (list 'listp args)))
+ (or (<= 2 (length args) 4)
+ (signal 'wrong-number-of-arguments (list 2 4 (length args))))
+ (let* ((where (nth 0 args))
+ (lambda-list (nth 1 args))
+ (name (nth 2 args))
+ (depth (nth 3 args))
+ (props (and depth `((depth . ,depth))))
+ (advice (cond ((null name) `(lambda ,lambda-list ,@body))
+ ((or (stringp name) (symbolp name))
+ (intern (format "%s@%s" symbol name)))
+ (t (error "Unrecognized name spec `%S'" name)))))
+ `(prog1 ,@(and (symbolp advice) `((defun ,advice ,lambda-list ,@body)))
+ (advice-add ',symbol ,where #',advice ,@(and props `(',props))))))
+
+(defun advice-mapc (fun symbol)
+ "Apply FUN to every advice function in SYMBOL.
+FUN is called with a two arguments: the function that was added, and the
+properties alist that was specified when it was added."
+ (advice-function-mapc fun (advice--symbol-function symbol)))