Commit | Line | Data |
360aca43 |
1 | ############################################################################# |
2 | # Pod/PlainText.pm -- convert POD data to formatted ASCII text |
3 | # |
4 | # Derived from Tom Christiansen's Pod::PlainText module |
5 | # (with extensive modifications). |
6 | # |
7 | # Copyright (C) 1994-1999 Tom Christiansen. All rights reserved. |
8 | # This file is part of "PodParser". PodParser is free software; |
9 | # you can redistribute it and/or modify it under the same terms |
10 | # as Perl itself. |
11 | ############################################################################# |
12 | |
13 | package Pod::PlainText; |
14 | |
15 | use vars qw($VERSION); |
e9fdc7d2 |
16 | $VERSION = 1.081; ## Current version of this package |
360aca43 |
17 | require 5.004; ## requires this Perl version or later |
18 | |
19 | =head1 NAME |
20 | |
21 | pod2plaintext - function to convert POD data to formatted ASCII text |
22 | |
23 | Pod::PlainText - a class for converting POD data to formatted ASCII text |
24 | |
25 | =head1 SYNOPSIS |
26 | |
27 | use Pod::PlainText; |
28 | pod2plaintext("perlfunc.pod"); |
29 | |
30 | or |
31 | |
32 | use Pod::PlainText; |
33 | package MyParser; |
34 | @ISA = qw(Pod::PlainText); |
35 | |
36 | sub new { |
37 | ## constructor code ... |
38 | } |
39 | |
40 | ## implementation of appropriate subclass methods ... |
41 | |
42 | package main; |
43 | $parser = new MyParser; |
44 | @ARGV = ('-') unless (@ARGV > 0); |
45 | for (@ARGV) { |
46 | $parser->parse_from_file($_); |
47 | } |
48 | |
49 | =head1 REQUIRES |
50 | |
51 | perl5.004, Pod::Select, Term::Cap, Exporter, Carp |
52 | |
53 | =head1 EXPORTS |
54 | |
55 | pod2plaintext() |
56 | |
57 | =head1 DESCRIPTION |
58 | |
59 | Pod::PlainText is a module that can convert documentation in the POD |
60 | format (such as can be found throughout the Perl distribution) into |
61 | formatted ASCII. Termcap is optionally supported for |
62 | boldface/underline, and can be enabled via C<$Pod::PlainText::termcap=1>. |
63 | If termcap has not been enabled, then backspaces will be used to |
64 | simulate bold and underlined text. |
65 | |
66 | A separate F<pod2plaintext> program is included that is primarily a wrapper |
67 | for C<Pod::PlainText::pod2plaintext()>. |
68 | |
69 | The single function C<pod2plaintext()> can take one or two arguments. The first |
70 | should be the name of a file to read the pod from, or "<&STDIN" to read from |
71 | STDIN. A second argument, if provided, should be a filehandle glob where |
72 | output should be sent. |
73 | |
74 | =head1 SEE ALSO |
75 | |
76 | L<Pod::Parser>. |
77 | |
78 | =head1 AUTHOR |
79 | |
80 | Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> |
81 | |
82 | Modified to derive from B<Pod::Parser> by |
83 | Brad Appleton E<lt>bradapp@enteract.comE<gt> |
84 | |
85 | =cut |
86 | |
87 | ############################################################################# |
88 | |
89 | use strict; |
90 | #use diagnostics; |
91 | use Carp; |
92 | use Exporter; |
93 | use Pod::Select; |
94 | use Term::Cap; |
95 | use vars qw(@ISA @EXPORT %HTML_Escapes); |
96 | |
97 | @ISA = qw(Exporter Pod::Select); |
98 | @EXPORT = qw(&pod2plaintext); |
99 | |
100 | %HTML_Escapes = ( |
101 | 'amp' => '&', # ampersand |
102 | 'lt' => '<', # left chevron, less-than |
103 | 'gt' => '>', # right chevron, greater-than |
104 | 'quot' => '"', # double quote |
105 | |
106 | "Aacute" => "\xC1", # capital A, acute accent |
107 | "aacute" => "\xE1", # small a, acute accent |
108 | "Acirc" => "\xC2", # capital A, circumflex accent |
109 | "acirc" => "\xE2", # small a, circumflex accent |
110 | "AElig" => "\xC6", # capital AE diphthong (ligature) |
111 | "aelig" => "\xE6", # small ae diphthong (ligature) |
112 | "Agrave" => "\xC0", # capital A, grave accent |
113 | "agrave" => "\xE0", # small a, grave accent |
114 | "Aring" => "\xC5", # capital A, ring |
115 | "aring" => "\xE5", # small a, ring |
116 | "Atilde" => "\xC3", # capital A, tilde |
117 | "atilde" => "\xE3", # small a, tilde |
118 | "Auml" => "\xC4", # capital A, dieresis or umlaut mark |
119 | "auml" => "\xE4", # small a, dieresis or umlaut mark |
120 | "Ccedil" => "\xC7", # capital C, cedilla |
121 | "ccedil" => "\xE7", # small c, cedilla |
122 | "Eacute" => "\xC9", # capital E, acute accent |
123 | "eacute" => "\xE9", # small e, acute accent |
124 | "Ecirc" => "\xCA", # capital E, circumflex accent |
125 | "ecirc" => "\xEA", # small e, circumflex accent |
126 | "Egrave" => "\xC8", # capital E, grave accent |
127 | "egrave" => "\xE8", # small e, grave accent |
128 | "ETH" => "\xD0", # capital Eth, Icelandic |
129 | "eth" => "\xF0", # small eth, Icelandic |
130 | "Euml" => "\xCB", # capital E, dieresis or umlaut mark |
131 | "euml" => "\xEB", # small e, dieresis or umlaut mark |
132 | "Iacute" => "\xCD", # capital I, acute accent |
133 | "iacute" => "\xED", # small i, acute accent |
134 | "Icirc" => "\xCE", # capital I, circumflex accent |
135 | "icirc" => "\xEE", # small i, circumflex accent |
136 | "Igrave" => "\xCD", # capital I, grave accent |
137 | "igrave" => "\xED", # small i, grave accent |
138 | "Iuml" => "\xCF", # capital I, dieresis or umlaut mark |
139 | "iuml" => "\xEF", # small i, dieresis or umlaut mark |
140 | "Ntilde" => "\xD1", # capital N, tilde |
141 | "ntilde" => "\xF1", # small n, tilde |
142 | "Oacute" => "\xD3", # capital O, acute accent |
143 | "oacute" => "\xF3", # small o, acute accent |
144 | "Ocirc" => "\xD4", # capital O, circumflex accent |
145 | "ocirc" => "\xF4", # small o, circumflex accent |
146 | "Ograve" => "\xD2", # capital O, grave accent |
147 | "ograve" => "\xF2", # small o, grave accent |
148 | "Oslash" => "\xD8", # capital O, slash |
149 | "oslash" => "\xF8", # small o, slash |
150 | "Otilde" => "\xD5", # capital O, tilde |
151 | "otilde" => "\xF5", # small o, tilde |
152 | "Ouml" => "\xD6", # capital O, dieresis or umlaut mark |
153 | "ouml" => "\xF6", # small o, dieresis or umlaut mark |
154 | "szlig" => "\xDF", # small sharp s, German (sz ligature) |
155 | "THORN" => "\xDE", # capital THORN, Icelandic |
156 | "thorn" => "\xFE", # small thorn, Icelandic |
157 | "Uacute" => "\xDA", # capital U, acute accent |
158 | "uacute" => "\xFA", # small u, acute accent |
159 | "Ucirc" => "\xDB", # capital U, circumflex accent |
160 | "ucirc" => "\xFB", # small u, circumflex accent |
161 | "Ugrave" => "\xD9", # capital U, grave accent |
162 | "ugrave" => "\xF9", # small u, grave accent |
163 | "Uuml" => "\xDC", # capital U, dieresis or umlaut mark |
164 | "uuml" => "\xFC", # small u, dieresis or umlaut mark |
165 | "Yacute" => "\xDD", # capital Y, acute accent |
166 | "yacute" => "\xFD", # small y, acute accent |
167 | "yuml" => "\xFF", # small y, dieresis or umlaut mark |
168 | |
169 | "lchevron" => "\xAB", # left chevron (double less than) |
170 | "rchevron" => "\xBB", # right chevron (double greater than) |
171 | ); |
172 | |
173 | ##--------------------------------- |
174 | ## Function definitions begin here |
175 | ##--------------------------------- |
176 | |
177 | ## Try to find #columns for the tty |
178 | my %NotUnix = map {($_ => 1)} qw(MacOS MSWin32 VMS MVS); |
179 | sub get_screen { |
180 | ((defined $ENV{TERMCAP}) && ($ENV{TERMCAP} =~ /co#(\d+)/)[0]) |
181 | or ((defined $ENV{COLUMNS}) && $ENV{COLUMNS}) |
182 | or (!$NotUnix{$^O} && (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0]) |
183 | or 72; |
184 | |
185 | } |
186 | |
187 | sub pod2plaintext { |
188 | my ($infile, $outfile) = @_; |
189 | local $_; |
190 | my $text_parser = new Pod::PlainText; |
191 | $text_parser->parse_from_file($infile, $outfile); |
192 | } |
193 | |
194 | ##------------------------------- |
195 | ## Method definitions begin here |
196 | ##------------------------------- |
197 | |
198 | sub new { |
199 | my $this = shift; |
200 | my $class = ref($this) || $this; |
201 | my %params = @_; |
202 | my $self = {%params}; |
203 | bless $self, $class; |
204 | $self->initialize(); |
205 | return $self; |
206 | } |
207 | |
208 | sub initialize { |
209 | my $self = shift; |
210 | $self->SUPER::initialize(); |
211 | return; |
212 | } |
213 | |
214 | sub makespace { |
215 | my $self = shift; |
216 | my $out_fh = $self->output_handle(); |
217 | if ($self->{NEEDSPACE}) { |
218 | print $out_fh "\n"; |
219 | $self->{NEEDSPACE} = 0; |
220 | } |
221 | } |
222 | |
223 | sub bold { |
224 | my $self = shift; |
225 | my $line = shift; |
226 | my $map = $self->{FONTMAP}; |
227 | return $line if $self->{USE_FORMAT}; |
228 | if ($self->{TERMCAP}) { |
229 | $line = "$map->{BOLD}$line$map->{NORM}"; |
230 | } |
231 | else { |
232 | $line =~ s/(.)/$1\b$1/g; |
233 | } |
234 | # $line = "$map->{BOLD}$line$map->{NORM}" if $self->{ANSIFY}; |
235 | return $line; |
236 | } |
237 | |
238 | sub italic { |
239 | my $self = shift; |
240 | my $line = shift; |
241 | my $map = $self->{FONTMAP}; |
242 | return $line if $self->{USE_FORMAT}; |
243 | if ($self->{TERMCAP}) { |
244 | $line = "$map->{UNDL}$line$map->{NORM}"; |
245 | } |
246 | else { |
247 | $line =~ s/(.)/$1\b_/g; |
248 | } |
249 | # $line = "$map->{UNDL}$line$map->{NORM}" if $self->{ANSIFY}; |
250 | return $line; |
251 | } |
252 | |
253 | # Fill a paragraph including underlined and overstricken chars. |
254 | # It's not perfect for words longer than the margin, and it's probably |
255 | # slow, but it works. |
256 | sub fill { |
257 | my $self = shift; |
258 | local $_ = shift; |
259 | my $par = ""; |
260 | my $indent_space = " " x $self->{INDENT}; |
261 | my $marg = $self->{SCREEN} - $self->{INDENT}; |
262 | my $line = $indent_space; |
263 | my $line_length; |
264 | foreach (split) { |
265 | my $word_length = length; |
266 | $word_length -= 2 while /\010/g; # Subtract backspaces |
267 | |
268 | if ($line_length + $word_length > $marg) { |
269 | $par .= $line . "\n"; |
270 | $line= $indent_space . $_; |
271 | $line_length = $word_length; |
272 | } |
273 | else { |
274 | if ($line_length) { |
275 | $line_length++; |
276 | $line .= " "; |
277 | } |
278 | $line_length += $word_length; |
279 | $line .= $_; |
280 | } |
281 | } |
e9fdc7d2 |
282 | $par .= "$line\n" if length $line; |
360aca43 |
283 | $par .= "\n"; |
284 | return $par; |
285 | } |
286 | |
287 | ## Handle a pending "item" paragraph. The paragraph (if given) is the |
288 | ## corresponding item text. (the item tag should be in $self->{ITEM}). |
289 | sub item { |
290 | my $self = shift; |
291 | my $cmd = shift; |
292 | local $_ = shift; |
293 | my $line = shift; |
294 | $cmd = '' unless (defined $cmd); |
295 | $_ = '' unless (defined $_); |
296 | my $out_fh = $self->output_handle(); |
297 | return unless (defined $self->{ITEM}); |
298 | my $paratag = $self->{ITEM}; |
299 | my $prev_indent = $self->{INDENTS}->[-1] || $self->{DEF_INDENT}; |
300 | ## reset state |
301 | undef $self->{ITEM}; |
302 | #$self->rm_callbacks('*'); |
303 | |
304 | my $over = $self->{INDENT}; |
305 | $over -= $prev_indent if ($prev_indent < $over); |
306 | if (length $cmd) { # tricked - this is another command |
307 | $self->output($paratag, INDENT => $prev_indent); |
308 | $self->command($cmd, $_); |
309 | } |
310 | elsif (/^\s+/o) { # verbatim |
311 | $self->output($paratag, INDENT => $prev_indent); |
312 | s/\s+\Z//; |
313 | $self->verbatim($_); |
314 | } |
315 | else { # plain textblock |
316 | $_ = $self->interpolate($_, $line); |
317 | s/\s+\Z//; |
318 | if ((length $_) && (length($paratag) <= $over)) { |
319 | $self->IP_output($paratag, $_); |
320 | } |
321 | else { |
322 | $self->output($paratag, INDENT => $prev_indent); |
323 | $self->output($_, REFORMAT => 1); |
324 | } |
325 | } |
326 | } |
327 | |
328 | sub remap_whitespace { |
329 | my $self = shift; |
330 | local($_) = shift; |
331 | tr/\000-\177/\200-\377/; |
332 | return $_; |
333 | } |
334 | |
335 | sub unmap_whitespace { |
336 | my $self = shift; |
337 | local($_) = shift; |
338 | tr/\200-\377/\000-\177/; |
339 | return $_; |
340 | } |
341 | |
342 | sub IP_output { |
343 | my $self = shift; |
344 | my $tag = shift; |
345 | local($_) = @_; |
346 | my $out_fh = $self->output_handle(); |
347 | my $tag_indent = $self->{INDENTS}->[-1] || $self->{DEF_INDENT}; |
348 | my $tag_cols = $self->{SCREEN} - $tag_indent; |
349 | my $cols = $self->{SCREEN} - $self->{INDENT}; |
350 | $tag =~ s/\s*$//; |
351 | s/\s+/ /g; |
352 | s/^ //; |
353 | my $fmt_name = '_Pod_Text_IP_output_format_'; |
354 | my $str = "format $fmt_name = \n" |
355 | . (" " x ($tag_indent)) |
356 | . '@' . ('<' x ($self->{INDENT} - $tag_indent - 1)) |
357 | . "^" . ("<" x ($cols - 1)) . "\n" |
358 | . '$tag, $_' |
359 | . "\n~~" |
360 | . (" " x ($self->{INDENT} - 2)) |
361 | . "^" . ("<" x ($cols - 5)) . "\n" |
362 | . '$_' . "\n\n.\n1"; |
363 | #warn $str; warn "tag is $tag, _ is $_"; |
364 | { |
365 | ## reset format (turn off warning about redefining a format) |
366 | local($^W) = 0; |
367 | eval $str; |
368 | croak if ($@); |
369 | } |
370 | select((select($out_fh), $~ = $fmt_name)[0]); |
371 | local($:) = ($self->curr_headings(1) eq 'SYNOPSIS') ? "\n " : $: ; |
372 | write $out_fh; |
373 | } |
374 | |
375 | sub output { |
376 | my $self = shift; |
377 | local $_ = shift; |
378 | $_ = '' unless (defined $_); |
379 | return unless (length $_); |
380 | my $out_fh = $self->output_handle(); |
381 | my %options; |
382 | if (@_ > 1) { |
383 | ## usage was $self->output($text, NAME=>VALUE, ...); |
384 | %options = @_; |
385 | } |
386 | elsif (@_ == 1) { |
387 | if (ref $_[0]) { |
388 | ## usage was $self->output($text, { NAME=>VALUE, ... } ); |
389 | %options = %{$_[0]}; |
390 | } |
391 | else { |
392 | ## usage was $self->output($text, $number); |
393 | $options{"REFORMAT"} = shift; |
394 | } |
395 | } |
396 | $options{"INDENT"} = $self->{INDENT} unless (defined $options{"INDENT"}); |
397 | if ((defined $options{"REFORMAT"}) && $options{"REFORMAT"}) { |
398 | my $cols = $self->{SCREEN} - $options{"INDENT"}; |
399 | s/\s+/ /g; |
400 | s/^ //; |
401 | my $fmt_name = '_Pod_Text_output_format_'; |
402 | my $str = "format $fmt_name = \n~~" |
403 | . (" " x ($options{"INDENT"} - 2)) |
404 | . "^" . ("<" x ($cols - 5)) . "\n" |
405 | . '$_' . "\n\n.\n1"; |
406 | { |
407 | ## reset format (turn off warning about redefining a format) |
408 | local($^W) = 0; |
409 | eval $str; |
410 | croak if ($@); |
411 | } |
412 | select((select($out_fh), $~ = $fmt_name)[0]); |
413 | local($:) = ($self->curr_headings(1) eq 'SYNOPSIS') ? "\n " : $: ; |
414 | write $out_fh; |
415 | } |
416 | else { |
417 | s/^/' ' x $options{"INDENT"}/gem; |
418 | s/^\s+\n$/\n/gm; |
419 | print $out_fh $_; |
420 | } |
421 | } |
422 | |
423 | sub internal_lrefs { |
424 | my $self = shift; |
425 | local $_ = shift; |
426 | s{L</([^>]+)>}{$1}g; |
427 | my(@items) = split( /(?:,?\s+(?:and\s+)?)/ ); |
428 | my $retstr = "the "; |
429 | my $i; |
430 | for ($i = 0; $i <= $#items; $i++) { |
431 | $retstr .= "C<$items[$i]>"; |
432 | $retstr .= ", " if @items > 2 && $i != $#items; |
433 | $retstr .= " and " if $i+2 == @items; |
434 | } |
435 | |
436 | $retstr .= " entr" . ( @items > 1 ? "ies" : "y" ) |
437 | . " elsewhere in this document "; |
438 | |
439 | return $retstr; |
440 | } |
441 | |
442 | sub begin_pod { |
443 | my $self = shift; |
444 | |
445 | $self->{BEGUN} = []; |
446 | $self->{TERMCAP} = 0; |
447 | #$self->{USE_FORMAT} = 1; |
448 | |
449 | $self->{FONTMAP} = { |
450 | UNDL => "\x1b[4m", |
451 | INV => "\x1b[7m", |
452 | BOLD => "\x1b[1m", |
453 | NORM => "\x1b[0m", |
454 | }; |
455 | if ($self->{TERMCAP} and (! defined $self->{SETUPTERMCAP})) { |
456 | $self->{SETUPTERMCAP} = 1; |
457 | my ($term) = Tgetent Term::Cap { TERM => undef, OSPEED => 9600 }; |
458 | $self->{FONTMAP}->{UNDL} = $term->{'_us'}; |
459 | $self->{FONTMAP}->{INV} = $term->{'_mr'}; |
460 | $self->{FONTMAP}->{BOLD} = $term->{'_md'}; |
461 | $self->{FONTMAP}->{NORM} = $term->{'_me'}; |
462 | } |
463 | |
464 | $self->{SCREEN} = &get_screen; |
465 | $self->{FANCY} = 0; |
466 | $self->{DEF_INDENT} = 4; |
467 | $self->{INDENTS} = []; |
468 | $self->{INDENT} = $self->{DEF_INDENT}; |
469 | $self->{NEEDSPACE} = 0; |
470 | } |
471 | |
472 | sub end_pod { |
473 | my $self = shift; |
474 | $self->item('', '', '', 0) if (defined $self->{ITEM}); |
475 | } |
476 | |
477 | sub begun_excluded { |
478 | my $self = shift; |
479 | my @begun = @{ $self->{BEGUN} }; |
480 | return (@begun > 0) ? ($begun[-1] ne 'text') : 0; |
481 | } |
482 | |
483 | sub command { |
484 | my $self = shift; |
485 | my $cmd = shift; |
486 | local $_ = shift; |
487 | my $line = shift; |
488 | $cmd = '' unless (defined $cmd); |
489 | $_ = '' unless (defined $_); |
490 | my $out_fh = $self->output_handle(); |
491 | |
492 | return if (($cmd ne 'end') and $self->begun_excluded()); |
493 | return $self->item($cmd, $_, $line) if (defined $self->{ITEM}); |
494 | $_ = $self->interpolate($_, $line); |
495 | s/\s+\Z/\n/; |
496 | |
497 | return if ($cmd eq 'pod'); |
498 | if ($cmd eq 'head1') { |
499 | $self->makespace(); |
500 | print $out_fh $_; |
501 | # print $out_fh uc($_); |
502 | } |
503 | elsif ($cmd eq 'head2') { |
504 | $self->makespace(); |
505 | # s/(\w+)/\u\L$1/g; |
506 | #print ' ' x $self->{DEF_INDENT}, $_; |
507 | # print "\xA7"; |
508 | s/(\w)/\xA7 $1/ if $self->{FANCY}; |
509 | print $out_fh ' ' x ($self->{DEF_INDENT}/2), $_, "\n"; |
510 | } |
511 | elsif ($cmd eq 'over') { |
512 | /^[-+]?\d+$/ or $_ = $self->{DEF_INDENT}; |
513 | push(@{$self->{INDENTS}}, $self->{INDENT}); |
514 | $self->{INDENT} += ($_ + 0); |
515 | } |
516 | elsif ($cmd eq 'back') { |
517 | $self->{INDENT} = pop(@{$self->{INDENTS}}); |
518 | unless (defined $self->{INDENT}) { |
519 | carp "Unmatched =back\n"; |
520 | $self->{INDENT} = $self->{DEF_INDENT}; |
521 | } |
522 | } |
523 | elsif ($cmd eq 'begin') { |
524 | my ($kind) = /^(\S*)/; |
525 | push( @{ $self->{BEGUN} }, $kind ); |
526 | } |
527 | elsif ($cmd eq 'end') { |
528 | pop( @{ $self->{BEGUN} } ); |
529 | } |
530 | elsif ($cmd eq 'for') { |
531 | $self->textblock($1) if /^text\b\s*(.*)$/s; |
532 | } |
533 | elsif ($cmd eq 'item') { |
534 | $self->makespace(); |
535 | # s/\A(\s*)\*/$1\xb7/ if $self->{FANCY}; |
536 | # s/^(\s*\*\s+)/$1 /; |
537 | $self->{ITEM} = $_; |
538 | #$self->add_callbacks('*', SUB => \&item); |
539 | } |
540 | else { |
541 | carp "Unrecognized directive: $cmd\n"; |
542 | } |
543 | } |
544 | |
545 | sub verbatim { |
546 | my $self = shift; |
547 | local $_ = shift; |
548 | my $line = shift; |
549 | return if $self->begun_excluded(); |
550 | return $self->item('', $_, $line) if (defined $self->{ITEM}); |
551 | $self->output($_); |
552 | #$self->{NEEDSPACE} = 1; |
553 | } |
554 | |
555 | sub textblock { |
556 | my $self = shift; |
557 | my $text = shift; |
558 | my $line = shift; |
559 | return if $self->begun_excluded(); |
560 | return $self->item('', $text, $line) if (defined $self->{ITEM}); |
561 | local($_) = $self->interpolate($text, $line); |
562 | s/\s*\Z/\n/; |
563 | $self->makespace(); |
564 | $self->output($_, REFORMAT => 1); |
565 | } |
566 | |
567 | sub interior_sequence { |
568 | my $self = shift; |
569 | my $cmd = shift; |
570 | my $arg = shift; |
571 | local($_) = $arg; |
572 | if ($cmd eq 'C') { |
573 | my ($pre, $post) = ("`", "'"); |
574 | ($pre, $post) = ($HTML_Escapes{"lchevron"}, $HTML_Escapes{"rchevron"}) |
575 | if ((defined $self->{FANCY}) && $self->{FANCY}); |
576 | $_ = $pre . $_ . $post; |
577 | } |
578 | elsif ($cmd eq 'E') { |
579 | if (defined $HTML_Escapes{$_}) { |
580 | $_ = $HTML_Escapes{$_}; |
581 | } |
582 | else { |
583 | carp "Unknown escape: E<$_>"; |
584 | $_ = "E<$_>"; |
585 | } |
586 | # } |
587 | # elsif ($cmd eq 'B') { |
588 | # $_ = $self->bold($_); |
589 | } |
590 | elsif ($cmd eq 'I') { |
591 | # $_ = $self->italic($_); |
592 | $_ = "*" . $_ . "*"; |
593 | } |
594 | elsif (($cmd eq 'X') || ($cmd eq 'Z')) { |
595 | $_ = ''; |
596 | } |
597 | elsif ($cmd eq 'S') { |
598 | # Escape whitespace until we are ready to print |
599 | #$_ = $self->remap_whitespace($_); |
600 | } |
601 | elsif ($cmd eq 'L') { |
602 | s/\s+/ /g; |
603 | my ($text, $manpage, $sec, $ref) = ('', $_, '', ''); |
604 | if (/\A(.*?)\|(.*)\Z/) { |
605 | $text = $1; |
606 | $manpage = $_ = $2; |
607 | } |
608 | if (/^\s*"\s*(.*)\s*"\s*$/o) { |
609 | ($manpage, $sec) = ('', "\"$1\""); |
610 | } |
611 | elsif (m|\s*/\s*|s) { |
612 | ($manpage, $sec) = split(/\s*\/\s*/, $_, 2); |
613 | } |
614 | if (! length $sec) { |
615 | $ref .= "the $manpage manpage" if (length $manpage); |
616 | } |
617 | elsif ($sec =~ /^\s*"\s*(.*)\s*"\s*$/o) { |
618 | $ref .= "the section on \"$1\""; |
619 | $ref .= " in the $manpage manpage" if (length $manpage); |
620 | } |
621 | else { |
622 | $ref .= "the \"$sec\" entry"; |
623 | $ref .= (length $manpage) ? " in the $manpage manpage" |
624 | : " in this manpage" |
625 | } |
626 | $_ = $text || $ref; |
627 | #if ( m{^ ([a-zA-Z][^\s\/]+) (\([^\)]+\))? $}x ) { |
628 | # ## LREF: a manpage(3f) |
629 | # $_ = "the $1$2 manpage"; |
630 | #} |
631 | #elsif ( m{^ ([^/]+) / ([:\w]+(\(\))?) $}x ) { |
632 | # ## LREF: an =item on another manpage |
633 | # $_ = "the \"$2\" entry in the $1 manpage"; |
634 | #} |
635 | #elsif ( m{^ / ([:\w]+(\(\))?) $}x ) { |
636 | # ## LREF: an =item on this manpage |
637 | # $_ = $self->internal_lrefs($1); |
638 | #} |
639 | #elsif ( m{^ (?: ([a-zA-Z]\S+?) / )? "?(.*?)"? $}x ) { |
640 | # ## LREF: a =head2 (head1?), maybe on a manpage, maybe right here |
641 | # ## the "func" can disambiguate |
642 | # $_ = ((defined $1) && $1) |
643 | # ? "the section on \"$2\" in the $1 manpage" |
644 | # : "the section on \"$2\""; |
645 | #} |
646 | } |
647 | return $_; |
648 | } |
649 | |
650 | 1; |