# -*-perl-*-

# Makes the calling tree for the code.

# $Id: grdoc_tree,v 1.14 1996/04/19 15:29:43 pwalker Exp $

# Globals
$treeentrytag = "<font color=\"#ff0000\"><b>-&gt;</b></font>";

sub
grdoc_tree
{
    # First things first.  Start with the sanity check
    &tree_sanity_check();

    # First create the index file
    open (OUT, "> $opt_o/Tree.html") || die "Tree.html: $!\n";
    &html_head("$opt_c Routine Calling Tree");
    print OUT "<h1 align=center>$opt_c</h1>\n";
    print OUT "<h2 align=center>Routine Calling Tree</h1>\n";
    &navigation();
    print OUT "<hr>\n";
    print OUT "<b>Choose a starting routine to enter the tree</b><br>\n";
    print OUT "For compactness, the routines are shown in 2 columns<br>\n";
    print OUT "Items marked with a $treeentrytag are specified entry points";
    print OUT " to the sourcecode\n";
    print OUT "<hr><table width=100%>\n";
    @foo = sort cialph keys %routine_home;
    $nf = $#foo;
    $nn = 0;
    $donesplit = 0;
    print OUT "<tr><td width=50% cellspacing=0 cellpadding=0>\n";
    foreach $ROUTINE (@foo) {
	$xr = &resolve_XRefs("\@seeroutine $ROUTINE", "norich");
	$xr =~ s:Routine_Doc:Routine_Tree:;
	print OUT "$treeentrytag " if $routineTreeEntry{$ROUTINE};
	print OUT "$xr<br>\n";
	$nn++;
	if (($nn >= $nf/2) && (!$donesplit)) {
	    print OUT "</td><td>\n";
	    $donesplit = 1;
	}
    }
    print OUT "</td><!-- B --></tr></table>\n";
    print OUT "<hr>\n";
    &navigation();
    &html_foot("$opt_c Routine Calling Tree");
    close OUT;
    
    # OK, now go through each routine and make the tree doc for it.
    foreach $ROUTINE (@foo) {
	$msd = $mysubdir{$routine_home{$ROUTINE}};
	open (OUT, "> $opt_o/$msd/${ROUTINE}_Routine_Tree.html") ||
	    die " $opt_o/$msd/${ROUTINE}_Routine_Tree.html: $!\n";
	&html_head("$ROUTINE Calling Tree\n");
	print OUT "<h1 align=center>$ROUTINE Calling Tree</h1>\n";
	&navigation();
	print OUT "<hr>\n";
	print OUT "<div align=center><b>KEY</b>: <b>D</b>: Routine Doc,";
	print OUT "<b>R</b>: Rich Doc, <b>S</b>: Raw Source</div><p>\n";
	print OUT "<table width=100% border>\n";
	print OUT "<tr><td width=25%><b>Called By</b></td>";
	print OUT "<td width=15%><b>Routine</b></td>\n";
	print OUT "<td width=60%><b>Calls</b></td></tr>\n";
	print OUT "<tr><td>\n";
	print OUT "<!-- CALLED BY TABLE -->\n";
	print OUT &calledbyTable($ROUTINE);
	print OUT "</td><td>\n";
	print OUT "<!-- ME -->\n";
	$insertthis = &routineTreeElement($ROUTINE);
	$insertthis =~ s:</?[bt].>::g;
	$insertthis =~ s:^(.*\]) (.*)$:\2<br>\1:;
	print OUT "$insertthis\n";
	print OUT "</td><td>\n";
	print OUT "<!-- CALLS TABLE -->\n";
	print OUT &callsTable($ROUTINE,1);
	print OUT "</td></tr>\n";
	print OUT "<!-- END CALLS TABLE -->\n";
	print OUT "</table>\n";
	print OUT "<p>\n";
	&navigation();
	&html_foot("$ROUTINE Calling Tree\n");
	close OUT;
    }
} 

sub
calledbyTable 
{
    local ($routine) = @_;
    local ($r);			# The result
    if (!$routineCalledby{$routine}) {
	$r = "&nbsp;\n";
	return ($r);
    }

    $r = "<!-- CBT --><table width=100%>\n";
    $rdiv = "";
    foreach $CB (split(' ', $routineCalledby{$routine}) ) {
	($CB, $garbage) = &de_punctualize($CB);
	$xr = &resolve_XRefs("\@seeroutine $CB", "norich");
	$rr = &resolve_XRefs("\@seeroutine $CB");
	$rr =~ s:>$CB:>Rich:;
	$ct = $xr;
	$ct =~ s:Routine_Doc:Routine_Tree:;
	$xr =~ s:>$CB:>Doc:;
	$rr =~ s:\s+$::g;
	$xr =~ s:\s+$::g;
	$wid = "";
	$r .= &routineTreeElement($CB, $rdiv);
	$r .= "<!-- C --></tr>";
	$rdiv = "<hr>";
    }
    $r .= "<!-- /CBT --></table>";
    return $r;
}

