aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--doc/lispref/functions.texi3
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/emacs-lisp/nadvice.el41
-rw-r--r--test/automated/advice-tests.el23
-rwxr-xr-xtest/indent/perl.perl13
-rw-r--r--test/indent/ruby.rb3
6 files changed, 71 insertions, 22 deletions
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 46073677881..9888411667f 100644
--- 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
1240global value of @var{place}. Whereas if @var{place} is of the form 1240global value of @var{place}. Whereas if @var{place} is of the form
1241@code{(local @var{symbol})}, where @var{symbol} is an expression which returns 1241@code{(local @var{symbol})}, where @var{symbol} is an expression which returns
1242the variable name, then @var{function} will only be added in the 1242the variable name, then @var{function} will only be added in the
1243current buffer. 1243current buffer. Finally, if you want to modify a lexical variable, you will
1244have to use @code{(var @var{VARIABLE})}.
1244 1245
1245Every function added with @code{add-function} can be accompanied by an 1246Every function added with @code{add-function} can be accompanied by an
1246association list of properties @var{props}. Currently only two of those 1247association list of properties @var{props}. Currently only two of those
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3f47c077f5c..0fa0c93915a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
12014-05-10 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/nadvice.el: Support adding a given function multiple times.
4 (advice--member-p): If name is given, only compare the name.
5 (advice--remove-function): Don't stop at the first match.
6 (advice--normalize-place): New function.
7 (add-function, remove-function): Use it.
8 (advice--add-function): Pass the name, if any, to
9 advice--remove-function.
10
12014-05-09 Philipp Rumpf <prumpf@gmail.com> (tiny change) 112014-05-09 Philipp Rumpf <prumpf@gmail.com> (tiny change)
2 12
3 * electric.el (electric-indent-post-self-insert-function): Don't use 13 * 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 0e2536f8179..332d1ed61b6 100644
--- 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'."
183(defun advice--member-p (function name definition) 183(defun advice--member-p (function name definition)
184 (let ((found nil)) 184 (let ((found nil))
185 (while (and (not found) (advice--p definition)) 185 (while (and (not found) (advice--p definition))
186 (if (or (equal function (advice--car definition)) 186 (if (if name
187 (when name 187 (equal name (cdr (assq 'name (advice--props definition))))
188 (equal name (cdr (assq 'name (advice--props definition)))))) 188 (equal function (advice--car definition)))
189 (setq found definition) 189 (setq found definition)
190 (setq definition (advice--cdr definition)))) 190 (setq definition (advice--cdr definition))))
191 found)) 191 found))
@@ -209,8 +209,8 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
209 (lambda (first rest props) 209 (lambda (first rest props)
210 (cond ((not first) rest) 210 (cond ((not first) rest)
211 ((or (equal function first) 211 ((or (equal function first)
212 (equal function (cdr (assq 'name props)))) 212 (equal function (cdr (assq 'name props))))
213 (list rest)))))) 213 (list (advice--remove-function rest function)))))))
214 214
215(defvar advice--buffer-local-function-sample nil 215(defvar advice--buffer-local-function-sample nil
216 "keeps an example of the special \"run the default value\" functions. 216 "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 ;; This function acts like the t special value in buffer-local hooks. 232 ;; This function acts like the t special value in buffer-local hooks.
233 (lambda (&rest args) (apply (default-value var) args))))) 233 (lambda (&rest args) (apply (default-value var) args)))))
234 234
235(defun advice--normalize-place (place)
236 (cond ((eq 'local (car-safe place)) `(advice--buffer-local ,@(cdr place)))
237 ((eq 'var (car-safe place)) (nth 1 place))
238 ((symbolp place) `(default-value ',place))
239 (t place)))
240
235;;;###autoload 241;;;###autoload
236(defmacro add-function (where place function &optional props) 242(defmacro add-function (where place function &optional props)
237 ;; TODO: 243 ;; TODO:
@@ -267,8 +273,9 @@ a special meaning:
267 the advice should be innermost (i.e. at the end of the list), 273 the advice should be innermost (i.e. at the end of the list),
268 whereas a depth of -100 means that the advice should be outermost. 274 whereas a depth of -100 means that the advice should be outermost.
269 275
270If PLACE is a simple variable, only its global value will be affected. 276If PLACE is a symbol, its `default-value' will be affected.
271Use (local 'VAR) if you want to apply FUNCTION to VAR buffer-locally. 277Use (local 'SYMBOL) if you want to apply FUNCTION to SYMBOL buffer-locally.
278Use (var VAR) if you want to apply FUNCTION to the (lexical) VAR.
272 279
273If one of FUNCTION or OLDFUN is interactive, then the resulting function 280If one of FUNCTION or OLDFUN is interactive, then the resulting function
274is also interactive. There are 3 cases: 281is also interactive. There are 3 cases:
@@ -278,20 +285,18 @@ is also interactive. There are 3 cases:
278 `advice-eval-interactive-spec') and return the list of arguments to use. 285 `advice-eval-interactive-spec') and return the list of arguments to use.
279- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN." 286- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN."
280 (declare (debug t)) ;;(indent 2) 287 (declare (debug t)) ;;(indent 2)
281 (cond ((eq 'local (car-safe place)) 288 `(advice--add-function ,where (gv-ref ,(advice--normalize-place place))
282 (setq place `(advice--buffer-local ,@(cdr place)))) 289 ,function ,props))
283 ((symbolp place)
284 (setq place `(default-value ',place))))
285 `(advice--add-function ,where (gv-ref ,place) ,function ,props))
286 290
287;;;###autoload 291;;;###autoload
288(defun advice--add-function (where ref function props) 292(defun advice--add-function (where ref function props)
289 (let ((a (advice--member-p function (cdr (assq 'name props)) 293 (let* ((name (cdr (assq 'name props)))
290 (gv-deref ref)))) 294 (a (advice--member-p function name (gv-deref ref))))
291 (when a 295 (when a
292 ;; The advice is already present. Remove the old one, first. 296 ;; The advice is already present. Remove the old one, first.
293 (setf (gv-deref ref) 297 (setf (gv-deref ref)
294 (advice--remove-function (gv-deref ref) (advice--car a)))) 298 (advice--remove-function (gv-deref ref)
299 (or name (advice--car a)))))
295 (setf (gv-deref ref) 300 (setf (gv-deref ref)
296 (advice--make where function (gv-deref ref) props)))) 301 (advice--make where function (gv-deref ref) props))))
297 302
@@ -302,11 +307,7 @@ If FUNCTION was not added to PLACE, do nothing.
302Instead of FUNCTION being the actual function, it can also be the `name' 307Instead of FUNCTION being the actual function, it can also be the `name'
303of the piece of advice." 308of the piece of advice."
304 (declare (debug t)) 309 (declare (debug t))
305 (cond ((eq 'local (car-safe place)) 310 (gv-letplace (getter setter) (advice--normalize-place place)
306 (setq place `(advice--buffer-local ,@(cdr place))))
307 ((symbolp place)
308 (setq place `(default-value ',place))))
309 (gv-letplace (getter setter) place
310 (macroexp-let2 nil new `(advice--remove-function ,getter ,function) 311 (macroexp-let2 nil new `(advice--remove-function ,getter ,function)
311 `(unless (eq ,new ,getter) ,(funcall setter new))))) 312 `(unless (eq ,new ,getter) ,(funcall setter new)))))
312 313
diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el
index f755e8defef..e0c3b40487e 100644
--- a/test/automated/advice-tests.el
+++ b/test/automated/advice-tests.el
@@ -179,6 +179,29 @@ function being an around advice."
179 (interactive "P") nil) 179 (interactive "P") nil)
180 (should (equal (interactive-form 'sm-test9) '(interactive "P")))) 180 (should (equal (interactive-form 'sm-test9) '(interactive "P"))))
181 181
182(ert-deftest advice-test-multiples ()
183 (let ((sm-test10 (lambda (a) (+ a 10)))
184 (sm-advice (lambda (x) (if (consp x) (list (* 5 (car x))) (* 4 x)))))
185 (should (equal (funcall sm-test10 5) 15))
186 (add-function :filter-args (var sm-test10) sm-advice)
187 (should (equal (funcall sm-test10 5) 35))
188 (add-function :filter-return (var sm-test10) sm-advice)
189 (should (equal (funcall sm-test10 5) 60))
190 ;; Make sure we can add multiple times the same function, under the
191 ;; condition that they have different `name' properties.
192 (add-function :filter-args (var sm-test10) sm-advice '((name . "args")))
193 (should (equal (funcall sm-test10 5) 140))
194 (remove-function (var sm-test10) "args")
195 (should (equal (funcall sm-test10 5) 60))
196 (add-function :filter-args (var sm-test10) sm-advice '((name . "args")))
197 (add-function :filter-return (var sm-test10) sm-advice '((name . "ret")))
198 (should (equal (funcall sm-test10 5) 560))
199 ;; Make sure that if we specify to remove a function that was added
200 ;; multiple times, they are all removed, rather than removing only some
201 ;; arbitrary subset of them.
202 (remove-function (var sm-test10) sm-advice)
203 (should (equal (funcall sm-test10 5) 15))))
204
182;; Local Variables: 205;; Local Variables:
183;; no-byte-compile: t 206;; no-byte-compile: t
184;; End: 207;; End:
diff --git a/test/indent/perl.perl b/test/indent/perl.perl
index c7a2fbfb2d2..aca478a1375 100755
--- a/test/indent/perl.perl
+++ b/test/indent/perl.perl
@@ -1,9 +1,20 @@
1#!/usr/bin/perl 1#!/usr/bin/perl
2# -*- eval: (bug-reference-mode 1) -*- 2# -*- eval: (bug-reference-mode 1) -*-
3 3
4use v5.14;
5
6my $str= <<END;
7Hello
8END
9
10my $a = $';
11
12my $b=3;
13
14print $str;
4if ($c && /====/){xyz;} 15if ($c && /====/){xyz;}
5 16
6print <<"EOF1" . s/he"llo/th'ere/; 17print << "EOF1" . s/he"llo/th'ere/;
7foo 18foo
8EOF2 19EOF2
9bar 20bar
diff --git a/test/indent/ruby.rb b/test/indent/ruby.rb
index fb341ee7ba6..7e778798996 100644
--- a/test/indent/ruby.rb
+++ b/test/indent/ruby.rb
@@ -16,6 +16,9 @@ d = %(hello (nested) world)
16# Don't propertize percent literals inside strings. 16# Don't propertize percent literals inside strings.
17"(%s, %s)" % [123, 456] 17"(%s, %s)" % [123, 456]
18 18
19"abc/#{def}ghi"
20"abc\#{def}ghi"
21
19# Or inside comments. 22# Or inside comments.
20x = # "tot %q/to"; = 23x = # "tot %q/to"; =
21 y = 2 / 3 24 y = 2 / 3