|
35160
|
1 ;;; ansi-color.el --- translate ANSI escape sequences into faces
|
|
25171
|
2
|
|
64762
|
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
|
|
75347
|
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
|
|
25171
|
5
|
|
26092
|
6 ;; Author: Alex Schroeder <alex@gnu.org>
|
|
|
7 ;; Maintainer: Alex Schroeder <alex@gnu.org>
|
|
35305
|
8 ;; Version: 3.4.2
|
|
|
9 ;; Keywords: comm processes terminals services
|
|
25171
|
10
|
|
|
11 ;; This file is part of GNU Emacs.
|
|
|
12
|
|
|
13 ;; GNU Emacs is free software; you can redistribute it and/or modify it
|
|
|
14 ;; under the terms of the GNU General Public License as published by the
|
|
|
15 ;; Free Software Foundation; either version 2, or (at your option) any
|
|
|
16 ;; later version.
|
|
|
17 ;;
|
|
|
18 ;; GNU Emacs is distributed in the hope that it will be useful, but
|
|
|
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
21 ;; General Public License for more details.
|
|
|
22 ;;
|
|
|
23 ;; You should have received a copy of the GNU General Public License
|
|
|
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
64091
|
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
|
26 ;; Boston, MA 02110-1301, USA.
|
|
25171
|
27
|
|
|
28 ;;; Commentary:
|
|
|
29
|
|
35160
|
30 ;; This file provides a function that takes a string or a region
|
|
|
31 ;; containing Select Graphic Rendition (SGR) control sequences (formerly
|
|
|
32 ;; known as ANSI escape sequences) and tries to translate these into
|
|
|
33 ;; faces.
|
|
|
34 ;;
|
|
|
35 ;; This allows you to run ls --color=yes in shell-mode. In order to
|
|
|
36 ;; test this, proceed as follows:
|
|
25171
|
37 ;;
|
|
35160
|
38 ;; 1. start a shell: M-x shell
|
|
|
39 ;; 2. load this file: M-x load-library RET ansi-color RET
|
|
|
40 ;; 3. activate ansi-color: M-x ansi-color-for-comint-mode-on
|
|
|
41 ;; 4. test ls --color=yes in the *shell* buffer
|
|
|
42 ;;
|
|
|
43 ;; Note that starting your shell from within Emacs might set the TERM
|
|
|
44 ;; environment variable. The new setting might disable the output of
|
|
|
45 ;; SGR control sequences. Using ls --color=yes forces ls to produce
|
|
|
46 ;; these.
|
|
|
47 ;;
|
|
|
48 ;; If you decide you like this, add the following to your .emacs file:
|
|
|
49 ;;
|
|
|
50 ;; (add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)
|
|
25171
|
51 ;;
|
|
31595
|
52 ;; SGR control sequences are defined in section 3.8.117 of the ECMA-48
|
|
|
53 ;; standard (identical to ISO/IEC 6429), which is freely available as a
|
|
|
54 ;; PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>. The
|
|
|
55 ;; "Graphic Rendition Combination Mode (GRCM)" implemented is
|
|
|
56 ;; "cumulative mode" as defined in section 7.2.8. Cumulative mode means
|
|
|
57 ;; that whenever possible, SGR control sequences are combined (ie. blue
|
|
|
58 ;; and bold).
|
|
25171
|
59
|
|
31595
|
60 ;; The basic functions are:
|
|
25171
|
61 ;;
|
|
31595
|
62 ;; `ansi-color-apply' to colorize a string containing SGR control
|
|
|
63 ;; sequences.
|
|
|
64 ;;
|
|
|
65 ;; `ansi-color-filter-apply' to filter SGR control sequences from a
|
|
|
66 ;; string.
|
|
|
67 ;;
|
|
|
68 ;; `ansi-color-apply-on-region' to colorize a region containing SGR
|
|
|
69 ;; control sequences.
|
|
|
70 ;;
|
|
|
71 ;; `ansi-color-filter-region' to filter SGR control sequences from a
|
|
|
72 ;; region.
|
|
26092
|
73
|
|
31595
|
74 ;;; Thanks
|
|
26092
|
75
|
|
31595
|
76 ;; Georges Brun-Cottan <gbruncot@emc.com> for improving ansi-color.el
|
|
|
77 ;; substantially by adding the code needed to cope with arbitrary chunks
|
|
|
78 ;; of output and the filter functions.
|
|
|
79 ;;
|
|
|
80 ;; Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk> for pointing me to ECMA-48.
|
|
35160
|
81 ;;
|
|
|
82 ;; Stefan Monnier <foo@acm.com> explaing obscure font-lock stuff and
|
|
|
83 ;; code suggestions.
|
|
25171
|
84
|
|
|
85
|
|
|
86
|
|
|
87 ;;; Code:
|
|
|
88
|
|
65285
|
89 (defvar comint-last-output-start)
|
|
|
90
|
|
26092
|
91 ;; Customization
|
|
|
92
|
|
31595
|
93 (defgroup ansi-colors nil
|
|
35160
|
94 "Translating SGR control sequences to faces.
|
|
31595
|
95 This translation effectively colorizes strings and regions based upon
|
|
|
96 SGR control sequences embedded in the text. SGR (Select Graphic
|
|
|
97 Rendition) control sequences are defined in section 3.8.117 of the
|
|
|
98 ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available
|
|
|
99 as a PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>."
|
|
35207
|
100 :version "21.1"
|
|
31595
|
101 :group 'processes)
|
|
|
102
|
|
|
103 (defcustom ansi-color-faces-vector
|
|
|
104 [default bold default italic underline bold bold-italic modeline]
|
|
|
105 "Faces used for SGR control sequences determining a face.
|
|
|
106 This vector holds the faces used for SGR control sequence parameters 0
|
|
|
107 to 7.
|
|
25171
|
108
|
|
31595
|
109 Parameter Description Face used by default
|
|
|
110 0 default default
|
|
|
111 1 bold bold
|
|
|
112 2 faint default
|
|
|
113 3 italic italic
|
|
|
114 4 underlined underline
|
|
|
115 5 slowly blinking bold
|
|
|
116 6 rapidly blinking bold-italic
|
|
|
117 7 negative image modeline
|
|
25171
|
118
|
|
35160
|
119 Note that the symbol `default' is special: It will not be combined
|
|
|
120 with the current face.
|
|
|
121
|
|
31595
|
122 This vector is used by `ansi-color-make-color-map' to create a color
|
|
|
123 map. This color map is stored in the variable `ansi-color-map'."
|
|
|
124 :type '(vector face face face face face face face face)
|
|
|
125 :set 'ansi-color-map-update
|
|
|
126 :initialize 'custom-initialize-default
|
|
|
127 :group 'ansi-colors)
|
|
|
128
|
|
|
129 (defcustom ansi-color-names-vector
|
|
25171
|
130 ["black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"]
|
|
31595
|
131 "Colors used for SGR control sequences determining a color.
|
|
|
132 This vector holds the colors used for SGR control sequences parameters
|
|
|
133 30 to 37 \(foreground colors) and 40 to 47 (background colors).
|
|
|
134
|
|
|
135 Parameter Color
|
|
|
136 30 40 black
|
|
|
137 31 41 red
|
|
|
138 32 42 green
|
|
|
139 33 43 yellow
|
|
|
140 34 44 blue
|
|
|
141 35 45 magenta
|
|
|
142 36 46 cyan
|
|
|
143 37 47 white
|
|
25171
|
144
|
|
31595
|
145 This vector is used by `ansi-color-make-color-map' to create a color
|
|
|
146 map. This color map is stored in the variable `ansi-color-map'."
|
|
|
147 :type '(vector string string string string string string string string)
|
|
|
148 :set 'ansi-color-map-update
|
|
|
149 :initialize 'custom-initialize-default
|
|
|
150 :group 'ansi-colors)
|
|
|
151
|
|
|
152 (defconst ansi-color-regexp "\033\\[\\([0-9;]*\\)m"
|
|
|
153 "Regexp that matches SGR control sequences.")
|
|
|
154
|
|
|
155 (defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"
|
|
|
156 "Regexp that matches SGR control sequence parameters.")
|
|
|
157
|
|
|
158
|
|
35160
|
159 ;; Convenience functions for comint modes (eg. shell-mode)
|
|
25171
|
160
|
|
31595
|
161
|
|
35160
|
162 (defcustom ansi-color-for-comint-mode nil
|
|
|
163 "Determines what to do with comint output.
|
|
|
164 If nil, do nothing.
|
|
|
165 If the symbol `filter', then filter all SGR control sequences.
|
|
|
166 If anything else (such as t), then translate SGR control sequences
|
|
|
167 into text-properties.
|
|
|
168
|
|
|
169 In order for this to have any effect, `ansi-color-process-output' must
|
|
|
170 be in `comint-output-filter-functions'.
|
|
|
171
|
|
|
172 This can be used to enable colorized ls --color=yes output
|
|
|
173 in shell buffers. You set this variable by calling one of:
|
|
|
174 \\[ansi-color-for-comint-mode-on]
|
|
|
175 \\[ansi-color-for-comint-mode-off]
|
|
|
176 \\[ansi-color-for-comint-mode-filter]"
|
|
|
177 :type '(choice (const :tag "Do nothing" nil)
|
|
|
178 (const :tag "Filter" filter)
|
|
|
179 (const :tag "Translate" t))
|
|
|
180 :group 'ansi-colors)
|
|
|
181
|
|
35686
|
182 ;;;###autoload
|
|
35160
|
183 (defun ansi-color-for-comint-mode-on ()
|
|
|
184 "Set `ansi-color-for-comint-mode' to t."
|
|
|
185 (interactive)
|
|
|
186 (setq ansi-color-for-comint-mode t))
|
|
|
187
|
|
|
188 (defun ansi-color-for-comint-mode-off ()
|
|
|
189 "Set `ansi-color-for-comint-mode' to nil."
|
|
|
190 (interactive)
|
|
|
191 (setq ansi-color-for-comint-mode nil))
|
|
31595
|
192
|
|
35160
|
193 (defun ansi-color-for-comint-mode-filter ()
|
|
|
194 "Set `ansi-color-for-comint-mode' to symbol `filter'."
|
|
|
195 (interactive)
|
|
|
196 (setq ansi-color-for-comint-mode 'filter))
|
|
|
197
|
|
35686
|
198 ;;;###autoload
|
|
35160
|
199 (defun ansi-color-process-output (string)
|
|
|
200 "Maybe translate SGR control sequences of comint output into text-properties.
|
|
|
201
|
|
|
202 Depending on variable `ansi-color-for-comint-mode' the comint output is
|
|
|
203 either not processed, SGR control sequences are filtered using
|
|
|
204 `ansi-color-filter-region', or SGR control sequences are translated into
|
|
|
205 text-properties using `ansi-color-apply-on-region'.
|
|
|
206
|
|
|
207 The comint output is assumed to lie between the marker
|
|
|
208 `comint-last-output-start' and the process-mark.
|
|
|
209
|
|
|
210 This is a good function to put in `comint-output-filter-functions'."
|
|
|
211 (let ((start-marker (or comint-last-output-start
|
|
|
212 (point-min-marker)))
|
|
|
213 (end-marker (process-mark (get-buffer-process (current-buffer)))))
|
|
|
214 (cond ((eq ansi-color-for-comint-mode nil))
|
|
|
215 ((eq ansi-color-for-comint-mode 'filter)
|
|
|
216 (ansi-color-filter-region start-marker end-marker))
|
|
|
217 (t
|
|
|
218 (ansi-color-apply-on-region start-marker end-marker)))))
|
|
|
219
|
|
|
220 (add-hook 'comint-output-filter-functions
|
|
|
221 'ansi-color-process-output)
|
|
|
222
|
|
|
223
|
|
35305
|
224 ;; Alternative font-lock-unfontify-region-function for Emacs only
|
|
31595
|
225
|
|
35160
|
226 (defun ansi-color-unfontify-region (beg end &rest xemacs-stuff)
|
|
35305
|
227 "Replacement function for `font-lock-default-unfontify-region'.
|
|
|
228
|
|
|
229 As text-properties are implemented using extents in XEmacs, this
|
|
|
230 function is probably not needed. In Emacs, however, things are a bit
|
|
|
231 different: When font-lock is active in a buffer, you cannot simply add
|
|
|
232 face text-properties to the buffer. Font-lock will remove the face
|
|
35160
|
233 text-property using `font-lock-unfontify-region-function'. If you want
|
|
|
234 to insert the strings returned by `ansi-color-apply' into such buffers,
|
|
|
235 you must set `font-lock-unfontify-region-function' to
|
|
|
236 `ansi-color-unfontify-region'. This function will not remove all face
|
|
|
237 text-properties unconditionally. It will keep the face text-properties
|
|
|
238 if the property `ansi-color' is set.
|
|
31595
|
239
|
|
35160
|
240 The region from BEG to END is unfontified. XEMACS-STUFF is ignored.
|
|
|
241
|
|
|
242 A possible way to install this would be:
|
|
25171
|
243
|
|
35160
|
244 \(add-hook 'font-lock-mode-hook
|
|
|
245 \(function (lambda ()
|
|
|
246 \(setq font-lock-unfontify-region-function
|
|
|
247 'ansi-color-unfontify-region))))"
|
|
59104
|
248 ;; Simplified now that font-lock-unfontify-region uses save-buffer-state.
|
|
|
249 (when (boundp 'font-lock-syntactic-keywords)
|
|
|
250 (remove-text-properties beg end '(syntax-table nil)))
|
|
|
251 ;; instead of just using (remove-text-properties beg end '(face
|
|
|
252 ;; nil)), we find regions with a non-nil face test-property, skip
|
|
|
253 ;; positions with the ansi-color property set, and remove the
|
|
|
254 ;; remaining face test-properties.
|
|
|
255 (while (setq beg (text-property-not-all beg end 'face nil))
|
|
|
256 (setq beg (or (text-property-not-all beg end 'ansi-color t) end))
|
|
|
257 (when (get-text-property beg 'face)
|
|
|
258 (let ((end-face (or (text-property-any beg end 'face nil)
|
|
|
259 end)))
|
|
|
260 (remove-text-properties beg end-face '(face nil))
|
|
|
261 (setq beg end-face)))))
|
|
35160
|
262
|
|
|
263 ;; Working with strings
|
|
|
264
|
|
|
265 (defvar ansi-color-context nil
|
|
|
266 "Context saved between two calls to `ansi-color-apply'.
|
|
|
267 This is a list of the form (FACES FRAGMENT) or nil. FACES is a list of
|
|
|
268 faces the last call to `ansi-color-apply' ended with, and FRAGMENT is a
|
|
|
269 string starting with an escape sequence, possibly the start of a new
|
|
|
270 escape sequence.")
|
|
|
271 (make-variable-buffer-local 'ansi-color-context)
|
|
31595
|
272
|
|
35160
|
273 (defun ansi-color-filter-apply (string)
|
|
|
274 "Filter out all SGR control sequences from STRING.
|
|
|
275
|
|
|
276 Every call to this function will set and use the buffer-local variable
|
|
|
277 `ansi-color-context' to save partial escape sequences. This information
|
|
|
278 will be used for the next call to `ansi-color-apply'. Set
|
|
|
279 `ansi-color-context' to nil if you don't want this.
|
|
31595
|
280
|
|
35160
|
281 This function can be added to `comint-preoutput-filter-functions'."
|
|
|
282 (let ((start 0) end result)
|
|
|
283 ;; if context was saved and is a string, prepend it
|
|
|
284 (if (cadr ansi-color-context)
|
|
|
285 (setq string (concat (cadr ansi-color-context) string)
|
|
|
286 ansi-color-context nil))
|
|
|
287 ;; find the next escape sequence
|
|
|
288 (while (setq end (string-match ansi-color-regexp string start))
|
|
|
289 (setq result (concat result (substring string start end))
|
|
|
290 start (match-end 0)))
|
|
|
291 ;; save context, add the remainder of the string to the result
|
|
|
292 (let (fragment)
|
|
|
293 (if (string-match "\033" string start)
|
|
|
294 (let ((pos (match-beginning 0)))
|
|
|
295 (setq fragment (substring string pos)
|
|
|
296 result (concat result (substring string start pos))))
|
|
|
297 (setq result (concat result (substring string start))))
|
|
|
298 (if fragment
|
|
|
299 (setq ansi-color-context (list nil fragment))
|
|
|
300 (setq ansi-color-context nil)))
|
|
|
301 result))
|
|
25171
|
302
|
|
26092
|
303 (defun ansi-color-apply (string)
|
|
31595
|
304 "Translates SGR control sequences into text-properties.
|
|
26092
|
305
|
|
31595
|
306 Applies SGR control sequences setting foreground and background colors
|
|
35160
|
307 to STRING using text-properties and returns the result. The colors used
|
|
|
308 are given in `ansi-color-faces-vector' and `ansi-color-names-vector'.
|
|
|
309 See function `ansi-color-apply-sequence' for details.
|
|
|
310
|
|
|
311 Every call to this function will set and use the buffer-local variable
|
|
|
312 `ansi-color-context' to save partial escape sequences and current face.
|
|
|
313 This information will be used for the next call to `ansi-color-apply'.
|
|
|
314 Set `ansi-color-context' to nil if you don't want this.
|
|
25171
|
315
|
|
35160
|
316 This function can be added to `comint-preoutput-filter-functions'.
|
|
|
317
|
|
|
318 You cannot insert the strings returned into buffers using font-lock.
|
|
|
319 See `ansi-color-unfontify-region' for a way around this."
|
|
|
320 (let ((face (car ansi-color-context))
|
|
|
321 (start 0) end escape-sequence result)
|
|
|
322 ;; if context was saved and is a string, prepend it
|
|
|
323 (if (cadr ansi-color-context)
|
|
|
324 (setq string (concat (cadr ansi-color-context) string)
|
|
|
325 ansi-color-context nil))
|
|
26092
|
326 ;; find the next escape sequence
|
|
31595
|
327 (while (setq end (string-match ansi-color-regexp string start))
|
|
26092
|
328 ;; store escape sequence
|
|
35160
|
329 (setq escape-sequence (match-string 1 string))
|
|
26092
|
330 ;; colorize the old block from start to end using old face
|
|
35160
|
331 (when face
|
|
|
332 (put-text-property start end 'ansi-color t string)
|
|
|
333 (put-text-property start end 'face face string))
|
|
31595
|
334 (setq result (concat result (substring string start end))
|
|
|
335 start (match-end 0))
|
|
35160
|
336 ;; create new face by applying all the parameters in the escape
|
|
|
337 ;; sequence
|
|
|
338 (setq face (ansi-color-apply-sequence escape-sequence face)))
|
|
|
339 ;; if the rest of the string should have a face, put it there
|
|
|
340 (when face
|
|
|
341 (put-text-property start (length string) 'ansi-color t string)
|
|
|
342 (put-text-property start (length string) 'face face string))
|
|
|
343 ;; save context, add the remainder of the string to the result
|
|
|
344 (let (fragment)
|
|
|
345 (if (string-match "\033" string start)
|
|
|
346 (let ((pos (match-beginning 0)))
|
|
|
347 (setq fragment (substring string pos)
|
|
|
348 result (concat result (substring string start pos))))
|
|
|
349 (setq result (concat result (substring string start))))
|
|
|
350 (if (or face fragment)
|
|
|
351 (setq ansi-color-context (list face fragment))
|
|
|
352 (setq ansi-color-context nil)))
|
|
|
353 result))
|
|
|
354
|
|
|
355 ;; Working with regions
|
|
25171
|
356
|
|
35160
|
357 (defvar ansi-color-context-region nil
|
|
|
358 "Context saved between two calls to `ansi-color-apply-on-region'.
|
|
|
359 This is a list of the form (FACES MARKER) or nil. FACES is a list of
|
|
|
360 faces the last call to `ansi-color-apply-on-region' ended with, and
|
|
|
361 MARKER is a buffer position within an escape sequence or the last
|
|
|
362 position processed.")
|
|
|
363 (make-variable-buffer-local 'ansi-color-context-region)
|
|
31595
|
364
|
|
35160
|
365 (defun ansi-color-filter-region (begin end)
|
|
|
366 "Filter out all SGR control sequences from region BEGIN to END.
|
|
|
367
|
|
|
368 Every call to this function will set and use the buffer-local variable
|
|
|
369 `ansi-color-context-region' to save position. This information will be
|
|
|
370 used for the next call to `ansi-color-apply-on-region'. Specifically,
|
|
|
371 it will override BEGIN, the start of the region. Set
|
|
|
372 `ansi-color-context-region' to nil if you don't want this."
|
|
|
373 (let ((end-marker (copy-marker end))
|
|
|
374 (start (or (cadr ansi-color-context-region) begin)))
|
|
|
375 (save-excursion
|
|
|
376 (goto-char start)
|
|
|
377 ;; find the next escape sequence
|
|
|
378 (while (re-search-forward ansi-color-regexp end-marker t)
|
|
|
379 ;; delete the escape sequence
|
|
|
380 (replace-match ""))
|
|
|
381 ;; save context, add the remainder of the string to the result
|
|
|
382 (if (re-search-forward "\033" end-marker t)
|
|
|
383 (setq ansi-color-context-region (list nil (match-beginning 0)))
|
|
|
384 (setq ansi-color-context-region nil)))))
|
|
|
385
|
|
|
386 (defun ansi-color-apply-on-region (begin end)
|
|
|
387 "Translates SGR control sequences into overlays or extents.
|
|
31595
|
388
|
|
|
389 Applies SGR control sequences setting foreground and background colors
|
|
35160
|
390 to text in region between BEGIN and END using extents or overlays.
|
|
|
391 Emacs will use overlays, XEmacs will use extents. The colors used are
|
|
|
392 given in `ansi-color-faces-vector' and `ansi-color-names-vector'. See
|
|
|
393 function `ansi-color-apply-sequence' for details.
|
|
31595
|
394
|
|
35160
|
395 Every call to this function will set and use the buffer-local variable
|
|
|
396 `ansi-color-context-region' to save position and current face. This
|
|
|
397 information will be used for the next call to
|
|
|
398 `ansi-color-apply-on-region'. Specifically, it will override BEGIN, the
|
|
|
399 start of the region and set the face with which to start. Set
|
|
|
400 `ansi-color-context-region' to nil if you don't want this."
|
|
|
401 (let ((face (car ansi-color-context-region))
|
|
49588
|
402 (start-marker (or (cadr ansi-color-context-region)
|
|
35160
|
403 (copy-marker begin)))
|
|
|
404 (end-marker (copy-marker end))
|
|
|
405 escape-sequence)
|
|
|
406 (save-excursion
|
|
|
407 (goto-char start-marker)
|
|
|
408 ;; find the next escape sequence
|
|
|
409 (while (re-search-forward ansi-color-regexp end-marker t)
|
|
|
410 ;; colorize the old block from start to end using old face
|
|
|
411 (when face
|
|
|
412 (ansi-color-set-extent-face
|
|
|
413 (ansi-color-make-extent start-marker (match-beginning 0))
|
|
|
414 face))
|
|
|
415 ;; store escape sequence and new start position
|
|
|
416 (setq escape-sequence (match-string 1)
|
|
|
417 start-marker (copy-marker (match-end 0)))
|
|
|
418 ;; delete the escape sequence
|
|
|
419 (replace-match "")
|
|
|
420 ;; create new face by applying all the parameters in the escape
|
|
|
421 ;; sequence
|
|
|
422 (setq face (ansi-color-apply-sequence escape-sequence face)))
|
|
|
423 ;; search for the possible start of a new escape sequence
|
|
|
424 (if (re-search-forward "\033" end-marker t)
|
|
|
425 (progn
|
|
|
426 ;; if the rest of the region should have a face, put it there
|
|
|
427 (when face
|
|
|
428 (ansi-color-set-extent-face
|
|
|
429 (ansi-color-make-extent start-marker (point))
|
|
|
430 face))
|
|
|
431 ;; save face and point
|
|
|
432 (setq ansi-color-context-region
|
|
|
433 (list face (copy-marker (match-beginning 0)))))
|
|
|
434 ;; if the rest of the region should have a face, put it there
|
|
|
435 (if face
|
|
|
436 (progn
|
|
|
437 (ansi-color-set-extent-face
|
|
|
438 (ansi-color-make-extent start-marker end-marker)
|
|
|
439 face)
|
|
|
440 (setq ansi-color-context-region (list face)))
|
|
|
441 ;; reset context
|
|
|
442 (setq ansi-color-context-region nil))))))
|
|
31595
|
443
|
|
35160
|
444 ;; This function helps you look for overlapping overlays. This is
|
|
|
445 ;; usefull in comint-buffers. Overlapping overlays should not happen!
|
|
|
446 ;; A possible cause for bugs are the markers. If you create an overlay
|
|
|
447 ;; up to the end of the region, then that end might coincide with the
|
|
|
448 ;; process-mark. As text is added BEFORE the process-mark, the overlay
|
|
|
449 ;; will keep growing. Therefore, as more overlays are created later on,
|
|
|
450 ;; there will be TWO OR MORE overlays covering the buffer at that point.
|
|
|
451 ;; This function helps you check your buffer for these situations.
|
|
|
452 ; (defun ansi-color-debug-overlays ()
|
|
|
453 ; (interactive)
|
|
|
454 ; (let ((pos (point-min)))
|
|
|
455 ; (while (< pos (point-max))
|
|
|
456 ; (if (<= 2 (length (overlays-at pos)))
|
|
|
457 ; (progn
|
|
|
458 ; (goto-char pos)
|
|
|
459 ; (error "%d overlays at %d" (length (overlays-at pos)) pos))
|
|
|
460 ; (let (message-log-max)
|
|
|
461 ; (message "Reached %d." pos)))
|
|
|
462 ; (setq pos (next-overlay-change pos)))))
|
|
|
463
|
|
|
464 ;; Emacs/XEmacs compatibility layer
|
|
|
465
|
|
|
466 (defun ansi-color-make-face (property color)
|
|
|
467 "Return a face with PROPERTY set to COLOR.
|
|
49588
|
468 PROPERTY can be either symbol `foreground' or symbol `background'.
|
|
35160
|
469
|
|
|
470 For Emacs, we just return the cons cell \(PROPERTY . COLOR).
|
|
|
471 For XEmacs, we create a temporary face and return it."
|
|
|
472 (if (featurep 'xemacs)
|
|
|
473 (let ((face (make-face (intern (concat color "-" (symbol-name property)))
|
|
|
474 "Temporary face created by ansi-color."
|
|
|
475 t)))
|
|
|
476 (set-face-property face property color)
|
|
|
477 face)
|
|
|
478 (cond ((eq property 'foreground)
|
|
|
479 (cons 'foreground-color color))
|
|
|
480 ((eq property 'background)
|
|
|
481 (cons 'background-color color))
|
|
|
482 (t
|
|
|
483 (cons property color)))))
|
|
|
484
|
|
|
485 (defun ansi-color-make-extent (from to &optional object)
|
|
|
486 "Make an extent for the range [FROM, TO) in OBJECT.
|
|
|
487
|
|
|
488 OBJECT defaults to the current buffer. XEmacs uses `make-extent', Emacs
|
|
|
489 uses `make-overlay'. XEmacs can use a buffer or a string for OBJECT,
|
|
|
490 Emacs requires OBJECT to be a buffer."
|
|
64802
|
491 (if (fboundp 'make-extent)
|
|
35160
|
492 (make-extent from to object)
|
|
|
493 ;; In Emacs, the overlay might end at the process-mark in comint
|
|
|
494 ;; buffers. In that case, new text will be inserted before the
|
|
|
495 ;; process-mark, ie. inside the overlay (using insert-before-marks).
|
|
|
496 ;; In order to avoid this, we use the `insert-behind-hooks' overlay
|
|
|
497 ;; property to make sure it works.
|
|
|
498 (let ((overlay (make-overlay from to object)))
|
|
|
499 (overlay-put overlay 'modification-hooks '(ansi-color-freeze-overlay))
|
|
|
500 overlay)))
|
|
|
501
|
|
|
502 (defun ansi-color-freeze-overlay (overlay is-after begin end &optional len)
|
|
|
503 "Prevent OVERLAY from being extended.
|
|
|
504 This function can be used for the `modification-hooks' overlay
|
|
|
505 property."
|
|
|
506 ;; if stuff was inserted at the end of the overlay
|
|
|
507 (when (and is-after
|
|
|
508 (= 0 len)
|
|
|
509 (= end (overlay-end overlay)))
|
|
|
510 ;; reset the end of the overlay
|
|
|
511 (move-overlay overlay (overlay-start overlay) begin)))
|
|
|
512
|
|
|
513 (defun ansi-color-set-extent-face (extent face)
|
|
|
514 "Set the `face' property of EXTENT to FACE.
|
|
|
515 XEmacs uses `set-extent-face', Emacs uses `overlay-put'."
|
|
64802
|
516 (if (fboundp 'set-extent-face)
|
|
35160
|
517 (set-extent-face extent face)
|
|
|
518 (overlay-put extent 'face face)))
|
|
31595
|
519
|
|
26092
|
520 ;; Helper functions
|
|
|
521
|
|
35160
|
522 (defun ansi-color-apply-sequence (escape-sequence faces)
|
|
|
523 "Apply ESCAPE-SEQ to FACES and return the new list of faces.
|
|
|
524
|
|
|
525 ESCAPE-SEQ is an escape sequences parsed by `ansi-color-get-face'.
|
|
|
526
|
|
|
527 If the new faces start with the symbol `default', then the new
|
|
|
528 faces are returned. If the faces start with something else,
|
|
|
529 they are appended to the front of the FACES list, and the new
|
|
|
530 list of faces is returned.
|
|
|
531
|
|
|
532 If `ansi-color-get-face' returns nil, then we either got a
|
|
|
533 null-sequence, or we stumbled upon some garbage. In either
|
|
|
534 case we return nil."
|
|
|
535 (let ((new-faces (ansi-color-get-face escape-sequence)))
|
|
|
536 (cond ((null new-faces)
|
|
|
537 nil)
|
|
|
538 ((eq (car new-faces) 'default)
|
|
|
539 (cdr new-faces))
|
|
|
540 (t
|
|
45250
|
541 ;; Like (append NEW-FACES FACES)
|
|
|
542 ;; but delete duplicates in FACES.
|
|
|
543 (let ((modified-faces (copy-sequence faces)))
|
|
|
544 (dolist (face (nreverse new-faces))
|
|
|
545 (setq modified-faces (delete face modified-faces))
|
|
|
546 (push face modified-faces))
|
|
|
547 modified-faces)))))
|
|
35160
|
548
|
|
31595
|
549 (defun ansi-color-make-color-map ()
|
|
|
550 "Creates a vector of face definitions and returns it.
|
|
|
551
|
|
|
552 The index into the vector is an ANSI code. See the documentation of
|
|
|
553 `ansi-color-map' for an example.
|
|
|
554
|
|
|
555 The face definitions are based upon the variables
|
|
|
556 `ansi-color-faces-vector' and `ansi-color-names-vector'."
|
|
|
557 (let ((ansi-color-map (make-vector 50 nil))
|
|
|
558 (index 0))
|
|
|
559 ;; miscellaneous attributes
|
|
|
560 (mapcar
|
|
|
561 (function (lambda (e)
|
|
|
562 (aset ansi-color-map index e)
|
|
|
563 (setq index (1+ index)) ))
|
|
|
564 ansi-color-faces-vector)
|
|
|
565 ;; foreground attributes
|
|
|
566 (setq index 30)
|
|
|
567 (mapcar
|
|
|
568 (function (lambda (e)
|
|
|
569 (aset ansi-color-map index
|
|
35160
|
570 (ansi-color-make-face 'foreground e))
|
|
31595
|
571 (setq index (1+ index)) ))
|
|
|
572 ansi-color-names-vector)
|
|
|
573 ;; background attributes
|
|
|
574 (setq index 40)
|
|
|
575 (mapcar
|
|
|
576 (function (lambda (e)
|
|
|
577 (aset ansi-color-map index
|
|
35160
|
578 (ansi-color-make-face 'background e))
|
|
31595
|
579 (setq index (1+ index)) ))
|
|
|
580 ansi-color-names-vector)
|
|
|
581 ansi-color-map))
|
|
|
582
|
|
|
583 (defvar ansi-color-map (ansi-color-make-color-map)
|
|
35160
|
584 "A brand new color map suitable for `ansi-color-get-face'.
|
|
25225
|
585
|
|
31595
|
586 The value of this variable is usually constructed by
|
|
|
587 `ansi-color-make-color-map'. The values in the array are such that the
|
|
|
588 numbers included in an SGR control sequences point to the correct
|
|
|
589 foreground or background colors.
|
|
|
590
|
|
|
591 Example: The sequence \033[34m specifies a blue foreground. Therefore:
|
|
|
592 (aref ansi-color-map 34)
|
|
|
593 => \(foreground-color . \"blue\")")
|
|
|
594
|
|
|
595 (defun ansi-color-map-update (symbol value)
|
|
|
596 "Update `ansi-color-map'.
|
|
|
597
|
|
|
598 Whenever the vectors used to construct `ansi-color-map' are changed,
|
|
|
599 this function is called. Therefore this function is listed as the :set
|
|
|
600 property of `ansi-color-faces-vector' and `ansi-color-names-vector'."
|
|
|
601 (set-default symbol value)
|
|
|
602 (setq ansi-color-map (ansi-color-make-color-map)))
|
|
|
603
|
|
|
604 (defun ansi-color-get-face-1 (ansi-code)
|
|
|
605 "Get face definition from `ansi-color-map'.
|
|
|
606 ANSI-CODE is used as an index into the vector."
|
|
|
607 (condition-case nil
|
|
|
608 (aref ansi-color-map ansi-code)
|
|
|
609 ('args-out-of-range nil)))
|
|
|
610
|
|
|
611 (defun ansi-color-get-face (escape-seq)
|
|
|
612 "Create a new face by applying all the parameters in ESCAPE-SEQ.
|
|
|
613
|
|
35160
|
614 Should any of the parameters result in the default face (usually this is
|
|
|
615 the parameter 0), then the effect of all previous parameters is cancelled.
|
|
|
616
|
|
|
617 ESCAPE-SEQ is a SGR control sequences such as \\033[34m. The parameter
|
|
31595
|
618 34 is used by `ansi-color-get-face-1' to return a face definition."
|
|
|
619 (let ((ansi-color-r "[0-9][0-9]?")
|
|
|
620 (i 0)
|
|
35160
|
621 f val)
|
|
31595
|
622 (while (string-match ansi-color-r escape-seq i)
|
|
35160
|
623 (setq i (match-end 0)
|
|
|
624 val (ansi-color-get-face-1
|
|
62402
|
625 (string-to-number (match-string 0 escape-seq) 10)))
|
|
35160
|
626 (cond ((not val))
|
|
|
627 ((eq val 'default)
|
|
|
628 (setq f (list val)))
|
|
|
629 (t
|
|
45250
|
630 (unless (member val f)
|
|
|
631 (push val f)))))
|
|
31595
|
632 f))
|
|
25171
|
633
|
|
|
634 (provide 'ansi-color)
|
|
|
635
|
|
52401
|
636 ;;; arch-tag: 00726118-9432-44fd-b72d-d2af7591c99c
|
|
26092
|
637 ;;; ansi-color.el ends here
|
