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

package APE::Tk::ProcessTree;

use Tk::widgets qw/Frame Tree ItemStyle DialogBox HList Balloon/;
use base qw/Tk::Derived Tk::Frame/;
use strict;
use warnings;
use Carp;

use APE::AtomicProcessEngine;
use APE::InputControllerFactory::ExoApeInputControllerFactory;
use APE::FlushControllerFactory::ExoApeFlushControllerFactory;
use APE::OutputControllerFactory::ExoApeOutputControllerFactory;

Construct Tk::Widget 'ProcessTree';

use constant TRUE  => 1;
use constant FALSE => 0;
use constant DEFAULT_IMAGE => "/usr/local/badger/lib/perl5/SITk/Images/circle.gif";

$APE::AtomicProcessEngine::VERBOSE = TRUE;


########################################################################
## 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) = @_;
    $self->SUPER::Populate($args);
    ## Capture vars unknown to Tk.
    $self->{_topLevelProcessIdList} = delete $args->{-topLevelProcessIdList};
    $self->{_user}           = delete $args->{-user}           || croak "ERROR: argument -user is missing.";
    $self->{_showProcessIds} = delete $args->{-showProcessIds} || FALSE;
    $self->{_indicator}      = delete $args->{-indicatorImage} || $self->_createDefaultIndicator();
    $self->{_noBttns}        = delete $args->{-noButtons}      || FALSE;
    $self->{_noStartBttn}    = delete $args->{-noStartBttn}    || FALSE;
    $self->{_noRefreshBttn}  = delete $args->{-noRefreshBttn}  || FALSE;
    $self->discoveryMode(delete $args->{-discoveryMode} || FALSE);
    croak "ERROR: argument -user is not a reference." unless ref ${$self->{_user}};

    ## Set up extra widgets.
    my $scroll      = $self->Scrolled('Tree',-scrollbars=>'osoe')->pack(-fill=>'both',-expand=>1);
    my $tree        = $scroll->Subwidget('tree');
    my $bttnFrame   = $self->Frame->pack();
    $self->{_tree}  = $tree;

    unless($self->{_noBttns}) {
	unless($self->{_noStartBttn}) {
	    $self->{_startBttn} = $bttnFrame->Button(-text=>'Start',-width=>9)
		->pack(-side=>'left',-pady=>3,-padx=>3);
	    $self->{_startBttn}->configure(-command=>[\&_start, $self]);
	}
	unless($self->{_noRefreshBttn}) {
	    $self->{_refreshBttn} = $bttnFrame->Button(-text=>'Refresh',-width=>9)
		->pack(-side=>'left',-pady=>3,-padx=>3);
	    $self->{_refreshBttn}->configure(-command=>[\&refresh,$self]);
	    $self->Advertise('refreshBttn' => $self->{_refreshBttn});
	}
    }

    ## Create tree styles for state changes.
    $self->{disabled} = $tree->ItemStyle('imagetext',-foreground=>'grey');
    $self->{normal}   = $tree->ItemStyle('imagetext',-foreground=>'black');

    $self->Advertise('tree'        => $tree);
    $self->Advertise('scroll'      => $scroll);
    $self->Advertise('bttnFrame'   => $bttnFrame);

    my $balloon = $self->toplevel->Balloon();
    $balloon->attach($tree,-balloonposition=>'mouse',-msg=>\$self->{_bmsg},
		     -postcommand  =>[\&processBalloon,$self]);

    $tree->bind('<Motion>',[\&processMotionBalloon,$self,$balloon,Tk::Ev('x'),Tk::Ev('y')]);
    $tree->bind('<Double-Button-1>'=>sub{ $self->_start; });
    $tree->bind('<Button-3>',[\&processMenu,$self,Tk::Ev('y')]);

    $self->ConfigSpecs(-width         => [$self],
		       -height        => [$self],
		       -background    => [$tree],
		       -foreground    => [$tree],
		       -selectmode    => [$tree],
		       -state         => [qw/METHOD state State normal/],
		       -discoveryMode => [qw/METHOD discoverymode DiscoveryMode/],
		       -noballoon     => [qw/PASSIVE noballoon NoBalloon 0/],
		       -nomenu        => [qw/PASSIVE nomenu NoMenu 0/],
		       -apecommand    => [qw/CALLBACK apecommand ApeCmd/],
		       -preloadcmd    => [qw/CALLBACK preloadcmd PreLoadCmd/],
		       -postloadcmd   => [qw/CALLBACK postloadcmd PostLoadCmd/],
		       -preunloadcmd  => [qw/CALLBACK preunloadcmd PreUnloadCmd/],
		       -postunloadcmd => [qw/CALLBACK postunloadcmd PostUnloadCmd/],
		       -startcommand  => [qw/CALLBACK startcommand StartCommand/]);

    ## Set the pre load and unload callbacks to default.
    $self->configure('-preloadcmd'  , $args->{-preloadcmd}    || sub{ TRUE });
    $self->configure('-preunloadcmd', $args->{-preunloadcmd}  || sub{ TRUE });
    $self->configure('-apecommand',   $args->{-apecommand}    || [\&createApe]);

    ## Load the passed process id numbers - tracts.
    if($self->{_topLevelProcessIdList} && 
       ref $self->{_topLevelProcessIdList} eq 'ARRAY') {
	foreach my $processId (@{$self->{_topLevelProcessIdList}}) {
	    $self->loadProcessId($processId);
	}
    }
}


