#Copyright Massachusetts Institute of technology, 2000.
#Written by Eric Prud'hommeaux for the World Wide Web Consortium

# derive from MainWindow instead of frame.

package W3C::Rdf::TkVisualizer::WindowSet;

use strict;
use base  qw(Tk::Frame);
use Tk::widgets qw(Frame Label Entry);

use W3C::Rdf::TkVisualizer::PromptHistory;
use W3C::Rdf::TkVisualizer::StatementListWidget;

use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK @TODO);

@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = 0.01;
$DSLI = 'adpO';
@TODO = ('write');

Construct Tk::Widget 'WindowSet';
use Tk::DropSite;
use vars qw($OSDragNDrop);           
BEGIN  { $OSDragNDrop = ($^O eq 'MSWin32') ? ['Win32'] : ['Sun','XDND','KDE'] }
use Tk::DropSite @$OSDragNDrop;
use Tk::DragDrop @$OSDragNDrop;
use W3C::XML::TkNamespaceEditor;
use W3C::Util::Exception;
use W3C::Rdf::Atoms qw($RDF_SCHEMA_URI);

use W3C::Rdf::TkVisualizer::StatementSet;

sub Populate
{
    require W3C::Rdf::TkVisualizer::Graph;
    require W3C::Rdf::TkVisualizer::QueryResults;
    require W3C::Rdf::TkVisualizer::ViewMaster;
    require W3C::Rdf::TkVisualizer::QueryMaster;
    my($cw, $args) = @_;
    $cw->SUPER::Populate($args);

    my $self = $cw;
    my $window = $cw->Toplevel;
    $window->title('RDF Browser - main 1');
    $window->protocol('WM_DELETE_WINDOW', sub {$self->destroyWindow});
    $self->{CONTROL_WINDOW} = $window;

    my $self = $cw;
    $self->{SHOW_REIFICATIONS} = 0;
    $self->{SQUASH_NODES} = 1;
    my $matrixWidget;
    eval {
	die if ($args->{-noColumns});
	require W3C::Rdf::TkVisualizer::ColumnMatrixRenderer;
	$matrixWidget = 'ColumnMatrixRenderer';
    }; if ($@) {
	require W3C::Rdf::TkVisualizer::ListboxMatrixRenderer;
	$matrixWidget = 'ListboxMatrixRenderer';
    }

    # set up menus
    my $namespaceButton;
    my $menuFrame = $window->Frame(-relief => 'ridge', -bd => 2)->pack(-fill => 'x', -side => 'top');
    { # set up file menu
	my $filebutton = $menuFrame->Menubutton(-text => 'file')->pack(-side => 'left');

	my $loadEntry = $filebutton->command(-label => 'load ...', -command => sub {$self->fileActions('open')}, -underline => 0);
	$loadEntry->configure(-accelerator => 'Ctrl+F');
	$window->bind('<Control-f>' => sub {$self->fileActions('open')});

	my $loadEntry = $filebutton->command(-label => 'save', -command => sub {$self->fileActions('save')}, -underline => 0);
	$loadEntry->configure(-accelerator => 'Ctrl+S');
	$window->bind('<Control-s>' => sub {$self->fileActions('save')});

	my $loadEntry = $filebutton->command(-label => 'save as', -command => sub {$self->fileActions('saveAs')}, -underline => 0);

	my $exitEntry = $filebutton->command(-label => 'Exit', -command => sub {$self->destroyWindow}, -underline => 0);
	$exitEntry->configure(-accelerator => 'Ctrl+Q');
	$window->bind('<Control-q>' => sub {$self->destroyWindow});
    }
    # namespace menu gets built later
    {
	$namespaceButton = $menuFrame->Menubutton(-text => 'namespaces')->pack(-side => 'left');

	my $addEntry = $namespaceButton->command(-label => 'add ...', -underline => 0, 
						 -command => sub {$self->namespaceActions('add')});
	$addEntry->configure(-accelerator => 'Ctrl+A');
	$window->bind('<Control-a>' => sub {$self->namespaceActions('add')});
    }

    # next row is some input fields
    {
	my $inputFrame = $window->Frame(-relief => 'groove', -bd => 2)->pack(-fill => 'x', -side => 'top');
	($self->{VIEW_MASTER} = $inputFrame->ViewMaster(-windowSet => $self))->pack(-side => 'left');
	($self->{QUERY_MASTER} = $inputFrame->QueryMaster(-windowSet => $self))
	    ->pack(-side => 'right', -fill => 'x', -expand => 1);
	my $blotter = $menuFrame->Message('-text' => 'drop indicator', '-relief' => 'ridge' )->pack(-side => 'left');
	$window->DropSite(-dropcommand => sub {$self->dropHandler($window, @_)}, 
			  -entercommand => sub {return $self->dropIndicator({VIEW => $self->{VIEW_MASTER}->getDragWidget, 
									     QUERY => $self->{QUERY_MASTER}->getDragWidget}, 
									    $window, $blotter, @_)});
    }

    # now the namespace options for each source
    foreach my $sourceId (keys %{$args->{-namespaceHandler}->{NAMESPACE_REVERSE}}) {
	my $shortName = $args->{-namespaceHandler}->unmapString($sourceId);
	my $label = $shortName.' ('.$sourceId.')';
#	$window->Label(-text => $label, -justify => 'left')->pack(-anchor => 'w');
	my $m = $namespaceButton->menu(-tearoff => 0)->Menu(-title => $label); # , -direction => 'below');
	$namespaceButton->cascade(-label => $label);
	$namespaceButton->entryconfigure($label, -menu => $m);
#	my $namespaceFrame = $window->Frame(-relief => 'groove', -bd => 2)->pack(-padx => 20, -side => 'top');
	foreach my $expanded (keys %{$args->{-namespaceHandler}->{NAMESPACE_REVERSE}{$sourceId}}) {
	    my $ns = $args->{-namespaceHandler}->{NAMESPACE_REVERSE}{$sourceId}{$expanded};
	    $self->{ENS}{$sourceId}{$expanded} = 1;
#	    $namespaceFrame->Checkbutton(-text => "xmlns:$ns=\"$expanded\"", -variable => \ $self->{ENS}{$sourceId}{$expanded}, 
#					 -anchor => 'e', -padx => 5, -command => sub {$self->nsPick})->pack(-anchor => 'w');
	    $m->checkbutton(-label => "xmlns:$ns=\"$expanded\"", 
		    -command => sub {$self->nsPick}, -variable => \ $self->{ENS}{$sourceId}{$expanded});
	}
    }

    # a new frame provides the body for the search prompt, triple list, and graph canvas
    {
	my $listFrame = $window->Frame(-relief => 'groove', -bd => 2)->pack(-fill => 'both', -expand => 1, -side => 'top');
	my $searchFrame;
	{

	    # framed search prompt on the top
	    $searchFrame = $listFrame->Frame(-relief => 'groove', -bd => 2)->pack(-fill => 'x');

	    my $statementSet = new W3C::Rdf::TkVisualizer::StatementSet;
	    ($self->{STATEMENTS} = $listFrame->StatementListWidget(-windowSet => $self, 
								   -searchFrame => $searchFrame, 
								   -matrixWidget => $matrixWidget, 
								   -statementSet => $statementSet))
		->pack(-fill => 'both', -expand => 1);
	    ($self->{GRAPH} = $cw->Graph(-windowSet => $self, -statementSet => $statementSet))->pack;
	    ($self->{QRESULTS} = $cw->QueryResults(-windowSet => $self, -matrixWidget => $matrixWidget))->pack;

	    # View options:
	    # ... node
	    $searchFrame->Checkbutton(-text => 'query results', 
			     -underline => 5, 
			     -variable => $self->{QRESULTS}->getShowVariable, 
			     -command => sub {$self->{QRESULTS}->viewWindow})->pack(-anchor => 'w', -side => 'right', -padx => 10);
	    # ... graph
	    $searchFrame->Checkbutton(-text => 'graph', 
			     -underline => 5, 
			     -variable => $self->{GRAPH}->getShowVariable, 
			     -command => sub {$self->{GRAPH}->viewWindow})->pack(-anchor => 'w', -side => 'right', -padx => 10);
	    # ... reifications
	    $searchFrame->Checkbutton(-text => 'reifications', 
			     -underline => 5, 
			     -variable => \ $self->{SHOW_REIFICATIONS}, 
			     -command => sub {$self->changeLazyReification})->pack(-anchor => 'w', -side => 'right', -padx => 10);
#	    $searchFrame->Label(-text => 'View: ')->pack(-side => 'right');
	    # ... squashed
	    $searchFrame->Checkbutton(-text => 'squashed', 
			     -underline => 5, 
			     -variable => \ $self->{SQUASH_NODES}, 
			     -command => sub {$self->refreshList})->pack(-anchor => 'w', -side => 'right', -padx => 10);
	    $searchFrame->Label(-text => 'View: ')->pack(-side => 'right');
	}
    }

    # bottom row is just the exit and clone buttons
    {
	my $controlFrame = $window->Frame(-relief => 'groove', -bd => 2)->pack(-fill => 'x', -side => 'top');
	$controlFrame->Button(-text => "clone", -underline => 1, -command => sub {$self->cget(-main)->makeWindowSet})
	    ->pack(-side => 'left');
	$controlFrame->Button(-text => "exit", -underline => 1, -command => sub {$self->destroyWindow})
	    ->pack(-side => 'right');
    }

    $cw->Advertise('StatementListWidget' => $self->{STATEMENTS});
    $cw->ConfigSpecs(-main => ['PASSIVE', undef, undef, undef], 
		     -attributionsByInputSource => ['PASSIVE', undef, undef, undef], 
		     -queryOptions => ['PASSIVE', undef, undef, undef], 
		     -namespaceHandler => ['PASSIVE', undef, undef, undef], 
		     -RdfDB => ['PASSIVE', undef, undef, undef], 
		     -RdfApp => ['PASSIVE', undef, undef, undef], 
		     -systemId => ['PASSIVE', undef, undef, undef], 
		     -noColumns => ['PASSIVE', undef, undef, undef]);
    $cw->Delegates(DEFAULT => $self->{STATEMENTS});
}

