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