## Method to find if the passed y coordinate is within the bounding
## box of a process in the tree. If it is then the entry path is
## returned, otherwise false is returned.
sub isMouseOnProcess {
    my ($self,$tree,$y) = @_;
    my $entryPath = $tree->nearest($y);
    return FALSE unless $entryPath;
    my $bbox      = $tree->infoBbox($entryPath);
    my $bboxTopY  = $bbox->[1];
    my $bboxBttY  = $bbox->[3];
    return FALSE unless $bboxTopY && $bboxBttY;
    if($y >= $bboxTopY && $y <= $bboxBttY) {
	return $entryPath;
    }
    return FALSE;
}


## Method to process a motion bind on this widgets Tk::Tree widget in
## order to configure and show this widgets Tk::Balloon when the mouse
## pointer is over a process in the tree. This method simply stores
## the entry path of the current process that the mouse is over as
## well as the x and y coordinates. This data is then picked up by the
## processBalloon method that is called by the Tk::Balloon when it
## thinks a balloon should be posted. If this method has populated the
## _currentBalloon structure then a balloon is shown.
sub processMotionBalloon {
    my ($tree,$self,$balloon,$x,$y) = @_;
    if(my $entryPath = $self->isMouseOnProcess($tree,$y)) {
	$self->{_currentBalloon} = 
	{ _entryPath => $entryPath,
	  _xCoord    => $x,
	  _yCoord    => $y };
    }else{
	$self->{_currentBalloon} = undef;
	$balloon->Deactivate;
    }
}


## Method to return a callback from this widgets Tk::Balloon to draw
## its self. This is our chance to say if the balloon should be drawn
## and if it should then what message to display. We test the value of
## the objects _currentBalloon var which is set in the
## processMotionBalloon method which is a callback from this widgets
## Tk::Balloon. The _currentBalloon var is only set if the mouse is
## over a process within the tree, otherwise it's undef. Returns
## boolean true to show the balloon or false not to show it.
sub processBalloon {
    my ($self,$tree) = @_;
    return FALSE if $self->cget(-noballoon);
    if($self->{_currentBalloon}) {
	my $entryPath = $self->{_currentBalloon}{_entryPath};
	my $xCoord    = $self->{_currentBalloon}{_xCoord};
	my $yCoord    = $self->{_currentBalloon}{_yCoord};
	my $process = $tree->infoData($entryPath);
	my $desc    = $process->getDescription;
	$self->{_bmsg} = $desc;
	return TRUE;
    }
    return FALSE;
}


