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