]> code.delx.au - gnu-emacs-elpa/commitdiff
Add condition-case support.
authorJackson Ray Hamilton <jackson@jacksonrayhamilton.com>
Sat, 6 Jun 2015 21:16:45 +0000 (14:16 -0700)
committerJackson Ray Hamilton <jackson@jacksonrayhamilton.com>
Sat, 6 Jun 2015 21:16:45 +0000 (14:16 -0700)
context-coloring.el
test/context-coloring-test.el
test/fixtures/condition-case.el [new file with mode: 0644]

index 104964c66acb07d468ba527a1b425cb2a0c1ff05..de220142012d94fa6d0273b581279498506e86c1 100644 (file)
@@ -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.
index d877d49e77ca74eaa46acd36aa8a232855806bc9..2cfd64aa2b3948b157b62fdc8bac0c740d310f4b 100644 (file)
@@ -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 (file)
index 0000000..bdbca7e
--- /dev/null
@@ -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)))