This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
This is patch.2b1f to perl5.002beta1.
[perl5.git] / pod / pod2man.PL
CommitLineData
4633a7c4
LW
1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
5
6# List explicitly here the variables you want Configure to
7# generate. Metaconfig only looks for shell variables, so you
8# have to mention them as if they were shell variables, not
9# %Config entries. Thus you write
10# $startperl
11# to ensure Configure will look for $Config{startperl}.
12
13# This forces PL files to create target in same directory as PL file.
14# This is so that make depend always knows where to find PL derivatives.
15chdir(dirname($0));
16($file = basename($0)) =~ s/\.PL$//;
17$file =~ s/\.pl$//
18 if ($Config{'osname'} eq 'VMS' or
19 $Config{'osname'} eq 'OS2'); # "case-forgiving"
20
21open OUT,">$file" or die "Can't create $file: $!";
22
23print "Extracting $file (with variable substitutions)\n";
24
25# In this section, perl variables will be expanded during extraction.
26# You can use $Config{...} to use Configure variables.
27
28print OUT <<"!GROK!THIS!";
29$Config{'startperl'}
30 eval 'exec perl -S \$0 "\$@"'
31 if 0;
5d94fbed
AD
32!GROK!THIS!
33
4633a7c4
LW
34# In the following, perl variables are not expanded during extraction.
35
36print OUT <<'!NO!SUBS!';
a0d0e21e
LW
37
38$/ = "";
39$cutting = 1;
40
41$CFont = 'CW';
42if ($ARGV[0] =~ s/-fc(.*)//) {
43 shift;
44 $CFont = $1 || shift;
45}
46
47if (length($CFont) == 2) {
48 $CFont_embed = "\\f($CFont";
49}
50elsif (length($CFont) == 1) {
51 $CFont_embed = "\\f$CFont";
52}
53else {
54 die "Roff font should be 1 or 2 chars, not `$CFont_embed'";
55}
56
57$name = @ARGV ? $ARGV[0] : "something";
58$name =~ s/\..*//;
59
60print <<"END";
61.rn '' }`
62''' \$RCSfile\$\$Revision\$\$Date\$
63'''
64''' \$Log\$
65'''
66.de Sh
67.br
68.if t .Sp
69.ne 5
70.PP
71\\fB\\\\\$1\\fR
72.PP
73..
74.de Sp
75.if t .sp .5v
76.if n .sp
77..
78.de Ip
79.br
80.ie \\\\n(.\$>=3 .ne \\\\\$3
81.el .ne 3
82.IP "\\\\\$1" \\\\\$2
83..
84.de Vb
85.ft $CFont
86.nf
87.ne \\\\\$1
88..
89.de Ve
90.ft R
91
92.fi
93..
94'''
95'''
96''' Set up \\*(-- to give an unbreakable dash;
97''' string Tr holds user defined translation string.
98''' Bell System Logo is used as a dummy character.
99'''
100.tr \\(*W-|\\(bv\\*(Tr
101.ie n \\{\\
102.ds -- \\(*W-
103.if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
104.if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
105.ds L" ""
106.ds R" ""
107.ds L' '
108.ds R' '
109'br\\}
110.el\\{\\
111.ds -- \\(em\\|
112.tr \\*(Tr
113.ds L" ``
114.ds R" ''
115.ds L' `
116.ds R' '
117.if t .ds PI \\(*p
118.if n .ds PI PI
119'br\\}
120.TH \U$name\E 1 "\\*(RP"
121.UC
122END
123
124print <<'END';
125.if n .hy 0
126.if n .na
127.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
128.de CQ \" put $1 in typewriter font
129END
130print ".ft $CFont\n";
131print <<'END';
132'if n "\c
748a9306
LW
133'if t \\&\\$1\c
134'if n \\&\\$1\c
a0d0e21e 135'if n \&"
748a9306 136\\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
a0d0e21e
LW
137'.ft R
138..
139.\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
140. \" AM - accent mark definitions
141.bd S B 3
142. \" fudge factors for nroff and troff
143.if n \{\
144. ds #H 0
145. ds #V .8m
146. ds #F .3m
147. ds #[ \f1
148. ds #] \fP
149.\}
150.if t \{\
748a9306 151. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
a0d0e21e
LW
152. ds #V .6m
153. ds #F 0
154. ds #[ \&
155. ds #] \&
156.\}
157. \" simple accents for nroff and troff
158.if n \{\
159. ds ' \&
160. ds ` \&
161. ds ^ \&
162. ds , \&
163. ds ~ ~
164. ds ? ?
165. ds ! !
166. ds /
167. ds q
168.\}
169.if t \{\
748a9306
LW
170. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
171. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
172. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
173. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
174. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
a0d0e21e
LW
175. ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
176. ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
748a9306 177. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
a0d0e21e
LW
178. 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'
179.\}
180. \" troff and (daisy-wheel) nroff accents
748a9306 181.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
a0d0e21e 182.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
748a9306
LW
183.ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
184.ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
185.ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
a0d0e21e 186.ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
748a9306 187.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
a0d0e21e 188.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
748a9306 189.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
a0d0e21e
LW
190.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
191.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
192.ds ae a\h'-(\w'a'u*4/10)'e
193.ds Ae A\h'-(\w'A'u*4/10)'E
194.ds oe o\h'-(\w'o'u*4/10)'e
195.ds Oe O\h'-(\w'O'u*4/10)'E
196. \" corrections for vroff
748a9306
LW
197.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
198.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
a0d0e21e
LW
199. \" for low resolution devices (crt and lpr)
200.if \n(.H>23 .if \n(.V>19 \
201\{\
202. ds : e
203. ds 8 ss
204. ds v \h'-1'\o'\(aa\(ga'
205. ds _ \h'-1'^
206. ds . \h'-1'.
207. ds 3 3
208. ds o a
209. ds d- d\h'-1'\(ga
210. ds D- D\h'-1'\(hy
211. ds th \o'bp'
212. ds Th \o'LP'
213. ds ae ae
214. ds Ae AE
215. ds oe oe
216. ds Oe OE
217.\}
218.rm #[ #] #H #V #F C
219END
220
221$indent = 0;
222
223while (<>) {
224 if ($cutting) {
225 next unless /^=/;
226 $cutting = 0;
227 }
228 chomp;
229
230 # Translate verbatim paragraph
231
232 if (/^\s/) {
233 @lines = split(/\n/);
234 for (@lines) {
235 1 while s
236 {^( [^\t]* ) \t ( \t* ) }
237 { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
238 s/\\/\\e/g;
239 s/\A/\\&/s;
240 }
241 $lines = @lines;
242 makespace() unless $verbatim++;
243 print ".Vb $lines\n";
244 print join("\n", @lines), "\n";
245 print ".Ve\n";
246 $needspace = 0;
247 next;
248 }
249
250 $verbatim = 0;
251
252 # check for things that'll hosed our noremap scheme; affects $_
253 init_noremap();
254
255 if (!/^=item/) {
256
257 # trofficate backslashes; must do it before what happens below
258 s/\\/noremap('\\e')/ge;
259
260 # first hide the escapes in case we need to
261 # intuit something and get it wrong due to fmting
262
263 s/([A-Z]<[^<>]*>)/noremap($1)/ge;
264
265 # func() is a reference to a perl function
266 s{
267 \b
268 (
269 [:\w]+ \(\)
270 )
271 } {I<$1>}gx;
272
273 # func(n) is a reference to a man page
274 s{
275 (\w+)
276 (
277 \(
278 [^\s,\051]+
279 \)
280 )
281 } {I<$1>\\|$2}gx;
282
283 # convert simple variable references
748a9306 284 s/(\s+)([\$\@%][\w:]+)/${1}C<$2>/g;
a0d0e21e
LW
285
286 if (m{ (
287 [\-\w]+
288 \(
289 [^\051]*?
290 [\@\$,]
291 [^\051]*?
292 \)
293 )
294 }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
295 {
296 warn "``$1'' should be a [LCI]<$1> ref";
297 }
298
299 while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
300 warn "``$1'' should be [CB]<$1> ref";
301 }
302
303 # put it back so we get the <> processed again;
304 clear_noremap(0); # 0 means leave the E's
305
306 } else {
307 # trofficate backslashes
308 s/\\/noremap('\\e')/ge;
309
310 }
311
312 # need to hide E<> first; they're processed in clear_noremap
313 s/(E<[^<>]+>)/noremap($1)/ge;
314
315
316 $maxnest = 10;
317 while ($maxnest-- && /[A-Z]</) {
318
319 # can't do C font here
320 s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
321
322 # files and filelike refs in italics
323 s/F<([^<>]*)>/I<$1>/g;
324
325 # no break -- usually we want C<> for this
326 s/S<([^<>]*)>/nobreak($1)/eg;
327
328 # LREF: a manpage(3f)
329 s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
330
331 # LREF: an =item on another manpage
332 s{
333 L<
334 ([^/]+)
335 /
336 (
337 [:\w]+
338 (\(\))?
339 )
340 >
341 } {the C<$2> entry in the I<$1> manpage}gx;
342
343 # LREF: an =item on this manpage
344 s{
345 ((?:
346 L<
347 /
348 (
349 [:\w]+
350 (\(\))?
351 )
352 >
353 (,?\s+(and\s+)?)?
354 )+)
355 } { internal_lrefs($1) }gex;
356
357 # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
358 # the "func" can disambiguate
359 s{
360 L<
361 (?:
362 ([a-zA-Z]\S+?) /
363 )?
364 "?(.*?)"?
365 >
366 }{
367 do {
368 $1 # if no $1, assume it means on this page.
369 ? "the section on I<$2> in the I<$1> manpage"
370 : "the section on I<$2>"
371 }
372 }gex;
373
374 s/Z<>/\\&/g;
375
376 # comes last because not subject to reprocessing
377 s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
378 }
379
380 if (s/^=//) {
381 $needspace = 0; # Assume this.
382
383 s/\n/ /g;
384
385 ($Cmd, $_) = split(' ', $_, 2);
386
387 if (defined $_) {
388 &escapes;
389 s/"/""/g;
390 }
391
392 clear_noremap(1);
393
394 if ($Cmd eq 'cut') {
395 $cutting = 1;
396 }
397 elsif ($Cmd eq 'head1') {
398 print qq{.SH "$_"\n}
399 }
400 elsif ($Cmd eq 'head2') {
401 print qq{.Sh "$_"\n}
402 }
403 elsif ($Cmd eq 'over') {
404 push(@indent,$indent);
405 $indent = $_ + 0;
406 }
407 elsif ($Cmd eq 'back') {
408 $indent = pop(@indent);
409 warn "Unmatched =back\n" unless defined $indent;
410 $needspace = 1;
411 }
412 elsif ($Cmd eq 'item') {
413 s/^\*( |$)/\\(bu$1/g;
414 print STDOUT qq{.Ip "$_" $indent\n};
415 }
416 else {
417 warn "Unrecognized directive: $Cmd\n";
418 }
419 }
420 else {
421 if ($needspace) {
422 &makespace;
423 }
424 &escapes;
425 clear_noremap(1);
426 print $_, "\n";
427 $needspace = 1;
428 }
429}
430
431print <<"END";
432
433.rn }` ''
434END
435
436#########################################################################
437
438sub nobreak {
439 my $string = shift;
440 $string =~ s/ /\\ /g;
441 $string;
442}
443
444sub escapes {
445
446 # translate the minus in foo-bar into foo\-bar for roff
447 s/([^0-9a-z-])-([^-])/$1\\-$2/g;
448
449 # make -- into the string version \*(-- (defined above)
450 s/\b--\b/\\*(--/g;
451 s/"--([^"])/"\\*(--$1/g; # should be a better way
452 s/([^"])--"/$1\\*(--"/g;
453
454 # fix up quotes; this is somewhat tricky
455 if (!/""/) {
456 s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge;
457 s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
458 }
459
460 #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
461 #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
462
463
464 # make sure that func() keeps a bit a space tween the parens
465 ### s/\b\(\)/\\|()/g;
466 ### s/\b\(\)/(\\|)/g;
467
468 # make C++ into \*C+, which is a squinched version (defined above)
469 s/\bC\+\+/\\*(C+/g;
470
471 # make double underbars have a little tiny space between them
472 s/__/_\\|_/g;
473
474 # PI goes to \*(-- (defined above)
475 s/\bPI\b/noremap('\\*(PI')/ge;
476
477 # make all caps a teeny bit smaller, but don't muck with embedded code literals
478 my $hidCFont = font('C');
479 if ($Cmd !~ /^head1/) { # SH already makes smaller
480 # /g isn't enough; 1 while or we'll be off
481
482# 1 while s{
483# (?!$hidCFont)(..|^.|^)
484# \b
485# (
486# [A-Z][\/A-Z+:\-\d_$.]+
487# )
488# (s?)
489# \b
490# } {$1\\s-1$2\\s0}gmox;
491
492 1 while s{
493 (?!$hidCFont)(..|^.|^)
494 (
495 \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
496 )
497 } {
498 $1 . noremap( '\\s-1' . $2 . '\\s0' )
499 }egmox;
500
501 }
502}
503
504# make troff just be normal, but make small nroff get quoted
505# decided to just put the quotes in the text; sigh;
506sub ccvt {
507 local($_,$prev) = @_;
508 if ( /^\W+$/ && !/^\$./ ) {
509 ($prev && "\n") . noremap(qq{.CQ $_ \n\\&});
510 # what about $" ?
511 } else {
512 noremap(qq{${CFont_embed}$_\\fR});
513 }
514 noremap(qq{.CQ "$_" \n\\&});
515}
516
517sub makespace {
518 if ($indent) {
519 print ".Sp\n";
520 }
521 else {
522 print ".PP\n";
523 }
524}
525
526sub font {
527 local($font) = shift;
528 return '\\f' . noremap($font);
529}
530
531sub noremap {
532 local($thing_to_hide) = shift;
533 $thing_to_hide =~ tr/\000-\177/\200-\377/;
534 return $thing_to_hide;
535}
536
537sub init_noremap {
538 if ( /[\200-\377]/ ) {
539 warn "hit bit char in input stream";
540 }
541}
542
543sub clear_noremap {
544 my $ready_to_print = $_[0];
545
546 tr/\200-\377/\000-\177/;
547
548 # trofficate backslashes
549 # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
550
551 # now for the E<>s, which have been hidden until now
552 # otherwise the interative \w<> processing would have
553 # been hosed by the E<gt>
554 s {
555 E<
556 ( [A-Za-z]+ )
557 >
558 } {
559 do {
560 exists $HTML_Escapes{$1}
561 ? do { $HTML_Escapes{$1} }
562 : do {
563 warn "Unknown escape: $& in $_";
564 "E<$1>";
565 }
566 }
567 }egx if $ready_to_print;
568}
569
570sub internal_lrefs {
571 local($_) = shift;
572
573 s{L</([^>]+)>}{$1}g;
574 my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
575 my $retstr = "the ";
576 my $i;
577 for ($i = 0; $i <= $#items; $i++) {
578 $retstr .= "C<$items[$i]>";
579 $retstr .= ", " if @items > 2 && $i != $#items;
580 $retstr .= " and " if $i+2 == @items;
581 }
582
583 $retstr .= " entr" . ( @items > 1 ? "ies" : "y" )
584 . " elsewhere in this document";
585
586 return $retstr;
587
588}
589
590BEGIN {
591%HTML_Escapes = (
592 'amp' => '&', # ampersand
593 'lt' => '<', # left chevron, less-than
594 'gt' => '>', # right chevron, greater-than
595 'quot' => '"', # double quote
596
597 "Aacute" => "A\\*'", # capital A, acute accent
598 "aacute" => "a\\*'", # small a, acute accent
599 "Acirc" => "A\\*^", # capital A, circumflex accent
600 "acirc" => "a\\*^", # small a, circumflex accent
601 "AElig" => '\*(AE', # capital AE diphthong (ligature)
602 "aelig" => '\*(ae', # small ae diphthong (ligature)
603 "Agrave" => "A\\*`", # capital A, grave accent
604 "agrave" => "A\\*`", # small a, grave accent
605 "Aring" => 'A\\*o', # capital A, ring
606 "aring" => 'a\\*o', # small a, ring
607 "Atilde" => 'A\\*~', # capital A, tilde
608 "atilde" => 'a\\*~', # small a, tilde
609 "Auml" => 'A\\*:', # capital A, dieresis or umlaut mark
610 "auml" => 'a\\*:', # small a, dieresis or umlaut mark
611 "Ccedil" => 'C\\*,', # capital C, cedilla
612 "ccedil" => 'c\\*,', # small c, cedilla
613 "Eacute" => "E\\*'", # capital E, acute accent
614 "eacute" => "e\\*'", # small e, acute accent
615 "Ecirc" => "E\\*^", # capital E, circumflex accent
616 "ecirc" => "e\\*^", # small e, circumflex accent
617 "Egrave" => "E\\*`", # capital E, grave accent
618 "egrave" => "e\\*`", # small e, grave accent
619 "ETH" => '\\*(D-', # capital Eth, Icelandic
620 "eth" => '\\*(d-', # small eth, Icelandic
621 "Euml" => "E\\*:", # capital E, dieresis or umlaut mark
622 "euml" => "e\\*:", # small e, dieresis or umlaut mark
623 "Iacute" => "I\\*'", # capital I, acute accent
624 "iacute" => "i\\*'", # small i, acute accent
625 "Icirc" => "I\\*^", # capital I, circumflex accent
626 "icirc" => "i\\*^", # small i, circumflex accent
627 "Igrave" => "I\\*`", # capital I, grave accent
628 "igrave" => "i\\*`", # small i, grave accent
629 "Iuml" => "I\\*:", # capital I, dieresis or umlaut mark
630 "iuml" => "i\\*:", # small i, dieresis or umlaut mark
631 "Ntilde" => 'N\*~', # capital N, tilde
632 "ntilde" => 'n\*~', # small n, tilde
633 "Oacute" => "O\\*'", # capital O, acute accent
634 "oacute" => "o\\*'", # small o, acute accent
635 "Ocirc" => "O\\*^", # capital O, circumflex accent
636 "ocirc" => "o\\*^", # small o, circumflex accent
637 "Ograve" => "O\\*`", # capital O, grave accent
638 "ograve" => "o\\*`", # small o, grave accent
639 "Oslash" => "O\\*/", # capital O, slash
640 "oslash" => "o\\*/", # small o, slash
641 "Otilde" => "O\\*~", # capital O, tilde
642 "otilde" => "o\\*~", # small o, tilde
643 "Ouml" => "O\\*:", # capital O, dieresis or umlaut mark
644 "ouml" => "o\\*:", # small o, dieresis or umlaut mark
645 "szlig" => '\*8', # small sharp s, German (sz ligature)
646 "THORN" => '\\*(Th', # capital THORN, Icelandic
647 "thorn" => '\\*(th',, # small thorn, Icelandic
648 "Uacute" => "U\\*'", # capital U, acute accent
649 "uacute" => "u\\*'", # small u, acute accent
650 "Ucirc" => "U\\*^", # capital U, circumflex accent
651 "ucirc" => "u\\*^", # small u, circumflex accent
652 "Ugrave" => "U\\*`", # capital U, grave accent
653 "ugrave" => "u\\*`", # small u, grave accent
654 "Uuml" => "U\\*:", # capital U, dieresis or umlaut mark
655 "uuml" => "u\\*:", # small u, dieresis or umlaut mark
656 "Yacute" => "Y\\*'", # capital Y, acute accent
657 "yacute" => "y\\*'", # small y, acute accent
658 "yuml" => "y\\*:", # small y, dieresis or umlaut mark
659);
660}
5d94fbed 661!NO!SUBS!
4633a7c4
LW
662
663close OUT or die "Can't close $file: $!";
664chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
665exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';