branch: master
commit 636e6b9e655724be822605cb2971a2110bbd215f
Author: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Commit: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Add elisp comments and strings support.
---
context-coloring.el | 22 ++++++-
test/context-coloring-test.el | 132 +++++++++++++++++++++++++----------------
test/fixtures/comment.el | 3 +
test/fixtures/string.el | 2 +
4 files changed, 104 insertions(+), 55 deletions(-)
diff --git a/context-coloring.el b/context-coloring.el
index d5da9da..92e4578 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -345,6 +345,10 @@ generated by `js2-mode'."
(or (= 2 syntax-code)
(= 3 syntax-code)))
+(defun context-coloring-forward-sws ()
+ "Move forward through whitespace and comments."
+ (while (forward-comment 1)))
+
(defun context-coloring-emacs-lisp-colorize ()
"Color the current buffer by parsing emacs lisp sexps."
(with-silent-modifications
@@ -395,6 +399,18 @@ generated by `js2-mode'."
(1+ token-pos))))
(cond
+ ;; Resolve invalid state
+ ((cond
+ ;; Inside string?
+ ((nth 3 ppss)
+ (skip-syntax-forward "^\"" end)
+ (forward-char)
+ t)
+ ;; Inside comment?
+ ((nth 4 ppss)
+ (skip-syntax-forward "^>" end) ; comment ender
+ t)))
+
;; Expression prefix
;; Has to come first in case of commas
((= 6 token-syntax-code)
@@ -426,7 +442,7 @@ generated by `js2-mode'."
((= 4 token-syntax-code)
(forward-char)
;; Lookahead for scopes / function calls
- (skip-syntax-forward " " end)
+ (context-coloring-forward-sws)
(setq child-0-pos (point))
(setq child-0-syntax (syntax-after child-0-pos))
(setq child-0-syntax-code (logand #xFFFF (car child-0-syntax)))
@@ -463,7 +479,7 @@ generated by `js2-mode'."
(goto-char child-0-end)
(when in-defun-p
;; Lookahead for defun name
- (skip-syntax-forward " " end)
+ (context-coloring-forward-sws)
(setq child-1-pos (point))
(setq child-1-syntax (syntax-after child-1-pos))
(setq child-1-syntax-code (logand #xFFFF (car child-1-syntax)))
@@ -475,7 +491,7 @@ generated by `js2-mode'."
(context-coloring-colorize-region child-1-pos child-1-end 0)
(goto-char child-1-end))))
;; Lookahead for parameters
- (skip-syntax-forward " " end)
+ (context-coloring-forward-sws)
(when (= 4 (logand #xFFFF (car (syntax-after (point)))))
(setq child-2-end (scan-sexps (point) 1))
(setq defun-arglist (read (buffer-substring-no-properties
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 95c52e0..192d2ef 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -44,13 +44,12 @@
(defun context-coloring-test-setup ()
"Prepare before all tests."
- (setq context-coloring-comments-and-strings nil))
+ (setq context-coloring-syntactic-comments nil)
+ (setq context-coloring-syntactic-strings nil))
(defun context-coloring-test-cleanup ()
"Cleanup after all tests."
- (setq context-coloring-comments-and-strings t)
- (setq context-coloring-syntactic-comments nil)
- (setq context-coloring-syntactic-strings nil)
+ (setq context-coloring-comments-and-strings nil)
(setq context-coloring-js-block-scopes nil)
(setq context-coloring-colorize-hook nil)
(setq context-coloring-check-scopifier-version-hook nil)
@@ -167,24 +166,22 @@ format."
',setup-function-name
(,function-name)))))
-(defmacro context-coloring-test-emacs-lisp-mode (fixture &rest body)
- "Use FIXTURE as the subject matter for test logic in BODY."
- `(context-coloring-test-with-fixture
- ,fixture
- (emacs-lisp-mode)
- (context-coloring-mode)
- ,@body))
-
-(defmacro context-coloring-test-deftest-emacs-lisp-mode (name &rest body)
+(cl-defmacro context-coloring-test-deftest-emacs-lisp-mode (name
+ body
+ &key setup)
"Define a test for `emacs-lisp-mode' with name and fixture as
-NAME, with BODY containing the assertions."
+NAME, with BODY containing the assertions, and SETUP defining the
+environment."
(declare (indent defun))
(let ((test-name (intern (format "context-coloring-emacs-lisp-mode-%s"
name)))
(fixture (format "./fixtures/%s.el" name)))
`(ert-deftest ,test-name ()
- (context-coloring-test-emacs-lisp-mode
+ (context-coloring-test-with-fixture
,fixture
- ,@body))))
+ (emacs-lisp-mode)
+ (when ,setup (funcall ,setup))
+ (context-coloring-mode)
+ (funcall ,body)))))
;;; Assertion functions
@@ -1008,46 +1005,77 @@ see that function."
(context-coloring-test-deftest-js2-mode unterminated-comment)
(context-coloring-test-deftest-emacs-lisp-mode defun
- (context-coloring-test-assert-region-level 1 8 1) ; (defun
- (context-coloring-test-assert-region-level 8 11 0) ; abc
- (context-coloring-test-assert-region-level 11 39 1) ; (def ghi &optional
jkl) (
- (context-coloring-test-assert-region-level 39 40 0) ; +
- (context-coloring-test-assert-region-level 40 53 1) ; def ghi jkl
- (context-coloring-test-assert-region-level 53 57 0) ; free
- (context-coloring-test-assert-region-level 57 59 1) ; ))
- (context-coloring-test-assert-region-level 61 72 0) ; (abc 1 2 3)
- (context-coloring-test-assert-region-level 74 81 1) ; (defun
- (context-coloring-test-assert-region-level 81 82 0) ; a
- (context-coloring-test-assert-region-level 82 83 1) ; )
- (context-coloring-test-assert-region-level 84 94 1)) ; (defun ())
+ (lambda ()
+ (context-coloring-test-assert-region-level 1 8 1) ; (defun
+ (context-coloring-test-assert-region-level 8 11 0) ; abc
+ (context-coloring-test-assert-region-level 11 39 1) ; (def ghi &optional
jkl) (
+ (context-coloring-test-assert-region-level 39 40 0) ; +
+ (context-coloring-test-assert-region-level 40 53 1) ; def ghi jkl
+ (context-coloring-test-assert-region-level 53 57 0) ; free
+ (context-coloring-test-assert-region-level 57 59 1) ; ))
+ (context-coloring-test-assert-region-level 61 72 0) ; (abc 1 2 3)
+ (context-coloring-test-assert-region-level 74 81 1) ; (defun
+ (context-coloring-test-assert-region-level 81 82 0) ; a
+ (context-coloring-test-assert-region-level 82 83 1) ; )
+ (context-coloring-test-assert-region-level 84 94 1) ; (defun ())
+ ))
(context-coloring-test-deftest-emacs-lisp-mode lambda
- (context-coloring-test-assert-region-level 1 10 0) ; (funcall
- (context-coloring-test-assert-region-level 10 35 1) ; (lambda (fn) (
- (context-coloring-test-assert-region-level 35 42 0) ; funcall
- (context-coloring-test-assert-region-level 42 46 1) ; fn
- (context-coloring-test-assert-region-level 46 85 2) ; (lambda (fn) (
- (context-coloring-test-assert-region-level 85 87 0) ; fn
- (context-coloring-test-assert-region-level 87 98 2) ; fn fn) fn)
- (context-coloring-test-assert-region-level 98 103 1) ; ) fn)
- (context-coloring-test-assert-region-level 103 106 0)) ; 0)
+ (lambda ()
+ (context-coloring-test-assert-region-level 1 10 0) ; (funcall
+ (context-coloring-test-assert-region-level 10 35 1) ; (lambda (fn) (
+ (context-coloring-test-assert-region-level 35 42 0) ; funcall
+ (context-coloring-test-assert-region-level 42 46 1) ; fn
+ (context-coloring-test-assert-region-level 46 85 2) ; (lambda (fn) (
+ (context-coloring-test-assert-region-level 85 87 0) ; fn
+ (context-coloring-test-assert-region-level 87 98 2) ; fn fn) fn)
+ (context-coloring-test-assert-region-level 98 103 1) ; ) fn)
+ (context-coloring-test-assert-region-level 103 106 0) ; 0)
+ ))
(context-coloring-test-deftest-emacs-lisp-mode quote
- (context-coloring-test-assert-region-level 26 28 1) ; 'b
- (context-coloring-test-assert-region-level 45 51 1) ; '(a b)
- (context-coloring-test-assert-region-level 68 72 1) ; `(,
- (context-coloring-test-assert-region-level 72 78 0) ; append
- (context-coloring-test-assert-region-level 78 90 1) ; () `(a b ,(
- (context-coloring-test-assert-region-level 90 91 0) ; +
- (context-coloring-test-assert-region-level 91 94 1) ; 1
- (context-coloring-test-assert-region-level 94 98 0) ; free
- (context-coloring-test-assert-region-level 98 101 1) ; ) ,
- (context-coloring-test-assert-region-level 101 105 0) ; free
- (context-coloring-test-assert-region-level 105 109 1) ; ) b)
- (context-coloring-test-assert-region-level 109 113 0) ; free
- (context-coloring-test-assert-region-level 113 118 1) ; ) b ,
- (context-coloring-test-assert-region-level 118 122 0) ; ) free
- (context-coloring-test-assert-region-level 122 126 1)) ; ))))
+ (lambda ()
+ (context-coloring-test-assert-region-level 26 28 1) ; 'b
+ (context-coloring-test-assert-region-level 45 51 1) ; '(a b)
+ (context-coloring-test-assert-region-level 68 72 1) ; `(,
+ (context-coloring-test-assert-region-level 72 78 0) ; append
+ (context-coloring-test-assert-region-level 78 90 1) ; () `(a b ,(
+ (context-coloring-test-assert-region-level 90 91 0) ; +
+ (context-coloring-test-assert-region-level 91 94 1) ; 1
+ (context-coloring-test-assert-region-level 94 98 0) ; free
+ (context-coloring-test-assert-region-level 98 101 1) ; ) ,
+ (context-coloring-test-assert-region-level 101 105 0) ; free
+ (context-coloring-test-assert-region-level 105 109 1) ; ) b)
+ (context-coloring-test-assert-region-level 109 113 0) ; free
+ (context-coloring-test-assert-region-level 113 118 1) ; ) b ,
+ (context-coloring-test-assert-region-level 118 122 0) ; ) free
+ (context-coloring-test-assert-region-level 122 126 1) ; ))))
+ ))
+
+(context-coloring-test-deftest-emacs-lisp-mode comment
+ (lambda ()
+ ;; Just check that the comment isn't parsed syntactically.
+ (context-coloring-test-assert-region-comment-delimiter 39 41) ; ;
+ (context-coloring-test-assert-region-comment 41 49) ; 96 = '`'
+ (context-coloring-test-assert-region-level 57 58 0) ; =
+ )
+ :setup (lambda ()
+ (setq context-coloring-syntactic-comments t)))
+
+(context-coloring-test-deftest-emacs-lisp-mode string
+ (lambda ()
+ ;; Ensure the string is evaded.
+ (context-coloring-test-assert-region-string 28 31) ; "("
+ (context-coloring-test-assert-region-level 32 33 1) ; a
+ (context-coloring-test-assert-region-level 34 35 0) ; b
+ (context-coloring-test-assert-region-string 36 41) ; "(\""
+ (context-coloring-test-assert-region-level 42 43 0) ; b
+ (context-coloring-test-assert-region-level 44 45 1) ; a
+ (context-coloring-test-assert-region-string 46 53) ; "(\"\""
+ (context-coloring-test-assert-region-level 53 55 1) ; ))
+ )
+ :setup (lambda ()
+ (setq context-coloring-syntactic-strings t)))
(provide 'context-coloring-test)
diff --git a/test/fixtures/comment.el b/test/fixtures/comment.el
new file mode 100644
index 0000000..c3ba432
--- /dev/null
+++ b/test/fixtures/comment.el
@@ -0,0 +1,3 @@
+(defun a ()
+ (or (= token-char 96) ; 96 = '`'
+ (= token-char 44))) ; 44 = ','
diff --git a/test/fixtures/string.el b/test/fixtures/string.el
new file mode 100644
index 0000000..4172642
--- /dev/null
+++ b/test/fixtures/string.el
@@ -0,0 +1,2 @@
+(defun a (a)
+ (concat a b "(" a b "(\"" b a "(\"\""))
