view release on metacpan or  search on metacpan

Tk/VTree.pm  view on Meta::CPAN

# VTree -- Tix Virtual base class needed to implement the Tree widget.
#
# This should not be used directly by the application programmer.
#
# Derived from VTree.tcl in Tix 4.1
# Thanks to rsi@earthling.net for VStack.pm
#
# Chris Dean <ctdean@cogit.com> 

package Tk::VTree;

require 5.004;

use Tk::Derived;
use Tk::HList;

use strict;
use vars qw( @ISA $VERSION );
@ISA = qw( Tk::Derived Tk::HList );
$VERSION = '0.02';

BEGIN { 
    die "Patched version of HList.pm required" 
        unless( $Tk::HList::VERSION =~ /ctd/ || $Tk::HList::VERSION > 2.013 );
}

sub Populate {
    my( $w, $args ) = @_;

    $args->{-indicatorcmd} ||= sub { $w->IndicatorCmd( @_ ) };
    $w->SUPER::Populate( $args );
        
    $w->ConfigSpecs(
        -ignoreinvoke => ["PASSIVE",  "ignoreInvoke", "IgnoreInvoke", 0],
        -opencmd      => ["CALLBACK", "openCmd",      "OpenCmd",
                          sub { $w->OpenCmd( @_ ) } ],
        -closecmd     => ["CALLBACK", "closeCmd",     "CloseCmd", 
                          sub { $w->CloseCmd( @_ ) } ] );
}

sub IndicatorCmd {
    my( $w, $ent ) = @_;

    my $event = $w->tixEventType;
    my $mode = $w->GetMode( $ent );

    if( $event eq "<Arm>" ) {
        if( $mode eq "open" ) {
            $w->_indicator_image( $ent, "plusarm" );
        } else {
            $w->_indicator_image( $ent, "minusarm" );
        }
    } elsif( $event eq "<Disarm>" ) {
        if( $mode eq "open" ) {
            $w->_indicator_image( $ent, "plus" );
        } else {
            $w->_indicator_image( $ent, "minus" );
        }
    } elsif( $event eq "<Activate>" ) {
        $w->Activate( $ent, $mode );
        $w->Callback( -browsecmd => $ent );
    }
}

sub GetMode {
    my( $w, $ent ) = @_;

    return( "none" ) unless $w->indicatorExists( $ent );

    my $img = $w->_indicator_image( $ent );
    return( "open" ) if( $img eq "plus" || $img eq "plusarm" );
    return( "close" );
}

sub Activate {
    my( $w, $ent, $mode ) = @_;

    if( $mode eq "open" ) {
        $w->Callback( -opencmd => $ent );