-;;; ansi-color.el -- translate ANSI into text-properties
-
-;; Copyright (C) 1999 Free Software Foundation, Inc.
-
-;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: Alex Schroeder <alex@gnu.org>
-;; Version: 2.1.2
-;; Keywords: comm processes
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by the
-;; Free Software Foundation; either version 2, or (at your option) any
-;; later version.
-;;
-;; GNU Emacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; 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 ANSI
-;; control sequences and tries to replace these with text-properties.
-;;
-;; 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.
-
-;;; 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!
-;;
-;; (insert (ansi-color-apply "\033[1mbold\033[0m and \033[34mblue\033[0m, \033[1m\033[34mbold and blue\033[0m!!"))
-
-;; Usage with TinyMush.el:
-
-;; In order to install this with TinyMush.el, add the following to your
-;; .emacs file:
-;;
-;; (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).
-
-\f
-
-;;; Code:
-
-;; Customization
-
-(defvar ansi-color-faces-vector
- [default bold default default underline bold default modeline]
- "Faces used for ANSI control sequences determining a face.
-
-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)")
-
-(defvar ansi-color-names-vector
- ["black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"]
- "Array of colors.
-
-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.
-
-The default colors are: black, red, green, yellow, blue, magenta,
-cyan, and white.
-
-On a light background, I prefer: black, red, dark green, orange, blue,
-magenta, turquoise, snow4")
-
-;; Main function
-
-(defun ansi-color-apply (string)
- "Translates ANSI color control sequences into text-properties.
-
-Applies ANSI 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))
- ;; find the next escape sequence
- (while (setq end (string-match "\033\\[\\([013457][01234567]?;\\)*[013457][01234567]?m" string start))
- ;; store escape sequence
- (setq escape (match-string 0 string))
- ;; 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)))
- ;; 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))))
- (concat result (substring string start))))
-
-;; 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)))))))
-
-(provide 'ansi-color)
-
-;;; ansi-color.el ends here
+;;; ansi-color.el --- translate ANSI into text-properties
+
+;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+
+;; Author: Alex Schroeder <alex@gnu.org>
+;; Maintainer: Alex Schroeder <alex@gnu.org>
+;; Version: 2.4.0
+;; Keywords: comm processes
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by the
+;; Free Software Foundation; either version 2, or (at your option) any
+;; later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; 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 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.
+;;
+;; 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).
+
+;; 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.
+;;
+;; `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::.
+
+;;; Thanks
+
+;; 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.
+;;
+;; Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk> for pointing me to ECMA-48.
+
+\f
+
+;;; Code:
+
+;; Customization
+
+(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.
+
+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
+
+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"]
+ "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.
+
+Returns the first point it is safe to start with. Used to speedup
+further processing.
+
+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 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)))))
+
+
+(defun ansi-color-apply (string)
+ "Translates SGR control sequences into text-properties.
+
+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-sequence null-sequence result)
+ ;; find the next escape sequence
+ (while (setq end (string-match ansi-color-regexp string start))
+ ;; store escape sequence
+ (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))
+ start (match-end 0))
+ ;; create new face by applying all the parameters in the escape sequence
+ (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-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)
+
+;;; ansi-color.el ends here
HCoop / bpt / emacs.git / commitdiff