-
-
Notifications
You must be signed in to change notification settings - Fork 5
/
engrave-faces-latex.el
226 lines (200 loc) · 9.08 KB
/
engrave-faces-latex.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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
;;; engrave-faces-latex.el --- Support for engraving buffers to LaTeX -*- 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 LaTeX.
;;; Code:
(require 'engrave-faces)
(require 'cl-lib)
(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'."
:type '(choice nil preset)
:group 'engrave-faces)
(defcustom engrave-faces-latex-mathescape nil
"Whether maths characters in comments should be allowed.
When nil, all potential maths (both \"$tex$\" and
\"\\(latex\\)\") is protected by
`engrave-faces-latex--protect-content'. Three non-nil symbols are
supported:
- latex, in which case the content of LaTeX maths is left unprotected
- tex, in which case the content of TeX dollar-delimited maths is left
unprotected
- t, in which case LaTeX and TeX maths are supported
This only affects text set with `font-lock-comment-face'.
For TeX maths to be supported, fvextra's mathescape option must
also be applied. This is done automatically when generating a
standalone document."
:type 'boolean
:group 'engrave-faces)
(defcustom engrave-faces-latex-colorbox-strut
"\\vrule height 2.1ex depth 0.8ex width 0pt"
"LaTeX code which sets the height and depth for any colorboxes."
:type 'string
:group 'engrave-faces)
(defun engrave-faces-latex-gen-preamble (&optional theme)
"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
(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."
(let ((short (plist-get style :slug))
(fg (plist-get style :foreground))
(bg (plist-get style :background))
(st (plist-get style :strike-through))
(it (eql (plist-get style :slant) 'italic))
(bl (member (plist-get style :weight) '(bold extra-bold))))
(concat (when fg (format "\\definecolor{EF%s}{HTML}{%s}\n" short (substring fg 1)))
(when bg (format "\\definecolor{Ef%s}{HTML}{%s}\n" short (substring bg 1)))
"\\newcommand{\\EF" short "}[1]{"
(when (and bg (not (eq face 'default)))
(concat "\\colorbox{Ef" short "}{\\efstrut{}"))
(when fg (concat "\\textcolor{EF" short "}{"))
(when st "\\sout{") (when bl "\\textbf{") (when it "\\textit{")
"#1}"
(make-string
(cl-count-if #'identity
(list (and bg (not (eq face 'default))) fg st bl it))
?})
" % " (symbol-name face))))
(defun engrave-faces-latex-face-apply (faces content)
"Convert the parameters of FACES to a LaTeX command applied to CONTENT."
(let ((attrs (engrave-faces-merge-attributes faces)))
(let ((bg (plist-get attrs :background))
(fg (plist-get attrs :foreground))
(it (eql (plist-get attrs :slant) 'italic))
(bl (member (plist-get attrs :weight) '(bold extra-bold)))
(st (plist-get attrs :strike-through)))
(concat
(when bg (concat "\\colorbox[HTML]{" (substring bg 1) "}{"))
(when fg (concat "\\textcolor[HTML]{" (substring fg 1) "}{"))
(when st "\\sout{") (when bl "\\textbf{") (when it "\\textit{")
content
(when bg "}") (when fg "}") (when st "}") (when bl "}") (when it "}")))))
(defconst engrave-faces-latex--char-replacements
'(("\\\\" . "\\char92{}")
("^" . "\\char94{}")
("~" . "\\char126{}")))
(defun engrave-faces-latex--protect-content (content)
"Escape active characters in CONTENT."
(replace-regexp-in-string
(regexp-opt (mapcar #'car engrave-faces-latex--char-replacements))
(lambda (char)
(cdr (assoc char engrave-faces-latex--char-replacements)))
(replace-regexp-in-string
"[\\{}$%&_#]" "\\\\\\&"
content)
nil t))
(defun engrave-faces-latex--protect-content-mathescape (content)
"Protect CONTENT, but leave inline maths unaffected."
(let ((dollar-maths
(and (memq engrave-faces-latex-mathescape '(t tex TeX))
(string-match-p "\\$.+\\$" content)))
(paren-maths
(and (memq engrave-faces-latex-mathescape '(t latex LaTeX))
(string-match-p "\\\\(.+\\\\)" content))))
(replace-regexp-in-string
(cond
(dollar-maths "^\\([^$]*\\)\\(\\$.+\\$\\)\\([^$]*\\)$")
(paren-maths "^\\(.*?\\)\\(\\\\(.+\\\\)\\)\\(.*?\\)$")
(t "^\\(.*\\)\\(\\)\\(\\)$"))
(lambda (full-match)
(concat (engrave-faces-latex--protect-content (match-string 1 full-match))
(match-string 2 full-match)
(engrave-faces-latex--protect-content (match-string 3 full-match))))
content
nil t)))
(defun engrave-faces-latex-face-mapper (faces content)
"Create a LaTeX representation of CONTENT With FACES applied."
(let* ((style (engrave-faces-preset-style faces))
(protected-content
(funcall
(if (and engrave-faces-latex-mathescape
(eq 'font-lock-comment-face (car style)))
#'engrave-faces-latex--protect-content-mathescape
#'engrave-faces-latex--protect-content)
content)))
;; Wrap groups of "words joined by blank characters" in LaTeX commands.
;; Do not wrap newlines and other whitespace between those groups.
(let ((contains-blank-re
(rx (or (group (+ graph ) (* (+ blank) (+ graph)))
(group (+ (any "\n" space))))))
(slug (and style
(eq engrave-faces-latex-output-style 'preset)
(plist-get (cdr style) :slug))))
(with-temp-buffer
(insert protected-content)
(goto-char (point-min))
(while (re-search-forward contains-blank-re nil t)
(replace-match
(concat
(and (match-string 1)
(if (stringp slug)
(format "\\EF%s{%s}" slug (match-string 1))
(engrave-faces-latex-face-apply faces (match-string 1))))
(match-string 2))
t t))
(buffer-string)))))
(defun engrave-faces-latex--post-processing ()
"Set the initial text color and curly paren positioning.
Trailing curly parens are sometimes put on the next line,
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)
(format "\\color{EF%s}" (plist-get style :slug))
(concat "\\color[HTML]{" (substring (plist-get style :foreground) 1) "}"))))
(goto-char (point-min))
(while (re-search-forward "\n\\([[:space:]]*\\)\\(}+\\)" nil t)
(replace-match "\\2\n\\1")))
(defun engrave-faces-latex-make-standalone ()
"Export current buffer to a standalone LaTeX buffer."
(goto-char (point-min))
(insert "\\documentclass{article}
\\usepackage[margin=1.5cm]{geometry}
\\usepackage{xcolor}
\\usepackage{fvextra}
\\usepackage{sourcecodepro}
\\pagestyle{empty}\n\n"
(engrave-faces-latex-gen-preamble)
"
\\begin{document}\n"
(let ((default-face
(alist-get 'default engrave-faces-current-preset-style)))
(concat
(when (plist-get default-face :background)
(format "\\pagecolor{Ef%s}\n" (plist-get default-face :slug)))
(when (plist-get default-face :foreground)
(format "\\color{EF%s}\n" (plist-get default-face :slug)))))
"\\setlength{\\fboxsep}{0pt}
\\begin{Verbatim}[breaklines=true, commandchars=\\\\\\{\\}"
(if engrave-faces-latex-mathescape
", mathescape" "")
"]\n")
(goto-char (point-max))
(insert "\\end{Verbatim}
\\end{document}"))
;;;###autoload (autoload #'engrave-faces-latex-buffer "engrave-faces-latex" nil t)
;;;###autoload (autoload #'engrave-faces-latex-buffer-standalone "engrave-faces-latex" nil t)
;;;###autoload (autoload #'engrave-faces-latex-file "engrave-faces-latex" nil t)
(engrave-faces-define-backend "latex" ".tex" #'engrave-faces-latex-face-mapper #'engrave-faces-latex-make-standalone #'latex-mode)
(add-hook 'engrave-faces-latex-after-hook #'engrave-faces-latex--post-processing)
(provide 'engrave-faces-latex)
;;; engrave-faces-latex.el ends here