[elpa] master f664821 31/31: Merge commit '6f3ad757155b9b3089aba55ee6102ecc9bed647d' from context-coloring

[Jackson Ray Hamilton]

branch: master
commit f664821f71834b2b52d945551351ff82ebfacdf5
Merge: 2fb700c 6f3ad75
Author: Jackson Ray Hamilton <address@hidden>
Commit: Jackson Ray Hamilton <address@hidden>

    Merge commit '6f3ad757155b9b3089aba55ee6102ecc9bed647d' from 
context-coloring
---
 packages/context-coloring/README.md                |   12 +-
 packages/context-coloring/context-coloring.el      |  333 ++++++++++++++----
 .../context-coloring/test/context-coloring-test.el |  384 +++++++++++++++++++-
 3 files changed, 643 insertions(+), 86 deletions(-)

diff --git a/packages/context-coloring/README.md 
b/packages/context-coloring/README.md
index 21ba184..ff305c1 100644
--- a/packages/context-coloring/README.md
+++ b/packages/context-coloring/README.md
@@ -90,8 +90,9 @@ Add the following to your `~/.emacs` file:
 ## Customizing
 
 Color schemes for custom themes are automatically applied when those themes are
-active. Built-in theme support is available for: `leuven`, `monokai`,
-`solarized`, `tango` and `zenburn`.
+active. Built-in theme support is available for: `ample`, `anti-zenburn`,
+`grandshell`, `leuven`, `monokai`, `solarized`, `spacegray`, `tango` and
+`zenburn`.
 
 You can define your own theme colors too:
 
