diff options
Diffstat (limited to 'lisp/emacs-lisp/advice.el')
| -rw-r--r-- | lisp/emacs-lisp/advice.el | 136 |
1 files changed, 47 insertions, 89 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 861054e777f..4ee830023fc 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1,9 +1,9 @@ ;;; advice.el --- An overloading mechanism for Emacs Lisp functions -*- lexical-binding: t -*- -;; Copyright (C) 1993-1994, 2000-2013 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2000-2015 Free Software Foundation, Inc. ;; Author: Hans Chalupsky <hans@cs.buffalo.edu> -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Created: 12 Dec 1992 ;; Keywords: extensions, lisp, tools ;; Package: emacs @@ -168,7 +168,8 @@ ;; "Switch to non-existing buffers only upon confirmation." ;; (interactive "BSwitch to buffer: ") ;; (if (or (get-buffer (ad-get-arg 0)) -;; (y-or-n-p (format "`%s' does not exist, create? " (ad-get-arg 0)))) +;; (y-or-n-p (format-message "`%s' does not exist, create? " +;; (ad-get-arg 0)))) ;; ad-do-it)) ;; ;;(defadvice find-file (before existing-files-only activate) @@ -295,8 +296,8 @@ ;; {<after-K-1-body-form>}* ;; ad-return-value)) -;; Macros and special forms will be redefined as macros, hence the optional -;; [macro] in the beginning of the definition. +;; Macros are redefined as macros, hence the optional [macro] in the +;; beginning of the definition. ;; <arglist> is either the argument list of the original function or the ;; first argument list defined in the list of before/around/after advices. @@ -698,6 +699,7 @@ ;; problems because they get expanded at compile or load time, hence, they ;; might not have all the necessary runtime support and such advice cannot be ;; de/activated or changed as it is possible for functions. +;; ;; Special forms cannot be advised. ;; ;; MORAL: - Only advise macros when you are absolutely sure what you are doing. @@ -1563,29 +1565,6 @@ ;; flexibility and effectiveness of the advice mechanism. Macros that were ;; compile-time expanded before the advice was activated will of course never ;; exhibit the advised behavior. -;; -;; @@ Advising special forms: -;; ========================== -;; Now for something that should be even more rare than advising macros: -;; Advising special forms. Because special forms are irregular in their -;; argument evaluation behavior (e.g., `setq' evaluates the second but not -;; the first argument) they have to be advised into macros. A dangerous -;; consequence of this is that the byte-compiler will not recognize them -;; as special forms anymore (well, in most cases) and use their expansion -;; rather than the proper byte-code. Also, because the original definition -;; of a special form cannot be `funcall'ed, `eval' has to be used instead -;; which is less efficient. -;; -;; MORAL: Do not advise special forms unless you are completely sure about -;; what you are doing (some of the forward advice behavior is -;; implemented via advice of the special forms `defun' and `defmacro'). -;; As a safety measure one should always do `ad-deactivate-all' before -;; one byte-compiles a file to avoid any interference of advised -;; special forms. -;; -;; Apart from the safety concerns advising special forms is not any different -;; from advising plain functions or subrs. - ;;; Code: @@ -2101,9 +2080,7 @@ mapped to the closest extremal position). If FUNCTION was not advised already, its advice info will be initialized. Redefining a piece of advice whose name is part of -the cache-id will clear the cache. - -See Info node `(elisp)Computed Advice' for detailed documentation." +the cache-id will clear the cache." (cond ((not (ad-is-advised function)) (ad-initialize-advice-info function) (ad-set-advice-info-field @@ -2173,7 +2150,6 @@ See Info node `(elisp)Computed Advice' for detailed documentation." (defun ad-arglist (definition) "Return the argument list of DEFINITION." - (require 'help-fns) (help-function-arglist (if (or (macrop definition) (ad-advice-p definition)) (cdr definition) @@ -2207,26 +2183,6 @@ Like `interactive-form', but also works on pieces of advice." (if (ad-interactive-form definition) 1 0)) (cdr (cdr (ad-lambda-expression definition))))))) -(defun ad-make-advised-definition-docstring (_function) - "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 (see the code for `documentation')." - (eval-when-compile - (propertize "Advice function assembled by advice.el." - 'dynamic-docstring-function - #'ad--make-advised-docstring))) - -(defun ad-advised-definition-p (definition) - "Return non-nil if DEFINITION was generated from advice information." - (if (or (ad-lambda-p definition) - (macrop definition) - (ad-compiled-p definition)) - (let ((docstring (ad-docstring definition))) - (and (stringp docstring) - (get-text-property 0 'dynamic-docstring-function docstring))))) - (defun ad-definition-type (definition) "Return symbol that describes the type of DEFINITION." ;; These symbols are only ever used to check a cache entry's validity. @@ -2463,8 +2419,8 @@ 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 ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))'." +Example: (ad-map-arglists '(a &rest args) '(w x y z)) will return + (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))." (let* ((parsed-source-arglist (ad-parse-arglist source-arglist)) (source-reqopt-args (append (nth 0 parsed-source-arglist) (nth 1 parsed-source-arglist))) @@ -2518,38 +2474,39 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return (capitalize (symbol-name class)) (ad-advice-name advice))))))) -(require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage. - -(defun ad--make-advised-docstring (origdoc function &optional style) +(defun ad--make-advised-docstring (function &optional style) "Construct a documentation string for the advised FUNCTION. -It concatenates the original documentation with the documentation -strings of the individual pieces of advice which will be formatted -according to STYLE. STYLE can be `plain', everything else -will be interpreted as `default'. The order of the advice documentation -strings corresponds to before/around/after and the individual ordering -in any of these classes." - (if (and (symbolp function) - (string-match "\\`ad-+Advice-" (symbol-name function))) - (setq function - (intern (substring (symbol-name function) (match-end 0))))) - (let* ((usage (help-split-fundoc origdoc function)) - paragraphs advice-docstring) - (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage))) - (if origdoc (setq paragraphs (list origdoc))) - (dolist (class ad-advice-classes) - (dolist (advice (ad-get-enabled-advices function class)) - (setq advice-docstring - (ad-make-single-advice-docstring advice class style)) - (if advice-docstring - (push advice-docstring paragraphs)))) - (setq origdoc (if paragraphs - (propertize - ;; separate paragraphs with blank lines: - (mapconcat 'identity (nreverse paragraphs) "\n\n") - ;; FIXME: what is this for? - 'dynamic-docstring-function - #'ad--make-advised-docstring))) - (help-add-fundoc-usage origdoc usage))) +Concatenate the original documentation with the documentation +strings of the individual pieces of advice. Optional argument +STYLE specifies how to format the pieces of advice; it can be +`plain', or any other value which means the default formatting. + +The advice documentation is shown in order of before/around/after +advice type, obeying the priority in each of these types." + ;; Retrieve the original function documentation + (let* ((fun (get function 'function-documentation)) + (origdoc (unwind-protect + (progn (put function 'function-documentation nil) + (documentation function t)) + (put function 'function-documentation fun)))) + (if (and (symbolp function) + (string-match "\\`ad-+Advice-" (symbol-name function))) + (setq function + (intern (substring (symbol-name function) (match-end 0))))) + (let* ((usage (help-split-fundoc origdoc function)) + paragraphs advice-docstring) + (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage))) + (if origdoc (setq paragraphs (list origdoc))) + (dolist (class ad-advice-classes) + (dolist (advice (ad-get-enabled-advices function class)) + (setq advice-docstring + (ad-make-single-advice-docstring advice class style)) + (if advice-docstring + (push advice-docstring paragraphs)))) + (setq origdoc (if paragraphs + (mapconcat 'identity (nreverse paragraphs) + "\n\n"))) + (help-add-fundoc-usage origdoc usage)))) ;; @@@ Accessing overriding arglists and interactive forms: @@ -2597,7 +2554,7 @@ in any of these classes." ;; Finally, build the sucker: (ad-assemble-advised-definition advised-arglist - (ad-make-advised-definition-docstring function) + nil interactive-form orig-form (ad-get-enabled-advices function 'before) @@ -2911,6 +2868,8 @@ The current definition and its cache-id will be put into the cache." (fset advicefunname (or verified-cached-definition (ad-make-advised-definition function))) + (put advicefunname 'function-documentation + `(ad--make-advised-docstring ',advicefunname)) (unless (equal (interactive-form advicefunname) old-ispec) ;; If the interactive-spec of advicefunname has changed, force nadvice to ;; refresh its copy. @@ -3148,7 +3107,7 @@ deactivation, which might run hooks and get into other trouble." "Define a piece of advice for FUNCTION (a symbol). The syntax of `defadvice' is as follows: - \(defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) + (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) [DOCSTRING] [INTERACTIVE-FORM] BODY...) @@ -3186,11 +3145,10 @@ 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. -See Info node `(elisp)Advising Functions' for comprehensive documentation. usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) [DOCSTRING] [INTERACTIVE-FORM] BODY...)" - (declare (doc-string 3) + (declare (doc-string 3) (indent 2) (debug (&define name ;; thing being advised. (name ;; class is [&or "before" "around" "after" ;; "activation" "deactivation"] |