;;; advice.el --- an overloading mechanism for Emacs Lisp functions
-;; Copyright (C) 1993, 1994, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2000-2011 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
;; Maintainer: FSF
;; Created: 12 Dec 1992
;; Keywords: extensions, lisp, tools
+;; Package: emacs
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; LCD Archive Entry:
;; advice|Hans Chalupsky|hans@cs.buffalo.edu|
;; "Make `car' an interactive function."
;; (interactive "xCar of list: ")
;; ad-do-it
-;; (if (interactive-p)
+;; (if (called-interactively-p 'interactive)
;; (message "%s" ad-return-value)))
;;;###autoload
(defcustom ad-redefinition-action 'warn
- "*Defines what to do with redefinitions during Advice de/activation.
+ "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
;;;###autoload
(defcustom ad-default-compilation-action 'maybe
- "*Defines whether to compile advised definitions during activation.
+ "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
(defmacro ad-set-orig-definition (function definition)
`(ad-safe-fset
- (ad-get-advice-info-field function 'origname) ,definition))
+ (ad-get-advice-info-field ,function 'origname) ,definition))
(defmacro ad-clear-orig-definition (function)
`(fmakunbound (ad-get-advice-info-field ,function 'origname)))
(interactive
(list (ad-read-regexp "Enable advices via regexp")))
(let ((matched-advices (ad-enable-regexp-internal regexp 'any t)))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%d matching advices enabled" matched-advices))
matched-advices))
(interactive
(list (ad-read-regexp "Disable advices via regexp")))
(let ((matched-advices (ad-enable-regexp-internal regexp 'any nil)))
- (if (interactive-p)
+ (if (called-interactively-p 'interactive)
(message "%d matching advices disabled" matched-advices))
matched-advices))
;;;###autoload
(defun ad-add-advice (function advice class position)
"Add a piece of ADVICE to FUNCTION's list of advices in CLASS.
-If FUNCTION already has one or more pieces of advice of the specified
-CLASS then POSITION determines where the new piece will go. The value
-of POSITION can either be `first', `last' or a number where 0 corresponds
-to `first'. Numbers outside the range will be mapped to the closest
-extreme position. If there was already a piece of ADVICE with the same
-name, then the position argument will be ignored and the old advice
-will be overwritten with the new one.
- If the FUNCTION was not advised already, then its advice info will be
-initialized. Redefining a piece of advice whose name is part of the cache-id
-will clear the cache."
+
+ADVICE has the form (NAME PROTECTED ENABLED DEFINITION), where
+NAME is the advice name; PROTECTED is a flag specifying whether
+to protect against non-local exits; ENABLED is a flag specifying
+whether to initially enable the advice; and DEFINITION has the
+form (advice . LAMBDA), where LAMBDA is a lambda expression.
+
+If FUNCTION already has a piece of advice with the same name,
+then POSITION is ignored, and the old advice is overwritten with
+the new one.
+
+If FUNCTION already has one or more pieces of advice of the
+specified CLASS, then POSITION determines where the new piece
+goes. POSITION can either be `first', `last' or a number (where
+0 corresponds to `first', and numbers outside the valid range are
+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."
(cond ((not (ad-is-advised function))
(ad-initialize-advice-info function)
(ad-set-advice-info-field
`(cdr ,definition))
(defun ad-special-form-p (definition)
- "Non-nil iff DEFINITION is a special form."
+ "Non-nil if and only if DEFINITION is a special form."
(if (and (symbolp definition) (fboundp definition))
(setq definition (indirect-function definition)))
(and (subrp definition) (eq (cdr (subr-arity definition)) 'unevalled)))
;; because `byte-compile' uses `fset':
(ad-with-auto-activation-disabled
(require 'bytecomp)
+ (require 'warnings) ;To define warning-suppress-types
+ ;before we let-bind it.
(let ((symbol (make-symbol "advice-compilation"))
- (byte-compile-warnings byte-compile-warnings))
+ (byte-compile-warnings byte-compile-warnings)
+ ;; Don't pop up windows showing byte-compiler warnings.
+ (warning-suppress-types '((bytecomp))))
(if (featurep 'cl)
(byte-compile-disable-warning 'cl-functions))
(fset symbol (symbol-function function))
(list (- index (length reqopt-args)) rest-arg)))))
(defun ad-get-argument (arglist index)
- "Return form to access ARGLIST's actual argument at position INDEX."
+ "Return form to access ARGLIST's actual argument at position INDEX.
+INDEX counts from zero."
(let ((argument-access (ad-access-argument arglist index)))
(cond ((consp argument-access)
(ad-element-access
(argument-access))))
(defun ad-set-argument (arglist index value-form)
- "Return form to set ARGLIST's actual arg at INDEX to VALUE-FORM."
+ "Return form to set ARGLIST's actual arg at INDEX to VALUE-FORM.
+INDEX counts from zero."
(let ((argument-access (ad-access-argument arglist index)))
(cond ((consp argument-access)
;; should this check whether there actually is something to set?
(setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
(if origdoc (setq paragraphs (list origdoc)))
(unless (eq style 'plain)
- (push (propertize (concat "This " origtype " is advised.")
- 'face 'font-lock-warning-face)
- paragraphs))
+ (push (concat "This " origtype " is advised.") paragraphs))
(ad-dolist (class ad-advice-classes)
(ad-dolist (advice (ad-get-enabled-advices function class))
(setq advice-docstring
(not advised-interactive-form))
;; Check whether we were called interactively
;; in order to do proper prompting:
- `(if (called-interactively-p)
+ `(if (called-interactively-p 'any)
(call-interactively ',origname)
,(ad-make-mapped-call advised-arglist
orig-arglist
documentation of the advised function can be dumped onto the `DOC' file
during preloading.
-See Info node `(elisp)Advising Functions' for comprehensive documentation."
+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))
(if (not (ad-name-p function))
(error "defadvice: Invalid function name: %s" function))
(provide 'advice)
-;; arch-tag: 29f8c9a1-8c88-471f-95d7-e28541c6b7c0
;;; advice.el ends here
HCoop / bpt / emacs.git / blobdiff