lisp/ansi-color.el

   1 ;;; ansi-color.el --- translate ANSI into text-properties
   2
   3 ;; Copyright (C) 1999, 2000  Free Software Foundation, Inc.
   4
   5 ;; Author: Alex Schroeder <alex@gnu.org>
   6 ;; Maintainer: Alex Schroeder <alex@gnu.org>
   7 ;; Version: 2.4.0
   8 ;; Keywords: comm processes
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by the
  14 ;; Free Software Foundation; either version 2, or (at your option) any
  15 ;; later version.
  16 ;;
  17 ;; GNU Emacs is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; This file provides a function that takes a string containing Select
  30 ;; Graphic Rendition (SGR) control sequences (formerly known as ANSI
  31 ;; escape sequences) and tries to replace these with text-properties.
  32 ;;
  33 ;; This allows you to run ls --color=yes in shell-mode: If
  34 ;; `ansi-color-for-shell-mode' is non-nil, the SGR control sequences are
  35 ;; translated into text-properties, colorizing the ls output.  If
  36 ;; `ansi-color-for-shell-mode' is nil, the SGR control sequences are
  37 ;; stripped, making the ls output legible.
  38 ;;
  39 ;; SGR control sequences are defined in section 3.8.117 of the ECMA-48
  40 ;; standard (identical to ISO/IEC 6429), which is freely available as a
  41 ;; PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>.  The
  42 ;; "Graphic Rendition Combination Mode (GRCM)" implemented is
  43 ;; "cumulative mode" as defined in section 7.2.8.  Cumulative mode means
  44 ;; that whenever possible, SGR control sequences are combined (ie. blue
  45 ;; and bold).
  46
  47 ;; The basic functions are:
  48 ;;
  49 ;; `ansi-color-apply' to colorize a string containing SGR control
  50 ;; sequences.
  51 ;;
  52 ;; `ansi-color-filter-apply' to filter SGR control sequences from a
  53 ;; string.
  54 ;;
  55 ;; `ansi-color-apply-on-region' to colorize a region containing SGR
  56 ;; control sequences.
  57 ;;
  58 ;; `ansi-color-filter-region' to filter SGR control sequences from a
  59 ;; region.
  60
  61 ;; Instead of defining lots of new faces, this package uses
  62 ;; text-properties as described in the elisp manual
  63 ;; *Note (elisp)Special Properties::.
  64
  65 ;;; Thanks
  66
  67 ;; Georges Brun-Cottan <gbruncot@emc.com> for improving ansi-color.el
  68 ;; substantially by adding the code needed to cope with arbitrary chunks
  69 ;; of output and the filter functions.
  70 ;;
  71 ;; Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk> for pointing me to ECMA-48.
  72
  73 \f
  74
  75 ;;; Code:
  76
  77 ;; Customization
  78
  79 (defgroup ansi-colors nil
  80   "Translating SGR control sequences to text-properties.
  81 This translation effectively colorizes strings and regions based upon
  82 SGR control sequences embedded in the text.  SGR (Select Graphic
  83 Rendition) control sequences are defined in section 3.8.117 of the
  84 ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available
  85 as a PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>."
  86   :version "20.7"
  87   :group 'processes)
  88
  89 (defcustom ansi-color-faces-vector
  90   [default bold default italic underline bold bold-italic modeline]
  91   "Faces used for SGR control sequences determining a face.
  92 This vector holds the faces used for SGR control sequence parameters 0
  93 to 7.
  94
  95 Parameter  Description        Face used by default
  96   0        default            default
  97   1        bold               bold
  98   2        faint              default
  99   3        italic             italic
 100   4        underlined         underline
 101   5        slowly blinking    bold
 102   6        rapidly blinking   bold-italic
 103   7        negative image     modeline
 104
 105 This vector is used by `ansi-color-make-color-map' to create a color
 106 map.  This color map is stored in the variable `ansi-color-map'."
 107   :type '(vector face face face face face face face face)
 108   :set 'ansi-color-map-update
 109   :initialize 'custom-initialize-default
 110   :group 'ansi-colors)
 111
 112 (defcustom ansi-color-names-vector
 113   ["black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"]
 114   "Colors used for SGR control sequences determining a color.
 115 This vector holds the colors used for SGR control sequences parameters
 116 30 to 37 \(foreground colors) and 40 to 47 (background colors).
 117
 118 Parameter  Color
 119   30  40   black
 120   31  41   red
 121   32  42   green
 122   33  43   yellow
 123   34  44   blue
 124   35  45   magenta
 125   36  46   cyan
 126   37  47   white
 127
 128 This vector is used by `ansi-color-make-color-map' to create a color
 129 map.  This color map is stored in the variable `ansi-color-map'."
 130   :type '(vector string string string string string string string string)
 131   :set 'ansi-color-map-update
 132   :initialize 'custom-initialize-default
 133   :group 'ansi-colors)
 134
 135 (defcustom ansi-color-for-shell-mode nil
 136   "Determine wether font-lock or ansi-color get to fontify shell buffers.
 137
 138 If non-nil and `global-font-lock-mode' is non-nil, ansi-color will be
 139 used.  This adds `ansi-color-apply' to
 140 `comint-preoutput-filter-functions' and removes
 141 `ansi-color-filter-apply' for all shell-mode buffers.
 142
 143 If non-nil and global-font-lock-mode is nil, both `ansi-color-apply' and
 144 `ansi-color-filter-apply' will be removed from
 145 `comint-preoutput-filter-functions' for all shell-mode buffers.
 146
 147 If nil, font-lock will be used (if it is enabled).  This adds
 148 `ansi-color-filter-apply' to `comint-preoutput-filter-functions' and
 149 removes `ansi-color-apply' for all shell-mode buffers."
 150   :version "20.8"
 151   :type 'boolean
 152   :set (function (lambda (symbol value)
 153                    (set-default symbol value)
 154                    (save-excursion
 155                      (let ((buffers (buffer-list))
 156                            buffer)
 157                        (while buffers
 158                          (setq buffer (car buffers)
 159                                buffers (cdr buffers))
 160                          (set-buffer buffer)
 161                          (when (eq major-mode 'shell-mode)
 162                            (if value
 163                                (if global-font-lock-mode
 164                                    (progn
 165                                      (font-lock-mode 0)
 166                                      (remove-hook 'comint-preoutput-filter-functions
 167                                                   'ansi-color-filter-apply)
 168                                      (add-hook 'comint-preoutput-filter-functions
 169                                                'ansi-color-apply))
 170                                  (remove-hook 'comint-preoutput-filter-functions
 171                                               'ansi-color-filter-apply)
 172                                  (remove-hook 'comint-preoutput-filter-functions
 173                                               'ansi-color-apply))
 174                              (if global-font-lock-mode
 175                                  (font-lock-mode 1))
 176                              (remove-hook 'comint-preoutput-filter-functions
 177                                           'ansi-color-apply)
 178                              (add-hook 'comint-preoutput-filter-functions
 179                                        'ansi-color-filter-apply))))))))
 180   :initialize 'custom-initialize-reset
 181   :group 'ansi-colors)
 182
 183 (defconst ansi-color-regexp "\033\\[\\([0-9;]*\\)m"
 184   "Regexp that matches SGR control sequences.")
 185
 186 (defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"
 187   "Regexp that matches SGR control sequence parameters.")
 188
 189
 190 ;; Main functions
 191
 192
 193 (defun ansi-color-filter-apply (s)
 194   "Filter out all SGR control sequences from S.
 195
 196 This function can be added to `comint-preoutput-filter-functions'."
 197   (while (string-match ansi-color-regexp s)
 198     (setq s (replace-match "" t t s)))
 199   s)
 200
 201
 202 (defun ansi-color-filter-region (begin end)
 203   "Filter out all SGR control sequences from region START END.
 204
 205 Returns the first point it is safe to start with.  Used to speedup
 206 further processing.
 207
 208 Design to cope with arbitrary chunk of output such as the ones get by
 209 comint-output-filter-functions, e.g.:
 210
 211 \(defvar last-context nil)
 212 \(make-variable-buffer-local 'last-context)
 213
 214 \(defun filter-out-color-in-buffer (s)
 215   \(setq last-context
 216         \(ansi-color-filter-region
 217          \(if last-context
 218              last-context
 219            \(if (marker-position comint-last-output-start)
 220                \(marker-position comint-last-output-start)
 221              1))
 222          \(marker-position (process-mark (get-buffer-process (current-buffer)))) ))
 223   s)
 224
 225 \(add-hook 'comint-output-filter-functions 'filter-out-color-in-buffer)
 226 "
 227   (let ((endm (copy-marker end)))
 228     (save-excursion
 229       (goto-char begin)
 230       (while (re-search-forward ansi-color-regexp endm t)
 231         (replace-match ""))
 232       (if (re-search-forward "\033" endm t)
 233           (match-beginning 0)
 234         (marker-position endm)))))
 235
 236
 237 (defun ansi-color-apply (string)
 238   "Translates SGR control sequences into text-properties.
 239
 240 Applies SGR control sequences setting foreground and background colors
 241 to STRING and returns the result.  The colors used are given in
 242 `ansi-color-faces-vector' and `ansi-color-names-vector'.
 243
 244 This function can be added to `comint-preoutput-filter-functions'."
 245   (let (face (start 0) end escape-sequence null-sequence result)
 246     ;; find the next escape sequence
 247     (while (setq end (string-match ansi-color-regexp string start))
 248       ;; store escape sequence
 249       (setq escape-sequence (match-string 1 string)
 250             null-sequence (string-equal escape-sequence ""))
 251       ;; colorize the old block from start to end using old face
 252       (if face
 253           (put-text-property start end 'face face string))
 254       (setq result (concat result (substring string start end))
 255             start (match-end 0))
 256       ;; create new face by applying all the parameters in the escape sequence
 257       (if null-sequence
 258           (setq face nil)
 259         (setq face (ansi-color-get-face escape-sequence))))
 260     (concat result (substring string start))))
 261
 262
 263 (defun ansi-color-apply-on-region (begin end &optional context)
 264   "Translates SGR control sequences into text-properties.
 265
 266 Applies SGR control sequences setting foreground and background colors
 267 to text in region. The colors used are given in
 268 `ansi-color-faces-vector' and `ansi-color-names-vector'.
 269 Returns a context than can be used to speedup further processing.
 270 Context is a (begin (start . face)) list.
 271
 272 Design to cope with arbitrary chunk of output such as the ones get by
 273 comint-output-filter-functions, e.g.:
 274
 275 \(defvar last-context nil)
 276 \(make-variable-buffer-local 'last-context)
 277
 278 \(defun ansi-output-filter (s)
 279   \(setq last-context
 280         \(ansi-color-apply-on-region
 281          \(if last-context
 282              \(car last-context)
 283            \(if (marker-position comint-last-output-start)
 284                \(marker-position comint-last-output-start)
 285              1))
 286          \(process-mark (get-buffer-process (current-buffer)))
 287          last-context ))
 288   s)
 289
 290 \(add-hook 'comint-output-filter-functions 'ansi-output-filter)
 291 "
 292   (let ((endm (copy-marker end))
 293         (face (if (and context (cdr context))
 294                   (cdr (cdr context))))
 295         (face-start (if (and context (cdr context))
 296                         (car (cdr context))))
 297         (next-safe-start begin)
 298         escape-sequence
 299         null-sequence
 300         stop )
 301     (save-excursion
 302       (goto-char begin)
 303       ;; find the next escape sequence
 304       (while (setq stop (re-search-forward ansi-color-regexp endm t))
 305         ;; store escape sequence
 306         (setq escape-sequence (match-string 1))
 307         (setq null-sequence (string-equal (match-string 1) ""))
 308         (setq next-safe-start (match-beginning 0))
 309         (if face
 310             (put-text-property face-start next-safe-start 'face face)) ; colorize
 311         (replace-match "") ; delete the ANSI sequence
 312         (if null-sequence
 313             (setq face nil)
 314           (setq face-start next-safe-start)
 315           (setq face (ansi-color-get-face escape-sequence))))
 316       (setq next-safe-start
 317             (if (re-search-forward "\033" endm t)
 318                 (match-beginning 0)
 319               (marker-position endm))))
 320     (cons next-safe-start
 321           (if face
 322               (cons face-start face))) ))
 323
 324 ;; Helper functions
 325
 326 (defun ansi-color-make-color-map ()
 327   "Creates a vector of face definitions and returns it.
 328
 329 The index into the vector is an ANSI code.  See the documentation of
 330 `ansi-color-map' for an example.
 331
 332 The face definitions are based upon the variables
 333 `ansi-color-faces-vector' and `ansi-color-names-vector'."
 334   (let ((ansi-color-map (make-vector 50 nil))
 335         (index 0))
 336     ;; miscellaneous attributes
 337     (mapcar
 338      (function (lambda (e)
 339                  (aset ansi-color-map index e)
 340                  (setq index (1+ index)) ))
 341      ansi-color-faces-vector)
 342
 343     ;; foreground attributes
 344     (setq index 30)
 345     (mapcar
 346      (function (lambda (e)
 347                  (aset ansi-color-map index
 348                        (cons 'foreground-color e))
 349                  (setq index (1+ index)) ))
 350      ansi-color-names-vector)
 351
 352     ;; background attributes
 353     (setq index 40)
 354     (mapcar
 355      (function (lambda (e)
 356                  (aset ansi-color-map index
 357                        (cons 'background-color e))
 358                  (setq index (1+ index)) ))
 359      ansi-color-names-vector)
 360     ansi-color-map))
 361
 362 (defvar ansi-color-map (ansi-color-make-color-map)
 363   "A brand new color map suitable for ansi-color-get-face.
 364
 365 The value of this variable is usually constructed by
 366 `ansi-color-make-color-map'.  The values in the array are such that the
 367 numbers included in an SGR control sequences point to the correct
 368 foreground or background colors.
 369
 370 Example: The sequence \033[34m specifies a blue foreground.  Therefore:
 371      (aref ansi-color-map 34)
 372           => \(foreground-color . \"blue\")")
 373
 374 (defun ansi-color-map-update (symbol value)
 375   "Update `ansi-color-map'.
 376
 377 Whenever the vectors used to construct `ansi-color-map' are changed,
 378 this function is called.  Therefore this function is listed as the :set
 379 property of `ansi-color-faces-vector' and `ansi-color-names-vector'."
 380   (set-default symbol value)
 381   (setq ansi-color-map (ansi-color-make-color-map)))
 382
 383 (defun ansi-color-get-face-1 (ansi-code)
 384   "Get face definition from `ansi-color-map'.
 385 ANSI-CODE is used as an index into the vector."
 386   (condition-case nil
 387       (aref ansi-color-map ansi-code)
 388     ('args-out-of-range nil)))
 389
 390 (defun ansi-color-get-face (escape-seq)
 391   "Create a new face by applying all the parameters in ESCAPE-SEQ.
 392
 393 ESCAPE-SEQ is a SGR control sequences such as \033[34m.  The parameter
 394 34 is used by `ansi-color-get-face-1' to return a face definition."
 395   (let ((ansi-color-r "[0-9][0-9]?")
 396         (i 0)
 397         f)
 398     (while (string-match ansi-color-r escape-seq i)
 399       (setq i (match-end 0))
 400       (add-to-list 'f
 401                    (ansi-color-get-face-1
 402                     (string-to-int (match-string 0 escape-seq) 10))))
 403     f))
 404
 405 (provide 'ansi-color)
 406
 407 ;;; ansi-color.el ends here