;ELC ;;; compiled by rms@mole.gnu.ai.mit.edu on Wed Aug 10 00:49:58 1994 ;;; from file /gd/gnu/emacs/19.0/lisp/advice.el ;;; emacs version 19.25.93.1. ;;; bytecomp version FSF 2.10 ;;; optimization is on. ;;; this file uses opcodes which do not exist in Emacs 18. (if (and (boundp 'emacs-version) (or (and (boundp 'epoch::version) epoch::version) (string-lessp emacs-version "19"))) (error "`/gd/gnu/emacs/19.0/lisp/advice.el' was compiled for Emacs 19")) (byte-code "!\"\"" [provide advice-preload require "advice.el" defalias ad-lemacs-p (macro . #[nil "\n\"" [string-match "Lucid" emacs-version] 3]) "2.14" ad-version] 3) (defvar ad-redefinition-action (quote warn) "\ *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'.") (defvar ad-default-compilation-action (quote maybe) "\ *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.") (byte-code "\"\"" [defalias ad-substitute-tree #[(sUbTrEe-TeSt fUnCtIoN tReE) ":, @!\n@!$@:\" \n@#$@ \nA#B !6\n!" [tReE sUbTrEe-TeSt fUnCtIoN ad-substitute-tree] 5] ad-copy-tree #[(tree) ":@!A!B" [tree ad-copy-tree] 3]] 3) (defalias 'ad-dolist '(macro . #[(varform &rest body) "\nA@D\n@D\n@BBC\"BBB\nAA@F ˍ/ E1 )" [let ad-dO-vAr varform while setq ((car ad-dO-vAr)) append body (setq ad-dO-vAr (cdr ad-dO-vAr)) expansion contains-return (byte-code " #ć" [ad-substitute-tree #[(subtree) "==\"" [subtree ad-dolist ad-do-return throw contains-return t] 3] identity body nil] 4) catch (quote ad-dO-eXiT)] 8 "\ 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])'."])) (byte-code "\"N#\"\" !'\f\"\"\"NB#\"\"\"\"\"\"\"\"" [defalias ad-do-return (macro . #[(value) "\nE" [throw (quote ad-dO-eXiT) value] 3]) ad-dolist lisp-indent-hook put 1 ad-save-real-definition (macro . #[(function) " \"!\"\fDDD\fD DDE N2\fD NDFC ND\fD NDFC\"BBE)" [intern format "ad-real-%s" function saved-function require byte-compile "bytecomp" if not fboundp quote progn fset symbol-function append put (quote byte-compile) byte-opcode (quote byte-opcode)] 12]) ad-save-real-definitions #[nil "!KM##!?\"KM" [fboundp ad-real-fset fset put byte-compile byte-compile-fset byte-opcode byte-fset ad-real-documentation documentation] 4] boundp ad-advised-functions nil ad-pushnew-advised-function (macro . #[(function) "\fDBBD\fDDBBEE" [if not assoc symbol-name function (ad-advised-functions) setq ad-advised-functions cons list (ad-advised-functions)] 8]) ad-pop-advised-function (macro . #[(function) " DBBBBE" [setq ad-advised-functions delq assoc symbol-name function (ad-advised-functions) (ad-advised-functions)] 6]) ad-do-advised-functions (macro . #[(varform &rest body) " @ A@E @ @DDEBBB" [ad-dolist varform ad-advised-functions setq intern car body] 7]) ad-get-advice-info (macro . #[(function) " BB" [get function ((quote ad-advice-info))] 3]) ad-set-advice-info (macro . #[(function advice-info) " F" [put function (quote ad-advice-info) advice-info] 4]) ad-copy-advice-info (macro . #[(function) "\nBBD" [ad-copy-tree get function ((quote ad-advice-info))] 4]) ad-is-advised (macro . #[(function) " D" [ad-get-advice-info function] 2]) ad-initialize-advice-info #[(function) "\n! \"\n!C B\nBC#" [assoc symbol-name function ad-advised-functions put ad-advice-info active nil] 5] ad-get-advice-info-field (macro . #[(function field) "\n\fDED" [cdr assq field ad-get-advice-info function] 5]) ad-set-advice-info-field #[(function field value) "N\nN\nN N\n BC" [function ad-advice-info field value] 3] ad-is-active #[(function) " NA" [active function ad-advice-info] 3]] 4) (defalias 'ad-make-advice #[(name protect enable definition) " \n F" [name protect enable definition] 4 "\ 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...)'."]) (byte-code "\"\"\"\"\"\"\"\"!1\"\"\"\"" [defalias ad-advice-name (macro . #[(advice) " D" [car advice] 2]) ad-advice-protected (macro . #[(advice) "\nE" [nth 1 advice] 3]) ad-advice-enabled (macro . #[(advice) "\nE" [nth 2 advice] 3]) ad-advice-definition (macro . #[(advice) "\nE" [nth 3 advice] 3]) ad-advice-set-enabled #[(advice flag) "AA " [advice flag] 2] ad-class-p #[(thing) " >" [thing ad-advice-classes] 2] ad-name-p #[(thing) "9" [thing] 1] ad-position-p #[(thing) " ! >" [natnump thing (first last)] 2] boundp ad-advice-classes (before around after activation deactivation) ad-has-enabled-advice #[(function class) "" [ad-dO-eXiT (byte-code " NA\" @\f8\" A *Ç" [class function ad-advice-info nil advice ad-dO-vAr 2 throw ad-dO-eXiT t] 4)] 2] ad-has-redefining-advice #[(function) "N\"\"\"" [function ad-advice-info ad-has-enabled-advice before around after] 3] ad-has-any-advice #[(function) "N Í" [function ad-advice-info ad-dO-eXiT (byte-code " @\fNA\" A*" [ad-advice-classes nil class ad-dO-vAr function ad-advice-info throw ad-dO-eXiT t] 4)] 2] ad-get-enabled-advices #[(function class) "\n NA'@ 8 BA* !)" [nil enabled-advices class function ad-advice-info advice ad-dO-vAr 2 reverse] 4]] 3) (defun ad-activate (function &optional compile) "\ Automatic advice activation is disabled. `ad-start-advice' enables it." nil) (defun ad-activate-off (function &optional compile) "\ Automatic advice activation is disabled. `ad-start-advice' enables it." nil) (byte-code "!\"\"\"\"\"\"\"!8\"\"\"\"!P\"\"\"" [boundp ad-activate-on-top-level t defalias ad-with-auto-activation-disabled (macro . #[(&rest body) "\nBB" [let ((ad-activate-on-top-level nil)) body] 3]) ad-safe-fset #[(symbol definition) "\n M)" [nil ad-activate-on-top-level symbol definition] 2] ad-make-origname #[(function) " \"!" [intern format "ad-Orig-%s" function] 4] ad-get-orig-definition (macro . #[(function) " BBDCBB" [let origname ad-get-advice-info-field function ((quote origname)) ((if (fboundp origname) (symbol-function origname)))] 5]) ad-set-orig-definition (macro . #[(function definition) "\nE" [ad-safe-fset (ad-get-advice-info-field function (quote origname)) definition] 3]) ad-clear-orig-definition (macro . #[(function) "\nBBD" [fmakunbound ad-get-advice-info-field function ((quote origname))] 4]) ad-read-advised-function #[(&optional prompt predicate default) "! ō\"  $ #-$ҚH NA L \"L!*" [ad-advised-functions error "ad-read-advised-function: There are no advised functions" default ad-dO-eXiT (byte-code "& @\n@!  \n!\n\" A*" [ad-advised-functions nil function ad-dO-vAr intern predicate throw ad-dO-eXiT] 4) "ad-read-advised-function: %s" "There are no qualifying advised functions" predicate ad-pReDiCaTe completing-read format "%s(default %s) " prompt "Function: " #[(function) "\n@!!" [ad-pReDiCaTe intern function] 3] t function "" ad-advice-info "ad-read-advised-function: `%s' is not advised" intern] 6] ad-advice-class-completion-table mapcar #[(class) " !C" [symbol-name class] 2] ad-advice-classes ad-read-advice-class #[(function &optional prompt default) " \" # $Ϛ+/!)" [default ad-dO-eXiT (byte-code " @\fNA\n\" A*" [ad-advice-classes nil class ad-dO-vAr function ad-advice-info throw ad-dO-eXiT] 4) error "ad-read-advice-class: `%s' has no advices" function completing-read format "%s(default %s) " prompt "Class: " ad-advice-class-completion-table nil t class "" intern] 6] ad-read-advice-name #[(function class &optional prompt) "\n NA\" \n# @@ ##  $њ>!B!," [mapcar #[(advice) " @!C" [symbol-name advice] 2] class function ad-advice-info name-completion-table error "ad-read-advice-name: `%s' has no %s advice" default format "%s(default %s) " prompt "Name: " completing-read nil t name "" intern] 6] ad-read-advice-specification #[(&optional prompt) " !\n!\n\f\"\n\fE+" [ad-read-advised-function prompt function ad-read-advice-class class ad-read-advice-name name] 3] ad-last-regexp "" ad-read-regexp #[(&optional prompt) "  ĚĂ \"P!Ě\" $)" [read-from-minibuffer prompt "Regular expression: " ad-last-regexp "" format "(default \"%s\") " regexp] 6] ad-find-advice (macro . #[(function class name) " \fEE" [assq name ad-get-advice-info-field function class] 5]) ad-advice-position #[(function class name) " \nNA \nNA\f G\f >GZ*" [name class function ad-advice-info found-advice advices] 4]] 3) (defalias 'ad-find-some-advice #[(function class name) "N\fō)" [function ad-advice-info nil found-advice ad-dO-eXiT (byte-code ". @\f=\n\f=Ǎ'\" A*" [ad-advice-classes nil advice-class ad-dO-vAr class any ad-dO-eXiT (byte-code " NA5 @;!\f@!\")\f@=.\f\" A *Ç" [advice-class function ad-advice-info nil advice ad-dO-vAr name string-match symbol-name throw ad-dO-eXiT] 5) found-advice throw] 4)] 2 "\ Finds 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 (quote ad-enable-advice-internal) #[(function class name flag) "Nv\fs@=&=jNA\ni@\n ;M \n@!\"V \n@=` T\n\"A6*A* )" [function ad-advice-info 0 matched-advices ad-advice-classes nil advice-class ad-dO-vAr class any advice name string-match symbol-name ad-advice-set-enabled flag] 5]) (defalias 'ad-enable-advice #[(function class name) "N \f$= \f$\"" [function ad-advice-info ad-enable-advice-internal class name t 0 error "ad-enable-advice: `%s' has no %s advice matching `%s'" "ad-enable-advice: `%s' is not advised"] 5 "\ Enables the advice of FUNCTION with CLASS and NAME." (ad-read-advice-specification "Enable advice of: ")]) (defalias 'ad-disable-advice #[(function class name) "N \f$= \f$\"" [function ad-advice-info ad-enable-advice-internal class name nil 0 error "ad-disable-advice: `%s' has no %s advice matching `%s'" "ad-disable-advice: `%s' is not advised"] 5 "\ Disables the advice of FUNCTION with CLASS and NAME." (ad-read-advice-specification "Disable advice of: ")]) (defalias (quote ad-enable-regexp-internal) #[(regexp class flag) "\n) @\f@! \f \n$ \\ A\n* )" [0 matched-advices ad-advised-functions nil advised-function ad-dO-vAr intern ad-enable-advice-internal class regexp flag] 7]) (defalias 'ad-enable-regexp #[(regexp) " #t\f\"\f)" [ad-enable-regexp-internal regexp any t matched-advices message "%d matching advices enabled"] 4 "\ Enables all advices with names that contain a match for REGEXP. All currently advised functions will be considered." (list (ad-read-regexp "Enable advices via regexp: "))]) (defalias 'ad-disable-regexp #[(regexp) " #t\f\"\f)" [ad-enable-regexp-internal regexp any nil matched-advices message "%d matching advices disabled"] 4 "\ Disables all advices with names that contain a match for REGEXP. All currently advised functions will be considered." (list (ad-read-regexp "Disable advices via regexp: "))]) (defalias 'ad-remove-advice #[(function class name) "N+\n NA# \f NA\"#) \n$)\"" [function ad-advice-info name class advice-to-remove ad-set-advice-info-field delq error "ad-remove-advice: `%s' has no %s advice `%s'" "ad-remove-advice: `%s' is not advised"] 9 "\ Removes 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." (ad-read-advice-specification "Remove advice of: ")]) (defalias 'ad-add-advice #[(function advice class position) "N!!#@# NA\n T =5͂T =B\nGT S \nG^]T @\">f! v \n U\nB# S\n \nB+" [function ad-advice-info ad-initialize-advice-info ad-set-advice-info-field origname ad-make-origname ad-advice-position class advice previous-position advices position first 0 last ad-get-cache-class-id ad-clear-cache] 5 "\ Adds 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."]) (byte-code "\"\"!\"\"\"\"\"\"\"!E!E\"\"\"\"\"\"\"\"\"\"\"\"\"!2\"\"\"\"\"\"@A\"" [defalias ad-macrofy (macro . #[(definition) "\nE" [cons (quote macro) definition] 3]) ad-lambdafy (macro . #[(definition) " D" [cdr definition] 2]) boundp ad-special-forms mapcar symbol-function (and catch cond condition-case defconst defmacro defun defvar function if interactive let let* or prog1 prog2 progn quote save-excursion save-restriction save-window-excursion setq setq-default unwind-protect while with-output-to-temp-buffer) ad-special-form-p (macro . #[(definition) " E" [memq definition ad-special-forms] 3]) ad-interactive-p (macro . #[(definition) " D" [commandp definition] 2]) ad-subr-p (macro . #[(definition) " D" [subrp definition] 2]) ad-macro-p (macro . #[(definition) "\nDBB" [eq car-safe definition ((quote macro))] 3]) ad-lambda-p (macro . #[(definition) "\nDBB" [eq car-safe definition ((quote lambda))] 3]) ad-advice-p (macro . #[(definition) "\nDBB" [eq car-safe definition ((quote advice))] 3]) fboundp byte-code-function-p compiled-function-p ad-safe-fset ad-compiled-p (macro . #[(definition) "\nD\nD\nDDEE" [or byte-code-function-p definition and ad-macro-p ad-lambdafy] 7]) ad-compiled-code (macro . #[(compiled-definition) "\nD\nD\nF" [if ad-macro-p compiled-definition ad-lambdafy] 4]) ad-lambda-expression #[(definition) "= =A=Ać" [definition lambda macro advice nil] 2] ad-arglist #[(definition &optional name) " ! =$ A!$ = A! H :/ !A@ !V?! \"\"͔͕O!!" [byte-code-function-p definition macro 0 ad-lambda-expression subrp name ad-subr-arglist format "%s" string-match "^#]+\\)>$" intern 1] 5] ad-define-subr-args (macro . #[(subr arglist) " \fDF" [put subr (quote ad-subr-arglist) list arglist] 5]) ad-undefine-subr-args (macro . #[(subr) " BB" [put subr ((quote ad-subr-arglist) nil)] 3]) ad-subr-args-defined-p (macro . #[(subr) " BB" [get subr ((quote ad-subr-arglist))] 3]) ad-get-subr-args (macro . #[(subr) "\nBBD" [car get subr ((quote ad-subr-arglist))] 4]) ad-subr-arglist #[(subr-name) "N N@\" \"3 ʔʕO!@AC#N@P \"O ʔʕ#@C#N@P)" [subr-name ad-subr-arglist ad-real-documentation t "" doc string-match "^\\(([^)]+)\\)\n?\\'" put read-from-string 1 "[\n ]*\narguments: ?\\((.*)\\)\n?\\'" (&rest ad-subr-args)] 7] ad-docstring #[(definition) " ! = A! \"! !AA@;/!1)" [byte-code-function-p definition macro ad-real-documentation t ad-lambda-expression docstring natnump] 4] ad-interactive-form #[(definition) " ! =, A!, !? =' A( HD =: =? !!" [byte-code-function-p definition macro commandp interactive 5 advice lambda ad-lambda-expression] 3] ad-body-forms #[(definition) " ! = A!Ç :8 !%ł& !0ł1\\ !AA" [byte-code-function-p definition macro nil ad-docstring 1 0 ad-interactive-form ad-lambda-expression] 3] ad-advised-definition-docstring-regexp "^\\$ad-doc: \\(.+\\)\\$$" ad-make-advised-definition-docstring #[(function) " !\"" [format "$ad-doc: %s$" prin1-to-string function] 4] ad-advised-definition-p #[(definition) "=\"=\"!\"=1A!1!;0 \")" [definition lambda macro byte-code-function-p ad-docstring docstring string-match ad-advised-definition-docstring-regexp] 4] ad-definition-type #[(definition) "= ! >ćŇ=4!4=6A!6ȇ=>ɇ" [definition macro subrp ad-special-forms special-form subr lambda byte-code-function-p function advice] 2] ad-has-proper-definition #[(function) "9!K=?" [function fboundp autoload] 2] ad-real-definition #[(function) " ! K9\n!\n)" [ad-has-proper-definition function definition ad-real-definition] 3] ad-real-orig-definition #[(function) "NNA!" [function ad-advice-info ad-real-definition origname] 4] ad-is-compilable #[(function) " !+ K= K=+ K!* K=* KA!?" [ad-has-proper-definition function lambda macro byte-code-function-p] 2]] 3) (defalias 'ad-compile-function #[(function) " !\f !)" [ad-is-compilable function nil ad-activate-on-top-level byte-compile] 2 "\ Byte-compiles FUNCTION (or macro) if it is not yet compiled." "aByte-compile function: "]) (byte-code "\"\"\"\"\"\"\"\"\"\"\"\"" [defalias ad-prognify #[(forms) "GX\n@B" [forms 1 progn] 2] ad-parse-arglist #[(arglist) " >A@ !>A! >A. !>A!0  \n E+" [nil required optional rest &rest arglist reverse &optional] 5] ad-retrieve-args-form #[(arglist) " !\n8\n@\"\nA@\"\f#\fD\fBBBC#*B" [ad-parse-arglist arglist parsed-arglist 2 rest list append mapcar #[(req) "\nD\nBBB" [list quote req ((quote required))] 4] #[(opt) "\nD\nBBB" [list quote opt ((quote optional))] 4] quote ((quote rest))] 8] ad-arg-binding-field #[(binding field) "= \n@=\nA@=\nAA@" [field name binding value type] 2] ad-list-access #[(position list) "U\nU\nD\nE" [position 0 list 1 cdr nthcdr] 3] ad-element-access #[(position list) "U\n DU DD E" [position 0 car list 1 cdr nth] 3] ad-access-argument #[(arglist index) " !\n@\nA@\"\n8\fGW \f8--\fGZD+" [ad-parse-arglist arglist parsed-arglist append reqopt-args 2 rest-arg index] 3] ad-get-argument #[(arglist index) " \n\": @ A@\" )" [ad-access-argument arglist index argument-access ad-element-access] 4] ad-set-argument #[(arglist index value-form) " \n\": @ A@\"E) $ E)\n #)" [ad-access-argument arglist index argument-access setcar ad-list-access value-form setq error "ad-set-argument: No argument at position %d of `%s'"] 5] ad-get-arguments #[(arglist index) " !\n@\nA@\"\n8 \fGW$ \fBD9ED \fGZ\"," [ad-parse-arglist arglist parsed-arglist append reqopt-args 2 rest-arg nil args-form index list nconc ad-list-access] 3] ad-set-arguments #[(arglist index values-form) "\"X 9&\f\"#\nBM @U9 A@\f\"EG @S A@\"\f\"E\nBT\fT\nf#\nGUv\n@#DC\n!C\"BB+" [0 nil set-forms argument-access values-index ad-access-argument arglist index 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) "=" [form ad-vAlUeS] 2] (lambda (form) values-form) let values-form append reverse] 6] ad-insert-argument-access-forms #[(definition arglist) " #" [ad-substitute-tree #[(form) "=>A" [form ad-arg-bindings (ad-get-arg ad-get-args ad-set-arg ad-set-args)] 2] #[(form) "=\n !@A@A \"A@=) \"U=9  #U=H \"U=U  #+" [form ad-arg-bindings ad-retrieve-args-form arglist ad-insert-argument-access-forms val index accessor 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] definition] 4]] 3) (defalias 'ad-map-arglists #[(source-arglist target-arglist) " !\n@\nA@\"\n8!@A@\" 8\n/\n   >΂?D O\fC\"` \n^ G\f\"\"\"." [ad-parse-arglist source-arglist parsed-source-arglist append source-reqopt-args 2 source-rest-arg target-arglist parsed-target-arglist target-reqopt-args target-rest-arg need-apply -1 target-arg-index apply funcall function mapcar #[(arg) "T\n\"" [target-arg-index ad-get-argument source-arglist] 3]] 8 "\ Makes `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))'."]) (byte-code "\"\"\"\"\"\"\"\"\"\"\"\"\"" [defalias ad-make-mapped-call #[(source-arglist target-arglist target-function) " \n\"@= AAB A D)" [ad-map-arglists source-arglist target-arglist mapped-form funcall target-function quote] 5] ad-make-single-advice-docstring #[(advice class &optional style) "\n8!\f= G\f=. \n@ $ʂ% *%G !!\n@ @ʂA F%)" [ad-docstring 3 advice advice-docstring style plain freeze format "Permanent %s-advice `%s':%s%s" class "\n" "" "%s-advice `%s':%s%s" capitalize symbol-name] 6] ad-make-advised-docstring #[(function &optional style) " !\n!!\n\"\n  C\n\f=0 Q\nB\n{@ \"q@\f# h \nB\nAN*A;*\n\n#-" [ad-real-orig-definition function origdef symbol-name ad-definition-type origtype ad-real-documentation t origdoc nil paragraphs advice-docstring style plain "This " " is advised." ad-advice-classes class ad-dO-vAr ad-get-enabled-advices advice ad-make-single-advice-docstring mapconcat identity "\n\n"] 5] ad-make-plain-docstring #[(function) " \"" [ad-make-advised-docstring function plain] 3] ad-make-freeze-docstring #[(function) " \"" [ad-make-advised-docstring function freeze] 3] ad-advised-arglist #[(function) "" [ad-dO-eXiT (byte-code "\n\"\n\"\n\"#8@8! . \")A*Ƈ" [append ad-get-enabled-advices function before around after nil advice ad-dO-vAr ad-arglist 3 arglist throw ad-dO-eXiT] 7)] 2] ad-advised-interactive-form #[(function) "" [ad-dO-eXiT (byte-code "\n\"\n\"\n\"#8@8! . \")A*Ƈ" [append ad-get-enabled-advices function before around after nil advice ad-dO-vAr ad-interactive-form 3 interactive-form throw ad-dO-eXiT] 7)] 2] ad-make-advised-definition #[(function) "N!!NA\f!\f! \f\n> \f= \f\"!;! KԂuu\f!uu!@sG\"DDt)   ݂ D\"ED  DD #F #& ̂ !&\"\"\"&. " [function ad-advice-info ad-has-redefining-advice ad-real-orig-definition origdef origname commandp orig-interactive-p subrp orig-subr-p ad-special-forms orig-special-form-p macro orig-macro-p ad-arglist orig-arglist ad-advised-arglist advised-arglist ad-advised-interactive-form advised-interactive-form nil ad-interactive-form ad-parse-arglist reqargs interactive quote make-list (interactive) interactive-form macroexpand eval cons ad-get-arguments 0 if (interactive-p) call-interactively ad-make-mapped-call orig-form ad-assemble-advised-definition special-form ad-make-advised-definition-docstring ad-get-enabled-advices before around after] 12] ad-assemble-advised-definition #[(type args docstring interactive orig &optional befores arounds afters) "H@A@5 5 !8!BBC? 8!\"A*E!@A@i8!!#A\\* !\fEC \fC\"@A@\n\n!8!BBC\n8!\"A*>DCC\n=C\"BBC% \"-" [nil definition after-forms around-form-protected around-form before-forms befores advice ad-dO-vAr unwind-protect ad-prognify ad-body-forms 3 append setq ad-return-value orig reverse arounds t ad-substitute-tree #[(form) "=" [form ad-do-it] 2] (lambda (form) around-form) afters type (macro special-form) (macro) lambda args docstring interactive let (ad-return-value) special-form (list (quote quote) ad-return-value) ad-insert-argument-access-forms] 12] ad-make-hook-form #[(function hook-name) " \f\"\" \"!)" [mapcar #[(advice) "\n8!" [ad-body-forms 3 advice] 3] ad-get-enabled-advices function hook-name hook-forms ad-prognify apply append] 6] ad-get-cache-definition (macro . #[(function) "\nBBD" [car ad-get-advice-info-field function ((quote cache))] 4]) ad-get-cache-id (macro . #[(function) "\nBBD" [cdr ad-get-advice-info-field function ((quote cache))] 4]) ad-set-cache (macro . #[(function definition id) " \f EF" [ad-set-advice-info-field function (quote cache) cons definition id] 6])] 3) (defalias 'ad-clear-cache #[(function) " #" [ad-set-advice-info-field function cache nil] 4 "\ 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." (list (ad-read-advised-function "Clear cached definition of: "))]) (byte-code "\"\"\"\"\"\"\"\"\"" [defalias ad-make-cache-id #[(function) " ! NA@ \"\" \"\" \"\" ! \"\f!3Ђ7 \" !=F !\f!*" [ad-real-orig-definition function cache ad-advice-info cached-definition original-definition mapcar #[(advice) "@" [advice] 1] ad-get-enabled-advices before #[(advice) "@" [advice] 1] around #[(advice) "@" [advice] 1] after ad-definition-type ad-arglist t ad-interactive-form] 8] ad-get-cache-class-id #[(function class) " NAA\f= @\"\f= A@\" 8)" [cache function ad-advice-info cache-id class before around 2] 3] ad-verify-cache-class-id #[(cache-class-id advices) "" [ad-dO-eXiT (byte-code "+ @\n8$ @\n@= A$\" A *?" [advices nil advice ad-dO-vAr 2 cache-class-id throw ad-dO-eXiT] 4)] 2] ad-cache-id-verification-code #[(function) " NAA @ NA\"ȉ 8 NA\"ˉ 8 NA\"Ή ! NA@ 8!=ԉ 8=t \"w 8!؉ 8!!*\f*" [cache function ad-advice-info before-advice-mismatch code cache-id ad-verify-cache-class-id before around-advice-mismatch 1 around after-advice-mismatch 2 after definition-type-mismatch ad-real-orig-definition cached-definition original-definition 3 ad-definition-type arglist-mismatch 4 t ad-arglist interactive-form-mismatch 5 ad-interactive-form verified] 5] ad-verify-cache-id #[(function) " !=" [ad-cache-id-verification-code function verified] 2] ad-preactivate-advice #[(function advice class position) " !\n K N!Ȏ \n \f$  \n@# ! \" !S NA@S NA@ NAAD-" [fboundp function function-defined-p old-definition ad-copy-tree ad-advice-info old-advice-info ad-advised-functions ((byte-code " #\f \" !" [put function ad-advice-info old-advice-info function-defined-p ad-safe-fset old-definition fmakunbound] 4)) ad-add-advice advice class position ad-enable-advice ad-clear-cache ad-activate-on -1 ad-is-active cache] 6] ad-make-freeze-definition #[(function advice class position) " ! \"\f@ !\n $! NA\f\f!-\fK)3 K N@ N!KKՎ\"\" # \f\n$ NA\" !)= AA! DDD D DD DDEEE ꂷ !BBE*." [ad-has-proper-definition function error "ad-make-freeze-definition: `%s' is not yet defined" advice name intern format "%s-%s-%s" ad-make-origname class unique-origname origname ad-advice-info fboundp orig-definition ad-copy-tree old-advice-info ad-make-advised-definition-docstring real-docstring-fn real-origname-fn ((byte-code " #\"\"" [put function ad-advice-info old-advice-info ad-safe-fset ad-make-advised-definition-docstring real-docstring-fn ad-make-origname real-origname-fn] 4)) ad-safe-fset ad-make-freeze-docstring (lambda (x) unique-origname) put nil ad-add-advice position ad-make-advised-definition frozen-definition macro macro-p body progn if not quote fset or ad-get-orig-definition symbol-function defmacro defun] 11] ad-should-compile #[(function compile) " Y\n=ć\n=Ƈ\n=\nNA  !9 K)!\nNA  !R K)!\nNA  !j K)=\nNA  ! K)A!!" [compile 0 ad-default-compilation-action never nil always t like-original subrp origname function ad-advice-info fboundp byte-code-function-p macro featurep byte-compile] 4] ad-activate-advised-definition #[(function compile) " ! NA@ \f !\" \"% !\fB\f K=?Y K NAAB#Y ! KB# K !B#)" [ad-verify-cache-id function cache ad-advice-info verified-cached-definition ad-safe-fset ad-make-advised-definition ad-should-compile compile ad-compile-function ad-set-advice-info-field ad-clear-cache nil ad-make-cache-id] 7]] 3) (defalias 'ad-handle-definition #[(function) " NA!K) ! Kh u =?u !?u>A #u=P \"u NA \"=u \"u u NA \"*" [origname function ad-advice-info fboundp ad-real-definition current-definition original-definition ad-advised-definition-p ad-redefinition-action (accept discard warn) error "ad-handle-definition (see its doc): `%s' %s" "illegally redefined" discard ad-safe-fset warn message "ad-handle-definition: `%s' got redefined"] 5 "\ Handles 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-activate-on #[(function &optional compile) "Z\nN\n\"Y\n!\nNA!)K)Y\n!9\n!Y\n!V\n \"\n#\n\"!\nY\n!)" [ad-activate-on-top-level nil function ad-advice-info error "ad-activate: `%s' is not advised" ad-handle-definition origname fboundp ad-has-any-advice ad-unadvise ad-has-redefining-advice ad-activate-advised-definition compile ad-set-advice-info-field active t eval ad-make-hook-form activation ad-deactivate] 4 "\ Activates 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." (list (ad-read-advised-function "Activate advice of: ") current-prefix-arg)]) (defalias 'ad-deactivate #[(function) "N \"!U!NA!'K)0\"NA!DK)\"#\"!" [function ad-advice-info error "ad-deactivate: `%s' is not advised" ad-is-active ad-handle-definition origname 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 "\ Deactivates 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'." (list (ad-read-advised-function "Deactivate advice of: " (quote ad-is-active)))]) (defalias 'ad-update #[(function &optional compile) " !\n \"" [ad-is-active function ad-activate-on compile] 3 "\ Update the advised definition of FUNCTION if its advice is active. See `ad-activate-on' for documentation on the optional COMPILE argument." (list (ad-read-advised-function "Update advised definition of: " (quote ad-is-active)))]) (defalias 'ad-unadvise #[(function) "N-!!NA!#! \" \" " [function ad-advice-info ad-is-active ad-deactivate fmakunbound origname put nil delq assoc symbol-name ad-advised-functions] 4 "\ Deactivates FUNCTION and then removes all its advice information. If FUNCTION was not advised this will be a noop." (list (ad-read-advised-function "Unadvise function: "))]) (defalias 'ad-recover #[(function) "NJNA\n!\nK)6NA\n!*\nK)\"NA!#! \" \" " [function ad-advice-info origname fboundp ad-safe-fset fmakunbound put nil delq assoc symbol-name ad-advised-functions] 5 "\ Tries to recover FUNCTION's original definition and unadvises it. This is more low-level than `ad-unadvise' because it does not do any deactivation which might run hooks and get into other trouble. Use in emergencies." (list (intern (completing-read "Recover advised function: " obarray nil t)))]) (defalias 'ad-activate-regexp #[(regexp &optional compile) "& @\n@!\n#\n \" A*" [ad-advised-functions nil function ad-dO-vAr intern ad-find-some-advice any regexp ad-activate-on compile] 5 "\ Activates functions with an advice name containing a REGEXP match. See `ad-activate-on' for documentation on the optional COMPILE argument." (list (ad-read-regexp "Activate via advice regexp: ") current-prefix-arg)]) (defalias 'ad-deactivate-regexp #[(regexp) "$ @\n@!\n#\n! A*" [ad-advised-functions nil function ad-dO-vAr intern ad-find-some-advice any regexp ad-deactivate] 5 "\ Deactivates functions with an advice name containing REGEXP match." (list (ad-read-regexp "Deactivate via advice regexp: "))]) (defalias 'ad-update-regexp #[(regexp &optional compile) "& @\n@!\n#\n \" A*" [ad-advised-functions nil function ad-dO-vAr intern ad-find-some-advice any regexp ad-update compile] 5 "\ Updates functions with an advice name containing a REGEXP match. See `ad-activate-on' for documentation on the optional COMPILE argument." (list (ad-read-regexp "Update via advice regexp: ") current-prefix-arg)]) (defalias 'ad-activate-all #[(&optional compile) " @\n@!\n\" A*" [ad-advised-functions nil function ad-dO-vAr intern ad-activate-on compile] 4 "\ Activates all currently advised functions. See `ad-activate-on' for documentation on the optional COMPILE argument." "P"]) (defalias 'ad-deactivate-all #[nil " @\n@!\n! A*" [ad-advised-functions nil function ad-dO-vAr intern ad-deactivate] 3 "\ Deactivates all currently advised functions." nil]) (defalias 'ad-update-all #[(&optional compile) " @\n@!\n\" A*" [ad-advised-functions nil function ad-dO-vAr intern ad-update compile] 4 "\ Updates all currently advised functions. With prefix argument compiles resulting advised definitions." "P"]) (defalias 'ad-unadvise-all #[nil " @\n@!\n! A*" [ad-advised-functions nil function ad-dO-vAr intern ad-unadvise] 3 "\ Unadvises all currently advised functions." nil]) (defalias 'ad-recover-all #[nil " @\n@!Ə A*" [ad-advised-functions nil function ad-dO-vAr intern (ad-recover function) ((error))] 4 "\ Recovers all currently advised functions. Use in emergencies." nil]) (byte-code "!" [boundp ad-defadvice-flags (("protect") ("disable") ("activate") ("compile") ("preactivate") ("freeze"))] 2) (defalias 'defadvice '(macro . #[(function args &rest body) " ! \"\f@ ! \"\fA@!/\"?\fAA\f@!?\f@\fA \f@>?\fBBB$>{   $>   $ DD D D D@=@ADD@DA@DFC> D>EC DC#BB." [ad-name-p function error "defadvice: Illegal function name: %s" args class ad-class-p "defadvice: Illegal advice class: %s" name "defadvice: Illegal advice name: %s" ad-position-p position arglist mapcar #[(flag) "\n! \"=\n\"\f \"\f!\"\n\")" [try-completion symbol-name flag ad-defadvice-flags completion t assoc intern error "defadvice: Illegal or ambiguous flag: %s"] 4] flags ad-make-advice protect disable advice lambda body preactivate ad-preactivate-advice preactivation freeze ad-make-freeze-definition progn ad-add-advice quote append ad-set-cache macro ad-macrofy activate ad-activate-on compile t] 8 "\ Defines 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. Look at the file `advice.el' for comprehensive documentation."])) (defalias 'ad-with-originals '(macro . #[(functions &rest body) "\f\" \f\" \"B\f\"BBE*" [-1 index mapcar #[(function) "T\"!DDD" [index intern format "ad-oRiGdEf-%d" symbol-function quote function] 4] functions current-bindings let unwind-protect progn append #[(function) "T D DD8@EE" [index ad-safe-fset quote function or ad-get-orig-definition current-bindings] 6] body #[(function) "T D\f8@E" [index ad-safe-fset quote function current-bindings] 4]] 8 "\ Binds FUNCTIONS to their original definitions and executes 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."])) (byte-code "N\f#$B#" [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 ((function (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) " \f\";0 \"0 Ȕȕ#@N/ !\f/ !) )" [nil ad-return-value ad-Orig-documentation function raw string-match ad-advised-definition-docstring-regexp 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) (defalias 'ad-start-advice #[nil "#\"#\"" [put ad-activate ad-advice-info nil ad-safe-fset ad-activate-on ad-enable-advice documentation after ad-advised-docstring compile] 4 "\ Starts the automatic advice handling magic." nil]) (defalias 'ad-stop-advice #[nil "##!\"" [put ad-activate ad-advice-info nil ad-disable-advice documentation after ad-advised-docstring ad-update ad-safe-fset ad-activate-off] 4 "\ Stops the automatic advice handling magic. You should only need this in case of Advice-related emergencies." nil]) (defalias 'ad-recover-normality #[nil "#\" É" [put ad-activate ad-advice-info nil ad-safe-fset ad-activate-off ad-recover-all ad-advised-functions] 4 "\ Undoes all advice related redefinitions and unadvises everything. Use only in REAL emergencies." nil]) (byte-code " !" [ad-start-advice provide advice] 2)