# -*-perl-*-

#
# grdoc_parsedo
#
# Actually does the parsing stuff!  Basically a list of subroutines
# called by grdoc_parse.

# $Id: grdoc_parsedo,v 1.16 1996/04/19 15:29:50 pwalker Exp $


sub
do_seealso
{
    local ($region, $routine) = @_;
    local ($value, $what, $calltree, $endtree);
    $ph = 0;
    $what = "";
    if ($routine) {
	$calltree = "";  $endcall = "";
    } else {
	$calltree = "";  $endcall = "";
    }
    while ($region =~ m:\@includes:) {
	if (!$ph) {
	    print OUT "<br><b>";
	    print OUT "Includes $calltree$endcall</b>\n";
	    print OUT "<div align=right>";
	    print OUT "<table width=95% cellspacing=0 cellpadding=0>\n";
	    $ph = 1;
	}
	($region, $value) = &get_keyword($region, "includes");
	print OUT &xref_list($value, $what);
    }
    print OUT "</table></div>" if $ph;

    $ph = 0;
    $what = "";
    while ($region =~ m:\@calls:) {
	if (!$ph) {
	    print OUT "<br><b>";
	    print OUT "Calls $calltree$endcall</b>\n";
	    print OUT "<div align=right>";
	    print OUT "<table width=95% cellspacing=0 cellpadding=0>\n";
	    $ph = 1;
	}
	($region, $value) = &get_keyword($region, "calls");
	if ($routine) {
	    $routineCalls{$routine} = "$routineCalls{$routine} $value";
	}
	print OUT &xref_list($value, $what);
    }
    print OUT "</table></div>\n" if ($ph);
    $ph = 0;
    while ($region =~ m:\@calledby:) {
	if (!$ph) {
	    print OUT "<br><b>Called By $calltree$endcall</b>\n";
	    print OUT "<div align=right>";
	    print OUT "<table width=95% cellspacing=0 cellpadding=0>\n";
	    $ph = 1;
	}
	($region, $value) = &get_keyword($region, "calledby");
	if ($routine) {
	    $routineCalledby{$routine} = "$routineCalledby{$routine} $value";
	}
	print OUT &xref_list($value, $what);
    }
    print OUT "</table></div>\n" if ($ph);
    $ph = 0;
    while ($region =~ m:\@(see\S+):) {
	$thekw = $1;
	if (!$ph) {
	    print OUT "<br><b>See Also</b>\n";
	    print OUT "<div align=right>";
	    print OUT "<table width=95% cellspacing=0 cellpadding=0>\n";

	    $ph = 1;
	}
	if ($thekw =~ m/file/i) {
	    $what = "File: ";
	} elsif ($thekw =~ m/header/i) {
	    $what = "Header: "; 
	} elsif ($thekw =~ m/routine/i) {
	    $what = "Routine: ";
	} else {
	    print STDERR "WARNING: Unrecognized XREF Type @$thekw\n";
	    $what = "Unknown: ";
	}
	($region, $value) = &get_keyword($region, "$thekw");
	print OUT &xref_list($value, $what);
    }
    print OUT "</table></div>\n" if ($ph);
    return $region;
}

sub
xref_list
{
    local ($value, $what) = @_;
    $value =~ s:,: :g;
    $value =~ s:(\s+|\n): :g;
    foreach $XR (split(' ', $value)) {
	$value =~ s: ::g;
	print OUT "<tr><td width=50%>$what";
	&localnav("$XR", "brief");
	print OUT "</td>\n";
	if ($routine_home{$XR}) {
	    print OUT "<td>In ";
	    &localnav("$routine_home{$XR}", "brief");
	    print OUT "</td>\n";
	} else {
	    print OUT "<td></td>\n";
	}
	print OUT "</tr>\n";
    }
}


