Mercurial > emacs
annotate lisp/ansi-color.el @ 34042:f933093476c2
*** empty log message ***
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Thu, 30 Nov 2000 13:01:40 +0000 |
parents | 5ad18c4ebe5c |
children | 75a8ca0bdd1d |
rev | line source |
---|---|
31595 | 1 ;;; ansi-color.el --- translate ANSI into text-properties |
25171 | 2 |
31595 | 3 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. |
25171 | 4 |
26092 | 5 ;; Author: Alex Schroeder <alex@gnu.org> |
6 ;; Maintainer: Alex Schroeder <alex@gnu.org> | |
31595 | 7 ;; Version: 2.4.0 |
25171 | 8 ;; Keywords: comm processes |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify it | |
13 ;; under the terms of the GNU General Public License as published by the | |
14 ;; Free Software Foundation; either version 2, or (at your option) any | |
15 ;; later version. | |
16 ;; | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, but | |
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
20 ;; General Public License for more details. | |
21 ;; | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 ;; Boston, MA 02111-1307, USA. | |
26 | |
27 ;;; Commentary: | |
28 | |
31595 | 29 ;; This file provides a function that takes a string containing Select |
30 ;; Graphic Rendition (SGR) control sequences (formerly known as ANSI | |
31 ;; escape sequences) and tries to replace these with text-properties. | |
25171 | 32 ;; |
31595 | 33 ;; This allows you to run ls --color=yes in shell-mode: If |
34 ;; `ansi-color-for-shell-mode' is non-nil, the SGR control sequences are | |
35 ;; translated into text-properties, colorizing the ls output. If | |
36 ;; `ansi-color-for-shell-mode' is nil, the SGR control sequences are | |
37 ;; stripped, making the ls output legible. | |
25171 | 38 ;; |
31595 | 39 ;; SGR control sequences are defined in section 3.8.117 of the ECMA-48 |
40 ;; standard (identical to ISO/IEC 6429), which is freely available as a | |
41 ;; PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>. The | |
42 ;; "Graphic Rendition Combination Mode (GRCM)" implemented is | |
43 ;; "cumulative mode" as defined in section 7.2.8. Cumulative mode means | |
44 ;; that whenever possible, SGR control sequences are combined (ie. blue | |
45 ;; and bold). | |
25171 | 46 |
31595 | 47 ;; The basic functions are: |
25171 | 48 ;; |
31595 | 49 ;; `ansi-color-apply' to colorize a string containing SGR control |
50 ;; sequences. | |
51 ;; | |
52 ;; `ansi-color-filter-apply' to filter SGR control sequences from a | |
53 ;; string. | |
54 ;; | |
55 ;; `ansi-color-apply-on-region' to colorize a region containing SGR | |
56 ;; control sequences. | |
57 ;; | |
58 ;; `ansi-color-filter-region' to filter SGR control sequences from a | |
59 ;; region. | |
26092 | 60 |
31595 | 61 ;; Instead of defining lots of new faces, this package uses |
62 ;; text-properties as described in the elisp manual | |
63 ;; *Note (elisp)Special Properties::. | |
64 | |
65 ;;; Thanks | |
26092 | 66 |
31595 | 67 ;; Georges Brun-Cottan <gbruncot@emc.com> for improving ansi-color.el |
68 ;; substantially by adding the code needed to cope with arbitrary chunks | |
69 ;; of output and the filter functions. | |
70 ;; | |
71 ;; Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk> for pointing me to ECMA-48. | |
25171 | 72 |
73 | |
74 | |
75 ;;; Code: | |
76 | |
26092 | 77 ;; Customization |
78 | |
31595 | 79 (defgroup ansi-colors nil |
80 "Translating SGR control sequences to text-properties. | |
81 This translation effectively colorizes strings and regions based upon | |
82 SGR control sequences embedded in the text. SGR (Select Graphic | |
83 Rendition) control sequences are defined in section 3.8.117 of the | |
84 ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available | |
85 as a PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>." | |
86 :version "20.7" | |
87 :group 'processes) | |
88 | |
89 (defcustom ansi-color-faces-vector | |
90 [default bold default italic underline bold bold-italic modeline] | |
91 "Faces used for SGR control sequences determining a face. | |
92 This vector holds the faces used for SGR control sequence parameters 0 | |
93 to 7. | |
25171 | 94 |
31595 | 95 Parameter Description Face used by default |
96 0 default default | |
97 1 bold bold | |
98 2 faint default | |
99 3 italic italic | |
100 4 underlined underline | |
101 5 slowly blinking bold | |
102 6 rapidly blinking bold-italic | |
103 7 negative image modeline | |
25171 | 104 |
31595 | 105 This vector is used by `ansi-color-make-color-map' to create a color |
106 map. This color map is stored in the variable `ansi-color-map'." | |
107 :type '(vector face face face face face face face face) | |
108 :set 'ansi-color-map-update | |
109 :initialize 'custom-initialize-default | |
110 :group 'ansi-colors) | |
111 | |
112 (defcustom ansi-color-names-vector | |
25171 | 113 ["black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"] |
31595 | 114 "Colors used for SGR control sequences determining a color. |
115 This vector holds the colors used for SGR control sequences parameters | |
116 30 to 37 \(foreground colors) and 40 to 47 (background colors). | |
117 | |
118 Parameter Color | |
119 30 40 black | |
120 31 41 red | |
121 32 42 green | |
122 33 43 yellow | |
123 34 44 blue | |
124 35 45 magenta | |
125 36 46 cyan | |
126 37 47 white | |
25171 | 127 |
31595 | 128 This vector is used by `ansi-color-make-color-map' to create a color |
129 map. This color map is stored in the variable `ansi-color-map'." | |
130 :type '(vector string string string string string string string string) | |
131 :set 'ansi-color-map-update | |
132 :initialize 'custom-initialize-default | |
133 :group 'ansi-colors) | |
134 | |
135 (defcustom ansi-color-for-shell-mode nil | |
136 "Determine wether font-lock or ansi-color get to fontify shell buffers. | |
137 | |
138 If non-nil and `global-font-lock-mode' is non-nil, ansi-color will be | |
139 used. This adds `ansi-color-apply' to | |
140 `comint-preoutput-filter-functions' and removes | |
141 `ansi-color-filter-apply' for all shell-mode buffers. | |
142 | |
143 If non-nil and global-font-lock-mode is nil, both `ansi-color-apply' and | |
144 `ansi-color-filter-apply' will be removed from | |
145 `comint-preoutput-filter-functions' for all shell-mode buffers. | |
25171 | 146 |
31595 | 147 If nil, font-lock will be used (if it is enabled). This adds |
148 `ansi-color-filter-apply' to `comint-preoutput-filter-functions' and | |
149 removes `ansi-color-apply' for all shell-mode buffers." | |
150 :version "20.8" | |
151 :type 'boolean | |
152 :set (function (lambda (symbol value) | |
153 (set-default symbol value) | |
154 (save-excursion | |
155 (let ((buffers (buffer-list)) | |
156 buffer) | |
157 (while buffers | |
158 (setq buffer (car buffers) | |
159 buffers (cdr buffers)) | |
160 (set-buffer buffer) | |
161 (when (eq major-mode 'shell-mode) | |
162 (if value | |
163 (if global-font-lock-mode | |
164 (progn | |
165 (font-lock-mode 0) | |
166 (remove-hook 'comint-preoutput-filter-functions | |
167 'ansi-color-filter-apply) | |
168 (add-hook 'comint-preoutput-filter-functions | |
169 'ansi-color-apply)) | |
170 (remove-hook 'comint-preoutput-filter-functions | |
171 'ansi-color-filter-apply) | |
172 (remove-hook 'comint-preoutput-filter-functions | |
173 'ansi-color-apply)) | |
174 (if global-font-lock-mode | |
175 (font-lock-mode 1)) | |
176 (remove-hook 'comint-preoutput-filter-functions | |
177 'ansi-color-apply) | |
178 (add-hook 'comint-preoutput-filter-functions | |
179 'ansi-color-filter-apply)))))))) | |
180 :initialize 'custom-initialize-reset | |
181 :group 'ansi-colors) | |
182 | |
183 (defconst ansi-color-regexp "\033\\[\\([0-9;]*\\)m" | |
184 "Regexp that matches SGR control sequences.") | |
185 | |
186 (defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]" | |
187 "Regexp that matches SGR control sequence parameters.") | |
188 | |
189 | |
190 ;; Main functions | |
25171 | 191 |
31595 | 192 |
193 (defun ansi-color-filter-apply (s) | |
194 "Filter out all SGR control sequences from S. | |
195 | |
196 This function can be added to `comint-preoutput-filter-functions'." | |
197 (while (string-match ansi-color-regexp s) | |
198 (setq s (replace-match "" t t s))) | |
199 s) | |
200 | |
201 | |
202 (defun ansi-color-filter-region (begin end) | |
203 "Filter out all SGR control sequences from region START END. | |
204 | |
205 Returns the first point it is safe to start with. Used to speedup | |
206 further processing. | |
207 | |
208 Design to cope with arbitrary chunk of output such as the ones get by | |
209 comint-output-filter-functions, e.g.: | |
210 | |
211 \(defvar last-context nil) | |
212 \(make-variable-buffer-local 'last-context) | |
25171 | 213 |
31595 | 214 \(defun filter-out-color-in-buffer (s) |
215 \(setq last-context | |
216 \(ansi-color-filter-region | |
217 \(if last-context | |
218 last-context | |
219 \(if (marker-position comint-last-output-start) | |
220 \(marker-position comint-last-output-start) | |
221 1)) | |
222 \(marker-position (process-mark (get-buffer-process (current-buffer)))) )) | |
223 s) | |
224 | |
225 \(add-hook 'comint-output-filter-functions 'filter-out-color-in-buffer) | |
226 " | |
227 (let ((endm (copy-marker end))) | |
228 (save-excursion | |
229 (goto-char begin) | |
230 (while (re-search-forward ansi-color-regexp endm t) | |
231 (replace-match "")) | |
232 (if (re-search-forward "\033" endm t) | |
233 (match-beginning 0) | |
234 (marker-position endm))))) | |
235 | |
25171 | 236 |
26092 | 237 (defun ansi-color-apply (string) |
31595 | 238 "Translates SGR control sequences into text-properties. |
26092 | 239 |
31595 | 240 Applies SGR control sequences setting foreground and background colors |
26092 | 241 to STRING and returns the result. The colors used are given in |
242 `ansi-color-faces-vector' and `ansi-color-names-vector'. | |
25171 | 243 |
26092 | 244 This function can be added to `comint-preoutput-filter-functions'." |
31595 | 245 (let (face (start 0) end escape-sequence null-sequence result) |
26092 | 246 ;; find the next escape sequence |
31595 | 247 (while (setq end (string-match ansi-color-regexp string start)) |
26092 | 248 ;; store escape sequence |
31595 | 249 (setq escape-sequence (match-string 1 string) |
250 null-sequence (string-equal escape-sequence "")) | |
26092 | 251 ;; colorize the old block from start to end using old face |
252 (if face | |
253 (put-text-property start end 'face face string)) | |
31595 | 254 (setq result (concat result (substring string start end)) |
255 start (match-end 0)) | |
26092 | 256 ;; create new face by applying all the parameters in the escape sequence |
31595 | 257 (if null-sequence |
258 (setq face nil) | |
259 (setq face (ansi-color-get-face escape-sequence)))) | |
26092 | 260 (concat result (substring string start)))) |
25171 | 261 |
31595 | 262 |
263 (defun ansi-color-apply-on-region (begin end &optional context) | |
264 "Translates SGR control sequences into text-properties. | |
265 | |
266 Applies SGR control sequences setting foreground and background colors | |
267 to text in region. The colors used are given in | |
268 `ansi-color-faces-vector' and `ansi-color-names-vector'. | |
269 Returns a context than can be used to speedup further processing. | |
270 Context is a (begin (start . face)) list. | |
271 | |
272 Design to cope with arbitrary chunk of output such as the ones get by | |
273 comint-output-filter-functions, e.g.: | |
274 | |
275 \(defvar last-context nil) | |
276 \(make-variable-buffer-local 'last-context) | |
277 | |
278 \(defun ansi-output-filter (s) | |
279 \(setq last-context | |
280 \(ansi-color-apply-on-region | |
281 \(if last-context | |
282 \(car last-context) | |
283 \(if (marker-position comint-last-output-start) | |
284 \(marker-position comint-last-output-start) | |
285 1)) | |
286 \(process-mark (get-buffer-process (current-buffer))) | |
287 last-context )) | |
288 s) | |
289 | |
290 \(add-hook 'comint-output-filter-functions 'ansi-output-filter) | |
291 " | |
292 (let ((endm (copy-marker end)) | |
293 (face (if (and context (cdr context)) | |
294 (cdr (cdr context)))) | |
295 (face-start (if (and context (cdr context)) | |
296 (car (cdr context)))) | |
297 (next-safe-start begin) | |
298 escape-sequence | |
299 null-sequence | |
300 stop ) | |
301 (save-excursion | |
302 (goto-char begin) | |
303 ;; find the next escape sequence | |
304 (while (setq stop (re-search-forward ansi-color-regexp endm t)) | |
305 ;; store escape sequence | |
306 (setq escape-sequence (match-string 1)) | |
307 (setq null-sequence (string-equal (match-string 1) "")) | |
308 (setq next-safe-start (match-beginning 0)) | |
309 (if face | |
310 (put-text-property face-start next-safe-start 'face face)) ; colorize | |
311 (replace-match "") ; delete the ANSI sequence | |
312 (if null-sequence | |
313 (setq face nil) | |
314 (setq face-start next-safe-start) | |
315 (setq face (ansi-color-get-face escape-sequence)))) | |
316 (setq next-safe-start | |
317 (if (re-search-forward "\033" endm t) | |
318 (match-beginning 0) | |
319 (marker-position endm)))) | |
320 (cons next-safe-start | |
321 (if face | |
322 (cons face-start face))) )) | |
323 | |
26092 | 324 ;; Helper functions |
325 | |
31595 | 326 (defun ansi-color-make-color-map () |
327 "Creates a vector of face definitions and returns it. | |
328 | |
329 The index into the vector is an ANSI code. See the documentation of | |
330 `ansi-color-map' for an example. | |
331 | |
332 The face definitions are based upon the variables | |
333 `ansi-color-faces-vector' and `ansi-color-names-vector'." | |
334 (let ((ansi-color-map (make-vector 50 nil)) | |
335 (index 0)) | |
336 ;; miscellaneous attributes | |
337 (mapcar | |
338 (function (lambda (e) | |
339 (aset ansi-color-map index e) | |
340 (setq index (1+ index)) )) | |
341 ansi-color-faces-vector) | |
342 | |
343 ;; foreground attributes | |
344 (setq index 30) | |
345 (mapcar | |
346 (function (lambda (e) | |
347 (aset ansi-color-map index | |
348 (cons 'foreground-color e)) | |
349 (setq index (1+ index)) )) | |
350 ansi-color-names-vector) | |
351 | |
352 ;; background attributes | |
353 (setq index 40) | |
354 (mapcar | |
355 (function (lambda (e) | |
356 (aset ansi-color-map index | |
357 (cons 'background-color e)) | |
358 (setq index (1+ index)) )) | |
359 ansi-color-names-vector) | |
360 ansi-color-map)) | |
361 | |
362 (defvar ansi-color-map (ansi-color-make-color-map) | |
363 "A brand new color map suitable for ansi-color-get-face. | |
25225
38f98813a83d
(ansi-color-to-text-properties): Added New state 5
Karl Heuer <kwzh@gnu.org>
parents:
25171
diff
changeset
|
364 |
31595 | 365 The value of this variable is usually constructed by |
366 `ansi-color-make-color-map'. The values in the array are such that the | |
367 numbers included in an SGR control sequences point to the correct | |
368 foreground or background colors. | |
369 | |
370 Example: The sequence \033[34m specifies a blue foreground. Therefore: | |
371 (aref ansi-color-map 34) | |
372 => \(foreground-color . \"blue\")") | |
373 | |
374 (defun ansi-color-map-update (symbol value) | |
375 "Update `ansi-color-map'. | |
376 | |
377 Whenever the vectors used to construct `ansi-color-map' are changed, | |
378 this function is called. Therefore this function is listed as the :set | |
379 property of `ansi-color-faces-vector' and `ansi-color-names-vector'." | |
380 (set-default symbol value) | |
381 (setq ansi-color-map (ansi-color-make-color-map))) | |
382 | |
383 (defun ansi-color-get-face-1 (ansi-code) | |
384 "Get face definition from `ansi-color-map'. | |
385 ANSI-CODE is used as an index into the vector." | |
386 (condition-case nil | |
387 (aref ansi-color-map ansi-code) | |
388 ('args-out-of-range nil))) | |
389 | |
390 (defun ansi-color-get-face (escape-seq) | |
391 "Create a new face by applying all the parameters in ESCAPE-SEQ. | |
392 | |
393 ESCAPE-SEQ is a SGR control sequences such as \033[34m. The parameter | |
394 34 is used by `ansi-color-get-face-1' to return a face definition." | |
395 (let ((ansi-color-r "[0-9][0-9]?") | |
396 (i 0) | |
397 f) | |
398 (while (string-match ansi-color-r escape-seq i) | |
399 (setq i (match-end 0)) | |
400 (add-to-list 'f | |
401 (ansi-color-get-face-1 | |
402 (string-to-int (match-string 0 escape-seq) 10)))) | |
403 f)) | |
25171 | 404 |
405 (provide 'ansi-color) | |
406 | |
26092 | 407 ;;; ansi-color.el ends here |