aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDave Love1999-10-27 11:59:45 +0000
committerDave Love1999-10-27 11:59:45 +0000
commitfce4437307ab8004a8d4e818d0e5897fc0d27cc9 (patch)
treef1b81b792462943bf42b36ece135a3608c07f02c
parent6b5c0a2e942d1ec1560c5a3a591d1c44034ea203 (diff)
downloademacs-fce4437307ab8004a8d4e818d0e5897fc0d27cc9.tar.gz
emacs-fce4437307ab8004a8d4e818d0e5897fc0d27cc9.zip
Doc fixes.
(ad-lemacs-p): Removed. (advice): Add :link to defgroup.
-rw-r--r--lisp/ChangeLog6
-rw-r--r--lisp/emacs-lisp/advice.el440
2 files changed, 221 insertions, 225 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index edfa5da9b9e..402b45aada9 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
11999-10-27 Dave Love <fx@gnu.org>
2
3 * emacs-lisp/advice.el: Doc fixes.
4 (ad-lemacs-p): Removed.
5 (advice): Add :link to defgroup.
6
11999-10-27 Kenichi Handa <handa@etl.go.jp> 71999-10-27 Kenichi Handa <handa@etl.go.jp>
2 8
3 * ange-ftp.el (ange-ftp-insert-file-contents): Don't change 9 * ange-ftp.el (ange-ftp-insert-file-contents): Don't change
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index df0a68d1543..4a4a7f9e18c 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -34,18 +34,18 @@
34 34
35;; NOTE: This documentation is slightly out of date. In particular, all the 35;; NOTE: This documentation is slightly out of date. In particular, all the
36;; references to Emacs-18 are obsolete now, because it is not any longer 36;; references to Emacs-18 are obsolete now, because it is not any longer
37;; supported by this version of Advice. An up-to-date version will soon be 37;; supported by this version of Advice.
38;; available as an info file (thanks to the kind help of Jack Vinson and 38
39;; David M. Smith). 39;; Advice is documented in the Emacs Lisp Manual.
40 40
41;; @ Introduction: 41;; @ Introduction:
42;; =============== 42;; ===============
43;; This package implements a full-fledged Lisp-style advice mechanism 43;; This package implements a full-fledged Lisp-style advice mechanism
44;; for Emacs Lisp. Advice is a clean and efficient way to modify the 44;; for Emacs Lisp. Advice is a clean and efficient way to modify the
45;; behavior of Emacs Lisp functions without having to keep personal 45;; behavior of Emacs Lisp functions without having to keep personal
46;; modified copies of such functions around. A great number of such 46;; modified copies of such functions around. A great number of such
47;; modifications can be achieved by treating the original function as a 47;; modifications can be achieved by treating the original function as a
48;; black box and specifying a different execution environment for it 48;; black box and specifying a different execution environment for it
49;; with a piece of advice. Think of a piece of advice as a kind of fancy 49;; with a piece of advice. Think of a piece of advice as a kind of fancy
50;; hook that you can attach to any function/macro/subr. 50;; hook that you can attach to any function/macro/subr.
51 51
@@ -57,7 +57,7 @@
57;; the binding environment in which it will be executed, as well as the 57;; the binding environment in which it will be executed, as well as the
58;; value it will return. 58;; value it will return.
59;; - Allows re/definition of interactive behavior for functions and subrs 59;; - Allows re/definition of interactive behavior for functions and subrs
60;; - Every piece of advice can have its documentation string which will be 60;; - Every piece of advice can have its documentation string which will be
61;; combined with the original documentation of the advised function at 61;; combined with the original documentation of the advised function at
62;; call-time of `documentation' for proper command-key substitution. 62;; call-time of `documentation' for proper command-key substitution.
63;; - The execution of every piece of advice can be protected against error 63;; - The execution of every piece of advice can be protected against error
@@ -71,7 +71,7 @@
71;; - Separation of advice definition and activation 71;; - Separation of advice definition and activation
72;; - Forward advice is possible, that is 72;; - Forward advice is possible, that is
73;; as yet undefined or autoload functions can be advised without having to 73;; as yet undefined or autoload functions can be advised without having to
74;; preload the file in which they are defined. 74;; preload the file in which they are defined.
75;; - Forward redefinition is possible because around advice can be used to 75;; - Forward redefinition is possible because around advice can be used to
76;; completely redefine a function. 76;; completely redefine a function.
77;; - A caching mechanism for advised definition provides for cheap deactivation 77;; - A caching mechanism for advised definition provides for cheap deactivation
@@ -81,13 +81,13 @@
81;; the advice mechanism. 81;; the advice mechanism.
82;; - En/disablement mechanism allows the use of different "views" of advised 82;; - En/disablement mechanism allows the use of different "views" of advised
83;; functions depending on what pieces of advice are currently en/disabled 83;; functions depending on what pieces of advice are currently en/disabled
84;; - Provides manipulation mechanisms for sets of advised functions via 84;; - Provides manipulation mechanisms for sets of advised functions via
85;; regular expressions that match advice names 85;; regular expressions that match advice names
86 86
87;; @ How to get Advice for Emacs-18: 87;; @ How to get Advice for Emacs-18:
88;; ================================= 88;; =================================
89;; `advice18.el', a version of Advice that also works in Emacs-18 is available 89;; `advice18.el', a version of Advice that also works in Emacs-18 is available
90;; either via anonymous ftp from `ftp.cs.buffalo.edu (128.205.32.9)' with 90;; either via anonymous ftp from `ftp.cs.buffalo.edu (128.205.32.9)' with
91;; pathname `/pub/Emacs/advice18.el', or from one of the Emacs Lisp archive 91;; pathname `/pub/Emacs/advice18.el', or from one of the Emacs Lisp archive
92;; sites, or send email to <hans@cs.buffalo.edu> and I'll mail it to you. 92;; sites, or send email to <hans@cs.buffalo.edu> and I'll mail it to you.
93 93
@@ -118,8 +118,8 @@
118;; - Advised functions/macros/subrs will only exhibit their advised behavior 118;; - Advised functions/macros/subrs will only exhibit their advised behavior
119;; when they are invoked via their function cell. This means that advice will 119;; when they are invoked via their function cell. This means that advice will
120;; not work for the following: 120;; not work for the following:
121;; + advised subrs that are called directly from other subrs or C-code 121;; + advised subrs that are called directly from other subrs or C-code
122;; + advised subrs that got replaced with their byte-code during 122;; + advised subrs that got replaced with their byte-code during
123;; byte-compilation (e.g., car) 123;; byte-compilation (e.g., car)
124;; + advised macros which were expanded during byte-compilation before 124;; + advised macros which were expanded during byte-compilation before
125;; their advice was activated. 125;; their advice was activated.
@@ -171,7 +171,7 @@
171;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before 171;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before
172;; you byte-compile a file, because advised special forms and macros can lead 172;; you byte-compile a file, because advised special forms and macros can lead
173;; to unwanted compilation results. When you are done compiling use 173;; to unwanted compilation results. When you are done compiling use
174;; `M-x ad-activate-all' to go back to the advised state of all your 174;; `M-x ad-activate-all' to go back to the advised state of all your
175;; advised functions. 175;; advised functions.
176 176
177;; RELAX: Advice is pretty safe even if you are oblivious to the above. 177;; RELAX: Advice is pretty safe even if you are oblivious to the above.
@@ -198,10 +198,10 @@
198;; is just a joke: 198;; is just a joke:
199 199
200;;(defadvice switch-to-buffer (before existing-buffers-only activate) 200;;(defadvice switch-to-buffer (before existing-buffers-only activate)
201;; "When called interactively switch to existing buffers only, unless 201;; "When called interactively switch to existing buffers only, unless
202;;when called with a prefix argument." 202;;when called with a prefix argument."
203;; (interactive 203;; (interactive
204;; (list (read-buffer "Switch to buffer: " (other-buffer) 204;; (list (read-buffer "Switch to buffer: " (other-buffer)
205;; (null current-prefix-arg))))) 205;; (null current-prefix-arg)))))
206;; 206;;
207;;(defadvice switch-to-buffer (around confirm-non-existing-buffers activate) 207;;(defadvice switch-to-buffer (around confirm-non-existing-buffers activate)
@@ -235,7 +235,7 @@
235;; - v18: Any Emacs with major version 18 or built as an extension to that 235;; - v18: Any Emacs with major version 18 or built as an extension to that
236;; (such as Epoch) 236;; (such as Epoch)
237;; - v19: Any Emacs with major version 19 237;; - v19: Any Emacs with major version 19
238;; - jwz: Jamie Zawinski - keeper of Lemacs and creator of the optimizing 238;; - jwz: Jamie Zawinski - former keeper of Lemacs and creator of the optimizing
239;; byte-compiler used in v19s. 239;; byte-compiler used in v19s.
240;; - Advice: The name of this package. 240;; - Advice: The name of this package.
241;; - advices: Short for "pieces of advice". 241;; - advices: Short for "pieces of advice".
@@ -283,7 +283,7 @@
283;; advice. All flags can be specified with unambiguous initial substrings. 283;; advice. All flags can be specified with unambiguous initial substrings.
284;; `activate': Specifies that the advice information of the advised 284;; `activate': Specifies that the advice information of the advised
285;; function should be activated right after this advice has been 285;; function should be activated right after this advice has been
286;; defined. In forward advices `activate' will be ignored. 286;; defined. In forward advices `activate' will be ignored.
287;; `protect': Specifies that this advice should be protected against 287;; `protect': Specifies that this advice should be protected against
288;; non-local exits and errors in preceding code/advices. 288;; non-local exits and errors in preceding code/advices.
289;; `compile': Specifies that the advised function should be byte-compiled. 289;; `compile': Specifies that the advised function should be byte-compiled.
@@ -310,7 +310,7 @@
310 310
311;; A possibly empty list of <body-forms> specifies the body of the advice in 311;; A possibly empty list of <body-forms> specifies the body of the advice in
312;; an implicit progn. The body of an advice can access/change arguments, 312;; an implicit progn. The body of an advice can access/change arguments,
313;; the return value, the binding environment, and can have all sorts of 313;; the return value, the binding environment, and can have all sorts of
314;; other side effects. 314;; other side effects.
315 315
316;; @@ Assembling advised definitions: 316;; @@ Assembling advised definitions:
@@ -376,7 +376,7 @@
376;; keyword `ad-do-it', which will be substituted with a `progn' containing the 376;; keyword `ad-do-it', which will be substituted with a `progn' containing the
377;; forms of the surrounded code. 377;; forms of the surrounded code.
378 378
379;; The innermost part of the around advice onion is 379;; The innermost part of the around advice onion is
380;; <apply original definition to <arglist>> 380;; <apply original definition to <arglist>>
381;; whose form depends on the type of the original function. The variable 381;; whose form depends on the type of the original function. The variable
382;; `ad-return-value' will be set to its result. This variable is visible to 382;; `ad-return-value' will be set to its result. This variable is visible to
@@ -499,7 +499,7 @@
499;; `(&rest ad-subr-args)' as the argument list of the original function 499;; `(&rest ad-subr-args)' as the argument list of the original function
500;; (depending on what Emacs version is used). Hence SYM and NEWDEF have to 500;; (depending on what Emacs version is used). Hence SYM and NEWDEF have to
501;; be properly mapped onto the &rest variable when the original definition is 501;; be properly mapped onto the &rest variable when the original definition is
502;; called. Advice automatically takes care of that mapping, hence, the advice 502;; called. Advice automatically takes care of that mapping, hence, the advice
503;; programmer can specify an argument list without having to know about the 503;; programmer can specify an argument list without having to know about the
504;; exact structure of the original argument list as long as the new argument 504;; exact structure of the original argument list as long as the new argument
505;; list takes a compatible number/magnitude of actual arguments. 505;; list takes a compatible number/magnitude of actual arguments.
@@ -776,15 +776,15 @@
776;; verification failed which should give you enough information to 776;; verification failed which should give you enough information to
777;; fix your preactivation/compile/load/activation sequence. 777;; fix your preactivation/compile/load/activation sequence.
778 778
779;; IMPORTANT: There is one case (that I am aware of) that can make 779;; IMPORTANT: There is one case (that I am aware of) that can make
780;; preactivation fail, i.e., a preconstructed advised definition that does 780;; preactivation fail, i.e., a preconstructed advised definition that does
781;; NOT match the current state of advice gets used nevertheless. That case 781;; NOT match the current state of advice gets used nevertheless. That case
782;; arises if one package defines a certain piece of advice which gets used 782;; arises if one package defines a certain piece of advice which gets used
783;; during preactivation, and another package incompatibly redefines that 783;; during preactivation, and another package incompatibly redefines that
784;; very advice (i.e., same function/class/name), and it is the second advice 784;; very advice (i.e., same function/class/name), and it is the second advice
785;; that is available when the preconstructed definition gets activated, and 785;; that is available when the preconstructed definition gets activated, and
786;; that was the only definition of that advice so far (`ad-add-advice' 786;; that was the only definition of that advice so far (`ad-add-advice'
787;; catches advice redefinitions and clears the cache in such a case). 787;; catches advice redefinitions and clears the cache in such a case).
788;; Catching that would make the cache verification too expensive. 788;; Catching that would make the cache verification too expensive.
789 789
790;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with 790;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with
@@ -861,7 +861,7 @@
861;; - Deactivation: 861;; - Deactivation:
862;; Back-define an advised function to its original definition. 862;; Back-define an advised function to its original definition.
863;; - Update: 863;; - Update:
864;; Reactivate an advised function but only if its advice is currently 864;; Reactivate an advised function but only if its advice is currently
865;; active. This can be used to bring all currently advised function up 865;; active. This can be used to bring all currently advised function up
866;; to date with the current state of advice without also activating 866;; to date with the current state of advice without also activating
867;; currently deactivated functions. 867;; currently deactivated functions.
@@ -885,7 +885,7 @@
885;; - ad-deactivate to deactivate the advice of a FUNCTION 885;; - ad-deactivate to deactivate the advice of a FUNCTION
886;; - ad-update to activate the advice of a FUNCTION unless it was not 886;; - ad-update to activate the advice of a FUNCTION unless it was not
887;; yet activated or is currently deactivated. 887;; yet activated or is currently deactivated.
888;; - ad-unadvise deactivates a FUNCTION and removes all of its advice 888;; - ad-unadvise deactivates a FUNCTION and removes all of its advice
889;; information, hence, it cannot be activated again 889;; information, hence, it cannot be activated again
890;; - ad-recover tries to redefine a FUNCTION to its original definition and 890;; - ad-recover tries to redefine a FUNCTION to its original definition and
891;; discards all advice information (a low-level `ad-unadvise'). 891;; discards all advice information (a low-level `ad-unadvise').
@@ -1062,17 +1062,17 @@
1062;; (call-interactively 'foo) 1062;; (call-interactively 'foo)
1063;; 6 1063;; 6
1064;; 1064;;
1065;; Let's have a look at what the definition of `foo' looks like now 1065;; Let's have a look at what the definition of `foo' looks like now
1066;; (indentation added by hand for legibility): 1066;; (indentation added by hand for legibility):
1067;; 1067;;
1068;; (symbol-function 'foo) 1068;; (symbol-function 'foo)
1069;; (lambda (x) 1069;; (lambda (x)
1070;; "$ad-doc: foo$" 1070;; "$ad-doc: foo$"
1071;; (interactive (list 5)) 1071;; (interactive (list 5))
1072;; (let (ad-return-value) 1072;; (let (ad-return-value)
1073;; (setq x (1- x)) 1073;; (setq x (1- x))
1074;; (setq x (1+ x)) 1074;; (setq x (1+ x))
1075;; (setq ad-return-value (ad-Orig-foo x)) 1075;; (setq ad-return-value (ad-Orig-foo x))
1076;; ad-return-value)) 1076;; ad-return-value))
1077;; 1077;;
1078;; @@ Around advices: 1078;; @@ Around advices:
@@ -1084,7 +1084,7 @@
1084;; specifies where the code of the original function will be executed. The 1084;; specifies where the code of the original function will be executed. The
1085;; keyword can appear multiple times which will result in multiple calls of 1085;; keyword can appear multiple times which will result in multiple calls of
1086;; the original function in the resulting advised code. Note, that if we don't 1086;; the original function in the resulting advised code. Note, that if we don't
1087;; specify a position argument (i.e., `first', `last' or a number), then 1087;; specify a position argument (i.e., `first', `last' or a number), then
1088;; `first' (or 0) is the default): 1088;; `first' (or 0) is the default):
1089;; 1089;;
1090;; (defadvice foo (around fg-times-2 act) 1090;; (defadvice foo (around fg-times-2 act)
@@ -1115,15 +1115,15 @@
1115;; Again, let's see what the definition of `foo' looks like so far: 1115;; Again, let's see what the definition of `foo' looks like so far:
1116;; 1116;;
1117;; (symbol-function 'foo) 1117;; (symbol-function 'foo)
1118;; (lambda (x) 1118;; (lambda (x)
1119;; "$ad-doc: foo$" 1119;; "$ad-doc: foo$"
1120;; (interactive (list 5)) 1120;; (interactive (list 5))
1121;; (let (ad-return-value) 1121;; (let (ad-return-value)
1122;; (setq x (1- x)) 1122;; (setq x (1- x))
1123;; (setq x (1+ x)) 1123;; (setq x (1+ x))
1124;; (let ((x (* x 2))) 1124;; (let ((x (* x 2)))
1125;; (let ((x (1+ x))) 1125;; (let ((x (1+ x)))
1126;; (setq ad-return-value (ad-Orig-foo x)))) 1126;; (setq ad-return-value (ad-Orig-foo x))))
1127;; ad-return-value)) 1127;; ad-return-value))
1128;; 1128;;
1129;; @@ Controlling advice activation: 1129;; @@ Controlling advice activation:
@@ -1162,7 +1162,7 @@
1162;; 1162;;
1163;; @@ Protecting advice execution: 1163;; @@ Protecting advice execution:
1164;; =============================== 1164;; ===============================
1165;; Once in a while we define an advice to perform some cleanup action, 1165;; Once in a while we define an advice to perform some cleanup action,
1166;; for example: 1166;; for example:
1167;; 1167;;
1168;; (defadvice foo (after fg-cleanup last act) 1168;; (defadvice foo (after fg-cleanup last act)
@@ -1198,19 +1198,19 @@
1198;; Again, let's see what `foo' looks like: 1198;; Again, let's see what `foo' looks like:
1199;; 1199;;
1200;; (symbol-function 'foo) 1200;; (symbol-function 'foo)
1201;; (lambda (x) 1201;; (lambda (x)
1202;; "$ad-doc: foo$" 1202;; "$ad-doc: foo$"
1203;; (interactive (list 5)) 1203;; (interactive (list 5))
1204;; (let (ad-return-value) 1204;; (let (ad-return-value)
1205;; (unwind-protect 1205;; (unwind-protect
1206;; (progn (setq x (1- x)) 1206;; (progn (setq x (1- x))
1207;; (setq x (1+ x)) 1207;; (setq x (1+ x))
1208;; (let ((x (* x 2))) 1208;; (let ((x (* x 2)))
1209;; (let ((x (1+ x))) 1209;; (let ((x (1+ x)))
1210;; (setq ad-return-value (ad-Orig-foo x)))) 1210;; (setq ad-return-value (ad-Orig-foo x))))
1211;; (setq ad-return-value (* ad-return-value x)) 1211;; (setq ad-return-value (* ad-return-value x))
1212;; (setq ad-return-value (* ad-return-value x))) 1212;; (setq ad-return-value (* ad-return-value x)))
1213;; (print "Let's clean up now!")) 1213;; (print "Let's clean up now!"))
1214;; ad-return-value)) 1214;; ad-return-value))
1215;; 1215;;
1216;; @@ Compilation of advised definitions: 1216;; @@ Compilation of advised definitions:
@@ -1227,9 +1227,9 @@
1227;; Now `foo' is byte-compiled: 1227;; Now `foo' is byte-compiled:
1228;; 1228;;
1229;; (symbol-function 'foo) 1229;; (symbol-function 'foo)
1230;; (lambda (x) 1230;; (lambda (x)
1231;; "$ad-doc: foo$" 1231;; "$ad-doc: foo$"
1232;; (interactive (byte-code "....." [5] 1)) 1232;; (interactive (byte-code "....." [5] 1))
1233;; (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6)) 1233;; (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6))
1234;; 1234;;
1235;; (foo 3) 1235;; (foo 3)
@@ -1482,7 +1482,7 @@
1482;; the `compile' flag: 1482;; the `compile' flag:
1483;; 1483;;
1484;; (symbol-function 'fum) 1484;; (symbol-function 'fum)
1485;; (lambda (x) 1485;; (lambda (x)
1486;; "$ad-doc: fum$" 1486;; "$ad-doc: fum$"
1487;; (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4)) 1487;; (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4))
1488;; 1488;;
@@ -1626,7 +1626,7 @@
1626;; give it an extra argument that controls the advised code, for example, one 1626;; give it an extra argument that controls the advised code, for example, one
1627;; might want to make an interactive function sensitive to a prefix argument. 1627;; might want to make an interactive function sensitive to a prefix argument.
1628;; For such cases `defadvice' allows the specification of an argument list 1628;; For such cases `defadvice' allows the specification of an argument list
1629;; for the advised function. Similar to the redefinition of interactive 1629;; for the advised function. Similar to the redefinition of interactive
1630;; behavior, the first argument list specification found in the list of before/ 1630;; behavior, the first argument list specification found in the list of before/
1631;; around/after advices will be used. Of course, the specified argument list 1631;; around/after advices will be used. Of course, the specified argument list
1632;; should be downward compatible with the original argument list, otherwise 1632;; should be downward compatible with the original argument list, otherwise
@@ -1755,7 +1755,7 @@
1755;; (quote (a)) 1755;; (quote (a))
1756;; (list (quote (a))) 1756;; (list (quote (a)))
1757;; 1757;;
1758;; If we want it to happen during evaluation time we have to do the 1758;; If we want it to happen during evaluation time we have to do the
1759;; following (first remove the old advice): 1759;; following (first remove the old advice):
1760;; 1760;;
1761;; (ad-remove-advice 'foom 'before 'fg-print-x) 1761;; (ad-remove-advice 'foom 'before 'fg-print-x)
@@ -1822,18 +1822,13 @@
1822(require 'advice-preload "advice.el") 1822(require 'advice-preload "advice.el")
1823 1823
1824 1824
1825(defmacro ad-lemacs-p ()
1826 ;;Expands into Non-nil constant if we run Lucid's version of Emacs-19.
1827 ;;Unselected conditional code will be optimized away during compilation.
1828 (string-match "Lucid" emacs-version))
1829
1830
1831;; @@ Variable definitions: 1825;; @@ Variable definitions:
1832;; ======================== 1826;; ========================
1833 1827
1834(defgroup advice nil 1828(defgroup advice nil
1835 "An overloading mechanism for Emacs Lisp functions." 1829 "An overloading mechanism for Emacs Lisp functions."
1836 :prefix "ad-" 1830 :prefix "ad-"
1831 :link '(custom-manual "(elisp)Advising Functions")
1837 :group 'lisp) 1832 :group 'lisp)
1838 1833
1839(defconst ad-version "2.14") 1834(defconst ad-version "2.14")
@@ -1859,8 +1854,8 @@ interpreted as `error'."
1859A value of `always' will result in unconditional compilation, `never' will 1854A value of `always' will result in unconditional compilation, `never' will
1860always avoid compilation, `maybe' will compile if the byte-compiler is already 1855always avoid compilation, `maybe' will compile if the byte-compiler is already
1861loaded, and `like-original' will compile if the original definition of the 1856loaded, and `like-original' will compile if the original definition of the
1862advised function is compiled or a built-in function. Every other value will 1857advised function is compiled or a built-in function. Every other value will
1863be interpreted as `maybe'. This variable will only be considered if the 1858be interpreted as `maybe'. This variable will only be considered if the
1864COMPILE argument of `ad-activate' was supplied as nil." 1859COMPILE argument of `ad-activate' was supplied as nil."
1865 :type '(choice (const always) (const never) (const like-original) 1860 :type '(choice (const always) (const never) (const like-original)
1866 (other :tag "maybe" maybe)) 1861 (other :tag "maybe" maybe))
@@ -1874,12 +1869,12 @@ COMPILE argument of `ad-activate' was supplied as nil."
1874;; We don't want the local arguments to interfere with anything 1869;; We don't want the local arguments to interfere with anything
1875;; referenced in the supplied functions => the cryptic casing: 1870;; referenced in the supplied functions => the cryptic casing:
1876(defun ad-substitute-tree (sUbTrEe-TeSt fUnCtIoN tReE) 1871(defun ad-substitute-tree (sUbTrEe-TeSt fUnCtIoN tReE)
1877 ;;"Substitutes qualifying subTREEs with result of FUNCTION(subTREE). 1872 "Substitute qualifying subTREEs with result of FUNCTION(subTREE).
1878 ;;Only proper subtrees are considered, for example, if TREE is (1 (2 (3)) 4) 1873Only proper subtrees are considered, for example, if TREE is (1 (2 (3)) 4)
1879 ;;then the subtrees will be 1 (2 (3)) 2 (3) 3 4, dotted structures are 1874then the subtrees will be 1 (2 (3)) 2 (3) 3 4, dotted structures are
1880 ;;allowed too. Once a qualifying subtree has been found its subtrees will 1875allowed too. Once a qualifying subtree has been found its subtrees will
1881 ;;not be considered anymore. (ad-substitute-tree 'atom 'identity tree) 1876not be considered anymore. (ad-substitute-tree 'atom 'identity tree)
1882 ;;generates a copy of TREE." 1877generates a copy of TREE."
1883 (cond ((consp tReE) 1878 (cond ((consp tReE)
1884 (cons (if (funcall sUbTrEe-TeSt (car tReE)) 1879 (cons (if (funcall sUbTrEe-TeSt (car tReE))
1885 (funcall fUnCtIoN (car tReE)) 1880 (funcall fUnCtIoN (car tReE))
@@ -1893,7 +1888,7 @@ COMPILE argument of `ad-activate' was supplied as nil."
1893 1888
1894;; this is just faster than `ad-substitute-tree': 1889;; this is just faster than `ad-substitute-tree':
1895(defun ad-copy-tree (tree) 1890(defun ad-copy-tree (tree)
1896 ;;"Returns a copy of the list structure of TREE." 1891 "Return a copy of the list structure of TREE."
1897 (cond ((consp tree) 1892 (cond ((consp tree)
1898 (cons (ad-copy-tree (car tree)) 1893 (cons (ad-copy-tree (car tree))
1899 (ad-copy-tree (cdr tree)))) 1894 (ad-copy-tree (cdr tree))))
@@ -1941,7 +1936,7 @@ exited prematurely with `(ad-do-return [VALUE])'."
1941 1936
1942;; @@ Save real definitions of subrs used by Advice: 1937;; @@ Save real definitions of subrs used by Advice:
1943;; ================================================= 1938;; =================================================
1944;; Advice depends on the real, unmodified functionality of various subrs, 1939;; Advice depends on the real, unmodified functionality of various subrs,
1945;; we save them here so advised versions will not interfere (eventually, 1940;; we save them here so advised versions will not interfere (eventually,
1946;; we will save all subrs used in code generated by Advice): 1941;; we will save all subrs used in code generated by Advice):
1947 1942
@@ -1990,24 +1985,24 @@ exited prematurely with `(ad-do-return [VALUE])'."
1990(defvar ad-advised-functions nil) 1985(defvar ad-advised-functions nil)
1991 1986
1992(defmacro ad-pushnew-advised-function (function) 1987(defmacro ad-pushnew-advised-function (function)
1993 ;;"Add FUNCTION to `ad-advised-functions' unless its already there." 1988 "Add FUNCTION to `ad-advised-functions' unless its already there."
1994 (` (if (not (assoc (symbol-name (, function)) ad-advised-functions)) 1989 (` (if (not (assoc (symbol-name (, function)) ad-advised-functions))
1995 (setq ad-advised-functions 1990 (setq ad-advised-functions
1996 (cons (list (symbol-name (, function))) 1991 (cons (list (symbol-name (, function)))
1997 ad-advised-functions))))) 1992 ad-advised-functions)))))
1998 1993
1999(defmacro ad-pop-advised-function (function) 1994(defmacro ad-pop-advised-function (function)
2000 ;;"Remove FUNCTION from `ad-advised-functions'." 1995 "Remove FUNCTION from `ad-advised-functions'."
2001 (` (setq ad-advised-functions 1996 (` (setq ad-advised-functions
2002 (delq (assoc (symbol-name (, function)) ad-advised-functions) 1997 (delq (assoc (symbol-name (, function)) ad-advised-functions)
2003 ad-advised-functions)))) 1998 ad-advised-functions))))
2004 1999
2005(defmacro ad-do-advised-functions (varform &rest body) 2000(defmacro ad-do-advised-functions (varform &rest body)
2006 ;;"`ad-dolist'-style iterator that maps over `ad-advised-functions'. 2001 "`ad-dolist'-style iterator that maps over `ad-advised-functions'.
2007 ;; (ad-do-advised-functions (VAR [RESULT-FORM]) 2002\(ad-do-advised-functions (VAR [RESULT-FORM])
2008 ;; BODY-FORM...) 2003 BODY-FORM...)
2009 ;;Also see `ad-dolist'. On each iteration VAR will be bound to the 2004On each iteration VAR will be bound to the name of an advised function
2010 ;;name of an advised function (a symbol)." 2005\(a symbol)."
2011 (` (ad-dolist ((, (car varform)) 2006 (` (ad-dolist ((, (car varform))
2012 ad-advised-functions 2007 ad-advised-functions
2013 (, (car (cdr varform)))) 2008 (, (car (cdr varform))))
@@ -2027,22 +2022,22 @@ exited prematurely with `(ad-do-return [VALUE])'."
2027 (` (ad-copy-tree (get (, function) 'ad-advice-info)))) 2022 (` (ad-copy-tree (get (, function) 'ad-advice-info))))
2028 2023
2029(defmacro ad-is-advised (function) 2024(defmacro ad-is-advised (function)
2030 ;;"Returns non-nil if FUNCTION has any advice info associated with it. 2025 "Return non-nil if FUNCTION has any advice info associated with it.
2031 ;;This does not mean that the advice is also active." 2026This does not mean that the advice is also active."
2032 (list 'ad-get-advice-info function)) 2027 (list 'ad-get-advice-info function))
2033 2028
2034(defun ad-initialize-advice-info (function) 2029(defun ad-initialize-advice-info (function)
2035 ;;"Initializes the advice info for FUNCTION. 2030 "Initialize the advice info for FUNCTION.
2036 ;;Assumes that FUNCTION has not yet been advised." 2031Assumes that FUNCTION has not yet been advised."
2037 (ad-pushnew-advised-function function) 2032 (ad-pushnew-advised-function function)
2038 (ad-set-advice-info function (list (cons 'active nil)))) 2033 (ad-set-advice-info function (list (cons 'active nil))))
2039 2034
2040(defmacro ad-get-advice-info-field (function field) 2035(defmacro ad-get-advice-info-field (function field)
2041 ;;"Retrieves the value of the advice info FIELD of FUNCTION." 2036 "Retrieve the value of the advice info FIELD of FUNCTION."
2042 (` (cdr (assq (, field) (ad-get-advice-info (, function)))))) 2037 (` (cdr (assq (, field) (ad-get-advice-info (, function))))))
2043 2038
2044(defun ad-set-advice-info-field (function field value) 2039(defun ad-set-advice-info-field (function field value)
2045 ;;"Destructively modifies VALUE of the advice info FIELD of FUNCTION." 2040 "Destructively modify VALUE of the advice info FIELD of FUNCTION."
2046 (and (ad-is-advised function) 2041 (and (ad-is-advised function)
2047 (cond ((assq field (ad-get-advice-info function)) 2042 (cond ((assq field (ad-get-advice-info function))
2048 ;; A field with that name is already present: 2043 ;; A field with that name is already present:
@@ -2053,7 +2048,7 @@ exited prematurely with `(ad-do-return [VALUE])'."
2053 2048
2054;; Don't make this a macro so we can use it as a predicate: 2049;; Don't make this a macro so we can use it as a predicate:
2055(defun ad-is-active (function) 2050(defun ad-is-active (function)
2056 ;;"non-nil if FUNCTION is advised and activated." 2051 "Return non-nil if FUNCTION is advised and activated."
2057 (ad-get-advice-info-field function 'active)) 2052 (ad-get-advice-info-field function 'active))
2058 2053
2059 2054
@@ -2097,27 +2092,27 @@ either t or nil, and DEFINITION should be a list of the form
2097(defvar ad-advice-classes '(before around after activation deactivation)) 2092(defvar ad-advice-classes '(before around after activation deactivation))
2098 2093
2099(defun ad-has-enabled-advice (function class) 2094(defun ad-has-enabled-advice (function class)
2100 ;;"True if at least one of FUNCTION's advices in CLASS is enabled." 2095 "True if at least one of FUNCTION's advices in CLASS is enabled."
2101 (ad-dolist (advice (ad-get-advice-info-field function class)) 2096 (ad-dolist (advice (ad-get-advice-info-field function class))
2102 (if (ad-advice-enabled advice) (ad-do-return t)))) 2097 (if (ad-advice-enabled advice) (ad-do-return t))))
2103 2098
2104(defun ad-has-redefining-advice (function) 2099(defun ad-has-redefining-advice (function)
2105 ;;"True if FUNCTION's advice info defines at least 1 redefining advice. 2100 "True if FUNCTION's advice info defines at least 1 redefining advice.
2106 ;;Redefining advices affect the construction of an advised definition." 2101Redefining advices affect the construction of an advised definition."
2107 (and (ad-is-advised function) 2102 (and (ad-is-advised function)
2108 (or (ad-has-enabled-advice function 'before) 2103 (or (ad-has-enabled-advice function 'before)
2109 (ad-has-enabled-advice function 'around) 2104 (ad-has-enabled-advice function 'around)
2110 (ad-has-enabled-advice function 'after)))) 2105 (ad-has-enabled-advice function 'after))))
2111 2106
2112(defun ad-has-any-advice (function) 2107(defun ad-has-any-advice (function)
2113 ;;"True if the advice info of FUNCTION defines at least one advice." 2108 "True if the advice info of FUNCTION defines at least one advice."
2114 (and (ad-is-advised function) 2109 (and (ad-is-advised function)
2115 (ad-dolist (class ad-advice-classes nil) 2110 (ad-dolist (class ad-advice-classes nil)
2116 (if (ad-get-advice-info-field function class) 2111 (if (ad-get-advice-info-field function class)
2117 (ad-do-return t))))) 2112 (ad-do-return t)))))
2118 2113
2119(defun ad-get-enabled-advices (function class) 2114(defun ad-get-enabled-advices (function class)
2120 ;;"Returns the list of enabled advices of FUNCTION in CLASS." 2115 "Return the list of enabled advices of FUNCTION in CLASS."
2121 (let (enabled-advices) 2116 (let (enabled-advices)
2122 (ad-dolist (advice (ad-get-advice-info-field function class)) 2117 (ad-dolist (advice (ad-get-advice-info-field function class))
2123 (if (ad-advice-enabled advice) 2118 (if (ad-advice-enabled advice)
@@ -2169,7 +2164,7 @@ either t or nil, and DEFINITION should be a list of the form
2169 (,@ body)))) 2164 (,@ body))))
2170 2165
2171(defun ad-safe-fset (symbol definition) 2166(defun ad-safe-fset (symbol definition)
2172 ;; A safe `fset' which will never call `ad-activate-internal' recursively. 2167 "A safe `fset' which will never call `ad-activate-internal' recursively."
2173 (ad-with-auto-activation-disabled 2168 (ad-with-auto-activation-disabled
2174 (ad-real-fset symbol definition))) 2169 (ad-real-fset symbol definition)))
2175 2170
@@ -2184,7 +2179,7 @@ either t or nil, and DEFINITION should be a list of the form
2184;; we need to use `ad-real-orig-definition'. 2179;; we need to use `ad-real-orig-definition'.
2185 2180
2186(defun ad-make-origname (function) 2181(defun ad-make-origname (function)
2187 ;;"Makes name to be used to call the original FUNCTION." 2182 "Make name to be used to call the original FUNCTION."
2188 (intern (format "ad-Orig-%s" function))) 2183 (intern (format "ad-Orig-%s" function)))
2189 2184
2190(defmacro ad-get-orig-definition (function) 2185(defmacro ad-get-orig-definition (function)
@@ -2204,11 +2199,11 @@ either t or nil, and DEFINITION should be a list of the form
2204;; =============================== 2199;; ===============================
2205 2200
2206(defun ad-read-advised-function (&optional prompt predicate default) 2201(defun ad-read-advised-function (&optional prompt predicate default)
2207 ;;"Reads name of advised function with completion from the minibuffer. 2202 "Read name of advised function with completion from the minibuffer.
2208 ;;An optional PROMPT will be used to prompt for the function. PREDICATE 2203An optional PROMPT will be used to prompt for the function. PREDICATE
2209 ;;plays the same role as for `try-completion' (which see). DEFAULT will 2204plays the same role as for `try-completion' (which see). DEFAULT will
2210 ;;be returned on empty input (defaults to the first advised function for 2205be returned on empty input (defaults to the first advised function for
2211 ;;which PREDICATE returns non-nil)." 2206which PREDICATE returns non-nil)."
2212 (if (null ad-advised-functions) 2207 (if (null ad-advised-functions)
2213 (error "ad-read-advised-function: There are no advised functions")) 2208 (error "ad-read-advised-function: There are no advised functions"))
2214 (setq default 2209 (setq default
@@ -2243,10 +2238,10 @@ either t or nil, and DEFINITION should be a list of the form
2243 ad-advice-classes)) 2238 ad-advice-classes))
2244 2239
2245(defun ad-read-advice-class (function &optional prompt default) 2240(defun ad-read-advice-class (function &optional prompt default)
2246 ;;"Reads a legal advice class with completion from the minibuffer. 2241 "Read a legal advice class with completion from the minibuffer.
2247 ;;An optional PROMPT will be used to prompt for the class. DEFAULT will 2242An optional PROMPT will be used to prompt for the class. DEFAULT will
2248 ;;be returned on empty input (defaults to the first non-empty advice 2243be returned on empty input (defaults to the first non-empty advice
2249 ;;class of FUNCTION)." 2244class of FUNCTION)."
2250 (setq default 2245 (setq default
2251 (or default 2246 (or default
2252 (ad-dolist (class ad-advice-classes) 2247 (ad-dolist (class ad-advice-classes)
@@ -2261,8 +2256,8 @@ either t or nil, and DEFINITION should be a list of the form
2261 (intern class)))) 2256 (intern class))))
2262 2257
2263(defun ad-read-advice-name (function class &optional prompt) 2258(defun ad-read-advice-name (function class &optional prompt)
2264 ;;"Reads name of existing advice of CLASS for FUNCTION with completion. 2259 "Read name of existing advice of CLASS for FUNCTION with completion.
2265 ;;An optional PROMPT is used to prompt for the name." 2260An optional PROMPT is used to prompt for the name."
2266 (let* ((name-completion-table 2261 (let* ((name-completion-table
2267 (mapcar (function (lambda (advice) 2262 (mapcar (function (lambda (advice)
2268 (list (symbol-name (ad-advice-name advice))))) 2263 (list (symbol-name (ad-advice-name advice)))))
@@ -2279,9 +2274,9 @@ either t or nil, and DEFINITION should be a list of the form
2279 (intern name)))) 2274 (intern name))))
2280 2275
2281(defun ad-read-advice-specification (&optional prompt) 2276(defun ad-read-advice-specification (&optional prompt)
2282 ;;"Reads a complete function/class/name specification from minibuffer. 2277 "Read a complete function/class/name specification from minibuffer.
2283 ;;The list of read symbols will be returned. The optional PROMPT will 2278The list of read symbols will be returned. The optional PROMPT will
2284 ;;be used to prompt for the function." 2279be used to prompt for the function."
2285 (let* ((function (ad-read-advised-function prompt)) 2280 (let* ((function (ad-read-advised-function prompt))
2286 (class (ad-read-advice-class function)) 2281 (class (ad-read-advice-class function))
2287 (name (ad-read-advice-name function class))) 2282 (name (ad-read-advice-name function class)))
@@ -2291,7 +2286,7 @@ either t or nil, and DEFINITION should be a list of the form
2291(defvar ad-last-regexp "") 2286(defvar ad-last-regexp "")
2292 2287
2293(defun ad-read-regexp (&optional prompt) 2288(defun ad-read-regexp (&optional prompt)
2294 ;;"Reads a regular expression from the minibuffer." 2289 "Read a regular expression from the minibuffer."
2295 (let ((regexp (read-from-minibuffer 2290 (let ((regexp (read-from-minibuffer
2296 (concat (or prompt "Regular expression: ") 2291 (concat (or prompt "Regular expression: ")
2297 (if (equal ad-last-regexp "") "" 2292 (if (equal ad-last-regexp "") ""
@@ -2304,18 +2299,18 @@ either t or nil, and DEFINITION should be a list of the form
2304;; =========================================================== 2299;; ===========================================================
2305 2300
2306(defmacro ad-find-advice (function class name) 2301(defmacro ad-find-advice (function class name)
2307 ;;"Finds the first advice of FUNCTION in CLASS with NAME." 2302 "Find the first advice of FUNCTION in CLASS with NAME."
2308 (` (assq (, name) (ad-get-advice-info-field (, function) (, class))))) 2303 (` (assq (, name) (ad-get-advice-info-field (, function) (, class)))))
2309 2304
2310(defun ad-advice-position (function class name) 2305(defun ad-advice-position (function class name)
2311 ;;"Returns position of first advice of FUNCTION in CLASS with NAME." 2306 "Return position of first advice of FUNCTION in CLASS with NAME."
2312 (let* ((found-advice (ad-find-advice function class name)) 2307 (let* ((found-advice (ad-find-advice function class name))
2313 (advices (ad-get-advice-info-field function class))) 2308 (advices (ad-get-advice-info-field function class)))
2314 (if found-advice 2309 (if found-advice
2315 (- (length advices) (length (memq found-advice advices)))))) 2310 (- (length advices) (length (memq found-advice advices))))))
2316 2311
2317(defun ad-find-some-advice (function class name) 2312(defun ad-find-some-advice (function class name)
2318 "Finds the first of FUNCTION's advices in CLASS matching NAME. 2313 "Find the first of FUNCTION's advices in CLASS matching NAME.
2319NAME can be a symbol or a regular expression matching part of an advice name. 2314NAME can be a symbol or a regular expression matching part of an advice name.
2320If CLASS is `any' all legal advice classes will be checked." 2315If CLASS is `any' all legal advice classes will be checked."
2321 (if (ad-is-advised function) 2316 (if (ad-is-advised function)
@@ -2334,12 +2329,12 @@ If CLASS is `any' all legal advice classes will be checked."
2334 (if found-advice (ad-do-return found-advice)))))) 2329 (if found-advice (ad-do-return found-advice))))))
2335 2330
2336(defun ad-enable-advice-internal (function class name flag) 2331(defun ad-enable-advice-internal (function class name flag)
2337 ;;"Sets enable FLAG of FUNCTION's advices in CLASS matching NAME. 2332 "Set enable FLAG of FUNCTION's advices in CLASS matching NAME.
2338 ;;If NAME is a string rather than a symbol then it's interpreted as a regular 2333If NAME is a string rather than a symbol then it's interpreted as a regular
2339 ;;expression and all advices whose name contain a match for it will be 2334expression and all advices whose name contain a match for it will be
2340 ;;affected. If CLASS is `any' advices in all legal advice classes will be 2335affected. If CLASS is `any' advices in all legal advice classes will be
2341 ;;considered. The number of changed advices will be returned (or nil if 2336considered. The number of changed advices will be returned (or nil if
2342 ;;FUNCTION was not advised)." 2337FUNCTION was not advised)."
2343 (if (ad-is-advised function) 2338 (if (ad-is-advised function)
2344 (let ((matched-advices 0)) 2339 (let ((matched-advices 0))
2345 (ad-dolist (advice-class ad-advice-classes) 2340 (ad-dolist (advice-class ad-advice-classes)
@@ -2364,7 +2359,7 @@ If CLASS is `any' all legal advice classes will be checked."
2364 (error "ad-enable-advice: `%s' is not advised" function))) 2359 (error "ad-enable-advice: `%s' is not advised" function)))
2365 2360
2366(defun ad-disable-advice (function class name) 2361(defun ad-disable-advice (function class name)
2367 "Disables the advice of FUNCTION with CLASS and NAME." 2362 "Disable the advice of FUNCTION with CLASS and NAME."
2368 (interactive (ad-read-advice-specification "Disable advice of: ")) 2363 (interactive (ad-read-advice-specification "Disable advice of: "))
2369 (if (ad-is-advised function) 2364 (if (ad-is-advised function)
2370 (if (eq (ad-enable-advice-internal function class name nil) 0) 2365 (if (eq (ad-enable-advice-internal function class name nil) 0)
@@ -2373,9 +2368,9 @@ If CLASS is `any' all legal advice classes will be checked."
2373 (error "ad-disable-advice: `%s' is not advised" function))) 2368 (error "ad-disable-advice: `%s' is not advised" function)))
2374 2369
2375(defun ad-enable-regexp-internal (regexp class flag) 2370(defun ad-enable-regexp-internal (regexp class flag)
2376 ;;"Sets enable FLAGs of all CLASS advices whose name contains a REGEXP match. 2371 "Set enable FLAGs of all CLASS advices whose name contains a REGEXP match.
2377 ;;If CLASS is `any' all legal advice classes are considered. The number of 2372If CLASS is `any' all legal advice classes are considered. The number of
2378 ;;affected advices will be returned." 2373affected advices will be returned."
2379 (let ((matched-advices 0)) 2374 (let ((matched-advices 0))
2380 (ad-do-advised-functions (advised-function) 2375 (ad-do-advised-functions (advised-function)
2381 (setq matched-advices 2376 (setq matched-advices
@@ -2396,7 +2391,7 @@ All currently advised functions will be considered."
2396 matched-advices)) 2391 matched-advices))
2397 2392
2398(defun ad-disable-regexp (regexp) 2393(defun ad-disable-regexp (regexp)
2399 "Disables all advices with names that contain a match for REGEXP. 2394 "Disable all advices with names that contain a match for REGEXP.
2400All currently advised functions will be considered." 2395All currently advised functions will be considered."
2401 (interactive 2396 (interactive
2402 (list (ad-read-regexp "Disable advices via regexp: "))) 2397 (list (ad-read-regexp "Disable advices via regexp: ")))
@@ -2406,7 +2401,7 @@ All currently advised functions will be considered."
2406 matched-advices)) 2401 matched-advices))
2407 2402
2408(defun ad-remove-advice (function class name) 2403(defun ad-remove-advice (function class name)
2409 "Removes FUNCTION's advice with NAME from its advices in CLASS. 2404 "Remove FUNCTION's advice with NAME from its advices in CLASS.
2410If such an advice was found it will be removed from the list of advices 2405If such an advice was found it will be removed from the list of advices
2411in that CLASS." 2406in that CLASS."
2412 (interactive (ad-read-advice-specification "Remove advice of: ")) 2407 (interactive (ad-read-advice-specification "Remove advice of: "))
@@ -2422,7 +2417,7 @@ in that CLASS."
2422 2417
2423;;;###autoload 2418;;;###autoload
2424(defun ad-add-advice (function advice class position) 2419(defun ad-add-advice (function advice class position)
2425 "Adds a piece of ADVICE to FUNCTION's list of advices in CLASS. 2420 "Add a piece of ADVICE to FUNCTION's list of advices in CLASS.
2426If FUNCTION already has one or more pieces of advice of the specified 2421If FUNCTION already has one or more pieces of advice of the specified
2427CLASS then POSITION determines where the new piece will go. The value 2422CLASS then POSITION determines where the new piece will go. The value
2428of POSITION can either be `first', `last' or a number where 0 corresponds 2423of POSITION can either be `first', `last' or a number where 0 corresponds
@@ -2430,7 +2425,7 @@ to `first'. Numbers outside the range will be mapped to the closest
2430extreme position. If there was already a piece of ADVICE with the same 2425extreme position. If there was already a piece of ADVICE with the same
2431name, then the position argument will be ignored and the old advice 2426name, then the position argument will be ignored and the old advice
2432will be overwritten with the new one. 2427will be overwritten with the new one.
2433 If the FUNCTION was not advised already, then its advice info will be 2428 If the FUNCTION was not advised already, then its advice info will be
2434initialized. Redefining a piece of advice whose name is part of the cache-id 2429initialized. Redefining a piece of advice whose name is part of the cache-id
2435will clear the cache." 2430will clear the cache."
2436 (cond ((not (ad-is-advised function)) 2431 (cond ((not (ad-is-advised function))
@@ -2462,11 +2457,11 @@ will clear the cache."
2462;; =================================================== 2457;; ===================================================
2463 2458
2464(defmacro ad-macrofy (definition) 2459(defmacro ad-macrofy (definition)
2465 ;;"Takes a lambda function DEFINITION and makes a macro out of it." 2460 "Take a lambda function DEFINITION and make a macro out of it."
2466 (` (cons 'macro (, definition)))) 2461 (` (cons 'macro (, definition))))
2467 2462
2468(defmacro ad-lambdafy (definition) 2463(defmacro ad-lambdafy (definition)
2469 ;;"Takes a macro function DEFINITION and makes a lambda out of it." 2464 "Take a macro function DEFINITION and make a lambda out of it."
2470 (` (cdr (, definition)))) 2465 (` (cdr (, definition))))
2471 2466
2472;; There is no way to determine whether some subr is a special form or not, 2467;; There is no way to determine whether some subr is a special form or not,
@@ -2515,19 +2510,19 @@ will clear the cache."
2515 (ad-safe-fset 'byte-code-function-p 'compiled-function-p)) 2510 (ad-safe-fset 'byte-code-function-p 'compiled-function-p))
2516 2511
2517(defmacro ad-compiled-p (definition) 2512(defmacro ad-compiled-p (definition)
2518 ;;"non-nil if DEFINITION is a compiled byte-code object." 2513 "Return non-nil if DEFINITION is a compiled byte-code object."
2519 (` (or (byte-code-function-p (, definition)) 2514 (` (or (byte-code-function-p (, definition))
2520 (and (ad-macro-p (, definition)) 2515 (and (ad-macro-p (, definition))
2521 (byte-code-function-p (ad-lambdafy (, definition))))))) 2516 (byte-code-function-p (ad-lambdafy (, definition)))))))
2522 2517
2523(defmacro ad-compiled-code (compiled-definition) 2518(defmacro ad-compiled-code (compiled-definition)
2524 ;;"Returns the byte-code object of a COMPILED-DEFINITION." 2519 "Return the byte-code object of a COMPILED-DEFINITION."
2525 (` (if (ad-macro-p (, compiled-definition)) 2520 (` (if (ad-macro-p (, compiled-definition))
2526 (ad-lambdafy (, compiled-definition)) 2521 (ad-lambdafy (, compiled-definition))
2527 (, compiled-definition)))) 2522 (, compiled-definition))))
2528 2523
2529(defun ad-lambda-expression (definition) 2524(defun ad-lambda-expression (definition)
2530 ;;"Returns the lambda expression of a function/macro/advice DEFINITION." 2525 "Return the lambda expression of a function/macro/advice DEFINITION."
2531 (cond ((ad-lambda-p definition) 2526 (cond ((ad-lambda-p definition)
2532 definition) 2527 definition)
2533 ((ad-macro-p definition) 2528 ((ad-macro-p definition)
@@ -2537,9 +2532,9 @@ will clear the cache."
2537 (t nil))) 2532 (t nil)))
2538 2533
2539(defun ad-arglist (definition &optional name) 2534(defun ad-arglist (definition &optional name)
2540 ;;"Returns the argument list of DEFINITION. 2535 "Return the argument list of DEFINITION.
2541 ;;If DEFINITION could be from a subr then its NAME should be 2536If DEFINITION could be from a subr then its NAME should be
2542 ;;supplied to make subr arglist lookup more efficient." 2537supplied to make subr arglist lookup more efficient."
2543 (cond ((ad-compiled-p definition) 2538 (cond ((ad-compiled-p definition)
2544 (aref (ad-compiled-code definition) 0)) 2539 (aref (ad-compiled-code definition) 0))
2545 ((consp definition) 2540 ((consp definition)
@@ -2565,10 +2560,10 @@ will clear the cache."
2565 (` (car (get (, subr) 'ad-subr-arglist)))) 2560 (` (car (get (, subr) 'ad-subr-arglist))))
2566 2561
2567(defun ad-subr-arglist (subr-name) 2562(defun ad-subr-arglist (subr-name)
2568 ;;"Retrieve arglist of the subr with SUBR-NAME. 2563 "Retrieve arglist of the subr with SUBR-NAME.
2569 ;;Either use the one stored under the `ad-subr-arglist' property, 2564Either use the one stored under the `ad-subr-arglist' property,
2570 ;;or try to retrieve it from the docstring and cache it under 2565or try to retrieve it from the docstring and cache it under
2571 ;;that property, or otherwise use `(&rest ad-subr-args)'." 2566that property, or otherwise use `(&rest ad-subr-args)'."
2572 (cond ((ad-subr-args-defined-p subr-name) 2567 (cond ((ad-subr-args-defined-p subr-name)
2573 (ad-get-subr-args subr-name)) 2568 (ad-get-subr-args subr-name))
2574 ;; says jwz: Should use this for Lemacs 19.8 and above: 2569 ;; says jwz: Should use this for Lemacs 19.8 and above:
@@ -2604,7 +2599,7 @@ will clear the cache."
2604 (t '(&rest ad-subr-args))))))) 2599 (t '(&rest ad-subr-args)))))))
2605 2600
2606(defun ad-docstring (definition) 2601(defun ad-docstring (definition)
2607 ;;"Returns the unexpanded docstring of DEFINITION." 2602 "Return the unexpanded docstring of DEFINITION."
2608 (let ((docstring 2603 (let ((docstring
2609 (if (ad-compiled-p definition) 2604 (if (ad-compiled-p definition)
2610 (ad-real-documentation definition t) 2605 (ad-real-documentation definition t)
@@ -2614,7 +2609,7 @@ will clear the cache."
2614 docstring))) 2609 docstring)))
2615 2610
2616(defun ad-interactive-form (definition) 2611(defun ad-interactive-form (definition)
2617 ;;"Returns the interactive form of DEFINITION." 2612 "Return the interactive form of DEFINITION."
2618 (cond ((ad-compiled-p definition) 2613 (cond ((ad-compiled-p definition)
2619 (and (commandp definition) 2614 (and (commandp definition)
2620 (list 'interactive (aref (ad-compiled-code definition) 5)))) 2615 (list 'interactive (aref (ad-compiled-code definition) 5))))
@@ -2623,7 +2618,7 @@ will clear the cache."
2623 (commandp (ad-lambda-expression definition))))) 2618 (commandp (ad-lambda-expression definition)))))
2624 2619
2625(defun ad-body-forms (definition) 2620(defun ad-body-forms (definition)
2626 ;;"Returns the list of body forms of DEFINITION." 2621 "Return the list of body forms of DEFINITION."
2627 (cond ((ad-compiled-p definition) 2622 (cond ((ad-compiled-p definition)
2628 nil) 2623 nil)
2629 ((consp definition) 2624 ((consp definition)
@@ -2636,15 +2631,15 @@ will clear the cache."
2636(defvar ad-advised-definition-docstring-regexp "^\\$ad-doc: \\(.+\\)\\$$") 2631(defvar ad-advised-definition-docstring-regexp "^\\$ad-doc: \\(.+\\)\\$$")
2637 2632
2638(defun ad-make-advised-definition-docstring (function) 2633(defun ad-make-advised-definition-docstring (function)
2639 ;; Makes an identifying docstring for the advised definition of FUNCTION. 2634 "Make an identifying docstring for the advised definition of FUNCTION.
2640 ;; Put function name into the documentation string so we can infer 2635Put function name into the documentation string so we can infer
2641 ;; the name of the advised function from the docstring. This is needed 2636the name of the advised function from the docstring. This is needed
2642 ;; to generate a proper advised docstring even if we are just given a 2637to generate a proper advised docstring even if we are just given a
2643 ;; definition (also see the defadvice for `documentation'): 2638definition (also see the defadvice for `documentation')."
2644 (format "$ad-doc: %s$" (prin1-to-string function))) 2639 (format "$ad-doc: %s$" (prin1-to-string function)))
2645 2640
2646(defun ad-advised-definition-p (definition) 2641(defun ad-advised-definition-p (definition)
2647 ;;"non-nil if DEFINITION was generated from advice information." 2642 "Return non-nil if DEFINITION was generated from advice information."
2648 (if (or (ad-lambda-p definition) 2643 (if (or (ad-lambda-p definition)
2649 (ad-macro-p definition) 2644 (ad-macro-p definition)
2650 (ad-compiled-p definition)) 2645 (ad-compiled-p definition))
@@ -2654,7 +2649,7 @@ will clear the cache."
2654 ad-advised-definition-docstring-regexp docstring))))) 2649 ad-advised-definition-docstring-regexp docstring)))))
2655 2650
2656(defun ad-definition-type (definition) 2651(defun ad-definition-type (definition)
2657 ;;"Returns symbol that describes the type of DEFINITION." 2652 "Return symbol that describes the type of DEFINITION."
2658 (if (ad-macro-p definition) 2653 (if (ad-macro-p definition)
2659 'macro 2654 'macro
2660 (if (ad-subr-p definition) 2655 (if (ad-subr-p definition)
@@ -2668,8 +2663,8 @@ will clear the cache."
2668 'advice))))) 2663 'advice)))))
2669 2664
2670(defun ad-has-proper-definition (function) 2665(defun ad-has-proper-definition (function)
2671 ;;"True if FUNCTION is a symbol with a proper definition. 2666 "True if FUNCTION is a symbol with a proper definition.
2672 ;;For that it has to be fbound with a non-autoload definition." 2667For that it has to be fbound with a non-autoload definition."
2673 (and (symbolp function) 2668 (and (symbolp function)
2674 (fboundp function) 2669 (fboundp function)
2675 (not (eq (car-safe (symbol-function function)) 'autoload)))) 2670 (not (eq (car-safe (symbol-function function)) 'autoload))))
@@ -2677,7 +2672,7 @@ will clear the cache."
2677;; The following two are necessary for the sake of packages such as 2672;; The following two are necessary for the sake of packages such as
2678;; ange-ftp which redefine functions via fcell indirection: 2673;; ange-ftp which redefine functions via fcell indirection:
2679(defun ad-real-definition (function) 2674(defun ad-real-definition (function)
2680 ;;"Finds FUNCTION's definition at the end of function cell indirection." 2675 "Find FUNCTION's definition at the end of function cell indirection."
2681 (if (ad-has-proper-definition function) 2676 (if (ad-has-proper-definition function)
2682 (let ((definition (symbol-function function))) 2677 (let ((definition (symbol-function function)))
2683 (if (symbolp definition) 2678 (if (symbolp definition)
@@ -2685,12 +2680,12 @@ will clear the cache."
2685 definition)))) 2680 definition))))
2686 2681
2687(defun ad-real-orig-definition (function) 2682(defun ad-real-orig-definition (function)
2688 ;;"Finds FUNCTION's real original definition starting from its `origname'." 2683 "Find FUNCTION's real original definition starting from its `origname'."
2689 (if (ad-is-advised function) 2684 (if (ad-is-advised function)
2690 (ad-real-definition (ad-get-advice-info-field function 'origname)))) 2685 (ad-real-definition (ad-get-advice-info-field function 'origname))))
2691 2686
2692(defun ad-is-compilable (function) 2687(defun ad-is-compilable (function)
2693 ;;"True if FUNCTION has an interpreted definition that can be compiled." 2688 "True if FUNCTION has an interpreted definition that can be compiled."
2694 (and (ad-has-proper-definition function) 2689 (and (ad-has-proper-definition function)
2695 (or (ad-lambda-p (symbol-function function)) 2690 (or (ad-lambda-p (symbol-function function))
2696 (ad-macro-p (symbol-function function))) 2691 (ad-macro-p (symbol-function function)))
@@ -2721,7 +2716,7 @@ will clear the cache."
2721;; definition and call it according to type and arguments. Functions and 2716;; definition and call it according to type and arguments. Functions and
2722;; subrs that don't have any &rest arguments can be called directly in a 2717;; subrs that don't have any &rest arguments can be called directly in a
2723;; `(ad-Orig-<name> ....)' form. If they have a &rest argument we have to 2718;; `(ad-Orig-<name> ....)' form. If they have a &rest argument we have to
2724;; use `apply'. Macros will be called with 2719;; use `apply'. Macros will be called with
2725;; `(macroexpand '(ad-Orig-<name> ....))', and special forms also need a 2720;; `(macroexpand '(ad-Orig-<name> ....))', and special forms also need a
2726;; form like that with `eval' instead of `macroexpand'. 2721;; form like that with `eval' instead of `macroexpand'.
2727;; 2722;;
@@ -2744,10 +2739,10 @@ will clear the cache."
2744;; ============================= 2739;; =============================
2745 2740
2746(defun ad-parse-arglist (arglist) 2741(defun ad-parse-arglist (arglist)
2747 ;;"Parses ARGLIST into its required, optional and rest parameters. 2742 "Parse ARGLIST into its required, optional and rest parameters.
2748 ;;A three-element list is returned, where the 1st element is the list of 2743A three-element list is returned, where the 1st element is the list of
2749 ;;required arguments, the 2nd is the list of optional arguments, and the 3rd 2744required arguments, the 2nd is the list of optional arguments, and the 3rd
2750 ;;is the name of an optional rest parameter (or nil)." 2745is the name of an optional rest parameter (or nil)."
2751 (let* (required optional rest) 2746 (let* (required optional rest)
2752 (setq rest (car (cdr (memq '&rest arglist)))) 2747 (setq rest (car (cdr (memq '&rest arglist))))
2753 (if rest (setq arglist (reverse (cdr (memq '&rest (reverse arglist)))))) 2748 (if rest (setq arglist (reverse (cdr (memq '&rest (reverse arglist))))))
@@ -2758,12 +2753,12 @@ will clear the cache."
2758 (list required optional rest))) 2753 (list required optional rest)))
2759 2754
2760(defun ad-retrieve-args-form (arglist) 2755(defun ad-retrieve-args-form (arglist)
2761 ;;"Generates a form which evaluates into names/values/types of ARGLIST. 2756 "Generate a form which evaluates into names/values/types of ARGLIST.
2762 ;;When the form gets evaluated within a function with that argument list 2757When the form gets evaluated within a function with that argument list
2763 ;;it will result in a list with one entry for each argument, where the 2758it will result in a list with one entry for each argument, where the
2764 ;;first element of each entry is the name of the argument, the second 2759first element of each entry is the name of the argument, the second
2765 ;;element is its actual current value, and the third element is either 2760element is its actual current value, and the third element is either
2766 ;;`required', `optional' or `rest' depending on the type of the argument." 2761`required', `optional' or `rest' depending on the type of the argument."
2767 (let* ((parsed-arglist (ad-parse-arglist arglist)) 2762 (let* ((parsed-arglist (ad-parse-arglist arglist))
2768 (rest (nth 2 parsed-arglist))) 2763 (rest (nth 2 parsed-arglist)))
2769 (` (list 2764 (` (list
@@ -2794,9 +2789,9 @@ will clear the cache."
2794 (t (list 'nth position list)))) 2789 (t (list 'nth position list))))
2795 2790
2796(defun ad-access-argument (arglist index) 2791(defun ad-access-argument (arglist index)
2797 ;;"Tells how to access ARGLIST's actual argument at position INDEX. 2792 "Tell how to access ARGLIST's actual argument at position INDEX.
2798 ;;For a required/optional arg it simply returns it, if a rest argument has 2793For a required/optional arg it simply returns it, if a rest argument has
2799 ;;to be accessed, it returns a list with the index and name." 2794to be accessed, it returns a list with the index and name."
2800 (let* ((parsed-arglist (ad-parse-arglist arglist)) 2795 (let* ((parsed-arglist (ad-parse-arglist arglist))
2801 (reqopt-args (append (nth 0 parsed-arglist) 2796 (reqopt-args (append (nth 0 parsed-arglist)
2802 (nth 1 parsed-arglist))) 2797 (nth 1 parsed-arglist)))
@@ -2807,7 +2802,7 @@ will clear the cache."
2807 (list (- index (length reqopt-args)) rest-arg))))) 2802 (list (- index (length reqopt-args)) rest-arg)))))
2808 2803
2809(defun ad-get-argument (arglist index) 2804(defun ad-get-argument (arglist index)
2810 ;;"Returns form to access ARGLIST's actual argument at position INDEX." 2805 "Return form to access ARGLIST's actual argument at position INDEX."
2811 (let ((argument-access (ad-access-argument arglist index))) 2806 (let ((argument-access (ad-access-argument arglist index)))
2812 (cond ((consp argument-access) 2807 (cond ((consp argument-access)
2813 (ad-element-access 2808 (ad-element-access
@@ -2815,7 +2810,7 @@ will clear the cache."
2815 (argument-access)))) 2810 (argument-access))))
2816 2811
2817(defun ad-set-argument (arglist index value-form) 2812(defun ad-set-argument (arglist index value-form)
2818 ;;"Returns form to set ARGLIST's actual arg at INDEX to VALUE-FORM." 2813 "Return form to set ARGLIST's actual arg at INDEX to VALUE-FORM."
2819 (let ((argument-access (ad-access-argument arglist index))) 2814 (let ((argument-access (ad-access-argument arglist index)))
2820 (cond ((consp argument-access) 2815 (cond ((consp argument-access)
2821 ;; should this check whether there actually is something to set? 2816 ;; should this check whether there actually is something to set?
@@ -2828,7 +2823,7 @@ will clear the cache."
2828 index arglist))))) 2823 index arglist)))))
2829 2824
2830(defun ad-get-arguments (arglist index) 2825(defun ad-get-arguments (arglist index)
2831 ;;"Returns form to access all actual arguments starting at position INDEX." 2826 "Return form to access all actual arguments starting at position INDEX."
2832 (let* ((parsed-arglist (ad-parse-arglist arglist)) 2827 (let* ((parsed-arglist (ad-parse-arglist arglist))
2833 (reqopt-args (append (nth 0 parsed-arglist) 2828 (reqopt-args (append (nth 0 parsed-arglist)
2834 (nth 1 parsed-arglist))) 2829 (nth 1 parsed-arglist)))
@@ -2844,8 +2839,8 @@ will clear the cache."
2844 args-form)) 2839 args-form))
2845 2840
2846(defun ad-set-arguments (arglist index values-form) 2841(defun ad-set-arguments (arglist index values-form)
2847 ;;"Makes form to assign elements of VALUES-FORM as actual ARGLIST args. 2842 "Make form to assign elements of VALUES-FORM as actual ARGLIST args.
2848 ;;The assignment starts at position INDEX." 2843The assignment starts at position INDEX."
2849 (let ((values-index 0) 2844 (let ((values-index 0)
2850 argument-access set-forms) 2845 argument-access set-forms)
2851 (while (setq argument-access (ad-access-argument arglist index)) 2846 (while (setq argument-access (ad-access-argument arglist index))
@@ -2885,7 +2880,7 @@ will clear the cache."
2885 (, 'ad-vAlUeS))))))) 2880 (, 'ad-vAlUeS)))))))
2886 2881
2887(defun ad-insert-argument-access-forms (definition arglist) 2882(defun ad-insert-argument-access-forms (definition arglist)
2888 ;;"Expands arg-access text macros in DEFINITION according to ARGLIST." 2883 "Expands arg-access text macros in DEFINITION according to ARGLIST."
2889 (ad-substitute-tree 2884 (ad-substitute-tree
2890 (function 2885 (function
2891 (lambda (form) 2886 (lambda (form)
@@ -2917,14 +2912,14 @@ will clear the cache."
2917;; Suppose function foo was called with (foo 1 2 3 4 5), and foo has the 2912;; Suppose function foo was called with (foo 1 2 3 4 5), and foo has the
2918;; argument list (x y &rest z), and we want to call the function bar which 2913;; argument list (x y &rest z), and we want to call the function bar which
2919;; has argument list (a &rest b) with a combination of x, y and z so that 2914;; has argument list (a &rest b) with a combination of x, y and z so that
2920;; the effect is just as if we had called (bar 1 2 3 4 5) directly. 2915;; the effect is just as if we had called (bar 1 2 3 4 5) directly.
2921;; The mapping should work for any two argument lists. 2916;; The mapping should work for any two argument lists.
2922 2917
2923(defun ad-map-arglists (source-arglist target-arglist) 2918(defun ad-map-arglists (source-arglist target-arglist)
2924 "Makes `funcall/apply' form to map SOURCE-ARGLIST to TARGET-ARGLIST. 2919 "Make `funcall/apply' form to map SOURCE-ARGLIST to TARGET-ARGLIST.
2925The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just 2920The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just
2926as if they had been supplied to a function with TARGET-ARGLIST directly. 2921as if they had been supplied to a function with TARGET-ARGLIST directly.
2927Excess source arguments will be neglected, missing source arguments will be 2922Excess source arguments will be neglected, missing source arguments will be
2928supplied as nil. Returns a `funcall' or `apply' form with the second element 2923supplied as nil. Returns a `funcall' or `apply' form with the second element
2929being `function' which has to be replaced by an actual function argument. 2924being `function' which has to be replaced by an actual function argument.
2930Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return 2925Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
@@ -2959,7 +2954,7 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
2959 source-reqopt-args))))))))) 2954 source-reqopt-args)))))))))
2960 2955
2961(defun ad-make-mapped-call (source-arglist target-arglist target-function) 2956(defun ad-make-mapped-call (source-arglist target-arglist target-function)
2962 ;;"Makes form to call TARGET-FUNCTION with args from SOURCE-ARGLIST." 2957 "Make form to call TARGET-FUNCTION with args from SOURCE-ARGLIST."
2963 (let* ((mapped-form (ad-map-arglists source-arglist target-arglist))) 2958 (let* ((mapped-form (ad-map-arglists source-arglist target-arglist)))
2964 (if (eq (car mapped-form) 'funcall) 2959 (if (eq (car mapped-form) 'funcall)
2965 (cons target-function (cdr (cdr mapped-form))) 2960 (cons target-function (cdr (cdr mapped-form)))
@@ -3032,7 +3027,7 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
3032;; ======================================================== 3027;; ========================================================
3033 3028
3034(defun ad-advised-arglist (function) 3029(defun ad-advised-arglist (function)
3035 ;;"Finds first defined arglist in FUNCTION's redefining advices." 3030 "Find first defined arglist in FUNCTION's redefining advices."
3036 (ad-dolist (advice (append (ad-get-enabled-advices function 'before) 3031 (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
3037 (ad-get-enabled-advices function 'around) 3032 (ad-get-enabled-advices function 'around)
3038 (ad-get-enabled-advices function 'after))) 3033 (ad-get-enabled-advices function 'after)))
@@ -3042,7 +3037,7 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
3042 (ad-do-return arglist))))) 3037 (ad-do-return arglist)))))
3043 3038
3044(defun ad-advised-interactive-form (function) 3039(defun ad-advised-interactive-form (function)
3045 ;;"Finds first interactive form in FUNCTION's redefining advices." 3040 "Find first interactive form in FUNCTION's redefining advices."
3046 (ad-dolist (advice (append (ad-get-enabled-advices function 'before) 3041 (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
3047 (ad-get-enabled-advices function 'around) 3042 (ad-get-enabled-advices function 'around)
3048 (ad-get-enabled-advices function 'after))) 3043 (ad-get-enabled-advices function 'after)))
@@ -3056,7 +3051,7 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
3056;; ============================ 3051;; ============================
3057 3052
3058(defun ad-make-advised-definition (function) 3053(defun ad-make-advised-definition (function)
3059 ;;"Generates an advised definition of FUNCTION from its advice info." 3054 "Generate an advised definition of FUNCTION from its advice info."
3060 (if (and (ad-is-advised function) 3055 (if (and (ad-is-advised function)
3061 (ad-has-redefining-advice function)) 3056 (ad-has-redefining-advice function))
3062 (let* ((origdef (ad-real-orig-definition function)) 3057 (let* ((origdef (ad-real-orig-definition function))
@@ -3134,14 +3129,14 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
3134(defun ad-assemble-advised-definition 3129(defun ad-assemble-advised-definition
3135 (type args docstring interactive orig &optional befores arounds afters) 3130 (type args docstring interactive orig &optional befores arounds afters)
3136 3131
3137 ;;"Assembles an original and its advices into an advised function. 3132 "Assembles an original and its advices into an advised function.
3138 ;;It constructs a function or macro definition according to TYPE which has to 3133It constructs a function or macro definition according to TYPE which has to
3139 ;;be either `macro', `function' or `special-form'. ARGS is the argument list 3134be either `macro', `function' or `special-form'. ARGS is the argument list
3140 ;;that has to be used, DOCSTRING if non-nil defines the documentation of the 3135that has to be used, DOCSTRING if non-nil defines the documentation of the
3141 ;;definition, INTERACTIVE if non-nil is the interactive form to be used, 3136definition, INTERACTIVE if non-nil is the interactive form to be used,
3142 ;;ORIG is a form that calls the body of the original unadvised function, 3137ORIG is a form that calls the body of the original unadvised function,
3143 ;;and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG 3138and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG
3144 ;;should be modified. The assembled function will be returned." 3139should be modified. The assembled function will be returned."
3145 3140
3146 (let (before-forms around-form around-form-protected after-forms definition) 3141 (let (before-forms around-form around-form-protected after-forms definition)
3147 (ad-dolist (advice befores) 3142 (ad-dolist (advice befores)
@@ -3202,7 +3197,7 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
3202 3197
3203;; This is needed for activation/deactivation hooks: 3198;; This is needed for activation/deactivation hooks:
3204(defun ad-make-hook-form (function hook-name) 3199(defun ad-make-hook-form (function hook-name)
3205 ;;"Makes hook-form from FUNCTION's advice bodies in class HOOK-NAME." 3200 "Make hook-form from FUNCTION's advice bodies in class HOOK-NAME."
3206 (let ((hook-forms 3201 (let ((hook-forms
3207 (mapcar (function (lambda (advice) 3202 (mapcar (function (lambda (advice)
3208 (ad-body-forms (ad-advice-definition advice)))) 3203 (ad-body-forms (ad-advice-definition advice))))
@@ -3290,7 +3285,7 @@ advised definition from scratch."
3290 (ad-set-advice-info-field function 'cache nil)) 3285 (ad-set-advice-info-field function 'cache nil))
3291 3286
3292(defun ad-make-cache-id (function) 3287(defun ad-make-cache-id (function)
3293 ;;"Generates an identifying image of the current advices of FUNCTION." 3288 "Generate an identifying image of the current advices of FUNCTION."
3294 (let ((original-definition (ad-real-orig-definition function)) 3289 (let ((original-definition (ad-real-orig-definition function))
3295 (cached-definition (ad-get-cache-definition function))) 3290 (cached-definition (ad-get-cache-definition function)))
3296 (list (mapcar (function (lambda (advice) (ad-advice-name advice))) 3291 (list (mapcar (function (lambda (advice) (ad-advice-name advice)))
@@ -3309,7 +3304,7 @@ advised definition from scratch."
3309 (ad-interactive-form cached-definition)))))) 3304 (ad-interactive-form cached-definition))))))
3310 3305
3311(defun ad-get-cache-class-id (function class) 3306(defun ad-get-cache-class-id (function class)
3312 ;;"Returns the part of FUNCTION's cache id that identifies CLASS." 3307 "Return the part of FUNCTION's cache id that identifies CLASS."
3313 (let ((cache-id (ad-get-cache-id function))) 3308 (let ((cache-id (ad-get-cache-id function)))
3314 (if (eq class 'before) 3309 (if (eq class 'before)
3315 (car cache-id) 3310 (car cache-id)
@@ -3326,7 +3321,7 @@ advised definition from scratch."
3326 3321
3327;; There should be a way to monitor if and why a cache verification failed 3322;; There should be a way to monitor if and why a cache verification failed
3328;; in order to determine whether a certain preactivation could be used or 3323;; in order to determine whether a certain preactivation could be used or
3329;; not. Right now the only way to find out is to trace 3324;; not. Right now the only way to find out is to trace
3330;; `ad-cache-id-verification-code'. The code it returns indicates where the 3325;; `ad-cache-id-verification-code'. The code it returns indicates where the
3331;; verification failed. Tracing `ad-verify-cache-class-id' might provide 3326;; verification failed. Tracing `ad-verify-cache-class-id' might provide
3332;; some additional useful information. 3327;; some additional useful information.
@@ -3359,7 +3354,7 @@ advised definition from scratch."
3359 code)) 3354 code))
3360 3355
3361(defun ad-verify-cache-id (function) 3356(defun ad-verify-cache-id (function)
3362 ;;"True if FUNCTION's cache-id is compatible with its current advices." 3357 "True if FUNCTION's cache-id is compatible with its current advices."
3363 (eq (ad-cache-id-verification-code function) 'verified)) 3358 (eq (ad-cache-id-verification-code function) 'verified))
3364 3359
3365 3360
@@ -3387,7 +3382,7 @@ advised definition from scratch."
3387;; advised definition will be generated. 3382;; advised definition will be generated.
3388 3383
3389(defun ad-preactivate-advice (function advice class position) 3384(defun ad-preactivate-advice (function advice class position)
3390 ;;"Preactivates FUNCTION and returns the constructed cache." 3385 "Preactivate FUNCTION and returns the constructed cache."
3391 (let* ((function-defined-p (fboundp function)) 3386 (let* ((function-defined-p (fboundp function))
3392 (old-definition 3387 (old-definition
3393 (if function-defined-p 3388 (if function-defined-p
@@ -3499,11 +3494,11 @@ advised definition from scratch."
3499;; ====================================== 3494;; ======================================
3500 3495
3501(defun ad-should-compile (function compile) 3496(defun ad-should-compile (function compile)
3502 ;;"Returns non-nil if the advised FUNCTION should be compiled. 3497 "Return non-nil if the advised FUNCTION should be compiled.
3503 ;;If COMPILE is non-nil and not a negative number then it returns t. 3498If COMPILE is non-nil and not a negative number then it returns t.
3504 ;;If COMPILE is a negative number then it returns nil. 3499If COMPILE is a negative number then it returns nil.
3505 ;;If COMPILE is nil then the result depends on the value of 3500If COMPILE is nil then the result depends on the value of
3506 ;;`ad-default-compilation-action' (which see)." 3501`ad-default-compilation-action' (which see)."
3507 (if (integerp compile) 3502 (if (integerp compile)
3508 (>= compile 0) 3503 (>= compile 0)
3509 (if compile 3504 (if compile
@@ -3519,9 +3514,9 @@ advised definition from scratch."
3519 (t (featurep 'byte-compile)))))) 3514 (t (featurep 'byte-compile))))))
3520 3515
3521(defun ad-activate-advised-definition (function compile) 3516(defun ad-activate-advised-definition (function compile)
3522 ;;"Redefines FUNCTION with its advised definition from cache or scratch. 3517 "Redefine FUNCTION with its advised definition from cache or scratch.
3523 ;;The resulting FUNCTION will be compiled if `ad-should-compile' returns t. 3518The resulting FUNCTION will be compiled if `ad-should-compile' returns t.
3524 ;;The current definition and its cache-id will be put into the cache." 3519The current definition and its cache-id will be put into the cache."
3525 (let ((verified-cached-definition 3520 (let ((verified-cached-definition
3526 (if (ad-verify-cache-id function) 3521 (if (ad-verify-cache-id function)
3527 (ad-get-cache-definition function)))) 3522 (ad-get-cache-definition function))))
@@ -3654,7 +3649,7 @@ See `ad-activate' for documentation on the optional COMPILE argument."
3654 (ad-activate function compile))) 3649 (ad-activate function compile)))
3655 3650
3656(defun ad-unadvise (function) 3651(defun ad-unadvise (function)
3657 "Deactivates FUNCTION and then removes all its advice information. 3652 "Deactivates FUNCTION and then remove all its advice information.
3658If FUNCTION was not advised this will be a noop." 3653If FUNCTION was not advised this will be a noop."
3659 (interactive 3654 (interactive
3660 (list (ad-read-advised-function "Unadvise function: "))) 3655 (list (ad-read-advised-function "Unadvise function: ")))
@@ -3666,7 +3661,7 @@ If FUNCTION was not advised this will be a noop."
3666 (ad-pop-advised-function function)))) 3661 (ad-pop-advised-function function))))
3667 3662
3668(defun ad-recover (function) 3663(defun ad-recover (function)
3669 "Tries to recover FUNCTION's original definition and unadvises it. 3664 "Try to recover FUNCTION's original definition and unadvises it.
3670This is more low-level than `ad-unadvise' because it does not do any 3665This is more low-level than `ad-unadvise' because it does not do any
3671deactivation which might run hooks and get into other trouble. 3666deactivation which might run hooks and get into other trouble.
3672Use in emergencies." 3667Use in emergencies."
@@ -3701,7 +3696,7 @@ See `ad-activate' for documentation on the optional COMPILE argument."
3701 (ad-deactivate function)))) 3696 (ad-deactivate function))))
3702 3697
3703(defun ad-update-regexp (regexp &optional compile) 3698(defun ad-update-regexp (regexp &optional compile)
3704 "Updates functions with an advice name containing a REGEXP match. 3699 "Update functions with an advice name containing a REGEXP match.
3705See `ad-activate' for documentation on the optional COMPILE argument." 3700See `ad-activate' for documentation on the optional COMPILE argument."
3706 (interactive 3701 (interactive
3707 (list (ad-read-regexp "Update via advice regexp: ") 3702 (list (ad-read-regexp "Update via advice regexp: ")
@@ -3724,8 +3719,8 @@ See `ad-activate' for documentation on the optional COMPILE argument."
3724 (ad-deactivate function))) 3719 (ad-deactivate function)))
3725 3720
3726(defun ad-update-all (&optional compile) 3721(defun ad-update-all (&optional compile)
3727 "Updates all currently advised functions. 3722 "Update all currently advised functions.
3728With prefix argument compiles resulting advised definitions." 3723With prefix argument, COMPILE resulting advised definitions."
3729 (interactive "P") 3724 (interactive "P")
3730 (ad-do-advised-functions (function) 3725 (ad-do-advised-functions (function)
3731 (ad-update function compile))) 3726 (ad-update function compile)))
@@ -3752,10 +3747,10 @@ With prefix argument compiles resulting advised definitions."
3752 3747
3753;;;###autoload 3748;;;###autoload
3754(defmacro defadvice (function args &rest body) 3749(defmacro defadvice (function args &rest body)
3755 "Defines a piece of advice for FUNCTION (a symbol). 3750 "Define a piece of advice for FUNCTION (a symbol).
3756The syntax of `defadvice' is as follows: 3751The syntax of `defadvice' is as follows:
3757 3752
3758 (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) 3753 \(defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
3759 [DOCSTRING] [INTERACTIVE-FORM] 3754 [DOCSTRING] [INTERACTIVE-FORM]
3760 BODY... ) 3755 BODY... )
3761 3756
@@ -3785,7 +3780,7 @@ FUNCTION has been properly defined prior to this application of `defadvice'.
3785`compile': In conjunction with `activate' specifies that the resulting 3780`compile': In conjunction with `activate' specifies that the resulting
3786advised function should be compiled. 3781advised function should be compiled.
3787 3782
3788`disable': The defined advice will be disabled, hence, it will not be used 3783`disable': The defined advice will be disabled, hence, it will not be used
3789during activation until somebody enables it. 3784during activation until somebody enables it.
3790 3785
3791`preactivate': Preactivates the advised FUNCTION at macro-expansion/compile 3786`preactivate': Preactivates the advised FUNCTION at macro-expansion/compile
@@ -3800,7 +3795,7 @@ the advised function. `freeze' implies `activate' and `preactivate'. The
3800documentation of the advised function can be dumped onto the `DOC' file 3795documentation of the advised function can be dumped onto the `DOC' file
3801during preloading. 3796during preloading.
3802 3797
3803Look at the file `advice.el' for comprehensive documentation." 3798See Info node `(elisp)Advising Functions' for comprehensive documentation."
3804 (if (not (ad-name-p function)) 3799 (if (not (ad-name-p function))
3805 (error "defadvice: Invalid function name: %s" function)) 3800 (error "defadvice: Invalid function name: %s" function))
3806 (let* ((class (car args)) 3801 (let* ((class (car args))
@@ -3840,7 +3835,7 @@ Look at the file `advice.el' for comprehensive documentation."
3840 ;; jwz's idea: Freeze the advised definition into a dumpable 3835 ;; jwz's idea: Freeze the advised definition into a dumpable
3841 ;; defun/defmacro whose docs can be written to the DOC file: 3836 ;; defun/defmacro whose docs can be written to the DOC file:
3842 (ad-make-freeze-definition function advice class position) 3837 (ad-make-freeze-definition function advice class position)
3843 ;; the normal case: 3838 ;; the normal case:
3844 (` (progn 3839 (` (progn
3845 (ad-add-advice '(, function) '(, advice) '(, class) '(, position)) 3840 (ad-add-advice '(, function) '(, advice) '(, class) '(, position))
3846 (,@ (if preactivation 3841 (,@ (if preactivation
@@ -3865,7 +3860,7 @@ Look at the file `advice.el' for comprehensive documentation."
3865;; ========= 3860;; =========
3866 3861
3867(defmacro ad-with-originals (functions &rest body) 3862(defmacro ad-with-originals (functions &rest body)
3868 "Binds FUNCTIONS to their original definitions and executes BODY. 3863 "Binds FUNCTIONS to their original definitions and execute BODY.
3869For any members of FUNCTIONS that are not currently advised the rebinding will 3864For any members of FUNCTIONS that are not currently advised the rebinding will
3870be a noop. Any modifications done to the definitions of FUNCTIONS will be 3865be a noop. Any modifications done to the definitions of FUNCTIONS will be
3871undone on exit of this macro." 3866undone on exit of this macro."
@@ -3929,7 +3924,7 @@ undone on exit of this macro."
3929 ad-return-value (match-beginning 1) (match-end 1))))) 3924 ad-return-value (match-beginning 1) (match-end 1)))))
3930 (cond ((ad-is-advised function) 3925 (cond ((ad-is-advised function)
3931 (setq ad-return-value (ad-make-advised-docstring function)) 3926 (setq ad-return-value (ad-make-advised-docstring function))
3932 ;; Handle optional `raw' argument: 3927 ;; Handle optional `raw' argument:
3933 (if (not (ad-get-arg 1)) 3928 (if (not (ad-get-arg 1))
3934 (setq ad-return-value 3929 (setq ad-return-value
3935 (substitute-command-keys ad-return-value)))))))) 3930 (substitute-command-keys ad-return-value))))))))
@@ -3939,7 +3934,7 @@ undone on exit of this macro."
3939;; =================================================================== 3934;; ===================================================================
3940 3935
3941(defun ad-start-advice () 3936(defun ad-start-advice ()
3942 "Starts the automatic advice handling magic." 3937 "Start the automatic advice handling magic."
3943 (interactive) 3938 (interactive)
3944 ;; Advising `ad-activate-internal' means death!! 3939 ;; Advising `ad-activate-internal' means death!!
3945 (ad-set-advice-info 'ad-activate-internal nil) 3940 (ad-set-advice-info 'ad-activate-internal nil)
@@ -3958,7 +3953,7 @@ You should only need this in case of Advice-related emergencies."
3958 (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off)) 3953 (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off))
3959 3954
3960(defun ad-recover-normality () 3955(defun ad-recover-normality ()
3961 "Undoes all advice related redefinitions and unadvises everything. 3956 "Undo all advice related redefinitions and unadvises everything.
3962Use only in REAL emergencies." 3957Use only in REAL emergencies."
3963 (interactive) 3958 (interactive)
3964 ;; Advising `ad-activate-internal' means death!! 3959 ;; Advising `ad-activate-internal' means death!!
@@ -3967,11 +3962,6 @@ Use only in REAL emergencies."
3967 (ad-recover-all) 3962 (ad-recover-all)
3968 (setq ad-advised-functions nil)) 3963 (setq ad-advised-functions nil))
3969 3964
3970;; Until the Advice-related changes to `data.c' are part of Lemacs we
3971;; have to load the old implementation of advice activation hooks:
3972(if (ad-lemacs-p)
3973 (require 'ad-hooks))
3974
3975(ad-start-advice) 3965(ad-start-advice)
3976 3966
3977(provide 'advice) 3967(provide 'advice)