jao-themes: simplifications (no independent term faces)

3 files changed, 87 insertions, 137 deletions

diff --git a/lib/themes/jao-dark-theme.el b/lib/themes/jao-dark-theme.el
index c15f8af..83dba9d 100644
--- a/lib/themes/jao-dark-theme.el
+++ b/lib/themes/jao-dark-theme.el
@@ -52,41 +52,36 @@
   (:palette (fg "#c6c6c6")
             (bg "#1f2024")
             (box "grey25")
-            (button ((p f12) bx nul))
-            (hilite ((c nil region) ex))
-            (strike-through (st))
-            (italic (it))
-            (link ((ul dark-blue))) ;; (ul dimm-line)
-            (visited-link ((ul dark-blue)))
-            (tab-sel ((c 252 232) nbf))
-            (tab-unsel ((c 245 232)))
-            (comment ((c comments)))
-            (keyword ((c keywords)))
-            (function ((c functions)))
-            (type ((c constants)))
-            (variable-name ((c nil)))
-            (constant ((c constants)))
-            (string ((c strings) it))
-            (error ((c warning2)))
-            (warning ((c warning)))
-            (success ((c green)))
-            (dimm ((c dimm-line)))
-            (gnus-mail ((c nil)))
-            (gnus-news ((c nil)))
-            (outline-1 ((c strings) nbf))
-            (outline-2 ((c functions) nbf))
-            (outline-3 ((c blue) nbf))
-            (outline-4 ((c functions2) nbf))
-            (outline-5 ((c nil)))
-            (f00 ((c "lightskyblue3")))
-            (f01 ((c "lightskyblue4")))
-            (f02 ((c "lightblue3")))
-            (f10 ((c "lightblue4")))
-            (f11 ((c "lightblue2")))
-            (f12 ((c "azure3"))))
-  (:faces (bold (c nil nil) nul)
-          (mode-line (c 248 235) nbf nul)
-          (mode-line-inactive (c 243 235) nbf nul))
+            (button (p f12) bx nul)
+            (hilite (c nil region) ex)
+            (link (ul dark-blue)) ;; (ul dimm-line)
+            (visited-link (ul dark-blue))
+            (tab-sel (c 252 232) nbf)
+            (tab-unsel (c 245 232))
+            (comment (c comments))
+            (keyword (c keywords))
+            (function (c functions))
+            (type (c constants))
+            (variable-name (c nil))
+            (constant (c constants))
+            (string (c strings) it)
+            (error (c warning2))
+            (warning (c warning))
+            (success (c green))
+            (dimm (c dimm-line))
+            (gnus-mail (c nil))
+            (gnus-news (c nil))
+            (outline-1 (c strings) nbf)
+            (outline-2 (c functions) nbf)
+            (outline-3 (c blue) nbf)
+            (outline-4 (c functions2) nbf)
+            (outline-5 (c nil))
+            (f00 (c "lightskyblue3"))
+            (f01 (c "lightskyblue4"))
+            (f02 (c "lightblue3"))
+            (f10 (c "lightblue4"))
+            (f11 (c "lightblue2"))
+            (f12 (c "azure3")))
   (:x-faces (clojure-keyword-face (c "powder blue"))
             (corfu-background (c "white" "grey20"))
             (corfu-bar (c nil "grey20")) ;; moving part of the bar
diff --git a/lib/themes/jao-light-theme.el b/lib/themes/jao-light-theme.el
index 1dc1303..98c3d40 100644
--- a/lib/themes/jao-light-theme.el
+++ b/lib/themes/jao-light-theme.el
@@ -43,89 +43,53 @@
           (functions "#005555")
           (red "salmon3")
           (red2 "sienna4"))
