LCOV - code coverage report
Current view: top level - lisp - ansi-color.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 27 182 14.8 %
Date: 2017-08-30 10:12:24 Functions: 3 22 13.6 %

          Line data    Source code
       1             : ;;; ansi-color.el --- translate ANSI escape sequences into faces -*- lexical-binding: t -*-
       2             : 
       3             : ;; Copyright (C) 1999-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author: Alex Schroeder <alex@gnu.org>
       6             : ;; Maintainer: Alex Schroeder <alex@gnu.org>
       7             : ;; Version: 3.4.2
       8             : ;; Keywords: comm processes terminals services
       9             : 
      10             : ;; This file is part of GNU Emacs.
      11             : 
      12             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      13             : ;; it under the terms of the GNU General Public License as published by
      14             : ;; the Free Software Foundation, either version 3 of the License, or
      15             : ;; (at your option) any later version.
      16             : 
      17             : ;; GNU Emacs is distributed in the hope that it will be useful,
      18             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      19             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      20             : ;; GNU 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.  If not, see <http://www.gnu.org/licenses/>.
      24             : 
      25             : ;;; Commentary:
      26             : 
      27             : ;; This file provides a function that takes a string or a region
      28             : ;; containing Select Graphic Rendition (SGR) control sequences (formerly
      29             : ;; known as ANSI escape sequences) and tries to translate these into
      30             : ;; faces.
      31             : ;;
      32             : ;; This allows you to run ls --color=yes in shell-mode.  It is now
      33             : ;; enabled by default; to disable it, set ansi-color-for-comint-mode
      34             : ;; to nil.
      35             : ;;
      36             : ;; Note that starting your shell from within Emacs might set the TERM
      37             : ;; environment variable.  The new setting might disable the output of
      38             : ;; SGR control sequences.  Using ls --color=yes forces ls to produce
      39             : ;; these.
      40             : ;;
      41             : ;; SGR control sequences are defined in section 3.8.117 of the ECMA-48
      42             : ;; standard (identical to ISO/IEC 6429), which is freely available as a
      43             : ;; PDF file <URL:http://www.ecma-international.org/publications/standards/Ecma-048.htm>.
      44             : ;; The "Graphic Rendition Combination Mode (GRCM)" implemented is
      45             : ;; "cumulative mode" as defined in section 7.2.8.  Cumulative mode
      46             : ;; means that whenever possible, SGR control sequences are combined
      47             : ;; (ie. blue and bold).
      48             : 
      49             : ;; The basic functions are:
      50             : ;;
      51             : ;; `ansi-color-apply' to colorize a string containing SGR control
      52             : ;; sequences.
      53             : ;;
      54             : ;; `ansi-color-filter-apply' to filter SGR control sequences from a
      55             : ;; string.
      56             : ;;
      57             : ;; `ansi-color-apply-on-region' to colorize a region containing SGR
      58             : ;; control sequences.
      59             : ;;
      60             : ;; `ansi-color-filter-region' to filter SGR control sequences from a
      61             : ;; region.
      62             : 
      63             : ;;; Thanks
      64             : 
      65             : ;; Georges Brun-Cottan <gbruncot@emc.com> for improving ansi-color.el
      66             : ;; substantially by adding the code needed to cope with arbitrary chunks
      67             : ;; of output and the filter functions.
      68             : ;;
      69             : ;; Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk> for pointing me to ECMA-48.
      70             : ;;
      71             : ;; Stefan Monnier <foo@acm.com> for explaining obscure font-lock stuff and for
      72             : ;; code suggestions.
      73             : 
      74             : 
      75             : 
      76             : ;;; Code:
      77             : 
      78             : (defvar comint-last-output-start)
      79             : 
      80             : ;; Customization
      81             : 
      82             : (defgroup ansi-colors nil
      83             :   "Translating SGR control sequences to faces.
      84             : This translation effectively colorizes strings and regions based upon
      85             : SGR control sequences embedded in the text.  SGR (Select Graphic
      86             : Rendition) control sequences are defined in section 8.3.117 of the
      87             : ECMA-48 standard (identical to ISO/IEC 6429), which is freely available
      88             : at <URL:http://www.ecma-international.org/publications/standards/Ecma-048.htm>
      89             : as a PDF file."
      90             :   :version "21.1"
      91             :   :group 'processes)
      92             : 
      93             : (defcustom ansi-color-faces-vector
      94             :   [default bold default italic underline success warning error]
      95             :   "Faces used for SGR control sequences determining a face.
      96             : This vector holds the faces used for SGR control sequence parameters 0
      97             : to 7.
      98             : 
      99             : Parameter  Description        Face used by default
     100             :   0        default            default
     101             :   1        bold               bold
     102             :   2        faint              default
     103             :   3        italic             italic
     104             :   4        underlined         underline
     105             :   5        slowly blinking    success
     106             :   6        rapidly blinking   warning
     107             :   7        negative image     error
     108             : 
     109             : Note that the symbol `default' is special: It will not be combined
     110             : with the current face.
     111             : 
     112             : This vector is used by `ansi-color-make-color-map' to create a color
     113             : map.  This color map is stored in the variable `ansi-color-map'."
     114             :   :type '(vector face face face face face face face face)
     115             :   :set 'ansi-color-map-update
     116             :   :initialize 'custom-initialize-default
     117             :   :group 'ansi-colors)
     118             : 
     119             : (defcustom ansi-color-names-vector
     120             :   ["black" "red3" "green3" "yellow3" "blue2" "magenta3" "cyan3" "gray90"]
     121             :   "Colors used for SGR control sequences determining a color.
     122             : This vector holds the colors used for SGR control sequences parameters
     123             : 30 to 37 (foreground colors) and 40 to 47 (background colors).
     124             : 
     125             : Parameter  Color
     126             :   30  40   black
     127             :   31  41   red
     128             :   32  42   green
     129             :   33  43   yellow
     130             :   34  44   blue
     131             :   35  45   magenta
     132             :   36  46   cyan
     133             :   37  47   white
     134             : 
     135             : This vector is used by `ansi-color-make-color-map' to create a color
     136             : map.  This color map is stored in the variable `ansi-color-map'.
     137             : 
     138             : Each element may also be a cons cell where the car and cdr specify the
     139             : foreground and background colors, respectively."
     140             :   :type '(vector (choice color (cons color color))
     141             :                  (choice color (cons color color))
     142             :                  (choice color (cons color color))
     143             :                  (choice color (cons color color))
     144             :                  (choice color (cons color color))
     145             :                  (choice color (cons color color))
     146             :                  (choice color (cons color color))
     147             :                  (choice color (cons color color)))
     148             :   :set 'ansi-color-map-update
     149             :   :initialize 'custom-initialize-default
     150             :   :version "24.4" ; default colors copied from `xterm-standard-colors'
     151             :   :group 'ansi-colors)
     152             : 
     153             : (defconst ansi-color-control-seq-regexp
     154             :   ;; See ECMA 48, section 5.4 "Control Sequences".
     155             :   "\e\\[[\x30-\x3F]*[\x20-\x2F]*[\x40-\x7E]"
     156             :   "Regexp matching an ANSI control sequence.")
     157             : 
     158             : (defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"
     159             :   "Regexp that matches SGR control sequence parameters.")
     160             : 
     161             : ;; Convenience functions for comint modes (eg. shell-mode)
     162             : 
     163             : 
     164             : (defcustom ansi-color-for-comint-mode t
     165             :   "Determines what to do with comint output.
     166             : If nil, do nothing.
     167             : If the symbol `filter', then filter all SGR control sequences.
     168             : If anything else (such as t), then translate SGR control sequences
     169             : into text properties.
     170             : 
     171             : In order for this to have any effect, `ansi-color-process-output' must
     172             : be in `comint-output-filter-functions'.
     173             : 
     174             : This can be used to enable colorized ls --color=yes output
     175             : in shell buffers.  You set this variable by calling one of:
     176             : \\[ansi-color-for-comint-mode-on]
     177             : \\[ansi-color-for-comint-mode-off]
     178             : \\[ansi-color-for-comint-mode-filter]"
     179             :   :type '(choice (const :tag "Do nothing" nil)
     180             :                  (const :tag "Filter" filter)
     181             :                  (const :tag "Translate" t))
     182             :   :group 'ansi-colors
     183             :   :version "23.2")
     184             : 
     185             : (defvar ansi-color-apply-face-function 'ansi-color-apply-overlay-face
     186             :   "Function for applying an Ansi Color face to text in a buffer.
     187             : This function should accept three arguments: BEG, END, and FACE,
     188             : and it should apply face FACE to the text between BEG and END.")
     189             : 
     190             : ;;;###autoload
     191             : (defun ansi-color-for-comint-mode-on ()
     192             :   "Set `ansi-color-for-comint-mode' to t."
     193             :   (interactive)
     194           0 :   (setq ansi-color-for-comint-mode t))
     195             : 
     196             : (defun ansi-color-for-comint-mode-off ()
     197             :   "Set `ansi-color-for-comint-mode' to nil."
     198             :   (interactive)
     199           0 :   (setq ansi-color-for-comint-mode nil))
     200             : 
     201             : (defun ansi-color-for-comint-mode-filter ()
     202             :   "Set `ansi-color-for-comint-mode' to symbol `filter'."
     203             :   (interactive)
     204           0 :   (setq ansi-color-for-comint-mode 'filter))
     205             : 
     206             : ;;;###autoload
     207             : (defun ansi-color-process-output (ignored)
     208             :   "Maybe translate SGR control sequences of comint output into text properties.
     209             : 
     210             : Depending on variable `ansi-color-for-comint-mode' the comint output is
     211             : either not processed, SGR control sequences are filtered using
     212             : `ansi-color-filter-region', or SGR control sequences are translated into
     213             : text properties using `ansi-color-apply-on-region'.
     214             : 
     215             : The comint output is assumed to lie between the marker
     216             : `comint-last-output-start' and the process-mark.
     217             : 
     218             : This is a good function to put in `comint-output-filter-functions'."
     219          26 :   (let ((start-marker (if (and (markerp comint-last-output-start)
     220          26 :                                (eq (marker-buffer comint-last-output-start)
     221          26 :                                    (current-buffer))
     222          26 :                                (marker-position comint-last-output-start))
     223          26 :                           comint-last-output-start
     224          26 :                         (point-min-marker)))
     225          26 :         (end-marker (process-mark (get-buffer-process (current-buffer)))))
     226          26 :     (cond ((eq ansi-color-for-comint-mode nil))
     227          26 :           ((eq ansi-color-for-comint-mode 'filter)
     228           0 :            (ansi-color-filter-region start-marker end-marker))
     229             :           (t
     230          26 :            (ansi-color-apply-on-region start-marker end-marker)))))
     231             : 
     232             : (define-obsolete-function-alias 'ansi-color-unfontify-region
     233             :   'font-lock-default-unfontify-region "24.1")
     234             : 
     235             : ;; Working with strings
     236             : (defvar-local ansi-color-context nil
     237             :   "Context saved between two calls to `ansi-color-apply'.
     238             : This is a list of the form (CODES FRAGMENT) or nil.  CODES
     239             : represents the state the last call to `ansi-color-apply' ended
     240             : with, currently a list of ansi codes, and FRAGMENT is a string
     241             : starting with an escape sequence, possibly the start of a new
     242             : escape sequence.")
     243             : 
     244             : (defun ansi-color-filter-apply (string)
     245             :   "Filter out all ANSI control sequences from STRING.
     246             : 
     247             : Every call to this function will set and use the buffer-local variable
     248             : `ansi-color-context' to save partial escape sequences.  This information
     249             : will be used for the next call to `ansi-color-apply'.  Set
     250             : `ansi-color-context' to nil if you don't want this.
     251             : 
     252             : This function can be added to `comint-preoutput-filter-functions'."
     253           0 :   (let ((start 0) end result)
     254             :     ;; if context was saved and is a string, prepend it
     255           0 :     (if (cadr ansi-color-context)
     256           0 :         (setq string (concat (cadr ansi-color-context) string)
     257           0 :               ansi-color-context nil))
     258             :     ;; find the next escape sequence
     259           0 :     (while (setq end (string-match ansi-color-control-seq-regexp string start))
     260           0 :       (push (substring string start end) result)
     261           0 :       (setq start (match-end 0)))
     262             :     ;; save context, add the remainder of the string to the result
     263           0 :     (let (fragment)
     264           0 :       (push (substring string start
     265           0 :                        (if (string-match "\033" string start)
     266           0 :                            (let ((pos (match-beginning 0)))
     267           0 :                              (setq fragment (substring string pos))
     268           0 :                              pos)
     269           0 :                          nil))
     270           0 :             result)
     271           0 :       (setq ansi-color-context (if fragment (list nil fragment))))
     272           0 :     (apply #'concat (nreverse result))))
     273             : 
     274             : (defun ansi-color--find-face (codes)
     275             :   "Return the face corresponding to CODES."
     276          26 :   (let (faces)
     277          26 :     (while codes
     278           0 :       (let ((face (ansi-color-get-face-1 (pop codes))))
     279             :         ;; In the (default underline) face, say, the value of the
     280             :         ;; "underline" attribute of the `default' face wins.
     281           0 :         (unless (eq face 'default)
     282          26 :           (push face faces))))
     283             :     ;; Avoid some long-lived conses in the common case.
     284          26 :     (if (cdr faces)
     285           0 :         (nreverse faces)
     286          26 :       (car faces))))
     287             : 
     288             : (defun ansi-color-apply (string)
     289             :   "Translates SGR control sequences into text properties.
     290             : Delete all other control sequences without processing them.
     291             : 
     292             : Applies SGR control sequences setting foreground and background colors
     293             : to STRING using text properties and returns the result.  The colors used
     294             : are given in `ansi-color-faces-vector' and `ansi-color-names-vector'.
     295             : See function `ansi-color-apply-sequence' for details.
     296             : 
     297             : Every call to this function will set and use the buffer-local variable
     298             : `ansi-color-context' to save partial escape sequences and current ansi codes.
     299             : This information will be used for the next call to `ansi-color-apply'.
     300             : Set `ansi-color-context' to nil if you don't want this.
     301             : 
     302             : This function can be added to `comint-preoutput-filter-functions'."
     303           0 :   (let ((codes (car ansi-color-context))
     304             :         (start 0) end result)
     305             :     ;; If context was saved and is a string, prepend it.
     306           0 :     (if (cadr ansi-color-context)
     307           0 :         (setq string (concat (cadr ansi-color-context) string)
     308           0 :               ansi-color-context nil))
     309             :     ;; Find the next escape sequence.
     310           0 :     (while (setq end (string-match ansi-color-control-seq-regexp string start))
     311           0 :       (let ((esc-end (match-end 0)))
     312             :         ;; Colorize the old block from start to end using old face.
     313           0 :         (when codes
     314           0 :           (put-text-property start end 'font-lock-face
     315           0 :                              (ansi-color--find-face codes) string))
     316           0 :         (push (substring string start end) result)
     317           0 :         (setq start (match-end 0))
     318             :         ;; If this is a color escape sequence,
     319           0 :         (when (eq (aref string (1- esc-end)) ?m)
     320             :           ;; create a new face from it.
     321           0 :           (setq codes (ansi-color-apply-sequence
     322           0 :                        (substring string end esc-end) codes)))))
     323             :     ;; if the rest of the string should have a face, put it there
     324           0 :     (when codes
     325           0 :       (put-text-property start (length string)
     326           0 :                          'font-lock-face (ansi-color--find-face codes) string))
     327             :     ;; save context, add the remainder of the string to the result
     328           0 :     (let (fragment)
     329           0 :       (if (string-match "\033" string start)
     330           0 :           (let ((pos (match-beginning 0)))
     331           0 :             (setq fragment (substring string pos))
     332           0 :             (push (substring string start pos) result))
     333           0 :         (push (substring string start) result))
     334           0 :       (setq ansi-color-context (if (or codes fragment) (list codes fragment))))
     335           0 :     (apply 'concat (nreverse result))))
     336             : 
     337             : ;; Working with regions
     338             : 
     339             : (defvar-local ansi-color-context-region nil
     340             :   "Context saved between two calls to `ansi-color-apply-on-region'.
     341             : This is a list of the form (CODES MARKER) or nil.  CODES
     342             : represents the state the last call to `ansi-color-apply-on-region'
     343             : ended with, currently a list of ansi codes, and MARKER is a
     344             : buffer position within an escape sequence or the last position
     345             : processed.")
     346             : 
     347             : (defun ansi-color-filter-region (begin end)
     348             :   "Filter out all ANSI control sequences from region BEGIN to END.
     349             : 
     350             : Every call to this function will set and use the buffer-local variable
     351             : `ansi-color-context-region' to save position.  This information will be
     352             : used for the next call to `ansi-color-apply-on-region'.  Specifically,
     353             : it will override BEGIN, the start of the region.  Set
     354             : `ansi-color-context-region' to nil if you don't want this."
     355           0 :   (let ((end-marker (copy-marker end))
     356           0 :         (start (or (cadr ansi-color-context-region) begin)))
     357           0 :     (save-excursion
     358           0 :       (goto-char start)
     359             :       ;; Delete escape sequences.
     360           0 :       (while (re-search-forward ansi-color-control-seq-regexp end-marker t)
     361           0 :         (delete-region (match-beginning 0) (match-end 0)))
     362             :       ;; save context, add the remainder of the string to the result
     363           0 :       (if (re-search-forward "\033" end-marker t)
     364           0 :           (setq ansi-color-context-region (list nil (match-beginning 0)))
     365           0 :         (setq ansi-color-context-region nil)))))
     366             : 
     367             : (defun ansi-color-apply-on-region (begin end)
     368             :   "Translates SGR control sequences into overlays or extents.
     369             : Delete all other control sequences without processing them.
     370             : 
     371             : SGR control sequences are applied by calling the function
     372             : specified by `ansi-color-apply-face-function'.  The default
     373             : function sets foreground and background colors to the text
     374             : between BEGIN and END, using overlays.  The colors used are given
     375             : in `ansi-color-faces-vector' and `ansi-color-names-vector'.  See
     376             : `ansi-color-apply-sequence' for details.
     377             : 
     378             : Every call to this function will set and use the buffer-local
     379             : variable `ansi-color-context-region' to save position and current
     380             : ansi codes.  This information will be used for the next call to
     381             : `ansi-color-apply-on-region'.  Specifically, it will override
     382             : BEGIN, the start of the region and set the face with which to
     383             : start.  Set `ansi-color-context-region' to nil if you don't want
     384             : this."
     385          26 :   (let ((codes (car ansi-color-context-region))
     386          26 :         (start-marker (or (cadr ansi-color-context-region)
     387          26 :                           (copy-marker begin)))
     388          26 :         (end-marker (copy-marker end)))
     389          26 :     (save-excursion
     390          26 :       (goto-char start-marker)
     391             :       ;; Find the next escape sequence.
     392          26 :       (while (re-search-forward ansi-color-control-seq-regexp end-marker t)
     393             :         ;; Remove escape sequence.
     394           0 :         (let ((esc-seq (delete-and-extract-region
     395           0 :                         (match-beginning 0) (point))))
     396             :           ;; Colorize the old block from start to end using old face.
     397           0 :           (funcall ansi-color-apply-face-function
     398           0 :                    (prog1 (marker-position start-marker)
     399             :                      ;; Store new start position.
     400           0 :                      (set-marker start-marker (point)))
     401           0 :                    (match-beginning 0) (ansi-color--find-face codes))
     402             :           ;; If this is a color sequence,
     403           0 :           (when (eq (aref esc-seq (1- (length esc-seq))) ?m)
     404             :             ;; update the list of ansi codes.
     405          26 :             (setq codes (ansi-color-apply-sequence esc-seq codes)))))
     406             :       ;; search for the possible start of a new escape sequence
     407          26 :       (if (re-search-forward "\033" end-marker t)
     408           0 :           (progn
     409             :             ;; if the rest of the region should have a face, put it there
     410           0 :             (funcall ansi-color-apply-face-function
     411           0 :                      start-marker (point) (ansi-color--find-face codes))
     412             :             ;; save codes and point
     413           0 :             (setq ansi-color-context-region
     414           0 :                   (list codes (copy-marker (match-beginning 0)))))
     415             :         ;; if the rest of the region should have a face, put it there
     416          26 :         (funcall ansi-color-apply-face-function
     417          26 :                  start-marker end-marker (ansi-color--find-face codes))
     418          26 :         (setq ansi-color-context-region (if codes (list codes)))))))
     419             : 
     420             : (defun ansi-color-apply-overlay-face (beg end face)
     421             :   "Make an overlay from BEG to END, and apply face FACE.
     422             : If FACE is nil, do nothing."
     423           0 :   (when face
     424           0 :     (ansi-color-set-extent-face
     425           0 :      (ansi-color-make-extent beg end)
     426           0 :      face)))
     427             : 
     428             : ;; This function helps you look for overlapping overlays.  This is
     429             : ;; useful in comint-buffers.  Overlapping overlays should not happen!
     430             : ;; A possible cause for bugs are the markers.  If you create an overlay
     431             : ;; up to the end of the region, then that end might coincide with the
     432             : ;; process-mark.  As text is added BEFORE the process-mark, the overlay
     433             : ;; will keep growing.  Therefore, as more overlays are created later on,
     434             : ;; there will be TWO OR MORE overlays covering the buffer at that point.
     435             : ;; This function helps you check your buffer for these situations.
     436             : ; (defun ansi-color-debug-overlays ()
     437             : ;   (interactive)
     438             : ;   (let ((pos (point-min)))
     439             : ;     (while (< pos (point-max))
     440             : ;       (if (<= 2 (length (overlays-at pos)))
     441             : ;         (progn
     442             : ;           (goto-char pos)
     443             : ;           (error "%d overlays at %d" (length (overlays-at pos)) pos))
     444             : ;       (let (message-log-max)
     445             : ;         (message  "Reached %d." pos)))
     446             : ;       (setq pos (next-overlay-change pos)))))
     447             : 
     448             : ;; Emacs/XEmacs compatibility layer
     449             : 
     450             : (defun ansi-color-make-face (property color)
     451             :   "Return a face with PROPERTY set to COLOR.
     452             : PROPERTY can be either symbol `foreground' or symbol `background'.
     453             : 
     454             : For Emacs, we just return the cons cell (PROPERTY . COLOR).
     455             : For XEmacs, we create a temporary face and return it."
     456           0 :   (if (featurep 'xemacs)
     457           0 :       (let ((face (make-face (intern (concat color "-" (symbol-name property)))
     458             :                              "Temporary face created by ansi-color."
     459           0 :                              t)))
     460           0 :         (set-face-property face property color)
     461           0 :         face)
     462           0 :     (cond ((eq property 'foreground)
     463           0 :            (cons 'foreground-color color))
     464           0 :           ((eq property 'background)
     465           0 :            (cons 'background-color color))
     466             :           (t
     467           0 :            (cons property color)))))
     468             : 
     469             : (defun ansi-color-make-extent (from to &optional object)
     470             :   "Make an extent for the range [FROM, TO) in OBJECT.
     471             : 
     472             : OBJECT defaults to the current buffer.  XEmacs uses `make-extent', Emacs
     473             : uses `make-overlay'.  XEmacs can use a buffer or a string for OBJECT,
     474             : Emacs requires OBJECT to be a buffer."
     475           0 :   (if (fboundp 'make-extent)
     476           0 :       (make-extent from to object)
     477             :     ;; In Emacs, the overlay might end at the process-mark in comint
     478             :     ;; buffers.  In that case, new text will be inserted before the
     479             :     ;; process-mark, ie. inside the overlay (using insert-before-marks).
     480             :     ;; In order to avoid this, we use the `insert-behind-hooks' overlay
     481             :     ;; property to make sure it works.
     482           0 :     (let ((overlay (make-overlay from to object)))
     483           0 :       (overlay-put overlay 'modification-hooks '(ansi-color-freeze-overlay))
     484           0 :       (overlay-put overlay 'insert-behind-hooks '(ansi-color-freeze-overlay))
     485           0 :       overlay)))
     486             : 
     487             : (defun ansi-color-freeze-overlay (overlay is-after begin end &optional len)
     488             :   "Prevent OVERLAY from being extended.
     489             : This function can be used for the `modification-hooks' overlay
     490             : property."
     491             :   ;; if stuff was inserted at the end of the overlay
     492           0 :   (when (and is-after
     493           0 :              (= 0 len)
     494           0 :              (= end (overlay-end overlay)))
     495             :     ;; reset the end of the overlay
     496           0 :     (move-overlay overlay (overlay-start overlay) begin)))
     497             : 
     498             : (defun ansi-color-set-extent-face (extent face)
     499             :   "Set the `face' property of EXTENT to FACE.
     500             : XEmacs uses `set-extent-face', Emacs  uses `overlay-put'."
     501           0 :   (if (featurep 'xemacs)
     502           0 :       (set-extent-face extent face)
     503           0 :     (overlay-put extent 'face face)))
     504             : 
     505             : ;; Helper functions
     506             : 
     507             : (defsubst ansi-color-parse-sequence (escape-seq)
     508             :   "Return the list of all the parameters in ESCAPE-SEQ.
     509             : 
     510             : ESCAPE-SEQ is a SGR control sequences such as \\033[34m.  The parameter
     511             : 34 is used by `ansi-color-get-face-1' to return a face definition.
     512             : 
     513             : Returns nil only if there's no match for `ansi-color-parameter-regexp'."
     514           0 :   (let ((i 0)
     515             :         codes val)
     516           0 :     (while (string-match ansi-color-parameter-regexp escape-seq i)
     517           0 :       (setq i (match-end 0)
     518           0 :             val (string-to-number (match-string 1 escape-seq) 10))
     519             :       ;; It so happens that (string-to-number "") => 0.
     520           0 :       (push val codes))
     521           0 :     (nreverse codes)))
     522             : 
     523             : (defun ansi-color-apply-sequence (escape-sequence codes)
     524             :   "Apply ESCAPE-SEQUENCE to CODES and return the new list of codes.
     525             : 
     526             : ESCAPE-SEQUENCE is an escape sequence parsed by
     527             : `ansi-color-parse-sequence'.
     528             : 
     529             : For each new code, the following happens: if it is 1-7, add it to
     530             : the list of codes; if it is 21-25 or 27, delete appropriate
     531             : parameters from the list of codes; if it is 30-37 resp. 39, the
     532             : foreground color code is replaced or added resp. deleted; if it
     533             : is 40-47 resp. 49, the background color code is replaced or added
     534             : resp. deleted; any other code is discarded together with the old
     535             : codes.  Finally, the so changed list of codes is returned."
     536           0 :   (let ((new-codes (ansi-color-parse-sequence escape-sequence)))
     537           0 :     (while new-codes
     538           0 :       (let* ((new (pop new-codes))
     539           0 :              (q (/ new 10)))
     540           0 :         (setq codes
     541           0 :               (pcase q
     542           0 :                 (0 (unless (memq new '(0 8 9))
     543           0 :                      (cons new (remq new codes))))
     544           0 :                 (2 (unless (memq new '(20 26 28 29))
     545             :                      ;; The standard says `21 doubly underlined' while
     546             :                      ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims
     547             :                      ;; `21 Bright/Bold: off or Underline: Double'.
     548           0 :                      (remq (- new 20) (pcase new
     549           0 :                                         (22 (remq 1 codes))
     550           0 :                                         (25 (remq 6 codes))
     551           0 :                                         (_ codes)))))
     552           0 :                 ((or 3 4) (let ((r (mod new 10)))
     553           0 :                             (unless (= r 8)
     554           0 :                               (let (beg)
     555           0 :                                 (while (and codes (/= q (/ (car codes) 10)))
     556           0 :                                   (push (pop codes) beg))
     557           0 :                                 (setq codes (nconc (nreverse beg) (cdr codes)))
     558           0 :                                 (if (= r 9)
     559           0 :                                     codes
     560           0 :                                   (cons new codes))))))
     561           0 :                 (_ nil)))))
     562           0 :     codes))
     563             : 
     564             : (defun ansi-color-make-color-map ()
     565             :   "Creates a vector of face definitions and returns it.
     566             : 
     567             : The index into the vector is an ANSI code.  See the documentation of
     568             : `ansi-color-map' for an example.
     569             : 
     570             : The face definitions are based upon the variables
     571             : `ansi-color-faces-vector' and `ansi-color-names-vector'."
     572           0 :   (let ((map (make-vector 50 nil))
     573             :         (index 0))
     574             :     ;; miscellaneous attributes
     575           0 :     (mapc
     576           0 :      (function (lambda (e)
     577           0 :                  (aset map index e)
     578           0 :                  (setq index (1+ index)) ))
     579           0 :      ansi-color-faces-vector)
     580             :     ;; foreground attributes
     581           0 :     (setq index 30)
     582           0 :     (mapc
     583           0 :      (function (lambda (e)
     584           0 :                  (aset map index
     585           0 :                        (ansi-color-make-face 'foreground
     586           0 :                                              (if (consp e) (car e) e)))
     587           0 :                  (setq index (1+ index)) ))
     588           0 :      ansi-color-names-vector)
     589             :     ;; background attributes
     590           0 :     (setq index 40)
     591           0 :     (mapc
     592           0 :      (function (lambda (e)
     593           0 :                  (aset map index
     594           0 :                        (ansi-color-make-face 'background
     595           0 :                                              (if (consp e) (cdr e) e)))
     596           0 :                  (setq index (1+ index)) ))
     597           0 :      ansi-color-names-vector)
     598           0 :     map))
     599             : 
     600             : (defvar ansi-color-map (ansi-color-make-color-map)
     601             :   "A brand new color map suitable for `ansi-color-get-face'.
     602             : 
     603             : The value of this variable is usually constructed by
     604             : `ansi-color-make-color-map'.  The values in the array are such that the
     605             : numbers included in an SGR control sequences point to the correct
     606             : foreground or background colors.
     607             : 
     608             : Example: The sequence \\033[34m specifies a blue foreground.  Therefore:
     609             :      (aref ansi-color-map 34)
     610             :           => (foreground-color . \"blue\")")
     611             : 
     612             : (defun ansi-color-map-update (symbol value)
     613             :   "Update `ansi-color-map'.
     614             : 
     615             : Whenever the vectors used to construct `ansi-color-map' are changed,
     616             : this function is called.  Therefore this function is listed as the :set
     617             : property of `ansi-color-faces-vector' and `ansi-color-names-vector'."
     618           0 :   (set-default symbol value)
     619           0 :   (setq ansi-color-map (ansi-color-make-color-map)))
     620             : 
     621             : (defun ansi-color-get-face-1 (ansi-code)
     622             :   "Get face definition from `ansi-color-map'.
     623             : ANSI-CODE is used as an index into the vector."
     624           0 :   (condition-case nil
     625           0 :       (aref ansi-color-map ansi-code)
     626           0 :     (args-out-of-range nil)))
     627             : 
     628             : (provide 'ansi-color)
     629             : 
     630             : ;;; ansi-color.el ends here

Generated by: LCOV version 1.12