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