Tk::IDEtabFrame - Tabbed Notebook Widget for a IDE Environment

    use Tk::IDEtabFrame;

    $TabbedFrame = $widget->IDEtabFrame
       (
        # Tk::DynaTabFrame Options:
        -font => $font,
        -raisecmd => \&raise_callback,
        -raisecolor => 'green',
        -tabclose => sub { 
                my ($dtf, $caption) = @_; 
                $dtf->delete($caption);
                },
        -tabcolor => 'yellow',
        -tabcurve => 2,
        -tablock => undef,
        -tabpadx => 5,
        -tabpady => 5,
        -tabrotate => 1,
        -tabside => 'nw',
        -tabscroll => undef,
        -textalign => 1,
        -tiptime => 600,
        -tipcolor => 'yellow',

	# Additional Options added by IDEtabFrame
	-raisedfg => 'black',
	-raisedActivefg => 'red',

	-raisedCloseButtonfg => 'black',
	-raisedCloseButtonbg => 'lightgrey',
	-raisedCloseButtonActivefg => 'red',
	-raisedCloseButtonActivebg => 'white',

	-noraisedfg => 'grey60',
	-noraisedActivefg => 'black',

	-noraisedCloseButtonfg => 'lightgrey',
	-noraisedCloseButtonbg => 'white',
	-noraisedCloseButtonActivefg => 'red',
	-noraisedCloseButtonActivebg => 'white',

        [normal frame options...],

       );

	$self->dragImage();    # Get dragImage
	$self->dragImage(...); # Set dragImage

   $self->toolWindowConfigure($toolwindow);

package Tk::IDEtabFrame;
our ($VERSION) = ('0.32');

use Carp;
use strict;


use Tk;
use Tk::IDEdragDrop;
use Tk::DropSite;
use Tk::IDEdragShadow;
use Tk::CaptureRelease;
use Tk::IDElayout::DropBox; # Used for temp storage during drag/drop operations

use base qw/ Tk::Derived Tk::DynaTabFrame/;

our ($DEBUG); 

Tk::Widget->Construct("IDEtabFrame");

sub Populate {
    my ($cw, $args) = @_;
     
    $cw->SUPER::Populate($args);

    
    $cw->ConfigSpecs( 
		      -raisedfg => [ qw/PASSIVE raisedfg     raisedfg/, 'black' ],
		      -raisedActivefg => [ qw/PASSIVE raisedActivefg     raisedActivefg/, 'black' ],
		      -raisedCloseButtonfg => [ qw/PASSIVE raisedCloseButtonfg     raisedCloseButtonfg/, 'black' ],
		      -raisedCloseButtonbg => [ qw/PASSIVE raisedCloseButtonbg     raisedCloseButtonbg/, 'lightgrey' ],
		      -raisedCloseButtonActivefg => [ qw/PASSIVE raisedCloseButtonActivefg     raisedCloseButtonActivefg/, 'red' ],
		      -raisedCloseButtonActivebg => [ qw/PASSIVE raisedCloseButtonActivebg     raisedCloseButtonActivebg/, 'lightgrey' ],

		      -noraisedfg => [ qw/PASSIVE noraisedfg     noraisedfg/, 'grey60' ],
		      -noraisedActivefg => [ qw/PASSIVE noraisedActivefg     noraisedActivefg/, 'grey60' ],
		      -noraisedCloseButtonfg => [ qw/PASSIVE noraisedCloseButtonfg     noraisedCloseButtonfg/, 'black' ],
		      -noraisedCloseButtonbg => [ qw/PASSIVE noraisedCloseButtonbg     noraisedCloseButtonbg/, 'lightgrey' ],
		      -noraisedCloseButtonActivefg => [ qw/PASSIVE noraisedCloseButtonActivefg     noraisedCloseButtonActivefg/, 'red' ],
		      -noraisedCloseButtonActivebg => [ qw/PASSIVE noraisedCloseButtonActivebg     noraisedCloseButtonActivebg/, 'lightgrey' ],
		      -defaultFrameConfig => [ qw/PASSIVE defaultFrameConfig     defaultFrameConfig/, [-relief => 'flat', -bg => 'steelblue4', -bd => 2] ],
		      -lastTabDeleteCallback => [ qw/METHOD lastTabDeleteCallback     lastTabDeleteCallback/, undef ],

    );


        # This keeps tab contents from being obscured after drag/drop events
        #   Similar to the parent ConfigDebounce method, but this calls TabReconfig more often, 
        #     which is enough to avoid the problem.
        $cw->bind('<Configure>',sub{
                        
        
                        $cw->afterCancel($cw->{LastAfterID}) if defined($cw->{LastAfterID});
        
                        $cw->{LastAfterID} = $cw->after(200, # $cw->cget('-delay'), 
                                sub {
                                        $cw->TabReconfig();
                                        delete $cw->{LastAfterID};
                                }
                        );
        });

    
}


