aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorChong Yidong2012-02-19 21:59:42 +0800
committerChong Yidong2012-02-19 21:59:42 +0800
commit0fd40f8951f1aaa387e78999ecfbf6bc954ccf8a (patch)
tree48386211397064dd0eb1bc47fb0a292e3ad4e19f
parent2375c96a71874756c132de1d0508a224c0fea0ab (diff)
downloademacs-0fd40f8951f1aaa387e78999ecfbf6bc954ccf8a.tar.gz
emacs-0fd40f8951f1aaa387e78999ecfbf6bc954ccf8a.zip
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
-rw-r--r--lisp/ChangeLog15
-rw-r--r--lisp/ansi-color.el40
-rw-r--r--lisp/comint.el3
-rw-r--r--lisp/shell.el11
4 files changed, 48 insertions, 21 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5455d4320f8..cc5851373b0 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,20 @@
12012-02-19 Chong Yidong <cyd@gnu.org> 12012-02-19 Chong Yidong <cyd@gnu.org>
2 2
3 * comint.el: Require ansi-color.
4 (comint-output-filter-functions): Add ansi-color-process-output.
5
6 * ansi-color.el: Don't set comint-output-filter-functions; it is
7 now in the initial value defined in comint.el.
8 (ansi-color-apply-face-function): New variable.
9 (ansi-color-apply-on-region): Use it.
10 (ansi-color-apply-overlay-face): New function.
11
12 * shell.el (shell): No need to require ansi-color.
13 (shell-mode): Use ansi-color-apply-face-function to highlight
14 color escapes using font-lock-face property (Bug#10835).
15
162012-02-19 Chong Yidong <cyd@gnu.org>
17
3 * vc/ediff-init.el (ediff-strip-mode-line-format): Handle non-list 18 * vc/ediff-init.el (ediff-strip-mode-line-format): Handle non-list
4 mode-line formats (Bug#10839). 19 mode-line formats (Bug#10839).
5 20
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index aaea903de56..15a543e9591 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:
183 :group 'ansi-colors 183 :group 'ansi-colors
184 :version "23.2") 184 :version "23.2")
185 185
186(defvar ansi-color-apply-face-function 'ansi-color-apply-overlay-face
187 "Function for applying an Ansi Color face to text in a buffer.
188This function should accept three arguments: BEG, END, and FACE,
189and it should apply face FACE to the text between BEG and END.")
190
186;;;###autoload 191;;;###autoload
187(defun ansi-color-for-comint-mode-on () 192(defun ansi-color-for-comint-mode-on ()
188 "Set `ansi-color-for-comint-mode' to t." 193 "Set `ansi-color-for-comint-mode' to t."
@@ -221,9 +226,6 @@ This is a good function to put in `comint-output-filter-functions'."
221 (t 226 (t
222 (ansi-color-apply-on-region start-marker end-marker))))) 227 (ansi-color-apply-on-region start-marker end-marker)))))
223 228
224(add-hook 'comint-output-filter-functions
225 'ansi-color-process-output)
226
227(defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region) 229(defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region)
228(make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1") 230(make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1")
229 231
@@ -379,10 +381,9 @@ start of the region and set the face with which to start. Set
379 ;; Find the next SGR sequence. 381 ;; Find the next SGR sequence.
380 (while (re-search-forward ansi-color-regexp end-marker t) 382 (while (re-search-forward ansi-color-regexp end-marker t)
381 ;; Colorize the old block from start to end using old face. 383 ;; Colorize the old block from start to end using old face.
382 (when face 384 (funcall ansi-color-apply-face-function
383 (ansi-color-set-extent-face 385 start-marker (match-beginning 0)
384 (ansi-color-make-extent start-marker (match-beginning 0)) 386 face)
385 face))
386 ;; store escape sequence and new start position 387 ;; store escape sequence and new start position
387 (setq escape-sequence (match-string 1) 388 (setq escape-sequence (match-string 1)
388 start-marker (copy-marker (match-end 0))) 389 start-marker (copy-marker (match-end 0)))
@@ -395,22 +396,23 @@ start of the region and set the face with which to start. Set
395 (if (re-search-forward "\033" end-marker t) 396 (if (re-search-forward "\033" end-marker t)
396 (progn 397 (progn
397 ;; if the rest of the region should have a face, put it there 398 ;; if the rest of the region should have a face, put it there
398 (when face 399 (funcall ansi-color-apply-face-function
399 (ansi-color-set-extent-face 400 start-marker (point) face)
400 (ansi-color-make-extent start-marker (point))
401 face))
402 ;; save face and point 401 ;; save face and point
403 (setq ansi-color-context-region 402 (setq ansi-color-context-region
404 (list face (copy-marker (match-beginning 0))))) 403 (list face (copy-marker (match-beginning 0)))))
405 ;; if the rest of the region should have a face, put it there 404 ;; if the rest of the region should have a face, put it there
406 (if face 405 (funcall ansi-color-apply-face-function
407 (progn 406 start-marker end-marker face)
408 (ansi-color-set-extent-face 407 (setq ansi-color-context-region (if face (list face)))))))
409 (ansi-color-make-extent start-marker end-marker) 408
410 face) 409(defun ansi-color-apply-overlay-face (beg end face)
411 (setq ansi-color-context-region (list face))) 410 "Make an overlay from BEG to END, and apply face FACE.
412 ;; reset context 411If FACE is nil, do nothing."
413 (setq ansi-color-context-region nil)))))) 412 (when face
413 (ansi-color-set-extent-face
414 (ansi-color-make-extent beg end)
415 face)))
414 416
415;; This function helps you look for overlapping overlays. This is 417;; This function helps you look for overlapping overlays. This is
416;; useful in comint-buffers. Overlapping overlays should not happen! 418;; useful in comint-buffers. Overlapping overlays should not happen!
diff --git a/lisp/comint.el b/lisp/comint.el
index 975291471df..4c2229f2f83 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -103,6 +103,7 @@
103 103
104(eval-when-compile (require 'cl)) 104(eval-when-compile (require 'cl))
105(require 'ring) 105(require 'ring)
106(require 'ansi-color)
106 107
107;; Buffer Local Variables: 108;; Buffer Local Variables:
108;;============================================================================ 109;;============================================================================
@@ -385,7 +386,7 @@ history list. Default is to save anything that isn't all whitespace.")
385These functions get one argument, a string containing the text to send.") 386These functions get one argument, a string containing the text to send.")
386 387
387;;;###autoload 388;;;###autoload
388(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) 389(defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)
389 "Functions to call after output is inserted into the buffer. 390 "Functions to call after output is inserted into the buffer.
390One possible function is `comint-postoutput-scroll-to-bottom'. 391One possible function is `comint-postoutput-scroll-to-bottom'.
391These functions get one argument, a string containing the text as originally 392These functions get one argument, a string containing the text as originally
diff --git a/lisp/shell.el b/lisp/shell.el
index b4b388655c8..1ed43863452 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -510,6 +510,16 @@ buffer."
510 (set (make-local-variable 'shell-dirstack) nil) 510 (set (make-local-variable 'shell-dirstack) nil)
511 (set (make-local-variable 'shell-last-dir) nil) 511 (set (make-local-variable 'shell-last-dir) nil)
512 (shell-dirtrack-mode 1) 512 (shell-dirtrack-mode 1)
513
514 ;; By default, ansi-color applies faces using overlays. This is
515 ;; very inefficient in Shell buffers (e.g. Bug#10835). We use a
516 ;; custom `ansi-color-apply-face-function' to convert color escape
517 ;; sequences into `font-lock-face' properties.
518 (set (make-local-variable 'ansi-color-apply-face-function)
519 (lambda (beg end face)
520 (when face
521 (put-text-property beg end 'font-lock-face face))))
522
513 ;; This is not really correct, since the shell buffer does not really 523 ;; This is not really correct, since the shell buffer does not really
514 ;; edit this directory. But it is useful in the buffer list and menus. 524 ;; edit this directory. But it is useful in the buffer list and menus.
515 (setq list-buffers-directory (expand-file-name default-directory)) 525 (setq list-buffers-directory (expand-file-name default-directory))
@@ -625,7 +635,6 @@ Otherwise, one argument `-i' is passed to the shell.
625 (read-directory-name 635 (read-directory-name
626 "Default directory: " default-directory default-directory 636 "Default directory: " default-directory default-directory
627 t nil)))))))) 637 t nil))))))))
628 (require 'ansi-color)
629 (setq buffer (if (or buffer (not (derived-mode-p 'shell-mode)) 638 (setq buffer (if (or buffer (not (derived-mode-p 'shell-mode))
630 (comint-check-proc (current-buffer))) 639 (comint-check-proc (current-buffer)))
631 (get-buffer-create (or buffer "*shell*")) 640 (get-buffer-create (or buffer "*shell*"))