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