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