[elpa] externals/standard-themes 839536724a 1/4: Implement system for palette overrides

[ELPA Syncer]

branch: externals/standard-themes
commit 839536724a3daacee35983b6172948b7a9dbed69
Author: Protesilaos Stavrou <info@protesilaos.com>
Commit: Protesilaos Stavrou <info@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))))