pod2man.pl revision 59191
159191Skris: #!/usr/bin/perl-5.005
259191Skris    eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
359191Skris	if $running_under_some_shell;
459191Skris
559191Skris$DEF_PM_SECTION = '3pm' || '3';
659191Skris
759191Skris=head1 NAME
859191Skris
959191Skrispod2man - translate embedded Perl pod directives into man pages
1059191Skris
1159191Skris=head1 SYNOPSIS
1259191Skris
1359191SkrisB<pod2man>
1459191Skris[ B<--section=>I<manext> ]
1559191Skris[ B<--release=>I<relpatch> ]
1659191Skris[ B<--center=>I<string> ]
1759191Skris[ B<--date=>I<string> ]
1859191Skris[ B<--fixed=>I<font> ]
1959191Skris[ B<--official> ]
2059191Skris[ B<--lax> ]
2159191SkrisI<inputfile>
2259191Skris
2359191Skris=head1 DESCRIPTION
2459191Skris
2559191SkrisB<pod2man> converts its input file containing embedded pod directives (see
2659191SkrisL<perlpod>) into nroff source suitable for viewing with nroff(1) or
2759191Skristroff(1) using the man(7) macro set.
2859191Skris
2959191SkrisBesides the obvious pod conversions, B<pod2man> also takes care of
3059191Skrisfunc(), func(n), and simple variable references like $foo or @bar so
3159191Skrisyou don't have to use code escapes for them; complex expressions like
3259191SkrisC<$fred{'stuff'}> will still need to be escaped, though.  Other nagging
3359191Skrislittle roffish things that it catches include translating the minus in
3459191Skrissomething like foo-bar, making a long dash--like this--into a real em
3559191Skrisdash, fixing up "paired quotes", putting a little space after the
3659191Skrisparens in something like func(), making C++ and PI look right, making
3759191Skrisdouble underbars have a little tiny space between them, making ALLCAPS
3859191Skrisa teeny bit smaller in troff(1), and escaping backslashes so you don't
3959191Skrishave to.
4059191Skris
4159191Skris=head1 OPTIONS
4259191Skris
4359191Skris=over 8
4459191Skris
4559191Skris=item center
4659191Skris
4759191SkrisSet the centered header to a specific string.  The default is
4859191Skris"User Contributed Perl Documentation", unless the C<--official> flag is
4959191Skrisgiven, in which case the default is "Perl Programmers Reference Guide".
5059191Skris
5159191Skris=item date
5259191Skris
5359191SkrisSet the left-hand footer string to this value.  By default,
5459191Skristhe modification date of the input file will be used.
5559191Skris
5659191Skris=item fixed
5759191Skris
5859191SkrisThe fixed font to use for code refs.  Defaults to CW.
5959191Skris
6059191Skris=item official
6159191Skris
6259191SkrisSet the default header to indicate that this page is of
6359191Skristhe standard release in case C<--center> is not given.
6459191Skris
6559191Skris=item release
6659191Skris
6759191SkrisSet the centered footer.  By default, this is the current
6859191Skrisperl release.
6959191Skris
7059191Skris=item section
7159191Skris
7259191SkrisSet the section for the C<.TH> macro.  The standard conventions on
7359191Skrissections are to use 1 for user commands,  2 for system calls, 3 for
7459191Skrisfunctions, 4 for devices, 5 for file formats, 6 for games, 7 for
7559191Skrismiscellaneous information, and 8 for administrator commands.  This works
7659191Skrisbest if you put your Perl man pages in a separate tree, like
7759191SkrisF</usr/local/perl/man/>.  By default, section 1 will be used
7859191Skrisunless the file ends in F<.pm> in which case section 3 will be selected.
7959191Skris
8059191Skris=item lax
8159191Skris
8259191SkrisDon't complain when required sections aren't present.
8359191Skris
8459191Skris=back
8559191Skris
8659191Skris=head1 Anatomy of a Proper Man Page
8759191Skris
8859191SkrisFor those not sure of the proper layout of a man page, here's
8959191Skrisan example of the skeleton of a proper man page.  Head of the
9059191Skrismajor headers should be setout as a C<=head1> directive, and
9159191Skrisare historically written in the rather startling ALL UPPER CASE
9259191Skrisformat, although this is not mandatory.
9359191SkrisMinor headers may be included using C<=head2>, and are
9459191Skristypically in mixed case.
9559191Skris
9659191Skris=over 10
9759191Skris
9859191Skris=item NAME
9959191Skris
10059191SkrisMandatory section; should be a comma-separated list of programs or
10159191Skrisfunctions documented by this podpage, such as:
10259191Skris
10359191Skris    foo, bar - programs to do something
10459191Skris
10559191Skris=item SYNOPSIS
10659191Skris
10759191SkrisA short usage summary for programs and functions, which
10859191Skrismay someday be deemed mandatory.
10959191Skris
11059191Skris=item DESCRIPTION
11159191Skris
11259191SkrisLong drawn out discussion of the program.  It's a good idea to break this
11359191Skrisup into subsections using the C<=head2> directives, like
11459191Skris
11559191Skris    =head2 A Sample Subection
11659191Skris
11759191Skris    =head2 Yet Another Sample Subection
11859191Skris
11959191Skris=item OPTIONS
12059191Skris
12159191SkrisSome people make this separate from the description.
12259191Skris
12359191Skris=item RETURN VALUE
12459191Skris
12559191SkrisWhat the program or function returns if successful.
12659191Skris
12759191Skris=item ERRORS
12859191Skris
12959191SkrisExceptions, return codes, exit stati, and errno settings.
13059191Skris
13159191Skris=item EXAMPLES
13259191Skris
13359191SkrisGive some example uses of the program.
13459191Skris
13559191Skris=item ENVIRONMENT
13659191Skris
13759191SkrisEnvariables this program might care about.
13859191Skris
13959191Skris=item FILES
14059191Skris
14159191SkrisAll files used by the program.  You should probably use the FE<lt>E<gt>
14259191Skrisfor these.
14359191Skris
14459191Skris=item SEE ALSO
14559191Skris
14659191SkrisOther man pages to check out, like man(1), man(7), makewhatis(8), or catman(8).
14759191Skris
14859191Skris=item NOTES
14959191Skris
15059191SkrisMiscellaneous commentary.
15159191Skris
15259191Skris=item CAVEATS
15359191Skris
15459191SkrisThings to take special care with; sometimes called WARNINGS.
15559191Skris
15659191Skris=item DIAGNOSTICS
15759191Skris
15859191SkrisAll possible messages the program can print out--and
15959191Skriswhat they mean.
16059191Skris
16159191Skris=item BUGS
16259191Skris
16359191SkrisThings that are broken or just don't work quite right.
16459191Skris
16559191Skris=item RESTRICTIONS
16659191Skris
16759191SkrisBugs you don't plan to fix :-)
16859191Skris
16959191Skris=item AUTHOR
17059191Skris
17159191SkrisWho wrote it (or AUTHORS if multiple).
17259191Skris
17359191Skris=item HISTORY
17459191Skris
17559191SkrisPrograms derived from other sources sometimes have this, or
17659191Skrisyou might keep a modification log here.
17759191Skris
17859191Skris=back
17959191Skris
18059191Skris=head1 EXAMPLES
18159191Skris
18259191Skris    pod2man program > program.1
18359191Skris    pod2man some_module.pm > /usr/perl/man/man3/some_module.3
18459191Skris    pod2man --section=7 note.pod > note.7
18559191Skris
18659191Skris=head1 DIAGNOSTICS
18759191Skris
18859191SkrisThe following diagnostics are generated by B<pod2man>.  Items
18959191Skrismarked "(W)" are non-fatal, whereas the "(F)" errors will cause
19059191SkrisB<pod2man> to immediately exit with a non-zero status.
19159191Skris
19259191Skris=over 4
19359191Skris
19459191Skris=item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s>
19559191Skris
19659191Skris(W) If you start include an option, you should set it off
19759191Skrisas bold, italic, or code.
19859191Skris
19959191Skris=item can't open %s: %s
20059191Skris
20159191Skris(F) The input file wasn't available for the given reason.
20259191Skris
20359191Skris=item Improper man page - no dash in NAME header in paragraph %d of %s
20459191Skris
20559191Skris(W) The NAME header did not have an isolated dash in it.  This is
20659191Skrisconsidered important.
20759191Skris
20859191Skris=item Invalid man page - no NAME line in %s
20959191Skris
21059191Skris(F) You did not include a NAME header, which is essential.
21159191Skris
21259191Skris=item roff font should be 1 or 2 chars, not `%s'  (F)
21359191Skris
21459191Skris(F) The font specified with the C<--fixed> option was not
21559191Skrisa one- or two-digit roff font.
21659191Skris
21759191Skris=item %s is missing required section: %s
21859191Skris
21959191Skris(W) Required sections include NAME, DESCRIPTION, and if you're
22059191Skrisusing a section starting with a 3, also a SYNOPSIS.  Actually,
22159191Skrisnot having a NAME is a fatal.
22259191Skris
22359191Skris=item Unknown escape: %s in %s
22459191Skris
22559191Skris(W) An unknown HTML entity (probably for an 8-bit character) was given via
22659191Skrisa C<EE<lt>E<gt>> directive.  Besides amp, lt, gt, and quot, recognized
22759191Skrisentities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave,
22859191SkrisAring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute,
22959191SkrisEcirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc,
23059191Skrisicirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc,
23159191Skrisocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig,
23259191SkrisTHORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml,
23359191SkrisYacute, yacute, and yuml.
23459191Skris
23559191Skris=item Unmatched =back
23659191Skris
23759191Skris(W) You have a C<=back> without a corresponding C<=over>.
23859191Skris
23959191Skris=item Unrecognized pod directive: %s
24059191Skris
24159191Skris(W) You specified a pod directive that isn't in the known list of
24259191SkrisC<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>.
24359191Skris
24459191Skris
24559191Skris=back
24659191Skris
24759191Skris=head1 NOTES
24859191Skris
24959191SkrisIf you would like to print out a lot of man page continuously, you
25059191Skrisprobably want to set the C and D registers to set contiguous page
25159191Skrisnumbering and even/odd paging, at least on some versions of man(7).
25259191SkrisSettting the F register will get you some additional experimental
25359191Skrisindexing:
25459191Skris
25559191Skris    troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ...
25659191Skris
25759191SkrisThe indexing merely outputs messages via C<.tm> for each
25859191Skrismajor page, section, subsection, item, and any C<XE<lt>E<gt>>
25959191Skrisdirectives.
26059191Skris
26159191Skris
26259191Skris=head1 RESTRICTIONS
26359191Skris
26459191SkrisNone at this time.
26559191Skris
26659191Skris=head1 BUGS
26759191Skris
26859191SkrisThe =over and =back directives don't really work right.  They
26959191Skristake absolute positions instead of offsets, don't nest well, and
27059191Skrismaking people count is suboptimal in any event.
27159191Skris
27259191Skris=head1 AUTHORS
27359191Skris
27459191SkrisOriginal prototype by Larry Wall, but so massively hacked over by
27559191SkrisTom Christiansen such that Larry probably doesn't recognize it anymore.
27659191Skris
27759191Skris=cut
27859191Skris
27959191Skris$/ = "";
28059191Skris$cutting = 1;
28159191Skris@Indices = ();
28259191Skris
28359191Skris# We try first to get the version number from a local binary, in case we're
28459191Skris# running an installed version of Perl to produce documentation from an
28559191Skris# uninstalled newer version's pod files.
28659191Skrisif ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') {
28759191Skris  my $perl = (-x './perl' && -f './perl' ) ?
28859191Skris                 './perl' :
28959191Skris                 ((-x '../perl' && -f '../perl') ?
29059191Skris                      '../perl' :
29159191Skris                      '');
29259191Skris  ($version,$patch) = `$perl -e 'print $]'` =~ /^(\d\.\d{3})(\d{2})?/ if $perl;
29359191Skris}
29459191Skris# No luck; we'll just go with the running Perl's version
29559191Skris($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version;
29659191Skris$DEF_RELEASE  = "perl $version";
29759191Skris$DEF_RELEASE .= ", patch $patch" if $patch;
29859191Skris
29959191Skris
30059191Skrissub makedate {
30159191Skris    my $secs = shift;
30259191Skris    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
30359191Skris    my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
30459191Skris    $year += 1900;
30559191Skris    return "$mday/$mname/$year";
30659191Skris}
30759191Skris
30859191Skrisuse Getopt::Long;
30959191Skris
31059191Skris$DEF_SECTION = 1;
31159191Skris$DEF_CENTER = "User Contributed Perl Documentation";
31259191Skris$STD_CENTER = "Perl Programmers Reference Guide";
31359191Skris$DEF_FIXED = 'CW';
31459191Skris$DEF_LAX = 0;
31559191Skris
31659191Skrissub usage {
31759191Skris    warn "$0: @_\n" if @_;
31859191Skris    die <<EOF;
31959191Skrisusage: $0 [options] podpage
32059191SkrisOptions are:
32159191Skris	--section=manext      (default "$DEF_SECTION")
32259191Skris	--release=relpatch    (default "$DEF_RELEASE")
32359191Skris	--center=string       (default "$DEF_CENTER")
32459191Skris	--date=string         (default "$DEF_DATE")
32559191Skris	--fixed=font	      (default "$DEF_FIXED")
32659191Skris	--official	      (default NOT)
32759191Skris	--lax                 (default NOT)
32859191SkrisEOF
32959191Skris}
33059191Skris
33159191Skris$uok = GetOptions( qw(
33259191Skris	section=s
33359191Skris	release=s
33459191Skris	center=s
33559191Skris	date=s
33659191Skris	fixed=s
33759191Skris	official
33859191Skris	lax
33959191Skris	help));
34059191Skris
34159191Skris$DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
34259191Skris
34359191Skrisusage("Usage error!") unless $uok;
34459191Skrisusage() if $opt_help;
34559191Skrisusage("Need one and only one podpage argument") unless @ARGV == 1;
34659191Skris
34759191Skris$section = $opt_section || ($ARGV[0] =~ /\.pm$/
34859191Skris				? $DEF_PM_SECTION : $DEF_SECTION);
34959191Skris$RP = $opt_release || $DEF_RELEASE;
35059191Skris$center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER);
35159191Skris$lax = $opt_lax || $DEF_LAX;
35259191Skris
35359191Skris$CFont = $opt_fixed || $DEF_FIXED;
35459191Skris
35559191Skrisif (length($CFont) == 2) {
35659191Skris    $CFont_embed = "\\f($CFont";
35759191Skris}
35859191Skriselsif (length($CFont) == 1) {
35959191Skris    $CFont_embed = "\\f$CFont";
36059191Skris}
36159191Skriselse {
36259191Skris    die "roff font should be 1 or 2 chars, not `$CFont_embed'";
36359191Skris}
36459191Skris
36559191Skris$date = $opt_date || $DEF_DATE;
36659191Skris
36759191Skrisfor (qw{NAME DESCRIPTION}) {
36859191Skris# for (qw{NAME DESCRIPTION AUTHOR}) {
36959191Skris    $wanna_see{$_}++;
37059191Skris}
37159191Skris$wanna_see{SYNOPSIS}++ if $section =~ /^3/;
37259191Skris
37359191Skris
37459191Skris$name = @ARGV ? $ARGV[0] : "<STDIN>";
37559191Skris$Filename = $name;
37659191Skrisif ($section =~ /^1/) {
37759191Skris    require File::Basename;
37859191Skris    $name = uc File::Basename::basename($name);
37959191Skris}
38059191Skris$name =~ s/\.(pod|p[lm])$//i;
38159191Skris
38259191Skris# Lose everything up to the first of
38359191Skris#     */lib/*perl*	standard or site_perl module
38459191Skris#     */*perl*/lib	from -D prefix=/opt/perl
38559191Skris#     */*perl*/		random module hierarchy
38659191Skris# which works.
38759191Skris$name =~ s-//+-/-g;
38859191Skrisif ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i
38959191Skris	or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i
39059191Skris	or $name =~ s-^.*?/[^/]*perl[^/]*/--i) {
39159191Skris    # Lose ^site(_perl)?/.
39259191Skris    $name =~ s-^site(_perl)?/--;
39359191Skris    # Lose ^arch/.	(XXX should we use Config? Just for archname?)
39459191Skris    $name =~ s~^(.*-$^O|$^O-.*)/~~o;
39559191Skris    # Lose ^version/.
39659191Skris    $name =~ s-^\d+\.\d+/--;
39759191Skris}
39859191Skris
39959191Skris# Translate Getopt/Long to Getopt::Long, etc.
40059191Skris$name =~ s(/)(::)g;
40159191Skris
40259191Skrisif ($name ne 'something') {
40359191Skris    FCHECK: {
40459191Skris	open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!";
40559191Skris	while (<F>) {
40659191Skris	    next unless /^=\b/;
40759191Skris	    if (/^=head1\s+NAME\s*$/) {  # an /m would forgive mistakes
40859191Skris		$_ = <F>;
40959191Skris		unless (/\s*-+\s+/) {
41059191Skris		    $oops++;
41159191Skris		    warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n"
41259191Skris                } else {
41359191Skris		    my @n = split /\s+-+\s+/;
41459191Skris		    if (@n != 2) {
41559191Skris			$oops++;
41659191Skris			warn "$0: Improper man page - malformed NAME header in paragraph $. of $ARGV[0]\n"
41759191Skris		    }
41859191Skris		    else {
41959191Skris			%namedesc = @n;
42059191Skris		    }
42159191Skris		}
42259191Skris		last FCHECK;
42359191Skris	    }
42459191Skris	    next if /^=cut\b/;	# DB_File and Net::Ping have =cut before NAME
42559191Skris	    next if /^=pod\b/;  # It is OK to have =pod before NAME
42659191Skris	    die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n" unless $lax;
42759191Skris	}
42859191Skris	die "$0: Invalid man page - no documentation in $ARGV[0]\n" unless $lax;
42959191Skris    }
43059191Skris    close F;
43159191Skris}
43259191Skris
43359191Skrisprint <<"END";
43459191Skris.rn '' }`
43559191Skris''' \$RCSfile\$\$Revision\$\$Date\$
43659191Skris'''
43759191Skris''' \$Log\$
43859191Skris'''
43959191Skris.de Sh
44059191Skris.br
44159191Skris.if t .Sp
44259191Skris.ne 5
44359191Skris.PP
44459191Skris\\fB\\\\\$1\\fR
44559191Skris.PP
44659191Skris..
44759191Skris.de Sp
44859191Skris.if t .sp .5v
44959191Skris.if n .sp
45059191Skris..
45159191Skris.de Ip
45259191Skris.br
45359191Skris.ie \\\\n(.\$>=3 .ne \\\\\$3
45459191Skris.el .ne 3
45559191Skris.IP "\\\\\$1" \\\\\$2
45659191Skris..
45759191Skris.de Vb
45859191Skris.ft $CFont
45959191Skris.nf
46059191Skris.ne \\\\\$1
46159191Skris..
46259191Skris.de Ve
46359191Skris.ft R
46459191Skris
46559191Skris.fi
46659191Skris..
46759191Skris'''
46859191Skris'''
46959191Skris'''     Set up \\*(-- to give an unbreakable dash;
47059191Skris'''     string Tr holds user defined translation string.
47159191Skris'''     Bell System Logo is used as a dummy character.
47259191Skris'''
47359191Skris.tr \\(*W-|\\(bv\\*(Tr
47459191Skris.ie n \\{\\
47559191Skris.ds -- \\(*W-
47659191Skris.ds PI pi
47759191Skris.if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
47859191Skris.if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
47959191Skris.ds L" ""
48059191Skris.ds R" ""
48159191Skris'''   \\*(M", \\*(S", \\*(N" and \\*(T" are the equivalent of
48259191Skris'''   \\*(L" and \\*(R", except that they are used on ".xx" lines,
48359191Skris'''   such as .IP and .SH, which do another additional levels of
48459191Skris'''   double-quote interpretation
48559191Skris.ds M" """
48659191Skris.ds S" """
48759191Skris.ds N" """""
48859191Skris.ds T" """""
48959191Skris.ds L' '
49059191Skris.ds R' '
49159191Skris.ds M' '
49259191Skris.ds S' '
49359191Skris.ds N' '
49459191Skris.ds T' '
49559191Skris'br\\}
49659191Skris.el\\{\\
49759191Skris.ds -- \\(em\\|
49859191Skris.tr \\*(Tr
49959191Skris.ds L" ``
50059191Skris.ds R" ''
50159191Skris.ds M" ``
50259191Skris.ds S" ''
50359191Skris.ds N" ``
50459191Skris.ds T" ''
50559191Skris.ds L' `
50659191Skris.ds R' '
50759191Skris.ds M' `
50859191Skris.ds S' '
50959191Skris.ds N' `
51059191Skris.ds T' '
51159191Skris.ds PI \\(*p
51259191Skris'br\\}
51359191SkrisEND
51459191Skris
51559191Skrisprint <<'END';
51659191Skris.\"	If the F register is turned on, we'll generate
51759191Skris.\"	index entries out stderr for the following things:
51859191Skris.\"		TH	Title
51959191Skris.\"		SH	Header
52059191Skris.\"		Sh	Subsection
52159191Skris.\"		Ip	Item
52259191Skris.\"		X<>	Xref  (embedded
52359191Skris.\"	Of course, you have to process the output yourself
52459191Skris.\"	in some meaninful fashion.
52559191Skris.if \nF \{
52659191Skris.de IX
52759191Skris.tm Index:\\$1\t\\n%\t"\\$2"
52859191Skris..
52959191Skris.nr % 0
53059191Skris.rr F
53159191Skris.\}
53259191SkrisEND
53359191Skris
53459191Skrisprint <<"END";
53559191Skris.TH $name $section "$RP" "$date" "$center"
53659191Skris.UC
53759191SkrisEND
53859191Skris
53959191Skrispush(@Indices, qq{.IX Title "$name $section"});
54059191Skris
54159191Skriswhile (($name, $desc) = each %namedesc) {
54259191Skris    for ($name, $desc) { s/^\s+//; s/\s+$//; }
54359191Skris    push(@Indices, qq(.IX Name "$name - $desc"\n));
54459191Skris}
54559191Skris
54659191Skrisprint <<'END';
54759191Skris.if n .hy 0
54859191Skris.if n .na
54959191Skris.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
55059191Skris.de CQ          \" put $1 in typewriter font
55159191SkrisEND
55259191Skrisprint ".ft $CFont\n";
55359191Skrisprint <<'END';
55459191Skris'if n "\c
55559191Skris'if t \\&\\$1\c
55659191Skris'if n \\&\\$1\c
55759191Skris'if n \&"
55859191Skris\\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
55959191Skris'.ft R
56059191Skris..
56159191Skris.\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
56259191Skris.	\" AM - accent mark definitions
56359191Skris.bd B 3
56459191Skris.	\" fudge factors for nroff and troff
56559191Skris.if n \{\
56659191Skris.	ds #H 0
56759191Skris.	ds #V .8m
56859191Skris.	ds #F .3m
56959191Skris.	ds #[ \f1
57059191Skris.	ds #] \fP
57159191Skris.\}
57259191Skris.if t \{\
57359191Skris.	ds #H ((1u-(\\\\n(.fu%2u))*.13m)
57459191Skris.	ds #V .6m
57559191Skris.	ds #F 0
57659191Skris.	ds #[ \&
57759191Skris.	ds #] \&
57859191Skris.\}
57959191Skris.	\" simple accents for nroff and troff
58059191Skris.if n \{\
58159191Skris.	ds ' \&
58259191Skris.	ds ` \&
58359191Skris.	ds ^ \&
58459191Skris.	ds , \&
58559191Skris.	ds ~ ~
58659191Skris.	ds ? ?
58759191Skris.	ds ! !
58859191Skris.	ds /
58959191Skris.	ds q
59059191Skris.\}
59159191Skris.if t \{\
59259191Skris.	ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
59359191Skris.	ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
59459191Skris.	ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
59559191Skris.	ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
59659191Skris.	ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
59759191Skris.	ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
59859191Skris.	ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
59959191Skris.	ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
60059191Skris.	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'
60159191Skris.\}
60259191Skris.	\" troff and (daisy-wheel) nroff accents
60359191Skris.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
60459191Skris.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
60559191Skris.ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
60659191Skris.ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
60759191Skris.ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
60859191Skris.ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
60959191Skris.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
61059191Skris.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
61159191Skris.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
61259191Skris.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
61359191Skris.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
61459191Skris.ds ae a\h'-(\w'a'u*4/10)'e
61559191Skris.ds Ae A\h'-(\w'A'u*4/10)'E
61659191Skris.ds oe o\h'-(\w'o'u*4/10)'e
61759191Skris.ds Oe O\h'-(\w'O'u*4/10)'E
61859191Skris.	\" corrections for vroff
61959191Skris.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
62059191Skris.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
62159191Skris.	\" for low resolution devices (crt and lpr)
62259191Skris.if \n(.H>23 .if \n(.V>19 \
62359191Skris\{\
62459191Skris.	ds : e
62559191Skris.	ds 8 ss
62659191Skris.	ds v \h'-1'\o'\(aa\(ga'
62759191Skris.	ds _ \h'-1'^
62859191Skris.	ds . \h'-1'.
62959191Skris.	ds 3 3
63059191Skris.	ds o a
63159191Skris.	ds d- d\h'-1'\(ga
63259191Skris.	ds D- D\h'-1'\(hy
63359191Skris.	ds th \o'bp'
63459191Skris.	ds Th \o'LP'
63559191Skris.	ds ae ae
63659191Skris.	ds Ae AE
63759191Skris.	ds oe oe
63859191Skris.	ds Oe OE
63959191Skris.\}
64059191Skris.rm #[ #] #H #V #F C
64159191SkrisEND
64259191Skris
64359191Skris$indent = 0;
64459191Skris
64559191Skris$begun = "";
64659191Skris
64759191Skris# Unrolling [^A-Z>]|[A-Z](?!<) gives:    // MRE pp 165.
64859191Skrismy $nonest = '(?:[^A-Z>]*(?:[A-Z](?!<)[^A-Z>]*)*)';
64959191Skris
65059191Skriswhile (<>) {
65159191Skris    if ($cutting) {
65259191Skris	next unless /^=/;
65359191Skris	$cutting = 0;
65459191Skris    }
65559191Skris    if ($begun) {
65659191Skris	if (/^=end\s+$begun/) {
65759191Skris            $begun = "";
65859191Skris	}
65959191Skris	elsif ($begun =~ /^(roff|man)$/) {
66059191Skris	    print STDOUT $_;
66159191Skris        }
66259191Skris	next;
66359191Skris    }
66459191Skris    chomp;
66559191Skris
66659191Skris    # Translate verbatim paragraph
66759191Skris
66859191Skris    if (/^\s/) {
66959191Skris	@lines = split(/\n/);
67059191Skris	for (@lines) {
67159191Skris	    1 while s
67259191Skris		{^( [^\t]* ) \t ( \t* ) }
67359191Skris		{ $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
67459191Skris	    s/\\/\\e/g;
67559191Skris	    s/\A/\\&/s;
67659191Skris	}
67759191Skris	$lines = @lines;
67859191Skris	makespace() unless $verbatim++;
67959191Skris	print ".Vb $lines\n";
68059191Skris	print join("\n", @lines), "\n";
68159191Skris	print ".Ve\n";
68259191Skris	$needspace = 0;
68359191Skris	next;
68459191Skris    }
68559191Skris
68659191Skris    $verbatim = 0;
68759191Skris
68859191Skris    if (/^=for\s+(\S+)\s*/s) {
68959191Skris	if ($1 eq "man" or $1 eq "roff") {
69059191Skris	    print STDOUT $',"\n\n";
69159191Skris	} else {
69259191Skris	    # ignore unknown for
69359191Skris	}
69459191Skris	next;
69559191Skris    }
69659191Skris    elsif (/^=begin\s+(\S+)\s*/s) {
69759191Skris	$begun = $1;
69859191Skris	if ($1 eq "man" or $1 eq "roff") {
69959191Skris	    print STDOUT $'."\n\n";
70059191Skris	}
70159191Skris	next;
70259191Skris    }
70359191Skris
70459191Skris    # check for things that'll hosed our noremap scheme; affects $_
70559191Skris    init_noremap();
70659191Skris
70759191Skris    if (!/^=item/) {
70859191Skris
70959191Skris	# trofficate backslashes; must do it before what happens below
71059191Skris	s/\\/noremap('\\e')/ge;
71159191Skris
71259191Skris	# protect leading periods and quotes against *roff
71359191Skris	# mistaking them for directives
71459191Skris	s/^(?:[A-Z]<)?[.']/\\&$&/gm;
71559191Skris
71659191Skris	# first hide the escapes in case we need to
71759191Skris	# intuit something and get it wrong due to fmting
71859191Skris
71959191Skris	1 while s/([A-Z]<$nonest>)/noremap($1)/ge;
72059191Skris
72159191Skris	# func() is a reference to a perl function
72259191Skris	s{
72359191Skris	    \b
72459191Skris	    (
72559191Skris		[:\w]+ \(\)
72659191Skris	    )
72759191Skris	} {I<$1>}gx;
72859191Skris
72959191Skris	# func(n) is a reference to a perl function or a man page
73059191Skris	s{
73159191Skris	    ([:\w]+)
73259191Skris	    (
73359191Skris		\( [^\051]+ \)
73459191Skris	    )
73559191Skris	} {I<$1>\\|$2}gx;
73659191Skris
73759191Skris	# convert simple variable references
73859191Skris	s/(\s+)([\$\@%][\w:]+)(?!\()/${1}C<$2>/g;
73959191Skris
74059191Skris	if (m{ (
74159191Skris		    [\-\w]+
74259191Skris		    \(
74359191Skris			[^\051]*?
74459191Skris			[\@\$,]
74559191Skris			[^\051]*?
74659191Skris		    \)
74759191Skris		)
74859191Skris	    }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
74959191Skris	{
75059191Skris	    warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n";
75159191Skris	    $oops++;
75259191Skris	}
75359191Skris
75459191Skris	while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
75559191Skris	    warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n";
75659191Skris	    $oops++;
75759191Skris	}
75859191Skris
75959191Skris	# put it back so we get the <> processed again;
76059191Skris	clear_noremap(0); # 0 means leave the E's
76159191Skris
76259191Skris    } else {
76359191Skris	# trofficate backslashes
76459191Skris	s/\\/noremap('\\e')/ge;
76559191Skris
76659191Skris    }
76759191Skris
76859191Skris    # need to hide E<> first; they're processed in clear_noremap
76959191Skris    s/(E<[^<>]+>)/noremap($1)/ge;
77059191Skris
77159191Skris
77259191Skris    $maxnest = 10;
77359191Skris    while ($maxnest-- && /[A-Z]</) {
77459191Skris
77559191Skris	# can't do C font here
77659191Skris	s/([BI])<($nonest)>/font($1) . $2 . font('R')/eg;
77759191Skris
77859191Skris	# files and filelike refs in italics
77959191Skris	s/F<($nonest)>/I<$1>/g;
78059191Skris
78159191Skris	# no break -- usually we want C<> for this
78259191Skris	s/S<($nonest)>/nobreak($1)/eg;
78359191Skris
78459191Skris	# LREF: a la HREF L<show this text|man/section>
78559191Skris	s:L<([^|>]+)\|[^>]+>:$1:g;
78659191Skris
78759191Skris	# LREF: a manpage(3f)
78859191Skris	s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
78959191Skris
79059191Skris	# LREF: an =item on another manpage
79159191Skris	s{
79259191Skris	    L<
79359191Skris		([^/]+)
79459191Skris		/
79559191Skris		(
79659191Skris		    [:\w]+
79759191Skris		    (\(\))?
79859191Skris		)
79959191Skris	    >
80059191Skris	} {the C<$2> entry in the I<$1> manpage}gx;
80159191Skris
80259191Skris	# LREF: an =item on this manpage
80359191Skris	s{
80459191Skris	   ((?:
80559191Skris	    L<
80659191Skris		/
80759191Skris		(
80859191Skris		    [:\w]+
80959191Skris		    (\(\))?
81059191Skris		)
81159191Skris	    >
81259191Skris	    (,?\s+(and\s+)?)?
81359191Skris	  )+)
81459191Skris	} { internal_lrefs($1) }gex;
81559191Skris
81659191Skris	# LREF: a =head2 (head1?), maybe on a manpage, maybe right here
81759191Skris	# the "func" can disambiguate
81859191Skris	s{
81959191Skris	    L<
82059191Skris		(?:
82159191Skris		    ([a-zA-Z]\S+?) /
82259191Skris		)?
82359191Skris		"?(.*?)"?
82459191Skris	    >
82559191Skris	}{
82659191Skris	    do {
82759191Skris		$1 	# if no $1, assume it means on this page.
82859191Skris		    ?  "the section on I<$2> in the I<$1> manpage"
82959191Skris		    :  "the section on I<$2>"
83059191Skris	    }
83159191Skris	}gesx; # s in case it goes over multiple lines, so . matches \n
83259191Skris
83359191Skris	s/Z<>/\\&/g;
83459191Skris
83559191Skris	# comes last because not subject to reprocessing
83659191Skris	s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg;
83759191Skris    }
83859191Skris
83959191Skris    if (s/^=//) {
84059191Skris	$needspace = 0;		# Assume this.
84159191Skris
84259191Skris	s/\n/ /g;
84359191Skris
84459191Skris	($Cmd, $_) = split(' ', $_, 2);
84559191Skris
84659191Skris	$dotlevel = 1;
84759191Skris	if ($Cmd eq 'head1') {
84859191Skris	   $dotlevel = 1;
84959191Skris	}
85059191Skris	elsif ($Cmd eq 'head2') {
85159191Skris	   $dotlevel = 1;
85259191Skris	}
85359191Skris	elsif ($Cmd eq 'item') {
85459191Skris	   $dotlevel = 2;
85559191Skris	}
85659191Skris
85759191Skris	if (defined $_) {
85859191Skris	    &escapes($dotlevel);
85959191Skris	    s/"/""/g;
86059191Skris	}
86159191Skris
86259191Skris	clear_noremap(1);
86359191Skris
86459191Skris	if ($Cmd eq 'cut') {
86559191Skris	    $cutting = 1;
86659191Skris	}
86759191Skris	elsif ($Cmd eq 'head1') {
86859191Skris	    s/\s+$//;
86959191Skris	    delete $wanna_see{$_} if exists $wanna_see{$_};
87059191Skris	    print qq{.SH "$_"\n};
87159191Skris      push(@Indices, qq{.IX Header "$_"\n});
87259191Skris	}
87359191Skris	elsif ($Cmd eq 'head2') {
87459191Skris	    print qq{.Sh "$_"\n};
87559191Skris      push(@Indices, qq{.IX Subsection "$_"\n});
87659191Skris	}
87759191Skris	elsif ($Cmd eq 'over') {
87859191Skris	    push(@indent,$indent);
87959191Skris	    $indent += ($_ + 0) || 5;
88059191Skris	}
88159191Skris	elsif ($Cmd eq 'back') {
88259191Skris	    $indent = pop(@indent);
88359191Skris	    warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
88459191Skris	    $needspace = 1;
88559191Skris	}
88659191Skris	elsif ($Cmd eq 'item') {
88759191Skris	    s/^\*( |$)/\\(bu$1/g;
88859191Skris	    # if you know how to get ":s please do
88959191Skris	    s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g;
89059191Skris	    s/\\\*\(L"([^"]+?)""/'$1'/g;
89159191Skris	    s/[^"]""([^"]+?)""[^"]/'$1'/g;
89259191Skris	    # here do something about the $" in perlvar?
89359191Skris	    print STDOUT qq{.Ip "$_" $indent\n};
89459191Skris      push(@Indices, qq{.IX Item "$_"\n});
89559191Skris	}
89659191Skris	elsif ($Cmd eq 'pod') {
89759191Skris	    # this is just a comment
89859191Skris	}
89959191Skris	else {
90059191Skris	    warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
90159191Skris	}
90259191Skris    }
90359191Skris    else {
90459191Skris	if ($needspace) {
90559191Skris	    &makespace;
90659191Skris	}
90759191Skris	&escapes(0);
90859191Skris	clear_noremap(1);
90959191Skris	print $_, "\n";
91059191Skris	$needspace = 1;
91159191Skris    }
91259191Skris}
91359191Skris
91459191Skrisprint <<"END";
91559191Skris
91659191Skris.rn }` ''
91759191SkrisEND
91859191Skris
91959191Skrisif (%wanna_see && !$lax) {
92059191Skris    @missing = keys %wanna_see;
92159191Skris    warn "$0: $Filename is missing required section"
92259191Skris	.  (@missing > 1 && "s")
92359191Skris	.  ": @missing\n";
92459191Skris    $oops++;
92559191Skris}
92659191Skris
92759191Skrisforeach (@Indices) { print "$_\n"; }
92859191Skris
92959191Skrisexit;
93059191Skris#exit ($oops != 0);
93159191Skris
93259191Skris#########################################################################
93359191Skris
93459191Skrissub nobreak {
93559191Skris    my $string = shift;
93659191Skris    $string =~ s/ /\\ /g;
93759191Skris    $string;
93859191Skris}
93959191Skris
94059191Skrissub escapes {
94159191Skris    my $indot = shift;
94259191Skris
94359191Skris    s/X<(.*?)>/mkindex($1)/ge;
94459191Skris
94559191Skris    # translate the minus in foo-bar into foo\-bar for roff
94659191Skris    s/([^0-9a-z-])-([^-])/$1\\-$2/g;
94759191Skris
94859191Skris    # make -- into the string version \*(-- (defined above)
94959191Skris    s/\b--\b/\\*(--/g;
95059191Skris    s/"--([^"])/"\\*(--$1/g;  # should be a better way
95159191Skris    s/([^"])--"/$1\\*(--"/g;
95259191Skris
95359191Skris    # fix up quotes; this is somewhat tricky
95459191Skris    my $dotmacroL = 'L';
95559191Skris    my $dotmacroR = 'R';
95659191Skris    if ( $indot == 1 ) {
95759191Skris	$dotmacroL = 'M';
95859191Skris	$dotmacroR = 'S';
95959191Skris    }
96059191Skris    elsif ( $indot >= 2 ) {
96159191Skris	$dotmacroL = 'N';
96259191Skris	$dotmacroR = 'T';
96359191Skris    }
96459191Skris    if (!/""/) {
96559191Skris	s/(^|\s)(['"])/noremap("$1\\*($dotmacroL$2")/ge;
96659191Skris	s/(['"])($|[\-\s,;\\!?.])/noremap("\\*($dotmacroR$1$2")/ge;
96759191Skris    }
96859191Skris
96959191Skris    #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
97059191Skris    #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
97159191Skris
97259191Skris
97359191Skris    # make sure that func() keeps a bit a space tween the parens
97459191Skris    ### s/\b\(\)/\\|()/g;
97559191Skris    ### s/\b\(\)/(\\|)/g;
97659191Skris
97759191Skris    # make C++ into \*C+, which is a squinched version (defined above)
97859191Skris    s/\bC\+\+/\\*(C+/g;
97959191Skris
98059191Skris    # make double underbars have a little tiny space between them
98159191Skris    s/__/_\\|_/g;
98259191Skris
98359191Skris    # PI goes to \*(PI (defined above)
98459191Skris    s/\bPI\b/noremap('\\*(PI')/ge;
98559191Skris
98659191Skris    # make all caps a teeny bit smaller, but don't muck with embedded code literals
98759191Skris    my $hidCFont = font('C');
98859191Skris    if ($Cmd !~ /^head1/) { # SH already makes smaller
98959191Skris	# /g isn't enough; 1 while or we'll be off
99059191Skris
99159191Skris#	1 while s{
99259191Skris#	    (?!$hidCFont)(..|^.|^)
99359191Skris#	    \b
99459191Skris#	    (
99559191Skris#		[A-Z][\/A-Z+:\-\d_$.]+
99659191Skris#	    )
99759191Skris#	    (s?)
99859191Skris#	    \b
99959191Skris#	} {$1\\s-1$2\\s0}gmox;
100059191Skris
100159191Skris	1 while s{
100259191Skris	    (?!$hidCFont)(..|^.|^)
100359191Skris	    (
100459191Skris		\b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
100559191Skris	    )
100659191Skris	} {
100759191Skris	    $1 . noremap( '\\s-1' .  $2 . '\\s0' )
100859191Skris	}egmox;
100959191Skris
101059191Skris    }
101159191Skris}
101259191Skris
101359191Skris# make troff just be normal, but make small nroff get quoted
101459191Skris# decided to just put the quotes in the text; sigh;
101559191Skrissub ccvt {
101659191Skris    local($_,$prev) = @_;
101759191Skris    noremap(qq{.CQ "$_" \n\\&});
101859191Skris}
101959191Skris
102059191Skrissub makespace {
102159191Skris    if ($indent) {
102259191Skris	print ".Sp\n";
102359191Skris    }
102459191Skris    else {
102559191Skris	print ".PP\n";
102659191Skris    }
102759191Skris}
102859191Skris
102959191Skrissub mkindex {
103059191Skris    my ($entry) = @_;
103159191Skris    my @entries = split m:\s*/\s*:, $entry;
103259191Skris    push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries;
103359191Skris    return '';
103459191Skris}
103559191Skris
103659191Skrissub font {
103759191Skris    local($font) = shift;
103859191Skris    return '\\f' . noremap($font);
103959191Skris}
104059191Skris
104159191Skrissub noremap {
104259191Skris    local($thing_to_hide) = shift;
104359191Skris    $thing_to_hide =~ tr/\000-\177/\200-\377/;
104459191Skris    return $thing_to_hide;
104559191Skris}
104659191Skris
104759191Skrissub init_noremap {
104859191Skris	# escape high bit characters in input stream
104959191Skris	s/([\200-\377])/"E<".ord($1).">"/ge;
105059191Skris}
105159191Skris
105259191Skrissub clear_noremap {
105359191Skris    my $ready_to_print = $_[0];
105459191Skris
105559191Skris    tr/\200-\377/\000-\177/;
105659191Skris
105759191Skris    # trofficate backslashes
105859191Skris    # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
105959191Skris
106059191Skris    # now for the E<>s, which have been hidden until now
106159191Skris    # otherwise the interative \w<> processing would have
106259191Skris    # been hosed by the E<gt>
106359191Skris    s {
106459191Skris	    E<
106559191Skris	    (
106659191Skris	        ( \d + )
106759191Skris	        | ( [A-Za-z]+ )
106859191Skris	    )
106959191Skris	    >
107059191Skris    } {
107159191Skris	 do {
107259191Skris	     defined $2
107359191Skris		? chr($2)
107459191Skris		:
107559191Skris	     exists $HTML_Escapes{$3}
107659191Skris		? do { $HTML_Escapes{$3} }
107759191Skris		: do {
107859191Skris		    warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
107959191Skris		    "E<$1>";
108059191Skris		}
108159191Skris	 }
108259191Skris    }egx if $ready_to_print;
108359191Skris}
108459191Skris
108559191Skrissub internal_lrefs {
108659191Skris    local($_) = shift;
108759191Skris    local $trailing_and = s/and\s+$// ? "and " : "";
108859191Skris
108959191Skris    s{L</([^>]+)>}{$1}g;
109059191Skris    my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
109159191Skris    my $retstr = "the ";
109259191Skris    my $i;
109359191Skris    for ($i = 0; $i <= $#items; $i++) {
109459191Skris	$retstr .= "C<$items[$i]>";
109559191Skris	$retstr .= ", " if @items > 2 && $i != $#items;
109659191Skris	$retstr .= " and " if $i+2 == @items;
109759191Skris    }
109859191Skris
109959191Skris    $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
110059191Skris	    .  " elsewhere in this document";
110159191Skris    # terminal space to avoid words running together (pattern used
110259191Skris    # strips terminal spaces)
110359191Skris    $retstr .= " " if length $trailing_and;
110459191Skris    $retstr .=  $trailing_and;
110559191Skris
110659191Skris    return $retstr;
110759191Skris
110859191Skris}
110959191Skris
111059191SkrisBEGIN {
111159191Skris%HTML_Escapes = (
111259191Skris    'amp'	=>	'&',	#   ampersand
111359191Skris    'lt'	=>	'<',	#   left chevron, less-than
111459191Skris    'gt'	=>	'>',	#   right chevron, greater-than
111559191Skris    'quot'	=>	'"',	#   double quote
111659191Skris
111759191Skris    "Aacute"	=>	"A\\*'",	#   capital A, acute accent
111859191Skris    "aacute"	=>	"a\\*'",	#   small a, acute accent
111959191Skris    "Acirc"	=>	"A\\*^",	#   capital A, circumflex accent
112059191Skris    "acirc"	=>	"a\\*^",	#   small a, circumflex accent
112159191Skris    "AElig"	=>	'\*(AE',	#   capital AE diphthong (ligature)
112259191Skris    "aelig"	=>	'\*(ae',	#   small ae diphthong (ligature)
112359191Skris    "Agrave"	=>	"A\\*`",	#   capital A, grave accent
112459191Skris    "agrave"	=>	"A\\*`",	#   small a, grave accent
112559191Skris    "Aring"	=>	'A\\*o',	#   capital A, ring
112659191Skris    "aring"	=>	'a\\*o',	#   small a, ring
112759191Skris    "Atilde"	=>	'A\\*~',	#   capital A, tilde
112859191Skris    "atilde"	=>	'a\\*~',	#   small a, tilde
112959191Skris    "Auml"	=>	'A\\*:',	#   capital A, dieresis or umlaut mark
113059191Skris    "auml"	=>	'a\\*:',	#   small a, dieresis or umlaut mark
113159191Skris    "Ccedil"	=>	'C\\*,',	#   capital C, cedilla
113259191Skris    "ccedil"	=>	'c\\*,',	#   small c, cedilla
113359191Skris    "Eacute"	=>	"E\\*'",	#   capital E, acute accent
113459191Skris    "eacute"	=>	"e\\*'",	#   small e, acute accent
113559191Skris    "Ecirc"	=>	"E\\*^",	#   capital E, circumflex accent
113659191Skris    "ecirc"	=>	"e\\*^",	#   small e, circumflex accent
113759191Skris    "Egrave"	=>	"E\\*`",	#   capital E, grave accent
113859191Skris    "egrave"	=>	"e\\*`",	#   small e, grave accent
113959191Skris    "ETH"	=>	'\\*(D-',	#   capital Eth, Icelandic
114059191Skris    "eth"	=>	'\\*(d-',	#   small eth, Icelandic
114159191Skris    "Euml"	=>	"E\\*:",	#   capital E, dieresis or umlaut mark
114259191Skris    "euml"	=>	"e\\*:",	#   small e, dieresis or umlaut mark
114359191Skris    "Iacute"	=>	"I\\*'",	#   capital I, acute accent
114459191Skris    "iacute"	=>	"i\\*'",	#   small i, acute accent
114559191Skris    "Icirc"	=>	"I\\*^",	#   capital I, circumflex accent
114659191Skris    "icirc"	=>	"i\\*^",	#   small i, circumflex accent
114759191Skris    "Igrave"	=>	"I\\*`",	#   capital I, grave accent
114859191Skris    "igrave"	=>	"i\\*`",	#   small i, grave accent
114959191Skris    "Iuml"	=>	"I\\*:",	#   capital I, dieresis or umlaut mark
115059191Skris    "iuml"	=>	"i\\*:",	#   small i, dieresis or umlaut mark
115159191Skris    "Ntilde"	=>	'N\*~',		#   capital N, tilde
115259191Skris    "ntilde"	=>	'n\*~',		#   small n, tilde
115359191Skris    "Oacute"	=>	"O\\*'",	#   capital O, acute accent
115459191Skris    "oacute"	=>	"o\\*'",	#   small o, acute accent
115559191Skris    "Ocirc"	=>	"O\\*^",	#   capital O, circumflex accent
115659191Skris    "ocirc"	=>	"o\\*^",	#   small o, circumflex accent
115759191Skris    "Ograve"	=>	"O\\*`",	#   capital O, grave accent
115859191Skris    "ograve"	=>	"o\\*`",	#   small o, grave accent
115959191Skris    "Oslash"	=>	"O\\*/",	#   capital O, slash
116059191Skris    "oslash"	=>	"o\\*/",	#   small o, slash
116159191Skris    "Otilde"	=>	"O\\*~",	#   capital O, tilde
116259191Skris    "otilde"	=>	"o\\*~",	#   small o, tilde
116359191Skris    "Ouml"	=>	"O\\*:",	#   capital O, dieresis or umlaut mark
116459191Skris    "ouml"	=>	"o\\*:",	#   small o, dieresis or umlaut mark
116559191Skris    "szlig"	=>	'\*8',		#   small sharp s, German (sz ligature)
116659191Skris    "THORN"	=>	'\\*(Th',	#   capital THORN, Icelandic
116759191Skris    "thorn"	=>	'\\*(th',,	#   small thorn, Icelandic
116859191Skris    "Uacute"	=>	"U\\*'",	#   capital U, acute accent
116959191Skris    "uacute"	=>	"u\\*'",	#   small u, acute accent
117059191Skris    "Ucirc"	=>	"U\\*^",	#   capital U, circumflex accent
117159191Skris    "ucirc"	=>	"u\\*^",	#   small u, circumflex accent
117259191Skris    "Ugrave"	=>	"U\\*`",	#   capital U, grave accent
117359191Skris    "ugrave"	=>	"u\\*`",	#   small u, grave accent
117459191Skris    "Uuml"	=>	"U\\*:",	#   capital U, dieresis or umlaut mark
117559191Skris    "uuml"	=>	"u\\*:",	#   small u, dieresis or umlaut mark
117659191Skris    "Yacute"	=>	"Y\\*'",	#   capital Y, acute accent
117759191Skris    "yacute"	=>	"y\\*'",	#   small y, acute accent
117859191Skris    "yuml"	=>	"y\\*:",	#   small y, dieresis or umlaut mark
117959191Skris);
118059191Skris}
118159191Skris
1182