## Method to show a popup menu over each of the
## APE::AtomicProcessContainer objects - these objects have a circle
## next to their names in the tree (unless the circle has been changed
## to something else).
sub processMenu {
    my ($tree,$self,$y) = @_;
    return if $self->cget(-nomenu);
    if(my $entryPath = $self->isMouseOnProcess($tree,$y)) {
	my $process        = $tree->infoData($entryPath);
	my $subProcessList = $process->getSubProcessList;
	return unless $subProcessList;
	my $apc = $subProcessList->[0];
	if(UNIVERSAL::isa($apc,"APE::AtomicProcessContainer")) {
	    my $menu      = $self->Menu(-tearoff=>0);
	    $menu->add("command",-label=>"View controllers",-command=>[\&viewControllers,$self,$apc]);
	    $menu->Popup(-popover=>"cursor",-popanchor=>"nw");
	}
    }
}


sub _getFlushControllers {
    my $apc = shift;
    my $aeList  = $apc->getArrayingEntityList;
    my %horde   = ();
    foreach my $ae (@$aeList) {
	my $flushController = $ae->getFlushController;
	my $fcName = ref $flushController;
	unless(exists($horde{$fcName})) {
	    $horde{$fcName} = 1;
	}
    }
    my @newFcList = keys %horde;
    return \@newFcList;
}


## Method to create a dialog box that displays all of the controllers
## that the pass APE::AtomicProcessContainer has loaded. This may end
## up allowing the controllers to be swapped in and out (???)
sub viewControllers {
    my ($self,$apc) = @_;
    my $pid  = $apc->getParentProcessId;
    my %c = 
	(InputControllerFactory  => $apc->getInputControllerFactory,
	 InputController         => $apc->getInputController,
	 FlushControllerFactory  => $apc->getFlushControllerFactory,
	 FlushController         => _getFlushControllers($apc),
	 OutputControllerFactory => $apc->getOutputControllerFactory,
	 OutputController        => $apc->getOutputController );

    my $diab = $self->DialogBox
	(-title          => "Controllers for pid: $pid",
	 -buttons        => [qw/OK/],
	 -default_button =>  qw/OK/);

    my $hlist = $diab->add
	("HList",
	 -columns  => 2,
	 -header   => TRUE,
	 -width    => 100,
	 -itemtype => 'text')
	->pack(-fill=>'both',-expand=>1);

    $hlist->headerCreate(0,-text=>"Controller");
    $hlist->headerCreate(1,-text=>"Attached Class");

    foreach my $controller (qw/InputControllerFactory InputController
			    FlushControllerFactory FlushController
                            OutputControllerFactory OutputController/) {
	if($controller eq 'FlushController') {
	    my $counter = 1;
	    foreach my $fc (@{$c{$controller}}) {
		my $name = $controller . $counter;
		$hlist->add($name);
		$hlist->itemCreate($name,0,-text=>$name);
		$hlist->itemCreate($name,1,-text=>$fc);
	    }
	}else{
	    $hlist->add($controller);
	    $hlist->itemCreate($controller,0,-text=>$controller);
	    $hlist->itemCreate($controller,1,-text=>(ref $c{$controller}));
	}
    }
    $diab->Show;
}


########################################################################
## Configure method to adjust the state of this mega widget - see the 
## call to ConfigSpecs in this modules Populate method.
########################################################################
sub state {
    my ($self,$state) = @_;
    return $self->{_state} unless $state;
    unless($self->{_noBttns}) {
	$self->{_startBttn}  ->configure(-state=>$state) unless $self->{_noStartBttn};
	$self->{_refreshBttn}->configure(-state=>$state) unless $self->{_noRefreshBttn};
    }
    foreach my $path (@{$self->{_treeParentage}}) {
	$self->{_tree}->entryconfigure($path,-state=>$state,-style=>$self->{$state});
    }
    $self->{_state} = $state;
}


## Method to set the discovery mode flag or to return it. This method
## is called by configure or cget to configure or get the discovery
## mode flag value.
sub discoveryMode {
    my ($self,$discoveryModeVal) = @_;
    return $self->{_discoveryMode} unless $discoveryModeVal;
    $self->{_discoveryMode} = $discoveryModeVal;
    $self->refresh;
}


## Method to return boolean true if the widget is currently in
## discovery mode or false if it is not. This is an alternative to
## cget or configure to find the value of -discoveryMode from Tk.
sub isInDiscoveryMode {
    my $self = shift;
    return $self->{_discoveryMode} ? TRUE : FALSE;
}


