X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b90caf50d04d2c51742054bb6b0e836f6d425203..9805f81dda38cd541ba8043f44e720e06adf6492:/lisp/ansi-color.el?ds=sidebyside diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index e343f56016..15a543e959 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -1,7 +1,6 @@ ;;; ansi-color.el --- translate ANSI escape sequences into faces -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1999-2012 Free Software Foundation, Inc. ;; Author: Alex Schroeder ;; Maintainer: Alex Schroeder @@ -30,23 +29,15 @@ ;; known as ANSI escape sequences) and tries to translate these into ;; faces. ;; -;; This allows you to run ls --color=yes in shell-mode. In order to -;; test this, proceed as follows: -;; -;; 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 +;; This allows you to run ls --color=yes in shell-mode. It is now +;; enabled by default; to disable it, set ansi-color-for-comint-mode +;; to nil. ;; ;; 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 @@ -77,7 +68,7 @@ ;; ;; Markus Kuhn for pointing me to ECMA-48. ;; -;; Stefan Monnier explaing obscure font-lock stuff and +;; Stefan Monnier for explaining obscure font-lock stuff and for ;; code suggestions. @@ -141,8 +132,18 @@ Parameter Color 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) +map. This color map is stored in the variable `ansi-color-map'. + +Each element may also be a cons cell where the car and cdr specify the +foreground and background colors, respectively." + :type '(vector (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color)) + (choice color (cons color color))) :set 'ansi-color-map-update :initialize 'custom-initialize-default :group 'ansi-colors) @@ -150,6 +151,10 @@ map. This color map is stored in the variable `ansi-color-map'." (defconst ansi-color-regexp "\033\\[\\([0-9;]*m\\)" "Regexp that matches SGR control sequences.") +(defconst ansi-color-drop-regexp + "\033\\[\\([ABCDsuK]\\|2J\\|=[0-9]+[hI]\\|[0-9;]*[Hf]\\)" + "Regexp that matches ANSI control sequences to silently drop.") + (defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]" "Regexp that matches SGR control sequence parameters.") @@ -157,12 +162,12 @@ map. This color map is stored in the variable `ansi-color-map'." ;; Convenience functions for comint modes (eg. shell-mode) -(defcustom ansi-color-for-comint-mode nil +(defcustom ansi-color-for-comint-mode t "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. +into text properties. In order for this to have any effect, `ansi-color-process-output' must be in `comint-output-filter-functions'. @@ -175,7 +180,13 @@ in shell buffers. You set this variable by calling one of: :type '(choice (const :tag "Do nothing" nil) (const :tag "Filter" filter) (const :tag "Translate" t)) - :group 'ansi-colors) + :group 'ansi-colors + :version "23.2") + +(defvar ansi-color-apply-face-function 'ansi-color-apply-overlay-face + "Function for applying an Ansi Color face to text in a buffer. +This function should accept three arguments: BEG, END, and FACE, +and it should apply face FACE to the text between BEG and END.") ;;;###autoload (defun ansi-color-for-comint-mode-on () @@ -195,12 +206,12 @@ in shell buffers. You set this variable by calling one of: ;;;###autoload (defun ansi-color-process-output (ignored) - "Maybe translate SGR control sequences of comint output into text-properties. + "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'. +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. @@ -215,51 +226,10 @@ This is a good function to put in `comint-output-filter-functions'." (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))))) +(defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region) +(make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1") ;; 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 @@ -269,7 +239,7 @@ escape sequence.") (make-variable-buffer-local 'ansi-color-context) (defun ansi-color-filter-apply (string) - "Filter out all SGR control sequences from STRING. + "Filter out all ANSI 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 @@ -293,16 +263,15 @@ This function can be added to `comint-preoutput-filter-functions'." (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))) + (setq ansi-color-context (if fragment (list nil fragment)))) result)) (defun ansi-color-apply (string) - "Translates SGR control sequences into text-properties. + "Translates SGR control sequences into text properties. +Delete all other control sequences without processing them. Applies SGR control sequences setting foreground and background colors -to STRING using text-properties and returns the result. The colors used +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. @@ -311,44 +280,41 @@ Every call to this function will set and use the buffer-local variable 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." +This function can be added to `comint-preoutput-filter-functions'." (let ((face (car ansi-color-context)) - (start 0) end escape-sequence result) - ;; if context was saved and is a string, prepend it + (start 0) end escape-sequence result + colorized-substring) + ;; 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 + ;; 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 + ;; 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)) + (put-text-property start end 'font-lock-face face string)) + (setq colorized-substring (substring string start end) start (match-end 0)) - ;; create new face by applying all the parameters in the escape - ;; sequence + ;; Eliminate unrecognized ANSI sequences. + (while (string-match ansi-color-drop-regexp colorized-substring) + (setq colorized-substring + (replace-match "" nil nil colorized-substring))) + (push colorized-substring result) + ;; Create new face, by applying escape sequence parameters. (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)) + (put-text-property start (length string) 'font-lock-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)) + (setq fragment (substring string pos)) + (push (substring string start pos) result)) + (push (substring string start) result)) + (setq ansi-color-context (if (or face fragment) (list face fragment)))) + (apply 'concat (nreverse result)))) ;; Working with regions @@ -361,7 +327,7 @@ 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. + "Filter out all ANSI 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 @@ -372,23 +338,27 @@ it will override BEGIN, the start of the region. Set (start (or (cadr ansi-color-context-region) begin))) (save-excursion (goto-char start) - ;; find the next escape sequence + ;; Delete unrecognized escape sequences. + (while (re-search-forward ansi-color-drop-regexp end-marker t) + (replace-match "")) + (goto-char start) + ;; Delete SGR escape sequences. (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))))) + ;; 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. +Delete all other control sequences without processing them. -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. +SGR control sequences are applied by setting foreground and +background colors to the text between BEGIN and END using +overlays. The colors used are given in `ansi-color-faces-vector' +and `ansi-color-names-vector'. See `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 @@ -401,15 +371,19 @@ start of the region and set the face with which to start. Set (copy-marker begin))) (end-marker (copy-marker end)) escape-sequence) + ;; First, eliminate unrecognized ANSI control sequences. + (save-excursion + (goto-char start-marker) + (while (re-search-forward ansi-color-drop-regexp end-marker t) + (replace-match ""))) (save-excursion (goto-char start-marker) - ;; find the next escape sequence + ;; Find the next SGR 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)) + ;; Colorize the old block from start to end using old face. + (funcall ansi-color-apply-face-function + 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))) @@ -422,25 +396,26 @@ start of the region and set the face with which to start. Set (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)) + (funcall ansi-color-apply-face-function + 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)))))) + (funcall ansi-color-apply-face-function + start-marker end-marker face) + (setq ansi-color-context-region (if face (list face))))))) + +(defun ansi-color-apply-overlay-face (beg end face) + "Make an overlay from BEG to END, and apply face FACE. +If FACE is nil, do nothing." + (when face + (ansi-color-set-extent-face + (ansi-color-make-extent beg end) + face))) ;; This function helps you look for overlapping overlays. This is -;; usefull in comint-buffers. Overlapping overlays should not happen! +;; useful 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 @@ -565,7 +540,8 @@ The face definitions are based upon the variables (mapc (function (lambda (e) (aset ansi-color-map index - (ansi-color-make-face 'foreground e)) + (ansi-color-make-face 'foreground + (if (consp e) (car e) e))) (setq index (1+ index)) )) ansi-color-names-vector) ;; background attributes @@ -573,7 +549,8 @@ The face definitions are based upon the variables (mapc (function (lambda (e) (aset ansi-color-map index - (ansi-color-make-face 'background e)) + (ansi-color-make-face 'background + (if (consp e) (cdr e) e))) (setq index (1+ index)) )) ansi-color-names-vector) ansi-color-map)) @@ -610,7 +587,7 @@ ANSI-CODE is used as an index into the vector." "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. +the parameter 0), then the effect of all previous parameters is canceled. 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." @@ -630,5 +607,4 @@ ESCAPE-SEQ is a SGR control sequences such as \\033[34m. The parameter (provide 'ansi-color) -;; arch-tag: 00726118-9432-44fd-b72d-d2af7591c99c ;;; ansi-color.el ends here