Add non-recursive let* coloring.

[gnu-emacs-elpa] / context-coloring.el

diff --git a/context-coloring.el b/context-coloring.el
index 3bd2b0fdfd4470e9dac24604ebcb321085a7d099..3a57b3f1d5de5f0087a646b024bf47ba3898e053 100644 (file)
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -341,6 +341,13 @@ generated by `js2-mode'."
 (defun context-coloring-backtick-enabled-p (backtick-stack)
   (context-coloring-backtick-get-enabled (car backtick-stack)))
 
+(defun context-coloring-make-let-value (end)
+  (list
+   :end end))
+
+(defun context-coloring-let-value-get-end (let-value)
+  (plist-get let-value :end))
+
 (defun context-coloring-emacs-lisp-identifier-syntax-p (syntax-code)
   (or (= 2 syntax-code)
       (= 3 syntax-code)))
@@ -349,6 +356,9 @@ generated by `js2-mode'."
   "Move forward through whitespace and comments."
   (while (forward-comment 1)))
 
+(defun context-coloring-at-open-parenthesis ()
+  (= 4 (logand #xFFFF (car (syntax-after (point))))))
+
 (defun context-coloring-emacs-lisp-colorize ()
   "Color the current buffer by parsing emacs lisp sexps."
   (with-silent-modifications
@@ -361,12 +371,16 @@ generated by `js2-mode'."
              (ppss (syntax-ppss))
              (scope-stack `(,(context-coloring-make-scope -1 0))) ; -1 never matches a depth
              (backtick-stack `(,(context-coloring-make-backtick -1 nil)))
+             (let-value-stack `(,(context-coloring-make-let-value -1)))
              one-word-found-p
              in-defun-p
              in-lambda-p
+             in-let*-p
              function-call-p
              defun-arglist
              defun-arg
+             let-varlist
+             let-var
              variable
              variable-end
              variable-string
@@ -453,14 +467,18 @@ generated by `js2-mode'."
               (setq child-0-end (scan-sexps child-0-pos 1))
               (setq child-0-string (buffer-substring-no-properties child-0-pos child-0-end))
               (cond
-               ((string-match-p "defun\\|defmacro" child-0-string)
+               ((string-match-p "\\`defun\\'\\|\\`defmacro\\'" child-0-string)
                 (setq in-defun-p t))
-               ((string-match-p "lambda" child-0-string)
+               ((string-match-p "\\`lambda\\'" child-0-string)
                 (setq in-lambda-p t))
+               ((string-match-p "\\`let\\*\\'" child-0-string)
+                (setq in-let*-p t))
                ;; Assume a global function call
                (t
                 (setq function-call-p t)))))
-            (when (or in-defun-p in-lambda-p)
+            (when (or in-defun-p
+                      in-lambda-p
+                      in-let*-p)
               (setq scope-stack (cons (context-coloring-make-scope
                                        (nth 0 ppss)
                                        (1+ (context-coloring-scope-get-level
@@ -475,7 +493,8 @@ generated by `js2-mode'."
               (context-coloring-colorize-region child-0-pos child-0-end 0)
               (setq function-call-p nil))
             (cond
-             ((or in-defun-p in-lambda-p)
+             ((or in-defun-p
+                  in-lambda-p)
               (goto-char child-0-end)
               (when in-defun-p
                 ;; Lookahead for defun name
@@ -492,7 +511,8 @@ generated by `js2-mode'."
                   (goto-char child-1-end))))
               ;; Lookahead for parameters
               (context-coloring-forward-sws)
-              (when (= 4 (logand #xFFFF (car (syntax-after (point)))))
+              (when (context-coloring-at-open-parenthesis)
+                ;; Actually it should be `child-1-end' for `lambda'.
                 (setq child-2-end (scan-sexps (point) 1))
                 (setq defun-arglist (read (buffer-substring-no-properties
                                            (point)
@@ -509,6 +529,35 @@ generated by `js2-mode'."
               ;; Cleanup
               (setq in-defun-p nil)
               (setq in-lambda-p nil))
+             (in-let*-p
+              (goto-char child-0-end)
+              ;; Lookahead for bindings
+              (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)))
+              (when (= 4 child-1-syntax-code)
+                (setq child-1-end (scan-sexps (point) 1))
+                (setq let-varlist (read (buffer-substring-no-properties
+                                         (point)
+                                         child-1-end)))
+                (while let-varlist
+                  (setq let-var (car let-varlist))
+                  (cond
+                   ((symbolp let-var)
+                    (context-coloring-scope-add-variable
+                     (car scope-stack)
+                     let-var))
+                   ((listp let-var)
+                    (context-coloring-scope-add-variable
+                     (car scope-stack)
+                     (car let-var))
+                    ;; TODO: Recurse or use stack to eval var value
+                    ))
+                  (setq let-varlist (cdr let-varlist)))
+                (goto-char child-1-end))
+              ;; Cleanup
+              (setq in-let*-p nil))
              (t
               (goto-char (cond
                           ;; If there was a word, continue parsing after it.