refactor: swap load-theme advice for enable-theme-functions

Instead of advising load-theme, which was more opinionated, and broke in
instances where users (relying on `custom-enabled-themes`s setter) or
packages (like auto-dark) were enabling themes with `enable-theme`
instead of `load-theme`.

This also adds support for enabling multiple themes with `doom-theme`.

Fix: #8119
This commit is contained in:
Henrik Lissner
2024-12-11 15:18:50 -05:00
parent ecd079f6da
commit 50b9afbb2d
2 changed files with 85 additions and 46 deletions

View File

@ -6,10 +6,13 @@
;;; Variables
(defcustom doom-theme nil
"A symbol representing the Emacs theme to load at startup.
"What theme (or themes) to load at startup.
Set to `nil' to load no theme at all. This variable is changed by
`load-theme'.")
Is either a symbol representing the name of an Emacs theme, or a list thereof
(to enable in order).
Set to `nil' to load no theme at all. This variable is changed by `load-theme'
and `enable-theme'.")
(defcustom doom-font nil
"The default font to use.
@ -570,38 +573,77 @@ windows, switch to `doom-fallback-buffer'. Otherwise, delegate to original
(defun doom-init-theme-h (&rest _)
"Load the theme specified by `doom-theme' in FRAME."
(when (and doom-theme (not (custom-theme-enabled-p doom-theme)))
(load-theme doom-theme t)))
(dolist (th (ensure-list doom-theme))
(unless (custom-theme-enabled-p th)
(if (custom-theme-p th)
(enable-theme th)
(load-theme th t)))))
(defadvice! doom--load-theme-a (fn theme &optional no-confirm no-enable)
"Record `doom-theme', disable old themes, and trigger `doom-load-theme-hook'."
:around #'load-theme
;; Run `load-theme' from an estranged buffer, where we can ensure that
;; buffer-local face remaps (by `mixed-pitch-mode', for instance) won't
;; interfere with recalculating faces in new themes.
(with-temp-buffer
(let ((last-themes (copy-sequence custom-enabled-themes)))
;; Disable previous themes so there are no conflicts. If you truly want
;; multiple themes enabled, then use `enable-theme' instead.
(mapc #'disable-theme custom-enabled-themes)
(prog1 (funcall fn theme no-confirm no-enable)
(when (and (not no-enable) (custom-theme-enabled-p theme))
(setq doom-theme theme)
(put 'doom-theme 'previous-themes (or last-themes 'none))
;; DEPRECATED Hook into `enable-theme-functions' when we target 29
(doom-run-hooks 'doom-load-theme-hook)
;; Fix incorrect fg/bg in new frames created after the initial frame
;; (which are reroneously displayed as black).
(pcase-dolist (`(,param ,fn ,face)
'((foreground-color face-foreground default)
(background-color face-background default)
(cursor-color face-background cursor)
(border-color face-background border)
(mouse-color face-background mouse)))
(when-let* ((color (funcall fn face nil t))
((stringp color))
((not (string-prefix-p "unspecified-" color))))
(setf (alist-get param default-frame-alist) color))))))))
(defadvice! doom--detect-colorscheme-a (theme)
"Add :kind \\='color-scheme to THEME if it doesn't already have one.
Themes wouldn't call `provide-theme' unless they were a color-scheme, so treat
them as such. Also intended as a helper for `doom--theme-is-colorscheme-p'."
:after #'provide-theme
(with-memoization (plist-get (get theme 'theme-properties) :kind)
'color-scheme))
(defun doom--theme-is-colorscheme-p (theme)
(unless (memq theme '(nil user changed use-package))
(if-let* ((kind (plist-get (get theme 'theme-properties) :kind)))
;; Some newer themes announce that they are colorschemes. Also, we've
;; advised `provide-theme' (only used by colorschemes) to give these
;; themes this property (see `doom--detect-colorscheme-a').
(eq kind 'color-scheme)
;; HACK: If by some chance a legit (probably very old) theme isn't using
;; `provide-theme' (ugh), fall back to this hail mary heuristic to
;; detect colorscheme themes:
(let ((feature (get theme 'theme-feature)))
(and
;; Colorschemes always have a theme-feature (possible to define them
;; without one with `custom-declare-theme' + a nil second argument):
feature
;; ...and they always end in -theme (this is hardcoded into `deftheme'
;; and others in Emacs' theme API).
(string-suffix-p "-theme" (symbol-name feature))
;; ...and any theme (deftheme X) will have a corresponding `X-theme'
;; package loaded when it's enabled.
(featurep feature))))))
(add-hook! 'enable-theme-functions :depth -90
(defun doom-enable-theme-h (theme)
"Record themes and trigger `doom-load-theme-hook'."
(when (doom--theme-is-colorscheme-p theme)
(ring-insert (with-memoization (get 'doom-theme 'history) (make-ring 8))
(copy-sequence custom-enabled-themes))
;; Functions in `doom-load-theme-hook' may trigger face recalculations,
;; which can be contaminated by buffer-local face remaps (e.g. by
;; `mixed-pitch-mode'); this prevents that contamination:
(with-temp-buffer
(let ((enable-theme-functions
(remq 'doom-enable-theme-h enable-theme-functions)))
(doom-run-hooks 'doom-load-theme-hook))))))
(add-hook! 'after-make-frame-functions :depth -90
(defun doom-fix-frame-color-parameters-h (f)
;; HACK: Some window systems produce new frames (after the initial one) with
;; incorrect color parameters (black).
;; REVIEW: What is injecting those parameters? Maybe a PGTK-only issue?
(when (display-graphic-p f)
(letf! (defun invalid-p (color)
(or (equal color "black")
(string-prefix-p "unspecified-" color)))
(pcase-dolist (`(,param ,fn ,face)
'((foreground-color face-foreground default)
(background-color face-background default)
(cursor-color face-background cursor)
(border-color face-background border)
(mouse-color face-background mouse)))
(when-let* ((color (frame-parameter f param))
((invalid-p color))
(color (funcall fn face nil t))
((not (invalid-p color))))
(set-frame-parameter f param color)))))))
;;