#----------------------------------------------
# Sub called when -lastTabDeleteCallback option changed
#
sub lastTabDeleteCallback{
	my ($cw, $lastTabDeleteCallback) = @_;


	if(! defined($lastTabDeleteCallback)){ # Handle case where $widget->cget(-$array) is called

		return $cw->{Configure}{-lastTabDeleteCallback}
		
	}
	else{
	
		# Make A Tk::Callback Object
		$cw->{Configure}{-lastTabDeleteCallback} = Tk::Callback->new($lastTabDeleteCallback);
	}
	


}

#############################################################
#

sub TabCreate{
	
	my $self = shift;
	my @args = @_;
		
	my $Caption = $args[0]; # Name of tab being added
	
	my $widget = $self->SUPER::TabCreate(@args);
	
	
	my $clientHash = $self->{ClientHash};
	my $clientList = $self->{ClientList};
	
	return unless( @$clientList); # Skip if no clients
		
	# Make lookup of client names to client frames
	my @clientFrames =  map $clientList->[$clientHash->{$_}][0], keys %$clientHash;
	
	my %clientFrames;
	@clientFrames{ keys %$clientHash} = @clientFrames;
	
	my $ButtonFrame = $self->{ButtonFrame};
	
		
	my $pageFrame = $clientFrames{$Caption};
	my $TabFrame = $ButtonFrame->Subwidget('Button_'.$pageFrame);
	#$TabFrame->configure(-bd => 2 );
	my $TabButton = $TabFrame->Subwidget('Button');
	
	my $dragToken;
	$dragToken = $TabButton->IDEdragDrop(
	  -event  => '<Any-B1-Motion>',  
	  -sitetypes => ['Local'],
	  -handlers => [[sub{ 
	  			# print "In Handler\n";
				my ($contents) = $widget->packSlaves();
                                my @packInfo = $contents->packInfo();
	  			my $data = {
                                        "DragSource" => $TabButton, "Object" => $self,
                                        "Caption" => $Caption, "Contents" =>  $contents,
                                        "PackInfo"=> [@packInfo]
                                };
                                
				# Put data in dropbox, key'ed by ref address
                                my $DropBox = Tk::IDElayout::DropBox->instance();
                                $DropBox->set("$data", $data);
				# Delete Tab from object
				my $endDragAction = sub{ $self->delete($Caption)};
				
				# Create array ref of endDragActions, if not defined already
				$self->{endDragActions} = [] unless( defined($self->{endDragActions}));
				
				push @{$self->{endDragActions}}, $endDragAction;
				$self->{dropped} = 1; # Flag to indicate that the drag has dropped
	  			return "$data";
	  		    }
	  		],
	  		],
	  -startcommand => [$self, 'startDrag', \$dragToken, $widget],
	  -endcommand => [$self, 'endDrag', \$dragToken, $widget],
	);


	unless( defined($self->{dropSite})){ # Create dropSite, if we don't have one already
		my $dropSite = $ButtonFrame->DropSite(
			-droptypes     => ['Local'],
			-dropcommand   => [ $self, 'drop' ],
			-entercommand => [$self, 'dragDropEnterLeave', \$dragToken], 
		);
		$self->{dropSite} = $dropSite;
	}

	unless( defined($self->{dragShadow})){ # Create DropShadow, if we don't have one already
		my $dragShadow = $ButtonFrame->IDEdragShadow();
		$self->{dragShadow} = $dragShadow;
	}

	
	# my $closeButton = $TabFrame->Subwidget('CloseBtn');

	# Apply default frame configuration
	my $frameConfig = $self->cget(-defaultFrameConfig);
	$widget->configure(@$frameConfig) if (@$frameConfig);	
	
	return $widget;

}