sub fileActions {
    my ($self, $operation) = @_;
    if ($operation eq 'save') {
	if ($self->{-saveFileSpec} && $self->serializeCurrentView) {
	    return;
	} else {
	    $operation = 'saveAs';
	}
    }
    local($^W) = 0;
    require Tk::FBox;
  Tk::FBox->import('as_default');
    # XXX remove cached dialogs
    my $mw = $self->MainWindow;
    delete $mw->{'tk_getOpenFile'};
    delete $mw->{'tk_getSaveFile'};
    my @types =
	(["RDF files",          [qw/.rdf .RDF/]],
	 ["RDF files",          '',             'TEXT'],
	 ["XML files",          [qw/.xml .XML/]],
	 ["XML files",          '',             'TEXT'],
	 ["Text files",         [qw/.txt/]],
	 ["Text files",         '',             'TEXT'],
	 ["All files",		'*']
	 );
    my $file;
    if ($operation eq 'open') {
	$file = $mw->getOpenFile(-title => 'get RDF file', -filetypes => \@types, 
				 -initialdir => $self->{-lastDir});
	if (defined $file && $file ne '') {
	    $self->readFile($file);
	}
    } elsif ($operation eq 'saveAs') {
	$file = $mw->getSaveFile(-title => 'save RDF file', -filetypes => \@types,
				 -initialfile => 'Untitled',
				 -defaultextension => '.rdf');
	if (defined $file && $file ne '') {
	    $self->{-saveFileSpec} = $file;
	    $self->serializeCurrentView;
	}
    }
    if ($file =~ m/^ (.*?) \/ ([^\/]+) $/x) {
	$self->{-lastDir} = $1;
	$self->{-lastFile} = $2;
    }
}

