]> code.delx.au - gnu-emacs/blobdiff - lisp/ansi-color.el
(ibuffer-compressed-file-name-regexp): Undo previous
[gnu-emacs] / lisp / ansi-color.el
index a3e3fb5e44c74708c7e575c2de025caeb3e5ae1e..20cdfaad2cf52e68ff0553429bd731a1f0bb1878 100644 (file)
@@ -1,11 +1,12 @@
 ;;; ansi-color.el --- translate ANSI escape sequences into faces
 
-;; Copyright (C) 1999, 2000, 2001  Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Alex Schroeder <alex@gnu.org>
 ;; Maintainer: Alex Schroeder <alex@gnu.org>
-;; Version: 3.4.0
-;; Keywords: comm processes
+;; Version: 3.4.2
+;; Keywords: comm processes terminals services
 
 ;; This file is part of GNU Emacs.
 
@@ -21,8 +22,8 @@
 ;;
 ;; 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:
 
@@ -46,7 +47,6 @@
 ;;
 ;; If you decide you like this, add the following to your .emacs file:
 ;;
-;; (autoload 'ansi-color-for-comint-mode-on "ansi-color" nil t)
 ;; (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
@@ -86,6 +86,8 @@
 
 ;;; Code:
 
+(defvar comint-last-output-start)
+
 ;; Customization
 
 (defgroup ansi-colors nil
@@ -95,7 +97,7 @@ 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 <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>."
-  :version "20.7"
+  :version "21.1"
   :group 'processes)
 
 (defcustom ansi-color-faces-vector
@@ -172,12 +174,12 @@ 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]"
-  :version "20.8"
   :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)
@@ -193,6 +195,7 @@ in shell buffers.  You set this variable by calling one of:
   (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.
 
@@ -218,29 +221,15 @@ This is a good function to put in `comint-output-filter-functions'."
          'ansi-color-process-output)
 
 
-;; Alternative font-lock-unfontify-region-function
-
-
-(eval-when-compile
-  ;; We use this to preserve or protect things when modifying text
-  ;; properties.  Stolen from lazy-lock and font-lock.  Ugly!!!
-  ;; Probably most of this is not needed?
-  (defmacro save-buffer-state (varlist &rest body)
-    "Bind variables according to VARLIST and eval BODY restoring buffer state."
-    (` (let* ((,@ (append varlist
-                  '((modified (buffer-modified-p)) (buffer-undo-list t)
-                    (inhibit-read-only t) (inhibit-point-motion-hooks t)
-                    before-change-functions after-change-functions
-                    deactivate-mark buffer-file-name buffer-file-truename))))
-        (,@ body)
-        (when (and (not modified) (buffer-modified-p))
-          (set-buffer-modified-p nil)))))
-  (put 'save-buffer-state 'lisp-indent-function 1))
+;; 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'.  
-When font-lock is active in a buffer, you cannot simply add face
-text-properties to the buffer.  Font-lock will remove the face
+  "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
@@ -256,21 +245,20 @@ A possible way to install this would be:
          \(function (lambda ()
                      \(setq font-lock-unfontify-region-function
                            'ansi-color-unfontify-region))))"
-  ;; save-buffer-state is a macro in font-lock.el!
-  (save-buffer-state nil
-    (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))))))
+  ;; 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
 
@@ -411,7 +399,7 @@ information will be used for the next call to
 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) 
+       (start-marker (or (cadr ansi-color-context-region)
                          (copy-marker begin)))
        (end-marker (copy-marker end))
        escape-sequence)
@@ -477,7 +465,7 @@ start of the region and set the face with which to start.  Set
 
 (defun ansi-color-make-face (property color)
   "Return a face with PROPERTY set to COLOR.
-PROPERTY can be either symbol `foreground' or symbol `background'.  
+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."
@@ -500,7 +488,7 @@ For XEmacs, we create a temporary face and return it."
 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)
+  (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
@@ -525,7 +513,7 @@ property."
 (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)
+  (if (fboundp 'set-extent-face)
       (set-extent-face extent face)
     (overlay-put extent 'face face)))
 
@@ -550,7 +538,13 @@ case we return nil."
          ((eq (car new-faces) 'default)
           (cdr new-faces))
          (t
-          (append new-faces face)))))
+          ;; 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.
@@ -628,14 +622,16 @@ ESCAPE-SEQ is a SGR control sequences such as \\033[34m.  The parameter
     (while (string-match ansi-color-r escape-seq i)
       (setq i (match-end 0)
            val (ansi-color-get-face-1
-                (string-to-int (match-string 0 escape-seq) 10)))
+                (string-to-number (match-string 0 escape-seq) 10)))
       (cond ((not val))
            ((eq val 'default)
             (setq f (list val)))
            (t
-            (add-to-list 'f val))))
+            (unless (member val f)
+              (push val f)))))
     f))
 
 (provide 'ansi-color)
 
+;;; arch-tag: 00726118-9432-44fd-b72d-d2af7591c99c
 ;;; ansi-color.el ends here