branch: master
commit 2875503d488a8f358400c1d863200f3e854530b4
Author: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Commit: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
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)
