[elpa] master 2875503 04/31: Write and pass tests for context-coloring-define-theme and recede and override properties.

[Jackson Ray Hamilton]

branch: master
commit 2875503d488a8f358400c1d863200f3e854530b4
Author: Jackson Ray Hamilton <address@hidden>
Commit: Jackson Ray Hamilton <address@hidden>

    Write and pass tests for context-coloring-define-theme and recede and 
override properties.
---
 context-coloring.el           |   35 +++++++--
 test/context-coloring-test.el |  156 +++++++++++++++++++++++++++++++++++++++--
 2 files changed, 179 insertions(+), 12 deletions(-)

diff --git a/context-coloring.el b/context-coloring.el
index 2dcf183..5f2a433 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -500,6 +500,10 @@ for THEME, nil otherwise."
       (setq tail (cdr tail)))
     found))
 
+(defun context-coloring-warn-theme-defined (theme)
+  "Warns the user that the colors for a theme are already defined."
+  (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' defined for THEME, or -1 if there
@@ -545,10 +549,12 @@ which must already exist and which *should* already be 
enabled."
 PROPERTIES is a property list specifiying the following details:
 
 `:colors': List of colors that this theme uses."
-  (let ((aliases (plist-get properties :aliases)))
+  (let ((aliases (plist-get properties :aliases))
+        (override (plist-get properties :override)))
     (dolist (name (append `(,theme) aliases))
-      (when (context-coloring-theme-definedp name)
-        (warn "Colors for `%s' are already defined" name))
+      (when (and (not override)
+                 (context-coloring-theme-definedp name))
+        (context-coloring-warn-theme-defined name))
       (puthash name properties context-coloring-theme-hash-table)
       ;; Set (or overwrite) colors.
       (when (custom-theme-p name)
@@ -564,12 +570,22 @@ PROPERTIES is a property list specifiying the following 
details:
   "Applies THEME if its colors are not already defined, else just
 sets `context-coloring-face-count' to the correct value for
 THEME."
-  (let ((highest-level (context-coloring-theme-highest-level theme)))
+  (let* ((properties (gethash theme context-coloring-theme-hash-table))
+         (recede (plist-get properties :recede))
+         (override (plist-get properties :override)))
     (cond
-     ((> highest-level -1)
-      (setq context-coloring-face-count (+ highest-level 1)))
+     (recede
+      (let ((highest-level (context-coloring-theme-highest-level theme)))
+        (cond
+         ((> highest-level -1)
+          (setq context-coloring-face-count (+ highest-level 1)))
+         (t
+          (context-coloring-apply-theme theme)))))
      (t
-      (context-coloring-apply-theme theme)))))
+      (let ((defined (context-coloring-theme-definedp theme)))
+        (when (and defined (not override))
+          (context-coloring-warn-theme-defined theme))
+        (context-coloring-apply-theme theme))))))
 
 (defadvice enable-theme (after context-coloring-enable-theme (theme) activate)
   "Enable colors for themes just-in-time.  We can't set faces for
@@ -581,6 +597,7 @@ themes that might not exist yet."
 
 (context-coloring-define-theme
  'leuven
+ :recede t
  :colors '("#333333"
            "#0000FF"
            "#6434A3"
@@ -593,6 +610,7 @@ themes that might not exist yet."
 
 (context-coloring-define-theme
  'monokai
+ :recede t
  :colors '("#F8F8F2"
            "#66D9EF"
            "#A1EFE4"
@@ -605,6 +623,7 @@ themes that might not exist yet."
 
 (context-coloring-define-theme
  'solarized
+ :recede t
  :aliases '(solarized-light
             solarized-dark
             sanityinc-solarized-light
@@ -629,6 +648,7 @@ themes that might not exist yet."
 
 (context-coloring-define-theme
  'tango
+ :recede t
  :colors '("#2e3436"
            "#346604"
            "#204a87"
@@ -645,6 +665,7 @@ themes that might not exist yet."
 
 (context-coloring-define-theme
  'zenburn
+ :recede t
  :colors '("#DCDCCC"
            "#93E0E3"
            "#BFEBBF"
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 168b6fa..c6a29e6 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -19,6 +19,9 @@
 
 ;;; Code:
 
+(require 'ert-async)
+
+
 ;;; Test running utilities
 
 (defconst context-coloring-test-path
@@ -205,16 +208,31 @@ 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."
+  (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))))))
+        (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."
+  (null (get-buffer buffer)))
+
+(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)
   "Assert that a face for LEVEL exists and that its `:foreground'
@@ -240,7 +258,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
@@ -331,6 +350,133 @@ t for a theme with SETTINGS."
    1)
   )
 
+(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-deftheme (theme)
+  (eval (macroexpand `(deftheme ,theme))))
+
+(defmacro context-coloring-test-deftest-define-theme (name &rest body)
+  (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))))))
+
+(context-coloring-test-deftest-define-theme preexisting-set
+  (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)
+  (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 preexisting-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 preexisting-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 preexisting-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 
preexisting-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 preexisting-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-js-function-scopes ()
   (context-coloring-test-assert-region-level 1 9 0)
   (context-coloring-test-assert-region-level 9 23 1)