Version 0.4

This seems more fitting

engrave-faces-html.el

@@ -16,8 +16,10 @@
 (defcustom engrave-faces-html-output-style 'preset
   "How to encode HTML style information.
 When nil, all face properties are applied via inline styles.
-When preset, CSS classes are generated for `engrave-faces-preset-styles'."
+When preset, CSS classes are generated for `engrave-faces-current-preset-style'."
-  :type '(choice nil preset)
+  :type '(choice (const nil :tag "Create no <style> elements")
+          (const preset :tag "Create a <style> element based on the preset style")
+          (const dynamic :tag "Create a dynamic <style> element for faces used"))
   :group 'engrave-faces)
 
 (defcustom engrave-faces-html-class-prefix "ef-"
@@ -27,23 +29,22 @@ When preset, CSS classes are generated for `engrave-faces-preset-styles'."
 
 (defun engrave-faces-html-gen-stylesheet (&optional theme indent)
   "Generate a preamble which provides short commands for the preset styles.
-See `engrave-faces-preset-styles' and `engrave-faces-html-output-style'.
+See `engrave-faces-current-preset-style' and `engrave-faces-html-output-style'.
 When THEME is given, the style used is obtained from `engrave-faces-get-theme'.
 When INDENT is given, it is prepended to each line."
-  (let ((stylesheet
+  (let ((face-styles
-         (mapconcat
+         (cond
-          (lambda (face-style)
+          ((and theme (symbolp theme))
-            (engrave-faces-html--gen-stylesheet-entry (car face-style) (cdr face-style)))
+           (engrave-faces-get-theme theme))
-          (if theme
+          ((consp theme)
-              (engrave-faces-get-theme theme)
+           theme)
-            engrave-faces-current-preset-style)
+          (t engrave-faces-current-preset-style))))
-          "\n")))
+    (mapconcat
-    (if indent
+     (lambda (face-style)
-        (mapconcat (lambda (line)
+       (concat indent (engrave-faces-html--gen-stylesheet-entry
-                     (concat indent line))
+                       (car face-style) (cdr face-style))))
-                   (split-string stylesheet "\n")
+     face-styles
-                   "\n")
+     "\n")))
-      stylesheet)))
 
 (defun engrave-faces-html--gen-stylesheet-entry (face style)
   "Generate a HTML preamble line for STYLE representing FACE."
@@ -113,10 +114,11 @@ Values are taken from https://docs.microsoft.com/en-us/typography/opentype/spec/
 (defun engrave-faces-html--face-mapper (faces content)
   "Create a HTML representation of CONTENT With FACES applied."
   (let ((protected-content (engrave-faces-html--protect-string content))
-        (style (engrave-faces-preset-style faces)))
+        (style (engrave-faces-preset-style
+                faces (eq engrave-faces-html-output-style 'dynamic))))
     (if (string-match-p "\\`[\n[:space:]]+\\'" content)
         protected-content
-      (if (and style (eq engrave-faces-html-output-style 'preset))
+      (if (and style (memq engrave-faces-html-output-style '(preset dynamic)))
           (concat "<span class=\"" engrave-faces-html-class-prefix
                   (plist-get (cdr style) :slug) "\">"
                   protected-content "</span>")

engrave-faces-latex.el

@@ -12,15 +12,20 @@
 ;;; Code:
 
 (require 'engrave-faces)
-
 (require 'cl-lib)
 
+(defvar engrave-faces-current-face-styles)
+(defvar engrave-faces-dynamic-style)
+
 (defcustom engrave-faces-latex-output-style 'preset
   "How to encode LaTeX style information.
 When nil, all face properties are applied via \\colorbox, \\textcolor,
 \\textbf, etc. each time.
-When preset, short commands are generated for `engrave-faces-preset-styles'."
+When preset, short commands are generated for
-  :type '(choice nil preset)
+`engrave-faces-current-preset-style'."
+  :type '(choice (const nil :tag "Create no style commands in the preamble")
+          (const preset :tag "Create a preset collection of style commands in the preamble")
+          (const dynamic :tag "Dynamicly generate style commands in the preamble"))
   :group 'engrave-faces)
 
 (defcustom engrave-faces-latex-mathescape nil
@@ -53,18 +58,21 @@ standalone document."
   "Generate a preamble which provides short commands for the preset styles.
 See `engrave-faces-current-preset-style' and `engrave-faces-latex-output-style'.
 When THEME is given, the style used is obtained from `engrave-faces-get-theme'."
-  (let ((preset-style
+  (let ((face-styles
-         (if theme
+         (cond
-             (engrave-faces-get-theme theme)
+          ((and theme (symbolp theme))
-           engrave-faces-current-preset-style)))
+           (engrave-faces-get-theme theme))
+          ((consp theme)
+           theme)
+          (t engrave-faces-current-preset-style))))
     (concat
      (unless (cl-notany (lambda (s) (plist-get (cdr s) :background))
-                        preset-style)
+                        face-styles)
        (format "\\newcommand\\efstrut{%s}\n" engrave-faces-latex-colorbox-strut))
      (mapconcat
       (lambda (face-style)
         (engrave-faces-latex-gen-preamble-line (car face-style) (cdr face-style)))
-      preset-style
+      face-styles
       "\n"))))
 
 (defun engrave-faces-latex-gen-preamble-line (face style)
@@ -142,7 +150,8 @@ When THEME is given, the style used is obtained from `engrave-faces-get-theme'."
 
 (defun engrave-faces-latex-face-mapper (faces content)
   "Create a LaTeX representation of CONTENT With FACES applied."
-  (let* ((style (engrave-faces-preset-style faces))
+  (let* ((style (engrave-faces-preset-style
+                 faces (eq engrave-faces-latex-output-style 'dynamic)))
          (protected-content
           (funcall
            (if (and engrave-faces-latex-mathescape
@@ -156,7 +165,7 @@ When THEME is given, the style used is obtained from `engrave-faces-get-theme'."
            (rx (or (group (+ graph ) (* (+ blank) (+ graph)))
                    (group (+ (any "\n" space))))))
           (slug (and style
-                     (eq engrave-faces-latex-output-style 'preset)
+                     (memq engrave-faces-latex-output-style '(preset dynamic))
                      (plist-get (cdr style) :slug))))
       (with-temp-buffer
         (insert protected-content)
@@ -179,7 +188,7 @@ and need to be moved back."
   (goto-char (point-min))
   (insert
    (let ((style (cdr (assoc 'default engrave-faces-current-preset-style))))
-     (if (eq engrave-faces-latex-output-style 'preset)
+     (if (memq engrave-faces-latex-output-style '(preset dynamic))
          (format "\\color{EF%s}" (plist-get style :slug))
        (concat "\\color[HTML]{" (substring (plist-get style :foreground) 1) "}"))))
   (goto-char (point-min))
@@ -197,7 +206,9 @@ and need to be moved back."
 \\usepackage{fvextra}
 \\usepackage{sourcecodepro}
 \\pagestyle{empty}\n\n"
-          (engrave-faces-latex-gen-preamble)
+          (engrave-faces-latex-gen-preamble
+           (and (eq engrave-faces-latex-output-style 'dynamic)
+                engrave-faces-dynamic-style))
           "
 \\begin{document}\n"
           (let ((default-face

engrave-faces.el

@@ -2,13 +2,13 @@
 
 ;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
 
-;; Author: TEC <https://git.tecosaur.net/>
+;; Author: TEC <https://code.tecosaur.net/>
 ;; Maintainer: TEC <contact@tecosaur.net>
 ;; Created: January 18, 2021
 ;; Modified: July 10, 2021
-;; Version: 0.3.1
+;; Version: 0.4.0
 ;; Keywords: faces
-;; Homepage: https://github.com/tecosaur/engrave-faces
+;; Homepage: https://code.tecosaur.net/tec/engrave-faces
 ;; Package-Requires: ((emacs "27.1"))
 
 ;;; License:
@@ -123,7 +123,24 @@ buffer.  You may use them to modify the outlook of the final output."
        (rainbow-delimiters-depth-6-face     :short "rd-6"                :slug "rdf" :foreground "#6276ba")
        (rainbow-delimiters-depth-7-face     :short "rd-7"                :slug "rdg" :foreground "#858580")
        (rainbow-delimiters-depth-8-face     :short "rd-8"                :slug "rdh" :foreground "#80a880")
-       (rainbow-delimiters-depth-9-face     :short "rd-9"                :slug "rdi" :foreground "#887070"))))
+       (rainbow-delimiters-depth-9-face     :short "rd-9"                :slug "rdi" :foreground "#887070")
+       ;; ansi-color
+       (ansi-color-yellow                   :short "ansi-yellow"         :slug "any" :foreground "#CDCD00")
+       (ansi-color-red                      :short "ansi-red"            :slug "anr" :foreground "#CD0000")
+       (ansi-color-black                    :short "ansi-black"          :slug "anb" :foreground "#000000")
+       (ansi-color-green                    :short "ansi-green"          :slug "ang" :foreground "#00CD00")
+       (ansi-color-blue                     :short "ansi-blue"           :slug "anB" :foreground "#0000EE")
+       (ansi-color-cyan                     :short "ansi-cyan"           :slug "anc" :foreground "#00CDCD")
+       (ansi-color-white                    :short "ansi-white"          :slug "anw" :foreground "#E5E5E5")
+       (ansi-color-magenta                  :short "ansi-magenta"        :slug "anm" :foreground "#CD00CD")
+       (ansi-color-bright-yellow            :short "ansi-bright-yellow"  :slug "ANy" :foreground "#EEEE00")
+       (ansi-color-bright-red               :short "ansi-bright-red"     :slug "ANr" :foreground "#EE0000")
+       (ansi-color-bright-black             :short "ansi-bright-black"   :slug "ANb" :foregroun  "#4D4D4D")
+       (ansi-color-bright-green             :short "ansi-bright-green"   :slug "ANg" :foreground "#00EE00")
+       (ansi-color-bright-blue              :short "ansi-bright-blue"    :slug "ANB" :foreground "#0000FF")
+       (ansi-color-bright-cyan              :short "ansi-bright-cyan"    :slug "ANc" :foreground "#00EEEE")
+       (ansi-color-bright-white             :short "ansi-bright-white"   :slug "ANw" :foregroun  "#FFFFFF")
+       (ansi-color-bright-magenta           :short "ansi-bright-magenta" :slug "ANm" :foregroun  "#EE00EE"))))
   "A collection of named style presets.
 
 This takes the form of an alist with theme names as the cars, with
@@ -178,6 +195,26 @@ Other faces will need to be styled explicitly each time they are used."
                        :value-type (choice :tag "Value" string symbol)
                        :tag "Face specification"))))
 
+(defvar engrave-faces-dynamic-style nil
+  "A dynamic equivalent of `engrave-faces-current-preset-style'.
+Used with dynamic theme modes, on a per-backend basis.")
+
+(defcustom engrave-faces-slug-function #'engrave-faces-make-slug
+  "Function used to generate a :slug from a face name (symbol).
+To be compatible with LaTeX, the slug must only use characters in [A-Za-z].  To
+balance this concern with the value of brevity, FACE-SYMBOL is split on hyphens,
+and turned into a lower-case acronym. Then, \"x\"s are appended until the slug
+is unique.
+
+The generated slug should also be unique in `engrave-faces-dynamic-style'."
+  :type 'function)
+
+(defcustom engrave-faces-short-function nil
+  "Function used to generate a :short name from a face name (symbol).
+Defaults to the value of `engrave-faces-slug-function'.
+The generated short name should also be unique in `engrave-faces-dynamic-style'."
+  :type '(choice function (const nil)))
+
 (defvar engrave-faces-preset-missed-faces nil
   "Faces not found in `engrave-faces-current-preset-style'.")
 
@@ -231,8 +268,13 @@ switching to the result buffer."
             (engrave-faces-file file out-file ,backend theme ,standalone-transformer)
             (when open-result (find-file out-file))
             out-file)
-          (defvar ,(intern (concat "engrave-faces-" backend "-before-hook")) nil)
+          (defvar ,(intern (concat "engrave-faces-" backend "-before-hook")) nil
-          (defvar ,(intern (concat "engrave-faces-" backend "-after-hook")) nil)))
+            ,(format "Hooks run after `engrave-faces-before-hook' when using the %s backend"
+                     backend))
+          (defvar ,(intern (concat "engrave-faces-" backend "-after-hook")) nil
+            ,(format "Hooks to be run after `engrave-faces-after-hook' when using the %s backend.\n\
+                      Each hook function is run with a list of the styles used as the argument."
+                     backend))))
 
 (defun engrave-faces-file (in-file out-file backend &optional theme postprocessor)
   "Using BACKEND, engrave IN-FILE and save it as OUT-FILE.
@@ -249,6 +291,7 @@ If a POSTPROCESSOR function is provided, it is called before saving."
 (defun engrave-faces-buffer (backend &optional theme)
   "Export the current buffer with BACKEND and return the created buffer.
 When THEME is given, the style used is obtained from `engrave-faces-get-theme'."
+  (setq engrave-faces-dynamic-style nil)
   (let ((engrave-faces-current-preset-style
          (if theme
              (engrave-faces-get-theme theme)
@@ -295,12 +338,12 @@ When THEME is given, the style used is obtained from `engrave-faces-get-theme'."
                                   (let ((prop (get-text-property (point) 'face)))
                                     (cond
                                      ((null prop) 'default)
+                                     ((and (consp prop) (keywordp (car prop)))
+                                      (list prop))
                                      ;; FIXME: Why/where/when does the `face'
                                      ;; property take a value (quote X)?
                                      ((and (listp prop) (eq (car prop) 'quote))
                                       (eval prop t))
-                                     ((and (consp prop) (keywordp (car prop)))
-                                      (list prop))
                                      (t prop)))
                                   text)
                          engraved-buf))
@@ -402,15 +445,57 @@ This function is lifted from htmlize."
               (eq value 'unspecified))
     value))
 
-(defun engrave-faces-preset-style (faces)
+(defun engrave-faces-preset-style (faces &optional dynamic-theme-p)
   "Return the preset style for FACES, should it exist.
-Unconditionally returns nil when FACES is default."
+Unconditionally returns nil when FACES is default.
-  (pcase faces
+
-    ('default nil)
+DYNAMIC-THEME-P specifies whether `engrave-faces-dynamic-style'
-    ((pred symbolp)
+should be used."
-     (assoc faces engrave-faces-preset-styles))
+  (when-let ((face (cond
-    ((and (pred listp) (app length 1))
+                    ((symbolp faces) faces)
-     (assoc (car faces) engrave-faces-preset-styles))))
+                    ((and (listp faces) (= (length faces) 1))
+                     (car faces)))))
+    (cond
+     ((eq face 'default)
+      (unless (or (not dynamic-theme-p) (assoc face engrave-faces-dynamic-style))
+        (push (engrave-faces--generate-style face)
+              engrave-faces-dynamic-style)
+        nil))
+     (dynamic-theme-p
+      (or (assoc face engrave-faces-dynamic-style)
+          (car (push (engrave-faces--generate-style face)
+                     engrave-faces-dynamic-style))))
+     (t (assoc face engrave-faces-current-preset-style)))))
+
+(defun engrave-faces--generate-style (face)
+  "Generate and return a style declaration for FACE."
+  (or (assoc face engrave-faces-current-preset-style)
+      (let ((attrs (mapcan
+                    (lambda (attr)
+                      (list attr (car (engrave-faces-attribute-values face attr))))
+                    engrave-faces-attributes-of-interest))
+            (slug (funcall engrave-faces-slug-function face)))
+        (plist-put attrs :slug slug)
+        (plist-put attrs :short (if engrave-faces-short-function
+                                    (funcall engrave-faces-short-function face)
+                                  slug))
+        (cons face attrs))))
+
+(defun engrave-faces-make-slug (face-symbol)
+  "Create a slug for FACE-SYMBOL, unique in `engrave-faces-dynamic-style'.
+See `engrave-faces-slug-function' for more information."
+  (let ((slug
+         (mapconcat
+          (lambda (word) (char-to-string (aref word 0)))
+          (split-string (symbol-name face-symbol) "-")))
+        (existing-slugs
+         (mapcar
+          (lambda (style)
+            (plist-get (cdr style) :slug))
+          engrave-faces-dynamic-style)))
+    (while (member slug existing-slugs)
+      (setq slug (concat slug "x")))
+    slug))
 
 (defun engrave-faces-generate-preset ()
   "Generate a preset style based on the current Emacs theme."
@@ -440,7 +525,7 @@ Unconditionally returns nil when FACES is default."
                                                   (color-values attr-val)))
                                  attr-val)))))
                    engrave-faces-attributes-of-interest))))
-   engrave-faces-preset-styles))
+   engrave-faces-current-preset-style))
 
 (defun engrave-faces-get-theme (theme &optional noput)
   "Obtain the preset style for THEME.
@@ -448,24 +533,23 @@ Unless NOPUT is non-nil, the preset will be added to `engrave-faces-themes'.
 The theme t is treated as shorthand for the current theme."
   (when (eq theme t)
     (setq theme (car custom-enabled-themes)))
-  (if-let ((theme-preset (alist-get theme engrave-faces-themes)))
+  (or (alist-get theme engrave-faces-themes)
-      theme-preset
+      (if (or (eq theme (car custom-enabled-themes))
-    (if (or (eq theme (car custom-enabled-themes))
+              (memq theme (custom-available-themes)))
-            (memq theme (custom-available-themes)))
+          (let ((spec
-        (let ((spec
+                 (if (eq theme (car custom-enabled-themes))
-               (if (eq theme (car custom-enabled-themes))
+                     (engrave-faces-generate-preset)
-                   (engrave-faces-generate-preset)
+                   (let ((old-theme (car custom-enabled-themes))
-                 (let ((old-theme (car custom-enabled-themes))
+                         spec)
-                       spec)
+                     (load-theme theme t)
-                   (load-theme theme t)
+                     (setq spec (engrave-faces-generate-preset))
-                   (setq spec (engrave-faces-generate-preset))
+                     (load-theme old-theme t)
-                   (load-theme old-theme t)
+                     (redraw-display)
-                   (redraw-display)
+                     spec))))
-                   spec))))
+            (unless noput
-          (unless noput
+              (push (cons theme spec) engrave-faces-themes))
-            (push (cons theme spec) engrave-faces-themes))
+            spec)
-          spec)
+        (error "Theme `%s' is not found in `engrave-faces-current-preset-style' or availible Emacs themes" theme))))
-      (user-error "Theme `%s' is not found in `engrave-faces-current-preset-style' or availible Emacs themes" theme))))
 
 (defun engrave-faces-use-theme (&optional theme insert-def)
   "Select a THEME an apply it as the current engraved preset style.