package Tk::MulColListbox; use vars qw($VERSION); $VERSION = '0.4'; use Tk; require Tk::Frame; use strict; use base qw(Tk::Frame); Construct Tk::Widget 'MulColListbox'; sub Populate { my ($cw, $args) = @_; $cw->{headers}->{canvas} = $cw-> Canvas((exists($args->{-headerbackground}) ? (-background => $args->{-headerbackground}) : ()), -highlightthickness=>0, -takefocus=>0, -height=>30, (exists($args->{-width}) ? (-width => $args->{-width}) : ()), -closeenough=>1, )->pack(-side=>'top', -fill=>'x'); $cw->{subframe} = $cw-> Frame((exists($args->{-background}) ? (-background => $args->{-background}) : ()), )->pack(-side=>'top', -fill=>'both', -expand=>1); $cw->{lists}->{canvas} = $cw->{subframe}-> Canvas((exists($args->{-background}) ? (-background => $args->{-background}) : (-background=>"white")), -highlightthickness=>0, -takefocus=>0, (exists($args->{-height}) ? (-height => $args->{-height}) : ()), (exists($args->{-width}) ? (-width => $args->{-width}) : ()), )->pack(-side=>'left', -fill=>'both', -expand=>1); $cw->{scrollbar} = $cw->{subframe}-> Scrollbar(-highlightthickness=>0, -takefocus=>0, (exists($args->{-scrollbarrelief}) ? (-relief => delete($args->{-scrollbarrelief})) : ()), (exists($args->{-scrollbarborderwidth}) ? (-borderwidth => delete($args->{-scrollbarborderwidth})) : ()), -command=>['yview',$cw->{lists}->{canvas}], )->pack(-side=>'right', -fill=>'y'); $cw->{lists}->{canvas}-> configure(-yscrollcommand=>[ 'set',$cw->{scrollbar}]); $cw->{vars}->{Headers}->{Font} = (exists($args->{-headerfont}) ? delete($args->{-headerfont}) : (exists($args->{-font}) ? $args->{-font} : "-*-arial-regular-r-*--10-*-*-p-*-*")); $cw->{vars}->{Headers}->{Background}->{Light} = (exists($args->{-headerlight}) ? delete($args->{-headerlight}) : "grey100"); $cw->{vars}->{Headers}->{Background}->{Normal} = (exists($args->{-headerbackground}) ? delete($args->{-headerbackground}) : $cw->{headers}->{canvas}->cget("background")); $cw->{vars}->{Headers}->{Background}->{Dark} = (exists($args->{-headerdark}) ? delete($args->{-headerdark}) : "grey50"); $cw->{vars}->{Headers}->{Foreground} = (exists($args->{-headerforeground}) ? delete($args->{-headerforeground}) : "black"); $cw->{vars}->{Headers}->{BorderWidth} = (exists($args->{-headerborderwidth}) ? delete($args->{-headerborderwidth}) : 2); $cw->{vars}->{Headers}->{Index} = -1; $cw->{vars}->{Headers}->{Cursor} = $cw->{headers}->{canvas}->cget("cursor"); $cw->{vars}->{Headers}->{Nonfixed} = 0; $cw->{vars}->{Headers}->{Id} = 0; $cw->{vars}->{Entries}->{Font} = (exists($args->{-font}) ? delete($args->{-font}) : "-*-arial-regular-r-*--10-*-*-p-*-*"); $cw->{vars}->{Entries}->{Background} = (exists($args->{-background}) ? $args->{-background} : "white"); $cw->{vars}->{Entries}->{Foreground} = (exists($args->{-foreground}) ? $args->{-foreground} : "black"); $cw->{vars}->{Entries}->{SelectBackground} = (exists($args->{-selectbackground}) ? delete($args->{-selectbackground}) : "lightblue"); $cw->{vars}->{Entries}->{SelectForeground} = (exists($args->{-selectforeground}) ? delete($args->{-selectforeground}) : "black"); $cw->{vars}->{Entries}->{Draw} = 1; $cw->{vars}->{Entries}->{Id} = 0; $cw->{vars}->{Entries}->{Mode} = (exists($args->{-selectmode}) ? delete($args->{-selectmode}) : "single"); $cw->{vars}->{Entries}->{SortBy} = (exists($args->{-sortby}) ? delete($args->{-sortby}) : "_none_"); $cw->{vars}->{Entries}->{SortOrder} = (exists($args->{-sortorder}) ? delete($args->{-sortorder}) : "ascending"); $cw->{columns} = []; $cw->{entries} = {}; $cw->{headers}->{canvas}-> Tk::bind("", [ sub { my ($canvas,$cw) = @_; return if ($cw->{headers}->{canvas}->width() <= ((10 * ($#{$cw->{columns}})) + ($cw->{scrollbar}->cget("width") + (2 * $cw->{scrollbar}->cget("borderwidth"))))); if (!exists($cw->{vars}->{Headers}->{Width})) { my $total = 0; foreach my $index (0..$#{$cw->{columns}}) { $total += $cw->{columns}->[$index]->{width}; } $cw->{vars}->{Headers}->{Width} = $total; } my $delta = $cw->{headers}->{canvas}->width() - $cw->{vars}->{Headers}->{Width}; $cw->ResizeColumns("insert",$delta); $cw->{vars}->{Headers}->{Width} = $cw->{headers}->{canvas}->width(); }, $cw ]); $cw->{headers}->{canvas}-> Tk::bind("", [ sub { my ($canvas,$evX,$cw) = @_; return if ($cw->{vars}->{Headers}->{Index} == -1); my $newX = $canvas->canvasx($evX); my $deltaX = $newX - $cw->{vars}->{Headers}->{X}; my $newWidthBefore = $cw->{vars}->{Headers}->{WidthBefore} + $deltaX; my $newWidthAfter = $cw->{vars}->{Headers}->{WidthAfter} - $deltaX; if ($newWidthBefore <= 10) { $newWidthBefore = 10; $newWidthAfter = $cw->{vars}->{Headers}->{WidthBefore} + $cw->{vars}->{Headers}->{WidthAfter} - 10; } if ($newWidthAfter <= 10) { $newWidthBefore = $cw->{vars}->{Headers}->{WidthBefore} + $cw->{vars}->{Headers}->{WidthAfter} - 10; $newWidthAfter = 10; } my $moveX = $cw->{columns}->[$cw->{vars}->{Headers}->{Index}+1]->{width} - $newWidthAfter; $cw->{columns}->[$cw->{vars}->{Headers}->{Index}]->{width} = $newWidthBefore; $cw->{columns}->[$cw->{vars}->{Headers}->{Index}+1]->{width} = $newWidthAfter; $cw->{lists}->{canvas}-> move("column-".$cw->{columns}->[($cw->{vars}->{Headers}->{Index}+1)]->{id},$moveX,0); $cw->DrawHeaders(); }, Ev('x'), $cw, ]); $cw->{headers}->{canvas}-> Tk::bind("", [ sub { my ($canvas,$evX,$cw) = @_; return if ($cw->{vars}->{Headers}->{Index} == -1); my $newX = $canvas->canvasx($evX); my $newWidthBefore = $cw->{vars}->{Headers}->{WidthBefore} + ($newX - $cw->{vars}->{Headers}->{X}); my $newWidthAfter = $cw->{vars}->{Headers}->{WidthAfter} - ($newX - $cw->{vars}->{Headers}->{X}); if ($newWidthBefore <= 10) { $newWidthBefore = 10; $newWidthAfter = $cw->{vars}->{Headers}->{WidthBefore} + $cw->{vars}->{Headers}->{WidthAfter} - 10; } if ($newWidthAfter <= 10) { $newWidthBefore = $cw->{vars}->{Headers}->{WidthBefore} + $cw->{vars}->{Headers}->{WidthAfter} - 10; $newWidthAfter = 10; } my $moveX = $cw->{columns}->[$cw->{vars}->{Headers}->{Index}+1]->{width} - $newWidthAfter; $cw->{columns}->[$cw->{vars}->{Headers}->{Index}]->{width} = $newWidthBefore; $cw->{columns}->[$cw->{vars}->{Headers}->{Index}+1]->{width} = $newWidthAfter; $cw->{lists}->{canvas}-> move("column-".$cw->{columns}->[($cw->{vars}->{Headers}->{Index}+1)]->{id},$moveX,0); $cw->{vars}->{Headers}->{Index} = -1; $cw->DrawHeaders(); $cw->{headers}->{canvas}->configure(-cursor=>$cw->{vars}->{Headers}->{Cursor}); }, Ev('x'), $cw, ]); $cw->{lists}->{canvas}-> Tk::bind("", [ sub { my ($canvas,$cw) = @_; $cw->setScrollRegion(); }, $cw ]); $cw->AddColumn(-fixed=>1, -place=>"begin", -marker=>1, (exists($args->{-markerstyle}) ? ( -style=>delete($args->{-markerstyle}) ) : () ), -key=>"mcl_viewed") if (exists($args->{-marker}) && ($args->{-marker} == 1)); delete($args->{-marker}); $cw->AddColumn(-filler=>1, -nolist=>1, -place=>"begin", -header=>"", -width=>0, -key=>"mcl_filler"); $cw->AddColumn(-fixed=>1, -nolist=>1, -place=>"end", -header=>"", -key=>"mcl_undef"); } sub Refresh { my $cw = shift; $cw->DrawHeaders(); $cw->DrawEntries(); } sub ResizeColumns { my ($cw,$type,$delta,$startCol) = @_; my @columnDeltas; foreach my $col (0..$#{$cw->{columns}}) { $columnDeltas[$col] = 0; } if (($type eq "replace") && ($delta > 0)) { foreach my $index (0..$#{$cw->{columns}}) { $cw->{columns}->[$index]->{width} = 0 if ($cw->{columns}->[$index]->{fixed} == 0); } } my $index = 0; foreach (1..$delta) { my $startIndex = $index; while($cw->{columns}->[$index]->{fixed} == 1) { $index++; $index = 0 if ($index > $#{$cw->{columns}}); return if ($startIndex == $index); } $cw->{columns}->[$index]->{width}++; $columnDeltas[$index]++; $index++; $index = 0 if ($index > $#{$cw->{columns}}); } foreach ($delta..-1) { my $startIndex = $index; while(($cw->{columns}->[$index]->{fixed} == 1) || ($cw->{columns}->[$index]->{width} == 10)) { $index++; $index = 0 if ($index > $#{$cw->{columns}}); return if ($startIndex == $index); } $cw->{columns}->[$index]->{width}--; $columnDeltas[$index]--; $index++; $index = 0 if ($index > $#{$cw->{columns}}); } $cw->DrawHeaders(); if ($type eq "insert") { foreach my $col (1..$#{$cw->{columns}}) { $cw->{lists}->{canvas}-> move("column-".$cw->{columns}->[$col]->{id},$columnDeltas[$col-1],0); $columnDeltas[$col] += $columnDeltas[$col-1]; } } if (($type eq "delete") || ($type eq "replace")) { foreach my $col (1..($startCol-1)) { $cw->{lists}->{canvas}-> move("column-".$cw->{columns}->[$col]->{id},$columnDeltas[$col-1],0); $columnDeltas[$col] += $columnDeltas[$col-1]; } foreach my $col (reverse($startCol..$#{$cw->{columns}})) { $cw->{lists}->{canvas}-> move("column-".$cw->{columns}->[$col]->{id},-$columnDeltas[$col],0); $columnDeltas[$col-1] += $columnDeltas[$col]; } } } sub selectionClear { my ($cw) = @_; foreach my $id (keys(%{$cw->{selected}})) { next if ($id == -1); $cw->{lists}->{canvas}-> itemconfigure("entry-back-".$id, -fill=>$cw->{vars}->{Entries}->{Background}); $cw->{lists}->{canvas}-> itemconfigure("entry-front-".$id, -fill=>$cw->{vars}->{Entries}->{Foreground}); delete($cw->{selected}->{$id}); } $cw->{selectedfirst} = -1; $cw->{selectedlast} = -1; } sub selectionSet { my ($cw,@ids) = @_; foreach my $id (@ids) { next if ($id == -1); $cw->{lists}->{canvas}-> itemconfigure("entry-back-".$id, -fill=>$cw->{vars}->{Entries}->{SelectBackground}); $cw->{lists}->{canvas}-> itemconfigure("entry-front-".$id, -fill=>$cw->{vars}->{Entries}->{SelectForeground}); $cw->{selected}->{$id} = 1; } $cw->{selectedfirst} = -1; $cw->{selectedlast} = -1; } sub nearest { my ($cw,$y) = @_; my $nearest = -1; my (undef,$y1,undef,$y2) = $cw->{lists}->{canvas}->bbox("all"); my $height = $y2-$y1; $y = $y + (($cw->{lists}->{canvas}->yview)[0] * $height); my @items = $cw->{lists}->{canvas}->find("closest",0,$y,0); foreach my $tag ($cw->{lists}->{canvas}->gettags($items[0])) { if ($tag =~ /^entry-back/) { ($nearest) = ($tag =~ /^entry-back-(\d+)$/); last; } } return $nearest; } # # This is a big hack, but it's probably how it was meant to be done. :P # # Basically since the list canvas is the only thing that the user can click # on that we would want a binding, we have to bind to that. But if the user # passes our bind an anonymous subroutine with args then we are going to # passing the anonymous subroutine the canvas as the first object... Not # good. Here's the hack: # # Declare a new anonymous subroutine that gets the args passed to it. # Then declare a local anonymous subroutine that is actually the original # subroutine that the user wants to bind to. Once that is a local function, # pass it argument list, minus the first arg (or the canvas). # # To complete the hack... Add a new argument onto the list that represents # the MCL. Now when the user's code gets called all it sees is the MCL as # the first argument which is what we want. # sub bind { my ($cw,@args) = @_; if (ref($args[1]) eq "CODE") { $cw->{lists}->{canvas}->Tk::bind(@args); } if (ref($args[1]) eq "ARRAY") { my @array = @{$args[1]}; splice(@array,1,0,$cw); my $code = $array[0]; $array[0] = sub { my ($widget,@args) = @_; local *inner = \&{$code}; return &inner(@args); }; $cw->{lists}->{canvas}->Tk::bind($args[0] => [@array]); } } sub search { my ($cw,$key,@values) = @_; my %values; foreach my $value (@values) { $values{$value} = 1; } my @ids; foreach my $id (keys(%{$cw->{entries}})) { next if ($id == -1); push(@ids,$id) if ($values{$cw->{entries}->{$id}->{$key}} == 1); } return $ids[0] if ($#ids == 0); return @ids; } sub get { my ($cw,$key,@selection) = @_; my @values; foreach my $id (@selection) { next if ($id == -1); push(@values,$cw->{entries}->{$id}->{$key}); } return $values[0] if ($#values == 0); return @values; } sub curselection { my ($cw) = @_; my @selected; foreach my $id (keys(%{$cw->{selected}})) { next if ($id == -1); push(@selected,$id); } return "" if ($#selected == -1); return $selected[0] if ($#selected == 0); return @selected; } sub selected { my ($cw,$id) = @_; return exists($cw->{selected}->{$id}); } sub viewed { my ($cw,$id) = @_; $cw->{entries}->{$id}->{mcl_viewed} = 1; $cw->{lists}->{canvas}-> itemconfigure("viewed-icon-$id", -image=>$main::GUI{Icons}->{MCLmarked}); } sub delete { my ($cw,@ids) = @_; foreach my $id (@ids) { next if ($id == -1); delete($cw->{entries}->{$id}); delete($cw->{selected}->{$id}); } $cw->DrawEntries(); } sub clear { my ($cw) = @_; $cw->delete(keys(%{$cw->{entries}})); } sub setScrollRegion { my ($cw) = @_; $cw->{lists}->{canvas}-> configure(-scrollregion=> [ 0, 0, $cw->{lists}->{canvas}->width(), (((($#{$cw->{displayorder}}+1) * $cw->{vars}->{Entries}->{Height}) >= $cw->{lists}->{canvas}->height()) ? (($#{$cw->{displayorder}}+1) * $cw->{vars}->{Entries}->{Height}) : $cw->{lists}->{canvas}->height()) ]); } sub insert { my ($cw,@elements) = @_; foreach my $element (@elements) { my $id = $cw->{vars}->{Entries}->{Id}; $cw->{vars}->{Entries}->{Id}++; my %args = %{$element}; foreach my $key (keys(%args)) { $cw->{entries}->{$id}->{$key} = $args{$key}; } $cw->{entries}->{$id}->{mcl_viewed} = 0; } $cw->DrawEntries() if ($cw->{vars}->{Entries}->{Draw} == 1); } sub AddColumn { my ($cw,@args) = @_; my %args; while($#args > -1) { $args{ lc(pop(@args)) } = pop(@args); } my ($y1,$y2); $cw->{headers}->{canvas}-> createText(10000,10000, -text=>"Test", -font=>$cw->{vars}->{Headers}->{Font}, -tags=>[ "mcltest-$$" ]); (undef,$y1,undef,$y2) = $cw->{headers}->{canvas}->bbox("mcltest-$$"); my $fontHeight = $y2 - $y1; $cw->{headers}->{canvas}->delete("mcltest-$$"); $args{-sortby} = $args{-key} if !exists($args{-sortby}); $args{-marker} = 0 if !exists($args{-marker}); $args{-style} = "diamond" if !exists($args{-style}); $args{-filler} = 0 if !exists($args{-filler}); $args{-nolist} = 0 if !exists($args{-nolist}); $args{-fixed} = 0 if !exists($args{-fixed}); $args{-place} = "end" if !exists($args{-place}); $args{-width} = $fontHeight + 4 if !exists($args{-width}); $args{-header} = "No Header" if !exists($args{-header}); $args{-type} = "normal" if !exists($args{-type}); if (($args{-fixed} == 0) && ($args{-filler} == 0)) { $cw->{vars}->{Headers}->{Nonfixed}++; } $cw->ResizeColumns("insert",-$args{-width}) if ($cw->{vars}->{Headers}->{Nonfixed} > 1); my $position = ""; if ($args{-place} eq "begin") { if ($args{-fixed} == 0) { foreach my $index (0..$#{$cw->{columns}}) { if (($cw->{columns}->[$index]->{place} eq "end") || ($cw->{columns}->[$index]->{fixed} == 0)) { $position = $index; last; } } if ($position eq "") { $position = ($#{$cw->{columns}}+1); } } else { $position = 0; } } if ($args{-place} eq "end") { if ($args{-fixed} == 0) { foreach my $index (reverse(0..$#{$cw->{columns}})) { if (($cw->{columns}->[$index]->{place} eq "begin") || ($cw->{columns}->[$index]->{fixed} == 0)) { $position = $index+1; last; } } if ($position eq "") { $position = 0; } } else { $position = ($#{$cw->{columns}} + 1); } } $args{-key} = "column$position" if !exists($args{-key}); splice(@{$cw->{columns}},$position,0,{}); $cw->{columns}->[$position]->{marker} = $args{-marker}; $cw->{columns}->[$position]->{style} = $args{-style}; $cw->{columns}->[$position]->{place} = $args{-place}; $cw->{columns}->[$position]->{header} = $args{-header}; $cw->{columns}->[$position]->{width} = $args{-width}; $cw->{columns}->[$position]->{fixed} = $args{-fixed}; $cw->{columns}->[$position]->{nolist} = $args{-nolist}; $cw->{columns}->[$position]->{key} = $args{-key}; $cw->{columns}->[$position]->{sortby} = $args{-sortby}; $cw->{columns}->[$position]->{id} = $cw->{vars}->{Headers}->{Id}; $cw->{vars}->{Headers}->{Id}++; foreach my $index (0..$#{$cw->{columns}}) { $cw->{keys}->{$cw->{columns}->[$position]->{key}} = $index; } $cw->DrawHeaders(); if (($args{-fixed} == 0) && ($args{-filler} == 0)) { $cw->DeleteColumn("mcl_filler"); } $cw->DrawEntries(); } sub DeleteColumn { my ($cw,$key) = @_; my $column = -1; my $count = 0; foreach my $index (0..$#{$cw->{columns}}) { if ($cw->{columns}->[$index]->{key} eq $key) { $column = $index; } else { $count++ unless ($cw->{columns}->[$index]->{fixed} != 1); } } return if ($column == -1); if (($cw->{vars}->{Headers}->{Nonfixed} == 1) && ($key ne "mcl_filler")) { $cw->AddColumn(-filler=>1, -nolist=>1, -place=>"begin", -header=>"", -width=>0, -key=>"mcl_filler"); $column++; } if (($cw->{columns}->[$column]->{fixed} == 0) && ($cw->{columns}->[$column]->{key} ne "mcl_filler")) { $cw->{vars}->{Headers}->{Nonfixed}--; } $cw->{lists}->{canvas}->delete("column-".$cw->{columns}->[$column]->{id}); my $delta = $cw->{columns}->[$column]->{width}; splice(@{$cw->{columns}},$column,1); $cw->ResizeColumns("delete",$delta,$column) unless ($key eq "mcl_filler"); $cw->ResizeColumns("replace",$delta,$column) if ($key eq "mcl_filler"); } sub DrawHeaders { my ($cw) = @_; my ($y1,$y2); $cw->{headers}->{canvas}-> createText(10000,10000, -text=>"Test", -font=>$cw->{vars}->{Headers}->{Font}, -tags=>[ "mcltest" ]); (undef,$y1,undef,$y2) = $cw->{headers}->{canvas}->bbox("mcltest"); my $height = $y2 - $y1; my $frameHeight = ($height + (2*(1+$cw->{vars}->{Headers}->{BorderWidth}))); $cw->{headers}->{canvas}->delete("all"); my $x = 0; $cw->{vars}->{Headers}->{Height} = $frameHeight; my $diff = 0; my $adjIndex = ""; foreach my $index (reverse(0..$#{$cw->{columns}})) { if ($cw->{columns}->[$index]->{fixed} == 0) { $adjIndex = $index if ($adjIndex eq ""); } else { if (($height >= 15) || ($cw->{columns}->[$index]->{width} >= 15)) { my $tempDiff = $cw->{columns}->[$index]->{width} - $height; $diff += $tempDiff; $cw->{columns}->[$index]->{width} -= $tempDiff; } } $cw->{scrollbar}->configure(-width=>($cw->{columns}->[$index]->{width}-3)) if ($index == $#{$cw->{columns}}); } $cw->{columns}->[$adjIndex]->{width} += $diff; foreach my $index (0..$#{$cw->{columns}}) { $cw->DrawHeader($cw->{columns}->[$index]->{header},$x,($x+$cw->{columns}->[$index]->{width}),$height,$frameHeight,$index,$cw->{columns}->[$index]->{sortby}); $x += $cw->{columns}->[$index]->{width}; } $cw->{headers}->{canvas}->configure(-height=>$cw->{vars}->{Headers}->{Height}); } sub DrawHeader { my ($cw,$text,$x1,$x2,$height,$frameHeight,$index,$sortby) = @_; my $iconSize = $cw->iconSize($height); $cw->{headers}->{canvas}-> createRectangle(($x1+$cw->{vars}->{Headers}->{BorderWidth}),$cw->{vars}->{Headers}->{BorderWidth}, ($x2-$cw->{vars}->{Headers}->{BorderWidth}),($cw->{vars}->{Headers}->{BorderWidth}+$height+2), -fill=>$cw->{vars}->{Headers}->{Background}->{Normal}, -outline=>undef, -tags=>[ "header-$sortby"] ); if ($sortby eq $cw->{vars}->{Entries}->{SortBy}) { $cw->{headers}->{canvas}-> createImage(($x2-$cw->{vars}->{Headers}->{BorderWidth}-($frameHeight/2)),($frameHeight/2), -anchor=>"center", -image=>($cw->{vars}->{Entries}->{SortOrder} eq "descending") ? $main::GUI{Icons}->{MCLorderdown} : $main::GUI{Icons}->{MCLorderup}, -tags=>[ "header-$sortby"] ); } if ($cw->{columns}->[$index]->{marker} == 0) { $cw->{headers}->{canvas}-> createText(($x1+$cw->{vars}->{Headers}->{BorderWidth}+2), ($cw->{vars}->{Headers}->{BorderWidth}+1), -text=>$text, -fill=>$cw->{vars}->{Headers}->{Foreground}, -font=>$cw->{vars}->{Headers}->{Font}, -anchor=>"nw", -tags=>[ "header-$sortby"] ); } else { if ($cw->{columns}->[$index]->{style} eq "diamond") { $cw->{headers}->{canvas}-> createImage(($cw->{columns}->[$index]->{width}/2),($frameHeight/2), -anchor=>"center", -image=>$main::GUI{Icons}->{MCLdiamond} ); } } foreach my $borderx (0..($cw->{vars}->{Headers}->{BorderWidth}-1)) { $cw->{headers}->{canvas}-> createLine(($x1+$borderx),($borderx), ($x2-$borderx),($borderx), -width=>1, -fill=>$cw->{vars}->{Headers}->{Background}->{Light}, ); $cw->{headers}->{canvas}-> createLine(($x1+$borderx),($borderx), ($x1+$borderx),((2*$cw->{vars}->{Headers}->{BorderWidth})+$height+2-$borderx), -width=>1, -fill=>$cw->{vars}->{Headers}->{Background}->{Light}, -tags=>[ ((($index != 0) && ($cw->{columns}->[$index-1]->{fixed} == 0) && ($cw->{columns}->[$index]->{fixed} == 0)) ? "divider-".($index-1)."-".($index) : "mclundef" ) ] ); $cw->{headers}->{canvas}-> createLine(($x1+$borderx+1),((2*$cw->{vars}->{Headers}->{BorderWidth})+$height+2-$borderx-1), ($x2-$borderx),((2*$cw->{vars}->{Headers}->{BorderWidth})+$height+2-$borderx-1), -width=>1, -fill=>$cw->{vars}->{Headers}->{Background}->{Dark}, ); $cw->{headers}->{canvas}-> createLine(($x2-$borderx-1),($borderx+1), ($x2-$borderx-1),((2*$cw->{vars}->{Headers}->{BorderWidth})+$height+2-$borderx), -width=>1, -fill=>$cw->{vars}->{Headers}->{Background}->{Dark}, -tags=>[ ((($index != $#{$cw->{columns}}) && ($cw->{columns}->[$index]->{fixed} == 0) && ($cw->{columns}->[$index+1]->{fixed} == 0)) ? "divider-".($index)."-".($index+1) : "mclundef" ) ] ); } $cw->{headers}->{canvas}-> bind("header-$sortby", "", sub { if ($cw->{vars}->{Entries}->{SortBy} ne $sortby) { $cw->{vars}->{Entries}->{SortOrder} = "ascending"; $cw->{vars}->{Entries}->{SortBy} = $sortby; } else { $cw->{vars}->{Entries}->{SortOrder} = (($cw->{vars}->{Entries}->{SortOrder} eq "descending") ? "ascending" : "descending" ); } $cw->Refresh(); } ); $cw->{headers}->{canvas}-> bind("divider-$index-".($index+1), "", sub { $cw->{headers}->{canvas}->configure(-cursor=>"sb_h_double_arrow"); }); $cw->{headers}->{canvas}-> bind("divider-$index-".($index+1), "", [ sub { my ($canvas,$evX,$cw) = @_; $cw->{vars}->{Headers}->{Index} = $index; $cw->{vars}->{Headers}->{X} = $canvas->canvasx($evX); $cw->{vars}->{Entries}->{X} = $canvas->canvasx($evX); $cw->{vars}->{Headers}->{WidthBefore} = $cw->{columns}->[$index]->{width}; $cw->{vars}->{Headers}->{WidthAfter} = $cw->{columns}->[$index+1]->{width}; }, Ev('x'), $cw, ]); $cw->{headers}->{canvas}-> bind("divider-$index-".($index+1), "", sub { $cw->{headers}->{canvas}->configure(-cursor=>$cw->{vars}->{Headers}->{Cursor}); }); $cw->{headers}->{canvas}->dtag("mclundef","mclundef"); } sub draw { my ($cw,$value) = @_; if (($value == 1) && ($cw->{vars}->{Entries}->{Draw} == 0)) { $cw->DrawEntries() } $cw->{vars}->{Entries}->{Draw} = $value; } sub SortList { my $cw = shift; delete($cw->{displayorder}); $cw->{displayorder} = []; if ($cw->{vars}->{Entries}->{SortOrder} eq "ascending") { foreach my $id (sort { $cw->{entries}->{$b}->{$cw->{vars}->{Entries}->{SortBy}} cmp $cw->{entries}->{$a}->{$cw->{vars}->{Entries}->{SortBy}} } keys(%{$cw->{entries}})) { next if ($id == -1); push(@{$cw->{displayorder}},$id); } } if ($cw->{vars}->{Entries}->{SortOrder} eq "descending") { foreach my $id (sort { $cw->{entries}->{$a}->{$cw->{vars}->{Entries}->{SortBy}} cmp $cw->{entries}->{$b}->{$cw->{vars}->{Entries}->{SortBy}} } keys(%{$cw->{entries}})) { next if ($id == -1); push(@{$cw->{displayorder}},$id); } } } sub DrawEntries { my ($cw) = @_; $cw->SortList(); $cw->{lists}->{canvas}-> createText(10000,10000, -text=>"This is a test", -font=>$cw->{vars}->{Entries}->{Font}, -tags=> [ "mcltest" ]); my (undef,$y1,undef,$y2) = $cw->{lists}->{canvas}->bbox("mcltest"); $cw->{vars}->{Entries}->{Height} = $y2 - $y1 + 2; $cw->{lists}->{canvas}->delete("all"); my $y = 0; foreach my $id (@{$cw->{displayorder}}) { next if ($id == -1); $cw->DrawEntry($y,$id); $y += $cw->{vars}->{Entries}->{Height}; } $cw->setScrollRegion(); } sub iconSize { my ($cw,$height) = @_; if (defined($height)) { my $iconSize = "9"; $iconSize = "11" if ($height > 15); $iconSize = "13" if ($height > 17); $iconSize = "15" if ($height > 19); $iconSize = "17" if ($height > 21); $cw->{vars}->{IconSize} = $iconSize; } return $cw->{vars}->{IconSize}; } sub DrawEntry { my ($cw,$y,$id) = @_; my $x = 0; my $iconSize = $cw->iconSize($cw->{vars}->{Entries}->{Height}-2); foreach my $col (0..$#{$cw->{columns}}) { $cw->DrawColumnEntry(-value=>$cw->{entries}->{$id}->{$cw->{columns}->[$col]->{key}}, -left=>$x, -top=>$y, -selected=>exists($cw->{selected}->{$id}), -width=>$cw->{columns}->[$col]->{width}, -style=>((exists($cw->{entries}->{$id}->{mcl_style})) ? $cw->{entries}->{$id}->{mcl_style} : $cw->{columns}->[$col]->{style}), -marker=>$cw->{columns}->[$col]->{marker}, -column=>$cw->{columns}->[$col]->{id}, -id=>$id, -iconsize=>$iconSize, ) unless ($cw->{columns}->[$col]->{nolist} == 1); $x += $cw->{columns}->[$col]->{width}; } $cw->{lists}->{canvas}-> bind("entry-".$id, "", [ sub { my ($canvas,$cw) = @_; $canvas-> itemconfigure("entries-back", -fill=>$cw->{vars}->{Entries}->{Background}); $canvas-> itemconfigure("entries-front", -fill=>$cw->{vars}->{Entries}->{Foreground}); $canvas-> itemconfigure("entry-back-".$id, -fill=>$cw->{vars}->{Entries}->{SelectBackground}); $canvas-> itemconfigure("entry-front-".$id, -fill=>$cw->{vars}->{Entries}->{SelectForeground}); $cw->{selected} = {}; $cw->{selected}->{$id} = 1; $cw->{selectedfirst} = $id; $cw->viewed($id); }, $cw ]); $cw->{lists}->{canvas}-> bind("entry-".$id, "", [ sub { my ($canvas,$cw) = @_; return unless ($cw->{vars}->{Entries}->{Mode} eq "multiple"); if (exists($cw->{selected}->{$id})) { $canvas-> itemconfigure("entry-back-".$id, -fill=>$cw->{vars}->{Entries}->{Background}); $canvas-> itemconfigure("entry-front-".$id, -fill=>$cw->{vars}->{Entries}->{Foreground}); } else { $canvas-> itemconfigure("entry-back-".$id, -fill=>$cw->{vars}->{Entries}->{SelectBackground}); $canvas-> itemconfigure("entry-front-".$id, -fill=>$cw->{vars}->{Entries}->{SelectForeground}); $cw->{selected}->{$id} = 1; } }, $cw ]); $cw->{lists}->{canvas}-> bind("entry-".$id, "", [ sub { my ($canvas,$cw) = @_; return unless ($cw->{vars}->{Entries}->{Mode} eq "multiple"); my $ignoreon; my $ignoreoff; my $seenoff = 0; my $seenon = 0; foreach my $tid (@{$cw->{displayorder}}) { $seenon++ if ($tid eq $cw->{selectedfirst}); $seenon++ if ($tid eq $id); $seenoff++ if ($tid eq $cw->{selectedfirst}); $seenoff++ if ($tid eq $cw->{selectedlast}); $seenoff++ if ($tid eq $id); $ignoreoff = 1 if (!defined($ignoreoff) && (($tid eq $cw->{selectedfirst}) || ($tid eq $cw->{selectedlast}) || ($tid eq $id))); $ignoreoff = 0 if ($seenoff == 3); $ignoreon = 1 if (!defined($ignoreon) && (($tid eq $cw->{selectedfirst}) || ($tid eq $id))); $ignoreon = 0 if ($seenon == 2); if (($ignoreon == 1) || (($tid eq $cw->{selectedfirst}) || ($tid eq $id))) { $canvas-> itemconfigure("entry-back-".$tid, -fill=>$cw->{vars}->{Entries}->{SelectBackground}); $canvas-> itemconfigure("entry-front-".$tid, -fill=>$cw->{vars}->{Entries}->{SelectForeground}); $cw->{selected}->{$tid} = 1; } else { if (($ignoreoff == 1) || (($seenoff == 3) && (($tid eq $cw->{selectedfirst}) || ($tid eq $cw->{selectedlast}) || ($tid eq $id)))) { $canvas-> itemconfigure("entry-back-".$tid, -fill=>$cw->{vars}->{Entries}->{Background}); $canvas-> itemconfigure("entry-front-".$tid, -fill=>$cw->{vars}->{Entries}->{Foreground}); delete($cw->{selected}->{$tid}); } } } $cw->{selectedlast} = $id; }, $cw ]); } sub DrawColumnEntry { my ($cw,@args) = @_; my %args; while($#args > -1) { $args{ lc(pop(@args)) } = pop(@args); } $cw->{lists}->{canvas}-> createRectangle($args{-left}, $args{-top}, 100000, ($args{-top} + $cw->{vars}->{Entries}->{Height}), -fill=>(($args{-selected} == 1) ? $cw->{vars}->{Entries}->{SelectBackground} : $cw->{vars}->{Entries}->{Background}), -outline=>undef, -tags=>[ "entries-back", "entry-back-".$args{-id}, ($args{-marker} == 0 ? "entry-".$args{-id} : "viewed-".$args{-id}), "column-".$args{-column}, ] ); if ($args{-marker} == 0) { $cw->{lists}->{canvas}-> createText(($args{-left}+5),$args{-top}, -text=>$args{-value}, -fill=>(($args{-selected} == 1) ? $cw->{vars}->{Entries}->{SelectForeground} : $cw->{vars}->{Entries}->{Foreground}), -font=>$cw->{vars}->{Entries}->{Font}, -anchor=>"nw", -tags=>[ "entries-front", "entry-front-".$args{-id}, "entry-".$args{-id}, "column-".$args{-column}, ] ); } else { $cw->{lists}->{canvas}-> createImage(($args{-width}/2),$args{-top}+($cw->{vars}->{Entries}->{Height}/2), -anchor=>"center", -image=>(($cw->{entries}->{$args{-id}}->{mcl_viewed} == 1) ? $main::GUI{Icons}->{MCLmarked} : $main::GUI{Icons}->{"MCL".$args{-style}}), -tags=>[ "viewed-".$args{-id}, "viewed-icon-".$args{-id} ] ); $cw->{lists}->{canvas}-> bind("viewed-".$args{-id}, "", sub { $cw->{entries}->{$args{-id}}->{mcl_viewed} ^= 1; if ($cw->{entries}->{$args{-id}}->{mcl_viewed} == 1) { $cw->{lists}->{canvas}-> itemconfigure("viewed-icon-".$args{-id}, -image=>$main::GUI{Icons}->{MCLmarked}); } else { $cw->{lists}->{canvas}-> itemconfigure("viewed-icon-".$args{-id}, -image=>$main::GUI{Icons}->{"MCL".$args{-style}}); } } ); } } 1;