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

lisp/doom-ui.el

@@ -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)))))))
 
 
 ;;

lisp/lib/themes.el

@@ -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
        ;; or the theme has already loaded. This allows you to evaluate these
        ;; 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))
          (doom--run-customize-theme-hook #',fn))
        ;; FIXME Prevent clobbering this on-the-fly
@@ -63,23 +63,20 @@ doom-themes' API without worry."
 
 ;;;###autoload
 (defun doom/reload-theme ()
-  "Reload the current Emacs theme."
+  "Reload all currently active themes."
   (interactive)
-  (unless doom-theme
-    (user-error "No theme is active"))
-  (let ((themes (copy-sequence custom-enabled-themes)))
-    (mapc #'disable-theme custom-enabled-themes)
-    (let (doom-load-theme-hook)
-      (mapc #'enable-theme (reverse themes)))
-    (doom-run-hooks 'doom-load-theme-hook)
+  (let* ((themes (copy-sequence custom-enabled-themes))
+         (real-themes (cl-remove-if-not #'doom--theme-is-colorscheme-p themes)))
+    (mapc #'disable-theme themes)
+    (mapc #'enable-theme (reverse themes))
     (doom/reload-font)
     (message "%s %s"
              (propertize
               (format "Reloaded %d theme%s:"
-                      (length themes)
-                      (if (cdr themes) "s" ""))
+                      (length real-themes)
+                      (if (cdr real-themes) "s" ""))
               'face 'bold)
-             (mapconcat #'prin1-to-string themes ", "))))
+             (mapconcat #'prin1-to-string real-themes ", "))))
 
 
 ;;