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