#######################################################################

sub TabRaise{
	
	my $self = shift;
	my @args = @_;
		
	my $widget = $self->SUPER::TabRaise(@args);
	
	my $clientHash = $self->{ClientHash};
	my $clientList = $self->{ClientList};
	my $Raised     = $self->{Raised};
	
	return unless( @$clientList); # Skip if no clients
	my ($raised) = grep $clientList->[$_][0] eq $Raised, (0..(scalar(@$clientList)-1));
	
	my %raiseLookup = reverse(%$clientHash);
	
	my $raiseName = $raiseLookup{$raised}; # Name of the currently raised tab
	#print "RaiseName = $raiseLookup{$raised}\n";

	#  Get current options
	my ($raisedfg, $raisedActivefg) = map $self->cget($_), (-raisedfg, -raisedActivefg);	
	my ($raisedCloseButtonfg, $raisedCloseButtonbg, $raisedCloseButtonActivefg, $raisedCloseButtonActivebg) = 
		map $self->cget($_), (-raisedCloseButtonfg, -raisedCloseButtonbg, -raisedCloseButtonActivefg, -raisedCloseButtonActivebg);
	my ($noraisedfg, $noraisedActivefg) = map $self->cget($_), ( -noraisedfg, -noraisedActivefg);	
	my ($noraisedCloseButtonfg, $noraisedCloseButtonbg, $noraisedCloseButtonActivefg, $noraisedCloseButtonActivebg) = 
		map $self->cget($_), ( -noraisedCloseButtonfg, -noraisedCloseButtonbg, -noraisedCloseButtonActivefg, -noraisedCloseButtonActivebg);

	# Apply Options to all tabs
	my @allTabs = $self->pages();
		
	# Make lookup of client names to client frames
	my @clientFrames =  map $clientList->[$clientHash->{$_}][0], keys %$clientHash;
	
	my %clientFrames;
	@clientFrames{ keys %$clientHash} = @clientFrames;
	
	my $ButtonFrame = $self->{ButtonFrame};
	
	my $Xfont = $self->{Xfont}; # Font used to display the "X"
        
        my $maxWidgetWidth = 0;
        my $maxWidgetHeight = 0;
	
	foreach my $page($self->pages){
		
		my $pageFrame = $clientFrames{$page};
                
                # This is needed to keep some widgets from being unmapped when other IDEtabframes
                #   are deleted in the IDElayout GUI (Not sure why).
                $pageFrame->eventGenerate('<Configure>');

		# get the frame contents, so we can raise/lower in the stacking order
		my ($pageContents) = $pageFrame->packSlaves();
		
                my $widgetWidth = $pageFrame->reqwidth;
                my $widgetHeight= $pageFrame->reqheight;
                
                $maxWidgetWidth = $widgetWidth  if( $widgetWidth  > $maxWidgetWidth);
                $maxWidgetHeight= $widgetHeight if( $widgetHeight > $maxWidgetHeight);
                
		my $TabFrame = $ButtonFrame->Subwidget('Button_'.$pageFrame);
		#$TabFrame->configure(-bd => 2 );
		my $TabButton = $TabFrame->Subwidget('Button');
		my $closeButton = $TabFrame->Subwidget('CloseBtn');
				
		unless (defined($Xfont)){
			my $normFont = $closeButton->cget(-font);
			my $size = $normFont->actual(-size);
			#print "$normFont size = $size\n";
			$Xfont = $self->{Xfont} = $normFont->Clone( -weight => 'bold');	
		}			

		$closeButton->configure(-text => 'X', -anchor => 'center', -image => undef);
		$closeButton->configure(-font => $Xfont, -relief => 'flat', -padx => 0, -pady => 0);
		
		# Set color to raiseFG or noRaiseFG, based on which page is raised
		if( $page eq $raiseName){
			$pageContents->raise() if($pageContents);
			$TabButton->configure(-foreground => $raisedfg, 
			                      -activeforeground => $raisedfg);
			$pageFrame->focus();	
			$closeButton->configure( -bg => $raisedCloseButtonbg, -fg => $raisedCloseButtonfg,
					-activeforeground => $raisedCloseButtonActivefg, 
					-activebackground => $raisedCloseButtonActivebg);
		}
		else{
			$pageContents->lower() if($pageContents);
			$TabButton->configure(-foreground => $noraisedfg,
			                      -activeforeground => $noraisedActivefg);
			$closeButton->configure( -bg => $noraisedCloseButtonbg, -fg => $noraisedCloseButtonfg,
					-activeforeground => $noraisedCloseButtonActivefg, 
					-activebackground => $noraisedCloseButtonActivebg);
			
		}
	}
        
        # Set to the max width/height of the managed frames to the total widget will request the
        #  correct width/height
        $self->{ClientFrame}->configure(-width => $maxWidgetWidth, -height => $maxWidgetHeight );
	
	return $widget;
}

