use Tk;
use Tk::MListbox;
use File::stat;

my $dir_name=0;
my $dir_mode=3;

my $dir_prefix=' <';
my $dir_postfix='>';
my $file_prefix='  --> ';
my $file_postfix='';

my $mw=new MainWindow;

$mw->geometry('+30+30');

my $control=$mw->Frame->pack(-expand=>1,-fill=>'x');

$control->Button(
	-text=>'Exit',
	-width=>30,
	-background=>'#ffafaf',
	-activebackground=>'#ff7f7f',
	-command=>sub{exit}
	)->pack(-side=>'right');
	
my $control1=$control->Frame->pack(-side=>'right',-expand=>1,-fill=>'x');

my $control2=$control1->Frame->pack(-anchor=>'center');

$control2->Button(
	-width=>10,
	-text=>'Up',
	-command=>sub{directory('..')}
	)->pack(-side=>'left');

$control2->Button(
	-width=>10,
	-text=>'<',
	-command=>sub{my_move(-1)}
	)->pack(-side=>'left');
	
$control2->Button(
	-width=>10,
	-text=>'>',
	-command=>sub{my_move(1)}
	)->pack(-side=>'left');
	
my $go_button=$control2->Button(
	-width=>10,
	-text=>'Go',
	-command=>\&openFileOrDir
	)->pack(-side=>'left');

my $ml = $mw->Scrolled('MListbox',
	-height=>20,
	-width=>685,
	-font=>[-family=>'Courier',-size=>10],
	-scrollbars => 'e',
	-selectmode => 'browse',
	-columns=>
		[
	
		[-text=>'Name',-textwidth=>'30',-bg=>'#ffafaf',-fg=>'#000000'],
		[-text=>'Size',-textwidth=>'20',-bg=>'#afffaf',-fg=>'#000000'],
		[-text=>'Modt',-textwidth=>'21',-bg=>'#ffafaf',-fg=>'#000000'],
		[-text=>'Mode',-textwidth=>'12',-bg=>'#afffaf',-fg=>'#000000',-comparecmd => sub {$_[1] cmp $_[0]}]
	
		]
	)->pack;
	
my $text=$mw->Scrolled('Text',
	-scrollbars=>'se',
	-width=>97,
	-height=>15
	)->pack;
	
$ml->bindRows("<Double-Button-1>", \&openFileOrDir);

$ml->bindRows('<ButtonRelease-1>',  
	sub
		{
		my ($w, $infoHR) = @_;
		view_file($infoHR->{-row});
		}
	);
	
directory('.');
	
MainLoop;

sub directory
{
	my ($dir) = @_;
	my ($par_attr);
	chdir($dir);
	my $pwd = `echo %cd%`; chomp $pwd;
	$mw->title ("Directory: $pwd");
	# Empty $ml
	$ml->delete(0,'end');
	opendir (DIR, ".") or die "Cannot open '.': $!\n";
	foreach my $name (readdir(DIR)) {	
	my $st = stat($name);
	my $mode = $st->mode;
	my $type = do {
	if (-l $name) {
	$mode = 0777;
	'l';
	} elsif (-f $name) {
	'-';
	} elsif (-d $name) {
	'd';
	} elsif (-p $name) {
	'p';
	} elsif (-b $name) {
	'b';
	} elsif (-c $name) {
	'c';
	} else {
	' ';
	}};
	
	my $mtime = $st->mtime;
	
	$mtime=' '.my_time($mtime);
	
	$mode = " $type" . convMode ($st->mode);
	
	if($type eq 'd')
		{
		$name="$dir_prefix$name$dir_postfix";
		}
	else
		{
		$name="$file_prefix$name$file_postfix";
		}
		
	my $size=' '.my_size($st->size);
	
	my @row=[$name,$size,$mtime,$mode];
	
	if(($name ne "$dir_prefix.$dir_postfix")&&($name ne "$dir_prefix..$dir_postfix"))
		{
		$ml->insert('end',@row);
		}
		
	if($name eq "$dir_prefix..$dir_postfix")
		{
		@par_attr=@row;
		}
		
	}
	
	$ml->sort(0,(3,0,2,1));
	
	print "pwd:$pwd\n";
	if(!($pwd=~/:\\$/))
		{
		$ml->insert
				(0, 
				@par_attr
				);
		}
		
	$ml->update;
}

