]> code.delx.au - gnu-emacs/blobdiff - lisp/ansi-color.el
* doc/emacs/dired.texi (Shell Commands in Dired): Fix typo.
[gnu-emacs] / lisp / ansi-color.el
index e343f560169a53439791fb718076b987e48584db..15a543e959194eba935402fb11c123b131612cf1 100644 (file)
@@ -1,7 +1,6 @@
 ;;; ansi-color.el --- translate ANSI escape sequences into faces
 
 ;;; ansi-color.el --- translate ANSI escape sequences into faces
 
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 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>
 ;; known as ANSI escape sequences) and tries to translate these into
 ;; faces.
 ;;
 ;; known as ANSI escape sequences) and tries to translate these into
 ;; faces.
 ;;
-;; This allows you to run ls --color=yes in shell-mode.  In order to
-;; test this, proceed as follows:
-;;
-;; 1. start a shell: M-x shell
-;; 2. load this file: M-x load-library RET ansi-color RET
-;; 3. activate ansi-color: M-x ansi-color-for-comint-mode-on
-;; 4. test ls --color=yes in the *shell* buffer
+;; This allows you to run ls --color=yes in shell-mode.  It is now
+;; enabled by default; to disable it, set ansi-color-for-comint-mode
+;; to nil.
 ;;
 ;; Note that starting your shell from within Emacs might set the TERM
 ;; environment variable.  The new setting might disable the output of
 ;; SGR control sequences.  Using ls --color=yes forces ls to produce
 ;; these.
 ;;
 ;;
 ;; Note that starting your shell from within Emacs might set the TERM
 ;; environment variable.  The new setting might disable the output of
 ;; SGR control sequences.  Using ls --color=yes forces ls to produce
 ;; these.
 ;;
-;; If you decide you like this, add the following to your .emacs file:
-;;
-;; (add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)
-;;
 ;; 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
 ;; 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
@@ -77,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
@@ -141,8 +132,18 @@ Parameter  Color
   37  47   white
 
 This vector is used by `ansi-color-make-color-map' to create a color
   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
   :group 'ansi-colors)
   :set 'ansi-color-map-update
   :initialize 'custom-initialize-default
   :group 'ansi-colors)
@@ -150,6 +151,10 @@ map.  This color map is stored in the variable `ansi-color-map'."
 (defconst ansi-color-regexp "\033\\[\\([0-9;]*m\\)"
   "Regexp that matches SGR control sequences.")
 
 (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]\\)"
+  "Regexp that matches ANSI control sequences to silently drop.")
+
 (defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"
   "Regexp that matches SGR control sequence parameters.")
 
 (defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"
   "Regexp that matches SGR control sequence parameters.")
 
