package Tk::CanvasDirTree;

our $VERSION = '0.05';
use warnings;
use strict;

use Tk::widgets qw/Canvas/;
use base  qw/Tk::Derived Tk::Canvas/;
use File::Spec;
use Tk::JPEG;
use Tk::PNG;

Construct Tk::Widget 'CanvasDirTree';

sub ClassInit
{
    my ($class, $mw) = @_;
    $class->SUPER::ClassInit($mw);
    $mw->bind($class, "<1>" =>'pick_one' );
    return $class; 
}

sub bind{
   my $self = shift;
   $self->CanvasBind(@_);
}

sub ConfigChanged {
  my ($self,$args)= @_;
  
   foreach my $opt (keys %{$args} ){
 
          if( $opt eq '-indfilla' ){ 
                    $self->{'indfilla'} = $args->{$opt}; 	  

		    my @items = $self->find('withtag','open');
		     foreach my $item (@items){
		         $self->itemconfigure($item, -fill => $args->{$opt});
                      }
		 };

          if( $opt eq '-indfilln' ){ 
	            $self->{'indfilln'} = $args->{$opt}; 	  
                    
		    my @items = $self->find('withtag','ind');
		     foreach my $item (@items){
		        my @tags = $self->gettags($item);
		        if( grep {$_ eq 'open'} @tags ){next} 
		        $self->itemconfigure($item, -fill => $args->{$opt});
                      }
                  };  
       #---------------------------------------------
    
       #----------- fontcolor updates--------------
          if( $opt eq '-fontcolora' ){ 
                    $self->{'fontcolora'} = $args->{$opt}; 	  
		    $self->itemconfigure('list', -activefill => $args->{$opt});
    	         };
        
          if( $opt eq '-fontcolorn' ){ 
	            $self->{'fontcolorn'} = $args->{$opt}; 	  
                    $self->itemconfigure('list', -fill => $args->{$opt});
                  };  
        #---------------------------------------------

       #----------- background image updates--------------
          if(( $opt eq '-backimage' ) or ( $opt eq '-imx' ) or ( $opt eq '-imy' )){ 
                   my $chipped = $opt;
	           substr $chipped, 0, 1, '' ;  #chip off - off of $opt
	           $self->{ $chipped } = $args->{$opt}; 	  
		    $self->set_background( 
                      $self->{'backimage'} ,$self->{'imx'}, $self->{'imy'}
	             );  
		 };
       #---------------------------------------------
   }
  
$self->idletasks;

} #end config changed   
    
#################################################################

sub Populate {
   my ($self, $args) = @_;
  #-------------------------------------------------------------------
   #take care of args which don't belong to the SUPER, see Tk::Derived
   foreach my $extra ('backimage','imx','imy','font','indfilla',
                      'indfilln','fontcolorn','fontcolora','floatback') {
       my $xtra_arg = delete $args->{ "-$extra" };  #delete and read same time 
     if( defined $xtra_arg ) { $self->{$extra} = $xtra_arg }
   }
   #-----------------------------------------------------------------

    $self->SUPER::Populate($args);   

    $self->ConfigSpecs(
     -indfilla => [ 'PASSIVE', undef, undef , undef],  # need to set defaults
     -indfilln => [ 'PASSIVE', undef, undef, undef],   # below for unknown
     -fontcolora => [ 'PASSIVE', undef, undef, undef], # reason ??
     -fontcolorn => [ 'PASSIVE', undef, undef, undef], #
     -backimage => [ 'PASSIVE', undef, undef, undef],
     -imx => [ 'PASSIVE', undef, undef, undef],
     -imy => [ 'PASSIVE', undef, undef, undef],
     -font => [ 'PASSIVE', undef, undef, undef],
     -floatback => [ 'PASSIVE', undef, undef, undef],
    ); 
    
     #set some defaults
     $self->{'indfilla'} ||= 'red';        
     $self->{'indfilln'} ||= 'blue'; 
     $self->{'fontcolorn'} ||= 'black';
     $self->{'fontcolora'} ||= 'red';
     $self->{'backimage'} ||= '';        
     $self->{'imx'} ||= 0; 
     $self->{'imy'} ||= 0;
     $self->{'font'} ||= 'system';
     $self->{'floatback'} ||= 0;
       
#---determine font spacing by making a capital W---
   my $fonttest =  $self->createText(0,0,
              -fill    => 'black',
              -text    => 'W',            
              -font => $self->{'font'},
              );
   
    my ($bx,$by,$bx1,$by1) = $self->bbox($fonttest);
    $self->{'f_width'} = $bx1 - $bx;
    $self->{'f_height'} = $by1 - $by;
    $self->delete($fonttest);
#--------------------------------------------------
   $self->make_trunk('.', 0); 

   $self->after(1,sub{ $self->_set_bars() });

} # end Populate

.....snip......