xref: /openbsd-src/gnu/usr.bin/perl/cpan/podlators/lib/Pod/Text/Color.pm (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9) 
1# Convert POD data to formatted color ASCII text
2#
3# This is just a basic proof of concept.  It should later be modified to make
4# better use of color, take options changing what colors are used for what
5# text, and the like.
6#
7# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
8
9##############################################################################
10# Modules and declarations
11##############################################################################
12
13package Pod::Text::Color;
14
15use 5.010;
16use strict;
17use warnings;
18
19use Pod::Text ();
20use Term::ANSIColor qw(color colored);
21
22our @ISA = qw(Pod::Text);
23our $VERSION = '5.01_02';
24$VERSION =~ tr/_//d;
25
26##############################################################################
27# Overrides
28##############################################################################
29
30# Make level one headings bold.
31sub cmd_head1 {
32    my ($self, $attrs, $text) = @_;
33    $text =~ s/\s+$//;
34    local $Term::ANSIColor::EACHLINE = "\n";
35    $self->SUPER::cmd_head1 ($attrs, colored ($text, 'bold'));
36}
37
38# Make level two headings bold.
39sub cmd_head2 {
40    my ($self, $attrs, $text) = @_;
41    $text =~ s/\s+$//;
42    $self->SUPER::cmd_head2 ($attrs, colored ($text, 'bold'));
43}
44
45# Fix the various formatting codes.
46sub cmd_b { return colored ($_[2], 'bold')   }
47sub cmd_f { return colored ($_[2], 'cyan')   }
48sub cmd_i { return colored ($_[2], 'yellow') }
49
50# Analyze a single line and return any formatting codes in effect at the end
51# of that line.
52sub end_format {
53    my ($self, $line) = @_;
54    my $reset = color ('reset');
55    my $current;
56    while ($line =~ /(\e\[[\d;]+m)/g) {
57        my $code = $1;
58        if ($code eq $reset) {
59            undef $current;
60        } else {
61            $current .= $code;
62        }
63    }
64    return $current;
65}
66
67# Output any included code in green.
68sub output_code {
69    my ($self, $code) = @_;
70    local $Term::ANSIColor::EACHLINE = "\n";
71    $code = colored ($code, 'green');
72    $self->output ($code);
73}
74
75# Strip all of the formatting from a provided string, returning the stripped
76# version.  We will eventually want to use colorstrip() from Term::ANSIColor,
77# but it's fairly new so avoid the tight dependency.
78sub strip_format {
79    my ($self, $text) = @_;
80    $text =~ s/\e\[[\d;]*m//g;
81    return $text;
82}
83
84# We unfortunately have to override the wrapping code here, since the normal
85# wrapping code gets really confused by all the escape sequences.
86sub wrap {
87    my $self = shift;
88    local $_ = shift;
89    my $output = '';
90    my $spaces = ' ' x $$self{MARGIN};
91    my $width = $$self{opt_width} - $$self{MARGIN};
92
93    # $codes matches a single special sequence.  $char matches any number of
94    # special sequences preceding a single character other than a newline.
95    # $shortchar matches some sequence of $char ending in codes followed by
96    # whitespace or the end of the string.  $longchar matches exactly $width
97    # $chars, used when we have to truncate and hard wrap.
98    my $code = '(?:\e\[[\d;]+m)';
99    my $char = "(?>$code*[^\\n])";
100    my $shortchar = '^(' . $char . "{0,$width}(?>$code*)" . ')(?:\s+|\z)';
101    my $longchar = '^(' . $char . "{$width})";
102    while (length > $width) {
103        if (s/$shortchar// || s/$longchar//) {
104            $output .= $spaces . $1 . "\n";
105        } else {
106            last;
107        }
108    }
109    $output .= $spaces . $_;
110
111    # less -R always resets terminal attributes at the end of each line, so we
112    # need to clear attributes at the end of lines and then set them again at
113    # the start of the next line.  This requires a second pass through the
114    # wrapped string, accumulating any attributes we see, remembering them,
115    # and then inserting the appropriate sequences at the newline.
116    if ($output =~ /\n/) {
117        my @lines = split (/\n/, $output);
118        my $start_format;
119        for my $line (@lines) {
120            if ($start_format && $line =~ /\S/) {
121                $line =~ s/^(\s*)(\S)/$1$start_format$2/;
122            }
123            $start_format = $self->end_format ($line);
124            if ($start_format) {
125                $line .= color ('reset');
126            }
127        }
128        $output = join ("\n", @lines);
129    }
130
131    # Fix up trailing whitespace and return the results.
132    $output =~ s/\s+$/\n\n/;
133    $output;
134}
135
136##############################################################################
137# Module return value and documentation
138##############################################################################
139
1401;
141__END__
142
143=for stopwords
144Allbery
145
146=head1 NAME
147
148Pod::Text::Color - Convert POD data to formatted color ASCII text
149
150=head1 SYNOPSIS
151
152    use Pod::Text::Color;
153    my $parser = Pod::Text::Color->new (sentence => 0, width => 78);
154
155    # Read POD from STDIN and write to STDOUT.
156    $parser->parse_from_filehandle;
157
158    # Read POD from file.pod and write to file.txt.
159    $parser->parse_from_file ('file.pod', 'file.txt');
160
161=head1 DESCRIPTION
162
163Pod::Text::Color is a simple subclass of Pod::Text that highlights output
164text using ANSI color escape sequences.  Apart from the color, it in all
165ways functions like Pod::Text.  See L<Pod::Text> for details and available
166options.
167
168Term::ANSIColor is used to get colors and therefore must be installed to use
169this module.
170
171=head1 COMPATIBILITY
172
173Pod::Text::Color 0.05 (based on L<Pod::Parser>) was the first version of this
174module included with Perl, in Perl 5.6.0.
175
176The current API based on L<Pod::Simple> was added in Pod::Text::Color 2.00.
177Pod::Text::Color 2.01 was included in Perl 5.9.3, the first version of Perl to
178incorporate those changes.
179
180Several problems with wrapping and line length were fixed as recently as
181Pod::Text::Color 4.11, included in Perl 5.29.1.
182
183This module inherits its API and most behavior from Pod::Text, so the details
184in L<Pod::Text/COMPATIBILITY> also apply.  Pod::Text and Pod::Text::Color have
185had the same module version since 4.00, included in Perl 5.23.7.  (They
186unfortunately diverge in confusing ways prior to that.)
187
188=head1 AUTHOR
189
190Russ Allbery <rra@cpan.org>.
191
192=head1 COPYRIGHT AND LICENSE
193
194Copyright 1999, 2001, 2004, 2006, 2008, 2009, 2018-2019, 2022 Russ Allbery
195<rra@cpan.org>
196
197This program is free software; you may redistribute it and/or modify it
198under the same terms as Perl itself.
199
200=head1 SEE ALSO
201
202L<Pod::Text>, L<Pod::Simple>
203
204The current version of this module is always available from its web site at
205L<https://www.eyrie.org/~eagle/software/podlators/>.  It is also part of the
206Perl core distribution as of 5.6.0.
207
208=cut
209
210# Local Variables:
211# copyright-at-end-flag: t
212# End:
213