Add a couple cells to lisp-prettify-symbols-alist

[gnu-emacs] / lisp / ansi-color.el

diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index ff7edf40dcb0c4ed5bafaf50b35548efb69ee27f..788a7bde4cad80c5260adff95cfb6adb4ce9bebb 100644 (file)
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -1,6 +1,6 @@
-;;; ansi-color.el --- translate ANSI escape sequences into faces
+;;; ansi-color.el --- translate ANSI escape sequences into faces -*- lexical-binding: t -*-

 
 

-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2016 Free Software Foundation, Inc.

 
 ;; Author: Alex Schroeder <alex@gnu.org>
 ;; Maintainer: Alex Schroeder <alex@gnu.org>
 
 ;; Author: Alex Schroeder <alex@gnu.org>
 ;; Maintainer: Alex Schroeder <alex@gnu.org>


@@ -40,11 +40,11 @@
 ;;
 ;; 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
 ;;
 ;; 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:
 ;;
 
 ;; The basic functions are:
 ;;


@@ -68,7 +68,7 @@
 ;;
 ;; Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk> for pointing me to ECMA-48.
 ;;
 ;;
 ;; 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
 ;; code suggestions.
 
 \f


@@ -83,14 +83,15 @@
   "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
   "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
   :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.
   "Faces used for SGR control sequences determining a face.
 This vector holds the faces used for SGR control sequence parameters 0
 to 7.


@@ -101,9 +102,9 @@ Parameter  Description        Face used by default
   2        faint              default
   3        italic             italic
   4        underlined         underline
   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.
 
 Note that the symbol `default' is special: It will not be combined
 with the current face.


@@ -116,10 +117,10 @@ map.  This color map is stored in the variable `ansi-color-map'."
   :group 'ansi-colors)
 
 (defcustom ansi-color-names-vector
   :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
   "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
 
 Parameter  Color
   30  40   black


@@ -146,13 +147,14 @@ foreground and background colors, respectively."
                  (choice color (cons color color)))
   :set 'ansi-color-map-update
   :initialize 'custom-initialize-default
                  (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
   :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;]"
   "Regexp that matches ANSI control sequences to silently drop.")
 
 (defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"


@@ -183,6 +185,11 @@ in shell buffers.  You set this variable by calling one of:
   :group 'ansi-colors
   :version "23.2")
 
   :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."
 ;;;###autoload
 (defun ansi-color-for-comint-mode-on ()
   "Set `ansi-color-for-comint-mode' to t."


@@ -212,8 +219,12 @@ The comint output is assumed to lie between the marker
 `comint-last-output-start' and the process-mark.
 
 This is a good function to put in `comint-output-filter-functions'."
 `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)
        (end-marker (process-mark (get-buffer-process (current-buffer)))))
     (cond ((eq ansi-color-for-comint-mode nil))
          ((eq ansi-color-for-comint-mode 'filter)


@@ -221,20 +232,17 @@ This is a good function to put in `comint-output-filter-functions'."
          (t
           (ansi-color-apply-on-region start-marker end-marker)))))
 
          (t
           (ansi-color-apply-on-region start-marker end-marker)))))
 

