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