[elpa] externals/engrave-faces 4a0d16715a 4/8: Themes support

[ELPA Syncer]

branch: externals/engrave-faces
commit 4a0d16715a8fc7b1d6f88ecc2c6a83ab5eeef2ea
Author: TEC <tec@tecosaur.com>
Commit: TEC <tec@tecosaur.com>

    Themes support
---
 engrave-faces-html.el  |   8 +-
 engrave-faces-latex.el |  24 ++--
 engrave-faces.el       | 294 +++++++++++++++++++++++++++++++++----------------
 3 files changed, 217 insertions(+), 109 deletions(-)

diff --git a/engrave-faces-html.el b/engrave-faces-html.el
index 9166e01b0e..72be9d023b 100644
--- a/engrave-faces-html.el
+++ b/engrave-faces-html.el
@@ -25,14 +25,16 @@ When preset, CSS classes are generated for 
`engrave-faces-preset-styles'."
   :type 'string
   :group 'engrave-faces)
 
-(defun engrave-faces-html-gen-stylesheet (&optional indent)
+(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'."
   (let ((stylesheet
          (mapconcat
           (lambda (face-style)
             (engrave-faces-html--gen-stylesheet-entry (car face-style) (cdr 
face-style)))
-          engrave-faces-preset-styles
+          (if theme
+              (engrave-faces-get-theme theme)
+            engrave-faces-current-preset-style)
           "\n")))
     (if indent
         (mapconcat (lambda (line)
@@ -125,7 +127,7 @@ See `engrave-faces-preset-styles' and 
`engrave-faces-html-output-style'."
                                                (buffer-name)))
           "</title>
     <style>"
-          (let* ((default-sty (cdr (assoc 'default 
engrave-faces-preset-styles)))
+          (let* ((default-sty (cdr (assoc 'default 
engrave-faces-current-preset-style)))
                  (default-bg (plist-get default-sty :background))
                  (default-fg (plist-get default-sty :foreground)))
             (if (or default-bg default-fg)
diff --git a/engrave-faces-latex.el b/engrave-faces-latex.el
index f7c867ebc0..48dbbdbec8 100644
--- a/engrave-faces-latex.el
+++ b/engrave-faces-latex.el
@@ -27,18 +27,22 @@ When preset, short commands are generated for 
`engrave-faces-preset-styles'."
   :type 'string
   :group 'engrave-faces)
 
