Commit | Line | Data |
---|---|---|
0e3c1e3e | 1 | ;;; ansi-color.el --- translate ANSI escape sequences into faces |
618206ea | 2 | |
acaf905b | 3 | ;; Copyright (C) 1999-2012 Free Software Foundation, Inc. |
618206ea | 4 | |
8737bb5a GM |
5 | ;; Author: Alex Schroeder <alex@gnu.org> |
6 | ;; Maintainer: Alex Schroeder <alex@gnu.org> | |
b3287acf GM |
7 | ;; Version: 3.4.2 |
8 | ;; Keywords: comm processes terminals services | |
618206ea RS |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
eb3fa2cf GM |
12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation, either version 3 of the License, or | |
15 | ;; (at your option) any later version. | |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
618206ea | 22 | ;; You should have received a copy of the GNU General Public License |
eb3fa2cf | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
618206ea RS |
24 | |
25 | ;;; Commentary: | |
26 | ||
0e3c1e3e GM |
27 | ;; This file provides a function that takes a string or a region |
28 | ;; containing Select Graphic Rendition (SGR) control sequences (formerly | |
29 | ;; known as ANSI escape sequences) and tries to translate these into | |
30 | ;; faces. | |
618206ea | 31 | ;; |
89601c7b CY |
32 | ;; This allows you to run ls --color=yes in shell-mode. It is now |
33 | ;; enabled by default; to disable it, set ansi-color-for-comint-mode | |
34 | ;; to nil. | |
0e3c1e3e GM |
35 | ;; |
36 | ;; Note that starting your shell from within Emacs might set the TERM | |
37 | ;; environment variable. The new setting might disable the output of | |
38 | ;; SGR control sequences. Using ls --color=yes forces ls to produce | |
39 | ;; these. | |
40 | ;; | |
986b7dee GM |
41 | ;; SGR control sequences are defined in section 3.8.117 of the ECMA-48 |
42 | ;; standard (identical to ISO/IEC 6429), which is freely available as a | |
43 | ;; PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>. The | |
44 | ;; "Graphic Rendition Combination Mode (GRCM)" implemented is | |
45 | ;; "cumulative mode" as defined in section 7.2.8. Cumulative mode means | |
46 | ;; that whenever possible, SGR control sequences are combined (ie. blue | |
47 | ;; and bold). | |
618206ea | 48 | |
986b7dee GM |
49 | ;; The basic functions are: |
50 | ;; | |
51 | ;; `ansi-color-apply' to colorize a string containing SGR control | |
52 | ;; sequences. | |
53 | ;; | |
54 | ;; `ansi-color-filter-apply' to filter SGR control sequences from a | |
55 | ;; string. | |
618206ea | 56 | ;; |
986b7dee GM |
57 | ;; `ansi-color-apply-on-region' to colorize a region containing SGR |
58 | ;; control sequences. | |
59 | ;; | |
60 | ;; `ansi-color-filter-region' to filter SGR control sequences from a | |
61 | ;; region. | |
62 | ||
986b7dee | 63 | ;;; Thanks |
618206ea | 64 | |
986b7dee GM |
65 | ;; Georges Brun-Cottan <gbruncot@emc.com> for improving ansi-color.el |
66 | ;; substantially by adding the code needed to cope with arbitrary chunks | |
67 | ;; of output and the filter functions. | |
618206ea | 68 | ;; |
986b7dee | 69 | ;; Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk> for pointing me to ECMA-48. |
0e3c1e3e | 70 | ;; |
4c36be58 | 71 | ;; Stefan Monnier <foo@acm.com> for explaining obscure font-lock stuff and for |
0e3c1e3e | 72 | ;; code suggestions. |
618206ea RS |
73 | |
74 | \f | |
75 | ||
76 | ;;; Code: | |
77 | ||
cd91462f JB |
78 | (defvar comint-last-output-start) |
79 | ||
8737bb5a GM |
80 | ;; Customization |
81 | ||
986b7dee | 82 | (defgroup ansi-colors nil |
0e3c1e3e | 83 | "Translating SGR control sequences to faces. |
986b7dee GM |
84 | This translation effectively colorizes strings and regions based upon |
85 | SGR control sequences embedded in the text. SGR (Select Graphic | |
2f29c200 | 86 | Rendition) control sequences are defined in section 8.3.117 of the |
986b7dee GM |
87 | ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available |
88 | as a PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>." | |
7c6c3d8e | 89 | :version "21.1" |
986b7dee GM |
90 | :group 'processes) |
91 | ||
92 | (defcustom ansi-color-faces-vector | |
37269466 | 93 | [default bold default italic underline success warning error] |
986b7dee GM |
94 | "Faces used for SGR control sequences determining a face. |
95 | This vector holds the faces used for SGR control sequence parameters 0 | |
96 | to 7. | |
618206ea | 97 | |
986b7dee GM |
98 | Parameter Description Face used by default |
99 | 0 default default | |
100 | 1 bold bold | |
101 | 2 faint default | |
102 | 3 italic italic | |
103 | 4 underlined underline | |
37269466 CY |
104 | 5 slowly blinking success |
105 | 6 rapidly blinking warning | |
106 | 7 negative image error | |
618206ea | 107 | |
0e3c1e3e GM |
108 | Note that the symbol `default' is special: It will not be combined |
109 | with the current face. | |
110 | ||
986b7dee GM |
111 | This vector is used by `ansi-color-make-color-map' to create a color |
112 | map. This color map is stored in the variable `ansi-color-map'." | |
113 | :type '(vector face face face face face face face face) | |
114 | :set 'ansi-color-map-update | |
115 | :initialize 'custom-initialize-default | |
116 | :group 'ansi-colors) | |
117 | ||
118 | (defcustom ansi-color-names-vector | |
618206ea | 119 | ["black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"] |
986b7dee GM |
120 | "Colors used for SGR control sequences determining a color. |
121 | This vector holds the colors used for SGR control sequences parameters | |
122 | 30 to 37 \(foreground colors) and 40 to 47 (background colors). | |
123 | ||
124 | Parameter Color | |
125 | 30 40 black | |
126 | 31 41 red | |
127 | 32 42 green | |
128 | 33 43 yellow | |
129 | 34 44 blue | |
130 | 35 45 magenta | |
131 | 36 46 cyan | |
132 | 37 47 white | |
133 | ||
134 | This vector is used by `ansi-color-make-color-map' to create a color | |
7a097943 LL |
135 | map. This color map is stored in the variable `ansi-color-map'. |
136 | ||
137 | Each element may also be a cons cell where the car and cdr specify the | |
138 | foreground and background colors, respectively." | |
139 | :type '(vector (choice color (cons color color)) | |
140 | (choice color (cons color color)) | |
141 | (choice color (cons color color)) | |
142 | (choice color (cons color color)) | |
143 | (choice color (cons color color)) | |
144 | (choice color (cons color color)) | |
145 | (choice color (cons color color)) | |
146 | (choice color (cons color color))) | |
986b7dee GM |
147 | :set 'ansi-color-map-update |
148 | :initialize 'custom-initialize-default | |
149 | :group 'ansi-colors) | |
150 | ||
c21d4d1a | 151 | (defconst ansi-color-regexp "\033\\[\\([0-9;]*m\\)" |
986b7dee GM |
152 | "Regexp that matches SGR control sequences.") |
153 | ||
bc8d33d5 CY |
154 | (defconst ansi-color-drop-regexp |
155 | "\033\\[\\([ABCDsuK]\\|2J\\|=[0-9]+[hI]\\|[0-9;]*[Hf]\\)" | |
156 | "Regexp that matches ANSI control sequences to silently drop.") | |
157 | ||
986b7dee GM |
158 | (defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]" |
159 | "Regexp that matches SGR control sequence parameters.") | |
160 | ||
161 | ||
0e3c1e3e | 162 | ;; Convenience functions for comint modes (eg. shell-mode) |
986b7dee GM |
163 | |
164 | ||
925f8c70 | 165 | (defcustom ansi-color-for-comint-mode t |
0e3c1e3e GM |
166 | "Determines what to do with comint output. |
167 | If nil, do nothing. | |
168 | If the symbol `filter', then filter all SGR control sequences. | |
169 | If anything else (such as t), then translate SGR control sequences | |
bc8d33d5 | 170 | into text properties. |
986b7dee | 171 | |
0e3c1e3e GM |
172 | In order for this to have any effect, `ansi-color-process-output' must |
173 | be in `comint-output-filter-functions'. | |
986b7dee | 174 | |
0e3c1e3e GM |
175 | This can be used to enable colorized ls --color=yes output |
176 | in shell buffers. You set this variable by calling one of: | |
177 | \\[ansi-color-for-comint-mode-on] | |
178 | \\[ansi-color-for-comint-mode-off] | |
179 | \\[ansi-color-for-comint-mode-filter]" | |
0e3c1e3e GM |
180 | :type '(choice (const :tag "Do nothing" nil) |
181 | (const :tag "Filter" filter) | |
182 | (const :tag "Translate" t)) | |
c2dae51b CY |
183 | :group 'ansi-colors |
184 | :version "23.2") | |
986b7dee | 185 | |
0fd40f89 CY |
186 | (defvar ansi-color-apply-face-function 'ansi-color-apply-overlay-face |
187 | "Function for applying an Ansi Color face to text in a buffer. | |
188 | This function should accept three arguments: BEG, END, and FACE, | |
189 | and it should apply face FACE to the text between BEG and END.") | |
190 | ||
58622cc5 | 191 | ;;;###autoload |
0e3c1e3e GM |
192 | (defun ansi-color-for-comint-mode-on () |
193 | "Set `ansi-color-for-comint-mode' to t." | |
194 | (interactive) | |
195 | (setq ansi-color-for-comint-mode t)) | |
196 | ||
197 | (defun ansi-color-for-comint-mode-off () | |
198 | "Set `ansi-color-for-comint-mode' to nil." | |
199 | (interactive) | |
200 | (setq ansi-color-for-comint-mode nil)) | |
201 | ||
202 | (defun ansi-color-for-comint-mode-filter () | |
203 | "Set `ansi-color-for-comint-mode' to symbol `filter'." | |
204 | (interactive) | |
205 | (setq ansi-color-for-comint-mode 'filter)) | |
206 | ||
58622cc5 | 207 | ;;;###autoload |
1b25a579 | 208 | (defun ansi-color-process-output (ignored) |
bc8d33d5 | 209 | "Maybe translate SGR control sequences of comint output into text properties. |
0e3c1e3e GM |
210 | |
211 | Depending on variable `ansi-color-for-comint-mode' the comint output is | |
212 | either not processed, SGR control sequences are filtered using | |
213 | `ansi-color-filter-region', or SGR control sequences are translated into | |
bc8d33d5 | 214 | text properties using `ansi-color-apply-on-region'. |
0e3c1e3e GM |
215 | |
216 | The comint output is assumed to lie between the marker | |
217 | `comint-last-output-start' and the process-mark. | |
218 | ||
219 | This is a good function to put in `comint-output-filter-functions'." | |
18f00515 CY |
220 | (let ((start-marker (if (and (markerp comint-last-output-start) |
221 | (eq (marker-buffer comint-last-output-start) | |
222 | (current-buffer)) | |
223 | (marker-position comint-last-output-start)) | |
224 | comint-last-output-start | |
225 | (point-min-marker))) | |
0e3c1e3e GM |
226 | (end-marker (process-mark (get-buffer-process (current-buffer))))) |
227 | (cond ((eq ansi-color-for-comint-mode nil)) | |
228 | ((eq ansi-color-for-comint-mode 'filter) | |
229 | (ansi-color-filter-region start-marker end-marker)) | |
230 | (t | |
231 | (ansi-color-apply-on-region start-marker end-marker))))) | |
232 | ||
59f7af81 CY |
233 | (define-obsolete-function-alias 'ansi-color-unfontify-region |
234 | 'font-lock-default-unfontify-region "24.1") | |
0e3c1e3e GM |
235 | |
236 | ;; Working with strings | |
0e3c1e3e GM |
237 | (defvar ansi-color-context nil |
238 | "Context saved between two calls to `ansi-color-apply'. | |
2f29c200 WJ |
239 | This is a list of the form (CODES FRAGMENT) or nil. CODES |
240 | represents the state the last call to `ansi-color-apply' ended | |
241 | with, currently a list of ansi codes, and FRAGMENT is a string | |
242 | starting with an escape sequence, possibly the start of a new | |
0e3c1e3e GM |
243 | escape sequence.") |
244 | (make-variable-buffer-local 'ansi-color-context) | |
245 | ||
246 | (defun ansi-color-filter-apply (string) | |
bc8d33d5 | 247 | "Filter out all ANSI control sequences from STRING. |
0e3c1e3e GM |
248 | |
249 | Every call to this function will set and use the buffer-local variable | |
250 | `ansi-color-context' to save partial escape sequences. This information | |
251 | will be used for the next call to `ansi-color-apply'. Set | |
252 | `ansi-color-context' to nil if you don't want this. | |
618206ea | 253 | |
0e3c1e3e GM |
254 | This function can be added to `comint-preoutput-filter-functions'." |
255 | (let ((start 0) end result) | |
256 | ;; if context was saved and is a string, prepend it | |
257 | (if (cadr ansi-color-context) | |
258 | (setq string (concat (cadr ansi-color-context) string) | |
259 | ansi-color-context nil)) | |
260 | ;; find the next escape sequence | |
261 | (while (setq end (string-match ansi-color-regexp string start)) | |
262 | (setq result (concat result (substring string start end)) | |
263 | start (match-end 0))) | |
264 | ;; save context, add the remainder of the string to the result | |
265 | (let (fragment) | |
266 | (if (string-match "\033" string start) | |
267 | (let ((pos (match-beginning 0))) | |
268 | (setq fragment (substring string pos) | |
269 | result (concat result (substring string start pos)))) | |
270 | (setq result (concat result (substring string start)))) | |
ce327e48 | 271 | (setq ansi-color-context (if fragment (list nil fragment)))) |
0e3c1e3e | 272 | result)) |
8737bb5a | 273 | |
2f29c200 WJ |
274 | (defun ansi-color--find-face (codes) |
275 | "Return the face corresponding to CODES." | |
276 | (let (faces) | |
277 | (while codes | |
278 | (let ((face (ansi-color-get-face-1 (pop codes)))) | |
279 | ;; In the (default underline) face, say, the value of the | |
280 | ;; "underline" attribute of the `default' face wins. | |
281 | (unless (eq face 'default) | |
282 | (push face faces)))) | |
283 | ;; Avoid some long-lived conses in the common case. | |
284 | (if (cdr faces) | |
285 | (nreverse faces) | |
286 | (car faces)))) | |
287 | ||
8737bb5a | 288 | (defun ansi-color-apply (string) |
bc8d33d5 CY |
289 | "Translates SGR control sequences into text properties. |
290 | Delete all other control sequences without processing them. | |
8737bb5a | 291 | |
986b7dee | 292 | Applies SGR control sequences setting foreground and background colors |
bc8d33d5 | 293 | to STRING using text properties and returns the result. The colors used |
0e3c1e3e GM |
294 | are given in `ansi-color-faces-vector' and `ansi-color-names-vector'. |
295 | See function `ansi-color-apply-sequence' for details. | |
296 | ||
297 | Every call to this function will set and use the buffer-local variable | |
2f29c200 | 298 | `ansi-color-context' to save partial escape sequences and current ansi codes. |
0e3c1e3e GM |
299 | This information will be used for the next call to `ansi-color-apply'. |
300 | Set `ansi-color-context' to nil if you don't want this. | |
301 | ||
ce327e48 | 302 | This function can be added to `comint-preoutput-filter-functions'." |
2f29c200 | 303 | (let ((codes (car ansi-color-context)) |
bc8d33d5 CY |
304 | (start 0) end escape-sequence result |
305 | colorized-substring) | |
306 | ;; If context was saved and is a string, prepend it. | |
0e3c1e3e GM |
307 | (if (cadr ansi-color-context) |
308 | (setq string (concat (cadr ansi-color-context) string) | |
309 | ansi-color-context nil)) | |
bc8d33d5 | 310 | ;; Find the next escape sequence. |
986b7dee | 311 | (while (setq end (string-match ansi-color-regexp string start)) |
0e3c1e3e | 312 | (setq escape-sequence (match-string 1 string)) |
bc8d33d5 | 313 | ;; Colorize the old block from start to end using old face. |
2f29c200 WJ |
314 | (when codes |
315 | (put-text-property start end 'font-lock-face (ansi-color--find-face codes) string)) | |
bc8d33d5 | 316 | (setq colorized-substring (substring string start end) |
986b7dee | 317 | start (match-end 0)) |
bc8d33d5 CY |
318 | ;; Eliminate unrecognized ANSI sequences. |
319 | (while (string-match ansi-color-drop-regexp colorized-substring) | |
320 | (setq colorized-substring | |
321 | (replace-match "" nil nil colorized-substring))) | |
322 | (push colorized-substring result) | |
323 | ;; Create new face, by applying escape sequence parameters. | |
2f29c200 | 324 | (setq codes (ansi-color-apply-sequence escape-sequence codes))) |
0e3c1e3e | 325 | ;; if the rest of the string should have a face, put it there |
2f29c200 WJ |
326 | (when codes |
327 | (put-text-property start (length string) 'font-lock-face (ansi-color--find-face codes) string)) | |
0e3c1e3e GM |
328 | ;; save context, add the remainder of the string to the result |
329 | (let (fragment) | |
330 | (if (string-match "\033" string start) | |
331 | (let ((pos (match-beginning 0))) | |
bc8d33d5 CY |
332 | (setq fragment (substring string pos)) |
333 | (push (substring string start pos) result)) | |
334 | (push (substring string start) result)) | |
2f29c200 | 335 | (setq ansi-color-context (if (or codes fragment) (list codes fragment)))) |
bc8d33d5 | 336 | (apply 'concat (nreverse result)))) |
0e3c1e3e GM |
337 | |
338 | ;; Working with regions | |
339 | ||
340 | (defvar ansi-color-context-region nil | |
341 | "Context saved between two calls to `ansi-color-apply-on-region'. | |
2f29c200 WJ |
342 | This is a list of the form (CODES MARKER) or nil. CODES |
343 | represents the state the last call to `ansi-color-apply-on-region' | |
344 | ended with, currently a list of ansi codes, and MARKER is a | |
345 | buffer position within an escape sequence or the last position | |
346 | processed.") | |
0e3c1e3e | 347 | (make-variable-buffer-local 'ansi-color-context-region) |
8737bb5a | 348 | |
0e3c1e3e | 349 | (defun ansi-color-filter-region (begin end) |
bc8d33d5 | 350 | "Filter out all ANSI control sequences from region BEGIN to END. |
0e3c1e3e GM |
351 | |
352 | Every call to this function will set and use the buffer-local variable | |
353 | `ansi-color-context-region' to save position. This information will be | |
354 | used for the next call to `ansi-color-apply-on-region'. Specifically, | |
355 | it will override BEGIN, the start of the region. Set | |
356 | `ansi-color-context-region' to nil if you don't want this." | |
357 | (let ((end-marker (copy-marker end)) | |
358 | (start (or (cadr ansi-color-context-region) begin))) | |
359 | (save-excursion | |
360 | (goto-char start) | |
bc8d33d5 CY |
361 | ;; Delete unrecognized escape sequences. |
362 | (while (re-search-forward ansi-color-drop-regexp end-marker t) | |
363 | (replace-match "")) | |
364 | (goto-char start) | |
365 | ;; Delete SGR escape sequences. | |
0e3c1e3e | 366 | (while (re-search-forward ansi-color-regexp end-marker t) |
0e3c1e3e | 367 | (replace-match "")) |
bc8d33d5 CY |
368 | ;; save context, add the remainder of the string to the result |
369 | (if (re-search-forward "\033" end-marker t) | |
370 | (setq ansi-color-context-region (list nil (match-beginning 0))) | |
371 | (setq ansi-color-context-region nil))))) | |
986b7dee | 372 | |
0e3c1e3e GM |
373 | (defun ansi-color-apply-on-region (begin end) |
374 | "Translates SGR control sequences into overlays or extents. | |
bc8d33d5 | 375 | Delete all other control sequences without processing them. |
986b7dee | 376 | |
0e9e6c6a CY |
377 | SGR control sequences are applied by calling the function |
378 | specified by `ansi-color-apply-face-function'. The default | |
379 | function sets foreground and background colors to the text | |
380 | between BEGIN and END, using overlays. The colors used are given | |
381 | in `ansi-color-faces-vector' and `ansi-color-names-vector'. See | |
382 | `ansi-color-apply-sequence' for details. | |
0e3c1e3e | 383 | |
2f29c200 WJ |
384 | Every call to this function will set and use the buffer-local |
385 | variable `ansi-color-context-region' to save position and current | |
386 | ansi codes. This information will be used for the next call to | |
387 | `ansi-color-apply-on-region'. Specifically, it will override | |
388 | BEGIN, the start of the region and set the face with which to | |
389 | start. Set `ansi-color-context-region' to nil if you don't want | |
390 | this." | |
391 | (let ((codes (car ansi-color-context-region)) | |
71296446 | 392 | (start-marker (or (cadr ansi-color-context-region) |
0e3c1e3e GM |
393 | (copy-marker begin))) |
394 | (end-marker (copy-marker end)) | |
395 | escape-sequence) | |
bc8d33d5 CY |
396 | ;; First, eliminate unrecognized ANSI control sequences. |
397 | (save-excursion | |
398 | (goto-char start-marker) | |
399 | (while (re-search-forward ansi-color-drop-regexp end-marker t) | |
400 | (replace-match ""))) | |
986b7dee | 401 | (save-excursion |
0e3c1e3e | 402 | (goto-char start-marker) |
bc8d33d5 | 403 | ;; Find the next SGR sequence. |
0e3c1e3e | 404 | (while (re-search-forward ansi-color-regexp end-marker t) |
bc8d33d5 | 405 | ;; Colorize the old block from start to end using old face. |
0fd40f89 CY |
406 | (funcall ansi-color-apply-face-function |
407 | start-marker (match-beginning 0) | |
2f29c200 | 408 | (ansi-color--find-face codes)) |
0e3c1e3e GM |
409 | ;; store escape sequence and new start position |
410 | (setq escape-sequence (match-string 1) | |
411 | start-marker (copy-marker (match-end 0))) | |
412 | ;; delete the escape sequence | |
413 | (replace-match "") | |
2f29c200 WJ |
414 | ;; Update the list of ansi codes. |
415 | (setq codes (ansi-color-apply-sequence escape-sequence codes))) | |
0e3c1e3e GM |
416 | ;; search for the possible start of a new escape sequence |
417 | (if (re-search-forward "\033" end-marker t) | |
418 | (progn | |
419 | ;; if the rest of the region should have a face, put it there | |
0fd40f89 | 420 | (funcall ansi-color-apply-face-function |
2f29c200 WJ |
421 | start-marker (point) (ansi-color--find-face codes)) |
422 | ;; save codes and point | |
0e3c1e3e | 423 | (setq ansi-color-context-region |
2f29c200 | 424 | (list codes (copy-marker (match-beginning 0))))) |
0e3c1e3e | 425 | ;; if the rest of the region should have a face, put it there |
0fd40f89 | 426 | (funcall ansi-color-apply-face-function |
2f29c200 WJ |
427 | start-marker end-marker (ansi-color--find-face codes)) |
428 | (setq ansi-color-context-region (if codes (list codes))))))) | |
0fd40f89 CY |
429 | |
430 | (defun ansi-color-apply-overlay-face (beg end face) | |
431 | "Make an overlay from BEG to END, and apply face FACE. | |
432 | If FACE is nil, do nothing." | |
433 | (when face | |
434 | (ansi-color-set-extent-face | |
435 | (ansi-color-make-extent beg end) | |
436 | face))) | |
0e3c1e3e GM |
437 | |
438 | ;; This function helps you look for overlapping overlays. This is | |
fa463103 | 439 | ;; useful in comint-buffers. Overlapping overlays should not happen! |
0e3c1e3e GM |
440 | ;; A possible cause for bugs are the markers. If you create an overlay |
441 | ;; up to the end of the region, then that end might coincide with the | |
442 | ;; process-mark. As text is added BEFORE the process-mark, the overlay | |
443 | ;; will keep growing. Therefore, as more overlays are created later on, | |
444 | ;; there will be TWO OR MORE overlays covering the buffer at that point. | |
445 | ;; This function helps you check your buffer for these situations. | |
446 | ; (defun ansi-color-debug-overlays () | |
447 | ; (interactive) | |
448 | ; (let ((pos (point-min))) | |
449 | ; (while (< pos (point-max)) | |
450 | ; (if (<= 2 (length (overlays-at pos))) | |
451 | ; (progn | |
452 | ; (goto-char pos) | |
453 | ; (error "%d overlays at %d" (length (overlays-at pos)) pos)) | |
454 | ; (let (message-log-max) | |
455 | ; (message "Reached %d." pos))) | |
456 | ; (setq pos (next-overlay-change pos))))) | |
457 | ||
458 | ;; Emacs/XEmacs compatibility layer | |
459 | ||
460 | (defun ansi-color-make-face (property color) | |
461 | "Return a face with PROPERTY set to COLOR. | |
71296446 | 462 | PROPERTY can be either symbol `foreground' or symbol `background'. |
0e3c1e3e GM |
463 | |
464 | For Emacs, we just return the cons cell \(PROPERTY . COLOR). | |
465 | For XEmacs, we create a temporary face and return it." | |
466 | (if (featurep 'xemacs) | |
467 | (let ((face (make-face (intern (concat color "-" (symbol-name property))) | |
468 | "Temporary face created by ansi-color." | |
469 | t))) | |
470 | (set-face-property face property color) | |
471 | face) | |
472 | (cond ((eq property 'foreground) | |
473 | (cons 'foreground-color color)) | |
474 | ((eq property 'background) | |
475 | (cons 'background-color color)) | |
476 | (t | |
477 | (cons property color))))) | |
478 | ||
479 | (defun ansi-color-make-extent (from to &optional object) | |
480 | "Make an extent for the range [FROM, TO) in OBJECT. | |
481 | ||
482 | OBJECT defaults to the current buffer. XEmacs uses `make-extent', Emacs | |
483 | uses `make-overlay'. XEmacs can use a buffer or a string for OBJECT, | |
484 | Emacs requires OBJECT to be a buffer." | |
c8f0dac9 | 485 | (if (fboundp 'make-extent) |
0e3c1e3e GM |
486 | (make-extent from to object) |
487 | ;; In Emacs, the overlay might end at the process-mark in comint | |
488 | ;; buffers. In that case, new text will be inserted before the | |
489 | ;; process-mark, ie. inside the overlay (using insert-before-marks). | |
490 | ;; In order to avoid this, we use the `insert-behind-hooks' overlay | |
491 | ;; property to make sure it works. | |
492 | (let ((overlay (make-overlay from to object))) | |
493 | (overlay-put overlay 'modification-hooks '(ansi-color-freeze-overlay)) | |
494 | overlay))) | |
495 | ||
496 | (defun ansi-color-freeze-overlay (overlay is-after begin end &optional len) | |
497 | "Prevent OVERLAY from being extended. | |
498 | This function can be used for the `modification-hooks' overlay | |
499 | property." | |
500 | ;; if stuff was inserted at the end of the overlay | |
501 | (when (and is-after | |
502 | (= 0 len) | |
503 | (= end (overlay-end overlay))) | |
504 | ;; reset the end of the overlay | |
505 | (move-overlay overlay (overlay-start overlay) begin))) | |
506 | ||
507 | (defun ansi-color-set-extent-face (extent face) | |
508 | "Set the `face' property of EXTENT to FACE. | |
509 | XEmacs uses `set-extent-face', Emacs uses `overlay-put'." | |
a445370f | 510 | (if (featurep 'xemacs) |
0e3c1e3e GM |
511 | (set-extent-face extent face) |
512 | (overlay-put extent 'face face))) | |
986b7dee | 513 | |
8737bb5a GM |
514 | ;; Helper functions |
515 | ||
2f29c200 WJ |
516 | (defsubst ansi-color-parse-sequence (escape-seq) |
517 | "Return the list of all the parameters in ESCAPE-SEQ. | |
0e3c1e3e | 518 | |
2f29c200 WJ |
519 | ESCAPE-SEQ is a SGR control sequences such as \\033[34m. The parameter |
520 | 34 is used by `ansi-color-get-face-1' to return a face definition. | |
0e3c1e3e | 521 | |
2f29c200 WJ |
522 | Returns nil only if there's no match for `ansi-color-parameter-regexp'." |
523 | (let ((i 0) | |
524 | codes val) | |
525 | (while (string-match ansi-color-parameter-regexp escape-seq i) | |
526 | (setq i (match-end 0) | |
527 | val (string-to-number (match-string 1 escape-seq) 10)) | |
528 | ;; It so happens that (string-to-number "") => 0. | |
529 | (push val codes)) | |
530 | (nreverse codes))) | |
531 | ||
532 | (defun ansi-color-apply-sequence (escape-sequence codes) | |
533 | "Apply ESCAPE-SEQ to CODES and return the new list of codes. | |
534 | ||
535 | ESCAPE-SEQ is an escape sequence parsed by `ansi-color-parse-sequence'. | |
536 | ||
9db94175 WJ |
537 | For each new code, the following happens: if it is 1-7, add it to |
538 | the list of codes; if it is 21-25 or 27, delete appropriate | |
539 | parameters from the list of codes; if it is 30-37 resp. 39, the | |
540 | foreground color code is replaced or added resp. deleted; if it | |
541 | is 40-47 resp. 49, the background color code is replaced or added | |
542 | resp. deleted; any other code is discarded together with the old | |
543 | codes. Finally, the so changed list of codes is returned." | |
2f29c200 WJ |
544 | (let ((new-codes (ansi-color-parse-sequence escape-sequence))) |
545 | (while new-codes | |
9db94175 WJ |
546 | (let* ((new (pop new-codes)) |
547 | (q (/ new 10))) | |
548 | (setq codes | |
549 | (pcase q | |
550 | (0 (unless (memq new '(0 8 9)) | |
551 | (cons new (remq new codes)))) | |
552 | (2 (unless (memq new '(20 26 28 29)) | |
553 | ;; The standard says `21 doubly underlined' while | |
554 | ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims | |
555 | ;; `21 Bright/Bold: off or Underline: Double'. | |
556 | (remq (- new 20) (pcase new | |
557 | (22 (remq 1 codes)) | |
558 | (25 (remq 6 codes)) | |
559 | (_ codes))))) | |
560 | ((or 3 4) (let ((r (mod new 10))) | |
561 | (unless (= r 8) | |
562 | (let (beg) | |
563 | (while (and codes (/= q (/ (car codes) 10))) | |
564 | (push (pop codes) beg)) | |
565 | (setq codes (nconc (nreverse beg) (cdr codes))) | |
566 | (if (= r 9) | |
567 | codes | |
568 | (cons new codes)))))) | |
569 | (_ nil))))) | |
2f29c200 | 570 | codes)) |
0e3c1e3e | 571 | |
986b7dee GM |
572 | (defun ansi-color-make-color-map () |
573 | "Creates a vector of face definitions and returns it. | |
574 | ||
575 | The index into the vector is an ANSI code. See the documentation of | |
576 | `ansi-color-map' for an example. | |
577 | ||
578 | The face definitions are based upon the variables | |
579 | `ansi-color-faces-vector' and `ansi-color-names-vector'." | |
580 | (let ((ansi-color-map (make-vector 50 nil)) | |
581 | (index 0)) | |
582 | ;; miscellaneous attributes | |
c04c01ca | 583 | (mapc |
986b7dee GM |
584 | (function (lambda (e) |
585 | (aset ansi-color-map index e) | |
586 | (setq index (1+ index)) )) | |
587 | ansi-color-faces-vector) | |
986b7dee GM |
588 | ;; foreground attributes |
589 | (setq index 30) | |
c04c01ca | 590 | (mapc |
986b7dee GM |
591 | (function (lambda (e) |
592 | (aset ansi-color-map index | |
7a097943 LL |
593 | (ansi-color-make-face 'foreground |
594 | (if (consp e) (car e) e))) | |
986b7dee GM |
595 | (setq index (1+ index)) )) |
596 | ansi-color-names-vector) | |
986b7dee GM |
597 | ;; background attributes |
598 | (setq index 40) | |
c04c01ca | 599 | (mapc |
986b7dee GM |
600 | (function (lambda (e) |
601 | (aset ansi-color-map index | |
7a097943 LL |
602 | (ansi-color-make-face 'background |
603 | (if (consp e) (cdr e) e))) | |
986b7dee GM |
604 | (setq index (1+ index)) )) |
605 | ansi-color-names-vector) | |
606 | ansi-color-map)) | |
607 | ||
608 | (defvar ansi-color-map (ansi-color-make-color-map) | |
0e3c1e3e | 609 | "A brand new color map suitable for `ansi-color-get-face'. |
986b7dee GM |
610 | |
611 | The value of this variable is usually constructed by | |
612 | `ansi-color-make-color-map'. The values in the array are such that the | |
613 | numbers included in an SGR control sequences point to the correct | |
614 | foreground or background colors. | |
615 | ||
616 | Example: The sequence \033[34m specifies a blue foreground. Therefore: | |
617 | (aref ansi-color-map 34) | |
618 | => \(foreground-color . \"blue\")") | |
619 | ||
620 | (defun ansi-color-map-update (symbol value) | |
621 | "Update `ansi-color-map'. | |
622 | ||
623 | Whenever the vectors used to construct `ansi-color-map' are changed, | |
624 | this function is called. Therefore this function is listed as the :set | |
625 | property of `ansi-color-faces-vector' and `ansi-color-names-vector'." | |
626 | (set-default symbol value) | |
627 | (setq ansi-color-map (ansi-color-make-color-map))) | |
628 | ||
629 | (defun ansi-color-get-face-1 (ansi-code) | |
630 | "Get face definition from `ansi-color-map'. | |
631 | ANSI-CODE is used as an index into the vector." | |
632 | (condition-case nil | |
633 | (aref ansi-color-map ansi-code) | |
74f24ba7 | 634 | (args-out-of-range nil))) |
986b7dee | 635 | |
618206ea RS |
636 | (provide 'ansi-color) |
637 | ||
8737bb5a | 638 | ;;; ansi-color.el ends here |