# HG changeset patch # User Gerd Moellmann # Date 968935071 0 # Node ID 5ad18c4ebe5c4a0ca3c14b0862a76f5ad5d5679b # Parent f8ad701a4a5bf5b3bcc97a9b068ca6515eaea24a (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. diff -r f8ad701a4a5b -r 5ad18c4ebe5c lisp/ansi-color.el --- a/lisp/ansi-color.el Thu Sep 14 12:19:16 2000 +0000 +++ b/lisp/ansi-color.el Thu Sep 14 12:37:51 2000 +0000 @@ -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 ;; Maintainer: Alex Schroeder -;; 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 -;; . +;; 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 . 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! -;; -;; (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: +;; The basic functions are: ;; -;; (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) +;; `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. -;; Usage with shell-mode: +;; Instead of defining lots of new faces, this package uses +;; text-properties as described in the elisp manual +;; *Note (elisp)Special Properties::. + +;;; Thanks -;; 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). +;; Georges Brun-Cottan for improving ansi-color.el +;; substantially by adding the code needed to cope with arbitrary chunks +;; of output and the filter functions. +;; +;; Markus Kuhn 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 ." + :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 -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. +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. -The default colors are: black, red, green, yellow, blue, magenta, -cyan, and white. +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 -On a light background, I prefer: black, red, dark green, orange, blue, -magenta, turquoise, snow4") + +(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) -;; Main function +\(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 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. +(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 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))))))) +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)