From 39fcd5112b29139f4cf41e5101dc474f89169ebd Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Mon, 8 Jun 2026 06:34:06 -0500 Subject: feat(theme-selector): converter writes :underline and :strike-through build-theme/--attrs takes underline and strike flags and emits :underline t and :strike-through t in canonical order (after slant, before height). The UI and package spec builders read the two new fields off each face object; syntax and default faces pass nil since they never carry them. Two new ERT tests plus updated ordering cases; an end-to-end convert confirms a shr-link face round-trips to :underline t and shr-strike-through to :strike-through t. 22/22 green. --- scripts/theme-selector/build-theme.el | 20 +++++++++++++------- tests/test-build-theme.el | 34 +++++++++++++++++++++++++++------- 2 files changed, 40 insertions(+), 14 deletions(-) diff --git a/scripts/theme-selector/build-theme.el b/scripts/theme-selector/build-theme.el index a377a8ff..fe080c0d 100644 --- a/scripts/theme-selector/build-theme.el +++ b/scripts/theme-selector/build-theme.el @@ -71,15 +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/--attrs (inherit fg bg bold italic height) +(defun build-theme/--attrs (inherit fg bg bold italic underline strike 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." +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. 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 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))) @@ -111,7 +113,7 @@ Return nil when ATTRS is empty, so cleared faces emit nothing." "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)))) + (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. @@ -124,7 +126,7 @@ the font-lock faces in `build-theme/--syntax-face-map'." (hex (build-theme/--obj-get assignments cat))) (when hex (let ((attrs (build-theme/--attrs nil hex nil - (memq cat bold) (memq cat italic) nil))) + (memq cat bold) (memq cat italic) nil nil nil))) (dolist (face faces) (when-let ((spec (build-theme/--face-spec face attrs))) (push spec specs))))))) @@ -141,6 +143,8 @@ the font-lock faces in `build-theme/--syntax-face-map'." (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))) (when-let ((spec (build-theme/--face-spec face attrs))) (push spec specs)))) @@ -159,6 +163,8 @@ the font-lock faces in `build-theme/--syntax-face-map'." (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)))) (when-let ((spec (build-theme/--face-spec face attrs))) (push spec specs))))) diff --git a/tests/test-build-theme.el b/tests/test-build-theme.el index 8624be6b..954e9542 100644 --- a/tests/test-build-theme.el +++ b/tests/test-build-theme.el @@ -94,29 +94,39 @@ the way Craig's downloaded exports under scripts/theme-selector/ can.") (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) + (should (equal (build-theme/--attrs nil "#67809c" nil t nil nil 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) + (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 :height 1.3)))) + :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-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) '()))) + (should (equal (build-theme/--attrs nil nil 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) + (should (equal (build-theme/--attrs nil "#cdced1" nil nil 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) + (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 1) + (should (equal (build-theme/--attrs nil "#cdced1" nil nil nil nil nil 1) '(:foreground "#cdced1")))) ;;; --------------------------------------------------------------------------- @@ -195,6 +205,16 @@ mapping dec would clobber the type color." (should (member '(org-level-2 ((t (:inherit org-level-1 :foreground "#e8bd30" :height 1.2)))) specs)))) +(ert-deftest test-build-theme-package-underline-and-strike () + "Normal: a package face writes :underline and :strike-through from the flags." + (let ((specs (build-theme/--package-face-specs + '((shr . ((shr-link . ((fg . "#67809c") (bg . nil) (bold . nil) (italic . nil) + (underline . t) (strike . nil) (inherit . nil) (source . "default"))) + (shr-strike-through . ((fg . "#5e6770") (bg . nil) (bold . nil) (italic . nil) + (underline . nil) (strike . t) (inherit . nil) (source . "default"))))))))) + (should (member '(shr-link ((t (:foreground "#67809c" :underline t)))) specs)) + (should (member '(shr-strike-through ((t (:foreground "#5e6770" :strike-through t)))) 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 -- cgit v1.2.3