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