;;; advice.el --- an overloading mechanism for Emacs Lisp functions
-;; Copyright (C) 1993,1994,2000,01,2004 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
;; Maintainer: FSF
;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;; LCD Archive Entry:
;; advice|Hans Chalupsky|hans@cs.buffalo.edu|
;; ============================================
;; The advice-info of an advised function contains its `origname' which is
;; a symbol that is fbound to the original definition available at the first
-;; proper activation of the function after a legal re/definition. If the
+;; proper activation of the function after a valid re/definition. If the
;; original was defined via fcell indirection then `origname' will be defined
;; just so. Hence, to get hold of the actual original definition of a function
;; we need to use `ad-real-orig-definition'.
(let* ((ad-pReDiCaTe predicate)
(function
(completing-read
- (format "%s(default %s) " (or prompt "Function: ") default)
+ (format "%s (default %s): " (or prompt "Function") default)
ad-advised-functions
(if predicate
(function
ad-advice-classes))
(defun ad-read-advice-class (function &optional prompt default)
- "Read a legal advice class with completion from the minibuffer.
+ "Read a valid advice class with completion from the minibuffer.
An optional PROMPT will be used to prompt for the class. DEFAULT will
be returned on empty input (defaults to the first non-empty advice
class of FUNCTION)."
(ad-do-return class)))
(error "ad-read-advice-class: `%s' has no advices" function)))
(let ((class (completing-read
- (format "%s(default %s) " (or prompt "Class: ") default)
+ (format "%s (default %s): " (or prompt "Class") default)
ad-advice-class-completion-table nil t)))
(if (equal class "")
default
(error "ad-read-advice-name: `%s' has no %s advice"
function class)
(car (car name-completion-table))))
- (prompt (format "%s(default %s) " (or prompt "Name: ") default))
+ (prompt (format "%s (default %s): " (or prompt "Name") default))
(name (completing-read prompt name-completion-table nil t)))
(if (equal name "")
(intern default)
(defun ad-read-regexp (&optional prompt)
"Read a regular expression from the minibuffer."
(let ((regexp (read-from-minibuffer
- (concat (or prompt "Regular expression: ")
- (if (equal ad-last-regexp "") ""
- (format "(default \"%s\") " ad-last-regexp))))))
+ (concat (or prompt "Regular expression")
+ (if (equal ad-last-regexp "") ": "
+ (format " (default %s): " ad-last-regexp))))))
(setq ad-last-regexp
(if (equal regexp "") ad-last-regexp regexp))))
(defun ad-find-some-advice (function class name)
"Find 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."
+If CLASS is `any' all valid advice classes will be checked."
(if (ad-is-advised function)
(let (found-advice)
(ad-dolist (advice-class ad-advice-classes)
"Set enable FLAG of FUNCTION's advices in CLASS matching NAME.
If NAME is a string rather than a symbol then it's interpreted as a regular
expression and all advices whose name contain a match for it will be
-affected. If CLASS is `any' advices in all legal advice classes will be
+affected. If CLASS is `any' advices in all valid advice classes will be
considered. The number of changed advices will be returned (or nil if
FUNCTION was not advised)."
(if (ad-is-advised function)
(ad-advice-set-enabled advice flag))))))
matched-advices)))
+;;;###autoload
(defun ad-enable-advice (function class name)
"Enables the advice of FUNCTION with CLASS and NAME."
- (interactive (ad-read-advice-specification "Enable advice of: "))
+ (interactive (ad-read-advice-specification "Enable advice of"))
(if (ad-is-advised function)
(if (eq (ad-enable-advice-internal function class name t) 0)
(error "ad-enable-advice: `%s' has no %s advice matching `%s'"
function class name))
(error "ad-enable-advice: `%s' is not advised" function)))
+;;;###autoload
(defun ad-disable-advice (function class name)
"Disable the advice of FUNCTION with CLASS and NAME."
- (interactive (ad-read-advice-specification "Disable advice of: "))
+ (interactive (ad-read-advice-specification "Disable advice of"))
(if (ad-is-advised function)
(if (eq (ad-enable-advice-internal function class name nil) 0)
(error "ad-disable-advice: `%s' has no %s advice matching `%s'"
(defun ad-enable-regexp-internal (regexp class flag)
"Set enable FLAGs of all CLASS advices whose name contains a REGEXP match.
-If CLASS is `any' all legal advice classes are considered. The number of
+If CLASS is `any' all valid advice classes are considered. The number of
affected advices will be returned."
(let ((matched-advices 0))
(ad-do-advised-functions (advised-function)
"Enables all advices with names that contain a match for REGEXP.
All currently advised functions will be considered."
(interactive
- (list (ad-read-regexp "Enable advices via regexp: ")))
+ (list (ad-read-regexp "Enable advices via regexp")))
(let ((matched-advices (ad-enable-regexp-internal regexp 'any t)))
(if (interactive-p)
(message "%d matching advices enabled" matched-advices))
"Disable all advices with names that contain a match for REGEXP.
All currently advised functions will be considered."
(interactive
- (list (ad-read-regexp "Disable advices via regexp: ")))
+ (list (ad-read-regexp "Disable advices via regexp")))
(let ((matched-advices (ad-enable-regexp-internal regexp 'any nil)))
(if (interactive-p)
(message "%d matching advices disabled" matched-advices))
"Remove 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."
- (interactive (ad-read-advice-specification "Remove advice of: "))
+ (interactive (ad-read-advice-specification "Remove advice of"))
(if (ad-is-advised function)
- (let* ((advice-to-remove (ad-find-advice function class name)))
+ (let ((advice-to-remove (ad-find-advice function class name)))
(if advice-to-remove
(ad-set-advice-info-field
function class
A three-element list is returned, where the 1st element is the list of
required arguments, the 2nd is the list of optional arguments, and the 3rd
is the name of an optional rest parameter (or nil)."
- (let* (required optional rest)
+ (let (required optional rest)
(setq rest (car (cdr (memq '&rest arglist))))
(if rest (setq arglist (reverse (cdr (memq '&rest (reverse arglist))))))
(setq optional (cdr (memq '&optional arglist)))
(defun ad-make-mapped-call (source-arglist target-arglist target-function)
"Make form to call TARGET-FUNCTION with args from SOURCE-ARGLIST."
- (let* ((mapped-form (ad-map-arglists source-arglist target-arglist)))
+ (let ((mapped-form (ad-map-arglists source-arglist target-arglist)))
(if (eq (car mapped-form) 'funcall)
(cons target-function (cdr (cdr mapped-form)))
(prog1 mapped-form
(not advised-interactive-form))
;; Check whether we were called interactively
;; in order to do proper prompting:
- `(if (interactive-p)
+ `(if (called-interactively-p)
(call-interactively ',origname)
- ,(ad-make-mapped-call orig-arglist
- advised-arglist
+ ,(ad-make-mapped-call advised-arglist
+ orig-arglist
origname)))
;; And now for normal functions and non-interactive subrs
;; (or subrs whose interactive behavior was advised):
Clear the cache if you want to force `ad-activate' to construct a new
advised definition from scratch."
(interactive
- (list (ad-read-advised-function "Clear cached definition of: ")))
+ (list (ad-read-advised-function "Clear cached definition of")))
(ad-set-advice-info-field function 'cache nil))
(defun ad-make-cache-id (function)
;; @@ The top-level advice interface:
;; ==================================
+;;;###autoload
(defun ad-activate (function &optional compile)
"Activate all the advice information of an advised FUNCTION.
If FUNCTION has a proper original definition then an advised
enabled is equivalent to a call to `ad-deactivate'. The current advised
definition will always be cached for later usage."
(interactive
- (list (ad-read-advised-function "Activate advice of: ")
+ (list (ad-read-advised-function "Activate advice of")
current-prefix-arg))
(if ad-activate-on-top-level
;; avoid recursive calls to `ad-activate':
information will still be available so it can be activated again with
a call to `ad-activate'."
(interactive
- (list (ad-read-advised-function "Deactivate advice of: " 'ad-is-active)))
+ (list (ad-read-advised-function "Deactivate advice of" 'ad-is-active)))
(if (not (ad-is-advised function))
(error "ad-deactivate: `%s' is not advised" function)
(cond ((ad-is-active function)
See `ad-activate' for documentation on the optional COMPILE argument."
(interactive
(list (ad-read-advised-function
- "Update advised definition of: " 'ad-is-active)))
+ "Update advised definition of" 'ad-is-active)))
(if (ad-is-active function)
(ad-activate function compile)))
"Deactivate FUNCTION and then remove all its advice information.
If FUNCTION was not advised this will be a noop."
(interactive
- (list (ad-read-advised-function "Unadvise function: ")))
+ (list (ad-read-advised-function "Unadvise function")))
(cond ((ad-is-advised function)
(if (ad-is-active function)
(ad-deactivate function))
that has at least one piece of advice whose name includes a match for REGEXP.
See `ad-activate' for documentation on the optional COMPILE argument."
(interactive
- (list (ad-read-regexp "Activate via advice regexp: ")
+ (list (ad-read-regexp "Activate via advice regexp")
current-prefix-arg))
(ad-do-advised-functions (function)
(if (ad-find-some-advice function 'any regexp)
This deactivates the advice for each function
that has at least one piece of advice whose name includes a match for REGEXP."
(interactive
- (list (ad-read-regexp "Deactivate via advice regexp: ")))
+ (list (ad-read-regexp "Deactivate via advice regexp")))
(ad-do-advised-functions (function)
(if (ad-find-some-advice function 'any regexp)
(ad-deactivate function))))
that has at least one piece of advice whose name includes a match for REGEXP.
See `ad-activate' for documentation on the optional COMPILE argument."
(interactive
- (list (ad-read-regexp "Update via advice regexp: ")
+ (list (ad-read-regexp "Update via advice regexp")
current-prefix-arg))
(ad-do-advised-functions (function)
(if (ad-find-some-advice function 'any regexp)
(error nil))))
-;; Completion alist of legal `defadvice' flags
+;; Completion alist of valid `defadvice' flags
(defvar ad-defadvice-flags
'(("protect") ("disable") ("activate")
("compile") ("preactivate") ("freeze")))
\(defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM]
- BODY... )
+ BODY...)
FUNCTION ::= Name of the function to be advised.
CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'.
during preloading.
See Info node `(elisp)Advising Functions' for comprehensive documentation."
+ (declare (doc-string 3))
(if (not (ad-name-p function))
(error "defadvice: Invalid function name: %s" function))
(let* ((class (car args))
(provide 'advice)
-;;; arch-tag: 29f8c9a1-8c88-471f-95d7-e28541c6b7c0
+;; arch-tag: 29f8c9a1-8c88-471f-95d7-e28541c6b7c0
;;; advice.el ends here
HCoop / bpt / emacs.git / blobdiff