[elpa] master 62506ae 06/47: Add quote and number coloring.

[Jackson Ray Hamilton]

branch: master
commit 62506ae9653eae070b1e329be2b7fc7a32572fbb
Author: Jackson Ray Hamilton <address@hidden>
Commit: Jackson Ray Hamilton <address@hidden>

    Add quote and number coloring.
---
 context-coloring.el           |   80 ++++++++++++++++++++++++++++++++++------
 test/context-coloring-test.el |   17 +++++++++
 test/fixtures/quote.el        |    4 ++
 3 files changed, 89 insertions(+), 12 deletions(-)

diff --git a/context-coloring.el b/context-coloring.el
index 5f443dd..d5da9da 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -327,6 +327,20 @@ generated by `js2-mode'."
     ;; Assume global
     (or level 0)))
 
+(defun context-coloring-make-backtick (end enabled)
+  (list
+   :end end
+   :enabled enabled))
+
+(defun context-coloring-backtick-get-end (backtick)
+  (plist-get backtick :end))
+
+(defun context-coloring-backtick-get-enabled (backtick)
+  (plist-get backtick :enabled))
+
+(defun context-coloring-backtick-enabled-p (backtick-stack)
+  (context-coloring-backtick-get-enabled (car backtick-stack)))
+
 (defun context-coloring-emacs-lisp-identifier-syntax-p (syntax-code)
   (or (= 2 syntax-code)
       (= 3 syntax-code)))
@@ -342,6 +356,7 @@ generated by `js2-mode'."
              (last-ppss-pos (point))
              (ppss (syntax-ppss))
              (scope-stack `(,(context-coloring-make-scope -1 0))) ; -1 never 
matches a depth
+             (backtick-stack `(,(context-coloring-make-backtick -1 nil)))
              one-word-found-p
              in-defun-p
              in-lambda-p
@@ -355,6 +370,7 @@ generated by `js2-mode'."
              token-pos
              token-syntax
              token-syntax-code
+             token-char
              child-0-pos
              child-0-end
              child-0-syntax
@@ -365,7 +381,7 @@ generated by `js2-mode'."
              child-1-syntax
              child-1-syntax-code
              child-2-end)
-        (while (> end (progn (skip-syntax-forward "^()w_" end)
+        (while (> end (progn (skip-syntax-forward "^()w_'" end)
                              (point)))
           (setq token-pos (point))
           (setq token-syntax (syntax-after token-pos))
@@ -374,7 +390,38 @@ generated by `js2-mode'."
           ;; `skip-syntax-forward' leaves the point at the delimiter, move past
           ;; it.
           (setq token-syntax-code (logand #xFFFF (car token-syntax)))
+          (setq token-char (string-to-char (buffer-substring-no-properties
+                                            token-pos
+                                            (1+ token-pos))))
           (cond
+
+           ;; Expression prefix
+           ;; Has to come first in case of commas
+           ((= 6 token-syntax-code)
+            (forward-char)
+            (cond
+             ;; Just outright skip top-level symbols
+             ((not (or (cadr backtick-stack)
+                       (= token-char 96))) ; 96 = '`'
+              (goto-char (scan-sexps (point) 1)))
+             ((or (= token-char 96)  ; 96 = '`'
+                  (= token-char 44)) ; 44 = ','
+              ;; Have to manage backticks
+              (setq backtick-stack (cons (context-coloring-make-backtick
+                                          (scan-sexps (point) 1) ; End of the 
backtick
+                                          (= token-char 96)) ; 96 = '`'
+                                         backtick-stack)))))
+
+           ;; End backtick
+           ((and (cadr backtick-stack)
+                 (>= (point) (context-coloring-backtick-get-end (car 
backtick-stack))))
+            (setq backtick-stack (cdr backtick-stack)))
+
+           ;; Restricted by backtick
+           ((and (cadr backtick-stack)
+                 (context-coloring-backtick-enabled-p backtick-stack))
+            (forward-char))
+
            ;; Opening delimiter
            ((= 4 token-syntax-code)
             (forward-char)
@@ -455,30 +502,39 @@ generated by `js2-mode'."
                            (1+ token-pos))))))
             ;; Cleanup
             (setq one-word-found-p nil))
+
            ;; Word (variable)
            ((context-coloring-emacs-lisp-identifier-syntax-p token-syntax-code)
             (setq variable-end (scan-sexps (point) 1))
             (setq variable-string (buffer-substring-no-properties
                                    token-pos
                                    variable-end))
-            (setq variable (intern variable-string))
-            (setq variable-scope-level
-                  (context-coloring-get-variable-level scope-stack variable))
-            (when (/= variable-scope-level (context-coloring-scope-get-level
-                                            (car scope-stack)))
-              (context-coloring-colorize-region
-               token-pos
-               variable-end
-               variable-scope-level))
+            (cond
+             ;; Ignore numbers
+             ((string-match-p "\\`[-+]?[0-9]" variable-string))
+             (t
+              (setq variable (intern variable-string))
+              (setq variable-scope-level
+                    (context-coloring-get-variable-level scope-stack variable))
+              (when (/= variable-scope-level (context-coloring-scope-get-level
+                                              (car scope-stack)))
+                (context-coloring-colorize-region
+                 token-pos
+                 variable-end
+                 variable-scope-level))))
             (goto-char variable-end))
+
            ;; Closing delimiter
-           (t
+           ((= 5 token-syntax-code)
             (forward-char)
             ;; End scope
             (setq ppss (parse-partial-sexp last-ppss-pos (point) nil nil ppss))
             (setq last-ppss-pos (point))
             (when (= (nth 0 ppss) (context-coloring-scope-get-depth (car 
scope-stack)))
-              (setq scope-stack (cdr scope-stack))))))))))
+              (setq scope-stack (cdr scope-stack))))
+
+           ))))
+    (context-coloring-maybe-colorize-comments-and-strings)))
 
 
 ;;; Shell command scopification / colorization
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 1c2147a..95c52e0 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -1032,6 +1032,23 @@ see that function."
   (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)) ; ))))
+
 (provide 'context-coloring-test)
 
 ;;; context-coloring-test.el ends here
diff --git a/test/fixtures/quote.el b/test/fixtures/quote.el
new file mode 100644
index 0000000..654bc70
--- /dev/null
+++ b/test/fixtures/quote.el
@@ -0,0 +1,4 @@
+(defun a (a)
+  (or (eq a 'b)
+      (equal a '(a b))
+      (equal a `(,(append () `(a b ,(+ 1 free) ,free b) free) b ,free))))