]> code.delx.au - gnu-emacs/blobdiff - lisp/ansi-color.el
(custom-initialize-safe-set, custom-initialize-safe-default): Doc fixes.
[gnu-emacs] / lisp / ansi-color.el
index 51421add42c0629e3d63a54f2d8156f8b7e03b6a..31aaef2fcdcdf13d6ce9e5ae59a4d8fc6c146fac 100644 (file)
@@ -21,8 +21,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 +46,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
@@ -221,23 +220,6 @@ This is a good function to put in `comint-output-filter-functions'."
 
 ;; Alternative font-lock-unfontify-region-function for Emacs only
 
-
-(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))
-
 (defun ansi-color-unfontify-region (beg end &rest xemacs-stuff)
   "Replacement function for `font-lock-default-unfontify-region'.
 
@@ -260,21 +242,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
 
@@ -415,7 +396,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)
@@ -481,7 +462,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."
@@ -554,7 +535,13 @@ case we return nil."
          ((eq (car new-faces) 'default)
           (cdr new-faces))
          (t
-          (append new-faces faces)))))
+          ;; 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.
@@ -632,14 +619,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