diff options
| author | Dave Love | 1999-10-27 11:59:45 +0000 |
|---|---|---|
| committer | Dave Love | 1999-10-27 11:59:45 +0000 |
| commit | fce4437307ab8004a8d4e818d0e5897fc0d27cc9 (patch) | |
| tree | f1b81b792462943bf42b36ece135a3608c07f02c | |
| parent | 6b5c0a2e942d1ec1560c5a3a591d1c44034ea203 (diff) | |
| download | emacs-fce4437307ab8004a8d4e818d0e5897fc0d27cc9.tar.gz emacs-fce4437307ab8004a8d4e818d0e5897fc0d27cc9.zip | |
Doc fixes.
(ad-lemacs-p): Removed.
(advice): Add :link to defgroup.
| -rw-r--r-- | lisp/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/emacs-lisp/advice.el | 440 |
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 @@ | |||
| 1 | 1999-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 | |||
| 1 | 1999-10-27 Kenichi Handa <handa@etl.go.jp> | 7 | 1999-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'." | |||
| 1859 | A value of `always' will result in unconditional compilation, `never' will | 1854 | A value of `always' will result in unconditional compilation, `never' will |
| 1860 | always avoid compilation, `maybe' will compile if the byte-compiler is already | 1855 | always avoid compilation, `maybe' will compile if the byte-compiler is already |
| 1861 | loaded, and `like-original' will compile if the original definition of the | 1856 | loaded, and `like-original' will compile if the original definition of the |
| 1862 | advised function is compiled or a built-in function. Every other value will | 1857 | advised function is compiled or a built-in function. Every other value will |
| 1863 | be interpreted as `maybe'. This variable will only be considered if the | 1858 | be interpreted as `maybe'. This variable will only be considered if the |
| 1864 | COMPILE argument of `ad-activate' was supplied as nil." | 1859 | COMPILE 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) | 1873 | Only 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 | 1874 | then 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 | 1875 | allowed too. Once a qualifying subtree has been found its subtrees will |
| 1881 | ;;not be considered anymore. (ad-substitute-tree 'atom 'identity tree) | 1876 | not be considered anymore. (ad-substitute-tree 'atom 'identity tree) |
| 1882 | ;;generates a copy of TREE." | 1877 | generates 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 | 2004 | On 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." | 2026 | This 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." | 2031 | Assumes 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." | 2101 | Redefining 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 | 2203 | An optional PROMPT will be used to prompt for the function. PREDICATE |
| 2209 | ;;plays the same role as for `try-completion' (which see). DEFAULT will | 2204 | plays the same role as for `try-completion' (which see). DEFAULT will |
| 2210 | ;;be returned on empty input (defaults to the first advised function for | 2205 | be returned on empty input (defaults to the first advised function for |
| 2211 | ;;which PREDICATE returns non-nil)." | 2206 | which 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 | 2242 | An 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 | 2243 | be returned on empty input (defaults to the first non-empty advice |
| 2249 | ;;class of FUNCTION)." | 2244 | class 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." | 2260 | An 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 | 2278 | The list of read symbols will be returned. The optional PROMPT will |
| 2284 | ;;be used to prompt for the function." | 2279 | be 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. |
| 2319 | NAME can be a symbol or a regular expression matching part of an advice name. | 2314 | NAME can be a symbol or a regular expression matching part of an advice name. |
| 2320 | If CLASS is `any' all legal advice classes will be checked." | 2315 | If 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 | 2333 | If 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 | 2334 | expression 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 | 2335 | affected. 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 | 2336 | considered. The number of changed advices will be returned (or nil if |
| 2342 | ;;FUNCTION was not advised)." | 2337 | FUNCTION 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 | 2372 | If CLASS is `any' all legal advice classes are considered. The number of |
| 2378 | ;;affected advices will be returned." | 2373 | affected 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. |
| 2400 | All currently advised functions will be considered." | 2395 | All 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. |
| 2410 | If such an advice was found it will be removed from the list of advices | 2405 | If such an advice was found it will be removed from the list of advices |
| 2411 | in that CLASS." | 2406 | in 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. |
| 2426 | If FUNCTION already has one or more pieces of advice of the specified | 2421 | If FUNCTION already has one or more pieces of advice of the specified |
| 2427 | CLASS then POSITION determines where the new piece will go. The value | 2422 | CLASS then POSITION determines where the new piece will go. The value |
| 2428 | of POSITION can either be `first', `last' or a number where 0 corresponds | 2423 | of 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 | |||
| 2430 | extreme position. If there was already a piece of ADVICE with the same | 2425 | extreme position. If there was already a piece of ADVICE with the same |
| 2431 | name, then the position argument will be ignored and the old advice | 2426 | name, then the position argument will be ignored and the old advice |
| 2432 | will be overwritten with the new one. | 2427 | will 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 |
| 2434 | initialized. Redefining a piece of advice whose name is part of the cache-id | 2429 | initialized. Redefining a piece of advice whose name is part of the cache-id |
| 2435 | will clear the cache." | 2430 | will 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 | 2536 | If DEFINITION could be from a subr then its NAME should be |
| 2542 | ;;supplied to make subr arglist lookup more efficient." | 2537 | supplied 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, | 2564 | Either use the one stored under the `ad-subr-arglist' property, |
| 2570 | ;;or try to retrieve it from the docstring and cache it under | 2565 | or try to retrieve it from the docstring and cache it under |
| 2571 | ;;that property, or otherwise use `(&rest ad-subr-args)'." | 2566 | that 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 | 2635 | Put function name into the documentation string so we can infer |
| 2641 | ;; the name of the advised function from the docstring. This is needed | 2636 | the 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 | 2637 | to generate a proper advised docstring even if we are just given a |
| 2643 | ;; definition (also see the defadvice for `documentation'): | 2638 | definition (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." | 2667 | For 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 | 2743 | A 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 | 2744 | required arguments, the 2nd is the list of optional arguments, and the 3rd |
| 2750 | ;;is the name of an optional rest parameter (or nil)." | 2745 | is 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 | 2757 | When 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 | 2758 | it 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 | 2759 | first 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 | 2760 | element 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 | 2793 | For 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." | 2794 | to 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." | 2843 | The 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. |
| 2925 | The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just | 2920 | The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just |
| 2926 | as if they had been supplied to a function with TARGET-ARGLIST directly. | 2921 | as if they had been supplied to a function with TARGET-ARGLIST directly. |
| 2927 | Excess source arguments will be neglected, missing source arguments will be | 2922 | Excess source arguments will be neglected, missing source arguments will be |
| 2928 | supplied as nil. Returns a `funcall' or `apply' form with the second element | 2923 | supplied as nil. Returns a `funcall' or `apply' form with the second element |
| 2929 | being `function' which has to be replaced by an actual function argument. | 2924 | being `function' which has to be replaced by an actual function argument. |
| 2930 | Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return | 2925 | Example: `(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 | 3133 | It 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 | 3134 | be 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 | 3135 | that 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, | 3136 | definition, 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, | 3137 | ORIG 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 | 3138 | and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG |
| 3144 | ;;should be modified. The assembled function will be returned." | 3139 | should 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. | 3498 | If COMPILE is non-nil and not a negative number then it returns t. |
| 3504 | ;;If COMPILE is a negative number then it returns nil. | 3499 | If COMPILE is a negative number then it returns nil. |
| 3505 | ;;If COMPILE is nil then the result depends on the value of | 3500 | If 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. | 3518 | The 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." | 3519 | The 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. |
| 3658 | If FUNCTION was not advised this will be a noop." | 3653 | If 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. |
| 3670 | This is more low-level than `ad-unadvise' because it does not do any | 3665 | This is more low-level than `ad-unadvise' because it does not do any |
| 3671 | deactivation which might run hooks and get into other trouble. | 3666 | deactivation which might run hooks and get into other trouble. |
| 3672 | Use in emergencies." | 3667 | Use 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. |
| 3705 | See `ad-activate' for documentation on the optional COMPILE argument." | 3700 | See `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. |
| 3728 | With prefix argument compiles resulting advised definitions." | 3723 | With 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). |
| 3756 | The syntax of `defadvice' is as follows: | 3751 | The 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 |
| 3786 | advised function should be compiled. | 3781 | advised 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 |
| 3789 | during activation until somebody enables it. | 3784 | during 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 | |||
| 3800 | documentation of the advised function can be dumped onto the `DOC' file | 3795 | documentation of the advised function can be dumped onto the `DOC' file |
| 3801 | during preloading. | 3796 | during preloading. |
| 3802 | 3797 | ||
| 3803 | Look at the file `advice.el' for comprehensive documentation." | 3798 | See 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. |
| 3869 | For any members of FUNCTIONS that are not currently advised the rebinding will | 3864 | For any members of FUNCTIONS that are not currently advised the rebinding will |
| 3870 | be a noop. Any modifications done to the definitions of FUNCTIONS will be | 3865 | be a noop. Any modifications done to the definitions of FUNCTIONS will be |
| 3871 | undone on exit of this macro." | 3866 | undone 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. |
| 3962 | Use only in REAL emergencies." | 3957 | Use 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) |