diff options
| -rw-r--r-- | scripts/theme-studio/build-theme.el | 144 | ||||
| -rwxr-xr-x | scripts/theme-studio/run-tests.sh | 14 | ||||
| -rw-r--r-- | tests/test-build-theme.el | 216 |
3 files changed, 286 insertions, 88 deletions
diff --git a/scripts/theme-studio/build-theme.el b/scripts/theme-studio/build-theme.el index ebfc2eb5c..e0a86f111 100644 --- a/scripts/theme-studio/build-theme.el +++ b/scripts/theme-studio/build-theme.el @@ -71,6 +71,17 @@ independently is not possible without clobbering types.") "Non-nil when S is a \"#rrggbb\" hex color string." (and (stringp s) (string-match-p "\\`#[0-9a-fA-F]\\{6\\}\\'" s))) +(defun build-theme/--obj-get (obj key) + "Value of KEY in alist OBJ, or nil." + (cdr (assq key obj))) + +(defun build-theme/--inherit-symbol (value) + "Coerce an inherit VALUE (a face-name string, symbol, or nil) to a symbol." + (cond ((null value) nil) + ((symbolp value) value) + ((stringp value) (intern value)) + (t nil))) + (defun build-theme/--box (box) "Convert a box spec alist (style/color/width) to an Emacs `:box' value, or nil. STYLE is \"line\", \"released\", or \"pressed\"; WIDTH defaults to 1; COLOR (a hex @@ -88,23 +99,72 @@ unset." (list :line-width width))) (t nil))))) -(defun build-theme/--attrs (inherit fg bg bold italic underline strike height &optional box) - "Build a face-attribute plist from the given fields, in canonical order. -INHERIT is a face symbol or nil. FG and BG are hex strings or nil. BOLD, -ITALIC, UNDERLINE, and STRIKE are booleans. HEIGHT is a float multiplier; 1.0 -(or nil) is omitted as the default. BOX is a box spec alist or nil. Only set -attributes are written, so a fully-nil face yields an empty plist." - (let ((plist nil) (bx (build-theme/--box box))) - (when bx (setq plist (list :box bx))) - (when (and height (numberp height) (/= height 1.0)) - (setq plist (append (list :height height) plist))) - (when strike (setq plist (append (list :strike-through t) plist))) - (when underline (setq plist (append (list :underline t) plist))) - (when italic (setq plist (append (list :slant 'italic) plist))) - (when bold (setq plist (append (list :weight 'bold) plist))) - (when bg (setq plist (append (list :background bg) plist))) - (when fg (setq plist (append (list :foreground fg) plist))) - (when inherit (setq plist (append (list :inherit inherit) plist))) +(defun build-theme/--weight (obj) + "Weight symbol for OBJ: explicit `weight' string, else the legacy `bold' flag." + (let ((w (build-theme/--obj-get obj 'weight))) + (cond ((and (stringp w) (> (length w) 0)) (intern w)) + ((build-theme/--obj-get obj 'bold) 'bold)))) + +(defun build-theme/--slant (obj) + "Slant symbol for OBJ: explicit `slant' string, else the legacy `italic' flag." + (let ((s (build-theme/--obj-get obj 'slant))) + (cond ((and (stringp s) (> (length s) 0)) (intern s)) + ((build-theme/--obj-get obj 'italic) 'italic)))) + +(defun build-theme/--line-attr (val) + "Coerce an overline/strike-through VAL to an Emacs attribute value. +nil and t pass through; a {color: C} alist becomes C, or t when COLOR is unset. +Tolerates the legacy boolean form." + (cond ((null val) nil) + ((eq val t) t) + ((consp val) (or (build-theme/--obj-get val 'color) t)) + (t t))) + +(defun build-theme/--underline (obj) + "Underline attribute value for OBJ. +nil when unset. t is a plain line in the face color. A color or wave style +yields a (:color C :style S) plist. Tolerates the legacy boolean form." + (let ((u (build-theme/--obj-get obj 'underline))) + (cond ((null u) nil) + ((eq u t) t) + ((consp u) + (let* ((color (build-theme/--obj-get u 'color)) + (style (build-theme/--obj-get u 'style)) + (wave (and (stringp style) (not (equal style "line")) (intern style)))) + (cond ((and color wave) (list :color color :style wave)) + (color (list :color color)) + (wave (list :style wave)) + (t t)))) + (t t)))) + +(defun build-theme/--attrs (obj) + "Build a face-attribute plist from face-spec alist OBJ, in canonical order. +Reads the full attribute model -- inherit, family, fg/bg, distant-foreground, +weight, slant, height, underline, overline, strike-through, box, inverse-video, +extend -- and tolerates the older boolean bold/italic/underline/strike fields. +Only attributes that are set appear, so a blank face yields nil." + (let* ((height (build-theme/--obj-get obj 'height)) + (family (build-theme/--obj-get obj 'family)) + (pairs + (list + (cons :inherit (build-theme/--inherit-symbol (build-theme/--obj-get obj 'inherit))) + (cons :family (and (stringp family) (> (length family) 0) family)) + (cons :foreground (build-theme/--obj-get obj 'fg)) + (cons :background (build-theme/--obj-get obj 'bg)) + (cons :distant-foreground (build-theme/--obj-get obj 'distant-fg)) + (cons :weight (build-theme/--weight obj)) + (cons :slant (build-theme/--slant obj)) + (cons :height (and (numberp height) (/= height 1.0) height)) + (cons :underline (build-theme/--underline obj)) + (cons :overline (build-theme/--line-attr (build-theme/--obj-get obj 'overline))) + (cons :strike-through (build-theme/--line-attr (build-theme/--obj-get obj 'strike))) + (cons :box (build-theme/--box (build-theme/--obj-get obj 'box))) + (cons :inverse-video (and (build-theme/--obj-get obj 'inverse) t)) + (cons :extend (and (build-theme/--obj-get obj 'extend) t)))) + (plist nil)) + (dolist (pair pairs) + (when (cdr pair) + (setq plist (nconc plist (list (car pair) (cdr pair)))))) plist)) (defun build-theme/--face-spec (face attrs) @@ -113,17 +173,6 @@ Return nil when ATTRS is empty, so cleared faces emit nothing." (when attrs (list face (list (list t attrs))))) -(defun build-theme/--obj-get (obj key) - "Value of KEY in alist OBJ, or nil." - (cdr (assq key obj))) - -(defun build-theme/--inherit-symbol (value) - "Coerce an inherit VALUE (a face-name string, symbol, or nil) to a symbol." - (cond ((null value) nil) - ((symbolp value) value) - ((stringp value) (intern value)) - (t nil))) - ;;; --------------------------------------------------------------------------- ;;; Tiers @@ -131,7 +180,7 @@ Return nil when ATTRS is empty, so cleared faces emit nothing." "Build the `default' face spec from SYNTAX bg / p entries." (let ((bg (build-theme/--obj-get (build-theme/--obj-get syntax 'bg) 'fg)) (fg (build-theme/--obj-get (build-theme/--obj-get syntax 'p) 'fg))) - (build-theme/--face-spec 'default (build-theme/--attrs nil fg bg nil nil nil nil nil)))) + (build-theme/--face-spec 'default (build-theme/--attrs (list (cons 'fg fg) (cons 'bg bg)))))) (defun build-theme/--syntax-face-specs (syntax) "Build syntax-tier face specs from SYNTAX. @@ -143,35 +192,19 @@ Each category fans out to the font-lock faces in (faces (cdr pair)) (obj (build-theme/--obj-get syntax cat))) (when obj - (let ((attrs (build-theme/--attrs nil - (build-theme/--obj-get obj 'fg) - (build-theme/--obj-get obj 'bg) - (build-theme/--obj-get obj 'bold) - (build-theme/--obj-get obj 'italic) - (build-theme/--obj-get obj 'underline) - (build-theme/--obj-get obj 'strike) - nil - (build-theme/--obj-get obj 'box)))) + (let ((attrs (build-theme/--attrs obj))) (dolist (face faces) (when-let ((spec (build-theme/--face-spec face attrs))) (push spec specs))))))) (nreverse specs))) (defun build-theme/--ui-face-specs (ui) - "Build UI-tier face specs from the UI alist (face -> {fg,bg,bold,italic})." + "Build UI-tier face specs from the UI alist (face -> attribute alist)." (let (specs) (dolist (entry ui) (let* ((face (car entry)) (obj (cdr entry)) - (attrs (build-theme/--attrs nil - (build-theme/--obj-get obj 'fg) - (build-theme/--obj-get obj 'bg) - (build-theme/--obj-get obj 'bold) - (build-theme/--obj-get obj 'italic) - (build-theme/--obj-get obj 'underline) - (build-theme/--obj-get obj 'strike) - nil - (build-theme/--obj-get obj 'box)))) + (attrs (build-theme/--attrs obj))) (when-let ((spec (build-theme/--face-spec face attrs))) (push spec specs)))) (nreverse specs))) @@ -183,16 +216,7 @@ Each category fans out to the font-lock faces in (dolist (entry (cdr app)) (let* ((face (car entry)) (obj (cdr entry)) - (attrs (build-theme/--attrs - (build-theme/--inherit-symbol (build-theme/--obj-get obj 'inherit)) - (build-theme/--obj-get obj 'fg) - (build-theme/--obj-get obj 'bg) - (build-theme/--obj-get obj 'bold) - (build-theme/--obj-get obj 'italic) - (build-theme/--obj-get obj 'underline) - (build-theme/--obj-get obj 'strike) - (build-theme/--obj-get obj 'height) - (build-theme/--obj-get obj 'box)))) + (attrs (build-theme/--attrs obj))) (when-let ((spec (build-theme/--face-spec face attrs))) (push spec specs))))) (nreverse specs))) @@ -248,8 +272,8 @@ Signal a `file-missing' error when JSON-FILE does not exist." "Convert JSON-FILE (a theme.json export) into a deftheme file. Write themes/<name>-theme.el, where <name> is JSON-FILE's basename, into OUT-DIR (default: the themes/ directory of this repo). The basename names the -theme so each export lands under its own file (sterling.json -> sterling-theme.el), -rather than colliding on whatever the JSON's internal name field happens to be. +theme so each export lands under its own file (sterling.json becomes +sterling-theme.el), not the name field inside the JSON. Return the written path." (let* ((data (build-theme/--parse json-file)) (name (file-name-base json-file)) diff --git a/scripts/theme-studio/run-tests.sh b/scripts/theme-studio/run-tests.sh index 6666fb0b9..ab9c351ad 100755 --- a/scripts/theme-studio/run-tests.sh +++ b/scripts/theme-studio/run-tests.sh @@ -41,6 +41,20 @@ if node --test ./*.mjs >/tmp/ts-node.log 2>&1; then pass_msg "Node unit tests ($(grep -E '^. tests' /tmp/ts-node.log | grep -oE '[0-9]+' | head -1) tests)" else fail_msg "Node unit tests"; grep -E 'not ok|AssertionError|Error' /tmp/ts-node.log | sed 's/^/ /' | head -20; fi +# 3b. ERT tests for build-theme.el (the theme.json -> deftheme emitter). The +# tests live in the repo's tests/ dir; run them headless. Skip cleanly if no +# emacs is on PATH (the JS/Python gates still run). +BT_TESTS="$HERE/../../tests/test-build-theme.el" +if command -v emacs >/dev/null 2>&1 && [ -f "$BT_TESTS" ]; then + if emacs --batch --no-site-file --no-site-lisp \ + -L "$HERE/../.." -L "$HERE/../../modules" -L "$HERE/../../tests" -L "$HERE/../../themes" \ + -l "$BT_TESTS" -f ert-run-tests-batch-and-exit >/tmp/ts-bt.log 2>&1; then + pass_msg "build-theme.el ERT tests ($(grep -oE 'Ran [0-9]+' /tmp/ts-bt.log | awk '{print $2}') tests)" + else fail_msg "build-theme.el ERT tests"; grep -E 'FAILED|Error' /tmp/ts-bt.log | sed 's/^/ /' | head -20; fi +else + skip_msg "build-theme.el ERT tests (no emacs on PATH)" +fi + # 4. Syntax-check the inlined page script. python3 - <<'PY' && node --check /tmp/ts-script.js >/dev/null 2>&1 && pass_msg "spliced page <script> parses" || fail_msg "spliced page <script> syntax" import re diff --git a/tests/test-build-theme.el b/tests/test-build-theme.el index 6c2fa3cf5..29607d099 100644 --- a/tests/test-build-theme.el +++ b/tests/test-build-theme.el @@ -95,43 +95,162 @@ drift the way Craig's downloaded exports under scripts/theme-studio/ can.") ;;; --------------------------------------------------------------------------- ;;; build-theme/--attrs (the core attribute builder) +;; +;; `--attrs' takes one face-spec alist and emits a face-attribute plist. It +;; reads the full attribute model and tolerates the legacy boolean +;; bold/italic/underline/strike fields that older theme.json exports carry. -(ert-deftest test-build-theme-attrs-fg-and-bold () - "Normal: a foreground plus bold yields :foreground and :weight bold." - (should (equal (build-theme/--attrs nil "#67809c" nil t nil nil nil nil) +;; --- Legacy boolean fields still work (back-compat with committed presets) --- + +(ert-deftest test-build-theme-attrs-legacy-fg-and-bold () + "Normal: legacy bold flag yields :weight bold." + (should (equal (build-theme/--attrs '((fg . "#67809c") (bold . t))) '(:foreground "#67809c" :weight bold)))) -(ert-deftest test-build-theme-attrs-full-ordering () - "Normal: every attribute present, in canonical order." - (should (equal (build-theme/--attrs 'org-level-1 "#e8bd30" "#1a1714" t t t t 1.3) - '(:inherit org-level-1 :foreground "#e8bd30" :background "#1a1714" - :weight bold :slant italic :underline t :strike-through t :height 1.3)))) - -(ert-deftest test-build-theme-attrs-underline-and-strike () - "Normal: underline and strike yield :underline t and :strike-through t." - (should (equal (build-theme/--attrs nil "#67809c" nil nil nil t t nil) - '(:foreground "#67809c" :underline t :strike-through t))) - ;; either alone - (should (equal (build-theme/--attrs nil nil nil nil nil t nil nil) - '(:underline t))) - (should (equal (build-theme/--attrs nil nil nil nil nil nil t nil) - '(:strike-through t)))) +(ert-deftest test-build-theme-attrs-legacy-italic-underline-strike () + "Normal: legacy italic/underline/strike booleans map to their attributes." + (should (equal (build-theme/--attrs '((italic . t))) '(:slant italic))) + (should (equal (build-theme/--attrs '((underline . t))) '(:underline t))) + (should (equal (build-theme/--attrs '((strike . t))) '(:strike-through t)))) (ert-deftest test-build-theme-attrs-empty-is-nil () - "Boundary: a fully-cleared face (all nil) yields an empty plist." - (should (equal (build-theme/--attrs nil nil nil nil nil nil nil nil) '()))) + "Boundary: a blank face (empty alist, or all-nil fields) yields an empty plist." + (should (equal (build-theme/--attrs '()) '())) + (should (equal (build-theme/--attrs '((fg) (bg) (bold) (italic) (underline) (strike))) '()))) (ert-deftest test-build-theme-attrs-bold-false-omits-weight () - "Boundary: bold false produces no :weight key (only overrides are written)." - (should (equal (build-theme/--attrs nil "#cdced1" nil nil nil nil nil nil) - '(:foreground "#cdced1")))) + "Boundary: bold false (or absent) writes no :weight -- only overrides appear." + (should (equal (build-theme/--attrs '((fg . "#cdced1") (bold . nil))) + '(:foreground "#cdced1"))) + (should (equal (build-theme/--attrs '((fg . "#cdced1"))) '(:foreground "#cdced1")))) (ert-deftest test-build-theme-attrs-height-one-omitted () - "Boundary: a height of exactly 1.0 is omitted (the default multiplier)." - (should (equal (build-theme/--attrs nil "#cdced1" nil nil nil nil nil 1.0) - '(:foreground "#cdced1"))) - (should (equal (build-theme/--attrs nil "#cdced1" nil nil nil nil nil 1) - '(:foreground "#cdced1")))) + "Boundary: a height of exactly 1.0 (or integer 1) is omitted as the default." + (should (equal (build-theme/--attrs '((fg . "#cdced1") (height . 1.0))) '(:foreground "#cdced1"))) + (should (equal (build-theme/--attrs '((fg . "#cdced1") (height . 1))) '(:foreground "#cdced1"))) + (should (equal (build-theme/--attrs '((height . 1.2))) '(:height 1.2)))) + +;; --- New attributes --- + +(ert-deftest test-build-theme-attrs-family () + "Normal/Boundary: a non-empty family string emits :family; empty is omitted." + (should (equal (build-theme/--attrs '((family . "Iosevka"))) '(:family "Iosevka"))) + (should (equal (build-theme/--attrs '((family . ""))) '())) + (should (equal (build-theme/--attrs '((family . nil))) '()))) + +(ert-deftest test-build-theme-attrs-distant-foreground () + "Normal: distant-fg emits :distant-foreground." + (should (equal (build-theme/--attrs '((distant-fg . "#ffffff"))) + '(:distant-foreground "#ffffff")))) + +(ert-deftest test-build-theme-attrs-weight-range () + "Normal: an explicit weight string emits that weight symbol." + (should (equal (build-theme/--attrs '((weight . "light"))) '(:weight light))) + (should (equal (build-theme/--attrs '((weight . "semibold"))) '(:weight semibold))) + (should (equal (build-theme/--attrs '((weight . "heavy"))) '(:weight heavy)))) + +(ert-deftest test-build-theme-attrs-weight-overrides-legacy-bold () + "Boundary: an explicit weight wins over a legacy bold flag on the same face." + (should (equal (build-theme/--attrs '((weight . "light") (bold . t))) + '(:weight light)))) + +(ert-deftest test-build-theme-attrs-slant-range () + "Normal: an explicit slant string emits that slant; it wins over legacy italic." + (should (equal (build-theme/--attrs '((slant . "oblique"))) '(:slant oblique))) + (should (equal (build-theme/--attrs '((slant . "normal"))) '(:slant normal))) + (should (equal (build-theme/--attrs '((slant . "oblique") (italic . t))) '(:slant oblique)))) + +(ert-deftest test-build-theme-attrs-underline-object () + "Normal/Boundary: the structured underline form covers line/wave and color." + ;; plain line in the face color collapses to t + (should (equal (build-theme/--attrs '((underline . ((style . "line") (color . nil))))) + '(:underline t))) + ;; wave alone -> a :style plist + (should (equal (build-theme/--attrs '((underline . ((style . "wave") (color . nil))))) + '(:underline (:style wave)))) + ;; colored line -> a :color plist + (should (equal (build-theme/--attrs '((underline . ((style . "line") (color . "#cb6b4d"))))) + '(:underline (:color "#cb6b4d")))) + ;; colored wave -> both + (should (equal (build-theme/--attrs '((underline . ((style . "wave") (color . "#cb6b4d"))))) + '(:underline (:color "#cb6b4d" :style wave))))) + +(ert-deftest test-build-theme-attrs-strike-object () + "Normal: structured strike emits t for no color, or the color string." + (should (equal (build-theme/--attrs '((strike . ((color . nil))))) '(:strike-through t))) + (should (equal (build-theme/--attrs '((strike . ((color . "#cb6b4d"))))) + '(:strike-through "#cb6b4d")))) + +(ert-deftest test-build-theme-attrs-overline () + "Normal/Boundary: overline emits t for no color, the color otherwise, nil when unset." + (should (equal (build-theme/--attrs '((overline . ((color . nil))))) '(:overline t))) + (should (equal (build-theme/--attrs '((overline . ((color . "#a9b2bb"))))) + '(:overline "#a9b2bb"))) + (should (equal (build-theme/--attrs '((overline . nil))) '()))) + +(ert-deftest test-build-theme-attrs-inverse-and-extend () + "Normal/Boundary: inverse and extend emit t when set, nothing when nil." + (should (equal (build-theme/--attrs '((inverse . t))) '(:inverse-video t))) + (should (equal (build-theme/--attrs '((extend . t))) '(:extend t))) + (should (equal (build-theme/--attrs '((inverse . t) (extend . t))) + '(:inverse-video t :extend t))) + (should (equal (build-theme/--attrs '((inverse . nil) (extend . nil))) '()))) + +(ert-deftest test-build-theme-attrs-inherit-any-tier () + "Normal: inherit coerces a face-name string to a symbol (now allowed on every tier)." + (should (equal (build-theme/--attrs '((inherit . "shadow"))) '(:inherit shadow))) + (should (equal (build-theme/--attrs '((inherit . shadow))) '(:inherit shadow))) + (should (equal (build-theme/--attrs '((inherit . nil))) '()))) + +(ert-deftest test-build-theme-attrs-full-ordering () + "Normal: every attribute present, emitted in canonical order." + (should (equal (build-theme/--attrs + '((inherit . "org-level-1") (family . "Iosevka") + (fg . "#e8bd30") (bg . "#1a1714") (distant-fg . "#ffffff") + (weight . "semibold") (slant . "italic") (height . 1.3) + (underline . ((style . "wave") (color . "#cb6b4d"))) + (overline . ((color . "#a9b2bb"))) + (strike . ((color . nil))) + (box . ((style . "line") (color . "#67809c"))) + (inverse . t) (extend . t))) + '(:inherit org-level-1 :family "Iosevka" + :foreground "#e8bd30" :background "#1a1714" :distant-foreground "#ffffff" + :weight semibold :slant italic :height 1.3 + :underline (:color "#cb6b4d" :style wave) :overline "#a9b2bb" + :strike-through t :box (:line-width 1 :color "#67809c") + :inverse-video t :extend t)))) + +;; --- Attribute-helper edge cases (the coercion functions in isolation) --- + +(ert-deftest test-build-theme-weight-helper () + "Boundary: weight prefers explicit string, falls back to bold, else nil." + (should (eq (build-theme/--weight '((weight . "bold"))) 'bold)) + (should (eq (build-theme/--weight '((weight . "light") (bold . t))) 'light)) + (should (eq (build-theme/--weight '((bold . t))) 'bold)) + (should (null (build-theme/--weight '((weight . "") (bold . nil))))) + (should (null (build-theme/--weight '())))) + +(ert-deftest test-build-theme-slant-helper () + "Boundary: slant prefers explicit string, falls back to italic, else nil." + (should (eq (build-theme/--slant '((slant . "oblique"))) 'oblique)) + (should (eq (build-theme/--slant '((italic . t))) 'italic)) + (should (null (build-theme/--slant '((slant . ""))))) + (should (null (build-theme/--slant '())))) + +(ert-deftest test-build-theme-underline-helper () + "Boundary: underline coercion across nil / legacy t / structured forms." + (should (null (build-theme/--underline '((underline . nil))))) + (should (eq (build-theme/--underline '((underline . t))) t)) + (should (eq (build-theme/--underline '((underline . ((style . "line") (color . nil))))) t)) + (should (equal (build-theme/--underline '((underline . ((style . "wave"))))) '(:style wave))) + (should (equal (build-theme/--underline '((underline . ((color . "#aa0000"))))) '(:color "#aa0000")))) + +(ert-deftest test-build-theme-line-attr-helper () + "Boundary: the overline/strike coercion: nil / t / {color} forms." + (should (null (build-theme/--line-attr nil))) + (should (eq (build-theme/--line-attr t) t)) + (should (eq (build-theme/--line-attr '((color . nil))) t)) + (should (equal (build-theme/--line-attr '((color . "#abcdef"))) "#abcdef"))) ;;; --------------------------------------------------------------------------- ;;; build-theme/--face-spec (skips empty faces) @@ -355,5 +474,46 @@ parse -> spec -> file -> face pipeline preserves the designed contrast." (should (>= (test-build-theme--contrast fg bg) 4.5)))) (disable-theme 'dupre-fixture)))))) +(ert-deftest test-build-theme-convert-file-new-attributes-round-trip () + "Integration: the new attribute model survives parse -> spec -> file -> face. +Components integrated: +- build-theme/convert-file (entry point, real) +- json parsing of the inline fixture (real) +- custom-theme-set-faces / load-theme / face-attribute (real) +Exercises extend, structured underline (wave + color), overline, inverse-video, +distant-foreground, family, and the weight/slant ranges across the UI and +package tiers." + (test-build-theme--with-sandbox out + (let* ((json "{\"name\":\"newattrs\",\"palette\":[[\"#000000\",\"ground\"]], + \"syntax\":{\"bg\":{\"fg\":\"#000000\"},\"p\":{\"fg\":\"#ffffff\"}}, + \"ui\":{ + \"region\":{\"bg\":\"#264364\",\"extend\":true}, + \"highlight\":{\"fg\":\"#eddba7\",\"underline\":{\"style\":\"wave\",\"color\":\"#cb6b4d\"},\"overline\":{\"color\":\"#a9b2bb\"}}, + \"secondary-selection\":{\"bg\":\"#333333\",\"inverse\":true,\"distant-fg\":\"#ffffff\"} + }, + \"packages\":{ + \"misc\":{ + \"shadow\":{\"fg\":\"#cdced1\",\"family\":\"Iosevka\",\"weight\":\"light\",\"slant\":\"oblique\",\"source\":\"user\"} + } + }}") + (in (expand-file-name "newattrs.json" out))) + (with-temp-file in (insert json)) + (build-theme/convert-file in out) + (let ((custom-theme-load-path (cons out custom-theme-load-path)) + (load-path (cons out load-path))) + (unwind-protect + (progn + (load-theme 'newattrs t) + (should (eq (face-attribute 'region :extend nil t) t)) + (should (equal (face-attribute 'highlight :underline nil t) + '(:color "#cb6b4d" :style wave))) + (should (string= (face-attribute 'highlight :overline nil t) "#a9b2bb")) + (should (eq (face-attribute 'secondary-selection :inverse-video nil t) t)) + (should (string= (face-attribute 'secondary-selection :distant-foreground nil t) "#ffffff")) + (should (string= (face-attribute 'shadow :family nil t) "Iosevka")) + (should (eq (face-attribute 'shadow :weight nil t) 'light)) + (should (eq (face-attribute 'shadow :slant nil t) 'oblique))) + (disable-theme 'newattrs)))))) + (provide 'test-build-theme) ;;; test-build-theme.el ends here |