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 ;;; Variables
(defcustom doom-theme nil (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 Is either a symbol representing the name of an Emacs theme, or a list thereof
`load-theme'.") (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 (defcustom doom-font nil
"The default font to use. "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 _) (defun doom-init-theme-h (&rest _)
"Load the theme specified by `doom-theme' in FRAME." "Load the theme specified by `doom-theme' in FRAME."
(when (and doom-theme (not (custom-theme-enabled-p doom-theme))) (dolist (th (ensure-list doom-theme))
(load-theme doom-theme t))) (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) (defadvice! doom--detect-colorscheme-a (theme)
"Record `doom-theme', disable old themes, and trigger `doom-load-theme-hook'." "Add :kind \\='color-scheme to THEME if it doesn't already have one.
:around #'load-theme
;; Run `load-theme' from an estranged buffer, where we can ensure that Themes wouldn't call `provide-theme' unless they were a color-scheme, so treat
;; buffer-local face remaps (by `mixed-pitch-mode', for instance) won't them as such. Also intended as a helper for `doom--theme-is-colorscheme-p'."
;; interfere with recalculating faces in new themes. :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 (with-temp-buffer
(let ((last-themes (copy-sequence custom-enabled-themes))) (let ((enable-theme-functions
;; Disable previous themes so there are no conflicts. If you truly want (remq 'doom-enable-theme-h enable-theme-functions)))
;; multiple themes enabled, then use `enable-theme' instead. (doom-run-hooks 'doom-load-theme-hook))))))
(mapc #'disable-theme custom-enabled-themes)
(prog1 (funcall fn theme no-confirm no-enable) (add-hook! 'after-make-frame-functions :depth -90
(when (and (not no-enable) (custom-theme-enabled-p theme)) (defun doom-fix-frame-color-parameters-h (f)
(setq doom-theme theme) ;; HACK: Some window systems produce new frames (after the initial one) with
(put 'doom-theme 'previous-themes (or last-themes 'none)) ;; incorrect color parameters (black).
;; DEPRECATED Hook into `enable-theme-functions' when we target 29 ;; REVIEW: What is injecting those parameters? Maybe a PGTK-only issue?
(doom-run-hooks 'doom-load-theme-hook) (when (display-graphic-p f)
;; Fix incorrect fg/bg in new frames created after the initial frame (letf! (defun invalid-p (color)
;; (which are reroneously displayed as black). (or (equal color "black")
(string-prefix-p "unspecified-" color)))
(pcase-dolist (`(,param ,fn ,face) (pcase-dolist (`(,param ,fn ,face)
'((foreground-color face-foreground default) '((foreground-color face-foreground default)
(background-color face-background default) (background-color face-background default)
(cursor-color face-background cursor) (cursor-color face-background cursor)
(border-color face-background border) (border-color face-background border)
(mouse-color face-background mouse))) (mouse-color face-background mouse)))
(when-let* ((color (funcall fn face nil t)) (when-let* ((color (frame-parameter f param))
((stringp color)) ((invalid-p color))
((not (string-prefix-p "unspecified-" color)))) (color (funcall fn face nil t))
(setf (alist-get param default-frame-alist) color)))))))) ((not (invalid-p color))))
(set-frame-parameter f param color)))))))
;; ;;

View File

@ -45,7 +45,7 @@ all themes. It will apply to all themes once they are loaded."
;; Apply the changes immediately if the user is using the default theme ;; Apply the changes immediately if the user is using the default theme
;; or the theme has already loaded. This allows you to evaluate these ;; or the theme has already loaded. This allows you to evaluate these
;; macros on the fly and customize your faces iteratively. ;; macros on the fly and customize your faces iteratively.
(when (or (get 'doom-theme 'previous-themes) (when (or (get 'doom-theme 'history)
(null doom-theme)) (null doom-theme))
(doom--run-customize-theme-hook #',fn)) (doom--run-customize-theme-hook #',fn))
;; FIXME Prevent clobbering this on-the-fly ;; FIXME Prevent clobbering this on-the-fly
@ -63,23 +63,20 @@ doom-themes' API without worry."
;;;###autoload ;;;###autoload
(defun doom/reload-theme () (defun doom/reload-theme ()
"Reload the current Emacs theme." "Reload all currently active themes."
(interactive) (interactive)
(unless doom-theme (let* ((themes (copy-sequence custom-enabled-themes))
(user-error "No theme is active")) (real-themes (cl-remove-if-not #'doom--theme-is-colorscheme-p themes)))
(let ((themes (copy-sequence custom-enabled-themes))) (mapc #'disable-theme themes)
(mapc #'disable-theme custom-enabled-themes) (mapc #'enable-theme (reverse themes))
(let (doom-load-theme-hook)
(mapc #'enable-theme (reverse themes)))
(doom-run-hooks 'doom-load-theme-hook)
(doom/reload-font) (doom/reload-font)
(message "%s %s" (message "%s %s"
(propertize (propertize
(format "Reloaded %d theme%s:" (format "Reloaded %d theme%s:"
(length themes) (length real-themes)
(if (cdr themes) "s" "")) (if (cdr real-themes) "s" ""))
'face 'bold) 'face 'bold)
(mapconcat #'prin1-to-string themes ", ")))) (mapconcat #'prin1-to-string real-themes ", "))))
;; ;;