$APE::Tk::AtomicProcessEngine::VERSION = '1.1';

package APE::Tk::AtomicProcessEngine;

use strict;
use warnings;

use Carp;

use Tk::widgets qw/MainWindow NoteBook Adjuster Dialog DialogBox Splashscreen JPEG/;
use base qw/Tk::Derived Tk::MainWindow/;

use APE::Tk::ProcessTree;
use APE::Tk::RequirementDisplayer;
use APE::Tk::ResultContainer;
use APE::Tk::TractSelector;
use SITk::LoginBar;
use SITk::OutputBox;
use User;

use constant TRUE  => 1;
use constant FALSE => 0;

Construct Tk::Widget 'AtomicProcessEngine';

## List of super users that are granted extra powers such as
## transaction control for debugging.
my @superUsers = (qw/holroyd/);


########################################################################
## Standard Tk mega widget method for creating this mega widget and 
## initialising the super class widget.
########################################################################
sub ClassInit {
    my ($class,$mw) = @_;
    $class->SUPER::ClassInit($mw);
}


########################################################################
## Standard Tk mega widget method for defining mega widget
## characteristics and capturing arguments unknown to Tk.
########################################################################
sub Populate {
    my ($self,$args) = @_;
    croak "ERROR: argument -user is missing" unless $args->{-user} && $args->{-user}->isa('User');
    $self->{_user} = delete $args->{-user};
    $self->{_tractCaching} = delete $args->{-tractCaching} || TRUE;
    $self->{_logo} = $self->Photo(-file=>Tk::findINC("APE/Tk/Images/ape_logo.gif"));
    $self->{_smallFont}    = $self->Font(-family=>'Helvetica',-size=>10);
    $self->{_mediumFont}   = $self->Font(-family=>'Helvetica',-size=>14);
    $self->{_largeFont}    = $self->Font(-family=>'Helvetica',-size=>20);
    $args->{-startcommand} = [\&populateWorkArea,$self] unless $args->{-startcommand};
    $self->_createWindow;
    $self->_showWelcomeMessage;
    #$self->FullScreen;
    $self->SUPER::Populate($args);
    $self->ConfigSpecs(-startcommand   => [$self->{_processTree}]);
    $self->Advertise('outputBox'       => $self->{_outputBox});
    $self->Advertise('requirementPage' => $self->{_requirementPage});
    $self->Advertise('processTree'     => $self->{_processTree});
    my $screenWidth  = $self->screenwidth;
    my $screenHeight = $self->screenheight;
    $self->geometry(($screenWidth-200)."x".($screenHeight-200));
    #eval  { $self->_loadProcessTract(TRUE); };
    #if($@){ croak $@; }
}


########################################################################
## Method to create and show the tract selector dialog box. The user
## may then select any or all of the tracts they wish to have loaded or
## unloaded from the ProcessTree widget.
########################################################################
sub _selectTract {
    my ($self,%args) = @_;
    my ($selected,$selectedProcessList) = eval { $self->TractSelector(%args)->Show; };
    croak $@ if $@;
    if($selected eq 'Cancel' || scalar(@{$selectedProcessList})==0) { 
	return undef;
    }
    return $selectedProcessList;
}


########################################################################
## Method to load/unload a process tract. This method displays a
## TractSelector dialog widget requesting the user to select the
## process tract to load/unload.  The selected tracts are then sent to
## the ProcessTree widget to load/unload as required.
########################################################################
sub _loadProcessTract {
    my ($self,$isLoading) = @_;
    eval { my $selectedProcessList =
	       $self->_selectTract
	       (-loadedApeHash => $self->{_processTree}->getLoadedProcesses,
		-isLoading     => $isLoading);
	   if($isLoading && ref $selectedProcessList eq 'ARRAY') {
	       my $splashScreen = $self->_createSplashScreen;
	       local $SIG{__WARN__} = sub {
	       	   my $msg = shift;
	       	   push(@{$self->{_tractLoadingData}},$msg);
	       	   $self->{_splText}->insert('end',$msg);
	       	   $self->{_splText}->see('end');
	       	   $self->{_splText}->update('idletasks');
	       };
	       foreach my $process (@{$selectedProcessList}) {
		   my $toLoad = $process->getProcessId;
		   if(exists($self->{_apeCache}{$toLoad})) {
		       print STDERR "Found a cached APE object - sending it to be reloaded\n";
		       $toLoad = $self->{_apeCache}{$toLoad};
		   }
		   $self->{_processTree}->loadProcessId($toLoad) 
		       if $isLoading;
	       }
	       $splashScreen->Destroy;
	   }else{
	       foreach my $process (@{$selectedProcessList}) {
		   $self->{_processTree}->unloadProcessId
		       ($process->getProcessId) if !$isLoading;
	       }
	   }
       };
    croak $@ if $@; 
}


