[elpa] master c2834f0 51/79: Add condition-case support.

[Jackson Ray Hamilton]

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

    Add condition-case support.
---
 context-coloring.el             |   80 ++++++++++++++++++++++++++++++++++++--
 test/context-coloring-test.el   |   12 ++++++
 test/fixtures/condition-case.el |    8 ++++
 3 files changed, 95 insertions(+), 5 deletions(-)

diff --git a/context-coloring.el b/context-coloring.el
index 104964c..de22014 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -307,8 +307,10 @@ them along the way."
    '("defun" "defun*" "defsubst" "defmacro"
      "cl-defun" "cl-defsubst" "cl-defmacro")))
 
-(defconst context-coloring-elisp-arglist-arg-regexp
-  "\\`[^&:]")
+(defconst context-coloring-elisp-condition-case-regexp
+  (context-coloring-exact-or-regexp
+   '("condition-case"
+     "condition-case-unless-debug")))
 
 (defconst context-coloring-ignored-word-regexp
   (context-coloring-join (list "\\`[-+]?[0-9]"
@@ -412,9 +414,9 @@ provide visually \"instant\" updates at 60 frames per 
second.")
                       (point)
                       (progn (forward-sexp)
                              (point)))))
-    (when (string-match-p
-           context-coloring-elisp-arglist-arg-regexp
-           arg-string)
+    (when (not (string-match-p
+                context-coloring-ignored-word-regexp
+                arg-string))
       (funcall callback arg-string))))
 
 ;; TODO: These seem to spiral into an infinite loop sometimes.
@@ -572,6 +574,70 @@ provide visually \"instant\" updates at 60 frames per 
second.")
     ;; Exit.
     (forward-char)))
 
+(defun context-coloring-elisp-colorize-condition-case ()
+  (let ((start (point))
+        end
+        syntax-code
+        variable
+        case-pos
+        case-end)
+    (context-coloring-elisp-push-scope)
+    ;; Color the whole sexp.
+    (forward-sexp)
+    (setq end (point))
+    (context-coloring-colorize-region
+     start
+     end
+     (context-coloring-elisp-current-scope-level))
+    (goto-char start)
+    ;; Enter.
+    (forward-char)
+    (context-coloring-elisp-forward-sws)
+    ;; Skip past the "condition-case".
+    (forward-sexp)
+    (context-coloring-elisp-forward-sws)
+    (setq syntax-code (context-coloring-get-syntax-code))
+    ;; Gracefully ignore missing variables.
+    (when (or (= syntax-code context-coloring-WORD-CODE)
+              (= syntax-code context-coloring-SYMBOL-CODE))
+      (context-coloring-elisp-parse-arg
+       (lambda (parsed-variable)
+         (setq variable parsed-variable)))
+      (context-coloring-elisp-forward-sws))
+    (context-coloring-elisp-colorize-sexp)
+    (context-coloring-elisp-forward-sws)
+    ;; Parse the handlers with the error variable in scope.
+    (when variable
+      (context-coloring-elisp-add-variable variable))
+    (while (/= (setq syntax-code (context-coloring-get-syntax-code))
+               context-coloring-CLOSE-PARENTHESIS-CODE)
+      (cond
+       ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+        (setq case-pos (point))
+        (forward-sexp)
+        (setq case-end (point))
+        (goto-char case-pos)
+        ;; Enter.
+        (forward-char)
+        (context-coloring-elisp-forward-sws)
+        (setq syntax-code (context-coloring-get-syntax-code))
+        (when (/= syntax-code context-coloring-CLOSE-PARENTHESIS-CODE)
+          ;; Skip the condition name(s).
+          (forward-sexp)
+          ;; Color the remaining portion of the handler.
+          (context-coloring-elisp-colorize-region
+           (point)
+           (1- case-end)))
+        ;; Exit.
+        (forward-char))
+       (t
+        ;; Ignore artifacts.
+        (forward-sexp)))
+      (context-coloring-elisp-forward-sws))
+    ;; Exit.
+    (forward-char)
+    (context-coloring-elisp-pop-scope)))
+
 (defun context-coloring-elisp-colorize-parenthesized-sexp ()
   (context-coloring-elisp-increment-sexp-count)
   (let* ((start (point))
@@ -610,6 +676,10 @@ provide visually \"instant\" updates at 60 frames per 
second.")
             (goto-char start)
             (context-coloring-elisp-colorize-cond)
             t)
+           ((string-match-p context-coloring-elisp-condition-case-regexp 
name-string)
+            (goto-char start)
+            (context-coloring-elisp-colorize-condition-case)
+            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 d877d49..2cfd64a 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -1164,6 +1164,18 @@ ssssssssssss0"))
    cc c
    sss1)")))
 
+(context-coloring-test-deftest-emacs-lisp condition-case
+  (lambda ()
+    (context-coloring-test-assert-coloring "
+1111111111-1111 111
+    111111 000 00001
+  111111 111 00001
+  1111111 111111 111 000011
+
+(111111111-1111-111111-11111 111
+    (xxx () 222)
+  (11111 (xxx () 222)))")))
+
 (defun context-coloring-test-insert-unread-space ()
   "Simulate the insertion of a space as if by a user."
   (setq unread-command-events (cons '(t . 32)
diff --git a/test/fixtures/condition-case.el b/test/fixtures/condition-case.el
new file mode 100644
index 0000000..bdbca7e
--- /dev/null
+++ b/test/fixtures/condition-case.el
@@ -0,0 +1,8 @@
+(condition-case err
+    (progn err free)
+  (error err free)
+  ((debug error) err free))
+
+(condition-case-unless-debug nil
+    (let () nil)
+  (error (let () nil)))