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             # if you know how to get ":s please do
 833             s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g;
 834             s/\\\*\(L"([^"]+?)""/'$1'/g;
 835             s/[^"]""([^"]+?)""[^"]/'$1'/g;
 836             # here do something about the $" in perlvar?
 837             print STDOUT qq{.Ip "$_" $indent\n};
 838             print qq{.IX Item "$_"\n};
 839         }
 840         elsif ($Cmd eq 'pod') {
 841             # this is just a comment
 842         }
 843         else {
 844             warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
 845         }
 846     }
 847     else {
 848         if ($needspace) {
 849             &makespace;
 850         }
 851         &escapes;
 852         clear_noremap(1);
 853         print $_, "\n";
 854         $needspace = 1;
 855     }
 856 }
 857
 858 print <<"END";
 859
 860 .rn }` ''
 861 END
 862
 863 if (%wanna_see) {
 864     @missing = keys %wanna_see;
 865     warn "$0: $Filename is missing required section"
 866         .  (@missing > 1 && "s")
 867         .  ": @missing\n";
 868     $oops++;
 869 }
 870
 871 exit;
 872 #exit ($oops != 0);
 873
 874 #########################################################################
 875
 876 sub nobreak {
 877     my $string = shift;
 878     $string =~ s/ /\\ /g;
 879     $string;
 880 }
 881
 882 sub escapes {
 883
 884     s/X<(.*?)>/mkindex($1)/ge;
 885
 886     # translate the minus in foo-bar into foo\-bar for roff
 887     s/([^0-9a-z-])-([^-])/$1\\-$2/g;
 888
 889     # make -- into the string version \*(-- (defined above)
 890     s/\b--\b/\\*(--/g;
 891     s/"--([^"])/"\\*(--$1/g;  # should be a better way
 892     s/([^"])--"/$1\\*(--"/g;
 893
 894     # fix up quotes; this is somewhat tricky
 895     if (!/""/) {
 896         s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge;
 897         s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
 898     }
 899
 900     #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
 901     #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
 902
 903
 904     # make sure that func() keeps a bit a space tween the parens
 905     ### s/\b\(\)/\\|()/g;
 906     ### s/\b\(\)/(\\|)/g;
 907
 908     # make C++ into \*C+, which is a squinched version (defined above)
 909     s/\bC\+\+/\\*(C+/g;
 910
 911     # make double underbars have a little tiny space between them
 912     s/__/_\\|_/g;
 913
 914     # PI goes to \*(PI (defined above)
 915     s/\bPI\b/noremap('\\*(PI')/ge;
 916
 917     # make all caps a teeny bit smaller, but don't muck with embedded code literals
 918     my $hidCFont = font('C');
 919     if ($Cmd !~ /^head1/) { # SH already makes smaller
 920         # /g isn't enough; 1 while or we'll be off
 921
 922 #       1 while s{
 923 #           (?!$hidCFont)(..|^.|^)
 924 #           \b
 925 #           (
 926 #               [A-Z][\/A-Z+:\-\d_$.]+
 927 #           )
 928 #           (s?)
 929 #           \b
 930 #       } {$1\\s-1$2\\s0}gmox;
 931
 932         1 while s{
 933             (?!$hidCFont)(..|^.|^)
 934             (
 935                 \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
 936             )
 937         } {
 938             $1 . noremap( '\\s-1' .  $2 . '\\s0' )
 939         }egmox;
 940
 941     }
 942 }
 943
 944 # make troff just be normal, but make small nroff get quoted
 945 # decided to just put the quotes in the text; sigh;
 946 sub ccvt {
 947      local($_,$prev) = @_;
 948      if ( /^\W+$/ && !/^\$./ ) {
 949         ($prev && "\n") . noremap(qq{.CQ $_ \n\\&});
 950         # what about $" ?
 951      } else {
 952         noremap(qq{${CFont_embed}$_\\fR});
 953      }
 954     noremap(qq{.CQ "$_" \n\\&});
 955 }
 956
 957 sub makespace {
 958     if ($indent) {
 959         print ".Sp\n";
 960     }
 961     else {
 962         print ".PP\n";
 963     }
 964 }
 965
 966 sub mkindex {
 967     my ($entry) = @_;
 968     my @entries = split m:\s*/\s*:, $entry;
 969     print ".IX Xref ";
 970     for $entry (@entries) {
 971         print qq("$entry" );
 972     }
 973     print "\n";
 974     return '';
 975 }
 976
 977 sub font {
 978     local($font) = shift;
 979     return '\\f' . noremap($font);
 980 }
 981
 982 sub noremap {
 983     local($thing_to_hide) = shift;
 984     $thing_to_hide =~ tr/\000-\177/\200-\377/;
 985     return $thing_to_hide;
 986 }
 987
 988 sub init_noremap {
 989         # escape high bit characters in input stream
 990         s/([\200-\377])/"E<".ord($1).">"/ge;
 991 }
 992
 993 sub clear_noremap {
 994     my $ready_to_print = $_[0];
 995
 996     tr/\200-\377/\000-\177/;
 997
 998     # trofficate backslashes
 999     # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
1000
1001     # now for the E<>s, which have been hidden until now
1002     # otherwise the interative \w<> processing would have
1003     # been hosed by the E<gt>
1004     s {
1005             E<
1006             (
1007                 ( \d + )
1008                 | ( [A-Za-z]+ )
1009             )
1010             >
1011     } {
1012          do {
1013              defined $2
1014                 ? chr($2)
1015                 :
1016              exists $HTML_Escapes{$3}
1017                 ? do { $HTML_Escapes{$3} }
1018                 : do {
1019                     warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
1020                     "E<$1>";
1021                 }
1022          }
1023     }egx if $ready_to_print;
1024 }
1025
1026 sub internal_lrefs {
1027     local($_) = shift;
1028
1029     s{L</([^>]+)>}{$1}g;
1030     my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
1031     my $retstr = "the ";
1032     my $i;
1033     for ($i = 0; $i <= $#items; $i++) {
1034         $retstr .= "C<$items[$i]>";
1035         $retstr .= ", " if @items > 2 && $i != $#items;
1036         $retstr .= " and " if $i+2 == @items;
1037     }
1038
1039     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
1040             .  " elsewhere in this document "; # terminal space to avoid words running together (pattern used strips terminal spaces)
1041
1042     return $retstr;
1043
1044 }
1045
1046 BEGIN {
1047 %HTML_Escapes = (
1048     'amp'       =>      '&',    #   ampersand
1049     'lt'        =>      '<',    #   left chevron, less-than
1050     'gt'        =>      '>',    #   right chevron, greater-than
1051     'quot'      =>      '"',    #   double quote
1052
1053     "Aacute"    =>      "A\\*'",        #   capital A, acute accent
1054     "aacute"    =>      "a\\*'",        #   small a, acute accent
1055     "Acirc"     =>      "A\\*^",        #   capital A, circumflex accent
1056     "acirc"     =>      "a\\*^",        #   small a, circumflex accent
1057     "AElig"     =>      '\*(AE',        #   capital AE diphthong (ligature)
1058     "aelig"     =>      '\*(ae',        #   small ae diphthong (ligature)
1059     "Agrave"    =>      "A\\*`",        #   capital A, grave accent
1060     "agrave"    =>      "A\\*`",        #   small a, grave accent
1061     "Aring"     =>      'A\\*o',        #   capital A, ring
1062     "aring"     =>      'a\\*o',        #   small a, ring
1063     "Atilde"    =>      'A\\*~',        #   capital A, tilde
1064     "atilde"    =>      'a\\*~',        #   small a, tilde
1065     "Auml"      =>      'A\\*:',        #   capital A, dieresis or umlaut mark
1066     "auml"      =>      'a\\*:',        #   small a, dieresis or umlaut mark
1067     "Ccedil"    =>      'C\\*,',        #   capital C, cedilla
1068     "ccedil"    =>      'c\\*,',        #   small c, cedilla
1069     "Eacute"    =>      "E\\*'",        #   capital E, acute accent
1070     "eacute"    =>      "e\\*'",        #   small e, acute accent
1071     "Ecirc"     =>      "E\\*^",        #   capital E, circumflex accent
1072     "ecirc"     =>      "e\\*^",        #   small e, circumflex accent
1073     "Egrave"    =>      "E\\*`",        #   capital E, grave accent
1074     "egrave"    =>      "e\\*`",        #   small e, grave accent
1075     "ETH"       =>      '\\*(D-',       #   capital Eth, Icelandic
1076     "eth"       =>      '\\*(d-',       #   small eth, Icelandic
1077     "Euml"      =>      "E\\*:",        #   capital E, dieresis or umlaut mark
1078     "euml"      =>      "e\\*:",        #   small e, dieresis or umlaut mark
1079     "Iacute"    =>      "I\\*'",        #   capital I, acute accent
1080     "iacute"    =>      "i\\*'",        #   small i, acute accent
1081     "Icirc"     =>      "I\\*^",        #   capital I, circumflex accent
1082     "icirc"     =>      "i\\*^",        #   small i, circumflex accent
1083     "Igrave"    =>      "I\\*`",        #   capital I, grave accent
1084     "igrave"    =>      "i\\*`",        #   small i, grave accent
1085     "Iuml"      =>      "I\\*:",        #   capital I, dieresis or umlaut mark
1086     "iuml"      =>      "i\\*:",        #   small i, dieresis or umlaut mark
1087     "Ntilde"    =>      'N\*~',         #   capital N, tilde
1088     "ntilde"    =>      'n\*~',         #   small n, tilde
1089     "Oacute"    =>      "O\\*'",        #   capital O, acute accent
1090     "oacute"    =>      "o\\*'",        #   small o, acute accent
1091     "Ocirc"     =>      "O\\*^",        #   capital O, circumflex accent
1092     "ocirc"     =>      "o\\*^",        #   small o, circumflex accent
1093     "Ograve"    =>      "O\\*`",        #   capital O, grave accent
1094     "ograve"    =>      "o\\*`",        #   small o, grave accent
1095     "Oslash"    =>      "O\\*/",        #   capital O, slash
1096     "oslash"    =>      "o\\*/",        #   small o, slash
1097     "Otilde"    =>      "O\\*~",        #   capital O, tilde
1098     "otilde"    =>      "o\\*~",        #   small o, tilde
1099     "Ouml"      =>      "O\\*:",        #   capital O, dieresis or umlaut mark
1100     "ouml"      =>      "o\\*:",        #   small o, dieresis or umlaut mark
1101     "szlig"     =>      '\*8',          #   small sharp s, German (sz ligature)
1102     "THORN"     =>      '\\*(Th',       #   capital THORN, Icelandic
1103     "thorn"     =>      '\\*(th',,      #   small thorn, Icelandic
1104     "Uacute"    =>      "U\\*'",        #   capital U, acute accent
1105     "uacute"    =>      "u\\*'",        #   small u, acute accent
1106     "Ucirc"     =>      "U\\*^",        #   capital U, circumflex accent
1107     "ucirc"     =>      "u\\*^",        #   small u, circumflex accent
1108     "Ugrave"    =>      "U\\*`",        #   capital U, grave accent
1109     "ugrave"    =>      "u\\*`",        #   small u, grave accent
1110     "Uuml"      =>      "U\\*:",        #   capital U, dieresis or umlaut mark
1111     "uuml"      =>      "u\\*:",        #   small u, dieresis or umlaut mark
1112     "Yacute"    =>      "Y\\*'",        #   capital Y, acute accent
1113     "yacute"    =>      "y\\*'",        #   small y, acute accent
1114     "yuml"      =>      "y\\*:",        #   small y, dieresis or umlaut mark
1115 );
1116 }
1117
1118 !NO!SUBS!
1119
1120 close OUT or die "Can't close $file: $!";
1121 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1122 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';