#!/usr/bin/perl -w
# $Id$
# This script verifies the conformity of the reference manual with
# some types informations available inside ZincTk
# It has been developped by C. Mertz <mertz@cena.fr>

# limitations: this script makes some very strong assumptions
#              on the latex Zinc reference manual formating!
#              However if the formating changes, it should be
#              simple to modify the &scanDoc function!

use Tk;
use Tk::Zinc;

use strict;

my $mw = MainWindow->new();

# Creating the zinc widget
# NB: this widget will not be displayed! It is only used for creating items
# and getting some internal information about attributes/options and types.

my $zinc = $mw->Zinc(-width => 1, -height => 1,);

# Creating an instance of every item type
my %itemtypes;

# These Items have fields! So the number of fields must be given at creation time
foreach my $type qw(tabular track waypoint) {
    $itemtypes{$type} = $zinc->add($type, 1, 1);
}

# These items needs no specific initial values
foreach my $type qw(group icon map reticle text window) {
    $itemtypes{$type} = $zinc->add($type, 1);
}

# These items needs some coordinates at creation time
# However curves and bezier usually needs more than 2 points.
foreach my $type qw(arc bezier curve rectangle) {
    $itemtypes{$type} = $zinc->add($type, 1, [0,0 , 1,1]);
}
# Triangles item needs at least 3 points for the coordinates 
foreach my $type qw(triangles) {
    $itemtypes{$type} = $zinc->add($type, 1, [0,0 , 1,1 , 2,2]);
}


my %zinc2doc;  # a hash recording every discrepency between attribute/option
               # type between the doc and TkZinc
my $current_item = 0;
my $prev_attribute = 0;
my %documentedOptions;
my %itemAttributeDoc;

&scanDoc ($ARGV[0]);

sub scanDoc {
    my ($filename) = @_;
    open (DOC, $filename) or die "unable to open " . $filename . "\n";
    while (<DOC>) {
	if ( /^\\attribute\{(\w+)\}\{(\w+)\}\{(\w+)\}/ ) {
	    $itemAttributeDoc{$1}{-$2}=$3;
	    if ($1 eq $current_item) {
		if ($2 lt $prev_attribute) {
		    print "W: attributes $prev_attribute and $2 are not in alphabetical order for $1\n";
		}
	    }
	    else {
		$current_item = $1;
		$prev_attribute = $2;
	    }
	}
	elsif ( /^\\option\{(\w+)\}\{(\w+)\}\{(\w+)\}/ ) {
	    # $1 = optionName
	    # $2 = Database name
	    # $3 = DatabaseClass
	    $documentedOptions{-$1}=$3;
	}
    }
}

sub testAllOptions {
    my @options = $zinc->configure();
    my %options;
    # we use this hashtable to check that all documented options
    # are matching all existing options in TkZinc
    
    for my $elem (@options) {
	my ($optionName, $optionDatabaseName, $optionClass, $default, $optionValue) = @$elem;
	$options{$optionName} = [$optionClass, $default, "", $optionValue];
    }

    foreach my $optionName (sort keys %options) {
	my ($optionType, $readOnly, $empty, $optionValue) = @{$options{$optionName}};
	# $empty is for provision by Zinc
	
	if (!defined $documentedOptions{$optionName}) {
	    print "E: $optionName ($optionType) of Zinc IS NOT DOCUMENTED!\n";
	    $options{$optionName} = undef;
	    next;
	}
	if ($documentedOptions{$optionName} ne $optionType) {
	    print "W: $optionName has type $optionType inside ZincTk and type $documentedOptions{$optionName} inside Doc\n";
	    $zinc2doc{$optionType}=$documentedOptions{$optionName};
	}
#	$attributes{$attributeName} = undef;
	$documentedOptions{$optionName} = undef;
    }
    
    foreach my $unexistingDocOpt (sort keys %documentedOptions) {
	if (defined $documentedOptions{$unexistingDocOpt}) {
	    print "E: The Documented Option \"$unexistingDocOpt\" DOES NOT EXIST!\n";
	}
    }
}