#######################################################################

sub startDrag{

	my $self = shift;
	my $dndTokenRef = shift;
	my $tabFrame  = shift;   # Frame in the current dragged frame
	
	my ($contents) = $tabFrame->packSlaves(); # Get the contents of the dragged frame

	#print "In IDEtabFrame StartDrag\n" if($DEBUG);

	my $dragImage = $self->dragImage;
	 $$dndTokenRef->configure( -image => $dragImage);
	 
	# Get the requested width/height of the contents, for use with the DragShadowtopLevel
	# Also get the rootx/y and pointer x/y so we can calculate the offset for DragShadowToplevel
	#  This will make the drag shadow have the same size as the tab-frame being dragged.
	#print "Contents = $contents\n" if($DEBUG); 
	 my $w = $contents->width;
	 my $h = $contents->height;
	 my $rootx = $contents->rootx;
	 my $rooty = $contents->rooty;
	 my $pointerx = $contents->pointerx;
	 my $pointery = $contents->pointery;
	 
	 my $offsetX = $pointerx - $rootx;
	 my $offsetY = -3;  # Offset y set to small number so the drag shadow will be slightly next to the mouse pointer

         # Offsets must be a little bit greater than zero, otherwise the cursor
         #   could be right on the shadow, causing the drop target to be obscured.
         $offsetX = 3 if( $offsetX < 3 );
         $offsetY = 3 if( $offsetY < 3 );
	 
	 #print "req width/height = $w/$h\n" if($DEBUG);
	 #print "offsetX/Y = $offsetX/$offsetY\n"  if($DEBUG);
	 
	$$dndTokenRef->DragShadowToplevelConfig($w, $h,-$offsetX,-$offsetY);
	 $self->{dragging} = 1;

	return 0;

}

##################################################

sub endDrag {

	my $self = shift;
	my $dndTokenRef = shift;
	my $tabFrame  = shift;   # Frame in the current dragged frame
	
	my ($contents) = $tabFrame->packSlaves(); # Get the contents of the dragged frame
	#print "Enddrag\n";
	 
	 if( defined($self->{endDragActions}) ){
		 my $actions = $self->{endDragActions};
		 
		 # Go thru each action
		 while( @$actions){
			 my $action = shift @$actions;
			 $action->(); # execute action
		 }
	 }
	 	 
	 if( !$self->{dropped} && $self->{dragging} ){ # Create a new toplevel window if dragged with no target
		#print "Not Dropped .......\n" if($DEBUG);
		$$dndTokenRef->DragShadowToplevelHide(); # Hide the dragshadow Toplevel
		
		# find the caption of the current tab dragged
		my $clientHash = $self->{ClientHash};
		my $clientList = $self->{ClientList};
		
		if( @$clientList){ # Skip if no clients
			
			# Get the caption for the currently dragged frame by
			#   Making lookup of client Frames (stringified) to client names
			my @clientFrames =  map $clientList->[$clientHash->{$_}][0], keys %$clientHash;
		
			my %clientFrames;
			@clientFrames{ @clientFrames } = keys %$clientHash;
			
			my $caption = $clientFrames{$tabFrame};

                        # Get the packing info for the contents and attach to the toolwindow
                        #  This will be used if the toolwindow is dragged back into a IDEtabFrame
                        my %PackInfo = $contents->packInfo();
                        delete $PackInfo{-in};  # delete the -in option, not relavent
			
			#print "Deleting Caption = $caption\n" if($DEBUG);
			# Delete tab from the dialog and make a new toplevel window
			$self->delete($caption);
			
			my $geometry = $$dndTokenRef->DragShadowToplevelGeometry(); # Hide the dragshadow Toplevel
			#print "Top Level geometry = '$geometry'\n" if($DEBUG);

			$contents->wmRelease;
			# MainWindow needed here because wmReleased widget don't properly inherit from
			#   Tk::Toplevel
			$contents->MainWindow::attributes(-toolwindow => 1) if( $^O =~ /mswin32/i);
			$contents->MainWindow::title($caption);
			$contents->MainWindow::geometry($geometry);
 			$contents->MainWindow::deiconify;
			$contents->raise;

                        $contents->{_PackInfo} = [%PackInfo]; # attach the packInfo
 			
			# Configure the new toolwindow so that we can drag it back to a tabFrame
			$self->toolWindowConfigure($contents);
			
		}

	 }
	 
	 $self->{dragging} = 0;
	 $self->{dropped}  = 0;


	
}

