]> code.delx.au - gnu-emacs-elpa/blobdiff - context-coloring.el
Add change hooks for elisp.
[gnu-emacs-elpa] / context-coloring.el
index ca15c4b7b03e95a9ecd6fa68d6ea8b3f84181697..6c56d1448488a0266d7bc9e43a3e95b3356cab75 100644 (file)
@@ -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.1.0
+;; Version: 6.2.1
+;; 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.
 
 
 ;;; 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.
+;; 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.
 
-;; 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.
+;; By default, comments and strings are still highlighted syntactically.
 
-;; To use, add the following to your ~/.emacs:
+;; To use with js2-mode, add the following to your init file:
 
 ;; (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.
+;; To use with js-mode or js3-mode, install Node.js 0.10+ and the scopifier
+;; executable:
 
 ;; $ npm install -g scopifier
 
   "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 +96,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
@@ -237,12 +244,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 +265,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 +294,398 @@ generated by `js2-mode'."
     (context-coloring-maybe-colorize-comments-and-strings)))
 
 
+;;; Emacs Lisp colorization
+
+(defun context-coloring-make-scope (depth level)
+  (list
+   :depth depth
+   :level level
+   :variables (make-hash-table)))
+
+(defun context-coloring-scope-get-level (scope)
+  (plist-get scope :level))
+
+(defun context-coloring-scope-add-variable (scope variable)
+  (puthash variable t (plist-get scope :variables)))
+
+(defun context-coloring-scope-get-variable (scope variable)
+  (gethash variable (plist-get scope :variables)))
+
+(defun 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)))
+
+(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-make-let-varlist (depth type)
+  (list
+   :depth depth
+   :type type
+   :vars '()))
+
+(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)))
+
+(defun context-coloring-forward-sexp-position ()
+  (scan-sexps (point) 1))
+
+(defun context-coloring-emacs-lisp-identifier-syntax-p (syntax-code)
+  (or (= 2 syntax-code)
+      (= 3 syntax-code)))
+
+(defun context-coloring-open-parenthesis-p (syntax-code)
+  (= 4 syntax-code))
+
+(defun context-coloring-close-parenthesis-p (syntax-code)
+  (= 5 syntax-code))
+
+(defun context-coloring-expression-prefix-p (syntax-code)
+  (= 6 syntax-code))
+
+(defun context-coloring-at-open-parenthesis-p ()
+  (= 4 (logand #xFFFF (car (syntax-after (point))))))
+
+(defun context-coloring-ppss-depth (ppss)
+  ;; 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\\'")
+
+(defconst context-coloring-arglist-arg-regexp
+  "\\`[^&:]")
+
+(defconst context-coloring-ignored-word-regexp
+  "\\`[-+]?[0-9]\\|\\`t\\'\\|\\`nil\\'\\|\\`\\.\\'")
+
+(defconst context-coloring-COMMA-CHAR 44)
+(defconst context-coloring-BACKTICK-CHAR 96)
+
+(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))
+             (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)))
+          (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-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 let-varlist-type 'let))
+               ((string-match-p "\\`let\\*\\'" 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: Probably redundant and wasteful.
+            (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-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))
+            (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)))
+
+
 ;;; Shell command scopification / colorization
 
 (defun context-coloring-apply-tokens (tokens)
@@ -298,8 +706,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.")
@@ -375,15 +788,6 @@ 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-define-dispatch (symbol &rest properties)
   "Define a new dispatch named SYMBOL with PROPERTIES.
 
@@ -438,47 +842,12 @@ should be numeric, e.g. \"2\", \"19700101\", \"1.2.3\",
       (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)))))
-
 
 ;;; 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.
 
@@ -486,7 +855,8 @@ Invoke CALLBACK when complete; see `context-coloring-dispatch'."
   (interactive)
   (context-coloring-dispatch
    (lambda ()
-     (when callback (funcall callback)))))
+     (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
@@ -515,7 +885,8 @@ used.")
 produces (1 0 0), \"19700101\" produces (19700101), etc."
   (let (version)
     (while (string-match "[0-9]+" string)
-      (setq version (append version (list (string-to-number (match-string 0 string)))))
+      (setq version (append version
+                            (list (string-to-number (match-string 0 string)))))
       (setq string (substring string (match-end 0))))
     version))
 
@@ -649,7 +1020,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
@@ -747,7 +1120,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))
@@ -774,7 +1147,7 @@ precedence, i.e. the car of `custom-enabled-themes'."
            "#5180b3"
            "#ab75c3"
            "#cd7542"
-           "#dF9522"
+           "#df9522"
            "#454545"))
 
 (context-coloring-define-theme
@@ -808,27 +1181,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
@@ -846,26 +1219,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
@@ -887,20 +1260,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.")
@@ -924,6 +1297,64 @@ Supported modes: `js-mode', `js3-mode'"
          t
          'context-coloring-maybe-colorize)))
 
+
+;;; 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
+ (lambda ()
+   (context-coloring-setup-idle-change-detection))
+ :teardown
+ (lambda ()
+   (when context-coloring-colorize-idle-timer
+     (cancel-timer context-coloring-colorize-idle-timer))
+   (remove-hook
+    'after-change-functions 'context-coloring-change-function 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)))))
+
+
+;;; Minor mode
+
 ;;;###autoload
 (define-minor-mode context-coloring-mode
   "Context-based code coloring, inspired by Douglas Crockford."
@@ -988,7 +1419,7 @@ Supported modes: `js-mode', `js3-mode'"
               (when colorize-initially-p
                 (context-coloring-colorize))))
         (when (null dispatch)
-          (message "%s" "Context coloring is not available for this major mode"))))))
+          (message "Context coloring is not available for this major mode"))))))
 
 (provide 'context-coloring)