comparison lisp/emacs-lisp/advice.el @ 65680:ed770a0a7846

2005-09-24 Emilio C. Lopes <[e-mail]> * woman.el (woman-file-name): * wid-edit.el (widget-file-prompt-value) (widget-coding-system-prompt-value): * w32-fns.el (set-w32-system-coding-system): * vc.el (vc-version-diff, vc-annotate): * textmodes/reftex-auc.el (reftex-arg-cite) (reftex-arg-index-tag): * textmodes/refer.el (refer-get-bib-files): * textmodes/artist.el (artist-figlet-choose-font): * terminal.el (terminal-emulator): * replace.el (occur-read-primary-args): * rect.el (string-rectangle, string-insert-rectangle): * ps-print.el (ps-print-preprint): * progmodes/pascal.el (pascal-goto-defun): * progmodes/etags.el (visit-tags-table, visit-tags-table-buffer): * progmodes/compile.el (compilation-find-file): * printing.el (pr-interactive-n-up): * play/animate.el (animate-birthday-present): * net/rcompile.el (remote-compile): * man.el (man, Man-goto-section, Man-follow-manual-reference): * mail/rmailsum.el (rmail-summary-search-backward) (rmail-summary-search): * mail/rmailout.el (rmail-output-read-rmail-file-name) (rmail-output-read-file-name): * mail/rmail.el (rmail-search, rmail-search-backwards): * mail/mailabbrev.el (merge-mail-abbrevs, rebuild-mail-abbrevs): * locate.el (locate): * international/quail.el (quail-show-keyboard-layout): * international/mule.el (set-buffer-file-coding-system) (revert-buffer-with-coding-system, set-file-name-coding-system) (set-terminal-coding-system, set-keyboard-coding-system) (set-next-selection-coding-system): * international/mule-diag.el (describe-coding-system) (describe-font, describe-fontset): * international/mule-cmds.el (universal-coding-system-argument) (search-unencodable-char, describe-input-method) (set-language-environment, describe-language-environment): * international/codepage.el (codepage-setup): * international/code-pages.el (codepage-setup): * info.el (Info-search, Info-follow-reference) (Info-search-backward): * emacs-lisp/advice.el (ad-read-advised-function) (ad-read-advice-class, ad-clear-cache, ad-activate) (ad-deactivate, ad-update, ad-unadvise, ad-read-advice-name) (ad-enable-advice, ad-disable-advice, ad-remove-advice) (ad-read-regexp): * ediff-util.el (ediff-toggle-regexp-match): * ediff-ptch.el (ediff-prompt-for-patch-file): * dired-aux.el (dired-diff): * diff.el (diff): * cus-edit.el (custom-variable-prompt): * calendar/timeclock.el (timeclock-ask-for-project): * calc/calcalg3.el (calc-get-fit-variables): * calc/calc-store.el (calc-edit-variable) (calc-permanent-variable): * vc-mcvs.el (vc-mcvs-register): * shadowfile.el (shadow-define-literal-group): * woman.el (woman-file-name): * vc.el (vc-version-diff, vc-merge): * textmodes/reftex-index.el (reftex-index-complete-tag): * format.el (format-decode-buffer, format-decode-region): * emulation/viper-cmd.el (viper-read-string-with-history): * emacs-lisp/debug.el (cancel-debug-on-entry): * emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine): * ediff.el (ediff-merge-revisions) (ediff-merge-revisions-with-ancestor, ediff-revision): * completion.el (interactive-completion-string-reader): * calc/calc-prog.el (calc-user-define-formula): Follow convention for reading with the minibuffer.

65679:56406afc87de

	    (error "ad-read-advised-function: %s"
		   "There are no qualifying advised functions")))
  (let* ((ad-pReDiCaTe predicate)
	 (function
	  (completing-read
	   (format "%s(default %s) " (or prompt "Function: ") default)
	   ad-advised-functions
	   (if predicate
	       (function
		(lambda (function)
		  ;; Oops, no closures - the joys of dynamic scoping:

	    (ad-dolist (class ad-advice-classes)
	      (if (ad-get-advice-info-field function class)
		  (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)
		ad-advice-class-completion-table nil t)))
    (if (equal class "")
	default
      (intern class))))

	 (default
	   (if (null name-completion-table)
	       (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))
	 (name (completing-read prompt name-completion-table nil t)))
    (if (equal name "")
	(intern default)
      (intern name))))

(defvar ad-last-regexp "")

(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))))))
    (setq ad-last-regexp
	  (if (equal regexp "") ad-last-regexp regexp))))


