* lisp/emacs-lisp/nadvice.el: Add buffer-local support to add-function.
(advice--buffer-local-function-sample): New var. (advice--set-buffer-local, advice--buffer-local): New functions. (add-function, remove-function): Use them.
This commit is contained in:
parent
875ce3a7c5
commit
a61428c42d
3 changed files with 38 additions and 5 deletions
|
@ -1,3 +1,10 @@
|
|||
2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* emacs-lisp/nadvice.el: Add buffer-local support to add-function.
|
||||
(advice--buffer-local-function-sample): New var.
|
||||
(advice--set-buffer-local, advice--buffer-local): New functions.
|
||||
(add-function, remove-function): Use them.
|
||||
|
||||
2012-11-15 Drew Adams <drew.adams@oracle.com>
|
||||
|
||||
* imenu.el (imenu--split-submenus): Use imenu--subalist-p (bug#12717).
|
||||
|
|
|
@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'.
|
|||
;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
|
||||
;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
|
||||
;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
|
||||
;;;;;; "cl-macs" "cl-macs.el" "c7ad09a74a1d2969406e7e2aaf3812fc")
|
||||
;;;;;; "cl-macs" "cl-macs.el" "887ee7c4b9eb5766c6483d27e84aac21")
|
||||
;;; Generated autoloads from cl-macs.el
|
||||
|
||||
(autoload 'cl--compiler-macro-list* "cl-macs" "\
|
||||
|
|
|
@ -182,17 +182,31 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
|
|||
(advice--make-1 (aref flist 1) (aref flist 3)
|
||||
first nrest props)))))))
|
||||
|
||||
(defvar advice--buffer-local-function-sample nil)
|
||||
|
||||
(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
|
||||
(lambda (&rest args) (apply (default-value var) args)))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro add-function (where place function &optional props)
|
||||
;; TODO:
|
||||
;; - provide something like `around' for interactive forms.
|
||||
;; - provide some kind of buffer-local functionality at least when `place'
|
||||
;; is a variable.
|
||||
;; - obsolete with-wrapper-hook (mostly requires buffer-local support).
|
||||
;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP
|
||||
;; and tracing want to stay first.
|
||||
;; - maybe also let `where' specify some kind of predicate and use it
|
||||
;; - maybe let `where' specify some kind of predicate and use it
|
||||
;; to implement things like mode-local or eieio-defmethod.
|
||||
;; Of course, that only makes sense if the predicates of all advices can
|
||||
;; be combined and made more efficient.
|
||||
;; :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.
|
||||
|
@ -214,6 +228,10 @@ PROPS is an alist of additional properties, among which the following have
|
|||
a special meaning:
|
||||
- `name': a string or symbol. It can be used to refer to this piece of advice.
|
||||
|
||||
PLACE cannot be a simple variable. Instead it should either be
|
||||
\(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION
|
||||
should be applied to VAR buffer-locally or globally.
|
||||
|
||||
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.
|
||||
|
@ -222,6 +240,10 @@ is also interactive. There are 3 cases:
|
|||
`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."
|
||||
(declare (debug t)) ;;(indent 2)
|
||||
(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)))
|
||||
`(advice--add-function ,where (gv-ref ,place) ,function ,props))
|
||||
|
||||
;;;###autoload
|
||||
|
@ -236,6 +258,10 @@ 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))
|
||||
(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)))
|
||||
(gv-letplace (getter setter) place
|
||||
(macroexp-let2 nil new `(advice--remove-function ,getter ,function)
|
||||
`(unless (eq ,new ,getter) ,(funcall setter new)))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue