Compare commits
8 Commits
25157a07bd
...
f5c1eb0c2a
Author | SHA1 | Date |
---|---|---|
TEC | f5c1eb0c2a | |
TEC | 2f39df4c22 | |
TEC | 40021aed6b | |
TEC | 71301e19c6 | |
TEC | 964e4d4c67 | |
TEC | 6ec666c48f | |
TEC | dfb8eac3d9 | |
Ellis Kenyo | 0cc5d0b980 |
|
@ -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'."
|
||||
:type '(choice nil preset)
|
||||
When preset, CSS classes are generated for `engrave-faces-current-preset-style'."
|
||||
: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
|
||||
(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)))
|
||||
(let ((face-styles
|
||||
(cond
|
||||
((and theme (symbolp theme))
|
||||
(engrave-faces-get-theme theme))
|
||||
((consp theme)
|
||||
theme)
|
||||
(t engrave-faces-current-preset-style))))
|
||||
(mapconcat
|
||||
(lambda (face-style)
|
||||
(concat indent (engrave-faces-html--gen-stylesheet-entry
|
||||
(car face-style) (cdr face-style))))
|
||||
face-styles
|
||||
"\n")))
|
||||
|
||||
(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>")
|
||||
|
|
|
@ -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'."
|
||||
:type '(choice nil preset)
|
||||
When preset, short commands are generated for
|
||||
`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
|
||||
(if theme
|
||||
(engrave-faces-get-theme theme)
|
||||
engrave-faces-current-preset-style)))
|
||||
(let ((face-styles
|
||||
(cond
|
||||
((and theme (symbolp theme))
|
||||
(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
|
||||
|
|
154
engrave-faces.el
154
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 "-after-hook")) nil)))
|
||||
(defvar ,(intern (concat "engrave-faces-" backend "-before-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."
|
||||
(pcase faces
|
||||
('default nil)
|
||||
((pred symbolp)
|
||||
(assoc faces engrave-faces-preset-styles))
|
||||
((and (pred listp) (app length 1))
|
||||
(assoc (car faces) engrave-faces-preset-styles))))
|
||||
Unconditionally returns nil when FACES is default.
|
||||
|
||||
DYNAMIC-THEME-P specifies whether `engrave-faces-dynamic-style'
|
||||
should be used."
|
||||
(when-let ((face (cond
|
||||
((symbolp faces) faces)
|
||||
((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)))
|
||||
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)
|
||||
(redraw-display)
|
||||
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))))
|
||||
(or (alist-get theme engrave-faces-themes)
|
||||
(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)
|
||||
(redraw-display)
|
||||
spec))))
|
||||
(unless noput
|
||||
(push (cons theme spec) engrave-faces-themes))
|
||||
spec)
|
||||
(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.
|
||||
|
|
Loading…
Reference in New Issue