branch: master
commit 22403b7aef5a77897c5da3e0944dac6b32636bbb
Author: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Commit: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Cover parsing edge cases.
---
context-coloring.el | 48 ++++++++++++++++++-----------------------
test/context-coloring-test.el | 15 ++++++++++--
test/fixtures/defun.el | 1 +
test/fixtures/ignored.el | 2 +-
test/fixtures/let.el | 2 +-
test/fixtures/sexp.el | 4 +++
6 files changed, 40 insertions(+), 32 deletions(-)
diff --git a/context-coloring.el b/context-coloring.el
index 753f4ca..0d860ac 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -428,6 +428,11 @@ bound as variables.")
(defconst context-coloring-AT-CHAR (string-to-char "@"))
(defconst context-coloring-BACKTICK-CHAR (string-to-char "`"))
+(defsubst context-coloring-elisp-identifier-p (syntax-code)
+ "Check if SYNTAX-CODE is an emacs lisp identifier constituent."
+ (or (= syntax-code context-coloring-WORD-CODE)
+ (= syntax-code context-coloring-SYMBOL-CODE)))
+
(defvar context-coloring-parse-interruptable-p t
"Set this to nil to force parse to continue until finished.")
@@ -539,8 +544,7 @@ after its own initializer is parsed."
(forward-char)
(context-coloring-elisp-forward-sws)
(setq syntax-code (context-coloring-get-syntax-code))
- (when (or (= syntax-code context-coloring-WORD-CODE)
- (= syntax-code context-coloring-SYMBOL-CODE))
+ (when (context-coloring-elisp-identifier-p syntax-code)
(context-coloring-elisp-parse-bindable
(lambda (var)
(push var varlist)))
@@ -551,8 +555,7 @@ after its own initializer is parsed."
(context-coloring-elisp-forward-sws)
;; Skip past the closing parenthesis.
(forward-char))
- ((or (= syntax-code context-coloring-WORD-CODE)
- (= syntax-code context-coloring-SYMBOL-CODE))
+ ((context-coloring-elisp-identifier-p syntax-code)
(context-coloring-elisp-parse-bindable
(lambda (var)
(push var varlist))))
@@ -576,8 +579,7 @@ after its own initializer is parsed."
(while (/= (setq syntax-code (context-coloring-get-syntax-code))
context-coloring-CLOSE-PARENTHESIS-CODE)
(cond
- ((or (= syntax-code context-coloring-WORD-CODE)
- (= syntax-code context-coloring-SYMBOL-CODE))
+ ((context-coloring-elisp-identifier-p syntax-code)
(context-coloring-elisp-parse-bindable
(lambda (arg)
(context-coloring-elisp-add-variable arg))))
@@ -619,8 +621,7 @@ LET-TYPE can be one of `let' or `let*'."
;; Check for the defun's name.
(setq syntax-code (context-coloring-get-syntax-code))
(cond
- ((or (= syntax-code context-coloring-WORD-CODE)
- (= syntax-code context-coloring-SYMBOL-CODE))
+ ((context-coloring-elisp-identifier-p syntax-code)
;; Color the defun's name with the top-level color.
(setq defun-name-pos (point))
(forward-sexp)
@@ -721,8 +722,7 @@ LET-TYPE can be one of `let' or `let*'."
(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))
+ (when (context-coloring-elisp-identifier-p syntax-code)
(context-coloring-elisp-parse-bindable
(lambda (parsed-variable)
(setq variable parsed-variable)))
@@ -775,8 +775,7 @@ LET-TYPE can be one of `let' or `let*'."
(context-coloring-get-syntax-code))))
;; Figure out if the sexp is a special form.
(cond
- ((when (or (= syntax-code context-coloring-WORD-CODE)
- (= syntax-code context-coloring-SYMBOL-CODE))
+ ((when (context-coloring-elisp-identifier-p syntax-code)
(let ((name-string (buffer-substring-no-properties
(point)
(progn (forward-sexp)
@@ -878,29 +877,29 @@ point. It could be a quoted or backquoted expression."
(forward-sexp)
(context-coloring-colorize-comments-and-strings start (point))))
+;; Elisp has whitespace, words, symbols, open/close parenthesis, expression
+;; prefix, string quote, comment starters/enders and escape syntax classes
only.
+
(defun context-coloring-elisp-colorize-sexp ()
"Color the sexp at point."
(let ((syntax-code (context-coloring-get-syntax-code)))
(cond
((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
(context-coloring-elisp-colorize-parenthesized-sexp))
- ((or (= syntax-code context-coloring-WORD-CODE)
- (= syntax-code context-coloring-SYMBOL-CODE))
+ ((context-coloring-elisp-identifier-p syntax-code)
(context-coloring-elisp-colorize-symbol))
((= syntax-code context-coloring-EXPRESSION-PREFIX-CODE)
(context-coloring-elisp-colorize-expression-prefix))
((= syntax-code context-coloring-STRING-QUOTE-CODE)
(context-coloring-elisp-colorize-string))
((= syntax-code context-coloring-ESCAPE-CODE)
- (forward-char 2))
- (t
- (forward-char)))))
+ (forward-char 2)))))
(defun context-coloring-elisp-colorize-comments-and-strings-in-region (start
end)
"Color comments and strings between START and END."
(let (syntax-code)
(goto-char start)
- (while (> end (progn (skip-syntax-forward "^<\"\\" end)
+ (while (> end (progn (skip-syntax-forward "^\"<\\" end)
(point)))
(setq syntax-code (context-coloring-get-syntax-code))
(cond
@@ -909,22 +908,19 @@ point. It could be a quoted or backquoted expression."
((= syntax-code context-coloring-COMMENT-START-CODE)
(context-coloring-elisp-colorize-comment))
((= syntax-code context-coloring-ESCAPE-CODE)
- (forward-char 2))
- (t
- (forward-char))))))
+ (forward-char 2))))))
(defun context-coloring-elisp-colorize-region (start end)
"Color everything between START and END."
(let (syntax-code)
(goto-char start)
- (while (> end (progn (skip-syntax-forward "^()w_'<\"\\" end)
+ (while (> end (progn (skip-syntax-forward "^w_('\"<\\" end)
(point)))
(setq syntax-code (context-coloring-get-syntax-code))
(cond
((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
(context-coloring-elisp-colorize-parenthesized-sexp))
- ((or (= syntax-code context-coloring-WORD-CODE)
- (= syntax-code context-coloring-SYMBOL-CODE))
+ ((context-coloring-elisp-identifier-p syntax-code)
(context-coloring-elisp-colorize-symbol))
((= syntax-code context-coloring-EXPRESSION-PREFIX-CODE)
(context-coloring-elisp-colorize-expression-prefix))
@@ -933,9 +929,7 @@ point. It could be a quoted or backquoted expression."
((= syntax-code context-coloring-COMMENT-START-CODE)
(context-coloring-elisp-colorize-comment))
((= syntax-code context-coloring-ESCAPE-CODE)
- (forward-char 2))
- (t
- (forward-char))))))
+ (forward-char 2))))))
(defun context-coloring-elisp-colorize-region-initially (start end)
"Begin coloring everything between START and END."
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 500f57e..0d226ba 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -1073,7 +1073,8 @@ ssssssssssss0"))
0000 0 0 00
111111 01
-111111 111")))
+111111 111
+111111 0 1sss11")))
(context-coloring-test-deftest-emacs-lisp lambda
(lambda ()
@@ -1122,7 +1123,15 @@ ssssssssssss0"))
(lambda ()
(context-coloring-test-assert-coloring "
(xxxxx x ()
- (x x 1 11 11 111 111 11 1 111 (1 1 1)))")))
+ (x x 1 11 11 111 111 11 11 1 111 (1 1 1)))")))
+
+(context-coloring-test-deftest-emacs-lisp sexp
+ (lambda ()
+ (context-coloring-test-assert-coloring "
+(xxx ()
+ `,@sss
+ `,@11
+ `,@11)")))
(context-coloring-test-deftest-emacs-lisp let
(lambda ()
@@ -1137,7 +1146,7 @@ ssssssssssss0"))
1111 1 1 1 000011
1111 cc ccccccc
- 111 sss11")))
+ 1sss11")))
(context-coloring-test-deftest-emacs-lisp let*
(lambda ()
diff --git a/test/fixtures/defun.el b/test/fixtures/defun.el
index a5bd039..10a52f6 100644
--- a/test/fixtures/defun.el
+++ b/test/fixtures/defun.el
@@ -5,3 +5,4 @@
(defun a)
(defun ())
+(defun b ("a"))
diff --git a/test/fixtures/ignored.el b/test/fixtures/ignored.el
index 748b970..ce7774e 100644
--- a/test/fixtures/ignored.el
+++ b/test/fixtures/ignored.el
@@ -1,2 +1,2 @@
(defun a ()
- (+ a 1 +1 -1 1.0 #x0 :a t nil (0 . 0)))
+ (+ a 1 +1 -1 1.0 #x0 \a :a t nil (0 . 0)))
diff --git a/test/fixtures/let.el b/test/fixtures/let.el
index 85bf90e..04fc039 100644
--- a/test/fixtures/let.el
+++ b/test/fixtures/let.el
@@ -8,4 +8,4 @@
(and a b c free))
(let ;; comment
- (_a "s"))
+ ("s"))
diff --git a/test/fixtures/sexp.el b/test/fixtures/sexp.el
new file mode 100644
index 0000000..438dc02
--- /dev/null
+++ b/test/fixtures/sexp.el
@@ -0,0 +1,4 @@
+(let ()
+ `,@"a"
+ `,@'b
+ `,@\c)