########################################################################
## Method to start the creation of the major widget groups that make up
## this mega widget.
########################################################################
sub _createWindow {
    my $self = shift;
    $self->_createFrames;
    $self->_createMainWidgets;
    $self->_createTopLevelWidgets;
    $self->_createMenus;
    $self->_addNotebookPages;
    $self->_createGlobalBinds;
}


########################################################################
## Method to display a welcome message to the user when they start up  
## the AtomicProcessEngine GUI.
########################################################################
sub _showWelcomeMessage {
    my $self = shift;
    $self->{_outputBox}->updateBox(-itemtype=>'text',
				   -textStruct=>["Welcome to ExoAPE",
						 "Please log in to start your session."]);
}


########################################################################
## Method to create the frames used to tie the APE tools together in.  
########################################################################
sub _createFrames {
    my $self = shift;
    $self->{_menuFrame}  = $self->Frame(-relief=>'groove',-borderwidth=>1)->pack(-fill=>'x');
    $self->{_titleFrame} = $self->Frame(-relief=>'groove',-borderwidth=>1)->pack(-fill=>'x');
}


########################################################################
## Method to create the top level widgets that together make the face of
## the AtomicProcessEngine GUI.
########################################################################
sub _createTopLevelWidgets {
    my $self = shift;
    $self->{_titleCanvas} = $self->{_titleFrame}->Canvas(-width=>140,-height=>4,-bg=>'white');
    $self->{_outputBox}   = $self->{_titleFrame}->Scrolled('OutputBox',-scrollbars=>'osoe',-bg=>'white',-height=>8);
    
    $self->{_titleCanvas} ->grid(-column=>0,-row=>1,-sticky=>'nesw');
    $self->{_outputBox}   ->grid(-column=>1,-row=>1,-sticky=>'nesw');
    
    $self->{_titleFrame}->gridRowconfigure(1,-weight=>1);
    $self->{_titleFrame}->gridColumnconfigure(1,-weight=>1);

    $self->{_titleCanvas}->createImage(70,70,-image=>$self->{_logo});
}


#######################################################################
## Method to create the menu button widgets and point them at their
## respective method calls to get their menu items.
#######################################################################
sub _createMenus {
    my $self = shift;
    $self->{_fileMenu} = 
	$self->{_menuFrame}->Menubutton(-text=>'File',-tearoff=>0,-underline=>0,
					-menuitems=>&_fileMenuItems($self));
    $self->{_editMenu} = 
	$self->{_menuFrame}->Menubutton(-text=>'Edit',-tearoff=>0,-underline=>0,
					-menuitems=>&_editMenuItems($self));
    $self->{_viewMenu} = 
	$self->{_menuFrame}->Menubutton(-text=>'View',-tearoff=>0,-underline=>0,
					-menuitems=>&_viewMenuItems($self));

    $self->{_toolsMenu} = 
	$self->{_menuFrame}->Menubutton(-text=>'Tools',-tearoff=>0,-underline=>0,
					-menuitems=>&_toolsMenuItems($self));

    $self->{_helpMenu} = 
	$self->{_menuFrame}->Menubutton(-text=>'Help',-tearoff=>0,-underline=>0,
					-menuitems=>&_helpMenuItems($self));

    $self->{_fileMenu} ->pack(-side=>'left',-padx=>3);
    $self->{_editMenu} ->pack(-side=>'left',-padx=>3);
    $self->{_viewMenu} ->pack(-side=>'left',-padx=>3);
    $self->{_toolsMenu}->pack(-side=>'left',-padx=>3);
    $self->{_helpMenu} ->pack(-side=>'right',-padx=>3);
}