sub dragImage{
    my $self = shift;
    if (defined $_[0]) { $self->{dragImage} = $_[0] };

    # Create drag image, if not defined
    unless( defined( $self->{dragImage})){
	    	my $dragImage = $self->Photo("dragImage", -data => 'R0lGODlhEAAQAIIAAPwCBAQCBAT+/Pz+/KSipPz+BAAAAAAAACH5BAEAAAAALAAAAAAQABAAAANFCBDc7iqIKUW98WkWpx1DAIphR41ouWya+YVpoBAaCKtMoRfsyue8WGC3YxBii5+RtiEWmASFdDVs6GRTKfCa7UK6AH8CACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs='
	 	);
		$self->{dragImage} = $dragImage;
    }

    return $self->{dragImage};
}

##################################################

sub dragDropEnterLeave{

	my $self = shift;
	my ($dndTokenRef,$flag) = @_;
	  
	if( $flag){  # Outline the drag target
		print "entering \n" if($DEBUG);
		my $ButtonFrame = $self->{ButtonFrame};
		
		# compute geometry of where the shadow fram should be
		my $geometry = $ButtonFrame->geometry(); # Geometry of just the button frame
		#print "Geometry $geometry\n";
		my ( $width, $height) = $geometry =~ /(\d+)x(\d+)\+\d+\+\d+/;
		
		# Offset x/y for the x/y of the total widget
		my ( $rootX, $rootY ) = ( $self->x + $ButtonFrame->x, $self->y + $ButtonFrame->y );
		$geometry = $width."x".$height."+".$rootX."+".$rootY;
		#print "New Geometry $geometry\n" if($DEBUG);

		my $dragShadow = $self->{dragShadow};
		$dragShadow->configure(-geometry => $geometry);
		
		# Hide the top-level dragShadow
		$$dndTokenRef->DragShadowToplevelHide();
	}
	else{
		# Get rid of outline
		print "leaving \n" if($DEBUG);
		my $dragShadow = $self->{dragShadow};
		$dragShadow->placeForget();
		# Show the top-level dragShadow
		$$dndTokenRef->DragShadowToplevelShow();
	}
	return 1;
}

##################################################