@@ -111,11 +112,14 @@ You can define your own theme colors too:
            "#DCA3A3"))
 ```
 
+See `C-h f context-coloring-define-theme` for more info on theme parameters.
+
 ## Extending
 
 To add support for a new language, write a "scopifier" for it, and define a new
 coloring dispatch strategy with `context-coloring-define-dispatch`. Then the
-plugin should handle the rest.
+plugin should handle the rest. (See `C-h f context-coloring-define-dispatch` 
for
+more info on dispatch strategies.)
 
 A "scopifier" is a CLI program that reads a buffer's contents from stdin and
 writes a JSON array of numbers to stdout. Every three numbers in the array
@@ -171,9 +175,7 @@ required.
 
 [linter]: http://jshint.com/about/
 [flycheck]: http://www.flycheck.org/
-[zenburn]: http://github.com/bbatsov/zenburn-emacs
 [point]: http://www.gnu.org/software/emacs/manual/html_node/elisp/Point.html
 [js2-mode]: https://github.com/mooz/js2-mode
 [node]: http://nodejs.org/download/
 [scopifier]: https://github.com/jacksonrayhamilton/scopifier
-[load path]: 
https://www.gnu.org/software/emacs/manual/html_node/emacs/Lisp-Libraries.html
diff --git a/packages/context-coloring/context-coloring.el 
b/packages/context-coloring/context-coloring.el
index 6af9444..6b6ffe9 100644
--- a/packages/context-coloring/context-coloring.el
+++ b/packages/context-coloring/context-coloring.el
@@ -5,7 +5,7 @@
 ;; Author: Jackson Ray Hamilton <address@hidden>
 ;; URL: https://github.com/jacksonrayhamilton/context-coloring
 ;; Keywords: context coloring syntax highlighting
-;; Version: 4.1.0
+;; Version: 5.0.0
 ;; Package-Requires: ((emacs "24") (js2-mode "20150126"))
 
 ;; This file is part of GNU Emacs.
@@ -56,13 +56,6 @@
 (require 'js2-mode)
 
 
-;;; Constants
-
-(defconst context-coloring-path
-  (file-name-directory (or load-file-name buffer-file-name))
-  "This file's directory.")
-
-
 ;;; Customizable options
 
 (defcustom context-coloring-delay 0.25
@@ -81,8 +74,8 @@ Supported modes: `js-mode', `js3-mode'"
 (defcustom context-coloring-js-block-scopes nil
   "If non-nil, also color block scopes in the scope hierarchy in JavaScript.
 
-The block-scope-inducing `let' and `const' are introduced in ES6.
-If you are writing ES6 code, enable this; otherwise, don't.
+The block-scoped `let' and `const' are introduced in ES6.  If you
+are writing ES6 code, enable this; otherwise, don't.
 
 Supported modes: `js2-mode'"
   :group 'context-coloring)
@@ -115,23 +108,28 @@ used.")
 ;;; Faces
 
 (defun context-coloring-defface (level tty light dark)
+  "Dynamically define a face for LEVEL with colors for TTY, LIGHT
+and DARK backgrounds."
   (let ((face (intern (format "context-coloring-level-%s-face" level)))
         (doc (format "Context coloring face, level %s." level)))
-    (eval (macroexpand `(defface ,face
-                          '((((type tty)) (:foreground ,tty))
-                            (((background light)) (:foreground ,light))
-                            (((background dark)) (:foreground ,dark)))
-                          ,doc
-                          :group 'context-coloring)))))
+    (eval
+     (macroexpand
+      `(defface ,face
+         '((((type tty)) (:foreground ,tty))
+           (((background light)) (:foreground ,light))
+           (((background dark)) (:foreground ,dark)))
+         ,doc
+         :group 'context-coloring)))))
 
 (defvar context-coloring-face-count nil
-  "Number of faces available for context coloring.")
+  "Number of faces available for coloring.")
 
 (defun context-coloring-defface-default (level)
-  (context-coloring-defface level "white" "#3f3f3f" "#cdcdcd"))
+  "Define a face for LEVEL with the default neutral colors."
+  (context-coloring-defface level nil "#3f3f3f" "#cdcdcd"))
 
 (defun context-coloring-set-colors-default ()
-  (context-coloring-defface 0 "white"   "#000000" "#ffffff")
+  (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")
@@ -292,7 +290,8 @@ element."
 
 (defun context-coloring-parse-array (input)
   "Specialized JSON parser for a flat array of numbers."
-  (vconcat (mapcar 'string-to-number (split-string (substring input 1 -1) 
","))))
+  (vconcat
+   (mapcar 'string-to-number (split-string (substring input 1 -1) ","))))
 
 (defun context-coloring-kill-scopifier ()
   "Kills the currently-running scopifier process for this
@@ -339,8 +338,11 @@ Invokes CALLBACK when complete."
            (if callback (funcall callback)))))))
 
   ;; Give the process its input so it can begin.
-  (process-send-region context-coloring-scopifier-process (point-min) 
(point-max))
-  (process-send-eof context-coloring-scopifier-process))
+  (process-send-region
+   context-coloring-scopifier-process
+   (point-min) (point-max))
+  (process-send-eof
+   context-coloring-scopifier-process))
 
 
 ;;; Dispatch
@@ -479,51 +481,243 @@ would be redundant."
 (defvar context-coloring-theme-hash-table (make-hash-table :test 'eq)
   "Mapping of theme names to theme properties.")
 
+(defun context-coloring-theme-p (theme)
+  "Return t if THEME is defined, nil otherwise."
+  (and (gethash theme context-coloring-theme-hash-table)))
+
+(defconst context-coloring-level-face-regexp
+  "context-coloring-level-\\([[:digit:]]+\\)-face"
+  "Regular expression for extracting a level from a face.")
+
+(defvar context-coloring-originally-set-theme-hash-table
+  (make-hash-table :test 'eq)
+  "Cache of custom themes who originally set their own
+  `context-coloring-level-N-face' faces.")
+
+(defun context-coloring-theme-originally-set-p (theme)
+  "Return t if there is a `context-coloring-level-N-face'
+originally set for THEME, nil otherwise."
+  (let (originally-set)
+    (cond
+     ;; `setq' might return a non-nil value for the sake of this `cond'.
+     ((setq
+       originally-set
+       (gethash
+        theme
+        context-coloring-originally-set-theme-hash-table))
+      (eq originally-set 'yes))
+     (t
+      (let* ((settings (get theme 'theme-settings))
+             (tail settings)
+             found)
+        (while (and tail (not found))
+          (and (eq (nth 0 (car tail)) 'theme-face)
+               (string-match
+                context-coloring-level-face-regexp
+                (symbol-name (nth 1 (car tail))))
+               (setq found t))
+          (setq tail (cdr tail)))
+        found)))))
+
+(defun context-coloring-cache-originally-set (theme originally-set)
+  "Remember if THEME had colors originally set for it; if
+ORIGINALLY-SET is non-nil, it did, otherwise it didn't."
+  ;; Caching whether a theme was originally set is kind of dirty, but we have 
to
+  ;; do it to remember the past state of the theme.  There are probably some
+  ;; edge cases where caching will be an issue, but they are probably rare.
+  (puthash
+   theme
+   (if originally-set 'yes 'no)
+   context-coloring-originally-set-theme-hash-table))
+
+(defun context-coloring-warn-theme-originally-set (theme)
+  "Warns the user that the colors for a theme are already
+originally set."
+  (warn "Context coloring colors for theme `%s' are already defined" theme))
+
+(defun context-coloring-theme-highest-level (theme)
+  "Return the highest level N of a face like
+`context-coloring-level-N-face' set for THEME, or -1 if there is
+none."
+  (let* ((settings (get theme 'theme-settings))
+         (tail settings)
+         face-string
+         number
+         (found -1))
+    (while tail
+      (and (eq (nth 0 (car tail)) 'theme-face)
+           (setq face-string (symbol-name (nth 1 (car tail))))
+           (string-match
+            context-coloring-level-face-regexp
+            face-string)
+           (setq number (string-to-number
+                         (substring face-string
+                                    (match-beginning 1)
+                                    (match-end 1))))
+           (> number found)
+           (setq found number))
+      (setq tail (cdr tail)))
+    found))
+
 (defun context-coloring-apply-theme (theme)
   "Applies THEME's properties to its respective custom theme,
 which must already exist and which *should* already be enabled."
-  (let ((properties (gethash theme context-coloring-theme-hash-table)))
-    (when (null properties)
-      (error (format "No such theme `%s'" theme)))
-    (let ((colors (plist-get properties :colors)))
-      (setq context-coloring-face-count (length colors)) ; Side-effect?
-      (let ((level -1))
-        ;; AFAIK, no way to know if a theme already has a face set, so just
-        ;; override blindly for now.
-        (apply
-         'custom-theme-set-faces
-         theme
-         (mapcar
-          (lambda (color)
-            (setq level (+ level 1))
-            `(,(context-coloring-face-symbol level) ((t (:foreground 
,color)))))
-          colors))))))
+  (let* ((properties (gethash theme context-coloring-theme-hash-table))
+         (colors (plist-get properties :colors))
+         (level -1))
+    (setq context-coloring-face-count (length colors))
+    (apply
+     'custom-theme-set-faces
+     theme
+     (mapcar
+      (lambda (color)
+        (setq level (+ level 1))
+        `(,(context-coloring-face-symbol level) ((t (:foreground ,color)))))
+      colors))))
 
 (defun context-coloring-define-theme (theme &rest properties)
-  "Define a theme named THEME for coloring scope levels.
+  "Define a context theme named THEME for coloring scope levels.
+
 PROPERTIES is a property list specifiying the following details:
 
-`:colors': List of colors that this theme uses."
-  (let ((aliases (plist-get properties :aliases)))
+`:aliases': List of symbols of other custom themes that these
+colors are applicable to.
+
+`:colors': List of colors that this context theme uses.
+
+`:override': If non-nil, this context theme is intentionally
+overriding colors set by a custom theme.  Don't set this non-nil
+unless there is a custom theme you want to use which sets
+`context-coloring-level-N-face' faces that you want to replace.
+
+`:recede': If non-nil, this context theme should not apply its
+colors if a custom theme already sets
+`context-coloring-level-N-face' faces.  This option is
+optimistic; set this non-nil if you would rather confer the duty
+of picking colors to a custom theme author (if / when he ever
+gets around to it).
+
+By default, context themes will always override custom themes,
+even if those custom themes set `context-coloring-level-N-face'
+faces.  If a context theme does override a custom theme, a
+warning will be raised, at which point you may want to enable the
+`:override' option, or just delete your context theme and opt to
+use your custom theme's author's colors instead.
+
+Context themes only work for the custom theme with the highest
+precedence, i.e. the car of `custom-enabled-themes'."
+  (let ((aliases (plist-get properties :aliases))
+        (override (plist-get properties :override))
+        (recede (plist-get properties :recede)))
     (dolist (name (append `(,theme) aliases))
       (puthash name properties context-coloring-theme-hash-table)
-      ;; Compensate for already-enabled themes by applying their colors now.
-      (when (custom-theme-enabled-p name)
-        (context-coloring-apply-theme name)))))
-
-(defun context-coloring-load-theme (&optional rest)
-  (declare (obsolete
-            "themes are now loaded alongside custom themes automatically."
-            "4.1.0")))
+      (when (custom-theme-p name)
+        (let ((originally-set (context-coloring-theme-originally-set-p name)))
+          (context-coloring-cache-originally-set name originally-set)
+          ;; In the particular case when you innocently define colors that a
+          ;; custom theme originally set, warn.  Arguably this only has to be
+          ;; done at enable time, but it is probably more useful to do it at
+          ;; definition time for prompter feedback.
+          (when (and originally-set
+                     (not recede)
+                     (not override))
+            (context-coloring-warn-theme-originally-set name))
+          ;; Set (or overwrite) colors.
+          (when (not (and originally-set
+                          recede))
+            (context-coloring-apply-theme name)))))))
+
+(defun context-coloring-enable-theme (theme)
+  "Applies THEME if its colors are not already set, else just
+sets `context-coloring-face-count' to the correct value for
+THEME."
+  (let* ((properties (gethash theme context-coloring-theme-hash-table))
+         (recede (plist-get properties :recede))
+         (override (plist-get properties :override)))
+    (cond
+     (recede
+      (let ((highest-level (context-coloring-theme-highest-level theme)))
+        (cond
+         ;; This can be true whether originally set by a custom theme or by a
+         ;; context theme.
+         ((> highest-level -1)
+          (setq context-coloring-face-count (+ highest-level 1)))
+         ;; It is possible that the corresponding custom theme did not exist at
+         ;; the time of defining this context theme, and in that case the above
+         ;; condition proves the custom theme did not originally set any faces,
+         ;; so we have license to apply the context theme for the first time
+         ;; here.
+         (t
+          (context-coloring-apply-theme theme)))))
+     (t
+      (let ((originally-set (context-coloring-theme-originally-set-p theme)))
+        ;; Cache now in case the context theme was defined after the custom
+        ;; theme.
+        (context-coloring-cache-originally-set theme originally-set)
+        (when (and originally-set
+                   (not override))
+          (context-coloring-warn-theme-originally-set theme))
+        (context-coloring-apply-theme theme))))))
 
 (defadvice enable-theme (after context-coloring-enable-theme (theme) activate)
-  "Add colors to themes just-in-time."
-  (when (and (not (eq theme 'user))  ; Called internally.
-             (custom-theme-p theme)) ; Guard against non-existent themes.
-    (context-coloring-apply-theme theme)))
+  "Enable colors for context themes just-in-time.  We can't set
+faces for custom themes that might not exist yet."
+  (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))
+    (context-coloring-enable-theme theme)))
+
+(defadvice disable-theme (after context-coloring-disable-theme (theme) 
activate)
+  "Colors are disabled normally, but
+`context-coloring-face-count' isn't.  Update it here."
+  (when (custom-theme-p theme) ; Guard against non-existent themes.
+    (let ((enabled-theme (car custom-enabled-themes)))
+      (if (context-coloring-theme-p enabled-theme)
+          (context-coloring-enable-theme enabled-theme)
+        (context-coloring-set-colors-default)))))
+
+(context-coloring-define-theme
+ 'ample
+ :recede t
+ :colors '("#bdbdb3"
+           "#baba36"
+           "#6aaf50"
+           "#5180b3"
+           "#ab75c3"
+           "#cd7542"
+           "#dF9522"
+           "#454545"))
+
+(context-coloring-define-theme
+ 'anti-zenburn
+ :recede t
+ :colors '("#232333"
+           "#6c1f1c"
+           "#401440"
+           "#0f2050"
+           "#205070"
+           "#336c6c"
+           "#23733c"
+           "#6b400c"
+           "#603a60"
+           "#2f4070"
+           "#235c5c"))
+
+(context-coloring-define-theme
+ 'grandshell
+ :recede t
+ :colors '("#bebebe"
+           "#5af2ee"
+           "#b2baf6"
+           "#f09fff"
+           "#efc334"
+           "#f6df92"
+           "#acfb5a"
+           "#888888"))
 
 (context-coloring-define-theme
  'leuven
+ :recede t
  :colors '("#333333"
            "#0000FF"
            "#6434A3"
@@ -536,6 +730,7 @@ PROPERTIES is a property list specifiying the following 
details:
 
 (context-coloring-define-theme
  'monokai
+ :recede t
  :colors '("#F8F8F2"
            "#66D9EF"
            "#A1EFE4"
@@ -548,6 +743,7 @@ PROPERTIES is a property list specifiying the following 
details:
 
 (context-coloring-define-theme
  'solarized
+ :recede t
  :aliases '(solarized-light
             solarized-dark
             sanityinc-solarized-light
@@ -571,7 +767,20 @@ PROPERTIES is a property list specifiying the following 
details:
            "#9EA0E5"))
 
 (context-coloring-define-theme
+ 'spacegray
+ :recede t
+ :colors '("#ffffff"
+           "#89AAEB"
+           "#C189EB"
+           "#bf616a"
+           "#DCA432"
+           "#ebcb8b"
+           "#B4EB89"
+           "#89EBCA"))
+
+(context-coloring-define-theme
  'tango
+ :recede t
  :colors '("#2e3436"
            "#346604"
            "#204a87"
@@ -588,6 +797,7 @@ PROPERTIES is a property list specifiying the following 
details:
 
 (context-coloring-define-theme
  'zenburn
+ :recede t
  :colors '("#DCDCCC"
            "#93E0E3"
            "#BFEBBF"
@@ -612,12 +822,14 @@ PROPERTIES is a property list specifiying the following 
details:
         (context-coloring-kill-scopifier)
         (when context-coloring-colorize-idle-timer
           (cancel-timer context-coloring-colorize-idle-timer))
-        (remove-hook 'js2-post-parse-callbacks 'context-coloring-colorize t)
-        (remove-hook 'after-change-functions 'context-coloring-change-function 
t)
+        (remove-hook
+         'js2-post-parse-callbacks 'context-coloring-colorize t)
+        (remove-hook
+         'after-change-functions 'context-coloring-change-function t)
         (font-lock-mode)
         (jit-lock-mode t))
 
-    ;; Remember this buffer. This value should not be dynamically-bound.
+    ;; 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.
@@ -632,16 +844,13 @@ PROPERTIES is a property list specifiying the following 
details:
       ;; Only recolor on reparse.
       (add-hook 'js2-post-parse-callbacks 'context-coloring-colorize nil t))
      (t
-      ;; Only recolor on change.
-      (add-hook 'after-change-functions 'context-coloring-change-function nil 
t)))
-
-    (when (not (equal major-mode 'js2-mode))
-      ;; Only recolor idly.
+      ;; Only recolor on change, idly.
+      (add-hook 'after-change-functions 'context-coloring-change-function nil 
t)
       (setq context-coloring-colorize-idle-timer
             (run-with-idle-timer
              context-coloring-delay
              t
-             'context-coloring-maybe-colorize)))))
+             'context-coloring-maybe-colorize))))))
 
 (provide 'context-coloring)
 
diff --git a/packages/context-coloring/test/context-coloring-test.el 
b/packages/context-coloring/test/context-coloring-test.el
index 607882b..fdb0d83 100644
--- a/packages/context-coloring/test/context-coloring-test.el
+++ b/packages/context-coloring/test/context-coloring-test.el
@@ -19,6 +19,9 @@
 
 ;;; Code:
 
+(require 'ert-async)
+
+
 ;;; Test running utilities
 
 (defconst context-coloring-test-path
@@ -68,7 +71,8 @@ is done."
               (kill-buffer temp-buffer))
          (set-buffer previous-buffer))))))
 
-(defun context-coloring-test-with-fixture-async (fixture callback &optional 
setup)
+(defun context-coloring-test-with-fixture-async
+    (fixture callback &optional setup)
   "Evaluate CALLBACK in a temporary buffer with the relative
 FIXTURE.  A teardown callback is passed to CALLBACK for it to
 invoke when it is done.  An optional SETUP callback can be passed
@@ -117,7 +121,8 @@ instantiated in SETUP."
 format."
   (let ((test-name (intern (format "context-coloring-test-js-mode-%s" name)))
         (fixture (format "./fixtures/%s.js" name))
-        (function-name (intern-soft (format "context-coloring-test-js-%s" 
name))))
+        (function-name (intern-soft
+                        (format "context-coloring-test-js-%s" name))))
     `(ert-deftest-async ,test-name (done)
                         (context-coloring-test-js-mode
                          ,fixture
@@ -131,7 +136,8 @@ format."
     "Define a test for `js2-mode' in the typical format."
   (let ((test-name (intern (format "context-coloring-test-js2-mode-%s" name)))
         (fixture (format "./fixtures/%s.js" name))
-        (function-name (intern-soft (format "context-coloring-test-js-%s" 
name))))
+        (function-name (intern-soft
+                        (format "context-coloring-test-js-%s" name))))
     `(ert-deftest ,test-name ()
        (context-coloring-test-js2-mode
         ,fixture
@@ -153,10 +159,6 @@ region.  Provides the free variables `i', `length', 
`point',
          ,@body)
        (setq i (+ i 1)))))
 
-(defconst context-coloring-test-level-regexp
-  "context-coloring-level-\\([[:digit:]]+\\)-face"
-  "Regular expression for extracting a level from a face.")
-
 (defun context-coloring-test-assert-region-level (start end level)
   "Assert that all points in the range [START, END) are of level
 LEVEL."
@@ -164,7 +166,7 @@ LEVEL."
    (when (not (when face
                 (let* ((face-string (symbol-name face))
                        (matches (string-match
-                                 context-coloring-test-level-regexp
+                                 context-coloring-level-face-regexp
                                  face-string)))
                   (when matches
                     (setq actual-level (string-to-number
@@ -209,32 +211,69 @@ EXPECTED-FACE."
   (context-coloring-test-assert-region-face
    start end 'font-lock-string-face))
 
-(defun context-coloring-test-assert-message (expected)
-  "Assert that the *Messages* buffer has message EXPECTED."
-  (with-current-buffer "*Messages*"
+(defun context-coloring-test-assert-message (expected buffer)
+  "Assert that BUFFER has message EXPECTED."
+  (when (null (get-buffer buffer))
+    (ert-fail
+     (format
+      (concat
+       "Expected buffer `%s' to have message \"%s\", "
+       "but the buffer did not have any messages.")
+      buffer expected)))
+  (with-current-buffer buffer
     (let ((messages (split-string
                      (buffer-substring-no-properties
                       (point-min)
                       (point-max))
                      "\n")))
       (let ((message (car (nthcdr (- (length messages) 2) messages))))
-        (should (equal message expected))))))
-
-(defun context-coloring-test-assert-face (level foreground)
+        (when (not (equal message expected))
+          (ert-fail
+           (format
+            (concat
+             "Expected buffer `%s' to have message \"%s\", "
+             "but instead it was \"%s\"")
+            buffer expected
+            message)))))))
+
+(defun context-coloring-test-assert-no-message (buffer)
+  "Assert that BUFFER has no message."
+  (when (get-buffer buffer)
+    (ert-fail (format (concat "Expected buffer `%s' to have no messages, "
+                              "but it did: `%s'")
+                      buffer
+                      (with-current-buffer buffer
+                        (buffer-string))))))
+
+(defun context-coloring-test-kill-buffer (buffer)
+  "Kill BUFFER if it exists."
+  (if (get-buffer buffer) (kill-buffer buffer)))
+
+(defun context-coloring-test-assert-face (level foreground &optional negate)
   "Assert that a face for LEVEL exists and that its `:foreground'
 is FOREGROUND."
   (let* ((face (context-coloring-face-symbol level))
          actual-foreground)
-    (when (not face)
+    (when (not (or negate
+                   face))
       (ert-fail (format (concat "Expected face for level `%s' to exist; "
                                 "but it didn't")
                         level)))
     (setq actual-foreground (face-attribute face :foreground))
-    (when (not (string-equal foreground actual-foreground))
+    (when (funcall (if negate 'identity 'not)
+                   (string-equal foreground actual-foreground))
       (ert-fail (format (concat "Expected face for level `%s' "
-                                "to have foreground `%s'; but it was `%s'")
+                                "%sto have foreground `%s'; "
+                                "but it %s.")
                         level
-                        foreground actual-foreground)))))
+                        (if negate "not " "") foreground
+                        (if negate "did" (format "was `%s'" 
actual-foreground)))))))
+
+(defun context-coloring-test-assert-not-face (&rest arguments)
+  "Assert that LEVEL does not have a face with `:foreground'
+FOREGROUND."
+  (apply 'context-coloring-test-assert-face
+         (append arguments '(t))))
 
 
 ;;; The tests
@@ -244,7 +283,8 @@ is FOREGROUND."
    "./fixtures/function-scopes.js"
    (context-coloring-mode)
    (context-coloring-test-assert-message
-    "Context coloring is not available for this major mode")))
+    "Context coloring is not available for this major mode"
+    "*Messages*")))
 
 (ert-deftest context-coloring-test-set-colors ()
   ;; This test has an irreversible side-effect in that it defines faces beyond
@@ -272,6 +312,312 @@ is FOREGROUND."
   (context-coloring-test-assert-face 8 "#888888")
   (context-coloring-test-assert-face 9 "#999999"))
 
+(defvar context-coloring-test-theme-index 0
+  "Unique index for unique theme names.")
+
+(defun context-coloring-test-get-next-theme ()
+  "Return a unique symbol for a throwaway theme."
+  (prog1
+      (intern (format "context-coloring-test-theme-%s"
+                      context-coloring-test-theme-index))
+    (setq context-coloring-test-theme-index
+          (+ context-coloring-test-theme-index 1))))
+
+(defun context-coloring-test-assert-theme-originally-set-p
+    (settings &optional negate)
+  "Assert that `context-coloring-theme-originally-set-p' returns
+t for a theme with SETTINGS (or the inverse if NEGATE is
+non-nil)."
+  (let ((theme (context-coloring-test-get-next-theme)))
+    (put theme 'theme-settings settings)
+    (when (funcall (if negate 'identity 'not)
+                   (context-coloring-theme-originally-set-p theme))
+      (ert-fail (format (concat "Expected theme `%s' with settings `%s' "
+                                "%sto be considered to have defined a level, "
+                                "but it %s.")
+                        theme settings
+                        (if negate "not " "")
+                        (if negate "was" "wasn't"))))))
+
+(defun context-coloring-test-assert-not-theme-originally-set-p (&rest 
arguments)
+  "Assert that `context-coloring-theme-originally-set-p' does not
+return t for a theme with SETTINGS."
+  (apply 'context-coloring-test-assert-theme-originally-set-p
+         (append arguments '(t))))
+
+(ert-deftest context-coloring-test-theme-originally-set-p ()
+  (context-coloring-test-assert-theme-originally-set-p
+   '((theme-face context-coloring-level-0-face)))
+  (context-coloring-test-assert-theme-originally-set-p
+   '((theme-face face)
+     (theme-face context-coloring-level-0-face)))
+  (context-coloring-test-assert-theme-originally-set-p
+   '((theme-face context-coloring-level-0-face)
+     (theme-face face)))
+  (context-coloring-test-assert-not-theme-originally-set-p
+   '((theme-face face)))
+  )
+
+(defun context-coloring-test-assert-theme-settings-highest-level
+    (settings expected-level)
+  "Assert that a theme with SETTINGS has the highest level
+EXPECTED-LEVEL."
+  (let ((theme (context-coloring-test-get-next-theme)))
+    (put theme 'theme-settings settings)
+    (context-coloring-test-assert-theme-highest-level theme expected-level)))
+
+(defun context-coloring-test-assert-theme-highest-level
+    (theme expected-level &optional negate)
+  "Assert that THEME has the highest level EXPECTED-LEVEL."
+  (let ((highest-level (context-coloring-theme-highest-level theme)))
+    (when (funcall (if negate 'identity 'not) (eq highest-level 
expected-level))
+      (ert-fail (format (concat "Expected theme with settings `%s' "
+                                "%sto have a highest level of `%s', "
+                                "but it %s.")
+                        (get theme 'theme-settings)
+                        (if negate "not " "") expected-level
+                        (if negate "did" (format "was %s" highest-level)))))))
+
+(defun context-coloring-test-assert-theme-not-highest-level (&rest arguments)
+  "Assert that THEME's highest level is not EXPECTED-LEVEL."
+  (apply 'context-coloring-test-assert-theme-highest-level
+         (append arguments '(t))))
+
+(ert-deftest context-coloring-test-theme-highest-level ()
+  (context-coloring-test-assert-theme-settings-highest-level
+   '((theme-face foo))
+   -1)
+  (context-coloring-test-assert-theme-settings-highest-level
+   '((theme-face context-coloring-level-0-face))
+   0)
+  (context-coloring-test-assert-theme-settings-highest-level
+   '((theme-face context-coloring-level-1-face))
+   1)
+  (context-coloring-test-assert-theme-settings-highest-level
+   '((theme-face context-coloring-level-1-face)
+     (theme-face context-coloring-level-0-face))
+   1)
+  (context-coloring-test-assert-theme-settings-highest-level
+   '((theme-face context-coloring-level-0-face)
+     (theme-face context-coloring-level-1-face))
+   1)
+  )
+
+(defmacro context-coloring-test-deftest-define-theme (name &rest body)
+  "Define a test with an automatically-generated theme symbol
+available as a free variable `theme'.  Side-effects from enabling
+themes are reversed after the test completes."
+  (declare (indent defun))
+  (let ((deftest-name (intern
+                       (format "context-coloring-test-define-theme-%s" name))))
+    `(ert-deftest ,deftest-name ()
+       (context-coloring-test-kill-buffer "*Warnings*")
+       (let ((theme (context-coloring-test-get-next-theme)))
+         (unwind-protect
+             (progn
+               ,@body)
+           ;; Always cleanup.
+           (disable-theme theme)
+           (context-coloring-set-colors-default))))))
+
+(defun context-coloring-test-deftheme (theme)
+  "Dynamically define theme THEME."
+  (eval (macroexpand `(deftheme ,theme))))
+
+(context-coloring-test-deftest-define-theme additive
+  (context-coloring-test-deftheme theme)
+  (context-coloring-define-theme
+   theme
+   :colors '("#aaaaaa"
+             "#bbbbbb"))
+  (context-coloring-test-assert-no-message "*Warnings*")
+  (enable-theme theme)
+  (context-coloring-test-assert-no-message "*Warnings*")
+  (context-coloring-test-assert-face 0 "#aaaaaa")
+  (context-coloring-test-assert-face 1 "#bbbbbb"))
+
+(defun context-coloring-test-assert-defined-warning (theme)
+  "Assert that a warning about colors already being defined for
+theme THEME is signaled."
+  (context-coloring-test-assert-message
+   (format (concat "Warning (emacs): Context coloring colors for theme "
+                   "`%s' are already defined")
+           theme)
+   "*Warnings*"))
+
+(context-coloring-test-deftest-define-theme unintentional-override
+  (context-coloring-test-deftheme theme)
+  (custom-theme-set-faces
+   theme
+   '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
+   '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
+  (context-coloring-define-theme
+   theme
+   :colors '("#cccccc"
+             "#dddddd"))
+  (context-coloring-test-assert-defined-warning theme)
+  (context-coloring-test-kill-buffer "*Warnings*")
+  (enable-theme theme)
+  (context-coloring-test-assert-defined-warning theme)
+  (context-coloring-test-assert-face 0 "#cccccc")
+  (context-coloring-test-assert-face 1 "#dddddd"))
+
+(context-coloring-test-deftest-define-theme intentional-override
+  (context-coloring-test-deftheme theme)
+  (custom-theme-set-faces
+   theme
+   '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
+   '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
+  (context-coloring-define-theme
+   theme
+   :override t
+   :colors '("#cccccc"
+             "#dddddd"))
+  (context-coloring-test-assert-no-message "*Warnings*")
+  (enable-theme theme)
+  (context-coloring-test-assert-no-message "*Warnings*")
+  (context-coloring-test-assert-face 0 "#cccccc")
+  (context-coloring-test-assert-face 1 "#dddddd"))
+
+(context-coloring-test-deftest-define-theme pre-recede
+  (context-coloring-define-theme
+   theme
+   :recede t
+   :colors '("#aaaaaa"
+             "#bbbbbb"))
+  (context-coloring-test-deftheme theme)
+  (custom-theme-set-faces
+   theme
+   '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
+   '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
+  (enable-theme theme)
+  (context-coloring-test-assert-no-message "*Warnings*")
+  (context-coloring-test-assert-face 0 "#cccccc")
+  (context-coloring-test-assert-face 1 "#dddddd"))
+
+(context-coloring-test-deftest-define-theme post-recede
+  (context-coloring-test-deftheme theme)
+  (custom-theme-set-faces
+   theme
+   '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
+   '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
+  (context-coloring-define-theme
+   theme
+   :recede t
+   :colors '("#cccccc"
+             "#dddddd"))
+  (context-coloring-test-assert-no-message "*Warnings*")
+  (context-coloring-test-assert-face 0 "#aaaaaa")
+  (context-coloring-test-assert-face 1 "#bbbbbb")
+  (enable-theme theme)
+  (context-coloring-test-assert-no-message "*Warnings*")
+  (context-coloring-test-assert-face 0 "#aaaaaa")
+  (context-coloring-test-assert-face 1 "#bbbbbb"))
+
+(context-coloring-test-deftest-define-theme recede-not-defined
+  (context-coloring-test-deftheme theme)
+  (custom-theme-set-faces
+   theme
+   '(foo-face ((t (:foreground "#ffffff")))))
+  (context-coloring-define-theme
+   theme
+   :recede t
+   :colors '("#aaaaaa"
+             "#bbbbbb"))
+  (context-coloring-test-assert-no-message "*Warnings*")
+  (context-coloring-test-assert-face 0 "#aaaaaa")
+  (context-coloring-test-assert-face 1 "#bbbbbb")
+  (enable-theme theme)
+  (context-coloring-test-assert-no-message "*Warnings*")
+  (context-coloring-test-assert-face 0 "#aaaaaa")
+  (context-coloring-test-assert-face 1 "#bbbbbb"))
+
+(context-coloring-test-deftest-define-theme unintentional-obstinance
+  (context-coloring-define-theme
+   theme
+   :colors '("#aaaaaa"
+             "#bbbbbb"))
+  (context-coloring-test-deftheme theme)
+  (custom-theme-set-faces
+   theme
+   '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
+   '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
+  (enable-theme theme)
+  (context-coloring-test-assert-defined-warning theme)
+  (context-coloring-test-assert-face 0 "#aaaaaa")
+  (context-coloring-test-assert-face 1 "#bbbbbb"))
+
+(context-coloring-test-deftest-define-theme intentional-obstinance
+  (context-coloring-define-theme
+   theme
+   :override t
+   :colors '("#aaaaaa"
+             "#bbbbbb"))
+  (context-coloring-test-deftheme theme)
+  (custom-theme-set-faces
+   theme
+   '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
+   '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
+  (enable-theme theme)
+  (context-coloring-test-assert-no-message "*Warnings*")
+  (context-coloring-test-assert-face 0 "#aaaaaa")
+  (context-coloring-test-assert-face 1 "#bbbbbb"))
+
+(defun context-coloring-test-assert-face-count (count &optional negate)
+  "Assert that `context-coloring-face-count' is COUNT."
+  (when (funcall (if negate 'identity 'not)
+                 (eq context-coloring-face-count count))
+    (ert-fail (format (concat "Expected `context-coloring-face-count' "
+                              "%sto be `%s', "
+                              "but it %s.")
+                      (if negate "not " "") count
+                      (if negate
+                          "was"
+                        (format "was `%s'" context-coloring-face-count))))))
+
+(defun context-coloring-test-assert-not-face-count (&rest arguments)
+  "Assert that `context-coloring-face-count' is not COUNT."
+  (apply 'context-coloring-test-assert-face-count
+         (append arguments '(t))))
+
+(context-coloring-test-deftest-define-theme disable-cascade
+  (context-coloring-test-deftheme theme)
+  (context-coloring-define-theme
+   theme
+   :colors '("#aaaaaa"
+             "#bbbbbb"))
+  (let ((second-theme (context-coloring-test-get-next-theme)))
+    (context-coloring-test-deftheme second-theme)
+    (context-coloring-define-theme
+     second-theme
+     :colors '("#cccccc"
+               "#dddddd"
+               "#eeeeee"))
+    (let ((third-theme (context-coloring-test-get-next-theme)))
+      (context-coloring-test-deftheme third-theme)
+      (context-coloring-define-theme
+       third-theme
+       :colors '("#111111"
+                 "#222222"
+                 "#333333"
+                 "#444444"))
+      (enable-theme theme)
+      (enable-theme second-theme)
+      (enable-theme third-theme)
+      (disable-theme third-theme)
+      (context-coloring-test-assert-face 0 "#cccccc")
+      (context-coloring-test-assert-face 1 "#dddddd")
+      (context-coloring-test-assert-face 2 "#eeeeee")
+      (context-coloring-test-assert-face-count 3))
+    (disable-theme second-theme)
+    (context-coloring-test-assert-face 0 "#aaaaaa")
+    (context-coloring-test-assert-face 1 "#bbbbbb")
+    (context-coloring-test-assert-face-count 2))
+  (disable-theme theme)
+  (context-coloring-test-assert-not-face 0 "#aaaaaa")
+  (context-coloring-test-assert-not-face 1 "#bbbbbb")
+  (context-coloring-test-assert-not-face-count 2))
+
 (defun context-coloring-test-js-function-scopes ()
   (context-coloring-test-assert-region-level 1 9 0)
   (context-coloring-test-assert-region-level 9 23 1)