diff options
Diffstat (limited to 'Master/tlpkg/tlperl.old/lib/Tk/Tree.pm')
| -rw-r--r-- | Master/tlpkg/tlperl.old/lib/Tk/Tree.pm | 228 |
1 files changed, 228 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.old/lib/Tk/Tree.pm b/Master/tlpkg/tlperl.old/lib/Tk/Tree.pm new file mode 100644 index 00000000000..6d4f76b0c63 --- /dev/null +++ b/Master/tlpkg/tlperl.old/lib/Tk/Tree.pm @@ -0,0 +1,228 @@ +package Tk::Tree; +# Tree -- TixTree widget +# +# Derived from Tree.tcl in Tix 4.1 +# +# Chris Dean <ctdean@cogit.com> + +use vars qw($VERSION); +$VERSION = '4.005'; # $Id: //depot/Tkutf8/Tixish/Tree.pm#5 $ + +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 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( $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; + +__END__ + +# Copyright (c) 1996, Expert Interface Technologies +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# The file man.macros and some of the macros used by this file are +# copyrighted: (c) 1990 The Regents of the University of California. +# (c) 1994-1995 Sun Microsystems, Inc. +# The license terms of the Tcl/Tk distrobution are in the file +# license.tcl. + +=cut |