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', '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 IndicatorCmd { my( $w, $ent, $event ) = @_; my $mode = $w->getmode( $ent ); if ( $event eq '' ) { if ($mode eq 'open' ) { $w->_indicator_image( $ent, 'plusarm' ); } else { $w->_indicator_image( $ent, 'minusarm' ); } } elsif ( $event eq '' ) { if ($mode eq 'open' ) { $w->_indicator_image( $ent, 'plus' ); } else { $w->_indicator_image( $ent, 'minus' ); } } elsif( $event eq '' ) { $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( $ent ); } 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;