-;;; ansi-color.el --- translate ANSI escape sequences into faces
+;;; ansi-color.el --- translate ANSI escape sequences into faces -*- lexical-binding: t -*-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2016 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Alex Schroeder <alex@gnu.org>
;;
;; SGR control sequences are defined in section 3.8.117 of the ECMA-48
;; standard (identical to ISO/IEC 6429), which is freely available as a
-;; PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>. The
-;; "Graphic Rendition Combination Mode (GRCM)" implemented is
-;; "cumulative mode" as defined in section 7.2.8. Cumulative mode means
-;; that whenever possible, SGR control sequences are combined (ie. blue
-;; and bold).
+;; PDF file <URL:http://www.ecma-international.org/publications/standards/Ecma-048.htm>.
+;; The "Graphic Rendition Combination Mode (GRCM)" implemented is
+;; "cumulative mode" as defined in section 7.2.8. Cumulative mode
+;; means that whenever possible, SGR control sequences are combined
+;; (ie. blue and bold).
;; The basic functions are:
;;
;;
;; Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk> for pointing me to ECMA-48.
;;
-;; Stefan Monnier <foo@acm.com> explaing obscure font-lock stuff and
+;; Stefan Monnier <foo@acm.com> for explaining obscure font-lock stuff and for
;; code suggestions.
\f
"Translating SGR control sequences to faces.
This translation effectively colorizes strings and regions based upon
SGR control sequences embedded in the text. SGR (Select Graphic
-Rendition) control sequences are defined in section 3.8.117 of the
-ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available
-as a PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>."
+Rendition) control sequences are defined in section 8.3.117 of the
+ECMA-48 standard (identical to ISO/IEC 6429), which is freely available
+at <URL:http://www.ecma-international.org/publications/standards/Ecma-048.htm>
+as a PDF file."
:version "21.1"
:group 'processes)
(defcustom ansi-color-faces-vector
- [default bold default italic underline bold bold-italic modeline]
+ [default bold default italic underline success warning error]
"Faces used for SGR control sequences determining a face.
This vector holds the faces used for SGR control sequence parameters 0
to 7.
2 faint default
3 italic italic
4 underlined underline
- 5 slowly blinking bold
- 6 rapidly blinking bold-italic
- 7 negative image modeline
+ 5 slowly blinking success
+ 6 rapidly blinking warning
+ 7 negative image error
Note that the symbol `default' is special: It will not be combined
with the current face.
:group 'ansi-colors)
(defcustom ansi-color-names-vector
- ["black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"]
+ ["black" "red3" "green3" "yellow3" "blue2" "magenta3" "cyan3" "gray90"]
"Colors used for SGR control sequences determining a color.
This vector holds the colors used for SGR control sequences parameters
-30 to 37 \(foreground colors) and 40 to 47 (background colors).
+30 to 37 (foreground colors) and 40 to 47 (background colors).
Parameter Color
30 40 black
37 47 white
This vector is used by `ansi-color-make-color-map' to create a color
-map. This color map is stored in the variable `ansi-color-map'."
- :type '(vector string string string string string string string string)
+map. This color map is stored in the variable `ansi-color-map'.
+
+Each element may also be a cons cell where the car and cdr specify the
+foreground and background colors, respectively."
+ :type '(vector (choice color (cons color color))
+ (choice color (cons color color))
+ (choice color (cons color color))
+ (choice color (cons color color))
+ (choice color (cons color color))
+ (choice color (cons color color))
+ (choice color (cons color color))
+ (choice color (cons color color)))
:set 'ansi-color-map-update
:initialize 'custom-initialize-default
+ :version "24.4" ; default colors copied from `xterm-standard-colors'
:group 'ansi-colors)
(defconst ansi-color-regexp "\033\\[\\([0-9;]*m\\)"
"Regexp that matches SGR control sequences.")
(defconst ansi-color-drop-regexp
- "\033\\[\\([ABCDsuK]\\|2J\\|=[0-9]+[hI]\\|[0-9;]*[Hf]\\)"
+ "\033\\[\\([ABCDsuK]\\|[12][JK]\\|=[0-9]+[hI]\\|[0-9;]*[Hf]\\|\\?[0-9]+[hl]\\)"
"Regexp that matches ANSI control sequences to silently drop.")
(defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"
:group 'ansi-colors
:version "23.2")
+(defvar ansi-color-apply-face-function 'ansi-color-apply-overlay-face
+ "Function for applying an Ansi Color face to text in a buffer.
+This function should accept three arguments: BEG, END, and FACE,
+and it should apply face FACE to the text between BEG and END.")
+
;;;###autoload
(defun ansi-color-for-comint-mode-on ()
"Set `ansi-color-for-comint-mode' to t."
`comint-last-output-start' and the process-mark.
This is a good function to put in `comint-output-filter-functions'."
- (let ((start-marker (or comint-last-output-start
- (point-min-marker)))
+ (let ((start-marker (if (and (markerp comint-last-output-start)
+ (eq (marker-buffer comint-last-output-start)
+ (current-buffer))
+ (marker-position comint-last-output-start))
+ comint-last-output-start
+ (point-min-marker)))
(end-marker (process-mark (get-buffer-process (current-buffer)))))
(cond ((eq ansi-color-for-comint-mode nil))
((eq ansi-color-for-comint-mode 'filter)
(t
(ansi-color-apply-on-region start-marker end-marker)))))
-(add-hook 'comint-output-filter-functions
- 'ansi-color-process-output)
-
-
-;; Alternative font-lock-unfontify-region-function for Emacs only
-
-(defun ansi-color-unfontify-region (beg end &rest xemacs-stuff)
- "Replacement function for `font-lock-default-unfontify-region'.
-
-As text properties are implemented using extents in XEmacs, this
-function is probably not needed. In Emacs, however, things are a bit
-different: When font-lock is active in a buffer, you cannot simply add
-face text properties to the buffer. Font-lock will remove the face
-text property using `font-lock-unfontify-region-function'. If you want
-to insert the strings returned by `ansi-color-apply' into such buffers,
-you must set `font-lock-unfontify-region-function' to
-`ansi-color-unfontify-region'. This function will not remove all face
-text properties unconditionally. It will keep the face text properties
-if the property `ansi-color' is set.
-
-The region from BEG to END is unfontified. XEMACS-STUFF is ignored.
-
-A possible way to install this would be:
-
-\(add-hook 'font-lock-mode-hook
- \(function (lambda ()
- \(setq font-lock-unfontify-region-function
- 'ansi-color-unfontify-region))))"
- ;; Simplified now that font-lock-unfontify-region uses save-buffer-state.
- (when (boundp 'font-lock-syntactic-keywords)
- (remove-text-properties beg end '(syntax-table nil)))
- ;; instead of just using (remove-text-properties beg end '(face
- ;; nil)), we find regions with a non-nil face test-property, skip
- ;; positions with the ansi-color property set, and remove the
- ;; remaining face test-properties.
- (while (setq beg (text-property-not-all beg end 'face nil))
- (setq beg (or (text-property-not-all beg end 'ansi-color t) end))
- (when (get-text-property beg 'face)
- (let ((end-face (or (text-property-any beg end 'face nil)
- end)))
- (remove-text-properties beg end-face '(face nil))
- (setq beg end-face)))))
+(define-obsolete-function-alias 'ansi-color-unfontify-region
+ 'font-lock-default-unfontify-region "24.1")
;; Working with strings
-
-(defvar ansi-color-context nil
+(defvar-local ansi-color-context nil
"Context saved between two calls to `ansi-color-apply'.
-This is a list of the form (FACES FRAGMENT) or nil. FACES is a list of
-faces the last call to `ansi-color-apply' ended with, and FRAGMENT is a
-string starting with an escape sequence, possibly the start of a new
+This is a list of the form (CODES FRAGMENT) or nil. CODES
+represents the state the last call to `ansi-color-apply' ended
+with, currently a list of ansi codes, and FRAGMENT is a string
+starting with an escape sequence, possibly the start of a new
escape sequence.")
-(make-variable-buffer-local 'ansi-color-context)
(defun ansi-color-filter-apply (string)
"Filter out all ANSI control sequences from STRING.
;; find the next escape sequence
(while (setq end (string-match ansi-color-regexp string start))
(setq result (concat result (substring string start end))
- start (match-end 0)))
+ start (match-end 0)))
+ ;; eliminate unrecognized escape sequences
+ (while (string-match ansi-color-drop-regexp string)
+ (setq string
+ (replace-match "" nil nil string)))
;; save context, add the remainder of the string to the result
(let (fragment)
(if (string-match "\033" string start)
(setq fragment (substring string pos)
result (concat result (substring string start pos))))
(setq result (concat result (substring string start))))
- (if fragment
- (setq ansi-color-context (list nil fragment))
- (setq ansi-color-context nil)))
+ (setq ansi-color-context (if fragment (list nil fragment))))
result))
+(defun ansi-color--find-face (codes)
+ "Return the face corresponding to CODES."
+ (let (faces)
+ (while codes
+ (let ((face (ansi-color-get-face-1 (pop codes))))
+ ;; In the (default underline) face, say, the value of the
+ ;; "underline" attribute of the `default' face wins.
+ (unless (eq face 'default)
+ (push face faces))))
+ ;; Avoid some long-lived conses in the common case.
+ (if (cdr faces)
+ (nreverse faces)
+ (car faces))))
+
(defun ansi-color-apply (string)
"Translates SGR control sequences into text properties.
Delete all other control sequences without processing them.
See function `ansi-color-apply-sequence' for details.
Every call to this function will set and use the buffer-local variable
-`ansi-color-context' to save partial escape sequences and current face.
+`ansi-color-context' to save partial escape sequences and current ansi codes.
This information will be used for the next call to `ansi-color-apply'.
Set `ansi-color-context' to nil if you don't want this.
-This function can be added to `comint-preoutput-filter-functions'.
-
-You cannot insert the strings returned into buffers using font-lock.
-See `ansi-color-unfontify-region' for a way around this."
- (let ((face (car ansi-color-context))
+This function can be added to `comint-preoutput-filter-functions'."
+ (let ((codes (car ansi-color-context))
(start 0) end escape-sequence result
colorized-substring)
;; If context was saved and is a string, prepend it.
(while (setq end (string-match ansi-color-regexp string start))
(setq escape-sequence (match-string 1 string))
;; Colorize the old block from start to end using old face.
- (when face
- (put-text-property start end 'ansi-color t string)
- (put-text-property start end 'face face string))
+ (when codes
+ (put-text-property start end 'font-lock-face (ansi-color--find-face codes) string))
(setq colorized-substring (substring string start end)
start (match-end 0))
;; Eliminate unrecognized ANSI sequences.
(replace-match "" nil nil colorized-substring)))
(push colorized-substring result)
;; Create new face, by applying escape sequence parameters.
- (setq face (ansi-color-apply-sequence escape-sequence face)))
+ (setq codes (ansi-color-apply-sequence escape-sequence codes)))
;; if the rest of the string should have a face, put it there
- (when face
- (put-text-property start (length string) 'ansi-color t string)
- (put-text-property start (length string) 'face face string))
+ (when codes
+ (put-text-property start (length string)
+ 'font-lock-face (ansi-color--find-face codes) string))
+ ;; eliminate unrecognized escape sequences
+ (while (string-match ansi-color-drop-regexp string)
+ (setq string
+ (replace-match "" nil nil string)))
;; save context, add the remainder of the string to the result
(let (fragment)
(if (string-match "\033" string start)
(setq fragment (substring string pos))
(push (substring string start pos) result))
(push (substring string start) result))
- (if (or face fragment)
- (setq ansi-color-context (list face fragment))
- (setq ansi-color-context nil)))
+ (setq ansi-color-context (if (or codes fragment) (list codes fragment))))
(apply 'concat (nreverse result))))
;; Working with regions
-(defvar ansi-color-context-region nil
+(defvar-local ansi-color-context-region nil
"Context saved between two calls to `ansi-color-apply-on-region'.
-This is a list of the form (FACES MARKER) or nil. FACES is a list of
-faces the last call to `ansi-color-apply-on-region' ended with, and
-MARKER is a buffer position within an escape sequence or the last
-position processed.")
-(make-variable-buffer-local 'ansi-color-context-region)
+This is a list of the form (CODES MARKER) or nil. CODES
+represents the state the last call to `ansi-color-apply-on-region'
+ended with, currently a list of ansi codes, and MARKER is a
+buffer position within an escape sequence or the last position
+processed.")
(defun ansi-color-filter-region (begin end)
"Filter out all ANSI control sequences from region BEGIN to END.
"Translates SGR control sequences into overlays or extents.
Delete all other control sequences without processing them.
-SGR control sequences are applied by setting foreground and
-background colors to the text between BEGIN and END using
-overlays. The colors used are given in `ansi-color-faces-vector'
-and `ansi-color-names-vector'. See `ansi-color-apply-sequence'
-for details.
-
-Every call to this function will set and use the buffer-local variable
-`ansi-color-context-region' to save position and current face. This
-information will be used for the next call to
-`ansi-color-apply-on-region'. Specifically, it will override BEGIN, the
-start of the region and set the face with which to start. Set
-`ansi-color-context-region' to nil if you don't want this."
- (let ((face (car ansi-color-context-region))
+SGR control sequences are applied by calling the function
+specified by `ansi-color-apply-face-function'. The default
+function sets foreground and background colors to the text
+between BEGIN and END, using overlays. The colors used are given
+in `ansi-color-faces-vector' and `ansi-color-names-vector'. See
+`ansi-color-apply-sequence' for details.
+
+Every call to this function will set and use the buffer-local
+variable `ansi-color-context-region' to save position and current
+ansi codes. This information will be used for the next call to
+`ansi-color-apply-on-region'. Specifically, it will override
+BEGIN, the start of the region and set the face with which to
+start. Set `ansi-color-context-region' to nil if you don't want
+this."
+ (let ((codes (car ansi-color-context-region))
(start-marker (or (cadr ansi-color-context-region)
(copy-marker begin)))
(end-marker (copy-marker end))
;; Find the next SGR sequence.
(while (re-search-forward ansi-color-regexp end-marker t)
;; Colorize the old block from start to end using old face.
- (when face
- (ansi-color-set-extent-face
- (ansi-color-make-extent start-marker (match-beginning 0))
- face))
+ (funcall ansi-color-apply-face-function
+ start-marker (match-beginning 0)
+ (ansi-color--find-face codes))
;; store escape sequence and new start position
(setq escape-sequence (match-string 1)
start-marker (copy-marker (match-end 0)))
;; delete the escape sequence
(replace-match "")
- ;; create new face by applying all the parameters in the escape
- ;; sequence
- (setq face (ansi-color-apply-sequence escape-sequence face)))
+ ;; Update the list of ansi codes.
+ (setq codes (ansi-color-apply-sequence escape-sequence codes)))
;; search for the possible start of a new escape sequence
(if (re-search-forward "\033" end-marker t)
(progn
;; if the rest of the region should have a face, put it there
- (when face
- (ansi-color-set-extent-face
- (ansi-color-make-extent start-marker (point))
- face))
- ;; save face and point
+ (funcall ansi-color-apply-face-function
+ start-marker (point) (ansi-color--find-face codes))
+ ;; save codes and point
(setq ansi-color-context-region
- (list face (copy-marker (match-beginning 0)))))
+ (list codes (copy-marker (match-beginning 0)))))
;; if the rest of the region should have a face, put it there
- (if face
- (progn
- (ansi-color-set-extent-face
- (ansi-color-make-extent start-marker end-marker)
- face)
- (setq ansi-color-context-region (list face)))
- ;; reset context
- (setq ansi-color-context-region nil))))))
+ (funcall ansi-color-apply-face-function
+ start-marker end-marker (ansi-color--find-face codes))
+ (setq ansi-color-context-region (if codes (list codes)))))))
+
+(defun ansi-color-apply-overlay-face (beg end face)
+ "Make an overlay from BEG to END, and apply face FACE.
+If FACE is nil, do nothing."
+ (when face
+ (ansi-color-set-extent-face
+ (ansi-color-make-extent beg end)
+ face)))
;; This function helps you look for overlapping overlays. This is
-;; usefull in comint-buffers. Overlapping overlays should not happen!
+;; useful in comint-buffers. Overlapping overlays should not happen!
;; A possible cause for bugs are the markers. If you create an overlay
;; up to the end of the region, then that end might coincide with the
;; process-mark. As text is added BEFORE the process-mark, the overlay
"Return a face with PROPERTY set to COLOR.
PROPERTY can be either symbol `foreground' or symbol `background'.
-For Emacs, we just return the cons cell \(PROPERTY . COLOR).
+For Emacs, we just return the cons cell (PROPERTY . COLOR).
For XEmacs, we create a temporary face and return it."
(if (featurep 'xemacs)
(let ((face (make-face (intern (concat color "-" (symbol-name property)))
;; Helper functions
-(defun ansi-color-apply-sequence (escape-sequence faces)
- "Apply ESCAPE-SEQ to FACES and return the new list of faces.
+(defsubst ansi-color-parse-sequence (escape-seq)
+ "Return the list of all the parameters in ESCAPE-SEQ.
-ESCAPE-SEQ is an escape sequences parsed by `ansi-color-get-face'.
-
-If the new faces start with the symbol `default', then the new
-faces are returned. If the faces start with something else,
-they are appended to the front of the FACES list, and the new
-list of faces is returned.
+ESCAPE-SEQ is a SGR control sequences such as \\033[34m. The parameter
+34 is used by `ansi-color-get-face-1' to return a face definition.
-If `ansi-color-get-face' returns nil, then we either got a
-null-sequence, or we stumbled upon some garbage. In either
-case we return nil."
- (let ((new-faces (ansi-color-get-face escape-sequence)))
- (cond ((null new-faces)
- nil)
- ((eq (car new-faces) 'default)
- (cdr new-faces))
- (t
- ;; Like (append NEW-FACES FACES)
- ;; but delete duplicates in FACES.
- (let ((modified-faces (copy-sequence faces)))
- (dolist (face (nreverse new-faces))
- (setq modified-faces (delete face modified-faces))
- (push face modified-faces))
- modified-faces)))))
+Returns nil only if there's no match for `ansi-color-parameter-regexp'."
+ (let ((i 0)
+ codes val)
+ (while (string-match ansi-color-parameter-regexp escape-seq i)
+ (setq i (match-end 0)
+ val (string-to-number (match-string 1 escape-seq) 10))
+ ;; It so happens that (string-to-number "") => 0.
+ (push val codes))
+ (nreverse codes)))
+
+(defun ansi-color-apply-sequence (escape-sequence codes)
+ "Apply ESCAPE-SEQUENCE to CODES and return the new list of codes.
+
+ESCAPE-SEQUENCE is an escape sequence parsed by
+`ansi-color-parse-sequence'.
+
+For each new code, the following happens: if it is 1-7, add it to
+the list of codes; if it is 21-25 or 27, delete appropriate
+parameters from the list of codes; if it is 30-37 resp. 39, the
+foreground color code is replaced or added resp. deleted; if it
+is 40-47 resp. 49, the background color code is replaced or added
+resp. deleted; any other code is discarded together with the old
+codes. Finally, the so changed list of codes is returned."
+ (let ((new-codes (ansi-color-parse-sequence escape-sequence)))
+ (while new-codes
+ (let* ((new (pop new-codes))
+ (q (/ new 10)))
+ (setq codes
+ (pcase q
+ (0 (unless (memq new '(0 8 9))
+ (cons new (remq new codes))))
+ (2 (unless (memq new '(20 26 28 29))
+ ;; The standard says `21 doubly underlined' while
+ ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims
+ ;; `21 Bright/Bold: off or Underline: Double'.
+ (remq (- new 20) (pcase new
+ (22 (remq 1 codes))
+ (25 (remq 6 codes))
+ (_ codes)))))
+ ((or 3 4) (let ((r (mod new 10)))
+ (unless (= r 8)
+ (let (beg)
+ (while (and codes (/= q (/ (car codes) 10)))
+ (push (pop codes) beg))
+ (setq codes (nconc (nreverse beg) (cdr codes)))
+ (if (= r 9)
+ codes
+ (cons new codes))))))
+ (_ nil)))))
+ codes))
(defun ansi-color-make-color-map ()
"Creates a vector of face definitions and returns it.
The face definitions are based upon the variables
`ansi-color-faces-vector' and `ansi-color-names-vector'."
- (let ((ansi-color-map (make-vector 50 nil))
+ (let ((map (make-vector 50 nil))
(index 0))
;; miscellaneous attributes
(mapc
(function (lambda (e)
- (aset ansi-color-map index e)
+ (aset map index e)
(setq index (1+ index)) ))
ansi-color-faces-vector)
;; foreground attributes
(setq index 30)
(mapc
(function (lambda (e)
- (aset ansi-color-map index
- (ansi-color-make-face 'foreground e))
+ (aset map index
+ (ansi-color-make-face 'foreground
+ (if (consp e) (car e) e)))
(setq index (1+ index)) ))
ansi-color-names-vector)
;; background attributes
(setq index 40)
(mapc
(function (lambda (e)
- (aset ansi-color-map index
- (ansi-color-make-face 'background e))
+ (aset map index
+ (ansi-color-make-face 'background
+ (if (consp e) (cdr e) e)))
(setq index (1+ index)) ))
ansi-color-names-vector)
- ansi-color-map))
+ map))
(defvar ansi-color-map (ansi-color-make-color-map)
"A brand new color map suitable for `ansi-color-get-face'.
numbers included in an SGR control sequences point to the correct
foreground or background colors.
-Example: The sequence \033[34m specifies a blue foreground. Therefore:
+Example: The sequence \\033[34m specifies a blue foreground. Therefore:
(aref ansi-color-map 34)
- => \(foreground-color . \"blue\")")
+ => (foreground-color . \"blue\")")
(defun ansi-color-map-update (symbol value)
"Update `ansi-color-map'.
(aref ansi-color-map ansi-code)
(args-out-of-range nil)))
-(defun ansi-color-get-face (escape-seq)
- "Create a new face by applying all the parameters in ESCAPE-SEQ.
-
-Should any of the parameters result in the default face (usually this is
-the parameter 0), then the effect of all previous parameters is cancelled.
-
-ESCAPE-SEQ is a SGR control sequences such as \\033[34m. The parameter
-34 is used by `ansi-color-get-face-1' to return a face definition."
- (let ((i 0)
- f val)
- (while (string-match ansi-color-parameter-regexp escape-seq i)
- (setq i (match-end 0)
- val (ansi-color-get-face-1
- (string-to-number (match-string 1 escape-seq) 10)))
- (cond ((not val))
- ((eq val 'default)
- (setq f (list val)))
- (t
- (unless (member val f)
- (push val f)))))
- f))
-
(provide 'ansi-color)
-;; arch-tag: 00726118-9432-44fd-b72d-d2af7591c99c
;;; ansi-color.el ends here