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