From: Jackson Ray Hamilton Date: Sat, 20 Jun 2015 10:56:27 +0000 (-0700) Subject: Remove automatic theming. X-Git-Url: https://code.delx.au/gnu-emacs-elpa/commitdiff_plain/cbffe2a5feafd41375dac392959a8a25a6f309c3 Remove automatic theming. --- diff --git a/README.md b/README.md index bf6bd936b..787403ece 100644 --- a/README.md +++ b/README.md @@ -13,7 +13,6 @@ By default, comments and strings are still highlighted syntactically. ## Features -- Light and dark (customizable) color schemes. - JavaScript support: - Script, function and block scopes (and even `catch` block scopes). - Very fast for files under 1000 lines. @@ -43,9 +42,32 @@ init file: (add-hook 'minibuffer-setup-hook #'context-coloring-mode) ``` -## Customizing +## Color Schemes -### Options +There is *no default color scheme*. Define the colors according to your liking +by setting the appropriate custom faces and the maximum face: + +```lisp +(custom-theme-set-faces + 'zenburn + '(context-coloring-level-0-face ((t :foreground "#dcdccc"))) + '(context-coloring-level-1-face ((t :foreground "#93e0e3"))) + '(context-coloring-level-2-face ((t :foreground "#bfebbf"))) + '(context-coloring-level-3-face ((t :foreground "#f0dfaf"))) + '(context-coloring-level-4-face ((t :foreground "#dfaf8f"))) + '(context-coloring-level-5-face ((t :foreground "#cc9393"))) + '(context-coloring-level-6-face ((t :foreground "#dc8cc3"))) + '(context-coloring-level-7-face ((t :foreground "#94bff3"))) + '(context-coloring-level-8-face ((t :foreground "#9fc59f"))) + '(context-coloring-level-9-face ((t :foreground "#d0bf8f"))) + '(context-coloring-level-10-face ((t :foreground "#dca3a3")))) +(setq context-coloring-maximum-face 10) +``` + +[See here](https://gist.github.com/jacksonrayhamilton/6b89ca3b85182c490816) for +some color schemes for popular custom themes. + +## Options - `context-coloring-syntactic-comments` (default: `t`): If non-nil, also color comments using `font-lock`. @@ -55,30 +77,3 @@ init file: buffer update and colorization. - `context-coloring-javascript-block-scopes` (default: `nil`): If non-nil, also color block scopes in the scope hierarchy in JavaScript. - -### Color Schemes - -Color schemes for custom themes are automatically applied when those themes are -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: - -```lisp -(context-coloring-define-theme - 'zenburn - :colors '("#dcdccc" - "#93e0e3" - "#bfebbf" - "#f0dfaf" - "#dfaf8f" - "#cc9393" - "#dc8cc3" - "#94bff3" - "#9fc59f" - "#d0bf8f" - "#dca3a3")) -``` - -See `C-h f context-coloring-define-theme` for more info on theme parameters. diff --git a/context-coloring.el b/context-coloring.el index 51310403c..5773b4094 100644 --- a/context-coloring.el +++ b/context-coloring.el @@ -46,51 +46,14 @@ ;;; Faces -(defun context-coloring-defface (level tty light dark) - "Define a face for LEVEL with colors for TTY, LIGHT and DARK -backgrounds." +;; Create placeholder faces for users to populate. +(dotimes (level 25) (let ((face (intern (format "context-coloring-level-%s-face" level))) (doc (format "Context coloring face, level %s." level))) - (custom-declare-face - face - `((((type tty)) (:foreground ,tty)) - (((background light)) (:foreground ,light)) - (((background dark)) (:foreground ,dark))) - doc - :group 'context-coloring))) - -(defun context-coloring-defface-neutral (level) - "Define a face for LEVEL with the default neutral colors." - (context-coloring-defface level nil "#3f3f3f" "#cdcdcd")) - -(context-coloring-defface 0 nil "#000000" "#ffffff") -(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 - "Index of the highest face available for coloring.") - -(defvar context-coloring-original-maximum-face nil - "Fallback value for `context-coloring-maximum-face' when all -themes have been disabled.") - -(setq context-coloring-maximum-face 7) - -(setq context-coloring-original-maximum-face - context-coloring-maximum-face) - -;; Theme authors can have up to 26 levels: 1 (0th) for globals, 24 (1st-24th) -;; for nested levels, and 1 (25th) for infinity. -(dotimes (number 18) - (context-coloring-defface-neutral (+ number context-coloring-maximum-face 1))) + (custom-declare-face face nil doc :group 'context-coloring))) - -;;; Face functions +(defvar context-coloring-maximum-face 24 + "Index of the highest face available for coloring.") (defsubst context-coloring-level-face (level) "Return the symbol for a face with LEVEL." @@ -1127,349 +1090,6 @@ the current buffer, then execute it." (context-coloring-colorize)))) -;;; Themes - -(defvar context-coloring-theme-hash-table (make-hash-table :test #'eq) - "Map 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" - "Extract a level from a face.") - -(defvar context-coloring-originally-set-theme-hash-table - (make-hash-table :test #'eq) - "Cache 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) - "Warn the user that the colors for 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) - "Apply 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)) - (colors (plist-get properties :colors)) - (level -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 - (mapcar - (lambda (color) - (setq level (+ level 1)) - `(,(context-coloring-level-face level) ((t (:foreground ,color))))) - colors)))) - -(defun context-coloring-define-theme (theme &rest properties) - "Define a context theme named THEME for coloring scope levels. - -PROPERTIES is a property list specifiying the following details: - -`: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) - (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) - "Apply THEME if its colors are not already set, else just set -`context-coloring-maximum-face' 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-maximum-face highest-level)) - ;; 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) - "Enable colors for context themes just-in-time." - (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) 1) - ;; Cache because we can't reliably figure it out in reverse. - (setq context-coloring-original-maximum-face - context-coloring-maximum-face)) - (context-coloring-enable-theme theme))) - -(defadvice disable-theme (after context-coloring-disable-theme (theme) activate) - "Update `context-coloring-maximum-face'." - (when (custom-theme-p theme) ; Guard against non-existent themes. - (let ((enabled-theme (car custom-enabled-themes))) - (cond - ((context-coloring-theme-p enabled-theme) - (context-coloring-enable-theme enabled-theme)) - (t - ;; Assume we are back to no theme; act as if nothing ever happened. - ;; This is still prone to intervention, but rather extraordinarily. - (setq context-coloring-maximum-face - context-coloring-original-maximum-face)))))) - -(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" - "#ba36a5" - "#d0372d" - "#036a07" - "#006699" - "#006fe0" - "#808080")) - -(context-coloring-define-theme - 'monokai - :recede t - :colors '("#f8f8f2" - "#66d9ef" - "#a1efe4" - "#a6e22e" - "#e6db74" - "#fd971f" - "#f92672" - "#fd5ff0" - "#ae81ff")) - -(context-coloring-define-theme - 'solarized - :recede t - :aliases '(solarized-light - solarized-dark - sanityinc-solarized-light - sanityinc-solarized-dark) - :colors '("#839496" - "#268bd2" - "#2aa198" - "#859900" - "#b58900" - "#cb4b16" - "#dc322f" - "#d33682" - "#6c71c4" - "#69b7f0" - "#69cabf" - "#b4c342" - "#deb542" - "#f2804f" - "#ff6e64" - "#f771ac" - "#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" - "#5c3566" - "#a40000" - "#b35000" - "#c4a000" - "#8ae234" - "#8cc4ff" - "#ad7fa8" - "#ef2929" - "#fcaf3e" - "#fce94f")) - -(context-coloring-define-theme - 'zenburn - :recede t - :colors '("#dcdccc" - "#93e0e3" - "#bfebbf" - "#f0dfaf" - "#dfaf8f" - "#cc9393" - "#dc8cc3" - "#94bff3" - "#9fc59f" - "#d0bf8f" - "#dca3a3")) - - ;;; Built-in dispatches (context-coloring-define-dispatch diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el index 3eb66bdeb..9a22cd213 100644 --- a/test/context-coloring-test.el +++ b/test/context-coloring-test.el @@ -59,18 +59,16 @@ buffer." &key extension &key no-fixture &key enable-context-coloring-mode - &key get-args &key before-each &key after-each) "Define a deftest defmacro for tests prefixed with NAME. MODE is called to set up tests' environments. EXTENSION denotes the suffix for tests' fixture files. If NO-FIXTURE is non-nil, don't use a fixture. If ENABLE-CONTEXT-COLORING-MODE is non-nil, -`context-coloring-mode' is activated before tests. GET-ARGS -provides arguments to apply to BEFORE-EACH, AFTER-EACH, and each -tests' body, before and after functions. Functions BEFORE-EACH -and AFTER-EACH run before the major mode is activated before each -test, and after each test, even if an error is signaled." +`context-coloring-mode' is activated before tests. Functions +BEFORE-EACH and AFTER-EACH run before the major mode is activated +before each test, and after each test, even if an error is +signaled." (declare (indent defun)) (let ((macro-name (intern (format "context-coloring-test-deftest%s" (cond @@ -86,10 +84,6 @@ test, and after each test, even if an error is signaled." ;; Commas in nested backquotes are not evaluated. Binding the variables ;; here is probably the cleanest workaround. (let ((mode ,mode) - (get-args ',(cond - (get-args get-args) - (t '(lambda () (list))))) - (args (make-symbol "args")) (before-each ',before-each) (after-each ',after-each) (test-name (intern (format ,(format "%s-%%s" @@ -102,18 +96,17 @@ test, and after each test, even if an error is signaled." (t (format ,(format "./fixtures/%%s.%s" extension) name))))) ,@`((let ((enable-context-coloring-mode ,enable-context-coloring-mode)) `(ert-deftest ,test-name () - (let ((,args (funcall ,get-args))) - (context-coloring-test-with-fixture - ,fixture - (when ,before-each (apply ,before-each ,args)) - (,mode) - (when ,before (apply ,before ,args)) - (when ,enable-context-coloring-mode (context-coloring-mode)) - (unwind-protect - (progn - (apply ,body ,args)) - (when ,after (apply ,after ,args)) - (when ,after-each (apply ,after-each ,args)))))))))))) + (context-coloring-test-with-fixture + ,fixture + (when ,before-each (funcall ,before-each)) + (,mode) + (when ,before (funcall ,before)) + (when ,enable-context-coloring-mode (context-coloring-mode)) + (unwind-protect + (progn + (funcall ,body)) + (when ,after (funcall ,after)) + (when ,after-each (funcall ,after-each))))))))))) (context-coloring-test-define-deftest nil :mode #'fundamental-mode @@ -136,18 +129,6 @@ test, and after each test, even if an error is signaled." :mode #'fundamental-mode :no-fixture t) -(context-coloring-test-define-deftest define-theme - :mode #'fundamental-mode - :no-fixture t - :get-args (lambda () - (list (context-coloring-test-get-next-theme))) - :after-each (lambda (theme) - (setq context-coloring-maximum-face 7) - (setq context-coloring-original-maximum-face - context-coloring-maximum-face) - (disable-theme theme) - (context-coloring-test-kill-buffer "*Warnings*"))) - ;;; Assertion functions @@ -193,15 +174,6 @@ test, and after each test, even if an error is signaled." "but it did") buffer expected))))))) -(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-assert-error (body error-message) "Assert that BODY signals ERROR-MESSAGE." (let ((error-signaled-p nil)) @@ -324,364 +296,6 @@ test, and after each test, even if an error is signaled." (ert-fail "Expected teardown function to have been called, but it wasn't."))))) -;;; Theme tests - -(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-face (level foreground &optional negate) - "Assert that a face for LEVEL exists and that its `:foreground' -is FOREGROUND, or the inverse if NEGATE is non-nil." - (let* ((face (context-coloring-level-face level)) - actual-foreground) - (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 (funcall (if negate #'identity #'not) - (string-equal foreground actual-foreground)) - (ert-fail (format (concat "Expected face for level `%s' " - "%sto have foreground `%s'; " - "but it %s.") - level - (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 ARGUMENTS to -`context-coloring-test-assert-face', see that function." - (apply #'context-coloring-test-assert-face - (append arguments '(t)))) - -(defun context-coloring-test-assert-theme-originally-set-p - (settings &optional negate) - "Assert that `context-coloring-theme-originally-set-p' will -return 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 ARGUMENTS to -`context-coloring-test-assert-theme-originally-set-p', see that -function." - (apply #'context-coloring-test-assert-theme-originally-set-p - (append arguments '(t)))) - -(context-coloring-test-deftest theme-originally-set-p - (lambda () - (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, or the -inverse if NEGATE is non-nil." - (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 ARGUMENTS to -`context-coloring-test-assert-theme-highest-level', see that -function." - (apply #'context-coloring-test-assert-theme-highest-level - (append arguments '(t)))) - -(context-coloring-test-deftest theme-highest-level - (lambda () - (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))) - -(defun context-coloring-test-kill-buffer (buffer) - "Kill BUFFER if it exists." - (when (get-buffer buffer) (kill-buffer buffer))) - -(defun context-coloring-test-deftheme (theme) - "Dynamically define theme THEME." - (eval (macroexpand `(deftheme ,theme)))) - -(context-coloring-test-deftest-define-theme additive - (lambda (theme) - (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 - (lambda (theme) - (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 - (lambda (theme) - (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 - (lambda (theme) - (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 pre-recede-delayed-application - (lambda (theme) - (context-coloring-define-theme - theme - :recede t - :colors '("#aaaaaa" - "#bbbbbb")) - (context-coloring-test-deftheme theme) - (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 post-recede - (lambda (theme) - (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 - (lambda (theme) - (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 - (lambda (theme) - (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 - (lambda (theme) - (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-maximum-face (maximum &optional negate) - "Assert that `context-coloring-maximum-face' is MAXIMUM, or the -inverse if NEGATE is non-nil." - (when (funcall (if negate #'identity #'not) - (eq context-coloring-maximum-face maximum)) - (ert-fail (format (concat "Expected `context-coloring-maximum-face' " - "%sto be `%s', " - "but it %s.") - (if negate "not " "") maximum - (if negate - "was" - (format "was `%s'" context-coloring-maximum-face)))))) - -(defun context-coloring-test-assert-not-maximum-face (&rest arguments) - "Assert that `context-coloring-maximum-face' is not MAXIMUM. -Apply ARGUMENTS to `context-coloring-test-assert-maximum-face', -see that function." - (apply #'context-coloring-test-assert-maximum-face - (append arguments '(t)))) - -(context-coloring-test-deftest-define-theme disable-cascade - (lambda (theme) - (let ((maximum-face-value 9999)) - (setq context-coloring-maximum-face maximum-face-value) - (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-maximum-face 2)) - (disable-theme second-theme) - (context-coloring-test-assert-face 0 "#aaaaaa") - (context-coloring-test-assert-face 1 "#bbbbbb") - (context-coloring-test-assert-maximum-face 1)) - (disable-theme theme) - (context-coloring-test-assert-not-face 0 "#aaaaaa") - (context-coloring-test-assert-not-face 1 "#bbbbbb") - (context-coloring-test-assert-maximum-face - maximum-face-value)))) - - ;;; Coloring tests (defun context-coloring-test-assert-position-level (position level) @@ -691,7 +305,7 @@ see that function." (when (not (and face (let* ((face-string (symbol-name face)) (matches (string-match - context-coloring-level-face-regexp + "context-coloring-level-\\([[:digit:]]+\\)-face" face-string))) (when matches (setq actual-level (string-to-number