Style, checkdoc, and byte-compile improvements
This commit is contained in:
parent
e541cf4366
commit
51a2f8d18e
SSH Key Fingerprint:
SHA256:eobz41Mnm0/iYWBvWThftS0ElEs1ftBr6jamutnXc/A
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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) "}"))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue