diff options
| -rw-r--r-- | lisp/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-loaddefs.el | 2 | ||||
| -rw-r--r-- | 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 @@ | |||
| 1 | 2012-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 | |||
| 1 | 2012-11-15 Drew Adams <drew.adams@oracle.com> | 8 | 2012-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 | |||
| 214 | a special meaning: | 228 | a 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 | ||
| 231 | PLACE cannot be a simple variable. Instead it should either be | ||
| 232 | \(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION | ||
| 233 | should be applied to VAR buffer-locally or globally. | ||
| 234 | |||
| 217 | If one of FUNCTION or OLDFUN is interactive, then the resulting function | 235 | If one of FUNCTION or OLDFUN is interactive, then the resulting function |
| 218 | is also interactive. There are 3 cases: | 236 | is 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. | |||
| 236 | Instead of FUNCTION being the actual function, it can also be the `name' | 258 | Instead of FUNCTION being the actual function, it can also be the `name' |
| 237 | of the piece of advice." | 259 | of 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))))) |