X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6664fc59a8f296117ea98b943f062c0cc0e907c1..4b2addb7e377f9a7601d78381025e343f776083c:/lisp/ansi-color.el diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 6bc95fa8d9..6a82f17667 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, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1999-2012 Free Software Foundation, Inc. ;; Author: Alex Schroeder ;; Maintainer: Alex Schroeder @@ -69,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. @@ -133,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) @@ -174,6 +183,11 @@ in shell buffers. You set this variable by calling one of: :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 () "Set `ansi-color-for-comint-mode' to t." @@ -203,8 +217,12 @@ 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))) + (let ((start-marker (if (and (markerp comint-last-output-start) + (eq (marker-buffer comint-last-output-start) + (current-buffer)) + (marker-position comint-last-output-start)) + 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) @@ -212,51 +230,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 text-property, skip - ;; positions with the ansi-color property set, and remove the - ;; remaining face text-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 @@ -290,9 +267,7 @@ 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) @@ -309,10 +284,7 @@ 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 colorized-substring) @@ -325,8 +297,7 @@ See `ansi-color-unfontify-region' for a way around this." (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)) + (put-text-property start end 'font-lock-face face string)) (setq colorized-substring (substring string start end) start (match-end 0)) ;; Eliminate unrecognized ANSI sequences. @@ -338,8 +309,7 @@ See `ansi-color-unfontify-region' for a way around this." (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) @@ -347,9 +317,7 @@ See `ansi-color-unfontify-region' for a way around this." (setq fragment (substring string pos)) (push (substring string start pos) result)) (push (substring string start) result)) - (if (or face fragment) - (setq ansi-color-context (list face fragment)) - (setq ansi-color-context nil))) + (setq ansi-color-context (if (or face fragment) (list face fragment)))) (apply 'concat (nreverse result)))) ;; Working with regions @@ -417,10 +385,9 @@ start of the region and set the face with which to start. Set ;; 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)) + (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))) @@ -433,25 +400,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 @@ -576,7 +544,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 @@ -584,7 +553,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)) @@ -621,7 +591,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." @@ -641,5 +611,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