* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
;;; nadvice.el --- Light-weight advice primitives for Elisp functions -*- lexical-binding: t -*-
|
|
|
|
|
|
2013-01-02 16:30:50 +00:00
|
|
|
|
;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
|
|
|
|
|
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
|
|
|
|
|
;; Keywords: extensions, lisp, tools
|
|
|
|
|
;; Package: emacs
|
|
|
|
|
|
|
|
|
|
;; This program 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 of the License, or
|
|
|
|
|
;; (at your option) any later version.
|
|
|
|
|
|
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
|
|
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;; This package lets you add behavior (which we call "piece of advice") to
|
|
|
|
|
;; existing functions, like the old `advice.el' package, but with much fewer
|
2013-03-02 07:19:10 +00:00
|
|
|
|
;; bells and whistles. It comes in 2 parts:
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
;;
|
|
|
|
|
;; - The first part lets you add/remove functions, similarly to
|
|
|
|
|
;; add/remove-hook, from any "place" (i.e. as accepted by `setf') that
|
|
|
|
|
;; holds a function.
|
|
|
|
|
;; This part provides mainly 2 macros: `add-function' and `remove-function'.
|
|
|
|
|
;;
|
2012-11-13 18:09:20 +00:00
|
|
|
|
;; - The second part provides `advice-add' and `advice-remove' which are
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
;; refined version of the previous macros specially tailored for the case
|
|
|
|
|
;; where the place that we want to modify is a `symbol-function'.
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
;;;; Lightweight advice/hook
|
|
|
|
|
(defvar advice--where-alist
|
|
|
|
|
'((:around "\300\301\302\003#\207" 5)
|
|
|
|
|
(:before "\300\301\002\"\210\300\302\002\"\207" 4)
|
|
|
|
|
(:after "\300\302\002\"\300\301\003\"\210\207" 5)
|
2013-04-20 16:24:04 +00:00
|
|
|
|
(:override "\300\301\"\207" 4)
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(:after-until "\300\302\002\"\206\013\000\300\301\002\"\207" 4)
|
|
|
|
|
(:after-while "\300\302\002\"\205\013\000\300\301\002\"\207" 4)
|
|
|
|
|
(:before-until "\300\301\002\"\206\013\000\300\302\002\"\207" 4)
|
2013-04-18 00:12:33 +00:00
|
|
|
|
(:before-while "\300\301\002\"\205\013\000\300\302\002\"\207" 4)
|
|
|
|
|
(:filter-args "\300\302\301!\"\207" 5)
|
|
|
|
|
(:filter-return "\301\300\302\"!\207" 5))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
"List of descriptions of how to add a function.
|
|
|
|
|
Each element has the form (WHERE BYTECODE STACK) where:
|
|
|
|
|
WHERE is a keyword indicating where the function is added.
|
|
|
|
|
BYTECODE is the corresponding byte-code that will be used.
|
|
|
|
|
STACK is the amount of stack space needed by the byte-code.")
|
|
|
|
|
|
|
|
|
|
(defvar advice--bytecodes (mapcar #'cadr advice--where-alist))
|
|
|
|
|
|
|
|
|
|
(defun advice--p (object)
|
|
|
|
|
(and (byte-code-function-p object)
|
|
|
|
|
(eq 128 (aref object 0))
|
|
|
|
|
(memq (length object) '(5 6))
|
|
|
|
|
(memq (aref object 1) advice--bytecodes)
|
|
|
|
|
(eq #'apply (aref (aref object 2) 0))))
|
|
|
|
|
|
|
|
|
|
(defsubst advice--car (f) (aref (aref f 2) 1))
|
|
|
|
|
(defsubst advice--cdr (f) (aref (aref f 2) 2))
|
|
|
|
|
(defsubst advice--props (f) (aref (aref f 2) 3))
|
|
|
|
|
|
|
|
|
|
(defun advice--make-docstring (_string function)
|
|
|
|
|
"Build the raw doc-string of SYMBOL, presumably advised."
|
|
|
|
|
(let ((flist (indirect-function function))
|
|
|
|
|
(docstring nil))
|
|
|
|
|
(if (eq 'macro (car-safe flist)) (setq flist (cdr flist)))
|
|
|
|
|
(while (advice--p flist)
|
|
|
|
|
(let ((bytecode (aref flist 1))
|
|
|
|
|
(where nil))
|
|
|
|
|
(dolist (elem advice--where-alist)
|
|
|
|
|
(if (eq bytecode (cadr elem)) (setq where (car elem))))
|
|
|
|
|
(setq docstring
|
|
|
|
|
(concat
|
|
|
|
|
docstring
|
|
|
|
|
(propertize (format "%s advice: " where)
|
|
|
|
|
'face 'warning)
|
|
|
|
|
(let ((fun (advice--car flist)))
|
|
|
|
|
(if (symbolp fun) (format "`%S'" fun)
|
|
|
|
|
(let* ((name (cdr (assq 'name (advice--props flist))))
|
|
|
|
|
(doc (documentation fun t))
|
|
|
|
|
(usage (help-split-fundoc doc function)))
|
|
|
|
|
(if usage (setq doc (cdr usage)))
|
|
|
|
|
(if name
|
|
|
|
|
(if doc
|
|
|
|
|
(format "%s\n%s" name doc)
|
|
|
|
|
(format "%s" name))
|
|
|
|
|
(or doc "No documentation")))))
|
|
|
|
|
"\n")))
|
|
|
|
|
(setq flist (advice--cdr flist)))
|
|
|
|
|
(if docstring (setq docstring (concat docstring "\n")))
|
|
|
|
|
(let* ((origdoc (unless (eq function flist) ;Avoid inf-loops.
|
|
|
|
|
(documentation flist t)))
|
|
|
|
|
(usage (help-split-fundoc origdoc function)))
|
|
|
|
|
(setq usage (if (null usage)
|
|
|
|
|
(let ((arglist (help-function-arglist flist)))
|
|
|
|
|
(format "%S" (help-make-usage function arglist)))
|
|
|
|
|
(setq origdoc (cdr usage)) (car usage)))
|
|
|
|
|
(help-add-fundoc-usage (concat docstring origdoc) usage))))
|
|
|
|
|
|
|
|
|
|
(defvar advice--docstring
|
|
|
|
|
;; Can't eval-when-compile nor use defconst because it then gets pure-copied,
|
|
|
|
|
;; which drops the text-properties.
|
|
|
|
|
;;(eval-when-compile
|
|
|
|
|
(propertize "Advised function"
|
|
|
|
|
'dynamic-docstring-function #'advice--make-docstring)) ;; )
|
|
|
|
|
|
2012-11-14 20:27:42 +00:00
|
|
|
|
(defun advice-eval-interactive-spec (spec)
|
|
|
|
|
"Evaluate the interactive spec SPEC."
|
|
|
|
|
(cond
|
|
|
|
|
((stringp spec)
|
|
|
|
|
;; There's no direct access to the C code (in call-interactively) that
|
|
|
|
|
;; processes those specs, but that shouldn't stop us, should it?
|
|
|
|
|
;; FIXME: Despite appearances, this is not faithful: SPEC and
|
|
|
|
|
;; (advice-eval-interactive-spec SPEC) will behave subtly differently w.r.t
|
|
|
|
|
;; command-history (and maybe a few other details).
|
|
|
|
|
(call-interactively `(lambda (&rest args) (interactive ,spec) args)))
|
|
|
|
|
;; ((functionp spec) (funcall spec))
|
|
|
|
|
(t (eval spec))))
|
|
|
|
|
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(defun advice--make-interactive-form (function main)
|
|
|
|
|
;; TODO: make it so that interactive spec can be a constant which
|
|
|
|
|
;; dynamically checks the advice--car/cdr to do its job.
|
2012-11-14 20:27:42 +00:00
|
|
|
|
;; For that, advice-eval-interactive-spec needs to be more faithful.
|
|
|
|
|
;; FIXME: The calls to interactive-form below load autoloaded functions
|
|
|
|
|
;; too eagerly.
|
|
|
|
|
(let ((fspec (cadr (interactive-form function))))
|
2012-11-15 03:30:25 +00:00
|
|
|
|
(when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda?
|
2012-11-14 20:27:42 +00:00
|
|
|
|
(setq fspec (nth 1 fspec)))
|
|
|
|
|
(if (functionp fspec)
|
|
|
|
|
`(funcall ',fspec
|
|
|
|
|
',(cadr (interactive-form main)))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(cadr (or (interactive-form function)
|
2012-11-14 20:27:42 +00:00
|
|
|
|
(interactive-form main))))))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
|
|
|
|
|
(defsubst advice--make-1 (byte-code stack-depth function main props)
|
|
|
|
|
"Build a function value that adds FUNCTION to MAIN."
|
|
|
|
|
(let ((adv-sig (gethash main advertised-signature-table))
|
|
|
|
|
(advice
|
|
|
|
|
(apply #'make-byte-code 128 byte-code
|
|
|
|
|
(vector #'apply function main props) stack-depth
|
|
|
|
|
advice--docstring
|
|
|
|
|
(when (or (commandp function) (commandp main))
|
|
|
|
|
(list (advice--make-interactive-form
|
|
|
|
|
function main))))))
|
|
|
|
|
(when adv-sig (puthash advice adv-sig advertised-signature-table))
|
|
|
|
|
advice))
|
|
|
|
|
|
|
|
|
|
(defun advice--make (where function main props)
|
|
|
|
|
"Build a function value that adds FUNCTION to MAIN at WHERE.
|
|
|
|
|
WHERE is a symbol to select an entry in `advice--where-alist'."
|
|
|
|
|
(let ((desc (assq where advice--where-alist)))
|
|
|
|
|
(unless desc (error "Unknown add-function location `%S'" where))
|
|
|
|
|
(advice--make-1 (nth 1 desc) (nth 2 desc)
|
|
|
|
|
function main props)))
|
|
|
|
|
|
2013-04-15 15:06:51 +00:00
|
|
|
|
(defun advice--member-p (function name definition)
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(let ((found nil))
|
|
|
|
|
(while (and (not found) (advice--p definition))
|
|
|
|
|
(if (or (equal function (advice--car definition))
|
2013-04-15 15:06:51 +00:00
|
|
|
|
(when name
|
|
|
|
|
(equal name (cdr (assq 'name (advice--props definition))))))
|
2013-05-06 15:27:11 +00:00
|
|
|
|
(setq found definition)
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(setq definition (advice--cdr definition))))
|
|
|
|
|
found))
|
|
|
|
|
|
2013-01-08 15:24:56 +00:00
|
|
|
|
(defun advice--tweak (flist tweaker)
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(if (not (advice--p flist))
|
2013-01-08 15:24:56 +00:00
|
|
|
|
(funcall tweaker nil flist nil)
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(let ((first (advice--car flist))
|
2013-01-08 15:24:56 +00:00
|
|
|
|
(rest (advice--cdr flist))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(props (advice--props flist)))
|
2013-01-15 06:05:22 +00:00
|
|
|
|
(let ((val (funcall tweaker first rest props)))
|
|
|
|
|
(if val (car val)
|
2013-01-08 15:24:56 +00:00
|
|
|
|
(let ((nrest (advice--tweak rest tweaker)))
|
|
|
|
|
(if (eq rest nrest) flist
|
|
|
|
|
(advice--make-1 (aref flist 1) (aref flist 3)
|
2013-01-15 06:05:22 +00:00
|
|
|
|
first nrest props))))))))
|
2013-01-08 15:24:56 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun advice--remove-function (flist function)
|
|
|
|
|
(advice--tweak flist
|
|
|
|
|
(lambda (first rest props)
|
2013-01-15 06:05:22 +00:00
|
|
|
|
(cond ((not first) rest)
|
|
|
|
|
((or (equal function first)
|
2013-01-08 15:24:56 +00:00
|
|
|
|
(equal function (cdr (assq 'name props))))
|
2013-01-15 06:05:22 +00:00
|
|
|
|
(list rest))))))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(defvar advice--buffer-local-function-sample nil
|
|
|
|
|
"keeps an example of the special \"run the default value\" functions.
|
|
|
|
|
These functions play the same role as t in buffer-local hooks, and to recognize
|
|
|
|
|
them, we keep a sample here against which to compare. Each instance is
|
|
|
|
|
different, but `function-equal' will hopefully ignore those differences.")
|
2012-11-15 03:20:49 +00:00
|
|
|
|
|
|
|
|
|
(defun advice--set-buffer-local (var val)
|
|
|
|
|
(if (function-equal val advice--buffer-local-function-sample)
|
|
|
|
|
(kill-local-variable var)
|
|
|
|
|
(set (make-local-variable var) val)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun advice--buffer-local (var)
|
|
|
|
|
"Buffer-local value of VAR, presumed to contain a function."
|
|
|
|
|
(declare (gv-setter advice--set-buffer-local))
|
|
|
|
|
(if (local-variable-p var) (symbol-value var)
|
|
|
|
|
(setq advice--buffer-local-function-sample
|
2013-08-04 06:48:00 +00:00
|
|
|
|
;; This function acts like the t special value in buffer-local hooks.
|
2012-11-15 03:20:49 +00:00
|
|
|
|
(lambda (&rest args) (apply (default-value var) args)))))
|
|
|
|
|
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
(defmacro add-function (where place function &optional props)
|
|
|
|
|
;; TODO:
|
|
|
|
|
;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP
|
|
|
|
|
;; and tracing want to stay first.
|
2012-11-15 03:20:49 +00:00
|
|
|
|
;; - maybe let `where' specify some kind of predicate and use it
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
;; to implement things like mode-local or eieio-defmethod.
|
2012-11-15 03:20:49 +00:00
|
|
|
|
;; Of course, that only makes sense if the predicates of all advices can
|
|
|
|
|
;; be combined and made more efficient.
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
;; :before is like a normal add-hook on a normal hook.
|
|
|
|
|
;; :before-while is like add-hook on run-hook-with-args-until-failure.
|
|
|
|
|
;; :before-until is like add-hook on run-hook-with-args-until-success.
|
|
|
|
|
;; Same with :after-* but for (add-hook ... 'append).
|
|
|
|
|
"Add a piece of advice on the function stored at PLACE.
|
|
|
|
|
FUNCTION describes the code to add. WHERE describes where to add it.
|
|
|
|
|
WHERE can be explained by showing the resulting new function, as the
|
|
|
|
|
result of combining FUNCTION and the previous value of PLACE, which we
|
|
|
|
|
call OLDFUN here:
|
|
|
|
|
`:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r))
|
|
|
|
|
`:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r)))
|
|
|
|
|
`:around' (lambda (&rest r) (apply FUNCTION OLDFUN r))
|
2013-04-20 16:24:04 +00:00
|
|
|
|
`:override' (lambda (&rest r) (apply FUNCTION r))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
`:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r)))
|
|
|
|
|
`:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r)))
|
|
|
|
|
`:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r)))
|
|
|
|
|
`:after-until' (lambda (&rest r) (or (apply OLDFUN r) (apply FUNCTION r)))
|
2013-04-18 00:12:33 +00:00
|
|
|
|
`:filter-args' (lambda (&rest r) (apply OLDFUN (funcall FUNCTION r)))
|
|
|
|
|
`:filter-return'(lambda (&rest r) (funcall FUNCTION (apply OLDFUN r)))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
If FUNCTION was already added, do nothing.
|
|
|
|
|
PROPS is an alist of additional properties, among which the following have
|
|
|
|
|
a special meaning:
|
2012-11-14 20:27:42 +00:00
|
|
|
|
- `name': a string or symbol. It can be used to refer to this piece of advice.
|
|
|
|
|
|
2013-04-16 02:10:16 +00:00
|
|
|
|
If PLACE is a simple variable, only its global value will be affected.
|
|
|
|
|
Use (local 'VAR) if you want to apply FUNCTION to VAR buffer-locally.
|
2012-11-15 03:20:49 +00:00
|
|
|
|
|
2012-11-14 20:27:42 +00:00
|
|
|
|
If one of FUNCTION or OLDFUN is interactive, then the resulting function
|
|
|
|
|
is also interactive. There are 3 cases:
|
|
|
|
|
- FUNCTION is not interactive: the interactive spec of OLDFUN is used.
|
|
|
|
|
- The interactive spec of FUNCTION is itself a function: it should take one
|
|
|
|
|
argument (the interactive spec of OLDFUN, which it can pass to
|
|
|
|
|
`advice-eval-interactive-spec') and return the list of arguments to use.
|
|
|
|
|
- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN."
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(declare (debug t)) ;;(indent 2)
|
2012-11-15 03:20:49 +00:00
|
|
|
|
(cond ((eq 'local (car-safe place))
|
|
|
|
|
(setq place `(advice--buffer-local ,@(cdr place))))
|
|
|
|
|
((symbolp place)
|
2013-04-16 02:10:16 +00:00
|
|
|
|
(setq place `(default-value ',place))))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
`(advice--add-function ,where (gv-ref ,place) ,function ,props))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun advice--add-function (where ref function props)
|
2013-05-06 15:27:11 +00:00
|
|
|
|
(let ((a (advice--member-p function (cdr (assq 'name props))
|
|
|
|
|
(gv-deref ref))))
|
|
|
|
|
(when a
|
|
|
|
|
;; The advice is already present. Remove the old one, first.
|
|
|
|
|
(setf (gv-deref ref)
|
|
|
|
|
(advice--remove-function (gv-deref ref) (advice--car a))))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(setf (gv-deref ref)
|
|
|
|
|
(advice--make where function (gv-deref ref) props))))
|
|
|
|
|
|
2013-04-20 16:24:04 +00:00
|
|
|
|
;;;###autoload
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(defmacro remove-function (place function)
|
|
|
|
|
"Remove the FUNCTION piece of advice from PLACE.
|
|
|
|
|
If FUNCTION was not added to PLACE, do nothing.
|
|
|
|
|
Instead of FUNCTION being the actual function, it can also be the `name'
|
|
|
|
|
of the piece of advice."
|
|
|
|
|
(declare (debug t))
|
2012-11-15 03:20:49 +00:00
|
|
|
|
(cond ((eq 'local (car-safe place))
|
|
|
|
|
(setq place `(advice--buffer-local ,@(cdr place))))
|
|
|
|
|
((symbolp place)
|
|
|
|
|
(error "Use (default-value '%S) or (local '%S)" place place)))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(gv-letplace (getter setter) place
|
|
|
|
|
(macroexp-let2 nil new `(advice--remove-function ,getter ,function)
|
|
|
|
|
`(unless (eq ,new ,getter) ,(funcall setter new)))))
|
|
|
|
|
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(defun advice-function-mapc (f function-def)
|
|
|
|
|
"Apply F to every advice function in FUNCTION-DEF.
|
|
|
|
|
F is called with two arguments: the function that was added, and the
|
|
|
|
|
properties alist that was specified when it was added."
|
|
|
|
|
(while (advice--p function-def)
|
|
|
|
|
(funcall f (advice--car function-def) (advice--props function-def))
|
|
|
|
|
(setq function-def (advice--cdr function-def))))
|
|
|
|
|
|
|
|
|
|
(defun advice-function-member-p (advice function-def)
|
|
|
|
|
"Return non-nil if ADVICE is already in FUNCTION-DEF.
|
|
|
|
|
Instead of ADVICE being the actual function, it can also be the `name'
|
|
|
|
|
of the piece of advice."
|
|
|
|
|
(advice--member-p advice advice function-def))
|
|
|
|
|
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
;;;; Specific application of add-function to `symbol-function' for advice.
|
|
|
|
|
|
|
|
|
|
(defun advice--subst-main (old new)
|
2013-01-08 15:24:56 +00:00
|
|
|
|
(advice--tweak old
|
|
|
|
|
(lambda (first _rest _props) (if (not first) new))))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
|
2012-11-13 03:00:09 +00:00
|
|
|
|
(defun advice--normalize (symbol def)
|
|
|
|
|
(cond
|
|
|
|
|
((special-form-p def)
|
|
|
|
|
;; Not worth the trouble trying to handle this, I think.
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(error "Advice impossible: %S is a special form" symbol))
|
2013-08-04 20:18:11 +00:00
|
|
|
|
((and (symbolp def) (macrop def))
|
|
|
|
|
(let ((newval `(macro . ,(lambda (&rest r) (macroexpand `(,def . ,r))))))
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(put symbol 'advice--saved-rewrite (cons def (cdr newval)))
|
2012-11-13 03:00:09 +00:00
|
|
|
|
newval))
|
|
|
|
|
;; `f' might be a pure (hence read-only) cons!
|
|
|
|
|
((and (eq 'macro (car-safe def))
|
|
|
|
|
(not (ignore-errors (setcdr def (cdr def)) t)))
|
|
|
|
|
(cons 'macro (cdr def)))
|
|
|
|
|
(t def)))
|
|
|
|
|
|
|
|
|
|
(defsubst advice--strip-macro (x)
|
|
|
|
|
(if (eq 'macro (car-safe x)) (cdr x) x))
|
|
|
|
|
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(defun advice--symbol-function (symbol)
|
|
|
|
|
;; The value conceptually stored in `symbol-function' is split into two
|
|
|
|
|
;; parts:
|
|
|
|
|
;; - the normal function definition.
|
|
|
|
|
;; - the list of advice applied to it.
|
|
|
|
|
;; `advice--symbol-function' is intended to return the second part (i.e. the
|
|
|
|
|
;; list of advice, which includes a hole at the end which typically holds the
|
|
|
|
|
;; first part, but this function doesn't care much which value is found
|
|
|
|
|
;; there).
|
|
|
|
|
;; In the "normal" state both parts are combined into a single value stored
|
|
|
|
|
;; in the "function slot" of the symbol. But the way they are combined is
|
|
|
|
|
;; different depending on whether the definition is a function or a macro.
|
|
|
|
|
;; Also if the function definition is nil (i.e. unbound) or is an autoload,
|
|
|
|
|
;; the second part is stashed away temporarily in the `advice--pending'
|
|
|
|
|
;; symbol property.
|
|
|
|
|
(or (get symbol 'advice--pending)
|
|
|
|
|
(advice--strip-macro (symbol-function symbol))))
|
|
|
|
|
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(defun advice--defalias-fset (fsetfun symbol newdef)
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(unless fsetfun (setq fsetfun #'fset))
|
2012-11-13 03:00:09 +00:00
|
|
|
|
(when (get symbol 'advice--saved-rewrite)
|
|
|
|
|
(put symbol 'advice--saved-rewrite nil))
|
|
|
|
|
(setq newdef (advice--normalize symbol newdef))
|
2013-08-04 20:18:11 +00:00
|
|
|
|
(let ((oldadv (advice--symbol-function symbol)))
|
2013-06-26 22:31:19 +00:00
|
|
|
|
(if (and newdef (not (autoloadp newdef)))
|
|
|
|
|
(let* ((snewdef (advice--strip-macro newdef))
|
|
|
|
|
(snewadv (advice--subst-main oldadv snewdef)))
|
|
|
|
|
(put symbol 'advice--pending nil)
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(funcall fsetfun symbol
|
2013-06-26 22:31:19 +00:00
|
|
|
|
(if (eq snewdef newdef) snewadv (cons 'macro snewadv))))
|
|
|
|
|
(unless (eq oldadv (get symbol 'advice--pending))
|
|
|
|
|
(put symbol 'advice--pending (advice--subst-main oldadv nil)))
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(funcall fsetfun symbol newdef))))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun advice-add (symbol where function &optional props)
|
|
|
|
|
"Like `add-function' but for the function named SYMBOL.
|
|
|
|
|
Contrary to `add-function', this will properly handle the cases where SYMBOL
|
|
|
|
|
is defined as a macro, alias, command, ..."
|
|
|
|
|
;; TODO:
|
|
|
|
|
;; - record the advice location, to display in describe-function.
|
|
|
|
|
;; - change all defadvice in lisp/**/*.el.
|
|
|
|
|
;; - obsolete advice.el.
|
2013-06-26 22:31:19 +00:00
|
|
|
|
(let* ((f (symbol-function symbol))
|
2012-11-13 03:00:09 +00:00
|
|
|
|
(nf (advice--normalize symbol f)))
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(unless (eq f nf) (fset symbol nf))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(add-function where (cond
|
2012-11-13 03:00:09 +00:00
|
|
|
|
((eq (car-safe nf) 'macro) (cdr nf))
|
2012-11-14 20:27:42 +00:00
|
|
|
|
;; Reasons to delay installation of the advice:
|
|
|
|
|
;; - If the function is not yet defined, installing
|
|
|
|
|
;; the advice would affect `fboundp'ness.
|
|
|
|
|
;; - If it's an autoloaded command,
|
|
|
|
|
;; advice--make-interactive-form would end up
|
|
|
|
|
;; loading the command eagerly.
|
|
|
|
|
;; - `autoload' does nothing if the function is
|
|
|
|
|
;; not an autoload or undefined.
|
|
|
|
|
((or (not nf) (autoloadp nf))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
(get symbol 'advice--pending))
|
|
|
|
|
(t (symbol-function symbol)))
|
|
|
|
|
function props)
|
|
|
|
|
(add-function :around (get symbol 'defalias-fset-function)
|
|
|
|
|
#'advice--defalias-fset))
|
|
|
|
|
nil)
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun advice-remove (symbol function)
|
|
|
|
|
"Like `remove-function' but for the function named SYMBOL.
|
2013-06-26 22:31:19 +00:00
|
|
|
|
Contrary to `remove-function', this also works when SYMBOL is a macro
|
|
|
|
|
or an autoload and it preserves `fboundp'.
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
Instead of the actual function to remove, FUNCTION can also be the `name'
|
|
|
|
|
of the piece of advice."
|
2013-06-26 22:31:19 +00:00
|
|
|
|
(let ((f (symbol-function symbol)))
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(remove-function (cond ;This is `advice--symbol-function' but as a "place".
|
|
|
|
|
((get symbol 'advice--pending)
|
|
|
|
|
(get symbol 'advice--pending))
|
|
|
|
|
((eq (car-safe f) 'macro) (cdr f))
|
|
|
|
|
(t (symbol-function symbol)))
|
2013-06-26 22:31:19 +00:00
|
|
|
|
function)
|
2013-08-04 20:18:11 +00:00
|
|
|
|
(unless (advice--p (advice--symbol-function symbol))
|
2013-06-26 22:31:19 +00:00
|
|
|
|
;; Not advised any more.
|
|
|
|
|
(remove-function (get symbol 'defalias-fset-function)
|
|
|
|
|
#'advice--defalias-fset)
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(let ((asr (get symbol 'advice--saved-rewrite)))
|
|
|
|
|
(and asr (eq (cdr-safe (symbol-function symbol))
|
|
|
|
|
(cdr asr))
|
|
|
|
|
(fset symbol (car (get symbol 'advice--saved-rewrite)))))))
|
2013-06-26 22:31:19 +00:00
|
|
|
|
nil)
|
|
|
|
|
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(defun advice-mapc (fun symbol)
|
|
|
|
|
"Apply FUN to every advice function in SYMBOL.
|
2013-06-26 22:31:19 +00:00
|
|
|
|
FUN is called with a two arguments: the function that was added, and the
|
|
|
|
|
properties alist that was specified when it was added."
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(advice-function-mapc fun (advice--symbol-function symbol)))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(defun advice-member-p (advice symbol)
|
|
|
|
|
"Return non-nil if ADVICE has been added to SYMBOL.
|
2012-11-13 03:00:09 +00:00
|
|
|
|
Instead of ADVICE being the actual function, it can also be the `name'
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
of the piece of advice."
|
2013-08-04 06:48:00 +00:00
|
|
|
|
(advice-function-member-p advice (advice--symbol-function symbol)))
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
|
2012-11-20 04:24:09 +00:00
|
|
|
|
;; When code is advised, called-interactively-p needs to be taught to skip
|
|
|
|
|
;; the advising frames.
|
|
|
|
|
;; FIXME: This Major Ugly Hack won't handle calls to called-interactively-p
|
|
|
|
|
;; done from the advised function if the deepest advice is an around advice!
|
|
|
|
|
;; In other cases (calls from an advice or calls from the advised function when
|
|
|
|
|
;; the deepest advice is not an around advice), it should hopefully get
|
|
|
|
|
;; it right.
|
|
|
|
|
(add-hook 'called-interactively-p-functions
|
|
|
|
|
#'advice--called-interactively-skip)
|
|
|
|
|
(defun advice--called-interactively-skip (origi frame1 frame2)
|
|
|
|
|
(let* ((i origi)
|
|
|
|
|
(get-next-frame
|
|
|
|
|
(lambda ()
|
|
|
|
|
(setq frame1 frame2)
|
2013-07-26 18:41:18 +00:00
|
|
|
|
(setq frame2 (backtrace-frame i #'called-interactively-p))
|
2012-11-20 04:24:09 +00:00
|
|
|
|
;; (message "Advice Frame %d = %S" i frame2)
|
|
|
|
|
(setq i (1+ i)))))
|
|
|
|
|
(when (and (eq (nth 1 frame2) 'apply)
|
|
|
|
|
(progn
|
|
|
|
|
(funcall get-next-frame)
|
|
|
|
|
(advice--p (indirect-function (nth 1 frame2)))))
|
|
|
|
|
(funcall get-next-frame)
|
|
|
|
|
;; If we now have the symbol, this was the head advice and
|
|
|
|
|
;; we're done.
|
|
|
|
|
(while (advice--p (nth 1 frame1))
|
|
|
|
|
;; This was an inner advice called from some earlier advice.
|
|
|
|
|
;; The stack frames look different depending on the particular
|
|
|
|
|
;; kind of the earlier advice.
|
|
|
|
|
(let ((inneradvice (nth 1 frame1)))
|
|
|
|
|
(if (and (eq (nth 1 frame2) 'apply)
|
|
|
|
|
(progn
|
|
|
|
|
(funcall get-next-frame)
|
|
|
|
|
(advice--p (indirect-function
|
|
|
|
|
(nth 1 frame2)))))
|
|
|
|
|
;; The earlier advice was something like a before/after
|
|
|
|
|
;; advice where the "next" code is called directly by the
|
|
|
|
|
;; advice--p object.
|
|
|
|
|
(funcall get-next-frame)
|
|
|
|
|
;; It's apparently an around advice, where the "next" is
|
|
|
|
|
;; called by the body of the advice in any way it sees fit,
|
|
|
|
|
;; so we need to skip the frames of that body.
|
|
|
|
|
(while
|
|
|
|
|
(progn
|
|
|
|
|
(funcall get-next-frame)
|
|
|
|
|
(not (and (eq (nth 1 frame2) 'apply)
|
|
|
|
|
(eq (nth 3 frame2) inneradvice)))))
|
|
|
|
|
(funcall get-next-frame)
|
|
|
|
|
(funcall get-next-frame))))
|
|
|
|
|
(- i origi 1))))
|
|
|
|
|
|
* lisp/emacs-lisp/nadvice.el: New package.
* lisp/subr.el (special-form-p): New function.
* lisp/emacs-lisp/elp.el: Use lexical-binding and advice-add.
(elp-all-instrumented-list): Remove var.
(elp-not-profilable): Remove elp-wrapper.
(elp-profilable-p): Use autoloadp and special-form-p.
(elp--advice-name): New const.
(elp-instrument-function): Use advice-add.
(elp--instrumented-p): New predicate.
(elp-restore-function): Use advice-remove.
(elp-restore-all, elp-reset-all): Use mapatoms.
(elp-set-master): Use elp--instrumented-p.
(elp--make-wrapper): Rename from elp-wrapper, return a function
suitable for advice-add. Use cl-inf.
(elp-results): Use mapatoms+elp--instrumented-p.
* lisp/emacs-lisp/debug.el: Use lexical-binding and advice-add.
(debug-function-list): Remove var.
(debug): Rename arg, and then let-bind it explicitly inside.
(debugger-setup-buffer): Rename arg.
(debugger-setup-buffer): Adjust counts to new debug-on-entry setup.
(debugger-frame-number): Adjust to new debug-on-entry setup.
(debug--implement-debug-on-entry): Rename from
implement-debug-on-entry, add argument.
(debugger-special-form-p): Remove, use special-form-p instead.
(debug-on-entry): Use advice-add.
(debug--function-list): New function.
(cancel-debug-on-entry): Use it, along with advice-remove.
(debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove.
(debugger-list-functions): Use debug--function-list instead of
debug-function-list.
* lisp/emacs-lisp/advice.el (ad-save-real-definition): Remove, unused.
(ad-special-form-p): Remove, use special-form-p instead.
(ad-set-advice-info): Use add-function and remove-function.
(ad--defalias-fset): Adjust accordingly.
* test/automated/advice-tests.el: New tests.
2012-11-12 20:43:43 +00:00
|
|
|
|
|
|
|
|
|
(provide 'nadvice)
|
|
|
|
|
;;; nadvice.el ends here
|