X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/618206eaeace23e040f784c9fc857c44ebfc6bb0..f7fba1a8c0ebf4d4dcfa84634b606979a0ce2995:/lisp/ansi-color.el diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index bab5c468b0..c329bab578 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -1,11 +1,12 @@ -;;; ansi-color.el -- translate ANSI into text-properties +;;; ansi-color.el --- translate ANSI escape sequences into faces -;; Copyright (C) 1999 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. -;; Author: Alex Schroeder -;; Maintainer: Alex Schroeder -;; Version: 1.1.1 -;; Keywords: comm processes +;; Author: Alex Schroeder +;; Maintainer: Alex Schroeder +;; Version: 3.4.2 +;; Keywords: comm processes terminals services ;; This file is part of GNU Emacs. @@ -21,160 +22,614 @@ ;; ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: -;; You can get the latest version of this file from my homepage -;; . +;; This file provides a function that takes a string or a region +;; containing Select Graphic Rendition (SGR) control sequences (formerly +;; known as ANSI escape sequences) and tries to translate these into +;; faces. ;; -;; 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. In order to +;; test this, proceed as follows: ;; -;; 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. +;; 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 +;; +;; 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 . 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). -;; In order to install this with TinyMush.el, add the following to your -;; .emacs file: +;; The basic functions are: +;; +;; `ansi-color-apply' to colorize a string containing SGR control +;; sequences. ;; -;; (setq tinymud-filter-line-hook 'my-tinymud-add-ansi-text-properties) -;; (autoload 'ansi-color-to-text-properties "ansi-color" -;; "Translates ANSI color control sequences into text-properties." t) -;; (defun my-tinymud-add-ansi-text-properties (conn line) -;; "Call `ansi-color-to-text-properties' for LINE. -;; Ignores CONN and returns nil, so that `tinymud-filter-line' continues to -;; process triggers and everything else." -;; (ansi-color-to-text-properties line) -;; nil) - -;; If the ANSI sequences assume that you have a black background, you'll -;; have to display the stuff in a frame with a black background. You -;; can create such a frame like this (it still looks ugly!): +;; `ansi-color-filter-apply' to filter SGR control sequences from a +;; string. ;; -;; (defun my-black-frame () -;; "Create a frame with black background." -;; (interactive) -;; (make-frame '((foreground-color . "white") -;; (background-color . "black")))) +;; `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. -;;; Testing: +;;; Thanks -;; 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! +;; 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. ;; -;; (progn -;; (setq line "bold and blue, bold and blue!!") -;; (ansi-color-to-text-properties line) -;; (insert line)) - -;;; Bugs: - -;; Only supports the ANSI sequences that the MUSH I'm on uses (the MUSH -;; is Elendor, see http://www.elendor.net). To see the list of codes -;; supported I did a `help ansi()'. Based on this information, I used -;; TinyTalk.el (without ANSI color support), gave myself the ANSI color -;; flags using `@set me=ANSI' and `@set me=COLOR', and noted the ANSI -;; escape sequences produced by the MUSH using `think ansi(r,red)' for -;; example. +;; Markus Kuhn for pointing me to ECMA-48. ;; -;; The code is spaghetti-code, I hate it. +;; Stefan Monnier explaing obscure font-lock stuff and +;; code suggestions. ;;; Code: -(defvar ansi-color-faces-vector - [default bold default default underline bold default modeline] - "Faces used for ANSI control sequences determining a face. +;; Customization + +(defgroup ansi-colors nil + "Translating SGR control sequences to faces. +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 "21.1" + :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 + +Note that the symbol `default' is special: It will not be combined +with the current face. -Those are sequences like this one: , 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)") +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) -(defvar ansi-color-names-vector +(defcustom ansi-color-names-vector ["black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"] - "Array of colors. - -Used for sequences like this one: , where 1 could be an index to a -foreground color (red, in this case), or , 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") - -;; The main function - -(defun ansi-color-to-text-properties (str) - "Translates ANSI color control sequences into text-properties. - -The ANSI control sequences are made invisible. The text-properties are -added to the string given in the parameter STR." - ;; ANSI code for highlighting, example: boringINTERESTINGboring - ;; state: start with 0, "" -> 1, "[" -> 2, "[013457]" -> 3, - ;; "[013457]" -> 4, "m" -> back to 0! - ;; param: stored when state is 3 (in the above example: 1) - (let ((str-length (length str)) - (face '(default)) - (i 0) (char) (state 0) (param1) (param2)) - (while (< i str-length) - (setq char (aref str i)) - (cond - ;; Eeither just finished an ANSI control squence (state 4) or - ;; wrote normal chars (state 0). - ((and (or (= state 0) (= state 4)) (= char ?)) - (setq state 1)); saw escape - ((and (= state 1) (= char ?\[)); seen escape - (setq state 2 - param1 nil - param2 nil)); saw [, prepare for param1 and param2! - ((and (or (= state 2) (= state 3)); reading first or second digit - (string-match "[01234567]" (substring str i (1+ i)))) - (if (= state 2); reading first digit - ;;  (hilight) - (setq param1 (string-to-number (substring str i (1+ i))) - state 3); prepare to read a second digit or quit. - ;; if reading second digit - ;; such as  (green foreground) - (setq param2 (string-to-number (substring str i (1+ i))) - state 4))); read second digit, prepare to quit - ((and (or (= state 3) (= state 4)) (= char ?m)); reading last char: m - (setq state 4); state 4: m will be invisible. Now reset face - ;; according to param1 and param2. - (if (null param2); only param1 set: no color changes! - ;; : default face - (if (= param1 0) - (setq face '(default)) - ;; : hilight, : inverse, : underline, etc. - (add-to-list 'face (aref ansi-color-faces-vector param1))) - ;; If param2 is set, we are changing back- or foreground color. - (if (= param1 3); first digit told us to change foreground - ;; : red foreground - (add-to-list 'face (cons 'foreground-color - (aref ansi-color-names-vector param2))) - ;; : green background - (add-to-list 'face (cons 'background-color - (aref ansi-color-names-vector param2)))))) - (t (setq state 0))); all other cases, state is 0. - - ;; Set text-property for every char. - (if (> state 0); if reading ANSI codes, state > 0: make them - ; invisible. - (put-text-property i (1+ i) 'invisible t str) - ;; if reading normal chars, state is 0, put them in the - ;; current face. - (put-text-property i (1+ i) 'face face str)) - ;; next char - (setq i (1+ i))))) + "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). -(provide 'ansi-color) +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) + +(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.") + + +;; Convenience functions for comint modes (eg. shell-mode) + + +(defcustom ansi-color-for-comint-mode nil + "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. + +In order for this to have any effect, `ansi-color-process-output' must +be in `comint-output-filter-functions'. + +This can be used to enable colorized ls --color=yes output +in shell buffers. You set this variable by calling one of: +\\[ansi-color-for-comint-mode-on] +\\[ansi-color-for-comint-mode-off] +\\[ansi-color-for-comint-mode-filter]" + :type '(choice (const :tag "Do nothing" nil) + (const :tag "Filter" filter) + (const :tag "Translate" t)) + :group 'ansi-colors) + +;;;###autoload +(defun ansi-color-for-comint-mode-on () + "Set `ansi-color-for-comint-mode' to t." + (interactive) + (setq ansi-color-for-comint-mode t)) + +(defun ansi-color-for-comint-mode-off () + "Set `ansi-color-for-comint-mode' to nil." + (interactive) + (setq ansi-color-for-comint-mode nil)) + +(defun ansi-color-for-comint-mode-filter () + "Set `ansi-color-for-comint-mode' to symbol `filter'." + (interactive) + (setq ansi-color-for-comint-mode 'filter)) + +;;;###autoload +(defun ansi-color-process-output (string) + "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 +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. + +This is a good function to put in `comint-output-filter-functions'." + (let ((start-marker (or comint-last-output-start + (point-min-marker))) + (end-marker (process-mark (get-buffer-process (current-buffer))))) + (cond ((eq ansi-color-for-comint-mode nil)) + ((eq ansi-color-for-comint-mode 'filter) + (ansi-color-filter-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))))) + +;; 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 +faces the last call to `ansi-color-apply' ended with, and FRAGMENT is a +string starting with an escape sequence, possibly the start of a new +escape sequence.") +(make-variable-buffer-local 'ansi-color-context) + +(defun ansi-color-filter-apply (string) + "Filter out all SGR 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 +will be used for the next call to `ansi-color-apply'. Set +`ansi-color-context' to nil if you don't want this. -;;; ansi-colors.el ends here +This function can be added to `comint-preoutput-filter-functions'." + (let ((start 0) end result) + ;; 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)) + ;; find the next escape sequence + (while (setq end (string-match ansi-color-regexp string start)) + (setq result (concat result (substring string start end)) + start (match-end 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 fragment + (setq ansi-color-context (list nil fragment)) + (setq ansi-color-context nil))) + result)) +(defun ansi-color-apply (string) + "Translates SGR control sequences into text-properties. + +Applies SGR control sequences setting foreground and background colors +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. + +Every call to this function will set and use the buffer-local variable +`ansi-color-context' to save partial escape sequences and current face. +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." + (let ((face (car ansi-color-context)) + (start 0) end escape-sequence result) + ;; 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)) + ;; 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)) + ;; colorize the old block from start to end using old 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)) + start (match-end 0)) + ;; create new face by applying all the parameters in the escape + ;; sequence + (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)) + ;; 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)) + +;; Working with regions + +(defvar ansi-color-context-region nil + "Context saved between two calls to `ansi-color-apply-on-region'. +This is a list of the form (FACES MARKER) or nil. FACES is a list of +faces the last call to `ansi-color-apply-on-region' ended with, and +MARKER is a buffer position within an escape sequence or the last +position processed.") +(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. + +Every call to this function will set and use the buffer-local variable +`ansi-color-context-region' to save position. This information will be +used for the next call to `ansi-color-apply-on-region'. Specifically, +it will override BEGIN, the start of the region. Set +`ansi-color-context-region' to nil if you don't want this." + (let ((end-marker (copy-marker end)) + (start (or (cadr ansi-color-context-region) begin))) + (save-excursion + (goto-char start) + ;; find the next escape sequence + (while (re-search-forward ansi-color-regexp end-marker t) + ;; delete the escape sequence + (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))))) + +(defun ansi-color-apply-on-region (begin end) + "Translates SGR control sequences into overlays or extents. + +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. + +Every call to this function will set and use the buffer-local variable +`ansi-color-context-region' to save position and current face. This +information will be used for the next call to +`ansi-color-apply-on-region'. Specifically, it will override BEGIN, the +start of the region and set the face with which to start. Set +`ansi-color-context-region' to nil if you don't want this." + (let ((face (car ansi-color-context-region)) + (start-marker (or (cadr ansi-color-context-region) + (copy-marker begin))) + (end-marker (copy-marker end)) + escape-sequence) + (save-excursion + (goto-char start-marker) + ;; find the next escape sequence + (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)) + ;; store escape sequence and new start position + (setq escape-sequence (match-string 1) + start-marker (copy-marker (match-end 0))) + ;; delete the escape sequence + (replace-match "") + ;; create new face by applying all the parameters in the escape + ;; sequence + (setq face (ansi-color-apply-sequence escape-sequence face))) + ;; search for the possible start of a new escape sequence + (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)) + ;; 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)))))) + +;; This function helps you look for overlapping overlays. This is +;; usefull 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 +;; will keep growing. Therefore, as more overlays are created later on, +;; there will be TWO OR MORE overlays covering the buffer at that point. +;; This function helps you check your buffer for these situations. +; (defun ansi-color-debug-overlays () +; (interactive) +; (let ((pos (point-min))) +; (while (< pos (point-max)) +; (if (<= 2 (length (overlays-at pos))) +; (progn +; (goto-char pos) +; (error "%d overlays at %d" (length (overlays-at pos)) pos)) +; (let (message-log-max) +; (message "Reached %d." pos))) +; (setq pos (next-overlay-change pos))))) + +;; Emacs/XEmacs compatibility layer + +(defun ansi-color-make-face (property color) + "Return a face with PROPERTY set to COLOR. +PROPERTY can be either symbol `foreground' or symbol `background'. + +For Emacs, we just return the cons cell \(PROPERTY . COLOR). +For XEmacs, we create a temporary face and return it." + (if (featurep 'xemacs) + (let ((face (make-face (intern (concat color "-" (symbol-name property))) + "Temporary face created by ansi-color." + t))) + (set-face-property face property color) + face) + (cond ((eq property 'foreground) + (cons 'foreground-color color)) + ((eq property 'background) + (cons 'background-color color)) + (t + (cons property color))))) + +(defun ansi-color-make-extent (from to &optional object) + "Make an extent for the range [FROM, TO) in OBJECT. + +OBJECT defaults to the current buffer. XEmacs uses `make-extent', Emacs +uses `make-overlay'. XEmacs can use a buffer or a string for OBJECT, +Emacs requires OBJECT to be a buffer." + (if (fboundp 'make-extent) + (make-extent from to object) + ;; In Emacs, the overlay might end at the process-mark in comint + ;; buffers. In that case, new text will be inserted before the + ;; process-mark, ie. inside the overlay (using insert-before-marks). + ;; In order to avoid this, we use the `insert-behind-hooks' overlay + ;; property to make sure it works. + (let ((overlay (make-overlay from to object))) + (overlay-put overlay 'modification-hooks '(ansi-color-freeze-overlay)) + overlay))) + +(defun ansi-color-freeze-overlay (overlay is-after begin end &optional len) + "Prevent OVERLAY from being extended. +This function can be used for the `modification-hooks' overlay +property." + ;; if stuff was inserted at the end of the overlay + (when (and is-after + (= 0 len) + (= end (overlay-end overlay))) + ;; reset the end of the overlay + (move-overlay overlay (overlay-start overlay) begin))) + +(defun ansi-color-set-extent-face (extent face) + "Set the `face' property of EXTENT to FACE. +XEmacs uses `set-extent-face', Emacs uses `overlay-put'." + (if (fboundp 'set-extent-face) + (set-extent-face extent face) + (overlay-put extent 'face face))) + +;; Helper functions + +(defun ansi-color-apply-sequence (escape-sequence faces) + "Apply ESCAPE-SEQ to FACES and return the new list of faces. + +ESCAPE-SEQ is an escape sequences parsed by `ansi-color-get-face'. + +If the new faces start with the symbol `default', then the new +faces are returned. If the faces start with something else, +they are appended to the front of the FACES list, and the new +list of faces is returned. + +If `ansi-color-get-face' returns nil, then we either got a +null-sequence, or we stumbled upon some garbage. In either +case we return nil." + (let ((new-faces (ansi-color-get-face escape-sequence))) + (cond ((null new-faces) + nil) + ((eq (car new-faces) 'default) + (cdr new-faces)) + (t + ;; Like (append NEW-FACES FACES) + ;; but delete duplicates in FACES. + (let ((modified-faces (copy-sequence faces))) + (dolist (face (nreverse new-faces)) + (setq modified-faces (delete face modified-faces)) + (push face modified-faces)) + modified-faces))))) + +(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 + (ansi-color-make-face 'foreground e)) + (setq index (1+ index)) )) + ansi-color-names-vector) + ;; background attributes + (setq index 40) + (mapcar + (function (lambda (e) + (aset ansi-color-map index + (ansi-color-make-face 'background 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. + +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. + +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 val) + (while (string-match ansi-color-r escape-seq i) + (setq i (match-end 0) + val (ansi-color-get-face-1 + (string-to-number (match-string 0 escape-seq) 10))) + (cond ((not val)) + ((eq val 'default) + (setq f (list val))) + (t + (unless (member val f) + (push val f))))) + f)) + +(provide 'ansi-color) +;;; arch-tag: 00726118-9432-44fd-b72d-d2af7591c99c +;;; ansi-color.el ends here