home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _b82174e2ae0979043c7fe6a40199bb8b < prev    next >
Encoding:
Text File  |  2004-04-13  |  4.6 KB  |  228 lines

  1. package Tk::Tree;
  2. # Tree -- TixTree widget
  3. #
  4. # Derived from Tree.tcl in Tix 4.1
  5. #
  6. # Chris Dean <ctdean@cogit.com>
  7.  
  8. use vars qw($VERSION);
  9. $VERSION = '3.019'; # $Id: //depot/Tk8/Tixish/Tree.pm#19 $
  10.  
  11. use Tk ();
  12. use Tk::Derived;
  13. use Tk::HList;
  14. use base  qw(Tk::Derived Tk::HList);
  15. use strict;
  16.  
  17. Construct Tk::Widget 'Tree';
  18.  
  19. sub Tk::Widget::ScrlTree { shift->Scrolled('Tree' => @_) }
  20.  
  21. sub Populate
  22. {
  23.  my( $w, $args ) = @_;
  24.  
  25.  $w->SUPER::Populate( $args );
  26.  
  27.  $w->ConfigSpecs(
  28.         -ignoreinvoke => ['PASSIVE',  'ignoreInvoke', 'IgnoreInvoke', 0],
  29.         -opencmd      => ['CALLBACK', 'openCmd',      'OpenCmd', 'OpenCmd' ],
  30.         -indicatorcmd => ['CALLBACK', 'indicatorCmd', 'IndicatorCmd', 'IndicatorCmd'],
  31.         -closecmd     => ['CALLBACK', 'closeCmd',     'CloseCmd', 'CloseCmd'],
  32.         -indicator    => ['SELF', 'indicator', 'Indicator', 1],
  33.         -indent       => ['SELF', 'indent', 'Indent', 20],
  34.         -width        => ['SELF', 'width', 'Width', 20],
  35.         -itemtype     => ['SELF', 'itemtype', 'Itemtype', 'imagetext'],
  36.        );
  37. }
  38.  
  39. sub autosetmode
  40. {
  41.  my( $w ) = @_;
  42.  $w->setmode();
  43. }
  44.  
  45. sub IndicatorCmd
  46. {
  47.  my( $w, $ent, $event ) = @_;
  48.  
  49.  my $mode = $w->getmode( $ent );
  50.  
  51.  if ( $event eq '<Arm>' )
  52.   {
  53.    if ($mode eq 'open' )
  54.     {
  55.      $w->_indicator_image( $ent, 'plusarm' );
  56.     }
  57.    else
  58.     {
  59.      $w->_indicator_image( $ent, 'minusarm' );
  60.     }
  61.   }
  62.  elsif ( $event eq '<Disarm>' )
  63.   {
  64.    if ($mode eq 'open' )
  65.     {
  66.      $w->_indicator_image( $ent, 'plus' );
  67.     }
  68.    else
  69.     {
  70.      $w->_indicator_image( $ent, 'minus' );
  71.     }
  72.   }
  73.  elsif( $event eq '<Activate>' )
  74.   {
  75.    $w->Activate( $ent, $mode );
  76.    $w->Callback( -browsecmd => $ent );
  77.   }
  78. }
  79.  
  80. sub close
  81. {
  82.  my( $w, $ent ) = @_;
  83.  my $mode = $w->getmode( $ent );
  84.  $w->Activate( $ent, $mode ) if( $mode eq 'close' );
  85. }
  86.  
  87. sub open
  88. {
  89.  my( $w, $ent ) = @_;
  90.  my $mode = $w->getmode( $ent );
  91.  $w->Activate( $ent, $mode ) if( $mode eq 'open' );
  92. }
  93.  
  94. sub getmode
  95. {
  96.  my( $w, $ent ) = @_;
  97.  
  98.  return( 'none' ) unless $w->indicatorExists( $ent );
  99.  
  100.  my $img = $w->_indicator_image( $ent );
  101.  return( 'open' ) if( $img eq 'plus' || $img eq 'plusarm' );
  102.  return( 'close' );
  103. }
  104.  
  105. sub setmode
  106. {
  107.  my ($w,$ent,$mode) = @_;
  108.  unless (defined $mode)
  109.   {
  110.    $mode = 'none';
  111.    my @args;
  112.    push(@args,$ent) if defined $ent;
  113.    my @children = $w->infoChildren( @args );
  114.    if ( @children )
  115.     {
  116.      $mode = 'close';
  117.      foreach my $c (@children)
  118.       {
  119.        $mode = 'open' if $w->infoHidden( $c );
  120.        $w->setmode( $c );
  121.       }
  122.     }
  123.   }
  124.  
  125.  if (defined $ent)
  126.   {
  127.    if ( $mode eq 'open' )
  128.     {
  129.      $w->_indicator_image( $ent, 'plus' );
  130.     }
  131.    elsif ( $mode eq 'close' )
  132.     {
  133.      $w->_indicator_image( $ent, 'minus' );
  134.     }
  135.    elsif( $mode eq 'none' )
  136.     {
  137.      $w->_indicator_image( $ent, undef );
  138.     }
  139.   }
  140. }
  141.  
  142. sub Activate
  143. {
  144.  my( $w, $ent, $mode ) = @_;
  145.  if ( $mode eq 'open' )
  146.   {
  147.    $w->Callback( -opencmd => $ent );
  148.    $w->_indicator_image( $ent, 'minus' );
  149.   }
  150.  elsif ( $mode eq 'close' )
  151.   {
  152.    $w->Callback( -closecmd => $ent );
  153.    $w->_indicator_image( $ent, 'plus' );
  154.   }
  155.  else
  156.   {
  157.  
  158.   }
  159. }
  160.  
  161. sub OpenCmd
  162. {
  163.  my( $w, $ent ) = @_;
  164.  # The default action
  165.  foreach my $kid ($w->infoChildren( $ent ))
  166.   {
  167.    $w->show( -entry => $kid );
  168.   }
  169. }
  170.  
  171. sub CloseCmd
  172. {
  173.  my( $w, $ent ) = @_;
  174.  
  175.  # The default action
  176.  foreach my $kid ($w->infoChildren( $ent ))
  177.   {
  178.    $w->hide( -entry => $kid );
  179.   }
  180. }
  181.  
  182. sub Command
  183. {
  184.  my( $w, $ent ) = @_;
  185.  
  186.  return if $w->{Configure}{-ignoreInvoke};
  187.  
  188.  $w->Activate( $ent, $w->getmode( $ent ) ) if $w->indicatorExists( $ent );
  189. }
  190.  
  191. sub _indicator_image
  192. {
  193.  my( $w, $ent, $image ) = @_;
  194.  my $data = $w->privateData();
  195.  if (@_ > 2)
  196.   {
  197.    if (defined $image)
  198.     {
  199.      $w->indicatorCreate( $ent, -itemtype => 'image' )
  200.          unless $w->indicatorExists($ent);
  201.      $data->{$ent} = $image;
  202.      $w->indicatorConfigure( $ent, -image => $w->Getimage( $image ) );
  203.     }
  204.    else
  205.     {
  206.      $w->indicatorDelete( $ent ) if $w->indicatorExists( $ent );
  207.      delete $data->{$ent};
  208.     }
  209.   }
  210.  return $data->{$ent};
  211. }
  212.  
  213. 1;
  214.  
  215. __END__
  216.  
  217. #  Copyright (c) 1996, Expert Interface Technologies
  218. #  See the file "license.terms" for information on usage and redistribution
  219. #  of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  220. #
  221. #  The file man.macros and some of the macros used by this file are
  222. #  copyrighted: (c) 1990 The Regents of the University of California.
  223. #               (c) 1994-1995 Sun Microsystems, Inc.
  224. #  The license terms of the Tcl/Tk distrobution are in the file
  225. #  license.tcl.
  226.  
  227. =cut
  228.