diff options
Diffstat (limited to 'scripts/theme-studio/build-theme.el')
| -rw-r--r-- | scripts/theme-studio/build-theme.el | 71 |
1 files changed, 40 insertions, 31 deletions
diff --git a/scripts/theme-studio/build-theme.el b/scripts/theme-studio/build-theme.el index 8391459ab..ebfc2eb5c 100644 --- a/scripts/theme-studio/build-theme.el +++ b/scripts/theme-studio/build-theme.el @@ -6,13 +6,13 @@ ;; The last link in the theme-studio pipeline: turn a theme.json exported by ;; the tool (see scripts/theme-studio/README.md and -;; docs/design/theme-studio-package-faces-spec.org) into a single, +;; docs/specs/theme-studio-package-faces-spec-doing.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 +;; - default -- background from syntax.bg, foreground from syntax.p +;; - syntax -- syntax.<cat> -> font-lock / tree-sitter faces, with full +;; face attrs where Emacs supports them ;; - ui -- the ui keys are already real face names; fg/bg passthrough ;; - packages -- per-package face specs with :inherit / :height / weight / ;; slant @@ -27,10 +27,10 @@ ;; 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. +;; The output is a flat generated deftheme: a theme.json carries resolved +;; per-face hex, so the converter emits one custom-theme-set-faces with a +;; literal value per face. Giving generated themes a palette + assignments +;; structure is tracked in its own spec. ;;; Code: @@ -80,8 +80,10 @@ unset." (let ((style (build-theme/--obj-get box 'style)) (color (build-theme/--obj-get box 'color)) (width (or (build-theme/--obj-get box 'width) 1))) - (cond ((equal style "released") (list :line-width width :style 'released-button)) - ((equal style "pressed") (list :line-width width :style 'pressed-button)) + (cond ((equal style "released") (append (list :line-width width :style 'released-button) + (when color (list :color color)))) + ((equal style "pressed") (append (list :line-width width :style 'pressed-button) + (when color (list :color color)))) ((equal style "line") (if color (list :line-width width :color color) (list :line-width width))) (t nil))))) @@ -125,24 +127,31 @@ Return nil when ATTRS is empty, so cleared faces emit nothing." ;;; --------------------------------------------------------------------------- ;;; 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))) +(defun build-theme/--default-spec (syntax) + "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)))) -(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'." +(defun build-theme/--syntax-face-specs (syntax) + "Build syntax-tier face specs from SYNTAX. +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 nil nil))) + (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)))) (dolist (face faces) (when-let ((spec (build-theme/--face-spec face attrs))) (push spec specs))))))) @@ -190,15 +199,13 @@ the font-lock faces in `build-theme/--syntax-face-map'." (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))) + (let ((syntax (build-theme/--obj-get data 'syntax)) (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) + (list (build-theme/--default-spec syntax)) + (build-theme/--syntax-face-specs syntax) (build-theme/--ui-face-specs ui) (build-theme/--package-face-specs packages))))) @@ -239,11 +246,13 @@ Signal a `file-missing' error when JSON-FILE does not exist." (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." +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. +Return the written path." (let* ((data (build-theme/--parse json-file)) - (name (build-theme/--obj-get data 'name)) + (name (file-name-base json-file)) (specs (build-theme/--all-specs data)) (dir (or out-dir (expand-file-name |