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