Hi,
I meant Mtree, NOT MListplus. For your perusal I am including the Mtree.pm code here. It also uses HListplus.pm. You can find HListplus.pm in cpan,http://search.cpan.org/~mikra/Tk-MK-0.21/lib/Tk/HListplus.pm
package Tk::MTree;
# Tree -- TixTree widget
#
# Derived from Tree.tcl in Tix 4.1
#
use vars qw($VERSION);
$VERSION = '4.005'; # $Id: //depot/Tkutf8/Tixish/Tree.pm#5 $
use Tk ();
use Tk::Derived;
use Tk::HListplus;
use base qw(Tk::Derived Tk::HListplus);
use strict;
Construct Tk::Widget 'MTree';
sub Tk::Widget::ScrlMTree { shift->Scrolled('MTree' => @_) }
sub Populate
{
my( $w, $args ) = @_;
$w->SUPER::Populate( $args );
$w->ConfigSpecs(
-ignoreinvoke => ['PASSIVE', 'ignoreInvoke', 'IgnoreInvoke',
+0],
-opencmd => ['CALLBACK', 'openCmd', 'OpenCmd', 'Open
+Cmd' ],
-indicatorcmd => ['CALLBACK', 'indicatorCmd', 'IndicatorCmd',
+'IndicatorCmd'],
-closecmd => ['CALLBACK', 'closeCmd', 'CloseCmd', 'Clo
+seCmd'],
-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
{
$w->_indicator_image( $ent, 'minus' );
}
}
elsif( $event eq '<Activate>' )
{
$w->Activate( $ent, $mode );
$w->Callback( -browsecmd => $ent );
}
}
sub close
{
my( $w, $ent ) = @_;
my $mode = $w->getmode( $ent );
$w->Activate( $ent, $mode ) if( $mode eq 'close' );
}
sub open
{
my( $w, $ent ) = @_;
my $mode = $w->getmode( $ent );
$w->Activate( $ent, $mode ) if( $mode eq 'open' );
}
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 setmode
{
my ($w,$ent,$mode) = @_;
unless (defined $mode)
{
$mode = 'none';
my @args;
push(@args,$ent) if defined $ent;
my @children = $w->infoChildren( @args );
if ( @children )
{
$mode = 'close';
foreach my $c (@children)
{
$mode = 'open' if $w->infoHidden( $c );
$w->setmode( $c );
}
}
}
if (defined $ent)
{
if ( $mode eq 'open' )
{
$w->_indicator_image( $ent, 'plus' );
}
elsif ( $mode eq 'close' )
{
$w->_indicator_image( $ent, 'minus' );
}
elsif( $mode eq 'none' )
{
$w->_indicator_image( $ent, undef );
}
}
}
sub Activate
{
my( $w, $ent, $mode ) = @_;
if ( $mode eq 'open' )
{
$w->Callback( -opencmd => $ent );
$w->_indicator_image( $ent, 'minus' );
}
elsif ( $mode eq 'close' )
{
$w->Callback( -closecmd => $ent );
$w->_indicator_image( $ent, 'plus' );
}
else
{
}
}
sub OpenCmd
{
my( $w, $ent ) = @_;
# The default action
foreach my $kid ($w->infoChildren( $ent ))
{
$w->show( -entry => $kid );
}
}
sub CloseCmd
{
my( $w, $ent ) = @_;
# The default action
foreach my $kid ($w->infoChildren( $ent ))
{
$w->hide( -entry => $kid );
}
}
sub Command
{
my( $w, $ent ) = @_;
return if $w->{Configure}{-ignoreInvoke};
$w->Activate( $ent, $w->getmode( $ent ) ) if $w->indicatorExists( $en
+t );
}
sub _indicator_image
{
my( $w, $ent, $image ) = @_;
my $data = $w->privateData();
if (@_ > 2)
{
if (defined $image)
{
$w->indicatorCreate( $ent, -itemtype => 'image' )
unless $w->indicatorExists($ent);
$data->{$ent} = $image;
$w->indicatorConfigure( $ent, -image => $w->Getimage( $image ) );
}
else
{
$w->indicatorDelete( $ent ) if $w->indicatorExists( $ent );
delete $data->{$ent};
}
}
return $data->{$ent};
}
1;
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.