* 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.
This commit is contained in:
Stefan Monnier 2014-05-10 16:07:01 -04:00
parent 4a5c71d7c2
commit 5d03fb436f
6 changed files with 71 additions and 22 deletions

View file

@ -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

View file

@ -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

View file

@ -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)))))

View file

@ -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:

View file

@ -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

View file

@ -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