#######################################################################
## Method to create the main widgets that offer the functionality that
## collectively offer the AtomicProcessEngine GUI re-arraying
## functionality.
#######################################################################
sub _createMainWidgets {
    my $self = shift;

    $self->{_processTree} = $self->ProcessTree
	(-showProcessIds=>1,
	 -user  => \$self->{_user},
	 -state => 'disabled',
	 -width => 210,
	 -postloadcmd=>sub{ 
	     my ($loadedProcessCount,$newApe) = @_;
	     my $description = $newApe->getTopLevelProcess->getDescription;
	     my $processId   = $newApe->getTopLevelProcess->getProcessId;
	     $self->{_outputBox}->
		 updateBox(-itemtype=>'text',-textStruct=>
			   ["Successfully loaded '$description' process tract.",
			    ["Loaded process tract has top level process ".
			     "id '$processId'."]]);
	 },
	 -postunloadcmd=>sub{
	     my ($loadedProcessCount,$oldApe) = @_;
	     my $description = $oldApe->getTopLevelProcess->getDescription;
	     my $processId   = $oldApe->getTopLevelProcess->getProcessId;
	     $self->{_outputBox}->
		 updateBox(-itemtype=>'text',-textStruct=>
			   ["Successfully unloaded '$description' ".
			    "process tract.",
			    ["Unloaded process tract has top level process ".
			     "id '$processId'."]]);
	     $self->{_apeCache}{$processId} = $oldApe;
	     
	     
	     ## XXX: Remove the currently visible RequirementContainer if 
	     ## it represents a process in the unloaded tract.
	 });

#    my $startCommand = $self->cget('-startcommand');
#    print "StartCommand: $startCommand\n";
#
#    $self->{_processTree}->configure(-startcommand=>$self->cget('-startcommand'));
    $self->{_adjuster} = $self->Adjuster(-restore=>0,-widget=>$self->{_processTree});

    my $frame = $self->Frame;
    my $frame1 = $frame->Frame(-relief=>'ridge',-borderwidth=>1);
    $self->{_loginBar} = $frame1->LoginBar(-roleType=>'ExoSeq',-logincommand=>[\&_login,$self],
					   -logoutcommand=>[\&_logout,$self]);
    $self->{_noteBook}    = $frame->NoteBook;
    $self->{_tree}        = $self->{_processTree}->Subwidget('tree');
    $self->{_refreshBttn} = $self->{_processTree}->Subwidget('refreshBttn');

    $self->{_processTree}->pack(-side=>'left',-fill=>'both');
    $self->{_adjuster}   ->packAfter($self->{_processTree},-side=>'left');

    $frame               ->pack(-fill=>'both',-expand=>1);
    $frame1              ->pack(-fill=>'x',-pady=>5,-padx=>5);
    $self->{_loginBar}   ->pack(-side=>'right',-fill=>'x');
    $self->{_noteBook}   ->pack(-fill=>'both',-expand=>1);

    $self->{_showProcessIds} = $self->{_processTree}->getShowProcessIds;
}


#######################################################################
## Callback method from the LoginBar widget. This method is called when
## the user attempts to login.
#######################################################################
sub _login {
    my ($self,$user) = @_;
    $self->{_user}        = $user;
    $self->{_isSuperUser} = $self->_isSuperUser;
    $self->{_outputBox}->
	updateBox(-itemtype  =>'text',
		  -textStruct=>["Hello ".$self->{_user}->getFullName .
				", welcome to APE - please select a process to start.",
				["Super user mode is " . ($self->{_isSuperUser} == TRUE ? "enabled" : "disabled")],
				["A process can be found in the process tree - double click here",
				 $self->{_processTree},
				 "A process is prefixed with a circle."]]);
    $self->{_processTree}->configure(-state=>'normal');
    $self->_loadProcessTract(TRUE);
}


