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