branch: externals/engrave-faces
commit 51a2f8d18ec5e3ce58499aaa27c6dbacf4265935
Author: TEC <[email protected]>
Commit: TEC <[email protected]>
Style, checkdoc, and byte-compile improvements
---
engrave-faces-ansi.el | 67 ++++++++++++++++++++++++++++++--------------------
engrave-faces-html.el | 12 ++++++---
engrave-faces-latex.el | 16 ++++++++----
engrave-faces.el | 40 +++++++++++++++++++-----------
4 files changed, 84 insertions(+), 51 deletions(-)
diff --git a/engrave-faces-ansi.el b/engrave-faces-ansi.el
index b19ca1ee21..5aaba1707b 100644
--- a/engrave-faces-ansi.el
+++ b/engrave-faces-ansi.el
@@ -29,8 +29,9 @@ Possible values are:
:group 'engrave-faces)
(defcustom engrave-faces-ansi-use-face-colours t
- "Whether to apply face colours"
- :group 'engrave-faces)
+ "Whether to apply face colours."
+ :group 'engrave-faces
+ :type 'boolean)
(defvar engrave-faces-ansi-face-nesting nil)
@@ -52,6 +53,8 @@ Possible values are:
;;;;; Color conversion
(defun engrave-faces-ansi--color-to-ansi (color &optional background)
+ "Convert the color COLOR to an ANSI code.
+When BACKGROUND is non-nil, the provided ANSI code sets the background color."
(if (eq color 'unspecified) nil
(apply (pcase engrave-faces-ansi-color-mode
((or '3-bit '8-color) #'engrave-faces-ansi-color-3bit-code)
@@ -61,7 +64,8 @@ Possible values are:
(append (mapcar (lambda (c) (/ c 257)) (color-values color)) (list
background)))))
(defun engrave-faces-ansi--color-dist-squared (reference rgb)
- "Squared l2 distance between a REFERENCE and RBG values, each a list of 3
values (r g b)."
+ "Squared l2 distance between a REFERENCE and particular RGB value.
+REFERENCE and RGB should each be a list of three values (r g b)."
(+ (* (nth 0 reference)
(nth 0 rgb))
(* (nth 1 reference)
@@ -73,24 +77,26 @@ Possible values are:
(defvar engrave-faces-ansi--256-to-16-map
'(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
- 0 4 4 4 12 12 2 6 4 4 12 12 2 2 6 4
- 12 12 2 2 2 6 12 12 10 10 10 10 14 12 10 10
- 10 10 10 14 1 5 4 4 12 12 3 8 4 4 12 12
- 2 2 6 4 12 12 2 2 2 6 12 12 10 10 10 10
- 14 12 10 10 10 10 10 14 1 1 5 4 12 12 1 1
- 5 4 12 12 3 3 8 4 12 12 2 2 2 6 12 12
- 10 10 10 10 14 12 10 10 10 10 10 14 1 1 1 5
- 12 12 1 1 1 5 12 12 1 1 1 5 12 12 3 3
- 3 7 12 12 10 10 10 10 14 12 10 10 10 10 10 14
- 9 9 9 9 13 12 9 9 9 9 13 12 9 9 9 9
- 13 12 9 9 9 9 13 12 11 11 11 11 7 12 10 10
- 10 10 10 14 9 9 9 9 9 13 9 9 9 9 9 13
- 9 9 9 9 9 13 9 9 9 9 9 13 9 9 9 9
- 9 13 11 11 11 11 11 15 0 0 0 0 0 0 8 8
- 8 8 8 8 7 7 7 7 7 7 15 15 15 15 15 15))
+ 0 4 4 4 12 12 2 6 4 4 12 12 2 2 6 4
+ 12 12 2 2 2 6 12 12 10 10 10 10 14 12 10 10
+ 10 10 10 14 1 5 4 4 12 12 3 8 4 4 12 12
+ 2 2 6 4 12 12 2 2 2 6 12 12 10 10 10 10
+ 14 12 10 10 10 10 10 14 1 1 5 4 12 12 1 1
+ 5 4 12 12 3 3 8 4 12 12 2 2 2 6 12 12
+ 10 10 10 10 14 12 10 10 10 10 10 14 1 1 1 5
+ 12 12 1 1 1 5 12 12 1 1 1 5 12 12 3 3
+ 3 7 12 12 10 10 10 10 14 12 10 10 10 10 10 14
+ 9 9 9 9 13 12 9 9 9 9 13 12 9 9 9 9
+ 13 12 9 9 9 9 13 12 11 11 11 11 7 12 10 10
+ 10 10 10 14 9 9 9 9 9 13 9 9 9 9 9 13
+ 9 9 9 9 9 13 9 9 9 9 9 13 9 9 9 9
+ 9 13 11 11 11 11 11 15 0 0 0 0 0 0 8 8
+ 8 8 8 8 7 7 7 7 7 7 15 15 15 15 15 15)
+ "A mapping from 256-color ANSI indicies to the closest 16-color number.")
(defun engrave-faces-ansi-color-4bit-code (r g b &optional background)
- "Convert the (R G B) colour code to a correspanding 4bit ansi escape
sequence."
+ "Convert the (R G B) colour code to a correspanding 4bit ansi escape
sequence.
+When BACKGROUND is non-nil, the provided ANSI code sets the background color."
(format "\uE000[%sm"
(pcase (nth (engrave-faces-ansi-color-rbg-to-256 r g b)
engrave-faces-ansi--256-to-16-map)
@@ -102,7 +108,8 @@ Possible values are:
(defun engrave-faces-ansi-color-3bit-code (r g b &optional background)
"Convert the (R G B) colour code to a correspanding 3bit ansi escape
sequence.
-Brighter colours are induced via the addition of a bold code."
+Brighter colours are induced via the addition of a bold code.
+When BACKGROUND is non-nil, the provided ANSI code sets the background color."
(format "\uE000[%sm"
(pcase (nth (engrave-faces-ansi-color-rbg-to-256 r g b)
engrave-faces-ansi--256-to-16-map)
@@ -121,7 +128,8 @@ Brighter colours are induced via the addition of a bold
code."
(_ (/ (- value 35) 40))))
(defun engrave-faces-ansi--color-8bit-code (r g b &optional background)
- "Convert the (R G B) colour code to a correspanding 8bit ansi escape
sequence."
+ "Convert the (R G B) colour code to a correspanding 8bit ansi escape
sequence.
+When BACKGROUND is non-nil, the provided ANSI code sets the background color."
(format (if background "\uE000[48;5;%dm" "\uE000[38;5;%dm")
(engrave-faces-ansi-color-rbg-to-256 r g b)))
@@ -150,21 +158,26 @@ Brighter colours are induced via the addition of a bold
code."
;;;;;; 24-bit / 16m-color
(defun engrave-faces-ansi-color-24bit-code (r g b &optional background)
+ "Convert the (R G B) colour code to a correspanding 24bit ansi escape
sequence.
+When BACKGROUND is non-nil, the provided ANSI code sets the background color."
(format (if background "\uE000[48;2;%d;%d;%dm" "\uE000[38;2;%d;%d;%dm") r g
b))
;;; Applying the transformation
(defun engrave-faces-ansi--face-apply (faces content)
- "TODO record faces, and use `engrave-faces-ansi-face-nesting' to diff
properties
-with parent form more intelligent use of escape codes, and renewing properties
which
-are collateral damage from \"[0m\"."
+ "Apply FACES to CONTENT."
+ ;; TODO record faces, and use `engrave-faces-ansi-face-nesting' to diff
+ ;; properties with parent form more intelligent use of escape codes, and
+ ;; renewing properties which are collateral damage from \"[0m\".
(let* ((face-str (engrave-faces-ansi-code (engrave-faces-merge-attributes
faces))))
(concat face-str content (if (string= face-str "") "" "\uE000[0m"))))
(defun engrave-faces-ansi--unescape-escape ()
- (goto-char (point-min))
- (while (re-search-forward "\uE000" nil t)
- (replace-match "\e")))
+ "Unescape all escaped sequences in the current buffer."
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "\uE000" nil t)
+ (replace-match "\e"))))
(declare-function ansi-color-apply-on-region "ansi-color"
(begin end &optional preserve-sequences))
diff --git a/engrave-faces-html.el b/engrave-faces-html.el
index 1771db9830..78c92161b3 100644
--- a/engrave-faces-html.el
+++ b/engrave-faces-html.el
@@ -27,7 +27,9 @@ 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-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)
@@ -51,8 +53,8 @@ See `engrave-faces-preset-styles' and
`engrave-faces-html-output-style'."
(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."
+(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))
@@ -71,7 +73,7 @@ See `engrave-faces-preset-styles' and
`engrave-faces-html-output-style'."
(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))))
- seperator)))
+ (or " " seperator))))
(defun engrave-faces-html--css-weight (weight)
"Give the numerical CSS font WEIGHT.
@@ -91,6 +93,7 @@ Values are taken from
https://docs.microsoft.com/en-us/typography/opentype/spec/
('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 "")
@@ -98,6 +101,7 @@ Values are taken from
https://docs.microsoft.com/en-us/typography/opentype/spec/
(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
diff --git a/engrave-faces-latex.el b/engrave-faces-latex.el
index bfff564f3d..8c91178e51 100644
--- a/engrave-faces-latex.el
+++ b/engrave-faces-latex.el
@@ -13,6 +13,8 @@
(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,
@@ -49,7 +51,8 @@ standalone document."
(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'."
+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)
@@ -87,7 +90,7 @@ See `engrave-faces-preset-styles' and
`engrave-faces-latex-output-style'."
" % " (symbol-name face))))
(defun engrave-faces-latex-face-apply (faces content)
- "Convert each (compatable) parameter of FACES to a LaTeX command apllied to
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))
@@ -107,6 +110,7 @@ See `engrave-faces-preset-styles' and
`engrave-faces-latex-output-style'."
("~" . "\\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)
@@ -117,6 +121,7 @@ See `engrave-faces-preset-styles' and
`engrave-faces-latex-output-style'."
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)))
@@ -152,11 +157,12 @@ See `engrave-faces-preset-styles' and
`engrave-faces-latex-output-style'."
(engrave-faces-latex-face-apply faces protected-content)))))
(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."
+ "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-preset-styles))))
+ (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)
"}"))))
diff --git a/engrave-faces.el b/engrave-faces.el
index 89231f24e7..5252089d2c 100644
--- a/engrave-faces.el
+++ b/engrave-faces.el
@@ -198,7 +198,10 @@ and is called after hooks.
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."
+transforming function to be created.
+
+When a VIEW-SETUP function is provided, it is called just after
+switching to the result buffer."
`(progn (add-to-list 'engrave-faces--backends
(list ,backend :face-transformer ,face-transformer
:extension ,extension))
(defun ,(intern (concat "engrave-faces-" backend "-buffer"))
(&optional theme switch-to-result)
@@ -232,7 +235,7 @@ transforming function to be created."
(defvar ,(intern (concat "engrave-faces-" backend "-after-hook"))
nil)))
(defun engrave-faces-file (in-file out-file backend &optional theme
postprocessor)
- "Using BACKEND, engrave IN-FILE and save it as FILE.EXTENSION.
+ "Using BACKEND, engrave IN-FILE and save it as OUT-FILE.
If a POSTPROCESSOR function is provided, it is called before saving."
(with-temp-buffer
(insert-file-contents in-file)
@@ -244,7 +247,8 @@ If a POSTPROCESSOR function is provided, it is called
before saving."
(kill-buffer)))))
(defun engrave-faces-buffer (backend &optional theme)
- "Export the current buffer with BACKEND and return the created buffer."
+ "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'."
(let ((engrave-faces-current-preset-style
(if theme
(engrave-faces-get-theme theme)
@@ -268,8 +272,8 @@ If a POSTPROCESSOR function is provided, it is called
before saving."
(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))
-
+ (face-transformer
+ (plist-get (cdr (assoc backend engrave-faces--backends))
:face-transformer))
(completed nil))
(unwind-protect
(let (next-change text)
@@ -311,7 +315,8 @@ If a POSTPROCESSOR function is provided, it is called
before saving."
(defun engrave-faces-merge-attributes (faces &optional attributes)
"Find the final ATTRIBUTES for text with FACES."
- (setq faces (engrave-faces-explicit-inheritance (if (listp faces) faces
(list faces))))
+ (setq faces (engrave-faces-explicit-inheritance
+ (if (listp faces) faces (list faces))))
(mapcan (lambda (attr)
(list attr (car (engrave-faces-attribute-values faces attr))))
(or attributes engrave-faces-attributes-of-interest)))
@@ -386,6 +391,7 @@ This function is lifted from htmlize."
pos))
(defun engrave-faces--overlay-faces-at (pos)
+ "Find all face overlay properties at POS."
(delq nil (mapcar (lambda (o) (overlay-get o 'face)) (overlays-at pos))))
;;; Style helpers
@@ -401,8 +407,10 @@ This function is lifted from htmlize."
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))))
+ ((pred symbolp)
+ (assoc faces engrave-faces-preset-styles))
+ ((and (pred listp) (app length 1))
+ (assoc (car faces) engrave-faces-preset-styles))))
(defun engrave-faces-generate-preset ()
"Generate a preset style based on the current Emacs theme."
@@ -415,11 +423,13 @@ Unconditionally returns nil when FACES is default."
(delq nil
(mapcar
(lambda (attr)
- (when-let ((attr-val (when (facep (car face-style))
- (face-attribute (car face-style)
attr nil t))))
- (when (or (engrave-faces--check-nondefault attr
attr-val)
- (and (eq (car face-style) 'default)
- (not (memq attr '(:height
:strike-through)))))
+ (let ((attr-val
+ (and (facep (car face-style))
+ (face-attribute (car face-style) attr nil
t))))
+ (when (and attr-val
+ (or (engrave-faces--check-nondefault attr
attr-val)
+ (and (eq (car face-style) 'default)
+ (not (memq attr '(:height
:strike-through))))))
(list attr
(if (and (memq attr '(:foreground :background))
(stringp attr-val)
@@ -455,7 +465,7 @@ The theme t is treated as shorthand for the current theme."
(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))))
+ (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.
@@ -465,7 +475,7 @@ current buffer at point."
(interactive (list (intern
(completing-read
"Theme: "
- (cl-remove-duplicates
+ (delete-dups
(append
(mapcar
(lambda (theme)
