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