diff options
| author | Stefan Monnier | 2012-11-13 09:12:46 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2012-11-13 09:12:46 -0500 |
| commit | 3c442f8b25bf6acc52c45a1f9966b8529ea936d2 (patch) | |
| tree | d6372faa4eef5ed4919e94592240b06634e0a4c8 | |
| parent | c708524567662c8911c5ab2695acc7bda0383705 (diff) | |
| download | emacs-3c442f8b25bf6acc52c45a1f9966b8529ea936d2.tar.gz emacs-3c442f8b25bf6acc52c45a1f9966b8529ea936d2.zip | |
* lisp/emacs-lisp/advice.el: Layer on top of nadvice.el.
Remove out of date self-require hack.
(ad-do-advised-functions): Use simple `dolist'.
(ad-advice-name, ad-advice-protected, ad-advice-enabled)
(ad-advice-definition): Redefine as functions.
(ad-advice-classes): Move before first use.
(ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition)
(ad-make-mapped-call, ad-make-advised-docstring, ad-make-plain-docstring)
(ad--defalias-fset): Remove functions.
(ad-make-advicefunname, ad-clear-advicefunname-definition): New functions.
(ad-get-orig-definition): Rewrite.
(ad-make-advised-definition-docstring): Change base docstring.
(ad-real-orig-definition): Rewrite.
(ad-map-arglists): Change name of called function.
(ad--make-advised-docstring): Redirect `function' from ad-Advice-...
(ad-make-advised-definition): Simplify.
(ad-assemble-advised-definition): Tweak for new calling context.
(ad-activate-advised-definition): Setup ad-Advice-* instead of ad-Orig-*.
(ad--defalias-fset): Rename from ad-handle-definition. Make it set the
function and call ad-activate if needed.
(ad-activate, ad-deactivate): Don't call ad-handle-definition any more.
(ad-recover): Clear ad-Advice-* instead of ad-Orig-*.
(ad-compile-function): Compile ad-Advice-*.
(ad-activate-on-top-level, ad-with-auto-activation-disabled): Remove.
(ad-start-advice, ad-stop-advice): Remove.
| -rw-r--r-- | etc/NEWS | 3 | ||||
| -rw-r--r-- | lisp/ChangeLog | 28 | ||||
| -rw-r--r-- | lisp/emacs-lisp/advice.el | 730 | ||||
| -rw-r--r-- | test/automated/advice-tests.el | 23 |
4 files changed, 291 insertions, 493 deletions
| @@ -43,7 +43,8 @@ It is layered as: | |||
| 43 | 43 | ||
| 44 | * Incompatible Lisp Changes in Emacs 24.4 | 44 | * Incompatible Lisp Changes in Emacs 24.4 |
| 45 | 45 | ||
| 46 | ** `defadvice' does not honor the `freeze' flag any more. | 46 | ** `defadvice' does not honor the `freeze' flag and cannot advise |
| 47 | special-forms any more. | ||
| 47 | 48 | ||
| 48 | ** `dolist' in lexical-binding mode does not bind VAR in RESULT any more. | 49 | ** `dolist' in lexical-binding mode does not bind VAR in RESULT any more. |
| 49 | VAR was bound to nil which was not tremendously useful and just lead to | 50 | VAR was bound to nil which was not tremendously useful and just lead to |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fc69b8643b6..72754190cf3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,31 @@ | |||
| 1 | 2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/advice.el: Layer on top of nadvice.el. | ||
| 4 | Remove out of date self-require hack. | ||
| 5 | (ad-do-advised-functions): Use simple `dolist'. | ||
| 6 | (ad-advice-name, ad-advice-protected, ad-advice-enabled) | ||
| 7 | (ad-advice-definition): Redefine as functions. | ||
| 8 | (ad-advice-classes): Move before first use. | ||
| 9 | (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition) | ||
| 10 | (ad-make-mapped-call, ad-make-advised-docstring, ad-make-plain-docstring) | ||
| 11 | (ad--defalias-fset): Remove functions. | ||
| 12 | (ad-make-advicefunname, ad-clear-advicefunname-definition): New functions. | ||
| 13 | (ad-get-orig-definition): Rewrite. | ||
| 14 | (ad-make-advised-definition-docstring): Change base docstring. | ||
| 15 | (ad-real-orig-definition): Rewrite. | ||
| 16 | (ad-map-arglists): Change name of called function. | ||
| 17 | (ad--make-advised-docstring): Redirect `function' from ad-Advice-... | ||
| 18 | (ad-make-advised-definition): Simplify. | ||
| 19 | (ad-assemble-advised-definition): Tweak for new calling context. | ||
| 20 | (ad-activate-advised-definition): Setup ad-Advice-* instead of ad-Orig-*. | ||
| 21 | (ad--defalias-fset): Rename from ad-handle-definition. Make it set the | ||
| 22 | function and call ad-activate if needed. | ||
| 23 | (ad-activate, ad-deactivate): Don't call ad-handle-definition any more. | ||
| 24 | (ad-recover): Clear ad-Advice-* instead of ad-Orig-*. | ||
| 25 | (ad-compile-function): Compile ad-Advice-*. | ||
| 26 | (ad-activate-on-top-level, ad-with-auto-activation-disabled): Remove. | ||
| 27 | (ad-start-advice, ad-stop-advice): Remove. | ||
| 28 | |||
| 1 | 2012-11-13 Dmitry Gutov <dgutov@yandex.ru> | 29 | 2012-11-13 Dmitry Gutov <dgutov@yandex.ru> |
| 2 | 30 | ||
| 3 | * progmodes/ruby-mode.el (ruby-add-log-current-method): Print the | 31 | * progmodes/ruby-mode.el (ruby-add-log-current-method): Print the |
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index ecaf6861a6c..f9b4491e6e0 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el | |||
| @@ -47,14 +47,12 @@ | |||
| 47 | ;; @ Highlights: | 47 | ;; @ Highlights: |
| 48 | ;; ============= | 48 | ;; ============= |
| 49 | ;; - Clean definition of multiple, named before/around/after advices | 49 | ;; - Clean definition of multiple, named before/around/after advices |
| 50 | ;; for functions, macros, subrs and special forms | 50 | ;; for functions and macros. |
| 51 | ;; - Full control over the arguments an advised function will receive, | 51 | ;; - Full control over the arguments an advised function will receive, |
| 52 | ;; the binding environment in which it will be executed, as well as the | 52 | ;; the binding environment in which it will be executed, as well as the |
| 53 | ;; value it will return. | 53 | ;; value it will return. |
| 54 | ;; - Allows re/definition of interactive behavior for functions and subrs | 54 | ;; - Allows re/definition of interactive behavior for commands. |
| 55 | ;; - Every piece of advice can have its documentation string which will be | 55 | ;; - Every piece of advice can have its documentation string. |
| 56 | ;; combined with the original documentation of the advised function at | ||
| 57 | ;; call-time of `documentation' for proper command-key substitution. | ||
| 58 | ;; - The execution of every piece of advice can be protected against error | 56 | ;; - The execution of every piece of advice can be protected against error |
| 59 | ;; and non-local exits in preceding code or advices. | 57 | ;; and non-local exits in preceding code or advices. |
| 60 | ;; - Simple argument access either by name, or, more portable but as | 58 | ;; - Simple argument access either by name, or, more portable but as |
| @@ -63,7 +61,7 @@ | |||
| 63 | ;; version of a function. | 61 | ;; version of a function. |
| 64 | ;; - Advised functions can be byte-compiled either at file-compile time | 62 | ;; - Advised functions can be byte-compiled either at file-compile time |
| 65 | ;; (see preactivation) or activation time. | 63 | ;; (see preactivation) or activation time. |
| 66 | ;; - Separation of advice definition and activation | 64 | ;; - Separation of advice definition and activation. |
| 67 | ;; - Forward advice is possible, that is | 65 | ;; - Forward advice is possible, that is |
| 68 | ;; as yet undefined or autoload functions can be advised without having to | 66 | ;; as yet undefined or autoload functions can be advised without having to |
| 69 | ;; preload the file in which they are defined. | 67 | ;; preload the file in which they are defined. |
| @@ -77,7 +75,7 @@ | |||
| 77 | ;; - En/disablement mechanism allows the use of different "views" of advised | 75 | ;; - En/disablement mechanism allows the use of different "views" of advised |
| 78 | ;; functions depending on what pieces of advice are currently en/disabled | 76 | ;; functions depending on what pieces of advice are currently en/disabled |
| 79 | ;; - Provides manipulation mechanisms for sets of advised functions via | 77 | ;; - Provides manipulation mechanisms for sets of advised functions via |
| 80 | ;; regular expressions that match advice names | 78 | ;; regular expressions that match advice names. |
| 81 | 79 | ||
| 82 | ;; @ Overview, or how to read this file: | 80 | ;; @ Overview, or how to read this file: |
| 83 | ;; ===================================== | 81 | ;; ===================================== |
| @@ -113,23 +111,12 @@ | |||
| 113 | ;; others come from the various Lisp advice mechanisms I've come across | 111 | ;; others come from the various Lisp advice mechanisms I've come across |
| 114 | ;; so far, and a few are simply mine. | 112 | ;; so far, and a few are simply mine. |
| 115 | 113 | ||
| 116 | ;; @ Comments, suggestions, bug reports: | ||
| 117 | ;; ===================================== | ||
| 118 | ;; If you find any bugs, have suggestions for new advice features, find the | ||
| 119 | ;; documentation wrong, confusing, incomplete, or otherwise unsatisfactory, | ||
| 120 | ;; have any questions about Advice, or have otherwise enlightening | ||
| 121 | ;; comments feel free to send me email at <hans@cs.buffalo.edu>. | ||
| 122 | |||
| 123 | ;; @ Safety Rules and Emergency Exits: | 114 | ;; @ Safety Rules and Emergency Exits: |
| 124 | ;; =================================== | 115 | ;; =================================== |
| 125 | ;; Before we begin: CAUTION!! | 116 | ;; Before we begin: CAUTION!! |
| 126 | ;; Advice provides you with a lot of rope to hang yourself on very | 117 | ;; Advice provides you with a lot of rope to hang yourself on very |
| 127 | ;; easily accessible trees, so, here are a few important things you | 118 | ;; easily accessible trees, so, here are a few important things you |
| 128 | ;; should know: Once Advice has been started with `ad-start-advice' | 119 | ;; should know: |
| 129 | ;; (which happens automatically when you load this file), it | ||
| 130 | ;; generates an advised definition of the `documentation' function, and | ||
| 131 | ;; it will enable automatic advice activation when functions get defined. | ||
| 132 | ;; All of this can be undone at any time with `M-x ad-stop-advice'. | ||
| 133 | ;; | 120 | ;; |
| 134 | ;; If you experience any strange behavior/errors etc. that you attribute to | 121 | ;; If you experience any strange behavior/errors etc. that you attribute to |
| 135 | ;; Advice or to some ill-advised function do one of the following: | 122 | ;; Advice or to some ill-advised function do one of the following: |
| @@ -137,45 +124,37 @@ | |||
| 137 | ;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what | 124 | ;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what |
| 138 | ;; function gives you problems) | 125 | ;; function gives you problems) |
| 139 | ;; - M-x ad-deactivate-all (if you don't have a clue what's going wrong) | 126 | ;; - M-x ad-deactivate-all (if you don't have a clue what's going wrong) |
| 140 | ;; - M-x ad-stop-advice (if you think the problem is related to the | ||
| 141 | ;; advised functions used by Advice itself) | ||
| 142 | ;; - M-x ad-recover-normality (for real emergencies) | 127 | ;; - M-x ad-recover-normality (for real emergencies) |
| 143 | ;; - If none of the above solves your Advice-related problem go to another | 128 | ;; - If none of the above solves your Advice-related problem go to another |
| 144 | ;; terminal, kill your Emacs process and send me some hate mail. | 129 | ;; terminal, kill your Emacs process and send me some hate mail. |
| 145 | 130 | ||
| 146 | ;; The first three measures have restarts, i.e., once you've figured out | 131 | ;; The first two measures have restarts, i.e., once you've figured out |
| 147 | ;; the problem you can reactivate advised functions with either `ad-activate', | 132 | ;; the problem you can reactivate advised functions with either `ad-activate', |
| 148 | ;; `ad-activate-all', or `ad-start-advice'. `ad-recover-normality' unadvises | 133 | ;; or `ad-activate-all'. `ad-recover-normality' unadvises |
| 149 | ;; everything so you won't be able to reactivate any advised functions, you'll | 134 | ;; everything so you won't be able to reactivate any advised functions, you'll |
| 150 | ;; have to stick with their standard incarnations for the rest of the session. | 135 | ;; have to stick with their standard incarnations for the rest of the session. |
| 151 | 136 | ||
| 152 | ;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before | ||
| 153 | ;; you byte-compile a file, because advised special forms and macros can lead | ||
| 154 | ;; to unwanted compilation results. When you are done compiling use | ||
| 155 | ;; `M-x ad-activate-all' to go back to the advised state of all your | ||
| 156 | ;; advised functions. | ||
| 157 | |||
| 158 | ;; RELAX: Advice is pretty safe even if you are oblivious to the above. | 137 | ;; RELAX: Advice is pretty safe even if you are oblivious to the above. |
| 159 | ;; I use it extensively and haven't run into any serious trouble in a long | 138 | ;; I use it extensively and haven't run into any serious trouble in a long |
| 160 | ;; time. Just wanted you to be warned. | 139 | ;; time. Just wanted you to be warned. |
| 161 | 140 | ||
| 162 | ;; @ Customization: | 141 | ;; @ Customization: |
| 163 | ;; ================ | 142 | ;; ================ |
| 164 | 143 | ||
| 165 | ;; Look at the documentation of `ad-redefinition-action' for possible values | 144 | ;; Look at the documentation of `ad-redefinition-action' for possible values |
| 166 | ;; of this variable. Its default value is `warn' which will print a warning | 145 | ;; of this variable. Its default value is `warn' which will print a warning |
| 167 | ;; message when an already defined advised function gets redefined with a | 146 | ;; message when an already defined advised function gets redefined with a |
| 168 | ;; new original definition and de/activated. | 147 | ;; new original definition and de/activated. |
| 169 | 148 | ||
| 170 | ;; Look at the documentation of `ad-default-compilation-action' for possible | 149 | ;; Look at the documentation of `ad-default-compilation-action' for possible |
| 171 | ;; values of this variable. Its default value is `maybe' which will compile | 150 | ;; values of this variable. Its default value is `maybe' which will compile |
| 172 | ;; advised definitions during activation in case the byte-compiler is already | 151 | ;; advised definitions during activation in case the byte-compiler is already |
| 173 | ;; loaded. Otherwise, it will leave them uncompiled. | 152 | ;; loaded. Otherwise, it will leave them uncompiled. |
| 174 | 153 | ||
| 175 | ;; @ Motivation: | 154 | ;; @ Motivation: |
| 176 | ;; ============= | 155 | ;; ============= |
| 177 | ;; Before I go on explaining how advice works, here are four simple examples | 156 | ;; Before I go on explaining how advice works, here are four simple examples |
| 178 | ;; how this package can be used. The first three are very useful, the last one | 157 | ;; how this package can be used. The first three are very useful, the last one |
| 179 | ;; is just a joke: | 158 | ;; is just a joke: |
| 180 | 159 | ||
| 181 | ;;(defadvice switch-to-buffer (before existing-buffers-only activate) | 160 | ;;(defadvice switch-to-buffer (before existing-buffers-only activate) |
| @@ -206,13 +185,12 @@ | |||
| 206 | 185 | ||
| 207 | ;; @ Advice documentation: | 186 | ;; @ Advice documentation: |
| 208 | ;; ======================= | 187 | ;; ======================= |
| 209 | ;; Below is general documentation of the various features of advice. For more | 188 | ;; Below is general documentation of the various features of advice. For more |
| 210 | ;; concrete examples check the corresponding sections in the tutorial part. | 189 | ;; concrete examples check the corresponding sections in the tutorial part. |
| 211 | 190 | ||
| 212 | ;; @@ Terminology: | 191 | ;; @@ Terminology: |
| 213 | ;; =============== | 192 | ;; =============== |
| 214 | ;; - Emacs: Emacs as released by the GNU Project | 193 | ;; - Emacs: Emacs as released by the GNU Project |
| 215 | ;; - jwz: Jamie Zawinski - creator of the byte-compiler used in v19s. | ||
| 216 | ;; - Advice: The name of this package. | 194 | ;; - Advice: The name of this package. |
| 217 | ;; - advices: Short for "pieces of advice". | 195 | ;; - advices: Short for "pieces of advice". |
| 218 | 196 | ||
| @@ -236,22 +214,22 @@ | |||
| 236 | ;; <name> is the name of the advice which has to be a non-nil symbol. | 214 | ;; <name> is the name of the advice which has to be a non-nil symbol. |
| 237 | ;; Names uniquely identify a piece of advice in a certain advice class, | 215 | ;; Names uniquely identify a piece of advice in a certain advice class, |
| 238 | ;; hence, advices can be redefined by defining an advice with the same class | 216 | ;; hence, advices can be redefined by defining an advice with the same class |
| 239 | ;; and name. Advice names are global symbols, hence, the same name space | 217 | ;; and name. Advice names are global symbols, hence, the same name space |
| 240 | ;; conventions used for function names should be applied. | 218 | ;; conventions used for function names should be applied. |
| 241 | 219 | ||
| 242 | ;; An optional <position> specifies where in the current list of advices of | 220 | ;; An optional <position> specifies where in the current list of advices of |
| 243 | ;; the specified <class> this new advice will be placed. <position> has to | 221 | ;; the specified <class> this new advice will be placed. <position> has to |
| 244 | ;; be either `first', `last' or a number that specifies a zero-based | 222 | ;; be either `first', `last' or a number that specifies a zero-based |
| 245 | ;; position (`first' is equivalent to 0). If no position is specified | 223 | ;; position (`first' is equivalent to 0). If no position is specified |
| 246 | ;; `first' will be used as a default. If this call to `defadvice' redefines | 224 | ;; `first' will be used as a default. If this call to `defadvice' redefines |
| 247 | ;; an already existing advice (see above) then the position argument will | 225 | ;; an already existing advice (see above) then the position argument will |
| 248 | ;; be ignored and the position of the already existing advice will be used. | 226 | ;; be ignored and the position of the already existing advice will be used. |
| 249 | 227 | ||
| 250 | ;; An optional <arglist> which has to be a list can be used to define the | 228 | ;; An optional <arglist> which has to be a list can be used to define the |
| 251 | ;; argument list of the advised function. This argument list should of | 229 | ;; argument list of the advised function. This argument list should of |
| 252 | ;; course be compatible with the argument list of the original function, | 230 | ;; course be compatible with the argument list of the original function, |
| 253 | ;; otherwise functions that call the advised function with the original | 231 | ;; otherwise functions that call the advised function with the original |
| 254 | ;; argument list in mind will break. If more than one advice specify an | 232 | ;; argument list in mind will break. If more than one advice specify an |
| 255 | ;; argument list then the first one (the one with the smallest position) | 233 | ;; argument list then the first one (the one with the smallest position) |
| 256 | ;; found in the list of before/around/after advices will be used. | 234 | ;; found in the list of before/around/after advices will be used. |
| 257 | 235 | ||
| @@ -267,10 +245,10 @@ | |||
| 267 | ;; `disable': Specifies that the defined advice should be disabled, hence, | 245 | ;; `disable': Specifies that the defined advice should be disabled, hence, |
| 268 | ;; it will not be used in an activation until somebody enables it. | 246 | ;; it will not be used in an activation until somebody enables it. |
| 269 | ;; `preactivate': Specifies that the advised function should get preactivated | 247 | ;; `preactivate': Specifies that the advised function should get preactivated |
| 270 | ;; at macro-expansion/compile time of this `defadvice'. This | 248 | ;; at macro-expansion/compile time of this `defadvice'. This |
| 271 | ;; generates a compiled advised definition according to the | 249 | ;; generates a compiled advised definition according to the |
| 272 | ;; current advice state which will be used during activation | 250 | ;; current advice state which will be used during activation |
| 273 | ;; if appropriate. Only use this if the `defadvice' gets | 251 | ;; if appropriate. Only use this if the `defadvice' gets |
| 274 | ;; actually compiled. | 252 | ;; actually compiled. |
| 275 | 253 | ||
| 276 | ;; An optional <documentation-string> can be supplied to document the advice. | 254 | ;; An optional <documentation-string> can be supplied to document the advice. |
| @@ -278,20 +256,20 @@ | |||
| 278 | ;; documentation strings of the original function and other advices. | 256 | ;; documentation strings of the original function and other advices. |
| 279 | 257 | ||
| 280 | ;; An optional <interactive-form> form can be supplied to change/add | 258 | ;; An optional <interactive-form> form can be supplied to change/add |
| 281 | ;; interactive behavior of the original function. If more than one advice | 259 | ;; interactive behavior of the original function. If more than one advice |
| 282 | ;; has an `(interactive ...)' specification then the first one (the one | 260 | ;; has an `(interactive ...)' specification then the first one (the one |
| 283 | ;; with the smallest position) found in the list of before/around/after | 261 | ;; with the smallest position) found in the list of before/around/after |
| 284 | ;; advices will be used. | 262 | ;; advices will be used. |
| 285 | 263 | ||
| 286 | ;; A possibly empty list of <body-forms> specifies the body of the advice in | 264 | ;; A possibly empty list of <body-forms> specifies the body of the advice in |
| 287 | ;; an implicit progn. The body of an advice can access/change arguments, | 265 | ;; an implicit progn. The body of an advice can access/change arguments, |
| 288 | ;; the return value, the binding environment, and can have all sorts of | 266 | ;; the return value, the binding environment, and can have all sorts of |
| 289 | ;; other side effects. | 267 | ;; other side effects. |
| 290 | 268 | ||
| 291 | ;; @@ Assembling advised definitions: | 269 | ;; @@ Assembling advised definitions: |
| 292 | ;; ================================== | 270 | ;; ================================== |
| 293 | ;; Suppose a function/macro/subr/special-form has N pieces of before advice, | 271 | ;; Suppose a function/macro/subr/special-form has N pieces of before advice, |
| 294 | ;; M pieces of around advice and K pieces of after advice. Assuming none of | 272 | ;; M pieces of around advice and K pieces of after advice. Assuming none of |
| 295 | ;; the advices is protected, its advised definition will look like this | 273 | ;; the advices is protected, its advised definition will look like this |
| 296 | ;; (body-form indices correspond to the position of the respective advice in | 274 | ;; (body-form indices correspond to the position of the respective advice in |
| 297 | ;; that advice class): | 275 | ;; that advice class): |
| @@ -330,11 +308,11 @@ | |||
| 330 | ;; be expanded into a proper documentation string upon call of `documentation'. | 308 | ;; be expanded into a proper documentation string upon call of `documentation'. |
| 331 | 309 | ||
| 332 | ;; (interactive ...) is an optional interactive form either taken from the | 310 | ;; (interactive ...) is an optional interactive form either taken from the |
| 333 | ;; original function or from a before/around/after advice. For advised | 311 | ;; original function or from a before/around/after advice. For advised |
| 334 | ;; interactive subrs that do not have an interactive form specified in any | 312 | ;; interactive subrs that do not have an interactive form specified in any |
| 335 | ;; advice we have to use (interactive) and then call the subr interactively | 313 | ;; advice we have to use (interactive) and then call the subr interactively |
| 336 | ;; if the advised function was called interactively, because the | 314 | ;; if the advised function was called interactively, because the |
| 337 | ;; interactive specification of subrs is not accessible. This is the only | 315 | ;; interactive specification of subrs is not accessible. This is the only |
| 338 | ;; case where changing the values of arguments will not have an affect | 316 | ;; case where changing the values of arguments will not have an affect |
| 339 | ;; because they will be reset by the interactive specification of the subr. | 317 | ;; because they will be reset by the interactive specification of the subr. |
| 340 | ;; If this is a problem one can always specify an interactive form in a | 318 | ;; If this is a problem one can always specify an interactive form in a |
| @@ -343,45 +321,44 @@ | |||
| 343 | ;; | 321 | ;; |
| 344 | ;; Then the body forms of the various advices in the various classes of advice | 322 | ;; Then the body forms of the various advices in the various classes of advice |
| 345 | ;; are assembled in order. The forms of around advice L are normally part of | 323 | ;; are assembled in order. The forms of around advice L are normally part of |
| 346 | ;; one of the forms of around advice L-1. An around advice can specify where | 324 | ;; one of the forms of around advice L-1. An around advice can specify where |
| 347 | ;; the forms of the wrapped or surrounded forms should go with the special | 325 | ;; the forms of the wrapped or surrounded forms should go with the special |
| 348 | ;; keyword `ad-do-it', which will be substituted with a `progn' containing the | 326 | ;; keyword `ad-do-it', which will run the forms of the surrounded code. |
| 349 | ;; forms of the surrounded code. | ||
| 350 | 327 | ||
| 351 | ;; The innermost part of the around advice onion is | 328 | ;; The innermost part of the around advice onion is |
| 352 | ;; <apply original definition to <arglist>> | 329 | ;; <apply original definition to <arglist>> |
| 353 | ;; whose form depends on the type of the original function. The variable | 330 | ;; whose form depends on the type of the original function. The variable |
| 354 | ;; `ad-return-value' will be set to its result. This variable is visible to | 331 | ;; `ad-return-value' will be set to its result. This variable is visible to |
| 355 | ;; all pieces of advice which can access and modify it before it gets returned. | 332 | ;; all pieces of advice which can access and modify it before it gets returned. |
| 356 | ;; | 333 | ;; |
| 357 | ;; The semantic structure of advised functions that contain protected pieces | 334 | ;; The semantic structure of advised functions that contain protected pieces |
| 358 | ;; of advice is the same. The only difference is that `unwind-protect' forms | 335 | ;; of advice is the same. The only difference is that `unwind-protect' forms |
| 359 | ;; make sure that the protected advice gets executed even if some previous | 336 | ;; make sure that the protected advice gets executed even if some previous |
| 360 | ;; piece of advice had an error or a non-local exit. If any around advice is | 337 | ;; piece of advice had an error or a non-local exit. If any around advice is |
| 361 | ;; protected then the whole around advice onion will be protected. | 338 | ;; protected then the whole around advice onion will be protected. |
| 362 | 339 | ||
| 363 | ;; @@ Argument access in advised functions: | 340 | ;; @@ Argument access in advised functions: |
| 364 | ;; ======================================== | 341 | ;; ======================================== |
| 365 | ;; As already mentioned, the simplest way to access the arguments of an | 342 | ;; As already mentioned, the simplest way to access the arguments of an |
| 366 | ;; advised function in the body of an advice is to refer to them by name. To | 343 | ;; advised function in the body of an advice is to refer to them by name. |
| 367 | ;; do that, the advice programmer needs to know either the names of the | 344 | ;; To do that, the advice programmer needs to know either the names of the |
| 368 | ;; argument variables of the original function, or the names used in the | 345 | ;; argument variables of the original function, or the names used in the |
| 369 | ;; argument list redefinition given in a piece of advice. While this simple | 346 | ;; argument list redefinition given in a piece of advice. While this simple |
| 370 | ;; method might be sufficient in many cases, it has the disadvantage that it | 347 | ;; method might be sufficient in many cases, it has the disadvantage that it |
| 371 | ;; is not very portable because it hardcodes the argument names into the | 348 | ;; is not very portable because it hardcodes the argument names into the |
| 372 | ;; advice. If the definition of the original function changes the advice | 349 | ;; advice. If the definition of the original function changes the advice |
| 373 | ;; might break even though the code might still be correct. Situations like | 350 | ;; might break even though the code might still be correct. Situations like |
| 374 | ;; that arise, for example, if one advises a subr like `eval-region' which | 351 | ;; that arise, for example, if one advises a subr like `eval-region' which |
| 375 | ;; gets redefined in a non-advice style into a function by the edebug | 352 | ;; gets redefined in a non-advice style into a function by the edebug |
| 376 | ;; package. If the advice assumes `eval-region' to be a subr it might break | 353 | ;; package. If the advice assumes `eval-region' to be a subr it might break |
| 377 | ;; once edebug is loaded. Similar situations arise when one wants to use the | 354 | ;; once edebug is loaded. Similar situations arise when one wants to use the |
| 378 | ;; same piece of advice across different versions of Emacs. | 355 | ;; same piece of advice across different versions of Emacs. |
| 379 | 356 | ||
| 380 | ;; As a solution to that advice provides argument list access macros that get | 357 | ;; As a solution to that advice provides argument list access macros that get |
| 381 | ;; translated into the proper access forms at activation time, i.e., when the | 358 | ;; translated into the proper access forms at activation time, i.e., when the |
| 382 | ;; advised definition gets constructed. Access macros access actual arguments | 359 | ;; advised definition gets constructed. Access macros access actual arguments |
| 383 | ;; by position regardless of how these actual argument get distributed onto | 360 | ;; by position regardless of how these actual argument get distributed onto |
| 384 | ;; the argument variables of a function. The rational behind this is that in | 361 | ;; the argument variables of a function. The rational behind this is that in |
| 385 | ;; Emacs Lisp the semantics of an argument is strictly determined by its | 362 | ;; Emacs Lisp the semantics of an argument is strictly determined by its |
| 386 | ;; position (there are no keyword arguments). | 363 | ;; position (there are no keyword arguments). |
| 387 | 364 | ||
| @@ -393,9 +370,9 @@ | |||
| 393 | ;; | 370 | ;; |
| 394 | ;; (foo 0 1 2 3 4 5 6) | 371 | ;; (foo 0 1 2 3 4 5 6) |
| 395 | 372 | ||
| 396 | ;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that | 373 | ;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that |
| 397 | ;; the semantics of an actual argument is determined by its position. It is | 374 | ;; the semantics of an actual argument is determined by its position. It is |
| 398 | ;; this semantics that has to be known by the advice programmer. Then s/he | 375 | ;; this semantics that has to be known by the advice programmer. Then s/he |
| 399 | ;; can access these arguments in a piece of advice with some of the | 376 | ;; can access these arguments in a piece of advice with some of the |
| 400 | ;; following macros (the arrows indicate what value they will return): | 377 | ;; following macros (the arrows indicate what value they will return): |
| 401 | 378 | ||
| @@ -408,17 +385,17 @@ | |||
| 408 | 385 | ||
| 409 | ;; `(ad-get-arg <position>)' will return the actual argument that was supplied | 386 | ;; `(ad-get-arg <position>)' will return the actual argument that was supplied |
| 410 | ;; at <position>, `(ad-get-args <position>)' will return the list of actual | 387 | ;; at <position>, `(ad-get-args <position>)' will return the list of actual |
| 411 | ;; arguments supplied starting at <position>. Note that these macros can be | 388 | ;; arguments supplied starting at <position>. Note that these macros can be |
| 412 | ;; used without any knowledge about the form of the actual argument list of | 389 | ;; used without any knowledge about the form of the actual argument list of |
| 413 | ;; the original function. | 390 | ;; the original function. |
| 414 | 391 | ||
| 415 | ;; Similarly, `(ad-set-arg <position> <value-form>)' can be used to set the | 392 | ;; Similarly, `(ad-set-arg <position> <value-form>)' can be used to set the |
| 416 | ;; value of the actual argument at <position> to <value-form>. For example, | 393 | ;; value of the actual argument at <position> to <value-form>. For example, |
| 417 | ;; | 394 | ;; |
| 418 | ;; (ad-set-arg 5 "five") | 395 | ;; (ad-set-arg 5 "five") |
| 419 | ;; | 396 | ;; |
| 420 | ;; will have the effect that R=(3 4 "five" 6) once the original function is | 397 | ;; will have the effect that R=(3 4 "five" 6) once the original function is |
| 421 | ;; called. `(ad-set-args <position> <value-list-form>)' can be used to set | 398 | ;; called. `(ad-set-args <position> <value-list-form>)' can be used to set |
| 422 | ;; the list of actual arguments starting at <position> to <value-list-form>. | 399 | ;; the list of actual arguments starting at <position> to <value-list-form>. |
| 423 | ;; For example, | 400 | ;; For example, |
| 424 | ;; | 401 | ;; |
| @@ -427,7 +404,7 @@ | |||
| 427 | ;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original | 404 | ;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original |
| 428 | ;; function is called. | 405 | ;; function is called. |
| 429 | 406 | ||
| 430 | ;; All these access macros are text macros rather than real Lisp macros. When | 407 | ;; All these access macros are text macros rather than real Lisp macros. When |
| 431 | ;; the advised definition gets constructed they get replaced with actual access | 408 | ;; the advised definition gets constructed they get replaced with actual access |
| 432 | ;; forms depending on the argument list of the advised function, i.e., after | 409 | ;; forms depending on the argument list of the advised function, i.e., after |
| 433 | ;; that argument access is in most cases as efficient as using the argument | 410 | ;; that argument access is in most cases as efficient as using the argument |
| @@ -437,7 +414,7 @@ | |||
| 437 | ;; ======================================================= | 414 | ;; ======================================================= |
| 438 | ;; Some functions (such as `trace-function' defined in trace.el) need a | 415 | ;; Some functions (such as `trace-function' defined in trace.el) need a |
| 439 | ;; method of accessing the names and bindings of the arguments of an | 416 | ;; method of accessing the names and bindings of the arguments of an |
| 440 | ;; arbitrary advised function. To do that within an advice one can use the | 417 | ;; arbitrary advised function. To do that within an advice one can use the |
| 441 | ;; special keyword `ad-arg-bindings' which is a text macro that will be | 418 | ;; special keyword `ad-arg-bindings' which is a text macro that will be |
| 442 | ;; substituted with a form that will evaluate to a list of binding | 419 | ;; substituted with a form that will evaluate to a list of binding |
| 443 | ;; specifications, one for every argument variable. These binding | 420 | ;; specifications, one for every argument variable. These binding |
| @@ -463,7 +440,7 @@ | |||
| 463 | ;; ========================== | 440 | ;; ========================== |
| 464 | ;; Because `defadvice' allows the specification of the argument list | 441 | ;; Because `defadvice' allows the specification of the argument list |
| 465 | ;; of the advised function we need a mapping mechanism that maps this | 442 | ;; of the advised function we need a mapping mechanism that maps this |
| 466 | ;; argument list onto that of the original function. Hence SYM and | 443 | ;; argument list onto that of the original function. Hence SYM and |
| 467 | ;; NEWDEF have to be properly mapped onto the &rest variable when the | 444 | ;; NEWDEF have to be properly mapped onto the &rest variable when the |
| 468 | ;; original definition is called. Advice automatically takes care of | 445 | ;; original definition is called. Advice automatically takes care of |
| 469 | ;; that mapping, hence, the advice programmer can specify an argument | 446 | ;; that mapping, hence, the advice programmer can specify an argument |
| @@ -474,11 +451,10 @@ | |||
| 474 | ;; @@ Activation and deactivation: | 451 | ;; @@ Activation and deactivation: |
| 475 | ;; =============================== | 452 | ;; =============================== |
| 476 | ;; The definition of an advised function does not change until all its advice | 453 | ;; The definition of an advised function does not change until all its advice |
| 477 | ;; gets actually activated. Activation can either happen with the `activate' | 454 | ;; gets actually activated. Activation can either happen with the `activate' |
| 478 | ;; flag specified in the `defadvice', with an explicit call or interactive | 455 | ;; flag specified in the `defadvice', with an explicit call or interactive |
| 479 | ;; invocation of `ad-activate', or if forward advice is enabled (i.e., the | 456 | ;; invocation of `ad-activate', or at the time an already advised function |
| 480 | ;; value of `ad-activate-on-definition' is t) at the time an already advised | 457 | ;; gets defined. |
| 481 | ;; function gets defined. | ||
| 482 | 458 | ||
| 483 | ;; When a function gets first activated its original definition gets saved, | 459 | ;; When a function gets first activated its original definition gets saved, |
| 484 | ;; all defined and enabled pieces of advice will get combined with the | 460 | ;; all defined and enabled pieces of advice will get combined with the |
| @@ -496,7 +472,7 @@ | |||
| 496 | ;; the file that contained the `defadvice' with the `preactivate' flag. | 472 | ;; the file that contained the `defadvice' with the `preactivate' flag. |
| 497 | 473 | ||
| 498 | ;; `ad-deactivate' can be used to back-define an advised function to its | 474 | ;; `ad-deactivate' can be used to back-define an advised function to its |
| 499 | ;; original definition. It can be called interactively or directly. Because | 475 | ;; original definition. It can be called interactively or directly. Because |
| 500 | ;; `ad-activate' caches the advised definition the function can be | 476 | ;; `ad-activate' caches the advised definition the function can be |
| 501 | ;; reactivated via `ad-activate' with only minor overhead (it is checked | 477 | ;; reactivated via `ad-activate' with only minor overhead (it is checked |
| 502 | ;; whether the current advice state is consistent with the cached | 478 | ;; whether the current advice state is consistent with the cached |
| @@ -504,12 +480,12 @@ | |||
| 504 | 480 | ||
| 505 | ;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate | 481 | ;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate |
| 506 | ;; all currently advised function that have a piece of advice with a name that | 482 | ;; all currently advised function that have a piece of advice with a name that |
| 507 | ;; contains a match for a regular expression. These functions can be used to | 483 | ;; contains a match for a regular expression. These functions can be used to |
| 508 | ;; de/activate sets of functions depending on certain advice naming | 484 | ;; de/activate sets of functions depending on certain advice naming |
| 509 | ;; conventions. | 485 | ;; conventions. |
| 510 | 486 | ||
| 511 | ;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to | 487 | ;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to |
| 512 | ;; de/activate all currently advised functions. These are useful to | 488 | ;; de/activate all currently advised functions. These are useful to |
| 513 | ;; (temporarily) return to an un/advised state. | 489 | ;; (temporarily) return to an un/advised state. |
| 514 | 490 | ||
| 515 | ;; @@@ Reasons for the separation of advice definition and activation: | 491 | ;; @@@ Reasons for the separation of advice definition and activation: |
| @@ -521,26 +497,26 @@ | |||
| 521 | 497 | ||
| 522 | ;; The advantage of this is that various pieces of advice can be defined | 498 | ;; The advantage of this is that various pieces of advice can be defined |
| 523 | ;; before they get combined into an advised definition which avoids | 499 | ;; before they get combined into an advised definition which avoids |
| 524 | ;; unnecessary constructions of intermediate advised definitions. The more | 500 | ;; unnecessary constructions of intermediate advised definitions. The more |
| 525 | ;; important advantage is that it allows the implementation of forward advice. | 501 | ;; important advantage is that it allows the implementation of forward advice. |
| 526 | ;; Advice information for a certain function accumulates as the value of the | 502 | ;; Advice information for a certain function accumulates as the value of the |
| 527 | ;; `advice-info' property of the function symbol. This accumulation is | 503 | ;; `advice-info' property of the function symbol. This accumulation is |
| 528 | ;; completely independent of the fact that that function might not yet be | 504 | ;; completely independent of the fact that that function might not yet be |
| 529 | ;; defined. The special forms `defun' and `defmacro' have been advised to | 505 | ;; defined. The macros `defun' and `defmacro' check whether the |
| 530 | ;; check whether the function/macro they defined had advice information | 506 | ;; function/macro they defined had advice information |
| 531 | ;; associated with it. If so and forward advice is enabled, the original | 507 | ;; associated with it. If so and forward advice is enabled, the original |
| 532 | ;; definition will be saved, and then the advice will be activated. | 508 | ;; definition will be saved, and then the advice will be activated. |
| 533 | 509 | ||
| 534 | ;; @@ Enabling/disabling pieces or sets of advice: | 510 | ;; @@ Enabling/disabling pieces or sets of advice: |
| 535 | ;; =============================================== | 511 | ;; =============================================== |
| 536 | ;; A major motivation for the development of this advice package was to bring | 512 | ;; A major motivation for the development of this advice package was to bring |
| 537 | ;; a little bit more structure into the function overloading chaos in Emacs | 513 | ;; a little bit more structure into the function overloading chaos in Emacs |
| 538 | ;; Lisp. Many packages achieve some of their functionality by adding a little | 514 | ;; Lisp. Many packages achieve some of their functionality by adding a little |
| 539 | ;; bit (or a lot) to the standard functionality of some Emacs Lisp function. | 515 | ;; bit (or a lot) to the standard functionality of some Emacs Lisp function. |
| 540 | ;; ange-ftp is a very popular package that achieves its magic by overloading | 516 | ;; ange-ftp is a very popular package that used to achieve its magic by |
| 541 | ;; most Emacs Lisp functions that deal with files. A popular function that's | 517 | ;; overloading most Emacs Lisp functions that deal with files. A popular |
| 542 | ;; overloaded by many packages is `expand-file-name'. The situation that one | 518 | ;; function that's overloaded by many packages is `expand-file-name'. |
| 543 | ;; function is multiply overloaded can arise easily. | 519 | ;; The situation that one function is multiply overloaded can arise easily. |
| 544 | 520 | ||
| 545 | ;; Once in a while it would be desirable to be able to disable some/all | 521 | ;; Once in a while it would be desirable to be able to disable some/all |
| 546 | ;; overloads of a particular package while keeping all the rest. Ideally - | 522 | ;; overloads of a particular package while keeping all the rest. Ideally - |
| @@ -548,7 +524,7 @@ | |||
| 548 | ;; I know I am dreaming right now... In that ideal case the enable/disable | 524 | ;; I know I am dreaming right now... In that ideal case the enable/disable |
| 549 | ;; mechanism of advice could be used to achieve just that. | 525 | ;; mechanism of advice could be used to achieve just that. |
| 550 | 526 | ||
| 551 | ;; Every piece of advice is associated with an enablement flag. When the | 527 | ;; Every piece of advice is associated with an enablement flag. When the |
| 552 | ;; advised definition of a particular function gets constructed (e.g., during | 528 | ;; advised definition of a particular function gets constructed (e.g., during |
| 553 | ;; activation) only the currently enabled pieces of advice will be considered. | 529 | ;; activation) only the currently enabled pieces of advice will be considered. |
| 554 | ;; This mechanism allows one to have different "views" of an advised function | 530 | ;; This mechanism allows one to have different "views" of an advised function |
| @@ -556,17 +532,15 @@ | |||
| 556 | 532 | ||
| 557 | ;; Another motivation for this mechanism is that it allows one to define a | 533 | ;; Another motivation for this mechanism is that it allows one to define a |
| 558 | ;; piece of advice for some function yet keep it dormant until a certain | 534 | ;; piece of advice for some function yet keep it dormant until a certain |
| 559 | ;; condition is met. Until then activation of the function will not make use | 535 | ;; condition is met. Until then activation of the function will not make use |
| 560 | ;; of that piece of advice. Once the condition is met the advice can be | 536 | ;; of that piece of advice. Once the condition is met the advice can be |
| 561 | ;; enabled and a reactivation of the function will add its functionality as | 537 | ;; enabled and a reactivation of the function will add its functionality as |
| 562 | ;; part of the new advised definition. For example, the advices of `defun' | 538 | ;; part of the new advised definition. Hence, if somebody |
| 563 | ;; etc. used by advice itself will stay disabled until `ad-start-advice' is | ||
| 564 | ;; called and some variables have the proper values. Hence, if somebody | ||
| 565 | ;; else advised these functions too and activates them the advices defined | 539 | ;; else advised these functions too and activates them the advices defined |
| 566 | ;; by advice will get used only if they are intended to be used. | 540 | ;; by advice will get used only if they are intended to be used. |
| 567 | 541 | ||
| 568 | ;; The main interface to this mechanism are the interactive functions | 542 | ;; The main interface to this mechanism are the interactive functions |
| 569 | ;; `ad-enable-advice' and `ad-disable-advice'. For example, the following | 543 | ;; `ad-enable-advice' and `ad-disable-advice'. For example, the following |
| 570 | ;; would disable a particular advice of the function `foo': | 544 | ;; would disable a particular advice of the function `foo': |
| 571 | ;; | 545 | ;; |
| 572 | ;; (ad-disable-advice 'foo 'before 'my-advice) | 546 | ;; (ad-disable-advice 'foo 'before 'my-advice) |
| @@ -576,28 +550,28 @@ | |||
| 576 | ;; | 550 | ;; |
| 577 | ;; (ad-activate 'foo) | 551 | ;; (ad-activate 'foo) |
| 578 | ;; | 552 | ;; |
| 579 | ;; or interactively. To disable whole sets of advices one can use a regular | 553 | ;; or interactively. To disable whole sets of advices one can use a regular |
| 580 | ;; expression mechanism. For example, let us assume that ange-ftp actually | 554 | ;; expression mechanism. For example, let us assume that ange-ftp actually |
| 581 | ;; used advice to overload all its functions, and that it used the | 555 | ;; used advice to overload all its functions, and that it used the |
| 582 | ;; "ange-ftp-" prefix for all its advice names, then we could temporarily | 556 | ;; "ange-ftp-" prefix for all its advice names, then we could temporarily |
| 583 | ;; disable all its advices with | 557 | ;; disable all its advices with |
| 584 | ;; | 558 | ;; |
| 585 | ;; (ad-disable-regexp "^ange-ftp-") | 559 | ;; (ad-disable-regexp "\\`ange-ftp-") |
| 586 | ;; | 560 | ;; |
| 587 | ;; and the following call would put that actually into effect: | 561 | ;; and the following call would put that actually into effect: |
| 588 | ;; | 562 | ;; |
| 589 | ;; (ad-activate-regexp "^ange-ftp-") | 563 | ;; (ad-activate-regexp "\\`ange-ftp-") |
| 590 | ;; | 564 | ;; |
| 591 | ;; A safer way would have been to use | 565 | ;; A safer way would have been to use |
| 592 | ;; | 566 | ;; |
| 593 | ;; (ad-update-regexp "^ange-ftp-") | 567 | ;; (ad-update-regexp "\\`ange-ftp-") |
| 594 | ;; | 568 | ;; |
| 595 | ;; instead which would have only reactivated currently actively advised | 569 | ;; instead which would have only reactivated currently actively advised |
| 596 | ;; functions, but not functions that were currently inactive. All these | 570 | ;; functions, but not functions that were currently inactive. All these |
| 597 | ;; functions can also be called interactively. | 571 | ;; functions can also be called interactively. |
| 598 | 572 | ||
| 599 | ;; A certain piece of advice is considered a match if its name contains a | 573 | ;; A certain piece of advice is considered a match if its name contains a |
| 600 | ;; match for the regular expression. To enable ange-ftp again we would use | 574 | ;; match for the regular expression. To enable ange-ftp again we would use |
| 601 | ;; `ad-enable-regexp' and then activate or update again. | 575 | ;; `ad-enable-regexp' and then activate or update again. |
| 602 | 576 | ||
| 603 | ;; @@ Forward advice, automatic advice activation: | 577 | ;; @@ Forward advice, automatic advice activation: |
| @@ -616,7 +590,7 @@ | |||
| 616 | ;; of advice definition and activation that makes it possible to accumulate | 590 | ;; of advice definition and activation that makes it possible to accumulate |
| 617 | ;; advice information without having the original function already defined, | 591 | ;; advice information without having the original function already defined, |
| 618 | ;; 2) special versions of the built-in functions `fset/defalias' which check | 592 | ;; 2) special versions of the built-in functions `fset/defalias' which check |
| 619 | ;; for advice information whenever they define a function. If advice | 593 | ;; for advice information whenever they define a function. If advice |
| 620 | ;; information was found then the advice will immediately get activated when | 594 | ;; information was found then the advice will immediately get activated when |
| 621 | ;; the function gets defined. | 595 | ;; the function gets defined. |
| 622 | 596 | ||
| @@ -625,16 +599,11 @@ | |||
| 625 | ;; file, and the function has some advice-info stored with it then that | 599 | ;; file, and the function has some advice-info stored with it then that |
| 626 | ;; advice will get activated right away. | 600 | ;; advice will get activated right away. |
| 627 | 601 | ||
| 628 | ;; @@@ Enabling automatic advice activation: | ||
| 629 | ;; ========================================= | ||
| 630 | ;; Automatic advice activation is enabled by default. It can be disabled with | ||
| 631 | ;; `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'. | ||
| 632 | |||
| 633 | ;; @@ Caching of advised definitions: | 602 | ;; @@ Caching of advised definitions: |
| 634 | ;; ================================== | 603 | ;; ================================== |
| 635 | ;; After an advised definition got constructed it gets cached as part of the | 604 | ;; After an advised definition got constructed it gets cached as part of the |
| 636 | ;; advised function's advice-info so it can be reused, for example, after an | 605 | ;; advised function's advice-info so it can be reused, for example, after an |
| 637 | ;; intermediate deactivation. Because the advice-info of a function might | 606 | ;; intermediate deactivation. Because the advice-info of a function might |
| 638 | ;; change between the time of caching and reuse a cached definition gets | 607 | ;; change between the time of caching and reuse a cached definition gets |
| 639 | ;; a cache-id associated with it so it can be verified whether the cached | 608 | ;; a cache-id associated with it so it can be verified whether the cached |
| 640 | ;; definition is still valid (the main application of this is preactivation | 609 | ;; definition is still valid (the main application of this is preactivation |
| @@ -642,19 +611,19 @@ | |||
| 642 | 611 | ||
| 643 | ;; When an advised function gets activated and a verifiable cached definition | 612 | ;; When an advised function gets activated and a verifiable cached definition |
| 644 | ;; is available, then that definition will be used instead of creating a new | 613 | ;; is available, then that definition will be used instead of creating a new |
| 645 | ;; advised definition from scratch. If you want to make sure that a new | 614 | ;; advised definition from scratch. If you want to make sure that a new |
| 646 | ;; definition gets constructed then you should use `ad-clear-cache' before you | 615 | ;; definition gets constructed then you should use `ad-clear-cache' before you |
| 647 | ;; activate the advised function. | 616 | ;; activate the advised function. |
| 648 | 617 | ||
| 649 | ;; @@ Preactivation: | 618 | ;; @@ Preactivation: |
| 650 | ;; ================= | 619 | ;; ================= |
| 651 | ;; Constructing an advised definition is moderately expensive. In a situation | 620 | ;; Constructing an advised definition is moderately expensive. In a situation |
| 652 | ;; where one package defines a lot of advised functions it might be | 621 | ;; where one package defines a lot of advised functions it might be |
| 653 | ;; prohibitively expensive to do all the advised definition construction at | 622 | ;; prohibitively expensive to do all the advised definition construction at |
| 654 | ;; runtime. Preactivation is a mechanism that allows compile-time construction | 623 | ;; runtime. Preactivation is a mechanism that allows compile-time construction |
| 655 | ;; of compiled advised definitions that can be activated cheaply during | 624 | ;; of compiled advised definitions that can be activated cheaply during |
| 656 | ;; runtime. Preactivation uses the caching mechanism to do that. Here's how it | 625 | ;; runtime. Preactivation uses the caching mechanism to do that. Here's how |
| 657 | ;; works: | 626 | ;; it works: |
| 658 | 627 | ||
| 659 | ;; When the byte-compiler compiles a `defadvice' that has the `preactivate' | 628 | ;; When the byte-compiler compiles a `defadvice' that has the `preactivate' |
| 660 | ;; flag specified, it uses the current original definition of the advised | 629 | ;; flag specified, it uses the current original definition of the advised |
| @@ -665,27 +634,27 @@ | |||
| 665 | ;; byte-compiler. | 634 | ;; byte-compiler. |
| 666 | ;; When the file with the compiled, preactivating `defadvice' gets loaded the | 635 | ;; When the file with the compiled, preactivating `defadvice' gets loaded the |
| 667 | ;; precompiled advised definition will be cached on the advised function's | 636 | ;; precompiled advised definition will be cached on the advised function's |
| 668 | ;; advice-info. When it gets activated (can be immediately on execution of the | 637 | ;; advice-info. When it gets activated (can be immediately on execution of the |
| 669 | ;; `defadvice' or any time later) the cache-id gets checked against the | 638 | ;; `defadvice' or any time later) the cache-id gets checked against the |
| 670 | ;; current state of advice and if it is verified the precompiled definition | 639 | ;; current state of advice and if it is verified the precompiled definition |
| 671 | ;; will be used directly (the verification is pretty cheap). If it couldn't get | 640 | ;; will be used directly (the verification is pretty cheap). If it couldn't |
| 672 | ;; verified a new advised definition for that function will be built from | 641 | ;; get verified a new advised definition for that function will be built from |
| 673 | ;; scratch, hence, the efficiency added by the preactivation mechanism does | 642 | ;; scratch, hence, the efficiency added by the preactivation mechanism does not |
| 674 | ;; not at all impair the flexibility of the advice mechanism. | 643 | ;; at all impair the flexibility of the advice mechanism. |
| 675 | 644 | ||
| 676 | ;; MORAL: In order get all the efficiency out of preactivation the advice | 645 | ;; MORAL: In order get all the efficiency out of preactivation the advice |
| 677 | ;; state of an advised function at the time the file with the | 646 | ;; state of an advised function at the time the file with the |
| 678 | ;; preactivating `defadvice' gets byte-compiled should be exactly | 647 | ;; preactivating `defadvice' gets byte-compiled should be exactly |
| 679 | ;; the same as it will be when the advice of that function gets | 648 | ;; the same as it will be when the advice of that function gets |
| 680 | ;; actually activated. If it is not there is a high chance that the | 649 | ;; actually activated. If it is not there is a high chance that the |
| 681 | ;; cache-id will not match and hence a new advised definition will | 650 | ;; cache-id will not match and hence a new advised definition will |
| 682 | ;; have to be constructed at runtime. | 651 | ;; have to be constructed at runtime. |
| 683 | 652 | ||
| 684 | ;; Preactivation and forward advice do not contradict each other. It is | 653 | ;; Preactivation and forward advice do not contradict each other. It is |
| 685 | ;; perfectly ok to load a file with a preactivating `defadvice' before the | 654 | ;; perfectly ok to load a file with a preactivating `defadvice' before the |
| 686 | ;; original definition of the advised function is available. The constructed | 655 | ;; original definition of the advised function is available. The constructed |
| 687 | ;; advised definition will be used once the original function gets defined and | 656 | ;; advised definition will be used once the original function gets defined and |
| 688 | ;; its advice gets activated. The only constraint is that at the time the | 657 | ;; its advice gets activated. The only constraint is that at the time the |
| 689 | ;; file with the preactivating `defadvice' got compiled the original function | 658 | ;; file with the preactivating `defadvice' got compiled the original function |
| 690 | ;; definition was available. | 659 | ;; definition was available. |
| 691 | 660 | ||
| @@ -697,18 +666,18 @@ | |||
| 697 | ;; - `byte-compile' is part of the `features' variable even though you | 666 | ;; - `byte-compile' is part of the `features' variable even though you |
| 698 | ;; did not use the byte-compiler | 667 | ;; did not use the byte-compiler |
| 699 | ;; Right now advice does not provide an elegant way to find out whether | 668 | ;; Right now advice does not provide an elegant way to find out whether |
| 700 | ;; and why a preactivation failed. What you can do is to trace the | 669 | ;; and why a preactivation failed. What you can do is to trace the |
| 701 | ;; function `ad-cache-id-verification-code' (with the function | 670 | ;; function `ad-cache-id-verification-code' (with the function |
| 702 | ;; `trace-function-background' defined in my trace.el package) before | 671 | ;; `trace-function-background' defined in my trace.el package) before |
| 703 | ;; any of your advised functions get activated. After they got | 672 | ;; any of your advised functions get activated. After they got |
| 704 | ;; activated check whether all calls to `ad-cache-id-verification-code' | 673 | ;; activated check whether all calls to `ad-cache-id-verification-code' |
| 705 | ;; returned `verified' as a result. Other values indicate why the | 674 | ;; returned `verified' as a result. Other values indicate why the |
| 706 | ;; verification failed which should give you enough information to | 675 | ;; verification failed which should give you enough information to |
| 707 | ;; fix your preactivation/compile/load/activation sequence. | 676 | ;; fix your preactivation/compile/load/activation sequence. |
| 708 | 677 | ||
| 709 | ;; IMPORTANT: There is one case (that I am aware of) that can make | 678 | ;; IMPORTANT: There is one case (that I am aware of) that can make |
| 710 | ;; preactivation fail, i.e., a preconstructed advised definition that does | 679 | ;; preactivation fail, i.e., a preconstructed advised definition that does |
| 711 | ;; NOT match the current state of advice gets used nevertheless. That case | 680 | ;; NOT match the current state of advice gets used nevertheless. That case |
| 712 | ;; arises if one package defines a certain piece of advice which gets used | 681 | ;; arises if one package defines a certain piece of advice which gets used |
| 713 | ;; during preactivation, and another package incompatibly redefines that | 682 | ;; during preactivation, and another package incompatibly redefines that |
| 714 | ;; very advice (i.e., same function/class/name), and it is the second advice | 683 | ;; very advice (i.e., same function/class/name), and it is the second advice |
| @@ -720,30 +689,20 @@ | |||
| 720 | ;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with | 689 | ;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with |
| 721 | ;; George Walker Bush), and why would you redefine your own advice anyway? | 690 | ;; George Walker Bush), and why would you redefine your own advice anyway? |
| 722 | ;; Advice is a mechanism to facilitate function redefinition, not advice | 691 | ;; Advice is a mechanism to facilitate function redefinition, not advice |
| 723 | ;; redefinition (wait until I write Meta-Advice :-). If you really have | 692 | ;; redefinition (wait until I write Meta-Advice :-). If you really have |
| 724 | ;; to undo somebody else's advice try to write a "neutralizing" advice. | 693 | ;; to undo somebody else's advice, try to write a "neutralizing" advice. |
| 725 | 694 | ||
| 726 | ;; @@ Advising macros and special forms and other dangerous things: | 695 | ;; @@ Advising macros and other dangerous things: |
| 727 | ;; ================================================================ | 696 | ;; ============================================== |
| 728 | ;; Look at the corresponding tutorial sections for more information on | 697 | ;; Look at the corresponding tutorial sections for more information on |
| 729 | ;; these topics. Here it suffices to point out that the special treatment | 698 | ;; these topics. Here it suffices to point out that the special treatment |
| 730 | ;; of macros and special forms by the byte-compiler can lead to problems | 699 | ;; of macros can lead to problems when they get advised. Macros can create |
| 731 | ;; when they get advised. Macros can create problems because they get | 700 | ;; problems because they get expanded at compile or load time, hence, they |
| 732 | ;; expanded at compile time, hence, they might not have all the necessary | 701 | ;; might not have all the necessary runtime support and such advice cannot be |
| 733 | ;; runtime support and such advice cannot be de/activated or changed as | 702 | ;; de/activated or changed as it is possible for functions. |
| 734 | ;; it is possible for functions. Special forms create problems because they | 703 | ;; Special forms cannot be advised. |
| 735 | ;; have to be advised "into" macros, i.e., an advised special form is a | 704 | ;; |
| 736 | ;; implemented as a macro, hence, in most cases the byte-compiler will | 705 | ;; MORAL: - Only advise macros when you are absolutely sure what you are doing. |
| 737 | ;; not recognize it as a special form anymore which can lead to very strange | ||
| 738 | ;; results. | ||
| 739 | ;; | ||
| 740 | ;; MORAL: - Only advise macros or special forms when you are absolutely sure | ||
| 741 | ;; what you are doing. | ||
| 742 | ;; - As a safety measure, always do `ad-deactivate-all' before you | ||
| 743 | ;; byte-compile a file to make sure that even if some inconsiderate | ||
| 744 | ;; person advised some special forms you'll get proper compilation | ||
| 745 | ;; results. After compilation do `ad-activate-all' to get back to | ||
| 746 | ;; the previous state. | ||
| 747 | 706 | ||
| 748 | ;; @@ Adding a piece of advice with `ad-add-advice': | 707 | ;; @@ Adding a piece of advice with `ad-add-advice': |
| 749 | ;; ================================================= | 708 | ;; ================================================= |
| @@ -754,10 +713,10 @@ | |||
| 754 | ;; @@ Activation/deactivation advices, file load hooks: | 713 | ;; @@ Activation/deactivation advices, file load hooks: |
| 755 | ;; ==================================================== | 714 | ;; ==================================================== |
| 756 | ;; There are two special classes of advice called `activation' and | 715 | ;; There are two special classes of advice called `activation' and |
| 757 | ;; `deactivation'. The body forms of these advices are not included into the | 716 | ;; `deactivation'. The body forms of these advices are not included into the |
| 758 | ;; advised definition of a function, rather they are assembled into a hook | 717 | ;; advised definition of a function, rather they are assembled into a hook |
| 759 | ;; form which will be evaluated whenever the advice-info of the advised | 718 | ;; form which will be evaluated whenever the advice-info of the advised |
| 760 | ;; function gets activated or deactivated. One application of this mechanism | 719 | ;; function gets activated or deactivated. One application of this mechanism |
| 761 | ;; is to define file load hooks for files that do not provide such hooks. | 720 | ;; is to define file load hooks for files that do not provide such hooks. |
| 762 | ;; For example, suppose you want to print a message whenever `file-x' gets | 721 | ;; For example, suppose you want to print a message whenever `file-x' gets |
| 763 | ;; loaded, and suppose the last function defined in `file-x' is | 722 | ;; loaded, and suppose the last function defined in `file-x' is |
| @@ -769,7 +728,7 @@ | |||
| 769 | ;; | 728 | ;; |
| 770 | ;; This will constitute a forward advice for function `file-x-last-fn' which | 729 | ;; This will constitute a forward advice for function `file-x-last-fn' which |
| 771 | ;; will get activated when `file-x' is loaded (only if forward advice is | 730 | ;; will get activated when `file-x' is loaded (only if forward advice is |
| 772 | ;; enabled of course). Because there are no "real" pieces of advice | 731 | ;; enabled of course). Because there are no "real" pieces of advice |
| 773 | ;; available for it, its definition will not be changed, but the activation | 732 | ;; available for it, its definition will not be changed, but the activation |
| 774 | ;; advice will be run during its activation which is equivalent to having a | 733 | ;; advice will be run during its activation which is equivalent to having a |
| 775 | ;; file load hook for `file-x'. | 734 | ;; file load hook for `file-x'. |
| @@ -784,14 +743,14 @@ | |||
| 784 | ;; enabled advices are considered during construction of an advised | 743 | ;; enabled advices are considered during construction of an advised |
| 785 | ;; definition. | 744 | ;; definition. |
| 786 | ;; - Activation: | 745 | ;; - Activation: |
| 787 | ;; Redefine an advised function with its advised definition. Constructs | 746 | ;; Redefine an advised function with its advised definition. Constructs |
| 788 | ;; an advised definition from scratch if no verifiable cached advised | 747 | ;; an advised definition from scratch if no verifiable cached advised |
| 789 | ;; definition is available and caches it. | 748 | ;; definition is available and caches it. |
| 790 | ;; - Deactivation: | 749 | ;; - Deactivation: |
| 791 | ;; Back-define an advised function to its original definition. | 750 | ;; Back-define an advised function to its original definition. |
| 792 | ;; - Update: | 751 | ;; - Update: |
| 793 | ;; Reactivate an advised function but only if its advice is currently | 752 | ;; Reactivate an advised function but only if its advice is currently |
| 794 | ;; active. This can be used to bring all currently advised function up | 753 | ;; active. This can be used to bring all currently advised function up |
| 795 | ;; to date with the current state of advice without also activating | 754 | ;; to date with the current state of advice without also activating |
| 796 | ;; currently inactive functions. | 755 | ;; currently inactive functions. |
| 797 | ;; - Caching: | 756 | ;; - Caching: |
| @@ -800,7 +759,7 @@ | |||
| 800 | ;; - Preactivation: | 759 | ;; - Preactivation: |
| 801 | ;; Is the construction of an advised definition according to the current | 760 | ;; Is the construction of an advised definition according to the current |
| 802 | ;; state of advice during byte-compilation of a file with a preactivating | 761 | ;; state of advice during byte-compilation of a file with a preactivating |
| 803 | ;; `defadvice'. That advised definition can then rather cheaply be used | 762 | ;; `defadvice'. That advised definition can then rather cheaply be used |
| 804 | ;; during activation without having to construct an advised definition | 763 | ;; during activation without having to construct an advised definition |
| 805 | ;; from scratch at runtime. | 764 | ;; from scratch at runtime. |
| 806 | 765 | ||
| @@ -860,12 +819,8 @@ | |||
| 860 | 819 | ||
| 861 | ;; @ Foo games: An advice tutorial | 820 | ;; @ Foo games: An advice tutorial |
| 862 | ;; =============================== | 821 | ;; =============================== |
| 863 | ;; The following tutorial was created in Emacs 18.59. Left-justified | 822 | ;; The following tutorial was created in Emacs 18.59. Left-justified |
| 864 | ;; s-expressions are input forms followed by one or more result forms. | 823 | ;; s-expressions are input forms followed by one or more result forms. |
| 865 | ;; First we have to start the advice magic: | ||
| 866 | ;; | ||
| 867 | ;; (ad-start-advice) | ||
| 868 | ;; nil | ||
| 869 | ;; | 824 | ;; |
| 870 | ;; We start by defining an innocent looking function `foo' that simply | 825 | ;; We start by defining an innocent looking function `foo' that simply |
| 871 | ;; adds 1 to its argument X: | 826 | ;; adds 1 to its argument X: |
| @@ -988,19 +943,6 @@ | |||
| 988 | ;; (call-interactively 'foo) | 943 | ;; (call-interactively 'foo) |
| 989 | ;; 6 | 944 | ;; 6 |
| 990 | ;; | 945 | ;; |
| 991 | ;; Let's have a look at what the definition of `foo' looks like now | ||
| 992 | ;; (indentation added by hand for legibility): | ||
| 993 | ;; | ||
| 994 | ;; (symbol-function 'foo) | ||
| 995 | ;; (lambda (x) | ||
| 996 | ;; "$ad-doc: foo$" | ||
| 997 | ;; (interactive (list 5)) | ||
| 998 | ;; (let (ad-return-value) | ||
| 999 | ;; (setq x (1- x)) | ||
| 1000 | ;; (setq x (1+ x)) | ||
| 1001 | ;; (setq ad-return-value (ad-Orig-foo x)) | ||
| 1002 | ;; ad-return-value)) | ||
| 1003 | ;; | ||
| 1004 | ;; @@ Around advices: | 946 | ;; @@ Around advices: |
| 1005 | ;; ================== | 947 | ;; ================== |
| 1006 | ;; Now we'll try some `around' advices. An around advice is a wrapper around | 948 | ;; Now we'll try some `around' advices. An around advice is a wrapper around |
| @@ -1038,20 +980,6 @@ | |||
| 1038 | ;; (foo 3) | 980 | ;; (foo 3) |
| 1039 | ;; 8 | 981 | ;; 8 |
| 1040 | ;; | 982 | ;; |
| 1041 | ;; Again, let's see what the definition of `foo' looks like so far: | ||
| 1042 | ;; | ||
| 1043 | ;; (symbol-function 'foo) | ||
| 1044 | ;; (lambda (x) | ||
| 1045 | ;; "$ad-doc: foo$" | ||
| 1046 | ;; (interactive (list 5)) | ||
| 1047 | ;; (let (ad-return-value) | ||
| 1048 | ;; (setq x (1- x)) | ||
| 1049 | ;; (setq x (1+ x)) | ||
| 1050 | ;; (let ((x (* x 2))) | ||
| 1051 | ;; (let ((x (1+ x))) | ||
| 1052 | ;; (setq ad-return-value (ad-Orig-foo x)))) | ||
| 1053 | ;; ad-return-value)) | ||
| 1054 | ;; | ||
| 1055 | ;; @@ Controlling advice activation: | 983 | ;; @@ Controlling advice activation: |
| 1056 | ;; ================================= | 984 | ;; ================================= |
| 1057 | ;; In every `defadvice' so far we have used the flag `activate' to activate | 985 | ;; In every `defadvice' so far we have used the flag `activate' to activate |
| @@ -1071,9 +999,9 @@ | |||
| 1071 | ;; 8 | 999 | ;; 8 |
| 1072 | ;; | 1000 | ;; |
| 1073 | ;; Now we define another advice and activate which will also activate the | 1001 | ;; Now we define another advice and activate which will also activate the |
| 1074 | ;; previous advice `fg-times-x'. Note the use of the special variable | 1002 | ;; previous advice `fg-times-x'. Note the use of the special variable |
| 1075 | ;; `ad-return-value' in the body of the advice which is set to the result of | 1003 | ;; `ad-return-value' in the body of the advice which is set to the result of |
| 1076 | ;; the original function. If we change its value then the value returned by | 1004 | ;; the original function. If we change its value then the value returned by |
| 1077 | ;; the advised function will be changed accordingly: | 1005 | ;; the advised function will be changed accordingly: |
| 1078 | ;; | 1006 | ;; |
| 1079 | ;; (defadvice foo (after fg-times-x-again act) | 1007 | ;; (defadvice foo (after fg-times-x-again act) |
| @@ -1121,24 +1049,6 @@ | |||
| 1121 | ;; "Let's clean up now!" | 1049 | ;; "Let's clean up now!" |
| 1122 | ;; error-in-foo | 1050 | ;; error-in-foo |
| 1123 | ;; | 1051 | ;; |
| 1124 | ;; Again, let's see what `foo' looks like: | ||
| 1125 | ;; | ||
| 1126 | ;; (symbol-function 'foo) | ||
| 1127 | ;; (lambda (x) | ||
| 1128 | ;; "$ad-doc: foo$" | ||
| 1129 | ;; (interactive (list 5)) | ||
| 1130 | ;; (let (ad-return-value) | ||
| 1131 | ;; (unwind-protect | ||
| 1132 | ;; (progn (setq x (1- x)) | ||
| 1133 | ;; (setq x (1+ x)) | ||
| 1134 | ;; (let ((x (* x 2))) | ||
| 1135 | ;; (let ((x (1+ x))) | ||
| 1136 | ;; (setq ad-return-value (ad-Orig-foo x)))) | ||
| 1137 | ;; (setq ad-return-value (* ad-return-value x)) | ||
| 1138 | ;; (setq ad-return-value (* ad-return-value x))) | ||
| 1139 | ;; (print "Let's clean up now!")) | ||
| 1140 | ;; ad-return-value)) | ||
| 1141 | ;; | ||
| 1142 | ;; @@ Compilation of advised definitions: | 1052 | ;; @@ Compilation of advised definitions: |
| 1143 | ;; ====================================== | 1053 | ;; ====================================== |
| 1144 | ;; Finally, we can specify the `compile' keyword in a `defadvice' to say | 1054 | ;; Finally, we can specify the `compile' keyword in a `defadvice' to say |
| @@ -1150,13 +1060,10 @@ | |||
| 1150 | ;; (print "Let's clean up now!")) | 1060 | ;; (print "Let's clean up now!")) |
| 1151 | ;; foo | 1061 | ;; foo |
| 1152 | ;; | 1062 | ;; |
| 1153 | ;; Now `foo' is byte-compiled: | 1063 | ;; Now `foo's advice is byte-compiled: |
| 1154 | ;; | 1064 | ;; |
| 1155 | ;; (symbol-function 'foo) | 1065 | ;; (byte-code-function-p 'ad-Advice-foo) |
| 1156 | ;; (lambda (x) | 1066 | ;; t |
| 1157 | ;; "$ad-doc: foo$" | ||
| 1158 | ;; (interactive (byte-code "....." [5] 1)) | ||
| 1159 | ;; (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6)) | ||
| 1160 | ;; | 1067 | ;; |
| 1161 | ;; (foo 3) | 1068 | ;; (foo 3) |
| 1162 | ;; "Let's clean up now!" | 1069 | ;; "Let's clean up now!" |
| @@ -1262,7 +1169,7 @@ | |||
| 1262 | ;; deactivate functions that have a piece of advice defined by a certain | 1169 | ;; deactivate functions that have a piece of advice defined by a certain |
| 1263 | ;; package (we save the old definition to check out caching): | 1170 | ;; package (we save the old definition to check out caching): |
| 1264 | ;; | 1171 | ;; |
| 1265 | ;; (setq old-definition (symbol-function 'foo)) | 1172 | ;; (setq old-definition (symbol-function 'ad-Advice-foo)) |
| 1266 | ;; (lambda (x) ....) | 1173 | ;; (lambda (x) ....) |
| 1267 | ;; | 1174 | ;; |
| 1268 | ;; (ad-deactivate-regexp "^fg-") | 1175 | ;; (ad-deactivate-regexp "^fg-") |
| @@ -1274,7 +1181,7 @@ | |||
| 1274 | ;; (ad-activate-regexp "^fg-") | 1181 | ;; (ad-activate-regexp "^fg-") |
| 1275 | ;; nil | 1182 | ;; nil |
| 1276 | ;; | 1183 | ;; |
| 1277 | ;; (eq old-definition (symbol-function 'foo)) | 1184 | ;; (eq old-definition (symbol-function 'ad-Advice-foo)) |
| 1278 | ;; t | 1185 | ;; t |
| 1279 | ;; | 1186 | ;; |
| 1280 | ;; (foo 3) | 1187 | ;; (foo 3) |
| @@ -1283,14 +1190,6 @@ | |||
| 1283 | ;; | 1190 | ;; |
| 1284 | ;; @@ Forward advice: | 1191 | ;; @@ Forward advice: |
| 1285 | ;; ================== | 1192 | ;; ================== |
| 1286 | ;; To enable automatic activation of forward advice we first have to set | ||
| 1287 | ;; `ad-activate-on-definition' to t and restart advice: | ||
| 1288 | ;; | ||
| 1289 | ;; (setq ad-activate-on-definition t) | ||
| 1290 | ;; t | ||
| 1291 | ;; | ||
| 1292 | ;; (ad-start-advice) | ||
| 1293 | ;; (ad-activate-defined-function) | ||
| 1294 | ;; | 1193 | ;; |
| 1295 | ;; Let's define a piece of advice for an undefined function: | 1194 | ;; Let's define a piece of advice for an undefined function: |
| 1296 | ;; | 1195 | ;; |
| @@ -1303,9 +1202,7 @@ | |||
| 1303 | ;; (fboundp 'bar) | 1202 | ;; (fboundp 'bar) |
| 1304 | ;; nil | 1203 | ;; nil |
| 1305 | ;; | 1204 | ;; |
| 1306 | ;; Now we define it and the forward advice will get activated (only because | 1205 | ;; Now we define it and the forward advice will get activated: |
| 1307 | ;; `ad-activate-on-definition' was t when we started advice above with | ||
| 1308 | ;; `ad-start-advice'): | ||
| 1309 | ;; | 1206 | ;; |
| 1310 | ;; (defun bar (x) | 1207 | ;; (defun bar (x) |
| 1311 | ;; "Subtract 1 from X." | 1208 | ;; "Subtract 1 from X." |
| @@ -1357,7 +1254,7 @@ | |||
| 1357 | ;; (ad-activate 'fie) | 1254 | ;; (ad-activate 'fie) |
| 1358 | ;; fie | 1255 | ;; fie |
| 1359 | ;; | 1256 | ;; |
| 1360 | ;; (eq cached-definition (symbol-function 'fie)) | 1257 | ;; (eq cached-definition (symbol-function 'ad-Advice-fie)) |
| 1361 | ;; t | 1258 | ;; t |
| 1362 | ;; | 1259 | ;; |
| 1363 | ;; (fie 2) | 1260 | ;; (fie 2) |
| @@ -1365,7 +1262,7 @@ | |||
| 1365 | ;; | 1262 | ;; |
| 1366 | ;; If you put a preactivating `defadvice' into a Lisp file that gets byte- | 1263 | ;; If you put a preactivating `defadvice' into a Lisp file that gets byte- |
| 1367 | ;; compiled then the constructed advised definition will get compiled by | 1264 | ;; compiled then the constructed advised definition will get compiled by |
| 1368 | ;; the byte-compiler. For that to occur in a v18 Emacs you had to put the | 1265 | ;; the byte-compiler. For that to occur in a v18 Emacs you had to put the |
| 1369 | ;; `defadvice' inside a `defun' because the v18 compiler did not compile | 1266 | ;; `defadvice' inside a `defun' because the v18 compiler did not compile |
| 1370 | ;; top-level forms other than `defun' or `defmacro', for example, | 1267 | ;; top-level forms other than `defun' or `defmacro', for example, |
| 1371 | ;; | 1268 | ;; |
| @@ -1407,18 +1304,16 @@ | |||
| 1407 | ;; constructed during preactivation was used, even though we did not specify | 1304 | ;; constructed during preactivation was used, even though we did not specify |
| 1408 | ;; the `compile' flag: | 1305 | ;; the `compile' flag: |
| 1409 | ;; | 1306 | ;; |
| 1410 | ;; (symbol-function 'fum) | 1307 | ;; (byte-code-function-p 'ad-Advice-fum) |
| 1411 | ;; (lambda (x) | 1308 | ;; t |
| 1412 | ;; "$ad-doc: fum$" | ||
| 1413 | ;; (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4)) | ||
| 1414 | ;; | 1309 | ;; |
| 1415 | ;; (fum 2) | 1310 | ;; (fum 2) |
| 1416 | ;; 8 | 1311 | ;; 8 |
| 1417 | ;; | 1312 | ;; |
| 1418 | ;; A preactivated definition will only be used if it matches the current | 1313 | ;; A preactivated definition will only be used if it matches the current |
| 1419 | ;; function definition and advice information. If it does not match it | 1314 | ;; function definition and advice information. If it does not match it |
| 1420 | ;; will simply be discarded and a new advised definition will be constructed | 1315 | ;; will simply be discarded and a new advised definition will be constructed |
| 1421 | ;; from scratch. For example, let's first remove all advice-info for `fum': | 1316 | ;; from scratch. For example, let's first remove all advice-info for `fum': |
| 1422 | ;; | 1317 | ;; |
| 1423 | ;; (ad-unadvise 'fum) | 1318 | ;; (ad-unadvise 'fum) |
| 1424 | ;; (("fie") ("bar") ("foo") ...) | 1319 | ;; (("fie") ("bar") ("foo") ...) |
| @@ -1431,7 +1326,7 @@ | |||
| 1431 | ;; fum | 1326 | ;; fum |
| 1432 | ;; | 1327 | ;; |
| 1433 | ;; When we now try to use a preactivation it will not be used because the | 1328 | ;; When we now try to use a preactivation it will not be used because the |
| 1434 | ;; current advice state is different from the one at preactivation time. This | 1329 | ;; current advice state is different from the one at preactivation time. This |
| 1435 | ;; is no tragedy, everything will work as expected just not as efficient, | 1330 | ;; is no tragedy, everything will work as expected just not as efficient, |
| 1436 | ;; because a new advised definition has to be constructed from scratch: | 1331 | ;; because a new advised definition has to be constructed from scratch: |
| 1437 | ;; | 1332 | ;; |
| @@ -1440,7 +1335,7 @@ | |||
| 1440 | ;; | 1335 | ;; |
| 1441 | ;; A new uncompiled advised definition got constructed: | 1336 | ;; A new uncompiled advised definition got constructed: |
| 1442 | ;; | 1337 | ;; |
| 1443 | ;; (ad-compiled-p (symbol-function 'fum)) | 1338 | ;; (byte-code-function-p 'ad-Advice-fum) |
| 1444 | ;; nil | 1339 | ;; nil |
| 1445 | ;; | 1340 | ;; |
| 1446 | ;; (fum 2) | 1341 | ;; (fum 2) |
| @@ -1448,7 +1343,7 @@ | |||
| 1448 | ;; | 1343 | ;; |
| 1449 | ;; MORAL: To get all the efficiency out of preactivation the function | 1344 | ;; MORAL: To get all the efficiency out of preactivation the function |
| 1450 | ;; definition and advice state at preactivation time must be the same as the | 1345 | ;; definition and advice state at preactivation time must be the same as the |
| 1451 | ;; state at activation time. Preactivation does work with forward advice, all | 1346 | ;; state at activation time. Preactivation does work with forward advice, all |
| 1452 | ;; that's necessary is that the definition of the forward advised function is | 1347 | ;; that's necessary is that the definition of the forward advised function is |
| 1453 | ;; available when the `defadvice' with the preactivation gets compiled. | 1348 | ;; available when the `defadvice' with the preactivation gets compiled. |
| 1454 | ;; | 1349 | ;; |
| @@ -1702,15 +1597,9 @@ | |||
| 1702 | ;; @@ Compilation idiosyncrasies: | 1597 | ;; @@ Compilation idiosyncrasies: |
| 1703 | ;; ============================== | 1598 | ;; ============================== |
| 1704 | 1599 | ||
| 1705 | ;; `defadvice' expansion needs quite a few advice functions and variables, | ||
| 1706 | ;; hence, I need to preload the file before it can be compiled. To avoid | ||
| 1707 | ;; interference of bogus compiled files I always preload the source file: | ||
| 1708 | (provide 'advice-preload) | ||
| 1709 | ;; During a normal load this is a noop: | ||
| 1710 | (require 'advice-preload "advice.el") | ||
| 1711 | (require 'macroexp) | 1600 | (require 'macroexp) |
| 1712 | ;; At run-time also, since ad-do-advised-functions returns code that uses it. | 1601 | ;; At run-time also, since ad-do-advised-functions returns code that uses it. |
| 1713 | (require 'cl-lib) | 1602 | (eval-when-compile (require 'cl-lib)) |
| 1714 | 1603 | ||
| 1715 | ;; @@ Variable definitions: | 1604 | ;; @@ Variable definitions: |
| 1716 | ;; ======================== | 1605 | ;; ======================== |
| @@ -1789,7 +1678,7 @@ generates a copy of TREE." | |||
| 1789 | ;; (after adv1 adv2 ...) | 1678 | ;; (after adv1 adv2 ...) |
| 1790 | ;; (activation adv1 adv2 ...) | 1679 | ;; (activation adv1 adv2 ...) |
| 1791 | ;; (deactivation adv1 adv2 ...) | 1680 | ;; (deactivation adv1 adv2 ...) |
| 1792 | ;; (origname . <symbol fbound to origdef>) | 1681 | ;; (advicefunname . <symbol fbound to assembled advice function>) |
| 1793 | ;; (cache . (<advised-definition> . <id>))) | 1682 | ;; (cache . (<advised-definition> . <id>))) |
| 1794 | 1683 | ||
| 1795 | ;; List of currently advised though not necessarily activated functions | 1684 | ;; List of currently advised though not necessarily activated functions |
| @@ -1816,7 +1705,7 @@ generates a copy of TREE." | |||
| 1816 | On each iteration VAR will be bound to the name of an advised function | 1705 | On each iteration VAR will be bound to the name of an advised function |
| 1817 | \(a symbol)." | 1706 | \(a symbol)." |
| 1818 | (declare (indent 1)) | 1707 | (declare (indent 1)) |
| 1819 | `(cl-dolist (,(car varform) ad-advised-functions) | 1708 | `(dolist (,(car varform) ad-advised-functions) |
| 1820 | (setq ,(car varform) (intern (car ,(car varform)))) | 1709 | (setq ,(car varform) (intern (car ,(car varform)))) |
| 1821 | ,@body)) | 1710 | ,@body)) |
| 1822 | 1711 | ||
| @@ -1882,18 +1771,17 @@ either t or nil, and DEFINITION should be a list of the form | |||
| 1882 | 1771 | ||
| 1883 | ;; ad-find-advice uses the alist structure directly -> | 1772 | ;; ad-find-advice uses the alist structure directly -> |
| 1884 | ;; change if this data structure changes!! | 1773 | ;; change if this data structure changes!! |
| 1885 | (defmacro ad-advice-name (advice) | 1774 | (defsubst ad-advice-name (advice) (car advice)) |
| 1886 | (list 'car advice)) | 1775 | (defsubst ad-advice-protected (advice) (nth 1 advice)) |
| 1887 | (defmacro ad-advice-protected (advice) | 1776 | (defsubst ad-advice-enabled (advice) (nth 2 advice)) |
| 1888 | (list 'nth 1 advice)) | 1777 | (defsubst ad-advice-definition (advice) (nth 3 advice)) |
| 1889 | (defmacro ad-advice-enabled (advice) | ||
| 1890 | (list 'nth 2 advice)) | ||
| 1891 | (defmacro ad-advice-definition (advice) | ||
| 1892 | (list 'nth 3 advice)) | ||
| 1893 | 1778 | ||
| 1894 | (defun ad-advice-set-enabled (advice flag) | 1779 | (defun ad-advice-set-enabled (advice flag) |
| 1895 | (rplaca (cdr (cdr advice)) flag)) | 1780 | (rplaca (cdr (cdr advice)) flag)) |
| 1896 | 1781 | ||
| 1782 | (defvar ad-advice-classes '(before around after activation deactivation) | ||
| 1783 | "List of defined advice classes.") | ||
| 1784 | |||
| 1897 | (defun ad-class-p (thing) | 1785 | (defun ad-class-p (thing) |
| 1898 | (memq thing ad-advice-classes)) | 1786 | (memq thing ad-advice-classes)) |
| 1899 | (defun ad-name-p (thing) | 1787 | (defun ad-name-p (thing) |
| @@ -1906,9 +1794,6 @@ either t or nil, and DEFINITION should be a list of the form | |||
| 1906 | ;; @@ Advice access functions: | 1794 | ;; @@ Advice access functions: |
| 1907 | ;; =========================== | 1795 | ;; =========================== |
| 1908 | 1796 | ||
| 1909 | ;; List of defined advice classes: | ||
| 1910 | (defvar ad-advice-classes '(before around after activation deactivation)) | ||
| 1911 | |||
| 1912 | (defun ad-has-enabled-advice (function class) | 1797 | (defun ad-has-enabled-advice (function class) |
| 1913 | "True if at least one of FUNCTION's advices in CLASS is enabled." | 1798 | "True if at least one of FUNCTION's advices in CLASS is enabled." |
| 1914 | (cl-dolist (advice (ad-get-advice-info-field function class)) | 1799 | (cl-dolist (advice (ad-get-advice-info-field function class)) |
| @@ -1948,58 +1833,23 @@ Redefining advices affect the construction of an advised definition." | |||
| 1948 | ;; Whether advised definitions created by automatic activations will be | 1833 | ;; Whether advised definitions created by automatic activations will be |
| 1949 | ;; compiled depends on the value of `ad-default-compilation-action'. | 1834 | ;; compiled depends on the value of `ad-default-compilation-action'. |
| 1950 | 1835 | ||
| 1951 | ;; Since calling `ad-activate-internal' in the built-in definition of `fset' can | 1836 | (defalias 'ad-activate-internal 'ad-activate) |
| 1952 | ;; create major disasters we have to be a bit careful. One precaution is | ||
| 1953 | ;; to provide a dummy definition for `ad-activate-internal' which can be used to | ||
| 1954 | ;; turn off automatic advice activation (e.g., when `ad-stop-advice' or | ||
| 1955 | ;; `ad-recover-normality' are called). Another is to avoid recursive calls | ||
| 1956 | ;; to `ad-activate' by using `ad-with-auto-activation-disabled' where | ||
| 1957 | ;; appropriate, especially in a safe version of `fset'. | ||
| 1958 | |||
| 1959 | (defun ad--defalias-fset (fsetfun function definition) | ||
| 1960 | (funcall (or fsetfun #'fset) function definition) | ||
| 1961 | (ad-activate-internal function nil)) | ||
| 1962 | |||
| 1963 | ;; For now define `ad-activate-internal' to the dummy definition: | ||
| 1964 | (defun ad-activate-internal (_function &optional _compile) | ||
| 1965 | "Automatic advice activation is disabled. `ad-start-advice' enables it." | ||
| 1966 | nil) | ||
| 1967 | |||
| 1968 | ;; This is just a copy of the above: | ||
| 1969 | (defun ad-activate-internal-off (_function &optional _compile) | ||
| 1970 | "Automatic advice activation is disabled. `ad-start-advice' enables it." | ||
| 1971 | nil) | ||
| 1972 | |||
| 1973 | ;; This will be t for top-level calls to `ad-activate-internal-on': | ||
| 1974 | (defvar ad-activate-on-top-level t) | ||
| 1975 | |||
| 1976 | (defmacro ad-with-auto-activation-disabled (&rest body) | ||
| 1977 | `(let ((ad-activate-on-top-level nil)) | ||
| 1978 | ,@body)) | ||
| 1979 | |||
| 1980 | ;; @@ Access functions for original definitions: | ||
| 1981 | ;; ============================================ | ||
| 1982 | ;; The advice-info of an advised function contains its `origname' which is | ||
| 1983 | ;; a symbol that is fbound to the original definition available at the first | ||
| 1984 | ;; proper activation of the function after a valid re/definition. If the | ||
| 1985 | ;; original was defined via fcell indirection then `origname' will be defined | ||
| 1986 | ;; just so. Hence, to get hold of the actual original definition of a function | ||
| 1987 | ;; we need to use `ad-real-orig-definition'. | ||
| 1988 | |||
| 1989 | (defun ad-make-origname (function) | ||
| 1990 | "Make name to be used to call the original FUNCTION." | ||
| 1991 | (intern (format "ad-Orig-%s" function))) | ||
| 1992 | 1837 | ||
| 1993 | (defmacro ad-get-orig-definition (function) | 1838 | (defun ad-make-advicefunname (function) |
| 1994 | `(let ((origname (ad-get-advice-info-field ,function 'origname))) | 1839 | "Make name to be used to call the assembled advice function." |
| 1995 | (if (fboundp origname) | 1840 | (intern (format "ad-Advice-%s" function))) |
| 1996 | (symbol-function origname)))) | ||
| 1997 | 1841 | ||
| 1998 | (defmacro ad-set-orig-definition (function definition) | 1842 | (defun ad-get-orig-definition (function) ;FIXME: Rename to "-unadvised-". |
| 1999 | `(fset (ad-get-advice-info-field ,function 'origname) ,definition)) | 1843 | (if (symbolp function) |
| 1844 | (setq function (if (fboundp function) | ||
| 1845 | (advice--strip-macro (symbol-function function))))) | ||
| 1846 | (while (advice--p function) (setq function (advice--cdr function))) | ||
| 1847 | function) | ||
| 2000 | 1848 | ||
| 2001 | (defmacro ad-clear-orig-definition (function) | 1849 | (defun ad-clear-advicefunname-definition (function) |
| 2002 | `(fmakunbound (ad-get-advice-info-field ,function 'origname))) | 1850 | (let ((advicefunname (ad-get-advice-info-field function 'advicefunname))) |
| 1851 | (advice-remove function advicefunname) | ||
| 1852 | (fmakunbound advicefunname))) | ||
| 2003 | 1853 | ||
| 2004 | 1854 | ||
| 2005 | ;; @@ Interactive input functions: | 1855 | ;; @@ Interactive input functions: |
| @@ -2259,7 +2109,7 @@ See Info node `(elisp)Computed Advice' for detailed documentation." | |||
| 2259 | (cond ((not (ad-is-advised function)) | 2109 | (cond ((not (ad-is-advised function)) |
| 2260 | (ad-initialize-advice-info function) | 2110 | (ad-initialize-advice-info function) |
| 2261 | (ad-set-advice-info-field | 2111 | (ad-set-advice-info-field |
| 2262 | function 'origname (ad-make-origname function)))) | 2112 | function 'advicefunname (ad-make-advicefunname function)))) |
| 2263 | (let* ((previous-position | 2113 | (let* ((previous-position |
| 2264 | (ad-advice-position function class (ad-advice-name advice))) | 2114 | (ad-advice-position function class (ad-advice-name advice))) |
| 2265 | (advices (ad-get-advice-info-field function class)) | 2115 | (advices (ad-get-advice-info-field function class)) |
| @@ -2374,7 +2224,8 @@ the name of the advised function from the docstring. This is needed | |||
| 2374 | to generate a proper advised docstring even if we are just given a | 2224 | to generate a proper advised docstring even if we are just given a |
| 2375 | definition (see the code for `documentation')." | 2225 | definition (see the code for `documentation')." |
| 2376 | (eval-when-compile | 2226 | (eval-when-compile |
| 2377 | (propertize "Advice doc string" 'dynamic-docstring-function | 2227 | (propertize "Advice function assembled by advice.el." |
| 2228 | 'dynamic-docstring-function | ||
| 2378 | #'ad--make-advised-docstring))) | 2229 | #'ad--make-advised-docstring))) |
| 2379 | 2230 | ||
| 2380 | (defun ad-advised-definition-p (definition) | 2231 | (defun ad-advised-definition-p (definition) |
| @@ -2417,9 +2268,9 @@ For that it has to be fbound with a non-autoload definition." | |||
| 2417 | definition)))) | 2268 | definition)))) |
| 2418 | 2269 | ||
| 2419 | (defun ad-real-orig-definition (function) | 2270 | (defun ad-real-orig-definition (function) |
| 2420 | "Find FUNCTION's real original definition starting from its `origname'." | 2271 | (let* ((fun1 (ad-get-orig-definition function)) |
| 2421 | (if (ad-is-advised function) | 2272 | (fun2 (indirect-function fun1))) |
| 2422 | (ad-real-definition (ad-get-advice-info-field function 'origname)))) | 2273 | (unless (autoloadp fun2) fun2))) |
| 2423 | 2274 | ||
| 2424 | (defun ad-is-compilable (function) | 2275 | (defun ad-is-compilable (function) |
| 2425 | "True if FUNCTION has an interpreted definition that can be compiled." | 2276 | "True if FUNCTION has an interpreted definition that can be compiled." |
| @@ -2430,24 +2281,15 @@ For that it has to be fbound with a non-autoload definition." | |||
| 2430 | 2281 | ||
| 2431 | (defvar warning-suppress-types) ;From warnings.el. | 2282 | (defvar warning-suppress-types) ;From warnings.el. |
| 2432 | (defun ad-compile-function (function) | 2283 | (defun ad-compile-function (function) |
| 2433 | "Byte-compiles FUNCTION (or macro) if it is not yet compiled." | 2284 | "Byte-compile the assembled advice function." |
| 2434 | (interactive "aByte-compile function: ") | 2285 | (require 'bytecomp) |
| 2435 | (if (ad-is-compilable function) | 2286 | (require 'warnings) ;To define warning-suppress-types before we let-bind it. |
| 2436 | ;; Need to turn off auto-activation | 2287 | (let ((byte-compile-warnings byte-compile-warnings) |
| 2437 | ;; because `byte-compile' uses `fset': | 2288 | ;; Don't pop up windows showing byte-compiler warnings. |
| 2438 | (ad-with-auto-activation-disabled | 2289 | (warning-suppress-types '((bytecomp)))) |
| 2439 | (require 'bytecomp) | 2290 | (if (featurep 'cl) |
| 2440 | (require 'warnings) ;To define warning-suppress-types | 2291 | (byte-compile-disable-warning 'cl-functions)) |
| 2441 | ;before we let-bind it. | 2292 | (byte-compile (ad-get-advice-info-field function 'advicefunname)))) |
| 2442 | (let ((symbol (make-symbol "advice-compilation")) | ||
| 2443 | (byte-compile-warnings byte-compile-warnings) | ||
| 2444 | ;; Don't pop up windows showing byte-compiler warnings. | ||
| 2445 | (warning-suppress-types '((bytecomp)))) | ||
| 2446 | (if (featurep 'cl) | ||
| 2447 | (byte-compile-disable-warning 'cl-functions)) | ||
| 2448 | (fset symbol (symbol-function function)) | ||
| 2449 | (byte-compile symbol) | ||
| 2450 | (fset function (symbol-function symbol)))))) | ||
| 2451 | 2293 | ||
| 2452 | ;; @@@ Accessing argument lists: | 2294 | ;; @@@ Accessing argument lists: |
| 2453 | ;; ============================= | 2295 | ;; ============================= |
| @@ -2634,7 +2476,7 @@ Excess source arguments will be neglected, missing source arguments will be | |||
| 2634 | supplied as nil. Returns a `funcall' or `apply' form with the second element | 2476 | supplied as nil. Returns a `funcall' or `apply' form with the second element |
| 2635 | being `function' which has to be replaced by an actual function argument. | 2477 | being `function' which has to be replaced by an actual function argument. |
| 2636 | Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return | 2478 | Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return |
| 2637 | `(funcall function a (car args) (car (cdr args)) (nth 2 args))'." | 2479 | `(funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))'." |
| 2638 | (let* ((parsed-source-arglist (ad-parse-arglist source-arglist)) | 2480 | (let* ((parsed-source-arglist (ad-parse-arglist source-arglist)) |
| 2639 | (source-reqopt-args (append (nth 0 parsed-source-arglist) | 2481 | (source-reqopt-args (append (nth 0 parsed-source-arglist) |
| 2640 | (nth 1 parsed-source-arglist))) | 2482 | (nth 1 parsed-source-arglist))) |
| @@ -2648,7 +2490,7 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return | |||
| 2648 | ;; This produces ``error-proof'' target function calls with the exception | 2490 | ;; This produces ``error-proof'' target function calls with the exception |
| 2649 | ;; of a case like (&rest a) mapped onto (x &rest y) where the actual args | 2491 | ;; of a case like (&rest a) mapped onto (x &rest y) where the actual args |
| 2650 | ;; supplied to A might not be enough to supply the required target arg X | 2492 | ;; supplied to A might not be enough to supply the required target arg X |
| 2651 | (append (list (if need-apply 'apply 'funcall) 'function) | 2493 | (append (list (if need-apply 'apply 'funcall) 'ad--addoit-function) |
| 2652 | (cond (need-apply | 2494 | (cond (need-apply |
| 2653 | ;; `apply' can take care of that directly: | 2495 | ;; `apply' can take care of that directly: |
| 2654 | (append source-reqopt-args (list source-rest-arg))) | 2496 | (append source-reqopt-args (list source-rest-arg))) |
| @@ -2663,13 +2505,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return | |||
| 2663 | (nthcdr (length target-reqopt-args) | 2505 | (nthcdr (length target-reqopt-args) |
| 2664 | source-reqopt-args))))))))) | 2506 | source-reqopt-args))))))))) |
| 2665 | 2507 | ||
| 2666 | (defun ad-make-mapped-call (source-arglist target-arglist target-function) | ||
| 2667 | "Make form to call TARGET-FUNCTION with args from SOURCE-ARGLIST." | ||
| 2668 | (let ((mapped-form (ad-map-arglists source-arglist target-arglist))) | ||
| 2669 | (if (eq (car mapped-form) 'funcall) | ||
| 2670 | (cons target-function (cdr (cdr mapped-form))) | ||
| 2671 | (prog1 mapped-form | ||
| 2672 | (setcar (cdr mapped-form) (list 'quote target-function)))))) | ||
| 2673 | 2508 | ||
| 2674 | ;; @@@ Making an advised documentation string: | 2509 | ;; @@@ Making an advised documentation string: |
| 2675 | ;; =========================================== | 2510 | ;; =========================================== |
| @@ -2697,13 +2532,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return | |||
| 2697 | 2532 | ||
| 2698 | (require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage. | 2533 | (require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage. |
| 2699 | 2534 | ||
| 2700 | (defun ad-make-advised-docstring (function &optional style) | ||
| 2701 | (let* ((origdef (ad-real-orig-definition function)) | ||
| 2702 | (origdoc | ||
| 2703 | ;; Retrieve raw doc, key substitution will be taken care of later: | ||
| 2704 | (documentation origdef t))) | ||
| 2705 | (ad--make-advised-docstring origdoc function style))) | ||
| 2706 | |||
| 2707 | (defun ad--make-advised-docstring (origdoc function &optional style) | 2535 | (defun ad--make-advised-docstring (origdoc function &optional style) |
| 2708 | "Construct a documentation string for the advised FUNCTION. | 2536 | "Construct a documentation string for the advised FUNCTION. |
| 2709 | It concatenates the original documentation with the documentation | 2537 | It concatenates the original documentation with the documentation |
| @@ -2712,14 +2540,14 @@ according to STYLE. STYLE can be `plain', everything else | |||
| 2712 | will be interpreted as `default'. The order of the advice documentation | 2540 | will be interpreted as `default'. The order of the advice documentation |
| 2713 | strings corresponds to before/around/after and the individual ordering | 2541 | strings corresponds to before/around/after and the individual ordering |
| 2714 | in any of these classes." | 2542 | in any of these classes." |
| 2715 | (let* ((origdef (ad-real-orig-definition function)) | 2543 | (if (and (symbolp function) |
| 2716 | (origtype (symbol-name (ad-definition-type origdef))) | 2544 | (string-match "\\`ad-+Advice-" (symbol-name function))) |
| 2717 | (usage (help-split-fundoc origdoc function)) | 2545 | (setq function |
| 2546 | (intern (substring (symbol-name function) (match-end 0))))) | ||
| 2547 | (let* ((usage (help-split-fundoc origdoc function)) | ||
| 2718 | paragraphs advice-docstring) | 2548 | paragraphs advice-docstring) |
| 2719 | (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage))) | 2549 | (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage))) |
| 2720 | (if origdoc (setq paragraphs (list origdoc))) | 2550 | (if origdoc (setq paragraphs (list origdoc))) |
| 2721 | (unless (eq style 'plain) | ||
| 2722 | (push (concat "This " origtype " is advised.") paragraphs)) | ||
| 2723 | (dolist (class ad-advice-classes) | 2551 | (dolist (class ad-advice-classes) |
| 2724 | (dolist (advice (ad-get-enabled-advices function class)) | 2552 | (dolist (advice (ad-get-enabled-advices function class)) |
| 2725 | (setq advice-docstring | 2553 | (setq advice-docstring |
| @@ -2735,8 +2563,6 @@ in any of these classes." | |||
| 2735 | #'ad--make-advised-docstring))) | 2563 | #'ad--make-advised-docstring))) |
| 2736 | (help-add-fundoc-usage origdoc usage))) | 2564 | (help-add-fundoc-usage origdoc usage))) |
| 2737 | 2565 | ||
| 2738 | (defun ad-make-plain-docstring (function) | ||
| 2739 | (ad-make-advised-docstring function 'plain)) | ||
| 2740 | 2566 | ||
| 2741 | ;; @@@ Accessing overriding arglists and interactive forms: | 2567 | ;; @@@ Accessing overriding arglists and interactive forms: |
| 2742 | ;; ======================================================== | 2568 | ;; ======================================================== |
| @@ -2770,64 +2596,16 @@ in any of these classes." | |||
| 2770 | (if (and (ad-is-advised function) | 2596 | (if (and (ad-is-advised function) |
| 2771 | (ad-has-redefining-advice function)) | 2597 | (ad-has-redefining-advice function)) |
| 2772 | (let* ((origdef (ad-real-orig-definition function)) | 2598 | (let* ((origdef (ad-real-orig-definition function)) |
| 2773 | (origname (ad-get-advice-info-field function 'origname)) | ||
| 2774 | (orig-interactive-p (commandp origdef)) | ||
| 2775 | (orig-subr-p (ad-subr-p origdef)) | ||
| 2776 | (orig-special-form-p (special-form-p origdef)) | ||
| 2777 | (orig-macro-p (ad-macro-p origdef)) | ||
| 2778 | ;; Construct the individual pieces that we need for assembly: | 2599 | ;; Construct the individual pieces that we need for assembly: |
| 2779 | (orig-arglist (ad-arglist origdef)) | 2600 | (orig-arglist (ad-arglist origdef)) |
| 2780 | (advised-arglist (or (ad-advised-arglist function) | 2601 | (advised-arglist (or (ad-advised-arglist function) |
| 2781 | orig-arglist)) | 2602 | orig-arglist)) |
| 2782 | (advised-interactive-form (ad-advised-interactive-form function)) | 2603 | (interactive-form (ad-advised-interactive-form function)) |
| 2783 | (interactive-form | ||
| 2784 | (cond (orig-macro-p nil) | ||
| 2785 | (advised-interactive-form) | ||
| 2786 | ((interactive-form origdef) | ||
| 2787 | (interactive-form | ||
| 2788 | (if (and (symbolp function) (get function 'elp-info)) | ||
| 2789 | (aref (get function 'elp-info) 2) | ||
| 2790 | origdef))))) | ||
| 2791 | (orig-form | 2604 | (orig-form |
| 2792 | (cond ((or orig-special-form-p orig-macro-p) | 2605 | (ad-map-arglists advised-arglist orig-arglist))) |
| 2793 | ;; Special forms and macros will be advised into macros. | ||
| 2794 | ;; The trick is to construct an expansion for the advised | ||
| 2795 | ;; macro that does the correct thing when it gets eval'ed. | ||
| 2796 | ;; For macros we'll just use the expansion of the original | ||
| 2797 | ;; macro and return that. This way compiled advised macros | ||
| 2798 | ;; will be expanded into something useful. Note that after | ||
| 2799 | ;; advices have full control over whether they want to | ||
| 2800 | ;; evaluate the expansion (the value of `ad-return-value') | ||
| 2801 | ;; at macro expansion time or not. For special forms there | ||
| 2802 | ;; is no solution that interacts reasonably with the | ||
| 2803 | ;; compiler, hence we just evaluate the original at macro | ||
| 2804 | ;; expansion time and return the result. The moral of that | ||
| 2805 | ;; is that one should always deactivate advised special | ||
| 2806 | ;; forms before one byte-compiles a file. | ||
| 2807 | `(,(if orig-macro-p 'macroexpand 'eval) | ||
| 2808 | (cons ',origname | ||
| 2809 | ,(ad-get-arguments advised-arglist 0)))) | ||
| 2810 | ((and orig-subr-p | ||
| 2811 | orig-interactive-p | ||
| 2812 | (not interactive-form) | ||
| 2813 | (not advised-interactive-form)) | ||
| 2814 | ;; Check whether we were called interactively | ||
| 2815 | ;; in order to do proper prompting: | ||
| 2816 | `(if (called-interactively-p 'any) | ||
| 2817 | (call-interactively ',origname) | ||
| 2818 | ,(ad-make-mapped-call advised-arglist | ||
| 2819 | orig-arglist | ||
| 2820 | origname))) | ||
| 2821 | ;; And now for normal functions and non-interactive subrs | ||
| 2822 | ;; (or subrs whose interactive behavior was advised): | ||
| 2823 | (t (ad-make-mapped-call | ||
| 2824 | advised-arglist orig-arglist origname))))) | ||
| 2825 | 2606 | ||
| 2826 | ;; Finally, build the sucker: | 2607 | ;; Finally, build the sucker: |
| 2827 | (ad-assemble-advised-definition | 2608 | (ad-assemble-advised-definition |
| 2828 | (cond (orig-macro-p 'macro) | ||
| 2829 | (orig-special-form-p 'special-form) | ||
| 2830 | (t 'function)) | ||
| 2831 | advised-arglist | 2609 | advised-arglist |
| 2832 | (ad-make-advised-definition-docstring function) | 2610 | (ad-make-advised-definition-docstring function) |
| 2833 | interactive-form | 2611 | interactive-form |
| @@ -2837,13 +2615,11 @@ in any of these classes." | |||
| 2837 | (ad-get-enabled-advices function 'after))))) | 2615 | (ad-get-enabled-advices function 'after))))) |
| 2838 | 2616 | ||
| 2839 | (defun ad-assemble-advised-definition | 2617 | (defun ad-assemble-advised-definition |
| 2840 | (type args docstring interactive orig &optional befores arounds afters) | 2618 | (args docstring interactive orig &optional befores arounds afters) |
| 2841 | 2619 | "Assemble the advices into an overall advice function. | |
| 2842 | "Assembles an original and its advices into an advised function. | 2620 | ARGS is the argument list that has to be used, |
| 2843 | It constructs a function or macro definition according to TYPE which has to | 2621 | DOCSTRING if non-nil defines the documentation of the definition, |
| 2844 | be either `macro', `function' or `special-form'. ARGS is the argument list | 2622 | INTERACTIVE if non-nil is the interactive form to be used, |
| 2845 | that has to be used, DOCSTRING if non-nil defines the documentation of the | ||
| 2846 | definition, INTERACTIVE if non-nil is the interactive form to be used, | ||
| 2847 | ORIG is a form that calls the body of the original unadvised function, | 2623 | ORIG is a form that calls the body of the original unadvised function, |
| 2848 | and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG | 2624 | and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG |
| 2849 | should be modified. The assembled function will be returned." | 2625 | should be modified. The assembled function will be returned." |
| @@ -2894,16 +2670,12 @@ should be modified. The assembled function will be returned." | |||
| 2894 | (ad-body-forms (ad-advice-definition advice))))))) | 2670 | (ad-body-forms (ad-advice-definition advice))))))) |
| 2895 | 2671 | ||
| 2896 | (setq definition | 2672 | (setq definition |
| 2897 | `(,@(if (memq type '(macro special-form)) '(macro)) | 2673 | `(lambda (ad--addoit-function ,@args) |
| 2898 | lambda | ||
| 2899 | ,args | ||
| 2900 | ,@(if docstring (list docstring)) | 2674 | ,@(if docstring (list docstring)) |
| 2901 | ,@(if interactive (list interactive)) | 2675 | ,@(if interactive (list interactive)) |
| 2902 | (let (ad-return-value) | 2676 | (let (ad-return-value) |
| 2903 | ,@after-forms | 2677 | ,@after-forms |
| 2904 | ,(if (eq type 'special-form) | 2678 | ad-return-value))) |
| 2905 | '(list 'quote ad-return-value) | ||
| 2906 | 'ad-return-value)))) | ||
| 2907 | 2679 | ||
| 2908 | (ad-insert-argument-access-forms definition args))) | 2680 | (ad-insert-argument-access-forms definition args))) |
| 2909 | 2681 | ||
| @@ -3000,11 +2772,11 @@ advised definition from scratch." | |||
| 3000 | "Generate an identifying image of the current advices of FUNCTION." | 2772 | "Generate an identifying image of the current advices of FUNCTION." |
| 3001 | (let ((original-definition (ad-real-orig-definition function)) | 2773 | (let ((original-definition (ad-real-orig-definition function)) |
| 3002 | (cached-definition (ad-get-cache-definition function))) | 2774 | (cached-definition (ad-get-cache-definition function))) |
| 3003 | (list (mapcar (function (lambda (advice) (ad-advice-name advice))) | 2775 | (list (mapcar #'ad-advice-name |
| 3004 | (ad-get-enabled-advices function 'before)) | 2776 | (ad-get-enabled-advices function 'before)) |
| 3005 | (mapcar (function (lambda (advice) (ad-advice-name advice))) | 2777 | (mapcar #'ad-advice-name |
| 3006 | (ad-get-enabled-advices function 'around)) | 2778 | (ad-get-enabled-advices function 'around)) |
| 3007 | (mapcar (function (lambda (advice) (ad-advice-name advice))) | 2779 | (mapcar #'ad-advice-name |
| 3008 | (ad-get-enabled-advices function 'after)) | 2780 | (ad-get-enabled-advices function 'after)) |
| 3009 | (ad-definition-type original-definition) | 2781 | (ad-definition-type original-definition) |
| 3010 | (if (equal (ad-arglist original-definition) | 2782 | (if (equal (ad-arglist original-definition) |
| @@ -3147,25 +2919,32 @@ The resulting FUNCTION will be compiled if `ad-should-compile' returns t. | |||
| 3147 | The current definition and its cache-id will be put into the cache." | 2919 | The current definition and its cache-id will be put into the cache." |
| 3148 | (let ((verified-cached-definition | 2920 | (let ((verified-cached-definition |
| 3149 | (if (ad-verify-cache-id function) | 2921 | (if (ad-verify-cache-id function) |
| 3150 | (ad-get-cache-definition function)))) | 2922 | (ad-get-cache-definition function))) |
| 3151 | (fset function | 2923 | (advicefunname (ad-get-advice-info-field function 'advicefunname))) |
| 3152 | (or verified-cached-definition | 2924 | (fset advicefunname |
| 3153 | (ad-make-advised-definition function))) | 2925 | (or verified-cached-definition |
| 2926 | (ad-make-advised-definition function))) | ||
| 2927 | (advice-add function :around advicefunname) | ||
| 3154 | (if (ad-should-compile function compile) | 2928 | (if (ad-should-compile function compile) |
| 3155 | (ad-compile-function function)) | 2929 | (byte-compile advicefunname)) |
| 3156 | (if verified-cached-definition | 2930 | (if verified-cached-definition |
| 3157 | (if (not (eq verified-cached-definition (symbol-function function))) | 2931 | (if (not (eq verified-cached-definition |
| 2932 | (symbol-function advicefunname))) | ||
| 3158 | ;; we must have compiled, cache the compiled definition: | 2933 | ;; we must have compiled, cache the compiled definition: |
| 3159 | (ad-set-cache | 2934 | (ad-set-cache function (symbol-function advicefunname) |
| 3160 | function (symbol-function function) (ad-get-cache-id function))) | 2935 | (ad-get-cache-id function))) |
| 3161 | ;; We created a new advised definition, cache it with a proper id: | 2936 | ;; We created a new advised definition, cache it with a proper id: |
| 3162 | (ad-clear-cache function) | 2937 | (ad-clear-cache function) |
| 3163 | ;; ad-make-cache-id needs the new cached definition: | 2938 | ;; ad-make-cache-id needs the new cached definition: |
| 3164 | (ad-set-cache function (symbol-function function) nil) | 2939 | (ad-set-cache function (symbol-function advicefunname) nil) |
| 3165 | (ad-set-cache | 2940 | (ad-set-cache |
| 3166 | function (symbol-function function) (ad-make-cache-id function))))) | 2941 | function (symbol-function advicefunname) (ad-make-cache-id function))))) |
| 3167 | 2942 | ||
| 3168 | (defun ad-handle-definition (function) | 2943 | (defun ad--defalias-fset (fsetfun function newdef) |
| 2944 | ;; Besides ad-redefinition-action we use this defalias-fset-function hook | ||
| 2945 | ;; for two other reasons: | ||
| 2946 | ;; - for `activation/deactivation' advices. | ||
| 2947 | ;; - to rebuild the ad-Advice-* function with the right argument names. | ||
| 3169 | "Handle re/definition of an advised FUNCTION during de/activation. | 2948 | "Handle re/definition of an advised FUNCTION during de/activation. |
| 3170 | If FUNCTION does not have an original definition associated with it and | 2949 | If FUNCTION does not have an original definition associated with it and |
| 3171 | the current definition is usable, then it will be stored as FUNCTION's | 2950 | the current definition is usable, then it will be stored as FUNCTION's |
| @@ -3177,33 +2956,27 @@ associated with it but got redefined with a new definition and then | |||
| 3177 | de/activated. If you do not like the current redefinition action change | 2956 | de/activated. If you do not like the current redefinition action change |
| 3178 | the value of `ad-redefinition-action' and de/activate again." | 2957 | the value of `ad-redefinition-action' and de/activate again." |
| 3179 | (let ((original-definition (ad-get-orig-definition function)) | 2958 | (let ((original-definition (ad-get-orig-definition function)) |
| 3180 | (current-definition (if (ad-real-definition function) | 2959 | (current-definition (ad-get-orig-definition newdef))) |
| 3181 | (symbol-function function)))) | ||
| 3182 | (if original-definition | 2960 | (if original-definition |
| 3183 | (if current-definition | 2961 | (if current-definition |
| 3184 | (if (and (not (eq current-definition original-definition)) | 2962 | (if (not (eq current-definition original-definition)) |
| 3185 | ;; Redefinition with an advised definition from a | 2963 | ;; We have a redefinition: |
| 3186 | ;; different function won't count as such: | ||
| 3187 | (not (ad-advised-definition-p current-definition))) | ||
| 3188 | ;; we have a redefinition: | ||
| 3189 | (if (not (memq ad-redefinition-action '(accept discard warn))) | 2964 | (if (not (memq ad-redefinition-action '(accept discard warn))) |
| 3190 | (error "ad-handle-definition (see its doc): `%s' %s" | 2965 | (error "ad-redefinition-action: `%s' %s" |
| 3191 | function "invalidly redefined") | 2966 | function "invalidly redefined") |
| 3192 | (if (eq ad-redefinition-action 'discard) | 2967 | (if (eq ad-redefinition-action 'discard) |
| 3193 | (fset function original-definition) | 2968 | nil ;; Just drop it! |
| 3194 | (ad-set-orig-definition function current-definition) | 2969 | (funcall (or fsetfun #'fset) function newdef) |
| 2970 | (ad-activate-internal function) | ||
| 3195 | (if (eq ad-redefinition-action 'warn) | 2971 | (if (eq ad-redefinition-action 'warn) |
| 3196 | (message "ad-handle-definition: `%s' got redefined" | 2972 | (message "ad-handle-definition: `%s' got redefined" |
| 3197 | function)))) | 2973 | function)))) |
| 3198 | ;; either advised def or correct original is in place: | 2974 | ;; either advised def or correct original is in place: |
| 3199 | nil) | 2975 | nil) |
| 3200 | ;; we have an undefinition, ignore it: | 2976 | ;; We have an undefinition, ignore it: |
| 3201 | nil) | 2977 | (funcall (or fsetfun #'fset) function newdef)) |
| 3202 | (if current-definition | 2978 | (funcall (or fsetfun #'fset) function newdef) |
| 3203 | ;; we have a first definition, save it as original: | 2979 | (when current-definition (ad-activate-internal function))))) |
| 3204 | (ad-set-orig-definition function current-definition) | ||
| 3205 | ;; we don't have anything noteworthy: | ||
| 3206 | nil)))) | ||
| 3207 | 2980 | ||
| 3208 | 2981 | ||
| 3209 | ;; @@ The top-level advice interface: | 2982 | ;; @@ The top-level advice interface: |
| @@ -3229,24 +3002,20 @@ definition will always be cached for later usage." | |||
| 3229 | (interactive | 3002 | (interactive |
| 3230 | (list (ad-read-advised-function "Activate advice of") | 3003 | (list (ad-read-advised-function "Activate advice of") |
| 3231 | current-prefix-arg)) | 3004 | current-prefix-arg)) |
| 3232 | (if ad-activate-on-top-level | 3005 | (if (not (ad-is-advised function)) |
| 3233 | ;; avoid recursive calls to `ad-activate': | 3006 | (error "ad-activate: `%s' is not advised" function) |
| 3234 | (ad-with-auto-activation-disabled | 3007 | ;; Just return for forward advised and not yet defined functions: |
| 3235 | (if (not (ad-is-advised function)) | 3008 | (if (ad-get-orig-definition function) |
| 3236 | (error "ad-activate: `%s' is not advised" function) | 3009 | (if (not (ad-has-any-advice function)) |
| 3237 | (ad-handle-definition function) | 3010 | (ad-unadvise function) |
| 3238 | ;; Just return for forward advised and not yet defined functions: | 3011 | ;; Otherwise activate the advice: |
| 3239 | (if (ad-get-orig-definition function) | 3012 | (cond ((ad-has-redefining-advice function) |
| 3240 | (if (not (ad-has-any-advice function)) | 3013 | (ad-activate-advised-definition function compile) |
| 3241 | (ad-unadvise function) | 3014 | (ad-set-advice-info-field function 'active t) |
| 3242 | ;; Otherwise activate the advice: | 3015 | (eval (ad-make-hook-form function 'activation)) |
| 3243 | (cond ((ad-has-redefining-advice function) | 3016 | function) |
| 3244 | (ad-activate-advised-definition function compile) | 3017 | ;; Here we are if we have all disabled advices: |
| 3245 | (ad-set-advice-info-field function 'active t) | 3018 | (t (ad-deactivate function))))))) |
| 3246 | (eval (ad-make-hook-form function 'activation)) | ||
| 3247 | function) | ||
| 3248 | ;; Here we are if we have all disabled advices: | ||
| 3249 | (t (ad-deactivate function))))))))) | ||
| 3250 | 3019 | ||
| 3251 | (defalias 'ad-activate-on 'ad-activate) | 3020 | (defalias 'ad-activate-on 'ad-activate) |
| 3252 | 3021 | ||
| @@ -3261,11 +3030,10 @@ a call to `ad-activate'." | |||
| 3261 | (if (not (ad-is-advised function)) | 3030 | (if (not (ad-is-advised function)) |
| 3262 | (error "ad-deactivate: `%s' is not advised" function) | 3031 | (error "ad-deactivate: `%s' is not advised" function) |
| 3263 | (cond ((ad-is-active function) | 3032 | (cond ((ad-is-active function) |
| 3264 | (ad-handle-definition function) | ||
| 3265 | (if (not (ad-get-orig-definition function)) | 3033 | (if (not (ad-get-orig-definition function)) |
| 3266 | (error "ad-deactivate: `%s' has no original definition" | 3034 | (error "ad-deactivate: `%s' has no original definition" |
| 3267 | function) | 3035 | function) |
| 3268 | (fset function (ad-get-orig-definition function)) | 3036 | (ad-clear-advicefunname-definition function) |
| 3269 | (ad-set-advice-info-field function 'active nil) | 3037 | (ad-set-advice-info-field function 'active nil) |
| 3270 | (eval (ad-make-hook-form function 'deactivation)) | 3038 | (eval (ad-make-hook-form function 'deactivation)) |
| 3271 | function))))) | 3039 | function))))) |
| @@ -3287,7 +3055,7 @@ If FUNCTION was not advised this will be a noop." | |||
| 3287 | (cond ((ad-is-advised function) | 3055 | (cond ((ad-is-advised function) |
| 3288 | (if (ad-is-active function) | 3056 | (if (ad-is-active function) |
| 3289 | (ad-deactivate function)) | 3057 | (ad-deactivate function)) |
| 3290 | (ad-clear-orig-definition function) | 3058 | (ad-clear-advicefunname-definition function) |
| 3291 | (ad-set-advice-info function nil) | 3059 | (ad-set-advice-info function nil) |
| 3292 | (ad-pop-advised-function function)))) | 3060 | (ad-pop-advised-function function)))) |
| 3293 | 3061 | ||
| @@ -3302,9 +3070,7 @@ Use in emergencies." | |||
| 3302 | (list (intern | 3070 | (list (intern |
| 3303 | (completing-read "Recover advised function: " obarray nil t)))) | 3071 | (completing-read "Recover advised function: " obarray nil t)))) |
| 3304 | (cond ((ad-is-advised function) | 3072 | (cond ((ad-is-advised function) |
| 3305 | (cond ((ad-get-orig-definition function) | 3073 | (ad-clear-advicefunname-definition function) |
| 3306 | (fset function (ad-get-orig-definition function)) | ||
| 3307 | (ad-clear-orig-definition function))) | ||
| 3308 | (ad-set-advice-info function nil) | 3074 | (ad-set-advice-info function nil) |
| 3309 | (ad-pop-advised-function function)))) | 3075 | (ad-pop-advised-function function)))) |
| 3310 | 3076 | ||
| @@ -3544,35 +3310,15 @@ undone on exit of this macro." | |||
| 3544 | ;; @@ Starting, stopping and recovering from the advice package magic: | 3310 | ;; @@ Starting, stopping and recovering from the advice package magic: |
| 3545 | ;; =================================================================== | 3311 | ;; =================================================================== |
| 3546 | 3312 | ||
| 3547 | (defun ad-start-advice () | ||
| 3548 | "Start the automatic advice handling magic." | ||
| 3549 | (interactive) | ||
| 3550 | ;; Advising `ad-activate-internal' means death!! | ||
| 3551 | (ad-set-advice-info 'ad-activate-internal nil) | ||
| 3552 | (fset 'ad-activate-internal 'ad-activate)) | ||
| 3553 | |||
| 3554 | (defun ad-stop-advice () | ||
| 3555 | "Stop the automatic advice handling magic. | ||
| 3556 | You should only need this in case of Advice-related emergencies." | ||
| 3557 | (interactive) | ||
| 3558 | ;; Advising `ad-activate-internal' means death!! | ||
| 3559 | (ad-set-advice-info 'ad-activate-internal nil) | ||
| 3560 | (fset 'ad-activate-internal 'ad-activate-internal-off)) | ||
| 3561 | |||
| 3562 | (defun ad-recover-normality () | 3313 | (defun ad-recover-normality () |
| 3563 | "Undo all advice related redefinitions and unadvises everything. | 3314 | "Undo all advice related redefinitions and unadvises everything. |
| 3564 | Use only in REAL emergencies." | 3315 | Use only in REAL emergencies." |
| 3565 | (interactive) | 3316 | (interactive) |
| 3566 | ;; Advising `ad-activate-internal' means death!! | ||
| 3567 | (ad-set-advice-info 'ad-activate-internal nil) | ||
| 3568 | (fset 'ad-activate-internal 'ad-activate-internal-off) | ||
| 3569 | (ad-recover-all) | 3317 | (ad-recover-all) |
| 3570 | (ad-do-advised-functions (function) | 3318 | (ad-do-advised-functions (function) |
| 3571 | (message "Oops! Left over advised function %S" function) | 3319 | (message "Oops! Left over advised function %S" function) |
| 3572 | (ad-pop-advised-function function))) | 3320 | (ad-pop-advised-function function))) |
| 3573 | 3321 | ||
| 3574 | (ad-start-advice) | ||
| 3575 | |||
| 3576 | (provide 'advice) | 3322 | (provide 'advice) |
| 3577 | 3323 | ||
| 3578 | ;;; advice.el ends here | 3324 | ;;; advice.el ends here |
diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el index 9f9719fdcfc..8f9bf54114c 100644 --- a/test/automated/advice-tests.el +++ b/test/automated/advice-tests.el | |||
| @@ -57,6 +57,29 @@ | |||
| 57 | (defmacro sm-test3 (x) `(call-test3 ,x)) | 57 | (defmacro sm-test3 (x) `(call-test3 ,x)) |
| 58 | (macroexpand '(sm-test3 56)) (toto (call-test3 56))) | 58 | (macroexpand '(sm-test3 56)) (toto (call-test3 56))) |
| 59 | 59 | ||
| 60 | ((defadvice sm-test4 (around wrap-with-toto activate) | ||
| 61 | ad-do-it (setq ad-return-value `(toto ,ad-return-value))) | ||
| 62 | (defmacro sm-test4 (x) `(call-test4 ,x)) | ||
| 63 | (macroexpand '(sm-test4 56)) (toto (call-test4 56))) | ||
| 64 | ((defmacro sm-test4 (x) `(call-testq ,x)) | ||
| 65 | (macroexpand '(sm-test4 56)) (toto (call-testq 56))) | ||
| 66 | |||
| 67 | ;; Combining old style and new style advices. | ||
| 68 | ((defun sm-test5 (x) (+ x 4)) | ||
| 69 | (sm-test5 6) 10) | ||
| 70 | ((advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) | ||
| 71 | (sm-test5 6) 50) | ||
| 72 | ((defadvice sm-test5 (around test activate) | ||
| 73 | ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) | ||
| 74 | (sm-test5 5) 45.1) | ||
| 75 | ((ad-deactivate 'sm-test5) | ||
| 76 | (sm-test5 6) 50) | ||
| 77 | ((ad-activate 'sm-test5) | ||
| 78 | (sm-test5 6) 50.1) | ||
| 79 | ((defun sm-test5 (x) (+ x 14)) | ||
| 80 | (sm-test5 6) 100.1) | ||
| 81 | ((advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) | ||
| 82 | (sm-test5 6) 20.1) | ||
| 60 | )) | 83 | )) |
| 61 | 84 | ||
| 62 | (ert-deftest advice-tests () | 85 | (ert-deftest advice-tests () |