[elpa] externals/engrave-faces 69f0e59 22/36: New backend: HTML

[ELPA Syncer]

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

    New backend: HTML
---
 README.org            |   2 +-
 engrave-faces-html.el | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 131 insertions(+), 1 deletion(-)

diff --git a/README.org b/README.org
index 7c8f771..82efd86 100644
--- a/README.org
+++ b/README.org
@@ -19,5 +19,5 @@ I fully expect some important items to have been forgotten.
 
 *Included backends*
 - [X] LaTeX
-- [ ] HTML
+- [X] HTML
 - [X] ANSI
diff --git a/engrave-faces-html.el b/engrave-faces-html.el
new file mode 100644
index 0000000..bb8ea22
--- /dev/null
+++ b/engrave-faces-html.el
@@ -0,0 +1,130 @@
+;;; engrave-faces-html.el --- Support for engraving buffers to HTML -*- 
lexical-binding: t; -*-
+
+;; This file is part of engrave-faces.
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;;; Commentary:
+
+;; Support for engraving buffers to HTML.
+
+;;; Code:
+
+(require 'engrave-faces)
+
+(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'."
+  :type '(choice nil preset)
+  :group 'engrave-faces)
+
+(defcustom engrave-faces-html-class-prefix "ef-"
+  "Prefix to use when generating CSS class names."
+  :type 'string
+  :group 'engrave-faces)
+
+(defun engrave-faces-html-gen-stylesheet (&optional 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
+          "\n")))
+    (if indent
+        (mapconcat (lambda (line)
+                     (concat indent line))
+                   (split-string stylesheet "\n")
+                   "\n")
+      stylesheet)))
+
+(defun engrave-faces-html-gen-stylesheet-entry (face style)
+  "Generate a HTML preamble line for STYLE representing FACE."
+  (concat "." engrave-faces-html-class-prefix (plist-get style :slug)
+          " {\n  "
+          (engrave-faces-html-gen-style-css style "\n  ")
+          " }"))
+
+(defun engrave-faces-html-gen-style-css (attrs seperator)
+  "Compose the relevant CSS styles to apply compatible ATTRS, seperated by 
SEPERATOR."
+  (let ((fg    (plist-get attrs      :foreground))
+        (bg    (plist-get attrs      :background))
+        (st    (plist-get attrs      :strike-through))
+        (ul    (plist-get attrs      :underline))
+        (it    (eql (plist-get attrs :slant) 'italic))
+        (wt    (plist-get attrs      :weight)))
+    (mapconcat
+     #'identity
+     (delq nil
+           (list
+            (when fg (format "color: %s;" fg))
+            (when bg (format "background-color: %s;" bg))
+            (when st "text-decoration: line-through;")
+            (when ul "text-decoration: underline;")
+            (when it "text-decoration: italic;")
+            (when wt (format "font-weight: %s;" wt))))
+     seperator)))
+
+(defun engrave-faces-html-face-apply (faces content)
+  (let ((attrs (engrave-faces-merge-attributes faces)))
+    (concat "<span style=\"" (engrave-faces-html-gen-style-css attrs " ") "\">"
+            content "</span>")))
+
+(defun engrave-faces-html-protect-string (str)
+  (replace-regexp-in-string
+   "<" "&lt;"
+   (replace-regexp-in-string
+    ">" "&gt;"
+    (replace-regexp-in-string
+     "&" "&amp;"
+     str))))
+
+(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 (unless (eq faces 'default) (assoc faces 
engrave-faces-preset-styles))))
+    (if (string-match-p "\\`[\n[:space:]]+\\'" content)
+        protected-content
+      (if (and style (eq engrave-faces-html-output-style 'preset))
+          (concat "<span class=\"" engrave-faces-html-class-prefix
+                  (plist-get (cdr style) :slug) "\">"
+                  protected-content "</span>")
+        (engrave-faces-html-face-apply faces protected-content)))))
+
+(defun engrave-faces-html-make-standalone ()
+  "Export current buffer to a standalone LaTeX buffer."
+  (goto-char (point-min))
+  (insert "<!DOCTYPE html>
+<html>
+  <head>
+    <meta charset=\"utf-8\">
+    <title>"
+          (engrave-faces-html-protect-string (if (buffer-file-name)
+                                                 (file-name-nondirectory 
(buffer-file-name))
+                                               (buffer-name)))
+          "</title>
+    <style>
+      pre {
+        font-size: 1rem;
+        max-width: min(100rem, 100%);
+        width: max-content;
+        white-space: pre-wrap;
+        margin: auto; }\n"
+          (engrave-faces-html-gen-stylesheet "      ")
+          "
+    </style>
+  </head>
+  <body>
+<pre>\n")
+  (goto-char (point-max))
+  (insert "
+</pre>
+  <body>
+</html>"))
+
+;;;###autoload
+(engrave-faces-define-backend "html" ".html" #'engrave-faces-html-face-mapper 
#'engrave-faces-html-make-standalone #'html-mode)
+
+(provide 'engrave-faces-html)
+;;; engrave-faces-html.el ends here