diff options
| -rw-r--r-- | scripts/theme-selector/README.md | 30 | ||||
| -rw-r--r-- | scripts/theme-selector/build-theme.el | 238 | ||||
| -rw-r--r-- | tests/test-build-theme.el | 292 | ||||
| -rw-r--r-- | todo.org | 5 |
4 files changed, 558 insertions, 7 deletions
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/<name>-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/<name>-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 <c@cjennings.net> + +;;; 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/<name>-theme.el. +;; +;; Four tiers come out of the JSON: +;; - default -- background from assignments.bg, foreground from .p +;; - syntax -- assignments.<cat> -> 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/<name>-theme.el, where <name> 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 @@ -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/<name>-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): |