Commit | Line | Data |
e3e5e1ea |
1 | # Term::ANSIColor -- Color screen output using ANSI escape sequences. |
110e9fb0 |
2 | # $Id: ANSIColor.pm,v 1.4 2001/07/10 08:52:05 eagle Exp $ |
e3e5e1ea |
3 | # |
110e9fb0 |
4 | # Copyright 1996, 1997, 1998, 2000, 2001 |
5 | # by Russ Allbery <rra@stanford.edu> and Zenin <zenin@bawdycaste.com> |
e3e5e1ea |
6 | # |
110e9fb0 |
7 | # This program is free software; you may redistribute it and/or modify it |
e3e5e1ea |
8 | # under the same terms as Perl itself. |
f63addff |
9 | # |
10 | # Ah, September, when the sysadmins turn colors and fall off the trees.... |
11 | # -- Dave Van Domelen |
e3e5e1ea |
12 | |
13 | ############################################################################ |
14 | # Modules and declarations |
15 | ############################################################################ |
16 | |
17 | package Term::ANSIColor; |
18 | require 5.001; |
19 | |
20 | use strict; |
110e9fb0 |
21 | use vars qw($AUTOLOAD $AUTORESET $EACHLINE @ISA @EXPORT @EXPORT_OK |
22 | %EXPORT_TAGS $VERSION %attributes %attributes_r); |
e3e5e1ea |
23 | |
24 | use Exporter (); |
25 | @ISA = qw(Exporter); |
26 | @EXPORT = qw(color colored); |
110e9fb0 |
27 | @EXPORT_OK = qw(uncolor); |
e3e5e1ea |
28 | %EXPORT_TAGS = (constants => [qw(CLEAR RESET BOLD UNDERLINE UNDERSCORE BLINK |
29 | REVERSE CONCEALED BLACK RED GREEN YELLOW |
30 | BLUE MAGENTA CYAN WHITE ON_BLACK ON_RED |
31 | ON_GREEN ON_YELLOW ON_BLUE ON_MAGENTA |
32 | ON_CYAN ON_WHITE)]); |
33 | Exporter::export_ok_tags ('constants'); |
f63addff |
34 | |
35 | # Don't use the CVS revision as the version, since this module is also in |
36 | # Perl core and too many things could munge CVS magic revision strings. |
110e9fb0 |
37 | $VERSION = 1.04; |
e3e5e1ea |
38 | |
39 | |
40 | ############################################################################ |
41 | # Internal data structures |
42 | ############################################################################ |
43 | |
44 | %attributes = ('clear' => 0, |
45 | 'reset' => 0, |
46 | 'bold' => 1, |
f63addff |
47 | 'dark' => 2, |
e3e5e1ea |
48 | 'underline' => 4, |
49 | 'underscore' => 4, |
50 | 'blink' => 5, |
51 | 'reverse' => 7, |
52 | 'concealed' => 8, |
53 | |
110e9fb0 |
54 | 'black' => 30, 'on_black' => 40, |
55 | 'red' => 31, 'on_red' => 41, |
56 | 'green' => 32, 'on_green' => 42, |
57 | 'yellow' => 33, 'on_yellow' => 43, |
58 | 'blue' => 34, 'on_blue' => 44, |
59 | 'magenta' => 35, 'on_magenta' => 45, |
60 | 'cyan' => 36, 'on_cyan' => 46, |
e3e5e1ea |
61 | 'white' => 37, 'on_white' => 47); |
62 | |
110e9fb0 |
63 | # Reverse lookup. Alphabetically first name for a sequence is preferred. |
64 | for (reverse sort keys %attributes) { |
65 | $attributes_r{$attributes{$_}} = $_; |
66 | } |
67 | |
e3e5e1ea |
68 | |
69 | ############################################################################ |
70 | # Implementation (constant form) |
71 | ############################################################################ |
72 | |
73 | # Time to have fun! We now want to define the constant subs, which are |
74 | # named the same as the attributes above but in all caps. Each constant sub |
75 | # needs to act differently depending on whether $AUTORESET is set. Without |
76 | # autoreset: |
77 | # |
78 | # BLUE "text\n" ==> "\e[34mtext\n" |
79 | # |
80 | # If $AUTORESET is set, we should instead get: |
81 | # |
82 | # BLUE "text\n" ==> "\e[34mtext\n\e[0m" |
83 | # |
84 | # The sub also needs to handle the case where it has no arguments correctly. |
85 | # Maintaining all of this as separate subs would be a major nightmare, as |
86 | # well as duplicate the %attributes hash, so instead we define an AUTOLOAD |
87 | # sub to define the constant subs on demand. To do that, we check the name |
88 | # of the called sub against the list of attributes, and if it's an all-caps |
89 | # version of one of them, we define the sub on the fly and then run it. |
110e9fb0 |
90 | # |
91 | # If the environment variable ANSI_COLORS_DISABLED is set, turn all of the |
92 | # generated subs into pass-through functions that don't add any escape |
93 | # sequences. This is to make it easier to write scripts that also work on |
94 | # systems without any ANSI support, like Windows consoles. |
e3e5e1ea |
95 | sub AUTOLOAD { |
110e9fb0 |
96 | my $enable_colors = !defined $ENV{ANSI_COLORS_DISABLED}; |
e3e5e1ea |
97 | my $sub; |
98 | ($sub = $AUTOLOAD) =~ s/^.*:://; |
99 | my $attr = $attributes{lc $sub}; |
100 | if ($sub =~ /^[A-Z_]+$/ && defined $attr) { |
110e9fb0 |
101 | $attr = $enable_colors ? "\e[" . $attr . 'm' : ''; |
e3e5e1ea |
102 | eval qq { |
103 | sub $AUTOLOAD { |
104 | if (\$AUTORESET && \@_) { |
105 | '$attr' . "\@_" . "\e[0m"; |
106 | } else { |
107 | ('$attr' . "\@_"); |
108 | } |
109 | } |
110 | }; |
111 | goto &$AUTOLOAD; |
112 | } else { |
f63addff |
113 | require Carp; |
114 | Carp::croak ("undefined subroutine &$AUTOLOAD called"); |
e3e5e1ea |
115 | } |
116 | } |
117 | |
118 | |
119 | ############################################################################ |
120 | # Implementation (attribute string form) |
121 | ############################################################################ |
122 | |
123 | # Return the escape code for a given set of color attributes. |
124 | sub color { |
110e9fb0 |
125 | return '' if defined $ENV{ANSI_COLORS_DISABLED}; |
e3e5e1ea |
126 | my @codes = map { split } @_; |
127 | my $attribute = ''; |
128 | foreach (@codes) { |
129 | $_ = lc $_; |
130 | unless (defined $attributes{$_}) { |
131 | require Carp; |
132 | Carp::croak ("Invalid attribute name $_"); |
133 | } |
134 | $attribute .= $attributes{$_} . ';'; |
135 | } |
136 | chop $attribute; |
137 | ($attribute ne '') ? "\e[${attribute}m" : undef; |
138 | } |
139 | |
110e9fb0 |
140 | # Return a list of named color attributes for a given set of escape codes. |
141 | # Escape sequences can be given with or without enclosing "\e[" and "m". |
142 | # The empty escape sequence '' or "\e[m" gives an empty list of attrs. |
143 | sub uncolor { |
144 | my (@nums, @result); |
145 | for (@_) { |
146 | my $escape = $_; |
147 | $escape =~ s/^\e\[//; |
148 | $escape =~ s/m$//; |
149 | unless ($escape =~ /^((?:\d+;)*\d*)$/) { |
150 | require Carp; |
151 | Carp::croak ("Bad escape sequence $_"); |
152 | } |
153 | push (@nums, split (/;/, $1)); |
154 | } |
155 | for (@nums) { |
156 | $_ += 0; # Strip leading zeroes |
157 | my $name = $attributes_r{$_}; |
158 | if (!defined $name) { |
159 | require Carp; |
160 | Carp::croak ("No name for escape sequence $_" ); |
161 | } |
162 | push (@result, $name); |
163 | } |
164 | @result; |
165 | } |
166 | |
e3e5e1ea |
167 | # Given a string and a set of attributes, returns the string surrounded by |
168 | # escape codes to set those attributes and then clear them at the end of the |
f63addff |
169 | # string. The attributes can be given either as an array ref as the first |
170 | # argument or as a list as the second and subsequent arguments. If |
171 | # $EACHLINE is set, insert a reset before each occurrence of the string |
172 | # $EACHLINE and the starting attribute code after the string $EACHLINE, so |
173 | # that no attribute crosses line delimiters (this is often desirable if the |
174 | # output is to be piped to a pager or some other program). |
e3e5e1ea |
175 | sub colored { |
f63addff |
176 | my ($string, @codes); |
177 | if (ref $_[0]) { |
178 | @codes = @{+shift}; |
179 | $string = join ('', @_); |
180 | } else { |
181 | $string = shift; |
182 | @codes = @_; |
183 | } |
110e9fb0 |
184 | return $string if defined $ENV{ANSI_COLORS_DISABLED}; |
e3e5e1ea |
185 | if (defined $EACHLINE) { |
f63addff |
186 | my $attr = color (@codes); |
110e9fb0 |
187 | join '', |
e3e5e1ea |
188 | map { $_ && $_ ne $EACHLINE ? $attr . $_ . "\e[0m" : $_ } |
189 | split (/(\Q$EACHLINE\E)/, $string); |
190 | } else { |
f63addff |
191 | color (@codes) . $string . "\e[0m"; |
e3e5e1ea |
192 | } |
193 | } |
194 | |
195 | |
196 | ############################################################################ |
197 | # Module return value and documentation |
198 | ############################################################################ |
199 | |
200 | # Ensure we evaluate to true. |
201 | 1; |
202 | __END__ |
203 | |
204 | =head1 NAME |
205 | |
206 | Term::ANSIColor - Color screen output using ANSI escape sequences |
207 | |
208 | =head1 SYNOPSIS |
209 | |
210 | use Term::ANSIColor; |
211 | print color 'bold blue'; |
212 | print "This text is bold blue.\n"; |
213 | print color 'reset'; |
214 | print "This text is normal.\n"; |
215 | print colored ("Yellow on magenta.\n", 'yellow on_magenta'); |
216 | print "This text is normal.\n"; |
f63addff |
217 | print colored ['yellow on_magenta'], "Yellow on magenta.\n"; |
e3e5e1ea |
218 | |
110e9fb0 |
219 | use Term::ANSIColor qw(uncolor); |
220 | print uncolor '01;31', "\n"; |
221 | |
e3e5e1ea |
222 | use Term::ANSIColor qw(:constants); |
223 | print BOLD, BLUE, "This text is in bold blue.\n", RESET; |
224 | |
225 | use Term::ANSIColor qw(:constants); |
226 | $Term::ANSIColor::AUTORESET = 1; |
227 | print BOLD BLUE "This text is in bold blue.\n"; |
228 | print "This text is normal.\n"; |
229 | |
230 | =head1 DESCRIPTION |
231 | |
232 | This module has two interfaces, one through color() and colored() and the |
110e9fb0 |
233 | other through constants. It also offers the utility function uncolor(), |
234 | which has to be explicitly imported to be used (see L<SYNOPSYS>). |
bbc7dcd2 |
235 | |
e3e5e1ea |
236 | color() takes any number of strings as arguments and considers them to be |
237 | space-separated lists of attributes. It then forms and returns the escape |
110e9fb0 |
238 | sequence to set those attributes. It doesn't print it out, just returns it, |
239 | so you'll have to print it yourself if you want to (this is so that you can |
240 | save it as a string, pass it to something else, send it to a file handle, or |
241 | do anything else with it that you might care to). |
242 | |
243 | uncolor() performs the opposite translation, turning escape sequences |
244 | into a list of strings. |
e3e5e1ea |
245 | |
246 | The recognized attributes (all of which should be fairly intuitive) are |
110e9fb0 |
247 | clear, reset, dark, bold, underline, underscore, blink, reverse, concealed, |
248 | black, red, green, yellow, blue, magenta, on_black, on_red, on_green, |
249 | on_yellow, on_blue, on_magenta, on_cyan, and on_white. Case is not |
250 | significant. Underline and underscore are equivalent, as are clear and |
251 | reset, so use whichever is the most intuitive to you. The color alone sets |
252 | the foreground color, and on_color sets the background color. |
e3e5e1ea |
253 | |
f63addff |
254 | Note that not all attributes are supported by all terminal types, and some |
255 | terminals may not support any of these sequences. Dark, blink, and |
256 | concealed in particular are frequently not implemented. |
257 | |
258 | Attributes, once set, last until they are unset (by sending the attribute |
259 | "reset"). Be careful to do this, or otherwise your attribute will last |
260 | after your script is done running, and people get very annoyed at having |
261 | their prompt and typing changed to weird colors. |
e3e5e1ea |
262 | |
110e9fb0 |
263 | As an aid to help with this, colored() takes a scalar as the first argument |
264 | and any number of attribute strings as the second argument and returns the |
265 | scalar wrapped in escape codes so that the attributes will be set as |
266 | requested before the string and reset to normal after the string. |
267 | Alternately, you can pass a reference to an array as the first argument, and |
268 | then the contents of that array will be taken as attributes and color codes |
269 | and the remainder of the arguments as text to colorize. |
f63addff |
270 | |
e3e5e1ea |
271 | Normally, colored() just puts attribute codes at the beginning and end of |
110e9fb0 |
272 | the string, but if you set $Term::ANSIColor::EACHLINE to some string, that |
273 | string will be considered the line delimiter and the attribute will be set |
274 | at the beginning of each line of the passed string and reset at the end of |
275 | each line. This is often desirable if the output is being sent to a program |
276 | like a pager that can be confused by attributes that span lines. Normally |
277 | you'll want to set $Term::ANSIColor::EACHLINE to C<"\n"> to use this |
278 | feature. |
e3e5e1ea |
279 | |
280 | Alternately, if you import C<:constants>, you can use the constants CLEAR, |
110e9fb0 |
281 | RESET, BOLD, DARK, UNDERLINE, UNDERSCORE, BLINK, REVERSE, CONCEALED, BLACK, |
282 | RED, GREEN, YELLOW, BLUE, MAGENTA, ON_BLACK, ON_RED, ON_GREEN, ON_YELLOW, |
283 | ON_BLUE, ON_MAGENTA, ON_CYAN, and ON_WHITE directly. These are the same as |
284 | color('attribute') and can be used if you prefer typing: |
e3e5e1ea |
285 | |
286 | print BOLD BLUE ON_WHITE "Text\n", RESET; |
287 | |
288 | to |
289 | |
290 | print colored ("Text\n", 'bold blue on_white'); |
291 | |
292 | When using the constants, if you don't want to have to remember to add the |
293 | C<, RESET> at the end of each print line, you can set |
294 | $Term::ANSIColor::AUTORESET to a true value. Then, the display mode will |
295 | automatically be reset if there is no comma after the constant. In other |
296 | words, with that variable set: |
297 | |
298 | print BOLD BLUE "Text\n"; |
299 | |
300 | will reset the display mode afterwards, whereas: |
301 | |
302 | print BOLD, BLUE, "Text\n"; |
303 | |
304 | will not. |
305 | |
306 | The subroutine interface has the advantage over the constants interface in |
f63addff |
307 | that only two subroutines are exported into your namespace, versus |
308 | twenty-two in the constants interface. On the flip side, the constants |
309 | interface has the advantage of better compile time error checking, since |
310 | misspelled names of colors or attributes in calls to color() and colored() |
110e9fb0 |
311 | won't be caught until runtime whereas misspelled names of constants will be |
312 | caught at compile time. So, polute your namespace with almost two dozen |
313 | subroutines that you may not even use that often, or risk a silly bug by |
314 | mistyping an attribute. Your choice, TMTOWTDI after all. |
e3e5e1ea |
315 | |
316 | =head1 DIAGNOSTICS |
317 | |
318 | =over 4 |
319 | |
110e9fb0 |
320 | =item Bad escape sequence %s |
321 | |
322 | (F) You passed an invalid ANSI escape sequence to uncolor(). |
323 | |
324 | =item Bareword "%s" not allowed while "strict subs" in use |
325 | |
326 | (F) You probably mistyped a constant color name such as: |
327 | |
328 | $Foobar = FOOBAR . "This line should be blue\n"; |
329 | |
330 | or: |
331 | |
332 | @Foobar = FOOBAR, "This line should be blue\n"; |
333 | |
334 | This will only show up under use strict (another good reason to run under |
335 | use strict). |
336 | |
e3e5e1ea |
337 | =item Invalid attribute name %s |
338 | |
f63addff |
339 | (F) You passed an invalid attribute name to either color() or colored(). |
e3e5e1ea |
340 | |
f63addff |
341 | =item Name "%s" used only once: possible typo |
e3e5e1ea |
342 | |
f63addff |
343 | (W) You probably mistyped a constant color name such as: |
e3e5e1ea |
344 | |
345 | print FOOBAR "This text is color FOOBAR\n"; |
346 | |
347 | It's probably better to always use commas after constant names in order to |
348 | force the next error. |
349 | |
350 | =item No comma allowed after filehandle |
351 | |
f63addff |
352 | (F) You probably mistyped a constant color name such as: |
e3e5e1ea |
353 | |
354 | print FOOBAR, "This text is color FOOBAR\n"; |
355 | |
356 | Generating this fatal compile error is one of the main advantages of using |
357 | the constants interface, since you'll immediately know if you mistype a |
358 | color name. |
359 | |
110e9fb0 |
360 | =item No name for escape sequence %s |
e3e5e1ea |
361 | |
110e9fb0 |
362 | (F) The ANSI escape sequence passed to uncolor() contains escapes which |
363 | aren't recognized and can't be translated to names. |
e3e5e1ea |
364 | |
110e9fb0 |
365 | =back |
e3e5e1ea |
366 | |
110e9fb0 |
367 | =head1 ENVIRONMENT |
e3e5e1ea |
368 | |
110e9fb0 |
369 | =over 4 |
e3e5e1ea |
370 | |
110e9fb0 |
371 | =item ANSI_COLORS_DISABLED |
372 | |
373 | If this environment variable is set, all of the functions defined by this |
374 | module (color(), colored(), and all of the constants not previously used in |
375 | the program) will not output any escape sequences and instead will just |
376 | return the empty string or pass through the original text as appropriate. |
377 | This is intended to support easy use of scripts using this module on |
378 | platforms that don't support ANSI escape sequences. |
379 | |
380 | For it to have its proper effect, this environment variable must be set |
381 | before any color constants are used in the program. |
e3e5e1ea |
382 | |
383 | =back |
384 | |
385 | =head1 RESTRICTIONS |
386 | |
387 | It would be nice if one could leave off the commas around the constants |
388 | entirely and just say: |
389 | |
390 | print BOLD BLUE ON_WHITE "Text\n" RESET; |
391 | |
392 | but the syntax of Perl doesn't allow this. You need a comma after the |
393 | string. (Of course, you may consider it a bug that commas between all the |
110e9fb0 |
394 | constants aren't required, in which case you may feel free to insert commas |
395 | unless you're using $Term::ANSIColor::AUTORESET.) |
e3e5e1ea |
396 | |
397 | For easier debuging, you may prefer to always use the commas when not |
110e9fb0 |
398 | setting $Term::ANSIColor::AUTORESET so that you'll get a fatal compile error |
399 | rather than a warning. |
e3e5e1ea |
400 | |
f63addff |
401 | =head1 NOTES |
402 | |
110e9fb0 |
403 | The codes generated by this module are standard terminal control codes, |
404 | complying with ECMA-48 and ISO 6429 (generally referred to as "ANSI color" |
405 | for the color codes). The non-color control codes (bold, dark, italic, |
406 | underline, and reverse) are part of the earlier ANSI X3.64 standard for |
407 | control sequences for video terminals and peripherals. |
408 | |
409 | Note that not all displays are ISO 6429-compliant, or even X3.64-compliant |
410 | (or are even attempting to be so). This module will not work as expected on |
411 | displays that do not honor these escape sequences, such as (reportedly) the |
412 | "console" in at least some versions of Windows. They may just be ignored, |
413 | or they may display as an ESC character followed by some apparent garbage. |
414 | |
f63addff |
415 | Jean Delvare provided the following table of different common terminal |
416 | emulators and their support for the various attributes: |
417 | |
418 | clear bold dark under blink reverse conceal |
419 | ------------------------------------------------------------------------ |
420 | xterm yes yes no yes bold yes yes |
421 | linux yes yes yes bold yes yes no |
422 | rxvt yes yes no yes bold/black yes no |
423 | dtterm yes yes yes yes reverse yes yes |
424 | teraterm yes reverse no yes rev/red yes no |
425 | aixterm kinda normal no yes no yes yes |
426 | |
427 | Where the entry is other than yes or no, that emulator interpret the given |
110e9fb0 |
428 | attribute as something else instead. Note that on an aixterm, clear doesn't |
429 | reset colors; you have to explicitly set the colors back to what you want. |
430 | More entries in this table are welcome. |
431 | |
432 | Note that codes 3 (italic), 6 (rapid blink), and 9 (strikethrough) are |
433 | specified in ANSI X3.64 and ECMA-048 but are not commonly supported by most |
434 | displays and emulators and therefore aren't supported by this module at the |
435 | present time. ECMA-048 also specifies a large number of other attributes, |
436 | including a sequence of attributes for font changes, Fraktur characters, |
437 | double-underlining, framing, circling, and overlining. As none of these |
438 | attributes are widely supported or useful, they also aren't currently |
439 | supported by this module. |
440 | |
441 | =head1 SEE ALSO |
442 | |
443 | ECMA-048 is available on-line (at least at the time of this writing) at |
444 | E<lt>http://www.ecma.ch/ecma1/STAND/ECMA-048.HTME<gt>. |
445 | |
446 | ISO 6429 is available from ISO for a charge; the author of this module does |
447 | not own a copy of it. Since the source material for ISO 6429 was ECMA-048 |
448 | and the latter is available for free, there seems little reason to obtain |
449 | the ISO standard. |
f63addff |
450 | |
e3e5e1ea |
451 | =head1 AUTHORS |
452 | |
110e9fb0 |
453 | Original idea (using constants) by Zenin, reimplemented using subs by Russ |
454 | Allbery E<lt>rra@stanford.eduE<gt>, and then combined with the original idea |
455 | by Russ with input from Zenin. Russ Allbery now maintains this module. |
456 | |
457 | =head1 LICENSE |
458 | |
459 | Copyright 1996, 1997, 1998, 2000, 2001 Russ Allbery <rra@stanford.edu> and |
460 | Zenin <zenin@bawdycaste.org>. This program is free software; you may |
461 | redistribute it and/or modify it under the same terms as Perl itself. |
e3e5e1ea |
462 | |
463 | =cut |