From: michael@cadilhac.name (Michaël Cadilhac)
To: emacs-devel@gnu.org
Subject: ad-remove-advice bug.
Date: Wed, 07 Mar 2007 15:36:53 +0100 [thread overview]
Message-ID: <878xe9t916.fsf@lrde.org> (raw)
[-- Attachment #1.1.1: Type: text/plain, Size: 599 bytes --]
Hi!
Here's a bug with advices.
Test case :
$ emacs -Q
M-: (defadvice forward-line (before foo activate))
M-x describe-function RET forward-line RET prints:
|
| This subr is advised.
|
| Before-advice `foo'.
`--------------------------
Now, use M-x ad-remove-advice RET RET RET RET (the default each time)
There's two annoying things :
1. M-x describe-function RET forward-line RET says :
| This subr is advised.
`--------------------------
although there's no more advice,
2. M-x ad-remove-advice default values are impossible.
I propose this (maybe too heavy, only parts may suffice) change:
[-- Attachment #1.1.2: advice.patch --]
[-- Type: text/x-patch, Size: 6027 bytes --]
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 <michael@cadilhac.name>
+
+ * 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.
+
[-- Attachment #1.1.3: Type: text/plain, Size: 333 bytes --]
TIA!
--
| Michaël `Micha' Cadilhac | Je veut dire que la loi francaise |
| http://michael.cadilhac.name | est overwritable par le |
| JID/MSN: | reglement interieur il me semble. |
`---- michael.cadilhac@gmail.com | -- ElBarto - --'
[-- Attachment #1.2: Type: application/pgp-signature, Size: 188 bytes --]
[-- Attachment #2: Type: text/plain, Size: 142 bytes --]
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel
next reply other threads:[~2007-03-07 14:36 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2007-03-07 14:36 Michaël Cadilhac [this message]
2007-03-08 0:07 ` ad-remove-advice bug Johan Bockgård
2007-03-08 17:40 ` Richard Stallman
2007-03-08 18:07 ` Michaël Cadilhac
2007-03-09 16:19 ` Richard Stallman
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=878xe9t916.fsf@lrde.org \
--to=michael@cadilhac.name \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.