jao-themes: simplifications (no independent term faces)

1 files changed, 23 insertions, 27 deletions

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)