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