########################################################################
## Callback method. Called when the 'start' button is
## depressed. Returns a list of the selected process Process objects.
########################################################################
sub _start {
    my $self = shift;
    my $selected = $self->getSelectedProcess;
    unless(scalar(@{$selected}) == 0) {
	$self->Callback(-startcommand,$selected);
    }
}


########################################################################
## Method to create the default indicator to display to the left of an
## executable process. 
########################################################################
sub _createDefaultIndicator {
    my $self = shift;
    return $self->Photo(-file => DEFAULT_IMAGE);
}


########################################################################
## Method to return a new AtomicProcessEngine object that has looked up
## the process data from the root process topLevelProcessId and assigned 
## a reference of the User object to the AtomicProcessContainer objects
## for the FlushController objects and other objects.
########################################################################
sub createApe {
    my ($self,$topLevelProcessId) = @_;
    return new APE::AtomicProcessEngine
	(topLevelProcessId       => $topLevelProcessId,
	 discoveryMode           => $self->{_discoveryMode},
	 inputControllerFactory  => new APE::InputControllerFactory::ExoApeInputControllerFactory,
	 outputControllerFactory => new APE::OutputControllerFactory::ExoApeOutputControllerFactory,
	 flushControllerFactory  => new APE::FlushControllerFactory::ExoApeFlushControllerFactory
	 (userObj => $self->{_user}));
}


########################################################################
## Method to load a new tracts process tree into the Tree widget. This 
## method checks if the tract is already loaded, creates a new APE object
## that represents the tract, stores it and redraws the Tree to show the
## tract processes. This method can also be passed an APE object that
## may represent a previously loaded and unloaded APE object that has 
## been cached.
########################################################################
sub loadProcessId {
    my ($self,$processId) = @_;
    my $ape;
    ## We may have been sent a cached APE object.
    if(UNIVERSAL::isa($processId,"APE::AtomicProcessEngine")) {
	$ape = $processId;
	$processId = $ape->getTopLevelProcess->getProcessId;
    }
    ## Don't allow any process tract to be loaded twice.
    return if exists $self->{_loadedProcesses}{$processId};
    ## Execute the preload callback command.
    return unless $self->Callback(-preloadcmd,$self->getLoadedProcessCount,$processId);
    ## Prepare the toplevel for a data change.
    $self->toplevel->Busy;
    my $state = $self->cget('-state');
    ## Create a new APE object based on the passed process id unless a
    ## cached APE object was passed.
    unless(defined $ape) {
	$ape = $self->Callback(-apecommand,$self,$processId);
	unless($ape && $ape->getTopLevelProcess) {
	    $self->toplevel->Unbusy;
	    warn "WARNING: failed to get APE object for process id: $processId\n";
	    return;
	}
	my $tlProcess   = $ape->getTopLevelProcess;
	my $tlProcessId = $tlProcess->getProcessId;
    }
    ## Store the APE object and re-populate the Tree.
    $self->{_loadedProcesses}{$processId} = $ape;
    $self->_populate($self->{_loadedProcesses});
    ## Execute the postload callback command.
    $self->Callback(-postloadcmd,$self->getLoadedProcessCount,$ape);
    $self->configure(-state=>$state);
    $self->toplevel->Unbusy;
}


## Method to unload a tract and all of its processes. The APE object is
## deleted and the Tree is redrawn.
sub unloadProcessId {
    my ($self,$processId) = @_;
    $self->Busy;
    my $state = $self->cget('-state');
    my $unloadedApe = undef;
    if(exists($self->{_loadedProcesses}{$processId})) {
	if($self->Callback
	   (-preunloadcmd,$self->getLoadedProcessCount,
	    $self->{_loadedProcesses}{$processId})) {
	    $unloadedApe = delete $self->{_loadedProcesses}{$processId};
	    $self->_populate($self->{_loadedProcesses});
	}
    }
    $self->Callback(-postunloadcmd,$self->getLoadedProcessCount,$unloadedApe);
    $self->configure(-state=>$state);
    $self->Unbusy;
}


## Method to unload all of the currently loaded APE processes. This
## simply calls the unloadProcessId method for each of the currently
## loaded processes.
sub unloadAllProcessIds {
    my $self = shift;
    foreach my $processId (keys(%{$self->{_loadedProcesses}})) {
	$self->unloadProcessId($processId);
    }
}

