* 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:
parent
4a5c71d7c2
commit
5d03fb436f
6 changed files with 71 additions and 22 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))))
|
||||
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue