view release on metacpan or  search on metacpan

lib/Tcl/pTk/Tree.pm  view on Meta::CPAN

package Tcl::pTk::Tree;
# Tree -- TixTree widget
#
# Derived from Tree.tcl in Tix 4.1
#
# Chris Dean <ctdean@cogit.com>
#
# Converted to Tcl::pTk  John Cerney

our ($VERSION) = ('1.11');

use Tcl::pTk ();
use Tcl::pTk::Derived;
use Tcl::pTk::HList;
use base  qw(Tcl::pTk::Derived Tcl::pTk::HList);
use strict;

Construct Tcl::pTk::Widget 'Tree';

sub Tcl::pTk::Widget::ScrlTree { shift->Scrolled('Tree' => @_) }


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

 $w->SUPER::Populate( $args );
 
 # Make the button-1 motion not change the selection. like it does in perl/tk
 $w->call('bind', 'TixHList', '<B1-Motion>', '');

 $w->ConfigSpecs(
        -ignoreinvoke => ['PASSIVE',  'ignoreInvoke', 'IgnoreInvoke', 0],
        -opencmd      => ['CALLBACK', 'openCmd',      'OpenCmd', 'OpenCmd' ],
        -indicatorcmd => ['SELF', 'indicatorCmd', 'IndicatorCmd', [$w, 'IndicatorCmd']],
        -closecmd     => ['CALLBACK', 'closeCmd',     'CloseCmd', 'CloseCmd'],
        -indicator    => ['SELF', 'indicator', 'Indicator', 1],
        -indent       => ['SELF', 'indent', 'Indent', 20],
        -width        => ['SELF', 'width', 'Width', 20],
        -itemtype     => ['SELF', 'itemtype', 'Itemtype', 'imagetext'],
	-foreground   => ['SELF'],
       );
}

sub autosetmode
{
 my( $w ) = @_;
 $w->setmode();
}

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

 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