branch: master
commit 06a760614d1fc4443d421e08765f0efeeeb58a29
Author: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Commit: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Pass / update tests for warnings.
---
context-coloring.el | 61 +++++++++++++++++++++++++++++------------
test/context-coloring-test.el | 43 +++++++++++++++++------------
2 files changed, 68 insertions(+), 36 deletions(-)
diff --git a/context-coloring.el b/context-coloring.el
index 0f2f9fa3..4d6c172 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -485,20 +485,40 @@ would be redundant."
"context-coloring-level-\\([[:digit:]]+\\)-face"
"Regular expression for extracting a level from a face.")
+(defvar context-coloring-defined-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-definedp (theme)
"Return t if there is a `context-coloring-level-N-face' defined
for THEME, nil otherwise."
- (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))
+ (let (defined)
+ (cond
+ ((setq defined (gethash theme context-coloring-defined-theme-hash-table))
+ (eq defined 'defined))
+ (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-defined (theme defined)
+ "Remember if THEME had colors defined for it; if DEFINED is
+non-nil, it did, otherwise it didn't."
+ ;; Caching the definededness of a theme 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 defined 'defined 'undefined)
+ context-coloring-defined-theme-hash-table))
(defun context-coloring-warn-theme-defined (theme)
"Warns the user that the colors for a theme are already defined."
@@ -575,14 +595,17 @@ theme's author's colors instead."
(override (plist-get properties :override))
(recede (plist-get properties :recede)))
(dolist (name (append `(,theme) aliases))
- (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 (and (custom-theme-p name)
- (not recede))
- (context-coloring-apply-theme name)))))
+ (when (custom-theme-p name)
+ (let ((defined (context-coloring-theme-definedp name)))
+ (context-coloring-cache-defined name defined)
+ (when (and defined
+ (not recede)
+ (not override))
+ (context-coloring-warn-theme-defined name)))
+ ;; Set (or overwrite) colors.
+ (when (not recede)
+ (context-coloring-apply-theme name))))))
(defun context-coloring-load-theme (&optional rest)
(declare
@@ -607,6 +630,8 @@ THEME."
(context-coloring-apply-theme theme)))))
(t
(let ((defined (context-coloring-theme-definedp theme)))
+ ;; Cache now in case the theme was defined after.
+ (context-coloring-cache-defined theme defined)
(when (and defined
(not override))
(context-coloring-warn-theme-defined theme))
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 5a55f28..9b636cc 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -210,6 +210,13 @@ EXPECTED-FACE."
(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
@@ -292,16 +299,27 @@ 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-definedp (settings &optional negate)
"Assert that `context-coloring-theme-definedp' returns t for a
theme with SETTINGS (or the inverse if NEGATE is non-nil)."
- (let (theme)
+ (let ((theme (context-coloring-test-get-next-theme)))
(put theme 'theme-settings settings)
(when (funcall (if negate 'identity 'not) (context-coloring-theme-definedp
theme))
- (ert-fail (format (concat "Expected theme with settings `%s' "
+ (ert-fail (format (concat "Expected theme `%s' with settings `%s' "
"%sto be considered to have defined a level, "
"but it %s.")
- settings
+ theme settings
(if negate "not " "")
(if negate "was" "wasn't"))))))
@@ -355,20 +373,6 @@ 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))))
@@ -382,6 +386,9 @@ t for a theme with SETTINGS."
(disable-theme theme)
(context-coloring-set-colors-default))))))
+(defun context-coloring-test-deftheme (theme)
+ (eval (macroexpand `(deftheme ,theme))))
+
(context-coloring-test-deftest-define-theme additive
(context-coloring-test-deftheme theme)
(context-coloring-define-theme
@@ -414,7 +421,7 @@ t for a theme with SETTINGS."
(context-coloring-test-assert-defined-warning theme)
(context-coloring-test-kill-buffer "*Warnings*")
(enable-theme theme)
- (context-coloring-test-assert-no-message "*Warnings*")
+ (context-coloring-test-assert-defined-warning theme)
(context-coloring-test-assert-face 0 "#cccccc")
(context-coloring-test-assert-face 1 "#dddddd"))
