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                   } else {
 408                     %namedesc = split /\s+-+\s+/;
 409                   }
 410                 last FCHECK;
 411             }
 412             next if /^=cut\b/;  # DB_File and Net::Ping have =cut before NAME
 413             die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n";
 414         }
 415         die "$0: Invalid man page - no documentation in $ARGV[0]\n";
 416     }
 417     close F;
 418 }
 419
 420 print <<"END";
 421 .rn '' }`
 422 ''' \$RCSfile\$\$Revision\$\$Date\$
 423 '''
 424 ''' \$Log\$
 425 '''
 426 .de Sh
 427 .br
 428 .if t .Sp
 429 .ne 5
 430 .PP
 431 \\fB\\\\\$1\\fR
 432 .PP
 433 ..
 434 .de Sp
 435 .if t .sp .5v
 436 .if n .sp
 437 ..
 438 .de Ip
 439 .br
 440 .ie \\\\n(.\$>=3 .ne \\\\\$3
 441 .el .ne 3
 442 .IP "\\\\\$1" \\\\\$2
 443 ..
 444 .de Vb
 445 .ft $CFont
 446 .nf
 447 .ne \\\\\$1
 448 ..
 449 .de Ve
 450 .ft R
 451
 452 .fi
 453 ..
 454 '''
 455 '''
 456 '''     Set up \\*(-- to give an unbreakable dash;
 457 '''     string Tr holds user defined translation string.
 458 '''     Bell System Logo is used as a dummy character.
 459 '''
 460 .tr \\(*W-|\\(bv\\*(Tr
 461 .ie n \\{\\
 462 .ds -- \\(*W-
 463 .ds PI pi
 464 .if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
 465 .if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
 466 .ds L" ""
 467 .ds R" ""
 468 .ds L' '
 469 .ds R' '
 470 'br\\}
 471 .el\\{\\
 472 .ds -- \\(em\\|
 473 .tr \\*(Tr
 474 .ds L" ``
 475 .ds R" ''
 476 .ds L' `
 477 .ds R' '
 478 .ds PI \\(*p
 479 'br\\}
 480 END
 481
 482 print <<'END';
 483 .\"     If the F register is turned on, we'll generate
 484 .\"     index entries out stderr for the following things:
 485 .\"             TH      Title
 486 .\"             SH      Header
 487 .\"             Sh      Subsection
 488 .\"             Ip      Item
 489 .\"             X<>     Xref  (embedded
 490 .\"     Of course, you have to process the output yourself
 491 .\"     in some meaninful fashion.
 492 .if \nF \{
 493 .de IX
 494 .tm Index:\\$1\t\\n%\t"\\$2"
 495 ..
 496 .nr % 0
 497 .rr F
 498 .\}
 499 END
 500
 501 print <<"END";
 502 .TH $name $section "$RP" "$date" "$center"
 503 .IX Title "$name $section"
 504 .UC
 505 END
 506
 507 while (($name, $desc) = each %namedesc) {
 508     for ($name, $desc) { s/^\s+//; s/\s+$//; }
 509     print qq(.IX Name "$name - $desc"\n);
 510 }
 511
 512 print <<'END';
 513 .if n .hy 0
 514 .if n .na
 515 .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
 516 .de CQ          \" put $1 in typewriter font
 517 END
 518 print ".ft $CFont\n";
 519 print <<'END';
 520 'if n "\c
 521 'if t \\&\\$1\c
 522 'if n \\&\\$1\c
 523 'if n \&"
 524 \\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
 525 '.ft R
 526 ..
 527 .\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
 528 .       \" AM - accent mark definitions
 529 .bd B 3
 530 .       \" fudge factors for nroff and troff
 531 .if n \{\
 532 .       ds #H 0
 533 .       ds #V .8m
 534 .       ds #F .3m
 535 .       ds #[ \f1
 536 .       ds #] \fP
 537 .\}
 538 .if t \{\
 539 .       ds #H ((1u-(\\\\n(.fu%2u))*.13m)
 540 .       ds #V .6m
 541 .       ds #F 0
 542 .       ds #[ \&
 543 .       ds #] \&
 544 .\}
 545 .       \" simple accents for nroff and troff
 546 .if n \{\
 547 .       ds ' \&
 548 .       ds ` \&
 549 .       ds ^ \&
 550 .       ds , \&
 551 .       ds ~ ~
 552 .       ds ? ?
 553 .       ds ! !
 554 .       ds /
 555 .       ds q
 556 .\}
 557 .if t \{\
 558 .       ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
 559 .       ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
 560 .       ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
 561 .       ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
 562 .       ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
 563 .       ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
 564 .       ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
 565 .       ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
 566 .       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'
 567 .\}
 568 .       \" troff and (daisy-wheel) nroff accents
 569 .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
 570 .ds 8 \h'\*(#H'\(*b\h'-\*(#H'
 571 .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
 572 .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
 573 .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
 574 .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
 575 .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
 576 .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
 577 .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
 578 .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
 579 .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
 580 .ds ae a\h'-(\w'a'u*4/10)'e
 581 .ds Ae A\h'-(\w'A'u*4/10)'E
 582 .ds oe o\h'-(\w'o'u*4/10)'e
 583 .ds Oe O\h'-(\w'O'u*4/10)'E
 584 .       \" corrections for vroff
 585 .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
 586 .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
 587 .       \" for low resolution devices (crt and lpr)
 588 .if \n(.H>23 .if \n(.V>19 \
 589 \{\
 590 .       ds : e
 591 .       ds 8 ss
 592 .       ds v \h'-1'\o'\(aa\(ga'
 593 .       ds _ \h'-1'^
 594 .       ds . \h'-1'.
 595 .       ds 3 3
 596 .       ds o a
 597 .       ds d- d\h'-1'\(ga
 598 .       ds D- D\h'-1'\(hy
 599 .       ds th \o'bp'
 600 .       ds Th \o'LP'
 601 .       ds ae ae
 602 .       ds Ae AE
 603 .       ds oe oe
 604 .       ds Oe OE
 605 .\}
 606 .rm #[ #] #H #V #F C
 607 END
 608
 609 $indent = 0;
 610
 611 $begun = "";
 612
 613 while (<>) {
 614     if ($cutting) {
 615         next unless /^=/;
 616         $cutting = 0;
 617     }
 618     if ($begun) {
 619         if (/^=end\s+$begun/) {
 620             $begun = "";
 621         }
 622         elsif ($begun =~ /^(roff|man)$/) {
 623             print STDOUT $_;
 624         }
 625         next;
 626     }
 627     chomp;
 628
 629     # Translate verbatim paragraph
 630
 631     if (/^\s/) {
 632         @lines = split(/\n/);
 633         for (@lines) {
 634             1 while s
 635                 {^( [^\t]* ) \t ( \t* ) }
 636                 { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
 637             s/\\/\\e/g;
 638             s/\A/\\&/s;
 639         }
 640         $lines = @lines;
 641         makespace() unless $verbatim++;
 642         print ".Vb $lines\n";
 643         print join("\n", @lines), "\n";
 644         print ".Ve\n";
 645         $needspace = 0;
 646         next;
 647     }
 648
 649     $verbatim = 0;
 650
 651     if (/^=for\s+(\S+)\s*/s) {
 652         if ($1 eq "man" or $1 eq "roff") {
 653             print STDOUT $',"\n\n";
 654         } else {
 655             # ignore unknown for
 656         }
 657         next;
 658     }
 659     elsif (/^=begin\s+(\S+)\s*/s) {
 660         $begun = $1;
 661         if ($1 eq "man" or $1 eq "roff") {
 662             print STDOUT $'."\n\n";
 663         }
 664         next;
 665     }
 666
 667     # check for things that'll hosed our noremap scheme; affects $_
 668     init_noremap();
 669
 670     if (!/^=item/) {
 671
 672         # trofficate backslashes; must do it before what happens below
 673         s/\\/noremap('\\e')/ge;
 674
 675         # first hide the escapes in case we need to
 676         # intuit something and get it wrong due to fmting
 677
 678         s/([A-Z]<[^<>]*>)/noremap($1)/ge;
 679
 680         # func() is a reference to a perl function
 681         s{
 682             \b
 683             (
 684                 [:\w]+ \(\)
 685             )
 686         } {I<$1>}gx;
 687
 688         # func(n) is a reference to a perl function or a man page
 689         s{
 690             ([:\w]+)
 691             (
 692                 \( [^\051]+ \)
 693             )
 694         } {I<$1>\\|$2}gx;
 695
 696         # convert simple variable references
 697         s/(\s+)([\$\@%][\w:]+)(?!\()/${1}C<$2>/g;
 698
 699         if (m{ (
 700                     [\-\w]+
 701                     \(
 702                         [^\051]*?
 703                         [\@\$,]
 704                         [^\051]*?
 705                     \)
 706                 )
 707             }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
 708         {
 709             warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n";
 710             $oops++;
 711         }
 712
 713         while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
 714             warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n";
 715             $oops++;
 716         }
 717
 718         # put it back so we get the <> processed again;
 719         clear_noremap(0); # 0 means leave the E's
 720
 721     } else {
 722         # trofficate backslashes
 723         s/\\/noremap('\\e')/ge;
 724
 725     }
 726
 727     # need to hide E<> first; they're processed in clear_noremap
 728     s/(E<[^<>]+>)/noremap($1)/ge;
 729
 730
 731     $maxnest = 10;
 732     while ($maxnest-- && /[A-Z]</) {
 733
 734         # can't do C font here
 735         s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
 736
 737         # files and filelike refs in italics
 738         s/F<([^<>]*)>/I<$1>/g;
 739
 740         # no break -- usually we want C<> for this
 741         s/S<([^<>]*)>/nobreak($1)/eg;
 742
 743         # LREF: a manpage(3f)
 744         s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
 745
 746         # LREF: an =item on another manpage
 747         s{
 748             L<
 749                 ([^/]+)
 750                 /
 751                 (
 752                     [:\w]+
 753                     (\(\))?
 754                 )
 755             >
 756         } {the C<$2> entry in the I<$1> manpage}gx;
 757
 758         # LREF: an =item on this manpage
 759         s{
 760            ((?:
 761             L<
 762                 /
 763                 (
 764                     [:\w]+
 765                     (\(\))?
 766                 )
 767             >
 768             (,?\s+(and\s+)?)?
 769           )+)
 770         } { internal_lrefs($1) }gex;
 771
 772         # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
 773         # the "func" can disambiguate
 774         s{
 775             L<
 776                 (?:
 777                     ([a-zA-Z]\S+?) /
 778                 )?
 779                 "?(.*?)"?
 780             >
 781         }{
 782             do {
 783                 $1      # if no $1, assume it means on this page.
 784                     ?  "the section on I<$2> in the I<$1> manpage"
 785                     :  "the section on I<$2>"
 786             }
 787         }gesx; # s in case it goes over multiple lines, so . matches \n
 788
 789         s/Z<>/\\&/g;
 790
 791         # comes last because not subject to reprocessing
 792         s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
 793     }
 794
 795     if (s/^=//) {
 796         $needspace = 0;         # Assume this.
 797
 798         s/\n/ /g;
 799
 800         ($Cmd, $_) = split(' ', $_, 2);
 801
 802         if (defined $_) {
 803             &escapes;
 804             s/"/""/g;
 805         }
 806
 807         clear_noremap(1);
 808
 809         if ($Cmd eq 'cut') {
 810             $cutting = 1;
 811         }
 812         elsif ($Cmd eq 'head1') {
 813             s/\s+$//;
 814             delete $wanna_see{$_} if exists $wanna_see{$_};
 815             print qq{.SH "$_"\n};
 816             print qq{.IX Header "$_"\n};
 817         }
 818         elsif ($Cmd eq 'head2') {
 819             print qq{.Sh "$_"\n};
 820             print qq{.IX Subsection "$_"\n};
 821         }
 822         elsif ($Cmd eq 'over') {
 823             push(@indent,$indent);
 824             $indent += ($_ + 0) || 5;
 825         }
 826         elsif ($Cmd eq 'back') {
 827             $indent = pop(@indent);
 828             warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
 829             $needspace = 1;
 830         }
 831         elsif ($Cmd eq 'item') {
 832             s/^\*( |$)/\\(bu$1/g;
 833             # if you know how to get ":s please do
 834             s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g;
 835             s/\\\*\(L"([^"]+?)""/'$1'/g;
 836             s/[^"]""([^"]+?)""[^"]/'$1'/g;
 837             # here do something about the $" in perlvar?
 838             print STDOUT qq{.Ip "$_" $indent\n};
 839             print qq{.IX Item "$_"\n};
 840         }
 841         elsif ($Cmd eq 'pod') {
 842             # this is just a comment
 843         }
 844         else {
 845             warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
 846         }
 847     }
 848     else {
 849         if ($needspace) {
 850             &makespace;
 851         }
 852         &escapes;
 853         clear_noremap(1);
 854         print $_, "\n";
 855         $needspace = 1;
 856     }
 857 }
 858
 859 print <<"END";
 860
 861 .rn }` ''
 862 END
 863
 864 if (%wanna_see) {
 865     @missing = keys %wanna_see;
 866     warn "$0: $Filename is missing required section"
 867         .  (@missing > 1 && "s")
 868         .  ": @missing\n";
 869     $oops++;
 870 }
 871
 872 exit;
 873 #exit ($oops != 0);
 874
 875 #########################################################################
 876
 877 sub nobreak {
 878     my $string = shift;
 879     $string =~ s/ /\\ /g;
 880     $string;
 881 }
 882
 883 sub escapes {
 884
 885     s/X<(.*?)>/mkindex($1)/ge;
 886
 887     # translate the minus in foo-bar into foo\-bar for roff
 888     s/([^0-9a-z-])-([^-])/$1\\-$2/g;
 889
 890     # make -- into the string version \*(-- (defined above)
 891     s/\b--\b/\\*(--/g;
 892     s/"--([^"])/"\\*(--$1/g;  # should be a better way
 893     s/([^"])--"/$1\\*(--"/g;
 894
 895     # fix up quotes; this is somewhat tricky
 896     if (!/""/) {
 897         s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge;
 898         s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
 899     }
 900
 901     #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
 902     #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
 903
 904
 905     # make sure that func() keeps a bit a space tween the parens
 906     ### s/\b\(\)/\\|()/g;
 907     ### s/\b\(\)/(\\|)/g;
 908
 909     # make C++ into \*C+, which is a squinched version (defined above)
 910     s/\bC\+\+/\\*(C+/g;
 911
 912     # make double underbars have a little tiny space between them
 913     s/__/_\\|_/g;
 914
 915     # PI goes to \*(PI (defined above)
 916     s/\bPI\b/noremap('\\*(PI')/ge;
 917
 918     # make all caps a teeny bit smaller, but don't muck with embedded code literals
 919     my $hidCFont = font('C');
 920     if ($Cmd !~ /^head1/) { # SH already makes smaller
 921         # /g isn't enough; 1 while or we'll be off
 922
 923 #       1 while s{
 924 #           (?!$hidCFont)(..|^.|^)
 925 #           \b
 926 #           (
 927 #               [A-Z][\/A-Z+:\-\d_$.]+
 928 #           )
 929 #           (s?)
 930 #           \b
 931 #       } {$1\\s-1$2\\s0}gmox;
 932
 933         1 while s{
 934             (?!$hidCFont)(..|^.|^)
 935             (
 936                 \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
 937             )
 938         } {
 939             $1 . noremap( '\\s-1' .  $2 . '\\s0' )
 940         }egmox;
 941
 942     }
 943 }
 944
 945 # make troff just be normal, but make small nroff get quoted
 946 # decided to just put the quotes in the text; sigh;
 947 sub ccvt {
 948      local($_,$prev) = @_;
 949      if ( /^\W+$/ && !/^\$./ ) {
 950         ($prev && "\n") . noremap(qq{.CQ $_ \n\\&});
 951         # what about $" ?
 952      } else {
 953         noremap(qq{${CFont_embed}$_\\fR});
 954      }
 955     noremap(qq{.CQ "$_" \n\\&});
 956 }
 957
 958 sub makespace {
 959     if ($indent) {
 960         print ".Sp\n";
 961     }
 962     else {
 963         print ".PP\n";
 964     }
 965 }
 966
 967 sub mkindex {
 968     my ($entry) = @_;
 969     my @entries = split m:\s*/\s*:, $entry;
 970     print ".IX Xref ";
 971     for $entry (@entries) {
 972         print qq("$entry" );
 973     }
 974     print "\n";
 975     return '';
 976 }
 977
 978 sub font {
 979     local($font) = shift;
 980     return '\\f' . noremap($font);
 981 }
 982
 983 sub noremap {
 984     local($thing_to_hide) = shift;
 985     $thing_to_hide =~ tr/\000-\177/\200-\377/;
 986     return $thing_to_hide;
 987 }
 988
 989 sub init_noremap {
 990         # escape high bit characters in input stream
 991         s/([\200-\377])/"E<".ord($1).">"/ge;
 992 }
 993
 994 sub clear_noremap {
 995     my $ready_to_print = $_[0];
 996
 997     tr/\200-\377/\000-\177/;
 998
 999     # trofficate backslashes
1000     # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
1001
1002     # now for the E<>s, which have been hidden until now
1003     # otherwise the interative \w<> processing would have
1004     # been hosed by the E<gt>
1005     s {
1006             E<
1007             (
1008                 ( \d + )
1009                 | ( [A-Za-z]+ )
1010             )
1011             >
1012     } {
1013          do {
1014              defined $2
1015                 ? chr($2)
1016                 :
1017              exists $HTML_Escapes{$3}
1018                 ? do { $HTML_Escapes{$3} }
1019                 : do {
1020                     warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
1021                     "E<$1>";
1022                 }
1023          }
1024     }egx if $ready_to_print;
1025 }
1026
1027 sub internal_lrefs {
1028     local($_) = shift;
1029
1030     s{L</([^>]+)>}{$1}g;
1031     my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
1032     my $retstr = "the ";
1033     my $i;
1034     for ($i = 0; $i <= $#items; $i++) {
1035         $retstr .= "C<$items[$i]>";
1036         $retstr .= ", " if @items > 2 && $i != $#items;
1037         $retstr .= " and " if $i+2 == @items;
1038     }
1039
1040     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
1041             .  " elsewhere in this document "; # terminal space to avoid words running together (pattern used strips terminal spaces)
1042
1043     return $retstr;
1044
1045 }
1046
1047 BEGIN {
1048 %HTML_Escapes = (
1049     'amp'       =>      '&',    #   ampersand
1050     'lt'        =>      '<',    #   left chevron, less-than
1051     'gt'        =>      '>',    #   right chevron, greater-than
1052     'quot'      =>      '"',    #   double quote
1053
1054     "Aacute"    =>      "A\\*'",        #   capital A, acute accent
1055     "aacute"    =>      "a\\*'",        #   small a, acute accent
1056     "Acirc"     =>      "A\\*^",        #   capital A, circumflex accent
1057     "acirc"     =>      "a\\*^",        #   small a, circumflex accent
1058     "AElig"     =>      '\*(AE',        #   capital AE diphthong (ligature)
1059     "aelig"     =>      '\*(ae',        #   small ae diphthong (ligature)
1060     "Agrave"    =>      "A\\*`",        #   capital A, grave accent
1061     "agrave"    =>      "A\\*`",        #   small a, grave accent
1062     "Aring"     =>      'A\\*o',        #   capital A, ring
1063     "aring"     =>      'a\\*o',        #   small a, ring
1064     "Atilde"    =>      'A\\*~',        #   capital A, tilde
1065     "atilde"    =>      'a\\*~',        #   small a, tilde
1066     "Auml"      =>      'A\\*:',        #   capital A, dieresis or umlaut mark
1067     "auml"      =>      'a\\*:',        #   small a, dieresis or umlaut mark
1068     "Ccedil"    =>      'C\\*,',        #   capital C, cedilla
1069     "ccedil"    =>      'c\\*,',        #   small c, cedilla
1070     "Eacute"    =>      "E\\*'",        #   capital E, acute accent
1071     "eacute"    =>      "e\\*'",        #   small e, acute accent
1072     "Ecirc"     =>      "E\\*^",        #   capital E, circumflex accent
1073     "ecirc"     =>      "e\\*^",        #   small e, circumflex accent
1074     "Egrave"    =>      "E\\*`",        #   capital E, grave accent
1075     "egrave"    =>      "e\\*`",        #   small e, grave accent
1076     "ETH"       =>      '\\*(D-',       #   capital Eth, Icelandic
1077     "eth"       =>      '\\*(d-',       #   small eth, Icelandic
1078     "Euml"      =>      "E\\*:",        #   capital E, dieresis or umlaut mark
1079     "euml"      =>      "e\\*:",        #   small e, dieresis or umlaut mark
1080     "Iacute"    =>      "I\\*'",        #   capital I, acute accent
1081     "iacute"    =>      "i\\*'",        #   small i, acute accent
1082     "Icirc"     =>      "I\\*^",        #   capital I, circumflex accent
1083     "icirc"     =>      "i\\*^",        #   small i, circumflex accent
1084     "Igrave"    =>      "I\\*`",        #   capital I, grave accent
1085     "igrave"    =>      "i\\*`",        #   small i, grave accent
1086     "Iuml"      =>      "I\\*:",        #   capital I, dieresis or umlaut mark
1087     "iuml"      =>      "i\\*:",        #   small i, dieresis or umlaut mark
1088     "Ntilde"    =>      'N\*~',         #   capital N, tilde
1089     "ntilde"    =>      'n\*~',         #   small n, tilde
1090     "Oacute"    =>      "O\\*'",        #   capital O, acute accent
1091     "oacute"    =>      "o\\*'",        #   small o, acute accent
1092     "Ocirc"     =>      "O\\*^",        #   capital O, circumflex accent
1093     "ocirc"     =>      "o\\*^",        #   small o, circumflex accent
1094     "Ograve"    =>      "O\\*`",        #   capital O, grave accent
1095     "ograve"    =>      "o\\*`",        #   small o, grave accent
1096     "Oslash"    =>      "O\\*/",        #   capital O, slash
1097     "oslash"    =>      "o\\*/",        #   small o, slash
1098     "Otilde"    =>      "O\\*~",        #   capital O, tilde
1099     "otilde"    =>      "o\\*~",        #   small o, tilde
1100     "Ouml"      =>      "O\\*:",        #   capital O, dieresis or umlaut mark
1101     "ouml"      =>      "o\\*:",        #   small o, dieresis or umlaut mark
1102     "szlig"     =>      '\*8',          #   small sharp s, German (sz ligature)
1103     "THORN"     =>      '\\*(Th',       #   capital THORN, Icelandic
1104     "thorn"     =>      '\\*(th',,      #   small thorn, Icelandic
1105     "Uacute"    =>      "U\\*'",        #   capital U, acute accent
1106     "uacute"    =>      "u\\*'",        #   small u, acute accent
1107     "Ucirc"     =>      "U\\*^",        #   capital U, circumflex accent
1108     "ucirc"     =>      "u\\*^",        #   small u, circumflex accent
1109     "Ugrave"    =>      "U\\*`",        #   capital U, grave accent
1110     "ugrave"    =>      "u\\*`",        #   small u, grave accent
1111     "Uuml"      =>      "U\\*:",        #   capital U, dieresis or umlaut mark
1112     "uuml"      =>      "u\\*:",        #   small u, dieresis or umlaut mark
1113     "Yacute"    =>      "Y\\*'",        #   capital Y, acute accent
1114     "yacute"    =>      "y\\*'",        #   small y, acute accent
1115     "yuml"      =>      "y\\*:",        #   small y, dieresis or umlaut mark
1116 );
1117 }
1118
1119 !NO!SUBS!
1120
1121 close OUT or die "Can't close $file: $!";
1122 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
1123 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';