view release on metacpan or  search on metacpan

Tixish/Tree.pm  view on Meta::CPAN

package Tk::Tree;
# Tree -- TixTree widget
#
# Derived from Tree.tcl in Tix 4.1
#
# Chris Dean <ctdean@cogit.com>
# Changes: Renee Baecker <module@renee-baecker.de>

use vars qw($VERSION);
$VERSION = '4.72'; # $Id: Tree.pm,v 1.4 2007/11/04 09:11:31 eserte Exp $

use Tk ();
use Tk::Derived;
use Tk::HList;
use base  qw(Tk::Derived Tk::HList);
use strict;

Construct Tk::Widget 'Tree';

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

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

 $w->SUPER::Populate( $args );

 $w->ConfigSpecs(
        -ignoreinvoke => ['PASSIVE',  'ignoreInvoke', 'IgnoreInvoke', 0],
        -opencmd      => ['CALLBACK', 'openCmd',      'OpenCmd', 'OpenCmd' ],
        -indicatorcmd => ['CALLBACK', 'indicatorCmd', 'IndicatorCmd', '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 add_pathimage
{
 my ($w,$path,$imgopen,$imgclose) = @_;
 $imgopen  ||= "minusarm";
 $imgclose ||= "plusarm";
  
 my $separator = $w->cget(-separator);
  
 $path =~ s/([\.?()|])/\\$1/g;
 $path =~ s/\$/\\\$/g;
 $path =~ s/\\\$$/\$/;
 $path =~ s/\*/[^$separator]+/g;
  
 push(@{$w->{Images}},[$path,$imgopen,$imgclose]);
}

sub child_entries
{
 my ($w,$path,$depth) = @_;
  
 my $level =  1;
 $depth  ||=  1;
 $path   ||= '';
  
 my @children = $w->_get_childinfos($depth,$level,$path);
  
 return wantarray ? @children : scalar(@children);
}