branch: master
commit c2834f0b4af70230021a998967e4bdf69f9799aa
Author: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Commit: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
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)))
