-
-
Notifications
You must be signed in to change notification settings - Fork 5
/
engrave-faces-html.el
172 lines (154 loc) · 6.28 KB
/
engrave-faces-html.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
;;; engrave-faces-html.el --- Support for engraving buffers to HTML -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
;; 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 theme indent)
"Generate a preamble which provides short commands for the preset styles.
See `engrave-faces-preset-styles' 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
(mapconcat
(lambda (face-style)
(engrave-faces-html--gen-stylesheet-entry (car face-style) (cdr face-style)))
(if theme
(engrave-faces-get-theme theme)
engrave-faces-current-preset-style)
"\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 (or (plist-get style :slug)
(symbol-name face))
" {\n "
(engrave-faces-html--gen-style-css style "\n ")
" }"))
(defun engrave-faces-html--gen-style-css (attrs &optional seperator)
"Compose CSS styles from ATTRS, seperated by a single space or 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))
(ht (plist-get attrs :height)))
(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;" (engrave-faces-html--css-weight wt)))
(when (and ht (floatp ht)) (format "font-size: %sem" ht))))
(or " " seperator))))
(defun engrave-faces-html--css-weight (weight)
"Give the numerical CSS font WEIGHT.
Values are taken from https://docs.microsoft.com/en-us/typography/opentype/spec/os2#usweightclass."
(pcase weight
('thin 100)
('extra-light 200) ('ultra-light 200)
('light 300)
('semi-light 350)
('normal 400)
('regular 400)
('book 450)
('medium 500)
('semi-bold 600) ('demi-bold 600)
('bold 700)
('exra-bold 800) ('ultra-bold 800)
('black 900) ('heavy 900)))
(defun engrave-faces-html--face-apply (faces content)
"Apply FACES to CONTENT."
(let* ((attrs (engrave-faces-merge-attributes faces))
(style (engrave-faces-html--gen-style-css attrs " ")))
(if (string= style "")
content
(concat "<span style=\"" style "\">" content "</span>"))))
(defun engrave-faces-html--protect-string (str)
"Protect interpreted characters in STR."
(replace-regexp-in-string
"<" "<"
(replace-regexp-in-string
">" ">"
(replace-regexp-in-string
"&" "&"
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 (engrave-faces-preset-style faces)))
(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 HTML 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>"
(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)
(concat "\n body {"
(when default-bg (format " background: %s;" default-bg))
(when default-fg (format " color: %s;" default-fg))
" }")
""))
"
pre {
font-size: 1rem;
max-width: min(100rem, 100%);
width: max-content;
white-space: pre-wrap;
margin: auto; }\n"
(engrave-faces-html-gen-stylesheet nil " ")
"
</style>
</head>
<body>
<pre>\n")
(goto-char (point-max))
(insert "
</pre>
<body>
</html>"))
;;;###autoload (autoload #'engrave-faces-html-buffer "engrave-faces-html" nil t)
;;;###autoload (autoload #'engrave-faces-html-buffer-standalone "engrave-faces-html" nil t)
;;;###autoload (autoload #'engrave-faces-html-file "engrave-faces-html" nil t)
(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