X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/98af8234e926e2de8910d42dae550ef2626a9289..1d9cd5e3ac710dafea67fa8a86054b43317845b8:/packages/context-coloring/context-coloring.el

diff --git a/packages/context-coloring/context-coloring.el b/packages/context-coloring/context-coloring.el
index cd1b97a50..cb74ee74e 100644
--- a/packages/context-coloring/context-coloring.el
+++ b/packages/context-coloring/context-coloring.el
@@ -1,12 +1,12 @@
-;;; context-coloring.el --- Syntax highlighting, except not for syntax. -*- lexical-binding: t; -*-
+;;; context-coloring.el --- Highlight by scope  -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2014-2015  Free Software Foundation, Inc.
 
 ;; Author: Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
-;; URL: https://github.com/jacksonrayhamilton/context-coloring
-;; Keywords: context coloring syntax highlighting
-;; Version: 6.2.0
+;; Version: 6.3.0
+;; Keywords: convenience faces tools
 ;; Package-Requires: ((emacs "24") (js2-mode "20150126"))
+;; URL: https://github.com/jacksonrayhamilton/context-coloring
 
 ;; This file is part of GNU Emacs.
 
@@ -25,49 +25,40 @@
 
 ;;; Commentary:
 
-;; Highlights code according to function context.
-
-;; - Code in the global scope is one color.  Code in functions within the global
-;;   scope is a different color, and code within such functions is another
-;;   color, and so on.
-;; - Identifiers retain the color of the scope in which they are declared.
-
-;; Lexical scope information at-a-glance can assist a programmer in
-;; understanding the overall structure of a program.  It can help to curb nasty
-;; bugs like name shadowing.  A rainbow can indicate excessive complexity.
-;; State change within a closure is easily monitored.
-
-;; By default, Context Coloring still highlights comments and strings
-;; syntactically.  It is still easy to differentiate code from non-code, and
-;; strings cannot be confused for variables.
-
-;; To use, add the following to your ~/.emacs:
-
-;; (require 'context-coloring)
-;; (add-hook 'js2-mode-hook 'context-coloring-mode)
-
-;; js-mode or js3-mode support requires Node.js 0.10+ and the scopifier
-;; executable.
+;; Highlights code by scope.  Top-level scopes are one color, second-level
+;; scopes are another color, and so on.  Variables retain the color of the scope
+;; in which they are defined.  A variable defined in an outer scope referenced
+;; by an inner scope is colored the same as the outer scope.
 
-;; $ npm install -g scopifier
+;; By default, comments and strings are still highlighted syntactically.
 
 ;;; Code:
 
 (require 'js2-mode)
 
 
-;;; Local variables
-
-(defvar-local context-coloring-buffer nil
-  "Reference to this buffer (for timers).")
-
-
 ;;; Utilities
 
 (defun context-coloring-join (strings delimiter)
   "Join a list of STRINGS with the string DELIMITER."
   (mapconcat 'identity strings delimiter))
 
+(defsubst context-coloring-trim-right (string)
+  "Remove leading whitespace from STRING."
+  (if (string-match "[ \t\n\r]+\\'" string)
+      (replace-match "" t t string)
+    string))
+
+(defsubst context-coloring-trim-left (string)
+  "Remove trailing whitespace from STRING."
+  (if (string-match "\\`[ \t\n\r]+" string)
+      (replace-match "" t t string)
+    string))
+
+(defsubst context-coloring-trim (string)
+  "Remove leading and trailing whitespace from STRING."
+  (context-coloring-trim-left (context-coloring-trim-right string)))
+
 
 ;;; Faces
 
@@ -89,12 +80,12 @@ backgrounds."
   (context-coloring-defface level nil "#3f3f3f" "#cdcdcd"))
 
 (context-coloring-defface 0 nil       "#000000" "#ffffff")
-(context-coloring-defface 1 "yellow"  "#007f80" "#ffff80")
-(context-coloring-defface 2 "green"   "#001580" "#cdfacd")
-(context-coloring-defface 3 "cyan"    "#550080" "#d8d8ff")
-(context-coloring-defface 4 "blue"    "#802b00" "#e7c7ff")
-(context-coloring-defface 5 "magenta" "#6a8000" "#ffcdcd")
-(context-coloring-defface 6 "red"     "#008000" "#ffe390")
+(context-coloring-defface 1 "yellow"  "#008b8b" "#00ffff")
+(context-coloring-defface 2 "green"   "#0000ff" "#87cefa")
+(context-coloring-defface 3 "cyan"    "#483d8b" "#b0c4de")
+(context-coloring-defface 4 "blue"    "#a020f0" "#eedd82")
+(context-coloring-defface 5 "magenta" "#a0522d" "#98fb98")
+(context-coloring-defface 6 "red"     "#228b22" "#7fffd4")
 (context-coloring-defface-neutral 7)
 
 (defvar context-coloring-maximum-face nil
@@ -165,29 +156,29 @@ the END point (exclusive) with the face corresponding to LEVEL."
   "Tell `font-lock' to color a string but not a comment."
   (if (nth 3 state) font-lock-string-face nil))
 
-(defsubst context-coloring-maybe-colorize-comments-and-strings ()
+(defsubst context-coloring-maybe-colorize-comments-and-strings (&optional min max)
   "Color the current buffer's comments and strings if
 `context-coloring-comments-and-strings' is non-nil."
   (when (or context-coloring-comments-and-strings
             context-coloring-syntactic-comments
             context-coloring-syntactic-strings)
-    (let ((old-function font-lock-syntactic-face-function)
-          saved-function-p)
-      (cond
-       ((and context-coloring-syntactic-comments
-             (not context-coloring-syntactic-strings))
-        (setq font-lock-syntactic-face-function
-              'context-coloring-font-lock-syntactic-comment-function)
-        (setq saved-function-p t))
-       ((and context-coloring-syntactic-strings
-             (not context-coloring-syntactic-comments))
-        (setq font-lock-syntactic-face-function
-              'context-coloring-font-lock-syntactic-string-function)
-        (setq saved-function-p t)))
+    (let ((min (or min (point-min)))
+          (max (or max (point-max)))
+          (font-lock-syntactic-face-function
+           (cond
+            ((and context-coloring-syntactic-comments
+                  (not context-coloring-syntactic-strings))
+             'context-coloring-font-lock-syntactic-comment-function)
+            ((and context-coloring-syntactic-strings
+                  (not context-coloring-syntactic-comments))
+             'context-coloring-font-lock-syntactic-string-function)
+            (t
+             font-lock-syntactic-face-function))))
       (save-excursion
-        (font-lock-fontify-syntactically-region (point-min) (point-max)))
-      (when saved-function-p
-        (setq font-lock-syntactic-face-function old-function)))))
+        (font-lock-fontify-syntactically-region min max)
+        ;; TODO: Make configurable at the dispatch level.
+        (when (eq major-mode 'emacs-lisp-mode)
+          (font-lock-fontify-keywords-region min max))))))
 
 
 ;;; js2-mode colorization
@@ -237,12 +228,20 @@ variable."
                        ;; `js2-prop-get-node', so this always works.
                        (eq node (js2-prop-get-node-right parent))))))))
 