sub my_time
	{
	my $mtime=shift;
	
	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime($mtime);
	
	$mtime=sprintf("%02d.%02d.%02d %02d:%02d:%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec);
	
	return $mtime;
	}

sub convMode 
{
	my $mode = shift;
	my $result = '';
	$result .= ($mode & 0400) ? 'r' : '-';
	$result .= ($mode & 0200) ? 'w' : '-';
	if ($mode & 0100) {
	if ($mode & 04000) {
	$result .= 's';
	} else {
	$result .= 'x';
	}
	} else {
	$result .= '-';
	}
	$result .= ($mode & 040) ? 'r' : '-';
	$result .= ($mode & 020) ? 'w' : '-';
	if ($mode & 010) {
	if ($mode & 02000) {
	if (($mode & 02010) || 
	($mode & 02030) ||
	($mode & 02050) ||
	($mode & 02070))
	{
	$result .= 's';
	} else {
	$result .= 'l';
	}
	} else {
	$result .= 'x';
	}
	} else {
	$result .= '-';
	}
	$result .= ($mode & 04) ? 'r' : '-';
	$result .= ($mode & 02) ? 'w' : '-';
	$result .= ($mode & 01) ? 'x' : '-';
	
	return $result;
}

sub openFileOrDir
{
	my @sel = $ml->curselection;
	if (@sel == 1) {
	
	my $name = ($ml->getRow($sel[0]))[$dir_name];
	my $mode = ($ml->getRow($sel[0]))[$dir_mode];
	
	if ($mode =~ m/^ d/) {   # Directory?
	
	$name=~/^$dir_prefix(.*)$dir_postfix/;
	
	directory ($1);
	}
	}
}

sub view_file
	{
	
	my $row=shift;
	
	if(is_dir($row))
		{
		$go_button->configure(-state=>'normal');
		
		my_put('');
		}
	else
		{
		$go_button->configure(-state=>'disabled');
		
		my $name=get_name($row);
	
		view_file_inner($name);
		
		}
	
	}
	
sub get_name
	{
	
	my $row=shift;
	
	my $name=($ml->getRow($row))[$dir_name];
	$name=~/^$file_prefix(.*)/;
	$name=$1;
	
	return $name;
	
	}
	
sub is_dir
	{
	
	my $row=shift;
	
	my $name=($ml->getRow($row))[$dir_name];
	
	return 1 if($name=~/</);
	
	return 0;
	
	}

sub view_file_inner
	{
	
	my $file=shift;
	
	if($file=~/\.pl$|\.bat|\.pm|\.txt|\.text/)
		{
		
		open FILE,$file;
		my $pl=join('',<FILE>);
		close FILE;
		
		my_put("Full name: $file\n\n$pl");
		
		}
	
	else
		{
		
		my_put("Full name: $file\n\nThis file can't be viewed.\n");
		
		}
	
	}
	
sub my_put
	{
	
	my $what=shift;
	
	$what=~s/\r//g;
	
	$text->delete('1.0','end');
	$text->insert('1.0',$what);
	
	}
	
sub my_size
	{
	
	my $what=shift;
	
	return '' unless $what;
	
	return sprintf "%10d %7s",$what,my_size_inner($what);
	
	}
	
sub my_size_inner
	{
	
	my $what=shift;
	
	return '' unless $what;
	
	return "$what b" if $what<1000;
	
	return sprintf("%.0f",$what/1000).' k' if $what<1000000;
	
	return sprintf("%.0f",$what/1000000).' M';
	
	}
	
sub my_move
	{
	
	my $dir=shift;
	
	my $cur=($ml->curselection)[0];
	
	my $size=$ml->size;
	
	print "old $dir $cur $size\n";
	
	$cur+=$dir;
	
	$cur=$size-1 if $cur<0;
	
	$cur=0 if $cur>=$size;
	
	print "new $dir $cur $size\n";
	
	$ml->selectionClear(0,'end');
	$ml->selectionSet($cur);
	
	$ml->see($cur);
	
	view_file($cur);
	
	}