branch: master
commit ea3ff31c6c4183828b15d818a016d95bb8b58d24
Author: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Commit: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Pass let* test.
---
context-coloring.el | 148 ++++++++++++++++++++++++++++++++++++++------------
1 files changed, 112 insertions(+), 36 deletions(-)
diff --git a/context-coloring.el b/context-coloring.el
index 9e1e1ed..4a37389 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -341,6 +341,36 @@ 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-varlist (depth type)
+ (list
+ :depth depth
+ :type type
+ :vars '()))
+
+(defun context-coloring-let-varlist-get-depth (let-varlist)
+ (plist-get let-varlist :depth))
+
+(defun context-coloring-let-varlist-get-type (let-varlist)
+ (plist-get let-varlist :type))
+
+(defun context-coloring-let-varlist-add-var (let-varlist var)
+ (plist-put let-varlist :vars (cons var (plist-get let-varlist :vars))))
+
+(defun context-coloring-let-varlist-pop-vars (let-varlist)
+ (let ((type (context-coloring-let-varlist-get-type let-varlist))
+ (vars (plist-get let-varlist :vars)))
+ (cond
+ ;; `let' binds all at once at the end.
+ ((eq type 'let)
+ (prog1
+ vars
+ (plist-put let-varlist :vars '())))
+ ;; `let*' binds incrementally.
+ ((eq type 'let*)
+ (prog1
+ (list (car vars))
+ (plist-put let-varlist :vars (cdr vars)))))))
+
(defun context-coloring-forward-sws ()
"Move forward through whitespace and comments."
(while (forward-comment 1)))
@@ -368,6 +398,9 @@ generated by `js2-mode'."
;; Same as (nth 0 ppss).
(car ppss))
+(defun context-coloring-stack-depth-equal (stack depth)
+ (= (plist-get (car stack) :depth) depth))
+
(defconst context-coloring-defun-regexp
"\\`defun\\'\\|\\`defmacro\\'\\|\\`defsubst\\'")
@@ -390,9 +423,13 @@ generated by `js2-mode'."
(end (point-max))
(last-ppss-pos (point))
(ppss (syntax-ppss))
- ; -1 never matches a depth. This is a minor optimization.
+ ppss-depth
+ ;; -1 never matches a depth. This is a minor optimization.
(scope-stack `(,(context-coloring-make-scope -1 0)))
(backtick-stack '())
+ (let-varlist-stack '())
+ (let-var-stack '())
+ popped-vars
one-word-found-p
in-defun-p
in-lambda-p
@@ -401,7 +438,7 @@ generated by `js2-mode'."
defun-arglist
defun-arg
let-varlist
- let-var
+ let-varlist-type
variable
variable-end
variable-string
@@ -481,14 +518,28 @@ 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
+ ;; Parse a var in a `let' varlist.
+ ((and
+ let-varlist-stack
+ (context-coloring-stack-depth-equal
+ let-varlist-stack
+ ;; 1- because we're inside the varlist.
+ (1- (context-coloring-ppss-depth ppss))))
+ (context-coloring-let-varlist-add-var
+ (car let-varlist-stack)
+ (intern child-0-string))
+ (setq let-var-stack (cons (context-coloring-ppss-depth ppss)
+ let-var-stack)))
((string-match-p context-coloring-defun-regexp child-0-string)
(setq in-defun-p t))
((string-match-p "\\`lambda\\'" child-0-string)
(setq in-lambda-p t))
((string-match-p "\\`let\\'" child-0-string)
- (setq in-let-p t))
+ (setq in-let-p t)
+ (setq let-varlist-type 'let))
((string-match-p "\\`let\\*\\'" child-0-string)
- (setq in-let*-p t)))))
+ (setq in-let*-p t)
+ (setq let-varlist-type 'let*)))))
(when (or in-defun-p
in-lambda-p
in-let-p
@@ -544,31 +595,20 @@ generated by `js2-mode'."
((or in-let-p
in-let*-p)
(goto-char child-0-end)
- ;; Look for bindings.
+ ;; Look for a varlist.
(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 (context-coloring-forward-sexp-position))
- (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))
+ (when (context-coloring-open-parenthesis-p child-1-syntax-code)
+ ;; Begin parsing the varlist.
+ (forward-char)
+ (setq let-varlist-stack (cons
(context-coloring-make-let-varlist
+ ;; 1+ because we parsed it at a
+ ;; higher depth.
+ (1+
(context-coloring-ppss-depth ppss))
+ let-varlist-type)
+ let-varlist-stack)))
;; Cleanup.
(setq in-let-p nil)
(setq in-let*-p nil))
@@ -594,23 +634,59 @@ generated by `js2-mode'."
((keywordp (read 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))))
+ (cond
+ ;; Parse a `let' varlist's uninitialized var.
+ ((and
+ let-varlist-stack
+ (context-coloring-stack-depth-equal
+ let-varlist-stack
+ ;; 1- because we're inside the varlist.
+ (1- (context-coloring-ppss-depth ppss))))
+ (setq let-varlist (car let-varlist-stack))
+ (setq let-varlist-type (context-coloring-let-varlist-get-type
let-varlist))
+ (cond
+ ;; Defer `let' binding until the end of the varlist.
+ ((eq let-varlist-type 'let)
+ (context-coloring-let-varlist-add-var let-varlist variable))
+ ;; Bind a `let*' right away.
+ ((eq let-varlist-type 'let*)
+ (context-coloring-scope-add-variable (car scope-stack)
variable))))
+ (t
+ (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))
((context-coloring-close-parenthesis-p token-syntax-code)
(forward-char)
(setq ppss (parse-partial-sexp last-ppss-pos (point) nil nil ppss))
(setq last-ppss-pos (point))
- (when (= (context-coloring-ppss-depth ppss)
- (context-coloring-scope-get-depth (car scope-stack)))
- (setq scope-stack (cdr scope-stack))))
+ (setq ppss-depth (context-coloring-ppss-depth ppss))
+ ;; TODO: Order might matter here but I'm not certain.
+ (when (context-coloring-stack-depth-equal scope-stack ppss-depth)
+ (setq scope-stack (cdr scope-stack)))
+ (when (and
+ let-var-stack
+ (= (car let-var-stack) ppss-depth))
+ (setq let-var-stack (cdr let-var-stack))
+ (when (eq (context-coloring-let-varlist-get-type (car
let-varlist-stack))
+ 'let*)
+ (setq popped-vars (context-coloring-let-varlist-pop-vars
+ (car let-varlist-stack)))))
+ (when (and
+ let-varlist-stack
+ (context-coloring-stack-depth-equal let-varlist-stack
ppss-depth))
+ (setq popped-vars (context-coloring-let-varlist-pop-vars
+ (car let-varlist-stack)))
+ (setq let-varlist-stack (cdr let-varlist-stack)))
+ (while popped-vars
+ (context-coloring-scope-add-variable (car scope-stack) (car
popped-vars))
+ (setq popped-vars (cdr popped-vars))))
))))
(context-coloring-maybe-colorize-comments-and-strings)))
