2 files changed, 361 insertions, 99 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 42df38b4ba1..315958d693e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -2,6 +2,27 @@
 
         * indent.el (indent-for-tab-command): Doc fix.
 
+2000-09-14  Alex Schroeder  <alex@gnu.org>
+
+        * ansi-color.el (ansi-colors): Doc change.
+        (ansi-color-get-face): Simplified regexp.
+        (ansi-color-faces-vector): Added more faces, doc change.
+        (ansi-color-names-vector): Doc change.
+        (ansi-color-regexp): Simplified regexp.
+        (ansi-color-parameter-regexp): New regexp.
+        (ansi-color-filter-apply): Doc change.
+        (ansi-color-filter-region): Doc change.
+        (ansi-color-apply): Use ansi-color-regexp and ansi-color-get-face,
+        deal with zero length parameters.
+        (ansi-color-apply-on-region): Doc change.
+        (ansi-color-map): Doc change.
+        (ansi-color-map-update): Removed debugging message.
+        (ansi-color-get-face-1): Added condition-case to trap
+        args-out-of-range errors.
+        (ansi-color-get-face): Doc change.
+        (ansi-color-make-face): Removed.
+        (ansi-color-for-shell-mode): New option.
+        
 2000-09-13  Kenichi Handa  <handa@etl.go.jp>
 
         * international/quail.el (quail-start-translation): Translate KEY
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 746038e32dc..ca07b0f8ea5 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -1,10 +1,10 @@
-;;; ansi-color.el -- translate ANSI into text-properties
+;;; ansi-color.el --- translate ANSI into text-properties
 
-;; Copyright (C) 1999  Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000  Free Software Foundation, Inc.
 
 ;; Author: Alex Schroeder <alex@gnu.org>
 ;; Maintainer: Alex Schroeder <alex@gnu.org>
-;; Version: 2.1.2
+;; Version: 2.4.0
 ;; Keywords: comm processes
 
 ;; This file is part of GNU Emacs.
@@ -26,53 +26,49 @@
 
 ;;; Commentary:
 
-;; You can get the latest version of this file from my homepage
-;; <URL:http://www.geocities.com/TimesSquare/6120/emacs.html>.
+;; This file provides a function that takes a string containing Select
+;; Graphic Rendition (SGR) control sequences (formerly known as ANSI
+;; escape sequences) and tries to replace these with text-properties.
 ;;
-;; This file provides a function that takes a string containing ANSI
-;; control sequences and tries to replace these with text-properties.
+;; This allows you to run ls --color=yes in shell-mode: If
+;; `ansi-color-for-shell-mode' is non-nil, the SGR control sequences are
+;; translated into text-properties, colorizing the ls output.  If
+;; `ansi-color-for-shell-mode' is nil, the SGR control sequences are
+;; stripped, making the ls output legible.
 ;;
-;; I was unable to extract this functionality from term.el for another
-;; program I wanted to extend (the MUSH client TinyTalk.el), so I had to
-;; rewrite this.
+;; 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).
 
-;;; Testing:
-
-;; If you want to test the setup, evaluate the following fragment in a
-;; buffer without font-lock-mode.  This doesn't work in buffers that
-;; have font-lock-mode!
+;; The basic functions are:
+;;
+;; `ansi-color-apply' to colorize a string containing SGR control
+;; sequences.
+;;
+;; `ansi-color-filter-apply' to filter SGR control sequences from a
+;; string.
 ;;
-;; (insert (ansi-color-apply "\033[1mbold\033[0m and \033[34mblue\033[0m, \033[1m\033[34mbold and blue\033[0m!!"))
+;; `ansi-color-apply-on-region' to colorize a region containing SGR
+;; control sequences.
+;;
+;; `ansi-color-filter-region' to filter SGR control sequences from a
+;; region.
+
+;; Instead of defining lots of new faces, this package uses
+;; text-properties as described in the elisp manual
+;; *Note (elisp)Special Properties::.
 
-;; Usage with TinyMush.el:
+;;; Thanks
 
-;; In order to install this with TinyMush.el, add the following to your
-;; .emacs file:
+;; Georges Brun-Cottan <gbruncot@emc.com> for improving ansi-color.el
+;; substantially by adding the code needed to cope with arbitrary chunks
+;; of output and the filter functions.
 ;;