-  (:palette (fg unspecified "black")
-            (bg unspecified "white")
-            ;; (bg unspecified "#fffff8")
-            (box "grey90" "grey88")
-            (button ((c "grey10" dimm-background-4) bx nit))
-            (hilite ((c nil dimm-background)))
-            (strike-through ((c 1)) (st))
-            (italic (it))
-            (link ((c dark-blue-2) (ul "grey80") nbf))
-            (visited-link ((c dark-blue-1) nul nbf))
-            (tab-sel ((~ mode-line)))
-            (tab-unsel ((~ mode-line-inactive)))
-            (comment ((c greyish) it))
-            (keyword ((c dark-blue-2) nbf))
-            (type ((c nil) nbf))
-            (function ((c green nil) nbf))
-            (variable-name ((c "black")))
-            (constant ((c 23)))
-            (string ((c link)))
-            (warning ((c red2)))
-            (error ((c red)))
-            (dimm ((c "lemonchiffon4")))
-            (gnus-mail ((c "black")))
-            (gnus-news ((c "black")))
-            (outline ((c "black") nbf))
-            (outline-1 (~ bold) ((c dark-blue-1) nit))
-            (outline-2 ((c functions) nit nbf))
-            (outline-3 ((c link) nit nbf))
-            (outline-4 ((c nil) it nbf))
-            (outline-5 ((c nil)))
-            (f00 ((c slate)))
-            (f01 ((c dark-blue-2)))
-            (f02 ((c green)))
-            (f10 ((p f00)))
-            (f11 ((p f01)))
-            (f12 ((p f02))))
-  (:faces (mode-line (c nil dimm-background) ;; "ghost white"
-                     :box (:line-width 1 :color "grey80"))
-          (mode-line-inactive (c "grey40" dimm-background-2)
-                              :box (:line-width 1 :color "grey85"))
-          (mode-line-buffer-id (~ mode-line) nit)
-          (mode-line-emphasis it)
-          (mode-line-highlight (c green nil)))
-  (:x-faces (ansi-color-blue (c "steelblue4" "steelblue4"))
-            (ansi-color-bright-blue (c "steelblue3" "steelblue3"))
-            (ansi-color-cyan (c "cyan4" "cyan4"))
-            (ansi-color-bright-cyan (c "cyan4" "cyan4"))
-            (ansi-color-green (c "darkseagreen4" "darkseagreen4"))
-            (ansi-color-bright-green (c "darkseagreen3" "darkseagreen3"))
-            (ansi-color-red (c "salmon4" "salmon4"))
-            (ansi-color-bright-red (c "salmon3" "salmon3"))
-            (ansi-color-magenta (~ ansi-color-red))
-            (ansi-color-bright-magenta (~ ansi-color-bright-red))
-            (ansi-color-yellow (c "lightgoldenrod3" "lightgoldenrod3"))
-            (ansi-color-bright-yellow (c "lightyellow4" "lightyellow4"))
-            (bold bf)
-            (compilation-info (c "#223142" nil) nbf)
-            (company-scrollbar-bg (c nil "grey95"))
-            (company-scrollbar-fg (c nil "grey90"))
+  (:palette (fg "black")
+            (bg "white")
+            (box "grey88")
+            (button (c "grey10" dimm-background-4) bx nit)
+            (hilite (c nil dimm-background))
+            (link (c dark-blue-2) (ul "grey80") nbf)
+            (visited-link (c dark-blue-1) nul nbf)
+            (tab-sel (~ mode-line))
+            (tab-unsel (~ mode-line-inactive))
+            (comment (c greyish) it)
+            (keyword (c dark-blue-2) nbf)
+            (type (c nil) nbf)
+            (function (c green nil) nbf)
+            (variable-name (c "black"))
+            (constant (c 23))
+            (string (c link))
+            (warning (c red2))
+            (error (c red))
+            (dimm (c "lemonchiffon4"))
+            (gnus-mail (c "black"))
+            (gnus-news (c "black"))
+            (outline (c "black") nbf)
+            (outline-1 (c dark-blue-1) nit)
+            (outline-2 (c functions) nit nbf)
+            (outline-3 (c link) nit nbf)
+            (outline-4 (c nil) it nbf)
+            (outline-5 (c nil))
+            (f00 (c slate))
+            (f01 (c dark-blue-2))
+            (f02 (c green))
+            (f10 (p f00))
+            (f11 (p f01))
+            (f12 (p f02)))
+  (:x-faces (compilation-info (c "#223142" nil) nbf)
             (corfu-background (~ default) (c "black" "grey95"))
             (corfu-bar (c nil "grey80")) ;; moving part of the bar
             (corfu-border (~ corfu-background)) ;; background of the bar
             (corfu-current (c "black" "grey95") nbf nit (ul "grey70"))
             (cursor (c "sienna3" "sienna3"))
-            (diary (p error) nbf)
             (diff-hl-change (c "white" pale-blue))
             (diff-hl-insert (c "white" "honeydew2"))
             (diff-hl-delete (c "white" "wheat1"))
             (fill-column-indicator (c "grey80"))
             (fringe (c "grey70" nil))
-            (gnus-button (p link) nul)
-            (gnus-cite-1 (c "darkslategray" nil))
-            (gnus-cite-2 (c "slate gray" nil))
-            (gnus-cite-3 (c "slate gray" nil))
-            (gnus-cite-4 (c "slate gray" nil))
-            (gnus-summary-selected (c green) nbf)
-            (gnus-summary-cancelled (c "sienna3" nil) st)
-            (haskell-type-face (p f12))
             (header-line (c nil "#efebe7"))
-            (lui-track-bar (p dimm) :height 0.2 nul nil ex)
             (magit-diff-context-highlight (c nil yellow) ex)
             (magit-diff-hunk-heading-highlight (c nil yellow) it bf)
-            (message-header-subject (p f00) bf)
             (mode-line (c "grey30" dimm-background-3)
                        :box (:line-width -1 :color "grey90"))
             (mode-line-inactive (c "grey40" dimm-background-4)
@@ -134,11 +98,6 @@
             (mode-line-emphasis (c green nil))
             (mode-line-highlight (c green nil))
             (org-link (p link) (ul "grey80"))
-            (outline-minor-1 (c dark-blue-1 light-grey) nit bf ex)
-            (outline-minor-2 (c functions light-grey) nit bf ex)
-            (outline-minor-3 (c link light-grey) nit nbf ex)
-            (outline-minor-4 (c nil light-grey) it nbf ex)
-            (outline-minor-5 (c nil light-grey) nbf ex)
             (scroll-bar (c "grey80" nil))
             (show-paren-match (c nil "grey85"))
             (success (p f00))
diff --git a/lib/themes/jao-themes.el b/lib/themes/jao-themes.el
index 1316462..47a006a 100644
--- a/lib/themes/jao-themes.el
+++ b/lib/themes/jao-themes.el
@@ -377,6 +377,7 @@
             (corfu-bar (p hilite))
             (corfu-border (~ corfu-bar))
             (corfu-current (~ corfu-bar) ul)
+            (corfu-echo (~ default))
             (cursor dfg dbg)
             (custom-button (~ button))
             (custom-button-mouse (~ button))
@@ -409,7 +410,7 @@
             (darcsum-marked-face (p f00) bf)
             (darcsum-need-action-face (p warning))
             (darcsum-need-action-marked-face bf (p warning))
-            (diary (p f02))
+            (diary (p error) nbf)
             (dictionary-button-face (p link))
             (dictionary-reference-face (p f11))
             (dictionary-word-definition-face (~ default))
@@ -611,7 +612,7 @@
             (git-gutter-fr:added (~ fringe) nbf)
             (git-gutter-fr:deleted (~ fringe) nbf)
             (git-gutter-fr:modified (~ fringe) nbf)
-            (gnus-button (~ button))
+            (gnus-button (p link) nul)
             (gnus-cite-attribution (~ default))
             (gnus-cite-1 (p f10))
             (gnus-cite-2 (p f11))
@@ -701,6 +702,7 @@
             (gui-button-face (~ button))
             (gui-element (~ gui-button-face)))
           `((haskell-constructor-face (~ haskell-type-face))
+            (haskell-type-face (p f12))
             (header-line (~ mode-line-inactive))
             (help-argument-name (p f10))
             (help-key-binding (p f00))
@@ -795,7 +797,7 @@
             (lui-button-face (p link))
             (lui-highlight-face (p warning))
             (lui-time-stamp-face (p dimm))
-            (lui-track-bar (p hilite) :height 0.1))
+            (lui-track-bar (p dimm) :height 0.2 nul nil ex))
           `((magit-branch (p f00))
             (magit-cherry-equivalent (p warning))
             (magit-diff-add (~ diff-added))
@@ -834,10 +836,10 @@
             (message-header-name (p f01) nbf)
             (message-header-newsgroups (p dimm) nbf)
             (message-header-other (p f00) nbf)
-            (message-header-subject (p f00) nbf)
+            (message-header-subject (p f00) bf)
             (message-header-to (p f00) nbf)
             (message-header-xheader (p f00) nbf)
-            (message-mml (p warning) nbf)
+            (message-mml (p dimm) nbf)
             (message-separator (p warning) nbf)
             (mm-uu-extract (p hilite) ex)
             (minibuffer-line (p f00))
@@ -1145,18 +1147,21 @@
       (when (not (assq (car df) fs))
         (push df fs)))))
 