#######################################################################
## Callback method from the LoginBar widget. This method is called when
## the user attempts to logout, returning false will prevent the logout,
## returning true allows the logout to commence. 
#######################################################################
sub _logout {
    my $self = shift;
    $self->{_processTree}->configure(-state=>'disabled');
    return FALSE if $self->_verifyResults;
    _destroyWidget($self->{_requirementDisplayer});
    $self->removeNoSelectionText;
    $self->addNoSelectionText;
    $self->{_noteBook}->raise('requirements');
    $self->{_outputBox}->updateBox(-itemtype  =>'text',
				   -textStruct=>["Goodbye!"]);
    return TRUE;
}


#######################################################################
## Method to add the required pages to the NoteBook widget.
#######################################################################
sub _addNotebookPages {
    my $self = shift;
    $self->{_requirementPage} = 
	$self->{_noteBook}->add('requirements',-label=>'Requirements',-raisecmd=>[\&_verifyResults,$self]);
    $self->{_resultPage}      = 
	$self->{_noteBook}->add('results',-label=>'Results',-state=>'disabled');
    $self->{_resultPage}->bind('<FocusOut>' => [\&_verifyResults,$self]);
    $self->addNoSelectionText;
}


#######################################################################
## Method to verify that the user commits or rolls back any outstanding 
## Result objects before starting a new process. This method is called
## when any of the other notebook pages are raised. If a ResultContainer
## object exists but does not contain any unflushed Result objects, then
## the ResultContainer is unmapped and deleted before the results page
## is disabled, otherwise a Dialog is displayed to the user requesting
## that they commit or rollback the outstanding Result objects.
#######################################################################
sub _verifyResults {
    my $self = shift;
    if(Tk::Exists($self->{_resultContainer})) {
	my $ans = 
	    $self->Dialog(-title   => "Results",
			  -text    => "Results will be lost are you sure you wish to continue?",
			  -buttons => ['Yes','No'])->Show;
	if($ans eq 'No') {
	    $self->{_noteBook}->raise('results');
	    return TRUE;
	}
	_destroyWidget($self->{_resultContainer});
	$self->{_noteBook}->pageconfigure('results',-state=>'disabled');
	$self->{_processTree}->configure(-state=>'normal');
    }
    return FALSE;
}


#######################################################################
## Method to add a new page to the notebook and return a reference to
## the new page so the tool can be attached to it.
#######################################################################
sub createToolPage {
    my ($self,%args) = @_;
    my $label = delete $args{-label};
    $self->{_toolPages}{"\_$label"} = 
	$self->{_noteBook}->add(lc($label),-label=>$label,
				-raisecmd=>[\&alterState,$self]);
    return $self->{_toolPages}{"\_$label"};
}


#######################################################################
## Method to create all of the global binds for ExoAPE widgets.
#######################################################################
sub _createGlobalBinds {
    my $self = shift;
    $self->{_refreshBttn}->configure(-command=>sub{ _destroyWidget($self->{_requirementDisplayer}); 
						    $self->{_processTree}->refresh(); });
}


