From a61428c42db53e4b90d4bf12bb49aeec7abbd13a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 14 Nov 2012 22:20:49 -0500 Subject: [PATCH] * 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. --- lisp/ChangeLog | 7 +++++++ lisp/emacs-lisp/cl-loaddefs.el | 2 +- lisp/emacs-lisp/nadvice.el | 34 ++++++++++++++++++++++++++++++---- 3 files changed, 38 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fb783aca16f..51efba25f97 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2012-11-15 Stefan Monnier + + * 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 * imenu.el (imenu--split-submenus): Use imenu--subalist-p (bug#12717). diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index eb58d17c02e..765bdf71519 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -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" "\ diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 873a1695867..0c3b267f9e1 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -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))))) -- 2.39.2