branch: master
commit 306335e9b29594c43b8b9b7be703f55cfb24845a
Author: Jackson Ray Hamilton <[email protected]>
Commit: Jackson Ray Hamilton <[email protected]>
Add defadvice support.
---
context-coloring.el | 40 ++++++++++++++++++++++++++++++++++++++++
test/context-coloring-test.el | 7 +++++++
test/fixtures/defadvice.el | 3 +++
3 files changed, 50 insertions(+), 0 deletions(-)
diff --git a/context-coloring.el b/context-coloring.el
index def509f..fc82548 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -662,6 +662,42 @@ no header, skip past the sexp at START."
(goto-char start)
(context-coloring-elisp-forward-sexp)))))))
+(defun context-coloring-elisp-colorize-defadvice ()
+ "Color the `defadvice' at point."
+ (let ((start (point)))
+ (context-coloring-elisp-colorize-scope
+ (lambda ()
+ (cond
+ ((context-coloring-elisp-identifier-p
(context-coloring-get-syntax-code))
+ ;; Color the advised function's name with the top-level color.
+ (context-coloring-colorize-region
+ (point)
+ (progn (forward-sexp)
+ (point))
+ 0)
+ (context-coloring-elisp-forward-sws)
+ (context-coloring-elisp-parse-header
+ (lambda ()
+ (let (syntax-code)
+ ;; Enter.
+ (forward-char)
+ (while (/= (setq syntax-code (context-coloring-get-syntax-code))
+ context-coloring-CLOSE-PARENTHESIS-CODE)
+ (cond
+ ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+ (context-coloring-elisp-parse-arglist))
+ (t
+ ;; Ignore artifacts.
+ (context-coloring-elisp-forward-sexp)))
+ (context-coloring-elisp-forward-sws))
+ ;; Exit.
+ (forward-char)))
+ start))
+ (t
+ ;; Skip it.
+ (goto-char start)
+ (context-coloring-elisp-forward-sexp)))))))
+
(defun context-coloring-elisp-colorize-lambda-like (callback)
"Color the lambda-like function at point, parsing the header
with CALLBACK."
@@ -831,6 +867,10 @@ with CALLBACK."
(goto-char start)
(context-coloring-elisp-colorize-dolist)
t)
+ ((string-equal "defadvice" name-string)
+ (goto-char start)
+ (context-coloring-elisp-colorize-defadvice)
+ t)
(t
nil)))))
;; Not a special form; just colorize the remaining region.
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 4393c74..56d072c 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -1077,6 +1077,13 @@ ssssssssssss0"))
111111 111
111111 0 1sss11")))
+(context-coloring-test-deftest-emacs-lisp defadvice
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+1111111111 0 1111111 111111 11111 111 111111111
+ 2222 222 122
+ 22 1 2221")))
+
(context-coloring-test-deftest-emacs-lisp lambda
(lambda ()
(context-coloring-test-assert-coloring "
diff --git a/test/fixtures/defadvice.el b/test/fixtures/defadvice.el
new file mode 100644
index 0000000..da1f0eb
--- /dev/null
+++ b/test/fixtures/defadvice.el
@@ -0,0 +1,3 @@
+(defadvice a (before advice first (b) activate)
+ (let ((c b))
+ (+ b c)))