-;; (setq tinymud-filter-line-hook 'my-ansi-color-filter)
-;; (autoload 'ansi-color-apply "ansi-color" 
-;;   "Translates ANSI color control sequences into text-properties." t)
-;; (defun my-ansi-color-filter (conn line)
-;;   "Call `ansi-color-apply' and then processes things like `filter-line'."
-;;   (setq line (ansi-color-apply line))
-;;   (if (not (get-value conn 'trigger-disable))
-;;       (progn
-;;      (check-triggers conn line
-;;                      (get-value conn 'triggers))
-;;      (check-triggers conn line
-;;                      (get-value (get-value conn 'world) 'triggers))
-;;      (check-triggers conn line
-;;                      tinymud-global-triggers)))
-;;   (display-line conn line)
-;;   t)
-
-;; Usage with shell-mode:
-
-;; In order to enjoy the marvels of "ls --color=tty" you will have to
-;; enter shell-mode using M-x shell, possibly disable font-lock-mode
-;; using M-: (font-lock-mode 0), and add ansi-color-apply to
-;; comint-preoutput-filter-functions using M-: (add-hook
-;; 'comint-preoutput-filter-functions 'ansi-color-apply).
+;; Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk> for pointing me to ECMA-48.
 
 
 
@@ -80,86 +76,331 @@
 
 ;; Customization
 
-(defvar ansi-color-faces-vector
-  [default bold  default default underline bold  default modeline]
-  "Faces used for ANSI control sequences determining a face.
+(defgroup ansi-colors nil
+  "Translating SGR control sequences to text-properties.
+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>."
+  :version "20.7"
+  :group 'processes)
+
+(defcustom ansi-color-faces-vector
+  [default bold default italic underline bold bold-italic modeline]
+  "Faces used for SGR control sequences determining a face.
+This vector holds the faces used for SGR control sequence parameters 0
+to 7.
 
-Those are sequences like this one: \033[1m, where 1 could be one of the
-following numbers: 0 (default), 1 (hilight, rendered as bold), 4
-(underline), 5 (flashing, rendered as bold), 7 (inverse, rendered the
-same as the modeline)")
+Parameter  Description        Face used by default
+  0        default            default
+  1        bold               bold
+  2        faint              default
+  3        italic             italic
+  4        underlined         underline
+  5        slowly blinking    bold
+  6        rapidly blinking   bold-italic
+  7        negative image     modeline
 
-(defvar ansi-color-names-vector
+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 face face face face face face face face)
+  :set 'ansi-color-map-update
+  :initialize 'custom-initialize-default
+  :group 'ansi-colors)
+
+(defcustom ansi-color-names-vector
   ["black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"]
-  "Array of colors.
+  "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).
+
+Parameter  Color
+  30  40   black
+  31  41   red
+  32  42   green
+  33  43   yellow
+  34  44   blue
+  35  45   magenta
+  36  46   cyan
+  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)
+  :set 'ansi-color-map-update
+  :initialize 'custom-initialize-default
+  :group 'ansi-colors)
+
+(defcustom ansi-color-for-shell-mode nil
+  "Determine wether font-lock or ansi-color get to fontify shell buffers.
+
+If non-nil and `global-font-lock-mode' is non-nil, ansi-color will be
+used.  This adds `ansi-color-apply' to
+`comint-preoutput-filter-functions' and removes
+`ansi-color-filter-apply' for all shell-mode buffers.
+
+If non-nil and global-font-lock-mode is nil, both `ansi-color-apply' and
+`ansi-color-filter-apply' will be removed from
+`comint-preoutput-filter-functions' for all shell-mode buffers.
+
+If nil, font-lock will be used (if it is enabled).  This adds
+`ansi-color-filter-apply' to `comint-preoutput-filter-functions' and
+removes `ansi-color-apply' for all shell-mode buffers."
+  :version "20.8"
+  :type 'boolean
+  :set (function (lambda (symbol value)
+                   (set-default symbol value)
+                   (save-excursion
+                     (let ((buffers (buffer-list))
+                           buffer)
+                       (while buffers
+                         (setq buffer (car buffers)
+                               buffers (cdr buffers))
+                         (set-buffer buffer)
+                         (when (eq major-mode 'shell-mode)
+                           (if value
+                               (if global-font-lock-mode
+                                   (progn
+                                     (font-lock-mode 0)
+                                     (remove-hook 'comint-preoutput-filter-functions 
+                                                  'ansi-color-filter-apply)
+                                     (add-hook 'comint-preoutput-filter-functions 
+                                               'ansi-color-apply))
+                                 (remove-hook 'comint-preoutput-filter-functions 
+                                              'ansi-color-filter-apply)
+                                 (remove-hook 'comint-preoutput-filter-functions 
+                                              'ansi-color-apply))
+                             (if global-font-lock-mode
+                                 (font-lock-mode 1))
+                             (remove-hook 'comint-preoutput-filter-functions 
+                                          'ansi-color-apply)
+                             (add-hook 'comint-preoutput-filter-functions 
+                                       'ansi-color-filter-apply))))))))
+  :initialize 'custom-initialize-reset
+  :group 'ansi-colors)
+
+(defconst ansi-color-regexp "\033\\[\\([0-9;]*\\)m"
+  "Regexp that matches SGR control sequences.")
+
+(defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"
+  "Regexp that matches SGR control sequence parameters.")
+
+
+;; Main functions
+
+
+(defun ansi-color-filter-apply (s)
+  "Filter out all SGR control sequences from S.
+
+This function can be added to `comint-preoutput-filter-functions'."
+  (while (string-match ansi-color-regexp s)
+    (setq s (replace-match "" t t s)))
+  s)
+
+
+(defun ansi-color-filter-region (begin end)
+  "Filter out all SGR control sequences from region START END.
 
-Used for sequences like this one: \033[31m, where 1 could be an index to a
-foreground color (red, in this case), or \033[41m, where 1 could be an
-index to a background color.
+Returns the first point it is safe to start with.  Used to speedup
+further processing.
 
-The default colors are: black, red, green, yellow, blue, magenta,
-cyan, and white.
+Design to cope with arbitrary chunk of output such as the ones get by
+comint-output-filter-functions, e.g.:
 
-On a light background, I prefer: black, red, dark green, orange, blue,
-magenta, turquoise, snow4")
+\(defvar last-context nil)
+\(make-variable-buffer-local 'last-context)
+
+\(defun filter-out-color-in-buffer (s)
+  \(setq last-context
+        \(ansi-color-filter-region
+         \(if last-context
+             last-context
+           \(if (marker-position comint-last-output-start)
+               \(marker-position comint-last-output-start)
+             1))
+         \(marker-position (process-mark (get-buffer-process (current-buffer)))) ))
+  s)
+
+\(add-hook 'comint-output-filter-functions 'filter-out-color-in-buffer)
+"
+  (let ((endm (copy-marker end)))
+    (save-excursion
+      (goto-char begin)
+      (while (re-search-forward ansi-color-regexp endm t)
+        (replace-match ""))
+      (if (re-search-forward "\033" endm t)
+          (match-beginning 0)
+        (marker-position endm)))))
 
-;; Main function
 
 (defun ansi-color-apply (string)
-  "Translates ANSI color control sequences into text-properties.
+  "Translates SGR control sequences into text-properties.
 
-Applies ANSI control sequences setting foreground and background colors
+Applies SGR control sequences setting foreground and background colors
 to STRING and returns the result.  The colors used are given in
 `ansi-color-faces-vector' and `ansi-color-names-vector'.
 
 This function can be added to `comint-preoutput-filter-functions'."
-  (let ((face)
-        (start 0) (end) (escape)
-        (result)
-        (params))
+  (let (face (start 0) end escape-sequence null-sequence result)
     ;; find the next escape sequence
-    (while (setq end (string-match "\033\\[\\([013457][01234567]?;\\)*[013457][01234567]?m" string start))
+    (while (setq end (string-match ansi-color-regexp string start))
       ;; store escape sequence
-      (setq escape (match-string 0 string))
+      (setq escape-sequence (match-string 1 string)
+            null-sequence (string-equal escape-sequence ""))
       ;; colorize the old block from start to end using old face
       (if face
           (put-text-property start end 'face face string))
-      (setq result (concat result (substring string start end)))
+      (setq result (concat result (substring string start end))
+            start (match-end 0))
       ;; create new face by applying all the parameters in the escape sequence
-      (let ((i 0))
-        (while (setq i (string-match "[013457][01234567]?[;m]" escape i))
-          (setq face (ansi-color-make-face face
-                                           (aref escape i)
-                                           (aref escape (1+ i))))
-          (setq i (match-end 0))))
-      (setq start (+ end (length escape))))
+      (if null-sequence
+          (setq face nil)
+        (setq face (ansi-color-get-face escape-sequence))))
     (concat result (substring string start))))
 
+
+(defun ansi-color-apply-on-region (begin end &optional context)
+  "Translates SGR control sequences into text-properties.
+
+Applies SGR control sequences setting foreground and background colors
+to text in region. The colors used are given in
+`ansi-color-faces-vector' and `ansi-color-names-vector'.
+Returns a context than can be used to speedup further processing.
+Context is a (begin (start . face)) list.
+
+Design to cope with arbitrary chunk of output such as the ones get by
+comint-output-filter-functions, e.g.:
+
+\(defvar last-context nil)
+\(make-variable-buffer-local 'last-context)
+
+\(defun ansi-output-filter (s)
+  \(setq last-context
+        \(ansi-color-apply-on-region
+         \(if last-context
+             \(car last-context)
+           \(if (marker-position comint-last-output-start)
+               \(marker-position comint-last-output-start)
+             1))
+         \(process-mark (get-buffer-process (current-buffer)))
+         last-context ))
+  s)
+
+\(add-hook 'comint-output-filter-functions 'ansi-output-filter)
+"
+  (let ((endm (copy-marker end))
+        (face (if (and context (cdr context))
+                  (cdr (cdr context))))
+        (face-start (if (and context (cdr context))
+                        (car (cdr context))))
+        (next-safe-start begin)
+        escape-sequence
+        null-sequence
+        stop )
+    (save-excursion
+      (goto-char begin)
+      ;; find the next escape sequence
+      (while (setq stop (re-search-forward ansi-color-regexp endm t))
+        ;; store escape sequence
+        (setq escape-sequence (match-string 1))
+        (setq null-sequence (string-equal (match-string 1) ""))
+        (setq next-safe-start (match-beginning 0))
+        (if face
+            (put-text-property face-start next-safe-start 'face face)) ; colorize
+        (replace-match "") ; delete the ANSI sequence
+        (if null-sequence
+            (setq face nil)
+          (setq face-start next-safe-start)
+          (setq face (ansi-color-get-face escape-sequence))))
+      (setq next-safe-start
+            (if (re-search-forward "\033" endm t)
+                (match-beginning 0)
+              (marker-position endm))))
+    (cons next-safe-start
+          (if face
+              (cons face-start face))) ))
+
 ;; Helper functions
 
-(defun ansi-color-make-face (face param1 param2)
-  "Return a face based on FACE and characters PARAM1 and PARAM2.
-
-The face can be used in a call to `add-text-properties'.  The PARAM1 and
-PARAM2 characters are the two numeric characters in ANSI control
-sequences between ?[ and ?m.  Unless the ANSI control sequence specifies
-a return to default face using PARAM1 ?0 and PARAM2 ?m (ie. \"\033[0m\"), the
-properties specified by PARAM1 and PARAM2 are added to face."
-  (cond ((= param1 ?0)
-         nil)
-        ((= param2 ?m)
-         (add-to-list 'face (aref ansi-color-faces-vector
-                                  (string-to-number (char-to-string param1)))))
-        ((= param1 ?3)
-         (add-to-list 'face (cons 'foreground-color
-                                  (aref ansi-color-names-vector
-                                        (string-to-number (char-to-string param2))))))
-        ((= param1 ?4)
-         (add-to-list 'face (cons 'background-color
-                                  (aref ansi-color-names-vector
-                                        (string-to-number (char-to-string param2))))))
-        (t (add-to-list 'face (aref ansi-color-faces-vector
-                                  (string-to-number (char-to-string param1)))))))
+(defun ansi-color-make-color-map ()
+  "Creates a vector of face definitions and returns it.
+
+The index into the vector is an ANSI code.  See the documentation of
+`ansi-color-map' for an example.
+
+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))
+        (index 0))
+    ;; miscellaneous attributes
+    (mapcar
+     (function (lambda (e)
+                 (aset ansi-color-map index e)
+                 (setq index (1+ index)) ))
+     ansi-color-faces-vector)
+
+    ;; foreground attributes
+    (setq index 30)
+    (mapcar
+     (function (lambda (e)
+                 (aset ansi-color-map index
+                       (cons 'foreground-color e))
+                 (setq index (1+ index)) ))
+     ansi-color-names-vector)
+
+    ;; background attributes
+    (setq index 40)
+    (mapcar
+     (function (lambda (e)
+                 (aset ansi-color-map index
+                       (cons 'background-color e))
+                 (setq index (1+ index)) ))
+     ansi-color-names-vector)
+    ansi-color-map))
+
+(defvar ansi-color-map (ansi-color-make-color-map)
+  "A brand new color map suitable for ansi-color-get-face.
+
+The value of this variable is usually constructed by
+`ansi-color-make-color-map'.  The values in the array are such that the
+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:
+     (aref ansi-color-map 34)
+          => \(foreground-color . \"blue\")")
+
+(defun ansi-color-map-update (symbol value)
+  "Update `ansi-color-map'.
+
+Whenever the vectors used to construct `ansi-color-map' are changed,
+this function is called.  Therefore this function is listed as the :set
+property of `ansi-color-faces-vector' and `ansi-color-names-vector'."
+  (set-default symbol value)
+  (setq ansi-color-map (ansi-color-make-color-map)))
+
+(defun ansi-color-get-face-1 (ansi-code)
+  "Get face definition from `ansi-color-map'.
+ANSI-CODE is used as an index into the vector."
+  (condition-case 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.
+
+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 ((ansi-color-r "[0-9][0-9]?")
+        (i 0)
+        f)
+    (while (string-match ansi-color-r escape-seq i)
+      (setq i (match-end 0))
+      (add-to-list 'f
+                   (ansi-color-get-face-1
+                    (string-to-int (match-string 0 escape-seq) 10))))
+    f))
 
 (provide 'ansi-color)