########################################################################
## Method to start the population of the tree by calling the
## _populateTree method with each of the APE instances - an APE
## instance is a single tract in the db.
########################################################################
sub _populate {
    my ($self,$processHash) = @_;
    $self->{_tree}->Busy;
    $self->{_tree}->delete('all');
    $self->{_processCount}  = 0;
    $self->{_treeParentage} = undef;
    foreach my $processId 
	(sort { $processHash->{$a}->getTopLevelProcessId <=> $processHash->{$b}->getTopLevelProcessId } 
	 keys(%{$processHash})) {
	    $self->_populateTree($processHash->{$processId});
	}
    $self->{_tree}->autosetmode();
    $self->{_tree}->Unbusy;
}


########################################################################
## Method to populate the tree based on the process passed to it. This
## is a recursive method that traverses the Process objects tree of
## AtomicProcess objects displaying their descriptions.
########################################################################
sub _populateTree {
    my ($self,$processObj,$processId) = @_;
    my $tree = $self->{_tree};
    if(UNIVERSAL::isa($processObj,'APE::AtomicProcessEngine')) {
	my $process = $processObj->getTopLevelProcess;
	$processId  = $process->getProcessId;
	$tree->add($processId,
		   -text=>($self->{_showProcessIds} ? " ($processId) " : "") . $process->getDescription(),
		   -data=>$process);
	push(@{$self->{_treeParentage}},$processId);	
    }
    my $processList         = $processObj->getSubProcessList();
    return unless $processList;
    $self->{_processCount} += scalar(@{$processList});
    foreach my $process (@{$processList}) {
	next if $process->isa('APE::AtomicProcessContainer');
	my $thisProcessId   = $process->getProcessId();
	my $singleProcessId = $thisProcessId;
	$thisProcessId      = "$processId\." . $thisProcessId if $processId;
	my $processList = $process->getSubProcessList;
	if((scalar @$processList && $processList->[0]->isa("APE::AtomicProcessContainer"))
	   || $process->isPlaceholder) {
	    #$process->getSubProcessList()->[0]->isa('APE::AtomicProcessContainer')
	    $tree->add($thisProcessId,-itemtype=>'imagetext',-image=>$self->{_indicator},
		       -data=>$process,
		       -text=>($self->{_showProcessIds} ? " ($singleProcessId) " : "") . $process->getDescription());
	    push(@{$self->{_treeParentage}},$thisProcessId);
	    next;
	}
	$tree->add($thisProcessId,
		   -text=>($self->{_showProcessIds} ? " ($singleProcessId) " : "") . $process->getDescription(),
		   -data=>$process);
	push(@{$self->{_treeParentage}},$thisProcessId);
	$self->_populateTree($process,$thisProcessId);
    }
}


########################################################################
## Method to return a list of the currently selected process
## descriptions in the tree. The list contains a 3 element array
## for each selection found.  
##    0 - the description of the selected processes parent.  
##    1 - the description of the selected process.  
##    2 - the Process object associated with the selected process.
########################################################################
sub getSelectedProcess {
    my $self = shift;
    my @selected  = $self->{_tree}->infoSelection();
    my @processes = map{ [$self->{_tree}->entrycget($self->_getParent($_),'-text'),
			  $self->{_tree}->entrycget($_,'-text'),
			  $self->{_tree}->infoData($_)] } @selected;
    return \@processes;
}


########################################################################
## Method to return the parent of the path in the tree. This method
## is ultimately looking for the parent that denotes the tract type
## (48X8, 384X1 etc).  Returns the path of the parent.
########################################################################
sub _getParent {
    my ($self,$path) = @_;
    my $parentPath = $path;
    while(my $newPath = $self->{_tree}->info('parent',$parentPath)) {
	$parentPath = $newPath;
    }
    return $parentPath;
}


########################################################################
## Method to return the hash of process id numbers currently loaded.
## These process id numbers will already have been used to create APE
## objects displayed in the Tree.
########################################################################
sub getLoadedProcesses {
    my $self = shift;
    return $self->{_loadedProcesses} || {};
}


