package ProjektExplorer;

use vars qw($VERSION);
$VERSION = '1.001';

use Tk;
use Tk::Derived;
use Tk::Tree;
use Cwd;
use DirHandle;

use base  qw(Tk::Derived Tk::Tree);

use strict;

Construct Tk::Widget 'ProjektExplorer';

sub Populate {
    my( $cw, $args ) = @_;

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

    $cw->ConfigSpecs(
        -dircmd         => [qw/CALLBACK dirCmd DirCmd DirCmd/],
        -showhidden     => [qw/PASSIVE showHidden ShowHidden 0/],
        -closeFolderImage          => [qw/PASSIVE closeFolderImage closeFolderImage folder/],
        -openFolderImage          => [qw/PASSIVE openFolderImage openFolderImage folder/],
        -pageImage          => [qw/PASSIVE pageImage pageImage folder/],
        -projectImage          => [qw/PASSIVE projectImage projectImage folder/],
        -root          => [qw/PASSIVE root root/],
        -directory      => [qw/SETMETHOD directory Directory ./],
        -value          => '-directory');

    $cw->configure( -separator => '/', -itemtype => 'imagetext');
}

sub DirCmd {
	my($w, $dir, $showhidden)=@_;
	$dir.="/" unless $dir=~m/\/$/i;
	my $dirName=$w->cget('-root').$dir;
	my $h=DirHandle->new($dirName) or return();
	my @names=grep($_ ne '.' && $_ ne '..', $h->read);
	@names = grep(!/^[.]/, @names ) unless $showhidden;
#	map {print "$_\n"}@names;
	return(@names);
}

sub directory{
	# Einstieg!
	my ($w,$key,$val) = @_;
	$w->delete('all');
	my $dirName=$w->cget('-directory');
	$dirName=~s/\/$//;
	$w->configure(-root=>$dirName);
	if (defined $w->cget('-image')){
		$w->chdir($val);
	}
	else{
		$w->afterIdle([$w, 'chdir'=>$val]);
	}
}


sub chdir{
	my($w,$val)=@_;
	my $name=$w->cget('-directory');
	($name)=($name=~m#([^/]+?)/$#);
	$w->add_to_tree('/', $name, "", '-projectImage') unless $w->infoExists('/');
	# $w->OpenCmd('/');
	$w->setmode('/', 'open' );
}


sub OpenCmd {
	my($w, $dir)=@_;

	my $parent=$dir;
	$dir='' if $dir eq '/';
	foreach my $name ($w->dirnames($parent)) {
		next if ($name eq '.' || $name eq '..');
        	my $subdir="$dir/$name";

        	# next unless -d $w->cget('-root').$subdir;

        	if($w->infoExists($subdir)) {
			$w->show(-entry=>$subdir);
		}

		else{
			if(-d $w->cget('-root').$subdir){
				$w->add_to_tree($subdir, $name, $parent, '-openFolderImage');
			}
			else{
				if($name=~m/\.txt$/i){
					$w->add_to_tree($subdir, $name, $parent, '-pageImage');
				}
			}
		}
	}
}


sub add_to_tree{
	my($w, $dir, $name, $parent, $art ) = @_;
	# $art='-pageImage' unless $art;
	my $image = $w->cget($art);
	my $mode = 'none';
	$mode = 'open' if -d ($w->cget('-root').$dir);
	my $data=$w->cget('-root').$dir;
	my @args = (-image=>$image, -text=>$name, -data=>$data);

	if($parent){ # Add in alphabetical order.
		foreach my $sib ($w->infoChildren($parent)){
			my $a;
			my $b;
			if (-d ($w->cget('-root').$sib)){
				$a="A".$sib;
			}
			else{
				$a="B".$sib;
			}

			if (-d ($w->cget('-root').$dir)){
				$b="A".$dir;
			}
			else{
				$b="B".$dir;
			}

			if($a gt $b) {
				push @args, (-before => $sib);
				last;
			}
		}
	}

	$w->add($dir, @args);

	$w->setmode( $dir, $mode );
}

sub has_subdir{
	my( $w, $dir ) = @_;
	foreach my $name ($w->dirnames($dir)){
		next if ($name eq '.' || $name eq '..');
		next if ($name =~ /^\.+$/);
		# print $w->cget('-root')."$dir/$name\n";
		return(1) if -d $w->cget('-root')."$dir/$name";
	}
	return( 1 );
}

sub dirnames {
	my ($w, $dir)=@_;
	my @names=$w->Callback('-dircmd', $dir, $w->cget('-showhidden'));
	return(@names);
}

sub getAktRoot{
	my $w=shift;
	return $w->cget('-root');
}

__END__