Subject: [PATCH] Add new command 'toggle-theme'

From: Philip Kaludercic <[email-masked]>
Date: Wed, 07 Sep 2022 07:19:30 +0000

Tags: patch

Find below a patch for a command that a lot of custom themes
re-implement, whenever there exists a light and dark variant.

In GNU Emacs 29.0.50 (build 8, x86_64-pc-linux-gnu, GTK+ Version
 3.24.34, cairo version 1.17.6) of 2022-09-03 built on rhea
Repository revision: 2763a516a048c2cbabb10a5bbe22dc3bbde561f3
Repository branch: master
System Description: Fedora Linux 36 (Workstation Edition)

Configured using:
 'configure --with-pgtk --with-native-compilation --with-imagemagick'

>From 2f27885460095a247421431faca14bf35fae3995 Mon Sep 17 00:00:00 2001
From: Philip Kaludercic <[email-masked]>
Date: Tue, 6 Sep 2022 20:53:35 +0200
Subject: [PATCH 1/2] Add new command 'toggle-theme'

* doc/emacs/custom.texi (Custom Themes): Mention it.
* etc/themes/leuven-dark-theme.el (leuven-dark): Add dual theme.
* etc/themes/leuven-theme.el (leuven): Add dual theme.
* etc/themes/tango-dark-theme.el (tango-dark): Add dual theme.
* etc/themes/tango-theme.el (tango): Add dual theme.
* etc/themes/tsdh-dark-theme.el (tsdh-dark): Add dual theme.
* etc/themes/tsdh-light-theme.el (tsdh-light): Add dual theme.
* lisp/cus-theme.el (describe-theme-1): Say if a theme has a dual.
* lisp/custom.el (toggle-theme): Add new command.
---
 doc/emacs/custom.texi           |  5 +++++
 etc/themes/leuven-dark-theme.el |  4 +++-
 etc/themes/leuven-theme.el      |  4 +++-
 etc/themes/tango-dark-theme.el  |  2 ++
 etc/themes/tango-theme.el       |  2 ++
 etc/themes/tsdh-dark-theme.el   |  2 ++
 etc/themes/tsdh-light-theme.el  |  2 ++
 lisp/cus-theme.el               |  2 ++
 lisp/custom.el                  | 19 +++++++++++++++++++
 9 files changed, 40 insertions(+), 2 deletions(-)

diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index ff7ab83190..3dabba9d2f 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -667,6 +667,11 @@ Custom Themes
 the @file{*Custom Themes*} buffer; or type @kbd{M-x describe-theme}
 anywhere in Emacs and enter the theme name.
 
+@findex toggle-theme
+  Some themes have dual variants (most often these are light and dark
+pairs).  You can switch between these by typing @kbd{M-x
+toggle-theme}.  Note that this only works if only one theme is active.
+
 @node Creating Custom Themes
 @subsection Creating Custom Themes
 @cindex custom themes, creating
diff --git a/etc/themes/leuven-dark-theme.el b/etc/themes/leuven-dark-theme.el
index 0e162c8bab..cef40782c1 100644
--- a/etc/themes/leuven-dark-theme.el
+++ b/etc/themes/leuven-dark-theme.el
@@ -5,7 +5,7 @@
 ;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")>
 ;; Contributor: Thibault Polge <(concat "thibault" at-sign "thb.lt")>
 ;; URL: https://github.com/fniessen/emacs-leuven-dark-theme
-;; Version: 20220202.1126
+;; Version: 20220906.2016
 ;; Keywords: color theme
 
 ;; This file is part of GNU Emacs.
@@ -1083,6 +1083,8 @@ leuven-dark
   (add-to-list 'custom-theme-load-path
                (file-name-as-directory (file-name-directory load-file-name))))
 
+(put 'leuven-dark 'dual-theme 'leuven) ;see `toggle-theme'
+
 (provide-theme 'leuven-dark)
 
 ;; This is for the sake of Emacs.
diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el
index d9a8d5391a..73ac96d28d 100644
--- a/etc/themes/leuven-theme.el
+++ b/etc/themes/leuven-theme.el
@@ -4,7 +4,7 @@
 
 ;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")>
 ;; URL: https://github.com/fniessen/emacs-leuven-theme
-;; Version: 20200513.1928
+;; Version: 20220906.2016
 ;; Keywords: color theme
 
 ;; This file is part of GNU Emacs.
@@ -1065,6 +1065,8 @@ leuven
   (add-to-list 'custom-theme-load-path
                (file-name-as-directory (file-name-directory load-file-name))))
 
+(put 'leuven 'dual-theme 'leuven-dark) ;see `toggle-theme'
+
 (provide-theme 'leuven)
 
 ;; This is for the sake of Emacs.
diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el
index ef00d2ac49..f9f2692ac5 100644
--- a/etc/themes/tango-dark-theme.el
+++ b/etc/themes/tango-dark-theme.el
@@ -190,6 +190,8 @@ tango-dark
    `(ansi-color-bright-white ((,class (:background ,alum-1
 				       :foreground ,alum-1))))))
 
+(put 'tango-dark 'dual-theme 'tango) ;see `toggle-theme'
+
 (provide-theme 'tango-dark)
 
 ;;; tango-dark-theme.el ends here
diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el
index ecbbf03753..8d1686f05e 100644
--- a/etc/themes/tango-theme.el
+++ b/etc/themes/tango-theme.el
@@ -173,6 +173,8 @@ tango
    `(ansi-color-bright-white ((,class (:background ,alum-1
 				       :foreground ,alum-1))))))
 
+(put 'tango 'dual-theme 'tango-dark) ;see `toggle-theme'
+
 (provide-theme 'tango)
 
 ;;; tango-theme.el ends here
diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el
index a88ad75520..ad54eb3df0 100644
--- a/etc/themes/tsdh-dark-theme.el
+++ b/etc/themes/tsdh-dark-theme.el
@@ -142,6 +142,8 @@ tsdh-dark
  '(widget-field ((t (:box (:line-width 2 :color "grey75" :style pressed-button)))))
  '(window-number-face ((t (:foreground "red" :weight bold)))))
 
+(put 'tsdh-dark 'dual-theme 'tsdh-light) ;see `toggle-theme'
+
 (provide-theme 'tsdh-dark)
 
 ;;; tsdh-dark-theme.el ends here
diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el
index d9d09b702b..64c048f7e5 100644
--- a/etc/themes/tsdh-light-theme.el
+++ b/etc/themes/tsdh-light-theme.el
@@ -104,6 +104,8 @@ tsdh-light
  '(show-paren-mismatch ((t (:background "deep pink" :weight bold))))
  '(window-number-face ((t (:foreground "red" :weight bold)))))
 
+(put 'tsdh-light 'dual-theme 'tsdh-dark) ;see `toggle-theme'
+
 (provide-theme 'tsdh-light)
 
 ;;; tsdh-light-theme.el ends here
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index 69ec837db8..04d9ed0004 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -515,6 +515,8 @@ describe-theme-1
 			  (end-of-file nil)))))
             (and (eq (car-safe sexp) 'deftheme)
 		 (setq doc (nth 2 sexp)))))))
+    (when-let ((dual (get theme 'dual-theme)))
+      (princ (format " The dual theme is `%s'" dual)))
     (princ "\n\nDocumentation:\n")
     (princ (if (stringp doc)
 	       (substitute-command-keys doc)
diff --git a/lisp/custom.el b/lisp/custom.el
index 96dfb37d86..ec15267c62 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1374,6 +1374,25 @@ load-theme
     (enable-theme theme))
   t)
 
+(defun toggle-theme (&optional no-confirm no-enable)
+  "Toggle the current active theme by enabling its dual pair.
+The current theme will be immediately disabled before the dual
+theme has been enabled.  If THEME is not active an error will be
+raised.  If theme is nil For NO-CONFIRM and NO-ENABLE, see
+`load-theme'."
+  (interactive)
+  (cond
+   ((length= custom-enabled-themes 0)
+    (user-error "No theme is active, cannot toggle"))
+   ((length> custom-enabled-themes 1)
+    (user-error "More than one theme active, cannot unambiguously toggle")))
+  (let* ((theme (car custom-enabled-themes))
+         (dual (get theme 'dual-theme)))
+    (unless dual
+      (error "`%s' has no dual theme to toggle between" theme))
+    (disable-theme theme)
+    (load-theme dual no-confirm no-enable)))
+
 (defun custom-theme-load-confirm (hash)
   "Query the user about loading a Custom theme that may not be safe.
 The theme should be in the current buffer.  If the user agrees,
-- 
2.37.2