-
-
Notifications
You must be signed in to change notification settings - Fork 5
/
engrave-faces-ansi.el
192 lines (161 loc) · 8.04 KB
/
engrave-faces-ansi.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
;;; engrave-faces-ansi.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)
(defcustom engrave-faces-ansi-color-mode '8-bit
"The ansi escape mode set to use.
This accepts both n-bit and m-color forms.
Possible values are:
- `3-bit' (`8-color')
- `4-bit' (`16-color')
- `8-bit' (`256-color')
- `24-bit' (`16m-color')"
:type '(choice
(const 3-bit)
(const 4-bit)
(const 8-bit)
(const 24-bit))
:group 'engrave-faces)
(defcustom engrave-faces-ansi-use-face-colours t
"Whether to apply face colours."
:group 'engrave-faces
:type 'boolean)
(defvar engrave-faces-ansi-face-nesting nil)
(defun engrave-faces-ansi-code (attrs)
"Genrerate ANSI commands which apply ATTRS to the succeeding text."
(concat
(when (member (plist-get attrs :weight) '(bold extra-bold)) "\uE000[1m")
(when (eq 'italic (plist-get attrs :slant)) "\uE000[3m")
(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
(plist-get attrs :foreground)))
(when (and engrave-faces-ansi-use-face-colours
(plist-get attrs :background))
(engrave-faces-ansi--color-to-ansi
(plist-get attrs :background) t))))
;;;;; 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)
((or '4-bit '16-color) #'engrave-faces-ansi-color-4bit-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)
"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)
(nth 1 rgb))
(* (nth 2 reference)
(nth 2 rgb))))
;;;;;; 4-bit / 16-color
(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)
"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.
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)
((and (pred (> 8)) n)
(+ 30 (if background 10 0) n))
(n (+ 82 (if background 10 0) n)))))
;;;;;; 3-bit / 8-color
(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.
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)
((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)
"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)
"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)))
(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)))
(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)
(list r g 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)))))))
;;;;;; 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)
"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 ()
"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))
;;;###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
(lambda () (ansi-color-apply-on-region (point-min) (point-max) t)))
(add-hook 'engrave-faces-ansi-after-hook #'engrave-faces-ansi--unescape-escape)
(provide 'engrave-faces-ansi)
;;; engrave-faces-ansi.el ends here