Commit | Line | Data |
---|---|---|
6858633a | 1 | ;;; advice.el --- An overloading mechanism for Emacs Lisp functions -*- lexical-binding: t -*- |
ee7bf2ad | 2 | |
ba318903 | 3 | ;; Copyright (C) 1993-1994, 2000-2014 Free Software Foundation, Inc. |
ee7bf2ad RM |
4 | |
5 | ;; Author: Hans Chalupsky <hans@cs.buffalo.edu> | |
34dc21db | 6 | ;; Maintainer: emacs-devel@gnu.org |
ee7bf2ad | 7 | ;; Created: 12 Dec 1992 |
b7f66977 | 8 | ;; Keywords: extensions, lisp, tools |
bd78fa1d | 9 | ;; Package: emacs |
ee7bf2ad RM |
10 | |
11 | ;; This file is part of GNU Emacs. | |
12 | ||
d6cba7ae | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
ee7bf2ad | 14 | ;; it under the terms of the GNU General Public License as published by |
d6cba7ae GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
ee7bf2ad RM |
17 | |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
d6cba7ae | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
ee7bf2ad RM |
25 | |
26 | ;; LCD Archive Entry: | |
27 | ;; advice|Hans Chalupsky|hans@cs.buffalo.edu| | |
6e2f6f45 | 28 | ;; Overloading mechanism for Emacs Lisp functions| |
81eee8ab | 29 | ;; 1994/08/05 03:42:04|2.14|~/packages/advice.el.Z| |
ee7bf2ad RM |
30 | |
31 | ||
32 | ;;; Commentary: | |
33 | ||
fce44373 | 34 | ;; Advice is documented in the Emacs Lisp Manual. |
6e2f6f45 | 35 | |
ee7bf2ad RM |
36 | ;; @ Introduction: |
37 | ;; =============== | |
38 | ;; This package implements a full-fledged Lisp-style advice mechanism | |
fce44373 | 39 | ;; for Emacs Lisp. Advice is a clean and efficient way to modify the |
ee7bf2ad | 40 | ;; behavior of Emacs Lisp functions without having to keep personal |
fce44373 DL |
41 | ;; modified copies of such functions around. A great number of such |
42 | ;; modifications can be achieved by treating the original function as a | |
43 | ;; black box and specifying a different execution environment for it | |
ee7bf2ad RM |
44 | ;; with a piece of advice. Think of a piece of advice as a kind of fancy |
45 | ;; hook that you can attach to any function/macro/subr. | |
46 | ||
47 | ;; @ Highlights: | |
48 | ;; ============= | |
49 | ;; - Clean definition of multiple, named before/around/after advices | |
3c442f8b | 50 | ;; for functions and macros. |
ee7bf2ad RM |
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 | |
53 | ;; value it will return. | |
3c442f8b SM |
54 | ;; - Allows re/definition of interactive behavior for commands. |
55 | ;; - Every piece of advice can have its documentation string. | |
ee7bf2ad RM |
56 | ;; - The execution of every piece of advice can be protected against error |
57 | ;; and non-local exits in preceding code or advices. | |
58 | ;; - Simple argument access either by name, or, more portable but as | |
59 | ;; efficient, via access macros | |
60 | ;; - Allows the specification of a different argument list for the advised | |
61 | ;; version of a function. | |
62 | ;; - Advised functions can be byte-compiled either at file-compile time | |
63 | ;; (see preactivation) or activation time. | |
3c442f8b | 64 | ;; - Separation of advice definition and activation. |
fabaa9b5 | 65 | ;; - Forward advice is possible, that is |
ee7bf2ad | 66 | ;; as yet undefined or autoload functions can be advised without having to |
fce44373 | 67 | ;; preload the file in which they are defined. |
ee7bf2ad RM |
68 | ;; - Forward redefinition is possible because around advice can be used to |
69 | ;; completely redefine a function. | |
70 | ;; - A caching mechanism for advised definition provides for cheap deactivation | |
71 | ;; and reactivation of advised functions. | |
72 | ;; - Preactivation allows efficient construction and compilation of advised | |
73 | ;; definitions at file compile time without giving up the flexibility of | |
74 | ;; the advice mechanism. | |
75 | ;; - En/disablement mechanism allows the use of different "views" of advised | |
76 | ;; functions depending on what pieces of advice are currently en/disabled | |
fce44373 | 77 | ;; - Provides manipulation mechanisms for sets of advised functions via |
3c442f8b | 78 | ;; regular expressions that match advice names. |
ee7bf2ad | 79 | |
ee7bf2ad RM |
80 | ;; @ Overview, or how to read this file: |
81 | ;; ===================================== | |
aaf0c300 SM |
82 | ;; You can use `outline-mode' to help you read this documentation (set |
83 | ;; `outline-regexp' to `";; @+"'). | |
ee7bf2ad RM |
84 | ;; |
85 | ;; The four major sections of this file are: | |
86 | ;; | |
87 | ;; @ This initial information ...installation, customization etc. | |
88 | ;; @ Advice documentation: ...general documentation | |
6e2f6f45 | 89 | ;; @ Foo games: An advice tutorial ...teaches about Advice by example |
ee7bf2ad RM |
90 | ;; @ Advice implementation: ...actual code, yeah!! |
91 | ;; | |
92 | ;; The latter three are actual headings which you can search for | |
6e2f6f45 | 93 | ;; directly in case `outline-mode' doesn't work for you. |
ee7bf2ad RM |
94 | |
95 | ;; @ Restrictions: | |
96 | ;; =============== | |
97 | ;; - Advised functions/macros/subrs will only exhibit their advised behavior | |
98 | ;; when they are invoked via their function cell. This means that advice will | |
99 | ;; not work for the following: | |
fce44373 DL |
100 | ;; + advised subrs that are called directly from other subrs or C-code |
101 | ;; + advised subrs that got replaced with their byte-code during | |
ee7bf2ad RM |
102 | ;; byte-compilation (e.g., car) |
103 | ;; + advised macros which were expanded during byte-compilation before | |
104 | ;; their advice was activated. | |
6e2f6f45 | 105 | |
ee7bf2ad RM |
106 | ;; @ Credits: |
107 | ;; ========== | |
108 | ;; This package is an extension and generalization of packages such as | |
109 | ;; insert-hooks.el written by Noah S. Friedman, and advise.el written by | |
110 | ;; Raul J. Acevedo. Some ideas used in here come from these packages, | |
111 | ;; others come from the various Lisp advice mechanisms I've come across | |
112 | ;; so far, and a few are simply mine. | |
113 | ||
ee7bf2ad RM |
114 | ;; @ Safety Rules and Emergency Exits: |
115 | ;; =================================== | |
116 | ;; Before we begin: CAUTION!! | |
6e2f6f45 | 117 | ;; Advice provides you with a lot of rope to hang yourself on very |
ee7bf2ad | 118 | ;; easily accessible trees, so, here are a few important things you |
3c442f8b | 119 | ;; should know: |
8a946354 | 120 | ;; |
ee7bf2ad | 121 | ;; If you experience any strange behavior/errors etc. that you attribute to |
6e2f6f45 | 122 | ;; Advice or to some ill-advised function do one of the following: |
ee7bf2ad RM |
123 | |
124 | ;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what | |
125 | ;; function gives you problems) | |
126 | ;; - M-x ad-deactivate-all (if you don't have a clue what's going wrong) | |
ee7bf2ad | 127 | ;; - M-x ad-recover-normality (for real emergencies) |
6e2f6f45 | 128 | ;; - If none of the above solves your Advice-related problem go to another |
ee7bf2ad RM |
129 | ;; terminal, kill your Emacs process and send me some hate mail. |
130 | ||
3c442f8b | 131 | ;; The first two measures have restarts, i.e., once you've figured out |
ee7bf2ad | 132 | ;; the problem you can reactivate advised functions with either `ad-activate', |
3c442f8b | 133 | ;; or `ad-activate-all'. `ad-recover-normality' unadvises |
ee7bf2ad RM |
134 | ;; everything so you won't be able to reactivate any advised functions, you'll |
135 | ;; have to stick with their standard incarnations for the rest of the session. | |
136 | ||
6e2f6f45 | 137 | ;; RELAX: Advice is pretty safe even if you are oblivious to the above. |
ee7bf2ad | 138 | ;; I use it extensively and haven't run into any serious trouble in a long |
3c442f8b | 139 | ;; time. Just wanted you to be warned. |
ee7bf2ad | 140 | |
ee7bf2ad RM |
141 | ;; @ Customization: |
142 | ;; ================ | |
ee7bf2ad | 143 | |
ee7bf2ad | 144 | ;; Look at the documentation of `ad-redefinition-action' for possible values |
3c442f8b | 145 | ;; of this variable. Its default value is `warn' which will print a warning |
ee7bf2ad RM |
146 | ;; message when an already defined advised function gets redefined with a |
147 | ;; new original definition and de/activated. | |
148 | ||
fabaa9b5 | 149 | ;; Look at the documentation of `ad-default-compilation-action' for possible |
3c442f8b | 150 | ;; values of this variable. Its default value is `maybe' which will compile |
fabaa9b5 | 151 | ;; advised definitions during activation in case the byte-compiler is already |
3c442f8b | 152 | ;; loaded. Otherwise, it will leave them uncompiled. |
fabaa9b5 | 153 | |
ee7bf2ad RM |
154 | ;; @ Motivation: |
155 | ;; ============= | |
156 | ;; Before I go on explaining how advice works, here are four simple examples | |
3c442f8b | 157 | ;; how this package can be used. The first three are very useful, the last one |
ee7bf2ad RM |
158 | ;; is just a joke: |
159 | ||
160 | ;;(defadvice switch-to-buffer (before existing-buffers-only activate) | |
fce44373 | 161 | ;; "When called interactively switch to existing buffers only, unless |
ee7bf2ad | 162 | ;;when called with a prefix argument." |
fce44373 DL |
163 | ;; (interactive |
164 | ;; (list (read-buffer "Switch to buffer: " (other-buffer) | |
ee7bf2ad RM |
165 | ;; (null current-prefix-arg))))) |
166 | ;; | |
167 | ;;(defadvice switch-to-buffer (around confirm-non-existing-buffers activate) | |
168 | ;; "Switch to non-existing buffers only upon confirmation." | |
169 | ;; (interactive "BSwitch to buffer: ") | |
170 | ;; (if (or (get-buffer (ad-get-arg 0)) | |
171 | ;; (y-or-n-p (format "`%s' does not exist, create? " (ad-get-arg 0)))) | |
172 | ;; ad-do-it)) | |
173 | ;; | |
174 | ;;(defadvice find-file (before existing-files-only activate) | |
175 | ;; "Find existing files only" | |
176 | ;; (interactive "fFind file: ")) | |
177 | ;; | |
178 | ;;(defadvice car (around interactive activate) | |
179 | ;; "Make `car' an interactive function." | |
180 | ;; (interactive "xCar of list: ") | |
181 | ;; ad-do-it | |
32226619 | 182 | ;; (if (called-interactively-p 'interactive) |
ee7bf2ad RM |
183 | ;; (message "%s" ad-return-value))) |
184 | ||
185 | ||
186 | ;; @ Advice documentation: | |
187 | ;; ======================= | |
3c442f8b | 188 | ;; Below is general documentation of the various features of advice. For more |
ee7bf2ad RM |
189 | ;; concrete examples check the corresponding sections in the tutorial part. |
190 | ||
191 | ;; @@ Terminology: | |
192 | ;; =============== | |
aaf0c300 | 193 | ;; - Emacs: Emacs as released by the GNU Project |
6e2f6f45 | 194 | ;; - Advice: The name of this package. |
ee7bf2ad RM |
195 | ;; - advices: Short for "pieces of advice". |
196 | ||
197 | ;; @@ Defining a piece of advice with `defadvice': | |
198 | ;; =============================================== | |
199 | ;; The main means of defining a piece of advice is the macro `defadvice', | |
200 | ;; there is no interactive way of specifying a piece of advice. A call to | |
201 | ;; `defadvice' has the following syntax which is similar to the syntax of | |
202 | ;; `defun/defmacro': | |
203 | ;; | |
204 | ;; (defadvice <function> (<class> <name> [<position>] [<arglist>] {<flags>}*) | |
205 | ;; [ [<documentation-string>] [<interactive-form>] ] | |
206 | ;; {<body-form>}* ) | |
207 | ||
208 | ;; <function> is the name of the function/macro/subr to be advised. | |
209 | ||
210 | ;; <class> is the class of the advice which has to be one of `before', | |
211 | ;; `around', `after', `activation' or `deactivation' (the last two allow | |
212 | ;; definition of special act/deactivation hooks). | |
213 | ||
6e2f6f45 | 214 | ;; <name> is the name of the advice which has to be a non-nil symbol. |
ee7bf2ad RM |
215 | ;; Names uniquely identify a piece of advice in a certain advice class, |
216 | ;; hence, advices can be redefined by defining an advice with the same class | |
3c442f8b | 217 | ;; and name. Advice names are global symbols, hence, the same name space |
ee7bf2ad RM |
218 | ;; conventions used for function names should be applied. |
219 | ||
220 | ;; An optional <position> specifies where in the current list of advices of | |
3c442f8b | 221 | ;; the specified <class> this new advice will be placed. <position> has to |
ee7bf2ad | 222 | ;; be either `first', `last' or a number that specifies a zero-based |
3c442f8b SM |
223 | ;; position (`first' is equivalent to 0). If no position is specified |
224 | ;; `first' will be used as a default. If this call to `defadvice' redefines | |
ee7bf2ad RM |
225 | ;; an already existing advice (see above) then the position argument will |
226 | ;; be ignored and the position of the already existing advice will be used. | |
227 | ||
228 | ;; An optional <arglist> which has to be a list can be used to define the | |
3c442f8b | 229 | ;; argument list of the advised function. This argument list should of |
ee7bf2ad RM |
230 | ;; course be compatible with the argument list of the original function, |
231 | ;; otherwise functions that call the advised function with the original | |
3c442f8b | 232 | ;; argument list in mind will break. If more than one advice specify an |
ee7bf2ad RM |
233 | ;; argument list then the first one (the one with the smallest position) |
234 | ;; found in the list of before/around/after advices will be used. | |
235 | ||
236 | ;; <flags> is a list of symbols that specify further information about the | |
237 | ;; advice. All flags can be specified with unambiguous initial substrings. | |
238 | ;; `activate': Specifies that the advice information of the advised | |
239 | ;; function should be activated right after this advice has been | |
fce44373 | 240 | ;; defined. In forward advices `activate' will be ignored. |
ee7bf2ad RM |
241 | ;; `protect': Specifies that this advice should be protected against |
242 | ;; non-local exits and errors in preceding code/advices. | |
243 | ;; `compile': Specifies that the advised function should be byte-compiled. | |
244 | ;; This flag will be ignored unless `activate' is also specified. | |
245 | ;; `disable': Specifies that the defined advice should be disabled, hence, | |
246 | ;; it will not be used in an activation until somebody enables it. | |
247 | ;; `preactivate': Specifies that the advised function should get preactivated | |
3c442f8b | 248 | ;; at macro-expansion/compile time of this `defadvice'. This |
ee7bf2ad RM |
249 | ;; generates a compiled advised definition according to the |
250 | ;; current advice state which will be used during activation | |
3c442f8b | 251 | ;; if appropriate. Only use this if the `defadvice' gets |
aaf0c300 | 252 | ;; actually compiled. |
ee7bf2ad RM |
253 | |
254 | ;; An optional <documentation-string> can be supplied to document the advice. | |
255 | ;; On call of the `documentation' function it will be combined with the | |
256 | ;; documentation strings of the original function and other advices. | |
257 | ||
258 | ;; An optional <interactive-form> form can be supplied to change/add | |
3c442f8b | 259 | ;; interactive behavior of the original function. If more than one advice |
ee7bf2ad RM |
260 | ;; has an `(interactive ...)' specification then the first one (the one |
261 | ;; with the smallest position) found in the list of before/around/after | |
262 | ;; advices will be used. | |
263 | ||
264 | ;; A possibly empty list of <body-forms> specifies the body of the advice in | |
3c442f8b | 265 | ;; an implicit progn. The body of an advice can access/change arguments, |
fce44373 | 266 | ;; the return value, the binding environment, and can have all sorts of |
ee7bf2ad RM |
267 | ;; other side effects. |
268 | ||
269 | ;; @@ Assembling advised definitions: | |
270 | ;; ================================== | |
271 | ;; Suppose a function/macro/subr/special-form has N pieces of before advice, | |
3c442f8b | 272 | ;; M pieces of around advice and K pieces of after advice. Assuming none of |
ee7bf2ad RM |
273 | ;; the advices is protected, its advised definition will look like this |
274 | ;; (body-form indices correspond to the position of the respective advice in | |
275 | ;; that advice class): | |
276 | ||
277 | ;; ([macro] lambda <arglist> | |
278 | ;; [ [<advised-docstring>] [(interactive ...)] ] | |
279 | ;; (let (ad-return-value) | |
280 | ;; {<before-0-body-form>}* | |
281 | ;; .... | |
282 | ;; {<before-N-1-body-form>}* | |
283 | ;; {<around-0-body-form>}* | |
284 | ;; {<around-1-body-form>}* | |
285 | ;; .... | |
286 | ;; {<around-M-1-body-form>}* | |
287 | ;; (setq ad-return-value | |
288 | ;; <apply original definition to <arglist>>) | |
289 | ;; {<other-around-M-1-body-form>}* | |
290 | ;; .... | |
291 | ;; {<other-around-1-body-form>}* | |
292 | ;; {<other-around-0-body-form>}* | |
293 | ;; {<after-0-body-form>}* | |
294 | ;; .... | |
295 | ;; {<after-K-1-body-form>}* | |
296 | ;; ad-return-value)) | |
297 | ||
2200a8c9 CY |
298 | ;; Macros are redefined as macros, hence the optional [macro] in the |
299 | ;; beginning of the definition. | |
ee7bf2ad RM |
300 | |
301 | ;; <arglist> is either the argument list of the original function or the | |
302 | ;; first argument list defined in the list of before/around/after advices. | |
303 | ;; The values of <arglist> variables can be accessed/changed in the body of | |
304 | ;; an advice by simply referring to them by their original name, however, | |
25dec365 | 305 | ;; more portable argument access macros are also provided (see below). |
ee7bf2ad RM |
306 | |
307 | ;; <advised-docstring> is an optional, special documentation string which will | |
308 | ;; be expanded into a proper documentation string upon call of `documentation'. | |
309 | ||
310 | ;; (interactive ...) is an optional interactive form either taken from the | |
3c442f8b | 311 | ;; original function or from a before/around/after advice. For advised |
ee7bf2ad RM |
312 | ;; interactive subrs that do not have an interactive form specified in any |
313 | ;; advice we have to use (interactive) and then call the subr interactively | |
314 | ;; if the advised function was called interactively, because the | |
3c442f8b | 315 | ;; interactive specification of subrs is not accessible. This is the only |
ee7bf2ad RM |
316 | ;; case where changing the values of arguments will not have an affect |
317 | ;; because they will be reset by the interactive specification of the subr. | |
318 | ;; If this is a problem one can always specify an interactive form in a | |
319 | ;; before/around/after advice to gain control over argument values that | |
320 | ;; were supplied interactively. | |
8a946354 | 321 | ;; |
ee7bf2ad RM |
322 | ;; Then the body forms of the various advices in the various classes of advice |
323 | ;; are assembled in order. The forms of around advice L are normally part of | |
3c442f8b | 324 | ;; one of the forms of around advice L-1. An around advice can specify where |
ee7bf2ad | 325 | ;; the forms of the wrapped or surrounded forms should go with the special |
3c442f8b | 326 | ;; keyword `ad-do-it', which will run the forms of the surrounded code. |
ee7bf2ad | 327 | |
fce44373 | 328 | ;; The innermost part of the around advice onion is |
ee7bf2ad | 329 | ;; <apply original definition to <arglist>> |
3c442f8b SM |
330 | ;; whose form depends on the type of the original function. The variable |
331 | ;; `ad-return-value' will be set to its result. This variable is visible to | |
ee7bf2ad | 332 | ;; all pieces of advice which can access and modify it before it gets returned. |
8a946354 | 333 | ;; |
ee7bf2ad | 334 | ;; The semantic structure of advised functions that contain protected pieces |
3c442f8b | 335 | ;; of advice is the same. The only difference is that `unwind-protect' forms |
ee7bf2ad | 336 | ;; make sure that the protected advice gets executed even if some previous |
3c442f8b | 337 | ;; piece of advice had an error or a non-local exit. If any around advice is |
ee7bf2ad RM |
338 | ;; protected then the whole around advice onion will be protected. |
339 | ||
340 | ;; @@ Argument access in advised functions: | |
341 | ;; ======================================== | |
342 | ;; As already mentioned, the simplest way to access the arguments of an | |
3c442f8b SM |
343 | ;; advised function in the body of an advice is to refer to them by name. |
344 | ;; To do that, the advice programmer needs to know either the names of the | |
ee7bf2ad | 345 | ;; argument variables of the original function, or the names used in the |
3c442f8b | 346 | ;; argument list redefinition given in a piece of advice. While this simple |
ee7bf2ad RM |
347 | ;; method might be sufficient in many cases, it has the disadvantage that it |
348 | ;; is not very portable because it hardcodes the argument names into the | |
349 | ;; advice. If the definition of the original function changes the advice | |
3c442f8b | 350 | ;; might break even though the code might still be correct. Situations like |
ee7bf2ad RM |
351 | ;; that arise, for example, if one advises a subr like `eval-region' which |
352 | ;; gets redefined in a non-advice style into a function by the edebug | |
3c442f8b SM |
353 | ;; package. If the advice assumes `eval-region' to be a subr it might break |
354 | ;; once edebug is loaded. Similar situations arise when one wants to use the | |
aaf0c300 | 355 | ;; same piece of advice across different versions of Emacs. |
ee7bf2ad RM |
356 | |
357 | ;; As a solution to that advice provides argument list access macros that get | |
358 | ;; translated into the proper access forms at activation time, i.e., when the | |
3c442f8b | 359 | ;; advised definition gets constructed. Access macros access actual arguments |
ee7bf2ad | 360 | ;; by position regardless of how these actual argument get distributed onto |
3c442f8b | 361 | ;; the argument variables of a function. The rational behind this is that in |
ee7bf2ad RM |
362 | ;; Emacs Lisp the semantics of an argument is strictly determined by its |
363 | ;; position (there are no keyword arguments). | |
364 | ||
365 | ;; Suppose the function `foo' is defined as | |
366 | ;; | |
367 | ;; (defun foo (x y &optional z &rest r) ....) | |
368 | ;; | |
369 | ;; and is then called with | |
370 | ;; | |
371 | ;; (foo 0 1 2 3 4 5 6) | |
372 | ||
3c442f8b SM |
373 | ;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that |
374 | ;; the semantics of an actual argument is determined by its position. It is | |
375 | ;; this semantics that has to be known by the advice programmer. Then s/he | |
ee7bf2ad RM |
376 | ;; can access these arguments in a piece of advice with some of the |
377 | ;; following macros (the arrows indicate what value they will return): | |
378 | ||
379 | ;; (ad-get-arg 0) -> 0 | |
380 | ;; (ad-get-arg 1) -> 1 | |
381 | ;; (ad-get-arg 2) -> 2 | |
382 | ;; (ad-get-arg 3) -> 3 | |
383 | ;; (ad-get-args 2) -> (2 3 4 5 6) | |
384 | ;; (ad-get-args 4) -> (4 5 6) | |
385 | ||
386 | ;; `(ad-get-arg <position>)' will return the actual argument that was supplied | |
387 | ;; at <position>, `(ad-get-args <position>)' will return the list of actual | |
3c442f8b | 388 | ;; arguments supplied starting at <position>. Note that these macros can be |
ee7bf2ad RM |
389 | ;; used without any knowledge about the form of the actual argument list of |
390 | ;; the original function. | |
391 | ||
392 | ;; Similarly, `(ad-set-arg <position> <value-form>)' can be used to set the | |
3c442f8b | 393 | ;; value of the actual argument at <position> to <value-form>. For example, |
ee7bf2ad RM |
394 | ;; |
395 | ;; (ad-set-arg 5 "five") | |
396 | ;; | |
397 | ;; will have the effect that R=(3 4 "five" 6) once the original function is | |
3c442f8b | 398 | ;; called. `(ad-set-args <position> <value-list-form>)' can be used to set |
ee7bf2ad RM |
399 | ;; the list of actual arguments starting at <position> to <value-list-form>. |
400 | ;; For example, | |
401 | ;; | |
402 | ;; (ad-set-args 0 '(5 4 3 2 1 0)) | |
403 | ;; | |
404 | ;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original | |
405 | ;; function is called. | |
406 | ||
3c442f8b | 407 | ;; All these access macros are text macros rather than real Lisp macros. When |
ee7bf2ad RM |
408 | ;; the advised definition gets constructed they get replaced with actual access |
409 | ;; forms depending on the argument list of the advised function, i.e., after | |
410 | ;; that argument access is in most cases as efficient as using the argument | |
411 | ;; variable names directly. | |
412 | ||
413 | ;; @@@ Accessing argument bindings of arbitrary functions: | |
414 | ;; ======================================================= | |
415 | ;; Some functions (such as `trace-function' defined in trace.el) need a | |
416 | ;; method of accessing the names and bindings of the arguments of an | |
3c442f8b | 417 | ;; arbitrary advised function. To do that within an advice one can use the |
ee7bf2ad RM |
418 | ;; special keyword `ad-arg-bindings' which is a text macro that will be |
419 | ;; substituted with a form that will evaluate to a list of binding | |
420 | ;; specifications, one for every argument variable. These binding | |
421 | ;; specifications can then be examined in the body of the advice. For | |
422 | ;; example, somewhere in an advice we could do this: | |
423 | ;; | |
424 | ;; (let* ((bindings ad-arg-bindings) | |
425 | ;; (firstarg (car bindings)) | |
426 | ;; (secondarg (car (cdr bindings)))) | |
427 | ;; ;; Print info about first argument | |
428 | ;; (print (format "%s=%s (%s)" | |
429 | ;; (ad-arg-binding-field firstarg 'name) | |
430 | ;; (ad-arg-binding-field firstarg 'value) | |
431 | ;; (ad-arg-binding-field firstarg 'type))) | |
432 | ;; ....) | |
433 | ;; | |
434 | ;; The `type' of an argument is either `required', `optional' or `rest'. | |
435 | ;; Wherever `ad-arg-bindings' appears a form will be inserted that evaluates | |
436 | ;; to the list of bindings, hence, in order to avoid multiple unnecessary | |
437 | ;; evaluations one should always bind it to some variable. | |
438 | ||
439 | ;; @@@ Argument list mapping: | |
440 | ;; ========================== | |
25dec365 CY |
441 | ;; Because `defadvice' allows the specification of the argument list |
442 | ;; of the advised function we need a mapping mechanism that maps this | |
3c442f8b | 443 | ;; argument list onto that of the original function. Hence SYM and |
25dec365 CY |
444 | ;; NEWDEF have to be properly mapped onto the &rest variable when the |
445 | ;; original definition is called. Advice automatically takes care of | |
446 | ;; that mapping, hence, the advice programmer can specify an argument | |
447 | ;; list without having to know about the exact structure of the | |
448 | ;; original argument list as long as the new argument list takes a | |
449 | ;; compatible number/magnitude of actual arguments. | |
ee7bf2ad | 450 | |
ee7bf2ad RM |
451 | ;; @@ Activation and deactivation: |
452 | ;; =============================== | |
453 | ;; The definition of an advised function does not change until all its advice | |
3c442f8b | 454 | ;; gets actually activated. Activation can either happen with the `activate' |
ee7bf2ad | 455 | ;; flag specified in the `defadvice', with an explicit call or interactive |
3c442f8b SM |
456 | ;; invocation of `ad-activate', or at the time an already advised function |
457 | ;; gets defined. | |
ee7bf2ad RM |
458 | |
459 | ;; When a function gets first activated its original definition gets saved, | |
460 | ;; all defined and enabled pieces of advice will get combined with the | |
461 | ;; original definition, the resulting definition might get compiled depending | |
462 | ;; on some conditions described below, and then the function will get | |
463 | ;; redefined with the advised definition. This also means that undefined | |
464 | ;; functions cannot get activated even though they might be already advised. | |
465 | ||
466 | ;; The advised definition will get compiled either if `ad-activate' was called | |
467 | ;; interactively with a prefix argument, or called explicitly with its second | |
fabaa9b5 RS |
468 | ;; argument as t, or, if `ad-default-compilation-action' justifies it according |
469 | ;; to the current system state. If the advised definition was | |
ee7bf2ad RM |
470 | ;; constructed during "preactivation" (see below) then that definition will |
471 | ;; be already compiled because it was constructed during byte-compilation of | |
472 | ;; the file that contained the `defadvice' with the `preactivate' flag. | |
473 | ||
474 | ;; `ad-deactivate' can be used to back-define an advised function to its | |
3c442f8b | 475 | ;; original definition. It can be called interactively or directly. Because |
ee7bf2ad RM |
476 | ;; `ad-activate' caches the advised definition the function can be |
477 | ;; reactivated via `ad-activate' with only minor overhead (it is checked | |
478 | ;; whether the current advice state is consistent with the cached | |
479 | ;; definition, see the section on caching below). | |
480 | ||
481 | ;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate | |
482 | ;; all currently advised function that have a piece of advice with a name that | |
3c442f8b | 483 | ;; contains a match for a regular expression. These functions can be used to |
ee7bf2ad RM |
484 | ;; de/activate sets of functions depending on certain advice naming |
485 | ;; conventions. | |
486 | ||
487 | ;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to | |
3c442f8b | 488 | ;; de/activate all currently advised functions. These are useful to |
ee7bf2ad RM |
489 | ;; (temporarily) return to an un/advised state. |
490 | ||
491 | ;; @@@ Reasons for the separation of advice definition and activation: | |
492 | ;; =================================================================== | |
493 | ;; As already mentioned, advising happens in two stages: | |
494 | ||
495 | ;; 1) definition of various pieces of advice | |
496 | ;; 2) activation of all advice currently defined and enabled | |
497 | ||
498 | ;; The advantage of this is that various pieces of advice can be defined | |
499 | ;; before they get combined into an advised definition which avoids | |
3c442f8b | 500 | ;; unnecessary constructions of intermediate advised definitions. The more |
ee7bf2ad RM |
501 | ;; important advantage is that it allows the implementation of forward advice. |
502 | ;; Advice information for a certain function accumulates as the value of the | |
3c442f8b | 503 | ;; `advice-info' property of the function symbol. This accumulation is |
ee7bf2ad | 504 | ;; completely independent of the fact that that function might not yet be |
3c442f8b SM |
505 | ;; defined. The macros `defun' and `defmacro' check whether the |
506 | ;; function/macro they defined had advice information | |
507 | ;; associated with it. If so and forward advice is enabled, the original | |
aaf0c300 | 508 | ;; definition will be saved, and then the advice will be activated. |
ee7bf2ad RM |
509 | |
510 | ;; @@ Enabling/disabling pieces or sets of advice: | |
511 | ;; =============================================== | |
512 | ;; A major motivation for the development of this advice package was to bring | |
513 | ;; a little bit more structure into the function overloading chaos in Emacs | |
3c442f8b | 514 | ;; Lisp. Many packages achieve some of their functionality by adding a little |
ee7bf2ad | 515 | ;; bit (or a lot) to the standard functionality of some Emacs Lisp function. |
3c442f8b SM |
516 | ;; ange-ftp is a very popular package that used to achieve its magic by |
517 | ;; overloading most Emacs Lisp functions that deal with files. A popular | |
518 | ;; function that's overloaded by many packages is `expand-file-name'. | |
519 | ;; The situation that one function is multiply overloaded can arise easily. | |
ee7bf2ad RM |
520 | |
521 | ;; Once in a while it would be desirable to be able to disable some/all | |
522 | ;; overloads of a particular package while keeping all the rest. Ideally - | |
523 | ;; at least in my opinion - these overloads would all be done with advice, | |
524 | ;; I know I am dreaming right now... In that ideal case the enable/disable | |
525 | ;; mechanism of advice could be used to achieve just that. | |
526 | ||
3c442f8b | 527 | ;; Every piece of advice is associated with an enablement flag. When the |
ee7bf2ad RM |
528 | ;; advised definition of a particular function gets constructed (e.g., during |
529 | ;; activation) only the currently enabled pieces of advice will be considered. | |
530 | ;; This mechanism allows one to have different "views" of an advised function | |
531 | ;; dependent on what pieces of advice are currently enabled. | |
532 | ||
533 | ;; Another motivation for this mechanism is that it allows one to define a | |
534 | ;; piece of advice for some function yet keep it dormant until a certain | |
3c442f8b SM |
535 | ;; condition is met. Until then activation of the function will not make use |
536 | ;; of that piece of advice. Once the condition is met the advice can be | |
ee7bf2ad | 537 | ;; enabled and a reactivation of the function will add its functionality as |
3c442f8b | 538 | ;; part of the new advised definition. Hence, if somebody |
ee7bf2ad RM |
539 | ;; else advised these functions too and activates them the advices defined |
540 | ;; by advice will get used only if they are intended to be used. | |
541 | ||
542 | ;; The main interface to this mechanism are the interactive functions | |
3c442f8b | 543 | ;; `ad-enable-advice' and `ad-disable-advice'. For example, the following |
ee7bf2ad RM |
544 | ;; would disable a particular advice of the function `foo': |
545 | ;; | |
546 | ;; (ad-disable-advice 'foo 'before 'my-advice) | |
547 | ;; | |
548 | ;; This call by itself only changes the flag, to get the proper effect in | |
549 | ;; the advised definition too one has to activate `foo' with | |
550 | ;; | |
551 | ;; (ad-activate 'foo) | |
552 | ;; | |
3c442f8b SM |
553 | ;; or interactively. To disable whole sets of advices one can use a regular |
554 | ;; expression mechanism. For example, let us assume that ange-ftp actually | |
ee7bf2ad RM |
555 | ;; used advice to overload all its functions, and that it used the |
556 | ;; "ange-ftp-" prefix for all its advice names, then we could temporarily | |
557 | ;; disable all its advices with | |
558 | ;; | |
3c442f8b | 559 | ;; (ad-disable-regexp "\\`ange-ftp-") |
ee7bf2ad RM |
560 | ;; |
561 | ;; and the following call would put that actually into effect: | |
562 | ;; | |
3c442f8b | 563 | ;; (ad-activate-regexp "\\`ange-ftp-") |
ee7bf2ad | 564 | ;; |
e9a452d9 | 565 | ;; A safer way would have been to use |
ee7bf2ad | 566 | ;; |
3c442f8b | 567 | ;; (ad-update-regexp "\\`ange-ftp-") |
ee7bf2ad RM |
568 | ;; |
569 | ;; instead which would have only reactivated currently actively advised | |
3c442f8b | 570 | ;; functions, but not functions that were currently inactive. All these |
ee7bf2ad RM |
571 | ;; functions can also be called interactively. |
572 | ||
573 | ;; A certain piece of advice is considered a match if its name contains a | |
3c442f8b | 574 | ;; match for the regular expression. To enable ange-ftp again we would use |
ee7bf2ad RM |
575 | ;; `ad-enable-regexp' and then activate or update again. |
576 | ||
fabaa9b5 RS |
577 | ;; @@ Forward advice, automatic advice activation: |
578 | ;; =============================================== | |
ee7bf2ad RM |
579 | ;; Because most Emacs Lisp packages are loaded on demand via an autoload |
580 | ;; mechanism it is essential to be able to "forward advise" functions. | |
581 | ;; Otherwise, proper advice definition and activation would make it necessary | |
582 | ;; to preload every file that defines a certain function before it can be | |
583 | ;; advised, which would partly defeat the purpose of the advice mechanism. | |
584 | ||
585 | ;; In the following, "forward advice" always implies its automatic activation | |
586 | ;; once a function gets defined, and not just the accumulation of advice | |
587 | ;; information for a possibly undefined function. | |
588 | ||
589 | ;; Advice implements forward advice mainly via the following: 1) Separation | |
590 | ;; of advice definition and activation that makes it possible to accumulate | |
591 | ;; advice information without having the original function already defined, | |
a731fc1b SM |
592 | ;; 2) Use of the `defalias-fset-function' symbol property which lets |
593 | ;; us advise the function when it gets defined. | |
ee7bf2ad | 594 | |
fabaa9b5 | 595 | ;; Automatic advice activation means, that whenever a function gets defined |
a731fc1b | 596 | ;; with either `defun', `defmacro', `defalias' or by loading a byte-compiled |
ee7bf2ad RM |
597 | ;; file, and the function has some advice-info stored with it then that |
598 | ;; advice will get activated right away. | |
599 | ||
ee7bf2ad RM |
600 | ;; @@ Caching of advised definitions: |
601 | ;; ================================== | |
602 | ;; After an advised definition got constructed it gets cached as part of the | |
603 | ;; advised function's advice-info so it can be reused, for example, after an | |
3c442f8b | 604 | ;; intermediate deactivation. Because the advice-info of a function might |
ee7bf2ad RM |
605 | ;; change between the time of caching and reuse a cached definition gets |
606 | ;; a cache-id associated with it so it can be verified whether the cached | |
607 | ;; definition is still valid (the main application of this is preactivation | |
608 | ;; - see below). | |
609 | ||
610 | ;; When an advised function gets activated and a verifiable cached definition | |
611 | ;; is available, then that definition will be used instead of creating a new | |
3c442f8b | 612 | ;; advised definition from scratch. If you want to make sure that a new |
ee7bf2ad RM |
613 | ;; definition gets constructed then you should use `ad-clear-cache' before you |
614 | ;; activate the advised function. | |
615 | ||
616 | ;; @@ Preactivation: | |
617 | ;; ================= | |
3c442f8b | 618 | ;; Constructing an advised definition is moderately expensive. In a situation |
ee7bf2ad RM |
619 | ;; where one package defines a lot of advised functions it might be |
620 | ;; prohibitively expensive to do all the advised definition construction at | |
3c442f8b | 621 | ;; runtime. Preactivation is a mechanism that allows compile-time construction |
ee7bf2ad | 622 | ;; of compiled advised definitions that can be activated cheaply during |
3c442f8b SM |
623 | ;; runtime. Preactivation uses the caching mechanism to do that. Here's how |
624 | ;; it works: | |
ee7bf2ad RM |
625 | |
626 | ;; When the byte-compiler compiles a `defadvice' that has the `preactivate' | |
627 | ;; flag specified, it uses the current original definition of the advised | |
628 | ;; function plus the advice specified in this `defadvice' (even if it is | |
629 | ;; specified as disabled) and all other currently enabled pieces of advice to | |
630 | ;; construct an advised definition and an identifying cache-id and makes them | |
631 | ;; part of the `defadvice' expansion which will then be compiled by the | |
aaf0c300 SM |
632 | ;; byte-compiler. |
633 | ;; When the file with the compiled, preactivating `defadvice' gets loaded the | |
ee7bf2ad | 634 | ;; precompiled advised definition will be cached on the advised function's |
3c442f8b | 635 | ;; advice-info. When it gets activated (can be immediately on execution of the |
ee7bf2ad RM |
636 | ;; `defadvice' or any time later) the cache-id gets checked against the |
637 | ;; current state of advice and if it is verified the precompiled definition | |
3c442f8b SM |
638 | ;; will be used directly (the verification is pretty cheap). If it couldn't |
639 | ;; get verified a new advised definition for that function will be built from | |
640 | ;; scratch, hence, the efficiency added by the preactivation mechanism does not | |
641 | ;; at all impair the flexibility of the advice mechanism. | |
ee7bf2ad RM |
642 | |
643 | ;; MORAL: In order get all the efficiency out of preactivation the advice | |
644 | ;; state of an advised function at the time the file with the | |
645 | ;; preactivating `defadvice' gets byte-compiled should be exactly | |
646 | ;; the same as it will be when the advice of that function gets | |
3c442f8b | 647 | ;; actually activated. If it is not there is a high chance that the |
ee7bf2ad RM |
648 | ;; cache-id will not match and hence a new advised definition will |
649 | ;; have to be constructed at runtime. | |
650 | ||
3c442f8b | 651 | ;; Preactivation and forward advice do not contradict each other. It is |
ee7bf2ad | 652 | ;; perfectly ok to load a file with a preactivating `defadvice' before the |
3c442f8b | 653 | ;; original definition of the advised function is available. The constructed |
ee7bf2ad | 654 | ;; advised definition will be used once the original function gets defined and |
3c442f8b | 655 | ;; its advice gets activated. The only constraint is that at the time the |
ee7bf2ad RM |
656 | ;; file with the preactivating `defadvice' got compiled the original function |
657 | ;; definition was available. | |
658 | ||
659 | ;; TIPS: Here are some indications that a preactivation did not work the way | |
660 | ;; you intended it to work: | |
661 | ;; - Activation of the advised function takes longer than usual/expected | |
662 | ;; - The byte-compiler gets loaded while an advised function gets | |
663 | ;; activated | |
664 | ;; - `byte-compile' is part of the `features' variable even though you | |
665 | ;; did not use the byte-compiler | |
666 | ;; Right now advice does not provide an elegant way to find out whether | |
3c442f8b | 667 | ;; and why a preactivation failed. What you can do is to trace the |
ee7bf2ad RM |
668 | ;; function `ad-cache-id-verification-code' (with the function |
669 | ;; `trace-function-background' defined in my trace.el package) before | |
3c442f8b | 670 | ;; any of your advised functions get activated. After they got |
ee7bf2ad | 671 | ;; activated check whether all calls to `ad-cache-id-verification-code' |
3c442f8b | 672 | ;; returned `verified' as a result. Other values indicate why the |
ee7bf2ad RM |
673 | ;; verification failed which should give you enough information to |
674 | ;; fix your preactivation/compile/load/activation sequence. | |
675 | ||
fce44373 | 676 | ;; IMPORTANT: There is one case (that I am aware of) that can make |
ee7bf2ad | 677 | ;; preactivation fail, i.e., a preconstructed advised definition that does |
3c442f8b | 678 | ;; NOT match the current state of advice gets used nevertheless. That case |
ee7bf2ad | 679 | ;; arises if one package defines a certain piece of advice which gets used |
fce44373 | 680 | ;; during preactivation, and another package incompatibly redefines that |
ee7bf2ad RM |
681 | ;; very advice (i.e., same function/class/name), and it is the second advice |
682 | ;; that is available when the preconstructed definition gets activated, and | |
fce44373 DL |
683 | ;; that was the only definition of that advice so far (`ad-add-advice' |
684 | ;; catches advice redefinitions and clears the cache in such a case). | |
ee7bf2ad RM |
685 | ;; Catching that would make the cache verification too expensive. |
686 | ||
687 | ;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with | |
688 | ;; George Walker Bush), and why would you redefine your own advice anyway? | |
689 | ;; Advice is a mechanism to facilitate function redefinition, not advice | |
3c442f8b SM |
690 | ;; redefinition (wait until I write Meta-Advice :-). If you really have |
691 | ;; to undo somebody else's advice, try to write a "neutralizing" advice. | |
ee7bf2ad | 692 | |
3c442f8b SM |
693 | ;; @@ Advising macros and other dangerous things: |
694 | ;; ============================================== | |
ee7bf2ad | 695 | ;; Look at the corresponding tutorial sections for more information on |
3c442f8b SM |
696 | ;; these topics. Here it suffices to point out that the special treatment |
697 | ;; of macros can lead to problems when they get advised. Macros can create | |
698 | ;; problems because they get expanded at compile or load time, hence, they | |
699 | ;; might not have all the necessary runtime support and such advice cannot be | |
700 | ;; de/activated or changed as it is possible for functions. | |
2200a8c9 | 701 | ;; |
3c442f8b SM |
702 | ;; Special forms cannot be advised. |
703 | ;; | |
704 | ;; MORAL: - Only advise macros when you are absolutely sure what you are doing. | |
ee7bf2ad RM |
705 | |
706 | ;; @@ Adding a piece of advice with `ad-add-advice': | |
707 | ;; ================================================= | |
708 | ;; The non-interactive function `ad-add-advice' can be used to add a piece of | |
709 | ;; advice to some function without using `defadvice'. This is useful if advice | |
710 | ;; has to be added somewhere by a function (also look at `ad-make-advice'). | |
711 | ||
712 | ;; @@ Activation/deactivation advices, file load hooks: | |
713 | ;; ==================================================== | |
714 | ;; There are two special classes of advice called `activation' and | |
3c442f8b | 715 | ;; `deactivation'. The body forms of these advices are not included into the |
ee7bf2ad RM |
716 | ;; advised definition of a function, rather they are assembled into a hook |
717 | ;; form which will be evaluated whenever the advice-info of the advised | |
3c442f8b | 718 | ;; function gets activated or deactivated. One application of this mechanism |
aaf0c300 | 719 | ;; is to define file load hooks for files that do not provide such hooks. |
ee7bf2ad RM |
720 | ;; For example, suppose you want to print a message whenever `file-x' gets |
721 | ;; loaded, and suppose the last function defined in `file-x' is | |
722 | ;; `file-x-last-fn'. Then we can define the following advice: | |
723 | ;; | |
724 | ;; (defadvice file-x-last-fn (activation file-x-load-hook) | |
725 | ;; "Executed whenever file-x is loaded" | |
726 | ;; (if load-in-progress (message "Loaded file-x"))) | |
727 | ;; | |
728 | ;; This will constitute a forward advice for function `file-x-last-fn' which | |
729 | ;; will get activated when `file-x' is loaded (only if forward advice is | |
3c442f8b | 730 | ;; enabled of course). Because there are no "real" pieces of advice |
ee7bf2ad RM |
731 | ;; available for it, its definition will not be changed, but the activation |
732 | ;; advice will be run during its activation which is equivalent to having a | |
733 | ;; file load hook for `file-x'. | |
734 | ||
735 | ;; @@ Summary of main advice concepts: | |
736 | ;; =================================== | |
737 | ;; - Definition: | |
738 | ;; A piece of advice gets defined with `defadvice' and added to the | |
739 | ;; `advice-info' property of a function. | |
740 | ;; - Enablement: | |
741 | ;; Every piece of advice has an enablement flag associated with it. Only | |
742 | ;; enabled advices are considered during construction of an advised | |
743 | ;; definition. | |
744 | ;; - Activation: | |
3c442f8b | 745 | ;; Redefine an advised function with its advised definition. Constructs |
ee7bf2ad RM |
746 | ;; an advised definition from scratch if no verifiable cached advised |
747 | ;; definition is available and caches it. | |
748 | ;; - Deactivation: | |
749 | ;; Back-define an advised function to its original definition. | |
750 | ;; - Update: | |
fce44373 | 751 | ;; Reactivate an advised function but only if its advice is currently |
3c442f8b | 752 | ;; active. This can be used to bring all currently advised function up |
ee7bf2ad | 753 | ;; to date with the current state of advice without also activating |
e9a452d9 | 754 | ;; currently inactive functions. |
ee7bf2ad RM |
755 | ;; - Caching: |
756 | ;; Is the saving of an advised definition and an identifying cache-id so | |
757 | ;; it can be reused, for example, for activation after deactivation. | |
758 | ;; - Preactivation: | |
759 | ;; Is the construction of an advised definition according to the current | |
760 | ;; state of advice during byte-compilation of a file with a preactivating | |
3c442f8b | 761 | ;; `defadvice'. That advised definition can then rather cheaply be used |
ee7bf2ad RM |
762 | ;; during activation without having to construct an advised definition |
763 | ;; from scratch at runtime. | |
764 | ||
765 | ;; @@ Summary of interactive advice manipulation functions: | |
766 | ;; ======================================================== | |
767 | ;; The following interactive functions can be used to manipulate the state | |
768 | ;; of advised functions (all of them support completion on function names, | |
769 | ;; advice classes and advice names): | |
770 | ||
771 | ;; - ad-activate to activate the advice of a FUNCTION | |
772 | ;; - ad-deactivate to deactivate the advice of a FUNCTION | |
773 | ;; - ad-update to activate the advice of a FUNCTION unless it was not | |
e9a452d9 | 774 | ;; yet activated or is currently inactive. |
fce44373 | 775 | ;; - ad-unadvise deactivates a FUNCTION and removes all of its advice |
ee7bf2ad RM |
776 | ;; information, hence, it cannot be activated again |
777 | ;; - ad-recover tries to redefine a FUNCTION to its original definition and | |
778 | ;; discards all advice information (a low-level `ad-unadvise'). | |
779 | ;; Use only in emergencies. | |
780 | ||
781 | ;; - ad-remove-advice removes a particular piece of advice of a FUNCTION. | |
782 | ;; You still have to do call `ad-activate' or `ad-update' to | |
783 | ;; activate the new state of advice. | |
784 | ;; - ad-enable-advice enables a particular piece of advice of a FUNCTION. | |
785 | ;; - ad-disable-advice disables a particular piece of advice of a FUNCTION. | |
786 | ;; - ad-enable-regexp maps over all currently advised functions and enables | |
787 | ;; every advice whose name contains a match for a regular | |
788 | ;; expression. | |
789 | ;; - ad-disable-regexp disables matching advices. | |
790 | ||
791 | ;; - ad-activate-regexp activates all advised function with a matching advice | |
792 | ;; - ad-deactivate-regexp deactivates all advised function with matching advice | |
793 | ;; - ad-update-regexp updates all advised function with a matching advice | |
794 | ;; - ad-activate-all activates all advised functions | |
795 | ;; - ad-deactivate-all deactivates all advised functions | |
796 | ;; - ad-update-all updates all advised functions | |
797 | ;; - ad-unadvise-all unadvises all advised functions | |
798 | ;; - ad-recover-all recovers all advised functions | |
799 | ||
800 | ;; - ad-compile byte-compiles a function/macro if it is compilable. | |
801 | ||
802 | ;; @@ Summary of forms with special meanings when used within an advice: | |
803 | ;; ===================================================================== | |
804 | ;; ad-return-value name of the return value variable (get/settable) | |
ee7bf2ad RM |
805 | ;; (ad-get-arg <pos>), (ad-get-args <pos>), |
806 | ;; (ad-set-arg <pos> <value>), (ad-set-args <pos> <value-list>) | |
807 | ;; argument access text macros to get/set the values of | |
808 | ;; actual arguments at a certain position | |
809 | ;; ad-arg-bindings text macro that returns the actual names, values | |
810 | ;; and types of the arguments as a list of bindings. The | |
811 | ;; order of the bindings corresponds to the order of the | |
812 | ;; arguments. The individual fields of every binding (name, | |
813 | ;; value and type) can be accessed with the function | |
814 | ;; `ad-arg-binding-field' (see example above). | |
815 | ;; ad-do-it text macro that identifies the place where the original | |
816 | ;; or wrapped definition should go in an around advice | |
817 | ||
818 | ||
819 | ;; @ Foo games: An advice tutorial | |
820 | ;; =============================== | |
3c442f8b | 821 | ;; The following tutorial was created in Emacs 18.59. Left-justified |
ee7bf2ad | 822 | ;; s-expressions are input forms followed by one or more result forms. |
ee7bf2ad RM |
823 | ;; |
824 | ;; We start by defining an innocent looking function `foo' that simply | |
825 | ;; adds 1 to its argument X: | |
8a946354 | 826 | ;; |
ee7bf2ad RM |
827 | ;; (defun foo (x) |
828 | ;; "Add 1 to X." | |
829 | ;; (1+ x)) | |
830 | ;; foo | |
831 | ;; | |
832 | ;; (foo 3) | |
833 | ;; 4 | |
834 | ;; | |
835 | ;; @@ Defining a simple piece of advice: | |
836 | ;; ===================================== | |
837 | ;; Now let's define the first piece of advice for `foo'. To do that we | |
838 | ;; use the macro `defadvice' which takes a function name, a list of advice | |
839 | ;; specifiers and a list of body forms as arguments. The first element of | |
840 | ;; the advice specifiers is the class of the advice, the second is its name, | |
841 | ;; the third its position and the rest are some flags. The class of our | |
842 | ;; first advice is `before', its name is `fg-add2', its position among the | |
843 | ;; currently defined before advices (none so far) is `first', and the advice | |
844 | ;; will be `activate'ed immediately. Advice names are global symbols, hence, | |
845 | ;; the name space conventions used for function names should be applied. All | |
846 | ;; advice names in this tutorial will be prefixed with `fg' for `Foo Games' | |
847 | ;; (because everybody has the right to be inconsistent all the function names | |
848 | ;; used in this tutorial do NOT follow this convention). | |
849 | ;; | |
850 | ;; In the body of an advice we can refer to the argument variables of the | |
851 | ;; original function by name. Here we add 1 to X so the effect of calling | |
852 | ;; `foo' will be to actually add 2. All of the advice definitions below only | |
853 | ;; have one body form for simplicity, but there is no restriction to that | |
854 | ;; extent. Every piece of advice can have a documentation string which will | |
855 | ;; be combined with the documentation of the original function. | |
856 | ;; | |
857 | ;; (defadvice foo (before fg-add2 first activate) | |
858 | ;; "Add 2 to X." | |
859 | ;; (setq x (1+ x))) | |
860 | ;; foo | |
861 | ;; | |
862 | ;; (foo 3) | |
863 | ;; 5 | |
864 | ;; | |
865 | ;; @@ Specifying the position of an advice: | |
866 | ;; ======================================== | |
867 | ;; Now we define the second before advice which will cancel the effect of | |
868 | ;; the previous advice. This time we specify the position as 0 which is | |
869 | ;; equivalent to `first'. A number can be used to specify the zero-based | |
870 | ;; position of an advice among the list of advices in the same class. This | |
871 | ;; time we already have one before advice hence the position specification | |
872 | ;; actually has an effect. So, after the following definition the position | |
873 | ;; of the previous advice will be 1 even though we specified it with `first' | |
874 | ;; above, the reason for this is that the position argument is relative to | |
875 | ;; the currently defined pieces of advice which by now has changed. | |
876 | ;; | |
877 | ;; (defadvice foo (before fg-cancel-add2 0 activate) | |
878 | ;; "Again only add 1 to X." | |
879 | ;; (setq x (1- x))) | |
880 | ;; foo | |
881 | ;; | |
882 | ;; (foo 3) | |
883 | ;; 4 | |
884 | ;; | |
885 | ;; @@ Redefining a piece of advice: | |
886 | ;; ================================ | |
887 | ;; Now we define an advice with the same class and same name but with a | |
888 | ;; different position. Defining an advice in a class in which an advice with | |
889 | ;; that name already exists is interpreted as a redefinition of that | |
890 | ;; particular advice, in which case the position argument will be ignored | |
891 | ;; and the previous position of the redefined piece of advice is used. | |
892 | ;; Advice flags can be specified with non-ambiguous initial substrings, hence, | |
893 | ;; from now on we'll use `act' instead of the verbose `activate'. | |
894 | ;; | |
895 | ;; (defadvice foo (before fg-cancel-add2 last act) | |
896 | ;; "Again only add 1 to X." | |
897 | ;; (setq x (1- x))) | |
898 | ;; foo | |
899 | ;; | |
900 | ;; @@ Assembly of advised documentation: | |
901 | ;; ===================================== | |
902 | ;; The documentation strings of the various pieces of advice are assembled | |
903 | ;; in order which shows that advice `fg-cancel-add2' is still the first | |
904 | ;; `before' advice even though we specified position `last' above: | |
905 | ;; | |
906 | ;; (documentation 'foo) | |
907 | ;; "Add 1 to X. | |
908 | ;; | |
909 | ;; This function is advised with the following advice(s): | |
910 | ;; | |
911 | ;; fg-cancel-add2 (before): | |
912 | ;; Again only add 1 to X. | |
913 | ;; | |
914 | ;; fg-add2 (before): | |
915 | ;; Add 2 to X." | |
916 | ;; | |
917 | ;; @@ Advising interactive behavior: | |
918 | ;; ================================= | |
919 | ;; We can make a function interactive (or change its interactive behavior) | |
920 | ;; by specifying an interactive form in one of the before or around | |
921 | ;; advices (there could also be body forms in this advice). The particular | |
922 | ;; definition always assigns 5 as an argument to X which gives us 6 as a | |
923 | ;; result when we call foo interactively: | |
924 | ;; | |
925 | ;; (defadvice foo (before fg-inter last act) | |
926 | ;; "Use 5 as argument when called interactively." | |
927 | ;; (interactive (list 5))) | |
928 | ;; foo | |
929 | ;; | |
930 | ;; (call-interactively 'foo) | |
931 | ;; 6 | |
932 | ;; | |
933 | ;; If more than one advice have an interactive declaration, then the one of | |
934 | ;; the advice with the smallest position will be used (before advices go | |
935 | ;; before around and after advices), hence, the declaration below does | |
936 | ;; not have any effect: | |
937 | ;; | |
938 | ;; (defadvice foo (before fg-inter2 last act) | |
939 | ;; (interactive (list 6))) | |
940 | ;; foo | |
941 | ;; | |
942 | ;; (call-interactively 'foo) | |
943 | ;; 6 | |
944 | ;; | |
ee7bf2ad RM |
945 | ;; @@ Around advices: |
946 | ;; ================== | |
947 | ;; Now we'll try some `around' advices. An around advice is a wrapper around | |
948 | ;; the original definition. It can shadow or establish bindings for the | |
949 | ;; original definition, and it can look at and manipulate the value returned | |
950 | ;; by the original function. The position of the special keyword `ad-do-it' | |
951 | ;; specifies where the code of the original function will be executed. The | |
952 | ;; keyword can appear multiple times which will result in multiple calls of | |
953 | ;; the original function in the resulting advised code. Note, that if we don't | |
fce44373 | 954 | ;; specify a position argument (i.e., `first', `last' or a number), then |
ee7bf2ad RM |
955 | ;; `first' (or 0) is the default): |
956 | ;; | |
957 | ;; (defadvice foo (around fg-times-2 act) | |
958 | ;; "First double X." | |
959 | ;; (let ((x (* x 2))) | |
960 | ;; ad-do-it)) | |
961 | ;; foo | |
962 | ;; | |
963 | ;; (foo 3) | |
964 | ;; 7 | |
965 | ;; | |
966 | ;; Around advices are assembled like onion skins where the around advice | |
967 | ;; with position 0 is the outermost skin and the advice at the last position | |
968 | ;; is the innermost skin which is directly wrapped around the call of the | |
969 | ;; original definition of the function. Hence, after the next `defadvice' we | |
970 | ;; will first multiply X by 2 then add 1 and then call the original | |
971 | ;; definition (i.e., add 1 again): | |
972 | ;; | |
973 | ;; (defadvice foo (around fg-add-1 last act) | |
974 | ;; "Add 1 to X." | |
975 | ;; (let ((x (1+ x))) | |
976 | ;; ad-do-it)) | |
977 | ;; foo | |
978 | ;; | |
979 | ;; (foo 3) | |
980 | ;; 8 | |
981 | ;; | |
ee7bf2ad RM |
982 | ;; @@ Controlling advice activation: |
983 | ;; ================================= | |
984 | ;; In every `defadvice' so far we have used the flag `activate' to activate | |
985 | ;; the advice immediately after its definition, and that's what we want in | |
986 | ;; most cases. However, if we define multiple pieces of advice for a single | |
987 | ;; function then activating every advice immediately is inefficient. A | |
988 | ;; better way to do this is to only activate the last defined advice. | |
989 | ;; For example: | |
990 | ;; | |
991 | ;; (defadvice foo (after fg-times-x) | |
992 | ;; "Multiply the result with X." | |
993 | ;; (setq ad-return-value (* ad-return-value x))) | |
994 | ;; foo | |
995 | ;; | |
996 | ;; This still yields the same result as before: | |
997 | ;; (foo 3) | |
998 | ;; 8 | |
999 | ;; | |
1000 | ;; Now we define another advice and activate which will also activate the | |
3c442f8b | 1001 | ;; previous advice `fg-times-x'. Note the use of the special variable |
ee7bf2ad | 1002 | ;; `ad-return-value' in the body of the advice which is set to the result of |
3c442f8b | 1003 | ;; the original function. If we change its value then the value returned by |
ee7bf2ad RM |
1004 | ;; the advised function will be changed accordingly: |
1005 | ;; | |
1006 | ;; (defadvice foo (after fg-times-x-again act) | |
1007 | ;; "Again multiply the result with X." | |
1008 | ;; (setq ad-return-value (* ad-return-value x))) | |
1009 | ;; foo | |
1010 | ;; | |
1011 | ;; Now the advices have an effect: | |
1012 | ;; | |
1013 | ;; (foo 3) | |
1014 | ;; 72 | |
1015 | ;; | |
1016 | ;; @@ Protecting advice execution: | |
1017 | ;; =============================== | |
fce44373 | 1018 | ;; Once in a while we define an advice to perform some cleanup action, |
ee7bf2ad RM |
1019 | ;; for example: |
1020 | ;; | |
1021 | ;; (defadvice foo (after fg-cleanup last act) | |
1022 | ;; "Do some cleanup." | |
1023 | ;; (print "Let's clean up now!")) | |
1024 | ;; foo | |
1025 | ;; | |
1026 | ;; However, in case of an error the cleanup won't be performed: | |
1027 | ;; | |
1028 | ;; (condition-case error | |
1029 | ;; (foo t) | |
1030 | ;; (error 'error-in-foo)) | |
1031 | ;; error-in-foo | |
1032 | ;; | |
1033 | ;; To make sure a certain piece of advice gets executed even if some error or | |
1034 | ;; non-local exit occurred in any preceding code, we can protect it by using | |
1035 | ;; the `protect' keyword. (if any of the around advices is protected then the | |
1036 | ;; whole around advice onion will be protected): | |
1037 | ;; | |
1038 | ;; (defadvice foo (after fg-cleanup prot act) | |
1039 | ;; "Do some protected cleanup." | |
1040 | ;; (print "Let's clean up now!")) | |
1041 | ;; foo | |
1042 | ;; | |
1043 | ;; Now the cleanup form will be executed even in case of an error: | |
1044 | ;; | |
1045 | ;; (condition-case error | |
1046 | ;; (foo t) | |
1047 | ;; (error 'error-in-foo)) | |
1048 | ;; "Let's clean up now!" | |
1049 | ;; error-in-foo | |
1050 | ;; | |
ee7bf2ad RM |
1051 | ;; @@ Compilation of advised definitions: |
1052 | ;; ====================================== | |
1053 | ;; Finally, we can specify the `compile' keyword in a `defadvice' to say | |
1054 | ;; that we want the resulting advised function to be byte-compiled | |
1055 | ;; (`compile' will be ignored unless we also specified `activate'): | |
1056 | ;; | |
1057 | ;; (defadvice foo (after fg-cleanup prot act comp) | |
1058 | ;; "Do some protected cleanup." | |
1059 | ;; (print "Let's clean up now!")) | |
1060 | ;; foo | |
1061 | ;; | |
3c442f8b | 1062 | ;; Now `foo's advice is byte-compiled: |
ee7bf2ad | 1063 | ;; |
3c442f8b SM |
1064 | ;; (byte-code-function-p 'ad-Advice-foo) |
1065 | ;; t | |
ee7bf2ad RM |
1066 | ;; |
1067 | ;; (foo 3) | |
1068 | ;; "Let's clean up now!" | |
1069 | ;; 72 | |
1070 | ;; | |
1071 | ;; @@ Enabling and disabling pieces of advice: | |
1072 | ;; =========================================== | |
1073 | ;; Once in a while it is desirable to temporarily disable a piece of advice | |
1074 | ;; so that it won't be considered during activation, for example, if two | |
1075 | ;; different packages advise the same function and one wants to temporarily | |
1076 | ;; neutralize the effect of the advice of one of the packages. | |
1077 | ;; | |
1078 | ;; The following disables the after advice `fg-times-x' in the function `foo'. | |
1079 | ;; All that does is to change a flag for this particular advice. All the | |
1080 | ;; other information defining it will be left unchanged (e.g., its relative | |
1081 | ;; position in this advice class, etc.). | |
1082 | ;; | |
1083 | ;; (ad-disable-advice 'foo 'after 'fg-times-x) | |
1084 | ;; nil | |
1085 | ;; | |
1086 | ;; For this to have an effect we have to activate `foo': | |
1087 | ;; | |
1088 | ;; (ad-activate 'foo) | |
1089 | ;; foo | |
1090 | ;; | |
1091 | ;; (foo 3) | |
1092 | ;; "Let's clean up now!" | |
1093 | ;; 24 | |
1094 | ;; | |
1095 | ;; If we want to disable all multiplication advices in `foo' we can use a | |
1096 | ;; regular expression that matches the names of such advices. Actually, any | |
1097 | ;; advice name that contains a match for the regular expression will be | |
1098 | ;; called a match. A special advice class `any' can be used to consider | |
1099 | ;; all advice classes: | |
1100 | ;; | |
1101 | ;; (ad-disable-advice 'foo 'any "^fg-.*times") | |
1102 | ;; nil | |
1103 | ;; | |
1104 | ;; (ad-activate 'foo) | |
1105 | ;; foo | |
1106 | ;; | |
1107 | ;; (foo 3) | |
1108 | ;; "Let's clean up now!" | |
1109 | ;; 5 | |
1110 | ;; | |
1111 | ;; To enable the disabled advice we could use either `ad-enable-advice' | |
1112 | ;; similar to `ad-disable-advice', or as an alternative `ad-enable-regexp' | |
1113 | ;; which will enable matching advices in ALL currently advised functions. | |
1114 | ;; Hence, this can be used to dis/enable advices made by a particular | |
1115 | ;; package to a set of functions as long as that package obeys standard | |
1116 | ;; advice name conventions. We prefixed all advice names with `fg-', hence | |
1117 | ;; the following will do the trick (`ad-enable-regexp' returns the number | |
1118 | ;; of matched advices): | |
1119 | ;; | |
1120 | ;; (ad-enable-regexp "^fg-") | |
1121 | ;; 9 | |
1122 | ;; | |
1123 | ;; The following will activate all currently active advised functions that | |
1124 | ;; contain some advice matched by the regular expression. This is a save | |
1125 | ;; way to update the activation of advised functions whose advice changed | |
1126 | ;; in some way or other without accidentally also activating currently | |
e9a452d9 | 1127 | ;; inactive functions: |
ee7bf2ad RM |
1128 | ;; |
1129 | ;; (ad-update-regexp "^fg-") | |
1130 | ;; nil | |
1131 | ;; | |
1132 | ;; (foo 3) | |
1133 | ;; "Let's clean up now!" | |
1134 | ;; 72 | |
1135 | ;; | |
1136 | ;; Another use for the dis/enablement mechanism is to define a piece of advice | |
1137 | ;; and keep it "dormant" until a particular condition is satisfied, i.e., until | |
1138 | ;; then the advice will not be used during activation. The `disable' flag lets | |
1139 | ;; one do that with `defadvice': | |
1140 | ;; | |
1141 | ;; (defadvice foo (before fg-1-more dis) | |
1142 | ;; "Add yet 1 more." | |
1143 | ;; (setq x (1+ x))) | |
1144 | ;; foo | |
1145 | ;; | |
1146 | ;; (ad-activate 'foo) | |
1147 | ;; foo | |
1148 | ;; | |
1149 | ;; (foo 3) | |
1150 | ;; "Let's clean up now!" | |
1151 | ;; 72 | |
1152 | ;; | |
1153 | ;; (ad-enable-advice 'foo 'before 'fg-1-more) | |
1154 | ;; nil | |
1155 | ;; | |
1156 | ;; (ad-activate 'foo) | |
1157 | ;; foo | |
1158 | ;; | |
1159 | ;; (foo 3) | |
1160 | ;; "Let's clean up now!" | |
1161 | ;; 160 | |
1162 | ;; | |
1163 | ;; @@ Caching: | |
1164 | ;; =========== | |
1165 | ;; Advised definitions get cached to allow efficient activation/deactivation | |
1166 | ;; without having to reconstruct them if nothing in the advice-info of a | |
1167 | ;; function has changed. The following idiom can be used to temporarily | |
1168 | ;; deactivate functions that have a piece of advice defined by a certain | |
1169 | ;; package (we save the old definition to check out caching): | |
1170 | ;; | |
3c442f8b | 1171 | ;; (setq old-definition (symbol-function 'ad-Advice-foo)) |
ee7bf2ad RM |
1172 | ;; (lambda (x) ....) |
1173 | ;; | |
1174 | ;; (ad-deactivate-regexp "^fg-") | |
1175 | ;; nil | |
1176 | ;; | |
1177 | ;; (foo 3) | |
1178 | ;; 4 | |
1179 | ;; | |
1180 | ;; (ad-activate-regexp "^fg-") | |
1181 | ;; nil | |
1182 | ;; | |
3c442f8b | 1183 | ;; (eq old-definition (symbol-function 'ad-Advice-foo)) |
ee7bf2ad RM |
1184 | ;; t |
1185 | ;; | |
1186 | ;; (foo 3) | |
1187 | ;; "Let's clean up now!" | |
1188 | ;; 160 | |
1189 | ;; | |
1190 | ;; @@ Forward advice: | |
1191 | ;; ================== | |
ee7bf2ad RM |
1192 | ;; |
1193 | ;; Let's define a piece of advice for an undefined function: | |
1194 | ;; | |
1195 | ;; (defadvice bar (before fg-sub-1-more act) | |
1196 | ;; "Subtract one more from X." | |
1197 | ;; (setq x (1- x))) | |
1198 | ;; bar | |
1199 | ;; | |
1200 | ;; `bar' is not yet defined: | |
1201 | ;; (fboundp 'bar) | |
1202 | ;; nil | |
1203 | ;; | |
3c442f8b | 1204 | ;; Now we define it and the forward advice will get activated: |
ee7bf2ad RM |
1205 | ;; |
1206 | ;; (defun bar (x) | |
1207 | ;; "Subtract 1 from X." | |
1208 | ;; (1- x)) | |
1209 | ;; bar | |
1210 | ;; | |
1211 | ;; (bar 4) | |
1212 | ;; 2 | |
1213 | ;; | |
1214 | ;; Redefinition will activate any available advice if the value of | |
1215 | ;; `ad-redefinition-action' is either `warn', `accept' or `discard': | |
1216 | ;; | |
1217 | ;; (defun bar (x) | |
1218 | ;; "Subtract 2 from X." | |
1219 | ;; (- x 2)) | |
1220 | ;; bar | |
1221 | ;; | |
1222 | ;; (bar 4) | |
1223 | ;; 1 | |
1224 | ;; | |
1225 | ;; @@ Preactivation: | |
1226 | ;; ================= | |
1227 | ;; Constructing advised definitions is moderately expensive, hence, it is | |
1228 | ;; desirable to have a way to construct them at byte-compile time. | |
1229 | ;; Preactivation is a mechanism that allows one to do that. | |
1230 | ;; | |
1231 | ;; (defun fie (x) | |
1232 | ;; "Multiply X by 2." | |
1233 | ;; (* x 2)) | |
1234 | ;; fie | |
1235 | ;; | |
1236 | ;; (defadvice fie (before fg-times-4 preact) | |
1237 | ;; "Multiply X by 4." | |
1238 | ;; (setq x (* x 2))) | |
1239 | ;; fie | |
1240 | ;; | |
1241 | ;; This advice did not affect `fie'... | |
1242 | ;; | |
1243 | ;; (fie 2) | |
1244 | ;; 4 | |
1245 | ;; | |
1246 | ;; ...but it constructed a cached definition that will be used once `fie' gets | |
1247 | ;; activated as long as its current advice state is the same as it was during | |
1248 | ;; preactivation: | |
1249 | ;; | |
1250 | ;; (setq cached-definition (ad-get-cache-definition 'fie)) | |
1251 | ;; (lambda (x) ....) | |
1252 | ;; | |
1253 | ;; (ad-activate 'fie) | |
1254 | ;; fie | |
1255 | ;; | |
3c442f8b | 1256 | ;; (eq cached-definition (symbol-function 'ad-Advice-fie)) |
ee7bf2ad RM |
1257 | ;; t |
1258 | ;; | |
1259 | ;; (fie 2) | |
1260 | ;; 8 | |
1261 | ;; | |
c0d79871 | 1262 | ;; If you put a preactivating `defadvice' into a Lisp file that gets byte- |
ee7bf2ad | 1263 | ;; compiled then the constructed advised definition will get compiled by |
3c442f8b | 1264 | ;; the byte-compiler. For that to occur in a v18 Emacs you had to put the |
aaf0c300 | 1265 | ;; `defadvice' inside a `defun' because the v18 compiler did not compile |
ee7bf2ad RM |
1266 | ;; top-level forms other than `defun' or `defmacro', for example, |
1267 | ;; | |
1268 | ;; (defun fg-defadvice-fum () | |
1269 | ;; (defadvice fum (before fg-times-4 preact act) | |
1270 | ;; "Multiply X by 4." | |
1271 | ;; (setq x (* x 2)))) | |
1272 | ;; fg-defadvice-fum | |
1273 | ;; | |
1274 | ;; So far, no `defadvice' for `fum' got executed, but when we compile | |
1275 | ;; `fg-defadvice-fum' the `defadvice' will be expanded by the byte compiler. | |
1276 | ;; In order for preactivation to be effective we have to have a proper | |
1277 | ;; definition of `fum' around at preactivation time, hence, we define it now: | |
1278 | ;; | |
1279 | ;; (defun fum (x) | |
1280 | ;; "Multiply X by 2." | |
1281 | ;; (* x 2)) | |
1282 | ;; fum | |
1283 | ;; | |
1284 | ;; Now we compile the defining function which will construct an advised | |
1285 | ;; definition during expansion of the `defadvice', compile it and store it | |
1286 | ;; as part of the compiled `fg-defadvice-fum': | |
1287 | ;; | |
1288 | ;; (ad-compile-function 'fg-defadvice-fum) | |
1289 | ;; (lambda nil (byte-code ...)) | |
1290 | ;; | |
1291 | ;; `fum' is still completely unaffected: | |
1292 | ;; | |
1293 | ;; (fum 2) | |
1294 | ;; 4 | |
1295 | ;; | |
1296 | ;; (ad-get-advice-info 'fum) | |
1297 | ;; nil | |
1298 | ;; | |
1299 | ;; (fg-defadvice-fum) | |
1300 | ;; fum | |
1301 | ;; | |
1302 | ;; Now the advised version of `fum' is compiled because the compiled definition | |
1303 | ;; constructed during preactivation was used, even though we did not specify | |
1304 | ;; the `compile' flag: | |
1305 | ;; | |
3c442f8b SM |
1306 | ;; (byte-code-function-p 'ad-Advice-fum) |
1307 | ;; t | |
ee7bf2ad RM |
1308 | ;; |
1309 | ;; (fum 2) | |
1310 | ;; 8 | |
1311 | ;; | |
1312 | ;; A preactivated definition will only be used if it matches the current | |
3c442f8b | 1313 | ;; function definition and advice information. If it does not match it |
ee7bf2ad | 1314 | ;; will simply be discarded and a new advised definition will be constructed |
3c442f8b | 1315 | ;; from scratch. For example, let's first remove all advice-info for `fum': |
ee7bf2ad RM |
1316 | ;; |
1317 | ;; (ad-unadvise 'fum) | |
1318 | ;; (("fie") ("bar") ("foo") ...) | |
1319 | ;; | |
1320 | ;; And now define a new piece of advice: | |
1321 | ;; | |
1322 | ;; (defadvice fum (before fg-interactive act) | |
1323 | ;; "Make fum interactive." | |
1324 | ;; (interactive "nEnter x: ")) | |
1325 | ;; fum | |
1326 | ;; | |
1327 | ;; When we now try to use a preactivation it will not be used because the | |
3c442f8b | 1328 | ;; current advice state is different from the one at preactivation time. This |
ee7bf2ad RM |
1329 | ;; is no tragedy, everything will work as expected just not as efficient, |
1330 | ;; because a new advised definition has to be constructed from scratch: | |
1331 | ;; | |
1332 | ;; (fg-defadvice-fum) | |
1333 | ;; fum | |
1334 | ;; | |
1335 | ;; A new uncompiled advised definition got constructed: | |
1336 | ;; | |
3c442f8b | 1337 | ;; (byte-code-function-p 'ad-Advice-fum) |
ee7bf2ad RM |
1338 | ;; nil |
1339 | ;; | |
1340 | ;; (fum 2) | |
1341 | ;; 8 | |
1342 | ;; | |
1343 | ;; MORAL: To get all the efficiency out of preactivation the function | |
1344 | ;; definition and advice state at preactivation time must be the same as the | |
3c442f8b | 1345 | ;; state at activation time. Preactivation does work with forward advice, all |
ee7bf2ad RM |
1346 | ;; that's necessary is that the definition of the forward advised function is |
1347 | ;; available when the `defadvice' with the preactivation gets compiled. | |
1348 | ;; | |
1349 | ;; @@ Portable argument access: | |
1350 | ;; ============================ | |
1351 | ;; So far, we always used the actual argument variable names to access an | |
1352 | ;; argument in a piece of advice. For many advice applications this is | |
1353 | ;; perfectly ok and keeps advices simple. However, it decreases portability | |
1354 | ;; of advices because it assumes specific argument variable names. For example, | |
1355 | ;; if one advises a subr such as `eval-region' which then gets redefined by | |
1356 | ;; some package (e.g., edebug) into a function with different argument names, | |
1357 | ;; then a piece of advice written for `eval-region' that was written with | |
aaf0c300 | 1358 | ;; the subr arguments in mind will break. |
ee7bf2ad RM |
1359 | ;; |
1360 | ;; Argument access text macros allow one to access arguments of an advised | |
1361 | ;; function in a portable way without having to worry about all these | |
1362 | ;; possibilities. These macros will be translated into the proper access forms | |
1363 | ;; at activation time, hence, argument access will be as efficient as if | |
1364 | ;; the arguments had been used directly in the definition of the advice. | |
1365 | ;; | |
1366 | ;; (defun fuu (x y z) | |
1367 | ;; "Add 3 numbers." | |
1368 | ;; (+ x y z)) | |
1369 | ;; fuu | |
1370 | ;; | |
1371 | ;; (fuu 1 1 1) | |
1372 | ;; 3 | |
1373 | ;; | |
1374 | ;; Argument access macros specify actual arguments at a certain position. | |
1375 | ;; Position 0 access the first actual argument, position 1 the second etc. | |
1376 | ;; For example, the following advice adds 1 to each of the 3 arguments: | |
1377 | ;; | |
1378 | ;; (defadvice fuu (before fg-add-1-to-all act) | |
1379 | ;; "Adds 1 to all arguments." | |
1380 | ;; (ad-set-arg 0 (1+ (ad-get-arg 0))) | |
1381 | ;; (ad-set-arg 1 (1+ (ad-get-arg 1))) | |
1382 | ;; (ad-set-arg 2 (1+ (ad-get-arg 2)))) | |
1383 | ;; fuu | |
1384 | ;; | |
1385 | ;; (fuu 1 1 1) | |
1386 | ;; 6 | |
1387 | ;; | |
1388 | ;; Now suppose somebody redefines `fuu' with a rest argument. Our advice | |
1389 | ;; will still work because we used access macros (note, that automatic | |
1390 | ;; advice activation is still in effect, hence, the redefinition of `fuu' | |
1391 | ;; will automatically activate all its advice): | |
1392 | ;; | |
1393 | ;; (defun fuu (&rest numbers) | |
1394 | ;; "Add NUMBERS." | |
1395 | ;; (apply '+ numbers)) | |
1396 | ;; fuu | |
1397 | ;; | |
1398 | ;; (fuu 1 1 1) | |
1399 | ;; 6 | |
1400 | ;; | |
1401 | ;; (fuu 1 1 1 1 1 1) | |
1402 | ;; 9 | |
1403 | ;; | |
1404 | ;; What's important to notice is that argument access macros access actual | |
1405 | ;; arguments regardless of how they got distributed onto argument variables. | |
1406 | ;; In Emacs Lisp the semantics of an actual argument is determined purely | |
1407 | ;; by position, hence, as long as nobody changes the semantics of what a | |
1408 | ;; certain actual argument at a certain position means the access macros | |
1409 | ;; will do the right thing. | |
1410 | ;; | |
1411 | ;; Because of &rest arguments we need a second kind of access macro that | |
1412 | ;; can access all actual arguments starting from a certain position: | |
1413 | ;; | |
1414 | ;; (defadvice fuu (before fg-print-args act) | |
1415 | ;; "Print all arguments." | |
1416 | ;; (print (ad-get-args 0))) | |
1417 | ;; fuu | |
1418 | ;; | |
1419 | ;; (fuu 1 2 3 4 5) | |
1420 | ;; (1 2 3 4 5) | |
1421 | ;; 18 | |
1422 | ;; | |
1423 | ;; (defadvice fuu (before fg-set-args act) | |
1424 | ;; "Swaps 2nd and 3rd arg and discards all the rest." | |
1425 | ;; (ad-set-args 1 (list (ad-get-arg 2) (ad-get-arg 1)))) | |
1426 | ;; fuu | |
1427 | ;; | |
1428 | ;; (fuu 1 2 3 4 4 4 4 4 4) | |
1429 | ;; (1 3 2) | |
1430 | ;; 9 | |
1431 | ;; | |
1432 | ;; (defun fuu (x y z) | |
1433 | ;; "Add 3 numbers." | |
1434 | ;; (+ x y z)) | |
1435 | ;; | |
1436 | ;; (fuu 1 2 3) | |
1437 | ;; (1 3 2) | |
1438 | ;; 9 | |
1439 | ;; | |
1440 | ;; @@ Defining the argument list of an advised function: | |
1441 | ;; ===================================================== | |
1442 | ;; Once in a while it might be desirable to advise a function and additionally | |
1443 | ;; give it an extra argument that controls the advised code, for example, one | |
1444 | ;; might want to make an interactive function sensitive to a prefix argument. | |
1445 | ;; For such cases `defadvice' allows the specification of an argument list | |
fce44373 | 1446 | ;; for the advised function. Similar to the redefinition of interactive |
ee7bf2ad RM |
1447 | ;; behavior, the first argument list specification found in the list of before/ |
1448 | ;; around/after advices will be used. Of course, the specified argument list | |
1449 | ;; should be downward compatible with the original argument list, otherwise | |
1450 | ;; functions that call the advised function with the original argument list | |
1451 | ;; in mind will break. | |
1452 | ;; | |
1453 | ;; (defun fii (x) | |
1454 | ;; "Add 1 to X." | |
1455 | ;; (1+ x)) | |
1456 | ;; fii | |
1457 | ;; | |
1458 | ;; Now we advise `fii' to use an optional second argument that controls the | |
53964682 | 1459 | ;; amount of incrementing. A list following the (optional) position |
ee7bf2ad RM |
1460 | ;; argument of the advice will be interpreted as an argument list |
1461 | ;; specification. This means you cannot specify an empty argument list, and | |
1462 | ;; why would you want to anyway? | |
1463 | ;; | |
1464 | ;; (defadvice fii (before fg-inc-x (x &optional incr) act) | |
1465 | ;; "Increment X by INCR (default is 1)." | |
1466 | ;; (setq x (+ x (1- (or incr 1))))) | |
1467 | ;; fii | |
1468 | ;; | |
1469 | ;; (fii 3) | |
1470 | ;; 4 | |
1471 | ;; | |
1472 | ;; (fii 3 2) | |
1473 | ;; 5 | |
1474 | ;; | |
ee7bf2ad RM |
1475 | ;; @@ Advising interactive subrs: |
1476 | ;; ============================== | |
1477 | ;; For the most part there is no difference between advising functions and | |
1478 | ;; advising subrs. There is one situation though where one might have to write | |
1479 | ;; slightly different advice code for subrs than for functions. This case | |
1480 | ;; arises when one wants to access subr arguments in a before/around advice | |
1481 | ;; when the arguments were determined by an interactive call to the subr. | |
1482 | ;; Advice cannot determine what `interactive' form determines the interactive | |
1483 | ;; behavior of the subr, hence, when it calls the original definition in an | |
1484 | ;; interactive subr invocation it has to use `call-interactively' to generate | |
1485 | ;; the proper interactive behavior. Thus up to that call the arguments of the | |
1486 | ;; interactive subr will be nil. For example, the following advice for | |
1487 | ;; `kill-buffer' will not work in an interactive invocation... | |
1488 | ;; | |
1489 | ;; (defadvice kill-buffer (before fg-kill-buffer-hook first act preact comp) | |
1490 | ;; (my-before-kill-buffer-hook (ad-get-arg 0))) | |
1491 | ;; kill-buffer | |
1492 | ;; | |
1493 | ;; ...because the buffer argument will be nil in that case. The way out of | |
1494 | ;; this dilemma is to provide an `interactive' specification that mirrors | |
1495 | ;; the interactive behavior of the unadvised subr, for example, the following | |
1496 | ;; will do the right thing even when `kill-buffer' is called interactively: | |
1497 | ;; | |
1498 | ;; (defadvice kill-buffer (before fg-kill-buffer-hook first act preact comp) | |
1499 | ;; (interactive "bKill buffer: ") | |
1500 | ;; (my-before-kill-buffer-hook (ad-get-arg 0))) | |
1501 | ;; kill-buffer | |
1502 | ;; | |
1503 | ;; @@ Advising macros: | |
1504 | ;; =================== | |
1505 | ;; Advising macros is slightly different because there are two significant | |
1506 | ;; time points in the invocation of a macro: Expansion and evaluation time. | |
1507 | ;; For an advised macro instead of evaluating the original definition we | |
1508 | ;; use `macroexpand', that is, changing argument values and binding | |
1509 | ;; environments by pieces of advice has an affect during macro expansion | |
1510 | ;; but not necessarily during evaluation. In particular, any side effects | |
1511 | ;; of pieces of advice will occur during macro expansion. To also affect | |
1512 | ;; the behavior during evaluation time one has to change the value of | |
1513 | ;; `ad-return-value' in a piece of after advice. For example: | |
1514 | ;; | |
1515 | ;; (defmacro foom (x) | |
1516 | ;; (` (list (, x)))) | |
1517 | ;; foom | |
1518 | ;; | |
1519 | ;; (foom '(a)) | |
1520 | ;; ((a)) | |
1521 | ;; | |
1522 | ;; (defadvice foom (before fg-print-x act) | |
1523 | ;; "Print the value of X." | |
1524 | ;; (print x)) | |
1525 | ;; foom | |
1526 | ;; | |
1527 | ;; The following works as expected because evaluation immediately follows | |
1528 | ;; macro expansion: | |
1529 | ;; | |
1530 | ;; (foom '(a)) | |
1531 | ;; (quote (a)) | |
1532 | ;; ((a)) | |
1533 | ;; | |
1534 | ;; However, the printing happens during expansion (or byte-compile) time: | |
1535 | ;; | |
1536 | ;; (macroexpand '(foom '(a))) | |
1537 | ;; (quote (a)) | |
1538 | ;; (list (quote (a))) | |
1539 | ;; | |
fce44373 | 1540 | ;; If we want it to happen during evaluation time we have to do the |
ee7bf2ad RM |
1541 | ;; following (first remove the old advice): |
1542 | ;; | |
1543 | ;; (ad-remove-advice 'foom 'before 'fg-print-x) | |
1544 | ;; nil | |
1545 | ;; | |
1546 | ;; (defadvice foom (after fg-print-x act) | |
1547 | ;; "Print the value of X." | |
1548 | ;; (setq ad-return-value | |
1549 | ;; (` (progn (print (, x)) | |
1550 | ;; (, ad-return-value))))) | |
1551 | ;; foom | |
1552 | ;; | |
1553 | ;; (macroexpand '(foom '(a))) | |
1554 | ;; (progn (print (quote (a))) (list (quote (a)))) | |
1555 | ;; | |
1556 | ;; (foom '(a)) | |
1557 | ;; (a) | |
1558 | ;; ((a)) | |
1559 | ;; | |
1560 | ;; While this method might seem somewhat cumbersome, it is very general | |
1561 | ;; because it allows one to influence macro expansion as well as evaluation. | |
1562 | ;; In general, advising macros should be a rather rare activity anyway, in | |
1563 | ;; particular, because compile-time macro expansion takes away a lot of the | |
1564 | ;; flexibility and effectiveness of the advice mechanism. Macros that were | |
1565 | ;; compile-time expanded before the advice was activated will of course never | |
1566 | ;; exhibit the advised behavior. | |
ee7bf2ad | 1567 | |
ee7bf2ad RM |
1568 | ;;; Code: |
1569 | ||
1570 | ;; @ Advice implementation: | |
1571 | ;; ======================== | |
1572 | ||
1573 | ;; @@ Compilation idiosyncrasies: | |
1574 | ;; ============================== | |
1575 | ||
0fb3cb7c | 1576 | (require 'macroexp) |
32170f7f | 1577 | ;; At run-time also, since ad-do-advised-functions returns code that uses it. |
3c442f8b | 1578 | (eval-when-compile (require 'cl-lib)) |
ee7bf2ad | 1579 | |
fabaa9b5 RS |
1580 | ;; @@ Variable definitions: |
1581 | ;; ======================== | |
1582 | ||
666b9413 SE |
1583 | (defgroup advice nil |
1584 | "An overloading mechanism for Emacs Lisp functions." | |
1585 | :prefix "ad-" | |
fce44373 | 1586 | :link '(custom-manual "(elisp)Advising Functions") |
666b9413 SE |
1587 | :group 'lisp) |
1588 | ||
81eee8ab | 1589 | (defconst ad-version "2.14") |
ee7bf2ad RM |
1590 | |
1591 | ;;;###autoload | |
666b9413 | 1592 | (defcustom ad-redefinition-action 'warn |
cb711556 | 1593 | "Defines what to do with redefinitions during Advice de/activation. |
ee7bf2ad RM |
1594 | Redefinition occurs if a previously activated function that already has an |
1595 | original definition associated with it gets redefined and then de/activated. | |
1596 | In such a case we can either accept the current definition as the new | |
1597 | original definition, discard the current definition and replace it with the | |
6e2f6f45 RS |
1598 | old original, or keep it and raise an error. The values `accept', `discard', |
1599 | `error' or `warn' govern what will be done. `warn' is just like `accept' but | |
1600 | it additionally prints a warning message. All other values will be | |
666b9413 | 1601 | interpreted as `error'." |
db352ce6 AS |
1602 | :type '(choice (const accept) (const discard) (const warn) |
1603 | (other :tag "error" error)) | |
666b9413 | 1604 | :group 'advice) |
ee7bf2ad RM |
1605 | |
1606 | ;;;###autoload | |
666b9413 | 1607 | (defcustom ad-default-compilation-action 'maybe |
cb711556 | 1608 | "Defines whether to compile advised definitions during activation. |
fabaa9b5 RS |
1609 | A value of `always' will result in unconditional compilation, `never' will |
1610 | always avoid compilation, `maybe' will compile if the byte-compiler is already | |
1611 | loaded, and `like-original' will compile if the original definition of the | |
fce44373 DL |
1612 | advised function is compiled or a built-in function. Every other value will |
1613 | be interpreted as `maybe'. This variable will only be considered if the | |
666b9413 | 1614 | COMPILE argument of `ad-activate' was supplied as nil." |
db352ce6 AS |
1615 | :type '(choice (const always) (const never) (const like-original) |
1616 | (other :tag "maybe" maybe)) | |
666b9413 SE |
1617 | :group 'advice) |
1618 | ||
ee7bf2ad RM |
1619 | |
1620 | ||
1621 | ;; @@ Some utilities: | |
1622 | ;; ================== | |
1623 | ||
1624 | ;; We don't want the local arguments to interfere with anything | |
1625 | ;; referenced in the supplied functions => the cryptic casing: | |
1626 | (defun ad-substitute-tree (sUbTrEe-TeSt fUnCtIoN tReE) | |
fce44373 DL |
1627 | "Substitute qualifying subTREEs with result of FUNCTION(subTREE). |
1628 | Only proper subtrees are considered, for example, if TREE is (1 (2 (3)) 4) | |
1629 | then the subtrees will be 1 (2 (3)) 2 (3) 3 4, dotted structures are | |
1630 | allowed too. Once a qualifying subtree has been found its subtrees will | |
1631 | not be considered anymore. (ad-substitute-tree 'atom 'identity tree) | |
1632 | generates a copy of TREE." | |
ee7bf2ad RM |
1633 | (cond ((consp tReE) |
1634 | (cons (if (funcall sUbTrEe-TeSt (car tReE)) | |
1635 | (funcall fUnCtIoN (car tReE)) | |
1636 | (if (consp (car tReE)) | |
1637 | (ad-substitute-tree sUbTrEe-TeSt fUnCtIoN (car tReE)) | |
1638 | (car tReE))) | |
1639 | (ad-substitute-tree sUbTrEe-TeSt fUnCtIoN (cdr tReE)))) | |
1640 | ((funcall sUbTrEe-TeSt tReE) | |
1641 | (funcall fUnCtIoN tReE)) | |
1642 | (t tReE))) | |
1643 | ||
ee7bf2ad RM |
1644 | ;; @@ Advice info access fns: |
1645 | ;; ========================== | |
1646 | ||
1647 | ;; Advice information for a particular function is stored on the | |
6e2f6f45 | 1648 | ;; advice-info property of the function symbol. It is stored as an |
ee7bf2ad RM |
1649 | ;; alist of the following format: |
1650 | ;; | |
1651 | ;; ((active . t/nil) | |
1652 | ;; (before adv1 adv2 ...) | |
1653 | ;; (around adv1 adv2 ...) | |
1654 | ;; (after adv1 adv2 ...) | |
1655 | ;; (activation adv1 adv2 ...) | |
1656 | ;; (deactivation adv1 adv2 ...) | |
3c442f8b | 1657 | ;; (advicefunname . <symbol fbound to assembled advice function>) |
ee7bf2ad RM |
1658 | ;; (cache . (<advised-definition> . <id>))) |
1659 | ||
1660 | ;; List of currently advised though not necessarily activated functions | |
1661 | ;; (this list is maintained as a completion table): | |
1662 | (defvar ad-advised-functions nil) | |
1663 | ||
1664 | (defmacro ad-pushnew-advised-function (function) | |
fce44373 | 1665 | "Add FUNCTION to `ad-advised-functions' unless its already there." |
8a946354 SS |
1666 | `(if (not (assoc (symbol-name ,function) ad-advised-functions)) |
1667 | (setq ad-advised-functions | |
1668 | (cons (list (symbol-name ,function)) | |
1669 | ad-advised-functions)))) | |
ee7bf2ad RM |
1670 | |
1671 | (defmacro ad-pop-advised-function (function) | |
fce44373 | 1672 | "Remove FUNCTION from `ad-advised-functions'." |
8a946354 SS |
1673 | `(setq ad-advised-functions |
1674 | (delq (assoc (symbol-name ,function) ad-advised-functions) | |
1675 | ad-advised-functions))) | |
ee7bf2ad RM |
1676 | |
1677 | (defmacro ad-do-advised-functions (varform &rest body) | |
6858633a SM |
1678 | "`dolist'-style iterator that maps over advised functions. |
1679 | \(ad-do-advised-functions (VAR) | |
fce44373 DL |
1680 | BODY-FORM...) |
1681 | On each iteration VAR will be bound to the name of an advised function | |
1682 | \(a symbol)." | |
aaf0c300 | 1683 | (declare (indent 1)) |
3c442f8b | 1684 | `(dolist (,(car varform) ad-advised-functions) |
2de39f08 SM |
1685 | (setq ,(car varform) (intern (car ,(car varform)))) |
1686 | ,@body)) | |
ee7bf2ad | 1687 | |
745dc723 RS |
1688 | (defun ad-get-advice-info (function) |
1689 | (get function 'ad-advice-info)) | |
1690 | ||
1691 | (defmacro ad-get-advice-info-macro (function) | |
8a946354 | 1692 | `(get ,function 'ad-advice-info)) |
ee7bf2ad | 1693 | |
32e5c58c SM |
1694 | (defsubst ad-set-advice-info (function advice-info) |
1695 | (cond | |
231d8498 SM |
1696 | (advice-info |
1697 | (add-function :around (get function 'defalias-fset-function) | |
1698 | #'ad--defalias-fset)) | |
32e5c58c | 1699 | ((get function 'defalias-fset-function) |
231d8498 SM |
1700 | (remove-function (get function 'defalias-fset-function) |
1701 | #'ad--defalias-fset))) | |
32e5c58c | 1702 | (put function 'ad-advice-info advice-info)) |
ee7bf2ad RM |
1703 | |
1704 | (defmacro ad-copy-advice-info (function) | |
2de39f08 | 1705 | `(copy-tree (get ,function 'ad-advice-info))) |
ee7bf2ad RM |
1706 | |
1707 | (defmacro ad-is-advised (function) | |
fce44373 DL |
1708 | "Return non-nil if FUNCTION has any advice info associated with it. |
1709 | This does not mean that the advice is also active." | |
6858633a | 1710 | `(ad-get-advice-info-macro ,function)) |
ee7bf2ad RM |
1711 | |
1712 | (defun ad-initialize-advice-info (function) | |
fce44373 DL |
1713 | "Initialize the advice info for FUNCTION. |
1714 | Assumes that FUNCTION has not yet been advised." | |
ee7bf2ad RM |
1715 | (ad-pushnew-advised-function function) |
1716 | (ad-set-advice-info function (list (cons 'active nil)))) | |
1717 | ||
1718 | (defmacro ad-get-advice-info-field (function field) | |
fce44373 | 1719 | "Retrieve the value of the advice info FIELD of FUNCTION." |
745dc723 | 1720 | `(cdr (assq ,field (ad-get-advice-info-macro ,function)))) |
ee7bf2ad RM |
1721 | |
1722 | (defun ad-set-advice-info-field (function field value) | |
fce44373 | 1723 | "Destructively modify VALUE of the advice info FIELD of FUNCTION." |
ee7bf2ad | 1724 | (and (ad-is-advised function) |
745dc723 | 1725 | (cond ((assq field (ad-get-advice-info-macro function)) |
ee7bf2ad | 1726 | ;; A field with that name is already present: |
745dc723 | 1727 | (rplacd (assq field (ad-get-advice-info-macro function)) value)) |
ee7bf2ad | 1728 | (t;; otherwise, create a new field with that name: |
745dc723 | 1729 | (nconc (ad-get-advice-info-macro function) |
ee7bf2ad RM |
1730 | (list (cons field value))))))) |
1731 | ||
1732 | ;; Don't make this a macro so we can use it as a predicate: | |
1733 | (defun ad-is-active (function) | |
fce44373 | 1734 | "Return non-nil if FUNCTION is advised and activated." |
ee7bf2ad RM |
1735 | (ad-get-advice-info-field function 'active)) |
1736 | ||
1737 | ||
1738 | ;; @@ Access fns for single pieces of advice and related predicates: | |
1739 | ;; ================================================================= | |
1740 | ||
1741 | (defun ad-make-advice (name protect enable definition) | |
1742 | "Constructs single piece of advice to be stored in some advice-info. | |
6e2f6f45 | 1743 | NAME should be a non-nil symbol, PROTECT and ENABLE should each be |
ee7bf2ad | 1744 | either t or nil, and DEFINITION should be a list of the form |
6e2f6f45 | 1745 | `(advice lambda ARGLIST [DOCSTRING] [INTERACTIVE-FORM] BODY...)'." |
ee7bf2ad RM |
1746 | (list name protect enable definition)) |
1747 | ||
1748 | ;; ad-find-advice uses the alist structure directly -> | |
1749 | ;; change if this data structure changes!! | |
3c442f8b SM |
1750 | (defsubst ad-advice-name (advice) (car advice)) |
1751 | (defsubst ad-advice-protected (advice) (nth 1 advice)) | |
1752 | (defsubst ad-advice-enabled (advice) (nth 2 advice)) | |
1753 | (defsubst ad-advice-definition (advice) (nth 3 advice)) | |
ee7bf2ad RM |
1754 | |
1755 | (defun ad-advice-set-enabled (advice flag) | |
1756 | (rplaca (cdr (cdr advice)) flag)) | |
1757 | ||
3c442f8b SM |
1758 | (defvar ad-advice-classes '(before around after activation deactivation) |
1759 | "List of defined advice classes.") | |
1760 | ||
ee7bf2ad RM |
1761 | (defun ad-class-p (thing) |
1762 | (memq thing ad-advice-classes)) | |
1763 | (defun ad-name-p (thing) | |
1764 | (and thing (symbolp thing))) | |
1765 | (defun ad-position-p (thing) | |
1766 | (or (natnump thing) | |
1767 | (memq thing '(first last)))) | |
1768 | ||
1769 | ||
1770 | ;; @@ Advice access functions: | |
1771 | ;; =========================== | |
1772 | ||
ee7bf2ad | 1773 | (defun ad-has-enabled-advice (function class) |
fce44373 | 1774 | "True if at least one of FUNCTION's advices in CLASS is enabled." |
2de39f08 SM |
1775 | (cl-dolist (advice (ad-get-advice-info-field function class)) |
1776 | (if (ad-advice-enabled advice) (cl-return t)))) | |
ee7bf2ad RM |
1777 | |
1778 | (defun ad-has-redefining-advice (function) | |
fce44373 DL |
1779 | "True if FUNCTION's advice info defines at least 1 redefining advice. |
1780 | Redefining advices affect the construction of an advised definition." | |
ee7bf2ad RM |
1781 | (and (ad-is-advised function) |
1782 | (or (ad-has-enabled-advice function 'before) | |
1783 | (ad-has-enabled-advice function 'around) | |
1784 | (ad-has-enabled-advice function 'after)))) | |
1785 | ||
1786 | (defun ad-has-any-advice (function) | |
fce44373 | 1787 | "True if the advice info of FUNCTION defines at least one advice." |
ee7bf2ad | 1788 | (and (ad-is-advised function) |
6858633a | 1789 | (cl-dolist (class ad-advice-classes) |
ee7bf2ad | 1790 | (if (ad-get-advice-info-field function class) |
2de39f08 | 1791 | (cl-return t))))) |
ee7bf2ad RM |
1792 | |
1793 | (defun ad-get-enabled-advices (function class) | |
fce44373 | 1794 | "Return the list of enabled advices of FUNCTION in CLASS." |
ee7bf2ad | 1795 | (let (enabled-advices) |
2de39f08 | 1796 | (dolist (advice (ad-get-advice-info-field function class)) |
ee7bf2ad | 1797 | (if (ad-advice-enabled advice) |
24c22ecf | 1798 | (push advice enabled-advices))) |
ee7bf2ad RM |
1799 | (reverse enabled-advices))) |
1800 | ||
1801 | ||
fabaa9b5 RS |
1802 | ;; @@ Dealing with automatic advice activation via `fset/defalias': |
1803 | ;; ================================================================ | |
1804 | ||
32e5c58c SM |
1805 | ;; Automatic activation happens when a function gets defined via `defalias', |
1806 | ;; which calls the `defalias-fset-function' (which we set to | |
1807 | ;; `ad--defalias-fset') instead of `fset', if non-nil. | |
fabaa9b5 | 1808 | |
fabaa9b5 RS |
1809 | ;; Whether advised definitions created by automatic activations will be |
1810 | ;; compiled depends on the value of `ad-default-compilation-action'. | |
1811 | ||
3c442f8b | 1812 | (defalias 'ad-activate-internal 'ad-activate) |
ee7bf2ad | 1813 | |
3c442f8b SM |
1814 | (defun ad-make-advicefunname (function) |
1815 | "Make name to be used to call the assembled advice function." | |
1816 | (intern (format "ad-Advice-%s" function))) | |
ee7bf2ad | 1817 | |
3c442f8b SM |
1818 | (defun ad-get-orig-definition (function) ;FIXME: Rename to "-unadvised-". |
1819 | (if (symbolp function) | |
1820 | (setq function (if (fboundp function) | |
1821 | (advice--strip-macro (symbol-function function))))) | |
1822 | (while (advice--p function) (setq function (advice--cdr function))) | |
1823 | function) | |
ee7bf2ad | 1824 | |
3c442f8b SM |
1825 | (defun ad-clear-advicefunname-definition (function) |
1826 | (let ((advicefunname (ad-get-advice-info-field function 'advicefunname))) | |
1827 | (advice-remove function advicefunname) | |
1828 | (fmakunbound advicefunname))) | |
ee7bf2ad RM |
1829 | |
1830 | ||
1831 | ;; @@ Interactive input functions: | |
1832 | ;; =============================== | |
1833 | ||
7de88b6e KR |
1834 | (declare-function 'function-called-at-point "help") |
1835 | ||
ee7bf2ad | 1836 | (defun ad-read-advised-function (&optional prompt predicate default) |
fce44373 DL |
1837 | "Read name of advised function with completion from the minibuffer. |
1838 | An optional PROMPT will be used to prompt for the function. PREDICATE | |
1839 | plays the same role as for `try-completion' (which see). DEFAULT will | |
7de88b6e KR |
1840 | be returned on empty input (defaults to the first advised function or |
1841 | function at point for which PREDICATE returns non-nil)." | |
ee7bf2ad RM |
1842 | (if (null ad-advised-functions) |
1843 | (error "ad-read-advised-function: There are no advised functions")) | |
1844 | (setq default | |
1845 | (or default | |
6858633a | 1846 | ;; Prefer func name at point, if it's an advised function etc. |
7de88b6e KR |
1847 | (let ((function (progn |
1848 | (require 'help) | |
1849 | (function-called-at-point)))) | |
1850 | (and function | |
1851 | (assoc (symbol-name function) ad-advised-functions) | |
1852 | (or (null predicate) | |
1853 | (funcall predicate function)) | |
1854 | function)) | |
6858633a SM |
1855 | (cl-block nil |
1856 | (ad-do-advised-functions (function) | |
1857 | (if (or (null predicate) | |
1858 | (funcall predicate function)) | |
1859 | (cl-return function)))) | |
ee7bf2ad RM |
1860 | (error "ad-read-advised-function: %s" |
1861 | "There are no qualifying advised functions"))) | |
6858633a | 1862 | (let* ((function |
ee7bf2ad | 1863 | (completing-read |
5b76833f | 1864 | (format "%s (default %s): " (or prompt "Function") default) |
ee7bf2ad RM |
1865 | ad-advised-functions |
1866 | (if predicate | |
6858633a SM |
1867 | (lambda (function) |
1868 | (funcall predicate (intern (car function))))) | |
ee7bf2ad RM |
1869 | t))) |
1870 | (if (equal function "") | |
1871 | (if (ad-is-advised default) | |
1872 | default | |
1873 | (error "ad-read-advised-function: `%s' is not advised" default)) | |
1874 | (intern function)))) | |
1875 | ||
1876 | (defvar ad-advice-class-completion-table | |
571b4b93 | 1877 | (mapcar (lambda (class) (list (symbol-name class))) |
ee7bf2ad RM |
1878 | ad-advice-classes)) |
1879 | ||
1880 | (defun ad-read-advice-class (function &optional prompt default) | |
bece3937 | 1881 | "Read a valid advice class with completion from the minibuffer. |
fce44373 DL |
1882 | An optional PROMPT will be used to prompt for the class. DEFAULT will |
1883 | be returned on empty input (defaults to the first non-empty advice | |
1884 | class of FUNCTION)." | |
ee7bf2ad RM |
1885 | (setq default |
1886 | (or default | |
2de39f08 | 1887 | (cl-dolist (class ad-advice-classes) |
ee7bf2ad | 1888 | (if (ad-get-advice-info-field function class) |
2de39f08 | 1889 | (cl-return class))) |
ee7bf2ad RM |
1890 | (error "ad-read-advice-class: `%s' has no advices" function))) |
1891 | (let ((class (completing-read | |
5b76833f | 1892 | (format "%s (default %s): " (or prompt "Class") default) |
ee7bf2ad RM |
1893 | ad-advice-class-completion-table nil t))) |
1894 | (if (equal class "") | |
1895 | default | |
1896 | (intern class)))) | |
1897 | ||
1898 | (defun ad-read-advice-name (function class &optional prompt) | |
fce44373 DL |
1899 | "Read name of existing advice of CLASS for FUNCTION with completion. |
1900 | An optional PROMPT is used to prompt for the name." | |
ee7bf2ad RM |
1901 | (let* ((name-completion-table |
1902 | (mapcar (function (lambda (advice) | |
1903 | (list (symbol-name (ad-advice-name advice))))) | |
1904 | (ad-get-advice-info-field function class))) | |
1905 | (default | |
1906 | (if (null name-completion-table) | |
1907 | (error "ad-read-advice-name: `%s' has no %s advice" | |
1908 | function class) | |
1909 | (car (car name-completion-table)))) | |
5b76833f | 1910 | (prompt (format "%s (default %s): " (or prompt "Name") default)) |
ee7bf2ad RM |
1911 | (name (completing-read prompt name-completion-table nil t))) |
1912 | (if (equal name "") | |
1913 | (intern default) | |
1914 | (intern name)))) | |
1915 | ||
1916 | (defun ad-read-advice-specification (&optional prompt) | |
fce44373 DL |
1917 | "Read a complete function/class/name specification from minibuffer. |
1918 | The list of read symbols will be returned. The optional PROMPT will | |
1919 | be used to prompt for the function." | |
ee7bf2ad RM |
1920 | (let* ((function (ad-read-advised-function prompt)) |
1921 | (class (ad-read-advice-class function)) | |
1922 | (name (ad-read-advice-name function class))) | |
1923 | (list function class name))) | |
1924 | ||
1925 | ;; Use previous regexp as a default: | |
1926 | (defvar ad-last-regexp "") | |
1927 | ||
1928 | (defun ad-read-regexp (&optional prompt) | |
fce44373 | 1929 | "Read a regular expression from the minibuffer." |
ee7bf2ad | 1930 | (let ((regexp (read-from-minibuffer |
5b76833f RF |
1931 | (concat (or prompt "Regular expression") |
1932 | (if (equal ad-last-regexp "") ": " | |
1933 | (format " (default %s): " ad-last-regexp)))))) | |
ee7bf2ad RM |
1934 | (setq ad-last-regexp |
1935 | (if (equal regexp "") ad-last-regexp regexp)))) | |
1936 | ||
1937 | ||
1938 | ;; @@ Finding, enabling, adding and removing pieces of advice: | |
1939 | ;; =========================================================== | |
1940 | ||
1941 | (defmacro ad-find-advice (function class name) | |
fce44373 | 1942 | "Find the first advice of FUNCTION in CLASS with NAME." |
8a946354 | 1943 | `(assq ,name (ad-get-advice-info-field ,function ,class))) |
ee7bf2ad RM |
1944 | |
1945 | (defun ad-advice-position (function class name) | |
fce44373 | 1946 | "Return position of first advice of FUNCTION in CLASS with NAME." |
ee7bf2ad RM |
1947 | (let* ((found-advice (ad-find-advice function class name)) |
1948 | (advices (ad-get-advice-info-field function class))) | |
1949 | (if found-advice | |
1950 | (- (length advices) (length (memq found-advice advices)))))) | |
1951 | ||
1952 | (defun ad-find-some-advice (function class name) | |
fce44373 | 1953 | "Find the first of FUNCTION's advices in CLASS matching NAME. |
ee7bf2ad | 1954 | NAME can be a symbol or a regular expression matching part of an advice name. |
bece3937 | 1955 | If CLASS is `any' all valid advice classes will be checked." |
ee7bf2ad RM |
1956 | (if (ad-is-advised function) |
1957 | (let (found-advice) | |
2de39f08 | 1958 | (cl-dolist (advice-class ad-advice-classes) |
ee7bf2ad RM |
1959 | (if (or (eq class 'any) (eq advice-class class)) |
1960 | (setq found-advice | |
2de39f08 | 1961 | (cl-dolist (advice (ad-get-advice-info-field |
ee7bf2ad RM |
1962 | function advice-class)) |
1963 | (if (or (and (stringp name) | |
1964 | (string-match | |
1965 | name (symbol-name | |
1966 | (ad-advice-name advice)))) | |
1967 | (eq name (ad-advice-name advice))) | |
2de39f08 SM |
1968 | (cl-return advice))))) |
1969 | (if found-advice (cl-return found-advice)))))) | |
ee7bf2ad RM |
1970 | |
1971 | (defun ad-enable-advice-internal (function class name flag) | |
fce44373 DL |
1972 | "Set enable FLAG of FUNCTION's advices in CLASS matching NAME. |
1973 | If NAME is a string rather than a symbol then it's interpreted as a regular | |
1974 | expression and all advices whose name contain a match for it will be | |
bece3937 | 1975 | affected. If CLASS is `any' advices in all valid advice classes will be |
fce44373 DL |
1976 | considered. The number of changed advices will be returned (or nil if |
1977 | FUNCTION was not advised)." | |
ee7bf2ad RM |
1978 | (if (ad-is-advised function) |
1979 | (let ((matched-advices 0)) | |
2de39f08 | 1980 | (dolist (advice-class ad-advice-classes) |
ee7bf2ad | 1981 | (if (or (eq class 'any) (eq advice-class class)) |
2de39f08 SM |
1982 | (dolist (advice (ad-get-advice-info-field |
1983 | function advice-class)) | |
ee7bf2ad RM |
1984 | (cond ((or (and (stringp name) |
1985 | (string-match | |
1986 | name (symbol-name (ad-advice-name advice)))) | |
1987 | (eq name (ad-advice-name advice))) | |
1988 | (setq matched-advices (1+ matched-advices)) | |
1989 | (ad-advice-set-enabled advice flag)))))) | |
1990 | matched-advices))) | |
1991 | ||
379ba58e | 1992 | ;;;###autoload |
ee7bf2ad RM |
1993 | (defun ad-enable-advice (function class name) |
1994 | "Enables the advice of FUNCTION with CLASS and NAME." | |
5b76833f | 1995 | (interactive (ad-read-advice-specification "Enable advice of")) |
ee7bf2ad RM |
1996 | (if (ad-is-advised function) |
1997 | (if (eq (ad-enable-advice-internal function class name t) 0) | |
1998 | (error "ad-enable-advice: `%s' has no %s advice matching `%s'" | |
1999 | function class name)) | |
2000 | (error "ad-enable-advice: `%s' is not advised" function))) | |
2001 | ||
379ba58e | 2002 | ;;;###autoload |
ee7bf2ad | 2003 | (defun ad-disable-advice (function class name) |
fce44373 | 2004 | "Disable the advice of FUNCTION with CLASS and NAME." |
5b76833f | 2005 | (interactive (ad-read-advice-specification "Disable advice of")) |
ee7bf2ad RM |
2006 | (if (ad-is-advised function) |
2007 | (if (eq (ad-enable-advice-internal function class name nil) 0) | |
2008 | (error "ad-disable-advice: `%s' has no %s advice matching `%s'" | |
2009 | function class name)) | |
2010 | (error "ad-disable-advice: `%s' is not advised" function))) | |
2011 | ||
2012 | (defun ad-enable-regexp-internal (regexp class flag) | |
fce44373 | 2013 | "Set enable FLAGs of all CLASS advices whose name contains a REGEXP match. |
bece3937 | 2014 | If CLASS is `any' all valid advice classes are considered. The number of |
fce44373 | 2015 | affected advices will be returned." |
ee7bf2ad RM |
2016 | (let ((matched-advices 0)) |
2017 | (ad-do-advised-functions (advised-function) | |
2018 | (setq matched-advices | |
2019 | (+ matched-advices | |
2020 | (or (ad-enable-advice-internal | |
2021 | advised-function class regexp flag) | |
2022 | 0)))) | |
2023 | matched-advices)) | |
2024 | ||
2025 | (defun ad-enable-regexp (regexp) | |
2026 | "Enables all advices with names that contain a match for REGEXP. | |
2027 | All currently advised functions will be considered." | |
2028 | (interactive | |
5b76833f | 2029 | (list (ad-read-regexp "Enable advices via regexp"))) |
ee7bf2ad | 2030 | (let ((matched-advices (ad-enable-regexp-internal regexp 'any t))) |
32226619 | 2031 | (if (called-interactively-p 'interactive) |
ee7bf2ad RM |
2032 | (message "%d matching advices enabled" matched-advices)) |
2033 | matched-advices)) | |
2034 | ||
2035 | (defun ad-disable-regexp (regexp) | |
fce44373 | 2036 | "Disable all advices with names that contain a match for REGEXP. |
ee7bf2ad RM |
2037 | All currently advised functions will be considered." |
2038 | (interactive | |
5b76833f | 2039 | (list (ad-read-regexp "Disable advices via regexp"))) |
ee7bf2ad | 2040 | (let ((matched-advices (ad-enable-regexp-internal regexp 'any nil))) |
32226619 | 2041 | (if (called-interactively-p 'interactive) |
ee7bf2ad RM |
2042 | (message "%d matching advices disabled" matched-advices)) |
2043 | matched-advices)) | |
2044 | ||
2045 | (defun ad-remove-advice (function class name) | |
fce44373 | 2046 | "Remove FUNCTION's advice with NAME from its advices in CLASS. |
ee7bf2ad RM |
2047 | If such an advice was found it will be removed from the list of advices |
2048 | in that CLASS." | |
5b76833f | 2049 | (interactive (ad-read-advice-specification "Remove advice of")) |
ee7bf2ad | 2050 | (if (ad-is-advised function) |
6b0a9634 | 2051 | (let ((advice-to-remove (ad-find-advice function class name))) |
ee7bf2ad RM |
2052 | (if advice-to-remove |
2053 | (ad-set-advice-info-field | |
2054 | function class | |
2055 | (delq advice-to-remove (ad-get-advice-info-field function class))) | |
2056 | (error "ad-remove-advice: `%s' has no %s advice `%s'" | |
2057 | function class name))) | |
2058 | (error "ad-remove-advice: `%s' is not advised" function))) | |
2059 | ||
2060 | ;;;###autoload | |
2061 | (defun ad-add-advice (function advice class position) | |
fce44373 | 2062 | "Add a piece of ADVICE to FUNCTION's list of advices in CLASS. |
bbdc98ef CY |
2063 | |
2064 | ADVICE has the form (NAME PROTECTED ENABLED DEFINITION), where | |
2065 | NAME is the advice name; PROTECTED is a flag specifying whether | |
2066 | to protect against non-local exits; ENABLED is a flag specifying | |
2067 | whether to initially enable the advice; and DEFINITION has the | |
2068 | form (advice . LAMBDA), where LAMBDA is a lambda expression. | |
2069 | ||
2070 | If FUNCTION already has a piece of advice with the same name, | |
2071 | then POSITION is ignored, and the old advice is overwritten with | |
2072 | the new one. | |
2073 | ||
2074 | If FUNCTION already has one or more pieces of advice of the | |
2075 | specified CLASS, then POSITION determines where the new piece | |
2076 | goes. POSITION can either be `first', `last' or a number (where | |
2077 | 0 corresponds to `first', and numbers outside the valid range are | |
2078 | mapped to the closest extremal position). | |
2079 | ||
2080 | If FUNCTION was not advised already, its advice info will be | |
2081 | initialized. Redefining a piece of advice whose name is part of | |
ba1a5c78 | 2082 | the cache-id will clear the cache." |
ee7bf2ad RM |
2083 | (cond ((not (ad-is-advised function)) |
2084 | (ad-initialize-advice-info function) | |
2085 | (ad-set-advice-info-field | |
3c442f8b | 2086 | function 'advicefunname (ad-make-advicefunname function)))) |
ee7bf2ad RM |
2087 | (let* ((previous-position |
2088 | (ad-advice-position function class (ad-advice-name advice))) | |
2089 | (advices (ad-get-advice-info-field function class)) | |
2090 | ;; Determine a numerical position for the new advice: | |
2091 | (position (cond (previous-position) | |
2092 | ((eq position 'first) 0) | |
2093 | ((eq position 'last) (length advices)) | |
2094 | ((numberp position) | |
2095 | (max 0 (min position (length advices)))) | |
2096 | (t 0)))) | |
2097 | ;; Check whether we have to clear the cache: | |
2098 | (if (memq (ad-advice-name advice) (ad-get-cache-class-id function class)) | |
2099 | (ad-clear-cache function)) | |
2100 | (if previous-position | |
2101 | (setcar (nthcdr position advices) advice) | |
2102 | (if (= position 0) | |
2103 | (ad-set-advice-info-field function class (cons advice advices)) | |
2104 | (setcdr (nthcdr (1- position) advices) | |
2105 | (cons advice (nthcdr position advices))))))) | |
2106 | ||
2107 | ||
2108 | ;; @@ Accessing and manipulating function definitions: | |
2109 | ;; =================================================== | |
2110 | ||
2111 | (defmacro ad-macrofy (definition) | |
fce44373 | 2112 | "Take a lambda function DEFINITION and make a macro out of it." |
8a946354 | 2113 | `(cons 'macro ,definition)) |
ee7bf2ad RM |
2114 | |
2115 | (defmacro ad-lambdafy (definition) | |
fce44373 | 2116 | "Take a macro function DEFINITION and make a lambda out of it." |
8a946354 | 2117 | `(cdr ,definition)) |
ee7bf2ad | 2118 | |
ee7bf2ad | 2119 | (defmacro ad-lambda-p (definition) |
6e2f6f45 | 2120 | ;;"non-nil if DEFINITION is a lambda expression." |
8a946354 | 2121 | `(eq (car-safe ,definition) 'lambda)) |
ee7bf2ad RM |
2122 | |
2123 | ;; see ad-make-advice for the format of advice definitions: | |
2124 | (defmacro ad-advice-p (definition) | |
6e2f6f45 | 2125 | ;;"non-nil if DEFINITION is a piece of advice." |
8a946354 | 2126 | `(eq (car-safe ,definition) 'advice)) |
ee7bf2ad | 2127 | |
6e2f6f45 | 2128 | (defmacro ad-compiled-p (definition) |
fce44373 | 2129 | "Return non-nil if DEFINITION is a compiled byte-code object." |
8a946354 | 2130 | `(or (byte-code-function-p ,definition) |
671d5c16 SM |
2131 | (and (macrop ,definition) |
2132 | (byte-code-function-p (ad-lambdafy ,definition))))) | |
ee7bf2ad | 2133 | |
6e2f6f45 | 2134 | (defmacro ad-compiled-code (compiled-definition) |
fce44373 | 2135 | "Return the byte-code object of a COMPILED-DEFINITION." |
671d5c16 | 2136 | `(if (macrop ,compiled-definition) |
8a946354 SS |
2137 | (ad-lambdafy ,compiled-definition) |
2138 | ,compiled-definition)) | |
ee7bf2ad RM |
2139 | |
2140 | (defun ad-lambda-expression (definition) | |
fce44373 | 2141 | "Return the lambda expression of a function/macro/advice DEFINITION." |
ee7bf2ad RM |
2142 | (cond ((ad-lambda-p definition) |
2143 | definition) | |
671d5c16 | 2144 | ((macrop definition) |
ee7bf2ad RM |
2145 | (ad-lambdafy definition)) |
2146 | ((ad-advice-p definition) | |
2147 | (cdr definition)) | |
2148 | (t nil))) | |
2149 | ||
6858633a SM |
2150 | (defun ad-arglist (definition) |
2151 | "Return the argument list of DEFINITION." | |
ba83908c | 2152 | (require 'help-fns) |
c2bd2ab0 | 2153 | (help-function-arglist |
671d5c16 | 2154 | (if (or (macrop definition) (ad-advice-p definition)) |
c2bd2ab0 SM |
2155 | (cdr definition) |
2156 | definition) | |
2157 | 'preserve-names)) | |
ee7bf2ad RM |
2158 | |
2159 | (defun ad-docstring (definition) | |
fce44373 | 2160 | "Return the unexpanded docstring of DEFINITION." |
ee7bf2ad | 2161 | (let ((docstring |
6e2f6f45 | 2162 | (if (ad-compiled-p definition) |
6858633a | 2163 | (documentation definition t) |
ee7bf2ad RM |
2164 | (car (cdr (cdr (ad-lambda-expression definition))))))) |
2165 | (if (or (stringp docstring) | |
2166 | (natnump docstring)) | |
2167 | docstring))) | |
2168 | ||
806bc6df SM |
2169 | (defun ad-interactive-form (definition) |
2170 | "Return the interactive form of DEFINITION. | |
2171 | Like `interactive-form', but also works on pieces of advice." | |
2172 | (interactive-form | |
2173 | (if (ad-advice-p definition) | |
2174 | (ad-lambda-expression definition) | |
2175 | definition))) | |
2176 | ||
ee7bf2ad | 2177 | (defun ad-body-forms (definition) |
fce44373 | 2178 | "Return the list of body forms of DEFINITION." |
6e2f6f45 RS |
2179 | (cond ((ad-compiled-p definition) |
2180 | nil) | |
ee7bf2ad RM |
2181 | ((consp definition) |
2182 | (nthcdr (+ (if (ad-docstring definition) 1 0) | |
806bc6df | 2183 | (if (ad-interactive-form definition) 1 0)) |
ee7bf2ad RM |
2184 | (cdr (cdr (ad-lambda-expression definition))))))) |
2185 | ||
ee7bf2ad | 2186 | (defun ad-definition-type (definition) |
fce44373 | 2187 | "Return symbol that describes the type of DEFINITION." |
1232d6c2 SM |
2188 | ;; These symbols are only ever used to check a cache entry's validity. |
2189 | ;; The suffix `2' reflects the fact that we're using version 2 of advice | |
2190 | ;; representations, so cache entries preactivated with version | |
2191 | ;; 1 can't be used. | |
c2bd2ab0 | 2192 | (cond |
671d5c16 SM |
2193 | ((macrop definition) 'macro2) |
2194 | ((subrp definition) 'subr2) | |
1232d6c2 SM |
2195 | ((or (ad-lambda-p definition) (ad-compiled-p definition)) 'fun2) |
2196 | ((ad-advice-p definition) 'advice2))) ;; FIXME: Can this ever happen? | |
ee7bf2ad RM |
2197 | |
2198 | (defun ad-has-proper-definition (function) | |
fce44373 DL |
2199 | "True if FUNCTION is a symbol with a proper definition. |
2200 | For that it has to be fbound with a non-autoload definition." | |
ee7bf2ad RM |
2201 | (and (symbolp function) |
2202 | (fboundp function) | |
7abaf5cc | 2203 | (not (autoloadp (symbol-function function))))) |
ee7bf2ad RM |
2204 | |
2205 | ;; The following two are necessary for the sake of packages such as | |
2206 | ;; ange-ftp which redefine functions via fcell indirection: | |
2207 | (defun ad-real-definition (function) | |
fce44373 | 2208 | "Find FUNCTION's definition at the end of function cell indirection." |
ee7bf2ad RM |
2209 | (if (ad-has-proper-definition function) |
2210 | (let ((definition (symbol-function function))) | |
2211 | (if (symbolp definition) | |
2212 | (ad-real-definition definition) | |
2213 | definition)))) | |
2214 | ||
2215 | (defun ad-real-orig-definition (function) | |
3c442f8b SM |
2216 | (let* ((fun1 (ad-get-orig-definition function)) |
2217 | (fun2 (indirect-function fun1))) | |
2218 | (unless (autoloadp fun2) fun2))) | |
ee7bf2ad RM |
2219 | |
2220 | (defun ad-is-compilable (function) | |
fce44373 | 2221 | "True if FUNCTION has an interpreted definition that can be compiled." |
ee7bf2ad RM |
2222 | (and (ad-has-proper-definition function) |
2223 | (or (ad-lambda-p (symbol-function function)) | |
671d5c16 | 2224 | (macrop (symbol-function function))) |
ee7bf2ad RM |
2225 | (not (ad-compiled-p (symbol-function function))))) |
2226 | ||
6858633a | 2227 | (defvar warning-suppress-types) ;From warnings.el. |
ee7bf2ad | 2228 | (defun ad-compile-function (function) |
3c442f8b SM |
2229 | "Byte-compile the assembled advice function." |
2230 | (require 'bytecomp) | |
3c442f8b SM |
2231 | (let ((byte-compile-warnings byte-compile-warnings) |
2232 | ;; Don't pop up windows showing byte-compiler warnings. | |
2233 | (warning-suppress-types '((bytecomp)))) | |
2234 | (if (featurep 'cl) | |
2235 | (byte-compile-disable-warning 'cl-functions)) | |
2236 | (byte-compile (ad-get-advice-info-field function 'advicefunname)))) | |
ee7bf2ad | 2237 | |
ee7bf2ad RM |
2238 | ;; @@@ Accessing argument lists: |
2239 | ;; ============================= | |
2240 | ||
2241 | (defun ad-parse-arglist (arglist) | |
fce44373 DL |
2242 | "Parse ARGLIST into its required, optional and rest parameters. |
2243 | A three-element list is returned, where the 1st element is the list of | |
2244 | required arguments, the 2nd is the list of optional arguments, and the 3rd | |
2245 | is the name of an optional rest parameter (or nil)." | |
6b0a9634 | 2246 | (let (required optional rest) |
ee7bf2ad RM |
2247 | (setq rest (car (cdr (memq '&rest arglist)))) |
2248 | (if rest (setq arglist (reverse (cdr (memq '&rest (reverse arglist)))))) | |
2249 | (setq optional (cdr (memq '&optional arglist))) | |
2250 | (if optional | |
2251 | (setq required (reverse (cdr (memq '&optional (reverse arglist))))) | |
2252 | (setq required arglist)) | |
2253 | (list required optional rest))) | |
2254 | ||
2255 | (defun ad-retrieve-args-form (arglist) | |
fce44373 DL |
2256 | "Generate a form which evaluates into names/values/types of ARGLIST. |
2257 | When the form gets evaluated within a function with that argument list | |
2258 | it will result in a list with one entry for each argument, where the | |
2259 | first element of each entry is the name of the argument, the second | |
2260 | element is its actual current value, and the third element is either | |
2261 | `required', `optional' or `rest' depending on the type of the argument." | |
ee7bf2ad RM |
2262 | (let* ((parsed-arglist (ad-parse-arglist arglist)) |
2263 | (rest (nth 2 parsed-arglist))) | |
8a946354 SS |
2264 | `(list |
2265 | ,@(mapcar (function | |
2266 | (lambda (req) | |
2267 | `(list ',req ,req 'required))) | |
2268 | (nth 0 parsed-arglist)) | |
2269 | ,@(mapcar (function | |
2270 | (lambda (opt) | |
2271 | `(list ',opt ,opt 'optional))) | |
2272 | (nth 1 parsed-arglist)) | |
2273 | ,@(if rest (list `(list ',rest ,rest 'rest)))))) | |
ee7bf2ad RM |
2274 | |
2275 | (defun ad-arg-binding-field (binding field) | |
2276 | (cond ((eq field 'name) (car binding)) | |
2277 | ((eq field 'value) (car (cdr binding))) | |
2278 | ((eq field 'type) (car (cdr (cdr binding)))))) | |
2279 | ||
2280 | (defun ad-list-access (position list) | |
2281 | (cond ((= position 0) list) | |
2282 | ((= position 1) (list 'cdr list)) | |
2283 | (t (list 'nthcdr position list)))) | |
2284 | ||
2285 | (defun ad-element-access (position list) | |
2286 | (cond ((= position 0) (list 'car list)) | |
8a946354 | 2287 | ((= position 1) `(car (cdr ,list))) |
ee7bf2ad RM |
2288 | (t (list 'nth position list)))) |
2289 | ||
2290 | (defun ad-access-argument (arglist index) | |
fce44373 DL |
2291 | "Tell how to access ARGLIST's actual argument at position INDEX. |
2292 | For a required/optional arg it simply returns it, if a rest argument has | |
2293 | to be accessed, it returns a list with the index and name." | |
ee7bf2ad RM |
2294 | (let* ((parsed-arglist (ad-parse-arglist arglist)) |
2295 | (reqopt-args (append (nth 0 parsed-arglist) | |
2296 | (nth 1 parsed-arglist))) | |
2297 | (rest-arg (nth 2 parsed-arglist))) | |
2298 | (cond ((< index (length reqopt-args)) | |
2299 | (nth index reqopt-args)) | |
2300 | (rest-arg | |
2301 | (list (- index (length reqopt-args)) rest-arg))))) | |
2302 | ||
2303 | (defun ad-get-argument (arglist index) | |
e2045997 CY |
2304 | "Return form to access ARGLIST's actual argument at position INDEX. |
2305 | INDEX counts from zero." | |
ee7bf2ad RM |
2306 | (let ((argument-access (ad-access-argument arglist index))) |
2307 | (cond ((consp argument-access) | |
2308 | (ad-element-access | |
2309 | (car argument-access) (car (cdr argument-access)))) | |
2310 | (argument-access)))) | |
2311 | ||
2312 | (defun ad-set-argument (arglist index value-form) | |
e2045997 CY |
2313 | "Return form to set ARGLIST's actual arg at INDEX to VALUE-FORM. |
2314 | INDEX counts from zero." | |
ee7bf2ad RM |
2315 | (let ((argument-access (ad-access-argument arglist index))) |
2316 | (cond ((consp argument-access) | |
2317 | ;; should this check whether there actually is something to set? | |
8a946354 SS |
2318 | `(setcar ,(ad-list-access |
2319 | (car argument-access) (car (cdr argument-access))) | |
2320 | ,value-form)) | |
ee7bf2ad | 2321 | (argument-access |
8a946354 | 2322 | `(setq ,argument-access ,value-form)) |
ee7bf2ad RM |
2323 | (t (error "ad-set-argument: No argument at position %d of `%s'" |
2324 | index arglist))))) | |
2325 | ||
2326 | (defun ad-get-arguments (arglist index) | |
fce44373 | 2327 | "Return form to access all actual arguments starting at position INDEX." |
ee7bf2ad RM |
2328 | (let* ((parsed-arglist (ad-parse-arglist arglist)) |
2329 | (reqopt-args (append (nth 0 parsed-arglist) | |
2330 | (nth 1 parsed-arglist))) | |
2331 | (rest-arg (nth 2 parsed-arglist)) | |
2332 | args-form) | |
2333 | (if (< index (length reqopt-args)) | |
8a946354 | 2334 | (setq args-form `(list ,@(nthcdr index reqopt-args)))) |
ee7bf2ad RM |
2335 | (if rest-arg |
2336 | (if args-form | |
8a946354 SS |
2337 | (setq args-form `(nconc ,args-form ,rest-arg)) |
2338 | (setq args-form (ad-list-access (- index (length reqopt-args)) | |
2339 | rest-arg)))) | |
ee7bf2ad RM |
2340 | args-form)) |
2341 | ||
2342 | (defun ad-set-arguments (arglist index values-form) | |
fce44373 DL |
2343 | "Make form to assign elements of VALUES-FORM as actual ARGLIST args. |
2344 | The assignment starts at position INDEX." | |
ee7bf2ad RM |
2345 | (let ((values-index 0) |
2346 | argument-access set-forms) | |
2347 | (while (setq argument-access (ad-access-argument arglist index)) | |
6858633a SM |
2348 | (push (if (symbolp argument-access) |
2349 | (ad-set-argument | |
2350 | arglist index | |
2351 | (ad-element-access values-index 'ad-vAlUeS)) | |
2352 | (setq arglist nil) ;; Terminate loop. | |
2353 | (if (= (car argument-access) 0) | |
2354 | `(setq | |
2355 | ,(car (cdr argument-access)) | |
2356 | ,(ad-list-access values-index 'ad-vAlUeS)) | |
2357 | `(setcdr | |
2358 | ,(ad-list-access (1- (car argument-access)) | |
2359 | (car (cdr argument-access))) | |
2360 | ,(ad-list-access values-index 'ad-vAlUeS)))) | |
2361 | set-forms) | |
ee7bf2ad RM |
2362 | (setq index (1+ index)) |
2363 | (setq values-index (1+ values-index))) | |
2364 | (if (null set-forms) | |
2365 | (error "ad-set-arguments: No argument at position %d of `%s'" | |
2366 | index arglist) | |
8a946354 SS |
2367 | (if (= (length set-forms) 1) |
2368 | ;; For exactly one set-form we can use values-form directly,... | |
2369 | (ad-substitute-tree | |
6858633a SM |
2370 | (lambda (form) (eq form 'ad-vAlUeS)) |
2371 | (lambda (_form) values-form) | |
8a946354 SS |
2372 | (car set-forms)) |
2373 | ;; ...if we have more we have to bind it to a variable: | |
2374 | `(let ((ad-vAlUeS ,values-form)) | |
2375 | ,@(reverse set-forms) | |
2376 | ;; work around the old backquote bug: | |
2377 | ,'ad-vAlUeS))))) | |
ee7bf2ad RM |
2378 | |
2379 | (defun ad-insert-argument-access-forms (definition arglist) | |
fce44373 | 2380 | "Expands arg-access text macros in DEFINITION according to ARGLIST." |
ee7bf2ad RM |
2381 | (ad-substitute-tree |
2382 | (function | |
2383 | (lambda (form) | |
2384 | (or (eq form 'ad-arg-bindings) | |
2385 | (and (memq (car-safe form) | |
2386 | '(ad-get-arg ad-get-args ad-set-arg ad-set-args)) | |
2387 | (integerp (car-safe (cdr form))))))) | |
2388 | (function | |
2389 | (lambda (form) | |
2390 | (if (eq form 'ad-arg-bindings) | |
2391 | (ad-retrieve-args-form arglist) | |
2392 | (let ((accessor (car form)) | |
2393 | (index (car (cdr form))) | |
2394 | (val (car (cdr (ad-insert-argument-access-forms | |
2395 | (cdr form) arglist))))) | |
2396 | (cond ((eq accessor 'ad-get-arg) | |
2397 | (ad-get-argument arglist index)) | |
2398 | ((eq accessor 'ad-set-arg) | |
2399 | (ad-set-argument arglist index val)) | |
2400 | ((eq accessor 'ad-get-args) | |
2401 | (ad-get-arguments arglist index)) | |
2402 | ((eq accessor 'ad-set-args) | |
2403 | (ad-set-arguments arglist index val))))))) | |
2404 | definition)) | |
2405 | ||
2406 | ;; @@@ Mapping argument lists: | |
2407 | ;; =========================== | |
2408 | ;; Here is the problem: | |
2409 | ;; Suppose function foo was called with (foo 1 2 3 4 5), and foo has the | |
2410 | ;; argument list (x y &rest z), and we want to call the function bar which | |
2411 | ;; has argument list (a &rest b) with a combination of x, y and z so that | |
fce44373 | 2412 | ;; the effect is just as if we had called (bar 1 2 3 4 5) directly. |
ee7bf2ad RM |
2413 | ;; The mapping should work for any two argument lists. |
2414 | ||
2415 | (defun ad-map-arglists (source-arglist target-arglist) | |
fce44373 | 2416 | "Make `funcall/apply' form to map SOURCE-ARGLIST to TARGET-ARGLIST. |
ee7bf2ad | 2417 | The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just |
fce44373 DL |
2418 | as if they had been supplied to a function with TARGET-ARGLIST directly. |
2419 | Excess source arguments will be neglected, missing source arguments will be | |
6e2f6f45 RS |
2420 | supplied as nil. Returns a `funcall' or `apply' form with the second element |
2421 | being `function' which has to be replaced by an actual function argument. | |
2422 | Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return | |
3c442f8b | 2423 | `(funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))'." |
ee7bf2ad RM |
2424 | (let* ((parsed-source-arglist (ad-parse-arglist source-arglist)) |
2425 | (source-reqopt-args (append (nth 0 parsed-source-arglist) | |
2426 | (nth 1 parsed-source-arglist))) | |
2427 | (source-rest-arg (nth 2 parsed-source-arglist)) | |
2428 | (parsed-target-arglist (ad-parse-arglist target-arglist)) | |
2429 | (target-reqopt-args (append (nth 0 parsed-target-arglist) | |
2430 | (nth 1 parsed-target-arglist))) | |
2431 | (target-rest-arg (nth 2 parsed-target-arglist)) | |
2432 | (need-apply (and source-rest-arg target-rest-arg)) | |
2433 | (target-arg-index -1)) | |
2434 | ;; This produces ``error-proof'' target function calls with the exception | |
2435 | ;; of a case like (&rest a) mapped onto (x &rest y) where the actual args | |
2436 | ;; supplied to A might not be enough to supply the required target arg X | |
3c442f8b | 2437 | (append (list (if need-apply 'apply 'funcall) 'ad--addoit-function) |
ee7bf2ad RM |
2438 | (cond (need-apply |
2439 | ;; `apply' can take care of that directly: | |
2440 | (append source-reqopt-args (list source-rest-arg))) | |
6858633a SM |
2441 | (t (mapcar (lambda (_arg) |
2442 | (setq target-arg-index (1+ target-arg-index)) | |
2443 | (ad-get-argument | |
2444 | source-arglist target-arg-index)) | |
ee7bf2ad RM |
2445 | (append target-reqopt-args |
2446 | (and target-rest-arg | |
2447 | ;; If we have a rest arg gobble up | |
2448 | ;; remaining source args: | |
2449 | (nthcdr (length target-reqopt-args) | |
2450 | source-reqopt-args))))))))) | |
2451 | ||
ee7bf2ad RM |
2452 | |
2453 | ;; @@@ Making an advised documentation string: | |
2454 | ;; =========================================== | |
2455 | ;; New policy: The documentation string for an advised function will be built | |
6e2f6f45 | 2456 | ;; at the time the advised `documentation' function is called. This has the |
ee7bf2ad RM |
2457 | ;; following advantages: |
2458 | ;; 1) command-key substitutions will automatically be correct | |
2459 | ;; 2) No wasted string space due to big advised docstrings in caches or | |
2460 | ;; compiled files that contain preactivations | |
2461 | ;; The overall overhead for this should be negligible because people normally | |
2462 | ;; don't lookup documentation for the same function over and over again. | |
2463 | ||
6e2f6f45 | 2464 | (defun ad-make-single-advice-docstring (advice class &optional style) |
ee7bf2ad | 2465 | (let ((advice-docstring (ad-docstring (ad-advice-definition advice)))) |
6e2f6f45 RS |
2466 | (cond ((eq style 'plain) |
2467 | advice-docstring) | |
8bae7480 DL |
2468 | (t (if advice-docstring |
2469 | (format "%s-advice `%s':\n%s" | |
2470 | (capitalize (symbol-name class)) | |
2471 | (ad-advice-name advice) | |
2472 | advice-docstring) | |
2473 | (format "%s-advice `%s'." | |
2474 | (capitalize (symbol-name class)) | |
2475 | (ad-advice-name advice))))))) | |
6e2f6f45 | 2476 | |
24c22ecf SM |
2477 | (require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage. |
2478 | ||
0d53f628 | 2479 | (defun ad--make-advised-docstring (function &optional style) |
24c22ecf | 2480 | "Construct a documentation string for the advised FUNCTION. |
0d53f628 CY |
2481 | Concatenate the original documentation with the documentation |
2482 | strings of the individual pieces of advice. Optional argument | |
2483 | STYLE specifies how to format the pieces of advice; it can be | |
2484 | `plain', or any other value which means the default formatting. | |
2485 | ||
2486 | The advice documentation is shown in order of before/around/after | |
2487 | advice type, obeying the priority in each of these types." | |
2488 | ;; Retrieve the original function documentation | |
2489 | (let* ((fun (get function 'function-documentation)) | |
2490 | (origdoc (unwind-protect | |
2491 | (progn (put function 'function-documentation nil) | |
2492 | (documentation function t)) | |
2493 | (put function 'function-documentation fun)))) | |
2494 | (if (and (symbolp function) | |
2495 | (string-match "\\`ad-+Advice-" (symbol-name function))) | |
2496 | (setq function | |
2497 | (intern (substring (symbol-name function) (match-end 0))))) | |
2498 | (let* ((usage (help-split-fundoc origdoc function)) | |
2499 | paragraphs advice-docstring) | |
2500 | (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage))) | |
2501 | (if origdoc (setq paragraphs (list origdoc))) | |
2502 | (dolist (class ad-advice-classes) | |
2503 | (dolist (advice (ad-get-enabled-advices function class)) | |
2504 | (setq advice-docstring | |
2505 | (ad-make-single-advice-docstring advice class style)) | |
2506 | (if advice-docstring | |
2507 | (push advice-docstring paragraphs)))) | |
2508 | (setq origdoc (if paragraphs | |
2509 | (mapconcat 'identity (nreverse paragraphs) | |
2510 | "\n\n"))) | |
2511 | (help-add-fundoc-usage origdoc usage)))) | |
6e2f6f45 | 2512 | |
ee7bf2ad RM |
2513 | |
2514 | ;; @@@ Accessing overriding arglists and interactive forms: | |
2515 | ;; ======================================================== | |
2516 | ||
2517 | (defun ad-advised-arglist (function) | |
fce44373 | 2518 | "Find first defined arglist in FUNCTION's redefining advices." |
2de39f08 | 2519 | (cl-dolist (advice (append (ad-get-enabled-advices function 'before) |
ee7bf2ad RM |
2520 | (ad-get-enabled-advices function 'around) |
2521 | (ad-get-enabled-advices function 'after))) | |
2522 | (let ((arglist (ad-arglist (ad-advice-definition advice)))) | |
2523 | (if arglist | |
2524 | ;; We found the first one, use it: | |
2de39f08 | 2525 | (cl-return arglist))))) |
ee7bf2ad RM |
2526 | |
2527 | (defun ad-advised-interactive-form (function) | |
fce44373 | 2528 | "Find first interactive form in FUNCTION's redefining advices." |
2de39f08 | 2529 | (cl-dolist (advice (append (ad-get-enabled-advices function 'before) |
ee7bf2ad RM |
2530 | (ad-get-enabled-advices function 'around) |
2531 | (ad-get-enabled-advices function 'after))) | |
2532 | (let ((interactive-form | |
806bc6df | 2533 | (ad-interactive-form (ad-advice-definition advice)))) |
ee7bf2ad RM |
2534 | (if interactive-form |
2535 | ;; We found the first one, use it: | |
2de39f08 | 2536 | (cl-return interactive-form))))) |
ee7bf2ad RM |
2537 | |
2538 | ;; @@@ Putting it all together: | |
2539 | ;; ============================ | |
2540 | ||
2541 | (defun ad-make-advised-definition (function) | |
fce44373 | 2542 | "Generate an advised definition of FUNCTION from its advice info." |
ee7bf2ad RM |
2543 | (if (and (ad-is-advised function) |
2544 | (ad-has-redefining-advice function)) | |
2545 | (let* ((origdef (ad-real-orig-definition function)) | |
ee7bf2ad | 2546 | ;; Construct the individual pieces that we need for assembly: |
dd0c5bbb SM |
2547 | (orig-arglist (let ((args (ad-arglist origdef))) |
2548 | ;; The arglist may still be unknown. | |
2549 | (if (listp args) args '(&rest args)))) | |
ee7bf2ad RM |
2550 | (advised-arglist (or (ad-advised-arglist function) |
2551 | orig-arglist)) | |
3c442f8b | 2552 | (interactive-form (ad-advised-interactive-form function)) |
ee7bf2ad | 2553 | (orig-form |
3c442f8b | 2554 | (ad-map-arglists advised-arglist orig-arglist))) |
ee7bf2ad RM |
2555 | |
2556 | ;; Finally, build the sucker: | |
2557 | (ad-assemble-advised-definition | |
ee7bf2ad | 2558 | advised-arglist |
0d53f628 | 2559 | nil |
ee7bf2ad RM |
2560 | interactive-form |
2561 | orig-form | |
2562 | (ad-get-enabled-advices function 'before) | |
2563 | (ad-get-enabled-advices function 'around) | |
2564 | (ad-get-enabled-advices function 'after))))) | |
2565 | ||
2566 | (defun ad-assemble-advised-definition | |
3c442f8b SM |
2567 | (args docstring interactive orig &optional befores arounds afters) |
2568 | "Assemble the advices into an overall advice function. | |
2569 | ARGS is the argument list that has to be used, | |
2570 | DOCSTRING if non-nil defines the documentation of the definition, | |
2571 | INTERACTIVE if non-nil is the interactive form to be used, | |
fce44373 DL |
2572 | ORIG is a form that calls the body of the original unadvised function, |
2573 | and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG | |
2574 | should be modified. The assembled function will be returned." | |
150f809c SM |
2575 | ;; The ad-do-it call should always have the right number of arguments, |
2576 | ;; but the compiler might signal a bogus warning because it checks the call | |
2577 | ;; against the advertised calling convention. | |
2578 | (let ((around-form `(setq ad-return-value (with-no-warnings ,orig))) | |
2579 | before-forms around-form-protected after-forms definition) | |
2de39f08 SM |
2580 | (dolist (advice befores) |
2581 | (cond ((and (ad-advice-protected advice) | |
2582 | before-forms) | |
2583 | (setq before-forms | |
2584 | `((unwind-protect | |
0fb3cb7c | 2585 | ,(macroexp-progn before-forms) |
2de39f08 SM |
2586 | ,@(ad-body-forms |
2587 | (ad-advice-definition advice)))))) | |
2588 | (t (setq before-forms | |
2589 | (append before-forms | |
2590 | (ad-body-forms (ad-advice-definition advice))))))) | |
8a946354 | 2591 | |
2de39f08 SM |
2592 | (dolist (advice (reverse arounds)) |
2593 | ;; If any of the around advices is protected then we | |
2594 | ;; protect the complete around advice onion: | |
2595 | (if (ad-advice-protected advice) | |
2596 | (setq around-form-protected t)) | |
2597 | (setq around-form | |
2598 | (ad-substitute-tree | |
6858633a SM |
2599 | (lambda (form) (eq form 'ad-do-it)) |
2600 | (lambda (_form) around-form) | |
0fb3cb7c | 2601 | (macroexp-progn (ad-body-forms (ad-advice-definition advice)))))) |
ee7bf2ad RM |
2602 | |
2603 | (setq after-forms | |
2604 | (if (and around-form-protected before-forms) | |
8a946354 | 2605 | `((unwind-protect |
0fb3cb7c | 2606 | ,(macroexp-progn before-forms) |
8a946354 SS |
2607 | ,around-form)) |
2608 | (append before-forms (list around-form)))) | |
2de39f08 SM |
2609 | (dolist (advice afters) |
2610 | (cond ((and (ad-advice-protected advice) | |
2611 | after-forms) | |
2612 | (setq after-forms | |
2613 | `((unwind-protect | |
0fb3cb7c | 2614 | ,(macroexp-progn after-forms) |
2de39f08 SM |
2615 | ,@(ad-body-forms |
2616 | (ad-advice-definition advice)))))) | |
2617 | (t (setq after-forms | |
2618 | (append after-forms | |
2619 | (ad-body-forms (ad-advice-definition advice))))))) | |
ee7bf2ad RM |
2620 | |
2621 | (setq definition | |
3c442f8b | 2622 | `(lambda (ad--addoit-function ,@args) |
8a946354 SS |
2623 | ,@(if docstring (list docstring)) |
2624 | ,@(if interactive (list interactive)) | |
2625 | (let (ad-return-value) | |
2626 | ,@after-forms | |
3c442f8b | 2627 | ad-return-value))) |
ee7bf2ad RM |
2628 | |
2629 | (ad-insert-argument-access-forms definition args))) | |
2630 | ||
2631 | ;; This is needed for activation/deactivation hooks: | |
2632 | (defun ad-make-hook-form (function hook-name) | |
fce44373 | 2633 | "Make hook-form from FUNCTION's advice bodies in class HOOK-NAME." |
ee7bf2ad RM |
2634 | (let ((hook-forms |
2635 | (mapcar (function (lambda (advice) | |
2636 | (ad-body-forms (ad-advice-definition advice)))) | |
2637 | (ad-get-enabled-advices function hook-name)))) | |
2638 | (if hook-forms | |
0fb3cb7c | 2639 | (macroexp-progn (apply 'append hook-forms))))) |
ee7bf2ad RM |
2640 | |
2641 | ||
2642 | ;; @@ Caching: | |
2643 | ;; =========== | |
2644 | ;; Generating an advised definition of a function is moderately expensive, | |
2645 | ;; hence, it makes sense to cache it so we can reuse it in appropriate | |
2646 | ;; circumstances. Of course, it only makes sense to reuse a cached | |
2647 | ;; definition if the current advice and function definition state is the | |
2648 | ;; same as it was at the time when the cached definition was generated. | |
2649 | ;; For that purpose we associate every cache with an id so we can verify | |
6e2f6f45 | 2650 | ;; if it is still valid at a certain point in time. This id mechanism |
ee7bf2ad RM |
2651 | ;; makes it possible to preactivate advised functions, write the compiled |
2652 | ;; advised definitions to a file and reuse them during the actual | |
2653 | ;; activation without having to risk that the resulting definition will be | |
2654 | ;; incorrect, well, almost. | |
2655 | ;; | |
2656 | ;; A cache id is a list with six elements: | |
2657 | ;; 1) the list of names of enabled before advices | |
2658 | ;; 2) the list of names of enabled around advices | |
2659 | ;; 3) the list of names of enabled after advices | |
2660 | ;; 4) the type of the original function (macro, subr, etc.) | |
2661 | ;; 5) the arglist of the original definition (or t if it was equal to the | |
2662 | ;; arglist of the cached definition) | |
2663 | ;; 6) t if the interactive form of the original definition was equal to the | |
2664 | ;; interactive form of the cached definition | |
2665 | ;; | |
2666 | ;; Here's how a cache can get invalidated or be incorrect: | |
2667 | ;; A) a piece of advice used in the cache gets redefined | |
2668 | ;; B) the current list of enabled advices is different from the ones used | |
2669 | ;; for the cache | |
2670 | ;; C) the type of the original function changed, e.g., a function became a | |
2671 | ;; macro, or a subr became a function | |
2672 | ;; D) the arglist of the original function changed | |
2673 | ;; E) the interactive form of the original function changed | |
2674 | ;; F) a piece of advice used in the cache got redefined before the | |
2675 | ;; defadvice with the cached definition got loaded: This is a PROBLEM! | |
2676 | ;; | |
6e2f6f45 | 2677 | ;; Cases A and B are the normal ones. A is taken care of by `ad-add-advice' |
ee7bf2ad RM |
2678 | ;; which clears the cache in such a case, B is easily checked during |
2679 | ;; verification at activation time. | |
2680 | ;; | |
2681 | ;; Cases C, D and E have to be considered if one is slightly paranoid, i.e., | |
2682 | ;; if one considers the case that the original function could be different | |
2683 | ;; from the one available at caching time (e.g., for forward advice of | |
2684 | ;; functions that get redefined by some packages - such as `eval-region' gets | |
6e2f6f45 RS |
2685 | ;; redefined by edebug). All these cases can be easily checked during |
2686 | ;; verification. Element 4 of the id lets one check case C, element 5 takes | |
ee7bf2ad RM |
2687 | ;; care of case D (using t in the equality case saves some space, because the |
2688 | ;; arglist can be recovered at validation time from the cached definition), | |
2689 | ;; and element 6 takes care of case E which is only a problem if the original | |
2690 | ;; was actually a function whose interactive form was not overridden by a | |
2691 | ;; piece of advice. | |
2692 | ;; | |
2693 | ;; Case F is the only one which will lead to an incorrect advised function. | |
2694 | ;; There is no way to avoid this without storing the complete advice definition | |
2695 | ;; in the cache-id which is not feasible. | |
2696 | ;; | |
2697 | ;; The cache-id of a typical advised function with one piece of advice and | |
2698 | ;; no arglist redefinition takes 7 conses which is a small price to pay for | |
6e2f6f45 | 2699 | ;; the added efficiency. The validation itself is also pretty cheap, certainly |
ee7bf2ad RM |
2700 | ;; a lot cheaper than reconstructing an advised definition. |
2701 | ||
2702 | (defmacro ad-get-cache-definition (function) | |
8a946354 | 2703 | `(car (ad-get-advice-info-field ,function 'cache))) |
ee7bf2ad RM |
2704 | |
2705 | (defmacro ad-get-cache-id (function) | |
8a946354 | 2706 | `(cdr (ad-get-advice-info-field ,function 'cache))) |
ee7bf2ad RM |
2707 | |
2708 | (defmacro ad-set-cache (function definition id) | |
8a946354 SS |
2709 | `(ad-set-advice-info-field |
2710 | ,function 'cache (cons ,definition ,id))) | |
ee7bf2ad RM |
2711 | |
2712 | (defun ad-clear-cache (function) | |
2713 | "Clears a previously cached advised definition of FUNCTION. | |
2714 | Clear the cache if you want to force `ad-activate' to construct a new | |
2715 | advised definition from scratch." | |
2716 | (interactive | |
5b76833f | 2717 | (list (ad-read-advised-function "Clear cached definition of"))) |
ee7bf2ad RM |
2718 | (ad-set-advice-info-field function 'cache nil)) |
2719 | ||
2720 | (defun ad-make-cache-id (function) | |
fce44373 | 2721 | "Generate an identifying image of the current advices of FUNCTION." |
ee7bf2ad RM |
2722 | (let ((original-definition (ad-real-orig-definition function)) |
2723 | (cached-definition (ad-get-cache-definition function))) | |
3c442f8b | 2724 | (list (mapcar #'ad-advice-name |
ee7bf2ad | 2725 | (ad-get-enabled-advices function 'before)) |
3c442f8b | 2726 | (mapcar #'ad-advice-name |
ee7bf2ad | 2727 | (ad-get-enabled-advices function 'around)) |
3c442f8b | 2728 | (mapcar #'ad-advice-name |
ee7bf2ad RM |
2729 | (ad-get-enabled-advices function 'after)) |
2730 | (ad-definition-type original-definition) | |
6858633a | 2731 | (if (equal (ad-arglist original-definition) |
ee7bf2ad RM |
2732 | (ad-arglist cached-definition)) |
2733 | t | |
6858633a | 2734 | (ad-arglist original-definition)) |
ee7bf2ad | 2735 | (if (eq (ad-definition-type original-definition) 'function) |
05bfa8f3 SM |
2736 | (equal (interactive-form original-definition) |
2737 | (interactive-form cached-definition)))))) | |
ee7bf2ad RM |
2738 | |
2739 | (defun ad-get-cache-class-id (function class) | |
fce44373 | 2740 | "Return the part of FUNCTION's cache id that identifies CLASS." |
ee7bf2ad RM |
2741 | (let ((cache-id (ad-get-cache-id function))) |
2742 | (if (eq class 'before) | |
2743 | (car cache-id) | |
2744 | (if (eq class 'around) | |
2745 | (nth 1 cache-id) | |
2746 | (nth 2 cache-id))))) | |
2747 | ||
2748 | (defun ad-verify-cache-class-id (cache-class-id advices) | |
2de39f08 | 2749 | (cl-dolist (advice advices (null cache-class-id)) |
ee7bf2ad RM |
2750 | (if (ad-advice-enabled advice) |
2751 | (if (eq (car cache-class-id) (ad-advice-name advice)) | |
2752 | (setq cache-class-id (cdr cache-class-id)) | |
2de39f08 | 2753 | (cl-return nil))))) |
ee7bf2ad RM |
2754 | |
2755 | ;; There should be a way to monitor if and why a cache verification failed | |
2756 | ;; in order to determine whether a certain preactivation could be used or | |
fce44373 | 2757 | ;; not. Right now the only way to find out is to trace |
6e2f6f45 RS |
2758 | ;; `ad-cache-id-verification-code'. The code it returns indicates where the |
2759 | ;; verification failed. Tracing `ad-verify-cache-class-id' might provide | |
ee7bf2ad RM |
2760 | ;; some additional useful information. |
2761 | ||
2762 | (defun ad-cache-id-verification-code (function) | |
2763 | (let ((cache-id (ad-get-cache-id function)) | |
2764 | (code 'before-advice-mismatch)) | |
2765 | (and (ad-verify-cache-class-id | |
2766 | (car cache-id) (ad-get-advice-info-field function 'before)) | |
2767 | (setq code 'around-advice-mismatch) | |
2768 | (ad-verify-cache-class-id | |
2769 | (nth 1 cache-id) (ad-get-advice-info-field function 'around)) | |
2770 | (setq code 'after-advice-mismatch) | |
2771 | (ad-verify-cache-class-id | |
2772 | (nth 2 cache-id) (ad-get-advice-info-field function 'after)) | |
2773 | (setq code 'definition-type-mismatch) | |
2774 | (let ((original-definition (ad-real-orig-definition function)) | |
2775 | (cached-definition (ad-get-cache-definition function))) | |
2776 | (and (eq (nth 3 cache-id) (ad-definition-type original-definition)) | |
2777 | (setq code 'arglist-mismatch) | |
2778 | (equal (if (eq (nth 4 cache-id) t) | |
6858633a | 2779 | (ad-arglist original-definition) |
ee7bf2ad RM |
2780 | (nth 4 cache-id) ) |
2781 | (ad-arglist cached-definition)) | |
2782 | (setq code 'interactive-form-mismatch) | |
2783 | (or (null (nth 5 cache-id)) | |
05bfa8f3 SM |
2784 | (equal (interactive-form original-definition) |
2785 | (interactive-form cached-definition))) | |
ee7bf2ad RM |
2786 | (setq code 'verified)))) |
2787 | code)) | |
2788 | ||
2789 | (defun ad-verify-cache-id (function) | |
fce44373 | 2790 | "True if FUNCTION's cache-id is compatible with its current advices." |
ee7bf2ad RM |
2791 | (eq (ad-cache-id-verification-code function) 'verified)) |
2792 | ||
2793 | ||
2794 | ;; @@ Preactivation: | |
2795 | ;; ================= | |
2796 | ;; Preactivation can be used to generate compiled advised definitions | |
2797 | ;; at compile time without having to give up the dynamic runtime flexibility | |
6e2f6f45 | 2798 | ;; of the advice mechanism. Preactivation is a special feature of `defadvice', |
ee7bf2ad RM |
2799 | ;; it involves the following steps: |
2800 | ;; - remembering the function's current state (definition and advice-info) | |
2801 | ;; - advising it with the defined piece of advice | |
2802 | ;; - clearing its cache | |
2803 | ;; - generating an interpreted advised definition by activating it, this will | |
2804 | ;; make use of all its current active advice and its current definition | |
2805 | ;; - saving the so generated cached definition and id | |
2806 | ;; - resetting the function's advice and definition state to what it was | |
2807 | ;; before the preactivation | |
2808 | ;; - Returning the saved definition and its id to be used in the expansion of | |
2809 | ;; `defadvice' to assign it as an initial cache, hence it will be compiled | |
6e2f6f45 | 2810 | ;; at time the `defadvice' gets compiled. |
ee7bf2ad RM |
2811 | ;; Naturally, for preactivation to be effective it has to be applied/compiled |
2812 | ;; at the right time, i.e., when the current state of advices and function | |
6e2f6f45 | 2813 | ;; definition exactly reflects the state at activation time. Should that not |
ee7bf2ad RM |
2814 | ;; be the case, the precompiled definition will just be discarded and a new |
2815 | ;; advised definition will be generated. | |
2816 | ||
2817 | (defun ad-preactivate-advice (function advice class position) | |
fce44373 | 2818 | "Preactivate FUNCTION and returns the constructed cache." |
cb9c0a53 SM |
2819 | (let* ((advicefunname (ad-get-advice-info-field function 'advicefunname)) |
2820 | (old-advice (symbol-function advicefunname)) | |
ee7bf2ad RM |
2821 | (old-advice-info (ad-copy-advice-info function)) |
2822 | (ad-advised-functions ad-advised-functions)) | |
2823 | (unwind-protect | |
2824 | (progn | |
2825 | (ad-add-advice function advice class position) | |
2826 | (ad-enable-advice function class (ad-advice-name advice)) | |
2827 | (ad-clear-cache function) | |
5f6bb68a | 2828 | (ad-activate function -1) |
ee7bf2ad RM |
2829 | (if (and (ad-is-active function) |
2830 | (ad-get-cache-definition function)) | |
2831 | (list (ad-get-cache-definition function) | |
2832 | (ad-get-cache-id function)))) | |
2833 | (ad-set-advice-info function old-advice-info) | |
cb9c0a53 SM |
2834 | (advice-remove function advicefunname) |
2835 | (fset advicefunname old-advice) | |
2836 | (if old-advice (advice-add function :around advicefunname))))) | |
ee7bf2ad | 2837 | |
fabaa9b5 | 2838 | |
fabaa9b5 RS |
2839 | ;; @@ Activation and definition handling: |
2840 | ;; ====================================== | |
2841 | ||
2842 | (defun ad-should-compile (function compile) | |
fce44373 DL |
2843 | "Return non-nil if the advised FUNCTION should be compiled. |
2844 | If COMPILE is non-nil and not a negative number then it returns t. | |
2845 | If COMPILE is a negative number then it returns nil. | |
2846 | If COMPILE is nil then the result depends on the value of | |
2847 | `ad-default-compilation-action' (which see)." | |
848a2dd1 SM |
2848 | (cond |
2849 | ;; Don't compile until the real function definition is known (bug#12965). | |
2850 | ((not (ad-real-orig-definition function)) nil) | |
2851 | ((integerp compile) (>= compile 0)) | |
2852 | (compile) | |
2853 | ((eq ad-default-compilation-action 'never) nil) | |
2854 | ((eq ad-default-compilation-action 'always) t) | |
2855 | ((eq ad-default-compilation-action 'like-original) | |
671d5c16 | 2856 | (or (subrp (ad-get-orig-definition function)) |
848a2dd1 SM |
2857 | (ad-compiled-p (ad-get-orig-definition function)))) |
2858 | ;; everything else means `maybe': | |
2859 | (t (featurep 'byte-compile)))) | |
fabaa9b5 | 2860 | |
ee7bf2ad | 2861 | (defun ad-activate-advised-definition (function compile) |
fce44373 DL |
2862 | "Redefine FUNCTION with its advised definition from cache or scratch. |
2863 | The resulting FUNCTION will be compiled if `ad-should-compile' returns t. | |
2864 | The current definition and its cache-id will be put into the cache." | |
4986fa21 SM |
2865 | (let* ((verified-cached-definition |
2866 | (if (ad-verify-cache-id function) | |
2867 | (ad-get-cache-definition function))) | |
2868 | (advicefunname (ad-get-advice-info-field function 'advicefunname)) | |
2869 | (old-ispec (interactive-form advicefunname))) | |
3c442f8b SM |
2870 | (fset advicefunname |
2871 | (or verified-cached-definition | |
2872 | (ad-make-advised-definition function))) | |
0d53f628 CY |
2873 | (put advicefunname 'function-documentation |
2874 | `(ad--make-advised-docstring ',advicefunname)) | |
4986fa21 SM |
2875 | (unless (equal (interactive-form advicefunname) old-ispec) |
2876 | ;; If the interactive-spec of advicefunname has changed, force nadvice to | |
2877 | ;; refresh its copy. | |
2878 | (advice-remove function advicefunname)) | |
3c442f8b | 2879 | (advice-add function :around advicefunname) |
fabaa9b5 | 2880 | (if (ad-should-compile function compile) |
848a2dd1 | 2881 | (ad-compile-function function)) |
ee7bf2ad | 2882 | (if verified-cached-definition |
3c442f8b SM |
2883 | (if (not (eq verified-cached-definition |
2884 | (symbol-function advicefunname))) | |
ee7bf2ad | 2885 | ;; we must have compiled, cache the compiled definition: |
3c442f8b SM |
2886 | (ad-set-cache function (symbol-function advicefunname) |
2887 | (ad-get-cache-id function))) | |
ee7bf2ad RM |
2888 | ;; We created a new advised definition, cache it with a proper id: |
2889 | (ad-clear-cache function) | |
2890 | ;; ad-make-cache-id needs the new cached definition: | |
3c442f8b | 2891 | (ad-set-cache function (symbol-function advicefunname) nil) |
ee7bf2ad | 2892 | (ad-set-cache |
3c442f8b | 2893 | function (symbol-function advicefunname) (ad-make-cache-id function))))) |
ee7bf2ad | 2894 | |
3c442f8b SM |
2895 | (defun ad--defalias-fset (fsetfun function newdef) |
2896 | ;; Besides ad-redefinition-action we use this defalias-fset-function hook | |
2897 | ;; for two other reasons: | |
2898 | ;; - for `activation/deactivation' advices. | |
2899 | ;; - to rebuild the ad-Advice-* function with the right argument names. | |
850da9d0 | 2900 | "Handle re/definition of an advised FUNCTION during de/activation. |
ee7bf2ad RM |
2901 | If FUNCTION does not have an original definition associated with it and |
2902 | the current definition is usable, then it will be stored as FUNCTION's | |
6e2f6f45 RS |
2903 | original definition. If no current definition is available (even in the |
2904 | case of undefinition) nothing will be done. In the case of redefinition | |
ee7bf2ad | 2905 | the action taken depends on the value of `ad-redefinition-action' (which |
6e2f6f45 | 2906 | see). Redefinition occurs when FUNCTION already has an original definition |
ee7bf2ad | 2907 | associated with it but got redefined with a new definition and then |
6e2f6f45 | 2908 | de/activated. If you do not like the current redefinition action change |
ee7bf2ad RM |
2909 | the value of `ad-redefinition-action' and de/activate again." |
2910 | (let ((original-definition (ad-get-orig-definition function)) | |
3c442f8b | 2911 | (current-definition (ad-get-orig-definition newdef))) |
ee7bf2ad RM |
2912 | (if original-definition |
2913 | (if current-definition | |
3c442f8b SM |
2914 | (if (not (eq current-definition original-definition)) |
2915 | ;; We have a redefinition: | |
ee7bf2ad | 2916 | (if (not (memq ad-redefinition-action '(accept discard warn))) |
3c442f8b | 2917 | (error "ad-redefinition-action: `%s' %s" |
2036d16f | 2918 | function "invalidly redefined") |
ee7bf2ad | 2919 | (if (eq ad-redefinition-action 'discard) |
3c442f8b SM |
2920 | nil ;; Just drop it! |
2921 | (funcall (or fsetfun #'fset) function newdef) | |
2922 | (ad-activate-internal function) | |
ee7bf2ad RM |
2923 | (if (eq ad-redefinition-action 'warn) |
2924 | (message "ad-handle-definition: `%s' got redefined" | |
2925 | function)))) | |
2926 | ;; either advised def or correct original is in place: | |
2927 | nil) | |
3c442f8b SM |
2928 | ;; We have an undefinition, ignore it: |
2929 | (funcall (or fsetfun #'fset) function newdef)) | |
2930 | (funcall (or fsetfun #'fset) function newdef) | |
2931 | (when current-definition (ad-activate-internal function))))) | |
ee7bf2ad RM |
2932 | |
2933 | ||
2934 | ;; @@ The top-level advice interface: | |
2935 | ;; ================================== | |
2936 | ||
379ba58e | 2937 | ;;;###autoload |
5f6bb68a | 2938 | (defun ad-activate (function &optional compile) |
850da9d0 | 2939 | "Activate all the advice information of an advised FUNCTION. |
ee7bf2ad RM |
2940 | If FUNCTION has a proper original definition then an advised |
2941 | definition will be generated from FUNCTION's advice info and the | |
6e2f6f45 | 2942 | definition of FUNCTION will be replaced with it. If a previously |
fabaa9b5 RS |
2943 | cached advised definition was available, it will be used. |
2944 | The optional COMPILE argument determines whether the resulting function | |
2945 | or a compilable cached definition will be compiled. If it is negative | |
2946 | no compilation will be performed, if it is positive or otherwise non-nil | |
2947 | the resulting function will be compiled, if it is nil the behavior depends | |
2948 | on the value of `ad-default-compilation-action' (which see). | |
2949 | Activation of an advised function that has an advice info but no actual | |
2950 | pieces of advice is equivalent to a call to `ad-unadvise'. Activation of | |
2951 | an advised function that has actual pieces of advice but none of them are | |
2952 | enabled is equivalent to a call to `ad-deactivate'. The current advised | |
ee7bf2ad RM |
2953 | definition will always be cached for later usage." |
2954 | (interactive | |
5b76833f | 2955 | (list (ad-read-advised-function "Activate advice of") |
ee7bf2ad | 2956 | current-prefix-arg)) |
848a2dd1 SM |
2957 | (cond |
2958 | ((not (ad-is-advised function)) | |
2959 | (error "ad-activate: `%s' is not advised" function)) | |
2960 | ;; Just return for forward advised and not yet defined functions: | |
2961 | ((not (ad-get-orig-definition function)) nil) | |
2962 | ((not (ad-has-any-advice function)) (ad-unadvise function)) | |
2963 | ;; Otherwise activate the advice: | |
2964 | ((ad-has-redefining-advice function) | |
2965 | (ad-activate-advised-definition function compile) | |
2966 | (ad-set-advice-info-field function 'active t) | |
2967 | (eval (ad-make-hook-form function 'activation)) | |
2968 | function) | |
2969 | ;; Here we are if we have all disabled advices: | |
2970 | (t (ad-deactivate function)))) | |
ee7bf2ad | 2971 | |
17d28a2a GM |
2972 | (defalias 'ad-activate-on 'ad-activate) |
2973 | ||
ee7bf2ad | 2974 | (defun ad-deactivate (function) |
850da9d0 | 2975 | "Deactivate the advice of an actively advised FUNCTION. |
ee7bf2ad | 2976 | If FUNCTION has a proper original definition, then the current |
6e2f6f45 | 2977 | definition of FUNCTION will be replaced with it. All the advice |
ee7bf2ad RM |
2978 | information will still be available so it can be activated again with |
2979 | a call to `ad-activate'." | |
2980 | (interactive | |
5b76833f | 2981 | (list (ad-read-advised-function "Deactivate advice of" 'ad-is-active))) |
ee7bf2ad RM |
2982 | (if (not (ad-is-advised function)) |
2983 | (error "ad-deactivate: `%s' is not advised" function) | |
2984 | (cond ((ad-is-active function) | |
ee7bf2ad RM |
2985 | (if (not (ad-get-orig-definition function)) |
2986 | (error "ad-deactivate: `%s' has no original definition" | |
2987 | function) | |
3c442f8b | 2988 | (ad-clear-advicefunname-definition function) |
ee7bf2ad RM |
2989 | (ad-set-advice-info-field function 'active nil) |
2990 | (eval (ad-make-hook-form function 'deactivation)) | |
2991 | function))))) | |
2992 | ||
2993 | (defun ad-update (function &optional compile) | |
2994 | "Update the advised definition of FUNCTION if its advice is active. | |
5f6bb68a | 2995 | See `ad-activate' for documentation on the optional COMPILE argument." |
ee7bf2ad RM |
2996 | (interactive |
2997 | (list (ad-read-advised-function | |
5b76833f | 2998 | "Update advised definition of" 'ad-is-active))) |
ee7bf2ad | 2999 | (if (ad-is-active function) |
5f6bb68a | 3000 | (ad-activate function compile))) |
ee7bf2ad RM |
3001 | |
3002 | (defun ad-unadvise (function) | |
850da9d0 | 3003 | "Deactivate FUNCTION and then remove all its advice information. |
ee7bf2ad RM |
3004 | If FUNCTION was not advised this will be a noop." |
3005 | (interactive | |
5b76833f | 3006 | (list (ad-read-advised-function "Unadvise function"))) |
ee7bf2ad RM |
3007 | (cond ((ad-is-advised function) |
3008 | (if (ad-is-active function) | |
3009 | (ad-deactivate function)) | |
3c442f8b | 3010 | (ad-clear-advicefunname-definition function) |
ee7bf2ad RM |
3011 | (ad-set-advice-info function nil) |
3012 | (ad-pop-advised-function function)))) | |
3013 | ||
3014 | (defun ad-recover (function) | |
850da9d0 RS |
3015 | "Try to recover FUNCTION's original definition, and unadvise it. |
3016 | This is more low-level than `ad-unadvise' in that it does not do | |
07c8b450 | 3017 | deactivation, which might run hooks and get into other trouble. |
ee7bf2ad RM |
3018 | Use in emergencies." |
3019 | ;; Use more primitive interactive behavior here: Accept any symbol that's | |
3020 | ;; currently defined in obarray, not necessarily with a function definition: | |
3021 | (interactive | |
3022 | (list (intern | |
3023 | (completing-read "Recover advised function: " obarray nil t)))) | |
3024 | (cond ((ad-is-advised function) | |
3c442f8b | 3025 | (ad-clear-advicefunname-definition function) |
ee7bf2ad RM |
3026 | (ad-set-advice-info function nil) |
3027 | (ad-pop-advised-function function)))) | |
3028 | ||
3029 | (defun ad-activate-regexp (regexp &optional compile) | |
850da9d0 RS |
3030 | "Activate functions with an advice name containing a REGEXP match. |
3031 | This activates the advice for each function | |
3032 | that has at least one piece of advice whose name includes a match for REGEXP. | |
5f6bb68a | 3033 | See `ad-activate' for documentation on the optional COMPILE argument." |
ee7bf2ad | 3034 | (interactive |
5b76833f | 3035 | (list (ad-read-regexp "Activate via advice regexp") |
ee7bf2ad RM |
3036 | current-prefix-arg)) |
3037 | (ad-do-advised-functions (function) | |
3038 | (if (ad-find-some-advice function 'any regexp) | |
5f6bb68a | 3039 | (ad-activate function compile)))) |
ee7bf2ad RM |
3040 | |
3041 | (defun ad-deactivate-regexp (regexp) | |
850da9d0 RS |
3042 | "Deactivate functions with an advice name containing REGEXP match. |
3043 | This deactivates the advice for each function | |
3044 | that has at least one piece of advice whose name includes a match for REGEXP." | |
ee7bf2ad | 3045 | (interactive |
5b76833f | 3046 | (list (ad-read-regexp "Deactivate via advice regexp"))) |
ee7bf2ad RM |
3047 | (ad-do-advised-functions (function) |
3048 | (if (ad-find-some-advice function 'any regexp) | |
3049 | (ad-deactivate function)))) | |
3050 | ||
3051 | (defun ad-update-regexp (regexp &optional compile) | |
fce44373 | 3052 | "Update functions with an advice name containing a REGEXP match. |
850da9d0 RS |
3053 | This reactivates the advice for each function |
3054 | that has at least one piece of advice whose name includes a match for REGEXP. | |
5f6bb68a | 3055 | See `ad-activate' for documentation on the optional COMPILE argument." |
ee7bf2ad | 3056 | (interactive |
5b76833f | 3057 | (list (ad-read-regexp "Update via advice regexp") |
ee7bf2ad RM |
3058 | current-prefix-arg)) |
3059 | (ad-do-advised-functions (function) | |
3060 | (if (ad-find-some-advice function 'any regexp) | |
3061 | (ad-update function compile)))) | |
3062 | ||
3063 | (defun ad-activate-all (&optional compile) | |
850da9d0 | 3064 | "Activate all currently advised functions. |
5f6bb68a | 3065 | See `ad-activate' for documentation on the optional COMPILE argument." |
ee7bf2ad RM |
3066 | (interactive "P") |
3067 | (ad-do-advised-functions (function) | |
5f6bb68a | 3068 | (ad-activate function compile))) |
ee7bf2ad RM |
3069 | |
3070 | (defun ad-deactivate-all () | |
850da9d0 | 3071 | "Deactivate all currently advised functions." |
ee7bf2ad RM |
3072 | (interactive) |
3073 | (ad-do-advised-functions (function) | |
3074 | (ad-deactivate function))) | |
3075 | ||
3076 | (defun ad-update-all (&optional compile) | |
fce44373 DL |
3077 | "Update all currently advised functions. |
3078 | With prefix argument, COMPILE resulting advised definitions." | |
ee7bf2ad RM |
3079 | (interactive "P") |
3080 | (ad-do-advised-functions (function) | |
3081 | (ad-update function compile))) | |
3082 | ||
3083 | (defun ad-unadvise-all () | |
850da9d0 | 3084 | "Unadvise all currently advised functions." |
ee7bf2ad RM |
3085 | (interactive) |
3086 | (ad-do-advised-functions (function) | |
3087 | (ad-unadvise function))) | |
3088 | ||
3089 | (defun ad-recover-all () | |
850da9d0 RS |
3090 | "Recover all currently advised functions. Use in emergencies. |
3091 | To recover a function means to try to find its original (pre-advice) | |
3092 | definition, and delete all advice. | |
3093 | This is more low-level than `ad-unadvise' in that it does not do | |
3094 | deactivation, which might run hooks and get into other trouble." | |
ee7bf2ad RM |
3095 | (interactive) |
3096 | (ad-do-advised-functions (function) | |
6e2f6f45 | 3097 | (condition-case nil |
ee7bf2ad RM |
3098 | (ad-recover function) |
3099 | (error nil)))) | |
3100 | ||
3101 | ||
bece3937 | 3102 | ;; Completion alist of valid `defadvice' flags |
ee7bf2ad | 3103 | (defvar ad-defadvice-flags |
6e2f6f45 | 3104 | '(("protect") ("disable") ("activate") |
7db1bda8 | 3105 | ("compile") ("preactivate"))) |
ee7bf2ad RM |
3106 | |
3107 | ;;;###autoload | |
3108 | (defmacro defadvice (function args &rest body) | |
fce44373 | 3109 | "Define a piece of advice for FUNCTION (a symbol). |
6e2f6f45 RS |
3110 | The syntax of `defadvice' is as follows: |
3111 | ||
fce44373 | 3112 | \(defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) |
6e2f6f45 | 3113 | [DOCSTRING] [INTERACTIVE-FORM] |
287a387c | 3114 | BODY...) |
6e2f6f45 RS |
3115 | |
3116 | FUNCTION ::= Name of the function to be advised. | |
3117 | CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'. | |
3118 | NAME ::= Non-nil symbol that names this piece of advice. | |
3119 | POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first', | |
3120 | see also `ad-add-advice'. | |
3121 | ARGLIST ::= An optional argument list to be used for the advised function | |
3122 | instead of the argument list of the original. The first one found in | |
3123 | before/around/after-advices will be used. | |
7db1bda8 | 3124 | FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'. |
ee7bf2ad | 3125 | All flags can be specified with unambiguous initial substrings. |
6e2f6f45 RS |
3126 | DOCSTRING ::= Optional documentation for this piece of advice. |
3127 | INTERACTIVE-FORM ::= Optional interactive form to be used for the advised | |
3128 | function. The first one found in before/around/after-advices will be used. | |
3129 | BODY ::= Any s-expression. | |
ee7bf2ad RM |
3130 | |
3131 | Semantics of the various flags: | |
3132 | `protect': The piece of advice will be protected against non-local exits in | |
6e2f6f45 RS |
3133 | any code that precedes it. If any around-advice of a function is protected |
3134 | then automatically all around-advices will be protected (the complete onion). | |
ee7bf2ad RM |
3135 | |
3136 | `activate': All advice of FUNCTION will be activated immediately if | |
6e2f6f45 | 3137 | FUNCTION has been properly defined prior to this application of `defadvice'. |
ee7bf2ad RM |
3138 | |
3139 | `compile': In conjunction with `activate' specifies that the resulting | |
3140 | advised function should be compiled. | |
3141 | ||
fce44373 | 3142 | `disable': The defined advice will be disabled, hence, it will not be used |
ee7bf2ad RM |
3143 | during activation until somebody enables it. |
3144 | ||
6e2f6f45 RS |
3145 | `preactivate': Preactivates the advised FUNCTION at macro-expansion/compile |
3146 | time. This generates a compiled advised definition according to the current | |
3147 | advice state that will be used during activation if appropriate. Only use | |
3148 | this if the `defadvice' gets actually compiled. | |
ee7bf2ad | 3149 | |
7aefbb06 RS |
3150 | usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) |
3151 | [DOCSTRING] [INTERACTIVE-FORM] | |
3152 | BODY...)" | |
c0458e0b | 3153 | (declare (doc-string 3) (indent 2) |
2de39f08 SM |
3154 | (debug (&define name ;; thing being advised. |
3155 | (name ;; class is [&or "before" "around" "after" | |
3156 | ;; "activation" "deactivation"] | |
3157 | name ;; name of advice | |
3158 | &rest sexp ;; optional position and flags | |
3159 | ) | |
3160 | [&optional stringp] | |
3161 | [&optional ("interactive" interactive)] | |
3162 | def-body))) | |
ee7bf2ad | 3163 | (if (not (ad-name-p function)) |
2036d16f | 3164 | (error "defadvice: Invalid function name: %s" function)) |
ee7bf2ad RM |
3165 | (let* ((class (car args)) |
3166 | (name (if (not (ad-class-p class)) | |
2036d16f | 3167 | (error "defadvice: Invalid advice class: %s" class) |
8a946354 | 3168 | (nth 1 args))) |
ee7bf2ad | 3169 | (position (if (not (ad-name-p name)) |
2036d16f | 3170 | (error "defadvice: Invalid advice name: %s" name) |
8a946354 SS |
3171 | (setq args (nthcdr 2 args)) |
3172 | (if (ad-position-p (car args)) | |
3173 | (prog1 (car args) | |
3174 | (setq args (cdr args)))))) | |
ee7bf2ad RM |
3175 | (arglist (if (listp (car args)) |
3176 | (prog1 (car args) | |
3177 | (setq args (cdr args))))) | |
3178 | (flags | |
3179 | (mapcar | |
3180 | (function | |
3181 | (lambda (flag) | |
8a946354 SS |
3182 | (let ((completion |
3183 | (try-completion (symbol-name flag) ad-defadvice-flags))) | |
3184 | (cond ((eq completion t) flag) | |
3185 | ((assoc completion ad-defadvice-flags) | |
3186 | (intern completion)) | |
3187 | (t (error "defadvice: Invalid or ambiguous flag: %s" | |
3188 | flag)))))) | |
ee7bf2ad RM |
3189 | args)) |
3190 | (advice (ad-make-advice | |
3191 | name (memq 'protect flags) | |
3192 | (not (memq 'disable flags)) | |
8a946354 | 3193 | `(advice lambda ,arglist ,@body))) |
ee7bf2ad RM |
3194 | (preactivation (if (memq 'preactivate flags) |
3195 | (ad-preactivate-advice | |
fabaa9b5 | 3196 | function advice class position)))) |
ee7bf2ad | 3197 | ;; Now for the things to be done at evaluation time: |
7db1bda8 SM |
3198 | `(progn |
3199 | (ad-add-advice ',function ',advice ',class ',position) | |
3200 | ,@(if preactivation | |
3201 | `((ad-set-cache | |
3202 | ',function | |
3203 | ;; the function will get compiled: | |
671d5c16 | 3204 | ,(cond ((macrop (car preactivation)) |
7db1bda8 SM |
3205 | `(ad-macrofy |
3206 | (function | |
3207 | ,(ad-lambdafy | |
3208 | (car preactivation))))) | |
3209 | (t `(function | |
3210 | ,(car preactivation)))) | |
3211 | ',(car (cdr preactivation))))) | |
3212 | ,@(if (memq 'activate flags) | |
3213 | `((ad-activate ',function | |
3214 | ,(if (memq 'compile flags) t)))) | |
3215 | ',function))) | |
ee7bf2ad RM |
3216 | |
3217 | ||
3218 | ;; @@ Tools: | |
3219 | ;; ========= | |
3220 | ||
3221 | (defmacro ad-with-originals (functions &rest body) | |
fce44373 | 3222 | "Binds FUNCTIONS to their original definitions and execute BODY. |
ee7bf2ad | 3223 | For any members of FUNCTIONS that are not currently advised the rebinding will |
6e2f6f45 | 3224 | be a noop. Any modifications done to the definitions of FUNCTIONS will be |
ee7bf2ad | 3225 | undone on exit of this macro." |
aaf0c300 | 3226 | (declare (indent 1)) |
ee7bf2ad RM |
3227 | (let* ((index -1) |
3228 | ;; Make let-variables to store current definitions: | |
3229 | (current-bindings | |
3230 | (mapcar (function | |
3231 | (lambda (function) | |
8a946354 SS |
3232 | (setq index (1+ index)) |
3233 | (list (intern (format "ad-oRiGdEf-%d" index)) | |
3234 | `(symbol-function ',function)))) | |
ee7bf2ad | 3235 | functions))) |
8a946354 SS |
3236 | `(let ,current-bindings |
3237 | (unwind-protect | |
3238 | (progn | |
3239 | ,@(progn | |
3240 | ;; Make forms to redefine functions to their | |
3241 | ;; original definitions if they are advised: | |
3242 | (setq index -1) | |
6858633a SM |
3243 | (mapcar (lambda (function) |
3244 | (setq index (1+ index)) | |
32e5c58c | 3245 | `(fset ',function |
6858633a SM |
3246 | (or (ad-get-orig-definition ',function) |
3247 | ,(car (nth index current-bindings))))) | |
3248 | functions)) | |
8a946354 SS |
3249 | ,@body) |
3250 | ,@(progn | |
3251 | ;; Make forms to back-define functions to the definitions | |
3252 | ;; they had outside this macro call: | |
3253 | (setq index -1) | |
6858633a SM |
3254 | (mapcar (lambda (function) |
3255 | (setq index (1+ index)) | |
32e5c58c | 3256 | `(fset ',function |
6858633a SM |
3257 | ,(car (nth index current-bindings)))) |
3258 | functions)))))) | |
ee7bf2ad | 3259 | |
ee7bf2ad | 3260 | |
ee7bf2ad RM |
3261 | ;; @@ Starting, stopping and recovering from the advice package magic: |
3262 | ;; =================================================================== | |
3263 | ||
ee7bf2ad | 3264 | (defun ad-recover-normality () |
fce44373 | 3265 | "Undo all advice related redefinitions and unadvises everything. |
ee7bf2ad RM |
3266 | Use only in REAL emergencies." |
3267 | (interactive) | |
ee7bf2ad | 3268 | (ad-recover-all) |
6858633a SM |
3269 | (ad-do-advised-functions (function) |
3270 | (message "Oops! Left over advised function %S" function) | |
3271 | (ad-pop-advised-function function))) | |
ee7bf2ad | 3272 | |
ee7bf2ad RM |
3273 | (provide 'advice) |
3274 | ||
3275 | ;;; advice.el ends here |