#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::HList;
use Tk::ItemStyle;

my $mw = MainWindow->new();
my $hlist = $mw->Scrolled("HList",
                          -header           => 1,
                          -columns          => 4,
                          -scrollbars       => 'osoe',
                          -width            => 70,
                          -selectbackground => 'SeaGreen3',
                          -background => 'white',
                          )
                    ->pack();


my $headerstyle = $hlist->ItemStyle('window',
                                    -padx   => 0,
                                    -pady   => 0,
                                   );

my $btn_from = $hlist->Button(-text => 'From',    -relief => 'flat', -command => [ \&MyTk::HList::order, 0, 0 ]);
my $btn_subj = $hlist->Button(-text => 'Subject', -relief => 'flat', -command => [ \&MyTk::HList::order, 1, 0 ]);
my $btn_date = $hlist->Button(-text => 'Date',    -relief => 'flat', -command => [ \&MyTk::HList::order, 2, 0 ]);
my $btn_size = $hlist->Button(-text => 'Size',    -relief => 'flat', -command => [ \&MyTk::HList::order, 3, 1 ]);

$hlist->header('create', 0, -itemtype => 'window', -widget => $btn_from, -style => $headerstyle);
$hlist->header('create', 1, -itemtype => 'window', -widget => $btn_subj, -style => $headerstyle);
$hlist->header('create', 2, -itemtype => 'window', -widget => $btn_date, -style => $headerstyle);
$hlist->header('create', 3, -itemtype => 'window', -widget => $btn_size, -style => $headerstyle);

my @x_coords = (2);

my @mails = (['test@email.de',  'Re:HList?',       '1999-11-20', '1432'],
             ["dummy\@foo.com", "Re: HList?",      "1999-11-21", "2335"],
             ['abc@foo.com', 'Re: Re: HList xxx?', '2004-10-12',  '965'],
            );

for my $index (0..$#mails) {
    $hlist->add($index);
    for my $textin (0..scalar(@{$mails[$index]}-1)) {
        $hlist->itemCreate($index, $textin,
                           -text => $mails[$index]->[$textin],
                          );
    }
}

my $x = 2;
for(0..3){
  $x += $hlist->columnWidth(0);
  push(@x_coords,$x);
}
print $_,"\n" for(@x_coords);

my $entry;
$hlist->bind('<Double-1>',[\&MyTk::HList::edit,Ev('x'),Ev('y')]);
$hlist->bind('<Button-1>',sub{if(defined $entry){$entry->destroy();$entry = undef}});

MainLoop();


# -----------------------------------------------------------------------------

package MyTk::HList;

my $last_btn;
my $switch;

BEGIN {
    $last_btn = -1;
    $switch   = 0;
}

sub order {
    my ($which, $numorder) = @_;

    $hlist->delete('all');

    my @sorted_mails = $numorder
                           ? sort{$a->[$which] <=> $b->[$which]} @mails
                           : sort{$a->[$which] cmp $b->[$which]} @mails;

    if ($which == $last_btn) {
        $switch       = 1 if $switch == 0;
        $switch       = -$switch;
        @sorted_mails = reverse @sorted_mails if $switch == -1;
    }
    else {
        $last_btn = $which;
        $switch   = 0;
    }
    
    for my $index(0..$#sorted_mails) {
        $hlist->add($index);
        for my $textin(0..scalar(@{$sorted_mails[$index]}-1)) {
            $hlist->itemCreate($index, $textin,
                               -text => $sorted_mails[$index]->[$textin],
                              );
        }
    }
}

sub edit{
  my ($hlist,$x,$y,$entryref) = @_;
  my ($col,$width);
  my $entryPath = $hlist->nearest($y);
  if($hlist->info('exists',$entryPath)){
    ($col) = grep{$x > $x_coords[$_] && $x <= $x_coords[$_+1]}0..scalar(@x_coords)-1;
    $width = $x_coords[$col+1] - $x_coords[$col];
    print "X: $x .. Col: ",$col," -> ",$x_coords[$col],"/",$x_coords[$col+1]," .. Width: ",$width,"\n";
  }
  $entry = $mw->Entry()->place('-x' => $x_coords[$col], '-y' => $y);
}