Lines Matching +defs:ad +defs:activate
148 ;; should know: Once Advice has been started with `ad-start-advice'
152 ;; All of this can be undone at any time with `M-x ad-stop-advice'.
157 ;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what
159 ;; - M-x ad-deactivate-all (if you don't have a clue what's going wrong)
160 ;; - M-x ad-stop-advice (if you think the problem is related to the
162 ;; - M-x ad-recover-normality (for real emergencies)
167 ;; the problem you can reactivate advised functions with either `ad-activate',
168 ;; `ad-activate-all', or `ad-start-advice'. `ad-recover-normality' unadvises
172 ;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before
175 ;; `M-x ad-activate-all' to go back to the advised state of all your
185 ;; Look at the documentation of `ad-redefinition-action' for possible values
190 ;; Look at the documentation of `ad-default-compilation-action' for possible
201 ;;(defadvice switch-to-buffer (before existing-buffers-only activate)
208 ;;(defadvice switch-to-buffer (around confirm-non-existing-buffers activate)
211 ;; (if (or (get-buffer (ad-get-arg 0))
212 ;; (y-or-n-p (format "`%s' does not exist, create? " (ad-get-arg 0))))
213 ;; ad-do-it))
215 ;;(defadvice find-file (before existing-files-only activate)
219 ;;(defadvice car (around interactive activate)
222 ;; ad-do-it
224 ;; (message "%s" ad-return-value)))
285 ;; `activate': Specifies that the advice information of the advised
287 ;; defined. In forward advices `activate' will be ignored.
291 ;; This flag will be ignored unless `activate' is also specified.
327 ;; (let (ad-return-value)
335 ;; (setq ad-return-value
344 ;; ad-return-value))
356 ;; (as they do v19s), `(&rest ad-subr-args)' will be used.
377 ;; keyword `ad-do-it', which will be substituted with a `progn' containing the
383 ;; `ad-return-value' will be set to its result. This variable is visible to
434 ;; (ad-get-arg 0) -> 0
435 ;; (ad-get-arg 1) -> 1
436 ;; (ad-get-arg 2) -> 2
437 ;; (ad-get-arg 3) -> 3
438 ;; (ad-get-args 2) -> (2 3 4 5 6)
439 ;; (ad-get-args 4) -> (4 5 6)
441 ;; `(ad-get-arg <position>)' will return the actual argument that was supplied
442 ;; at <position>, `(ad-get-args <position>)' will return the list of actual
447 ;; Similarly, `(ad-set-arg <position> <value-form>)' can be used to set the
450 ;; (ad-set-arg 5 "five")
453 ;; called. `(ad-set-args <position> <value-list-form>)' can be used to set
457 ;; (ad-set-args 0 '(5 4 3 2 1 0))
473 ;; special keyword `ad-arg-bindings' which is a text macro that will be
479 ;; (let* ((bindings ad-arg-bindings)
484 ;; (ad-arg-binding-field firstarg 'name)
485 ;; (ad-arg-binding-field firstarg 'value)
486 ;; (ad-arg-binding-field firstarg 'type)))
490 ;; Wherever `ad-arg-bindings' appears a form will be inserted that evaluates
500 ;; `(&rest ad-subr-args)' as the argument list of the original function
517 ;; `(&rest ad-subr-args)' which will always work but is inefficient because
518 ;; it conses up arguments. The macro `ad-define-subr-args' can be used by
522 ;; (ad-define-subr-args 'fset '(sym newdef))
527 ;; (ad-undefine-subr-args 'fset)
536 ;; 3) otherwise use `(&rest ad-subr-args)'
541 ;; gets actually activated. Activation can either happen with the `activate'
543 ;; invocation of `ad-activate', or if forward advice is enabled (i.e., the
544 ;; value of `ad-activate-on-definition' is t) at the time an already advised
554 ;; The advised definition will get compiled either if `ad-activate' was called
556 ;; argument as t, or, if `ad-default-compilation-action' justifies it according
562 ;; `ad-deactivate' can be used to back-define an advised function to its
564 ;; `ad-activate' caches the advised definition the function can be
565 ;; reactivated via `ad-activate' with only minor overhead (it is checked
569 ;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate
572 ;; de/activate sets of functions depending on certain advice naming
575 ;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to
576 ;; de/activate all currently advised functions. These are useful to
632 ;; etc. used by advice itself will stay disabled until `ad-start-advice' is
638 ;; `ad-enable-advice' and `ad-disable-advice'. For example, the following
641 ;; (ad-disable-advice 'foo 'before 'my-advice)
644 ;; the advised definition too one has to activate `foo' with
646 ;; (ad-activate 'foo)
654 ;; (ad-disable-regexp "^ange-ftp-")
658 ;; (ad-activate-regexp "^ange-ftp-")
662 ;; (ad-update-regexp "^ange-ftp-")
670 ;; `ad-enable-regexp' and then activate or update again.
700 ;; doint `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'.
715 ;; definition gets constructed then you should use `ad-clear-cache' before you
716 ;; activate the advised function.
772 ;; function `ad-cache-id-verification-code' (with the function
775 ;; activated check whether all calls to `ad-cache-id-verification-code'
787 ;; that was the only definition of that advice so far (`ad-add-advice'
813 ;; - As a safety measure, always do `ad-deactivate-all' before you
816 ;; results. After compilation do `ad-activate-all' to get back to
819 ;; @@ Adding a piece of advice with `ad-add-advice':
821 ;; The non-interactive function `ad-add-advice' can be used to add a piece of
823 ;; has to be added somewhere by a function (also look at `ad-make-advice').
885 ;; - ad-activate to activate the advice of a FUNCTION
886 ;; - ad-deactivate to deactivate the advice of a FUNCTION
887 ;; - ad-update to activate the advice of a FUNCTION unless it was not
889 ;; - ad-unadvise deactivates a FUNCTION and removes all of its advice
891 ;; - ad-recover tries to redefine a FUNCTION to its original definition and
892 ;; discards all advice information (a low-level `ad-unadvise').
895 ;; - ad-remove-advice removes a particular piece of advice of a FUNCTION.
896 ;; You still have to do call `ad-activate' or `ad-update' to
897 ;; activate the new state of advice.
898 ;; - ad-enable-advice enables a particular piece of advice of a FUNCTION.
899 ;; - ad-disable-advice disables a particular piece of advice of a FUNCTION.
900 ;; - ad-enable-regexp maps over all currently advised functions and enables
903 ;; - ad-disable-regexp disables matching advices.
905 ;; - ad-activate-regexp activates all advised function with a matching advice
906 ;; - ad-deactivate-regexp deactivates all advised function with matching advice
907 ;; - ad-update-regexp updates all advised function with a matching advice
908 ;; - ad-activate-all activates all advised functions
909 ;; - ad-deactivate-all deactivates all advised functions
910 ;; - ad-update-all updates all advised functions
911 ;; - ad-unadvise-all unadvises all advised functions
912 ;; - ad-recover-all recovers all advised functions
914 ;; - ad-compile byte-compiles a function/macro if it is compilable.
918 ;; ad-return-value name of the return value variable (get/settable)
919 ;; ad-subr-args name of &rest argument variable used for advised
922 ;; (ad-get-arg <pos>), (ad-get-args <pos>),
923 ;; (ad-set-arg <pos> <value>), (ad-set-args <pos> <value-list>)
926 ;; ad-arg-bindings text macro that returns the actual names, values
931 ;; `ad-arg-binding-field' (see example above).
932 ;; ad-do-it text macro that identifies the place where the original
942 ;; (ad-start-advice)
965 ;; will be `activate'ed immediately. Advice names are global symbols, hence,
978 ;; (defadvice foo (before fg-add2 first activate)
998 ;; (defadvice foo (before fg-cancel-add2 0 activate)
1014 ;; from now on we'll use `act' instead of the verbose `activate'.
1071 ;; "$ad-doc: foo$"
1073 ;; (let (ad-return-value)
1076 ;; (setq ad-return-value (ad-Orig-foo x))
1077 ;; ad-return-value))
1084 ;; by the original function. The position of the special keyword `ad-do-it'
1094 ;; ad-do-it))
1110 ;; ad-do-it))
1120 ;; "$ad-doc: foo$"
1122 ;; (let (ad-return-value)
1127 ;; (setq ad-return-value (ad-Orig-foo x))))
1128 ;; ad-return-value))
1132 ;; In every `defadvice' so far we have used the flag `activate' to activate
1136 ;; better way to do this is to only activate the last defined advice.
1141 ;; (setq ad-return-value (* ad-return-value x)))
1148 ;; Now we define another advice and activate which will also activate the
1150 ;; `ad-return-value' in the body of the advice which is set to the result of
1156 ;; (setq ad-return-value (* ad-return-value x)))
1203 ;; "$ad-doc: foo$"
1205 ;; (let (ad-return-value)
1211 ;; (setq ad-return-value (ad-Orig-foo x))))
1212 ;; (setq ad-return-value (* ad-return-value x))
1213 ;; (setq ad-return-value (* ad-return-value x)))
1215 ;; ad-return-value))
1221 ;; (`compile' will be ignored unless we also specified `activate'):
1232 ;; "$ad-doc: foo$"
1234 ;; (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6))
1252 ;; (ad-disable-advice 'foo 'after 'fg-times-x)
1255 ;; For this to have an effect we have to activate `foo':
1257 ;; (ad-activate 'foo)
1270 ;; (ad-disable-advice 'foo 'any "^fg-.*times")
1273 ;; (ad-activate 'foo)
1280 ;; To enable the disabled advice we could use either `ad-enable-advice'
1281 ;; similar to `ad-disable-advice', or as an alternative `ad-enable-regexp'
1286 ;; the following will do the trick (`ad-enable-regexp' returns the number
1289 ;; (ad-enable-regexp "^fg-")
1292 ;; The following will activate all currently active advised functions that
1298 ;; (ad-update-regexp "^fg-")
1315 ;; (ad-activate 'foo)
1322 ;; (ad-enable-advice 'foo 'before 'fg-1-more)
1325 ;; (ad-activate 'foo)
1343 ;; (ad-deactivate-regexp "^fg-")
1349 ;; (ad-activate-regexp "^fg-")
1362 ;; `ad-activate-on-definition' to t and restart advice:
1364 ;; (setq ad-activate-on-definition t)
1367 ;; (ad-start-advice)
1368 ;; (ad-activate-defined-function)
1382 ;; `ad-activate-on-definition' was t when we started advice above with
1383 ;; `ad-start-advice'):
1393 ;; Redefinition will activate any available advice if the value of
1394 ;; `ad-redefinition-action' is either `warn', `accept' or `discard':
1429 ;; (setq cached-definition (ad-get-cache-definition 'fie))
1432 ;; (ad-activate 'fie)
1467 ;; (ad-compile-function 'fg-defadvice-fum)
1475 ;; (ad-get-advice-info 'fum)
1487 ;; "$ad-doc: fum$"
1488 ;; (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4))
1498 ;; (ad-unadvise 'fum)
1518 ;; (ad-compiled-p (symbol-function 'fum))
1564 ;; (ad-set-arg 0 (1+ (ad-get-arg 0)))
1565 ;; (ad-set-arg 1 (1+ (ad-get-arg 1)))
1566 ;; (ad-set-arg 2 (1+ (ad-get-arg 2))))
1575 ;; will automatically activate all its advice):
1600 ;; (print (ad-get-args 0)))
1609 ;; (ad-set-args 1 (list (ad-get-arg 2) (ad-get-arg 1))))
1662 ;; This means that Advice has to use `(&rest ad-subr-args)' as the
1673 ;; (ad-arglist (symbol-function 'car))
1674 ;; (&rest ad-subr-args)
1679 ;; (ad-define-subr-args 'car '(list))
1682 ;; Now `ad-arglist' will return the proper argument list (this method is
1685 ;; (ad-arglist (symbol-function 'car))
1692 ;; list if it was successful, otherwise `(&rest ad-subr-args)' will be used.
1709 ;; (my-before-kill-buffer-hook (ad-get-arg 0)))
1719 ;; (my-before-kill-buffer-hook (ad-get-arg 0)))
1732 ;; `ad-return-value' in a piece of after advice. For example:
1762 ;; (ad-remove-advice 'foom 'before 'fg-print-x)
1767 ;; (setq ad-return-value
1769 ;; (, ad-return-value)))))
1802 ;; As a safety measure one should always do `ad-deactivate-all' before
1831 :prefix "ad-"
1835 (defconst ad-version "2.14")
1838 (defcustom ad-redefinition-action 'warn
1853 (defcustom ad-default-compilation-action 'maybe
1860 COMPILE argument of `ad-activate' was supplied as nil."
1872 (defun ad-substitute-tree (sUbTrEe-TeSt fUnCtIoN tReE)
1877 not be considered anymore. (ad-substitute-tree 'atom 'identity tree)
1883 (ad-substitute-tree sUbTrEe-TeSt fUnCtIoN (car tReE))
1885 (ad-substitute-tree sUbTrEe-TeSt fUnCtIoN (cdr tReE))))
1890 ;; this is just faster than `ad-substitute-tree':
1891 (defun ad-copy-tree (tree)
1894 (cons (ad-copy-tree (car tree))
1895 (ad-copy-tree (cdr tree))))
1898 (defmacro ad-dolist (varform &rest body)
1901 (ad-dolist (VAR INIT-FORM [RESULT-FORM])
1907 exited prematurely with `(ad-do-return [VALUE])'."
1909 `(let ((ad-dO-vAr ,(car (cdr varform)))
1911 (while ad-dO-vAr
1912 (setq ,(car varform) (car ad-dO-vAr))
1917 ,'(setq ad-dO-vAr (cdr ad-dO-vAr)))
1921 (ad-substitute-tree
1923 (cond ((eq (car-safe subtree) 'ad-dolist))
1924 ((eq (car-safe subtree) 'ad-do-return)
1928 `(catch 'ad-dO-eXiT ,expansion)
1931 (defmacro ad-do-return (value)
1932 `(throw 'ad-dO-eXiT ,value))
1934 (if (not (get 'ad-dolist 'lisp-indent-hook))
1935 (put 'ad-dolist 'lisp-indent-hook 1))
1944 (defmacro ad-save-real-definition (function)
1945 (let ((saved-function (intern (format "ad-real-%s" function))))
1958 (defun ad-save-real-definitions ()
1962 (ad-save-real-definition fset)
1963 (ad-save-real-definition documentation))
1965 (ad-save-real-definitions)
1986 (defvar ad-advised-functions nil)
1988 (defmacro ad-pushnew-advised-function (function)
1989 "Add FUNCTION to `ad-advised-functions' unless its already there."
1990 `(if (not (assoc (symbol-name ,function) ad-advised-functions))
1991 (setq ad-advised-functions
1993 ad-advised-functions))))
1995 (defmacro ad-pop-advised-function (function)
1996 "Remove FUNCTION from `ad-advised-functions'."
1997 `(setq ad-advised-functions
1998 (delq (assoc (symbol-name ,function) ad-advised-functions)
1999 ad-advised-functions)))
2001 (defmacro ad-do-advised-functions (varform &rest body)
2002 "`ad-dolist'-style iterator that maps over `ad-advised-functions'.
2003 \(ad-do-advised-functions (VAR [RESULT-FORM])
2007 `(ad-dolist (,(car varform)
2008 ad-advised-functions
2013 (if (not (get 'ad-do-advised-functions 'lisp-indent-hook))
2014 (put 'ad-do-advised-functions 'lisp-indent-hook 1))
2016 (defmacro ad-get-advice-info (function)
2017 `(get ,function 'ad-advice-info))
2019 (defmacro ad-set-advice-info (function advice-info)
2020 `(put ,function 'ad-advice-info ,advice-info))
2022 (defmacro ad-copy-advice-info (function)
2023 `(ad-copy-tree (get ,function 'ad-advice-info)))
2025 (defmacro ad-is-advised (function)
2028 (list 'ad-get-advice-info function))
2030 (defun ad-initialize-advice-info (function)
2033 (ad-pushnew-advised-function function)
2034 (ad-set-advice-info function (list (cons 'active nil))))
2036 (defmacro ad-get-advice-info-field (function field)
2038 `(cdr (assq ,field (ad-get-advice-info ,function))))
2040 (defun ad-set-advice-info-field (function field value)
2042 (and (ad-is-advised function)
2043 (cond ((assq field (ad-get-advice-info function))
2045 (rplacd (assq field (ad-get-advice-info function)) value))
2047 (nconc (ad-get-advice-info function)
2051 (defun ad-is-active (function)
2053 (ad-get-advice-info-field function 'active))
2059 (defun ad-make-advice (name protect enable definition)
2066 ;; ad-find-advice uses the alist structure directly ->
2068 (defmacro ad-advice-name (advice)
2070 (defmacro ad-advice-protected (advice)
2072 (defmacro ad-advice-enabled (advice)
2074 (defmacro ad-advice-definition (advice)
2077 (defun ad-advice-set-enabled (advice flag)
2080 (defun ad-class-p (thing)
2081 (memq thing ad-advice-classes))
2082 (defun ad-name-p (thing)
2084 (defun ad-position-p (thing)
2093 (defvar ad-advice-classes '(before around after activation deactivation))
2095 (defun ad-has-enabled-advice (function class)
2097 (ad-dolist (advice (ad-get-advice-info-field function class))
2098 (if (ad-advice-enabled advice) (ad-do-return t))))
2100 (defun ad-has-redefining-advice (function)
2103 (and (ad-is-advised function)
2104 (or (ad-has-enabled-advice function 'before)
2105 (ad-has-enabled-advice function 'around)
2106 (ad-has-enabled-advice function 'after))))
2108 (defun ad-has-any-advice (function)
2110 (and (ad-is-advised function)
2111 (ad-dolist (class ad-advice-classes nil)
2112 (if (ad-get-advice-info-field function class)
2113 (ad-do-return t)))))
2115 (defun ad-get-enabled-advices (function class)
2118 (ad-dolist (advice (ad-get-advice-info-field function class))
2119 (if (ad-advice-enabled advice)
2135 ;; if (get SYM 'ad-advice-info)
2136 ;; ad-activate-internal(SYM, nil)
2140 ;; compiled depends on the value of `ad-default-compilation-action'.
2142 ;; Since calling `ad-activate-internal' in the built-in definition of `fset' can
2144 ;; to provide a dummy definition for `ad-activate-internal' which can be used to
2145 ;; turn off automatic advice activation (e.g., when `ad-stop-advice' or
2146 ;; `ad-recover-normality' are called). Another is to avoid recursive calls
2147 ;; to `ad-activate' by using `ad-with-auto-activation-disabled' where
2150 ;; For now define `ad-activate-internal' to the dummy definition:
2151 (defun ad-activate-internal (function &optional compile)
2152 "Automatic advice activation is disabled. `ad-start-advice' enables it."
2156 (defun ad-activate-internal-off (function &optional compile)
2157 "Automatic advice activation is disabled. `ad-start-advice' enables it."
2160 ;; This will be t for top-level calls to `ad-activate-internal-on':
2161 (defvar ad-activate-on-top-level t)
2163 (defmacro ad-with-auto-activation-disabled (&rest body)
2164 `(let ((ad-activate-on-top-level nil))
2167 (defun ad-safe-fset (symbol definition)
2168 "A safe `fset' which will never call `ad-activate-internal' recursively."
2169 (ad-with-auto-activation-disabled
2170 (ad-real-fset symbol definition)))
2180 ;; we need to use `ad-real-orig-definition'.
2182 (defun ad-make-origname (function)
2184 (intern (format "ad-Orig-%s" function)))
2186 (defmacro ad-get-orig-definition (function)
2187 `(let ((origname (ad-get-advice-info-field ,function 'origname)))
2191 (defmacro ad-set-orig-definition (function definition)
2192 `(ad-safe-fset
2193 (ad-get-advice-info-field function 'origname) ,definition))
2195 (defmacro ad-clear-orig-definition (function)
2196 `(fmakunbound (ad-get-advice-info-field ,function 'origname)))
2202 (defun ad-read-advised-function (&optional prompt predicate default)
2208 (if (null ad-advised-functions)
2209 (error "ad-read-advised-function: There are no advised functions"))
2212 (ad-do-advised-functions (function)
2215 (ad-do-return function)))
2216 (error "ad-read-advised-function: %s"
2218 (let* ((ad-pReDiCaTe predicate)
2222 ad-advised-functions
2229 (funcall ad-pReDiCaTe (intern (car function))))))
2232 (if (ad-is-advised default)
2234 (error "ad-read-advised-function: `%s' is not advised" default))
2237 (defvar ad-advice-class-completion-table
2239 ad-advice-classes))
2241 (defun ad-read-advice-class (function &optional prompt default)
2248 (ad-dolist (class ad-advice-classes)
2249 (if (ad-get-advice-info-field function class)
2250 (ad-do-return class)))
2251 (error "ad-read-advice-class: `%s' has no advices" function)))
2254 ad-advice-class-completion-table nil t)))
2259 (defun ad-read-advice-name (function class &optional prompt)
2264 (list (symbol-name (ad-advice-name advice)))))
2265 (ad-get-advice-info-field function class)))
2268 (error "ad-read-advice-name: `%s' has no %s advice"
2277 (defun ad-read-advice-specification (&optional prompt)
2281 (let* ((function (ad-read-advised-function prompt))
2282 (class (ad-read-advice-class function))
2283 (name (ad-read-advice-name function class)))
2287 (defvar ad-last-regexp "")
2289 (defun ad-read-regexp (&optional prompt)
2293 (if (equal ad-last-regexp "") ": "
2294 (format " (default %s): " ad-last-regexp))))))
2295 (setq ad-last-regexp
2296 (if (equal regexp "") ad-last-regexp regexp))))
2302 (defmacro ad-find-advice (function class name)
2304 `(assq ,name (ad-get-advice-info-field ,function ,class)))
2306 (defun ad-advice-position (function class name)
2308 (let* ((found-advice (ad-find-advice function class name))
2309 (advices (ad-get-advice-info-field function class)))
2313 (defun ad-find-some-advice (function class name)
2317 (if (ad-is-advised function)
2319 (ad-dolist (advice-class ad-advice-classes)
2322 (ad-dolist (advice (ad-get-advice-info-field
2327 (ad-advice-name advice))))
2328 (eq name (ad-advice-name advice)))
2329 (ad-do-return advice)))))
2330 (if found-advice (ad-do-return found-advice))))))
2332 (defun ad-enable-advice-internal (function class name flag)
2339 (if (ad-is-advised function)
2341 (ad-dolist (advice-class ad-advice-classes)
2343 (ad-dolist (advice (ad-get-advice-info-field
2347 name (symbol-name (ad-advice-name advice))))
2348 (eq name (ad-advice-name advice)))
2350 (ad-advice-set-enabled advice flag))))))
2354 (defun ad-enable-advice (function class name)
2356 (interactive (ad-read-advice-specification "Enable advice of"))
2357 (if (ad-is-advised function)
2358 (if (eq (ad-enable-advice-internal function class name t) 0)
2359 (error "ad-enable-advice: `%s' has no %s advice matching `%s'"
2361 (error "ad-enable-advice: `%s' is not advised" function)))
2364 (defun ad-disable-advice (function class name)
2366 (interactive (ad-read-advice-specification "Disable advice of"))
2367 (if (ad-is-advised function)
2368 (if (eq (ad-enable-advice-internal function class name nil) 0)
2369 (error "ad-disable-advice: `%s' has no %s advice matching `%s'"
2371 (error "ad-disable-advice: `%s' is not advised" function)))
2373 (defun ad-enable-regexp-internal (regexp class flag)
2378 (ad-do-advised-functions (advised-function)
2381 (or (ad-enable-advice-internal
2386 (defun ad-enable-regexp (regexp)
2390 (list (ad-read-regexp "Enable advices via regexp")))
2391 (let ((matched-advices (ad-enable-regexp-internal regexp 'any t)))
2396 (defun ad-disable-regexp (regexp)
2400 (list (ad-read-regexp "Disable advices via regexp")))
2401 (let ((matched-advices (ad-enable-regexp-internal regexp 'any nil)))
2406 (defun ad-remove-advice (function class name)
2410 (interactive (ad-read-advice-specification "Remove advice of"))
2411 (if (ad-is-advised function)
2412 (let ((advice-to-remove (ad-find-advice function class name)))
2414 (ad-set-advice-info-field
2416 (delq advice-to-remove (ad-get-advice-info-field function class)))
2417 (error "ad-remove-advice: `%s' has no %s advice `%s'"
2419 (error "ad-remove-advice: `%s' is not advised" function)))
2422 (defun ad-add-advice (function advice class position)
2434 (cond ((not (ad-is-advised function))
2435 (ad-initialize-advice-info function)
2436 (ad-set-advice-info-field
2437 function 'origname (ad-make-origname function))))
2439 (ad-advice-position function class (ad-advice-name advice)))
2440 (advices (ad-get-advice-info-field function class))
2449 (if (memq (ad-advice-name advice) (ad-get-cache-class-id function class))
2450 (ad-clear-cache function))
2454 (ad-set-advice-info-field function class (cons advice advices))
2462 (defmacro ad-macrofy (definition)
2466 (defmacro ad-lambdafy (definition)
2472 (defvar ad-special-forms
2484 (defmacro ad-special-form-p (definition)
2486 (list 'memq definition 'ad-special-forms))
2488 (defmacro ad-interactive-p (definition)
2492 (defmacro ad-subr-p (definition)
2496 (defmacro ad-macro-p (definition)
2500 (defmacro ad-lambda-p (definition)
2504 ;; see ad-make-advice for the format of advice definitions:
2505 (defmacro ad-advice-p (definition)
2513 (ad-safe-fset 'byte-code-function-p 'compiled-function-p))
2515 (defmacro ad-compiled-p (definition)
2518 (and (ad-macro-p ,definition)
2519 (byte-code-function-p (ad-lambdafy ,definition)))))
2521 (defmacro ad-compiled-code (compiled-definition)
2523 `(if (ad-macro-p ,compiled-definition)
2524 (ad-lambdafy ,compiled-definition)
2527 (defun ad-lambda-expression (definition)
2529 (cond ((ad-lambda-p definition)
2531 ((ad-macro-p definition)
2532 (ad-lambdafy definition))
2533 ((ad-advice-p definition)
2537 (defun ad-arglist (definition &optional name)
2541 (cond ((ad-compiled-p definition)
2542 (aref (ad-compiled-code definition) 0))
2544 (car (cdr (ad-lambda-expression definition))))
2545 ((ad-subr-p definition)
2547 (ad-subr-arglist name)
2551 (ad-subr-arglist (intern (match-string 1 name)))))))
2555 (defmacro ad-define-subr-args (subr arglist)
2556 `(put ,subr 'ad-subr-arglist (list ,arglist)))
2557 (defmacro ad-undefine-subr-args (subr)
2558 `(put ,subr 'ad-subr-arglist nil))
2559 (defmacro ad-subr-args-defined-p (subr)
2560 `(get ,subr 'ad-subr-arglist))
2561 (defmacro ad-get-subr-args (subr)
2562 `(car (get ,subr 'ad-subr-arglist)))
2564 (defun ad-subr-arglist (subr-name)
2566 Either use the one stored under the `ad-subr-arglist' property,
2568 that property, or otherwise use `(&rest ad-subr-args)'."
2569 (if (ad-subr-args-defined-p subr-name)
2570 (ad-get-subr-args subr-name)
2583 (let ((doc (or (ad-real-documentation subr-name t) "")))
2588 '(&rest ad-subr-args)
2589 (ad-define-subr-args
2593 (ad-get-subr-args subr-name)))))
2595 (defun ad-docstring (definition)
2598 (if (ad-compiled-p definition)
2599 (ad-real-documentation definition t)
2600 (car (cdr (cdr (ad-lambda-expression definition)))))))
2605 (defun ad-interactive-form (definition)
2607 (cond ((ad-compiled-p definition)
2609 (list 'interactive (aref (ad-compiled-code definition) 5))))
2610 ((or (ad-advice-p definition)
2611 (ad-lambda-p definition))
2612 (commandp (ad-lambda-expression definition)))))
2614 (defun ad-body-forms (definition)
2616 (cond ((ad-compiled-p definition)
2619 (nthcdr (+ (if (ad-docstring definition) 1 0)
2620 (if (ad-interactive-form definition) 1 0))
2621 (cdr (cdr (ad-lambda-expression definition)))))))
2625 (defvar ad-advised-definition-docstring-regexp "^\\$ad-doc: \\(.+\\)\\$$")
2627 (defun ad-make-advised-definition-docstring (function)
2633 (format "$ad-doc: %s$" (prin1-to-string function)))
2635 (defun ad-advised-definition-p (definition)
2637 (if (or (ad-lambda-p definition)
2638 (ad-macro-p definition)
2639 (ad-compiled-p definition))
2640 (let ((docstring (ad-docstring definition)))
2643 ad-advised-definition-docstring-regexp docstring)))))
2645 (defun ad-definition-type (definition)
2647 (if (ad-macro-p definition)
2649 (if (ad-subr-p definition)
2650 (if (ad-special-form-p definition)
2653 (if (or (ad-lambda-p definition)
2654 (ad-compiled-p definition))
2656 (if (ad-advice-p definition)
2659 (defun ad-has-proper-definition (function)
2668 (defun ad-real-definition (function)
2670 (if (ad-has-proper-definition function)
2673 (ad-real-definition definition)
2676 (defun ad-real-orig-definition (function)
2678 (if (ad-is-advised function)
2679 (ad-real-definition (ad-get-advice-info-field function 'origname))))
2681 (defun ad-is-compilable (function)
2683 (and (ad-has-proper-definition function)
2684 (or (ad-lambda-p (symbol-function function))
2685 (ad-macro-p (symbol-function function)))
2686 (not (ad-compiled-p (symbol-function function)))))
2688 (defun ad-compile-function (function)
2691 (if (ad-is-compilable function)
2694 (ad-with-auto-activation-disabled
2719 ;; a unique symbol `ad-Orig-<name>' which is fbound to the original
2722 ;; `(ad-Orig-<name> ....)' form. If they have a &rest argument we have to
2724 ;; `(macroexpand '(ad-Orig-<name> ....))', and special forms also need a
2728 ;; Use original arguments where possible and `(&rest ad-subr-args)'
2737 (defun ad-prognify (forms)
2745 (defun ad-parse-arglist (arglist)
2759 (defun ad-retrieve-args-form (arglist)
2766 (let* ((parsed-arglist (ad-parse-arglist arglist))
2779 (defun ad-arg-binding-field (binding field)
2784 (defun ad-list-access (position list)
2789 (defun ad-element-access (position list)
2794 (defun ad-access-argument (arglist index)
2798 (let* ((parsed-arglist (ad-parse-arglist arglist))
2807 (defun ad-get-argument (arglist index)
2809 (let ((argument-access (ad-access-argument arglist index)))
2811 (ad-element-access
2815 (defun ad-set-argument (arglist index value-form)
2817 (let ((argument-access (ad-access-argument arglist index)))
2820 `(setcar ,(ad-list-access
2825 (t (error "ad-set-argument: No argument at position %d of `%s'"
2828 (defun ad-get-arguments (arglist index)
2830 (let* ((parsed-arglist (ad-parse-arglist arglist))
2840 (setq args-form (ad-list-access (- index (length reqopt-args))
2844 (defun ad-set-arguments (arglist index values-form)
2849 (while (setq argument-access (ad-access-argument arglist index))
2852 (cons (ad-set-argument
2854 (ad-element-access values-index 'ad-vAlUeS))
2860 (ad-list-access values-index 'ad-vAlUeS))
2862 (ad-list-access (1- (car argument-access))
2864 (ad-list-access values-index 'ad-vAlUeS)))
2871 (error "ad-set-arguments: No argument at position %d of `%s'"
2875 (ad-substitute-tree
2876 (function (lambda (form) (eq form 'ad-vAlUeS)))
2880 `(let ((ad-vAlUeS ,values-form))
2883 ,'ad-vAlUeS)))))
2885 (defun ad-insert-argument-access-forms (definition arglist)
2887 (ad-substitute-tree
2890 (or (eq form 'ad-arg-bindings)
2892 '(ad-get-arg ad-get-args ad-set-arg ad-set-args))
2896 (if (eq form 'ad-arg-bindings)
2897 (ad-retrieve-args-form arglist)
2900 (val (car (cdr (ad-insert-argument-access-forms
2902 (cond ((eq accessor 'ad-get-arg)
2903 (ad-get-argument arglist index))
2904 ((eq accessor 'ad-set-arg)
2905 (ad-set-argument arglist index val))
2906 ((eq accessor 'ad-get-args)
2907 (ad-get-arguments arglist index))
2908 ((eq accessor 'ad-set-args)
2909 (ad-set-arguments arglist index val)))))))
2921 (defun ad-map-arglists (source-arglist target-arglist)
2928 Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
2930 (let* ((parsed-source-arglist (ad-parse-arglist source-arglist))
2934 (parsed-target-arglist (ad-parse-arglist target-arglist))
2950 (ad-get-argument
2959 (defun ad-make-mapped-call (source-arglist target-arglist target-function)
2961 (let ((mapped-form (ad-map-arglists source-arglist target-arglist)))
2978 (defun ad-make-single-advice-docstring (advice class &optional style)
2979 (let ((advice-docstring (ad-docstring (ad-advice-definition advice))))
2984 class (ad-advice-name advice)
2990 (ad-advice-name advice)
2994 (ad-advice-name advice)))))))
2998 (defun ad-make-advised-docstring (function &optional style)
3006 (let* ((origdef (ad-real-orig-definition function))
3007 (origtype (symbol-name (ad-definition-type origdef)))
3010 (ad-real-documentation origdef t))
3012 paragraphs advice-docstring ad-usage)
3017 (ad-dolist (class ad-advice-classes)
3018 (ad-dolist (advice (ad-get-enabled-advices function class))
3020 (ad-make-single-advice-docstring advice class style))
3028 (defun ad-make-plain-docstring (function)
3029 (ad-make-advised-docstring function 'plain))
3030 (defun ad-make-freeze-docstring (function)
3031 (ad-make-advised-docstring function 'freeze))
3036 (defun ad-advised-arglist (function)
3038 (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
3039 (ad-get-enabled-advices function 'around)
3040 (ad-get-enabled-advices function 'after)))
3041 (let ((arglist (ad-arglist (ad-advice-definition advice))))
3044 (ad-do-return arglist)))))
3046 (defun ad-advised-interactive-form (function)
3048 (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
3049 (ad-get-enabled-advices function 'around)
3050 (ad-get-enabled-advices function 'after)))
3052 (ad-interactive-form (ad-advice-definition advice))))
3055 (ad-do-return interactive-form)))))
3060 (defun ad-make-advised-definition (function)
3062 (if (and (ad-is-advised function)
3063 (ad-has-redefining-advice function))
3064 (let* ((origdef (ad-real-orig-definition function))
3065 (origname (ad-get-advice-info-field function 'origname))
3066 (orig-interactive-p (ad-interactive-p origdef))
3067 (orig-subr-p (ad-subr-p origdef))
3068 (orig-special-form-p (ad-special-form-p origdef))
3069 (orig-macro-p (ad-macro-p origdef))
3071 (orig-arglist (ad-arglist origdef function))
3072 (advised-arglist (or (ad-advised-arglist function)
3074 (advised-interactive-form (ad-advised-interactive-form function))
3078 ((ad-interactive-form origdef)
3081 (ad-interactive-form origdef)))
3096 ;; evaluate the expansion (the value of `ad-return-value')
3105 ,(ad-get-arguments advised-arglist 0))))
3114 ,(ad-make-mapped-call advised-arglist
3119 (t (ad-make-mapped-call
3123 (ad-assemble-advised-definition
3128 (ad-make-advised-definition-docstring function)
3131 (ad-get-enabled-advices function 'before)
3132 (ad-get-enabled-advices function 'around)
3133 (ad-get-enabled-advices function 'after)))))
3135 (defun ad-assemble-advised-definition
3148 (ad-dolist (advice befores)
3149 (cond ((and (ad-advice-protected advice)
3153 ,(ad-prognify before-forms)
3154 ,@(ad-body-forms
3155 (ad-advice-definition advice))))))
3158 (ad-body-forms (ad-advice-definition advice)))))))
3160 (setq around-form `(setq ad-return-value ,orig))
3161 (ad-dolist (advice (reverse arounds))
3164 (if (ad-advice-protected advice)
3167 (ad-substitute-tree
3168 (function (lambda (form) (eq form 'ad-do-it)))
3170 (ad-prognify (ad-body-forms (ad-advice-definition advice))))))
3175 ,(ad-prognify before-forms)
3178 (ad-dolist (advice afters)
3179 (cond ((and (ad-advice-protected advice)
3183 ,(ad-prognify after-forms)
3184 ,@(ad-body-forms
3185 (ad-advice-definition advice))))))
3188 (ad-body-forms (ad-advice-definition advice)))))))
3196 (let (ad-return-value)
3199 '(list 'quote ad-return-value)
3200 'ad-return-value))))
3202 (ad-insert-argument-access-forms definition args)))
3205 (defun ad-make-hook-form (function hook-name)
3209 (ad-body-forms (ad-advice-definition advice))))
3210 (ad-get-enabled-advices function hook-name))))
3212 (ad-prognify (apply 'append hook-forms)))))
3250 ;; Cases A and B are the normal ones. A is taken care of by `ad-add-advice'
3275 (defmacro ad-get-cache-definition (function)
3276 `(car (ad-get-advice-info-field ,function 'cache)))
3278 (defmacro ad-get-cache-id (function)
3279 `(cdr (ad-get-advice-info-field ,function 'cache)))
3281 (defmacro ad-set-cache (function definition id)
3282 `(ad-set-advice-info-field
3285 (defun ad-clear-cache (function)
3287 Clear the cache if you want to force `ad-activate' to construct a new
3290 (list (ad-read-advised-function "Clear cached definition of")))
3291 (ad-set-advice-info-field function 'cache nil))
3293 (defun ad-make-cache-id (function)
3295 (let ((original-definition (ad-real-orig-definition function))
3296 (cached-definition (ad-get-cache-definition function)))
3297 (list (mapcar (function (lambda (advice) (ad-advice-name advice)))
3298 (ad-get-enabled-advices function 'before))
3299 (mapcar (function (lambda (advice) (ad-advice-name advice)))
3300 (ad-get-enabled-advices function 'around))
3301 (mapcar (function (lambda (advice) (ad-advice-name advice)))
3302 (ad-get-enabled-advices function 'after))
3303 (ad-definition-type original-definition)
3304 (if (equal (ad-arglist original-definition function)
3305 (ad-arglist cached-definition))
3307 (ad-arglist original-definition function))
3308 (if (eq (ad-definition-type original-definition) 'function)
3309 (equal (ad-interactive-form original-definition)
3310 (ad-interactive-form cached-definition))))))
3312 (defun ad-get-cache-class-id (function class)
3314 (let ((cache-id (ad-get-cache-id function)))
3321 (defun ad-verify-cache-class-id (cache-class-id advices)
3322 (ad-dolist (advice advices (null cache-class-id))
3323 (if (ad-advice-enabled advice)
3324 (if (eq (car cache-class-id) (ad-advice-name advice))
3326 (ad-do-return nil)))))
3331 ;; `ad-cache-id-verification-code'. The code it returns indicates where the
3332 ;; verification failed. Tracing `ad-verify-cache-class-id' might provide
3335 (defun ad-cache-id-verification-code (function)
3336 (let ((cache-id (ad-get-cache-id function))
3338 (and (ad-verify-cache-class-id
3339 (car cache-id) (ad-get-advice-info-field function 'before))
3341 (ad-verify-cache-class-id
3342 (nth 1 cache-id) (ad-get-advice-info-field function 'around))
3344 (ad-verify-cache-class-id
3345 (nth 2 cache-id) (ad-get-advice-info-field function 'after))
3347 (let ((original-definition (ad-real-orig-definition function))
3348 (cached-definition (ad-get-cache-definition function)))
3349 (and (eq (nth 3 cache-id) (ad-definition-type original-definition))
3352 (ad-arglist original-definition function)
3354 (ad-arglist cached-definition))
3357 (equal (ad-interactive-form original-definition)
3358 (ad-interactive-form cached-definition)))
3362 (defun ad-verify-cache-id (function)
3364 (eq (ad-cache-id-verification-code function) 'verified))
3390 (defun ad-preactivate-advice (function advice class position)
3396 (old-advice-info (ad-copy-advice-info function))
3397 (ad-advised-functions ad-advised-functions))
3400 (ad-add-advice function advice class position)
3401 (ad-enable-advice function class (ad-advice-name advice))
3402 (ad-clear-cache function)
3403 (ad-activate function -1)
3404 (if (and (ad-is-active function)
3405 (ad-get-cache-definition function))
3406 (list (ad-get-cache-definition function)
3407 (ad-get-cache-id function))))
3408 (ad-set-advice-info function old-advice-info)
3411 (ad-safe-fset function old-definition)
3437 (defun ad-make-freeze-definition (function advice class position)
3438 (if (not (ad-has-proper-definition function))
3440 "ad-make-freeze-definition: `%s' is not yet defined"
3442 (let* ((name (ad-advice-name advice))
3446 (intern (format "%s-%s-%s" (ad-make-origname function) class name)))
3450 (or (ad-get-orig-definition function)
3453 (if (ad-is-advised function)
3454 (ad-copy-advice-info function)))
3456 (symbol-function 'ad-make-advised-definition-docstring))
3458 (symbol-function 'ad-make-origname))
3463 (ad-safe-fset 'ad-make-advised-definition-docstring
3464 'ad-make-freeze-docstring)
3466 (ad-safe-fset 'ad-make-origname (lambda (x) unique-origname))
3470 (ad-set-advice-info function nil)
3471 (ad-add-advice function advice class position)
3474 (ad-set-orig-definition function orig-definition)
3475 (ad-make-advised-definition function))
3477 (ad-set-advice-info function old-advice-info)
3479 (ad-safe-fset
3480 'ad-make-advised-definition-docstring real-docstring-fn)
3481 (ad-safe-fset 'ad-make-origname real-origname-fn))))
3483 (let* ((macro-p (ad-macro-p frozen-definition))
3485 (ad-lambdafy frozen-definition)
3492 (or (ad-get-orig-definition ',function)
3502 (defun ad-should-compile (function compile)
3507 `ad-default-compilation-action' (which see)."
3512 (cond ((eq ad-default-compilation-action 'never)
3514 ((eq ad-default-compilation-action 'always)
3516 ((eq ad-default-compilation-action 'like-original)
3517 (or (ad-subr-p (ad-get-orig-definition function))
3518 (ad-compiled-p (ad-get-orig-definition function))))
3522 (defun ad-activate-advised-definition (function compile)
3524 The resulting FUNCTION will be compiled if `ad-should-compile' returns t.
3527 (if (ad-verify-cache-id function)
3528 (ad-get-cache-definition function))))
3529 (ad-safe-fset function
3531 (ad-make-advised-definition function)))
3532 (if (ad-should-compile function compile)
3533 (ad-compile-function function))
3537 (ad-set-cache
3538 function (symbol-function function) (ad-get-cache-id function)))
3540 (ad-clear-cache function)
3541 ;; ad-make-cache-id needs the new cached definition:
3542 (ad-set-cache function (symbol-function function) nil)
3543 (ad-set-cache
3544 function (symbol-function function) (ad-make-cache-id function)))))
3546 (defun ad-handle-definition (function)
3552 the action taken depends on the value of `ad-redefinition-action' (which
3556 the value of `ad-redefinition-action' and de/activate again."
3557 (let ((original-definition (ad-get-orig-definition function))
3558 (current-definition (if (ad-real-definition function)
3565 (not (ad-advised-definition-p current-definition)))
3567 (if (not (memq ad-redefinition-action '(accept discard warn)))
3568 (error "ad-handle-definition (see its doc): `%s' %s"
3570 (if (eq ad-redefinition-action 'discard)
3571 (ad-safe-fset function original-definition)
3572 (ad-set-orig-definition function current-definition)
3573 (if (eq ad-redefinition-action 'warn)
3574 (message "ad-handle-definition: `%s' got redefined"
3582 (ad-set-orig-definition function current-definition)
3591 (defun ad-activate (function &optional compile)
3601 on the value of `ad-default-compilation-action' (which see).
3603 pieces of advice is equivalent to a call to `ad-unadvise'. Activation of
3605 enabled is equivalent to a call to `ad-deactivate'. The current advised
3608 (list (ad-read-advised-function "Activate advice of")
3610 (if ad-activate-on-top-level
3611 ;; avoid recursive calls to `ad-activate':
3612 (ad-with-auto-activation-disabled
3613 (if (not (ad-is-advised function))
3614 (error "ad-activate: `%s' is not advised" function)
3615 (ad-handle-definition function)
3617 (if (ad-get-orig-definition function)
3618 (if (not (ad-has-any-advice function))
3619 (ad-unadvise function)
3620 ;; Otherwise activate the advice:
3621 (cond ((ad-has-redefining-advice function)
3622 (ad-activate-advised-definition function compile)
3623 (ad-set-advice-info-field function 'active t)
3624 (eval (ad-make-hook-form function 'activation))
3627 (t (ad-deactivate function)))))))))
3629 (defalias 'ad-activate-on 'ad-activate)
3631 (defun ad-deactivate (function)
3636 a call to `ad-activate'."
3638 (list (ad-read-advised-function "Deactivate advice of" 'ad-is-active)))
3639 (if (not (ad-is-advised function))
3640 (error "ad-deactivate: `%s' is not advised" function)
3641 (cond ((ad-is-active function)
3642 (ad-handle-definition function)
3643 (if (not (ad-get-orig-definition function))
3644 (error "ad-deactivate: `%s' has no original definition"
3646 (ad-safe-fset function (ad-get-orig-definition function))
3647 (ad-set-advice-info-field function 'active nil)
3648 (eval (ad-make-hook-form function 'deactivation))
3651 (defun ad-update (function &optional compile)
3653 See `ad-activate' for documentation on the optional COMPILE argument."
3655 (list (ad-read-advised-function
3656 "Update advised definition of" 'ad-is-active)))
3657 (if (ad-is-active function)
3658 (ad-activate function compile)))
3660 (defun ad-unadvise (function)
3664 (list (ad-read-advised-function "Unadvise function")))
3665 (cond ((ad-is-advised function)
3666 (if (ad-is-active function)
3667 (ad-deactivate function))
3668 (ad-clear-orig-definition function)
3669 (ad-set-advice-info function nil)
3670 (ad-pop-advised-function function))))
3672 (defun ad-recover (function)
3674 This is more low-level than `ad-unadvise' in that it does not do
3682 (cond ((ad-is-advised function)
3683 (cond ((ad-get-orig-definition function)
3684 (ad-safe-fset function (ad-get-orig-definition function))
3685 (ad-clear-orig-definition function)))
3686 (ad-set-advice-info function nil)
3687 (ad-pop-advised-function function))))
3689 (defun ad-activate-regexp (regexp &optional compile)
3693 See `ad-activate' for documentation on the optional COMPILE argument."
3695 (list (ad-read-regexp "Activate via advice regexp")
3697 (ad-do-advised-functions (function)
3698 (if (ad-find-some-advice function 'any regexp)
3699 (ad-activate function compile))))
3701 (defun ad-deactivate-regexp (regexp)
3706 (list (ad-read-regexp "Deactivate via advice regexp")))
3707 (ad-do-advised-functions (function)
3708 (if (ad-find-some-advice function 'any regexp)
3709 (ad-deactivate function))))
3711 (defun ad-update-regexp (regexp &optional compile)
3715 See `ad-activate' for documentation on the optional COMPILE argument."
3717 (list (ad-read-regexp "Update via advice regexp")
3719 (ad-do-advised-functions (function)
3720 (if (ad-find-some-advice function 'any regexp)
3721 (ad-update function compile))))
3723 (defun ad-activate-all (&optional compile)
3725 See `ad-activate' for documentation on the optional COMPILE argument."
3727 (ad-do-advised-functions (function)
3728 (ad-activate function compile)))
3730 (defun ad-deactivate-all ()
3733 (ad-do-advised-functions (function)
3734 (ad-deactivate function)))
3736 (defun ad-update-all (&optional compile)
3740 (ad-do-advised-functions (function)
3741 (ad-update function compile)))
3743 (defun ad-unadvise-all ()
3746 (ad-do-advised-functions (function)
3747 (ad-unadvise function)))
3749 (defun ad-recover-all ()
3753 This is more low-level than `ad-unadvise' in that it does not do
3756 (ad-do-advised-functions (function)
3758 (ad-recover function)
3763 (defvar ad-defadvice-flags
3764 '(("protect") ("disable") ("activate")
3780 see also `ad-add-advice'.
3784 FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'.
3796 `activate': All advice of FUNCTION will be activated immediately if
3799 `compile': In conjunction with `activate' specifies that the resulting
3813 the advised function. `freeze' implies `activate' and `preactivate'. The
3819 (if (not (ad-name-p function))
3822 (name (if (not (ad-class-p class))
3825 (position (if (not (ad-name-p name))
3828 (if (ad-position-p (car args))
3839 (try-completion (symbol-name flag) ad-defadvice-flags)))
3841 ((assoc completion ad-defadvice-flags)
3846 (advice (ad-make-advice
3851 (ad-preactivate-advice
3857 (ad-make-freeze-definition function advice class position)
3860 (ad-add-advice ',function ',advice ',class ',position)
3862 `((ad-set-cache
3865 ,(cond ((ad-macro-p (car preactivation))
3866 `(ad-macrofy
3868 ,(ad-lambdafy
3873 ,@(if (memq 'activate flags)
3874 `((ad-activate ',function
3882 (defmacro ad-with-originals (functions &rest body)
3893 (list (intern (format "ad-oRiGdEf-%d" index))
3907 `(ad-safe-fset
3909 (or (ad-get-orig-definition ',function)
3921 `(ad-safe-fset
3926 (if (not (get 'ad-with-originals 'lisp-indent-hook))
3927 (put 'ad-with-originals 'lisp-indent-hook 1))
3937 (ad-define-subr-args 'documentation '(function &optional raw))
3939 (defadvice documentation (after ad-advised-docstring first disable preact)
3943 (if (and (stringp ad-return-value)
3945 ad-advised-definition-docstring-regexp ad-return-value))
3948 ad-return-value (match-beginning 1) (match-end 1)))))
3949 (cond ((ad-is-advised function)
3950 (setq ad-return-value (ad-make-advised-docstring function))
3952 (if (not (ad-get-arg 1))
3953 (setq ad-return-value
3954 (substitute-command-keys ad-return-value))))))))
3960 (defun ad-start-advice ()
3963 ;; Advising `ad-activate-internal' means death!!
3964 (ad-set-advice-info 'ad-activate-internal nil)
3965 (ad-safe-fset 'ad-activate-internal 'ad-activate)
3966 (ad-enable-advice 'documentation 'after 'ad-advised-docstring)
3967 (ad-activate 'documentation 'compile))
3969 (defun ad-stop-advice ()
3973 ;; Advising `ad-activate-internal' means death!!
3974 (ad-set-advice-info 'ad-activate-internal nil)
3975 (ad-disable-advice 'documentation 'after 'ad-advised-docstring)
3976 (ad-update 'documentation)
3977 (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off))
3979 (defun ad-recover-normality ()
3983 ;; Advising `ad-activate-internal' means death!!
3984 (ad-set-advice-info 'ad-activate-internal nil)
3985 (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off)
3986 (ad-recover-all)
3987 (setq ad-advised-functions nil))
3989 (ad-start-advice)