sub drop{

	my $self = shift;
	
	my @args = @_;
	my $selection = shift;
	
	my ($sel) = $self->toplevel->SelectionGet('-selection'=>$selection);
	
        print "In IDEtabFrame::Drop...\n" if($DEBUG);
        
	# Get the real object from the dropbox
        my $DropBox = Tk::IDElayout::DropBox->instance();
	my $object = $DropBox->delete($sel);
        
	return 0 unless(defined($object));
	
        # Get all the info about the object dragged
	my ($DragSource, $IDEobject, $Caption, $Contents, $PackInfo) = 
                @$object{qw/DragSource Object Caption Contents PackInfo/};
	
        
	#print "Self Dragging = ".$self->{dragging}."\n";
	
	print "DragSource = $DragSource\n" if($DEBUG);
	
	# Calback to add new tab
	my $addAction =
		sub{
			my $newFrame = $self->add(
				-caption => $Caption,
				-label =>   $Caption,
				);
			my $frameConfig = $self->cget(-defaultFrameConfig);
			$newFrame->configure(@$frameConfig) if (@$frameConfig);	
			
			# If the source is a toolwindow, capture the window (i.e. make it a non-toplevel again)
			if( $DragSource =~ /toolwindow/i ){
                                
                                # Get rid of the dragArea
                                my @packSlaves = $Contents->packSlaves();
                                #print "Packslaves = ".join(", ", @packSlaves)."\n";
                                my ($dragArea) = grep defined($_->{_dragArea_}), @packSlaves; # find the drag area
                                                                                              # based on the tag we put there
                                $dragArea->packForget() if( $dragArea); # forget the drag Area, if we found it.
                                
				$Contents->wmCapture;  # Capture back to a window from a toplevel
 			}
			
                        my %packOptions = (@$PackInfo, -in => $newFrame); # Override the '-in' in the packInfo
			$Contents->pack(%packOptions);
			$Contents->raise();
		};

	# If we are currently dragging, delay adding the tab until after it is complete
	if( $self->{dragging} ){
		push @{ $self->{endDragActions} }, $addAction;
	}
	else{ # Not dragging, execute immediately
		$addAction->();
	}
		
	return 1;
}

###########################################################################################

sub toolWindowConfigure{
    my $self = shift;
    my $top = shift;
    
    # Make Drag Area at the top of the window
    # Get the real contents, unpack, and then pack back to make room for the drag
    #   area at the top of the window.
    my ($realContents) = $top->children();
    #print 'Children = '.join(", ", $contents->children)."\n";
    my $dragArea =  $top->Frame( -height => 5, -cursor => 'fleur')
                        ->pack(-before => $realContents, -side => 'top',  -fill => 'x');
   
    # Add a tag onto dragArea, so we can find it again
    $dragArea->{_dragArea_} = 1;
    
    my $dragAreaBG = $dragArea->cget(-bg);
    $dragArea->bind('<Enter>', sub{
                        $dragArea->configure(-bg => 'lightsteelblue');
                      }
                 );
     $dragArea->bind('<Leave>', sub{
                        $dragArea->configure(-bg => $dragAreaBG);
                      }
                 );
    
    
    my $shadow;
    my ( $posX,    $posY )    = ();
    my ( $offsetX, $offsetY ) = ( 0, 0 );
    
    my $dragToken;
    $dragToken = $dragArea->IDEdragDrop(
          -event  => '<Any-B1-Motion>',  
	  -sitetypes => ['Local'],
          -startcommand => [sub{ 
                my $self   = shift;
 	        my $dndTokenRef = shift;
                my $widget = shift;
                #print "In StartCommand, widget = $widget\n";
                
                my $geom = $widget->toplevel->geometry;
                my ( $rootx, $rooty ) = ( $widget->rootx, $widget->rooty );

                #print "Root x/y = $rootx/$rooty\n";
                #print "Pos X/Y = $posX/$posY\n";
                my ( $width, $height, $x, $y ) =
                  $geom =~
                  /^(\d+)x(\d+)\+(\d+)\+(\d+)/;   # Parse width/height from geom
                #print "x/y = $x/$y\n";

                # Make total height include the title bar
                $height = $height + ( $rooty - $y );
                
                # Figure out the offset between the current mouse position
                #  and the root x/y of the window
                 my $pointerx = $widget->pointerx;
                 my $pointery = $widget->pointery;
                 
                 my $offsetX = $pointerx - $x;
                 my $offsetY = $pointery - $y;
                 
                 

		 $$dndTokenRef->DragShadowToplevelShow();
                 $$dndTokenRef->DragShadowToplevelConfig($width, $height,-$offsetX,-$offsetY);
                 $self->{dragging} = 1;

                 # Set the drag image, so we don't get that lame default "Frame" image
                 my $dragImage = $self->dragImage;
                 $$dndTokenRef->configure( -image => $dragImage);
                 
                return 0;
                
          }, $self, \$dragToken, $top],
	  -handlers => [[sub{ 
				my $contents = $top; 
				my $Caption  = $top->MainWindow::title();
				print "In Handler, Caption = '$Caption'\n" if($DEBUG);
				
				# We signal the Tk::IDEtabFrame method that we will be dropping from a toolwindow
	  			my $data = { DragSource => 'ToolWindow', "Object" => $self, "Caption" => $Caption,
                                             "Contents" =>  $contents,
                                             "PackInfo" => $contents->{_PackInfo}, # Pack options attached when toolwindow created
                                };

				# Put data in dropbox, key'ed by ref address
                                my $DropBox = Tk::IDElayout::DropBox->instance();
				$DropBox->set("$data", $data);
				# Create array ref of endDragActions, if not defined already
				$self->{endDragActions} = [] unless( defined($self->{endDragActions}));
				$self->{dropped} = 1; # Flag to indicate that the drag has dropped
								
	  			return "$data";
	  		    }
	  		],
	  		],
			-endcommand => [$self, 'endDragTW', \$dragToken, $top],
		);
    
    
    
}