#######################################################################
## Method to start a process. This method is a callback from a double
## button 1 mouse click in the ProcessTree widget. The -data attribute,
## which can be either a Process or AtomicProcessContainer object, is
## retrieved. This method is only interested in the latter.  A
## RequirementDisplayer widget is created with the APC.
#######################################################################
#sub _startProcess {
sub populateWorkArea {
    my ($self,$processData) = @_;
    
    my $apc;
    $self->toplevel->Busy;
    $self->{_parentDesc}  = $processData->[0][0];
    $self->{_processDesc} = $processData->[0][1];
    my $process           = $processData->[0][2];
    my $atomicProcessContainer = $process->getSubProcessList->[0];
    
    ## Check that the apc parsed in is an AtomicProcessContainer object.
    unless(UNIVERSAL::isa($atomicProcessContainer,'APE::AtomicProcessContainer')) {
	$self->{_outputBox}->
	    updateBox(-itemtype  =>'text',
		      -textStruct=>["Selection is not an AtomicProcessContainer - please try again.",
				    ["Please select a process that is prefixed with a circle.",
				     "A circle denotes an AtomicProcess that can be executed."]]);
	$self->toplevel->Unbusy;
	return;
    }
    
    ## Destroy any RequirementDisplayer widgets in existence.
    _destroyWidget($self->{_requirementDisplayer});
    $self->removeNoSelectionText;
    ## Create the RequirementDisplayer widget.
    $self->{_requirementDisplayer} = 
	$self->{_requirementPage}->RequirementDisplayer
	(-parentDesc=>$self->{_parentDesc},-description=>$self->{_processDesc},
	 -wrap=>0,-atomicProcessContainer=>$atomicProcessContainer,
	 -duplicateData=>FALSE,
	 -resultcommand=>[\&_handleResults,$self,$atomicProcessContainer->getOutputController],
	 -submitcommand=>sub {
	     if(!$self->{_user}->getWorkingTeam()) {
		 ## Team has not been selected - can't continue. This
		 ## usually means that the SITk::LoginBar didn't get a
		 ## default team for the user using the ExoSeq (or
		 ## whatever) role type.
		 $self->{_outputBox}->
		   updateBox(-itemtype   => "text",
			     -textStruct =>
			     ["Team not set",
			      ["Your team number is not set",
			       "This usually means your default team does ".
			       "not have role permissions to run this software"]]);
		 return undef;
	     }else{
		 $self->{_outputBox}->
		   updateBox(-itemtype  =>'text',
			     -textStruct=>["Process submitted",
					   [$self->{_parentDesc},
					    $self->{_processDesc}],
					   ["User details...",
					    "Email: ".$self->{_user}->getEmail,
					    "Team: ".$self->{_user}->getWorkingTeam->getTeamName]]);
		 $self->{_splashScreen} = $self->_createSplashScreen;
		 $self->{_sigWarn} = $SIG{__WARN__};
		 $SIG{__WARN__} = sub {
		     my $msg = shift;
		     push(@{$self->{_processExecData}},$msg);
		     $self->{_splText}->insert('end',$msg);
		     $self->{_splText}->see('end');
		     $self->{_splText}->update('idletasks');
		 };
		 return 1;
	     }
	 },
	 -errorcommand=>sub{ 
	     if(Tk::Exists($self->{_splashScreen})) {
		 $self->{_splashScreen}->Destroy;
		 $SIG{__WARN__} = $self->{_sigWarn};
	     }
	     
	 })
	->pack(-fill=>'both',-expand=>1,-pady=>10,-padx=>10);
    
    $self->toplevel->Unbusy;
}

#######################################################################
## Method to add the 'Nothing to display' text to the start up frame in
## place of any future RequirementDisplayer widgets.
#######################################################################
sub addNoSelectionText {
    my ($self,$text) = @_;
    $self->{_noSelectionTextFrame} = $self->{_requirementPage}->Frame->pack(-fill=>'both',-expand=>1);
    $self->{_noSelectionTextFrame}->Label(-text=>"Nothing to display...",-font=>$self->{_largeFont})->grid;
    $self->{_noSelectionTextFrame}->Label(-text=>($text ? $text : "Please log in and select a process"),
					  -font=>$self->{_mediumFont})->grid;
}


## Method to remove the frame containing the 'No selection' text. This
## text is show before login and after logout.
sub removeNoSelectionText {
    my $self = shift;
    _destroyWidget($self->{_noSelectionTextFrame});
}


