Commit 5d03fb43 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* 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.
parent 4a5c71d7
...@@ -1240,7 +1240,8 @@ buffer: if @var{place} is just a symbol, then @var{function} is added to the ...@@ -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 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 @code{(local @var{symbol})}, where @var{symbol} is an expression which returns
the variable name, then @var{function} will only be added in the 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 Every function added with @code{add-function} can be accompanied by an
association list of properties @var{props}. Currently only two of those association list of properties @var{props}. Currently only two of those
......
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) 2014-05-09 Philipp Rumpf <prumpf@gmail.com> (tiny change)
   
* electric.el (electric-indent-post-self-insert-function): Don't use * electric.el (electric-indent-post-self-insert-function): Don't use
......
...@@ -183,9 +183,9 @@ WHERE is a symbol to select an entry in `advice--where-alist'." ...@@ -183,9 +183,9 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
(defun advice--member-p (function name definition) (defun advice--member-p (function name definition)
(let ((found nil)) (let ((found nil))
(while (and (not found) (advice--p definition)) (while (and (not found) (advice--p definition))
(if (or (equal function (advice--car definition)) (if (if name
(when name (equal name (cdr (assq 'name (advice--props definition))))
(equal name (cdr (assq 'name (advice--props definition)))))) (equal function (advice--car definition)))
(setq found definition) (setq found definition)
(setq definition (advice--cdr definition)))) (setq definition (advice--cdr definition))))
found)) found))
...@@ -209,8 +209,8 @@ WHERE is a symbol to select an entry in `advice--where-alist'." ...@@ -209,8 +209,8 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
(lambda (first rest props) (lambda (first rest props)
(cond ((not first) rest) (cond ((not first) rest)
((or (equal function first) ((or (equal function first)
(equal function (cdr (assq 'name props)))) (equal function (cdr (assq 'name props))))
(list rest)))))) (list (advice--remove-function rest function)))))))
(defvar advice--buffer-local-function-sample nil (defvar advice--buffer-local-function-sample nil
"keeps an example of the special \"run the default value\" functions. "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,6 +232,12 @@ different, but `function-equal' will hopefully ignore those differences.")
;; This function acts like the t special value in buffer-local hooks. ;; This function acts like the t special value in buffer-local hooks.
(lambda (&rest args) (apply (default-value var) args))))) (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 ;;;###autoload
(defmacro add-function (where place function &optional props) (defmacro add-function (where place function &optional props)
;; TODO: ;; TODO:
...@@ -267,8 +273,9 @@ a special meaning: ...@@ -267,8 +273,9 @@ a special meaning:
the advice should be innermost (i.e. at the end of the list), 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. 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. If PLACE is a symbol, its `default-value' will be affected.
Use (local 'VAR) if you want to apply FUNCTION to VAR buffer-locally. 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 If one of FUNCTION or OLDFUN is interactive, then the resulting function
is also interactive. There are 3 cases: is also interactive. There are 3 cases:
...@@ -278,20 +285,18 @@ 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. `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." - Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN."
(declare (debug t)) ;;(indent 2) (declare (debug t)) ;;(indent 2)
(cond ((eq 'local (car-safe place)) `(advice--add-function ,where (gv-ref ,(advice--normalize-place place))
(setq place `(advice--buffer-local ,@(cdr place)))) ,function ,props))
((symbolp place)
(setq place `(default-value ',place))))
`(advice--add-function ,where (gv-ref ,place) ,function ,props))
;;;###autoload ;;;###autoload
(defun advice--add-function (where ref function props) (defun advice--add-function (where ref function props)
(let ((a (advice--member-p function (cdr (assq 'name props)) (let* ((name (cdr (assq 'name props)))
(gv-deref ref)))) (a (advice--member-p function name (gv-deref ref))))
(when a (when a
;; The advice is already present. Remove the old one, first. ;; The advice is already present. Remove the old one, first.
(setf (gv-deref ref) (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) (setf (gv-deref ref)
(advice--make where function (gv-deref ref) props)))) (advice--make where function (gv-deref ref) props))))
...@@ -302,11 +307,7 @@ If FUNCTION was not added to PLACE, do nothing. ...@@ -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' Instead of FUNCTION being the actual function, it can also be the `name'
of the piece of advice." of the piece of advice."
(declare (debug t)) (declare (debug t))
(cond ((eq 'local (car-safe place)) (gv-letplace (getter setter) (advice--normalize-place place)
(setq place `(advice--buffer-local ,@(cdr place))))
((symbolp place)
(setq place `(default-value ',place))))
(gv-letplace (getter setter) place
(macroexp-let2 nil new `(advice--remove-function ,getter ,function) (macroexp-let2 nil new `(advice--remove-function ,getter ,function)
`(unless (eq ,new ,getter) ,(funcall setter new))))) `(unless (eq ,new ,getter) ,(funcall setter new)))))
......
...@@ -179,6 +179,29 @@ function being an around advice." ...@@ -179,6 +179,29 @@ function being an around advice."
(interactive "P") nil) (interactive "P") nil)
(should (equal (interactive-form 'sm-test9) '(interactive "P")))) (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: ;; Local Variables:
;; no-byte-compile: t ;; no-byte-compile: t
;; End: ;; End:
......
#!/usr/bin/perl #!/usr/bin/perl
# -*- eval: (bug-reference-mode 1) -*- # -*- eval: (bug-reference-mode 1) -*-
use v5.14;
my $str= <<END;
Hello
END
my $a = $';
my $b=3;
print $str;
if ($c && /====/){xyz;} if ($c && /====/){xyz;}
print <<"EOF1" . s/he"llo/th'ere/; print << "EOF1" . s/he"llo/th'ere/;
foo foo
EOF2 EOF2
bar bar
......
...@@ -16,6 +16,9 @@ ...@@ -16,6 +16,9 @@
# Don't propertize percent literals inside strings. # Don't propertize percent literals inside strings.
"(%s, %s)" % [123, 456] "(%s, %s)" % [123, 456]
"abc/#{def}ghi"
"abc\#{def}ghi"
# Or inside comments. # Or inside comments.
x = # "tot %q/to"; = x = # "tot %q/to"; =
y = 2 / 3 y = 2 / 3
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment