Index: lisp/emacs-lisp/advice.el =================================================================== RCS file: /sources/emacs/emacs/lisp/emacs-lisp/advice.el,v retrieving revision 1.49 diff -B -w -c -r1.49 advice.el *** lisp/emacs-lisp/advice.el 21 Jan 2007 02:44:24 -0000 1.49 --- lisp/emacs-lisp/advice.el 7 Mar 2007 14:03:11 -0000 *************** *** 2022,2030 **** (defmacro ad-copy-advice-info (function) `(ad-copy-tree (get ,function 'ad-advice-info))) ! (defmacro ad-is-advised (function) "Return non-nil if FUNCTION has any advice info associated with it. ! This does not mean that the advice is also active." (list 'ad-get-advice-info function)) (defun ad-initialize-advice-info (function) --- 2022,2040 ---- (defmacro ad-copy-advice-info (function) `(ad-copy-tree (get ,function 'ad-advice-info))) ! (defun ad-is-advised (function) ! "Return non-nil if FUNCTION has any advice code associated with it. ! This does not mean that the advice is also active, but that one of the ! advice classes of FUNCTION is not empty." ! (catch 'not-empty ! (ad-dolist (class ad-advice-classes nil) ! (when (ad-get-advice-info-field function class) ! (throw 'not-empty t))))) ! ! (defmacro ad-has-advice-info (function) "Return non-nil if FUNCTION has any advice info associated with it. ! This does not mean that the advice has any function, but that advice ! machinery is installed for this function." (list 'ad-get-advice-info function)) (defun ad-initialize-advice-info (function) *************** *** 2039,2045 **** (defun ad-set-advice-info-field (function field value) "Destructively modify VALUE of the advice info FIELD of FUNCTION." ! (and (ad-is-advised function) (cond ((assq field (ad-get-advice-info function)) ;; A field with that name is already present: (rplacd (assq field (ad-get-advice-info function)) value)) --- 2049,2055 ---- (defun ad-set-advice-info-field (function field value) "Destructively modify VALUE of the advice info FIELD of FUNCTION." ! (and (ad-has-advice-info function) (cond ((assq field (ad-get-advice-info function)) ;; A field with that name is already present: (rplacd (assq field (ad-get-advice-info function)) value)) *************** *** 2411,2419 **** --- 2421,2433 ---- (if (ad-is-advised function) (let ((advice-to-remove (ad-find-advice function class name))) (if advice-to-remove + (progn (ad-set-advice-info-field function class (delq advice-to-remove (ad-get-advice-info-field function class))) + ;; If the function now has no advice, remove the machinery. + (unless (ad-is-advised function) + (ad-unadvise function))) (error "ad-remove-advice: `%s' has no %s advice `%s'" function class name))) (error "ad-remove-advice: `%s' is not advised" function))) *************** *** 2431,2437 **** If the FUNCTION was not advised already, then its advice info will be initialized. Redefining a piece of advice whose name is part of the cache-id will clear the cache." ! (cond ((not (ad-is-advised function)) (ad-initialize-advice-info function) (ad-set-advice-info-field function 'origname (ad-make-origname function)))) --- 2445,2451 ---- If the FUNCTION was not advised already, then its advice info will be initialized. Redefining a piece of advice whose name is part of the cache-id will clear the cache." ! (cond ((not (ad-has-advice-info function)) (ad-initialize-advice-info function) (ad-set-advice-info-field function 'origname (ad-make-origname function)))) *************** *** 3636,3642 **** a call to `ad-activate'." (interactive (list (ad-read-advised-function "Deactivate advice of" 'ad-is-active))) ! (if (not (ad-is-advised function)) (error "ad-deactivate: `%s' is not advised" function) (cond ((ad-is-active function) (ad-handle-definition function) --- 3650,3656 ---- a call to `ad-activate'." (interactive (list (ad-read-advised-function "Deactivate advice of" 'ad-is-active))) ! (if (not (ad-has-advice-info function)) (error "ad-deactivate: `%s' is not advised" function) (cond ((ad-is-active function) (ad-handle-definition function) *************** *** 3662,3668 **** If FUNCTION was not advised this will be a noop." (interactive (list (ad-read-advised-function "Unadvise function"))) ! (cond ((ad-is-advised function) (if (ad-is-active function) (ad-deactivate function)) (ad-clear-orig-definition function) --- 3676,3682 ---- If FUNCTION was not advised this will be a noop." (interactive (list (ad-read-advised-function "Unadvise function"))) ! (cond ((ad-has-advice-info function) (if (ad-is-active function) (ad-deactivate function)) (ad-clear-orig-definition function) Index: lisp/ChangeLog =================================================================== RCS file: /sources/emacs/emacs/lisp/ChangeLog,v retrieving revision 1.10783 diff -C0 -r1.10783 ChangeLog *** lisp/ChangeLog 7 Mar 2007 12:50:23 -0000 1.10783 --- lisp/ChangeLog 7 Mar 2007 14:03:28 -0000 *************** *** 0 **** --- 1,13 ---- + 2007-03-07 Michaël Cadilhac + + * emacs-lisp/advice.el (ad-is-advised): Check not only that + function's advice info is not empty, but that an advice class of + the function has an element. + (ad-has-advise-info): New. Only check that function's advice info + is not empty. + (ad-set-advice-info-field, ad-deactivate, ad-unadvise) + (ad-add-advice): Use `ad-has-advise-info' instead of + `ad-is-advised': only advice machinery has to exist at this point. + (ad-remove-advice): If there's no more advice for the function, + remove advice machinery. +