sub readFile {
    my ($self, $file) = @_;
    if (my $newId = $self->cget(-RdfApp)->parseOne($file)) {
	$self->renderView($newId);
    }
}

sub serializeCurrentView {
    my ($self) = @_;
    if (open (OUTFILE, '>'.$self->{-saveFileSpec})) {
	eval {
	    my $handle = \ *OUTFILE;
	    my $publicId = &W3C::XML::FileInputSource::makePublicId($self->{-saveFileSpec});
	    use W3C::XML::XmlSerializer;
	    my $xmlSerializer = new W3C::XML::XmlSerializer(-target => $handle, 
							    -publicId => $publicId, 
							    -systemId => $publicId, 
							    -prettyPrint => 1);
	    my $serializer = new W3C::XML::UriXmlSerializer(-xmlSerializer => $standardSerializer, 
							    -namespaceElementSweep => 5, 
							    -namespaceElementTrip => 2, 
							    -namespaceForce => [$RDF_SCHEMA_URI]);
	    my $iterator = $self->cget(-RdfDB)->makeSerializerIterator([$self->getStatements], 
								       {-scheme => 'guess', 
									-serializeIgnoreReifications => 1, 
									-allowAnonymousRefs => 1, 
									-ignoreAnonymousReifications => 1, 
									-serializeNoNodeAttrs => 0});
	    $iterator->iterate($serializer);
	}; if ($@) {if (my $ex = &catch('W3C::Util::Exception')) {
	    my $string = $ex->toString;
	    print OUTFILE $string;
	    $self->Dialog(-title => 'serialization exception', -text => $string, 
			  -default_button => 'Bummer', -buttons => ['Bummer', 'OK'])->Show;
	} else {
	}}
	close (OUTFILE);
	return 1;
    } else {
	return 0;
    }
}