sub
do_vars
{
    local ($region, $myname) = @_;
    local (@vcf, @vcn);
    if ($region =~ m:\@var:i) {
        print OUT "<p><b>Variables</b>\n";
	print OUT "<div align=right>\n";
        print OUT "<table border width=95%>\n";
        print OUT "<tr valign><th width=20% ",
 	  "bgcolor=\"$toprowHL\">Variable</th>";
        print OUT "<th width=20% bgcolor=\"$toprowHL\">Type</th>";
	print OUT "<th width=15% bgcolor=\"$toprowHL\">io</th>";
        print OUT "<th width=45% bgcolor=\"$toprowHL\">Description</th>\n";

        # OK, so strip out the variables
	$vcfn = 1;		# Footnote number
	undef @vcf, @vcn;
        while ($region =~ m:\@var:i) {
	    undef $var, $varname, $vtype, $vio, $vcomment;
            ($region, $var, $varname) = &get_container($region, "var");
            # Note clever trick of subparsing from a string here!
            ($var, $vtype) = &get_keyword($var, "vtype");
            ($var, $vio) = &get_keyword($var, "vio");
            ($var, $vdesc) = &get_keyword($var, "vdesc");
            ($var, $vcomment) = &get_keyword($var, "vcomment");

	    # OK, support variable storing
	    $vtype =~ s:^\s+::; 
	    $vtype =~ s:(\S)\s+$:\1:;
	    $vnstore = $varname;
	    $vnstore =~ s:^\s+::;
	    $vnstore =~ s:\s+$::;
	    $vnstore =~ s:,: :g;
	    foreach $VN (split(' ',$vnstore)) {
		$VN =~ s: ::g;
		$VN =~ s:\"::g;
		$VN =~ s:\.::g;
		next if $VN =~ m:^$:;
		if (!$vtype{$VN}) {
		    $vtype{$VN} = $vtype;
		} else {
		    $checktype = $vtype;
		    $checktype =~ s/(\(\)\<\>\[\]\.\&)/\\\1/g;
		    if (!($vtype{$VN} =~ /$checktype/)) {
			$wn = "WARNING: VAR $VN is either $vtype or $vtype{$VN}\n";
			$wn =~ s:\n::g;
			print STDERR "$wn\n";
		    }
		}
		$visout = "";
		$visout = "GRDOCVARISOUT " if ($vio =~ m:out:);
		$vfile{$VN} = "$vfile{$VN} $visout$myname";
	    }

	    $varname = &html_safe($varname);
	    $varname =~ s:\"::g;
	    $varname =~ s:(,)(\S):\1 \2:g; # To make tables tab OK.
	    $vtype = &html_safe($vtype);
	    $vio = &html_safe($vio);

	    # OK, now make the comments into a footnote.
	    $vcfoot = "";
	    if (!($vcomment =~ m:^$:)) {
		$vcfoot = "<sup>$vcfn</sup>";
		push (@vcf, $vcomment);
		push (@vcn, $varname);
		$vcfn ++;
	    }
	    print OUT "<tr valign>";
	    print OUT "<td bgcolor=\"$pvrowHL\">";
	    print OUT "<code>$vstart$varname$vend$vcfoot&nbsp;</code></td>";
	    print OUT "<td bgcolor=\"$blahrowHL\">$vtype&nbsp;</td>";
	    print OUT "<td bgcolor=\"$blahrowHL\">$vio&nbsp;</td>";
	    print OUT "<td bgcolor=\"$lastrowHL\">$vdesc&nbsp;</td></tr>\n";
        }
        print OUT "</table></div>";
	if ($vcfn > 1) {
	    print OUT "<div align=right><table width=95%>\n";
	    print OUT "<tr><td>Variable Comments</td></tr>\n";
	    print OUT "<tr><td><ol>\n";
	    foreach $COMM (@vcf) {
		$vn = shift(@vcn);
		print OUT "<li><code>$vstart$vn$vend</code>: $COMM\n";
		$foo++;
	    }
	    print OUT "</ol></td></tr></table></div>\n";

	}

    }
    return $region;
}