#######################################################################
## Method to handle the results of a process having being completed.
## The results are represented as Result objects that are infact
## suspended transactions to the database. The Result objects are
## passed to a ResultContainer.
#######################################################################
sub _handleResults {
    my ($self,$outputController,$results) = @_;

    if(Tk::Exists($self->{_splashScreen})) {
	$self->{_splashScreen}->Destroy;
	$SIG{__WARN__} = $self->{_sigWarn};
    }

    $self->{_processTree}->configure(-state=>'disabled');

    eval {
	$self->{_resultContainer} =
	    $self->{_resultPage}->ResultContainer
	    (-results            => $results,
	     -description        => $self->{_processDesc},
	     -outputController   => $outputController,
	     -outputBox          => $self->{_outputBox},
	     -transactionControl => $self->{_isSuperUser})
	    ->pack(-fill=>'both',-expand=>1,-pady=>10,-padx=>10);
    };

    if($@){ croak $@; }

    $self->{_noteBook}->pageconfigure('results',-state=>'normal');
    $self->{_noteBook}->raise('results');
}


#######################################################################
## Method to return boolean if the current user should be considered as
## a super user and be granted extra powers such as control over
## transactions.
#######################################################################
sub _isSuperUser {
    my $self  = shift;
    my $email = $self->{_user}->getEmail; 
    foreach my $superUser (@superUsers) {
	if($superUser eq $email) {
	    return TRUE;
	}
    }
    return FALSE;
}


#######################################################################
## Method to alter the state of the Interpolate widget depending 
## on if any requirements have been selected in the Requiremet
## Displayer widget (if one exists).
#######################################################################
sub alterState {
    my ($self,$pageFrame) = @_;
    return if $self->_verifyResults;
    my $tool = ($pageFrame->children)[0];
    if(my $subWidget = $tool->Subwidget('scrolled')) {
	$tool = $subWidget;
    }
    if(Tk::Exists($self->{_requirementDisplayer})) {
    	my $selected = $self->{_requirementDisplayer}->getSelectedEntries;
    	unless(scalar(@{$selected}) == 0) {
	    $tool->configure(-state=>'normal');
	    $tool->setInterestedWidgets($selected);	    
	    return;
    	}
    }
    
    $tool->configure(-state=>'disabled');
}


#######################################################################
## Method to raise the requirements page on the NoteBook widget.
#######################################################################
sub raiseRequirementPage {
    my $self = shift;
    print STDERR "GOT HERE\n";
    $self->{_noteBook}->raise('requirements');
}


#######################################################################
## Method to destroy a Tk widget if it exists. 
#######################################################################
sub _destroyWidget {
    my $widget = shift;
    if(Tk::Exists($widget)) { $widget->destroy; }
}


#######################################################################
## Method to create the 'About' dialog and display it to the user.  
#######################################################################
sub _createAboutDialog {
    my $self = shift;
    my $ad         = $self->DialogBox(-title=>"Test",-buttons=>['OK']);
    my $frame      = $ad->add('Frame')->pack(-fill=>'both',-expand=>1);
    my $width      = $self->{_logo}->width;
    my $height     = $self->{_logo}->height;
    my $canvas     = $frame->Canvas(-width=>$width,-height=>$height)->pack(-side=>'left',-fill=>'x',-expand=>1);
    my $dataFrame  = $frame->Frame->pack(-side=>'left',-fill=>'x',-expand=>1);
    $canvas->createImage(0,0,-anchor=>'nw',-image=>$self->{_logo});
    $dataFrame->Label(-text=>'Author: Simon Holroyd')->pack;
    $dataFrame->Label(-text=>'Email: holroyd@sanger.ac.uk')->pack;
    $dataFrame->Label(-text=>"GUI Version: ".$APE::Tk::AtomicProcessEngine::VERSION)->pack;
    $dataFrame->Label(-text=>"APE Version: ".$self->{_processTree}->getApeVersion)->pack;
    $ad->Show;
}


#######################################################################
## Method to produce a TopLevel widget that displays the data associated
## with the loading of process tracts.
#######################################################################
sub _showTractLoadingData {    
    my $self = shift;
    my $ssd    = $self->DialogBox(-title=>"Tract loading data",-buttons=>['OK']);
    my $frame  = $ssd->add('Frame')->pack(-fill=>'both',-expand=>1);
    my $text   = $frame->Scrolled('ROText',-scrollbars=>'osoe',-bg=>'white',-font=>$self->{_smallFont},-wrap=>'none');
    $text->pack(-fill=>'both',-expand=>1);
    foreach(@{$self->{_tractLoadingData}}) {
	$text->insert('end',$_);
    }
    $text->update('idletasks');
    $ssd->Show;
}


