"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/Pod/Text/Color.pm" (7 Mar 2020, 6202 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

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