sub testAllAttributes {
    my ($type) = @_;

    my %documentedAttributes = %{$itemAttributeDoc{$type}}; 
    my @attributes = $zinc->itemconfigure($itemtypes{$type});

    my %attributes;
    # we use this hashtable to check that all documented attributes
    # are matching all existing attributes in TkZinc
    
    foreach my $elem (@attributes) {
	my ($attributeName, $attributeType, $readOnly, $empty, $attributeValue) = @$elem;
	$attributes{$attributeName} = [$attributeType, $readOnly, $empty, $attributeValue];
    }

    foreach my $attributeName (keys %attributes) {
	my ($attributeType, $readOnly, $empty, $attributeValue) = @{$attributes{$attributeName}};
	# $empty is for provision by Zinc
	
	if (!defined $documentedAttributes{$attributeName}) {
	    print "E: $attributeName ($attributeType) of item $type IS NOT DOCUMENTED!\n";
	    $attributes{$attributeName} = undef;
	    next;
	}

	if ($documentedAttributes{$attributeName} ne $attributeType) {
	    print "W: $attributeName has type $attributeType inside ZincTk and type $documentedAttributes{$attributeName} inside Doc\n";
	    $zinc2doc{$attributeType}=$documentedAttributes{$attributeName};
	}
#	$attributes{$attributeName} = undef;
	$documentedAttributes{$attributeName} = undef;
    }
    
    foreach my $unexistingDocAttr (sort keys %documentedAttributes) {
	if (defined $documentedAttributes{$unexistingDocAttr}) {
	    print "E: The Documented Attribute \"$unexistingDocAttr\" DOES NOT EXIST!\n";
	}
    }
}


sub testFieldAttributes {
    my %documentedAttributes = %{$itemAttributeDoc{"field"}}; 
    my @attributes = $zinc->itemconfigure($itemtypes{track},0);

    my %attributes;
    # we use this hashtable to check that all documented fields attributes
    # are matching all existing fields attributes in TkZinc
    
    foreach my $elem (@attributes) {
	my ($attributeName, $attributeType, $readOnly, $empty, $attributeValue) = @$elem;
	$attributes{$attributeName} = [$attributeType, $readOnly, $empty, $attributeValue];
    }

    foreach my $attributeName (keys %attributes) {
	my ($attributeType, $readOnly, $empty, $attributeValue) = @{$attributes{$attributeName}};
	# $empty is for provision by Zinc
	
	if (!defined $documentedAttributes{$attributeName}) {
	    print "E: $attributeName ($attributeType) of field IS NOT DOCUMENTED!\n";
	    $attributes{$attributeName} = undef;
	    next;
	}

	if ($documentedAttributes{$attributeName} ne $attributeType) {
	    print "W: $attributeName of field has type $attributeType inside ZincTk and type $documentedAttributes{$attributeName} inside Doc\n";
	    $zinc2doc{$attributeType}=$documentedAttributes{$attributeName};
	}
	$documentedAttributes{$attributeName} = undef;
    }
    
    foreach my $unexistingDocAttr (sort keys %documentedAttributes) {
	if (defined $documentedAttributes{$unexistingDocAttr}) {
	    print "E: The Documented Field Attribute \"$unexistingDocAttr\" DOES NOT EXIST!\n";
	}
    }
}



print "--- TkZinc Options -----------------------------------------\n";
&testAllOptions;
print "--- Field Attributes ---------------------------------------\n";

&testFieldAttributes;

foreach my $type (sort keys %itemtypes) {
    print "--- Item $type -------------------------------------------------\n";
    &testAllAttributes($type);
}

print "------- Summary of type discrepencies between Doc and Zinc --------\n";
printf "%15s |%15s\n", "zinctype","doctype";
foreach my $typezinc (sort keys %zinc2doc) {
    printf "%15s |%15s\n", $typezinc,$zinc2doc{$typezinc};
}


# MainLoop();


1;