+(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 (functionp '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 (functionp '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)