@@ -157,12 +162,12 @@ map.  This color map is stored in the variable `ansi-color-map'."
 ;; Convenience functions for comint modes (eg. shell-mode)
 
 
 ;; Convenience functions for comint modes (eg. shell-mode)
 
 
-(defcustom ansi-color-for-comint-mode nil
+(defcustom ansi-color-for-comint-mode t
   "Determines what to do with comint output.
 If nil, do nothing.
 If the symbol `filter', then filter all SGR control sequences.
 If anything else (such as t), then translate SGR control sequences
   "Determines what to do with comint output.
 If nil, do nothing.
 If the symbol `filter', then filter all SGR control sequences.
 If anything else (such as t), then translate SGR control sequences
-into text-properties.
+into text properties.
 
 In order for this to have any effect, `ansi-color-process-output' must
 be in `comint-output-filter-functions'.
 
 In order for this to have any effect, `ansi-color-process-output' must
 be in `comint-output-filter-functions'.
@@ -175,7 +180,13 @@ in shell buffers.  You set this variable by calling one of:
   :type '(choice (const :tag "Do nothing" nil)
                 (const :tag "Filter" filter)
                 (const :tag "Translate" t))
   :type '(choice (const :tag "Do nothing" nil)
                 (const :tag "Filter" filter)
                 (const :tag "Translate" t))
-  :group 'ansi-colors)
+  :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 ()
 
 ;;;###autoload
 (defun ansi-color-for-comint-mode-on ()
@@ -195,12 +206,12 @@ in shell buffers.  You set this variable by calling one of:
 
 ;;;###autoload
 (defun ansi-color-process-output (ignored)
 
 ;;;###autoload
 (defun ansi-color-process-output (ignored)
-  "Maybe translate SGR control sequences of comint output into text-properties.
+  "Maybe translate SGR control sequences of comint output into text properties.
 
 Depending on variable `ansi-color-for-comint-mode' the comint output is
 either not processed, SGR control sequences are filtered using
 `ansi-color-filter-region', or SGR control sequences are translated into
 
 Depending on variable `ansi-color-for-comint-mode' the comint output is
 either not processed, SGR control sequences are filtered using
 `ansi-color-filter-region', or SGR control sequences are translated into
-text-properties using `ansi-color-apply-on-region'.
+text properties using `ansi-color-apply-on-region'.
 
 The comint output is assumed to lie between the marker
 `comint-last-output-start' and the process-mark.
 
 The comint output is assumed to lie between the marker
 `comint-last-output-start' and the process-mark.
@@ -215,51 +226,10 @@ 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)
-
-
-;; 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)))))
+(defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region)
+(make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1")
 
 ;; Working with strings
 
 ;; Working with strings
-
 (defvar 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
 (defvar 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
@@ -269,7 +239,7 @@ escape sequence.")
 (make-variable-buffer-local 'ansi-color-context)
 
 (defun ansi-color-filter-apply (string)
 (make-variable-buffer-local 'ansi-color-context)
 
 (defun ansi-color-filter-apply (string)
-  "Filter out all SGR control sequences from STRING.
+  "Filter out all ANSI control sequences from STRING.
 
 Every call to this function will set and use the buffer-local variable
 `ansi-color-context' to save partial escape sequences.  This information
 
 Every call to this function will set and use the buffer-local variable
 `ansi-color-context' to save partial escape sequences.  This information
@@ -293,16 +263,15 @@ This function can be added to `comint-preoutput-filter-functions'."
            (setq fragment (substring string pos)
                  result (concat result (substring string start pos))))
        (setq result (concat result (substring 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-apply (string)
     result))
 
 (defun ansi-color-apply (string)
-  "Translates SGR control sequences into text-properties.
+  "Translates SGR control sequences into text properties.
+Delete all other control sequences without processing them.
 
 Applies SGR control sequences setting foreground and background colors
 
 Applies SGR control sequences setting foreground and background colors
-to STRING using text-properties and returns the result.  The colors used
+to STRING using text properties and returns the result.  The colors used
 are given in `ansi-color-faces-vector' and `ansi-color-names-vector'.
 See function `ansi-color-apply-sequence' for details.
 
 are given in `ansi-color-faces-vector' and `ansi-color-names-vector'.
 See function `ansi-color-apply-sequence' for details.
 
@@ -311,44 +280,41 @@ Every call to this function will set and use the buffer-local variable
 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 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."
+This function can be added to `comint-preoutput-filter-functions'."
   (let ((face (car ansi-color-context))
   (let ((face (car ansi-color-context))
-       (start 0) end escape-sequence result)
-    ;; 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.
     (if (cadr ansi-color-context)
         (setq string (concat (cadr ansi-color-context) string)
               ansi-color-context nil))
     (if (cadr ansi-color-context)
         (setq string (concat (cadr ansi-color-context) string)
               ansi-color-context nil))
-    ;; find the next escape sequence
+    ;; Find the next escape sequence.
     (while (setq end (string-match ansi-color-regexp string start))
     (while (setq end (string-match ansi-color-regexp string start))
-      ;; store escape sequence
       (setq escape-sequence (match-string 1 string))
       (setq escape-sequence (match-string 1 string))
-      ;; colorize the old block from start to end using old face
+      ;; Colorize the old block from start to end using old face.
       (when face
       (when face
-       (put-text-property start end 'ansi-color t string)
-       (put-text-property start end 'face face string))
-      (setq result (concat result (substring string start end))
+       (put-text-property start end 'font-lock-face face string))
+      (setq colorized-substring (substring string start end)
            start (match-end 0))
            start (match-end 0))
-      ;; create new face by applying all the parameters in the escape
-      ;; sequence
+      ;; Eliminate unrecognized ANSI sequences.
+      (while (string-match ansi-color-drop-regexp colorized-substring)
+       (setq colorized-substring
+             (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)))
     ;; if the rest of the string should have a face, put it there
     (when face
       (setq face (ansi-color-apply-sequence escape-sequence face)))
     ;; 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))
+      (put-text-property start (length string) 'font-lock-face face string))
     ;; save context, add the remainder of the string to the result
     (let (fragment)
       (if (string-match "\033" string start)
          (let ((pos (match-beginning 0)))
     ;; save context, add the remainder of the string to the result
     (let (fragment)
       (if (string-match "\033" string start)
          (let ((pos (match-beginning 0)))
-           (setq fragment (substring string pos)
-                 result (concat result (substring string start pos))))
-       (setq result (concat result (substring string start))))
-      (if (or face fragment)
-         (setq ansi-color-context (list face fragment))
-       (setq ansi-color-context nil)))
-    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))))
+    (apply 'concat (nreverse result))))
 
 ;; Working with regions
 
 
 ;; Working with regions
 
@@ -361,7 +327,7 @@ position processed.")
 (make-variable-buffer-local 'ansi-color-context-region)
 
 (defun ansi-color-filter-region (begin end)
 (make-variable-buffer-local 'ansi-color-context-region)
 
 (defun ansi-color-filter-region (begin end)
-  "Filter out all SGR control sequences from region BEGIN to END.
+  "Filter out all ANSI control sequences from region BEGIN to END.
 
 Every call to this function will set and use the buffer-local variable
 `ansi-color-context-region' to save position.  This information will be
 
 Every call to this function will set and use the buffer-local variable
 `ansi-color-context-region' to save position.  This information will be
@@ -372,23 +338,27 @@ it will override BEGIN, the start of the region.  Set
        (start (or (cadr ansi-color-context-region) begin)))
     (save-excursion
       (goto-char start)
        (start (or (cadr ansi-color-context-region) begin)))
     (save-excursion
       (goto-char start)
-      ;; find the next escape sequence
+      ;; Delete unrecognized escape sequences.
+      (while (re-search-forward ansi-color-drop-regexp end-marker t)
+        (replace-match ""))
+      (goto-char start)
+      ;; Delete SGR escape sequences.
       (while (re-search-forward ansi-color-regexp end-marker t)
       (while (re-search-forward ansi-color-regexp end-marker t)
-       ;; delete the escape sequence
         (replace-match ""))
         (replace-match ""))
-    ;; save context, add the remainder of the string to the result
-    (if (re-search-forward "\033" end-marker t)
-       (setq ansi-color-context-region (list nil (match-beginning 0)))
-      (setq ansi-color-context-region nil)))))
+      ;; save context, add the remainder of the string to the result
+      (if (re-search-forward "\033" end-marker t)
+         (setq ansi-color-context-region (list nil (match-beginning 0)))
+       (setq ansi-color-context-region nil)))))
 
 (defun ansi-color-apply-on-region (begin end)
   "Translates SGR control sequences into overlays or extents.
 
 (defun ansi-color-apply-on-region (begin end)
   "Translates SGR control sequences into overlays or extents.
+Delete all other control sequences without processing them.
 
 
-Applies SGR control sequences setting foreground and background colors
-to text in region between BEGIN and END using extents or overlays.
-Emacs will use overlays, XEmacs will use extents.  The colors used are
-given in `ansi-color-faces-vector' and `ansi-color-names-vector'.  See
-function `ansi-color-apply-sequence' for details.
+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
 
 Every call to this function will set and use the buffer-local variable
 `ansi-color-context-region' to save position and current face.  This
@@ -401,15 +371,19 @@ start of the region and set the face with which to start.  Set
                          (copy-marker begin)))
        (end-marker (copy-marker end))
        escape-sequence)
                          (copy-marker begin)))
        (end-marker (copy-marker end))
        escape-sequence)
+    ;; First, eliminate unrecognized ANSI control sequences.
+    (save-excursion
+      (goto-char start-marker)
+      (while (re-search-forward ansi-color-drop-regexp end-marker t)
+       (replace-match "")))
     (save-excursion
       (goto-char start-marker)
     (save-excursion
       (goto-char start-marker)
-      ;; find the next escape sequence
+      ;; Find the next SGR sequence.
       (while (re-search-forward ansi-color-regexp end-marker t)
       (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))
+       ;; Colorize the old block from start to end using old face.
+       (funcall ansi-color-apply-face-function
+                start-marker (match-beginning 0)
+                face)
         ;; store escape sequence and new start position
         (setq escape-sequence (match-string 1)
              start-marker (copy-marker (match-end 0)))
         ;; store escape sequence and new start position
         (setq escape-sequence (match-string 1)
              start-marker (copy-marker (match-end 0)))
@@ -422,25 +396,26 @@ start of the region and set the face with which to start.  Set
       (if (re-search-forward "\033" end-marker t)
          (progn
            ;; if the rest of the region should have a face, put it there
       (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))
+           (funcall ansi-color-apply-face-function
+                    start-marker (point) face)
            ;; save face and point
            (setq ansi-color-context-region
                  (list face (copy-marker (match-beginning 0)))))
        ;; if the rest of the region should have a face, put it there
            ;; save face and point
            (setq ansi-color-context-region
                  (list face (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 face)
+       (setq ansi-color-context-region (if face (list face)))))))
+
+(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
@@ -565,7 +540,8 @@ The face definitions are based upon the variables
     (mapc
      (function (lambda (e)
                  (aset ansi-color-map index
     (mapc
      (function (lambda (e)
                  (aset ansi-color-map index
-                      (ansi-color-make-face 'foreground e))
+                      (ansi-color-make-face 'foreground
+                                             (if (consp e) (car e) e)))
                  (setq index (1+ index)) ))
      ansi-color-names-vector)
     ;; background attributes
                  (setq index (1+ index)) ))
      ansi-color-names-vector)
     ;; background attributes
@@ -573,7 +549,8 @@ The face definitions are based upon the variables
     (mapc
      (function (lambda (e)
                  (aset ansi-color-map index
     (mapc
      (function (lambda (e)
                  (aset ansi-color-map index
-                      (ansi-color-make-face 'background e))
+                      (ansi-color-make-face 'background
+                                             (if (consp e) (cdr e) e)))
                  (setq index (1+ index)) ))
      ansi-color-names-vector)
     ansi-color-map))
                  (setq index (1+ index)) ))
      ansi-color-names-vector)
     ansi-color-map))
@@ -610,7 +587,7 @@ ANSI-CODE is used as an index into the vector."
   "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
   "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.
+the parameter 0), then the effect of all previous parameters is canceled.
 
 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."
 
 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."
@@ -630,5 +607,4 @@ ESCAPE-SEQ is a SGR control sequences such as \\033[34m.  The parameter
 
 (provide 'ansi-color)
 
 
 (provide 'ansi-color)
 
-;; arch-tag: 00726118-9432-44fd-b72d-d2af7591c99c
 ;;; ansi-color.el ends here
 ;;; ansi-color.el ends here