From 0fd40f8951f1aaa387e78999ecfbf6bc954ccf8a Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 19 Feb 2012 21:59:42 +0800 Subject: [PATCH] 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 --- lisp/ChangeLog | 15 +++++++++++++++ lisp/ansi-color.el | 40 +++++++++++++++++++++------------------- lisp/comint.el | 3 ++- lisp/shell.el | 11 ++++++++++- 4 files changed, 48 insertions(+), 21 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5455d4320f..cc5851373b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,18 @@ +2012-02-19 Chong Yidong + + * 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 * 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 aaea903de5..15a543e959 100644 --- 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 975291471d..4c2229f2f8 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -103,6 +103,7 @@ (eval-when-compile (require 'cl)) (require 'ring) +(require 'ansi-color) ;; 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 b4b388655c..1ed4386345 100644 --- 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*")) -- 2.20.1