Reduce the public API of engrave-faces
Private (--) symbols have not been used as much as they should have.
This commit is contained in:
TEC
parent
6b8261d9d4
commit
6b507611ee
GPG Key ID:
779591AFDB81F06C
|
|
@ -42,25 +42,25 @@ Possible values are:
|
|||
(when (eq t (plist-get attrs :underline)) "\uE000[4m")
|
||||
(when (and engrave-faces-ansi-use-face-colours
|
||||
(plist-get attrs :foreground))
|
||||
(engrave-faces-ansi-color-to-ansi
|
||||
(engrave-faces-ansi--color-to-ansi
|
||||
(plist-get attrs :foreground)))
|
||||
(when (and engrave-faces-ansi-use-face-colours
|
||||
(plist-get attrs :background))
|
||||
(engrave-faces-ansi-color-to-ansi
|
||||
(engrave-faces-ansi--color-to-ansi
|
||||
(plist-get attrs :background) t))))
|
||||
|
||||
;;;;; Color conversion
|
||||
|
||||
(defun engrave-faces-ansi-color-to-ansi (color &optional background)
|
||||
(defun engrave-faces-ansi--color-to-ansi (color &optional background)
|
||||
(if (eq color 'unspecified) nil
|
||||
(apply (pcase engrave-faces-ansi-color-mode
|
||||
((or '3-bit '8-color) #'engrave-faces-ansi-color-3bit-code)
|
||||
((or '4-bit '16-color) #'engrave-faces-ansi-color-4bit-code)
|
||||
((or '8-bit '256-color) #'engrave-faces-ansi-color-8bit-code)
|
||||
((or '8-bit '256-color) #'engrave-faces-ansi--color-8bit-code)
|
||||
((or '24-bit '16m-color) #'engrave-faces-ansi-color-24bit-code))
|
||||
(append (mapcar (lambda (c) (/ c 257)) (color-values color)) (list background)))))
|
||||
|
||||
(defun engrave-faces-ansi-color-dist-squared (reference rgb)
|
||||
(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)."
|
||||
(+ (* (nth 0 reference)
|
||||
(nth 0 rgb))
|
||||
|
|
@ -71,7 +71,7 @@ Possible values are:
|
|||
|
||||
;;;;;; 4-bit / 16-color
|
||||
|
||||
(defvar engrave-faces-ansi-256-to-16-map
|
||||
(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
|
||||
|
|
@ -93,7 +93,7 @@ Possible values are:
|
|||
"Convert the (R G B) colour code to a correspanding 4bit ansi escape sequence."
|
||||
(format "\uE000[%sm"
|
||||
(pcase (nth (engrave-faces-ansi-color-rbg-to-256 r g b)
|
||||
engrave-faces-ansi-256-to-16-map)
|
||||
engrave-faces-ansi--256-to-16-map)
|
||||
((and (pred (> 8)) n)
|
||||
(+ 30 (if background 10 0) n))
|
||||
(n (+ 82 (if background 10 0) n)))))
|
||||
|
|
@ -105,43 +105,43 @@ Possible values are:
|
|||
Brighter colours are induced via the addition of a bold code."
|
||||
(format "\uE000[%sm"
|
||||
(pcase (nth (engrave-faces-ansi-color-rbg-to-256 r g b)
|
||||
engrave-faces-ansi-256-to-16-map)
|
||||
engrave-faces-ansi--256-to-16-map)
|
||||
((and (pred (> 8)) n)
|
||||
(+ 30 (if background 10 0) n))
|
||||
(n (format "1;%d" (+ 22 (if background 10 0) n))))))
|
||||
|
||||
;;;;;; 8-bit / 256-color
|
||||
|
||||
(defvar engrave-faces-ansi-color-6cube-values '(0 95 135 175 215 255))
|
||||
(defun engrave-faces-ansi-color-to-6cube (value)
|
||||
(defvar engrave-faces-ansi--color-6cube-values '(0 95 135 175 215 255))
|
||||
(defun engrave-faces-ansi--color-to-6cube (value)
|
||||
"Map VALUE to the associated 6x6 colour cube value."
|
||||
(pcase value
|
||||
((pred (> 48)) 0)
|
||||
((pred (> 114)) 1)
|
||||
(_ (/ (- value 35) 40))))
|
||||
|
||||
(defun engrave-faces-ansi-color-8bit-code (r g b &optional background)
|
||||
(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."
|
||||
(format (if background "\uE000[48;5;%dm" "\uE000[38;5;%dm")
|
||||
(engrave-faces-ansi-color-rbg-to-256 r g b)))
|
||||
|
||||
(defun engrave-faces-ansi-color-rbg-to-256 (r g b)
|
||||
"Convert the (R G B) colour code to the nearest 256-colour."
|
||||
(let ((6cube-r (engrave-faces-ansi-color-to-6cube r))
|
||||
(6cube-g (engrave-faces-ansi-color-to-6cube g))
|
||||
(6cube-b (engrave-faces-ansi-color-to-6cube b)))
|
||||
(let ((nearest-r (nth 6cube-r engrave-faces-ansi-color-6cube-values))
|
||||
(nearest-g (nth 6cube-g engrave-faces-ansi-color-6cube-values))
|
||||
(nearest-b (nth 6cube-b engrave-faces-ansi-color-6cube-values)))
|
||||
(let ((6cube-r (engrave-faces-ansi--color-to-6cube r))
|
||||
(6cube-g (engrave-faces-ansi--color-to-6cube g))
|
||||
(6cube-b (engrave-faces-ansi--color-to-6cube b)))
|
||||
(let ((nearest-r (nth 6cube-r engrave-faces-ansi--color-6cube-values))
|
||||
(nearest-g (nth 6cube-g engrave-faces-ansi--color-6cube-values))
|
||||
(nearest-b (nth 6cube-b engrave-faces-ansi--color-6cube-values)))
|
||||
(if (and (= nearest-r r) (= nearest-g g) (= nearest-b b))
|
||||
(+ 16 (* 36 6cube-r) (* 6 6cube-g) 6cube-b)
|
||||
(let* ((grey-avg (/ (+ r g b) 3))
|
||||
(grey-index (if (> grey-avg 238) 23
|
||||
(/ (- grey-avg 3) 10)))
|
||||
(grey (+ 8 (* 10 grey-index))))
|
||||
(if (> (engrave-faces-ansi-color-dist-squared (list grey grey grey)
|
||||
(if (> (engrave-faces-ansi--color-dist-squared (list grey grey grey)
|
||||
(list r g b))
|
||||
(engrave-faces-ansi-color-dist-squared (list nearest-r nearest-g nearest-b)
|
||||
(engrave-faces-ansi--color-dist-squared (list nearest-r nearest-g nearest-b)
|
||||
(list r g b)))
|
||||
(+ 232 grey-index)
|
||||
(+ 16 (* 36 6cube-r) (* 6 6cube-g) 6cube-b)))))))
|
||||
|
|
@ -154,14 +154,14 @@ Brighter colours are induced via the addition of a bold code."
|
|||
|
||||
;;; Applying the transformation
|
||||
|
||||
(defun engrave-faces-ansi-face-apply (faces content)
|
||||
(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\"."
|
||||
(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-unescape-escape ()
|
||||
(defun engrave-faces-ansi--unescape-escape ()
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\uE000" nil t)
|
||||
(replace-match "\e")))
|
||||
|
|
@ -171,6 +171,9 @@ are collateral damage from \"[0m\"."
|
|||
|
||||
;;;###autoload (autoload #'engrave-faces-ansi-buffer "engrave-faces-ansi" nil t)
|
||||
;;;###autoload (autoload #'engrave-faces-ansi-file "engrave-faces-ansi" nil t)
|
||||
(engrave-faces-define-backend "ansi" ".txt" #'engrave-faces-ansi-face-apply nil
|
||||
(engrave-faces-define-backend "ansi" ".txt" #'engrave-faces-ansi--face-apply nil
|
||||
(lambda () (ansi-color-apply-on-region (point-min) (point-max) t)))
|
||||
(add-hook 'engrave-faces-ansi-after-hook #'engrave-faces-unescape-escape)
|
||||
(add-hook 'engrave-faces-ansi-after-hook #'engrave-faces-ansi--unescape-escape)
|
||||
|
||||
(provide 'engrave-faces-ansi)
|
||||
;;; engrave-faces-ansi.el ends here
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@ See `engrave-faces-preset-styles' and `engrave-faces-html-output-style'."
|
|||
(let ((stylesheet
|
||||
(mapconcat
|
||||
(lambda (face-style)
|
||||
(engrave-faces-html-gen-stylesheet-entry (car face-style) (cdr face-style)))
|
||||
(engrave-faces-html--gen-stylesheet-entry (car face-style) (cdr face-style)))
|
||||
engrave-faces-preset-styles
|
||||
"\n")))
|
||||
(if indent
|
||||
|
|
@ -41,15 +41,15 @@ See `engrave-faces-preset-styles' and `engrave-faces-html-output-style'."
|
|||
"\n")
|
||||
stylesheet)))
|
||||
|
||||
(defun engrave-faces-html-gen-stylesheet-entry (face style)
|
||||
(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 ")
|
||||
(engrave-faces-html--gen-style-css style "\n ")
|
||||
" }"))
|
||||
|
||||
(defun engrave-faces-html-gen-style-css (attrs seperator)
|
||||
(defun engrave-faces-html--gen-style-css (attrs seperator)
|
||||
"Compose the relevant CSS styles to apply compatible ATTRS, seperated by SEPERATOR."
|
||||
(let ((fg (plist-get attrs :foreground))
|
||||
(bg (plist-get attrs :background))
|
||||
|
|
@ -67,11 +67,11 @@ See `engrave-faces-preset-styles' and `engrave-faces-html-output-style'."
|
|||
(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 wt (format "font-weight: %s;" (engrave-faces-html--css-weight wt)))
|
||||
(when (and ht (floatp ht)) (format "font-size: %sem" ht))))
|
||||
seperator)))
|
||||
|
||||
(defun engrave-faces-html-css-weight (weight)
|
||||
(defun engrave-faces-html--css-weight (weight)
|
||||
(pcase weight
|
||||
('ultra-light 100) ('extra-light 100)
|
||||
('light 200) ('thin 200)
|
||||
|
|
@ -84,14 +84,14 @@ See `engrave-faces-preset-styles' and `engrave-faces-html-output-style'."
|
|||
('heavy 900) ('ultra-bold 900)
|
||||
('black 950)))
|
||||
|
||||
(defun engrave-faces-html-face-apply (faces content)
|
||||
(defun engrave-faces-html--face-apply (faces content)
|
||||
(let* ((attrs (engrave-faces-merge-attributes faces))
|
||||
(style (engrave-faces-html-gen-style-css attrs " ")))
|
||||
(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)
|
||||
(defun engrave-faces-html--protect-string (str)
|
||||
(replace-regexp-in-string
|
||||
"<" "<"
|
||||
(replace-regexp-in-string
|
||||
|
|
@ -100,9 +100,9 @@ See `engrave-faces-preset-styles' and `engrave-faces-html-output-style'."
|
|||
"&" "&"
|
||||
str))))
|
||||
|
||||
(defun engrave-faces-html-face-mapper (faces content)
|
||||
(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))
|
||||
(let ((protected-content (engrave-faces-html--protect-string content))
|
||||
(style (engrave-faces-preset-style faces)))
|
||||
(if (string-match-p "\\`[\n[:space:]]+\\'" content)
|
||||
protected-content
|
||||
|
|
@ -110,9 +110,9 @@ See `engrave-faces-preset-styles' and `engrave-faces-html-output-style'."
|
|||
(concat "<span class=\"" engrave-faces-html-class-prefix
|
||||
(plist-get (cdr style) :slug) "\">"
|
||||
protected-content "</span>")
|
||||
(engrave-faces-html-face-apply faces protected-content)))))
|
||||
(engrave-faces-html--face-apply faces protected-content)))))
|
||||
|
||||
(defun engrave-faces-html-make-standalone ()
|
||||
(defun engrave-faces-html--make-standalone ()
|
||||
"Export current buffer to a standalone HTML buffer."
|
||||
(goto-char (point-min))
|
||||
(insert "<!DOCTYPE html>
|
||||
|
|
@ -120,7 +120,7 @@ See `engrave-faces-preset-styles' and `engrave-faces-html-output-style'."
|
|||
<head>
|
||||
<meta charset=\"utf-8\">
|
||||
<title>"
|
||||
(engrave-faces-html-protect-string (if (buffer-file-name)
|
||||
(engrave-faces-html--protect-string (if (buffer-file-name)
|
||||
(file-name-nondirectory (buffer-file-name))
|
||||
(buffer-name)))
|
||||
"</title>
|
||||
|
|
@ -156,7 +156,7 @@ See `engrave-faces-preset-styles' and `engrave-faces-html-output-style'."
|
|||
;;;###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)
|
||||
(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
|
||||
|
|
|
|||
|
|
@ -147,13 +147,13 @@ If a POSTPROCESSOR function is provided, it is called before saving."
|
|||
;; This loop traverses and reads the source buffer, appending the
|
||||
;; resulting text to the export buffer. This method is fast because:
|
||||
;; 1) it doesn't require examining the text properties char by char
|
||||
;; (engrave-faces-next-face-change is used to move between runs with
|
||||
;; (engrave-faces--next-face-change is used to move between runs with
|
||||
;; the same face), and 2) it doesn't require frequent buffer
|
||||
;; switches, which are slow because they rebind all buffer-local
|
||||
;; vars.
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(setq next-change (engrave-faces-next-face-change (point)))
|
||||
(setq next-change (engrave-faces--next-face-change (point)))
|
||||
(setq text (buffer-substring-no-properties (point) next-change))
|
||||
;; Don't bother writing anything if there's no text (this
|
||||
;; happens in invisible regions).
|
||||
|
|
@ -212,7 +212,7 @@ To consider inheritence, use `engrave-faces-explicit-inheritance' first."
|
|||
((listp face) (plist-get face attribute)))))
|
||||
(delq 'default (if (listp faces) faces (list faces)))))))
|
||||
|
||||
(defun engrave-faces-next-face-change (pos &optional limit)
|
||||
(defun engrave-faces--next-face-change (pos &optional limit)
|
||||
"Find the next face change from POS up to LIMIT.
|
||||
|
||||
This function is lifted from htmlize."
|
||||
|
|
@ -223,11 +223,11 @@ This function is lifted from htmlize."
|
|||
(or limit
|
||||
(setq limit (point-max)))
|
||||
(let ((next-prop (next-single-property-change pos 'face nil limit))
|
||||
(overlay-faces (engrave-faces-overlay-faces-at pos)))
|
||||
(overlay-faces (engrave-faces--overlay-faces-at pos)))
|
||||
(while (progn
|
||||
(setq pos (next-overlay-change pos))
|
||||
(and (< pos next-prop)
|
||||
(equal overlay-faces (engrave-faces-overlay-faces-at pos)))))
|
||||
(equal overlay-faces (engrave-faces--overlay-faces-at pos)))))
|
||||
(setq pos (min pos next-prop))
|
||||
;; Additionally, we include the entire region that specifies the
|
||||
;; `display' property.
|
||||
|
|
@ -235,7 +235,7 @@ This function is lifted from htmlize."
|
|||
(setq pos (next-single-char-property-change pos 'display nil limit)))
|
||||
pos))
|
||||
|
||||
(defun engrave-faces-overlay-faces-at (pos)
|
||||
(defun engrave-faces--overlay-faces-at (pos)
|
||||
(delq nil (mapcar (lambda (o) (overlay-get o 'face)) (overlays-at pos))))
|
||||
|
||||
;;; Style helpers
|
||||
|
|
@ -282,7 +282,7 @@ faces will need to be explicitly styled each time they're used."
|
|||
:type '(repeat (repeat (choice symbol string)))
|
||||
:group 'engrave-faces)
|
||||
|
||||
(defun engrave-faces-check-nondefault (attr value)
|
||||
(defun engrave-faces--check-nondefault (attr value)
|
||||
"Return VALUE as long as it is specified, and not the default for ATTR."
|
||||
(unless (or (eq value (face-attribute 'default attr nil t))
|
||||
(eq value 'unspecified))
|
||||
|
|
@ -308,7 +308,7 @@ Unconditionally returns nil when FACES is default."
|
|||
(mapcar
|
||||
(lambda (attr)
|
||||
(let ((attr-val (face-attribute (car face-style) attr nil t)))
|
||||
(when (or (engrave-faces-check-nondefault attr attr-val)
|
||||
(when (or (engrave-faces--check-nondefault attr attr-val)
|
||||
(eq (car face-style) 'default))
|
||||
(list attr attr-val))))
|
||||
engrave-faces-attributes-of-interest))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue