branch: externals/standard-themes
commit 839536724a3daacee35983b6172948b7a9dbed69
Author: Protesilaos Stavrou <i...@protesilaos.com>
Commit: Protesilaos Stavrou <i...@protesilaos.com>
Implement system for palette overrides
---
README.org | 73 +++++++++++++++++++++++++++++++++++++++++++++++++
standard-dark-theme.el | 7 ++++-
standard-light-theme.el | 7 ++++-
standard-themes.el | 61 +++++++++++++++++++++++++++++++----------
4 files changed, 131 insertions(+), 17 deletions(-)
diff --git a/README.org b/README.org
index 6cd1a29c3d..23ac6433d0 100644
--- a/README.org
+++ b/README.org
@@ -513,6 +513,79 @@ Other examples:
(setq standard-themes-region '(intense no-extend neutral))
#+end_src
+** Palette overrides
+:PROPERTIES:
+:CUSTOM_ID: h:34fe0582-960b-45dc-af5d-23c8f3e9d724
+:END:
+#+cindex: Override color values and semantic color mappings
+
+[ Part of {{{development-version}}}. ]
+
+The Standard themes define their own color palette as well as semantic
+color mappings. The former is the set of color values such as what
+shade of blue to use. The latter refers to associations between a
+color value and a syntactic construct, such as a =variable= for
+variables in programming modes or =heading-1= for level 1 headings in
+Org and others.
+
+The definition is stored in the variable =NAME-palette=, where =NAME=
+is the symbol of the theme, such as ~standard-light~. Overrides for
+those associations are specified in the variable =NAME-palette-overrides=.
+
+#+vindex: standard-themes-common-palette-overrides
+The variable ~standard-themes-common-palette-overrides~ is available
+for shared values. It is advised to only use this for mappings that
+do not specify a color value directly. This way, the text remains
+legible by getting the theme-specific color value it needs.
+
+All associations take the form of =(KEY VALUE)= pairs. For example,
+the ~standard-light-palette~ contains =(blue-warmer "#3a5fcd")=.
+Semantic color mappings are the same, though the =VALUE= is one of the
+named colors of the theme. For instance, ~standard-light-palette~
+maps the aforementioned like =(link blue-warmer)=.
+
+The easiest way to learn about a theme's definition is to use the
+command ~describe-variable~ (bound to =C-h v= by default) and then
+search for the =NAME-palette=. The resulting Help buffer will look
+like this:
+
+#+begin_example
+standard-light-palette is a variable defined in ‘standard-light-theme.el’.
+
+Its value is shown below.
+
+The ‘standard-light’ palette.
+
+ This variable may be risky if used as a file-local variable.
+
+Value:
+((bg-main "#ffffff")
+ (fg-main "#000000")
+ (bg-dim "#ededed")
+
+[... Shortened for the purposes of this manual.]
+#+end_example
+
+The user can study this information to identify the overrides they
+wish to make. Then they can specify them and re-load the theme for
+changes to take effect. Sample of how to override a color value and a
+semantic mapping:
+
+#+begin_src emacs-lisp
+(setq standard-light-palette-overrides
+ '((blue-warmer "#5230ff") ; original value is #3a5fcd
+ (variable blue-warmer))) ; original value is yellow-cooler
+#+end_src
+
+The overrides can contain as many associations as the user needs.
+
+Changes to color values are reflected in the preview of the theme's
+palette ([[#h:8dd67bf5-879e-46e5-b277-5bac141f53d1][Preview theme colors]]).
They are shown at the top of the
+buffer. In the above example, the first instance of =blue-warmer= is
+the override and the second is the original one.
+
+Contact me if you need further help with this.
+
* Loading a theme
:PROPERTIES:
:CUSTOM_ID: h:59c399d6-5dca-4686-b793-255be8bffc31
diff --git a/standard-dark-theme.el b/standard-dark-theme.el
index 1596dd4d8a..79d1a94b6c 100644
--- a/standard-dark-theme.el
+++ b/standard-dark-theme.el
@@ -214,7 +214,12 @@
(prose-verbatim magenta-warmer))
"The `standard-dark' palette.")
- (standard-themes-theme standard-dark standard-dark-palette)
+ (defvar standard-dark-palette-overrides nil
+ "Overrides for `standard-dark-palette'.")
+
+ (standard-themes-theme standard-dark
+ standard-dark-palette
+ standard-dark-palette-overrides)
(provide-theme 'standard-dark))
diff --git a/standard-light-theme.el b/standard-light-theme.el
index fb00416092..8544c0be8a 100644
--- a/standard-light-theme.el
+++ b/standard-light-theme.el
@@ -214,7 +214,12 @@
(prose-verbatim magenta))
"The `standard-light' palette.")
- (standard-themes-theme standard-light standard-light-palette)
+ (defvar standard-light-palette-overrides nil
+ "Overrides for `standard-light-palette'.")
+
+ (standard-themes-theme standard-light
+ standard-light-palette
+ standard-light-palette-overrides)
(provide-theme 'standard-light))
diff --git a/standard-themes.el b/standard-themes.el
index d310c03e02..1c84ce14a2 100644
--- a/standard-themes.el
+++ b/standard-themes.el
@@ -560,16 +560,33 @@ color that is combined with FG-FOR-BG."
"Return first enabled Standard theme."
(car (standard-themes--list-enabled-themes)))
-(defun standard-themes--palette (theme)
- "Return THEME palette as a symbol."
- (when theme
- (intern (format "%s-palette" theme))))
-
-(defun standard-themes--current-theme-palette ()
- "Return palette of active Standard theme, else produce `user-error'."
- (if-let* ((palette (standard-themes--palette
(standard-themes--current-theme))))
- (symbol-value palette)
- (user-error "No enabled Standard theme could be found")))
+(defun standard-themes--palette-symbol (theme &optional overrides)
+ "Return THEME palette as a symbol.
+With optional OVERRIDES, return THEME palette overrides as a
+symbol."
+ (when-let ((suffix (cond
+ ((and theme overrides)
+ "palette-overrides")
+ (theme
+ "palette"))))
+ (intern (format "%s-%s" theme suffix))))
+
+(defun standard-themes--palette-value (theme &optional overrides)
+ "Return palette value of THEME with optional OVERRIDES."
+ (let ((base-value (symbol-value (standard-themes--palette-symbol theme))))
+ (if overrides
+ (append (symbol-value (standard-themes--palette-symbol theme
:overrides)) base-value)
+ base-value)))
+
+(defun standard-themes--current-theme-palette (&optional overrides)
+ "Return palette value of active Ef theme, else produce `user-error'.
+With optional OVERRIDES return palette value plus whatever
+overrides."
+ (if-let ((theme (standard-themes--current-theme)))
+ (if overrides
+ (standard-themes--palette-value theme :overrides)
+ (standard-themes--palette-value theme))
+ (user-error "No enabled Ef theme could be found")))
(defun standard-themes--load-theme (theme)
"Load THEME while disabling other Standard themes.
@@ -616,7 +633,7 @@ Run `standard-themes-post-load-hook' after loading the
theme."
Routine for `standard-themes-preview-colors'."
(let ((palette (seq-remove (lambda (cell)
(symbolp (cadr cell)))
- (symbol-value (standard-themes--palette theme))))
+ (symbol-value (standard-themes--palette-value
theme :overrides))))
(current-buffer buffer)
(current-theme theme))
(with-help-window buffer
@@ -1966,18 +1983,32 @@ Helper function for `standard-themes-preview-colors'."
;;; Theme macros
+(defvar standard-themes-common-palette-overrides nil
+ "Set palette overrides for all the Modus themes.
+
+Mirror the elements of a theme's palette, overriding their value.
+The palette variables are named THEME-NAME-palette, while
+individual theme overrides are THEME-NAME-palette-overrides. The
+THEME-NAME is one of the symbols in `modus-themes-items'.
+
+Individual theme overrides take precedence over these common
+overrides.")
+
;;;###autoload
-(defmacro standard-themes-theme (name palette)
+(defmacro standard-themes-theme (name palette &optional overrides)
"Bind NAME's color PALETTE around face specs and variables.
Face specifications are passed to `custom-theme-set-faces'.
While variables are handled by `custom-theme-set-variables'.
Those are stored in `standard-themes-faces' and
-`standard-themes-custom-variables' respectively."
+`standard-themes-custom-variables' respectively.
+
+Optional OVERRIDES are appended to PALETTE, overriding
+corresponding entries."
(declare (indent 0))
(let ((sym (gensym))
(colors (mapcar #'car (symbol-value palette))))
`(let* ((c '((class color) (min-colors 256)))
- (,sym ,palette)
+ (,sym (append ,overrides standard-themes-common-palette-overrides
,palette))
,@(mapcar (lambda (color)
(list color
`(let* ((value (car (alist-get ',color ,sym))))
@@ -2001,7 +2032,7 @@ Those are stored in `standard-themes-faces' and
;; inside a function.
(colors (mapcar #'car (standard-themes--current-theme-palette))))
`(let* ((c '((class color) (min-colors 256)))
- (,sym (standard-themes--current-theme-palette))
+ (,sym (standard-themes--current-theme-palette :overrides))
,@(mapcar (lambda (color)
(list color
`(let* ((value (car (alist-get ',color ,sym))))
