diff options
| -rw-r--r-- | doc/lispref/functions.texi | 3 | ||||
| -rw-r--r-- | lisp/ChangeLog | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/nadvice.el | 41 | ||||
| -rw-r--r-- | test/automated/advice-tests.el | 23 | ||||
| -rwxr-xr-x | test/indent/perl.perl | 13 | ||||
| -rw-r--r-- | test/indent/ruby.rb | 3 |
6 files changed, 71 insertions, 22 deletions
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 46073677881..9888411667f 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi | |||
| @@ -1240,7 +1240,8 @@ buffer: if @var{place} is just a symbol, then @var{function} is added to the | |||
| 1240 | global value of @var{place}. Whereas if @var{place} is of the form | 1240 | global value of @var{place}. Whereas if @var{place} is of the form |
| 1241 | @code{(local @var{symbol})}, where @var{symbol} is an expression which returns | 1241 | @code{(local @var{symbol})}, where @var{symbol} is an expression which returns |
| 1242 | the variable name, then @var{function} will only be added in the | 1242 | the variable name, then @var{function} will only be added in the |
| 1243 | current buffer. | 1243 | current buffer. Finally, if you want to modify a lexical variable, you will |
| 1244 | have to use @code{(var @var{VARIABLE})}. | ||
| 1244 | 1245 | ||
| 1245 | Every function added with @code{add-function} can be accompanied by an | 1246 | Every function added with @code{add-function} can be accompanied by an |
| 1246 | association list of properties @var{props}. Currently only two of those | 1247 | association list of properties @var{props}. Currently only two of those |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3f47c077f5c..0fa0c93915a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,13 @@ | |||
| 1 | 2014-05-10 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/nadvice.el: Support adding a given function multiple times. | ||
| 4 | (advice--member-p): If name is given, only compare the name. | ||
| 5 | (advice--remove-function): Don't stop at the first match. | ||
| 6 | (advice--normalize-place): New function. | ||
| 7 | (add-function, remove-function): Use it. | ||
| 8 | (advice--add-function): Pass the name, if any, to | ||
| 9 | advice--remove-function. | ||
| 10 | |||
| 1 | 2014-05-09 Philipp Rumpf <prumpf@gmail.com> (tiny change) | 11 | 2014-05-09 Philipp Rumpf <prumpf@gmail.com> (tiny change) |
| 2 | 12 | ||
| 3 | * electric.el (electric-indent-post-self-insert-function): Don't use | 13 | * electric.el (electric-indent-post-self-insert-function): Don't use |
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 0e2536f8179..332d1ed61b6 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el | |||
| @@ -183,9 +183,9 @@ WHERE is a symbol to select an entry in `advice--where-alist'." | |||
| 183 | (defun advice--member-p (function name definition) | 183 | (defun advice--member-p (function name definition) |
| 184 | (let ((found nil)) | 184 | (let ((found nil)) |
| 185 | (while (and (not found) (advice--p definition)) | 185 | (while (and (not found) (advice--p definition)) |
| 186 | (if (or (equal function (advice--car definition)) | 186 | (if (if name |
| 187 | (when name | 187 | (equal name (cdr (assq 'name (advice--props definition)))) |
| 188 | (equal name (cdr (assq 'name (advice--props definition)))))) | 188 | (equal function (advice--car definition))) |
| 189 | (setq found definition) | 189 | (setq found definition) |
| 190 | (setq definition (advice--cdr definition)))) | 190 | (setq definition (advice--cdr definition)))) |
| 191 | found)) | 191 | found)) |
| @@ -209,8 +209,8 @@ WHERE is a symbol to select an entry in `advice--where-alist'." | |||
| 209 | (lambda (first rest props) | 209 | (lambda (first rest props) |
| 210 | (cond ((not first) rest) | 210 | (cond ((not first) rest) |
| 211 | ((or (equal function first) | 211 | ((or (equal function first) |
| 212 | (equal function (cdr (assq 'name props)))) | 212 | (equal function (cdr (assq 'name props)))) |
| 213 | (list rest)))))) | 213 | (list (advice--remove-function rest function))))))) |
| 214 | 214 | ||
| 215 | (defvar advice--buffer-local-function-sample nil | 215 | (defvar advice--buffer-local-function-sample nil |
| 216 | "keeps an example of the special \"run the default value\" functions. | 216 | "keeps an example of the special \"run the default value\" functions. |
| @@ -232,6 +232,12 @@ different, but `function-equal' will hopefully ignore those differences.") | |||
| 232 | ;; This function acts like the t special value in buffer-local hooks. | 232 | ;; This function acts like the t special value in buffer-local hooks. |
| 233 | (lambda (&rest args) (apply (default-value var) args))))) | 233 | (lambda (&rest args) (apply (default-value var) args))))) |
| 234 | 234 | ||
| 235 | (defun advice--normalize-place (place) | ||
| 236 | (cond ((eq 'local (car-safe place)) `(advice--buffer-local ,@(cdr place))) | ||
| 237 | ((eq 'var (car-safe place)) (nth 1 place)) | ||
| 238 | ((symbolp place) `(default-value ',place)) | ||
| 239 | (t place))) | ||
| 240 | |||
| 235 | ;;;###autoload | 241 | ;;;###autoload |
| 236 | (defmacro add-function (where place function &optional props) | 242 | (defmacro add-function (where place function &optional props) |
| 237 | ;; TODO: | 243 | ;; TODO: |
| @@ -267,8 +273,9 @@ a special meaning: | |||
| 267 | the advice should be innermost (i.e. at the end of the list), | 273 | the advice should be innermost (i.e. at the end of the list), |
| 268 | whereas a depth of -100 means that the advice should be outermost. | 274 | whereas a depth of -100 means that the advice should be outermost. |
| 269 | 275 | ||
| 270 | If PLACE is a simple variable, only its global value will be affected. | 276 | If PLACE is a symbol, its `default-value' will be affected. |
| 271 | Use (local 'VAR) if you want to apply FUNCTION to VAR buffer-locally. | 277 | Use (local 'SYMBOL) if you want to apply FUNCTION to SYMBOL buffer-locally. |
| 278 | Use (var VAR) if you want to apply FUNCTION to the (lexical) VAR. | ||
| 272 | 279 | ||
| 273 | If one of FUNCTION or OLDFUN is interactive, then the resulting function | 280 | If one of FUNCTION or OLDFUN is interactive, then the resulting function |
| 274 | is also interactive. There are 3 cases: | 281 | is also interactive. There are 3 cases: |
| @@ -278,20 +285,18 @@ is also interactive. There are 3 cases: | |||
| 278 | `advice-eval-interactive-spec') and return the list of arguments to use. | 285 | `advice-eval-interactive-spec') and return the list of arguments to use. |
| 279 | - Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN." | 286 | - Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN." |
| 280 | (declare (debug t)) ;;(indent 2) | 287 | (declare (debug t)) ;;(indent 2) |
| 281 | (cond ((eq 'local (car-safe place)) | 288 | `(advice--add-function ,where (gv-ref ,(advice--normalize-place place)) |
| 282 | (setq place `(advice--buffer-local ,@(cdr place)))) | 289 | ,function ,props)) |
| 283 | ((symbolp place) | ||
| 284 | (setq place `(default-value ',place)))) | ||
| 285 | `(advice--add-function ,where (gv-ref ,place) ,function ,props)) | ||
| 286 | 290 | ||
| 287 | ;;;###autoload | 291 | ;;;###autoload |
| 288 | (defun advice--add-function (where ref function props) | 292 | (defun advice--add-function (where ref function props) |
| 289 | (let ((a (advice--member-p function (cdr (assq 'name props)) | 293 | (let* ((name (cdr (assq 'name props))) |
| 290 | (gv-deref ref)))) | 294 | (a (advice--member-p function name (gv-deref ref)))) |
| 291 | (when a | 295 | (when a |
| 292 | ;; The advice is already present. Remove the old one, first. | 296 | ;; The advice is already present. Remove the old one, first. |
| 293 | (setf (gv-deref ref) | 297 | (setf (gv-deref ref) |
| 294 | (advice--remove-function (gv-deref ref) (advice--car a)))) | 298 | (advice--remove-function (gv-deref ref) |
| 299 | (or name (advice--car a))))) | ||
| 295 | (setf (gv-deref ref) | 300 | (setf (gv-deref ref) |
| 296 | (advice--make where function (gv-deref ref) props)))) | 301 | (advice--make where function (gv-deref ref) props)))) |
| 297 | 302 | ||
| @@ -302,11 +307,7 @@ If FUNCTION was not added to PLACE, do nothing. | |||
| 302 | Instead of FUNCTION being the actual function, it can also be the `name' | 307 | Instead of FUNCTION being the actual function, it can also be the `name' |
| 303 | of the piece of advice." | 308 | of the piece of advice." |
| 304 | (declare (debug t)) | 309 | (declare (debug t)) |
| 305 | (cond ((eq 'local (car-safe place)) | 310 | (gv-letplace (getter setter) (advice--normalize-place place) |
| 306 | (setq place `(advice--buffer-local ,@(cdr place)))) | ||
| 307 | ((symbolp place) | ||
| 308 | (setq place `(default-value ',place)))) | ||
| 309 | (gv-letplace (getter setter) place | ||
| 310 | (macroexp-let2 nil new `(advice--remove-function ,getter ,function) | 311 | (macroexp-let2 nil new `(advice--remove-function ,getter ,function) |
| 311 | `(unless (eq ,new ,getter) ,(funcall setter new))))) | 312 | `(unless (eq ,new ,getter) ,(funcall setter new))))) |
| 312 | 313 | ||
diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el index f755e8defef..e0c3b40487e 100644 --- a/test/automated/advice-tests.el +++ b/test/automated/advice-tests.el | |||
| @@ -179,6 +179,29 @@ function being an around advice." | |||
| 179 | (interactive "P") nil) | 179 | (interactive "P") nil) |
| 180 | (should (equal (interactive-form 'sm-test9) '(interactive "P")))) | 180 | (should (equal (interactive-form 'sm-test9) '(interactive "P")))) |
| 181 | 181 | ||
| 182 | (ert-deftest advice-test-multiples () | ||
| 183 | (let ((sm-test10 (lambda (a) (+ a 10))) | ||
| 184 | (sm-advice (lambda (x) (if (consp x) (list (* 5 (car x))) (* 4 x))))) | ||
| 185 | (should (equal (funcall sm-test10 5) 15)) | ||
| 186 | (add-function :filter-args (var sm-test10) sm-advice) | ||
| 187 | (should (equal (funcall sm-test10 5) 35)) | ||
| 188 | (add-function :filter-return (var sm-test10) sm-advice) | ||
| 189 | (should (equal (funcall sm-test10 5) 60)) | ||
| 190 | ;; Make sure we can add multiple times the same function, under the | ||
| 191 | ;; condition that they have different `name' properties. | ||
| 192 | (add-function :filter-args (var sm-test10) sm-advice '((name . "args"))) | ||
| 193 | (should (equal (funcall sm-test10 5) 140)) | ||
| 194 | (remove-function (var sm-test10) "args") | ||
| 195 | (should (equal (funcall sm-test10 5) 60)) | ||
| 196 | (add-function :filter-args (var sm-test10) sm-advice '((name . "args"))) | ||
| 197 | (add-function :filter-return (var sm-test10) sm-advice '((name . "ret"))) | ||
| 198 | (should (equal (funcall sm-test10 5) 560)) | ||
| 199 | ;; Make sure that if we specify to remove a function that was added | ||
| 200 | ;; multiple times, they are all removed, rather than removing only some | ||
| 201 | ;; arbitrary subset of them. | ||
| 202 | (remove-function (var sm-test10) sm-advice) | ||
| 203 | (should (equal (funcall sm-test10 5) 15)))) | ||
| 204 | |||
| 182 | ;; Local Variables: | 205 | ;; Local Variables: |
| 183 | ;; no-byte-compile: t | 206 | ;; no-byte-compile: t |
| 184 | ;; End: | 207 | ;; End: |
diff --git a/test/indent/perl.perl b/test/indent/perl.perl index c7a2fbfb2d2..aca478a1375 100755 --- a/test/indent/perl.perl +++ b/test/indent/perl.perl | |||
| @@ -1,9 +1,20 @@ | |||
| 1 | #!/usr/bin/perl | 1 | #!/usr/bin/perl |
| 2 | # -*- eval: (bug-reference-mode 1) -*- | 2 | # -*- eval: (bug-reference-mode 1) -*- |
| 3 | 3 | ||
| 4 | use v5.14; | ||
| 5 | |||
| 6 | my $str= <<END; | ||
| 7 | Hello | ||
| 8 | END | ||
| 9 | |||
| 10 | my $a = $'; | ||
| 11 | |||
| 12 | my $b=3; | ||
| 13 | |||
| 14 | print $str; | ||
| 4 | if ($c && /====/){xyz;} | 15 | if ($c && /====/){xyz;} |
| 5 | 16 | ||
| 6 | print <<"EOF1" . s/he"llo/th'ere/; | 17 | print << "EOF1" . s/he"llo/th'ere/; |
| 7 | foo | 18 | foo |
| 8 | EOF2 | 19 | EOF2 |
| 9 | bar | 20 | bar |
diff --git a/test/indent/ruby.rb b/test/indent/ruby.rb index fb341ee7ba6..7e778798996 100644 --- a/test/indent/ruby.rb +++ b/test/indent/ruby.rb | |||
| @@ -16,6 +16,9 @@ d = %(hello (nested) world) | |||
| 16 | # Don't propertize percent literals inside strings. | 16 | # Don't propertize percent literals inside strings. |
| 17 | "(%s, %s)" % [123, 456] | 17 | "(%s, %s)" % [123, 456] |
| 18 | 18 | ||
| 19 | "abc/#{def}ghi" | ||
| 20 | "abc\#{def}ghi" | ||
| 21 | |||
| 19 | # Or inside comments. | 22 | # Or inside comments. |
| 20 | x = # "tot %q/to"; = | 23 | x = # "tot %q/to"; = |
| 21 | y = 2 / 3 | 24 | y = 2 / 3 |