[elpa] master 306335e 71/79: Add defadvice support.

[Jackson Ray Hamilton]

branch: master
commit 306335e9b29594c43b8b9b7be703f55cfb24845a
Author: Jackson Ray Hamilton <address@hidden>
Commit: Jackson Ray Hamilton <address@hidden>

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