diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2014-05-10 16:07:01 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2014-05-10 16:07:01 -0400 |
commit | 5d03fb436fcfb1fe704cc7a66dec7bd2d21d49f1 (patch) | |
tree | 7884824b46c957bc5bfce46066e756d4ae4992db | |
parent | 4a5c71d7c275b93238c629601526a87eca08e6fd (diff) | |
download | emacs-5d03fb436fcfb1fe704cc7a66dec7bd2d21d49f1.tar.gz |
* lisp/emacs-lisp/nadvice.el: Support adding a given function multiple times.
(advice--member-p): If name is given, only compare the name.
(advice--remove-function): Don't stop at the first match.
(advice--normalize-place): New function.
(add-function, remove-function): Use it.
(advice--add-function): Pass the name, if any, to
advice--remove-function.
-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 global value of @var{place}. Whereas if @var{place} is of the form @code{(local @var{symbol})}, where @var{symbol} is an expression which returns the variable name, then @var{function} will only be added in the -current buffer. +current buffer. Finally, if you want to modify a lexical variable, you will +have to use @code{(var @var{VARIABLE})}. Every function added with @code{add-function} can be accompanied by an 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 @@ +2014-05-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/nadvice.el: Support adding a given function multiple times. + (advice--member-p): If name is given, only compare the name. + (advice--remove-function): Don't stop at the first match. + (advice--normalize-place): New function. + (add-function, remove-function): Use it. + (advice--add-function): Pass the name, if any, to + advice--remove-function. + 2014-05-09 Philipp Rumpf <prumpf@gmail.com> (tiny change) * 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'." (defun advice--member-p (function name definition) (let ((found nil)) (while (and (not found) (advice--p definition)) - (if (or (equal function (advice--car definition)) - (when name - (equal name (cdr (assq 'name (advice--props definition)))))) + (if (if name + (equal name (cdr (assq 'name (advice--props definition)))) + (equal function (advice--car definition))) (setq found definition) (setq definition (advice--cdr definition)))) found)) @@ -209,8 +209,8 @@ WHERE is a symbol to select an entry in `advice--where-alist'." (lambda (first rest props) (cond ((not first) rest) ((or (equal function first) - (equal function (cdr (assq 'name props)))) - (list rest)))))) + (equal function (cdr (assq 'name props)))) + (list (advice--remove-function rest function))))))) (defvar advice--buffer-local-function-sample nil "keeps an example of the special \"run the default value\" functions. @@ -232,6 +232,12 @@ different, but `function-equal' will hopefully ignore those differences.") ;; This function acts like the t special value in buffer-local hooks. (lambda (&rest args) (apply (default-value var) args))))) +(defun advice--normalize-place (place) + (cond ((eq 'local (car-safe place)) `(advice--buffer-local ,@(cdr place))) + ((eq 'var (car-safe place)) (nth 1 place)) + ((symbolp place) `(default-value ',place)) + (t place))) + ;;;###autoload (defmacro add-function (where place function &optional props) ;; TODO: @@ -267,8 +273,9 @@ a special meaning: the advice should be innermost (i.e. at the end of the list), whereas a depth of -100 means that the advice should be outermost. -If PLACE is a simple variable, only its global value will be affected. -Use (local 'VAR) if you want to apply FUNCTION to VAR buffer-locally. +If PLACE is a symbol, its `default-value' will be affected. +Use (local 'SYMBOL) if you want to apply FUNCTION to SYMBOL buffer-locally. +Use (var VAR) if you want to apply FUNCTION to the (lexical) VAR. If one of FUNCTION or OLDFUN is interactive, then the resulting function is also interactive. There are 3 cases: @@ -278,20 +285,18 @@ 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) - (setq place `(default-value ',place)))) - `(advice--add-function ,where (gv-ref ,place) ,function ,props)) + `(advice--add-function ,where (gv-ref ,(advice--normalize-place place)) + ,function ,props)) ;;;###autoload (defun advice--add-function (where ref function props) - (let ((a (advice--member-p function (cdr (assq 'name props)) - (gv-deref ref)))) + (let* ((name (cdr (assq 'name props))) + (a (advice--member-p function name (gv-deref ref)))) (when a ;; The advice is already present. Remove the old one, first. (setf (gv-deref ref) - (advice--remove-function (gv-deref ref) (advice--car a)))) + (advice--remove-function (gv-deref ref) + (or name (advice--car a))))) (setf (gv-deref ref) (advice--make where function (gv-deref ref) props)))) @@ -302,11 +307,7 @@ 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) - (setq place `(default-value ',place)))) - (gv-letplace (getter setter) place + (gv-letplace (getter setter) (advice--normalize-place place) (macroexp-let2 nil new `(advice--remove-function ,getter ,function) `(unless (eq ,new ,getter) ,(funcall setter new))))) 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." (interactive "P") nil) (should (equal (interactive-form 'sm-test9) '(interactive "P")))) +(ert-deftest advice-test-multiples () + (let ((sm-test10 (lambda (a) (+ a 10))) + (sm-advice (lambda (x) (if (consp x) (list (* 5 (car x))) (* 4 x))))) + (should (equal (funcall sm-test10 5) 15)) + (add-function :filter-args (var sm-test10) sm-advice) + (should (equal (funcall sm-test10 5) 35)) + (add-function :filter-return (var sm-test10) sm-advice) + (should (equal (funcall sm-test10 5) 60)) + ;; Make sure we can add multiple times the same function, under the + ;; condition that they have different `name' properties. + (add-function :filter-args (var sm-test10) sm-advice '((name . "args"))) + (should (equal (funcall sm-test10 5) 140)) + (remove-function (var sm-test10) "args") + (should (equal (funcall sm-test10 5) 60)) + (add-function :filter-args (var sm-test10) sm-advice '((name . "args"))) + (add-function :filter-return (var sm-test10) sm-advice '((name . "ret"))) + (should (equal (funcall sm-test10 5) 560)) + ;; Make sure that if we specify to remove a function that was added + ;; multiple times, they are all removed, rather than removing only some + ;; arbitrary subset of them. + (remove-function (var sm-test10) sm-advice) + (should (equal (funcall sm-test10 5) 15)))) + ;; Local Variables: ;; no-byte-compile: t ;; 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 @@ #!/usr/bin/perl # -*- eval: (bug-reference-mode 1) -*- +use v5.14; + +my $str= <<END; +Hello +END + +my $a = $'; + +my $b=3; + +print $str; if ($c && /====/){xyz;} -print <<"EOF1" . s/he"llo/th'ere/; +print << "EOF1" . s/he"llo/th'ere/; foo EOF2 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) # Don't propertize percent literals inside strings. "(%s, %s)" % [123, 456] +"abc/#{def}ghi" +"abc\#{def}ghi" + # Or inside comments. x = # "tot %q/to"; = y = 2 / 3 |