* 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.

diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 460736778817a137d26f4ca682c7c344d47397eb..9888411667f26748cedadf441c6fc109ef4fbe77 100644 (file)
--- 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 3f47c077f5c71fb8f0721aa2866a5915b1ac0040..0fa0c93915a7bd996dd6647c8d54b09b95bda0c3 100644 (file)
--- 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 0e2536f81792f54a5a3ffb07123d07dfaab55ce6..332d1ed61b6cee1ea3fe1c7916a76c53905c2f8b 100644 (file)
--- 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 f755e8defef15b064736351fbdc9798430fbb445..e0c3b40487e41a644aae3098c58ab12f99252e5a 100644 (file)
--- 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 c7a2fbfb2d20b15ee1be3075e03e5d7816c924c7..aca478a1375285bd7acaa1db2c07c1553330dce3 100755 (executable)
--- 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 fb341ee7ba6096bae4fdca70fae655308f9613fa..7e7787989965ee5191562ead8960d89aef26ce05 100644 (file)
--- 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