# -*-perl-*-

#
# grdoc_parse
#
# This is the place where it is a smarty pants and actually makes the
# subhtml for parsing out.
#
# $Id: grdoc_parse,v 1.36 1996/04/21 17:44:52 pwalker Exp $

#define some colors
$pstart = "<font color=\"#005000\">";
$pend   = "</font>";
$vstart = "<font color=\"#500000\">";
$vend   = "</font>";

sub
grdoc_parse
{
    local ($infile) = @_[0];
    local (@grdoc_regions, @tmp);
    $pfile = &strip_dirs($infile);
    print "      Parsing $pfile\n" if $opt_V;
    open (IN, "< $infile") || die "IN: $infile: $!\n";
    $in = join('',<IN>);
    close IN;

    # Strip out the regions and put them into the grdoc_regions array.
    
    if (!($in =~ m:/\*\@\@:)) {
	print STDERR "WARNING: $thefile contains no grdoc regions\n";
	return;
    }
    @tmp = split('\@\@\*/',$in);
    foreach $CANDIDATE (@tmp) {
	$isf = 0;  $isidlorelisp = 0;
	if ($CANDIDATE =~ m:/\*\@\@:) {
	    $isf          = ($CANDIDATE =~ m:[Cc\*]/\*\@\@:);
#th modification (fortran 90 free format)
	    $isf90        = ($CANDIDATE =~ m:!/\*\@\@:);
	    $isidlorelisp = ($CANDIDATE =~ m:\;/\*\@\@:);
	    $isperl       = ($CANDIDATE =~ m:\#\s*/\*\@\@:);
	    $CANDIDATE =~ s:^(.|\n)*/\*\@\@::;
	    # Remove all the fortran idl (perl elisp...) things.
	    $CANDIDATE =~ s:\n[Cc\*]:\n:g if $isf;
#th modification (fortran 90 free format)
	    $CANDIDATE =~ s:\n!:\n:g if $isf90;
	    $CANDIDATE =~ s:\n[\;]+:\n:g if $isidlorelisp;
	    $CANDIDATE =~ s:\n[\#]+:\n:g if $isperl;
	    push (@grdoc_regions, $CANDIDATE);
	}
    }
    $regioncount = $#grdoc_regions + 1;
    
    # OK, great.  So now step through the regions, see if we are
    # a file or routine, and handle appropriately.
    # 
    # Note the additional code here.  Check further down the stact
    # to look for regions which do not match file, header, or routine.
    while ($REGION = shift(@grdoc_regions)) {
	while ($morestuff = shift(@grdoc_regions)) {
	    if ($morestuff =~ m:@(file|header|routine):) {
		@grdoc_regions = ($morestuff, @grdoc_regions);
		last;
	    } else {
		$REGION = "$REGION\n$morestuff";
	    }
	}
	if ($REGION =~ m:@(file|header):i) {
	    &parse_file($REGION);
	} elsif ($REGION =~ m:\@routine:i) {
	    &parse_routine($REGION);
	} else {
	    print "INTERNAL ERROR: Neither routine nor file/header\n";
	}
    }
}

sub
parse_file
{
    local ($region) = @_[0];
    # Whole idea here is we pick off things as we process them, leaving
    # other stuff around in region to still be processed while writing 
    # the output file.

    # OK, start by figuring out what my file is.
    $isheader = 0;
    ($region, $file) = &get_keyword($region,"file");
    if ($file =~ m:^$:) {
	($region, $file) = &get_keyword($region, "header");
	$isheader = 1;
    }
    $file =~ s:[\n\s]::g;
    if (!($mysubdir{$file} || $rootfiles{$file})) {
	print STDERR "WARNING: No Sub Dir for :$file:\n";
	print STDERR join(" ",keys %rootfiles);
	return;
    } else {
	$msd = $mysubdir{$file};
    }
    $urlfile = $file;
    $urlfile =~ s:\.:_:g;
    $outname = "$opt_o/$msd/${urlfile}_File_Doc.html";
    open (OUT, ">$outname") || die "OUT $outname: $!\n";
    print "         P: CREATED $outname\n" if $opt_V;
    if ($isheader) {
	&html_head("\@header: $file\n");
	print OUT "<h2 align=center>\@header: ";
    } else {
	&html_head("\@file: $file\n");
	print OUT "<h2 align=center>\@file: ";

    }
    print OUT "$file</h2>\n";

    &navigation($dadots);
    print OUT "<hr>\n";
    &localnav($file);
    print OUT &indent("$totallines{$file} Lines ($totalgrdlines{$file} grdoc lines)");
    print OUT "<p>\n";
    print OUT "<!-- BEGIN -->\n";
    $region = &parse_top_common_stuff($region, $file);
    $didrouts = 0;
    foreach $ROUTINE (sort cialph keys %routine_home) {
	if ($routine_home{$ROUTINE} =~ m/^$file$/) {
	    if (!$didrouts) {
		$didrouts = 1;
		print OUT "\n<!-- ROUTINES -->\n";
		print OUT "<br><B>Contains Routines</b>\n";
		print OUT "<div align=right>";
		print OUT "<table width=95% cellspacing=0 cellpadding=0>\n";
	    }
	    print OUT "<tr><td width=100%>";
	    &localnav($ROUTINE, "brief");
	    print OUT "</td></tr>\n";
	}
    }
    print OUT "</table></div>\n<!-- END ROUTINES -->\n" if ($didrouts);
    $region = &parse_bot_common_stuff($region);
    &do_leftovers($region);
    print OUT "\n<!-- END -->\n";
    print OUT "<hr>";
    &navigation($dadots);
    if ($isheader) {
	&html_foot("\@header: $file\n");
    } else {
	&html_foot("\@file: $file\n");
    }
}

sub
parse_routine
{
    local ($region) = @_[0];
    # Whole idea here is we pick off things as we process them, leaving
    # other stuff around in region to still be processed while writing 
    # the output file.

    # OK, start by figuring out what my file is.
    ($region, $routine) = &get_keyword($region,"routine");
    $routine =~ s:[\n\s]::g;
    if (!($mysubdir{$routine_home{$routine}} ||
	  $rootfiles{$routine_home{$routine}} )) {
	print STDERR "WARNING: No Sub Dir for $routine\n";
	return;
    } 
    $msd = $mysubdir{$routine_home{$routine}};
    $urlfile = $routine;
    $urlfile =~ s:\.:_:g;
    $outname = "$opt_o/$msd/${urlfile}_Routine_Doc.html";
    # Make the file header
    open (OUT, ">$outname") || die "OUT 2 $outname: $!\n";
    print "         P: CREATED $outname\n" if $opt_V;
    &html_head("\@routine: $routine\n");
    print OUT "<h2 align=center>\@routine: $routine</h2>\n";
    $myfile = $routine_home{$routine};
    $myfileurl = $myfile;
    $myfileurl =~ s:\.:_:g;
    $myfileurl = "${myfileurl}_Rich_Doc.html";
    &navigation();
    print OUT "<hr>\n";
    &localnav($routine);
    print OUT "<p>\n";
    # Region for inclusion in Rich Docs
    print OUT "<!-- BEGIN -->\n";
    $region = &parse_top_common_stuff($region, $routine);
    $region = &parse_bot_common_stuff($region, $routine);

    # Check for Entry Points
    ($region, $iste, $teval) = &get_boolean($region, "treeentry");
    $routineTreeEntry{$routine} = "GRDOCENTRY$teval" if $iste;
    &do_leftovers($region);
    print OUT "\n<!-- END -->\n";

    # And a footer
    print OUT "<hr>";
    &navigation($dadots);
    &html_foot("\@routine: $routine\n");
}

sub
parse_top_common_stuff
{
    local ($region, $myname) = @_;
    local ($version, $author, $date, $descr, $deschead);
    local ($stencil, $defines);
    ($region, $version) = &get_keyword($region, "version");
    ($region, $author) = &get_keyword($region, "author");
    ($region, $date) = &get_keyword($region, "date");
    ($region, $desc, $deschead) = &get_container($region, "desc");
    ($region, $stencil) = &get_keyword($region, "stencil");
    ($region, $defines) = &get_keyword($region, "defines");
    ($region, $rettype) = &get_keyword($region, "returntype");
    ($region, $retdesc, $retdeschead) = 
	&get_container($region, "returndesc");
    $test = "$version$date$author";
    if (!($test =~ m:^$:)) {
	print OUT "<table width=100% cellpadding=0 cellspacing=0>";
	&no_html_row("Version",$version);
	&no_html_row("Author",$author, $isfile);
	&no_html_row("Date",$date);
	print OUT "</table>\n";
    }
    if ($desc =~ m:\S:) {
	$dt = "Description";
	$dt = "$dt: <i>$deschead</i>" if (!($deschead =~ m:^\s*$:));
	print OUT "<br><b>$dt</b><br>\n";
	print OUT &indent($desc);
    }
    if ($rettype =~ m:\S:) {
	$dt = "Return Type: <code>$rettype</code>";
	$dt = "$dt: <i>$retdeschead</i>" if (!($deschead =~ m:^\s*$:));
	print OUT "<br><b>$dt</b><br>\n";
	if ($retdesc =~ m:\S:) {
	    print OUT &indent($retdesc);
	}
    }
    if ($routine_f_sub{$myname}) {
	print OUT "<br><b>Fortran Prototype</b><br>\n";
	print OUT "<pre>$routine_f_sub{$myname}</pre>\n";
    }
    if ($defines =~ m:\S:) {
	print OUT "<br><b>Defines</b><br>\n";
	print OUT &indent($defines);
    }
    if ($stencil =~ m:\S:) {
	print OUT "<br><b>Stencil</b><br>\n";
	print OUT &indent($stencil);
    }
    $region = &do_vars($region, $myname);
    $region = &do_pars($region, $myname);
    return ($region);
}

sub
parse_bot_common_stuff
{
    local ($region, $myname) = @_;
    local ($comm, $commhead);
    $region = &do_history($region);
    # Note we need to do it this way so the seealso doesn't munge the 
    # comment
    ($region, $comm, $commhead) = &get_container($region, "comment");
    $region = &do_seealso($region, $myname);
    if ($comm =~ m:\S:) {
        $ct = "Comment";
        $ct = "$ct: <i>$commhead</i>" if (!($commhead =~ m:^$:));
        print OUT "<br><b>$ct</b><br>\n";
        print OUT &indent($comm);
    }
    return ($region);
}

sub
no_html_row
{
    local($tag, $value) = @_;
    $value = &html_safe($value);
    $value =~ s:\n::;
    if (!($value =~ m:^\s*$:)) {
        print OUT "<tr valign><td width=30%><b>$tag</b></td><td width=70%>";
        print OUT "$value</td></tr>\n";
    }
}


sub
get_container
{
    local ($region, $kw) = @_;
    local ($value, $head);
    local ($firstbit, @rest, $lastbit, $pv, $ph);
    $value = "";
    $head = "";
    $pv = "";
    $ph = "";
    if (!($region =~ m:\@$kw:i)) {
	$head = "";
	$value = "";
	return ($region, $value, $head);
    }
    while ($region =~ m:\@$kw:i) {
	($firstbit, @rest) = split("\@end$kw", $region);
	$lastbit = join("\@end$kw", @rest);;
	$firstbit =~ s:\@$kw(.*)\n((.|\n)*)$::i;
	$pv = $2; $ph = $1;
	$value .= "<p>" if (($value =~ m:\S:) && ($kw =~ m:^(comment|desc):));
	$value .= $pv;
	$head = $ph if ($head =~ m:^$:);
	$region = "$firstbit$lastbit";
	last unless ($kw =~ /^(comment|desc)/i);
    }
    # resolve XRefs in $value
    $value = &resolve_XRefs($value, "norich");
    
    # Handle TeX in $value
    if ($opt_T) {
	while ($value =~ m:(\$+[^\$]+\$+):) {
	    $origtex = $1;
	    if (!($origtex =~ m:^\$(Id|Log):)) {
		$newtex = &tex_to_html($origtex);
		$value =~ s:(\$+[^\$]+\$+):GRDOCTEXREPLACETHIS:;
		$value =~ s:GRDOCTEXREPLACETHIS:$newtex:;
	    } else {
		print "Rejecting $origtex for TeX conversion!\n" if ($opt_V);
		$origtex =~ s:\$::g;
		$value =~ s:(\$+[^\$]+\$+):GRDOCTEXREPLACETHIS:;
		$value =~ s:GRDOCTEXREPLACETHIS:$origtex:;
	    }
		
	}
    }
    
    # Make the rest of the region again.
    return ($region, $value, $head);
}

sub
get_boolean
{
    local ($region, $kw) = @_;
    local ($value, $gotit);
    $value = ""; $gotit = 0;

    if ($region =~ m:\@$kw:) {
	$gotit = 1;
	$region =~ s:(\@$kw)([^\@]*)::;
	$value = $2;
	$value =~ s:\n::g;
	$value =~ s:^\s+::g;
	$value =~ s:\s+$::g;
    }

    return ($region, $gotit, $value);
}

sub
get_keyword
{
    local ($region, $kw) = @_;
    local ($value);

    if ($region =~ m:\@$kw:i) {
	$region =~ s:\@$kw([^\@]+)::;
	$value = $1;
    } else {
	$value = "";
    }
    return ($region, $value);
}

sub
resolve_XRefs
{
    local ($value, $norich) = @_;
    local ($xref, $item, $kw, $msd, $murlf, $isroutine, $punct);


    while ($value =~ m:@(see\S+|calls|calledby)\s+(\S+):i) {
	$kw   = $1;
	$item = $2;
	$isroutine = 0;
	($item, $punct) = &de_punctualize($item);
	if ($mysubdir{$item}) {
	    $msd   = $mysubdir{$item};
	    $murlf = $item;
	} elsif ($rootfiles{$item}) {
	    $msd = "";
	    $murlf = $item;
	} elsif ($routine_home{$item}) {
	    $isroutine = 1;
	    if ($norich) {
		$murlf = $item;
	    } else {
		$murlf = $routine_home{$item};
	    }
	    $msd   = $mysubdir{$routine_home{$item}};
	} else {
	    if (!($item =~ m:^$:)) {
		print "WARNING: Unresolved XRef to >>$item<<\n";
		$xref = "<a href=\"NotYet.html\" target=\"_top\">$item</a>$punct";
	    }
	    $value =~ s:@(see\S+|calls|calledby)(\s+)(\S+):$xref:i;
	    next;
	}
	$msd .= "/";
	$murlf =~ s:\.:_:g;
	if ($norich) {
	    if ($isroutine) {
		$murlf = "${murlf}_Routine_Doc.html";
	    } else {
		$murlf = "${murlf}_File_Doc.html";
	    }
	} else {
	    $murlf = "${murlf}_Rich_Doc.html";
	}
	$murlf = "$msd/$murlf";
	$murlf =~ s:[/]+:/:g;
	$murlf =~ s:^/::;
	$murlf = "$opt_t/$murlf";
	$xref = "<a href=\"$murlf\" target=\"_top\">$item</a>$punct";

	$value =~ s:@(see\S+|calls|calledby)(\s+)(\S+):$xref:i
    }

    return $value;
}


# Ahh, the joys of perl
1;