X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/fdc9061358d3654e14bfc1419632e1d6c6c5c13e..32226619c5e563c384372b566000e5d37d783a61:/lisp/emacs-lisp/advice.el diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 21136721e6..4165cb5f19 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1,7 +1,7 @@ ;;; advice.el --- an overloading mechanism for Emacs Lisp functions ;; Copyright (C) 1993, 1994, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Hans Chalupsky ;; Maintainer: FSF @@ -10,10 +10,10 @@ ;; 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 @@ -21,9 +21,7 @@ ;; 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 . ;; LCD Archive Entry: ;; advice|Hans Chalupsky|hans@cs.buffalo.edu| @@ -220,7 +218,7 @@ ;; "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))) @@ -1836,7 +1834,7 @@ ;;;###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 @@ -1851,7 +1849,7 @@ interpreted as `error'." ;;;###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 @@ -2392,7 +2390,7 @@ All currently advised functions will be considered." (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)) @@ -2402,7 +2400,7 @@ All currently advised functions will be considered." (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)) @@ -2471,7 +2469,7 @@ will clear the cache." `(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))) @@ -2675,12 +2673,9 @@ For that it has to be fbound with a non-autoload definition." (ad-with-auto-activation-disabled (require 'bytecomp) (let ((symbol (make-symbol "advice-compilation")) - (byte-compile-warnings - (if (listp byte-compile-warnings) byte-compile-warnings - byte-compile-warning-types))) + (byte-compile-warnings byte-compile-warnings)) (if (featurep 'cl) - (setq byte-compile-warnings - (remq 'cl-functions byte-compile-warnings))) + (byte-compile-disable-warning 'cl-functions)) (fset symbol (symbol-function function)) (byte-compile symbol) (fset function (symbol-function symbol)))))) @@ -2786,7 +2781,8 @@ to be accessed, it returns a list with the index and name." (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 @@ -2794,7 +2790,8 @@ to be accessed, it returns a list with the index and name." (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? @@ -3090,7 +3087,7 @@ in any of these classes." (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 @@ -3795,7 +3792,10 @@ the advised function. `freeze' implies `activate' and `preactivate'. The documentation of the advised function can be dumped onto the `DOC' file during preloading. -See Info node `(elisp)Advising Functions' for comprehensive documentation." +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))