-(defun engrave-faces-latex-gen-preamble ()
+(defun engrave-faces-latex-gen-preamble (&optional theme)
   "Generate a preamble which provides short commands for the preset styles.
 See `engrave-faces-preset-styles' and `engrave-faces-latex-output-style'."
-  (concat
-   (unless (cl-notany (lambda (s) (plist-get (cdr s) :background))
-                      engrave-faces-preset-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)))
-    engrave-faces-preset-styles
-    "\n")))
+  (let ((preset-style
+         (if theme
+             (engrave-faces-get-theme theme)
+           engrave-faces-current-preset-style)))
+    (concat
+     (unless (cl-notany (lambda (s) (plist-get (cdr s) :background))
+                        preset-style)
+       (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
+      "\n"))))
 
 (defun engrave-faces-latex-gen-preamble-line (face style)
   "Generate a LaTeX preamble line for STYLE representing FACE."
diff --git a/engrave-faces.el b/engrave-faces.el
index 903d9e4078..a6d3940b89 100644
--- a/engrave-faces.el
+++ b/engrave-faces.el
@@ -79,103 +79,109 @@ If STANDALONE-TRANSFORMER is given it will be used when 
directly creating a file
 and cause a -standalone version of the buffer transforming function to be 
created."
   `(progn (add-to-list 'engrave-faces--backends
                        (list ,backend :face-transformer ,face-transformer 
:extension ,extension))
-          (defun ,(intern (concat "engrave-faces-" backend "-buffer")) 
(&optional switch-to-result)
+          (defun ,(intern (concat "engrave-faces-" backend "-buffer")) 
(&optional theme switch-to-result)
             ,(concat "Convert buffer to " backend " formatting.")
             (interactive '(t))
-            (let ((buf (engrave-faces-buffer ,backend)))
+            (let ((buf (engrave-faces-buffer ,backend theme)))
               (when switch-to-result
                 (switch-to-buffer buf)
                 ,(when view-setup `(funcall ,view-setup)))
               buf))
           ,(when standalone-transformer
-             `(defun ,(intern (concat "engrave-faces-" backend 
"-buffer-standalone")) (&optional switch-to-result)
+             `(defun ,(intern (concat "engrave-faces-" backend 
"-buffer-standalone")) (&optional theme switch-to-result)
                 (interactive '(t))
                 ,(concat "Export the current buffer to a standalone " backend 
" buffer.")
-                (let ((buf (engrave-faces-buffer ,backend)))
+                (let ((buf (engrave-faces-buffer ,backend theme)))
                   (with-current-buffer buf
                     (funcall ,standalone-transformer))
                   (when switch-to-result
                     (switch-to-buffer buf)
                     ,(when view-setup `(funcall ,view-setup)))
                   buf)))
-          (defun ,(intern (concat "engrave-faces-" backend "-file")) (file 
&optional out-file open-result)
+          (defun ,(intern (concat "engrave-faces-" backend "-file")) (file 
&optional out-file theme open-result)
             ,(concat "Convert file to " backend " formatting.")
             (interactive (list buffer-file-name nil t))
             (unless out-file
               (setq out-file (concat file ,extension)))
-            (engrave-faces-file file out-file ,backend ,standalone-transformer)
+            (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 "-after-hook")) 
nil)))
 
-(defun engrave-faces-file (in-file out-file backend &optional postprocessor)
+(defun engrave-faces-file (in-file out-file backend &optional theme 
postprocessor)
   "Using BACKEND, engrave IN-FILE and save it as FILE.EXTENSION.
 If a POSTPROCESSOR function is provided, it is called before saving."
   (with-temp-buffer
     (insert-file-contents in-file)
     (let ((buffer-file-name in-file))
       (normal-mode)
-      (with-current-buffer (engrave-faces-buffer backend)
+      (with-current-buffer (engrave-faces-buffer backend theme)
         (when postprocessor (funcall postprocessor))
         (write-region (point-min) (point-max) out-file)
         (kill-buffer)))))
 
-(defun engrave-faces-buffer (backend)
+(defun engrave-faces-buffer (backend &optional theme)
   "Export the current buffer with BACKEND and return the created buffer."
-  (save-excursion
-    ;; Protect against the hook changing the current buffer.
+  (let ((engrave-faces-current-preset-style
+         (if theme
+             (engrave-faces-get-theme theme)
+           engrave-faces-current-preset-style)))
     (save-excursion
-      (run-hooks 'engrave-faces-before-hook)
-      (run-hooks (intern (concat "engrave-faces-" backend "-before-hook"))))
-    ;; Convince font-lock support modes to fontify the entire buffer
-    ;; in advance.
-    (when (and (boundp 'jit-lock-mode)
-               (symbol-value 'jit-lock-mode))
-      (jit-lock-fontify-now (point-min) (point-max)))
-    (font-lock-ensure)
-
-    ;; It's important that the new buffer inherits default-directory
-    ;; from the current buffer.
-    (let ((engraved-buf (generate-new-buffer (if (buffer-file-name)
-                                                 (concat 
(file-name-nondirectory (buffer-file-name))
-                                                         (plist-get (cdr 
(assoc backend engrave-faces--backends)) :extension))
-                                               (concat "*" backend "*"))))
-          (face-transformer (plist-get (cdr (assoc backend 
engrave-faces--backends)) :face-transformer))
-          (completed nil))
-      (unwind-protect
-          (let (next-change text)
-            ;; This loop traverses and reads the source buffer, appending the
-            ;; resulting text to the export buffer. This method is fast 
because:
-            ;; 1) it doesn't require examining the text properties char by char
-            ;; (engrave-faces--next-face-change is used to move between runs 
with
-            ;; the same face), and 2) it doesn't require frequent buffer
-            ;; switches, which are slow because they rebind all buffer-local
-            ;; vars.
-            (goto-char (point-min))
-            (while (not (eobp))
-              (setq next-change (engrave-faces--next-face-change (point)))
-              (setq text (buffer-substring-no-properties (point) next-change))
-              ;; Don't bother writing anything if there's no text (this
-              ;; happens in invisible regions).
-              (when (> (length text) 0)
-                (princ (funcall face-transformer
-                                (let ((prop (get-text-property (point) 'face)))
-                                  (cond
-                                   ((null prop) 'default)
-                                   ((and (listp prop) (eq (car prop) 'quote))
-                                    (eval prop t))
-                                   (t prop)))
-                                text)
-                       engraved-buf))
-              (goto-char next-change)))
-        (setq completed t))
-      (if (not completed)
-          (kill-buffer engraved-buf)
-        (with-current-buffer engraved-buf
-          (run-hooks 'engrave-faces-after-hook)
-          (run-hooks (intern (concat "engrave-faces-" backend "-after-hook"))))
-        engraved-buf))))
+      ;; Protect against the hook changing the current buffer.
+      (save-excursion
+        (run-hooks 'engrave-faces-before-hook)
+        (run-hooks (intern (concat "engrave-faces-" backend "-before-hook"))))
+      ;; Convince font-lock support modes to fontify the entire buffer
+      ;; in advance.
+      (when (and (boundp 'jit-lock-mode)
+                 (symbol-value 'jit-lock-mode))
+        (jit-lock-fontify-now (point-min) (point-max)))
+      (font-lock-ensure)
+      ;; It's important that the new buffer inherits default-directory
+      ;; from the current buffer.
+      (let ((engraved-buf
+             (generate-new-buffer
+              (if (buffer-file-name)
+                  (concat (file-name-nondirectory (buffer-file-name))
+                          (plist-get (cdr (assoc backend 
engrave-faces--backends)) :extension))
+                (concat "*" backend "*"))))
+            (face-transformer (plist-get (cdr (assoc backend 
engrave-faces--backends)) :face-transformer))
+
+            (completed nil))
+        (unwind-protect
+            (let (next-change text)
+              ;; This loop traverses and reads the source buffer, appending the
+              ;; resulting text to the export buffer. This method is fast 
because:
+              ;; 1) it doesn't require examining the text properties char by 
char
+              ;; (engrave-faces--next-face-change is used to move between runs 
with
+              ;; the same face), and 2) it doesn't require frequent buffer
+              ;; switches, which are slow because they rebind all buffer-local
+              ;; vars.
+              (goto-char (point-min))
+              (while (not (eobp))
+                (setq next-change (engrave-faces--next-face-change (point)))
+                (setq text (buffer-substring-no-properties (point) 
next-change))
+                ;; Don't bother writing anything if there's no text (this
+                ;; happens in invisible regions).
+                (when (> (length text) 0)
+                  (princ (funcall face-transformer
+                                  (let ((prop (get-text-property (point) 
'face)))
+                                    (cond
+                                     ((null prop) 'default)
+                                     ((and (listp prop) (eq (car prop) 'quote))
+                                      (eval prop t))
+                                     (t prop)))
+                                  text)
+                         engraved-buf))
+                (goto-char next-change)))
+          (setq completed t))
+        (if (not completed)
+            (kill-buffer engraved-buf)
+          (with-current-buffer engraved-buf
+            (run-hooks 'engrave-faces-after-hook)
+            (run-hooks (intern (concat "engrave-faces-" backend 
"-after-hook"))))
+          engraved-buf)))))
 
 (defun engrave-faces-merge-attributes (faces &optional attributes)
   "Find the final ATTRIBUTES for text with FACES."
@@ -214,7 +220,7 @@ To consider inheritence, use 
`engrave-faces-explicit-inheritance' first."
   (delq nil (delq 'unspecified
                   (mapcar
                    (lambda (face)
-                     (if-let ((style (cdr (assoc face 
engrave-faces-preset-styles))))
+                     (if-let ((style (cdr (assoc face 
engrave-faces-current-preset-style))))
                          (plist-get style attribute)
                        (cond
                         ((symbolp face)
@@ -232,8 +238,8 @@ This function is lifted from htmlize."
   ;; overlays that specify the `face' property, even when they
   ;; contain smaller text properties that also specify `face'.
   ;; Emacs display engine merges those faces, and so must we.
-  (or limit
-      (setq limit (point-max)))
+  (unless limit
+    (setq limit (point-max)))
   (let ((next-prop (next-single-property-change pos 'face nil limit))
         (overlay-faces (engrave-faces--overlay-faces-at pos)))
     (while (progn
@@ -252,36 +258,70 @@ This function is lifted from htmlize."
 
 ;;; Style helpers
 
-(defcustom engrave-faces-preset-styles ; doom-one-light
-  '((default                             :short "default"          :slug "D"   
  :foreground "#383a42")
-    (font-lock-keyword-face              :short "keyword"          :slug "k"   
  :foreground "#e45649")
-    (font-lock-doc-face                  :short "doc"              :slug "d"   
  :foreground "#84888b" :slant italic)
-    (font-lock-type-face                 :short "type"             :slug "t"   
  :foreground "#986801")
-    (font-lock-string-face               :short "string"           :slug "s"   
  :foreground "#50a14f")
-    (font-lock-warning-face              :short "warning"          :slug "w"   
  :foreground "#986801")
-    (font-lock-builtin-face              :short "builtin"          :slug "b"   
  :foreground "#a626a4")
-    (font-lock-comment-face              :short "comment"          :slug "ct"  
  :foreground "#9ca0a4")
-    (font-lock-constant-face             :short "constant"         :slug "c"   
  :foreground "#b751b6")
-    (font-lock-preprocessor-face         :short "preprocessor"     :slug "pp"  
  :foreground "#4078f2" :weight bold)
-    (font-lock-negation-char-face        :short "neg-char"         :slug "nc"  
  :foreground "#4078f2" :weight bold)
-    (font-lock-variable-name-face        :short "variable"         :slug "v"   
  :foreground "#6a1868")
-    (font-lock-function-name-face        :short "function"         :slug "f"   
  :foreground "#a626a4")
-    (font-lock-comment-delimiter-face    :short "comment-delim"    :slug "cd"  
  :foreground "#9ca0a4")
-    (font-lock-regexp-grouping-construct :short "regexp"           :slug "rc"  
  :foreground "#4078f2" :weight bold)
-    (font-lock-regexp-grouping-backslash :short "regexp-backslash" :slug "rb"  
  :foreground "#4078f2" :weight bold)
-    (org-block                           :short "org-block"        :slug "ob") 
; forcing no background is preferable
-    (highlight-numbers-number            :short "number"           :slug "hn"  
  :foreground "#da8548" :weight bold)
-    (highlight-quoted-quote              :short "qquote"           :slug "hq"  
  :foreground "#4078f2")
-    (highlight-quoted-symbol             :short "qsymbol"          :slug "hs"  
  :foreground "#986801")
-    (rainbow-delimiters-depth-1-face     :short "rd1"              :slug "rdi" 
  :foreground "#4078f2")
-    (rainbow-delimiters-depth-2-face     :short "rd2"              :slug 
"rdii"  :foreground "#a626a4")
-    (rainbow-delimiters-depth-3-face     :short "rd3"              :slug 
"rdiii" :foreground "#50a14f")
-    (rainbow-delimiters-depth-4-face     :short "rd4"              :slug 
"rdiv"  :foreground "#da8548")
-    (rainbow-delimiters-depth-5-face     :short "rd5"              :slug "rdv" 
  :foreground "#b751b6")
-    (rainbow-delimiters-depth-6-face     :short "rd6"              :slug 
"rdvi"  :foreground "#986801")
-    (rainbow-delimiters-depth-7-face     :short "rd7"              :slug 
"rdvii" :foreground "#4db5bd")
-    (rainbow-delimiters-depth-8-face     :short "rd8"              :slug 
"rdiix" :foreground "#80a880")
-    (rainbow-delimiters-depth-9-face     :short "rd9"              :slug 
"rdix"  :foreground "#887070"))
+(defcustom engrave-faces-themes
+  '((default .
+      (;; faces.el --- excluding: bold, italic, bold-italic, underline, and 
some others
+       (default                             :short "default"          :slug 
"D"     :foreground "#000000")
+       (shadow                              :short "shadow"           :slug 
"sh"    :foreground "#7f7f7f")
+       (success                             :short "success"          :slug 
"ss"    :foreground "#228b22" :weight bold)
+       (warning                             :short "warning"          :slug 
"w"     :foreground "#ff8e00" :weight bold)
+       (error                               :short "error"            :slug 
"e"     :foreground "#ff0000" :weight bold)
+       ;; font-lock.el
+       (font-lock-comment-face              :short "comment"          :slug 
"ct"    :foreground "#b22222")
+       (font-lock-comment-delimiter-face    :short "comment-delim"    :slug 
"cd"    :foreground "#b22222")
+       (font-lock-string-face               :short "string"           :slug 
"s"     :foreground "#8b2252")
+       (font-lock-doc-face                  :short "doc"              :slug 
"d"     :foreground "#8b2252")
+       (font-lock-doc-markup-face           :short "doc-markup"       :slug 
"dm"    :foreground "#008b8b")
+       (font-lock-keyword-face              :short "keyword"          :slug 
"k"     :foreground "#9370db")
+       (font-lock-builtin-face              :short "builtin"          :slug 
"b"     :foreground "#483d8b")
+       (font-lock-function-name-face        :short "function"         :slug 
"f"     :foreground "#0000ff")
+       (font-lock-variable-name-face        :short "variable"         :slug 
"v"     :foreground "#a0522d")
+       (font-lock-type-face                 :short "type"             :slug 
"t"     :foreground "#228b22")
+       (font-lock-constant-face             :short "constant"         :slug 
"c"     :foreground "#008b8b")
+       (font-lock-warning-face              :short "fl-warning"       :slug 
"W"     :foreground "#ff0000" :weight bold)
+       (font-lock-negation-char-face        :short "neg-char"         :slug 
"nc")
+       (font-lock-preprocessor-face         :short "preprocessor"     :slug 
"pp"    :foreground "#483d8b")
+       (font-lock-regexp-grouping-construct :short "regexp"           :slug 
"rc"    :weight bold)
+       (font-lock-regexp-grouping-backslash :short "regexp-backslash" :slug 
"rb"    :weight bold)
+       ;; org-faces.el
+       (org-block                           :short "org-block"        :slug 
"ob") ; forcing no background is preferable
+       ;; highlight-numbers.el
+       (highlight-numbers-number            :short "number"           :slug 
"hn"    :foreground "#008b8b")
+       ;; highlight-quoted.el
+       (highlight-quoted-quote              :short "qquote"           :slug 
"hq"    :foreground "#9370db")
+       (highlight-quoted-symbol             :short "qsymbol"          :slug 
"hs"    :foreground "#008b8b")
+       ;; rainbow-delimiters.el
+       (rainbow-delimiters-depth-1-face     :short "rd1"              :slug 
"rdi"   :foreground "#707183")
+       (rainbow-delimiters-depth-2-face     :short "rd2"              :slug 
"rdii"  :foreground "#7388d6")
+       (rainbow-delimiters-depth-3-face     :short "rd3"              :slug 
"rdiii" :foreground "#909183")
+       (rainbow-delimiters-depth-4-face     :short "rd4"              :slug 
"rdiv"  :foreground "#709870")
+       (rainbow-delimiters-depth-5-face     :short "rd5"              :slug 
"rdv"   :foreground "#907373")
+       (rainbow-delimiters-depth-6-face     :short "rd6"              :slug 
"rdvi"  :foreground "#6276ba")
+       (rainbow-delimiters-depth-7-face     :short "rd7"              :slug 
"rdvii" :foreground "#858580")
+       (rainbow-delimiters-depth-8-face     :short "rd8"              :slug 
"rdiix" :foreground "#80a880")
+       (rainbow-delimiters-depth-9-face     :short "rd9"              :slug 
"rdix"  :foreground "#887070"))))
+  "A collection of named style presets.
+
+This takes the form of an alist with theme names as the cars, with
+cdrs in the form of `engrave-faces-current-preset-style'."
+  :type '(alist
+          :key-type (symbol :tag "Theme name")
+          :value-type
+          (repeat
+           (cons (symbol :tag "Face")
+                 (plist :key-type (choice
+                                   (const :tag "Short identifier" :short)
+                                   (const :tag "Very short identifier" :slug)
+                                   (symbol :tag "Face attribute")
+                                   :tag "Property")
+                        :value-type (choice :tag "Value" string symbol)
+                        :tag "Face specification"))))
+  :group 'engrave-faces)
+
+(define-obsolete-variable-alias 'engrave-faces-preset-styles 
'engrave-faces-current-preset-style "0.3")
+
+(defcustom engrave-faces-current-preset-style
+  (alist-get 'default engrave-faces-themes)
   "Overriding face values.
 
 By setting :foreground, :background, etc. a certain theme can be set for
@@ -291,7 +331,15 @@ inherited styles.
 Faces here will represented more compactly when possible, by using the
 :short or :slug parameter to produce a named version styles, wheras other
 faces will need to be explicitly styled each time they're used."
-  :type '(repeat (repeat (choice symbol string)))
+  :type '(repeat
+          (cons (symbol :tag "Face")
+                (plist :key-type (choice
+                                  (const :tag "Short identifier" :short)
+                                  (const :tag "Very short identifier" :slug)
+                                  (symbol :tag "Face attribute")
+                                  :tag "Property")
+                       :value-type (choice :tag "Value" string symbol)
+                       :tag "Face specification")))
   :group 'engrave-faces)
 
 (defun engrave-faces--check-nondefault (attr value)
@@ -309,7 +357,7 @@ Unconditionally returns nil when FACES is default."
     ((and (pred listp) (app length 1)) (assoc (car faces) 
engrave-faces-preset-styles))))
 
 (defun engrave-faces-generate-preset ()
-  "Generate `engrave-faces-preset-styles' based on the current theme."
+  "Generate a preset style based on the current Emacs theme."
   (mapcar
    (lambda (face-style)
      (apply #'append
@@ -327,5 +375,59 @@ Unconditionally returns nil when FACES is default."
                    engrave-faces-attributes-of-interest))))
    engrave-faces-preset-styles))
 
+(defun engrave-faces-get-theme (theme &optional noput)
+  "Obtain the preset style for THEME.
+Unless NOPUT is non-nil, "
+  (if-let ((theme-preset (alist-get theme engrave-faces-themes)))
+      (setq engrave-faces-current-preset-style theme-preset)
+    (if (or (eq theme (car custom-enabled-themes))
+            (memq theme (custom-available-themes)))
+        (let ((spec
+               (if (eq theme (car custom-enabled-themes))
+                   (engrave-faces-generate-preset)
+                 (let ((old-theme (car custom-enabled-themes))
+                       spec)
+                   (load-theme theme t)
+                   (setq spec (engrave-faces-generate-preset))
+                   (load-theme old-theme t)
+                   spec))))
+          (unless noput
+            (push (cons theme spec) engrave-faces-themes))
+          spec)
+      (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.
+When INSERT-DEF is non-nil, or the universal argument has been
+provided, an expression adding THEME to `engrave-faces-themes'
+shall be inserted into the current buffer at point."
+  (interactive (list (intern
+                      (completing-read
+                       "Theme: "
+                       (cl-remove-duplicates
+                        (append
+                         (mapcar
+                          (lambda (theme)
+                            (propertize (symbol-name theme) 'face '(italic 
font-lock-doc-face)))
+                          (custom-available-themes))
+                         (list (propertize (symbol-name (car 
custom-enabled-themes))
+                                           'face '(bold 
font-lock-comment-face)))
+                         (mapcar #'car engrave-faces-themes)))))
+                     (when current-prefix-arg t)))
+  (unless theme
+    (setq theme (car custom-enabled-themes)))
+  (let ((spec (engrave-faces-get-theme theme)))
+    (if insert-def
+        (engrave-faces--insert-theme-def theme spec)
+      (setq engrave-faces-current-preset-style spec))))
+
+(defun engrave-faces--insert-theme-def (name &optional spec)
+  "Insert a definition for the theme NAME with a certain SPEC into the buffer."
+  (insert (pp
+           `(add-to-list
+             'engrave-faces-themes
+             ',(cons name (or spec
+                              (engrave-faces-get-theme name)))))))
+
 (provide 'engrave-faces)
 ;;; engrave-faces.el ends here