########################################################################
## Method to return the number of currently loaded process tracts.  
########################################################################
sub getLoadedProcessCount {
    my $self = shift;
    return scalar keys %{$self->{_loadedProcesses}};
}


########################################################################
## Method to return the count of processes in the tree. Instance variable
## _processCount is incremented in the _populateTree method when a new 
## process is added to the tree.
########################################################################
sub getProcessCount {
    my $self = shift;
    return $self->{_processCount};
}


########################################################################
## Method to set the instance variable flag that denotes if the id number
## of each process is displayed in brackets to the right of its process
## description.
########################################################################
sub showProcessIds {
    my ($self,$val) = @_;
    $self->{_showProcessIds} = $val;
}


########################################################################
## Method to get the instance variable flag that denotes if the id number
## of each process is displayed in brackets to the left of its process
## description. This attribute can be set at instance creation or using 
## the showProcessIds method.
########################################################################
sub getShowProcessIds {
    my $self = shift;
    return $self->{_showProcessIds};
}


########################################################################
## Method to refresh the tree by creating a new AtomicProcessEngine object.
########################################################################
sub refresh {
    my ($self,$user) = shift;
    $self->Busy;
    my $loadedProcessHash = delete $self->{_loadedProcesses};
    foreach my $processId (keys(%{$loadedProcessHash})) {
	$self->loadProcessId($processId);
    }
    $self->Unbusy;
    return $self->getProcessCount;
}

########################################################################
## Method to get the APE::AtomicProcessEngine version number.
########################################################################
sub getApeVersion { return $APE::AtomicProcessEngine::VERSION; }


1;


=head1 NAME

APE::Tk::ProcessTree - An adapted Tk::Tree widget that knows how to
create a new AtomicProcessEngine object and display the process data
using a Tk::Tree.

=head1 SYNOPSIS

use Tk;
use APE::Tk::ProcessTree;
use User;

my $mw = MainWindow->new();

my $user = new User(personId=>137,roleType=>'ExoSeq');

my $processTree = 
    $mw->ProcessTree(-topLevelProcessIdList => [5007],
                     -user                  => \$user,
                     -topLevelProcessIdList => [5008],
                     -showProcessIds        => 1);

$processTree->pack(-fill=>'both',-expand=>1);

$processTree->showProcessIds(0);

$processTree->refresh;

$processTree->loadProcessId(5008)

$processTree->unloadProcessId(5007);

MainLoop();


=head1 DESCRIPTION

This widget creates APE objects and loads them into its Tk::Tree for
selection. Top level process id numbers may be passed to the
constructor (topLevelProcessIdList) or the widgets loadProcessId
method may be used to load APE objects.

Leaf nodes within the widgets tree are represented with circles. These
leaf nodes are APE::Process objects that contain an
APE::AtomicProcessContainer object that represent an executable
arraying process.

When the user hovers their mouse icon over a process a balloon is
displayed. The balloon contains the description of the process as
shown in the tree. Certain applications use the Tk::Adjuster to adjust
the view of this widget. This means that some processes can not be
easily read. See Tk::Balloon and the -noballoon method.

=head1 CONSTRUCTORS

=over 10

=item $processTree = $mw->ProcessTree(option => value,... ?)

Use this syntax to create a new APE::Tk::ProcessTree widget.

=back

=over 10

=item -topLevelProcessIdList

An array reference containing the process id numbers to load. The
widget will instantiate a new APE object for each of these process id
numbers. The APE objects will be loaded in to the tree in the order
that they appear in this list.

=item -user

A reference to a User object containing information on the working
user (see User). This widget creates APE objects with ExoApe
FlushController objects. These FlushController objects require a
reference to a User object so that they know who is requesting the
flush.

=item -showProcessIds

Boolean flag. If true the process id number will be displayed in brackets
next to its process description. If false the process id number will not
be displayed.

=item -indicatorImage 

A Tk::Image object that will be used as the indicator to the right of
a branch and to the left of the text describing an
AtomicProcessContainer. Defaults to a plain circle.

=item -startcommand

Specifies a perl/Tk callback to associate with the start button. The callback
is passed an array containing arrays for each of the selected processes. The 
process arrays have 3 elements.

