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