aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2012-11-13 09:12:46 -0500
committerStefan Monnier2012-11-13 09:12:46 -0500
commit3c442f8b25bf6acc52c45a1f9966b8529ea936d2 (patch)
treed6372faa4eef5ed4919e94592240b06634e0a4c8
parentc708524567662c8911c5ab2695acc7bda0383705 (diff)
downloademacs-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/NEWS3
-rw-r--r--lisp/ChangeLog28
-rw-r--r--lisp/emacs-lisp/advice.el730
-rw-r--r--test/automated/advice-tests.el23
4 files changed, 291 insertions, 493 deletions
diff --git a/etc/NEWS b/etc/NEWS
index fbe24c8345f..58acf81897c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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
47special-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.
49VAR was bound to nil which was not tremendously useful and just lead to 50VAR 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 @@
12012-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
12012-11-13 Dmitry Gutov <dgutov@yandex.ru> 292012-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."
1816On each iteration VAR will be bound to the name of an advised function 1705On 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
2374to generate a proper advised docstring even if we are just given a 2224to generate a proper advised docstring even if we are just given a
2375definition (see the code for `documentation')." 2225definition (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
2634supplied as nil. Returns a `funcall' or `apply' form with the second element 2476supplied as nil. Returns a `funcall' or `apply' form with the second element
2635being `function' which has to be replaced by an actual function argument. 2477being `function' which has to be replaced by an actual function argument.
2636Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return 2478Example: `(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.
2709It concatenates the original documentation with the documentation 2537It concatenates the original documentation with the documentation
@@ -2712,14 +2540,14 @@ according to STYLE. STYLE can be `plain', everything else
2712will be interpreted as `default'. The order of the advice documentation 2540will be interpreted as `default'. The order of the advice documentation
2713strings corresponds to before/around/after and the individual ordering 2541strings corresponds to before/around/after and the individual ordering
2714in any of these classes." 2542in 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. 2620ARGS is the argument list that has to be used,
2843It constructs a function or macro definition according to TYPE which has to 2621DOCSTRING if non-nil defines the documentation of the definition,
2844be either `macro', `function' or `special-form'. ARGS is the argument list 2622INTERACTIVE if non-nil is the interactive form to be used,
2845that has to be used, DOCSTRING if non-nil defines the documentation of the
2846definition, INTERACTIVE if non-nil is the interactive form to be used,
2847ORIG is a form that calls the body of the original unadvised function, 2623ORIG is a form that calls the body of the original unadvised function,
2848and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG 2624and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG
2849should be modified. The assembled function will be returned." 2625should 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.
3147The current definition and its cache-id will be put into the cache." 2919The 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.
3170If FUNCTION does not have an original definition associated with it and 2949If FUNCTION does not have an original definition associated with it and
3171the current definition is usable, then it will be stored as FUNCTION's 2950the 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
3177de/activated. If you do not like the current redefinition action change 2956de/activated. If you do not like the current redefinition action change
3178the value of `ad-redefinition-action' and de/activate again." 2957the 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.
3556You 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.
3564Use only in REAL emergencies." 3315Use 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 ()