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