#!/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', ) ->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 @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], ); } } 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], ); } } }