##################################################

sub endDragTW {

	my $self = shift;    # IDE tabframe object
	my $dndTokenRef = shift;
	my $widget  = shift; # toolwindow widget
	
        # Get the geom of the toplevel
        my $shadow = $$dndTokenRef->dragShadowToplevel();
	my $newgeom = $shadow->geometry();
	print "In End Command\n" if($DEBUG);

	# Get the new root positio of the window and set posX/Y, so we don't
	#   get a false window move indication
	my ( $newX, $newY ) = $newgeom =~ /(\d+)\+(\d+)$/;
	if ( defined($newX) && defined($newY) && !$self->{dropped} )
	{    # only set new geom if we haven't dropped
		$widget->MainWindow::geometry("+$newX+$newY");
	}

	$$dndTokenRef->DragShadowToplevelHide(); # Hide the dragshadow Toplevel

        # Execute any endDragActions
	 if( defined($self->{endDragActions}) ){
		 my $actions = $self->{endDragActions};
		 
		 # Go thru each action
		 while( @$actions){
			 my $action = shift @$actions;
			 $action->(); # execute action
		 }
	 }

	$self->{dragging} = 0;
	$self->{dropped}  = 0;

}

##################################################

sub TabRemove {
	my ($self, @args) = @_;
        $self->SUPER::TabRemove(@args);
        
      # Check for no more tabs
        my $clientHash = $self->{ClientHash};
        if( scalar(keys %$clientHash) == 0){
                my $lastTabDeleteCallback = $self->cget('-lastTabDeleteCallback');
                if(defined($lastTabDeleteCallback) && ( ref($lastTabDeleteCallback) =~ /callback/i )){
                        $lastTabDeleteCallback->Call();
                }
        }
        
}
###################################################################################

sub tabclose {
	my ($this, $close) = @_;

	return $this->SUPER::tabclose() unless defined($close);

        if (ref($close) ne 'CODE' && $close == 1){ # Default close button desired
                
                # This code ref called when the close button pressed on the tab
                #   It destroys the widget contents. This is needed because the widgets in IDElayout
                #   are created as childs of the main widget, and not childs of the IDEtabframe widget.
                #   This is done so the widgets can be dragged around in the GUI.
                #   Since the widgets are created as childs of the main window, and not the IDEtabframe tabs,
                #    just deleting the tab won't delete the widget. So we delete it manually here.
                my $subRef = sub{
                        my $self = shift;
                        my $tabName = shift;

                        # Make lookup of client names to client frames
                        my $clientHash = $self->{ClientHash};
                        my $clientList = $self->{ClientList};
                        my @clientFrames =  map $clientList->[$clientHash->{$_}][0], keys %$clientHash;
                        
                        my %clientFrames;
                        @clientFrames{ keys %$clientHash} = @clientFrames;
                        
                        my $clientFrame = $clientFrames{$tabName};
                        #print "clientFrame = $clientFrame\n";
                        
                        # get the frame contents, explicitly destroy it
                        my ($pageContents) = $clientFrame->packSlaves();
                        $pageContents->destroy();
                        
                        #print "Page contents = $pageContents\n";
                        
                        $self->TabRemove($tabName)
                }; # Sub ref to call our TabRemove
                return $this->SUPER::tabclose($subRef);
        }
        
        # Special code ref supplied, just pass this to the parent method
        return $this->SUPER::tabclose($close);
}
        
1;