Commit | Line | Data |
e3e5e1ea |
1 | # Term::ANSIColor -- Color screen output using ANSI escape sequences. |
2 | # $Id: ANSIColor.pm,v 1.1 1997/12/10 20:05:29 eagle Exp $ |
3 | # |
4 | # Copyright 1996, 1997 by Russ Allbery <rra@stanford.edu> |
5 | # and Zenin <zenin@best.com> |
6 | # |
7 | # This program is free software; you can redistribute it and/or modify it |
8 | # under the same terms as Perl itself. |
9 | |
10 | ############################################################################ |
11 | # Modules and declarations |
12 | ############################################################################ |
13 | |
14 | package Term::ANSIColor; |
15 | require 5.001; |
16 | |
17 | use strict; |
18 | use vars qw(@ISA @EXPORT %EXPORT_TAGS $VERSION $AUTOLOAD %attributes |
19 | $AUTORESET $EACHLINE); |
20 | |
21 | use Exporter (); |
22 | @ISA = qw(Exporter); |
23 | @EXPORT = qw(color colored); |
24 | %EXPORT_TAGS = (constants => [qw(CLEAR RESET BOLD UNDERLINE UNDERSCORE BLINK |
25 | REVERSE CONCEALED BLACK RED GREEN YELLOW |
26 | BLUE MAGENTA CYAN WHITE ON_BLACK ON_RED |
27 | ON_GREEN ON_YELLOW ON_BLUE ON_MAGENTA |
28 | ON_CYAN ON_WHITE)]); |
29 | Exporter::export_ok_tags ('constants'); |
30 | |
31 | ($VERSION = (split (' ', q$Revision: 1.1 $ ))[1]) =~ s/\.(\d)$/.0$1/; |
32 | |
33 | |
34 | ############################################################################ |
35 | # Internal data structures |
36 | ############################################################################ |
37 | |
38 | %attributes = ('clear' => 0, |
39 | 'reset' => 0, |
40 | 'bold' => 1, |
41 | 'underline' => 4, |
42 | 'underscore' => 4, |
43 | 'blink' => 5, |
44 | 'reverse' => 7, |
45 | 'concealed' => 8, |
46 | |
47 | 'black' => 30, 'on_black' => 40, |
48 | 'red' => 31, 'on_red' => 41, |
49 | 'green' => 32, 'on_green' => 42, |
50 | 'yellow' => 33, 'on_yellow' => 43, |
51 | 'blue' => 34, 'on_blue' => 44, |
52 | 'magenta' => 35, 'on_magenta' => 45, |
53 | 'cyan' => 36, 'on_cyan' => 46, |
54 | 'white' => 37, 'on_white' => 47); |
55 | |
56 | |
57 | ############################################################################ |
58 | # Implementation (constant form) |
59 | ############################################################################ |
60 | |
61 | # Time to have fun! We now want to define the constant subs, which are |
62 | # named the same as the attributes above but in all caps. Each constant sub |
63 | # needs to act differently depending on whether $AUTORESET is set. Without |
64 | # autoreset: |
65 | # |
66 | # BLUE "text\n" ==> "\e[34mtext\n" |
67 | # |
68 | # If $AUTORESET is set, we should instead get: |
69 | # |
70 | # BLUE "text\n" ==> "\e[34mtext\n\e[0m" |
71 | # |
72 | # The sub also needs to handle the case where it has no arguments correctly. |
73 | # Maintaining all of this as separate subs would be a major nightmare, as |
74 | # well as duplicate the %attributes hash, so instead we define an AUTOLOAD |
75 | # sub to define the constant subs on demand. To do that, we check the name |
76 | # of the called sub against the list of attributes, and if it's an all-caps |
77 | # version of one of them, we define the sub on the fly and then run it. |
78 | sub AUTOLOAD { |
79 | my $sub; |
80 | ($sub = $AUTOLOAD) =~ s/^.*:://; |
81 | my $attr = $attributes{lc $sub}; |
82 | if ($sub =~ /^[A-Z_]+$/ && defined $attr) { |
83 | $attr = "\e[" . $attr . 'm'; |
84 | eval qq { |
85 | sub $AUTOLOAD { |
86 | if (\$AUTORESET && \@_) { |
87 | '$attr' . "\@_" . "\e[0m"; |
88 | } else { |
89 | ('$attr' . "\@_"); |
90 | } |
91 | } |
92 | }; |
93 | goto &$AUTOLOAD; |
94 | } else { |
95 | die "undefined subroutine &$AUTOLOAD called"; |
96 | } |
97 | } |
98 | |
99 | |
100 | ############################################################################ |
101 | # Implementation (attribute string form) |
102 | ############################################################################ |
103 | |
104 | # Return the escape code for a given set of color attributes. |
105 | sub color { |
106 | my @codes = map { split } @_; |
107 | my $attribute = ''; |
108 | foreach (@codes) { |
109 | $_ = lc $_; |
110 | unless (defined $attributes{$_}) { |
111 | require Carp; |
112 | Carp::croak ("Invalid attribute name $_"); |
113 | } |
114 | $attribute .= $attributes{$_} . ';'; |
115 | } |
116 | chop $attribute; |
117 | ($attribute ne '') ? "\e[${attribute}m" : undef; |
118 | } |
119 | |
120 | # Given a string and a set of attributes, returns the string surrounded by |
121 | # escape codes to set those attributes and then clear them at the end of the |
122 | # string. If $EACHLINE is set, insert a reset before each occurrence of the |
123 | # string $EACHLINE and the starting attribute code after the string |
124 | # $EACHLINE, so that no attribute crosses line delimiters (this is often |
125 | # desirable if the output is to be piped to a pager or some other program). |
126 | sub colored { |
127 | my $string = shift; |
128 | if (defined $EACHLINE) { |
129 | my $attr = color (@_); |
130 | join '', |
131 | map { $_ && $_ ne $EACHLINE ? $attr . $_ . "\e[0m" : $_ } |
132 | split (/(\Q$EACHLINE\E)/, $string); |
133 | } else { |
134 | color (@_) . $string . "\e[0m"; |
135 | } |
136 | } |
137 | |
138 | |
139 | ############################################################################ |
140 | # Module return value and documentation |
141 | ############################################################################ |
142 | |
143 | # Ensure we evaluate to true. |
144 | 1; |
145 | __END__ |
146 | |
147 | =head1 NAME |
148 | |
149 | Term::ANSIColor - Color screen output using ANSI escape sequences |
150 | |
151 | =head1 SYNOPSIS |
152 | |
153 | use Term::ANSIColor; |
154 | print color 'bold blue'; |
155 | print "This text is bold blue.\n"; |
156 | print color 'reset'; |
157 | print "This text is normal.\n"; |
158 | print colored ("Yellow on magenta.\n", 'yellow on_magenta'); |
159 | print "This text is normal.\n"; |
160 | |
161 | use Term::ANSIColor qw(:constants); |
162 | print BOLD, BLUE, "This text is in bold blue.\n", RESET; |
163 | |
164 | use Term::ANSIColor qw(:constants); |
165 | $Term::ANSIColor::AUTORESET = 1; |
166 | print BOLD BLUE "This text is in bold blue.\n"; |
167 | print "This text is normal.\n"; |
168 | |
169 | =head1 DESCRIPTION |
170 | |
171 | This module has two interfaces, one through color() and colored() and the |
172 | other through constants. |
173 | |
174 | color() takes any number of strings as arguments and considers them to be |
175 | space-separated lists of attributes. It then forms and returns the escape |
176 | sequence to set those attributes. It doesn't print it out, just returns |
177 | it, so you'll have to print it yourself if you want to (this is so that |
178 | you can save it as a string, pass it to something else, send it to a file |
179 | handle, or do anything else with it that you might care to). |
180 | |
181 | The recognized attributes (all of which should be fairly intuitive) are |
182 | clear, reset, bold, underline, underscore, blink, reverse, concealed, |
183 | black, red, green, yellow, blue, magenta, on_black, on_red, on_green, |
184 | on_yellow, on_blue, on_magenta, on_cyan, and on_white. Case is not |
185 | significant. Underline and underscore are equivalent, as are clear and |
186 | reset, so use whichever is the most intuitive to you. The color alone |
187 | sets the foreground color, and on_color sets the background color. |
188 | |
189 | Note that attributes, once set, last until they are unset (by sending the |
190 | attribute "reset"). Be careful to do this, or otherwise your attribute will |
191 | last after your script is done running, and people get very annoyed at |
192 | having their prompt and typing changed to weird colors. |
193 | |
194 | As an aid to help with this, colored() takes a scalar as the first |
195 | argument and any number of attribute strings as the second argument and |
196 | returns the scalar wrapped in escape codes so that the attributes will be |
197 | set as requested before the string and reset to normal after the string. |
198 | Normally, colored() just puts attribute codes at the beginning and end of |
199 | the string, but if you set $Term::ANSIColor::EACHLINE to some string, |
200 | that string will be considered the line delimiter and the attribute will |
201 | be set at the beginning of each line of the passed string and reset at the |
202 | end of each line. This is often desirable if the output is being sent to |
203 | a program like a pager that can be confused by attributes that span lines. |
204 | Normally you'll want to set $Term::ANSIColor::EACHLINE to C<"\n"> to use |
205 | this feature. |
206 | |
207 | Alternately, if you import C<:constants>, you can use the constants CLEAR, |
208 | RESET, BOLD, UNDERLINE, UNDERSCORE, BLINK, REVERSE, CONCEALED, BLACK, RED, |
209 | GREEN, YELLOW, BLUE, MAGENTA, ON_BLACK, ON_RED, ON_GREEN, ON_YELLOW, |
210 | ON_BLUE, ON_MAGENTA, ON_CYAN, and ON_WHITE directly. These are the same |
211 | as color('attribute') and can be used if you prefer typing: |
212 | |
213 | print BOLD BLUE ON_WHITE "Text\n", RESET; |
214 | |
215 | to |
216 | |
217 | print colored ("Text\n", 'bold blue on_white'); |
218 | |
219 | When using the constants, if you don't want to have to remember to add the |
220 | C<, RESET> at the end of each print line, you can set |
221 | $Term::ANSIColor::AUTORESET to a true value. Then, the display mode will |
222 | automatically be reset if there is no comma after the constant. In other |
223 | words, with that variable set: |
224 | |
225 | print BOLD BLUE "Text\n"; |
226 | |
227 | will reset the display mode afterwards, whereas: |
228 | |
229 | print BOLD, BLUE, "Text\n"; |
230 | |
231 | will not. |
232 | |
233 | The subroutine interface has the advantage over the constants interface in |
234 | that only 2 soubrutines are exported into your namespace, verses 22 in the |
235 | constants interface. On the flip side, the constants interface has the |
236 | advantage of better compile time error checking, since misspelled names of |
237 | colors or attributes in calls to color() and colored() won't be caught |
238 | until runtime whereas misspelled names of constants will be caught at |
239 | compile time. So, polute your namespace with almost two dozen subrutines |
240 | that you may not even use that oftin, or risk a silly bug by mistyping an |
241 | attribute. Your choice, TMTOWTDI after all. |
242 | |
243 | =head1 DIAGNOSTICS |
244 | |
245 | =over 4 |
246 | |
247 | =item Invalid attribute name %s |
248 | |
249 | You passed an invalid attribute name to either color() or colored(). |
250 | |
251 | =item Identifier %s used only once: possible typo |
252 | |
253 | You probably mistyped a constant color name such as: |
254 | |
255 | print FOOBAR "This text is color FOOBAR\n"; |
256 | |
257 | It's probably better to always use commas after constant names in order to |
258 | force the next error. |
259 | |
260 | =item No comma allowed after filehandle |
261 | |
262 | You probably mistyped a constant color name such as: |
263 | |
264 | print FOOBAR, "This text is color FOOBAR\n"; |
265 | |
266 | Generating this fatal compile error is one of the main advantages of using |
267 | the constants interface, since you'll immediately know if you mistype a |
268 | color name. |
269 | |
270 | =item Bareword %s not allowed while "strict subs" in use |
271 | |
272 | You probably mistyped a constant color name such as: |
273 | |
274 | $Foobar = FOOBAR . "This line should be blue\n"; |
275 | |
276 | or: |
277 | |
278 | @Foobar = FOOBAR, "This line should be blue\n"; |
279 | |
280 | This will only show up under use strict (another good reason to run under |
281 | use strict). |
282 | |
283 | =back |
284 | |
285 | =head1 RESTRICTIONS |
286 | |
287 | It would be nice if one could leave off the commas around the constants |
288 | entirely and just say: |
289 | |
290 | print BOLD BLUE ON_WHITE "Text\n" RESET; |
291 | |
292 | but the syntax of Perl doesn't allow this. You need a comma after the |
293 | string. (Of course, you may consider it a bug that commas between all the |
294 | constants aren't required, in which case you may feel free to insert |
295 | commas unless you're using $Term::ANSIColor::AUTORESET.) |
296 | |
297 | For easier debuging, you may prefer to always use the commas when not |
298 | setting $Term::ANSIColor::AUTORESET so that you'll get a fatal compile |
299 | error rather than a warning. |
300 | |
301 | =head1 AUTHORS |
302 | |
303 | Original idea (using constants) by Zenin (zenin@best.com), reimplemented |
304 | using subs by Russ Allbery (rra@stanford.edu), and then combined with the |
305 | original idea by Russ with input from Zenin. |
306 | |
307 | =cut |