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