;ELC ;;; compiled by kwzh@hal.gnu.ai.mit.edu on Tue May 2 20:11:06 1995 ;;; from file /gd/gnu/emacs/19.0/lisp/advice.el ;;; emacs version 19.28.90.69. ;;; 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"] 3) (defalias 'ad-lemacs-p '(macro . #[nil "\n\"" [string-match "Lucid" emacs-version] 3])) (byte-code "\nB" ["2.14" ad-version current-load-list] 2) #@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'. (defvar ad-redefinition-action (quote warn) (#$ . -709)) #@501 *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. (defvar ad-default-compilation-action (quote maybe) (#$ . -1387)) (defalias 'ad-substitute-tree #[(sUbTrEe-TeSt fUnCtIoN tReE) ":, @!\n@!$@:\" \n@#$@ \nA#B !6\n!" [tReE sUbTrEe-TeSt fUnCtIoN ad-substitute-tree] 5]) (defalias 'ad-copy-tree #[(tree) ":@!A!B" [tree ad-copy-tree] 3]) #@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) "\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 (#$ . 2214)])) (defalias 'ad-do-return '(macro . #[(value) "\nE" [throw (quote ad-dO-eXiT) value] 3])) (byte-code "N\f#" [ad-dolist lisp-indent-hook put 1] 4) (defalias '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])) (defalias '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]) (byte-code " ! \fBÇ" [ad-save-real-definitions boundp ad-advised-functions nil current-load-list] 2) (defalias '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])) (defalias 'ad-pop-advised-function '(macro . #[(function) " DBBBBE" [setq ad-advised-functions delq assoc symbol-name function (ad-advised-functions) (ad-advised-functions)] 6])) (defalias 'ad-do-advised-functions '(macro . #[(varform &rest body) " @ A@E @ @DDEBBB" [ad-dolist varform ad-advised-functions setq intern car body] 7])) (byte-code "N\f#" [ad-do-advised-functions lisp-indent-hook put 1] 4) (defalias 'ad-get-advice-info '(macro . #[(function) " BB" [get function ((quote ad-advice-info))] 3])) (defalias 'ad-set-advice-info '(macro . #[(function advice-info) " F" [put function (quote ad-advice-info) advice-info] 4])) (defalias 'ad-copy-advice-info '(macro . #[(function) "\nBBD" [ad-copy-tree get function ((quote ad-advice-info))] 4])) (defalias 'ad-is-advised '(macro . #[(function) " D" [ad-get-advice-info function] 2])) (defalias 'ad-initialize-advice-info #[(function) "\n! \"\n!C B\nBC#" [assoc symbol-name function ad-advised-functions put ad-advice-info active nil] 5]) (defalias 'ad-get-advice-info-field '(macro . #[(function field) "\n\fDED" [cdr assq field ad-get-advice-info function] 5])) (defalias 'ad-set-advice-info-field #[(function field value) "N\nN\nN N\n BC" [function ad-advice-info field value] 3]) (defalias 'ad-is-active #[(function) " NA" [active function ad-advice-info] 3]) #@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" [name protect enable definition] 4 (#$ . 5501)]) (defalias 'ad-advice-name '(macro . #[(advice) " D" [car advice] 2])) (defalias 'ad-advice-protected '(macro . #[(advice) "\nE" [nth 1 advice] 3])) (defalias 'ad-advice-enabled '(macro . #[(advice) "\nE" [nth 2 advice] 3])) (defalias 'ad-advice-definition '(macro . #[(advice) "\nE" [nth 3 advice] 3])) (defalias 'ad-advice-set-enabled #[(advice flag) "AA " [advice flag] 2]) (defalias 'ad-class-p #[(thing) " >" [thing ad-advice-classes] 2]) (defalias 'ad-name-p #[(thing) "9" [thing] 1]) (defalias 'ad-position-p #[(thing) " ! >" [natnump thing (first last)] 2]) (byte-code "! B" [boundp ad-advice-classes (before around after activation deactivation) current-load-list] 2) (defalias '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]) (defalias 'ad-has-redefining-advice #[(function) "N\"\"\"" [function ad-advice-info ad-has-enabled-advice before around after] 3]) (defalias '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]) (defalias '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]) #@72 Automatic advice activation is disabled. `ad-start-advice' enables it. (defalias 'ad-activate #[(function &optional compile) "" [nil] 1 (#$ . 7381)]) #@72 Automatic advice activation is disabled. `ad-start-advice' enables it. (defalias 'ad-activate-off #[(function &optional compile) "" [nil] 1 (#$ . 7539)]) (byte-code "! B" [boundp ad-activate-on-top-level t current-load-list] 2) (defalias 'ad-with-auto-activation-disabled '(macro . #[(&rest body) "\nBB" [let ((ad-activate-on-top-level nil)) body] 3])) (defalias 'ad-safe-fset #[(symbol definition) "\n M)" [nil ad-activate-on-top-level symbol definition] 2]) (defalias 'ad-make-origname #[(function) " \"!" [intern format "ad-Orig-%s" function] 4]) (defalias 'ad-get-orig-definition '(macro . #[(function) " BBDCBB" [let origname ad-get-advice-info-field function ((quote origname)) ((if (fboundp origname) (symbol-function origname)))] 5])) (defalias 'ad-set-orig-definition '(macro . #[(function definition) "\nE" [ad-safe-fset (ad-get-advice-info-field function (quote origname)) definition] 3])) (defalias 'ad-clear-orig-definition '(macro . #[(function) "\nBBD" [fmakunbound ad-get-advice-info-field function ((quote origname))] 4])) (defalias '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]) (byte-code "! \f\" B" [boundp ad-advice-class-completion-table mapcar #[(class) " !C" [symbol-name class] 2] ad-advice-classes current-load-list] 3) (defalias '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]) (defalias '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]) (defalias '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]) (byte-code "! B" [boundp ad-last-regexp "" current-load-list] 2) (defalias 'ad-read-regexp #[(&optional prompt) "  ĚĂ \"P!Ě\" $)" [read-from-minibuffer prompt "Regular expression: " ad-last-regexp "" format "(default \"%s\") " regexp] 6]) (defalias 'ad-find-advice '(macro . #[(function class name) " \fEE" [assq name ad-get-advice-info-field function class] 5])) (defalias 'ad-advice-position #[(function class name) " \nNA \nNA\f G\f >GZ*" [name class function ad-advice-info found-advice advices] 4]) #@201 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 '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 (#$ . 11087)]) (defalias '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]) #@53 Enables the advice of FUNCTION with CLASS and NAME. (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 (#$ . 12141) (ad-read-advice-specification "Enable advice of: ")]) #@54 Disables the advice of FUNCTION with CLASS and NAME. (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 (#$ . 12524) (ad-read-advice-specification "Disable advice of: ")]) (defalias '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]) #@117 Enables all advices with names that contain a match for REGEXP. All currently advised functions will be considered. (defalias 'ad-enable-regexp #[(regexp) " #t\f\"\f)" [ad-enable-regexp-internal regexp any t matched-advices message "%d matching advices enabled"] 4 (#$ . 13155) (list (ad-read-regexp "Enable advices via regexp: "))]) #@118 Disables all advices with names that contain a match for REGEXP. All currently advised functions will be considered. (defalias 'ad-disable-regexp #[(regexp) " #t\f\"\f)" [ad-enable-regexp-internal regexp any nil matched-advices message "%d matching advices disabled"] 4 (#$ . 13507) (list (ad-read-regexp "Disable advices via regexp: "))]) #@151 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. (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 (#$ . 13865) (ad-read-advice-specification "Remove advice of: ")]) #@701 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. (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 (#$ . 14376)]) (defalias 'ad-macrofy '(macro . #[(definition) "\nE" [cons (quote macro) definition] 3])) (defalias 'ad-lambdafy '(macro . #[(definition) " D" [cdr definition] 2])) (byte-code "! \" B" [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) current-load-list] 3) (defalias 'ad-special-form-p '(macro . #[(definition) " E" [memq definition ad-special-forms] 3])) (defalias 'ad-interactive-p '(macro . #[(definition) " D" [commandp definition] 2])) (defalias 'ad-subr-p '(macro . #[(definition) " D" [subrp definition] 2])) (defalias 'ad-macro-p '(macro . #[(definition) "\nDBB" [eq car-safe definition ((quote macro))] 3])) (defalias 'ad-lambda-p '(macro . #[(definition) "\nDBB" [eq car-safe definition ((quote lambda))] 3])) (defalias 'ad-advice-p '(macro . #[(definition) "\nDBB" [eq car-safe definition ((quote advice))] 3])) (byte-code "!!\"" [fboundp byte-code-function-p compiled-function-p ad-safe-fset] 3) (defalias 'ad-compiled-p '(macro . #[(definition) "\nD\nD\nDDEE" [or byte-code-function-p definition and ad-macro-p ad-lambdafy] 7])) (defalias 'ad-compiled-code '(macro . #[(compiled-definition) "\nD\nD\nF" [if ad-macro-p compiled-definition ad-lambdafy] 4])) (defalias 'ad-lambda-expression #[(definition) "= =A=Ać" [definition lambda macro advice nil] 2]) (defalias '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]) (defalias 'ad-define-subr-args '(macro . #[(subr arglist) " \fDF" [put subr (quote ad-subr-arglist) list arglist] 5])) (defalias 'ad-undefine-subr-args '(macro . #[(subr) " BB" [put subr ((quote ad-subr-arglist) nil)] 3])) (defalias 'ad-subr-args-defined-p '(macro . #[(subr) " BB" [get subr ((quote ad-subr-arglist))] 3])) (defalias 'ad-get-subr-args '(macro . #[(subr) "\nBBD" [car get subr ((quote ad-subr-arglist))] 4])) (defalias '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]) (defalias 'ad-docstring #[(definition) " ! = A! \"! !AA@;/!1)" [byte-code-function-p definition macro ad-real-documentation t ad-lambda-expression docstring natnump] 4]) (defalias 'ad-interactive-form #[(definition) " ! =, A!, !? =' A( HD =: =? !!" [byte-code-function-p definition macro commandp interactive 5 advice lambda ad-lambda-expression] 3]) (defalias '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]) (byte-code "! B" [boundp ad-advised-definition-docstring-regexp "^\\$ad-doc: \\(.+\\)\\$$" current-load-list] 2) (defalias 'ad-make-advised-definition-docstring #[(function) " !\"" [format "$ad-doc: %s$" prin1-to-string function] 4]) (defalias '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]) (defalias '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]) (defalias 'ad-has-proper-definition #[(function) "9!K=?" [function fboundp autoload] 2]) (defalias 'ad-real-definition #[(function) " ! K9\n!\n)" [ad-has-proper-definition function definition ad-real-definition] 3]) (defalias 'ad-real-orig-definition #[(function) "NNA!" [function ad-advice-info ad-real-definition origname] 4]) (defalias 'ad-is-compilable #[(function) " !+ K= K=+ K!* K=* KA!?" [ad-has-proper-definition function lambda macro byte-code-function-p] 2]) #@62 Byte-compiles FUNCTION (or macro) if it is not yet compiled. (defalias 'ad-compile-function #[(function) " !\f !)" [ad-is-compilable function nil ad-activate-on-top-level byte-compile] 2 (#$ . 20040) "aByte-compile function: "]) (defalias 'ad-prognify #[(forms) "GX\n@B" [forms 1 progn] 2]) (defalias 'ad-parse-arglist #[(arglist) " >A@ !>A! >A. !>A!0  \n E+" [nil required optional rest &rest arglist reverse &optional] 5]) (defalias '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]) (defalias 'ad-arg-binding-field #[(binding field) "= \n@=\nA@=\nAA@" [field name binding value type] 2]) (defalias 'ad-list-access #[(position list) "U\nU\nD\nE" [position 0 list 1 cdr nthcdr] 3]) (defalias 'ad-element-access #[(position list) "U\n DU DD E" [position 0 car list 1 cdr nth] 3]) (defalias '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]) (defalias 'ad-get-argument #[(arglist index) " \n\": @ A@\" )" [ad-access-argument arglist index argument-access ad-element-access] 4]) (defalias '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]) (defalias '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]) (defalias '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] #[(form) "" [values-form] 1] let values-form append reverse] 6]) (defalias '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]) #@594 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))'. (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 (#$ . 23101)]) (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]) (defalias '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]) (defalias '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]) (defalias 'ad-make-plain-docstring #[(function) " \"" [ad-make-advised-docstring function plain] 3]) (defalias 'ad-make-freeze-docstring #[(function) " \"" [ad-make-advised-docstring function freeze] 3]) (defalias '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]) (defalias '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]) (defalias '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]) (defalias '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] #[(form) "" [around-form] 1] 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]) (defalias '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]) (defalias 'ad-get-cache-definition '(macro . #[(function) "\nBBD" [car ad-get-advice-info-field function ((quote cache))] 4])) (defalias 'ad-get-cache-id '(macro . #[(function) "\nBBD" [cdr ad-get-advice-info-field function ((quote cache))] 4])) (defalias 'ad-set-cache '(macro . #[(function definition id) " \f EF" [ad-set-advice-info-field function (quote cache) cons definition id] 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) " #" [ad-set-advice-info-field function cache nil] 4 (#$ . 28488) (list (ad-read-advised-function "Clear cached definition of: "))]) (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]) (defalias 'ad-get-cache-class-id #[(function class) " NAA\f= @\"\f= A@\" 8)" [cache function ad-advice-info cache-id class before around 2] 3]) (defalias '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]) (defalias '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]) (defalias 'ad-verify-cache-id #[(function) " !=" [ad-cache-id-verification-code function verified] 2]) (defalias '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]) (defalias '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]) (defalias '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]) (defalias '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]) #@708 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-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 (#$ . 32658)]) #@1007 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. (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 (#$ . 33882) (list (ad-read-advised-function "Activate advice of: ") current-prefix-arg)]) #@280 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'. (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 (#$ . 35464) (list (ad-read-advised-function "Deactivate advice of: " (quote ad-is-active)))]) #@141 Update the advised definition of FUNCTION if its advice is active. See `ad-activate-on' for documentation on the optional COMPILE argument. (defalias 'ad-update #[(function &optional compile) " !\n \"" [ad-is-active function ad-activate-on compile] 3 (#$ . 36232) (list (ad-read-advised-function "Update advised definition of: " (quote ad-is-active)))]) #@117 Deactivates FUNCTION and then removes all its advice information. If FUNCTION was not advised this will be a noop. (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 (#$ . 36599) (list (ad-read-advised-function "Unadvise function: "))]) #@219 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. (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 (#$ . 37008) (list (intern (completing-read "Recover advised function: " obarray nil t)))]) #@141 Activates functions with an advice name containing a REGEXP match. See `ad-activate-on' for documentation on the optional COMPILE argument. (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 (#$ . 37567) (list (ad-read-regexp "Activate via advice regexp: ") current-prefix-arg)]) #@68 Deactivates functions with an advice name containing REGEXP match. (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 (#$ . 38018) (list (ad-read-regexp "Deactivate via advice regexp: "))]) #@139 Updates functions with an advice name containing a REGEXP match. See `ad-activate-on' for documentation on the optional COMPILE argument. (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 (#$ . 38352) (list (ad-read-regexp "Update via advice regexp: ") current-prefix-arg)]) #@117 Activates all currently advised functions. See `ad-activate-on' for documentation on the optional COMPILE argument. (defalias 'ad-activate-all #[(&optional compile) " @\n@!\n\" A*" [ad-advised-functions nil function ad-dO-vAr intern ad-activate-on compile] 4 (#$ . 38793) "P"]) #@46 Deactivates all currently advised functions. (defalias 'ad-deactivate-all #[nil " @\n@!\n! A*" [ad-advised-functions nil function ad-dO-vAr intern ad-deactivate] 3 (#$ . 39099) nil]) #@103 Updates all currently advised functions. With prefix argument compiles resulting advised definitions. (defalias 'ad-update-all #[(&optional compile) " @\n@!\n\" A*" [ad-advised-functions nil function ad-dO-vAr intern ad-update compile] 4 (#$ . 39309) "P"]) #@44 Unadvises all currently advised functions. (defalias 'ad-unadvise-all #[nil " @\n@!\n! A*" [ad-advised-functions nil function ad-dO-vAr intern ad-unadvise] 3 (#$ . 39594) nil]) #@64 Recovers all currently advised functions. Use in emergencies. (defalias 'ad-recover-all #[nil " @\n@!Ə A*" [ad-advised-functions nil function ad-dO-vAr intern (ad-recover function) ((error))] 4 (#$ . 39797) nil]) (byte-code "! B" [boundp ad-defadvice-flags (("protect") ("disable") ("activate") ("compile") ("preactivate") ("freeze")) current-load-list] 2) #@2445 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 '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 (#$ . 40196)])) #@250 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. (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 (#$ . 43608)])) (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) #@45 Starts the automatic advice handling magic. (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 (#$ . 45380) nil]) #@109 Stops the automatic advice handling magic. You should only need this in case of Advice-related emergencies. (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 (#$ . 45643) nil]) #@98 Undoes all advice related redefinitions and unadvises everything. Use only in REAL emergencies. (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 (#$ . 45970) nil]) (byte-code " !" [ad-start-advice provide advice] 2)