#######################################################################
## Method to display the splash screen to the user during startup and 
## APE initialisation.
#######################################################################
sub _createSplashScreen {
    my $self = shift;
    my $splash    = $self->Splashscreen;
    my $logo      = $self->Photo("-format"=>'jpeg',
				  -file=>Tk::findINC("APE/Tk/Images/Splash.jpg"));
    my $width     = $logo->width;
    my $height    = $logo->height;
    my $canvas    = $splash->Canvas(-width=>$width,-height=>$height,-bg=>'black')->pack(-fill=>'x',-expand=>1);
    my $dataFrame = $splash->Frame(-bd=>3,-bg=>'black')->pack(-fill=>'x',-expand=>1);
    $canvas->createImage(1,1,-anchor=>'nw',-image=>$logo);
    $self->{_splText} = $dataFrame->ROText(-bg=>"#666666",-font=>$self->{_smallFont},-height=>8,-bd=>0);
    $self->{_splText}->pack(-fill=>'both',-expand=>1);
    $splash->Splash;
    $splash->update('idletasks');
    return $splash;
}


#######################################################################
## Method to return the file menu items.
#######################################################################
sub _fileMenuItems {
    my $self = shift;
    [['command','Exit',-command=>sub{ return if $self->_verifyResults; Tk::exit; }]]
}


#######################################################################
## Method to return the edit menu items.
#######################################################################
sub _editMenuItems {
    my $self = shift;
    [['checkbutton','Allow duplicate data',-variable=>\$self->{_duplicateData},
      -command=>sub {
	  $self->{_requirementDisplayer}->configure(-duplicateData=>$self->{_duplicateData})
	      if Tk::Exists($self->{_requirementDisplayer});
      }],
     "",
     ['command','Clear update box',-command=>sub{ $self->{_outputBox}->clear; }]]
}


#######################################################################
## Method to return the edit menu items.
#######################################################################
sub _viewMenuItems {
    my $self = shift;
    [['checkbutton','Show process id numbers',-variable=>\$self->{_showProcessIds},
      -command=>sub{ 
	  $self->{_outputBox}->updateBox(-itemtype=>'text',
					 -textStruct=>["Refreshing the process tree....",
						       $self->{_showProcessIds} ? 
						       "Showing process id numbers." : 
						       "Removing process id nuumbers"]);
	  my $oldProcessCount = $self->{_processTree}->getProcessCount;
	  $self->Busy;   $self->{_processTree}->showProcessIds($self->{_showProcessIds}); 
	  my $newProcessCount = $self->{_processTree}->refresh; 
	  $self->{_outputBox}->updateBox(-itemtype=>'text',
					 -textStruct=>["New process count is '$newProcessCount'.",
						       "Old process count was '$oldProcessCount'."]);
	  $self->Unbusy; }],
     "",
     ['command','Clear highlighted widget',-command=>sub{ $self->{_outputBox}->clearSelected; } ],
     "",
     ['command','Show tract loading data...',-command=>[\&_showTractLoadingData,$self]]]
}


sub _toolsMenuItems {
    my $self = shift;
    [
     ['command','Load process tract...',-command=>[\&_loadProcessTract,$self,TRUE]],
     ['command','Unload process tract...',-command=>[\&_loadProcessTract,$self,FALSE]]
     ]
 }

#######################################################################
## Method to return the help menu items.
#######################################################################
sub _helpMenuItems {
    my $self = shift;
    [['command','About...',-command=>sub{ $self->_createAboutDialog; }]]
}


#######################################################################
## Method to ensure that any outstanding database transactions are 
## rolled back when a user destroys this widget.
#######################################################################
sub DESTROY {
    my $self = shift;
    if(defined $self->{_resultContainer}) {
	$self->{_resultContainer}->_rollBackAll;
    }
}


1;
