Pod typos, pod2man bugs, and miscellaneous installation comments
[perl.git] / pod / pod2man.PL
1 #!/usr/local/bin/perl
2
3 use Config;
4 use 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.
15 chdir(dirname($0));
16 ($file = basename($0)) =~ s/\.PL$//;
17 $file =~ s/\.pl$//
18         if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
19
20 open OUT,">$file" or die "Can't create $file: $!";
21
22 print "Extracting $file (with variable substitutions)\n";
23
24 # In this section, perl variables will be expanded during extraction.
25 # You can use $Config{...} to use Configure variables.
26
27 print OUT <<"!GROK!THIS!";
28 $Config{'startperl'}
29 !GROK!THIS!
30
31 # In the following, perl variables are not expanded during extraction.
32
33 print OUT <<'!NO!SUBS!';
34 eval 'exec perl -S $0 "$@"'
35     if 0;
36
37 =head1 NAME
38
39 pod2man - translate embedded Perl pod directives into man pages
40
41 =head1 SYNOPSIS
42
43 B<pod2man>
44 [ B<--section=>I<manext> ]
45 [ B<--release=>I<relpatch> ]
46 [ B<--center=>I<string> ]
47 [ B<--date=>I<string> ]
48 [ B<--fixed=>I<font> ]
49 [ B<--official> ]
50 I<inputfile>
51
52 =head1 DESCRIPTION
53
54 B<pod2man> converts its input file containing embedded pod directives (see
55 L<perlpod>) into nroff source suitable for viewing with nroff(1) or
56 troff(1) using the man(7) macro set.
57
58 Besides the obvious pod conversions, B<pod2man> also takes care of
59 func(), func(n), and simple variable references like $foo or @bar so
60 you don't have to use code escapes for them; complex expressions like
61 C<$fred{'stuff'}> will still need to be escaped, though.  Other nagging
62 little roffish things that it catches include translating the minus in
63 something like foo-bar, making a long dash--like this--into a real em
64 dash, fixing up "paired quotes", putting a little space after the
65 parens in something like func(), making C++ and PI look right, making
66 double underbars have a little tiny space between them, making ALLCAPS
67 a teeny bit smaller in troff(1), and escaping backslashes so you don't
68 have to.
69
70 =head1 OPTIONS
71
72 =over 8
73
74 =item center
75
76 Set the centered header to a specific string.  The default is
77 "User Contributed Perl Documentation", unless the C<--official> flag is
78 given, in which case the default is "Perl Programmers Reference Guide".
79
80 =item date
81
82 Set the left-hand footer string to this value.  By default,
83 the modification date of the input file will be used.
84
85 =item fixed
86
87 The fixed font to use for code refs.  Defaults to CW.
88
89 =item official
90
91 Set the default header to indicate that this page is of
92 the standard release in case C<--center> is not given.
93
94 =item release
95
96 Set the centered footer.  By default, this is the current
97 perl release.
98
99 =item section
100
101 Set the section for the C<.TH> macro.  The standard conventions on
102 sections are to use 1 for user commands,  2 for system calls, 3 for
103 functions, 4 for devices, 5 for file formats, 6 for games, 7 for
104 miscellaneous information, and 8 for administrator commands.  This works
105 best if you put your Perl man pages in a separate tree, like
106 F</usr/local/perl/man/>.  By default, section 1 will be used
107 unless the file ends in F<.pm> in which case section 3 will be selected.
108
109 =back
110
111 =head1 Anatomy of a Proper Man Page
112
113 For those not sure of the proper layout of a man page, here's
114 an example of the skeleton of a proper man page.  Head of the
115 major headers should be setout as a C<=head1> directive, and
116 are historically written in the rather startling ALL UPPER CASE
117 format, although this is not mandatory.
118 Minor headers may be included using C<=head2>, and are
119 typically in mixed case.
120
121 =over 10
122
123 =item NAME
124
125 Mandatory section; should be a comma-separated list of programs or
126 functions documented by this podpage, such as:
127
128     foo, bar - programs to do something
129
130 =item SYNOPSIS
131
132 A short usage summary for programs and functions, which
133 may someday be deemed mandatory.
134
135 =item DESCRIPTION
136
137 Long drawn out discussion of the program.  It's a good idea to break this
138 up into subsections using the C<=head2> directives, like
139
140     =head2 A Sample Subection
141
142     =head2 Yet Another Sample Subection
143
144 =item OPTIONS
145
146 Some people make this separate from the description.
147
148 =item RETURN VALUE
149
150 What the program or function returns if successful.
151
152 =item ERRORS
153
154 Exceptions, return codes, exit stati, and errno settings.
155
156 =item EXAMPLES
157
158 Give some example uses of the program.
159
160 =item ENVIRONMENT
161
162 Envariables this program might care about.
163
164 =item FILES
165
166 All files used by the program.  You should probably use the FE<lt>E<gt>
167 for these.
168
169 =item SEE ALSO
170
171 Other man pages to check out, like man(1), man(7), makewhatis(8), or catman(8).
172
173 =item NOTES
174
175 Miscellaneous commentary.
176
177 =item CAVEATS
178
179 Things to take special care with; sometimes called WARNINGS.
180
181 =item DIAGNOSTICS
182
183 All possible messages the program can print out--and
184 what they mean.
185
186 =item BUGS
187
188 Things that are broken or just don't work quite right.
189
190 =item RESTRICTIONS
191
192 Bugs you don't plan to fix :-)
193
194 =item AUTHOR
195
196 Who wrote it (or AUTHORS if multiple).
197
198 =item HISTORY
199
200 Programs derived from other sources sometimes have this, or
201 you might keep a modification log here.
202
203 =back
204
205 =head1 EXAMPLES
206
207     pod2man program > program.1
208     pod2man some_module.pm > /usr/perl/man/man3/some_module.3
209     pod2man --section=7 note.pod > note.7
210
211 =head1 DIAGNOSTICS
212
213 The following diagnostics are generated by B<pod2man>.  Items
214 marked "(W)" are non-fatal, whereas the "(F)" errors will cause
215 B<pod2man> to immediately exit with a non-zero status.
216
217 =over 4
218
219 =item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s>
220
221 (W) If you start include an option, you should set it off
222 as bold, italic, or code.
223
224 =item can't open %s: %s
225
226 (F) The input file wasn't available for the given reason.
227
228 =item Improper man page - no dash in NAME header in paragraph %d of %s
229
230 (W) The NAME header did not have an isolated dash in it.  This is
231 considered important.
232
233 =item Invalid man page - no NAME line in %s
234
235 (F) You did not include a NAME header, which is essential.
236
237 =item roff font should be 1 or 2 chars, not `%s'  (F)
238
239 (F) The font specified with the C<--fixed> option was not
240 a one- or two-digit roff font.
241
242 =item %s is missing required section: %s
243
244 (W) Required sections include NAME, DESCRIPTION, and if you're
245 using a section starting with a 3, also a SYNOPSIS.  Actually,
246 not having a NAME is a fatal.
247
248 =item Unknown escape: %s in %s
249
250 (W) An unknown HTML entity (probably for an 8-bit character) was given via
251 a C<EE<lt>E<gt>> directive.  Besides amp, lt, gt, and quot, recognized
252 entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave,
253 Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute,
254 Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc,
255 icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc,
256 ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig,
257 THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml,
258 Yacute, yacute, and yuml.
259
260 =item Unmatched =back
261
262 (W) You have a C<=back> without a corresponding C<=over>.
263
264 =item Unrecognized pod directive: %s
265
266 (W) You specified a pod directive that isn't in the known list of
267 C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>.
268
269
270 =back
271
272 =head1 NOTES
273
274 If you would like to print out a lot of man page continuously, you
275 probably want to set the C and D registers to set contiguous page
276 numbering and even/odd paging, at least on some versions of man(7).
277 Settting the F register will get you some additional experimental
278 indexing:
279
280     troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ...
281
282 The indexing merely outputs messages via C<.tm> for each
283 major page, section, subsection, item, and any C<XE<lt>E<gt>>
284 directives.
285
286
287 =head1 RESTRICTIONS
288
289 None at this time.
290
291 =head1 BUGS
292
293 The =over and =back directives don't really work right.  They
294 take absolute positions instead of offsets, don't nest well, and
295 making people count is suboptimal in any event.
296
297 =head1 AUTHORS
298
299 Original prototype by Larry Wall, but so massively hacked over by
300 Tom Christiansen such that Larry probably doesn't recognize it anymore.
301
302 =cut
303
304 $/ = "";
305 $cutting = 1;
306
307 # We try first to get the version number from a local binary, in case we're
308 # running an installed version of Perl to produce documentation from an
309 # uninstalled newer version's pod files.
310 if ($^O ne 'plan9') {
311   ($version,$patch) =
312     `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/;
313 }
314 # No luck; we'll just go with the running Perl's version
315 ($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version;
316 $DEF_RELEASE  = "perl $version";
317 $DEF_RELEASE .= ", patch $patch" if $patch;
318
319
320 sub makedate {
321     my $secs = shift;
322     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
323     my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
324     return "$mday/$mname/$year";
325 }
326
327 use Getopt::Long;
328
329 $DEF_SECTION = 1;
330 $DEF_CENTER = "User Contributed Perl Documentation";
331 $STD_CENTER = "Perl Programmers Reference Guide";
332 $DEF_FIXED = 'CW';
333
334 sub usage {
335     warn "$0: @_\n" if @_;
336     die <<EOF;
337 usage: $0 [options] podpage
338 Options are:
339         --section=manext      (default "$DEF_SECTION")
340         --release=relpatch    (default "$DEF_RELEASE")
341         --center=string       (default "$DEF_CENTER")
342         --date=string         (default "$DEF_DATE")
343         --fixed=font          (default "$DEF_FIXED")
344         --official            (default NOT)
345 EOF
346 }
347
348 $uok = GetOptions( qw(
349         section=s
350         release=s
351         center=s
352         date=s
353         fixed=s
354         official
355         help));
356
357 $DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
358
359 usage("Usage error!") unless $uok;
360 usage() if $opt_help;
361 usage("Need one and only one podpage argument") unless @ARGV == 1;
362
363 $section = $opt_section || ($ARGV[0] =~ /\.pm$/ ? 3 : $DEF_SECTION);
364 $RP = $opt_release || $DEF_RELEASE;
365 $center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER);
366
367 $CFont = $opt_fixed || $DEF_FIXED;
368
369 if (length($CFont) == 2) {
370     $CFont_embed = "\\f($CFont";
371 }
372 elsif (length($CFont) == 1) {
373     $CFont_embed = "\\f$CFont";
374 }
375 else {
376     die "roff font should be 1 or 2 chars, not `$CFont_embed'";
377 }
378
379 $section = $opt_section || $DEF_SECTION;
380 $date = $opt_date || $DEF_DATE;
381
382 for (qw{NAME DESCRIPTION}) {
383 # for (qw{NAME DESCRIPTION AUTHOR}) {
384     $wanna_see{$_}++;
385 }
386 $wanna_see{SYNOPSIS}++ if $section =~ /^3/;
387
388
389 $name = @ARGV ? $ARGV[0] : "<STDIN>";
390 $Filename = $name;
391 $name = uc($name) if $section =~ /^1/;
392 $name =~ s/\.[^.]*$//;
393 $name =~ s(/)(::)g; # translate Getopt/Long to Getopt::Long, etc.
394
395 if ($name ne 'something') {
396     FCHECK: {
397         open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!";
398         while (<F>) {
399             next unless /^=\b/;
400             if (/^=head1\s+NAME\s*$/) {  # an /m would forgive mistakes
401                 $_ = <F>;
402                 unless (/\s*-+\s+/) {
403                     $oops++;
404                     warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n"
405                 }
406                 %namedesc = split /\s+-+\s+/;
407                 last FCHECK;
408             }
409             next if /^=cut\b/;  # DB_File and Net::Ping have =cut before NAME
410             die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n";
411         }
412         die "$0: Invalid man page - no documentation in $ARGV[0]\n";
413     }
414     close F;
415 }
416
417 print <<"END";
418 .rn '' }`
419 ''' \$RCSfile\$\$Revision\$\$Date\$
420 '''
421 ''' \$Log\$
422 '''
423 .de Sh
424 .br
425 .if t .Sp
426 .ne 5
427 .PP
428 \\fB\\\\\$1\\fR
429 .PP
430 ..
431 .de Sp
432 .if t .sp .5v
433 .if n .sp
434 ..
435 .de Ip
436 .br
437 .ie \\\\n(.\$>=3 .ne \\\\\$3
438 .el .ne 3
439 .IP "\\\\\$1" \\\\\$2
440 ..
441 .de Vb
442 .ft $CFont
443 .nf
444 .ne \\\\\$1
445 ..
446 .de Ve
447 .ft R
448
449 .fi
450 ..
451 '''
452 '''
453 '''     Set up \\*(-- to give an unbreakable dash;
454 '''     string Tr holds user defined translation string.
455 '''     Bell System Logo is used as a dummy character.
456 '''
457 .tr \\(*W-|\\(bv\\*(Tr
458 .ie n \\{\\
459 .ds -- \\(*W-
460 .ds PI pi
461 .if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
462 .if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
463 .ds L" ""
464 .ds R" ""
465 .ds L' '
466 .ds R' '
467 'br\\}
468 .el\\{\\
469 .ds -- \\(em\\|
470 .tr \\*(Tr
471 .ds L" ``
472 .ds R" ''
473 .ds L' `
474 .ds R' '
475 .ds PI \\(*p
476 'br\\}
477 END
478
479 print <<'END';
480 .\"     If the F register is turned on, we'll generate
481 .\"     index entries out stderr for the following things:
482 .\"             TH      Title 
483 .\"             SH      Header
484 .\"             Sh      Subsection 
485 .\"             Ip      Item
486 .\"             X<>     Xref  (embedded
487 .\"     Of course, you have to process the output yourself
488 .\"     in some meaninful fashion.
489 .if \nF \{
490 .de IX
491 .tm Index:\\$1\t\\n%\t"\\$2"
492 ..
493 .nr % 0
494 .rr F
495 .\}
496 END
497
498 print <<"END";
499 .TH $name $section "$RP" "$date" "$center"
500 .IX Title "$name $section"
501 .UC
502 END
503
504 while (($name, $desc) = each %namedesc) {
505     for ($name, $desc) { s/^\s+//; s/\s+$//; }
506     print qq(.IX Name "$name - $desc"\n);
507 }
508
509 print <<'END';
510 .if n .hy 0
511 .if n .na
512 .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
513 .de CQ          \" put $1 in typewriter font
514 END
515 print ".ft $CFont\n";
516 print <<'END';
517 'if n "\c
518 'if t \\&\\$1\c
519 'if n \\&\\$1\c
520 'if n \&"
521 \\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
522 '.ft R
523 ..
524 .\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
525 .       \" AM - accent mark definitions
526 .bd B 3
527 .       \" fudge factors for nroff and troff
528 .if n \{\
529 .       ds #H 0
530 .       ds #V .8m
531 .       ds #F .3m
532 .       ds #[ \f1
533 .       ds #] \fP
534 .\}
535 .if t \{\
536 .       ds #H ((1u-(\\\\n(.fu%2u))*.13m)
537 .       ds #V .6m
538 .       ds #F 0
539 .       ds #[ \&
540 .       ds #] \&
541 .\}
542 .       \" simple accents for nroff and troff
543 .if n \{\
544 .       ds ' \&
545 .       ds ` \&
546 .       ds ^ \&
547 .       ds , \&
548 .       ds ~ ~
549 .       ds ? ?
550 .       ds ! !
551 .       ds /
552 .       ds q
553 .\}
554 .if t \{\
555 .       ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
556 .       ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
557 .       ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
558 .       ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
559 .       ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
560 .       ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
561 .       ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
562 .       ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
563 .       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'
564 .\}
565 .       \" troff and (daisy-wheel) nroff accents
566 .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
567 .ds 8 \h'\*(#H'\(*b\h'-\*(#H'
568 .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
569 .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
570 .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
571 .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
572 .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
573 .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
574 .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
575 .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
576 .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
577 .ds ae a\h'-(\w'a'u*4/10)'e
578 .ds Ae A\h'-(\w'A'u*4/10)'E
579 .ds oe o\h'-(\w'o'u*4/10)'e
580 .ds Oe O\h'-(\w'O'u*4/10)'E
581 .       \" corrections for vroff
582 .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
583 .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
584 .       \" for low resolution devices (crt and lpr)
585 .if \n(.H>23 .if \n(.V>19 \
586 \{\
587 .       ds : e
588 .       ds 8 ss
589 .       ds v \h'-1'\o'\(aa\(ga'
590 .       ds _ \h'-1'^
591 .       ds . \h'-1'.
592 .       ds 3 3
593 .       ds o a
594 .       ds d- d\h'-1'\(ga
595 .       ds D- D\h'-1'\(hy
596 .       ds th \o'bp'
597 .       ds Th \o'LP'
598 .       ds ae ae
599 .       ds Ae AE
600 .       ds oe oe
601 .       ds Oe OE
602 .\}
603 .rm #[ #] #H #V #F C
604 END
605
606 $indent = 0;
607
608 while (<>) {
609     if ($cutting) {
610         next unless /^=/;
611         $cutting = 0;
612     }
613     chomp;
614
615     # Translate verbatim paragraph
616
617     if (/^\s/) {
618         @lines = split(/\n/);
619         for (@lines) {
620             1 while s
621                 {^( [^\t]* ) \t ( \t* ) }
622                 { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
623             s/\\/\\e/g;
624             s/\A/\\&/s;
625         }
626         $lines = @lines;
627         makespace() unless $verbatim++;
628         print ".Vb $lines\n";
629         print join("\n", @lines), "\n";
630         print ".Ve\n";
631         $needspace = 0;
632         next;
633     }
634
635     $verbatim = 0;
636
637     # check for things that'll hosed our noremap scheme; affects $_
638     init_noremap();
639
640     if (!/^=item/) {
641
642         # trofficate backslashes; must do it before what happens below
643         s/\\/noremap('\\e')/ge;
644
645         # first hide the escapes in case we need to
646         # intuit something and get it wrong due to fmting
647
648         s/([A-Z]<[^<>]*>)/noremap($1)/ge;
649
650         # func() is a reference to a perl function
651         s{
652             \b
653             (
654                 [:\w]+ \(\)
655             )
656         } {I<$1>}gx;
657
658         # func(n) is a reference to a man page
659         s{
660             (\w+)
661             (
662                 \(
663                     [^\s,\051]+
664                 \)
665             )
666         } {I<$1>\\|$2}gx;
667
668         # convert simple variable references
669         s/(\s+)([\$\@%][\w:]+)/${1}C<$2>/g;
670
671         if (m{ (
672                     [\-\w]+
673                     \(
674                         [^\051]*?
675                         [\@\$,]
676                         [^\051]*?
677                     \)
678                 )
679             }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
680         {
681             warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n";
682             $oops++;
683         }
684
685         while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
686             warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n";
687             $oops++;
688         }
689
690         # put it back so we get the <> processed again;
691         clear_noremap(0); # 0 means leave the E's
692
693     } else {
694         # trofficate backslashes
695         s/\\/noremap('\\e')/ge;
696
697     }
698
699     # need to hide E<> first; they're processed in clear_noremap
700     s/(E<[^<>]+>)/noremap($1)/ge;
701
702
703     $maxnest = 10;
704     while ($maxnest-- && /[A-Z]</) {
705
706         # can't do C font here
707         s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
708
709         # files and filelike refs in italics
710         s/F<([^<>]*)>/I<$1>/g;
711
712         # no break -- usually we want C<> for this
713         s/S<([^<>]*)>/nobreak($1)/eg;
714
715         # LREF: a manpage(3f)
716         s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
717
718         # LREF: an =item on another manpage
719         s{
720             L<
721                 ([^/]+)
722                 /
723                 (
724                     [:\w]+
725                     (\(\))?
726                 )
727             >
728         } {the C<$2> entry in the I<$1> manpage}gx;
729
730         # LREF: an =item on this manpage
731         s{
732            ((?:
733             L<
734                 /
735                 (
736                     [:\w]+
737                     (\(\))?
738                 )
739             >
740             (,?\s+(and\s+)?)?
741           )+)
742         } { internal_lrefs($1) }gex;
743
744         # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
745         # the "func" can disambiguate
746         s{
747             L<
748                 (?:
749                     ([a-zA-Z]\S+?) /
750                 )?
751                 "?(.*?)"?
752             >
753         }{
754             do {
755                 $1      # if no $1, assume it means on this page.
756                     ?  "the section on I<$2> in the I<$1> manpage"
757                     :  "the section on I<$2>"
758             }
759         }gesx; # s in case it goes over multiple lines, so . matches \n
760
761         s/Z<>/\\&/g;
762
763         # comes last because not subject to reprocessing
764         s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
765     }
766
767     if (s/^=//) {
768         $needspace = 0;         # Assume this.
769
770         s/\n/ /g;
771
772         ($Cmd, $_) = split(' ', $_, 2);
773
774         if (defined $_) {
775             &escapes;
776             s/"/""/g;
777         }
778
779         clear_noremap(1);
780
781         if ($Cmd eq 'cut') {
782             $cutting = 1;
783         }
784         elsif ($Cmd eq 'head1') {
785             s/\s+$//;
786             delete $wanna_see{$_} if exists $wanna_see{$_};
787             print qq{.SH "$_"\n};
788             print qq{.IX Header "$_"\n};
789         }
790         elsif ($Cmd eq 'head2') {
791             print qq{.Sh "$_"\n};
792             print qq{.IX Subsection "$_"\n};
793         }
794         elsif ($Cmd eq 'over') {
795             push(@indent,$indent);
796             $indent += ($_ + 0) || 5;
797         }
798         elsif ($Cmd eq 'back') {
799             $indent = pop(@indent);
800             warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
801             $needspace = 1;
802         }
803         elsif ($Cmd eq 'item') {
804             s/^\*( |$)/\\(bu$1/g;
805             print STDOUT qq{.Ip "$_" $indent\n};
806             print qq{.IX Item "$_"\n};
807         }
808         elsif ($Cmd eq 'pod') {
809             # this is just a comment
810         } 
811         else {
812             warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
813         }
814     }
815     else {
816         if ($needspace) {
817             &makespace;
818         }
819         &escapes;
820         clear_noremap(1);
821         print $_, "\n";
822         $needspace = 1;
823     }
824 }
825
826 print <<"END";
827
828 .rn }` ''
829 END
830
831 if (%wanna_see) {
832     @missing = keys %wanna_see;
833     warn "$0: $Filename is missing required section"
834         .  (@missing > 1 && "s")
835         .  ": @missing\n";
836     $oops++;
837 }
838
839 exit;
840 #exit ($oops != 0);
841
842 #########################################################################
843
844 sub nobreak {
845     my $string = shift;
846     $string =~ s/ /\\ /g;
847     $string;
848 }
849
850 sub escapes {
851
852     s/X<(.*?)>/mkindex($1)/ge;
853
854     # translate the minus in foo-bar into foo\-bar for roff
855     s/([^0-9a-z-])-([^-])/$1\\-$2/g;
856
857     # make -- into the string version \*(-- (defined above)
858     s/\b--\b/\\*(--/g;
859     s/"--([^"])/"\\*(--$1/g;  # should be a better way
860     s/([^"])--"/$1\\*(--"/g;
861
862     # fix up quotes; this is somewhat tricky
863     if (!/""/) {
864         s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge;
865         s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
866     }
867
868     #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
869     #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
870
871
872     # make sure that func() keeps a bit a space tween the parens
873     ### s/\b\(\)/\\|()/g;
874     ### s/\b\(\)/(\\|)/g;
875
876     # make C++ into \*C+, which is a squinched version (defined above)
877     s/\bC\+\+/\\*(C+/g;
878
879     # make double underbars have a little tiny space between them
880     s/__/_\\|_/g;
881
882     # PI goes to \*(PI (defined above)
883     s/\bPI\b/noremap('\\*(PI')/ge;
884
885     # make all caps a teeny bit smaller, but don't muck with embedded code literals
886     my $hidCFont = font('C');
887     if ($Cmd !~ /^head1/) { # SH already makes smaller
888         # /g isn't enough; 1 while or we'll be off
889
890 #       1 while s{
891 #           (?!$hidCFont)(..|^.|^)
892 #           \b
893 #           (
894 #               [A-Z][\/A-Z+:\-\d_$.]+
895 #           )
896 #           (s?)                
897 #           \b
898 #       } {$1\\s-1$2\\s0}gmox;
899
900         1 while s{
901             (?!$hidCFont)(..|^.|^)
902             (
903                 \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
904             )
905         } {
906             $1 . noremap( '\\s-1' .  $2 . '\\s0' )
907         }egmox;
908
909     }
910 }
911
912 # make troff just be normal, but make small nroff get quoted
913 # decided to just put the quotes in the text; sigh;
914 sub ccvt {
915      local($_,$prev) = @_;
916      if ( /^\W+$/ && !/^\$./ ) {
917         ($prev && "\n") . noremap(qq{.CQ $_ \n\\&});
918         # what about $" ?
919      } else {
920         noremap(qq{${CFont_embed}$_\\fR});
921      }
922     noremap(qq{.CQ "$_" \n\\&});
923 }
924
925 sub makespace {
926     if ($indent) {
927         print ".Sp\n";
928     }
929     else {
930         print ".PP\n";
931     }
932 }
933
934 sub mkindex {
935     my ($entry) = @_;
936     my @entries = split m:\s*/\s*:, $entry;
937     print ".IX Xref ";
938     for $entry (@entries) {
939         print qq("$entry" );
940     }
941     print "\n";
942     return '';
943 }
944
945 sub font {
946     local($font) = shift;
947     return '\\f' . noremap($font);
948 }
949
950 sub noremap {
951     local($thing_to_hide) = shift;
952     $thing_to_hide =~ tr/\000-\177/\200-\377/;
953     return $thing_to_hide;
954 }
955
956 sub init_noremap {
957         # escape high bit characters in input stream
958         s/([\200-\377])/"E<".ord($1).">"/ge;
959 }
960
961 sub clear_noremap {
962     my $ready_to_print = $_[0];
963
964     tr/\200-\377/\000-\177/;
965
966     # trofficate backslashes
967     # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
968
969     # now for the E<>s, which have been hidden until now
970     # otherwise the interative \w<> processing would have
971     # been hosed by the E<gt>
972     s {
973             E<
974             (
975                 ( \d + ) 
976                 | ( [A-Za-z]+ ) 
977             )
978             >   
979     } {
980          do {
981              defined $2
982                 ? chr($2)
983                 :       
984              exists $HTML_Escapes{$3}
985                 ? do { $HTML_Escapes{$3} }
986                 : do {
987                     warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
988                     "E<$1>";
989                 }
990          }
991     }egx if $ready_to_print;
992 }
993
994 sub internal_lrefs {
995     local($_) = shift;
996
997     s{L</([^>]+)>}{$1}g;
998     my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
999     my $retstr = "the ";
1000     my $i;
1001     for ($i = 0; $i <= $#items; $i++) {
1002         $retstr .= "C<$items[$i]>";
1003         $retstr .= ", " if @items > 2 && $i != $#items;
1004         $retstr .= " and " if $i+2 == @items;
1005     }
1006
1007     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
1008             .  " elsewhere in this document "; # terminal space to avoid words running together (pattern used strips terminal spaces)
1009
1010     return $retstr;
1011
1012 }
1013
1014 BEGIN {
1015 %HTML_Escapes = (
1016     'amp'       =>      '&',    #   ampersand
1017     'lt'        =>      '<',    #   left chevron, less-than
1018     'gt'        =>      '>',    #   right chevron, greater-than
1019     'quot'      =>      '"',    #   double quote
1020
1021     "Aacute"    =>      "A\\*'",        #   capital A, acute accent
1022     "aacute"    =>      "a\\*'",        #   small a, acute accent
1023     "Acirc"     =>      "A\\*^",        #   capital A, circumflex accent
1024     "acirc"     =>      "a\\*^",        #   small a, circumflex accent
1025     "AElig"     =>      '\*(AE',        #   capital AE diphthong (ligature)
1026     "aelig"     =>      '\*(ae',        #   small ae diphthong (ligature)
1027     "Agrave"    =>      "A\\*`",        #   capital A, grave accent
1028     "agrave"    =>      "A\\*`",        #   small a, grave accent
1029     "Aring"     =>      'A\\*o',        #   capital A, ring
1030     "aring"     =>      'a\\*o',        #   small a, ring
1031     "Atilde"    =>      'A\\*~',        #   capital A, tilde
1032     "atilde"    =>      'a\\*~',        #   small a, tilde
1033     "Auml"      =>      'A\\*:',        #   capital A, dieresis or umlaut mark
1034     "auml"      =>      'a\\*:',        #   small a, dieresis or umlaut mark
1035     "Ccedil"    =>      'C\\*,',        #   capital C, cedilla
1036     "ccedil"    =>      'c\\*,',        #   small c, cedilla
1037     "Eacute"    =>      "E\\*'",        #   capital E, acute accent
1038     "eacute"    =>      "e\\*'",        #   small e, acute accent
1039     "Ecirc"     =>      "E\\*^",        #   capital E, circumflex accent
1040     "ecirc"     =>      "e\\*^",        #   small e, circumflex accent
1041     "Egrave"    =>      "E\\*`",        #   capital E, grave accent
1042     "egrave"    =>      "e\\*`",        #   small e, grave accent
1043     "ETH"       =>      '\\*(D-',       #   capital Eth, Icelandic
1044     "eth"       =>      '\\*(d-',       #   small eth, Icelandic
1045     "Euml"      =>      "E\\*:",        #   capital E, dieresis or umlaut mark
1046     "euml"      =>      "e\\*:",        #   small e, dieresis or umlaut mark
1047     "Iacute"    =>      "I\\*'",        #   capital I, acute accent
1048     "iacute"    =>      "i\\*'",        #   small i, acute accent
1049     "Icirc"     =>      "I\\*^",        #   capital I, circumflex accent
1050     "icirc"     =>      "i\\*^",        #   small i, circumflex accent
1051     "Igrave"    =>      "I\\*`",        #   capital I, grave accent
1052     "igrave"    =>      "i\\*`",        #   small i, grave accent
1053     "Iuml"      =>      "I\\*:",        #   capital I, dieresis or umlaut mark
1054     "iuml"      =>      "i\\*:",        #   small i, dieresis or umlaut mark
1055     "Ntilde"    =>      'N\*~',         #   capital N, tilde
1056     "ntilde"    =>      'n\*~',         #   small n, tilde
1057     "Oacute"    =>      "O\\*'",        #   capital O, acute accent
1058     "oacute"    =>      "o\\*'",        #   small o, acute accent
1059     "Ocirc"     =>      "O\\*^",        #   capital O, circumflex accent
1060     "ocirc"     =>      "o\\*^",        #   small o, circumflex accent
1061     "Ograve"    =>      "O\\*`",        #   capital O, grave accent
1062     "ograve"    =>      "o\\*`",        #   small o, grave accent
1063     "Oslash"    =>      "O\\*/",        #   capital O, slash
1064     "oslash"    =>      "o\\*/",        #   small o, slash
1065     "Otilde"    =>      "O\\*~",        #   capital O, tilde
1066     "otilde"    =>      "o\\*~",        #   small o, tilde
1067     "Ouml"      =>      "O\\*:",        #   capital O, dieresis or umlaut mark
1068     "ouml"      =>      "o\\*:",        #   small o, dieresis or umlaut mark
1069     "szlig"     =>      '\*8',          #   small sharp s, German (sz ligature)
1070     "THORN"     =>      '\\*(Th',       #   capital THORN, Icelandic
1071     "thorn"     =>      '\\*(th',,      #   small thorn, Icelandic
1072     "Uacute"    =>      "U\\*'",        #   capital U, acute accent
1073     "uacute"    =>      "u\\*'",        #   small u, acute accent
1074     "Ucirc"     =>      "U\\*^",        #   capital U, circumflex accent
1075     "ucirc"     =>      "u\\*^",        #   small u, circumflex accent
1076     "Ugrave"    =>      "U\\*`",        #   capital U, grave accent
1077     "ugrave"    =>      "u\\*`",        #   small u, grave accent
1078     "Uuml"      =>      "U\\*:",        #   capital U, dieresis or umlaut mark
1079     "uuml"      =>      "u\\*:",        #   small u, dieresis or umlaut mark
1080     "Yacute"    =>      "Y\\*'",        #   capital Y, acute accent
1081     "yacute"    =>      "y\\*'",        #   small y, acute accent
1082     "yuml"      =>      "y\\*:",        #   small y, dieresis or umlaut mark
1083 );
1084 }
1085
1086 !NO!SUBS!
1087
1088 close OUT or die "Can't close $file: $!";
1089 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1090 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';