0 - the description of the selected processes parent.
1 - the description of the selected process.
2 - the APE::Process object associated with the selected process.

See getSelectedProcess method.

=item -preloadcmd 

Specifies a perl/Tk callback to associate with the loading of a new
process tract. This callback should return true to continue loading
the process tract or false to halt it. The associated callback sub is
passed the count of currently loaded process tracts and the id number
of the process being loaded.

=item -postloadcmd 

Specifies a perl/Tk callback to associate with the end of the loading
of a new process tract. The associated callback sub is passed the new
count of currently loaded process tracts - including the tract just
loaded, and the AtomicProcessEngine (APE) object created as a
consequence.

See APE::AtomicProcessEngine for more information on APE objects.

=item -preunloadcmd 

Specifies a perl/Tk callback to associate with the unloading of a
currently loaded process tract. This callback should return true to
continue unloading the process tract of false to halt it. The
associated callback sub is passed the count of currently loaded
process tracts and the AtomicProcessEngine (APE) object which is about
to be unloaded.

See APE::AtomicProcessEngine for more information on APE objects.

=item -postunloadcmd

Specifies a perl/Tk callback to associate with the completion of the
unloading of a process tract. The associated callback sub is passed
the new count of currently loaded process tracts - excluding the tract
that has just been unloaded, and the AtomicProcessEngine (APE) object
that has been unloaded.

See APE::AtomicProcessEngine for more information on APE objects.

=item -noButtons

Boolean flag. If true then the start and refresh buttons are not
shown.

=item -noStartBttn 

Boolean flag. If true then the start button is not shown.

=item -noRefreshBttn

Boolean flag. If true then the refresh button is not shown.

=item -nomenu

Boolean flag. If true then no menu will be displayed when button 3 is
pressed over a process in the tree. If false then the menu will
appear.

=item -noballoon

Boolean flag. If true then no balloon will appear when hovering over a
process in the tree. If false then a balloon will appear when hovering
over a process in the tree displaying the description of the process.

=item -discoveryMode

Boolean flag. If true then the widget will request APE objects in
discovery mode. This will result in much faster APE object structure
creation. The downside is that the resulting APE process tree will be
populated with empty APE::AtomicProcessContainer objects so executing
these objects directly from this widgets tree is no longer
possible. Instead you should use the -startcommand and create a new
APE object using the process id number of the APE::Process object that
is passed to it as the top level process. You can then execute the
APE::AtomicProcessContainer object.

=back

=head1 METHODS

These methods are in addition to the methods available from the
Tk::Frame and Tk::Tree derived widgets.

=over 10

=item $processTree->getSelectedProcess()

Returns an array of arrays of the selected processes in the tree.

0 - the description of the selected processes parent.
1 - the description of the selected process.
2 - the APE::Process object associated with the selected process.

=item $processTree->getProcessCount()

Method to return the number of processes currently in the tree.

=item $processTree->showProcessIds($bool)

Method to set the flag that prompts the widget to display the process
id numbers next to the process descriptions in the tree.

Use $processTree->refresh after setting this flag to show the change.

=item $processTree->getShowProcessIds

Method to return the state of the showProcessIds flag as set when the
instance is created or using the showProcessIds method.

=item $processTree->getLoadedProcessCount

Method to return the count of currently loaded process tracts.

=item $processTree->refresh()

Method to refresh the ProcessTree process data using the same
-topLevelProcessId and -user arguments.

Returns the process count as from $processTree->getProcessCount.

=item $processTree->isInDiscoveryMode()

Method to return boolean true if the discoveryMode flag is set to
true, otherwise false. This call is analogous to calls to configure
and cget using the -discoveryMode option to retrieve its value from
the Tk database.

=Back

=head1 ADVERTISED

Use these advertised widget elemets to further enhance this widgets
look and feel or actions.

my $advertisedElement = $processTree->Subwidget(?advertised_element?);

=over 10

=item tree

This is the Tk::Tree widget derived from.

=item scroll

The scroll widget bar widget.

=item refreshBttn

The refresh button at the bottom of the ProcessTree.

=item bttnFrame 

The frame that the start and refresh buttons are packed into.

=back

=head1 AUTHOR

Simon Holroyd <holroyd@sanger.ac.uk>

=cut
