;ELC ;;; Compiled by pot@pot.cnuce.cnr.it on Tue Mar 18 15:38:49 2003 ;;; from file /home/pot/gnu/emacs-pretest.new/lisp/emacs-lisp/advice.el ;;; in Emacs version 21.3 ;;; with bytecomp version 2.85.4.1 ;;; with all optimizations. ;;; This file uses dynamic docstrings, first added in Emacs 19.29. (if (and (boundp 'emacs-version) (< (aref emacs-version (1- (length emacs-version))) ?A) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19.29"))) (error "`advice.el' was compiled for Emacs 19.29 or later")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (byte-code "\302\303!\210\304\303\305\"\210\306\307\310\311\312\313\314\315\316\317& \210\301B\320\310\207" [current-load-list ad-version provide advice-preload require "advice.el" custom-declare-group advice nil "An overloading mechanism for Emacs Lisp functions." :prefix "ad-" :link (custom-manual "(elisp)Advising Functions") :group lisp "2.14"] 10) #@615 *Defines what to do with redefinitions during Advice de/activation. Redefinition occurs if a previously activated function that already has an original definition associated with it gets redefined and then de/activated. In such a case we can either accept the current definition as the new original definition, discard the current definition and replace it with the old original, or keep it and raise an error. The values `accept', `discard', `error' or `warn' govern what will be done. `warn' is just like `accept' but it additionally prints a warning message. All other values will be interpreted as `error'. (custom-declare-variable 'ad-redefinition-action ''warn '(#$ . -983) :type '(choice (const accept) (const discard) (const warn) (other :tag "error" error)) :group 'advice) #@502 *Defines whether to compile advised definitions during activation. A value of `always' will result in unconditional compilation, `never' will always avoid compilation, `maybe' will compile if the byte-compiler is already loaded, and `like-original' will compile if the original definition of the advised function is compiled or a built-in function. Every other value will be interpreted as `maybe'. This variable will only be considered if the COMPILE argument of `ad-activate' was supplied as nil. (custom-declare-variable 'ad-default-compilation-action ''maybe '(#$ . -1776) :type '(choice (const always) (const never) (const like-original) (other :tag "maybe" maybe)) :group 'advice) #@379 Substitute qualifying subTREEs with result of FUNCTION(subTREE). Only proper subtrees are considered, for example, if TREE is (1 (2 (3)) 4) then the subtrees will be 1 (2 (3)) 2 (3) 3 4, dotted structures are allowed too. Once a qualifying subtree has been found its subtrees will not be considered anymore. (ad-substitute-tree 'atom 'identity tree) generates a copy of TREE. (defalias 'ad-substitute-tree #[(sUbTrEe-TeSt fUnCtIoN tReE) ":\203, @!\203\n@!\202$@:\203\"\303 \n@#\202$@\303 \nA#B\207 !\2036\n!\207\207" [tReE sUbTrEe-TeSt fUnCtIoN ad-substitute-tree] 5 (#$ . 2472)]) #@46 Return a copy of the list structure of TREE. (defalias 'ad-copy-tree #[(tree) ":\203\301@!\301A!B\207\207" [tree ad-copy-tree] 3 (#$ . 3078)]) #@409 A Common-Lisp-style dolist iterator with the following syntax: (ad-dolist (VAR INIT-FORM [RESULT-FORM]) BODY-FORM...) which will iterate over the list yielded by INIT-FORM binding VAR to the current head at every iteration. If RESULT-FORM is supplied its value will be returned at the end of the iteration, nil otherwise. The iteration can be exited prematurely with `(ad-do-return [VALUE])'. (defalias 'ad-dolist '(macro . #[(varform &rest body) "\303\304A@D@D\305\304\306@\307BB\310 \311C\"BBBAA@F\312\313\215\203,\314\315\nE\202-\n)\207" [varform body expansion let ad-dO-vAr while setq ((car ad-dO-vAr)) append (setq ad-dO-vAr (cdr ad-dO-vAr)) contains-return (byte-code "\301\302\303#\210\304\207" [body ad-substitute-tree #[(subtree) "\242\301=\206\242\302=\205\303\304\305\"\207" [subtree ad-dolist ad-do-return throw contains-return t] 3] identity nil] 4) catch 'ad-dO-eXiT] 8 (#$ . 3234)])) (defalias 'ad-do-return '(macro . #[(value) "\301\302E\207" [value throw 'ad-dO-eXiT] 3])) (byte-code "\300\301N\204\f\302\300\301\303#\210\300\207" [ad-dolist lisp-indent-hook put 1] 4) (defalias 'ad-save-real-definition '(macro . #[(function) "\302\303\304\"!\305\306\307\"\210\310\311\312\313 DDD\314\315\313 D\316\313DDE\317\306N\2052\320\313 D\321\313\306NDFC\322N\205D\320\313 D\323\313\322NDFC\"BBE)\207" [function saved-function intern format "ad-real-%s" require byte-compile "bytecomp" if not fboundp quote progn fset symbol-function append put 'byte-compile byte-opcode 'byte-opcode] 12])) (defalias 'ad-save-real-definitions #[nil "\300\301!\204\301\302KM\210\303\301\304\305#\210\303\301\306\307#\210\300\310!?\205\"\310\311KM\207" [fboundp ad-real-fset fset put byte-compile byte-compile-fset byte-opcode byte-fset ad-real-documentation documentation] 4]) (byte-code "\302 \210\301B\303\301!\204\304\304\207" [current-load-list ad-advised-functions ad-save-real-definitions boundp nil] 2) #@66 Add FUNCTION to `ad-advised-functions' unless its already there. (defalias 'ad-pushnew-advised-function '(macro . #[(function) "\301\302\303\304D\305BBD\306\307\310\311\304DD\312BBEE\207" [function if not assoc symbol-name (ad-advised-functions) setq ad-advised-functions cons list (ad-advised-functions)] 8 (#$ . 5191)])) #@46 Remove FUNCTION from `ad-advised-functions'. (defalias 'ad-pop-advised-function '(macro . #[(function) "\301\302\303\304\305D\306BB\307BBE\207" [function setq ad-advised-functions delq assoc symbol-name (ad-advised-functions) (ad-advised-functions)] 6 (#$ . 5522)])) #@212 `ad-dolist'-style iterator that maps over `ad-advised-functions'. (ad-do-advised-functions (VAR [RESULT-FORM]) BODY-FORM...) On each iteration VAR will be bound to the name of an advised function (a symbol). (defalias 'ad-do-advised-functions '(macro . #[(varform &rest body) "\302@\303A@E\304@\305\306@DDE BBB\207" [varform body ad-dolist ad-advised-functions setq intern car] 7 (#$ . 5797)])) (byte-code "\300\301N\204\f\302\300\301\303#\210\300\207" [ad-do-advised-functions lisp-indent-hook put 1] 4) (defalias 'ad-get-advice-info '(macro . #[(function) "\301\302BB\207" [function get ('ad-advice-info)] 3])) (defalias 'ad-set-advice-info '(macro . #[#'advice-info "\302\303 F\207" [function advice-info put 'ad-advice-info] 4])) (defalias 'ad-copy-advice-info '(macro . #[(function) "\301\302\303BBD\207" [function ad-copy-tree get ('ad-advice-info)] 4])) #@119 Return non-nil if FUNCTION has any advice info associated with it. This does not mean that the advice is also active. (defalias 'ad-is-advised '(macro . #[(function) "\301D\207" [function ad-get-advice-info] 2 (#$ . 6676)])) #@90 Initialize the advice info for FUNCTION. Assumes that FUNCTION has not yet been advised. (defalias 'ad-initialize-advice-info #[(function) "\302\303! \"\204\303!C B\304\305\306\307BC#\207" [function ad-advised-functions assoc symbol-name put ad-advice-info active nil] 5 (#$ . 6908)]) #@58 Retrieve the value of the advice info FIELD of FUNCTION. (defalias 'ad-get-advice-info-field '(macro . #[#'field "\302\303\304 DED\207" [field function cdr assq ad-get-advice-info] 5 (#$ . 7205)])) #@66 Destructively modify VALUE of the advice info FIELD of FUNCTION. (defalias 'ad-set-advice-info-field #[(function field value) "\303N\205 \303N\236\203 \303N\236\n\241\207\303N \nBC\244\207" [function field value ad-advice-info] 3 (#$ . 7410)]) #@54 Return non-nil if FUNCTION is advised and activated. (defalias 'ad-is-active #[(function) "\301\302N\236A\207" [function active ad-advice-info] 3 (#$ . 7668)]) #@263 Constructs single piece of advice to be stored in some advice-info. NAME should be a non-nil symbol, PROTECT and ENABLE should each be either t or nil, and DEFINITION should be a list of the form `(advice lambda ARGLIST [DOCSTRING] [INTERACTIVE-FORM] BODY...)'. (defalias 'ad-make-advice #[(name protect enable definition) " \n F\207" [name protect enable definition] 4 (#$ . 7836)]) (defalias 'ad-advice-name '(macro . #[(advice) "\301D\207" [advice car] 2])) (defalias 'ad-advice-protected '(macro . #[(advice) "\301\302E\207" [advice nth 1] 3])) (defalias 'ad-advice-enabled '(macro . #[(advice) "\301\302E\207" [advice nth 2] 3])) (defalias 'ad-advice-definition '(macro . #[(advice) "\301\302E\207" [advice nth 3] 3])) (defalias 'ad-advice-set-enabled #[(advice flag) "AA \240\207" [advice flag] 2]) (defalias 'ad-class-p #[(thing) " >\207" [thing ad-advice-classes] 2]) (defalias 'ad-name-p #[(thing) "\2059\207" [thing] 1]) (defalias 'ad-position-p #[(thing) "\301!\206 \302>\207" [thing natnump (first last)] 2]) (byte-code "\301B\302\301!\204\f\303\301\207" [current-load-list ad-advice-classes boundp (before around after activation deactivation)] 2) #@65 True if at least one of FUNCTION's advices in CLASS is enabled. (defalias 'ad-has-enabled-advice #[#'class "\300\301\215\207" [ad-dO-eXiT (byte-code " \304N\236A\305\211\203\" @\306\n8\203\307\310\311\"\210 A\211\204 *\305\207" [class function advice ad-dO-vAr ad-advice-info nil 2 throw ad-dO-eXiT t] 4)] 2 (#$ . 9021)]) #@139 True if FUNCTION's advice info defines at least 1 redefining advice. Redefining advices affect the construction of an advised definition. (defalias 'ad-has-redefining-advice #[(function) "\301N\205\302\303\"\206\302\304\"\206\302\305\"\207" [function ad-advice-info ad-has-enabled-advice before around after] 3 (#$ . 9359)]) #@66 True if the advice info of FUNCTION defines at least one advice. (defalias 'ad-has-any-advice #[(function) "\301N\205 \302\303\215\207" [function ad-advice-info ad-dO-eXiT (byte-code "\304\211\203 \n@\211 \305N\236A\203\306\307\310\"\210\nA\211\204*\304\207" [ad-advice-classes class ad-dO-vAr function nil ad-advice-info throw ad-dO-eXiT t] 4)] 2 (#$ . 9700)]) #@58 Return the list of enabled advices of FUNCTION in CLASS. (defalias 'ad-get-enabled-advices #[#'class "\305 \n\306N\236A\305\211\203#\f@\307 8\203 B\fA\211\204*\310!)\207" [enabled-advices class function advice ad-dO-vAr nil ad-advice-info 2 reverse] 4 (#$ . 10080)]) #@72 Automatic advice activation is disabled. `ad-start-advice' enables it. (defalias 'ad-activate-internal #[(function &optional compile) "\300\207" [nil] 1 (#$ . 10366)]) #@72 Automatic advice activation is disabled. `ad-start-advice' enables it. (defalias 'ad-activate-internal-off #[(function &optional compile) "\300\207" [nil] 1 (#$ . 10540)]) (byte-code "\301B\302\301!\204\f\303\301\207" [current-load-list ad-activate-on-top-level boundp t] 2) (defalias 'ad-with-auto-activation-disabled '(macro . #[(&rest body) "\301\302BB\207" [body let ((ad-activate-on-top-level nil))] 3])) #@73 A safe `fset' which will never call `ad-activate-internal' recursively. (defalias 'ad-safe-fset #[(symbol definition) "\303 \nM)\207" [ad-activate-on-top-level symbol definition nil] 2 (#$ . 10961)]) #@53 Make name to be used to call the original FUNCTION. (defalias 'ad-make-origname #[(function) "\301\302\303\"!\207" [function intern format "ad-Orig-%s"] 4 (#$ . 11168)]) (defalias 'ad-get-orig-definition '(macro . #[(function) "\301\302\303\304BBDC\305BB\207" [function let origname ad-get-advice-info-field ('origname) ((if (fboundp origname) (symbol-function origname)))] 5])) (defalias 'ad-set-orig-definition '(macro . #[#'definition "\301\302E\207" [definition ad-safe-fset (ad-get-advice-info-field function 'origname)] 3])) (defalias 'ad-clear-orig-definition '(macro . #[(function) "\301\302\303BBD\207" [function fmakunbound ad-get-advice-info-field ('origname)] 4])) #@315 Read name of advised function with completion from the minibuffer. An optional PROMPT will be used to prompt for the function. PREDICATE plays the same role as for `try-completion' (which see). DEFAULT will be returned on empty input (defaults to the first advised function for which PREDICATE returns non-nil). (defalias 'ad-read-advised-function #[(&optional prompt predicate default) "\204\306\307!\210 \206\310\311\215\206\306\312\313\"\n\314\315\316\f\206!\317 #\n\205)\320\321$\211\322\232\203C \323N\203< \202F\306\324 \"\202F\325 !*\207" [ad-advised-functions default predicate ad-pReDiCaTe prompt function error "ad-read-advised-function: There are no advised functions" ad-dO-eXiT (byte-code "\304\211\203&\n@\305 @! \203 !\203\306\307 \"\210\nA\211\204*\304\207" [ad-advised-functions function ad-dO-vAr predicate nil intern throw ad-dO-eXiT] 4) "ad-read-advised-function: %s" "There are no qualifying advised functions" completing-read format "%s(default %s) " "Function: " #[(function) "\302 @!!\207" [ad-pReDiCaTe function intern] 3] t "" ad-advice-info "ad-read-advised-function: `%s' is not advised" intern] 6 (#$ . 11856)]) (byte-code "\302B\303\302!\204\304\305 \"\302\207" [current-load-list ad-advice-classes ad-advice-class-completion-table boundp mapcar #[(class) "\301!C\207" [class symbol-name] 2]] 3) #@222 Read a legal advice class with completion from the minibuffer. An optional PROMPT will be used to prompt for the class. DEFAULT will be returned on empty input (defaults to the first non-empty advice class of FUNCTION). (defalias 'ad-read-advice-class #[(function &optional prompt default) "\206\305\306\215\206\307\310 \"\311\312\313\n\206\314# \315\316$\211\317\232\203(\202+\320\f!)\207" [default function prompt ad-advice-class-completion-table class ad-dO-eXiT (byte-code "\304\211\203 \n@\211 \305N\236A\203\306\307 \"\210\nA\211\204*\304\207" [ad-advice-classes class ad-dO-vAr function nil ad-advice-info throw ad-dO-eXiT] 4) error "ad-read-advice-class: `%s' has no advices" completing-read format "%s(default %s) " "Class: " nil t "" intern] 6 (#$ . 13229)]) #@120 Read name of existing advice of CLASS for FUNCTION with completion. An optional PROMPT is used to prompt for the name. (defalias 'ad-read-advice-name #[(function class &optional prompt) "\306\307 \310N\236A\"\211\204\311\312 #\202\n@@\313\314\f\206!\315 #\316\f\n\317\320$\211\321\232\2037\322 !\202:\322 !,\207" [class function name-completion-table default prompt name mapcar #[(advice) "\301@!C\207" [advice symbol-name] 2] ad-advice-info error "ad-read-advice-name: `%s' has no %s advice" format "%s(default %s) " "Name: " completing-read nil t "" intern] 6 (#$ . 14029)]) #@173 Read a complete function/class/name specification from minibuffer. The list of read symbols will be returned. The optional PROMPT will be used to prompt for the function. (defalias 'ad-read-advice-specification #[(&optional prompt) "\304!\305 !\306 \n\" \n E+\207" [prompt function class name ad-read-advised-function ad-read-advice-class ad-read-advice-name] 3 (#$ . 14627)]) (byte-code "\301B\302\301!\204\f\303\301\207" [current-load-list ad-last-regexp boundp ""] 2) #@48 Read a regular expression from the minibuffer. (defalias 'ad-read-regexp #[(&optional prompt) "\303\206\304 \305\232\203\305\202\306\307 \"P!\211\305\232\203! \202\"\n\211)\207" [prompt ad-last-regexp regexp read-from-minibuffer "Regular expression: " "" format "(default \"%s\") "] 6 (#$ . 15113)]) #@55 Find the first advice of FUNCTION in CLASS with NAME. (defalias 'ad-find-advice '(macro . #[(function class name) "\303\304 \nEE\207" [name function class assq ad-get-advice-info-field] 5 (#$ . 15430)])) #@65 Return position of first advice of FUNCTION in CLASS with NAME. (defalias 'ad-advice-position #[(function class name) " \n\305N\236A\236 \n\305N\236A \205\fG \f>GZ*\207" [name class function found-advice advices ad-advice-info] 4 (#$ . 15641)]) #@200 Find the first of FUNCTION's advices in CLASS matching NAME. NAME can be a symbol or a regular expression matching part of an advice name. If CLASS is `any' all legal advice classes will be checked. (defalias 'ad-find-some-advice #[(function class name) "\302N\205\f\303\304\305\215)\207" [function found-advice ad-advice-info nil ad-dO-eXiT (byte-code "\305\211\203+\n@ \306=\204 =\203\307\310\215\f\203$\311\307\f\"\210\nA\211\204*\305\207" [ad-advice-classes advice-class ad-dO-vAr class found-advice nil any ad-dO-eXiT (byte-code " \305N\236A\306\211\2032 @\f;\203\307\f\310\n@!\"\204&\f\n@=\203+\311\312\n\"\210 A\211\204 *\306\207" [advice-class function advice ad-dO-vAr name ad-advice-info nil string-match symbol-name throw ad-dO-eXiT] 5) throw] 4)] 2 (#$ . 15898)]) #@379 Set enable FLAG of FUNCTION's advices in CLASS matching NAME. If NAME is a string rather than a symbol then it's interpreted as a regular expression and all advices whose name contain a match for it will be affected. If CLASS is `any' advices in all legal advice classes will be considered. The number of changed advices will be returned (or nil if FUNCTION was not advised). (defalias 'ad-enable-advice-internal #[(function class name flag) "\306N\205h\307\n\310\211\203e\f@ \311=\204 =\203^ \306N\236A\310 \211\203]\f@ ;\203C\312\313 @!\"\204L @=\203V T\314 \"\210\fA\211\204-*\fA\211\204* )\207" [function matched-advices ad-advice-classes advice-class ad-dO-vAr class ad-advice-info 0 nil any string-match symbol-name ad-advice-set-enabled advice name flag] 5 (#$ . 16710)]) #@53 Enables the advice of FUNCTION with CLASS and NAME. (defalias 'ad-enable-advice #[(function class name) "\303N\203\304 \n\305$\306=\205\307\310 \n$\207\307\311\"\207" [function class name ad-advice-info ad-enable-advice-internal t 0 error "ad-enable-advice: `%s' has no %s advice matching `%s'" "ad-enable-advice: `%s' is not advised"] 5 (#$ . 17533) (ad-read-advice-specification "Enable advice of: ")]) #@53 Disable the advice of FUNCTION with CLASS and NAME. (defalias 'ad-disable-advice #[(function class name) "\303N\203\304 \n\305$\306=\205\307\310 \n$\207\307\311\"\207" [function class name ad-advice-info ad-enable-advice-internal nil 0 error "ad-disable-advice: `%s' has no %s advice matching `%s'" "ad-disable-advice: `%s' is not advised"] 5 (#$ . 17952) (ad-read-advice-specification "Disable advice of: ")]) #@184 Set enable FLAGs of all CLASS advices whose name contains a REGEXP match. If CLASS is `any' all legal advice classes are considered. The number of affected advices will be returned. (defalias 'ad-enable-regexp-internal #[(regexp class flag) "\306 \307\211\203' @\310\n@!\311\n\f \n$\206\306\\ A\211\204\n*)\207" [matched-advices ad-advised-functions advised-function ad-dO-vAr class regexp 0 nil intern ad-enable-advice-internal flag] 7 (#$ . 18378)]) #@117 Enables all advices with names that contain a match for REGEXP. All currently advised functions will be considered. (defalias 'ad-enable-regexp #[(regexp) "\302\303\304#t\203\305\306 \"\210 )\207" [regexp matched-advices ad-enable-regexp-internal any t message "%d matching advices enabled"] 4 (#$ . 18852) (list (ad-read-regexp "Enable advices via regexp: "))]) #@117 Disable all advices with names that contain a match for REGEXP. All currently advised functions will be considered. (defalias 'ad-disable-regexp #[(regexp) "\302\303\304#t\203\305\306 \"\210 )\207" [regexp matched-advices ad-enable-regexp-internal any nil message "%d matching advices disabled"] 4 (#$ . 19226) (list (ad-read-regexp "Disable advices via regexp: "))]) #@150 Remove FUNCTION's advice with NAME from its advices in CLASS. If such an advice was found it will be removed from the list of advices in that CLASS. (defalias 'ad-remove-advice #[(function class name) "\304N\203+ \n\304N\236A\236\211\203#\305\n\306 \n\304N\236A\"#\202)\307\310\n $)\207\307\311\"\207" [function name class advice-to-remove ad-advice-info ad-set-advice-info-field delq error "ad-remove-advice: `%s' has no %s advice `%s'" "ad-remove-advice: `%s' is not advised"] 9 (#$ . 19605) (ad-read-advice-specification "Remove advice of: ")]) #@699 Add a piece of ADVICE to FUNCTION's list of advices in CLASS. If FUNCTION already has one or more pieces of advice of the specified CLASS then POSITION determines where the new piece will go. The value of POSITION can either be `first', `last' or a number where 0 corresponds to `first'. Numbers outside the range will be mapped to the closest extreme position. If there was already a piece of ADVICE with the same name, then the position argument will be ignored and the old advice will be overwritten with the new one. If the FUNCTION was not advised already, then its advice info will be initialized. Redefining a piece of advice whose name is part of the cache-id will clear the cache. (defalias 'ad-add-advice #[(function advice class position) "\306N\204\307!\210\310\311\312!#\210\313 \n@# \306N\236A \206H \314=\203.\315\202H \316=\2039\fG\202H \247\203G\315 \fG^]\202H\315\n@\317 \">\203W\320!\210 \203c \f\233\n\240\202} \315U\203s\310 \n\fB#\202} S\f\233\n \f\233B\241+\207" [function class advice previous-position advices position ad-advice-info ad-initialize-advice-info ad-set-advice-info-field origname ad-make-origname ad-advice-position first 0 last ad-get-cache-class-id ad-clear-cache] 5 (#$ . 20170)]) #@63 Take a lambda function DEFINITION and make a macro out of it. (defalias 'ad-macrofy '(macro . #[(definition) "\301\302E\207" [definition cons 'macro] 3 (#$ . 21433)])) #@63 Take a macro function DEFINITION and make a lambda out of it. (defalias 'ad-lambdafy '(macro . #[(definition) "\301D\207" [definition cdr] 2 (#$ . 21608)])) (byte-code "\302B\303\302!\204\304\305\306!\203\306 B\307\310 \")\302\207" [current-load-list tem ad-special-forms boundp (and catch cond condition-case defconst defmacro defun defvar function if interactive let let* or prog1 prog2 progn quote save-current-buffer save-excursion save-restriction save-window-excursion setq setq-default unwind-protect while with-output-to-temp-buffer) fboundp track-mouse mapcar symbol-function] 3) (defalias 'ad-special-form-p '(macro . #[(definition) "\301\302E\207" [definition memq ad-special-forms] 3])) (defalias 'ad-interactive-p '(macro . #[(definition) "\301D\207" [definition commandp] 2])) (defalias 'ad-subr-p '(macro . #[(definition) "\301D\207" [definition subrp] 2])) (defalias 'ad-macro-p '(macro . #[(definition) "\301\302D\303BB\207" [definition eq car-safe ('macro)] 3])) (defalias 'ad-lambda-p '(macro . #[(definition) "\301\302D\303BB\207" [definition eq car-safe ('lambda)] 3])) (defalias 'ad-advice-p '(macro . #[(definition) "\301\302D\303BB\207" [definition eq car-safe ('advice)] 3])) (byte-code "\300\301!\204\300\302!\203\303\301\302\"\210\300\207" [fboundp byte-code-function-p compiled-function-p ad-safe-fset] 3) #@62 Return non-nil if DEFINITION is a compiled byte-code object. (defalias 'ad-compiled-p '(macro . #[(definition) "\301\302D\303\304D\302\305DDEE\207" [definition or byte-code-function-p and ad-macro-p ad-lambdafy] 7 (#$ . 22968)])) #@55 Return the byte-code object of a COMPILED-DEFINITION. (defalias 'ad-compiled-code '(macro . #[(compiled-definition) "\301\302D\303DF\207" [compiled-definition if ad-macro-p ad-lambdafy] 4 (#$ . 23207)])) #@69 Return the lambda expression of a function/macro/advice DEFINITION. (defalias 'ad-lambda-expression #[(definition) "\242\301=\203 \207\242\302=\203A\207\242\303=\203A\207\304\207" [definition lambda macro advice nil] 2 (#$ . 23420)]) #@153 Return the argument list of DEFINITION. If DEFINITION could be from a subr then its NAME should be supplied to make subr arglist lookup more efficient. (defalias 'ad-arglist #[(definition &optional name) "\302!\204\242\303=\203$\302A!\203$\242\303=\203 A\202!\304H\207:\203/\305!A@\207\306!\205Q \203=\307 !\207\310\311\"\312\313 \"\210\307\314 \315\224\315\225O!!\207" [definition name byte-code-function-p macro 0 ad-lambda-expression subrp ad-subr-arglist format "%s" string-match "^#]+\\)>$" intern 1] 5 (#$ . 23672)]) (defalias 'ad-define-subr-args '(macro . #[(subr arglist) "\302\303\304 DF\207" [subr arglist put 'ad-subr-arglist list] 5])) (defalias 'ad-undefine-subr-args '(macro . #[(subr) "\301\302BB\207" [subr put ('ad-subr-arglist nil)] 3])) (defalias 'ad-subr-args-defined-p '(macro . #[(subr) "\301\302BB\207" [subr get ('ad-subr-arglist)] 3])) (defalias 'ad-get-subr-args '(macro . #[(subr) "\301\302\303BBD\207" [subr car get ('ad-subr-arglist)] 4])) #@226 Retrieve arglist of the subr with SUBR-NAME. Either use the one stored under the `ad-subr-arglist' property, or try to retrieve it from the docstring and cache it under that property, or otherwise use `(&rest ad-subr-args)'. (defalias 'ad-subr-arglist #[(subr-name) "\302N\203 \302N@\207\303\304\"\206\305\306\307 \"\2033\310\302\311 \312\224\312\225O\227!@AC#\210\302N@\202P\306\313 \"\203O\310\302\311 \312\224\312\225#@C#\210\302N@\202P\314)\207" [subr-name doc ad-subr-arglist ad-real-documentation t "" string-match "^\\(([^)]+)\\)\n?\\'" put read-from-string 1 "[\n ]*\narguments: ?\\((.*)\\)\n?\\'" (&rest ad-subr-args)] 7 (#$ . 24685)]) #@48 Return the unexpanded docstring of DEFINITION. (defalias 'ad-docstring #[(definition) "\302!\204\242\303=\203\302A!\203\304\305\"\202!\306!AA@\211;\204-\307 !\205. )\207" [definition docstring byte-code-function-p macro ad-real-documentation t ad-lambda-expression natnump] 4 (#$ . 25352)]) #@44 Return the interactive form of DEFINITION. (defalias 'ad-interactive-form #[(definition) "\301!\204\242\302=\203,\301A!\203,\303!\205?\304\242\302=\203'A\202(\305HD\207\242\306=\204:\242\307=\205?\303\310!!\207" [definition byte-code-function-p macro commandp interactive 5 advice lambda ad-lambda-expression] 3 (#$ . 25664)]) #@46 Return the list of body forms of DEFINITION. (defalias 'ad-body-forms #[(definition) "\301!\204\242\302=\203\301A!\203\303\207:\2058\304!\203%\305\202&\306\307!\2030\305\2021\306\\\310!AA\233\207" [definition byte-code-function-p macro nil ad-docstring 1 0 ad-interactive-form ad-lambda-expression] 3 (#$ . 26016)]) (byte-code "\301B\302\301!\204\f\303\301\207" [current-load-list ad-advised-definition-docstring-regexp boundp "^\\$ad-doc: \\(.+\\)\\$$"] 2) #@328 Make an identifying docstring for the advised definition of FUNCTION. Put function name into the documentation string so we can infer the name of the advised function from the docstring. This is needed to generate a proper advised docstring even if we are just given a definition (also see the defadvice for `documentation'). (defalias 'ad-make-advised-definition-docstring #[(function) "\301\302\303!\"\207" [function format "$ad-doc: %s$" prin1-to-string] 4 (#$ . 26503)]) #@69 Return non-nil if DEFINITION was generated from advice information. (defalias 'ad-advised-definition-p #[(definition) "\242\303=\204\"\242\304=\204\"\305!\204\"\242\304=\2050\305A!\2050\306!\211;\205/\307\n \")\207" [definition docstring ad-advised-definition-docstring-regexp lambda macro byte-code-function-p ad-docstring string-match] 4 (#$ . 26986)]) #@54 Return symbol that describes the type of DEFINITION. (defalias 'ad-definition-type #[(definition) "\242\302=\203 \302\207\303!\203 >\203\304\207\305\207\242\306=\2044\307!\2044\242\302=\2036\307A!\2036\310\207\242\311=\205>\311\207" [definition ad-special-forms macro subrp special-form subr lambda byte-code-function-p function advice] 2 (#$ . 27360)]) #@117 True if FUNCTION is a symbol with a proper definition. For that it has to be fbound with a non-autoload definition. (defalias 'ad-has-proper-definition #[(function) "9\205\301!\205K\242\302=?\207" [function fboundp autoload] 2 (#$ . 27739)]) #@69 Find FUNCTION's definition at the end of function cell indirection. (defalias 'ad-real-definition #[(function) "\302!\205K\2119\203\303 !\202 )\207" [function definition ad-has-proper-definition ad-real-definition] 3 (#$ . 27994)]) #@72 Find FUNCTION's real original definition starting from its `origname'. (defalias 'ad-real-orig-definition #[(function) "\301N\205\302\303\301N\236A!\207" [function ad-advice-info ad-real-definition origname] 4 (#$ . 28241)]) #@70 True if FUNCTION has an interpreted definition that can be compiled. (defalias 'ad-is-compilable #[(function) "\301!\205+K\242\302=\204K\242\303=\205+\304K!\206*K\242\303=\205*\304KA!?\207" [function ad-has-proper-definition lambda macro byte-code-function-p] 2 (#$ . 28476)]) #@62 Byte-compiles FUNCTION (or macro) if it is not yet compiled. (defalias 'ad-compile-function #[(function) "\303!\205\304\305\306!\211KM\210\307\n!\210\nKM*\207" [function ad-activate-on-top-level symbol ad-is-compilable nil make-symbol "advice-compilation" byte-compile] 3 (#$ . 28771) "aByte-compile function: "]) (defalias 'ad-prognify #[(forms) "G\301X\203\n@\207\302B\207" [forms 1 progn] 2]) #@262 Parse ARGLIST into its required, optional and rest parameters. A three-element list is returned, where the 1st element is the list of required arguments, the 2nd is the list of optional arguments, and the 3rd is the name of an optional rest parameter (or nil). (defalias 'ad-parse-arglist #[(arglist) "\304\304\304\305 >A@\211\203\306\305\306 !>A!\307 >A\211\203.\306\307\306 !>A!\2020  \nE+\207" [required optional rest arglist nil &rest reverse &optional] 5 (#$ . 29185)]) #@418 Generate a form which evaluates into names/values/types of ARGLIST. When the form gets evaluated within a function with that argument list it will result in a list with one entry for each argument, where the first element of each entry is the name of the argument, the second element is its actual current value, and the third element is either `required', `optional' or `rest' depending on the type of the argument. (defalias 'ad-retrieve-args-form #[(arglist) "\303!\304 8\305\306\307\310 @\"\307\311 A@\"\n\205#\305\312\nD\n\313BBBC#*B\207" [arglist parsed-arglist rest ad-parse-arglist 2 list append mapcar #[(req) "\301\302D\303BBB\207" [req list quote ('required)] 4] #[(opt) "\301\302D\303BBB\207" [opt list quote ('optional)] 4] quote ('rest)] 8 (#$ . 29680)]) (defalias 'ad-arg-binding-field #[(binding field) "\302=\203 @\207\303=\203 A@\207\304=\205 AA@\207" [field binding name value type] 2]) (defalias 'ad-list-access #[(position list) "\302U\203 \207\303U\203\304 D\207\305 E\207" [position list 0 1 cdr nthcdr] 3]) (defalias 'ad-element-access #[(position list) "\302U\203\n\303 D\207\304U\203\303\305 DD\207\306 E\207" [position list 0 car 1 cdr nth] 3]) #@197 Tell how to access ARGLIST's actual argument at position INDEX. For a required/optional arg it simply returns it, if a rest argument has to be accessed, it returns a list with the index and name. (defalias 'ad-access-argument #[(arglist index) "\305!\306 @ A@\"\307 8\f\nGW\203\f\n8\202' \205'\f\nGZ D+\207" [arglist parsed-arglist reqopt-args rest-arg index ad-parse-arglist append 2] 3 (#$ . 30889)]) #@68 Return form to access ARGLIST's actual argument at position INDEX. (defalias 'ad-get-argument #[(arglist index) "\303 \"\211:\203\304\n@\nA@\"\202\n)\207" [arglist index argument-access ad-access-argument ad-element-access] 4 (#$ . 31306)]) #@65 Return form to set ARGLIST's actual arg at INDEX to VALUE-FORM. (defalias 'ad-set-argument #[(arglist index value-form) "\304 \"\211:\203\305\306\n@\nA@\" E\202'\n\203\"\307\n E\202'\310\311 #)\207" [arglist index argument-access value-form ad-access-argument setcar ad-list-access setq error "ad-set-argument: No argument at position %d of `%s'"] 5 (#$ . 31559)]) #@72 Return form to access all actual arguments starting at position INDEX. (defalias 'ad-get-arguments #[(arglist index) "\306!\307 @ A@\"\310 8\311 \nGW\203\312 \n\233B \2037\f\203/\313\f E\2027\314 \nGZ \"\f,\207" [arglist parsed-arglist reqopt-args rest-arg args-form index ad-parse-arglist append 2 nil list nconc ad-list-access] 3 (#$ . 31938)]) #@110 Make form to assign elements of VALUES-FORM as actual ARGLIST args. The assignment starts at position INDEX. (defalias 'ad-set-arguments #[(arglist index values-form) "\306\307\211\310 \f\"\211\203Q 9\203\"\311 \f\312\n\313\"#B\202H @\306U\2035\314 A@\315\n\313\"E\202C\316\315 @S A@\"\315\n\313\"EB\307\fT\nT\202\204]\317\320\f #\202{G\321U\203m\322\323\324@#\202{\325\313 DC\326\327!\313C\"BB+\207" [set-forms argument-access values-index arglist index values-form 0 nil ad-access-argument ad-set-argument ad-element-access ad-vAlUeS setq ad-list-access setcdr error "ad-set-arguments: No argument at position %d of `%s'" 1 ad-substitute-tree #[(form) "\301=\207" [form ad-vAlUeS] 2] #[(form) "\207" [values-form] 1] let append reverse] 6 (#$ . 32305)]) #@68 Expands arg-access text macros in DEFINITION according to ARGLIST. (defalias 'ad-insert-argument-access-forms #[(definition arglist) "\301\302\303#\207" [definition ad-substitute-tree #[(form) "\301=\206\242\302>\205A\242\250\207" [form ad-arg-bindings (ad-get-arg ad-get-args ad-set-arg ad-set-args)] 2] #[(form) "\305=\203\n\306 !\207@A@\307A \"A@\211\310=\203&\311 \"\202L\f\312=\2034\313 \n#\202L\f\314=\203A\315 \"\202L\f\316=\205L\317 \n#+\207" [form arglist val index accessor ad-arg-bindings ad-retrieve-args-form ad-insert-argument-access-forms ad-get-arg ad-get-argument ad-set-arg ad-set-argument ad-get-args ad-get-arguments ad-set-args ad-set-arguments] 6]] 4 (#$ . 33095)]) #@591 Make `funcall/apply' form to map SOURCE-ARGLIST to TARGET-ARGLIST. The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just as if they had been supplied to a function with TARGET-ARGLIST directly. Excess source arguments will be neglected, missing source arguments will be supplied as nil. Returns a `funcall' or `apply' form with the second element being `function' which has to be replaced by an actual function argument. Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return `(funcall function a (car args) (car (cdr args)) (nth 2 args))'. (defalias 'ad-map-arglists #[(source-arglist target-arglist) "\306!\307 @ A@\"\310 8\306\f!\307 @ A@\"\310 8 \205(\311\307\2037\312\2028\313\314D\203G\307\n C\"\202X\315\316\307\205VG\n\233\"\"\".\207" [source-arglist parsed-source-arglist source-reqopt-args source-rest-arg target-arglist parsed-target-arglist ad-parse-arglist append 2 -1 apply funcall function mapcar #[(arg) "T\302 \"\207" [target-arg-index source-arglist ad-get-argument] 3] target-reqopt-args target-rest-arg need-apply target-arg-index] 8 (#$ . 33817)]) #@66 Make form to call TARGET-FUNCTION with args from SOURCE-ARGLIST. (defalias 'ad-make-mapped-call #[(source-arglist target-arglist target-function) "\304 \"\211@\305=\203 \nAAB\202\n\211A\306 D\240\210)\207" [source-arglist target-arglist mapped-form target-function ad-map-arglists funcall quote] 5 (#$ . 34976)]) (defalias 'ad-make-single-advice-docstring #[(advice class &optional style) "\304\3058!\n\306=\203 \202I\n\307=\203-\310\311 @ \203#\312\202$\313 \206)\313%\202I \203?\310\314\315\316 !!@ $\202I\310\317\315\316 !!@#)\207" [advice advice-docstring style class ad-docstring 3 plain freeze format "Permanent %s-advice `%s':%s%s" "\n" "" "%s-advice `%s':\n%s" capitalize symbol-name "%s-advice `%s'."] 6]) (defalias 'ad-make-advised-docstring #[(function &optional style) "\306!\307\310 !!\311 \312\"\313\313 \203 C\314=\204(\315\n\316Q\fB\313\211\203o@\317\"\313\211\203e@\320#\211\203\\ \fBA\211\204F*A\211\2043*\f\205z\321\322\f\237\323#-\207" [function origdef origtype origdoc paragraphs advice-docstring ad-real-orig-definition symbol-name ad-definition-type ad-real-documentation t nil plain "This " " is advised." ad-get-enabled-advices ad-make-single-advice-docstring mapconcat identity "\n\n" style ad-advice-classes class ad-dO-vAr advice] 5]) (defalias 'ad-make-plain-docstring #[(function) "\301\302\"\207" [function ad-make-advised-docstring plain] 3]) (defalias 'ad-make-freeze-docstring #[(function) "\301\302\"\207" [function ad-make-advised-docstring freeze] 3]) #@62 Find first defined arglist in FUNCTION's redefining advices. (defalias 'ad-advised-arglist #[(function) "\300\301\215\207" [ad-dO-eXiT (byte-code "\304\305\306\"\305\307\"\305\310\"#\311\211\203/\n@\312\313 8!\211\203'\314\315 \"\210)\nA\211\204*\311\207" [function advice ad-dO-vAr arglist append ad-get-enabled-advices before around after nil ad-arglist 3 throw ad-dO-eXiT] 7)] 2 (#$ . 36551)]) #@63 Find first interactive form in FUNCTION's redefining advices. (defalias 'ad-advised-interactive-form #[(function) "\300\301\215\207" [ad-dO-eXiT (byte-code "\304\305\306\"\305\307\"\305\310\"#\311\211\203/\n@\312\313 8!\211\203'\314\315 \"\210)\nA\211\204*\311\207" [function advice ad-dO-vAr interactive-form append ad-get-enabled-advices before around after nil ad-interactive-form 3 throw ad-dO-eXiT] 7)] 2 (#$ . 36966)]) #@66 Generate an advised definition of FUNCTION from its advice info. (defalias 'ad-make-advised-definition #[(function) "\306N\205\363\307!\205\363\310!\302\306N\236A\311 !\312 ! >% \242\313=&\314 \"'\315!\2068'(\316!)&\203H\317\202u)\206u\320 !\203n9\203h\321N\203h\322\321N\323H!\202u\320 !\202u \205u\322 !%\204\201&\203\231&\203\212\324\202\213\325\326\327\nD\330(\331\"ED\202\304\f\203\275 \203\275\204\275)\204\275\332\333\334\327\nDD\335'(\n#F\202\304\335('\n#*\336&\203\320\313\202\332%\203\331\337\202\332\300(\340!*\341\342\"\341\343\"\341\344\"&. \207" [function origdef origname orig-interactive-p orig-subr-p ad-special-forms ad-advice-info ad-has-redefining-advice ad-real-orig-definition commandp subrp macro ad-arglist ad-advised-arglist ad-advised-interactive-form nil ad-interactive-form elp-info interactive-form 2 macroexpand eval cons quote ad-get-arguments 0 if (interactive-p) call-interactively ad-make-mapped-call ad-assemble-advised-definition special-form ad-make-advised-definition-docstring ad-get-enabled-advices before around after orig-special-form-p orig-macro-p orig-arglist advised-arglist advised-interactive-form orig-form] 11 (#$ . 37409)]) #@569 Assembles an original and its advices into an advised function. It constructs a function or macro definition according to TYPE which has to be either `macro', `function' or `special-form'. ARGS is the argument list that has to be used, DOCSTRING if non-nil defines the documentation of the definition, INTERACTIVE if non-nil is the interactive form to be used, ORIG is a form that calls the body of the original unadvised function, and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG should be modified. The assembled function will be returned. (defalias 'ad-assemble-advised-definition #[(type args docstring interactive orig &optional befores arounds afters) "\306\211\211\211\211 \306\211\203G@\211A@\2034\f\2034\307\310\f!\311\3128!BBC\202>\313\f\311\3128!\"A\211\204*\314\315E\316!\306\211\203~@\211A@\203h\317\320\321\322\310\311\3128!!#A\211\204[*\n\203\221\f\203\221\307\310\f! EC\202\226\313\f C\"\306\211\203\325@\211A@\203\302 \203\302\307\310 !\311\3128!BBC\202\314\313 \311\3128!\"A\211\204\242*\313 \323>\205\337\324\325!D\"\205\353\"C#\205\363#C\326\327\313  \330=\203\331\202\315C\"BBC%\332!\"-\207" [definition after-forms around-form-protected around-form before-forms befores nil unwind-protect ad-prognify ad-body-forms 3 append setq ad-return-value reverse t ad-substitute-tree #[(form) "\301=\207" [form ad-do-it] 2] #[(form) "\207" [around-form] 1] (macro special-form) (macro) lambda let (ad-return-value) special-form (list 'quote ad-return-value) ad-insert-argument-access-forms advice ad-dO-vAr orig arounds afters type args docstring interactive] 12 (#$ . 38665)]) #@66 Make hook-form from FUNCTION's advice bodies in class HOOK-NAME. (defalias 'ad-make-hook-form #[#'hook-name "\303\304\305 \"\"\211\205\306\307\310\n\"!)\207" [function hook-name hook-forms mapcar #[(advice) "\301\3028!\207" [advice ad-body-forms 3] 3] ad-get-enabled-advices ad-prognify apply append] 6 (#$ . 40388)]) (defalias 'ad-get-cache-definition '(macro . #[(function) "\301\302\303BBD\207" [function car ad-get-advice-info-field ('cache)] 4])) (defalias 'ad-get-cache-id '(macro . #[(function) "\301\302\303BBD\207" [function cdr ad-get-advice-info-field ('cache)] 4])) (defalias 'ad-set-cache '(macro . #[(function definition id) "\303\304\305 \nEF\207" [function definition id ad-set-advice-info-field 'cache cons] 6])) #@163 Clears a previously cached advised definition of FUNCTION. Clear the cache if you want to force `ad-activate' to construct a new advised definition from scratch. (defalias 'ad-clear-cache #[(function) "\301\302\303#\207" [function ad-set-advice-info-field cache nil] 4 (#$ . 41133) (list (ad-read-advised-function "Clear cached definition of: "))]) #@67 Generate an identifying image of the current advices of FUNCTION. (defalias 'ad-make-cache-id #[(function) "\303!\304\305N\236A@\306\307\310\311\"\"\306\312\310\313\"\"\306\314\310\315\"\"\316\n!\317\n\"\317 !\232\2033\320\2027\317\n\"\316\n!\300=\205F\321\n!\321 !\232\257*\207" [function cached-definition original-definition ad-real-orig-definition cache ad-advice-info mapcar #[(advice) "@\207" [advice] 1] ad-get-enabled-advices before #[(advice) "@\207" [advice] 1] around #[(advice) "@\207" [advice] 1] after ad-definition-type ad-arglist t ad-interactive-form] 8 (#$ . 41489)]) #@63 Return the part of FUNCTION's cache id that identifies CLASS. (defalias 'ad-get-cache-class-id #[#'class "\303\304N\236AA\n\305=\203 @\202\"\n\306=\203 A@\202\"\307 8)\207" [function cache-id class cache ad-advice-info before around 2] 3 (#$ . 42097)]) (defalias 'ad-verify-cache-class-id #[(cache-class-id advices) "\300\301\215\207" [ad-dO-eXiT (byte-code "\304\211\203+\n@\305 8\203$ @ @=\203 A\202$\306\307\304\"\210\nA\211\204 *?\207" [advices advice ad-dO-vAr cache-class-id nil 2 throw ad-dO-eXiT] 4)] 2]) (defalias 'ad-cache-id-verification-code #[(function) "\305\306N\236AA\307\310\n@\311\306N\236A\"\203\223\312\211\203\223\310\313\n8\314\306N\236A\"\203\223\315\211\203\223\310\316\n8\317\306N\236A\"\203\223\320\211\203\223\321!\305\306N\236A@\322\n8\323\f!=\203\222\324\211\203\222\325\n8\326=\203p\327\f\"\202s\325\n8\327 !\232\203\222\330\211\203\222\331\n8\203\220\332\f!\332 !\232\203\222\333* *\207" [function code cache-id cached-definition original-definition cache ad-advice-info before-advice-mismatch ad-verify-cache-class-id before around-advice-mismatch 1 around after-advice-mismatch 2 after definition-type-mismatch ad-real-orig-definition 3 ad-definition-type arglist-mismatch 4 t ad-arglist interactive-form-mismatch 5 ad-interactive-form verified] 5]) #@69 True if FUNCTION's cache-id is compatible with its current advices. (defalias 'ad-verify-cache-id #[(function) "\301!\302=\207" [function ad-cache-id-verification-code verified] 2 (#$ . 43438)]) #@57 Preactivate FUNCTION and returns the constructed cache. (defalias 'ad-preactivate-advice #[(function advice class position) "\306!\211\205\nK\307\310N!\f\311\216\312 $\210\313 @#\210\314!\210\315\316\"\210\317!\205N\320\310N\236A@\205N\320\310N\236A@\320\310N\236AAD-\207" [function function-defined-p old-definition old-advice-info ad-advised-functions advice fboundp ad-copy-tree ad-advice-info ((byte-code "\304\305 #\210\n\203\306 \"\210\202\307!\210\304\207" [function old-advice-info function-defined-p old-definition put ad-advice-info ad-safe-fset fmakunbound] 4)) ad-add-advice ad-enable-advice ad-clear-cache ad-activate -1 ad-is-active cache class position] 6 (#$ . 43640)]) (defalias 'ad-make-freeze-definition #[(function advice class position) "\306!\204 \307\310\"\210 @\311\312\313\314! \n$!\305\315N\236A\316 !\205( K)\206.K$\315N\205;\317\315N!%\320K&\314K'\321\216\322\320\323\"\210\322\314\324\"\210\325\315\326#\210\327 ($\210\322\305\315N\236A$\"\210\330!)\211)\205\266)\242\331=\211*\203\205)A\202\207)A+\332\333\334\316\335\fDDD\336\335\fD\337\340\335DD\341\335DDEEE*\203\256\342\202\257\343+BBE*.\207" [function advice name class unique-origname origname ad-has-proper-definition error "ad-make-freeze-definition: `%s' is not yet defined" intern format "%s-%s-%s" ad-make-origname ad-advice-info fboundp ad-copy-tree ad-make-advised-definition-docstring ((byte-code "\304\305 #\210\306\307\n\"\210\306\310 \"\207" [function old-advice-info real-docstring-fn real-origname-fn put ad-advice-info ad-safe-fset ad-make-advised-definition-docstring ad-make-origname] 4)) ad-safe-fset ad-make-freeze-docstring #[(x) "\207" [unique-origname] 1] put nil ad-add-advice ad-make-advised-definition macro progn if not quote fset or ad-get-orig-definition symbol-function defmacro defun orig-definition old-advice-info real-docstring-fn real-origname-fn position frozen-definition macro-p body] 11]) #@283 Return non-nil if the advised FUNCTION should be compiled. If COMPILE is non-nil and not a negative number then it returns t. If COMPILE is a negative number then it returns nil. If COMPILE is nil then the result depends on the value of `ad-default-compilation-action' (which see). (defalias 'ad-should-compile #[#'compile "\250\203 \304Y\207\203\207 \305=\203\306\207 \307=\203\310\207 \311=\203y\312\303\n\313N\236A\314 !\2055 K)!\206|\315\303\n\313N\236A\314 !\205J K)!\206|\303\n\313N\236A\314 !\205^ K)\242\316=\205|\315\303\n\313N\236A\314 !\205u K)A!\207\317\320!\207" [compile ad-default-compilation-action function origname 0 never nil always t like-original subrp ad-advice-info fboundp byte-code-function-p macro featurep byte-compile] 4 (#$ . 45634)]) #@212 Redefine FUNCTION with its advised definition from cache or scratch. The resulting FUNCTION will be compiled if `ad-should-compile' returns t. The current definition and its cache-id will be put into the cache. (defalias 'ad-activate-advised-definition #[#'compile "\303!\205 \304\305N\236A@\306 \206\307!\"\210\310\n\"\203$\311!\210 \203A K=?\205X\312\304K\304\305N\236AAB#\202X\313!\210\312\304K\314B#\210\312\304K\315!B#)\207" [function verified-cached-definition compile ad-verify-cache-id cache ad-advice-info ad-safe-fset ad-make-advised-definition ad-should-compile ad-compile-function ad-set-advice-info-field ad-clear-cache nil ad-make-cache-id] 7 (#$ . 46428)]) #@707 Handle re/definition of an advised FUNCTION during de/activation. If FUNCTION does not have an original definition associated with it and the current definition is usable, then it will be stored as FUNCTION's original definition. If no current definition is available (even in the case of undefinition) nothing will be done. In the case of redefinition the action taken depends on the value of `ad-redefinition-action' (which see). Redefinition occurs when FUNCTION already has an original definition associated with it but got redefined with a new definition and then de/activated. If you do not like the current redefinition action change the value of `ad-redefinition-action' and de/activate again. (defalias 'ad-handle-definition #[(function) "\301\305N\236A\306 !\205 K)\307!\205K\211\203b\n\205o\n =?\205o\310\n!?\205o\f\311>\204>\312\313\314#\202o\f\315=\203K\316 \"\202o\316\301\305N\236A\n\"\210\f\317=\205o\320\321\"\202o\n\205o\316\301\305N\236A\n\"*\207" [function origname current-definition original-definition ad-redefinition-action ad-advice-info fboundp ad-real-definition ad-advised-definition-p (accept discard warn) error "ad-handle-definition (see its doc): `%s' %s" "invalidly redefined" discard ad-safe-fset warn message "ad-handle-definition: `%s' got redefined"] 5 (#$ . 47131)]) #@1006 Activate all the advice information of an advised FUNCTION. If FUNCTION has a proper original definition then an advised definition will be generated from FUNCTION's advice info and the definition of FUNCTION will be replaced with it. If a previously cached advised definition was available, it will be used. The optional COMPILE argument determines whether the resulting function or a compilable cached definition will be compiled. If it is negative no compilation will be performed, if it is positive or otherwise non-nil the resulting function will be compiled, if it is nil the behavior depends on the value of `ad-default-compilation-action' (which see). Activation of an advised function that has an advice info but no actual pieces of advice is equivalent to a call to `ad-unadvise'. Activation of an advised function that has actual pieces of advice but none of them are enabled is equivalent to a call to `ad-deactivate'. The current advised definition will always be cached for later usage. (defalias 'ad-activate #[(function &optional compile) "\205V\304 \305N\204\306\307 \"\202U\310 !\210\302 \305N\236A\311\n!\205&\nK)\205U\312 !\2046\313 !\202U\314 !\203R\315 \"\210\316 \317\320#\210\321\322 \323\"!\210 \202U\324 !)\207" [ad-activate-on-top-level function origname compile nil ad-advice-info error "ad-activate: `%s' is not advised" ad-handle-definition fboundp ad-has-any-advice ad-unadvise ad-has-redefining-advice ad-activate-advised-definition ad-set-advice-info-field active t eval ad-make-hook-form activation ad-deactivate] 4 (#$ . 48474) (list (ad-read-advised-function "Activate advice of: ") current-prefix-arg)]) (defalias 'ad-activate-on 'ad-activate) #@279 Deactivate the advice of an actively advised FUNCTION. If FUNCTION has a proper original definition, then the current definition of FUNCTION will be replaced with it. All the advice information will still be available so it can be activated again with a call to `ad-activate'. (defalias 'ad-deactivate #[(function) "\302N\204 \303\304\"\207\305!\205O\306!\210\301\302N\236A\307 !\205$ K)\204-\303\310\"\207\311\301\302N\236A\307 !\205> K)\"\210\312\313\314#\210\315\316\317\"!\210\207" [function origname ad-advice-info error "ad-deactivate: `%s' is not advised" ad-is-active ad-handle-definition fboundp "ad-deactivate: `%s' has no original definition" ad-safe-fset ad-set-advice-info-field active nil eval ad-make-hook-form deactivation] 5 (#$ . 50180) (list (ad-read-advised-function "Deactivate advice of: " 'ad-is-active))]) #@138 Update the advised definition of FUNCTION if its advice is active. See `ad-activate' for documentation on the optional COMPILE argument. (defalias 'ad-update #[(function &optional compile) "\302!\205\n\303 \"\207" [function compile ad-is-active ad-activate] 3 (#$ . 51036) (list (ad-read-advised-function "Update advised definition of: " 'ad-is-active))]) #@114 Deactivate FUNCTION and then remove all its advice information. If FUNCTION was not advised this will be a noop. (defalias 'ad-unadvise #[(function) "\302N\205*\303!\203\304!\210\305\306\302N\236A!\210\307\302\310#\210\311\312\313! \" \"\211\207" [function ad-advised-functions ad-advice-info ad-is-active ad-deactivate fmakunbound origname put nil delq assoc symbol-name] 4 (#$ . 51402) (list (ad-read-advised-function "Unadvise function: "))]) #@214 Try to recover FUNCTION's original definition, and unadvise it. This is more low-level than `ad-unadvise' in that it does not do deactivation, which might run hooks and get into other trouble. Use in emergencies. (defalias 'ad-recover #[(function) "\303N\205G\301\303N\236A\304 !\205 K)\2036\305\301\303N\236A\304 !\205* K)\"\210\306\301\303N\236A!\210\307\303\310#\210\311\312\313!\n\"\n\"\211\207" [function origname ad-advised-functions ad-advice-info fboundp ad-safe-fset fmakunbound put nil delq assoc symbol-name] 5 (#$ . 51865) (list (intern (completing-read "Recover advised function: " obarray nil t)))]) #@259 Activate functions with an advice name containing a REGEXP match. This activates the advice for each function that has at least one piece of advice whose name includes a match for REGEXP. See `ad-activate' for documentation on the optional COMPILE argument. (defalias 'ad-activate-regexp #[(regexp &optional compile) "\305\211\203$\n@\306 @!\307 \310 #\203\311 \f\"\210\nA\211\204*\305\207" [ad-advised-functions function ad-dO-vAr regexp compile nil intern ad-find-some-advice any ad-activate] 5 (#$ . 52501) (list (ad-read-regexp "Activate via advice regexp: ") current-prefix-arg)]) #@191 Deactivate functions with an advice name containing REGEXP match. This deactivates the advice for each function that has at least one piece of advice whose name includes a match for REGEXP. (defalias 'ad-deactivate-regexp #[(regexp) "\304\211\203#\n@\305 @!\306 \307 #\203\310 !\210\nA\211\204*\304\207" [ad-advised-functions function ad-dO-vAr regexp nil intern ad-find-some-advice any ad-deactivate] 5 (#$ . 53105) (list (ad-read-regexp "Deactivate via advice regexp: "))]) #@259 Update functions with an advice name containing a REGEXP match. This reactivates the advice for each function that has at least one piece of advice whose name includes a match for REGEXP. See `ad-activate' for documentation on the optional COMPILE argument. (defalias 'ad-update-regexp #[(regexp &optional compile) "\305\211\203$\n@\306 @!\307 \310 #\203\311 \f\"\210\nA\211\204*\305\207" [ad-advised-functions function ad-dO-vAr regexp compile nil intern ad-find-some-advice any ad-update] 5 (#$ . 53599) (list (ad-read-regexp "Update via advice regexp: ") current-prefix-arg)]) #@113 Activate all currently advised functions. See `ad-activate' for documentation on the optional COMPILE argument. (defalias 'ad-activate-all #[(&optional compile) "\304\211\203\n@\305 @!\306 \"\210\nA\211\204*\304\207" [ad-advised-functions function ad-dO-vAr compile nil intern ad-activate] 4 (#$ . 54197) "P"]) #@45 Deactivate all currently advised functions. (defalias 'ad-deactivate-all #[nil "\303\211\203\n@\304 @!\305 !\210\nA\211\204*\303\207" [ad-advised-functions function ad-dO-vAr nil intern ad-deactivate] 3 (#$ . 54525) nil]) #@102 Update all currently advised functions. With prefix argument, COMPILE resulting advised definitions. (defalias 'ad-update-all #[(&optional compile) "\304\211\203\n@\305 @!\306 \"\210\nA\211\204*\304\207" [ad-advised-functions function ad-dO-vAr compile nil intern ad-update] 4 (#$ . 54764) "P"]) #@43 Unadvise all currently advised functions. (defalias 'ad-unadvise-all #[nil "\303\211\203\n@\304 @!\305 !\210\nA\211\204*\303\207" [ad-advised-functions function ad-dO-vAr nil intern ad-unadvise] 3 (#$ . 55077) nil]) #@296 Recover all currently advised functions. Use in emergencies. To recover a function means to try to find its original (pre-advice) definition, and delete all advice. This is more low-level than `ad-unadvise' in that it does not do deactivation, which might run hooks and get into other trouble. (defalias 'ad-recover-all #[nil "\303\211\203\n@\304 @!\303\305\306\217\210\nA\211\204*\303\207" [ad-advised-functions function ad-dO-vAr nil intern (ad-recover function) ((error))] 4 (#$ . 55310) nil]) (byte-code "\301B\302\301!\204\f\303\301\207" [current-load-list ad-defadvice-flags boundp (("protect") ("disable") ("activate") ("compile") ("preactivate") ("freeze"))] 2) #@2456 Define a piece of advice for FUNCTION (a symbol). The syntax of `defadvice' is as follows: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) [DOCSTRING] [INTERACTIVE-FORM] BODY... ) FUNCTION ::= Name of the function to be advised. CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'. NAME ::= Non-nil symbol that names this piece of advice. POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first', see also `ad-add-advice'. ARGLIST ::= An optional argument list to be used for the advised function instead of the argument list of the original. The first one found in before/around/after-advices will be used. FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'. All flags can be specified with unambiguous initial substrings. DOCSTRING ::= Optional documentation for this piece of advice. INTERACTIVE-FORM ::= Optional interactive form to be used for the advised function. The first one found in before/around/after-advices will be used. BODY ::= Any s-expression. Semantics of the various flags: `protect': The piece of advice will be protected against non-local exits in any code that precedes it. If any around-advice of a function is protected then automatically all around-advices will be protected (the complete onion). `activate': All advice of FUNCTION will be activated immediately if FUNCTION has been properly defined prior to this application of `defadvice'. `compile': In conjunction with `activate' specifies that the resulting advised function should be compiled. `disable': The defined advice will be disabled, hence, it will not be used during activation until somebody enables it. `preactivate': Preactivates the advised FUNCTION at macro-expansion/compile time. This generates a compiled advised definition according to the current advice state that will be used during activation if appropriate. Only use this if the `defadvice' gets actually compiled. `freeze': Expands the `defadvice' into a redefining `defun/defmacro' according to this particular single advice. No other advice information will be saved. Frozen advices cannot be undone, they behave like a hard redefinition of the advised function. `freeze' implies `activate' and `preactivate'. The documentation of the advised function can be dumped onto the `DOC' file during preloading. See Info node `(elisp)Advising Functions' for comprehensive documentation. (defalias 'defadvice '(macro . #[(function args &rest body) "\306!\204 \307\310\"\210 @\311\n!\204\307\312\n\"\202 A@\306 !\204,\307\313 \"\202< AA\314 @!\205< @ A @<\205H @ A\315\316 \"#\317 \320#>\321#>?\322\323 $BBB$\324#>\205s\325\n\f$%\326#>\203\206\327\n\f$\202\336\330\331\332D\332D\332\nD\332\fD\257\333%\205\302\334\332D%@\242\335=\203\265\336\300%@ADD\202\272\300%@D\332%A@DFC\337#>\205\327\340\332D\341#>\205\325\342EC\332DC#BB.\207" [function args class name position arglist ad-name-p error "defadvice: Invalid function name: %s" ad-class-p "defadvice: Invalid advice class: %s" "defadvice: Invalid advice name: %s" ad-position-p mapcar #[(flag) "\303\304! \"\211\305=\203\202\"\306\n \"\203\307\n!\202\"\310\311\")\207" [flag ad-defadvice-flags completion try-completion symbol-name t assoc intern error "defadvice: Invalid or ambiguous flag: %s"] 4] ad-make-advice protect disable advice lambda preactivate ad-preactivate-advice freeze ad-make-freeze-definition progn ad-add-advice quote append ad-set-cache macro ad-macrofy activate ad-activate compile t flags body preactivation] 8 (#$ . 56003)])) #@249 Binds FUNCTIONS to their original definitions and execute BODY. For any members of FUNCTIONS that are not currently advised the rebinding will be a noop. Any modifications done to the definitions of FUNCTIONS will be undone on exit of this macro. (defalias 'ad-with-originals '(macro . #[(functions &rest body) "\304\305\306 \"\307\n\310\311\312\304\305\313 \" \"B\304\305\314 \"BBE*\207" [index functions current-bindings body -1 mapcar #[(function) "T\302\303\304\"!\305\306 DDD\207" [index function intern format "ad-oRiGdEf-%d" symbol-function quote] 4] let unwind-protect progn append #[(function) "T\303\304 D\305\306\304 DD\n8@EE\207" [index function current-bindings ad-safe-fset quote or ad-get-orig-definition] 6] #[(function) "T\303\304 D\n8@E\207" [index function current-bindings ad-safe-fset quote] 4]] 8 (#$ . 59646)])) (byte-code "\300\301N\204\f\302\300\301\303#\210\304\305\306\307\310$\210\311\305\312\313\314B#\207" [ad-with-originals lisp-indent-hook put 1 ad-add-advice documentation (ad-advised-docstring nil t (advice lambda nil "Builds an advised docstring if FUNCTION is advised." (if (and (stringp ad-return-value) (string-match ad-advised-definition-docstring-regexp ad-return-value)) (let (#'(car (read-from-string ad-return-value (match-beginning 1) (match-end 1)))) (cond ((ad-is-advised function) (setq ad-return-value (ad-make-advised-docstring function)) (if (not (ad-get-arg 1)) (setq ad-return-value (substitute-command-keys ad-return-value))))))))) after first ad-set-advice-info-field cache #[(function &optional raw) "\304\305 \n\"\211;\203/\306 \"\203/\307\310\224\310\225#@\211\311N\203.\312 !\n\204.\313!))\207" [ad-return-value function raw ad-advised-definition-docstring-regexp nil ad-Orig-documentation string-match read-from-string 1 ad-advice-info ad-make-advised-docstring substitute-command-keys] 5 "$ad-doc: documentation$"] (nil nil (ad-advised-docstring) subr t nil)] 5) #@44 Start the automatic advice handling magic. (defalias 'ad-start-advice #[nil "\300\301\302\303#\210\304\301\305\"\210\306\307\310\311#\210\305\307\312\"\207" [put ad-activate-internal ad-advice-info nil ad-safe-fset ad-activate ad-enable-advice documentation after ad-advised-docstring compile] 4 (#$ . 61604) nil]) #@108 Stop the automatic advice handling magic. You should only need this in case of Advice-related emergencies. (defalias 'ad-stop-advice #[nil "\300\301\302\303#\210\304\305\306\307#\210\310\305!\210\311\301\312\"\207" [put ad-activate-internal ad-advice-info nil ad-disable-advice documentation after ad-advised-docstring ad-update ad-safe-fset ad-activate-internal-off] 4 (#$ . 61926) nil]) #@95 Undo all advice related redefinitions and unadvises everything. Use only in REAL emergencies. (defalias 'ad-recover-normality #[nil "\301\302\303\304#\210\305\302\306\"\210\307 \210\304\211\207" [ad-advised-functions put ad-activate-internal ad-advice-info nil ad-safe-fset ad-activate-internal-off ad-recover-all] 4 (#$ . 62321) nil]) (byte-code "\300 \210\301\302!\207" [ad-start-advice provide advice] 2)