feat(emacs): update color mechanism

This commit is contained in:
Pavel Korytov 2023-07-31 01:47:23 +03:00
parent 20f73002d6
commit 4a604c0461
4 changed files with 135 additions and 139 deletions

View file

@ -44,8 +44,8 @@
(format "%.2f seconds"
(float-time
(time-subtract after-init-time before-init-time)))
gcs-done))
(setq my/emacs-started t))
gcs-done)
(setq my/emacs-started t)))
;; (setq use-package-verbose t)
@ -872,72 +872,69 @@ then it takes a second \\[keyboard-quit] to abort the minibuffer."
(setq doom-themes-treemacs-theme "doom-colors")
(doom-themes-treemacs-config))
(defun my/color-join (r g b)
"Build a color from R G B.
Inverse of `color-values'."
(format "#%02x%02x%02x"
(ash r -8)
(ash g -8)
(ash b -8)))
(use-package modus-themes
:straight t)
(defun my/color-blend (c1 c2 &optional alpha)
"Blend the two colors C1 and C2 with ALPHA.
C1 and C2 are in the format of `color-values'.
ALPHA is a number between 0.0 and 1.0 which corresponds to the
influence of C1 on the result."
(setq alpha (or alpha 0.5))
(apply #'my/color-join
(cl-mapcar
(lambda (x y)
(round (+ (* x alpha) (* y (- 1 alpha)))))
c1 c2)))
(use-package ct
:straight t)
(defun my/modus-get-base (color)
(let ((base-value (string-to-number (substring (symbol-name color) 4 5)))
(base-start (cadr (assoc 'bg-main (modus-themes--current-theme-palette))))
(base-end (cadr (assoc 'fg-dim (modus-themes--current-theme-palette)))))
(nth base-value (ct-gradient 9 base-start base-end t))))
(defun my/doom-p ()
(seq-find (lambda (x) (string-match-p (rx bos "doom") (symbol-name x)))
custom-enabled-themes))
(defun my/modus-p ()
(seq-find (lambda (x) (string-match-p (rx bos "modus") (symbol-name x)))
custom-enabled-themes))
(defun my/color-value (color)
(cond
((my/doom-p) (doom-color color))
((my/modus-p) (cadr
(assoc
(cond
((eq color 'bg) 'bg-main)
((eq color 'fg) 'fg-main)
((string-match-p (rx bos "base" digit)
(symbol-name color))
(my/modus-get-base color))
(t color))
(modus-themes--current-theme-palette))))))
(deftheme my-theme-1)
(defvar my/doom-theme-update-colors-hook nil)
(defvar my/my-theme-update-color-params nil)
(defmacro my/use-doom-colors (&rest data)
(defmacro my/use-colors (&rest data)
`(progn
(add-hook 'my/doom-theme-update-colors-hook
(lambda ()
(custom-theme-set-faces
'my-theme-1
,@(cl-loop for i in data collect
`(,'\`
(,(car i)
((t (,@(cl-loop for (key value) on (cdr i) by #'cddr
append `(,key (,'\, ,value))))))))))))
(when (and (fboundp 'doom-color) my/emacs-started)
,@(cl-loop for i in data collect
`(setf (alist-get ',(car i) my/my-theme-update-color-params)
(list ,@(cl-loop for (key value) on (cdr i) by #'cddr
append `(,key ',value)))))
(when (and (or (my/doom-p) (my/modus-p)) my/emacs-started)
(my/update-my-theme))))
(defun my/update-my-theme (&rest _)
(run-hooks 'my/doom-theme-update-colors-hook)
(cl-loop for (face . values) in my/my-theme-update-color-params
do (custom-theme-set-faces
'my-theme-1
`(,face ((t ,@(cl-loop for (key value) on values by #'cddr
collect key
collect (eval value)))))))
(enable-theme 'my-theme-1))
(unless my/is-termux
(advice-add 'load-theme :after #'my/update-my-theme)
(when (fboundp 'doom-color)
(my/update-my-theme))
;; (when (fboundp 'doom-color)
;; (my/update-my-theme))
(add-hook 'emacs-startup-hook #'my/update-my-theme))
(defun my/color-value (color)
(let ((is-doom
(seq-find (lambda (x) (string-match-p (rx bos "doom") (symbol-name x)))
custom-enabled-themes))
(is-modus
(seq-find (lambda (x) (string-match-p (rx bos "modus") (symbol-name x)))
custom-enabled-themes)))
(cond
(is-doom (doom-color color))
(is-modus (cadr
(assoc
(pcase color
('bg 'bg-main)
('fg 'fg-main)
(_ color))
(modus-themes--current-theme-palette)))))))
(my/use-doom-colors
(my/use-colors
(tab-bar-tab :background (my/color-value 'bg)
:foreground (my/color-value 'yellow)
:underline (my/color-value 'yellow))
@ -948,9 +945,9 @@ influence of C1 on the result."
:if (display-graphic-p)
:config
(auto-dim-other-buffers-mode t)
(my/use-doom-colors
(my/use-colors
(auto-dim-other-buffers-face
:background (color-darken-name (my/color-value 'bg) 3))))
:background (ct-greaten (my/color-value 'bg) 3))))
(defun my/toggle-dark-light-theme ()
(interactive)
@ -963,7 +960,7 @@ influence of C1 on the result."
(disable-theme 'doom-one-light))))
(with-eval-after-load 'ansi-color
(my/use-doom-colors
(my/use-colors
(ansi-color-black
:foreground (my/color-value 'base2) :background (my/color-value 'base0))
(ansi-color-red
@ -3922,9 +3919,9 @@ KEYS is a list of cons cells like (<label> . <time>)."
(when (eq major-mode 'org-mode)
(my/org-no-ellipsis-in-headlines)))
(my/use-doom-colors
(org-block :background (color-darken-name (my/color-value 'bg) 3))
(org-block-begin-line :background (color-darken-name (my/color-value 'bg) 3)
(my/use-colors
(org-block :background (ct-greaten (my/color-value 'bg) 3))
(org-block-begin-line :background (ct-greaten (my/color-value 'bg) 3)
:foreground (my/color-value 'grey)))
(use-package ox-hugo
@ -4611,7 +4608,7 @@ With ARG, repeats or can move backward if negative."
:after evil-collection
:commands (eshell)
:init
(my/use-doom-colors
(my/use-colors
(epe-pipeline-delimiter-face :foreground (my/color-value 'green))
(epe-pipeline-host-face :foreground (my/color-value 'blue))
(epe-pipeline-time-face :foreground (my/color-value 'yellow))
@ -4628,7 +4625,7 @@ With ARG, repeats or can move backward if negative."
:straight (:repo "manateelazycat/aweshell" :host github)
:after eshell
:init
(my/use-doom-colors
(my/use-colors
(aweshell-alert-buffer-face :background (color-darken-name (my/color-value 'bg) 3))
(aweshell-alert-command-face :foreground (my/color-value 'red) :weight 'bold))
:config
@ -4779,7 +4776,7 @@ With ARG, repeats or can move backward if negative."
(defface elfeed-govt-entry nil
"Face for the elfeed entries with tag \"blogs\"")
(my/use-doom-colors
(my/use-colors
(elfeed-search-tag-face :foreground (my/color-value 'yellow))
(elfeed-videos-entry :foreground (my/color-value 'red))
(elfeed-twitter-entry :foreground (my/color-value 'blue))
@ -5751,7 +5748,7 @@ ENTRY is an instance of `elfeed-entry'."
`((t :inherit variable-pitch))
"Default face for shr rendering.")
(my/use-doom-colors
(my/use-colors
(my/shr-face :foreground (my/color-value 'blue)))
(defun my/shr-insert-around (fun &rest args)
@ -6279,7 +6276,7 @@ base toot."
:commands (telega)
:init
(my-leader-def "a l" (my/command-in-persp "telega" "telega" 3 (telega)))
(my/use-doom-colors
(my/use-colors
(telega-button-active :foreground (my/color-value 'base0)
:background (my/color-value 'cyan))
(telega-webpage-chat-link :foreground (my/color-value 'base0)
@ -6474,7 +6471,7 @@ base toot."
(my-leader-def
"hs" #'sx-search
"hS" #'sx-tab-frontpage)
(my/use-doom-colors
(my/use-colors
(sx-question-mode-accepted :foreground (my/color-value 'green)
:weight 'bold)
(sx-question-mode-content :background nil))

View file

@ -20,7 +20,7 @@
;; :ensure nil
:commands (notmuch notmuch-search)
:init
(my/use-doom-colors
(my/use-colors
(notmuch-wash-cited-text :foreground (doom-color 'yellow)))
:config
(setq mail-specify-envelope-from t)

143
Emacs.org
View file

@ -166,8 +166,8 @@ A small function to print out the loading time and number of GCs during the load
(format "%.2f seconds"
(float-time
(time-subtract after-init-time before-init-time)))
gcs-done))
(setq my/emacs-started t))
gcs-done)
(setq my/emacs-started t)))
#+end_src
Set the following to =t= to print debug information during the startup. This will include the order in which the packages are loaded and the loading time of individual packages.
@ -1446,7 +1446,7 @@ Showing the last pressed key. Occasionally useful.
#+end_src
** Themes and colors
*** Doom themes
My colorscheme of choice.
My colorschemes of choice.
#+begin_src emacs-lisp
(use-package doom-themes
:straight t
@ -1460,32 +1460,51 @@ My colorscheme of choice.
(setq doom-themes-treemacs-theme "doom-colors")
(doom-themes-treemacs-config))
#+end_src
#+begin_src emacs-lisp
(use-package modus-themes
:straight t)
#+end_src
*** Custom theme
Here I define a custom theme dependent on colors from =doom-themes=.
Here I define a custom theme dependent on colors from the current theme.
A custom theme is necessary because if one calls =custom-set-faces= and =custom-set-variables= in code, whenever a variable is changed and saved in a customize buffer, data from all calls of these functions is saved as well.
To make defining colors a bit easier, here is a function to blend two colors, taken from [[https://oremacs.com/2015/04/28/blending-faces/][this post]] by abo-abo.
First, here's a great package with various color tools:
#+begin_src emacs-lisp
(defun my/color-join (r g b)
"Build a color from R G B.
Inverse of `color-values'."
(format "#%02x%02x%02x"
(ash r -8)
(ash g -8)
(ash b -8)))
(use-package ct
:straight t)
#+end_src
(defun my/color-blend (c1 c2 &optional alpha)
"Blend the two colors C1 and C2 with ALPHA.
C1 and C2 are in the format of `color-values'.
ALPHA is a number between 0.0 and 1.0 which corresponds to the
influence of C1 on the result."
(setq alpha (or alpha 0.5))
(apply #'my/color-join
(cl-mapcar
(lambda (x y)
(round (+ (* x alpha) (* y (- 1 alpha)))))
c1 c2)))
A function to get a color value from the current theme. Supports both =doom-themes= and =modus-themes=... Sort of.
#+begin_src emacs-lisp
(defun my/modus-get-base (color)
(let ((base-value (string-to-number (substring (symbol-name color) 4 5)))
(base-start (cadr (assoc 'bg-main (modus-themes--current-theme-palette))))
(base-end (cadr (assoc 'fg-dim (modus-themes--current-theme-palette)))))
(nth base-value (ct-gradient 9 base-start base-end t))))
(defun my/doom-p ()
(seq-find (lambda (x) (string-match-p (rx bos "doom") (symbol-name x)))
custom-enabled-themes))
(defun my/modus-p ()
(seq-find (lambda (x) (string-match-p (rx bos "modus") (symbol-name x)))
custom-enabled-themes))
(defun my/color-value (color)
(cond
((my/doom-p) (doom-color color))
((my/modus-p) (cadr
(assoc
(cond
((eq color 'bg) 'bg-main)
((eq color 'fg) 'fg-main)
((string-match-p (rx bos "base" digit)
(symbol-name color))
(my/modus-get-base color))
(t color))
(modus-themes--current-theme-palette))))))
#+end_src
Defining the theme itself.
@ -1495,59 +1514,39 @@ Defining the theme itself.
A macro to simplify defining custom colors.
#+begin_src emacs-lisp
(defvar my/doom-theme-update-colors-hook nil)
(defvar my/my-theme-update-color-params nil)
(defmacro my/use-doom-colors (&rest data)
(defmacro my/use-colors (&rest data)
`(progn
(add-hook 'my/doom-theme-update-colors-hook
(lambda ()
(custom-theme-set-faces
'my-theme-1
,@(cl-loop for i in data collect
`(,'\`
(,(car i)
((t (,@(cl-loop for (key value) on (cdr i) by #'cddr
append `(,key (,'\, ,value))))))))))))
(when (and (fboundp 'doom-color) my/emacs-started)
,@(cl-loop for i in data collect
`(setf (alist-get ',(car i) my/my-theme-update-color-params)
(list ,@(cl-loop for (key value) on (cdr i) by #'cddr
append `(,key ',value)))))
(when (and (or (my/doom-p) (my/modus-p)) my/emacs-started)
(my/update-my-theme))))
#+end_src
This macro puts lambdas to =my/doom-theme-update-colors-hook= that updates faces in =my-theme-1=. Now I have to call this hook:
This macro puts lambdas to =my/my-theme-update-colors-hook= that updates faces in =my-theme-1=. Now I have to call this hook:
#+begin_src emacs-lisp
(defun my/update-my-theme (&rest _)
(run-hooks 'my/doom-theme-update-colors-hook)
(cl-loop for (face . values) in my/my-theme-update-color-params
do (custom-theme-set-faces
'my-theme-1
`(,face ((t ,@(cl-loop for (key value) on values by #'cddr
collect key
collect (eval value)))))))
(enable-theme 'my-theme-1))
(unless my/is-termux
(advice-add 'load-theme :after #'my/update-my-theme)
(when (fboundp 'doom-color)
(my/update-my-theme))
;; (when (fboundp 'doom-color)
;; (my/update-my-theme))
(add-hook 'emacs-startup-hook #'my/update-my-theme))
#+end_src
A function to get a color value from the current theme:
#+begin_src emacs-lisp
(defun my/color-value (color)
(let ((is-doom
(seq-find (lambda (x) (string-match-p (rx bos "doom") (symbol-name x)))
custom-enabled-themes))
(is-modus
(seq-find (lambda (x) (string-match-p (rx bos "modus") (symbol-name x)))
custom-enabled-themes)))
(cond
(is-doom (doom-color color))
(is-modus (cadr
(assoc
(pcase color
('bg 'bg-main)
('fg 'fg-main)
(_ color))
(modus-themes--current-theme-palette)))))))
#+end_src
Defining colors for =tab-bar.el=:
#+begin_src emacs-lisp
(my/use-doom-colors
(my/use-colors
(tab-bar-tab :background (my/color-value 'bg)
:foreground (my/color-value 'yellow)
:underline (my/color-value 'yellow))
@ -1561,9 +1560,9 @@ Dim inactive buffers.
:if (display-graphic-p)
:config
(auto-dim-other-buffers-mode t)
(my/use-doom-colors
(my/use-colors
(auto-dim-other-buffers-face
:background (color-darken-name (my/color-value 'bg) 3))))
:background (ct-greaten (my/color-value 'bg) 3))))
#+end_src
*** Toggle light/dark
#+begin_src emacs-lisp
@ -1584,7 +1583,7 @@ It is used by many other packages but doesn't seem to have an integration with =
#+begin_src emacs-lisp
(with-eval-after-load 'ansi-color
(my/use-doom-colors
(my/use-colors
(ansi-color-black
:foreground (my/color-value 'base2) :background (my/color-value 'base0))
(ansi-color-red
@ -5535,9 +5534,9 @@ Remove the ellipsis at the end of folded headlines, as it seems unnecessary with
#+end_src
*** Override colors
#+begin_src emacs-lisp
(my/use-doom-colors
(org-block :background (color-darken-name (my/color-value 'bg) 3))
(org-block-begin-line :background (color-darken-name (my/color-value 'bg) 3)
(my/use-colors
(org-block :background (ct-greaten (my/color-value 'bg) 3))
(org-block-begin-line :background (ct-greaten (my/color-value 'bg) 3)
:foreground (my/color-value 'grey)))
#+end_src
** Export
@ -6542,7 +6541,7 @@ A shell written in Emacs lisp. I don't use it as of now, but keep the config jus
:after evil-collection
:commands (eshell)
:init
(my/use-doom-colors
(my/use-colors
(epe-pipeline-delimiter-face :foreground (my/color-value 'green))
(epe-pipeline-host-face :foreground (my/color-value 'blue))
(epe-pipeline-time-face :foreground (my/color-value 'yellow))
@ -6559,7 +6558,7 @@ A shell written in Emacs lisp. I don't use it as of now, but keep the config jus
:straight (:repo "manateelazycat/aweshell" :host github)
:after eshell
:init
(my/use-doom-colors
(my/use-colors
(aweshell-alert-buffer-face :background (color-darken-name (my/color-value 'bg) 3))
(aweshell-alert-command-face :foreground (my/color-value 'red) :weight 'bold))
:config
@ -6753,7 +6752,7 @@ Setting up custom faces for certain tags to make the feed look a bit nicer.
(defface elfeed-govt-entry nil
"Face for the elfeed entries with tag \"blogs\"")
(my/use-doom-colors
(my/use-colors
(elfeed-search-tag-face :foreground (my/color-value 'yellow))
(elfeed-videos-entry :foreground (my/color-value 'red))
(elfeed-twitter-entry :foreground (my/color-value 'blue))
@ -8115,7 +8114,7 @@ Setting the default font.
`((t :inherit variable-pitch))
"Default face for shr rendering.")
(my/use-doom-colors
(my/use-colors
(my/shr-face :foreground (my/color-value 'blue)))
(defun my/shr-insert-around (fun &rest args)
@ -8739,7 +8738,7 @@ Also a keymap for room mode:
:commands (telega)
:init
(my-leader-def "a l" (my/command-in-persp "telega" "telega" 3 (telega)))
(my/use-doom-colors
(my/use-colors
(telega-button-active :foreground (my/color-value 'base0)
:background (my/color-value 'cyan))
(telega-webpage-chat-link :foreground (my/color-value 'base0)
@ -8977,7 +8976,7 @@ There is a package called =devdocs= that does more or less the same, but I like
(my-leader-def
"hs" #'sx-search
"hS" #'sx-tab-frontpage)
(my/use-doom-colors
(my/use-colors
(sx-question-mode-accepted :foreground (my/color-value 'green)
:weight 'bold)
(sx-question-mode-content :background nil))

View file

@ -403,7 +403,7 @@ And notmuch settings:
;; :ensure nil
:commands (notmuch notmuch-search)
:init
(my/use-doom-colors
(my/use-colors
(notmuch-wash-cited-text :foreground (doom-color 'yellow)))
:config
(setq mail-specify-envelope-from t)