sub
do_pars
{
    local ($region) = @_[0];
    local (@pcn);
    if ($region =~ m:\@par:i) {
        print OUT "<p><b>Parameters</b>\n";
	print OUT "<div align=right>\n";
        print OUT "<table border width=95%>\n";
        print OUT "<tr valign><th width=20% bgcolor=\"$toprowHL\">Parameter</th>";
        print OUT "<th width=15% bgcolor=\"$toprowHL\">Type</th>";
	print OUT "<th width=25% bgcolor=\"$toprowHL\">Values</th>";
        print OUT "<th width=40% bgcolor=\"$toprowHL\">Description</th>\n";

        # OK, so strip out the variables
	$pcfn = 1;		# Footnote number
	undef @pcf, @pcn;
        while ($region =~ m:\@par:i) {
	    undef $par, $parname, $ptype, $pio, $pcomment;
            ($region, $par, $parname) = &get_container($region, "par");
            # Note clever trick of subparsing from a string here!
            ($par, $ptype) = &get_keyword($par, "ptype");
            ($par, $pio) = &get_keyword($par, "pvalues");
            ($par, $pdesc) = &get_keyword($par, "pdesc");
            ($par, $pcomment) = &get_keyword($par, "pcomment");

	    # OK, support parameter storing
	    $pnstore = $parname;
	    $pnstore =~ s:^\s+::;
	    $pnstore =~ s:\s+$::;
	    $pnstore =~ s:,: :g;
	    foreach $PN (split(' ',$pnstore)) {
		$PN =~ s: ::g;
		$PN =~ s:\"::g;
		$PN =~ s:\.::g;
		next if $PN =~ m:^$:;
		if (!$ptype{$PN}) {
		    $ptype{$PN} = $ptype;
		} else {
		    $checktype = $ptype;
		    $checktype =~ s/(\(\)\<\>\[\]\.\&)/\\\1/g;

		    if (!($ptype{$PN} =~ /$checktype/)) {
			$wn = "WARNING: PAR $PN is either $ptype or $ptype{$PN}\n";
			$wn =~ s:\n::g;
			print STDERR "$wn\n";
		    }
		}
		$pfile{$PN} = "$pfile{$PN} $myname";
	    }


	    $parname = &html_safe($parname);
	    $parname =~ s:\"::g;
	    $ptype = &html_safe($ptype);
	    $pio = &html_safe($pio);

	    # OK, now make the comments into a footnote.
	    $pcfoot = "";
	    if (!($pcomment =~ m:^$:)) {
		$pcfoot = "<sup>$pcfn</sup>";
		push (@pcf, $pcomment);
		push (@pcn, $parname);
		$pcfn ++;
	    }
	    print OUT "<tr valign>";
	    print OUT "<td bgcolor=\"$pvrowHL\"><code>$pstart$parname$pend$pcfoot&nbsp;</code></td>";
	    print OUT "<td bgcolor=\"$blahrowHL\">$ptype&nbsp;</td>";
	    print OUT "<td bgcolor=\"$blahrowHL\">$pio&nbsp;</td>";
	    print OUT "<td bgcolor=\"$lastrowHL\">$pdesc&nbsp;</td></tr>\n";
        }
        print OUT "</table></div>";

	if ($pcfn > 1) {
	    print OUT "<div align=right><table width=95%>\n";
	    print OUT "<tr><td>Parameter Comments</td></tr>\n";
	    print OUT "<tr><td><ol>\n";
	    foreach $COMM (@pcf) {
		$pn = shift(@pcn);
		print OUT "<li><code>$pstart$pn$pend</code>: $COMM\n";
		$foo++;
	    }
	    print OUT "</ol></td></tr></table></div>\n";

	}
    }
    return $region;
}

sub
do_leftovers
{
    local ($region) = @_[0];
    local ($key, $value, $head);
    $test = $region;
    $test =~ s:\s::g;
    $test =~ s:\n::g;
    if (!($test =~ m:^$:)) {
        print OUT "<br><b>Unrecognized Tags</b><br>\n";

        print OUT "<div align=right><table width=95% border>\n";
	while ($region =~ m/\@end(\S+)/) {
	    $key = $1;
	    print "UNKNOWN CONTAINER: $key\n";
	    ($region, $value, $head) = &get_container($region, "$key");
	    $value = &html_safe($value);
	    print OUT "<tr><td width=30%><code>\@$key .. <br>\@end$key</code></td>";
	    print OUT "<td>$value</td></tr>\n";
	}
	while ($region =~ m/\@(\S+)/) {
	    $key = $1;
	    print "UNKNOWN KEYWORD: $key\n";
	    ($region, $value) = &get_keyword($region, "$key");
	    $value = &html_safe($value);
	    print OUT "<tr><td width=30%><code>\@$key</code></td>";
	    print OUT "<td>$value</td></tr>\n";
	}
	print OUT "</table></div>\n";
    }

}


sub
do_history
{
    local ($region) = @_[0];
    local ($hist, $hhead, $hdate, $hauthor, $hdesc);
    ($region, $hist, $hhead) = &get_container($region,"history");

    if (!($hist =~ m:^$:)) {
	print OUT "<br><b>History</b>\n<div align=right>";
	print OUT "<table width=95% cellspacing=0 cellpadding=0>\n";

	while ($hist =~ /\@hdate/) {
	    ($hist, $hdate)   = &get_keyword($hist, "hdate");
	    ($hist, $hauthor) = &get_keyword($hist, "hauthor");
	    ($hist, $hdesc)   = &get_keyword($hist, "hdesc");
	    if ($hauthor =~ m/^$/) {
		print STDERR "WARNING: Incorrect number of \@hauthor s\n";
	    }
	    if ($hdesc =~ m/^$/) {
		print STDERR "WARNING: Incorrect number of \@hdesc s\n";
	    }
	    $hdate   = &html_safe($hdate);
	    $hauthor = &html_safe($hauthor);
	    $hdesc   = &html_safe($hdesc);
	    print OUT "<tr><td width=20%>$hdate</td>";
	    print OUT "<td width=20%>$hauthor</td>";
	    print OUT "<td width=60%>$hdesc</td></tr>\n";
	}

	print OUT "</table></div>\n";
    }
    return ($region);
}

# Ahh, the joys of perl
1;