Commit | Line | Data |
653a2194 |
1 | package Devel::REPL::Plugin::Colors; |
2 | |
3 | use Moose::Role; |
4 | use Term::ANSIColor; |
5 | use namespace::clean -except => [ 'meta' ]; |
6 | |
7 | has normal_color => ( |
8 | is => 'rw', lazy => 1, |
9 | default => 'green', |
10 | ); |
11 | |
12 | has error_color => ( |
13 | is => 'rw', lazy => 1, |
14 | default => 'bold red', |
15 | ); |
16 | |
17 | around error_return => sub { |
18 | my $orig = shift; |
19 | my $self = shift; |
20 | return color($self->error_color) |
21 | . $orig->($self, @_) |
22 | . color('reset'); |
23 | }; |
24 | |
25 | # we can't just munge @_ because that screws up DDS |
26 | around print => sub { |
27 | my $orig = shift; |
28 | my $self = shift; |
29 | print {$self->out_fh} color($self->normal_color); |
30 | $orig->($self, @_); |
31 | print {$self->out_fh} color('reset'); |
32 | }; |
33 | |
34 | # make arbitrary warns colored -- somewhat difficult because warn doesn't |
35 | # get $self, so we localize $SIG{__WARN__} during eval so it can get |
36 | # error_color |
37 | |
38 | around execute => sub { |
39 | my $orig = shift; |
40 | my $self = shift; |
41 | |
42 | local $SIG{__WARN__} = sub { |
43 | my $warning = shift; |
44 | chomp $warning; |
45 | warn color($self->error_color || 'bold red') |
46 | . $warning |
47 | . color('reset') |
48 | . "\n"; |
49 | }; |
50 | |
51 | $orig->($self, @_); |
52 | }; |
53 | |
54 | 1; |
55 | |
56 | __END__ |
57 | |
58 | =head1 NAME |
59 | |
60 | Devel::REPL::Plugin::Colors - add color to return values, warnings, and errors |
61 | |
62 | =head1 SYNOPSIS |
63 | |
64 | #!/usr/bin/perl |
65 | |
66 | use lib './lib'; |
67 | use Devel::REPL; |
68 | |
69 | my $repl = Devel::REPL->new; |
70 | $repl->load_plugin('LexEnv'); |
71 | $repl->load_plugin('History'); |
72 | $repl->load_plugin('Colors'); |
73 | $repl->run; |
74 | |
75 | =head1 DESCRIPTION |
76 | |
77 | Colors are very pretty. |
78 | |
79 | This plugin causes certain prints, warns, and errors to be colored. Generally |
80 | the return value(s) of each line will be colored green (you can override this |
81 | by setting C<< $_REPL->normal_color >> in your rcfile). Warnings and |
82 | compile/runtime errors will be colored with C<< $_REPL->error_color >>. This |
83 | plugin uses L<Term::ANSIColor>, so consult that module for valid colors. The |
84 | defaults are actually 'green' and 'bold red'. |
85 | |
86 | =head1 SEE ALSO |
87 | |
88 | C<Devel::REPL> |
89 | |
90 | =head1 AUTHOR |
91 | |
92 | Shawn M Moore, C<< <sartak at gmail dot com> >> |
93 | |
94 | =head1 COPYRIGHT AND LICENSE |
95 | |
96 | Copyright (C) 2007 by Shawn M Moore |
97 | |
98 | This library is free software; you can redistribute it and/or modify |
99 | it under the same terms as Perl itself. |
100 | |
101 | =cut |