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