From f06b93b49c4543cb8dfc3d290d37beeac6653208 Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Mon, 8 Jun 2026 02:56:39 -0500 Subject: feat(theme-selector): convert theme.json into a loadable deftheme build-theme.el is the last link in the theme-selector pipeline: a theme.json export becomes a single self-contained themes/-theme.el. All four tiers convert: default from assignments.bg/.p, the syntax categories to their font-lock/tree-sitter faces with the bold/italic sets applied, UI passthrough, and package faces with :inherit/:height/weight/slant. The output is a flat generated deftheme, not the palette/faces/theme trio the hand-authored dupre ships. A theme.json carries resolved per-face hex, not dupre's semantic-mapping layer, so a flat deftheme is the faithful output and never clobbers the curated dupre files. I omitted the dec (decorator) key: Emacs has no dedicated decorator face and renders decorators with font-lock-type-face, which the type key already owns, so coloring dec independently would clobber types. Decorators follow the type color, as they do in stock Emacs. 20 ERT tests cover the attribute builder, each tier, the dec omission, and an end-to-end convert-and-load with a WCAG-AA assertion on the round-tripped default. --- scripts/theme-selector/README.md | 30 +++- scripts/theme-selector/build-theme.el | 238 +++++++++++++++++++++++++++ tests/test-build-theme.el | 292 ++++++++++++++++++++++++++++++++++ todo.org | 5 +- 4 files changed, 558 insertions(+), 7 deletions(-) create mode 100644 scripts/theme-selector/build-theme.el create mode 100644 tests/test-build-theme.el diff --git a/scripts/theme-selector/README.md b/scripts/theme-selector/README.md index 5ed49c14..ca708c51 100644 --- a/scripts/theme-selector/README.md +++ b/scripts/theme-selector/README.md @@ -125,10 +125,28 @@ The export (and what a build step consumes): `export` always downloads a fresh file; `save` (shown once a name is entered) writes the same file in place via the File System Access API. -## Next step (not yet built) +## Build step — `build-theme.el` -A `theme.json` → `themes/-palette.el` + `-faces.el` + `-theme.el` -converter, in Elisp. That step is the correctness-sensitive part and the one -worth TDD: JSON in, valid Emacs palette + faces out, every face (syntax, UI, and -package) mapped, `:inherit`/`:height` written correctly, and WCAG-contrast -asserted on the result. +`build-theme.el` converts a `theme.json` into a single self-contained +`themes/-theme.el` deftheme. JSON in, valid Emacs faces out, across all +four tiers: `default` from `assignments.bg`/`.p`, the syntax categories mapped +to their font-lock / tree-sitter faces (with the `bold`/`italic` sets applied), +the UI faces passed through, and the package faces with `:inherit`/`:height` +and weight/slant written. + +```bash +emacs --batch -l scripts/theme-selector/build-theme.el \ + --eval '(build-theme/convert-file "scripts/theme-selector/dupre-revised.json" "themes")' +``` + +Output is a flat generated deftheme, not the palette/faces/theme trio the +original dupre ships — a `theme.json` carries resolved per-face hex, not dupre's +semantic-mapping layer, so a flat deftheme is the faithful output and never +clobbers the curated dupre files. + +One mapping limitation: the `dec` (decorator) syntax key has no independent +Emacs face. Emacs renders decorators with `font-lock-type-face`, which the `ty` +key already owns, so `dec` is omitted from the output and decorators follow the +type color (as they do in stock Emacs). Tests live in +`tests/test-build-theme.el` (Normal / Boundary / Error, plus a WCAG-contrast +assertion on the round-tripped result). diff --git a/scripts/theme-selector/build-theme.el b/scripts/theme-selector/build-theme.el new file mode 100644 index 00000000..a377a8ff --- /dev/null +++ b/scripts/theme-selector/build-theme.el @@ -0,0 +1,238 @@ +;;; build-theme.el --- Convert a theme-selector theme.json into a deftheme -*- lexical-binding: t -*- + +;; Author: Craig Jennings + +;;; Commentary: + +;; The last link in the theme-selector pipeline: turn a theme.json exported by +;; the tool (see scripts/theme-selector/README.md and +;; docs/design/theme-selector-package-faces-spec.org) into a single, +;; self-contained, loadable Emacs deftheme written to themes/-theme.el. +;; +;; Four tiers come out of the JSON: +;; - default -- background from assignments.bg, foreground from .p +;; - syntax -- assignments. -> font-lock / tree-sitter faces, with +;; the bold / italic category sets applied +;; - ui -- the ui keys are already real face names; fg/bg passthrough +;; - packages -- per-package face specs with :inherit / :height / weight / +;; slant +;; +;; Usage (from a shell or a running Emacs): +;; +;; emacsclient -e '(progn (load ".../build-theme.el") +;; (build-theme/convert-file ".../dupre-revised.json"))' +;; +;; or in batch: +;; +;; emacs --batch -l build-theme.el \ +;; --eval '(build-theme/convert-file "dupre-revised.json" "themes")' +;; +;; The output is a flat generated deftheme, not the hand-authored +;; palette/faces/theme trio that the original dupre theme ships -- a theme.json +;; carries resolved per-face hex, not dupre's semantic-mapping layer, so a flat +;; deftheme is the faithful output and never clobbers the curated dupre files. + +;;; Code: + +(require 'json) +(require 'subr-x) + +(defconst build-theme/--syntax-face-map + '((kw . (font-lock-keyword-face)) + (bi . (font-lock-builtin-face)) + (pp . (font-lock-preprocessor-face)) + (fnd . (font-lock-function-name-face)) + (fnc . (font-lock-function-call-face)) + (ty . (font-lock-type-face)) + (prop . (font-lock-property-name-face font-lock-property-use-face)) + (con . (font-lock-constant-face)) + (num . (font-lock-number-face)) + (str . (font-lock-string-face)) + (esc . (font-lock-escape-face)) + (re . (font-lock-regexp-face)) + (doc . (font-lock-doc-face)) + (cm . (font-lock-comment-face)) + (cmd . (font-lock-comment-delimiter-face)) + (var . (font-lock-variable-name-face font-lock-variable-use-face)) + (op . (font-lock-operator-face)) + (punc . (font-lock-punctuation-face font-lock-bracket-face + font-lock-delimiter-face font-lock-misc-punctuation-face))) + "Map each theme.json syntax-category key to the font-lock faces it colors. +A category may fan out to several faces (e.g. punc covers bracket and +delimiter too). The dec (decorator) key is deliberately absent: Emacs has +no dedicated decorator face -- it renders decorators with +`font-lock-type-face', which the ty key already owns -- so coloring dec +independently is not possible without clobbering types.") + +;;; --------------------------------------------------------------------------- +;;; Pure helpers + +(defun build-theme/--hex-p (s) + "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/--attrs (inherit fg bg bold italic height) + "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 and +ITALIC are booleans. HEIGHT is a float multiplier; 1.0 (or nil) is omitted as +the default. Only set attributes are written, so a fully-nil face yields an +empty plist." + (let (plist) + (when (and height (numberp height) (/= height 1.0)) + (setq plist (list :height height))) + (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))) + plist)) + +(defun build-theme/--face-spec (face attrs) + "Wrap FACE and its ATTRS plist as a `custom-theme-set-faces' spec. +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 + +(defun build-theme/--default-spec (assignments) + "Build the `default' face spec from ASSIGNMENTS bg / p." + (let ((bg (build-theme/--obj-get assignments 'bg)) + (fg (build-theme/--obj-get assignments 'p))) + (build-theme/--face-spec 'default (build-theme/--attrs nil fg bg nil nil nil)))) + +(defun build-theme/--syntax-face-specs (assignments bold italic) + "Build syntax-tier face specs from ASSIGNMENTS plus the BOLD and ITALIC sets. +BOLD and ITALIC are lists of category-key symbols. Each category fans out to +the font-lock faces in `build-theme/--syntax-face-map'." + (let (specs) + (dolist (pair build-theme/--syntax-face-map) + (let* ((cat (car pair)) + (faces (cdr pair)) + (hex (build-theme/--obj-get assignments cat))) + (when hex + (let ((attrs (build-theme/--attrs nil hex nil + (memq cat bold) (memq cat italic) nil))) + (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})." + (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) + nil))) + (when-let ((spec (build-theme/--face-spec face attrs))) + (push spec specs)))) + (nreverse specs))) + +(defun build-theme/--package-face-specs (packages) + "Build package-tier face specs from the PACKAGES alist (app -> face -> spec)." + (let (specs) + (dolist (app packages) + (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 'height)))) + (when-let ((spec (build-theme/--face-spec face attrs))) + (push spec specs))))) + (nreverse specs))) + +(defun build-theme/--all-specs (data) + "Build the full ordered face-spec list from parsed theme.json DATA." + (let ((assignments (build-theme/--obj-get data 'assignments)) + (bold (mapcar #'intern (build-theme/--obj-get data 'bold))) + (italic (mapcar #'intern (build-theme/--obj-get data 'italic))) + (ui (build-theme/--obj-get data 'ui)) + (packages (build-theme/--obj-get data 'packages))) + (delq nil + (append + (list (build-theme/--default-spec assignments)) + (build-theme/--syntax-face-specs assignments bold italic) + (build-theme/--ui-face-specs ui) + (build-theme/--package-face-specs packages))))) + +;;; --------------------------------------------------------------------------- +;;; Rendering + +(defun build-theme/--render (name specs) + "Render a deftheme file body for theme NAME from face SPECS, as a string." + (concat + (format ";;; %s-theme.el --- Generated by theme-selector -*- lexical-binding: t -*-\n" name) + "\n;;; Commentary:\n" + (format ";; Generated from %s.json by scripts/theme-selector/build-theme.el.\n" name) + ";; Do not hand-edit; re-run the converter.\n" + "\n;;; Code:\n\n" + (format "(deftheme %s\n \"Generated by theme-selector.\")\n\n" name) + (format "(custom-theme-set-faces\n '%s\n" name) + ;; Each spec is quoted: custom-theme-set-faces is a function, so an + ;; unquoted (face ((t ...))) would be evaluated as a call. Specs hold + ;; only literal strings, symbols, and numbers, so a plain quote suffices. + (mapconcat (lambda (spec) (concat " '" (prin1-to-string spec))) specs "\n") + ")\n\n" + (format "(provide-theme '%s)\n" name) + (format ";;; %s-theme.el ends here\n" name))) + +(defun build-theme/--parse (json-file) + "Parse JSON-FILE into an alist, with null/false as nil and arrays as lists. +Signal a `file-missing' error when JSON-FILE does not exist." + (unless (file-readable-p json-file) + (signal 'file-missing (list "Cannot read theme.json" json-file))) + (with-temp-buffer + (insert-file-contents json-file) + (goto-char (point-min)) + (json-parse-buffer :object-type 'alist :array-type 'list + :null-object nil :false-object nil))) + +;;; --------------------------------------------------------------------------- +;;; Entry point + +(defun build-theme/convert-file (json-file &optional out-dir) + "Convert JSON-FILE (a theme.json export) into a deftheme file. +Write themes/-theme.el, where is the JSON name field, into +OUT-DIR (default: the themes/ directory of this repo). Return the written +path." + (let* ((data (build-theme/--parse json-file)) + (name (build-theme/--obj-get data 'name)) + (specs (build-theme/--all-specs data)) + (dir (or out-dir + (expand-file-name + "../../themes" + (file-name-directory (or load-file-name buffer-file-name + default-directory))))) + (out (expand-file-name (format "%s-theme.el" name) dir))) + (unless (and (stringp name) (string-match-p "\\`[a-zA-Z][a-zA-Z0-9-]*\\'" name)) + (error "Invalid theme name in %s: %S" json-file name)) + (make-directory dir t) + (with-temp-file out + (insert (build-theme/--render name specs))) + out)) + +(provide 'build-theme) +;;; build-theme.el ends here diff --git a/tests/test-build-theme.el b/tests/test-build-theme.el new file mode 100644 index 00000000..8624be6b --- /dev/null +++ b/tests/test-build-theme.el @@ -0,0 +1,292 @@ +;;; test-build-theme.el --- Tests for the theme.json -> dupre-*.el converter -*- lexical-binding: t -*- + +;;; Commentary: + +;; ERT tests for scripts/theme-selector/build-theme.el, the converter that +;; turns a theme.json exported by the theme-selector into a loadable Emacs +;; deftheme file. This is the correctness-sensitive end of the pipeline, so +;; it is covered Normal / Boundary / Error per category. + +;;; Code: + +(require 'ert) +(require 'json) + +;; The converter lives under scripts/, not on the normal load-path. Add it at +;; compile time too (the validate hook byte-compiles this file in isolation and +;; only -L's the project, modules, tests, and themes dirs). +(eval-and-compile + (add-to-list 'load-path + (expand-file-name + "../scripts/theme-selector" + (file-name-directory + (or load-file-name + (bound-and-true-p byte-compile-current-file) + buffer-file-name + default-directory))))) + +(require 'build-theme) + +;;; --------------------------------------------------------------------------- +;;; Fixtures + +(defconst test-build-theme--fixture-json + "{ + \"name\": \"dupre-fixture\", + \"palette\": [[\"#000000\",\"ground\"],[\"#7a9abe\",\"blue\"],[\"#84b068\",\"green\"]], + \"assignments\": { + \"bg\":\"#000000\", \"p\":\"#cdced1\", + \"kw\":\"#7a9abe\", \"str\":\"#84b068\", \"cm\":\"#838d97\", \"dec\":\"#e8bd30\" + }, + \"bold\": [\"kw\"], + \"italic\": [\"cm\"], + \"ui\": { + \"region\": {\"fg\":null, \"bg\":\"#264364\"}, + \"mode-line\": {\"fg\":\"#cdced1\", \"bg\":\"#2f343a\"} + }, + \"packages\": { + \"org-mode\": { + \"org-level-1\": {\"fg\":\"#67809c\",\"bg\":null,\"bold\":true,\"italic\":false,\"inherit\":null,\"source\":\"default\"}, + \"org-level-2\": {\"fg\":\"#e8bd30\",\"bg\":null,\"bold\":false,\"italic\":false,\"inherit\":\"org-level-1\",\"height\":1.2,\"source\":\"user\"}, + \"org-tag\": {\"fg\":null,\"bg\":null,\"bold\":false,\"italic\":false,\"inherit\":null,\"source\":\"cleared\"} + } + } +}" + "A self-contained theme.json exercising every tier: default, syntax (bold + +italic + the unmappable dec key), UI, and packages (a plain face, an +inherit+height face, and a cleared face). Owned by the test so it can't drift +the way Craig's downloaded exports under scripts/theme-selector/ can.") + +(defun test-build-theme--write-fixture (dir) + "Write the fixture JSON into DIR and return its path." + (let ((path (expand-file-name "dupre-fixture.json" dir))) + (with-temp-file path (insert test-build-theme--fixture-json)) + path)) + +(defmacro test-build-theme--with-sandbox (var &rest body) + "Bind VAR to a fresh temp directory, run BODY, then delete it." + (declare (indent 1)) + `(let ((,var (make-temp-file "build-theme-test-" t))) + (unwind-protect (progn ,@body) + (delete-directory ,var t)))) + +;; --- WCAG contrast helpers (mirror of the dupre-theme test helpers) --- + +(defun test-build-theme--channel-luminance (c) + "Linearize an 8-bit channel value C (0-255) per the WCAG formula." + (let ((x (/ c 255.0))) + (if (<= x 0.03928) (/ x 12.92) (expt (/ (+ x 0.055) 1.055) 2.4)))) + +(defun test-build-theme--relative-luminance (hex) + "WCAG relative luminance of HEX color \"#rrggbb\"." + (+ (* 0.2126 (test-build-theme--channel-luminance (string-to-number (substring hex 1 3) 16))) + (* 0.7152 (test-build-theme--channel-luminance (string-to-number (substring hex 3 5) 16))) + (* 0.0722 (test-build-theme--channel-luminance (string-to-number (substring hex 5 7) 16))))) + +(defun test-build-theme--contrast (fg bg) + "WCAG contrast ratio between hex colors FG and BG." + (let ((l1 (test-build-theme--relative-luminance fg)) + (l2 (test-build-theme--relative-luminance bg))) + (/ (+ (max l1 l2) 0.05) (+ (min l1 l2) 0.05)))) + +;;; --------------------------------------------------------------------------- +;;; build-theme/--attrs (the core attribute builder) + +(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) + '(: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 1.3) + '(:inherit org-level-1 :foreground "#e8bd30" :background "#1a1714" + :weight bold :slant italic :height 1.3)))) + +(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) '()))) + +(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) + '(: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 1.0) + '(:foreground "#cdced1"))) + (should (equal (build-theme/--attrs nil "#cdced1" nil nil nil 1) + '(:foreground "#cdced1")))) + +;;; --------------------------------------------------------------------------- +;;; build-theme/--face-spec (skips empty faces) + +(ert-deftest test-build-theme-face-spec-normal () + "Normal: a face with attrs becomes a custom-theme-set-faces spec." + (should (equal (build-theme/--face-spec 'font-lock-string-face '(:foreground "#84b068")) + '(font-lock-string-face ((t (:foreground "#84b068"))))))) + +(ert-deftest test-build-theme-face-spec-empty-skipped () + "Boundary: a face with no attributes (cleared) yields nil, not an empty spec." + (should (null (build-theme/--face-spec 'whatever '())))) + +;;; --------------------------------------------------------------------------- +;;; Syntax tier + +(ert-deftest test-build-theme-syntax-keyword-bold () + "Normal: kw maps to font-lock-keyword-face and picks up the bold set." + (let* ((assignments '((kw . "#7a9abe") (str . "#84b068"))) + (specs (build-theme/--syntax-face-specs assignments '(kw) '()))) + (should (member '(font-lock-keyword-face ((t (:foreground "#7a9abe" :weight bold)))) + specs)) + (should (member '(font-lock-string-face ((t (:foreground "#84b068")))) + specs)))) + +(ert-deftest test-build-theme-syntax-one-to-many () + "Normal: punc fans out to every punctuation/bracket/delimiter face." + (let ((specs (build-theme/--syntax-face-specs '((punc . "#a9b2bb")) '() '()))) + (dolist (face '(font-lock-punctuation-face font-lock-bracket-face + font-lock-delimiter-face font-lock-misc-punctuation-face)) + (should (member `(,face ((t (:foreground "#a9b2bb")))) specs))))) + +(ert-deftest test-build-theme-syntax-decorator-omitted () + "Boundary: dec has no independent Emacs face, so it maps to nothing. +Emacs renders decorators with font-lock-type-face, which ty already owns; +mapping dec would clobber the type color." + (let ((specs (build-theme/--syntax-face-specs '((dec . "#e8bd30")) '() '()))) + (should (null specs)))) + +(ert-deftest test-build-theme-syntax-comment-italic () + "Normal: cm in the italic set yields :slant italic on the comment face." + (let ((specs (build-theme/--syntax-face-specs '((cm . "#a9b2bb")) '() '(cm)))) + (should (member '(font-lock-comment-face ((t (:foreground "#a9b2bb" :slant italic)))) + specs)))) + +;;; --------------------------------------------------------------------------- +;;; Default face + +(ert-deftest test-build-theme-default-face () + "Normal: default takes background from bg and foreground from p." + (should (equal (build-theme/--default-spec '((bg . "#000000") (p . "#cdced1"))) + '(default ((t (:foreground "#cdced1" :background "#000000"))))))) + +;;; --------------------------------------------------------------------------- +;;; UI tier + +(ert-deftest test-build-theme-ui-passthrough () + "Normal: a ui face passes fg/bg straight through." + (let ((specs (build-theme/--ui-face-specs + '((region . ((fg . nil) (bg . "#264364"))) + (mode-line . ((fg . "#cdced1") (bg . "#2f343a"))))))) + (should (member '(region ((t (:background "#264364")))) specs)) + (should (member '(mode-line ((t (:foreground "#cdced1" :background "#2f343a")))) specs)))) + +;;; --------------------------------------------------------------------------- +;;; Package tier + +(ert-deftest test-build-theme-package-inherit-and-height () + "Normal: a package face writes :inherit plus overrides plus :height." + (let ((specs (build-theme/--package-face-specs + '((org-mode . ((org-level-2 . ((fg . "#e8bd30") (bg . nil) + (bold . nil) (italic . nil) + (inherit . "org-level-1") (height . 1.2) + (source . "user"))))))))) + (should (member '(org-level-2 ((t (:inherit org-level-1 :foreground "#e8bd30" :height 1.2)))) + specs)))) + +(ert-deftest test-build-theme-package-cleared-skipped () + "Boundary: a cleared package face (no renderable attrs) is not emitted." + (let ((specs (build-theme/--package-face-specs + '((org-mode . ((org-tag . ((fg . nil) (bg . nil) (bold . nil) + (italic . nil) (inherit . nil) + (height . nil) (source . "cleared"))))))))) + (should (null specs)))) + +;;; --------------------------------------------------------------------------- +;;; Hex validation + +(ert-deftest test-build-theme-hex-p () + "Normal/Error: only #rrggbb strings validate." + (should (build-theme/--hex-p "#0d0b0a")) + (should (build-theme/--hex-p "#FFFFFF")) + (should-not (build-theme/--hex-p "0d0b0a")) + (should-not (build-theme/--hex-p "#fff")) + (should-not (build-theme/--hex-p nil))) + +;;; --------------------------------------------------------------------------- +;;; End-to-end: convert a file and load the result + +(ert-deftest test-build-theme-convert-file-writes-loadable-theme () + "Integration: converting the fixture produces a theme Emacs can load. +Components integrated: +- build-theme/convert-file (entry point, real) +- json parsing of the inline fixture (real) +- custom-theme-set-faces / load-theme (real) +Validates the syntax, default, UI, and package tiers all reach real faces, +including an inherit+height package face." + (require 'org) + (test-build-theme--with-sandbox out + (let* ((in (test-build-theme--write-fixture out)) + (path (build-theme/convert-file in out))) + (should (file-exists-p path)) + (should (string-suffix-p "dupre-fixture-theme.el" path)) + (let ((custom-theme-load-path (cons out custom-theme-load-path)) + (load-path (cons out load-path))) + (unwind-protect + (progn + (load-theme 'dupre-fixture t) + ;; default tier + (should (string= (face-attribute 'default :background nil t) "#000000")) + (should (string= (face-attribute 'default :foreground nil t) "#cdced1")) + ;; syntax tier (kw is blue + bold in the fixture) + (should (string= (face-attribute 'font-lock-keyword-face :foreground nil t) "#7a9abe")) + (should (eq (face-attribute 'font-lock-keyword-face :weight nil t) 'bold)) + ;; ui tier + (should (string= (face-attribute 'region :background nil t) "#264364")) + ;; package tier — plain face and an inherit+height face + (should (string= (face-attribute 'org-level-1 :foreground nil t) "#67809c")) + (should (eq (face-attribute 'org-level-2 :inherit nil t) 'org-level-1)) + (should (= (face-attribute 'org-level-2 :height nil t) 1.2))) + (disable-theme 'dupre-fixture)))))) + +(ert-deftest test-build-theme-convert-file-old-json-without-packages () + "Boundary: a theme.json with no packages key still converts and loads." + (test-build-theme--with-sandbox out + (let* ((json "{\"name\":\"noformat\",\"palette\":[[\"#000000\",\"ground\"]],\"assignments\":{\"bg\":\"#000000\",\"p\":\"#ffffff\",\"kw\":\"#67809c\"},\"bold\":[\"kw\"],\"italic\":[],\"ui\":{}}") + (in (expand-file-name "noformat.json" out))) + (with-temp-file in (insert json)) + (let ((path (build-theme/convert-file in out))) + (should (file-exists-p path)) + (let ((custom-theme-load-path (cons out custom-theme-load-path)) + (load-path (cons out load-path))) + (unwind-protect + (progn + (load-theme 'noformat t) + (should (string= (face-attribute 'default :background nil t) "#000000")) + (should (string= (face-attribute 'font-lock-keyword-face :foreground nil t) "#67809c"))) + (disable-theme 'noformat))))))) + +(ert-deftest test-build-theme-convert-file-missing-input-errors () + "Error: a missing input file signals rather than writing garbage." + (test-build-theme--with-sandbox out + (should-error (build-theme/convert-file (expand-file-name "does-not-exist.json" out) out)))) + +(ert-deftest test-build-theme-generated-default-meets-wcag-aa () + "Error/Regression: the generated default face stays legible. +A WCAG-AA (>= 4.5:1) assertion on the round-tripped result -- proves the whole +parse -> spec -> file -> face pipeline preserves the designed contrast." + (test-build-theme--with-sandbox out + (let ((path (build-theme/convert-file (test-build-theme--write-fixture out) out))) + (let ((custom-theme-load-path (cons out custom-theme-load-path)) + (load-path (cons out load-path))) + (unwind-protect + (progn + (load-theme 'dupre-fixture t) + (let ((fg (face-attribute 'default :foreground nil t)) + (bg (face-attribute 'default :background nil t))) + (should (>= (test-build-theme--contrast fg bg) 4.5)))) + (disable-theme 'dupre-fixture)))))) + +(provide 'test-build-theme) +;;; test-build-theme.el ends here diff --git a/todo.org b/todo.org index 8b2084ae..e0964c20 100644 --- a/todo.org +++ b/todo.org @@ -41,7 +41,10 @@ Tags are additive. For example, a small wrong-behavior fix can be =:bug:quick:=, and a feature that requires internal restructuring can be =:feature:refactor:=. * Emacs Open Work -** TODO [#A] theme-selector theme.json -> dupre-*.el converter :feature:theme:theme-selector: +** DONE [#A] theme-selector theme.json -> dupre-*.el converter :feature:theme:theme-selector: +CLOSED: [2026-06-08 Mon] +Built as scripts/theme-selector/build-theme.el (sibling to build-inventory.el), emitting a single self-contained themes/-theme.el deftheme (not the palette/faces/theme trio — a theme.json carries resolved per-face hex, not dupre's semantic layer). All four tiers convert: default from assignments.bg/.p, syntax categories -> font-lock/tree-sitter faces with bold/italic sets, UI passthrough, packages with :inherit/:height/weight/slant. 20 ERT tests in tests/test-build-theme.el (Normal/Boundary/Error + an end-to-end load + a WCAG-AA assertion on the round-tripped result). One mapping limitation documented: the dec (decorator) key has no independent Emacs face (Emacs renders decorators with font-lock-type-face, which ty owns), so dec is omitted and decorators follow the type color. + The last link in the pipeline: turn a theme.json exported by the theme-selector into a real loadable Emacs theme. Elisp (per Craig), TDD — this is the correctness-sensitive piece. Inputs (all on disk; no chat history needed): -- cgit v1.2.3