Use text properties for color escape highlighting in Shell mode.

* ansi-color.el: Don't set comint-output-filter-functions; it is
now in the initial value defined in comint.el.
(ansi-color-apply-face-function): New variable.
(ansi-color-apply-on-region): Use it.
(ansi-color-apply-overlay-face): New function.

* comint.el: Require ansi-color.
(comint-output-filter-functions): Add ansi-color-process-output.

* shell.el (shell): No need to require ansi-color.
(shell-mode): Use ansi-color-apply-face-function to highlight
color escapes using font-lock-face property.

Fixes: debbugs:10835

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5455d4320f851b27686338885d1b9697ca644231..cc5851373b06618c9f3dbe0c28b6b48fe0e833ce 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,18 @@
+2012-02-19  Chong Yidong  <cyd@gnu.org>
+
+       * comint.el: Require ansi-color.
+       (comint-output-filter-functions): Add ansi-color-process-output.
+
+       * ansi-color.el: Don't set comint-output-filter-functions; it is
+       now in the initial value defined in comint.el.
+       (ansi-color-apply-face-function): New variable.
+       (ansi-color-apply-on-region): Use it.
+       (ansi-color-apply-overlay-face): New function.
+
+       * shell.el (shell): No need to require ansi-color.
+       (shell-mode): Use ansi-color-apply-face-function to highlight
+       color escapes using font-lock-face property (Bug#10835).
+
 2012-02-19  Chong Yidong  <cyd@gnu.org>
 
        * vc/ediff-init.el (ediff-strip-mode-line-format): Handle non-list

diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index aaea903de56bc2b7eb4aa9b6309d0c1f021f7431..15a543e959194eba935402fb11c123b131612cf1 100644 (file)
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -183,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."
@@ -221,9 +226,6 @@ 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)
-
 (defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region)
 (make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1")
 
@@ -379,10 +381,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)))
@@ -395,22 +396,23 @@ 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
 ;; useful in comint-buffers.  Overlapping overlays should not happen!

diff --git a/lisp/comint.el b/lisp/comint.el
index 975291471df62ed23855e3805c4f04a5df1c7bd8..4c2229f2f838e0e8975b1dc082d139ad4e9dc6f0 100644 (file)
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -103,6 +103,7 @@
 
 (eval-when-compile (require 'cl))
 (require 'ring)
+(require 'ansi-color)
 \f
 ;; Buffer Local Variables:
 ;;============================================================================
@@ -385,7 +386,7 @@ history list.  Default is to save anything that isn't all whitespace.")
 These functions get one argument, a string containing the text to send.")
 
 ;;;###autoload
-(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)
+(defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)
   "Functions to call after output is inserted into the buffer.
 One possible function is `comint-postoutput-scroll-to-bottom'.
 These functions get one argument, a string containing the text as originally

diff --git a/lisp/shell.el b/lisp/shell.el
index b4b388655c8e451983f2398ab357e20549d60b9f..1ed43863452dec99477ed788c980fd64850bd492 100644 (file)
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -510,6 +510,16 @@ buffer."
   (set (make-local-variable 'shell-dirstack) nil)
   (set (make-local-variable 'shell-last-dir) nil)
   (shell-dirtrack-mode 1)
+
+  ;; By default, ansi-color applies faces using overlays.  This is
+  ;; very inefficient in Shell buffers (e.g. Bug#10835).  We use a
+  ;; custom `ansi-color-apply-face-function' to convert color escape
+  ;; sequences into `font-lock-face' properties.
+  (set (make-local-variable 'ansi-color-apply-face-function)
+       (lambda (beg end face)
+        (when face
+          (put-text-property beg end 'font-lock-face face))))
+
   ;; This is not really correct, since the shell buffer does not really
   ;; edit this directory.  But it is useful in the buffer list and menus.
   (setq list-buffers-directory (expand-file-name default-directory))
@@ -625,7 +635,6 @@ Otherwise, one argument `-i' is passed to the shell.
                      (read-directory-name
                       "Default directory: " default-directory default-directory
                       t nil))))))))
-  (require 'ansi-color)
   (setq buffer (if (or buffer (not (derived-mode-p 'shell-mode))
                        (comint-check-proc (current-buffer)))
                    (get-buffer-create (or buffer "*shell*"))