sub namespaceActions {
    my ($self, $operation) = @_;
    if ($operation eq 'add') {
	my $dialog = $self->TkNamespaceEditor(-title		=> 'create a namespace',
					      -defaultNamespace	=> undef,
					      -windowSet	=> $self, 
					      -namespaceHandler	=> $self->cget(-namespaceHandler), 
					      -knownAttributions => $self->{-knownAttributions}, 
					      -attributionsByInputSource => $self->cget(-attributionsByInputSource));
#	$dialog->pack;
    }
}

sub dropIndicator {
    my ($self, $indicators, $window, $blotter, $flag, $X, $Y) = @_;
    my $status = $flag  ? 'sunken' : 'ridge';
    $blotter->configure(-relief => $status);
    return 1;
    print 'WindowSet::dropIndicator('.join (' | ', @_).")\n";
    eval {
	my @targ = $window->SelectionGet(-selection => 'XdndSelection', 'VIEW');
	print 'VIEW: '.join (' | ', @targ)."\n";
    };
    eval {
	my @targ = $window->SelectionGet(-selection => 'XdndSelection', 'QUERY');
	print 'QUERY: '.join (' | ', @targ)."\n";
    };
    my @targ;
    eval {
	@targ = $window->SelectionGet(-selection => 'XdndSelection', 'TARGETS');
	print 'targets: '.join (' | ', @targ)."\n";
	foreach my $type (@targ) {
	    eval {
		if (my $indicator = $indicators->{$type}) {
		    print "$indicator->configure(-relief => $status)\n";
		    $indicator->configure(-relief => $status);
		}
	    };
	}
    };
    return 1;
    foreach my $type (keys %$indicators) {
	eval {
	    if ($window->SelectionGet(-selection => 'XdndSelection', $type)) {
		$indicators->{$type}->configure(-relief => $flag  ? 'sunken' : 'ridge');
	    }
	};
    }
    return 1;
}

