view release on metacpan or  search on metacpan

IDEtabFrame.pm  view on Meta::CPAN

=head1 ATTRIBUTES

=over 1

=item dragImage

L<Tk::Photo> object of the image displayed when dragging data. Optional.

=item dropSite

L<Tk::DropSite> object of attached to the tab frame for the notebook widget. This provides a drop
target for dropping other widgets into the notebook as new tabs. 

=item dragShadow

L<Tk::IDEdragShadow> object used to show drag/drop drop targets.

=item endDragActions

Array Refs of callbacks to execute at the end of a drag operation. Typically this will be set to delete or 
add a tab to the dialog after a drag operation has been completed.

=item dragging

Flag = 1 if we are currently in a drag operation for this object.

=back

=head1 Class Data

=over 1

=item Dropbox

Hash of objects. Since the Tk Drag/Drop mechanism only supports passing strings around, this hash
is used as a "dropbox" where the source can put a object in this hash, key'ed by a text name. This
name is passed to the target (i.e. the drop location). The target can use the string to lookup the
real object in this hash.

=back

=head1 Methods

=cut

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

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