local-lib5/lib/perl5/Pod/Text/Overstrike.pm

   1 # Pod::Text::Overstrike -- Convert POD data to formatted overstrike text
   2 #
   3 # Created by Joe Smith <Joe.Smith@inwap.com> 30-Nov-2000
   4 #   (based on Pod::Text::Color by Russ Allbery <rra@stanford.edu>)
   5 # Copyright 2000 Joe Smith <Joe.Smith@inwap.com>.
   6 # Copyright 2001, 2004, 2008 Russ Allbery <rra@stanford.edu>.
   7 #
   8 # This program is free software; you may redistribute it and/or modify it
   9 # under the same terms as Perl itself.
  10 #
  11 # This was written because the output from:
  12 #
  13 #     pod2text Text.pm > plain.txt; less plain.txt
  14 #
  15 # is not as rich as the output from
  16 #
  17 #     pod2man Text.pm | nroff -man > fancy.txt; less fancy.txt
  18 #
  19 # and because both Pod::Text::Color and Pod::Text::Termcap are not device
  20 # independent.
  21
  22 ##############################################################################
  23 # Modules and declarations
  24 ##############################################################################
  25
  26 package Pod::Text::Overstrike;
  27
  28 require 5.004;
  29
  30 use Pod::Text ();
  31
  32 use strict;
  33 use vars qw(@ISA $VERSION);
  34
  35 @ISA = qw(Pod::Text);
  36
  37 $VERSION = '2.03';
  38
  39 ##############################################################################
  40 # Overrides
  41 ##############################################################################
  42
  43 # Make level one headings bold, overridding any existing formatting.
  44 sub cmd_head1 {
  45     my ($self, $attrs, $text) = @_;
  46     $text =~ s/\s+$//;
  47     $text = $self->strip_format ($text);
  48     $text =~ s/(.)/$1\b$1/g;
  49     return $self->SUPER::cmd_head1 ($attrs, $text);
  50 }
  51
  52 # Make level two headings bold, overriding any existing formatting.
  53 sub cmd_head2 {
  54     my ($self, $attrs, $text) = @_;
  55     $text =~ s/\s+$//;
  56     $text = $self->strip_format ($text);
  57     $text =~ s/(.)/$1\b$1/g;
  58     return $self->SUPER::cmd_head2 ($attrs, $text);
  59 }
  60
  61 # Make level three headings underscored, overriding any existing formatting.
  62 sub cmd_head3 {
  63     my ($self, $attrs, $text) = @_;
  64     $text =~ s/\s+$//;
  65     $text = $self->strip_format ($text);
  66     $text =~ s/(.)/_\b$1/g;
  67     return $self->SUPER::cmd_head3 ($attrs, $text);
  68 }
  69
  70 # Level four headings look like level three headings.
  71 sub cmd_head4 {
  72     my ($self, $attrs, $text) = @_;
  73     $text =~ s/\s+$//;
  74     $text = $self->strip_format ($text);
  75     $text =~ s/(.)/_\b$1/g;
  76     return $self->SUPER::cmd_head4 ($attrs, $text);
  77 }
  78
  79 # The common code for handling all headers.  We have to override to avoid
  80 # interpolating twice and because we don't want to honor alt.
  81 sub heading {
  82     my ($self, $text, $indent, $marker) = @_;
  83     $self->item ("\n\n") if defined $$self{ITEM};
  84     $text .= "\n" if $$self{opt_loose};
  85     my $margin = ' ' x ($$self{opt_margin} + $indent);
  86     $self->output ($margin . $text . "\n");
  87     return '';
  88 }
  89
  90 # Fix the various formatting codes.
  91 sub cmd_b { local $_ = $_[0]->strip_format ($_[2]); s/(.)/$1\b$1/g; $_ }
  92 sub cmd_f { local $_ = $_[0]->strip_format ($_[2]); s/(.)/_\b$1/g; $_ }
  93 sub cmd_i { local $_ = $_[0]->strip_format ($_[2]); s/(.)/_\b$1/g; $_ }
  94
  95 # Output any included code in bold.
  96 sub output_code {
  97     my ($self, $code) = @_;
  98     $code =~ s/(.)/$1\b$1/g;
  99     $self->output ($code);
 100 }
 101
 102 # We unfortunately have to override the wrapping code here, since the normal
 103 # wrapping code gets really confused by all the backspaces.
 104 sub wrap {
 105     my $self = shift;
 106     local $_ = shift;
 107     my $output = '';
 108     my $spaces = ' ' x $$self{MARGIN};
 109     my $width = $$self{opt_width} - $$self{MARGIN};
 110     while (length > $width) {
 111         # This regex represents a single character, that's possibly underlined
 112         # or in bold (in which case, it's three characters; the character, a
 113         # backspace, and a character).  Use [^\n] rather than . to protect
 114         # against odd settings of $*.
 115         my $char = '(?:[^\n][\b])?[^\n]';
 116         if (s/^((?>$char){0,$width})(?:\Z|\s+)//) {
 117             $output .= $spaces . $1 . "\n";
 118         } else {
 119             last;
 120         }
 121     }
 122     $output .= $spaces . $_;
 123     $output =~ s/\s+$/\n\n/;
 124     return $output;
 125 }
 126
 127 ##############################################################################
 128 # Utility functions
 129 ##############################################################################
 130
 131 # Strip all of the formatting from a provided string, returning the stripped
 132 # version.
 133 sub strip_format {
 134     my ($self, $text) = @_;
 135     $text =~ s/(.)[\b]\1/$1/g;
 136     $text =~ s/_[\b]//g;
 137     return $text;
 138 }
 139
 140 ##############################################################################
 141 # Module return value and documentation
 142 ##############################################################################
 143
 144 1;
 145 __END__
 146
 147 =head1 NAME
 148
 149 =for stopwords
 150 overstrike
 151
 152 Pod::Text::Overstrike - Convert POD data to formatted overstrike text
 153
 154 =for stopwords
 155 overstruck Overstruck Allbery terminal's
 156
 157 =head1 SYNOPSIS
 158
 159     use Pod::Text::Overstrike;
 160     my $parser = Pod::Text::Overstrike->new (sentence => 0, width => 78);
 161
 162     # Read POD from STDIN and write to STDOUT.
 163     $parser->parse_from_filehandle;
 164
 165     # Read POD from file.pod and write to file.txt.
 166     $parser->parse_from_file ('file.pod', 'file.txt');
 167
 168 =head1 DESCRIPTION
 169
 170 Pod::Text::Overstrike is a simple subclass of Pod::Text that highlights
 171 output text using overstrike sequences, in a manner similar to nroff.
 172 Characters in bold text are overstruck (character, backspace, character)
 173 and characters in underlined text are converted to overstruck underscores
 174 (underscore, backspace, character).  This format was originally designed
 175 for hard-copy terminals and/or line printers, yet is readable on soft-copy
 176 (CRT) terminals.
 177
 178 Overstruck text is best viewed by page-at-a-time programs that take
 179 advantage of the terminal's B<stand-out> and I<underline> capabilities, such
 180 as the less program on Unix.
 181
 182 Apart from the overstrike, it in all ways functions like Pod::Text.  See
 183 L<Pod::Text> for details and available options.
 184
 185 =head1 BUGS
 186
 187 Currently, the outermost formatting instruction wins, so for example
 188 underlined text inside a region of bold text is displayed as simply bold.
 189 There may be some better approach possible.
 190
 191 =head1 SEE ALSO
 192
 193 L<Pod::Text>, L<Pod::Simple>
 194
 195 The current version of this module is always available from its web site at
 196 L<http://www.eyrie.org/~eagle/software/podlators/>.  It is also part of the
 197 Perl core distribution as of 5.6.0.
 198
 199 =head1 AUTHOR
 200
 201 Joe Smith <Joe.Smith@inwap.com>, using the framework created by Russ Allbery
 202 <rra@stanford.edu>.
 203
 204 =head1 COPYRIGHT AND LICENSE
 205
 206 Copyright 2000 by Joe Smith <Joe.Smith@inwap.com>.
 207 Copyright 2001, 2004 by Russ Allbery <rra@stanford.edu>.
 208
 209 This program is free software; you may redistribute it and/or modify it
 210 under the same terms as Perl itself.
 211
 212 =cut