use Data::Dumper;
sub dropHandler
{
    my ($self, $lb, $seln) = @_;
    my @views;
  TYPE:
    foreach my $type (qw(QUERY VIEW FILE_NAME STRING)) {
	eval {
	    my @values = $lb->SelectionGet(-selection => $seln, $type);
	    if (@values) {
		foreach my $dropped (@values) {
		    push (@views, $dropped);
		    if ($dropped =~ m/^ \s* \(/x) {
		    } else {
			$dropped =~ s/file\:\/\/beastie//;
			$self->readFile($dropped);
		    }
		}
		last TYPE;
	    }
	};
    }
    return if (@views);
    print 'WindowSet::dropHandler('.join (' | ', @_).") on unknown drop type\n";
    my @targ = $lb->SelectionGet(-selection => $seln, 'TARGETS');
    my %args;
    foreach my $type (@targ) {
	if ($type =~ /FILE_NAME|VIEW|QUERY/) {
	    print "$lb->SelectionGet(-selection => $seln, $type)\n";
	    my $value = $lb->SelectionGet(-selection => $seln, $type);
	    push (@{$args{$type}}, $value);
	    print "$type($seln):$value\n";
	}
	if ($type =~ /_SUN/ && $type !~ /(END|ACK|DONE|YIELD)/) {       
	    my @info;
	  Tk::catch { @info  = $lb->SelectionGet(-selection => $seln, $type) };
	    if ($@) {
		print "Cannot get $type\n";
	    } else {
		print "$type:", Dumper(\@info);
	    }
	}
	if ($^O eq 'MSWin32' && $type =~ /STRING/) {
	    print "$type:",$lb->SelectionGet(-selection => $seln, $type),"\n";
	} 
    }
    if (my $views = $args{VIEW}) {
	foreach my $view (@$views) {
	    $view =~ s/file\:\/\/beastie//;
	    $self->readFile($view);
	}
    }
}

sub importNamespaces {
    my ($self, $namespaces) = @_;
    foreach my $namespaceSpec (@$namespaces) {
	# http://beastie.w3.org/ xmlns:dc="http://www.purl.org/"
	if ($namespaceSpec =~ m/^ \s* (\S+) \s+ xmlns \: (\w+) \=\" ([^\"]+) \" \s* $/x) {
	    my ($sourceId, $namespace, $url) = ($1, $2, $3);
	    $self->cget(-namespaceHandler)->addNamespace($namespace, $url, $sourceId);
	} else {
	    &throw(new W3C::Util::Exception(-message => "couldn't parse \"$namespaceSpec\""));
	}
    }
}

sub renderView {
    my ($self, $viewName) = @_;
    $self->{VIEW_MASTER}->passed($viewName);
    $self->refreshList;
}

sub renderQueries {
    my ($self, $queries) = @_;
    foreach my $alga (@$queries) {
	$self->{QUERY_MASTER}->passed($alga);
    }
}

sub getQueryOptions {
    my ($self) = @_;
    return defined $self->cget(-queryOptions) ? %{$self->cget(-queryOptions)} : ();
}

sub destroyWindow {
    my ($self) = @_;
    $self->{CONTROL_WINDOW}->destroy();
    $self->cget(-main)->notifyExit($self)
}

sub changeLazyReification {
    my ($self) = @_;
    my $statementHandle = $self->{STATEMENTS}->getCurrentStatement;
    $self->cget(-RdfDB)->setLazyReification(!$self->{SHOW_REIFICATIONS});
    $self->refreshList;
    $self->hilightStatement($statementHandle);
}

sub nsPick {
    my ($self) = @_;
    $self->refreshList;
}

sub getAttributionsForSources { # for ViewMaster
    my ($self, $sources) = @_;
    my (@nextAttribs, @nextSources, $errors);
    my $attributionsByInputSource = $self->cget(-attributionsByInputSource);
    foreach my $source (@$sources) {
	if (exists $attributionsByInputSource->{$source}) {
	    push (@nextAttribs, $attributionsByInputSource->{$source});
	    push (@nextSources, $source);
	} elsif ($source !~ /^\s*$/) {
	    $errors++;
	}
    }
    return ($errors, \@nextSources, \@nextAttribs);
}

sub triplesMatching {
    return shift->cget(-RdfDB)->triplesMatching(@_);
}

sub guessQuery {
    my $queryHandler = shift->cget(-RdfDB)->getAlgaeInterface;
    return $queryHandler->guessQuery(@_);
}

sub getViewMaster {
    return shift->{VIEW_MASTER};
}

sub renderStatement {
    my ($self, $statement) = @_;
    my $attribution = $statement->getAttribution;
    my $attributionUri = undef;
    if (defined $attribution) {
	eval {
	    $attributionUri = $attribution->getUri;
	}; if ($@) {
	    print "here: ".$statement->toString."\n";
	    eval {
		$attribution->toString;
	    }
	}
    }
    $self->{-knownAttributions}{$attributionUri} = $statement if ($attribution);

    my ($sourceId, $key, $predicateText) = 
	$self->cget(-namespaceHandler)->unmapNamespace($statement->getPredicate->toString, $attributionUri);
    my @segments;
    my $enabled = !defined $sourceId && !defined $key || $self->{ENS}{$sourceId}{$key};
    if ($enabled) {
	my %attrFlags = (-showAttributions => 1);
	if ($self->{SQUASH_NODES}) {
	    $attrFlags{-namespaceHandler} = $self->cget(-namespaceHandler);
	}
	push (@segments, $attribution->toString(%attrFlags));
	push (@segments, '(');
	push (@segments, $self->renderNode($statement->getPredicate, $attribution));
	push (@segments, $self->renderNode($statement->getSubject, $attribution));
	push (@segments, $self->renderNode($statement->getObject, $attribution, {-stringTrunc => 30,
											       -truncFlag => '...'}));
	push (@segments, ')');
	push (@segments, $statement->getReifiedAs ? $self->renderNode($statement->getReifiedAs, $attribution) : '');
	push (@segments, $statement->getReifiedIn ? $self->renderNode($statement->getReifiedIn, $attribution) : '');
    }
    return ($enabled, \@segments);
}

sub renderNode {
    my ($self, $node, $attribution, $flags, $enabled) = @_;
    my $namespaceId = $attribution ? $attribution->getUri : undef;
#    my $unsquashed = $node->toString(undef, undef, $flags);
#    my ($sourceId, $namespace, $squashed) = 
#	$self->cget(-namespaceHandler)->unmapNamespace($unsquashed, $namespaceId);
    my %nodeFlags = {%$flags, -namespaceHandler => $self->cget(-namespaceHandler)};
    my $squashed = $node->toString(%nodeFlags);
    my ($sourceId, $namespace) = ($nodeFlags{-namespacePrefix}, $nodeFlags{-namespaceNs});
    if ($enabled) {
	$$enabled = !defined $sourceId && !defined $namespace || $self->{ENS}{$sourceId}{$namespace};
    }
    return $self->{SQUASH_NODES} ? $squashed : $node->toString(%flags);
}

# control window event redirections
sub addView {return shift->{VIEW_MASTER}->add(@_);}
sub getStatements {return shift->{VIEW_MASTER}->getStatements(@_);}
sub setProofViews {return shift->{QRESULTS}->setProofViews(@_);}
sub refreshQueryResults {return shift->{QRESULTS}->refresh(@_);}
sub showQueryResultsWindow {return shift->{QRESULTS}->showWindow(@_);}
sub refreshList {return shift->{STATEMENTS}->refreshList(@_);}
sub findTriple {return shift->{STATEMENTS}->findTriple(@_);}
sub graphNode {return shift->{GRAPH}->graphNode(@_);}
sub graphStatement {return shift->{GRAPH}->graphStatement(@_);}
sub showGraphWindow {return shift->{GRAPH}->showWindow(@_);}

sub toString {
    my ($self, $prefix, $namespaceHandler) = @_; $prefix = '  ' if (!defined $prefix);
    my $ret = '';
    $ret .= $prefix.$self."\n";
    $ret .= $prefix.'RDF_PREFIX: '.$self->{RDF_PREFIX}."\n";
    $ret .= $prefix.'-sourceAttribution: '.$self->{-sourceAttribution}->dump."\n" if ($self->{-sourceAttribution});
    $ret .= $prefix."NAMESPACES:\n";map {$ret .= $prefix.'  '.$_.': '.$self->{NAMESPACES}{$_}."\n"} keys %{$self->{NAMESPACES}};
    $ret .= $prefix."CONTAINERS:\n";map {$ret .= $self->{CONTAINERS}{$_}->toString()} keys %{$self->{CONTAINERS}};
    $ret .= $prefix."ABOUT_EACH:\n";map {$ret .= $prefix.'  '.$_.': ('.join(',', @{$self->{ABOUT_EACH}{$_}}).")\n"} keys %{$self->{ABOUT_EACH}};
    $ret .= $prefix."ABOUT_EACH_PREFIX:\n";map {$ret .= $prefix.'  '.$_.': ('.join(',', @{$self->{ABOUT_EACH_PREFIX}{$_}}).")\n"} keys %{$self->{ABOUT_EACH_PREFIX}};
    $ret .= $prefix."TRIPLES:\n";
    $ret .= $self->showTriples($prefix.'  ', $namespaceHandler);
    return $ret;
}

__END__

1;