;; @@ Finding, enabling, adding and removing pieces of advice:

		       (ad-advice-set-enabled advice flag))))))
	matched-advices)))

(defun ad-enable-advice (function class name)
  "Enables the advice of FUNCTION with CLASS and NAME."
  (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)))

(defun ad-disable-advice (function class name)
  "Disable the advice of FUNCTION with CLASS and NAME."
  (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'"
		 function class name))
    (error "ad-disable-advice: `%s' is not advised" function)))

(defun ad-enable-regexp (regexp)
  "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: ")))
  (let ((matched-advices (ad-enable-regexp-internal regexp 'any t)))
    (if (interactive-p)
	(message "%d matching advices enabled" matched-advices))
    matched-advices))

(defun ad-disable-regexp (regexp)
  "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: ")))
  (let ((matched-advices (ad-enable-regexp-internal regexp 'any nil)))
    (if (interactive-p)
	(message "%d matching advices disabled" matched-advices))
    matched-advices))

(defun ad-remove-advice (function class name)
  "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: "))
  (if (ad-is-advised function)
      (let* ((advice-to-remove (ad-find-advice function class name)))
	(if advice-to-remove
	    (ad-set-advice-info-field
	     function class

(defun ad-clear-cache (function)
  "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."
  (interactive
   (list (ad-read-advised-function "Clear cached definition of: ")))
  (ad-set-advice-info-field function 'cache nil))

(defun ad-make-cache-id (function)
  "Generate an identifying image of the current advices of FUNCTION."
  (let ((original-definition (ad-real-orig-definition function))

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."
  (interactive
   (list (ad-read-advised-function "Activate advice of: ")
	 current-prefix-arg))
  (if ad-activate-on-top-level
      ;; avoid recursive calls to `ad-activate':
      (ad-with-auto-activation-disabled
	(if (not (ad-is-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'."
  (interactive
   (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)
	   (ad-handle-definition function)
	   (if (not (ad-get-orig-definition function))

(defun ad-update (function &optional compile)
  "Update the advised definition of FUNCTION if its advice is active.
See `ad-activate' for documentation on the optional COMPILE argument."
  (interactive
   (list (ad-read-advised-function
	  "Update advised definition of: " 'ad-is-active)))
  (if (ad-is-active function)
      (ad-activate function compile)))

(defun ad-unadvise (function)
  "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: ")))
  (cond ((ad-is-advised function)
	 (if (ad-is-active function)
	     (ad-deactivate function))
	 (ad-clear-orig-definition function)
	 (ad-set-advice-info function nil)

  "Activate functions with an advice name containing a REGEXP match.
This activates the advice for each 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: ")
	 current-prefix-arg))
  (ad-do-advised-functions (function)
    (if (ad-find-some-advice function 'any regexp)
	(ad-activate function compile))))

(defun ad-deactivate-regexp (regexp)
  "Deactivate functions with an advice name containing REGEXP match.
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: ")))
  (ad-do-advised-functions (function)
    (if (ad-find-some-advice function 'any regexp)
	(ad-deactivate function))))

(defun ad-update-regexp (regexp &optional compile)
  "Update functions with an advice name containing a REGEXP match.
This reactivates the advice for each 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: ")
	 current-prefix-arg))
  (ad-do-advised-functions (function)
    (if (ad-find-some-advice function 'any regexp)
	(ad-update function compile))))

65680:ed770a0a7846

	    (error "ad-read-advised-function: %s"
		   "There are no qualifying advised functions")))
  (let* ((ad-pReDiCaTe predicate)
	 (function
	  (completing-read
	   (format "%s (default %s): " (or prompt "Function") default)
	   ad-advised-functions
	   (if predicate
	       (function
		(lambda (function)
		  ;; Oops, no closures - the joys of dynamic scoping:

	    (ad-dolist (class ad-advice-classes)
	      (if (ad-get-advice-info-field function class)
		  (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)
		ad-advice-class-completion-table nil t)))
    (if (equal class "")
	default
      (intern class))))

	 (default
	   (if (null name-completion-table)
	       (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))
	 (name (completing-read prompt name-completion-table nil t)))
    (if (equal name "")
	(intern default)
      (intern name))))

(defvar ad-last-regexp "")

(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))))))
    (setq ad-last-regexp
	  (if (equal regexp "") ad-last-regexp regexp))))


;; @@ Finding, enabling, adding and removing pieces of advice:

		       (ad-advice-set-enabled advice flag))))))
	matched-advices)))