-(defsubst jao-themes--let-palette (palette xp)
-  (mapcar (lambda (f)
-            `(,(jao-themes--palette-face (car f))
-              ',(or (and xp (caddr f)) (cadr f))))
-          palette))
+(defun jao-themes--adjust-palette (p s)
+  (if-let (v (alist-get s p)) (cons (cons s (car v)) (assoc-delete-all s p)) p))
+
+(defun jao-themes--let-palette (palette)
+  (let ((palette (seq-reduce #'jao-themes--adjust-palette '(fg bg box) palette)))
+    (mapcar (lambda (f) `(,(jao-themes--palette-face (car f)) ',(cdr f)))
+            palette)))
 
 (defun jao-themes--extract-faces (t-faces x-faces)
   (let ((result))
     (dolist (f t-faces (reverse result))
       (let ((xfb (cdr (assq (car f) x-faces))))
         (push `(,(car f) ((((type x pgtk ns)) ,@xfb)
-                          (t ,@(cdr f)))) result)))))
+                          (t ,@(cdr f))))
+              result)))))
 
 (defun jao-themes--set-fbg (kind)
   (let* ((kvs (cdr (assoc kind window-system-default-frame-alist)))
@@ -1176,28 +1181,19 @@
            (assq-delete-all kind window-system-default-frame-alist)))))
 
 (defmacro jao-define-custom-theme (name &rest args)
-  (let* ((t-faces (make-symbol "t-faces"))
-         (xfaces (make-symbol "xfaces"))
-         (tx-faces (make-symbol "tx-faces"))
-         (palette (cdr (assoc :palette args)))
-         (faces (or (cdr (assoc :faces args)) (list)))
+  (let* ((palette (cdr (assoc :palette args)))
          (x-faces (cdr (assoc :x-faces args)))
          (x-colors (cdr (assoc :x-colors args))))
     `(progn
        (custom-make-theme-feature ',name)
        (deftheme ,name)
        (let ((*jao-themes--color-names* ',(cdr (assoc :names args))))
-         (let* ,(jao-themes--let-palette palette nil)
-           (jao-themes--set-fbg nil)
-           (let ((,t-faces (jao-themes--make-faces ',faces)))
-             (let* ,(jao-themes--let-palette palette t)
-               (jao-themes--set-fbg 'x)
-               (jao-themes--set-fbg 'pgtk)
-               (let* ((,xfaces (jao-themes--make-faces ',x-faces ',x-colors))
-                      (,tx-faces (jao-themes--extract-faces ,t-faces ,xfaces)))
-                 (put ',name 'theme-immediate t)
-                 (apply 'custom-theme-set-faces (cons ',name ,tx-faces)))))
-           (provide-theme ',name))))))
+         (let* ,(jao-themes--let-palette palette)
+           (jao-themes--set-fbg 'x)
+           (jao-themes--set-fbg 'pgtk)
+           (let* ((xfaces (jao-themes--make-faces ',x-faces ',x-colors))
+                  (tx-faces (jao-themes--extract-faces xfaces xfaces)))
+             (apply 'custom-theme-set-faces (cons ',name tx-faces))))))))
 
 (put 'jao-define-custom-theme 'lisp-indent-function 1)