[elpa] master 636e6b9 07/47: Add elisp comments and strings support.

[Jackson Ray Hamilton]

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

    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 "(\"\""))