[perl5.git] / pod / pod2man.SH

case $CONFIG in
'')
	if test -f config.sh; then TOP=.;
	elif test -f ../config.sh; then TOP=..;
	elif test -f ../../config.sh; then TOP=../..;
	elif test -f ../../../config.sh; then TOP=../../..;
	elif test -f ../../../../config.sh; then TOP=../../../..;
	else
		echo "Can't find config.sh."; exit 1
	fi
	. $TOP/config.sh
	;;
esac
case "$0" in
*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
esac
echo "Extracting pod/pod2man (with variable substitutions)"
rm -f pod2man
$spitshell >pod2man <<!GROK!THIS!
#!$bin/perl
eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
	if \$running_under_some_shell;
!GROK!THIS!

$spitshell >>pod2man <<'!NO!SUBS!'

$/ = "";
$cutting = 1;

$CFont = 'CW';
if ($ARGV[0] =~ s/-fc(.*)//) {
    shift;
    $CFont = $1 || shift;
}

if (length($CFont) == 2) {
    $CFont_embed = "\\f($CFont";
} 
elsif (length($CFont) == 1) {
    $CFont_embed = "\\f$CFont";
} 
else {
    die "Roff font should be 1 or 2 chars, not `$CFont_embed'";
} 

$name = @ARGV ? $ARGV[0] : "something";
$name =~ s/\..*//;