-(add-hook 'comint-output-filter-functions
-         'ansi-color-process-output)
-
-(defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region)
-(make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1")
+(define-obsolete-function-alias 'ansi-color-unfontify-region
+  'font-lock-default-unfontify-region "24.1")

 
 ;; Working with strings
 
 ;; Working with strings

-(defvar ansi-color-context nil
+(defvar-local ansi-color-context nil

   "Context saved between two calls to `ansi-color-apply'.
   "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.")
 escape sequence.")

-(make-variable-buffer-local 'ansi-color-context)

 
 (defun ansi-color-filter-apply (string)
   "Filter out all ANSI control sequences from STRING.
 
 (defun ansi-color-filter-apply (string)
   "Filter out all ANSI control sequences from STRING.


@@ -253,7 +261,11 @@ This function can be added to `comint-preoutput-filter-functions'."
     ;; find the next escape sequence
     (while (setq end (string-match ansi-color-regexp string start))
       (setq result (concat result (substring string start end))
     ;; 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)
     ;; save context, add the remainder of the string to the result
     (let (fragment)
       (if (string-match "\033" string start)


@@ -264,6 +276,20 @@ This function can be added to `comint-preoutput-filter-functions'."
       (setq ansi-color-context (if fragment (list nil fragment))))
     result))
 
       (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.
 (defun ansi-color-apply (string)
   "Translates SGR control sequences into text properties.
 Delete all other control sequences without processing them.


@@ -274,12 +300,12 @@ are given in `ansi-color-faces-vector' and `ansi-color-names-vector'.
 See function `ansi-color-apply-sequence' for details.
 
 Every call to this function will set and use the buffer-local variable
 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'."
 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'."

-  (let ((face (car ansi-color-context))
+  (let ((codes (car ansi-color-context))

        (start 0) end escape-sequence result
        colorized-substring)
     ;; If context was saved and is a string, prepend it.
        (start 0) end escape-sequence result
        colorized-substring)
     ;; If context was saved and is a string, prepend it.


@@ -290,8 +316,8 @@ This function can be added to `comint-preoutput-filter-functions'."
     (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.
     (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 'font-lock-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.
       (setq colorized-substring (substring string start end)
            start (match-end 0))
       ;; Eliminate unrecognized ANSI sequences.


@@ -300,10 +326,15 @@ This function can be added to `comint-preoutput-filter-functions'."
              (replace-match "" nil nil colorized-substring)))
       (push colorized-substring result)
       ;; Create new face, by applying escape sequence parameters.
              (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
     ;; if the rest of the string should have a face, put it there

-    (when face
-      (put-text-property start (length string) 'font-lock-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)
     ;; save context, add the remainder of the string to the result
     (let (fragment)
       (if (string-match "\033" string start)


@@ -311,18 +342,18 @@ This function can be added to `comint-preoutput-filter-functions'."
            (setq fragment (substring string pos))
            (push (substring string start pos) result))
        (push (substring string start) result))
            (setq fragment (substring string pos))
            (push (substring string start pos) result))
        (push (substring string start) result))

-      (setq ansi-color-context (if (or face fragment) (list face fragment))))
+      (setq ansi-color-context (if (or codes fragment) (list codes fragment))))

     (apply 'concat (nreverse result))))
 
 ;; Working with regions
 
     (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'.
   "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.
 
 (defun ansi-color-filter-region (begin end)
   "Filter out all ANSI control sequences from region BEGIN to END.


@@ -352,19 +383,21 @@ it will override BEGIN, the start of the region.  Set
   "Translates SGR control sequences into overlays or extents.
 Delete all other control sequences without processing them.
 
   "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))
        (start-marker (or (cadr ansi-color-context-region)
                          (copy-marker begin)))
        (end-marker (copy-marker end))


@@ -379,41 +412,40 @@ start of the region and set the face with which to start.  Set
       ;; 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.
       ;; 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 "")
         ;; 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
       ;; 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
            (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 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
 
 ;; 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
 ;; 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


@@ -438,7 +470,7 @@ start of the region and set the face with which to start.  Set
   "Return a face with PROPERTY set to COLOR.
 PROPERTY can be either symbol `foreground' or symbol `background'.
 
   "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)))
 For XEmacs, we create a temporary face and return it."
   (if (featurep 'xemacs)
       (let ((face (make-face (intern (concat color "-" (symbol-name property)))


@@ -490,32 +522,62 @@ XEmacs uses `set-extent-face', Emacs  uses `overlay-put'."
 
 ;; Helper functions
 
 
 ;; Helper functions
 

-(defun ansi-color-apply-sequence (escape-sequence faces)
-  "Apply ESCAPE-SEQ to FACES and return the new list of faces.
-
-ESCAPE-SEQ is an escape sequences parsed by `ansi-color-get-face'.
+(defsubst ansi-color-parse-sequence (escape-seq)
+  "Return the list of all the parameters in ESCAPE-SEQ.

 
 

-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.
 
 (defun ansi-color-make-color-map ()
   "Creates a vector of face definitions and returns it.


@@ -525,19 +587,19 @@ The index into the vector is an ANSI code.  See the documentation of
 
 The face definitions are based upon the variables
 `ansi-color-faces-vector' and `ansi-color-names-vector'."
 
 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)
         (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)
                  (setq index (1+ index)) ))
      ansi-color-faces-vector)
     ;; foreground attributes
     (setq index 30)
     (mapc
      (function (lambda (e)

-                 (aset ansi-color-map index
+                 (aset map index

                       (ansi-color-make-face 'foreground
                                              (if (consp e) (car e) e)))
                  (setq index (1+ index)) ))
                       (ansi-color-make-face 'foreground
                                              (if (consp e) (car e) e)))
                  (setq index (1+ index)) ))


@@ -546,12 +608,12 @@ The face definitions are based upon the variables
     (setq index 40)
     (mapc
      (function (lambda (e)
     (setq index 40)
     (mapc
      (function (lambda (e)

-                 (aset ansi-color-map index
+                 (aset map index

                       (ansi-color-make-face 'background
                                              (if (consp e) (cdr e) e)))
                  (setq index (1+ index)) ))
      ansi-color-names-vector)
                       (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'.
 
 (defvar ansi-color-map (ansi-color-make-color-map)
   "A brand new color map suitable for `ansi-color-get-face'.


@@ -561,9 +623,9 @@ The value of this variable is usually constructed by
 numbers included in an SGR control sequences point to the correct
 foreground or background colors.
 
 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)
      (aref ansi-color-map 34)

-          => \(foreground-color . \"blue\")")
+          => (foreground-color . \"blue\")")

 
 (defun ansi-color-map-update (symbol value)
   "Update `ansi-color-map'.
 
 (defun ansi-color-map-update (symbol value)
   "Update `ansi-color-map'.


@@ -581,28 +643,6 @@ ANSI-CODE is used as an index into the vector."
       (aref ansi-color-map ansi-code)
     (args-out-of-range nil)))
 
       (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)
 
 ;;; ansi-color.el ends here
 (provide 'ansi-color)
 
 ;;; ansi-color.el ends here