[Emacs-diffs] emacs-24 r117097: * lisp/emacs-lisp/nadvice.el: Support adding a given function multiple times.

[Stefan Monnier]

------------------------------------------------------------
revno: 117097
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: emacs-24
timestamp: Sat 2014-05-10 16:07:01 -0400
message:
  * 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.
modified:
  doc/lispref/functions.texi     
functions.texi-20091113204419-o5vbwnq5f7feedwu-6182
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/nadvice.el     nadvice.el-20121015213644-851fdxs2vximj8nr-1
  test/automated/advice-tests.el advice.el-20121111003311-i96f8i1au0zeaju7-1
  test/indent/perl.perl          perl.perl-20121031024456-cjjxr53eeyg5rvml-1
  test/indent/ruby.rb            ruby.rb-20120424165921-h044139hbrd7snvw-1

=== modified file 'doc/lispref/functions.texi'
--- a/doc/lispref/functions.texi        2014-03-22 08:35:03 +0000
+++ b/doc/lispref/functions.texi        2014-05-10 20:07:01 +0000
@@ -1240,7 +1240,8 @@
 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

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-05-09 18:03:21 +0000
+++ b/lisp/ChangeLog    2014-05-10 20:07:01 +0000
@@ -1,3 +1,13 @@
+2014-05-10  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>  (tiny change)
 
        * electric.el (electric-indent-post-self-insert-function): Don't use

=== modified file 'lisp/emacs-lisp/nadvice.el'
--- a/lisp/emacs-lisp/nadvice.el        2014-03-20 16:00:17 +0000
+++ b/lisp/emacs-lisp/nadvice.el        2014-05-10 20:07:01 +0000
@@ -183,9 +183,9 @@
 (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 @@
                  (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 @@
           ;; 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 @@
   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 @@
   `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 @@
 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)))))
 

=== modified file 'test/automated/advice-tests.el'
--- a/test/automated/advice-tests.el    2014-01-01 07:43:34 +0000
+++ b/test/automated/advice-tests.el    2014-05-10 20:07:01 +0000
@@ -179,6 +179,29 @@
     (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:

=== modified file 'test/indent/perl.perl'
--- a/test/indent/perl.perl     2014-04-23 01:56:18 +0000
+++ b/test/indent/perl.perl     2014-05-10 20:07:01 +0000
@@ -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

=== modified file 'test/indent/ruby.rb'
--- a/test/indent/ruby.rb       2014-03-27 06:53:13 +0000
+++ b/test/indent/ruby.rb       2014-05-10 20:07:01 +0000
@@ -16,6 +16,9 @@
 # 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