summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/Tree.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/Tree.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/Tree.pm228
1 files changed, 0 insertions, 228 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/Tree.pm b/Master/tlpkg/tlperl/lib/Tk/Tree.pm
deleted file mode 100644
index 6d4f76b0c63..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/Tree.pm
+++ /dev/null
@@ -1,228 +0,0 @@
-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