Commit | Line | Data |
9741dab0 |
1 | # Pod::Man -- Convert POD data to formatted *roff input. |
50a3fd2a |
2 | # $Id: Man.pm,v 1.10 2000/11/19 05:46:19 eagle Exp $ |
9741dab0 |
3 | # |
c9abbd5d |
4 | # Copyright 1999, 2000 by Russ Allbery <rra@stanford.edu> |
9741dab0 |
5 | # |
6 | # This program is free software; you can redistribute it and/or modify it |
7 | # under the same terms as Perl itself. |
8 | # |
c9abbd5d |
9 | # This module is intended to be a replacement for the pod2man script |
10 | # distributed with versions of Perl prior to 5.6, and attempts to match its |
11 | # output except for some specific circumstances where other decisions seemed |
12 | # to produce better output. It uses Pod::Parser and is designed to be easy |
13 | # to subclass. |
14 | # |
15 | # Perl core hackers, please note that this module is also separately |
16 | # maintained outside of the Perl core as part of the podlators. Please send |
17 | # me any patches at the address above in addition to sending them to the |
18 | # standard Perl mailing lists. |
9741dab0 |
19 | |
20 | ############################################################################ |
21 | # Modules and declarations |
22 | ############################################################################ |
23 | |
24 | package Pod::Man; |
25 | |
26 | require 5.004; |
27 | |
28 | use Carp qw(carp croak); |
29 | use Pod::Parser (); |
30 | |
31 | use strict; |
32 | use subs qw(makespace); |
33 | use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION); |
34 | |
35 | @ISA = qw(Pod::Parser); |
36 | |
c9abbd5d |
37 | # Don't use the CVS revision as the version, since this module is also in |
38 | # Perl core and too many things could munge CVS magic revision strings. |
39 | # This number should ideally be the same as the CVS revision in podlators, |
40 | # however. |
50a3fd2a |
41 | $VERSION = 1.10; |
9741dab0 |
42 | |
43 | |
44 | ############################################################################ |
45 | # Preamble and *roff output tables |
46 | ############################################################################ |
47 | |
48 | # The following is the static preamble which starts all *roff output we |
49 | # generate. It's completely static except for the font to use as a |
ab1f1d91 |
50 | # fixed-width font, which is designed by @CFONT@, and the left and right |
51 | # quotes to use for C<> text, designated by @LQOUTE@ and @RQUOTE@. |
52 | # $PREAMBLE should therefore be run through s/\@CFONT\@/<font>/g before |
53 | # output. |
9741dab0 |
54 | $PREAMBLE = <<'----END OF PREAMBLE----'; |
55 | .de Sh \" Subsection heading |
56 | .br |
57 | .if t .Sp |
58 | .ne 5 |
59 | .PP |
60 | \fB\\$1\fR |
61 | .PP |
62 | .. |
63 | .de Sp \" Vertical space (when we can't use .PP) |
64 | .if t .sp .5v |
65 | .if n .sp |
66 | .. |
67 | .de Ip \" List item |
68 | .br |
69 | .ie \\n(.$>=3 .ne \\$3 |
70 | .el .ne 3 |
71 | .IP "\\$1" \\$2 |
72 | .. |
73 | .de Vb \" Begin verbatim text |
74 | .ft @CFONT@ |
75 | .nf |
76 | .ne \\$1 |
77 | .. |
78 | .de Ve \" End verbatim text |
79 | .ft R |
80 | |
81 | .fi |
82 | .. |
83 | .\" Set up some character translations and predefined strings. \*(-- will |
84 | .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left |
85 | .\" double quote, and \*(R" will give a right double quote. | will give a |
86 | .\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used |
87 | .\" to do unbreakable dashes and therefore won't be available. \*(C` and |
88 | .\" \*(C' expand to `' in nroff, nothing in troff, for use with C<> |
89 | .tr \(*W-|\(bv\*(Tr |
90 | .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' |
91 | .ie n \{\ |
92 | . ds -- \(*W- |
93 | . ds PI pi |
94 | . if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch |
95 | . if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch |
96 | . ds L" "" |
97 | . ds R" "" |
ab1f1d91 |
98 | . ds C` @LQUOTE@ |
99 | . ds C' @RQUOTE@ |
9741dab0 |
100 | 'br\} |
101 | .el\{\ |
102 | . ds -- \|\(em\| |
103 | . ds PI \(*p |
104 | . ds L" `` |
105 | . ds R" '' |
106 | 'br\} |
107 | .\" |
108 | .\" If the F register is turned on, we'll generate index entries on stderr |
109 | .\" for titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and |
110 | .\" index entries marked with X<> in POD. Of course, you'll have to process |
111 | .\" the output yourself in some meaningful fashion. |
112 | .if \nF \{\ |
113 | . de IX |
114 | . tm Index:\\$1\t\\n%\t"\\$2" |
f3248e50 |
115 | .. |
9741dab0 |
116 | . nr % 0 |
117 | . rr F |
118 | .\} |
119 | .\" |
120 | .\" For nroff, turn off justification. Always turn off hyphenation; it |
121 | .\" makes way too many mistakes in technical documents. |
122 | .hy 0 |
123 | .if n .na |
124 | .\" |
125 | .\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). |
126 | .\" Fear. Run. Save yourself. No user-serviceable parts. |
127 | .bd B 3 |
128 | . \" fudge factors for nroff and troff |
129 | .if n \{\ |
130 | . ds #H 0 |
131 | . ds #V .8m |
132 | . ds #F .3m |
133 | . ds #[ \f1 |
134 | . ds #] \fP |
135 | .\} |
136 | .if t \{\ |
137 | . ds #H ((1u-(\\\\n(.fu%2u))*.13m) |
138 | . ds #V .6m |
139 | . ds #F 0 |
140 | . ds #[ \& |
141 | . ds #] \& |
142 | .\} |
143 | . \" simple accents for nroff and troff |
144 | .if n \{\ |
145 | . ds ' \& |
146 | . ds ` \& |
147 | . ds ^ \& |
148 | . ds , \& |
149 | . ds ~ ~ |
150 | . ds / |
151 | .\} |
152 | .if t \{\ |
153 | . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" |
154 | . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' |
155 | . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' |
156 | . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' |
157 | . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' |
158 | . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' |
159 | .\} |
160 | . \" troff and (daisy-wheel) nroff accents |
161 | .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' |
162 | .ds 8 \h'\*(#H'\(*b\h'-\*(#H' |
163 | .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] |
164 | .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' |
165 | .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' |
166 | .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] |
167 | .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] |
168 | .ds ae a\h'-(\w'a'u*4/10)'e |
169 | .ds Ae A\h'-(\w'A'u*4/10)'E |
170 | . \" corrections for vroff |
171 | .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' |
172 | .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' |
173 | . \" for low resolution devices (crt and lpr) |
174 | .if \n(.H>23 .if \n(.V>19 \ |
175 | \{\ |
176 | . ds : e |
177 | . ds 8 ss |
178 | . ds o a |
179 | . ds d- d\h'-1'\(ga |
180 | . ds D- D\h'-1'\(hy |
181 | . ds th \o'bp' |
182 | . ds Th \o'LP' |
183 | . ds ae ae |
184 | . ds Ae AE |
185 | .\} |
186 | .rm #[ #] #H #V #F C |
187 | ----END OF PREAMBLE---- |
5cdeb5a2 |
188 | #`# for cperl-mode |
189 | |
9741dab0 |
190 | # This table is taken nearly verbatim from Tom Christiansen's pod2man. It |
191 | # assumes that the standard preamble has already been printed, since that's |
192 | # what defines all of the accent marks. Note that some of these are quoted |
193 | # with double quotes since they contain embedded single quotes, so use \\ |
194 | # uniformly for backslash for readability. |
195 | %ESCAPES = ( |
196 | 'amp' => '&', # ampersand |
197 | 'lt' => '<', # left chevron, less-than |
198 | 'gt' => '>', # right chevron, greater-than |
199 | 'quot' => '"', # double quote |
ab1f1d91 |
200 | 'sol' => '/', # solidus (forward slash) |
be3174d2 |
201 | 'verbar' => '|', # vertical bar |
9741dab0 |
202 | |
203 | 'Aacute' => "A\\*'", # capital A, acute accent |
204 | 'aacute' => "a\\*'", # small a, acute accent |
205 | 'Acirc' => 'A\\*^', # capital A, circumflex accent |
206 | 'acirc' => 'a\\*^', # small a, circumflex accent |
207 | 'AElig' => '\*(AE', # capital AE diphthong (ligature) |
208 | 'aelig' => '\*(ae', # small ae diphthong (ligature) |
209 | 'Agrave' => "A\\*`", # capital A, grave accent |
210 | 'agrave' => "A\\*`", # small a, grave accent |
211 | 'Aring' => 'A\\*o', # capital A, ring |
212 | 'aring' => 'a\\*o', # small a, ring |
213 | 'Atilde' => 'A\\*~', # capital A, tilde |
214 | 'atilde' => 'a\\*~', # small a, tilde |
215 | 'Auml' => 'A\\*:', # capital A, dieresis or umlaut mark |
216 | 'auml' => 'a\\*:', # small a, dieresis or umlaut mark |
217 | 'Ccedil' => 'C\\*,', # capital C, cedilla |
218 | 'ccedil' => 'c\\*,', # small c, cedilla |
219 | 'Eacute' => "E\\*'", # capital E, acute accent |
220 | 'eacute' => "e\\*'", # small e, acute accent |
221 | 'Ecirc' => 'E\\*^', # capital E, circumflex accent |
222 | 'ecirc' => 'e\\*^', # small e, circumflex accent |
223 | 'Egrave' => 'E\\*`', # capital E, grave accent |
224 | 'egrave' => 'e\\*`', # small e, grave accent |
225 | 'ETH' => '\\*(D-', # capital Eth, Icelandic |
226 | 'eth' => '\\*(d-', # small eth, Icelandic |
227 | 'Euml' => 'E\\*:', # capital E, dieresis or umlaut mark |
228 | 'euml' => 'e\\*:', # small e, dieresis or umlaut mark |
229 | 'Iacute' => "I\\*'", # capital I, acute accent |
230 | 'iacute' => "i\\*'", # small i, acute accent |
231 | 'Icirc' => 'I\\*^', # capital I, circumflex accent |
232 | 'icirc' => 'i\\*^', # small i, circumflex accent |
233 | 'Igrave' => 'I\\*`', # capital I, grave accent |
234 | 'igrave' => 'i\\*`', # small i, grave accent |
235 | 'Iuml' => 'I\\*:', # capital I, dieresis or umlaut mark |
236 | 'iuml' => 'i\\*:', # small i, dieresis or umlaut mark |
237 | 'Ntilde' => 'N\*~', # capital N, tilde |
238 | 'ntilde' => 'n\*~', # small n, tilde |
239 | 'Oacute' => "O\\*'", # capital O, acute accent |
240 | 'oacute' => "o\\*'", # small o, acute accent |
241 | 'Ocirc' => 'O\\*^', # capital O, circumflex accent |
242 | 'ocirc' => 'o\\*^', # small o, circumflex accent |
243 | 'Ograve' => 'O\\*`', # capital O, grave accent |
244 | 'ograve' => 'o\\*`', # small o, grave accent |
245 | 'Oslash' => 'O\\*/', # capital O, slash |
246 | 'oslash' => 'o\\*/', # small o, slash |
247 | 'Otilde' => 'O\\*~', # capital O, tilde |
248 | 'otilde' => 'o\\*~', # small o, tilde |
249 | 'Ouml' => 'O\\*:', # capital O, dieresis or umlaut mark |
250 | 'ouml' => 'o\\*:', # small o, dieresis or umlaut mark |
251 | 'szlig' => '\*8', # small sharp s, German (sz ligature) |
252 | 'THORN' => '\\*(Th', # capital THORN, Icelandic |
253 | 'thorn' => '\\*(th', # small thorn, Icelandic |
254 | 'Uacute' => "U\\*'", # capital U, acute accent |
255 | 'uacute' => "u\\*'", # small u, acute accent |
256 | 'Ucirc' => 'U\\*^', # capital U, circumflex accent |
257 | 'ucirc' => 'u\\*^', # small u, circumflex accent |
258 | 'Ugrave' => 'U\\*`', # capital U, grave accent |
259 | 'ugrave' => 'u\\*`', # small u, grave accent |
260 | 'Uuml' => 'U\\*:', # capital U, dieresis or umlaut mark |
261 | 'uuml' => 'u\\*:', # small u, dieresis or umlaut mark |
262 | 'Yacute' => "Y\\*'", # capital Y, acute accent |
263 | 'yacute' => "y\\*'", # small y, acute accent |
264 | 'yuml' => 'y\\*:', # small y, dieresis or umlaut mark |
265 | ); |
266 | |
267 | |
268 | ############################################################################ |
269 | # Static helper functions |
270 | ############################################################################ |
271 | |
44464a02 |
272 | # Protect leading quotes and periods against interpretation as commands. |
273 | # Also protect anything starting with a backslash, since it could expand |
274 | # or hide something that *roff would interpret as a command. This is |
275 | # overkill, but it's much simpler than trying to parse *roff here. |
c9abbd5d |
276 | sub protect { |
277 | local $_ = shift; |
44464a02 |
278 | s/^([.\'\\])/\\&$1/mg; |
c9abbd5d |
279 | $_; |
280 | } |
5cdeb5a2 |
281 | |
9741dab0 |
282 | # Translate a font string into an escape. |
283 | sub toescape { (length ($_[0]) > 1 ? '\f(' : '\f') . $_[0] } |
284 | |
5cdeb5a2 |
285 | |
9741dab0 |
286 | ############################################################################ |
287 | # Initialization |
288 | ############################################################################ |
289 | |
290 | # Initialize the object. Here, we also process any additional options |
291 | # passed to the constructor or set up defaults if none were given. center |
292 | # is the centered title, release is the version number, and date is the date |
293 | # for the documentation. Note that we can't know what file name we're |
294 | # processing due to the architecture of Pod::Parser, so that *has* to either |
295 | # be passed to the constructor or set separately with Pod::Man::name(). |
296 | sub initialize { |
297 | my $self = shift; |
298 | |
299 | # Figure out the fixed-width font. If user-supplied, make sure that |
300 | # they are the right length. |
301 | for (qw/fixed fixedbold fixeditalic fixedbolditalic/) { |
302 | if (defined $$self{$_}) { |
303 | if (length ($$self{$_}) < 1 || length ($$self{$_}) > 2) { |
ab1f1d91 |
304 | croak qq(roff font should be 1 or 2 chars,) |
305 | . qq( not "$$self{$_}"); |
9741dab0 |
306 | } |
307 | } else { |
308 | $$self{$_} = ''; |
309 | } |
310 | } |
311 | |
312 | # Set the default fonts. We can't be sure what fixed bold-italic is |
313 | # going to be called, so default to just bold. |
314 | $$self{fixed} ||= 'CW'; |
315 | $$self{fixedbold} ||= 'CB'; |
316 | $$self{fixeditalic} ||= 'CI'; |
317 | $$self{fixedbolditalic} ||= 'CB'; |
318 | |
319 | # Set up a table of font escapes. First number is fixed-width, second |
320 | # is bold, third is italic. |
321 | $$self{FONTS} = { '000' => '\fR', '001' => '\fI', |
322 | '010' => '\fB', '011' => '\f(BI', |
323 | '100' => toescape ($$self{fixed}), |
324 | '101' => toescape ($$self{fixeditalic}), |
325 | '110' => toescape ($$self{fixedbold}), |
326 | '111' => toescape ($$self{fixedbolditalic})}; |
327 | |
328 | # Extra stuff for page titles. |
329 | $$self{center} = 'User Contributed Perl Documentation' |
330 | unless defined $$self{center}; |
331 | $$self{indent} = 4 unless defined $$self{indent}; |
332 | |
333 | # We used to try first to get the version number from a local binary, |
334 | # but we shouldn't need that any more. Get the version from the running |
c9abbd5d |
335 | # Perl. Work a little magic to handle subversions correctly under both |
336 | # the pre-5.6 and the post-5.6 version numbering schemes. |
9741dab0 |
337 | if (!defined $$self{release}) { |
c9abbd5d |
338 | my @version = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/); |
339 | $version[2] ||= 0; |
340 | $version[2] *= 10 ** (3 - length $version[2]); |
341 | for (@version) { $_ += 0 } |
342 | $$self{release} = 'perl v' . join ('.', @version); |
9741dab0 |
343 | } |
344 | |
345 | # Double quotes in things that will be quoted. |
c9abbd5d |
346 | for (qw/center date release/) { |
347 | $$self{$_} =~ s/\"/\"\"/g if $$self{$_}; |
348 | } |
9741dab0 |
349 | |
ab1f1d91 |
350 | # Figure out what quotes we'll be using for C<> text. |
5cdeb5a2 |
351 | $$self{quotes} ||= '"'; |
ab1f1d91 |
352 | if ($$self{quotes} eq 'none') { |
353 | $$self{LQUOTE} = $$self{RQUOTE} = ''; |
354 | } elsif (length ($$self{quotes}) == 1) { |
355 | $$self{LQUOTE} = $$self{RQUOTE} = $$self{quotes}; |
356 | } elsif ($$self{quotes} =~ /^(.)(.)$/ |
357 | || $$self{quotes} =~ /^(..)(..)$/) { |
358 | $$self{LQUOTE} = $1; |
359 | $$self{RQUOTE} = $2; |
360 | } else { |
361 | croak qq(Invalid quote specification "$$self{quotes}"); |
362 | } |
363 | |
364 | # Double the first quote; note that this should not be s///g as two |
365 | # double quotes is represented in *roff as three double quotes, not |
366 | # four. Weird, I know. |
367 | $$self{LQUOTE} =~ s/\"/\"\"/; |
368 | $$self{RQUOTE} =~ s/\"/\"\"/; |
369 | |
9741dab0 |
370 | $$self{INDENT} = 0; # Current indentation level. |
371 | $$self{INDENTS} = []; # Stack of indentations. |
372 | $$self{INDEX} = []; # Index keys waiting to be printed. |
5cdeb5a2 |
373 | $$self{ITEMS} = 0; # The number of consecutive =items. |
9741dab0 |
374 | |
375 | $self->SUPER::initialize; |
376 | } |
377 | |
ab1f1d91 |
378 | # For each document we process, output the preamble first. |
9741dab0 |
379 | sub begin_pod { |
380 | my $self = shift; |
381 | |
382 | # Try to figure out the name and section from the file name. |
383 | my $section = $$self{section} || 1; |
384 | my $name = $$self{name}; |
385 | if (!defined $name) { |
386 | $name = $self->input_file; |
fe6f1558 |
387 | $section = 3 if (!$$self{section} && $name =~ /\.pm\z/i); |
388 | $name =~ s/\.p(od|[lm])\z//i; |
9741dab0 |
389 | if ($section =~ /^1/) { |
390 | require File::Basename; |
391 | $name = uc File::Basename::basename ($name); |
392 | } else { |
393 | # Lose everything up to the first of |
394 | # */lib/*perl* standard or site_perl module |
395 | # */*perl*/lib from -D prefix=/opt/perl |
396 | # */*perl*/ random module hierarchy |
c88ded47 |
397 | # which works. Should be fixed to use File::Spec. Also handle |
398 | # a leading lib/ since that's what ExtUtils::MakeMaker creates. |
9741dab0 |
399 | for ($name) { |
400 | s%//+%/%g; |
c9abbd5d |
401 | if ( s%^.*?/lib/[^/]*perl[^/]*/%%si |
402 | or s%^.*?/[^/]*perl[^/]*/(?:lib/)?%%si) { |
403 | s%^site(_perl)?/%%s; # site and site_perl |
404 | s%^(.*-$^O|$^O-.*)/%%so; # arch |
405 | s%^\d+\.\d+%%s; # version |
9741dab0 |
406 | } |
c88ded47 |
407 | s%^lib/%%; |
9741dab0 |
408 | s%/%::%g; |
409 | } |
410 | } |
411 | } |
412 | |
413 | # Modification date header. Try to use the modification time of our |
414 | # input. |
415 | if (!defined $$self{date}) { |
416 | my $time = (stat $self->input_file)[9] || time; |
417 | my ($day, $month, $year) = (localtime $time)[3,4,5]; |
418 | $month++; |
419 | $year += 1900; |
c9abbd5d |
420 | $$self{date} = sprintf ('%4d-%02d-%02d', $year, $month, $day); |
9741dab0 |
421 | } |
422 | |
423 | # Now, print out the preamble and the title. |
ab1f1d91 |
424 | local $_ = $PREAMBLE; |
425 | s/\@CFONT\@/$$self{fixed}/; |
426 | s/\@LQUOTE\@/$$self{LQUOTE}/; |
427 | s/\@RQUOTE\@/$$self{RQUOTE}/; |
428 | chomp $_; |
9741dab0 |
429 | print { $self->output_handle } <<"----END OF HEADER----"; |
430 | .\\" Automatically generated by Pod::Man version $VERSION |
431 | .\\" @{[ scalar localtime ]} |
432 | .\\" |
433 | .\\" Standard preamble: |
434 | .\\" ====================================================================== |
ab1f1d91 |
435 | $_ |
9741dab0 |
436 | .\\" ====================================================================== |
437 | .\\" |
438 | .IX Title "$name $section" |
439 | .TH $name $section "$$self{release}" "$$self{date}" "$$self{center}" |
440 | .UC |
441 | ----END OF HEADER---- |
442 | #"# for cperl-mode |
443 | |
444 | # Initialize a few per-file variables. |
445 | $$self{INDENT} = 0; |
446 | $$self{NEEDSPACE} = 0; |
447 | } |
448 | |
449 | |
450 | ############################################################################ |
451 | # Core overrides |
452 | ############################################################################ |
453 | |
454 | # Called for each command paragraph. Gets the command, the associated |
455 | # paragraph, the line number, and a Pod::Paragraph object. Just dispatches |
456 | # the command to a method named the same as the command. =cut is handled |
457 | # internally by Pod::Parser. |
458 | sub command { |
459 | my $self = shift; |
460 | my $command = shift; |
461 | return if $command eq 'pod'; |
ab1f1d91 |
462 | return if ($$self{EXCLUDE} && $command ne 'end'); |
463 | if ($self->can ('cmd_' . $command)) { |
464 | $command = 'cmd_' . $command; |
844b31e3 |
465 | $self->$command (@_); |
ab1f1d91 |
466 | } else { |
467 | my ($text, $line, $paragraph) = @_; |
5cdeb5a2 |
468 | my $file; |
469 | ($file, $line) = $paragraph->file_line; |
ab1f1d91 |
470 | $text =~ s/\n+\z//; |
471 | $text = " $text" if ($text =~ /^\S/); |
472 | warn qq($file:$line: Unknown command paragraph "=$command$text"\n); |
473 | return; |
844b31e3 |
474 | } |
9741dab0 |
475 | } |
476 | |
477 | # Called for a verbatim paragraph. Gets the paragraph, the line number, and |
478 | # a Pod::Paragraph object. Rofficate backslashes, untabify, put a |
479 | # zero-width character at the beginning of each line to protect against |
480 | # commands, and wrap in .Vb/.Ve. |
481 | sub verbatim { |
482 | my $self = shift; |
483 | return if $$self{EXCLUDE}; |
484 | local $_ = shift; |
485 | return if /^\s+$/; |
486 | s/\s+$/\n/; |
487 | my $lines = tr/\n/\n/; |
488 | 1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me; |
489 | s/\\/\\e/g; |
490 | s/^(\s*\S)/'\&' . $1/gme; |
5cdeb5a2 |
491 | $self->makespace; |
9741dab0 |
492 | $self->output (".Vb $lines\n$_.Ve\n"); |
493 | $$self{NEEDSPACE} = 0; |
494 | } |
495 | |
496 | # Called for a regular text block. Gets the paragraph, the line number, and |
497 | # a Pod::Paragraph object. Perform interpolation and output the results. |
498 | sub textblock { |
499 | my $self = shift; |
500 | return if $$self{EXCLUDE}; |
501 | $self->output ($_[0]), return if $$self{VERBATIM}; |
502 | |
503 | # Perform a little magic to collapse multiple L<> references. We'll |
504 | # just rewrite the whole thing into actual text at this part, bypassing |
505 | # the whole internal sequence parsing thing. |
c9abbd5d |
506 | my $text = shift; |
507 | $text =~ s{ |
9741dab0 |
508 | (L< # A link of the form L</something>. |
509 | / |
510 | ( |
511 | [:\w]+ # The item has to be a simple word... |
512 | (\(\))? # ...or simple function. |
513 | ) |
514 | > |
515 | ( |
516 | ,?\s+(and\s+)? # Allow lots of them, conjuncted. |
5cdeb5a2 |
517 | L< |
9741dab0 |
518 | / |
519 | ( [:\w]+ ( \(\) )? ) |
520 | > |
521 | )+ |
522 | ) |
523 | } { |
524 | local $_ = $1; |
c9abbd5d |
525 | s{ L< / ( [^>]+ ) > } {$1}xg; |
9741dab0 |
526 | my @items = split /(?:,?\s+(?:and\s+)?)/; |
c9abbd5d |
527 | my $string = 'the '; |
9741dab0 |
528 | my $i; |
529 | for ($i = 0; $i < @items; $i++) { |
530 | $string .= $items[$i]; |
c9abbd5d |
531 | $string .= ', ' if @items > 2 && $i != $#items; |
532 | $string .= ' ' if @items == 2 && $i == 2; |
533 | $string .= 'and ' if ($i == $#items - 1); |
9741dab0 |
534 | } |
c9abbd5d |
535 | $string .= ' entries elsewhere in this document'; |
9741dab0 |
536 | $string; |
537 | }gex; |
538 | |
539 | # Parse the tree and output it. collapse knows about references to |
540 | # scalars as well as scalars and does the right thing with them. |
c9abbd5d |
541 | $text = $self->parse ($text, @_); |
542 | $text =~ s/\n\s*$/\n/; |
5cdeb5a2 |
543 | $self->makespace; |
50a3fd2a |
544 | $self->output (protect $self->textmapfonts ($text)); |
9741dab0 |
545 | $self->outindex; |
546 | $$self{NEEDSPACE} = 1; |
547 | } |
548 | |
549 | # Called for an interior sequence. Takes a Pod::InteriorSequence object and |
550 | # returns a reference to a scalar. This scalar is the final formatted text. |
551 | # It's returned as a reference so that other interior sequences above us |
552 | # know that the text has already been processed. |
553 | sub sequence { |
554 | my ($self, $seq) = @_; |
555 | my $command = $seq->cmd_name; |
556 | |
557 | # Zero-width characters. |
f5daac4a |
558 | if ($command eq 'Z') { |
c9abbd5d |
559 | # Workaround to generate a blessable reference, needed by 5.005. |
560 | my $tmp = '\&'; |
561 | return bless \ "$tmp", 'Pod::Man::String'; |
f5daac4a |
562 | } |
9741dab0 |
563 | |
a3e04946 |
564 | # C<>, L<>, X<>, and E<> don't apply guesswork to their contents. C<> |
565 | # needs some additional special handling. |
566 | my $literal = ($command =~ /^[CELX]$/); |
567 | $literal++ if $command eq 'C'; |
568 | local $_ = $self->collapse ($seq->parse_tree, $literal); |
9741dab0 |
569 | |
570 | # Handle E<> escapes. |
571 | if ($command eq 'E') { |
2e20e14f |
572 | if (/^\d+$/) { |
573 | return bless \ chr ($_), 'Pod::Man::String'; |
574 | } elsif (exists $ESCAPES{$_}) { |
9741dab0 |
575 | return bless \ "$ESCAPES{$_}", 'Pod::Man::String'; |
576 | } else { |
577 | carp "Unknown escape E<$1>"; |
578 | return bless \ "E<$_>", 'Pod::Man::String'; |
579 | } |
580 | } |
581 | |
582 | # For all the other sequences, empty content produces no output. |
583 | return '' if $_ eq ''; |
584 | |
585 | # Handle formatting sequences. |
586 | if ($command eq 'B') { |
587 | return bless \ ('\f(BS' . $_ . '\f(BE'), 'Pod::Man::String'; |
588 | } elsif ($command eq 'F') { |
589 | return bless \ ('\f(IS' . $_ . '\f(IE'), 'Pod::Man::String'; |
590 | } elsif ($command eq 'I') { |
591 | return bless \ ('\f(IS' . $_ . '\f(IE'), 'Pod::Man::String'; |
592 | } elsif ($command eq 'C') { |
9741dab0 |
593 | return bless \ ('\f(FS\*(C`' . $_ . "\\*(C'\\f(FE"), |
594 | 'Pod::Man::String'; |
595 | } |
596 | |
597 | # Handle links. |
598 | if ($command eq 'L') { |
c9abbd5d |
599 | # A bug in lvalue subs in 5.6 requires the temporary variable. |
600 | my $tmp = $self->buildlink ($_); |
601 | return bless \ "$tmp", 'Pod::Man::String'; |
9741dab0 |
602 | } |
5cdeb5a2 |
603 | |
9741dab0 |
604 | # Whitespace protection replaces whitespace with "\ ". |
605 | if ($command eq 'S') { |
606 | s/\s+/\\ /g; |
607 | return bless \ "$_", 'Pod::Man::String'; |
608 | } |
609 | |
610 | # Add an index entry to the list of ones waiting to be output. |
611 | if ($command eq 'X') { push (@{ $$self{INDEX} }, $_); return '' } |
612 | |
613 | # Anything else is unknown. |
614 | carp "Unknown sequence $command<$_>"; |
615 | } |
616 | |
617 | |
618 | ############################################################################ |
619 | # Command paragraphs |
620 | ############################################################################ |
621 | |
622 | # All command paragraphs take the paragraph and the line number. |
623 | |
624 | # First level heading. We can't output .IX in the NAME section due to a bug |
625 | # in some versions of catman, so don't output a .IX for that section. .SH |
626 | # already uses small caps, so remove any E<> sequences that would cause |
627 | # them. |
628 | sub cmd_head1 { |
629 | my $self = shift; |
630 | local $_ = $self->parse (@_); |
631 | s/\s+$//; |
632 | s/\\s-?\d//g; |
5cdeb5a2 |
633 | if ($$self{ITEMS} > 1) { |
634 | $$self{ITEMS} = 0; |
635 | $self->output (".PD\n"); |
636 | } |
50a3fd2a |
637 | $self->output ($self->switchquotes ('.SH', $self->mapfonts ($_))); |
9741dab0 |
638 | $self->outindex (($_ eq 'NAME') ? () : ('Header', $_)); |
639 | $$self{NEEDSPACE} = 0; |
640 | } |
641 | |
642 | # Second level heading. |
643 | sub cmd_head2 { |
644 | my $self = shift; |
645 | local $_ = $self->parse (@_); |
646 | s/\s+$//; |
5cdeb5a2 |
647 | if ($$self{ITEMS} > 1) { |
648 | $$self{ITEMS} = 0; |
649 | $self->output (".PD\n"); |
650 | } |
50a3fd2a |
651 | $self->output ($self->switchquotes ('.Sh', $self->mapfonts ($_))); |
9741dab0 |
652 | $self->outindex ('Subsection', $_); |
653 | $$self{NEEDSPACE} = 0; |
654 | } |
655 | |
50a3fd2a |
656 | # Third level heading. |
657 | sub cmd_head3 { |
658 | my $self = shift; |
659 | local $_ = $self->parse (@_); |
660 | s/\s+$//; |
661 | if ($$self{ITEMS} > 1) { |
662 | $$self{ITEMS} = 0; |
663 | $self->output (".PD\n"); |
664 | } |
665 | $self->makespace; |
666 | $self->output ($self->switchquotes ('.I', $self->mapfonts ($_))); |
667 | $self->outindex ('Subsection', $_); |
668 | $$self{NEEDSPACE} = 1; |
669 | } |
670 | |
671 | # Fourth level heading. |
672 | sub cmd_head4 { |
673 | my $self = shift; |
674 | local $_ = $self->parse (@_); |
675 | s/\s+$//; |
676 | if ($$self{ITEMS} > 1) { |
677 | $$self{ITEMS} = 0; |
678 | $self->output (".PD\n"); |
679 | } |
680 | $self->makespace; |
681 | $self->output ($self->textmapfonts ($_) . "\n"); |
682 | $self->outindex ('Subsection', $_); |
683 | $$self{NEEDSPACE} = 1; |
684 | } |
685 | |
9741dab0 |
686 | # Start a list. For indents after the first, wrap the outside indent in .RS |
687 | # so that hanging paragraph tags will be correct. |
688 | sub cmd_over { |
689 | my $self = shift; |
690 | local $_ = shift; |
691 | unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} } |
692 | if (@{ $$self{INDENTS} } > 0) { |
693 | $self->output (".RS $$self{INDENT}\n"); |
694 | } |
695 | push (@{ $$self{INDENTS} }, $$self{INDENT}); |
696 | $$self{INDENT} = ($_ + 0); |
697 | } |
698 | |
699 | # End a list. If we've closed an embedded indent, we've mangled the hanging |
700 | # paragraph indent, so temporarily replace it with .RS and set WEIRDINDENT. |
701 | # We'll close that .RS at the next =back or =item. |
702 | sub cmd_back { |
703 | my $self = shift; |
704 | $$self{INDENT} = pop @{ $$self{INDENTS} }; |
705 | unless (defined $$self{INDENT}) { |
706 | carp "Unmatched =back"; |
707 | $$self{INDENT} = 0; |
708 | } |
709 | if ($$self{WEIRDINDENT}) { |
710 | $self->output (".RE\n"); |
711 | $$self{WEIRDINDENT} = 0; |
712 | } |
713 | if (@{ $$self{INDENTS} } > 0) { |
714 | $self->output (".RE\n"); |
715 | $self->output (".RS $$self{INDENT}\n"); |
716 | $$self{WEIRDINDENT} = 1; |
717 | } |
718 | $$self{NEEDSPACE} = 1; |
719 | } |
720 | |
721 | # An individual list item. Emit an index entry for anything that's |
722 | # interesting, but don't emit index entries for things like bullets and |
723 | # numbers. rofficate bullets too while we're at it (so for nice output, use |
46bce7d0 |
724 | # * for your lists rather than o or . or - or some other thing). Newlines |
725 | # in an item title are turned into spaces since *roff can't handle them |
726 | # embedded. |
9741dab0 |
727 | sub cmd_item { |
728 | my $self = shift; |
729 | local $_ = $self->parse (@_); |
730 | s/\s+$//; |
46bce7d0 |
731 | s/\s*\n\s*/ /g; |
9741dab0 |
732 | my $index; |
733 | if (/\w/ && !/^\w[.\)]\s*$/) { |
734 | $index = $_; |
fe2227f0 |
735 | $index =~ s/^\s*[-*+o.]?(?:\s+|\Z)//; |
9741dab0 |
736 | } |
737 | s/^\*(\s|\Z)/\\\(bu$1/; |
738 | if ($$self{WEIRDINDENT}) { |
739 | $self->output (".RE\n"); |
740 | $$self{WEIRDINDENT} = 0; |
741 | } |
50a3fd2a |
742 | $_ = $self->textmapfonts ($_); |
5cdeb5a2 |
743 | $self->output (".PD 0\n") if ($$self{ITEMS} == 1); |
50a3fd2a |
744 | $self->output ($self->switchquotes ('.Ip', $_, $$self{INDENT})); |
9741dab0 |
745 | $self->outindex ($index ? ('Item', $index) : ()); |
746 | $$self{NEEDSPACE} = 0; |
5cdeb5a2 |
747 | $$self{ITEMS}++; |
9741dab0 |
748 | } |
749 | |
750 | # Begin a block for a particular translator. Setting VERBATIM triggers |
751 | # special handling in textblock(). |
752 | sub cmd_begin { |
753 | my $self = shift; |
754 | local $_ = shift; |
755 | my ($kind) = /^(\S+)/ or return; |
756 | if ($kind eq 'man' || $kind eq 'roff') { |
757 | $$self{VERBATIM} = 1; |
758 | } else { |
759 | $$self{EXCLUDE} = 1; |
760 | } |
761 | } |
762 | |
763 | # End a block for a particular translator. We assume that all =begin/=end |
764 | # pairs are properly closed. |
765 | sub cmd_end { |
766 | my $self = shift; |
767 | $$self{EXCLUDE} = 0; |
768 | $$self{VERBATIM} = 0; |
769 | } |
770 | |
771 | # One paragraph for a particular translator. Ignore it unless it's intended |
772 | # for man or roff, in which case we output it verbatim. |
773 | sub cmd_for { |
774 | my $self = shift; |
775 | local $_ = shift; |
9741dab0 |
776 | return unless s/^(?:man|roff)\b[ \t]*\n?//; |
777 | $self->output ($_); |
778 | } |
779 | |
780 | |
781 | ############################################################################ |
782 | # Link handling |
783 | ############################################################################ |
784 | |
785 | # Handle links. We can't actually make real hyperlinks, so this is all to |
786 | # figure out what text and formatting we print out. |
787 | sub buildlink { |
788 | my $self = shift; |
789 | local $_ = shift; |
790 | |
791 | # Smash whitespace in case we were split across multiple lines. |
792 | s/\s+/ /g; |
793 | |
794 | # If we were given any explicit text, just output it. |
795 | if (m{ ^ ([^|]+) \| }x) { return $1 } |
796 | |
797 | # Okay, leading and trailing whitespace isn't important. |
798 | s/^\s+//; |
799 | s/\s+$//; |
800 | |
801 | # Default to using the whole content of the link entry as a section |
802 | # name. Note that L<manpage/> forces a manpage interpretation, as does |
803 | # something looking like L<manpage(section)>. Do the same thing to |
804 | # L<manpage(section)> as we would to manpage(section) without the L<>; |
805 | # see guesswork(). If we've added italics, don't add the "manpage" |
806 | # text; markup is sufficient. |
807 | my ($manpage, $section) = ('', $_); |
808 | if (/^"\s*(.*?)\s*"$/) { |
809 | $section = '"' . $1 . '"'; |
810 | } elsif (m{ ^ [-:.\w]+ (?: \( \S+ \) )? $ }x) { |
811 | ($manpage, $section) = ($_, ''); |
812 | $manpage =~ s/^([^\(]+)\(/'\f(IS' . $1 . '\f(IE\|('/e; |
813 | } elsif (m%/%) { |
814 | ($manpage, $section) = split (/\s*\/\s*/, $_, 2); |
815 | if ($manpage =~ /^[-:.\w]+(?:\(\S+\))?$/) { |
816 | $manpage =~ s/^([^\(]+)\(/'\f(IS' . $1 . '\f(IE\|'/e; |
817 | } |
818 | $section =~ s/^\"\s*//; |
819 | $section =~ s/\s*\"$//; |
820 | } |
821 | if ($manpage && $manpage !~ /\\f\(IS/) { |
822 | $manpage = "the $manpage manpage"; |
823 | } |
824 | |
825 | # Now build the actual output text. |
826 | my $text = ''; |
827 | if (!length ($section) && !length ($manpage)) { |
828 | carp "Invalid link $_"; |
829 | } elsif (!length ($section)) { |
830 | $text = $manpage; |
831 | } elsif ($section =~ /^[:\w]+(?:\(\))?/) { |
832 | $text .= 'the ' . $section . ' entry'; |
833 | $text .= (length $manpage) ? " in $manpage" |
834 | : " elsewhere in this document"; |
835 | } else { |
2e20e14f |
836 | if ($section !~ /^".*"$/) { $section = '"' . $section . '"' } |
837 | $text .= 'the section on ' . $section; |
9741dab0 |
838 | $text .= " in $manpage" if length $manpage; |
839 | } |
840 | $text; |
841 | } |
842 | |
843 | |
844 | ############################################################################ |
845 | # Escaping and fontification |
846 | ############################################################################ |
847 | |
848 | # At this point, we'll have embedded font codes of the form \f(<font>[SE] |
849 | # where <font> is one of B, I, or F. Turn those into the right font start |
50a3fd2a |
850 | # or end codes. The old pod2man didn't get B<someI<thing> else> right; |
851 | # after I<> it switched back to normal text rather than bold. We take care |
852 | # of this by using variables as a combined pointer to our current font |
853 | # sequence, and set each to the number of current nestings of start tags for |
854 | # that font. Use them as a vector to look up what font sequence to use. |
855 | # |
856 | # \fP changes to the previous font, but only one previous font is kept. We |
857 | # don't know what the outside level font is; normally it's R, but if we're |
858 | # inside a heading it could be something else. So arrange things so that |
859 | # the outside font is always the "previous" font and end with \fP instead of |
860 | # \fR. Idea from Zack Weinberg. |
9741dab0 |
861 | sub mapfonts { |
862 | my $self = shift; |
863 | local $_ = shift; |
864 | |
865 | my ($fixed, $bold, $italic) = (0, 0, 0); |
866 | my %magic = (F => \$fixed, B => \$bold, I => \$italic); |
50a3fd2a |
867 | my $last = '\fR'; |
868 | s { \\f\((.)(.) } { |
869 | my $sequence = ''; |
870 | my $f; |
871 | if ($last ne '\fR') { $sequence = '\fP' } |
872 | ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1; |
873 | $f = $$self{FONTS}{($fixed && 1) . ($bold && 1) . ($italic && 1)}; |
874 | if ($f eq $last) { |
875 | ''; |
876 | } else { |
877 | if ($f ne '\fR') { $sequence .= $f } |
878 | $last = $f; |
879 | $sequence; |
880 | } |
881 | }gxe; |
882 | $_; |
883 | } |
884 | |
885 | # Unfortunately, there is a bug in Solaris 2.6 nroff (not present in GNU |
886 | # groff) where the sequence \fB\fP\f(CW\fP leaves the font set to B rather |
887 | # than R, presumably because \f(CW doesn't actually do a font change. To |
888 | # work around this, use a separate textmapfonts for text blocks where the |
889 | # default font is always R and only use the smart mapfonts for headings. |
890 | sub textmapfonts { |
891 | my $self = shift; |
892 | local $_ = shift; |
893 | |
894 | my ($fixed, $bold, $italic) = (0, 0, 0); |
895 | my %magic = (F => \$fixed, B => \$bold, I => \$italic); |
9741dab0 |
896 | s { \\f\((.)(.) } { |
897 | ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1; |
898 | $$self{FONTS}{($fixed && 1) . ($bold && 1) . ($italic && 1)}; |
899 | }gxe; |
900 | $_; |
901 | } |
902 | |
903 | |
904 | ############################################################################ |
905 | # *roff-specific parsing |
906 | ############################################################################ |
907 | |
908 | # Called instead of parse_text, calls parse_text with the right flags. |
909 | sub parse { |
910 | my $self = shift; |
911 | $self->parse_text ({ -expand_seq => 'sequence', |
912 | -expand_ptree => 'collapse' }, @_); |
913 | } |
5cdeb5a2 |
914 | |
9741dab0 |
915 | # Takes a parse tree and a flag saying whether or not to treat it as literal |
916 | # text (not call guesswork on it), and returns the concatenation of all of |
917 | # the text strings in that parse tree. If the literal flag isn't true, |
918 | # guesswork() will be called on all plain scalars in the parse tree. |
a3e04946 |
919 | # Otherwise, just escape backslashes in the normal case. If collapse is |
920 | # being called on a C<> sequence, literal is set to 2, and we do some |
921 | # additional cleanup. Assumes that everything in the parse tree is either a |
922 | # scalar or a reference to a scalar. |
9741dab0 |
923 | sub collapse { |
924 | my ($self, $ptree, $literal) = @_; |
925 | if ($literal) { |
926 | return join ('', map { |
927 | if (ref $_) { |
928 | $$_; |
929 | } else { |
930 | s/\\/\\e/g; |
a3e04946 |
931 | s/-/\\-/g if $literal > 1; |
932 | s/__/_\\|_/g if $literal > 1; |
9741dab0 |
933 | $_; |
934 | } |
935 | } $ptree->children); |
936 | } else { |
937 | return join ('', map { |
938 | ref ($_) ? $$_ : $self->guesswork ($_) |
939 | } $ptree->children); |
940 | } |
941 | } |
942 | |
943 | # Takes a text block to perform guesswork on; this is guaranteed not to |
944 | # contain any interior sequences. Returns the text block with remapping |
945 | # done. |
946 | sub guesswork { |
947 | my $self = shift; |
948 | local $_ = shift; |
949 | |
950 | # rofficate backslashes. |
951 | s/\\/\\e/g; |
952 | |
953 | # Ensure double underbars have a tiny space between them. |
954 | s/__/_\\|_/g; |
955 | |
956 | # Make all caps a little smaller. Be careful here, since we don't want |
957 | # to make @ARGV into small caps, nor do we want to fix the MIME in |
958 | # MIME-Version, since it looks weird with the full-height V. |
959 | s{ |
960 | ( ^ | [\s\(\"\'\`\[\{<>] ) |
961 | ( [A-Z] [A-Z] [/A-Z+:\d_\$&-]* ) |
962 | (?: (?= [\s>\}\]\)\'\".?!,;:] | -- ) | $ ) |
c9abbd5d |
963 | } { $1 . '\s-1' . $2 . '\s0' }egx; |
9741dab0 |
964 | |
965 | # Turn PI into a pretty pi. |
966 | s{ (?: \\s-1 | \b ) PI (?: \\s0 | \b ) } {\\*\(PI}gx; |
967 | |
968 | # Italize functions in the form func(). |
969 | s{ |
970 | \b |
971 | ( |
972 | [:\w]+ (?:\\s-1)? \(\) |
973 | ) |
974 | } { '\f(IS' . $1 . '\f(IE' }egx; |
975 | |
976 | # func(n) is a reference to a manual page. Make it \fIfunc\fR\|(n). |
977 | s{ |
978 | \b |
979 | (\w[-:.\w]+ (?:\\s-1)?) |
980 | ( |
981 | \( [^\)] \) |
982 | ) |
983 | } { '\f(IS' . $1 . '\f(IE\|' . $2 }egx; |
984 | |
985 | # Convert simple Perl variable references to a fixed-width font. |
986 | s{ |
987 | ( \s+ ) |
988 | ( [\$\@%] [\w:]+ ) |
989 | (?! \( ) |
990 | } { $1 . '\f(FS' . $2 . '\f(FE'}egx; |
991 | |
992 | # Translate -- into a real em dash if it's used like one and fix up |
993 | # dashes, but keep hyphens hyphens. |
994 | s{ (\G|^|.) (-+) (\b|.) } { |
995 | my ($pre, $dash, $post) = ($1, $2, $3); |
996 | if (length ($dash) == 1) { |
997 | ($pre =~ /[a-zA-Z]/) ? "$pre-$post" : "$pre\\-$post"; |
998 | } elsif (length ($dash) == 2 |
999 | && ((!$pre && !$post) |
1000 | || ($pre =~ /\w/ && !$post) |
1001 | || ($pre eq ' ' && $post eq ' ') |
1002 | || ($pre eq '=' && $post ne '=') |
1003 | || ($pre ne '=' && $post eq '='))) { |
1004 | "$pre\\*(--$post"; |
1005 | } else { |
1006 | $pre . ('\-' x length $dash) . $post; |
1007 | } |
1008 | }egxs; |
1009 | |
1010 | # Fix up double quotes. |
1011 | s{ \" ([^\"]+) \" } { '\*(L"' . $1 . '\*(R"' }egx; |
1012 | |
1013 | # Make C++ into \*(C+, which is a squinched version. |
1014 | s{ \b C\+\+ } {\\*\(C+}gx; |
1015 | |
1016 | # All done. |
1017 | $_; |
1018 | } |
1019 | |
1020 | |
1021 | ############################################################################ |
1022 | # Output formatting |
1023 | ############################################################################ |
1024 | |
1025 | # Make vertical whitespace. |
1026 | sub makespace { |
1027 | my $self = shift; |
5cdeb5a2 |
1028 | $self->output (".PD\n") if ($$self{ITEMS} > 1); |
1029 | $$self{ITEMS} = 0; |
1030 | $self->output ($$self{INDENT} > 0 ? ".Sp\n" : ".PP\n") |
1031 | if $$self{NEEDSPACE}; |
9741dab0 |
1032 | } |
1033 | |
1034 | # Output any pending index entries, and optionally an index entry given as |
1035 | # an argument. Support multiple index entries in X<> separated by slashes, |
1036 | # and strip special escapes from index entries. |
1037 | sub outindex { |
1038 | my ($self, $section, $index) = @_; |
1039 | my @entries = map { split m%\s*/\s*% } @{ $$self{INDEX} }; |
1040 | return unless ($section || @entries); |
1041 | $$self{INDEX} = []; |
1042 | my $output; |
1043 | if (@entries) { |
1044 | my $output = '.IX Xref "' |
1045 | . join (' ', map { s/\"/\"\"/; $_ } @entries) |
1046 | . '"' . "\n"; |
1047 | } |
1048 | if ($section) { |
1049 | $index =~ s/\"/\"\"/; |
1050 | $index =~ s/\\-/-/g; |
1051 | $index =~ s/\\(?:s-?\d|.\(..|.)//g; |
1052 | $output .= ".IX $section " . '"' . $index . '"' . "\n"; |
1053 | } |
1054 | $self->output ($output); |
1055 | } |
1056 | |
1057 | # Output text to the output device. |
1058 | sub output { print { $_[0]->output_handle } $_[1] } |
1059 | |
50a3fd2a |
1060 | # Given a command and a single argument that may or may not contain double |
1061 | # quotes, handle double-quote formatting for it. If there are no double |
1062 | # quotes, just return the command followed by the argument in double quotes. |
1063 | # If there are double quotes, use an if statement to test for nroff, and for |
1064 | # nroff output the command followed by the argument in double quotes with |
1065 | # embedded double quotes doubled. For other formatters, remap paired double |
1066 | # quotes to `` and ''. |
1067 | sub switchquotes { |
1068 | my $self = shift; |
1069 | my $command = shift; |
1070 | local $_ = shift; |
1071 | my $extra = shift; |
1072 | s/\\\*\([LR]\"/\"/g; |
1073 | |
1074 | # We also have to deal with \*C` and \*C', which are used to add the |
1075 | # quotes around C<> text, since they may expand to " and if they do this |
1076 | # confuses the .SH macros and the like no end. |
1077 | my $c_is_quote = ($$self{LQUOTE} =~ /\"/) || ($$self{RQUOTE} =~ /\"/); |
1078 | if (/\"/ || ($c_is_quote && /\\\*\(C[\'\`]/)) { |
1079 | s/\"/\"\"/g; |
1080 | my $troff = $_; |
1081 | $troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g; |
1082 | s/\"/\"\"/g if $extra; |
1083 | $troff =~ s/\"/\"\"/g if $extra; |
1084 | s/\\\*\(C\`/$$self{LQUOTE}/g; |
1085 | s/\\\*\(C\'/$$self{RQUOTE}/g; |
1086 | $troff =~ s/\\\*\(C[\'\`]//g; |
1087 | $_ = qq("$_") . ($extra ? " $extra" : ''); |
1088 | $troff = qq("$troff") . ($extra ? " $extra" : ''); |
1089 | return ".if n $command $_\n.el $command $troff\n"; |
1090 | } else { |
1091 | $_ = qq("$_") . ($extra ? " $extra" : ''); |
1092 | return "$command $_\n"; |
1093 | } |
1094 | } |
1095 | |
9741dab0 |
1096 | __END__ |
1097 | |
1098 | .\" These are some extra bits of roff that I don't want to lose track of |
1099 | .\" but that have been removed from the preamble to make it a bit shorter |
1100 | .\" since they're not currently being used. They're accents and special |
1101 | .\" characters we don't currently have escapes for. |
1102 | .if n \{\ |
1103 | . ds ? ? |
1104 | . ds ! ! |
1105 | . ds q |
1106 | .\} |
1107 | .if t \{\ |
1108 | . ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10' |
1109 | . ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m' |
1110 | . ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10' |
1111 | .\} |
1112 | .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#] |
1113 | .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u' |
1114 | .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u' |
1115 | .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#] |
1116 | .ds oe o\h'-(\w'o'u*4/10)'e |
1117 | .ds Oe O\h'-(\w'O'u*4/10)'E |
1118 | .if \n(.H>23 .if \n(.V>19 \ |
1119 | \{\ |
1120 | . ds v \h'-1'\o'\(aa\(ga' |
1121 | . ds _ \h'-1'^ |
1122 | . ds . \h'-1'. |
1123 | . ds 3 3 |
1124 | . ds oe oe |
1125 | . ds Oe OE |
1126 | .\} |
1127 | |
1128 | ############################################################################ |
1129 | # Documentation |
1130 | ############################################################################ |
1131 | |
1132 | =head1 NAME |
1133 | |
1134 | Pod::Man - Convert POD data to formatted *roff input |
1135 | |
1136 | =head1 SYNOPSIS |
1137 | |
1138 | use Pod::Man; |
1139 | my $parser = Pod::Man->new (release => $VERSION, section => 8); |
1140 | |
1141 | # Read POD from STDIN and write to STDOUT. |
1142 | $parser->parse_from_filehandle; |
1143 | |
1144 | # Read POD from file.pod and write to file.1. |
1145 | $parser->parse_from_file ('file.pod', 'file.1'); |
1146 | |
1147 | =head1 DESCRIPTION |
1148 | |
1149 | Pod::Man is a module to convert documentation in the POD format (the |
1150 | preferred language for documenting Perl) into *roff input using the man |
1151 | macro set. The resulting *roff code is suitable for display on a terminal |
1152 | using nroff(1), normally via man(1), or printing using troff(1). It is |
9e107c59 |
1153 | conventionally invoked using the driver script B<pod2man>, but it can also |
9741dab0 |
1154 | be used directly. |
1155 | |
1156 | As a derived class from Pod::Parser, Pod::Man supports the same methods and |
1157 | interfaces. See L<Pod::Parser> for all the details; briefly, one creates a |
1158 | new parser with C<Pod::Man-E<gt>new()> and then calls either |
1159 | parse_from_filehandle() or parse_from_file(). |
1160 | |
1161 | new() can take options, in the form of key/value pairs that control the |
1162 | behavior of the parser. See below for details. |
1163 | |
1164 | If no options are given, Pod::Man uses the name of the input file with any |
1165 | trailing C<.pod>, C<.pm>, or C<.pl> stripped as the man page title, to |
1166 | section 1 unless the file ended in C<.pm> in which case it defaults to |
1167 | section 3, to a centered title of "User Contributed Perl Documentation", to |
1168 | a centered footer of the Perl version it is run with, and to a left-hand |
1169 | footer of the modification date of its input (or the current date if given |
1170 | STDIN for input). |
1171 | |
1172 | Pod::Man assumes that your *roff formatters have a fixed-width font named |
1173 | CW. If yours is called something else (like CR), use the C<fixed> option to |
1174 | specify it. This generally only matters for troff output for printing. |
1175 | Similarly, you can set the fonts used for bold, italic, and bold italic |
1176 | fixed-width output. |
1177 | |
1178 | Besides the obvious pod conversions, Pod::Man also takes care of formatting |
1179 | func(), func(n), and simple variable references like $foo or @bar so you |
1180 | don't have to use code escapes for them; complex expressions like |
1181 | C<$fred{'stuff'}> will still need to be escaped, though. It also translates |
1182 | dashes that aren't used as hyphens into en dashes, makes long dashes--like |
1183 | this--into proper em dashes, fixes "paired quotes," makes C++ and PI look |
1184 | right, puts a little space between double underbars, makes ALLCAPS a teeny |
1185 | bit smaller in troff(1), and escapes stuff that *roff treats as special so |
1186 | that you don't have to. |
1187 | |
1188 | The recognized options to new() are as follows. All options take a single |
1189 | argument. |
1190 | |
1191 | =over 4 |
1192 | |
1193 | =item center |
1194 | |
1195 | Sets the centered page header to use instead of "User Contributed Perl |
1196 | Documentation". |
1197 | |
1198 | =item date |
1199 | |
1200 | Sets the left-hand footer. By default, the modification date of the input |
1201 | file will be used, or the current date if stat() can't find that file (the |
1202 | case if the input is from STDIN), and the date will be formatted as |
1203 | YYYY-MM-DD. |
1204 | |
1205 | =item fixed |
1206 | |
1207 | The fixed-width font to use for vertabim text and code. Defaults to CW. |
1208 | Some systems may want CR instead. Only matters for troff(1) output. |
1209 | |
1210 | =item fixedbold |
1211 | |
1212 | Bold version of the fixed-width font. Defaults to CB. Only matters for |
1213 | troff(1) output. |
1214 | |
1215 | =item fixeditalic |
1216 | |
1217 | Italic version of the fixed-width font (actually, something of a misnomer, |
1218 | since most fixed-width fonts only have an oblique version, not an italic |
1219 | version). Defaults to CI. Only matters for troff(1) output. |
1220 | |
1221 | =item fixedbolditalic |
1222 | |
1223 | Bold italic (probably actually oblique) version of the fixed-width font. |
1224 | Pod::Man doesn't assume you have this, and defaults to CB. Some systems |
1225 | (such as Solaris) have this font available as CX. Only matters for troff(1) |
1226 | output. |
1227 | |
ab1f1d91 |
1228 | =item quotes |
1229 | |
1230 | Sets the quote marks used to surround CE<lt>> text. If the value is a |
1231 | single character, it is used as both the left and right quote; if it is two |
1232 | characters, the first character is used as the left quote and the second as |
1233 | the right quoted; and if it is four characters, the first two are used as |
1234 | the left quote and the second two as the right quote. |
1235 | |
1236 | This may also be set to the special value C<none>, in which case no quote |
1237 | marks are added around CE<lt>> text (but the font is still changed for troff |
1238 | output). |
1239 | |
9741dab0 |
1240 | =item release |
1241 | |
1242 | Set the centered footer. By default, this is the version of Perl you run |
1243 | Pod::Man under. Note that some system an macro sets assume that the |
1244 | centered footer will be a modification date and will prepend something like |
1245 | "Last modified: "; if this is the case, you may want to set C<release> to |
1246 | the last modified date and C<date> to the version number. |
1247 | |
1248 | =item section |
1249 | |
1250 | Set the section for the C<.TH> macro. The standard section numbering |
1251 | convention is to use 1 for user commands, 2 for system calls, 3 for |
1252 | functions, 4 for devices, 5 for file formats, 6 for games, 7 for |
1253 | miscellaneous information, and 8 for administrator commands. There is a lot |
1254 | of variation here, however; some systems (like Solaris) use 4 for file |
1255 | formats, 5 for miscellaneous information, and 7 for devices. Still others |
1256 | use 1m instead of 8, or some mix of both. About the only section numbers |
1257 | that are reliably consistent are 1, 2, and 3. |
1258 | |
1259 | By default, section 1 will be used unless the file ends in .pm in which case |
1260 | section 3 will be selected. |
1261 | |
1262 | =back |
1263 | |
1264 | The standard Pod::Parser method parse_from_filehandle() takes up to two |
1265 | arguments, the first being the file handle to read POD from and the second |
1266 | being the file handle to write the formatted output to. The first defaults |
1267 | to STDIN if not given, and the second defaults to STDOUT. The method |
1268 | parse_from_file() is almost identical, except that its two arguments are the |
1269 | input and output disk files instead. See L<Pod::Parser> for the specific |
1270 | details. |
1271 | |
1272 | =head1 DIAGNOSTICS |
1273 | |
1274 | =over 4 |
1275 | |
ab1f1d91 |
1276 | =item roff font should be 1 or 2 chars, not "%s" |
9741dab0 |
1277 | |
1278 | (F) You specified a *roff font (using C<fixed>, C<fixedbold>, etc.) that |
1279 | wasn't either one or two characters. Pod::Man doesn't support *roff fonts |
1280 | longer than two characters, although some *roff extensions do (the canonical |
1281 | versions of nroff(1) and troff(1) don't either). |
1282 | |
1283 | =item Invalid link %s |
1284 | |
1285 | (W) The POD source contained a C<LE<lt>E<gt>> sequence that Pod::Man was |
1286 | unable to parse. You should never see this error message; it probably |
1287 | indicates a bug in Pod::Man. |
1288 | |
ab1f1d91 |
1289 | =item Invalid quote specification "%s" |
1290 | |
1291 | (F) The quote specification given (the quotes option to the constructor) was |
1292 | invalid. A quote specification must be one, two, or four characters long. |
1293 | |
1294 | =item %s:%d: Unknown command paragraph "%s". |
1295 | |
1296 | (W) The POD source contained a non-standard command paragraph (something of |
1297 | the form C<=command args>) that Pod::Man didn't know about. It was ignored. |
1298 | |
9741dab0 |
1299 | =item Unknown escape EE<lt>%sE<gt> |
1300 | |
1301 | (W) The POD source contained an C<EE<lt>E<gt>> escape that Pod::Man didn't |
1302 | know about. C<EE<lt>%sE<gt>> was printed verbatim in the output. |
1303 | |
1304 | =item Unknown sequence %s |
1305 | |
1306 | (W) The POD source contained a non-standard interior sequence (something of |
1307 | the form C<XE<lt>E<gt>>) that Pod::Man didn't know about. It was ignored. |
1308 | |
844b31e3 |
1309 | =item %s: Unknown command paragraph "%s" on line %d. |
1310 | |
1311 | (W) The POD source contained a non-standard command paragraph (something of |
1312 | the form C<=command args>) that Pod::Man didn't know about. It was ignored. |
1313 | |
9741dab0 |
1314 | =item Unmatched =back |
1315 | |
1316 | (W) Pod::Man encountered a C<=back> command that didn't correspond to an |
1317 | C<=over> command. |
1318 | |
1319 | =back |
1320 | |
1321 | =head1 BUGS |
1322 | |
1323 | The lint-like features and strict POD format checking done by B<pod2man> are |
1324 | not yet implemented and should be, along with the corresponding C<lax> |
1325 | option. |
1326 | |
1327 | The NAME section should be recognized specially and index entries emitted |
1328 | for everything in that section. This would have to be deferred until the |
1329 | next section, since extraneous things in NAME tends to confuse various man |
1330 | page processors. |
1331 | |
1332 | The handling of hyphens, en dashes, and em dashes is somewhat fragile, and |
1333 | one may get the wrong one under some circumstances. This should only matter |
1334 | for troff(1) output. |
1335 | |
1336 | When and whether to use small caps is somewhat tricky, and Pod::Man doesn't |
1337 | necessarily get it right. |
1338 | |
1339 | Pod::Man doesn't handle font names longer than two characters. Neither do |
1340 | most troff(1) implementations, but GNU troff does as an extension. It would |
1341 | be nice to support as an option for those who want to use it. |
1342 | |
1343 | The preamble added to each output file is rather verbose, and most of it is |
1344 | only necessary in the presence of EE<lt>E<gt> escapes for non-ASCII |
1345 | characters. It would ideally be nice if all of those definitions were only |
1346 | output if needed, perhaps on the fly as the characters are used. |
1347 | |
1348 | Some of the automagic applied to file names assumes Unix directory |
1349 | separators. |
1350 | |
1351 | Pod::Man is excessively slow. |
1352 | |
9741dab0 |
1353 | =head1 SEE ALSO |
1354 | |
9e107c59 |
1355 | L<Pod::Parser|Pod::Parser>, perlpod(1), pod2man(1), nroff(1), troff(1), |
9741dab0 |
1356 | man(1), man(7) |
1357 | |
1358 | Ossanna, Joseph F., and Brian W. Kernighan. "Troff User's Manual," |
1359 | Computing Science Technical Report No. 54, AT&T Bell Laboratories. This is |
1360 | the best documentation of standard nroff(1) and troff(1). At the time of |
1361 | this writing, it's available at http://www.cs.bell-labs.com/cm/cs/cstr.html. |
1362 | |
1363 | The man page documenting the man macro set may be man(5) instead of man(7) |
9e107c59 |
1364 | on your system. Also, please see pod2man(1) for extensive documentation on |
9741dab0 |
1365 | writing manual pages if you've not done it before and aren't familiar with |
1366 | the conventions. |
1367 | |
1368 | =head1 AUTHOR |
1369 | |
1370 | Russ Allbery E<lt>rra@stanford.eduE<gt>, based I<very> heavily on the |
1371 | original B<pod2man> by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>. |
1372 | |
1373 | =cut |