sub
callsTable
{
    local ($routine, $level) = @_;
    local ($r, $rdiv, $wid, $bd, $mocalls, $ls);	# The result
    ($routine, $garbage) = &de_punctualize($routine);
    if ($level == 1) {
	$bd = " border width=100%";
	$ls = "";
    } else {
	$bd = "cellspacing = 1 cellpadding = 1 width=100%";
	$ls = "  ";
    }
    if (!($routineCalls{$routine} =~ m:\S:)) {
	return "<!-- F -->&nbsp;";
	print OUT "<!-- G -->\n";
    }
    $r = "<!-- CT $level --><table $bd>\n";
    $rdiv = "";
    foreach $CB (split(' ', $routineCalls{$routine}) ) {
	($CB, $garbage) = &de_punctualize($CB);
	$mocalls = "";
	$mocalls = " -&gt;" if ($routineCalls{$CB} && $level == 0);
	if (!($CB =~ m:$routine:)) {
	    $r .= &routineTreeElement($CB, $rdiv, $mocalls);
	    $r .= "</tr>\n" if ($level == 0);
	}

	if ($level == 1) {
	    if ($CB =~ m:$routine:) {
		$r .= "<tr><td colspan=2><b>Recursive</b></td>";
	    } else {
		$r .= "<td width=50%>";
		$r .= &callsTable($CB, 0);
		$r .= "</td>\n";
	    }
	    $r .= "</tr>\n";
	}

	$rdiv = "<hr>" if ($level == 0);
    }
    $r .= "<!-- /CT $level --></table>";
    return $r;
}

sub
routineTreeElement
{
    local ($CB, $rdiv, $mocalls) = @_;
    local ($xr, $rr, $rw, $ct, $r);

    $r = "";
    ($CB, $trash) = &de_punctualize($CB);
    $xr = &resolve_XRefs("\@seeroutine $CB", "norich");
    $rw = &resolve_XRefs("\@seeroutine $CB");
    $rw =~ s:_Rich_Doc:_src:;
    $rw =~ s:$opt_t:$opt_t/PROTECTED:;
    $rw =~ s:\.html:.html\#$CB:;
    $rr = &resolve_XRefs("\@seeroutine $CB");
    $ct = $xr;
    $rr =~ s:>$CB:>R:;
    $rw =~ s:>$CB:>S:;
    $ct =~ s:Routine_Doc:Routine_Tree:;
    $xr =~ s:>$CB:>D:;
    $rr =~ s:\s+$::g;
    $xr =~ s:\s+$::g;
    $wid = "";
    $r .= "<tr><td>$rdiv";
    $r .= "[$xr|$rr|$rw] ";
    $r .= "<b>$ct</b> $mocalls<br>\n";
    $r .= "</td>\n";
    return ($r);
}

sub
tree_sanity_check
# Does a check on calls/calledby compatibilty
{
    # Check "calls -> calledby" first
    print "-- Calling Tree Sanity Check\n";
    foreach $ROUTINE (keys %routine_home) 
    {
	foreach $ICALL (split(' ', $routineCalls{$ROUTINE})) {
	    $ICALL =~ s:\s::g;
	    ($ICALL, $garbage) = &de_punctualize($ICALL);
	    if (!($routineCalledby{$ICALL} =~ m:$ROUTINE:)) {
		if (!($ICALL =~ m:$ROUTINE:)) {
		    print "Adding $ROUTINE to $ICALL \@calledby list\n";
		    $routineCalledby{$ICALL} .= " $ROUTINE";
		}
	    }
	}
    }
    print "\n";
    foreach $ROUTINE (keys %routine_home) 
    {
	foreach $CALLME (split(' ', $routineCalledby{$ROUTINE})) {
	    $CALLME =~ s:\s::g;
	    ($CALLME, $garbage) = &de_punctualize($CALLME);
	    if (!($routineCalls{$CALLME} =~ m:$ROUTINE:)) {
		if (!($CALLME =~ m:$ROUTINE:)) {
		    print "Adding $ROUTINE to $CALLME \@calls list\n";
		    $routineCalls{$CALLME} .= " $ROUTINE";
		}
	    }
	}
    }

}

1;