+(defvar-local context-coloring-point-max nil
+  "Cached value of `point-max'.")
+
 (defsubst context-coloring-js2-colorize-node (node level)
   "Color NODE with the color for LEVEL."
   (let ((start (js2-node-abs-pos node)))
     (context-coloring-colorize-region
      start
-     (+ start (js2-node-len node)) ; End
+     (min
+      ;; End
+      (+ start (js2-node-len node))
+      ;; Somes nodes (like the ast when there is an unterminated multiline
+      ;; comment) will stretch to the value of `point-max'.
+      context-coloring-point-max)
      level)))
 
 (defun context-coloring-js2-colorize ()
@@ -250,6 +249,7 @@ variable."
 generated by `js2-mode'."
   ;; Reset the hash table; the old one could be obsolete.
   (setq context-coloring-js2-scope-level-hash-table (make-hash-table :test 'eq))
+  (setq context-coloring-point-max (point-max))
   (with-silent-modifications
     (js2-visit-ast
      js2-mode-ast
@@ -278,6 +278,468 @@ generated by `js2-mode'."
     (context-coloring-maybe-colorize-comments-and-strings)))
 
 
+;;; Emacs Lisp colorization
+
+(defsubst context-coloring-make-scope (depth level)
+  (list
+   :depth depth
+   :level level
+   :variables (make-hash-table)))
+
+(defsubst context-coloring-scope-get-level (scope)
+  (plist-get scope :level))
+
+(defsubst context-coloring-scope-add-variable (scope variable)
+  (puthash variable t (plist-get scope :variables)))
+
+(defsubst context-coloring-scope-get-variable (scope variable)
+  (gethash variable (plist-get scope :variables)))
+
+(defsubst context-coloring-get-variable-level (scope-stack variable)
+  (let* (scope
+         level)
+    (while (and scope-stack (not level))
+      (setq scope (car scope-stack))
+      (cond
+       ((context-coloring-scope-get-variable scope variable)
+        (setq level (context-coloring-scope-get-level scope)))
+       (t
+        (setq scope-stack (cdr scope-stack)))))
+    ;; Assume a global variable.
+    (or level 0)))
+
+(defsubst context-coloring-make-backtick (end enabled)
+  (list
+   :end end
+   :enabled enabled))
+
+(defsubst context-coloring-backtick-get-end (backtick)
+  (plist-get backtick :end))
+
+(defsubst context-coloring-backtick-get-enabled (backtick)
+  (plist-get backtick :enabled))
+
+(defsubst context-coloring-backtick-enabled-p (backtick-stack)
+  (context-coloring-backtick-get-enabled (car backtick-stack)))
+
+(defsubst context-coloring-make-let-varlist (depth type)
+  (list
+   :depth depth
+   :type type
+   :vars '()))
+
+(defsubst context-coloring-let-varlist-get-type (let-varlist)
+  (plist-get let-varlist :type))
+
+(defsubst context-coloring-let-varlist-add-var (let-varlist var)
+  (plist-put let-varlist :vars (cons var (plist-get let-varlist :vars))))
+
+(defsubst 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)))))))
+
+(defsubst context-coloring-forward-sws ()
+  "Move forward through whitespace and comments."
+  (while (forward-comment 1)))
+
+(defsubst context-coloring-forward-sexp-position ()
+  "Like vanilla `forward-sexp', but just return the position."
+  (scan-sexps (point) 1))
+
+(defsubst context-coloring-emacs-lisp-identifier-syntax-p (syntax-code)
+  (or (= 2 syntax-code)
+      (= 3 syntax-code)))
+
+(defsubst context-coloring-open-parenthesis-p (syntax-code)
+  (= 4 syntax-code))
+
+(defsubst context-coloring-close-parenthesis-p (syntax-code)
+  (= 5 syntax-code))
+
+(defsubst context-coloring-expression-prefix-p (syntax-code)
+  (= 6 syntax-code))
+
+(defsubst context-coloring-at-open-parenthesis-p ()
+  (= 4 (logand #xFFFF (car (syntax-after (point))))))
+
+(defsubst context-coloring-ppss-depth (ppss)
+  ;; Same as (nth 0 ppss).
+  (car ppss))
+
+(defsubst context-coloring-at-stack-depth-p (stack depth)
+  (= (plist-get (car stack) :depth) depth))
+
+(defsubst context-coloring-exact-regexp (word)
+  "Create a regexp that matches exactly WORD."
+  (concat "\\`" (regexp-quote word) "\\'"))
+
+(defsubst context-coloring-exact-or-regexp (words)
+  "Create a regexp that matches any exact word in WORDS."
+  (context-coloring-join
+   (mapcar 'context-coloring-exact-regexp words) "\\|"))
+
+(defconst context-coloring-emacs-lisp-defun-regexp
+  (context-coloring-exact-or-regexp
+   '("defun" "defun*" "defsubst" "defmacro"
+     "cl-defun" "cl-defsubst" "cl-defmacro")))
+
+(defconst context-coloring-emacs-lisp-lambda-regexp
+  (context-coloring-exact-regexp "lambda"))
+
+(defconst context-coloring-emacs-lisp-let-regexp
+  (context-coloring-exact-regexp "let"))
+
+(defconst context-coloring-emacs-lisp-let*-regexp
+  (context-coloring-exact-regexp "let*"))
+
+(defconst context-coloring-arglist-arg-regexp
+  "\\`[^&:]")
+
+(defconst context-coloring-ignored-word-regexp
+  (concat "\\`[-+]?[0-9]\\|" (context-coloring-exact-or-regexp
+                              '("t" "nil" "." "?"))))
+
+(defconst context-coloring-COMMA-CHAR 44)
+(defconst context-coloring-BACKTICK-CHAR 96)
+
+(defvar context-coloring-parse-interruptable-p t
+  "Set this to nil to force parse to continue until finished.")
+
+(defconst context-coloring-emacs-lisp-iterations-per-pause 1000
+  "Pause after this many iterations to check for user input.
+If user input is pending, stop the parse.  This makes for a
+smoother user experience for large files.
+
+As of this writing, emacs lisp colorization seems to run at about
+60,000 iterations per second.  A default value of 1000 should
+provide visually \"instant\" updates at 60 frames per second.")
+
+(defun context-coloring-emacs-lisp-colorize ()
+  "Color the current buffer by parsing emacs lisp sexps."
+  (with-silent-modifications
+    (save-excursion
+      ;; TODO: Can probably make this lazy to the nearest defun.
+      (goto-char (point-min))
+      (let* ((inhibit-point-motion-hooks t)
+             (end (point-max))
+             (iteration-count 0)
+             (last-fontified-position (point))
+             beginning-of-current-defun
+             end-of-current-defun
+             (last-ppss-pos (point))
+             (ppss (syntax-ppss))
+             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
+             in-let-p
+             in-let*-p
+             defun-arglist
+             defun-arg
+             let-varlist
+             let-varlist-type
+             variable
+             variable-end
+             variable-string
+             variable-scope-level
+             token-pos
+             token-syntax
+             token-syntax-code
+             token-char
+             child-0-pos
+             child-0-end
+             child-0-syntax
+             child-0-syntax-code
+             child-0-string
+             child-1-pos
+             child-1-end
+             child-1-syntax
+             child-1-syntax-code
+             child-2-end)
+        (while (> end (progn (skip-syntax-forward "^()w_'" end)
+                             (point)))
+          ;; Sparingly-executed tasks.
+          (setq iteration-count (1+ iteration-count))
+          (when (zerop (% iteration-count
+                          context-coloring-emacs-lisp-iterations-per-pause))
+            ;; Fontify until the end of the current defun because doing it in
+            ;; chunks based soley on point could result in partial
+            ;; re-fontifications over the contents of scopes.
+            (save-excursion
+              (end-of-defun)
+              (setq end-of-current-defun (point))
+              (beginning-of-defun)
+              (setq beginning-of-current-defun (point)))
+
+            ;; Fontify in chunks.
+            (context-coloring-maybe-colorize-comments-and-strings
+             last-fontified-position
+             (cond
+              ;; We weren't actually in a defun, so don't color the next one, as
+              ;; that could result in `font-lock' properties being added to it.
+              ((> beginning-of-current-defun (point))
+               (point))
+              (t
+               end-of-current-defun)))
+            (setq last-fontified-position (point))
+            (when (and context-coloring-parse-interruptable-p
+                       (input-pending-p))
+              (throw 'interrupted t)))
+
+          (setq token-pos (point))
+          (setq token-syntax (syntax-after token-pos))
+          (setq token-syntax-code (logand #xFFFF (car token-syntax)))
+          (setq token-char (char-after))
+          (setq ppss (parse-partial-sexp last-ppss-pos token-pos nil nil ppss))
+          (setq last-ppss-pos token-pos)
+          (cond
+
+           ;; Resolve an invalid state.
+           ((cond
+             ;; Inside string?
+             ((nth 3 ppss)
+              (skip-syntax-forward "^\"" end)
+              (forward-char)
+              t)
+             ;; Inside comment?
+             ((nth 4 ppss)
+              (skip-syntax-forward "^>" end)
+              t)))
+
+           ;; Need to check early in case there's a comma.
+           ((context-coloring-expression-prefix-p token-syntax-code)
+            (forward-char)
+            (cond
+             ;; Skip top-level symbols.
+             ((not (or backtick-stack
+                       (= token-char context-coloring-BACKTICK-CHAR)))
+              (goto-char (context-coloring-forward-sexp-position)))
+             ;; Push a backtick state.
+             ((or (= token-char context-coloring-BACKTICK-CHAR)
+                  (= token-char context-coloring-COMMA-CHAR))
+              (setq backtick-stack (cons (context-coloring-make-backtick
+                                          (context-coloring-forward-sexp-position)
+                                          (= token-char context-coloring-BACKTICK-CHAR))
+                                         backtick-stack)))))
+
+           ;; Pop a backtick state.
+           ((and backtick-stack
+                 (>= (point) (context-coloring-backtick-get-end (car backtick-stack))))
+            (setq backtick-stack (cdr backtick-stack)))
+
+           ;; Restricted by an enabled backtick.
+           ((and backtick-stack
+                 (context-coloring-backtick-enabled-p backtick-stack))
+            (forward-char))
+
+           ((context-coloring-open-parenthesis-p token-syntax-code)
+            (forward-char)
+            ;; Look for function calls.
+            (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)))
+            (cond
+             ((context-coloring-emacs-lisp-identifier-syntax-p child-0-syntax-code)
+              (setq one-word-found-p t)
+              (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-at-stack-depth-p
+                  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-emacs-lisp-defun-regexp child-0-string)
+                (setq in-defun-p t))
+               ((string-match-p context-coloring-emacs-lisp-lambda-regexp child-0-string)
+                (setq in-lambda-p t))
+               ((string-match-p context-coloring-emacs-lisp-let-regexp child-0-string)
+                (setq in-let-p t)
+                (setq let-varlist-type 'let))
+               ((string-match-p context-coloring-emacs-lisp-let*-regexp child-0-string)
+                (setq in-let*-p t)
+                (setq let-varlist-type 'let*)))))
+            (when (or in-defun-p
+                      in-lambda-p
+                      in-let-p
+                      in-let*-p)
+              (setq scope-stack (cons (context-coloring-make-scope
+                                       (context-coloring-ppss-depth ppss)
+                                       (1+ (context-coloring-scope-get-level
+                                            (car scope-stack))))
+                                      scope-stack)))
+            ;; TODO: Maybe wasteful but doing this conditionally doesn't make
+            ;; much of a difference.
+            (context-coloring-colorize-region token-pos
+                                              (scan-sexps token-pos 1)
+                                              (context-coloring-scope-get-level
+                                               (car scope-stack)))
+            (cond
+             ((or in-defun-p
+                  in-lambda-p)
+              (goto-char child-0-end)
+              (when in-defun-p
+                ;; Look for a function name.
+                (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)))
+                (cond
+                 ((context-coloring-emacs-lisp-identifier-syntax-p child-1-syntax-code)
+                  (setq child-1-end (scan-sexps child-1-pos 1))
+                  ;; Defuns are global, so use level 0.
+                  (context-coloring-colorize-region child-1-pos child-1-end 0)
+                  (goto-char child-1-end))))
+              ;; Look for an arglist.
+              (context-coloring-forward-sws)
+              (when (context-coloring-at-open-parenthesis-p)
+                ;; (Actually it should be `child-1-end' for `lambda'.)
+                (setq child-2-end (context-coloring-forward-sexp-position))
+                (setq defun-arglist (read (buffer-substring-no-properties
+                                           (point)
+                                           child-2-end)))
+                (while defun-arglist
+                  (setq defun-arg (car defun-arglist))
+                  (when (and (symbolp defun-arg)
+                             (string-match-p
+                              context-coloring-arglist-arg-regexp
+                              (symbol-name defun-arg)))
+                    (context-coloring-scope-add-variable
+                     (car scope-stack)
+                     defun-arg))
+                  (setq defun-arglist (cdr defun-arglist)))
+                (goto-char child-2-end))
+              ;; Cleanup.
+              (setq in-defun-p nil)
+              (setq in-lambda-p nil))
+             ((or in-let-p
+                  in-let*-p)
+              (goto-char child-0-end)
+              ;; 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 (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))
+             (t
+              (goto-char (cond
+                          ;; If there was a word, continue parsing after it.
+                          (one-word-found-p
+                           (1+ child-0-end))
+                          (t
+                           (1+ token-pos))))))
+            ;; Cleanup.
+            (setq one-word-found-p nil))
+
+           ((context-coloring-emacs-lisp-identifier-syntax-p token-syntax-code)
+            (setq variable-end (context-coloring-forward-sexp-position))
+            (setq variable-string (buffer-substring-no-properties
+                                   token-pos
+                                   variable-end))
+            (cond
+             ;; Ignore constants such as numbers, keywords, t, nil.  These can't
+             ;; be rebound, so they should be treated like syntax.
+             ((string-match-p context-coloring-ignored-word-regexp variable-string))
+             ((keywordp (read variable-string)))
+             (t
+              (setq variable (intern variable-string))
+              (cond
+               ;; Parse a `let' varlist's uninitialized var.
+               ((and
+                 let-varlist-stack
+                 (context-coloring-at-stack-depth-p
+                  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))
+            (setq ppss-depth (context-coloring-ppss-depth ppss))
+            ;; TODO: Order might matter here but I'm not certain.
+            (when (context-coloring-at-stack-depth-p 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-at-stack-depth-p 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))))
+
+           ))
+        ;; Fontify the last stretch.
+        (context-coloring-maybe-colorize-comments-and-strings
+         last-fontified-position
+         (point))))))
+
+
 ;;; Shell command scopification / colorization
 
 (defun context-coloring-apply-tokens (tokens)
@@ -298,8 +760,13 @@ element."
 
 (defun context-coloring-parse-array (array)
   "Parse ARRAY as a flat JSON array of numbers."
-  (vconcat
-   (mapcar 'string-to-number (split-string (substring array 1 -1) ","))))
+  (let ((braceless (substring (context-coloring-trim array) 1 -1)))
+    (cond
+     ((> (length braceless) 0)
+      (vconcat
+       (mapcar 'string-to-number (split-string braceless ","))))
+     (t
+      (vector)))))
 
 (defvar-local context-coloring-scopifier-process nil
   "The single scopifier process that can be running.")
@@ -354,7 +821,7 @@ read the scopifier's response asynchronously and apply a parsed
 list of tokens to `context-coloring-apply-tokens'.
 
 Invoke CALLBACK when complete."
-  (let ((buffer context-coloring-buffer))
+  (let ((buffer (current-buffer)))
     (context-coloring-scopify-shell-command
      command
      (lambda (output)
@@ -375,14 +842,14 @@ Invoke CALLBACK when complete."
 (defvar context-coloring-mode-hash-table (make-hash-table :test 'eq)
   "Map major mode names to dispatch property lists.")
 
-(defun context-coloring-select-dispatch (mode dispatch)
-  "Use DISPATCH for MODE."
-  (puthash
-   mode
-   (gethash
-    dispatch
-    context-coloring-dispatch-hash-table)
-   context-coloring-mode-hash-table))
+(defun context-coloring-get-dispatch-for-mode (mode)
+  "Return the dispatch for MODE (or a derivative mode)."
+  (let ((parent mode)
+        dispatch)
+    (while (and parent
+                (not (setq dispatch (gethash parent context-coloring-mode-hash-table)))
+                (setq parent (get parent 'derived-mode-parent))))
+    dispatch))
 
 (defun context-coloring-define-dispatch (symbol &rest properties)
   "Define a new dispatch named SYMBOL with PROPERTIES.
@@ -435,56 +902,23 @@ should be numeric, e.g. \"2\", \"19700101\", \"1.2.3\",
       (error "No colorizer, scopifier or command defined for dispatch"))
     (puthash symbol properties context-coloring-dispatch-hash-table)
     (dolist (mode modes)
-      (when (null (gethash mode context-coloring-mode-hash-table))
-        (puthash mode properties context-coloring-mode-hash-table)))))
-
-(context-coloring-define-dispatch
- 'javascript-node
- :modes '(js-mode js3-mode)
- :executable "scopifier"
- :command "scopifier"
- :version "v1.1.1")
-
-(context-coloring-define-dispatch
- 'javascript-js2
- :modes '(js2-mode)
- :colorizer 'context-coloring-js2-colorize
- :setup
- (lambda ()
-   (add-hook 'js2-post-parse-callbacks 'context-coloring-colorize nil t))
- :teardown
- (lambda ()
-   (remove-hook 'js2-post-parse-callbacks 'context-coloring-colorize t)))
-
-(defun context-coloring-dispatch (&optional callback)
-  "Determine the optimal track for scopification / coloring of
-the current buffer, then execute it.
-
-Invoke CALLBACK when complete.  It is invoked synchronously for
-elisp tracks, and asynchronously for shell command tracks."
-  (let ((dispatch (gethash major-mode context-coloring-mode-hash-table))
-        colorizer
-        scopifier
-        command)
-    (cond
-     ((setq colorizer (plist-get dispatch :colorizer))
-      (funcall colorizer)
-      (when callback (funcall callback)))
-     ((setq scopifier (plist-get dispatch :scopifier))
-      (context-coloring-apply-tokens (funcall scopifier))
-      (when callback (funcall callback)))
-     ((setq command (plist-get dispatch :command))
-      (context-coloring-scopify-and-colorize command callback)))))
+      (puthash mode properties context-coloring-mode-hash-table))))
 
 
 ;;; Colorization
 
+(defvar context-coloring-colorize-hook nil
+  "Hooks to run after coloring a buffer.")
+
 (defun context-coloring-colorize (&optional callback)
   "Color the current buffer by function context.
 
 Invoke CALLBACK when complete; see `context-coloring-dispatch'."
   (interactive)
-  (context-coloring-dispatch callback))
+  (context-coloring-dispatch
+   (lambda ()
+     (when callback (funcall callback))
+     (run-hooks 'context-coloring-colorize-hook))))
 
 (defvar-local context-coloring-changed nil
   "Indication that the buffer has changed recently, which implies
@@ -498,9 +932,9 @@ used.")
   (context-coloring-kill-scopifier)
   (setq context-coloring-changed t))
 
-(defun context-coloring-maybe-colorize ()
+(defun context-coloring-maybe-colorize (buffer)
   "Colorize the current buffer if it has changed."
-  (when (and (eq context-coloring-buffer (window-buffer (selected-window)))
+  (when (and (eq buffer (current-buffer))
              context-coloring-changed)
     (setq context-coloring-changed nil)
     (context-coloring-colorize)))
@@ -545,7 +979,7 @@ produces (1 0 0), \"19700101\" produces (19700101), etc."
   "Asynchronously invoke CALLBACK with a predicate indicating
 whether the current scopifier version satisfies the minimum
 version number required for the current major mode."
-  (let ((dispatch (gethash major-mode context-coloring-mode-hash-table)))
+  (let ((dispatch (context-coloring-get-dispatch-for-mode major-mode)))
     (when dispatch
       (let ((version (plist-get dispatch :version))
             (command (plist-get dispatch :command)))
@@ -648,7 +1082,9 @@ which must already exist and which *should* already be enabled."
   (let* ((properties (gethash theme context-coloring-theme-hash-table))
          (colors (plist-get properties :colors))
          (level -1))
-    (setq context-coloring-maximum-face (- (length colors) 1))
+    ;; Only clobber when we have to.
+    (when (custom-theme-enabled-p theme)
+      (setq context-coloring-maximum-face (- (length colors) 1)))
     (apply
      'custom-theme-set-faces
      theme
@@ -746,7 +1182,7 @@ precedence, i.e. the car of `custom-enabled-themes'."
   (when (and (not (eq theme 'user)) ; Called internally by `enable-theme'.
              (custom-theme-p theme) ; Guard against non-existent themes.
              (context-coloring-theme-p theme))
-    (when (= (length custom-enabled-themes) 0)
+    (when (= (length custom-enabled-themes) 1)
       ;; Cache because we can't reliably figure it out in reverse.
       (setq context-coloring-original-maximum-face
             context-coloring-maximum-face))
@@ -773,7 +1209,7 @@ precedence, i.e. the car of `custom-enabled-themes'."
            "#5180b3"
            "#ab75c3"
            "#cd7542"
-           "#dF9522"
+           "#df9522"
            "#454545"))
 
 (context-coloring-define-theme
@@ -807,27 +1243,27 @@ precedence, i.e. the car of `custom-enabled-themes'."
  'leuven
  :recede t
  :colors '("#333333"
-           "#0000FF"
-           "#6434A3"
-           "#BA36A5"
-           "#D0372D"
-           "#036A07"
+           "#0000ff"
+           "#6434a3"
+           "#ba36a5"
+           "#d0372d"
+           "#036a07"
            "#006699"
-           "#006FE0"
+           "#006fe0"
            "#808080"))
 
 (context-coloring-define-theme
  'monokai
  :recede t
- :colors '("#F8F8F2"
-           "#66D9EF"
-           "#A1EFE4"
-           "#A6E22E"
-           "#E6DB74"
-           "#FD971F"
-           "#F92672"
-           "#FD5FF0"
-           "#AE81FF"))
+ :colors '("#f8f8f2"
+           "#66d9ef"
+           "#a1efe4"
+           "#a6e22e"
+           "#e6db74"
+           "#fd971f"
+           "#f92672"
+           "#fd5ff0"
+           "#ae81ff"))
 
 (context-coloring-define-theme
  'solarized
@@ -845,26 +1281,26 @@ precedence, i.e. the car of `custom-enabled-themes'."
            "#dc322f"
            "#d33682"
            "#6c71c4"
-           "#69B7F0"
-           "#69CABF"
-           "#B4C342"
-           "#DEB542"
-           "#F2804F"
-           "#FF6E64"
-           "#F771AC"
-           "#9EA0E5"))
+           "#69b7f0"
+           "#69cabf"
+           "#b4c342"
+           "#deb542"
+           "#f2804f"
+           "#ff6e64"
+           "#f771ac"
+           "#9ea0e5"))
 
 (context-coloring-define-theme
  'spacegray
  :recede t
  :colors '("#ffffff"
-           "#89AAEB"
-           "#C189EB"
+           "#89aaeb"
+           "#c189eb"
            "#bf616a"
-           "#DCA432"
+           "#dca432"
            "#ebcb8b"
-           "#B4EB89"
-           "#89EBCA"))
+           "#b4eb89"
+           "#89ebca"))
 
 (context-coloring-define-theme
  'tango
@@ -886,20 +1322,20 @@ precedence, i.e. the car of `custom-enabled-themes'."
 (context-coloring-define-theme
  'zenburn
  :recede t
- :colors '("#DCDCCC"
-           "#93E0E3"
-           "#BFEBBF"
-           "#F0DFAF"
-           "#DFAF8F"
-           "#CC9393"
-           "#DC8CC3"
-           "#94BFF3"
-           "#9FC59F"
-           "#D0BF8F"
-           "#DCA3A3"))
+ :colors '("#dcdccc"
+           "#93e0e3"
+           "#bfebbf"
+           "#f0dfaf"
+           "#dfaf8f"
+           "#cc9393"
+           "#dc8cc3"
+           "#94bff3"
+           "#9fc59f"
+           "#d0bf8f"
+           "#dca3a3"))
 
 
-;;; Minor mode
+;;; Change detection
 
 (defvar-local context-coloring-colorize-idle-timer nil
   "The currently-running idle timer.")
@@ -910,18 +1346,90 @@ precedence, i.e. the car of `custom-enabled-themes'."
 Increase this if your machine is high-performing.  Decrease it if
 it ain't.
 
-Supported modes: `js-mode', `js3-mode'"
+Supported modes: `js-mode', `js3-mode', `emacs-lisp-mode'"
   :group 'context-coloring)
 
 (defun context-coloring-setup-idle-change-detection ()
   "Setup idle change detection."
   (add-hook
    'after-change-functions 'context-coloring-change-function nil t)
+  (add-hook
+   'kill-buffer-hook 'context-coloring-teardown-idle-change-detection nil t)
   (setq context-coloring-colorize-idle-timer
         (run-with-idle-timer
          context-coloring-delay
          t
-         'context-coloring-maybe-colorize)))
+         'context-coloring-maybe-colorize
+         (current-buffer))))
+
+(defun context-coloring-teardown-idle-change-detection ()
+  "Teardown idle change detection."
+  (context-coloring-kill-scopifier)
+  (when context-coloring-colorize-idle-timer
+    (cancel-timer context-coloring-colorize-idle-timer))
+  (remove-hook
+   'kill-buffer-hook 'context-coloring-teardown-idle-change-detection t)
+  (remove-hook
+   'after-change-functions 'context-coloring-change-function t))
+
+
+;;; Built-in dispatches
+
+(context-coloring-define-dispatch
+ 'javascript-node
+ :modes '(js-mode js3-mode)
+ :executable "scopifier"
+ :command "scopifier"
+ :version "v1.1.1")
+
+(context-coloring-define-dispatch
+ 'javascript-js2
+ :modes '(js2-mode)
+ :colorizer 'context-coloring-js2-colorize
+ :setup
+ (lambda ()
+   (add-hook 'js2-post-parse-callbacks 'context-coloring-colorize nil t))
+ :teardown
+ (lambda ()
+   (remove-hook 'js2-post-parse-callbacks 'context-coloring-colorize t)))
+
+(context-coloring-define-dispatch
+ 'emacs-lisp
+ :modes '(emacs-lisp-mode)
+ :colorizer 'context-coloring-emacs-lisp-colorize
+ :setup 'context-coloring-setup-idle-change-detection
+ :teardown 'context-coloring-teardown-idle-change-detection)
+
+(defun context-coloring-dispatch (&optional callback)
+  "Determine the optimal track for scopification / coloring of
+the current buffer, then execute it.
+
+Invoke CALLBACK when complete.  It is invoked synchronously for
+elisp tracks, and asynchronously for shell command tracks."
+  (let* ((dispatch (context-coloring-get-dispatch-for-mode major-mode))
+         (colorizer (plist-get dispatch :colorizer))
+         (scopifier (plist-get dispatch :scopifier))
+         (command (plist-get dispatch :command))
+         interrupted-p)
+    (cond
+     ((or colorizer scopifier)
+      (setq interrupted-p
+            (catch 'interrupted
+              (cond
+               (colorizer
+                (funcall colorizer))
+               (scopifier
+                (context-coloring-apply-tokens (funcall scopifier))))))
+      (cond
+       (interrupted-p
+        (setq context-coloring-changed t))
+       (t
+        (when callback (funcall callback)))))
+     (command
+      (context-coloring-scopify-and-colorize command callback)))))
+
+
+;;; Minor mode
 
 ;;;###autoload
 (define-minor-mode context-coloring-mode
@@ -929,32 +1437,28 @@ Supported modes: `js-mode', `js3-mode'"
   nil " Context" nil
   (if (not context-coloring-mode)
       (progn
-        (context-coloring-kill-scopifier)
-        (when context-coloring-colorize-idle-timer
-          (cancel-timer context-coloring-colorize-idle-timer))
-        (let ((dispatch (gethash major-mode context-coloring-mode-hash-table)))
+        (let ((dispatch (context-coloring-get-dispatch-for-mode major-mode)))
           (when dispatch
             (let ((command (plist-get dispatch :command))
                   (teardown (plist-get dispatch :teardown)))
               (when command
-                (remove-hook
-                 'after-change-functions 'context-coloring-change-function t))
+                (context-coloring-teardown-idle-change-detection))
               (when teardown
                 (funcall teardown)))))
         (font-lock-mode)
         (jit-lock-mode t))
 
-    ;; Remember this buffer.  This value should not be dynamically-bound.
-    (setq context-coloring-buffer (current-buffer))
-
     ;; Font lock is incompatible with this mode; the converse is also true.
     (font-lock-mode 0)
     (jit-lock-mode nil)
 
+    ;; ...but we do use font-lock functions here.
+    (font-lock-set-defaults)
+
     ;; Safely change the valye of this function as necessary.
     (make-local-variable 'font-lock-syntactic-face-function)
 
-    (let ((dispatch (gethash major-mode context-coloring-mode-hash-table)))
+    (let ((dispatch (context-coloring-get-dispatch-for-mode major-mode)))
       (if dispatch
           (progn
             (let ((command (plist-get dispatch :command))
@@ -985,7 +1489,8 @@ Supported modes: `js-mode', `js3-mode'"
                 (funcall setup))
               ;; Colorize once initially.
               (when colorize-initially-p
-                (context-coloring-colorize))))
+                (let ((context-coloring-parse-interruptable-p nil))
+                  (context-coloring-colorize)))))
         (when (null dispatch)
           (message "Context coloring is not available for this major mode"))))))