print <<"END";
.rn '' }`
''' \$RCSfile\$\$Revision\$\$Date\$
''' 
''' \$Log\$
''' 
.de Sh
.br
.if t .Sp
.ne 5
.PP
\\fB\\\\\$1\\fR
.PP
..
.de Sp
.if t .sp .5v
.if n .sp
..
.de Ip
.br
.ie \\\\n(.\$>=3 .ne \\\\\$3
.el .ne 3
.IP "\\\\\$1" \\\\\$2
..
.de Vb
.ft $CFont
.nf
.ne \\\\\$1
..
.de Ve
.ft R

.fi
..
'''
'''
'''     Set up \\*(-- to give an unbreakable dash;
'''     string Tr holds user defined translation string.
'''     Bell System Logo is used as a dummy character.
'''
.tr \\(*W-|\\(bv\\*(Tr
.ie n \\{\\
.ds -- \\(*W-
.if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
.if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
.ds L" ""
.ds R" ""
.ds L' '
.ds R' '
'br\\}
.el\\{\\
.ds -- \\(em\\|
.tr \\*(Tr
.ds L" ``
.ds R" ''
.ds L' `
.ds R' '
.if t .ds PI \\(*p
.if n .ds PI PI
'br\\}
.TH \U$name\E 1 "\\*(RP"
.UC
END

print <<'END';
.if n .hy 0 
.if n .na
.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
.de CQ          \" put $1 in typewriter font
END
print ".ft $CFont\n";
print <<'END';
'if n "\c
'if t \\&\\$1\c
'if n \\&\\$1\c
'if n \&"
\\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
'.ft R
..
.\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
.	\" AM - accent mark definitions
.bd S B 3
.	\" fudge factors for nroff and troff
.if n \{\
.	ds #H 0
.	ds #V .8m
.	ds #F .3m
.	ds #[ \f1
.	ds #] \fP
.\}
.if t \{\
.	ds #H ((1u-(\\\\n(.fu%2u))*.13m)
.	ds #V .6m
.	ds #F 0
.	ds #[ \&
.	ds #] \&
.\}
.	\" simple accents for nroff and troff
.if n \{\
.	ds ' \&
.	ds ` \&
.	ds ^ \&
.	ds , \&
.	ds ~ ~
.	ds ? ?
.	ds ! !
.	ds / 
.	ds q 
.\}
.if t \{\
.	ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
.	ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
.	ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
.	ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
.	ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
.	ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
.	ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
.	ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
.	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'
.\}
.	\" troff and (daisy-wheel) nroff accents
.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
.ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
.ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
.ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
.ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
.ds ae a\h'-(\w'a'u*4/10)'e
.ds Ae A\h'-(\w'A'u*4/10)'E
.ds oe o\h'-(\w'o'u*4/10)'e
.ds Oe O\h'-(\w'O'u*4/10)'E
.	\" corrections for vroff
.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
.	\" for low resolution devices (crt and lpr)
.if \n(.H>23 .if \n(.V>19 \
\{\
.	ds : e
.	ds 8 ss
.	ds v \h'-1'\o'\(aa\(ga'
.	ds _ \h'-1'^
.	ds . \h'-1'.
.	ds 3 3
.	ds o a
.	ds d- d\h'-1'\(ga
.	ds D- D\h'-1'\(hy
.	ds th \o'bp'
.	ds Th \o'LP'
.	ds ae ae
.	ds Ae AE
.	ds oe oe
.	ds Oe OE
.\}
.rm #[ #] #H #V #F C
END

$indent = 0;

while (<>) {
    if ($cutting) {
	next unless /^=/;
	$cutting = 0;
    }
    chomp;

    # Translate verbatim paragraph

    if (/^\s/) {
	@lines = split(/\n/);
	for (@lines) {
	    1 while s
		{^( [^\t]* ) \t ( \t* ) }
		{ $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
	    s/\\/\\e/g;
	    s/\A/\\&/s;
	}
	$lines = @lines;
	makespace() unless $verbatim++;
	print ".Vb $lines\n";
	print join("\n", @lines), "\n";
	print ".Ve\n";
	$needspace = 0;
	next;
    }

    $verbatim = 0;

    # check for things that'll hosed our noremap scheme; affects $_
    init_noremap();

    if (!/^=item/) {

	# trofficate backslashes; must do it before what happens below
	s/\\/noremap('\\e')/ge;

	# first hide the escapes in case we need to 
	# intuit something and get it wrong due to fmting

	s/([A-Z]<[^<>]*>)/noremap($1)/ge;

	# func() is a reference to a perl function
	s{
	    \b
	    (
		[:\w]+ \(\)
	    )
	} {I<$1>}gx;

	# func(n) is a reference to a man page
	s{
	    (\w+)
	    (
		\(
		    [^\s,\051]+
		\)
	    )
	} {I<$1>\\|$2}gx;

	# convert simple variable references
	s/(\s+)([\$\@%][\w:]+)/${1}C<$2>/g;

	if (m{ (
		    [\-\w]+
		    \(
			[^\051]*?
			[\@\$,]
			[^\051]*?
		    \)
		)
	    }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/) 
	{
	    warn "``$1'' should be a [LCI]<$1> ref";
	} 

	while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
	    warn "``$1'' should be [CB]<$1> ref";
	} 

	# put it back so we get the <> processed again;
	clear_noremap(0); # 0 means leave the E's

    } else {
	# trofficate backslashes
	s/\\/noremap('\\e')/ge;

    } 

    # need to hide E<> first; they're processed in clear_noremap
    s/(E<[^<>]+>)/noremap($1)/ge;


    $maxnest = 10;
    while ($maxnest-- && /[A-Z]</) {

	# can't do C font here
	s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;

	# files and filelike refs in italics
	s/F<([^<>]*)>/I<$1>/g;

	# no break -- usually we want C<> for this
	s/S<([^<>]*)>/nobreak($1)/eg;

	# LREF: a manpage(3f) 
	s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;

	# LREF: an =item on another manpage
	s{
	    L<
		([^/]+)
		/
		(
		    [:\w]+
		    (\(\))?
		)
	    >
	} {the C<$2> entry in the I<$1> manpage}gx;

	# LREF: an =item on this manpage
	s{
	   ((?:
	    L<
		/
		(
		    [:\w]+
		    (\(\))?
		)
	    >
	    (,?\s+(and\s+)?)?
	  )+)
	} { internal_lrefs($1) }gex;

	# LREF: a =head2 (head1?), maybe on a manpage, maybe right here
	# the "func" can disambiguate
	s{
	    L<
		(?:
		    ([a-zA-Z]\S+?) / 
		)?
		"?(.*?)"?
	    >
	}{
	    do {
		$1 	# if no $1, assume it means on this page.
		    ?  "the section on I<$2> in the I<$1> manpage"
		    :  "the section on I<$2>"
	    } 
	}gex;

	s/Z<>/\\&/g;

	# comes last because not subject to reprocessing
	s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
    }

    if (s/^=//) {
	$needspace = 0;		# Assume this.

	s/\n/ /g;

	($Cmd, $_) = split(' ', $_, 2);

	if (defined $_) {
	    &escapes;
	    s/"/""/g;
	}

	clear_noremap(1);

	if ($Cmd eq 'cut') {
	    $cutting = 1;
	}
	elsif ($Cmd eq 'head1') {
	    print qq{.SH "$_"\n}
	}
	elsif ($Cmd eq 'head2') {
	    print qq{.Sh "$_"\n}
	}
	elsif ($Cmd eq 'over') {
	    push(@indent,$indent);
	    $indent = $_ + 0;
	}
	elsif ($Cmd eq 'back') {
	    $indent = pop(@indent);
	    warn "Unmatched =back\n" unless defined $indent;
	    $needspace = 1;
	}
	elsif ($Cmd eq 'item') {
	    s/^\*( |$)/\\(bu$1/g;
	    print STDOUT qq{.Ip "$_" $indent\n};
	}
	else {
	    warn "Unrecognized directive: $Cmd\n";
	}
    }
    else {
	if ($needspace) {
	    &makespace;
	}
	&escapes;
	clear_noremap(1);
	print $_, "\n";
	$needspace = 1;
    }
}

print <<"END";

.rn }` ''
END

#########################################################################

sub nobreak {
    my $string = shift;
    $string =~ s/ /\\ /g;
    $string;
}

sub escapes {

    # translate the minus in foo-bar into foo\-bar for roff
    s/([^0-9a-z-])-([^-])/$1\\-$2/g;

    # make -- into the string version \*(-- (defined above)
    s/\b--\b/\\*(--/g;
    s/"--([^"])/"\\*(--$1/g;  # should be a better way
    s/([^"])--"/$1\\*(--"/g;

    # fix up quotes; this is somewhat tricky
    if (!/""/) {
	s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge;
	s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
    }

    #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
    #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
    

    # make sure that func() keeps a bit a space tween the parens
    ### s/\b\(\)/\\|()/g;
    ### s/\b\(\)/(\\|)/g;

    # make C++ into \*C+, which is a squinched version (defined above)
    s/\bC\+\+/\\*(C+/g;

    # make double underbars have a little tiny space between them
    s/__/_\\|_/g;

    # PI goes to \*(-- (defined above)
    s/\bPI\b/noremap('\\*(PI')/ge;

    # make all caps a teeny bit smaller, but don't muck with embedded code literals
    my $hidCFont = font('C');
    if ($Cmd !~ /^head1/) { # SH already makes smaller
	# /g isn't enough; 1 while or we'll be off

#	1 while s{
#	    (?!$hidCFont)(..|^.|^)
#	    \b
#	    (
#		[A-Z][\/A-Z+:\-\d_$.]+
#	    )
#	    (s?) 		
#	    \b
#	} {$1\\s-1$2\\s0}gmox;

	1 while s{
	    (?!$hidCFont)(..|^.|^)
	    (
		\b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
	    )
	} { 
	    $1 . noremap( '\\s-1' .  $2 . '\\s0' )
	}egmox;

    }
}

# make troff just be normal, but make small nroff get quoted
# decided to just put the quotes in the text; sigh;
sub ccvt {
     local($_,$prev) = @_;
     if ( /^\W+$/ && !/^\$./ ) {
 	($prev && "\n") . noremap(qq{.CQ $_ \n\\&});
 	# what about $" ?
     } else {
 	noremap(qq{${CFont_embed}$_\\fR});
     } 
    noremap(qq{.CQ "$_" \n\\&});
} 

sub makespace {
    if ($indent) {
	print ".Sp\n";
    }
    else {
	print ".PP\n";
    }
}

sub font {
    local($font) = shift;
    return '\\f' . noremap($font);
} 

sub noremap {
    local($thing_to_hide) = shift;
    $thing_to_hide =~ tr/\000-\177/\200-\377/;
    return $thing_to_hide;
} 

sub init_noremap {
    if ( /[\200-\377]/ ) {
	warn "hit bit char in input stream";
    } 
} 

sub clear_noremap {
    my $ready_to_print = $_[0];

    tr/\200-\377/\000-\177/;

    # trofficate backslashes
    # s/(?!\\e)(?:..|^.|^)\\/\\e/g;

    # now for the E<>s, which have been hidden until now
    # otherwise the interative \w<> processing would have
    # been hosed by the E<gt>
    s {
	    E<	
	    ( [A-Za-z]+ )	
	    >	
    } { 
	 do {	
	     exists $HTML_Escapes{$1}
		? do { $HTML_Escapes{$1} }
		: do {
		    warn "Unknown escape: $& in $_";
		    "E<$1>";
		} 
	 } 
    }egx if $ready_to_print;
} 

sub internal_lrefs {
    local($_) = shift;

    s{L</([^>]+)>}{$1}g;
    my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
    my $retstr = "the ";
    my $i;
    for ($i = 0; $i <= $#items; $i++) {
	$retstr .= "C<$items[$i]>";
	$retstr .= ", " if @items > 2 && $i != $#items;
	$retstr .= " and " if $i+2 == @items;
    } 

    $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
	    .  " elsewhere in this document";

    return $retstr;

} 

BEGIN {
%HTML_Escapes = (
    'amp'	=>	'&',	#   ampersand
    'lt'	=>	'<',	#   left chevron, less-than
    'gt'	=>	'>',	#   right chevron, greater-than
    'quot'	=>	'"',	#   double quote

    "Aacute"	=>	"A\\*'",	#   capital A, acute accent
    "aacute"	=>	"a\\*'",	#   small a, acute accent
    "Acirc"	=>	"A\\*^",	#   capital A, circumflex accent
    "acirc"	=>	"a\\*^",	#   small a, circumflex accent
    "AElig"	=>	'\*(AE',	#   capital AE diphthong (ligature)
    "aelig"	=>	'\*(ae',	#   small ae diphthong (ligature)
    "Agrave"	=>	"A\\*`",	#   capital A, grave accent
    "agrave"	=>	"A\\*`",	#   small a, grave accent
    "Aring"	=>	'A\\*o',	#   capital A, ring
    "aring"	=>	'a\\*o',	#   small a, ring
    "Atilde"	=>	'A\\*~',	#   capital A, tilde
    "atilde"	=>	'a\\*~',	#   small a, tilde
    "Auml"	=>	'A\\*:',	#   capital A, dieresis or umlaut mark
    "auml"	=>	'a\\*:',	#   small a, dieresis or umlaut mark
    "Ccedil"	=>	'C\\*,',	#   capital C, cedilla
    "ccedil"	=>	'c\\*,',	#   small c, cedilla
    "Eacute"	=>	"E\\*'",	#   capital E, acute accent
    "eacute"	=>	"e\\*'",	#   small e, acute accent
    "Ecirc"	=>	"E\\*^",	#   capital E, circumflex accent
    "ecirc"	=>	"e\\*^",	#   small e, circumflex accent
    "Egrave"	=>	"E\\*`",	#   capital E, grave accent
    "egrave"	=>	"e\\*`",	#   small e, grave accent
    "ETH"	=>	'\\*(D-',	#   capital Eth, Icelandic
    "eth"	=>	'\\*(d-',	#   small eth, Icelandic
    "Euml"	=>	"E\\*:",	#   capital E, dieresis or umlaut mark
    "euml"	=>	"e\\*:",	#   small e, dieresis or umlaut mark
    "Iacute"	=>	"I\\*'",	#   capital I, acute accent
    "iacute"	=>	"i\\*'",	#   small i, acute accent
    "Icirc"	=>	"I\\*^",	#   capital I, circumflex accent
    "icirc"	=>	"i\\*^",	#   small i, circumflex accent
    "Igrave"	=>	"I\\*`",	#   capital I, grave accent
    "igrave"	=>	"i\\*`",	#   small i, grave accent
    "Iuml"	=>	"I\\*:",	#   capital I, dieresis or umlaut mark
    "iuml"	=>	"i\\*:",	#   small i, dieresis or umlaut mark
    "Ntilde"	=>	'N\*~',		#   capital N, tilde
    "ntilde"	=>	'n\*~',		#   small n, tilde
    "Oacute"	=>	"O\\*'",	#   capital O, acute accent
    "oacute"	=>	"o\\*'",	#   small o, acute accent
    "Ocirc"	=>	"O\\*^",	#   capital O, circumflex accent
    "ocirc"	=>	"o\\*^",	#   small o, circumflex accent
    "Ograve"	=>	"O\\*`",	#   capital O, grave accent
    "ograve"	=>	"o\\*`",	#   small o, grave accent
    "Oslash"	=>	"O\\*/",	#   capital O, slash
    "oslash"	=>	"o\\*/",	#   small o, slash
    "Otilde"	=>	"O\\*~",	#   capital O, tilde
    "otilde"	=>	"o\\*~",	#   small o, tilde
    "Ouml"	=>	"O\\*:",	#   capital O, dieresis or umlaut mark
    "ouml"	=>	"o\\*:",	#   small o, dieresis or umlaut mark
    "szlig"	=>	'\*8',		#   small sharp s, German (sz ligature)
    "THORN"	=>	'\\*(Th',	#   capital THORN, Icelandic
    "thorn"	=>	'\\*(th',,	#   small thorn, Icelandic
    "Uacute"	=>	"U\\*'",	#   capital U, acute accent
    "uacute"	=>	"u\\*'",	#   small u, acute accent
    "Ucirc"	=>	"U\\*^",	#   capital U, circumflex accent
    "ucirc"	=>	"u\\*^",	#   small u, circumflex accent
    "Ugrave"	=>	"U\\*`",	#   capital U, grave accent
    "ugrave"	=>	"u\\*`",	#   small u, grave accent
    "Uuml"	=>	"U\\*:",	#   capital U, dieresis or umlaut mark
    "uuml"	=>	"u\\*:",	#   small u, dieresis or umlaut mark
    "Yacute"	=>	"Y\\*'",	#   capital Y, acute accent
    "yacute"	=>	"y\\*'",	#   small y, acute accent
    "yuml"	=>	"y\\*:",	#   small y, dieresis or umlaut mark
);
}
!NO!SUBS!
chmod 755 pod2man
$eunicefix pod2man
Commit	Line	Data
5d94fbed AD	1	case $CONFIG in
	2	'')
	3	if test -f config.sh; then TOP=.;
	4	elif test -f ../config.sh; then TOP=..;
	5	elif test -f ../../config.sh; then TOP=../..;
	6	elif test -f ../../../config.sh; then TOP=../../..;
	7	elif test -f ../../../../config.sh; then TOP=../../../..;
	8	else
	9	echo "Can't find config.sh."; exit 1
	10	fi
	11	. $TOP/config.sh
	12	;;
	13	esac
	14	case "$0" in
	15	/) cd `expr X$0 : 'X\(.*\)/'` ;;
	16	esac
	17	echo "Extracting pod/pod2man (with variable substitutions)"
	18	rm -f pod2man
	19	$spitshell >pod2man <<!GROK!THIS!
	20	#!$bin/perl
	21	eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
	22	if \$running_under_some_shell;
	23	!GROK!THIS!
	24
	25	$spitshell >>pod2man <<'!NO!SUBS!'
a0d0e21e LW	26
	27	$/ = "";
	28	$cutting = 1;
	29
	30	$CFont = 'CW';
	31	if ($ARGV[0] =~ s/-fc(.*)//) {
	32	shift;
	33	$CFont = $1 \|\| shift;
	34	}
	35
	36	if (length($CFont) == 2) {
	37	$CFont_embed = "\\f($CFont";
	38	}
	39	elsif (length($CFont) == 1) {
	40	$CFont_embed = "\\f$CFont";
	41	}
	42	else {
	43	die "Roff font should be 1 or 2 chars, not `$CFont_embed'";
	44	}
	45
	46	$name = @ARGV ? $ARGV[0] : "something";
	47	$name =~ s/\..*//;
	48
	49	print <<"END";
	50	.rn '' }`
	51	''' \$RCSfile\$\$Revision\$\$Date\$
	52	'''
	53	''' \$Log\$
	54	'''
	55	.de Sh
	56	.br
	57	.if t .Sp
	58	.ne 5
	59	.PP
	60	\\fB\\\\\$1\\fR
	61	.PP
	62	..
	63	.de Sp
	64	.if t .sp .5v
	65	.if n .sp
	66	..
	67	.de Ip
	68	.br
	69	.ie \\\\n(.\$>=3 .ne \\\\\$3
	70	.el .ne 3
	71	.IP "\\\\\$1" \\\\\$2
	72	..
	73	.de Vb
	74	.ft $CFont
	75	.nf
	76	.ne \\\\\$1
	77	..
	78	.de Ve
	79	.ft R
	80
	81	.fi
	82	..
	83	'''
	84	'''
	85	''' Set up \\*(-- to give an unbreakable dash;
	86	''' string Tr holds user defined translation string.
	87	''' Bell System Logo is used as a dummy character.
	88	'''
	89	.tr \\(W-\|\\(bv\\(Tr
90	.ie n \\{\\
91	.ds -- \\(*W-
92	.if (\\n(.H=4u)&(1m=24u) .ds -- \\(W\\h'-12u'\\(W\\h'-12u'-\\" diablo 10 pitch
93	.if (\\n(.H=4u)&(1m=20u) .ds -- \\(W\\h'-12u'\\(W\\h'-8u'-\\" diablo 12 pitch
94	.ds L" ""
95	.ds R" ""
96	.ds L' '
97	.ds R' '
98	'br\\}
99	.el\\{\\
100	.ds -- \\(em\\\|
101	.tr \\*(Tr
102	.ds L" ``
103	.ds R" ''
104	.ds L' `
105	.ds R' '
106	.if t .ds PI \\(*p
107	.if n .ds PI PI
108	'br\\}
109	.TH \U$name\E 1 "\\*(RP"
110	.UC
111	END
112
113	print <<'END';
114	.if n .hy 0
115	.if n .na
116	.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
117	.de CQ \" put $1 in typewriter font
118	END
119	print ".ft $CFont\n";
120	print <<'END';
121	'if n "\c
748a9306 LW	122	'if t \\&\\$1\c
748a9306 LW	123	'if n \\&\\$1\c
a0d0e21e	124	'if n \&"
748a9306	125	\\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
a0d0e21e LW	126	'.ft R
	127	..
	128	.\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
	129	. \" AM - accent mark definitions
	130	.bd S B 3
	131	. \" fudge factors for nroff and troff
	132	.if n \{\
	133	. ds #H 0
	134	. ds #V .8m
	135	. ds #F .3m
	136	. ds #[ \f1
	137	. ds #] \fP
	138	.\}
	139	.if t \{\
748a9306	140	. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
a0d0e21e LW	141	. ds #V .6m
	142	. ds #F 0
	143	. ds #[ \&
	144	. ds #] \&
	145	.\}
	146	. \" simple accents for nroff and troff
	147	.if n \{\
	148	. ds ' \&
	149	. ds ` \&
	150	. ds ^ \&
	151	. ds , \&
	152	. ds ~ ~
	153	. ds ? ?
	154	. ds ! !
	155	. ds /
	156	. ds q
	157	.\}
	158	.if t \{\
748a9306 LW	159	. ds ' \\k:\h'-(\\n(.wu8/10-\(#H)'\'\h"\|\\n:u"
	160	. ds ` \\k:\h'-(\\n(.wu8/10-\(#H)'\`\h'\|\\n:u'
	161	. ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'^\h'\|\\n:u'
	162	. ds , \\k:\h'-(\\n(.wu*8/10)',\h'\|\\n:u'
	163	. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'\|\\n:u'
a0d0e21e LW	164	. ds ? \s-2c\h'-\w'c'u7/10'\u\h'\(#H'\zi\d\s+2\h'\w'c'u*8/10'
a0d0e21e LW	165	. ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
748a9306	166	. ds / \\k:\h'-(\\n(.wu8/10-\(#H)'\z\(sl\h'\|\\n:u'
a0d0e21e LW	167	. ds q o\h'-\w'o'u8/10'\s-4\v'.4m'\z\(i\v'-.4m'\s+4\h'\w'o'u*8/10'
	168	.\}
	169	. \" troff and (daisy-wheel) nroff accents
748a9306	170	.ds : \\k:\h'-(\\n(.wu8/10-\(#H+.1m+\(#F)'\v'-\(#V'\z.\h'.2m+\(#F'.\h'\|\\n:u'\v'\(#V'
a0d0e21e	171	.ds 8 \h'\(#H'\(b\h'-\*(#H'
748a9306 LW	172	.ds v \\k:\h'-(\\n(.wu9/10-\(#H)'\v'-\(#V'\(#[\s-4v\s0\v'\(#V'\h'\|\\n:u'\(#]
	173	.ds _ \\k:\h'-(\\n(.wu9/10-\(#H+(\(#F2/3))'\v'-.4m'\z\(hy\v'.4m'\h'\|\\n:u'
	174	.ds . \\k:\h'-(\\n(.wu8/10)'\v'\(#V4/10'\z.\v'-\(#V*4/10'\h'\|\\n:u'
a0d0e21e	175	.ds 3 \(#[\v'.2m'\s-2\&3\s0\v'-.2m'\(#]
748a9306	176	.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\(#H)/2u'\v'-.3n'\(#[\z\(de\v'.3n'\h'\|\\n:u'\*(#]
a0d0e21e	177	.ds d- \h'\(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\(#H'
748a9306	178	.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'\|\\n:u'
a0d0e21e LW	179	.ds th \(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u2/3)'\s-1o\s+1\*(#]
	180	.ds Th \(#[\s+2I\s-2\h'-\w'I'u3/5'\v'-.3m'o\v'.3m'\*(#]
	181	.ds ae a\h'-(\w'a'u*4/10)'e
	182	.ds Ae A\h'-(\w'A'u*4/10)'E
	183	.ds oe o\h'-(\w'o'u*4/10)'e
	184	.ds Oe O\h'-(\w'O'u*4/10)'E
	185	. \" corrections for vroff
748a9306 LW	186	.if v .ds ~ \\k:\h'-(\\n(.wu9/10-\(#H)'\s-2\u~\d\s+2\h'\|\\n:u'
748a9306 LW	187	.if v .ds ^ \\k:\h'-(\\n(.wu10/11-\(#H)'\v'-.4m'^\v'.4m'\h'\|\\n:u'
a0d0e21e LW	188	. \" for low resolution devices (crt and lpr)
	189	.if \n(.H>23 .if \n(.V>19 \
	190	\{\
	191	. ds : e
	192	. ds 8 ss
	193	. ds v \h'-1'\o'\(aa\(ga'
	194	. ds _ \h'-1'^
	195	. ds . \h'-1'.
	196	. ds 3 3
	197	. ds o a
	198	. ds d- d\h'-1'\(ga
	199	. ds D- D\h'-1'\(hy
	200	. ds th \o'bp'
	201	. ds Th \o'LP'
	202	. ds ae ae
	203	. ds Ae AE
	204	. ds oe oe
	205	. ds Oe OE
	206	.\}
	207	.rm #[ #] #H #V #F C
	208	END
	209
	210	$indent = 0;
	211
	212	while (<>) {
	213	if ($cutting) {
	214	next unless /^=/;
	215	$cutting = 0;
	216	}
	217	chomp;
	218
	219	# Translate verbatim paragraph
	220
	221	if (/^\s/) {
	222	@lines = split(/\n/);
	223	for (@lines) {
	224	1 while s
	225	{^( [^\t]* ) \t ( \t* ) }
	226	{ $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
	227	s/\\/\\e/g;
	228	s/\A/\\&/s;
	229	}
	230	$lines = @lines;
	231	makespace() unless $verbatim++;
	232	print ".Vb $lines\n";
	233	print join("\n", @lines), "\n";
	234	print ".Ve\n";
	235	$needspace = 0;
	236	next;
	237	}
	238
	239	$verbatim = 0;
	240
	241	# check for things that'll hosed our noremap scheme; affects $_
	242	init_noremap();
	243
	244	if (!/^=item/) {
	245
	246	# trofficate backslashes; must do it before what happens below
	247	s/\\/noremap('\\e')/ge;
	248
	249	# first hide the escapes in case we need to
	250	# intuit something and get it wrong due to fmting
	251
252	s/([A-Z]<[^<>]*>)/noremap($1)/ge;
253
254	# func() is a reference to a perl function
255	s{
256	\b
257	(
258	[:\w]+ \(\)
259	)
260	} {I<$1>}gx;
261
262	# func(n) is a reference to a man page
263	s{
264	(\w+)
265	(
266	\(
267	[^\s,\051]+
268	\)
269	)
270	} {I<$1>\\\|$2}gx;
271
272	# convert simple variable references
748a9306	273	s/(\s+)([\$\@%][\w:]+)/${1}C<$2>/g;
a0d0e21e LW	274
	275	if (m{ (
	276	[\-\w]+
	277	\(
	278	[^\051]*?
	279	[\@\$,]
	280	[^\051]*?
	281	\)
	282	)
	283	}x && $` !~ /([LCI]<[^<>]*\|-)$/ && !/^=\w/)
	284	{
	285	warn "``$1'' should be a [LCI]<$1> ref";
	286	}
	287
	288	while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
	289	warn "``$1'' should be [CB]<$1> ref";
	290	}
	291
	292	# put it back so we get the <> processed again;
	293	clear_noremap(0); # 0 means leave the E's
	294
	295	} else {
	296	# trofficate backslashes
	297	s/\\/noremap('\\e')/ge;
	298
	299	}
	300
	301	# need to hide E<> first; they're processed in clear_noremap
	302	s/(E<[^<>]+>)/noremap($1)/ge;
	303
	304
	305	$maxnest = 10;
	306	while ($maxnest-- && /[A-Z]</) {
	307
	308	# can't do C font here
	309	s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
	310
	311	# files and filelike refs in italics
	312	s/F<([^<>]*)>/I<$1>/g;
	313
	314	# no break -- usually we want C<> for this
	315	s/S<([^<>]*)>/nobreak($1)/eg;
	316
	317	# LREF: a manpage(3f)
	318	s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
	319
	320	# LREF: an =item on another manpage
	321	s{
	322	L<
	323	([^/]+)
	324	/
	325	(
	326	[:\w]+
	327	(\(\))?
	328	)
	329	>
	330	} {the C<$2> entry in the I<$1> manpage}gx;
	331
	332	# LREF: an =item on this manpage
	333	s{
	334	((?:
	335	L<
	336	/
	337	(
338	[:\w]+
339	(\(\))?
340	)
341	>
342	(,?\s+(and\s+)?)?
343	)+)
344	} { internal_lrefs($1) }gex;
345
346	# LREF: a =head2 (head1?), maybe on a manpage, maybe right here
347	# the "func" can disambiguate
348	s{
349	L<
350	(?:
351	([a-zA-Z]\S+?) /
352	)?
353	"?(.*?)"?
354	>
355	}{
356	do {
357	$1 # if no $1, assume it means on this page.
358	? "the section on I<$2> in the I<$1> manpage"
359	: "the section on I<$2>"
360	}
361	}gex;
362
363	s/Z<>/\\&/g;
364
365	# comes last because not subject to reprocessing
366	s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
367	}
368
369	if (s/^=//) {
370	$needspace = 0; # Assume this.
371
372	s/\n/ /g;
373
374	($Cmd, $_) = split(' ', $_, 2);
375
376	if (defined $_) {
377	&escapes;
378	s/"/""/g;
379	}
380
381	clear_noremap(1);
382
383	if ($Cmd eq 'cut') {
384	$cutting = 1;
385	}
386	elsif ($Cmd eq 'head1') {
387	print qq{.SH "$_"\n}
388	}
389	elsif ($Cmd eq 'head2') {
390	print qq{.Sh "$_"\n}
391	}
392	elsif ($Cmd eq 'over') {
393	push(@indent,$indent);
394	$indent = $_ + 0;
395	}
396	elsif ($Cmd eq 'back') {
397	$indent = pop(@indent);
398	warn "Unmatched =back\n" unless defined $indent;
399	$needspace = 1;
400	}
401	elsif ($Cmd eq 'item') {
402	s/^\*( \|$)/\\(bu$1/g;
403	print STDOUT qq{.Ip "$_" $indent\n};
404	}
405	else {
406	warn "Unrecognized directive: $Cmd\n";
407	}
408	}
409	else {
410	if ($needspace) {
411	&makespace;
412	}
413	&escapes;
414	clear_noremap(1);
415	print $_, "\n";
416	$needspace = 1;
417	}
418	}
419
420	print <<"END";
421
422	.rn }` ''
423	END
424
425	#########################################################################
426
427	sub nobreak {
428	my $string = shift;
429	$string =~ s/ /\\ /g;
430	$string;
431	}
432
433	sub escapes {
434
435	# translate the minus in foo-bar into foo\-bar for roff
436	s/([^0-9a-z-])-([^-])/$1\\-$2/g;
437
438	# make -- into the string version \*(-- (defined above)
439	s/\b--\b/\\*(--/g;
440	s/"--([^"])/"\\*(--$1/g; # should be a better way
441	s/([^"])--"/$1\\*(--"/g;
442
443	# fix up quotes; this is somewhat tricky
444	if (!/""/) {
445	s/(^\|\s)(['"])/noremap("$1\\*(L$2")/ge;
446	s/(['"])($\|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
447	}
448
449	#s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
450	#s/(?:(?!")(?:.)--(?:"))\|(?:(?:")--(?!")(?:.))/\\*(--/g;
451
452
453	# make sure that func() keeps a bit a space tween the parens
454	### s/\b\(\)/\\\|()/g;
455	### s/\b\(\)/(\\\|)/g;
456
457	# make C++ into \*C+, which is a squinched version (defined above)
458	s/\bC\+\+/\\*(C+/g;
459
460	# make double underbars have a little tiny space between them
461	s/__/_\\\|_/g;
462
463	# PI goes to \*(-- (defined above)
464	s/\bPI\b/noremap('\\*(PI')/ge;
465
466	# make all caps a teeny bit smaller, but don't muck with embedded code literals
467	my $hidCFont = font('C');
468	if ($Cmd !~ /^head1/) { # SH already makes smaller
469	# /g isn't enough; 1 while or we'll be off
470
471	# 1 while s{
472	# (?!$hidCFont)(..\|^.\|^)
473	# \b
474	# (
475	# [A-Z][\/A-Z+:\-\d_$.]+
476	# )
477	# (s?)
478	# \b
479	# } {$1\\s-1$2\\s0}gmox;
480
481	1 while s{
482	(?!$hidCFont)(..\|^.\|^)
483	(
484	\b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
485	)
486	} {
487	$1 . noremap( '\\s-1' . $2 . '\\s0' )
488	}egmox;
489
490	}
491	}
492
493	# make troff just be normal, but make small nroff get quoted
494	# decided to just put the quotes in the text; sigh;
495	sub ccvt {
496	local($_,$prev) = @_;
497	if ( /^\W+$/ && !/^\$./ ) {
498	($prev && "\n") . noremap(qq{.CQ $_ \n\\&});
499	# what about $" ?
500	} else {
501	noremap(qq{${CFont_embed}$_\\fR});
502	}
503	noremap(qq{.CQ "$_" \n\\&});
504	}
505
506	sub makespace {
507	if ($indent) {
508	print ".Sp\n";
509	}
510	else {
511	print ".PP\n";
512	}
513	}
514
515	sub font {
516	local($font) = shift;
517	return '\\f' . noremap($font);
518	}
519
520	sub noremap {
521	local($thing_to_hide) = shift;
522	$thing_to_hide =~ tr/\000-\177/\200-\377/;
523	return $thing_to_hide;
524	}
525
526	sub init_noremap {
527	if ( /[\200-\377]/ ) {
528	warn "hit bit char in input stream";
529	}
530	}
531
532	sub clear_noremap {
533	my $ready_to_print = $_[0];
534
535	tr/\200-\377/\000-\177/;
536
537	# trofficate backslashes
538	# s/(?!\\e)(?:..\|^.\|^)\\/\\e/g;
539
540	# now for the E<>s, which have been hidden until now
541	# otherwise the interative \w<> processing would have
542	# been hosed by the E<gt>
543	s {
544	E<
545	( [A-Za-z]+ )
546	>
547	} {
548	do {
549	exists $HTML_Escapes{$1}
550	? do { $HTML_Escapes{$1} }
551	: do {
552	warn "Unknown escape: $& in $_";
553	"E<$1>";
554	}
555	}
556	}egx if $ready_to_print;
557	}
558
559	sub internal_lrefs {
560	local($_) = shift;
561
562	s{L</([^>]+)>}{$1}g;
563	my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
564	my $retstr = "the ";
565	my $i;
566	for ($i = 0; $i <= $#items; $i++) {
567	$retstr .= "C<$items[$i]>";
568	$retstr .= ", " if @items > 2 && $i != $#items;
569	$retstr .= " and " if $i+2 == @items;
570	}
571
572	$retstr .= " entr" . ( @items > 1 ? "ies" : "y" )
573	. " elsewhere in this document";
574
575	return $retstr;
576
577	}
578
579	BEGIN {
580	%HTML_Escapes = (
581	'amp' => '&', # ampersand
582	'lt' => '<', # left chevron, less-than
583	'gt' => '>', # right chevron, greater-than
584	'quot' => '"', # double quote
585
586	"Aacute" => "A\\*'", # capital A, acute accent
587	"aacute" => "a\\*'", # small a, acute accent
588	"Acirc" => "A\\*^", # capital A, circumflex accent
589	"acirc" => "a\\*^", # small a, circumflex accent
590	"AElig" => '\*(AE', # capital AE diphthong (ligature)
591	"aelig" => '\*(ae', # small ae diphthong (ligature)
592	"Agrave" => "A\\*`", # capital A, grave accent
593	"agrave" => "A\\*`", # small a, grave accent
594	"Aring" => 'A\\*o', # capital A, ring
595	"aring" => 'a\\*o', # small a, ring
596	"Atilde" => 'A\\*~', # capital A, tilde
597	"atilde" => 'a\\*~', # small a, tilde
598	"Auml" => 'A\\*:', # capital A, dieresis or umlaut mark
599	"auml" => 'a\\*:', # small a, dieresis or umlaut mark
600	"Ccedil" => 'C\\*,', # capital C, cedilla
601	"ccedil" => 'c\\*,', # small c, cedilla
602	"Eacute" => "E\\*'", # capital E, acute accent
603	"eacute" => "e\\*'", # small e, acute accent
604	"Ecirc" => "E\\*^", # capital E, circumflex accent
605	"ecirc" => "e\\*^", # small e, circumflex accent
606	"Egrave" => "E\\*`", # capital E, grave accent
607	"egrave" => "e\\*`", # small e, grave accent
608	"ETH" => '\\*(D-', # capital Eth, Icelandic
609	"eth" => '\\*(d-', # small eth, Icelandic
610	"Euml" => "E\\*:", # capital E, dieresis or umlaut mark
611	"euml" => "e\\*:", # small e, dieresis or umlaut mark
612	"Iacute" => "I\\*'", # capital I, acute accent
613	"iacute" => "i\\*'", # small i, acute accent
614	"Icirc" => "I\\*^", # capital I, circumflex accent
615	"icirc" => "i\\*^", # small i, circumflex accent
616	"Igrave" => "I\\*`", # capital I, grave accent
617	"igrave" => "i\\*`", # small i, grave accent
618	"Iuml" => "I\\*:", # capital I, dieresis or umlaut mark
619	"iuml" => "i\\*:", # small i, dieresis or umlaut mark
620	"Ntilde" => 'N\*~', # capital N, tilde
621	"ntilde" => 'n\*~', # small n, tilde
622	"Oacute" => "O\\*'", # capital O, acute accent
623	"oacute" => "o\\*'", # small o, acute accent
624	"Ocirc" => "O\\*^", # capital O, circumflex accent
625	"ocirc" => "o\\*^", # small o, circumflex accent
626	"Ograve" => "O\\*`", # capital O, grave accent
627	"ograve" => "o\\*`", # small o, grave accent
628	"Oslash" => "O\\*/", # capital O, slash
629	"oslash" => "o\\*/", # small o, slash
630	"Otilde" => "O\\*~", # capital O, tilde
631	"otilde" => "o\\*~", # small o, tilde
632	"Ouml" => "O\\*:", # capital O, dieresis or umlaut mark
633	"ouml" => "o\\*:", # small o, dieresis or umlaut mark
634	"szlig" => '\*8', # small sharp s, German (sz ligature)
635	"THORN" => '\\*(Th', # capital THORN, Icelandic
636	"thorn" => '\\*(th',, # small thorn, Icelandic
637	"Uacute" => "U\\*'", # capital U, acute accent
638	"uacute" => "u\\*'", # small u, acute accent
639	"Ucirc" => "U\\*^", # capital U, circumflex accent
640	"ucirc" => "u\\*^", # small u, circumflex accent
641	"Ugrave" => "U\\*`", # capital U, grave accent
642	"ugrave" => "u\\*`", # small u, grave accent
643	"Uuml" => "U\\*:", # capital U, dieresis or umlaut mark
644	"uuml" => "u\\*:", # small u, dieresis or umlaut mark
645	"Yacute" => "Y\\*'", # capital Y, acute accent
646	"yacute" => "y\\*'", # small y, acute accent
647	"yuml" => "y\\*:", # small y, dieresis or umlaut mark
648	);
649	}
5d94fbed AD	650	!NO!SUBS!
	651	chmod 755 pod2man
	652	$eunicefix pod2man