aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog7
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el2
-rw-r--r--lisp/emacs-lisp/nadvice.el34
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 @@
12012-11-15 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/nadvice.el: Add buffer-local support to add-function.
4 (advice--buffer-local-function-sample): New var.
5 (advice--set-buffer-local, advice--buffer-local): New functions.
6 (add-function, remove-function): Use them.
7
12012-11-15 Drew Adams <drew.adams@oracle.com> 82012-11-15 Drew Adams <drew.adams@oracle.com>
2 9
3 * imenu.el (imenu--split-submenus): Use imenu--subalist-p (bug#12717). 10 * 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'.
267;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when 267;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
268;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp 268;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
269;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) 269;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
270;;;;;; "cl-macs" "cl-macs.el" "c7ad09a74a1d2969406e7e2aaf3812fc") 270;;;;;; "cl-macs" "cl-macs.el" "887ee7c4b9eb5766c6483d27e84aac21")
271;;; Generated autoloads from cl-macs.el 271;;; Generated autoloads from cl-macs.el
272 272
273(autoload 'cl--compiler-macro-list* "cl-macs" "\ 273(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'."
182 (advice--make-1 (aref flist 1) (aref flist 3) 182 (advice--make-1 (aref flist 1) (aref flist 3)
183 first nrest props))))))) 183 first nrest props)))))))
184 184
185(defvar advice--buffer-local-function-sample nil)
186
187(defun advice--set-buffer-local (var val)
188 (if (function-equal val advice--buffer-local-function-sample)
189 (kill-local-variable var)
190 (set (make-local-variable var) val)))
191
192;;;###autoload
193(defun advice--buffer-local (var)
194 "Buffer-local value of VAR, presumed to contain a function."
195 (declare (gv-setter advice--set-buffer-local))
196 (if (local-variable-p var) (symbol-value var)
197 (setq advice--buffer-local-function-sample
198 (lambda (&rest args) (apply (default-value var) args)))))
199
185;;;###autoload 200;;;###autoload
186(defmacro add-function (where place function &optional props) 201(defmacro add-function (where place function &optional props)
187 ;; TODO: 202 ;; TODO:
188 ;; - provide something like `around' for interactive forms.
189 ;; - provide some kind of buffer-local functionality at least when `place'
190 ;; is a variable.
191 ;; - obsolete with-wrapper-hook (mostly requires buffer-local support). 203 ;; - obsolete with-wrapper-hook (mostly requires buffer-local support).
192 ;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP 204 ;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP
193 ;; and tracing want to stay first. 205 ;; and tracing want to stay first.
194 ;; - maybe also let `where' specify some kind of predicate and use it 206 ;; - maybe let `where' specify some kind of predicate and use it
195 ;; to implement things like mode-local or eieio-defmethod. 207 ;; to implement things like mode-local or eieio-defmethod.
208 ;; Of course, that only makes sense if the predicates of all advices can
209 ;; be combined and made more efficient.
196 ;; :before is like a normal add-hook on a normal hook. 210 ;; :before is like a normal add-hook on a normal hook.
197 ;; :before-while is like add-hook on run-hook-with-args-until-failure. 211 ;; :before-while is like add-hook on run-hook-with-args-until-failure.
198 ;; :before-until is like add-hook on run-hook-with-args-until-success. 212 ;; :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
214a special meaning: 228a special meaning:
215- `name': a string or symbol. It can be used to refer to this piece of advice. 229- `name': a string or symbol. It can be used to refer to this piece of advice.
216 230
231PLACE cannot be a simple variable. Instead it should either be
232\(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION
233should be applied to VAR buffer-locally or globally.
234
217If one of FUNCTION or OLDFUN is interactive, then the resulting function 235If one of FUNCTION or OLDFUN is interactive, then the resulting function
218is also interactive. There are 3 cases: 236is also interactive. There are 3 cases:
219- FUNCTION is not interactive: the interactive spec of OLDFUN is used. 237- FUNCTION is not interactive: the interactive spec of OLDFUN is used.
@@ -222,6 +240,10 @@ is also interactive. There are 3 cases:
222 `advice-eval-interactive-spec') and return the list of arguments to use. 240 `advice-eval-interactive-spec') and return the list of arguments to use.
223- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN." 241- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN."
224 (declare (debug t)) ;;(indent 2) 242 (declare (debug t)) ;;(indent 2)
243 (cond ((eq 'local (car-safe place))
244 (setq place `(advice--buffer-local ,@(cdr place))))
245 ((symbolp place)
246 (error "Use (default-value '%S) or (local '%S)" place place)))
225 `(advice--add-function ,where (gv-ref ,place) ,function ,props)) 247 `(advice--add-function ,where (gv-ref ,place) ,function ,props))
226 248
227;;;###autoload 249;;;###autoload
@@ -236,6 +258,10 @@ If FUNCTION was not added to PLACE, do nothing.
236Instead of FUNCTION being the actual function, it can also be the `name' 258Instead of FUNCTION being the actual function, it can also be the `name'
237of the piece of advice." 259of the piece of advice."
238 (declare (debug t)) 260 (declare (debug t))
261 (cond ((eq 'local (car-safe place))
262 (setq place `(advice--buffer-local ,@(cdr place))))
263 ((symbolp place)
264 (error "Use (default-value '%S) or (local '%S)" place place)))
239 (gv-letplace (getter setter) place 265 (gv-letplace (getter setter) place
240 (macroexp-let2 nil new `(advice--remove-function ,getter ,function) 266 (macroexp-let2 nil new `(advice--remove-function ,getter ,function)
241 `(unless (eq ,new ,getter) ,(funcall setter new))))) 267 `(unless (eq ,new ,getter) ,(funcall setter new)))))