]> code.delx.au - gnu-emacs/blobdiff - lisp/ansi-color.el
Ibuffer: Mark buffers by content
[gnu-emacs] / lisp / ansi-color.el
index 8305aaf119923829bee0e0f66fe7c67d3faeee38..788a7bde4cad80c5260adff95cfb6adb4ce9bebb 100644 (file)
@@ -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-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:
 ;;
@@ -84,8 +84,9 @@
 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 8.3.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>."
+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)
 
@@ -116,10 +117,10 @@ map.  This color map is stored in the variable `ansi-color-map'."
   :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
@@ -146,13 +147,14 @@ foreground and background colors, respectively."
                  (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;]"
@@ -230,18 +232,17 @@ This is a good function to put in `comint-output-filter-functions'."
          (t
           (ansi-color-apply-on-region start-marker end-marker)))))
 
-(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
-(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 (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.
@@ -260,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))
-           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)
@@ -324,7 +329,12 @@ This function can be added to `comint-preoutput-filter-functions'."
       (setq codes (ansi-color-apply-sequence escape-sequence codes)))
     ;; if the rest of the string should have a face, put it there
     (when codes
-      (put-text-property start (length string) 'font-lock-face (ansi-color--find-face codes) string))
+      (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)
@@ -337,14 +347,13 @@ This function can be added to `comint-preoutput-filter-functions'."
 
 ;; 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 (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.")
-(make-variable-buffer-local 'ansi-color-context-region)
 
 (defun ansi-color-filter-region (begin end)
   "Filter out all ANSI control sequences from region BEGIN to END.
@@ -461,7 +470,7 @@ If FACE is nil, do nothing."
   "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)))
@@ -530,38 +539,44 @@ Returns nil only if there's no match for `ansi-color-parameter-regexp'."
     (nreverse codes)))
 
 (defun ansi-color-apply-sequence (escape-sequence codes)
-  "Apply ESCAPE-SEQ to CODES and return the new list of codes.
-
-ESCAPE-SEQ is an escape sequence parsed by `ansi-color-parse-sequence'.
-
-If the new codes resulting from ESCAPE-SEQ start with 0, then the
-old codes are discarded and the remaining new codes are
-processed.  Otherwise, for each new code: if it is 21-25 or 27-29
-delete appropriate parameters from the list of codes; any other
-code that makes sense is added to the list of codes.  Finally,
-the so changed list of codes is returned."
+  "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
-      (setq codes
-           (let ((new (pop new-codes)))
-             (cond ((zerop new)
-                    nil)
-                   ((or (<= new 20)
-                        (>= new 30))
-                    (if (memq new codes)
-                        codes
-                      (cons new codes)))
-                   ;; The standard says `21 doubly underlined' while
-                   ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims
-                   ;; `21 Bright/Bold: off or Underline: Double'.
-                   ((/= new 26)
-                    (remq (- new 20)
-                          (cond ((= new 22)
-                                 (remq 1 codes))
-                                ((= new 25)
-                                 (remq 6 codes))
-                                (t codes))))
-                   (t 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 ()
@@ -572,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'."
-  (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
+                 (aset map index
                       (ansi-color-make-face 'foreground
                                              (if (consp e) (car e) e)))
                  (setq index (1+ index)) ))
@@ -593,12 +608,12 @@ The face definitions are based upon the variables
     (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-map))
+    map))
 
 (defvar ansi-color-map (ansi-color-make-color-map)
   "A brand new color map suitable for `ansi-color-get-face'.
@@ -608,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.
 
-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'.