1 ;;; ansi-color.el --- translate ANSI escape sequences into faces
3 ;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
5 ;; Author: Alex Schroeder <alex@gnu.org>
6 ;; Maintainer: Alex Schroeder <alex@gnu.org>
8 ;; Keywords: comm processes
10 ;; This file is part of GNU Emacs.
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
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.
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.
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
34 ;; This allows you to run ls --color=yes in shell-mode. In order to
35 ;; test this, proceed as follows:
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
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
47 ;; If you decide you like this, add the following to your .emacs file:
49 ;; (autoload 'ansi-color-for-comint-mode-on "ansi-color" nil t)
50 ;; (add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)
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
60 ;; The basic functions are:
62 ;; `ansi-color-apply' to colorize a string containing SGR control
65 ;; `ansi-color-filter-apply' to filter SGR control sequences from a
68 ;; `ansi-color-apply-on-region' to colorize a region containing SGR
71 ;; `ansi-color-filter-region' to filter SGR control sequences from a
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.
80 ;; Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk> for pointing me to ECMA-48.
82 ;; Stefan Monnier <foo@acm.com> explaing obscure font-lock stuff and
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>."
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
107 Parameter Description Face used by default
112 4 underlined underline
113 5 slowly blinking bold
114 6 rapidly blinking bold-italic
115 7 negative image modeline
117 Note that the symbol `default' is special: It will not be combined
118 with the current face.
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
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).
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
150 (defconst ansi-color-regexp "\033\\[\\([0-9;]*\\)m"
151 "Regexp that matches SGR control sequences.")
153 (defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"
154 "Regexp that matches SGR control sequence parameters.")
157 ;; Convenience functions for comint modes (eg. shell-mode)
160 (defcustom ansi-color-for-comint-mode nil
161 "Determines what to do with comint output.
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.
167 In order for this to have any effect, `ansi-color-process-output' must
168 be in `comint-output-filter-functions'.
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]"
176 :type '(choice (const :tag "Do nothing" nil)
177 (const :tag "Filter" filter)
178 (const :tag "Translate" t))
181 (defun ansi-color-for-comint-mode-on ()
182 "Set `ansi-color-for-comint-mode' to t."
184 (setq ansi-color-for-comint-mode t))
186 (defun ansi-color-for-comint-mode-off ()
187 "Set `ansi-color-for-comint-mode' to nil."
189 (setq ansi-color-for-comint-mode nil))
191 (defun ansi-color-for-comint-mode-filter ()
192 "Set `ansi-color-for-comint-mode' to symbol `filter'."
194 (setq ansi-color-for-comint-mode 'filter))
196 (defun ansi-color-process-output (string)
197 "Maybe translate SGR control sequences of comint output into text-properties.
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'.
204 The comint output is assumed to lie between the marker
205 `comint-last-output-start' and the process-mark.
207 This is a good function to put in `comint-output-filter-functions'."
208 (let ((start-marker (or comint-last-output-start
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))
215 (ansi-color-apply-on-region start-marker end-marker)))))
217 (add-hook 'comint-output-filter-functions
218 'ansi-color-process-output)
221 ;; Alternative font-lock-unfontify-region-function
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))))
236 (when (and (not modified) (buffer-modified-p))
237 (set-buffer-modified-p nil)))))
238 (put 'save-buffer-state 'lisp-indent-function 1))
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.
251 The region from BEG to END is unfontified. XEMACS-STUFF is ignored.
253 A possible way to install this would be:
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)
272 (remove-text-properties beg end-face '(face nil))
273 (setq beg end-face))))))
275 ;; Working with strings
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
283 (make-variable-buffer-local 'ansi-color-context)
285 (defun ansi-color-filter-apply (string)
286 "Filter out all SGR control sequences from STRING.
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.
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
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))))
311 (setq ansi-color-context (list nil fragment))
312 (setq ansi-color-context nil)))
315 (defun ansi-color-apply (string)
316 "Translates SGR control sequences into text-properties.
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.
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.
328 This function can be added to `comint-preoutput-filter-functions'.
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
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))
348 ;; create new face by applying all the parameters in the escape
350 (setq face (ansi-color-apply-sequence escape-sequence face)))
351 ;; if the rest of the string should have a face, put it there
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
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)))
367 ;; Working with regions
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)
377 (defun ansi-color-filter-region (begin end)
378 "Filter out all SGR control sequences from region BEGIN to END.
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)))
389 ;; find the next escape sequence
390 (while (re-search-forward ansi-color-regexp end-marker t)
391 ;; delete the escape sequence
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)))))
398 (defun ansi-color-apply-on-region (begin end)
399 "Translates SGR control sequences into overlays or extents.
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.
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))
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
424 (ansi-color-set-extent-face
425 (ansi-color-make-extent start-marker (match-beginning 0))
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
432 ;; create new face by applying all the parameters in the escape
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)
438 ;; if the rest of the region should have a face, put it there
440 (ansi-color-set-extent-face
441 (ansi-color-make-extent start-marker (point))
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
449 (ansi-color-set-extent-face
450 (ansi-color-make-extent start-marker end-marker)
452 (setq ansi-color-context-region (list face)))
454 (setq ansi-color-context-region nil))))))
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 ()
466 ; (let ((pos (point-min)))
467 ; (while (< pos (point-max))
468 ; (if (<= 2 (length (overlays-at 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)))))
476 ;; Emacs/XEmacs compatibility layer
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'.
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."
488 (set-face-property face property color)
490 (cond ((eq property 'foreground)
491 (cons 'foreground-color color))
492 ((eq property 'background)
493 (cons 'background-color color))
495 (cons property color)))))
497 (defun ansi-color-make-extent (from to &optional object)
498 "Make an extent for the range [FROM, TO) in OBJECT.
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))
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
518 ;; if stuff was inserted at the end of the overlay
521 (= end (overlay-end overlay)))
522 ;; reset the end of the overlay
523 (move-overlay overlay (overlay-start overlay) begin)))
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)))
534 (defun ansi-color-apply-sequence (escape-sequence faces)
535 "Apply ESCAPE-SEQ to FACES and return the new list of faces.
537 ESCAPE-SEQ is an escape sequences parsed by `ansi-color-get-face'.
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.
544 If `ansi-color-get-face' returns nil, then we either got a
545 null-sequence, or we stumbled upon some garbage. In either
547 (let ((new-faces (ansi-color-get-face escape-sequence)))
548 (cond ((null new-faces)
550 ((eq (car new-faces) 'default)
553 (append new-faces face)))))
555 (defun ansi-color-make-color-map ()
556 "Creates a vector of face definitions and returns it.
558 The index into the vector is an ANSI code. See the documentation of
559 `ansi-color-map' for an example.
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))
565 ;; miscellaneous attributes
567 (function (lambda (e)
568 (aset ansi-color-map index e)
569 (setq index (1+ index)) ))
570 ansi-color-faces-vector)
571 ;; foreground attributes
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
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)
589 (defvar ansi-color-map (ansi-color-make-color-map)
590 "A brand new color map suitable for `ansi-color-get-face'.
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.
597 Example: The sequence \033[34m specifies a blue foreground. Therefore:
598 (aref ansi-color-map 34)
599 => \(foreground-color . \"blue\")")
601 (defun ansi-color-map-update (symbol value)
602 "Update `ansi-color-map'.
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)))
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."
614 (aref ansi-color-map ansi-code)
615 ('args-out-of-range nil)))
617 (defun ansi-color-get-face (escape-seq)
618 "Create a new face by applying all the parameters in ESCAPE-SEQ.
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.
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]?")
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)))
636 (add-to-list 'f val))))
639 (provide 'ansi-color)
641 ;;; ansi-color.el ends here