(defun ad-enable-advice (function class name)
  "Enables the advice of FUNCTION with CLASS and NAME."
  (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)))

(defun ad-disable-advice (function class name)
  "Disable the advice of FUNCTION with CLASS and NAME."
  (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'"
		 function class name))
    (error "ad-disable-advice: `%s' is not advised" function)))

(defun ad-enable-regexp (regexp)
  "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")))
  (let ((matched-advices (ad-enable-regexp-internal regexp 'any t)))
    (if (interactive-p)
	(message "%d matching advices enabled" matched-advices))
    matched-advices))

(defun ad-disable-regexp (regexp)
  "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")))
  (let ((matched-advices (ad-enable-regexp-internal regexp 'any nil)))
    (if (interactive-p)
	(message "%d matching advices disabled" matched-advices))
    matched-advices))

(defun ad-remove-advice (function class name)
  "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"))
  (if (ad-is-advised function)
      (let* ((advice-to-remove (ad-find-advice function class name)))
	(if advice-to-remove
	    (ad-set-advice-info-field
	     function class

(defun ad-clear-cache (function)
  "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."
  (interactive
   (list (ad-read-advised-function "Clear cached definition of")))
  (ad-set-advice-info-field function 'cache nil))

(defun ad-make-cache-id (function)
  "Generate an identifying image of the current advices of FUNCTION."
  (let ((original-definition (ad-real-orig-definition function))

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."
  (interactive
   (list (ad-read-advised-function "Activate advice of")
	 current-prefix-arg))
  (if ad-activate-on-top-level
      ;; avoid recursive calls to `ad-activate':
      (ad-with-auto-activation-disabled
	(if (not (ad-is-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'."
  (interactive
   (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)
	   (ad-handle-definition function)
	   (if (not (ad-get-orig-definition function))

(defun ad-update (function &optional compile)
  "Update the advised definition of FUNCTION if its advice is active.
See `ad-activate' for documentation on the optional COMPILE argument."
  (interactive
   (list (ad-read-advised-function
	  "Update advised definition of" 'ad-is-active)))
  (if (ad-is-active function)
      (ad-activate function compile)))

(defun ad-unadvise (function)
  "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")))
  (cond ((ad-is-advised function)
	 (if (ad-is-active function)
	     (ad-deactivate function))
	 (ad-clear-orig-definition function)
	 (ad-set-advice-info function nil)

  "Activate functions with an advice name containing a REGEXP match.
This activates the advice for each 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")
	 current-prefix-arg))
  (ad-do-advised-functions (function)
    (if (ad-find-some-advice function 'any regexp)
	(ad-activate function compile))))

(defun ad-deactivate-regexp (regexp)
  "Deactivate functions with an advice name containing REGEXP match.
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")))
  (ad-do-advised-functions (function)
    (if (ad-find-some-advice function 'any regexp)
	(ad-deactivate function))))

(defun ad-update-regexp (regexp &optional compile)
  "Update functions with an advice name containing a REGEXP match.
This reactivates the advice for each 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")
	 current-prefix-arg))
  (ad-do-advised-functions (function)
    (if (ad-find-some-advice function 'any regexp)
	(ad-update function compile))))