Ace128 has asked for the wisdom of the Perl Monks concerning the following question:

Hey,

Been a while since last time, but had other stuff to do and redid this based on some fine post made by zentara... So, I redid 533144 and this is what it is now, and frankly, I just want it to work now.. beeing fed up with the annoying bugs.

I know it may be alot of code to go through, but I think its a rather cool module. Specially when it is more stable!

Mainly arrowkey navigation works quite ok, although there seems to be some bugg with this aswell. (Something about the focus on a row that isnt there)

However, 3 things more I wanted to make work pretty well are:

1. Usage of the mouse
2. Drag and drop (able to reorganize the columns draging.. say the label)
3. As columns are added, how can I make the vertical scroller realize this and follow along?

I'm not sure if its the module, or the testing app that needs to be modified, but I have been trying to make the module based on what I wanna implement in the testing app, so one has some nice API to go after, and that the module does the hard work. This is surely a good idea, but working all by yourself you get kinda blind and its hard to figure out what should be where... So far things like DnD seems like some pretty nifty stuff having implemented. Natrually, there is gonna be a callback for it aswell.

Usage of the mouse is quite there, but I cant get the DnD to work as I want (some code is still there for easy access and to see what I've been doing). The idea is to make ie the label above the list dragable. When it is dropped, I somehow then knows where it is dropped in relation to the others (and the original place) and the columns are reordered... Ideas how to make this happen? This seems little tricky actually.

I started to save stuff in a big nice hash. An old array of the columns is still there, and I was seriously thinking of getting rid of that and try to use the big hash for everything. Array was first used so the order is saved, but the idea now was to use the hash and also the key would be a number (and thus still knowing the order of the columns). This would probably make things little easier in the module, and maybe get rid of annoying bugs like my $size = (scalar(@array) - 1)...

So, I would love some feedback and even better - some fixes and implementations to make this more stable and as I want it to be... I was hoping someone here may have some more free time than me, and that could help me out making this "finished". Natrually, this is gonna be GPL (or whatever is free) :)

Testing script:
use Tk; use Tk::ColumnView; use Data::Dumper; use lib "."; use strict; use warnings; my $mw = new MainWindow; $mw->optionAdd('*BorderWidth' => 1); #my $l1 = $pw->Label(-text => "This is the\nleft side", -background => + 'yellow'); #my $l2 = $pw->Label(-text => "This is the\nright side", -background = +>'cyan'); #my $l3 = $pw->Label(-text => "This is the\nright side", -background = +>'cyan'); my $columnView = $mw->ColumnView( # -left_right_nav => sub {print "Hej\n"}, # -columns => 1, # -scrollbars => 'osoe', -left_right_nav_post => \&left_right_navigation_post, -up_down_nav => \&up_down_navigation, -browsecmd => \&row_selected, -column_in_focus => \&column_in_focus, -left_mouse_button => \&left_mouse_button, -width => 400, -height => 300, )->pack(-expand => 1, -fill => 'both'); #$columnView->setOverRideLeftRightNavigation(1); my $root = "E:/"; #$columnView->addColumn("Title", "./*"); $columnView->addColumn("Root", ["."]); $columnView->addColumn("Files/Dirs", "./*"); #$columnView->modifyColumn("Title", "./*"); #$columnView->addColumn(); $columnView->setFocusOnColunmNamed("Root"); $mw->MainLoop; sub left_mouse_button { my $name = shift; my $path = shift; my $last = shift; print "[left_mouse_button] name: $name\n"; print "[left_mouse_button] path: $path\n"; print "[left_mouse_button] last : $last\n"; my @paths = split(/,/, $path); if ($columnView->getColumnInFocus() == ($columnView->getAmountOfCo +lumns() - 1)) { if ($columnView->addColumn($paths[@paths - 2])) { print "ADDED: " . $paths[@paths - 2] . "\n"; } else { print "FAILED TO ADD: " . $paths[@paths - 2] . "\n"; } } } sub column_in_focus { my $at = shift; my $path = shift; my $last = shift; if ($at >= $columnView->getAmountOfColumns()) { my @paths = split(/,/, $path); my $last_one = $paths[@paths-1]; #print "LAST: $last_one\n"; #$columnView->addColumn($last_one); #$columnView->setFocusOnColunmNamed($last_one); } elsif ($at == ($columnView->getAmountOfColumns() - 2)) { #$columnView->delLastColumn(); } #print "AT: " . $at . "\n"; #print $path . "\n"; } sub left_right_navigation_post { my $nav = shift; my $old_path = shift; my $new_path = shift; my $old_single_one = shift; my $last_one = shift; #print "[left_right_navigation] $old_path $new_path $last $s +ingle_one\n"; if ($nav eq "left") { if ($columnView->getAmountOfColumns() > 2) { $columnView->delLastColumn(); if (! $columnView->columnExistsNamed("Files/Dirs")) { # Sh +ould not be needed! $columnView->renameLastColumnTo("Files/Dirs"); } } } elsif ($nav eq "right") { #print $columnView->getColumnInFocus() . "\n"; if ( ($columnView->getAmountOfColumns() - $columnView->getColu +mnInFocus() ) == 2) { if ($columnView->columnExistsNamed("Files/Dirs")) { $columnView->renameColumnNamed("Files/Dirs", $old_pat +h); # if () $columnView->addColumn("Files/Dirs"); } #print "ADDED: $single_one\n"; #$columnView->addColumn("Artists", [ "Enigma", "Ace da Bra +in" ] ); #$columnView->addColumn("Artists", [ "Unhugnu", "Forever D +asa"] ); #$columnView->addColumn("./" . $selected . "/*"); #$columnView->addColumn("./*"); } } } sub up_down_navigation { my $nav = shift; my $selected = shift; my $single_one = shift; return if (!defined($single_one)); } sub row_selected { my $name = shift; my $path = shift; my $at = shift; #print "[row_selected] name: $name\n"; #print "[row_selected] path: $path\n"; $path =~ s/,/\//g; #my @paths = split(/,/, $path); #my $last_one = $paths[@paths-1]; #print "[row_selected] last_one: $last_one\n"; print "path: " . $path . " at: $at\n"; if ($columnView->columnExistsNamed("Files/Dirs")) { $columnView->modifyColumn("Files/Dirs", $path . "/*"); } }
And the Tk::ColumnView module. Put it in same dir as the testscript above, but in a dir called "Tk". That is, as ./Tk/ColumnView.pm
######################################## SOH ######################### +################## ## Function : Tk Class Using HList to view data columnwise, where one +can add/del more ## columns as if it was some kind of hierarchy. Navigation +through these using ## arrow keys. ## ## Copyright (c) 2006 Daniel Åkesson <danielakesson at gmail.com>. All + rights reserved. ## ## Thanks to B< Michael Krause> for the inspirational HListplus. :) ## ## This program is free software; you can redistribute it and/or modif +y it ## under the same terms as Perl itself. ## ## History : V0.1 2006-02-27 Basic Class compound extending HList +. ## History : V0.2 2006-05-02 Some major changes. ######################################## EOH ######################### +################## ############################################## ### Use ############################################## use Tk::HList; use Tk::ItemStyle; use Tk qw(Ev); use strict; use vars qw ($VERSION); $VERSION = '0.2'; ###################################################################### +## package OverriddenHList; use base qw (Tk::Derived Tk::HList); use Data::Dumper; Construct Tk::Widget 'OverriddenHList'; ################################## ## OVERRIDDEN #sub ClassInit { # my ($class, $mw) = @_; # $class->SUPER::ClassInit($mw); #} sub LeftRight { my $this = shift; my $direction = shift; if ($direction eq "left") { #$this->SUPER::LeftRight($direction); } elsif ($direction eq "right") { } $this->Callback(-left_right_nav => $direction); } sub UpDown { my $this = shift; my $direction = shift; $this->SUPER::UpDown($direction); if ($direction eq "left") { } elsif ($direction eq "right") { } $this->Callback(-up_down_nav => $direction); } sub Button1 { my $this = shift; $this->SUPER::Button1(@_); $this->Callback(-button_press => ($this, @_)); } #--------------------------------------------- # internal Setup function #--------------------------------------------- sub Populate { my $this = shift; my $args = shift; my $at = shift; my $name = shift; $this->SUPER::Populate($args); $this->ConfigSpecs( -left_right_nav => [ 'CALLBACK',undef,undef, sub {}], -up_down_nav => [ 'CALLBACK',undef,undef, sub {}], -button_press => [ 'CALLBACK',undef,undef, sub {}], -takefocus => [ [ 'SELF', 'PASSIVE' ], 'takefocus', + 'TakeFocus', 1 ], -at_column => [ [ 'SELF', 'PASSIVE' ], 'at_column', + 'at_column', -1 ], -column_in_focus => [ [ 'SELF', 'PASSIVE' ], 'column_in_foc +us', 'column_in_focus', -1 ], -name => [ [ 'SELF', 'PASSIVE' ], 'name', 'name' +, "OverriddenHList" ], -width => [ [ 'SELF', 'PASSIVE' ], 'width', 'wi +dth', -1 ], -height => [ [ 'SELF', 'PASSIVE' ], 'height', 'hei +ght', -1 ], ); $this->bind( '<Configure>' => sub { $this->_Configure($this); } ); #$this->{at_column} = $at; #$this->{'name'} = ""; #$this->{'width'} = -1; #$this->{'height'} = -1; #$this->privateData(-at_column => $at); #$this->privateData(-name => $name); } sub _Configure { my $this = shift; my $width = $this->width; my $height = $this->height; $this->configure(-width => $width); $this->configure(-height => $height); #print $width . "\n"; } sub getAtColumn { my $this = shift; return $this->cget(-at_column); } sub getName { my $this = shift; return $this->cget(-name); } sub getWidth { my $this = shift; return $this->cget(-width); } sub getHeigth { my $this = shift; return $this->cget(-height); } ###################################################################### +## package Tk::ColumnView; #use base qw (Tk::Derived Tk::Toplevel); use base qw (Tk::Derived Tk::Frame); use Tk; use Tk::Panedwindow; use Tk::Labelframe; use Tk::Pane; use Carp qw(croak); use File::Basename; use Tk::DragDrop; use Tk::DropSite; use Data::Dumper; Construct Tk::Widget 'ColumnView'; # needed to include also the aliased commands use Tk::Submethods ( 'addColumn' => [qw(configure cget create delet +e exists size)] ); sub ClassInit { my ($class, $mw) = @_; $class->SUPER::ClassInit($mw); } #--------------------------------------------- # internal Setup function #--------------------------------------------- sub Populate { my ($this, $args) = @_; my $data_background = delete $args->{-databackground}; $data_background = $this->cget ('-background') unless defined $dat +a_background; $this->{m_headerstyle} = delete $args->{-headerstyle} || $this->It +emStyle ('window', -padx => '0', -pady => '0', ); #Invoke Superclass fill func $this->SUPER::Populate($args); $this->{LabelFrame} = $this->Component( 'Labelframe' => "LabelFrame", #-text => "sdfasdf", # -scrollbars => 'soe', # -sticky => 'we', # -gridded => 'y', #-background => 'white', #-relief => 'raised', #-borderwidth => 1, #-width => 1, #-cursor => 'sb_h_double_arrow', )->pack(-expand => "all", -fill => "both", ); $this->{Pane} = $this->{LabelFrame}->Scrolled('Pane', -width => 800, -height => 400, -sticky => 'nsew', -scrollbars => 'os', )->pack(-fill => 'both', -expand => 1); # DnD SUPPORT! #my $c_src = $this->{LabelFrame}; ## $this->{'drag_source'} = $this->{'Pane'}->DragDrop( ## -event => '<B1-Motion>', ## -sitetypes => [qw/Local/], ## ); ## my $c_dest = $this->{LabelFrame}->Pane(qw/-background cyan/)->pa +ck; ## $c_dest->DropSite( ## -droptypes => [qw/Local/], ## -dropcommand => [\&move_items, $this->{'drag_source'}, $c_de +st], ## ); # Every Canvas source item has a <ButtonPress-1> binding associate +d # with it. The callback bound to this event serves to record the i +tem's # id in the global variable $drag_id, and to configure the drag La +bel's # -text option with the item's id and type. $this->{'press'} = sub { my ($c_src, $c_src_id, $drag_source) = @_; #print Dumper($drag_source); print "SFSDFD\n"; $this->{'Drag_Id'} = $c_src_id; my $type = ($this->{'Drag_Id'}); $drag_source->configure(-text => $c_src_id . " = $type"); }; $this->{Columns} = []; $this->{Name_To_Column} = {}; $this->{amount_Columns} = 0; $this->{left_right_nav_overridden} = 0; $this->{up_down_overridden} = 0; $this->{rows_added} = 0; $this->{column_selected} = 0; $this->{Columns_LabelFrame} = {}; #my $pw = $this->{PanedWindow}; #$pw->pack(qw/-side top -expand yes -fill both -pady 2 -padx 2m/); my $p = $this->{Pane}; $p->pack(qw/-side top -expand yes -fill both -pady 2 -padx 2m/); $this->{'reqheight'} = $p->reqheight(); $this->{'reqwidth'} = $p->reqwidth(); $this->{width} = 0; $this->{height} = 0; $p->bind( '<Configure>' => sub { $this->Configure($this); } ); #$pw->repeat( 1000, => sub { print "-----------------\n";print Dum +per($this->{Name_To_Column}) . "\n"; &_printColumnNames($this); print + "----------------\n";} ); #$trim->bind( '<ButtonRelease-1>' => sub { $this->ButtonRelease +(1); } ); #$trim->bind( '<ButtonPress-1>' => sub { $this->ButtonPress +(1); } ); #$trim->bind( '<Motion>' => sub { $this->ButtonOver(1) +; } ); #$trim->bind( '<Enter>' => sub { $this->TrimEnter() +; } ); #$trim->bind( '<Leave>' => sub { $this->TrimLeave() +; } ); #$this->bind( '<Enter>' => sub { $this->TrimEnter() +; } ); #$trim->bind( '<Leave>' => sub { $this->TrimLeave() +; } ); # # Override these ones too # $this->bind( '<Enter>' => sub { print + "EnterBttn\n"; $this->BttnEnter(); } ); # $this->bind( '<Leave>' => sub { $this +->BttnLeave(); } ); #$this->SUPER::Populate($args); $this->ConfigSpecs( -column => [ [ 'SELF', 'PASSIVE' ], 'Column', 'Co +lumn', 0 ], -minwidth => [ [ 'SELF', 'PASSIVE' ], 'minWidth', +'minWidth', 30 ], -command => [ 'CALLBACK',undef,undef, sub {}], -browsecmd => [ 'CALLBACK',undef,undef, sub {}], -left_right_nav_pre => [ 'CALLBACK',undef,undef, sub {}], -left_right_nav_post => [ 'CALLBACK',undef,undef, sub {}], -column_in_focus => [ 'CALLBACK',undef,undef, sub {}], -left_mouse_button => [ 'CALLBACK',undef,undef, sub {}], -up_down_nav => [ 'CALLBACK',undef,undef, sub {}], -activebackground => [ [ 'SELF', 'PASSIVE' ], 'activeba +ckground', 'activebackground', $this->SUPER::cget(-background) ], -activeforeground => [ [ 'SELF', 'PASSIVE' ], 'activeforeg +round', 'activeforeground', 'blue' ], -buttondownrelief => [ [ 'SELF', 'PASSIVE' ], 'buttondownr +elief', 'buttondownrelief', 'flat' ], -relief => [ [ 'SELF', 'PASSIVE' ], 'relief', 're +lief', 'flat' ], -padx => [ [ 'SELF', 'PASSIVE' ], 'padx', 'pad +x', 0 ], -pady => [ [ 'SELF', 'PASSIVE' ], 'pady', 'pad +y', 0 ], -anchor => [ [ 'SELF', 'PASSIVE' ], 'Anchor', +'Anchor', 'w' ], -lastcolumn => [ [ 'SELF', 'PASSIVE' ], 'LastColum +n', 'LastColumn', 0 ], #-takefocus => [ [ 'SELF', 'PASSIVE' ], 'takefocus +', 'TakeFocus', 1 ], ); } sub move_items { print "MOOOOOOOOOOOOOOOOVEEEEEEEEEEEE ITEMS!\n"; } sub Configure { my $this = shift; my $width = $this->width; my $height = $this->height; if ($width < 10) { $width = 200; } if ($height < 10) { $height = 300; } if ($this->{amount_Columns} == 1) { #print "O N E ! $width\n"; #$this->{one_width} = $width; #$this->{one_height} = $height; } $this->{width} = $width; $this->{height} = $height; #${$this->{Columns}}[$c_selected]{'s_hlist'}->focus(); #$this->{'Pane'}->idletasks; #$this->{'Pane'}->update; #if ($this->{update_needed}) { #} } sub MouseMotion { my $this = shift; my $s_hlist = shift; #$s_hlist->toplevel->focus; #$s_hlist->parent->focus; $s_hlist->focus; my $at = $s_hlist->getAtColumn(); #print $s_hlist->getWidth() . "\n"; $this->{'column_selected'} = $at; #$s_hlist->focus() if($s_hlist->cget('-takefocus')); #print Dumper($at); my ($path, $last) = &_getPath($this, $at); $this->_columnInFocus($s_hlist, $path, $last); #print "."; } sub _columnInFocus { my $this = shift; my $s_hlist = shift; my $path = shift; my $last = shift; #my $name = $s_hlist->getName(); #my $column_at = $this->{Name_To_Column}->{$name} - 1; #my ($path, $last) = &_getPath($this); # if (${$this->{Columns}}[$column_at]{'rows_added'} > 0) { # my $row_selected = (${$this->{Columns}}[$column_at]{'s_hlist' +}->selectionGet())[0]; # ${$this->{Columns}}[$column_at]{'s_hlist'}->selectionSet($row +_selected); # ${$this->{Columns}}[$column_at]{'s_hlist'}->anchorSet($row_se +lected); # ${$this->{Columns}}[$column_at]{'s_hlist'}->see($row_selected +); # ${$this->{Columns}}[$column_at]{'row_selected'} = $row_select +ed; # } $this->Callback(-column_in_focus => $this->{'column_selected'}, $p +ath, $last); } sub _Button1 { my $this = shift; my $frame = shift; my $s_hlist = shift; my $name = $s_hlist->getName(); my $column_at = $this->{Name_To_Column}->{$name}; #if (${$this->{Columns}}[$column_at]{'rows_added'} > 0) { #my $row_selected = (${$this->{Columns}}[$column_at]{'s_hlist' +}->selectionGet())[0]; #${$this->{Columns}}[$column_at]{'s_hlist'}->selectionSet($row +_selected); #${$this->{Columns}}[$column_at]{'s_hlist'}->anchorSet($row_se +lected); #${$this->{Columns}}[$column_at]{'s_hlist'}->see($row_selected +); #${$this->{Columns}}[$column_at]{'row_selected'} = $row_select +ed; #print ${$this->{Columns}}[$column_at]{'s_hlist'}->getWidth() +. "\n"; #} my ($path, $last) = &_getPath($this, $column_at); #print "DSFASDF: $path $last\n"; $this->Callback(-left_mouse_button => ($name, $path, $last, $colum +n_at)); } sub getColumnInFocus { my $this = shift; return $this->{'column_selected'}; } sub _getColumnNameAtNr { my $this = shift; my $nr_to_find = shift; #print Dumper($this->{Name_To_Column}); #print "Looking for: $nr_to_find\n"; foreach my $name (keys %{$this->{Name_To_Column}}) { #print "$name ----\n"; if ($nr_to_find == $this->{Name_To_Column}->{$name}) { return $name; } } return undef; } sub addColumn { my $this = shift; my $name = shift; # Name for this Column my $to_add = shift; # If wanna use files and folders in list. my $width = (shift || $this->{one_width} || 200); my $height = (shift || $this->{one_height} || 300); #print $this->{amount_Columns}; my $old_width = $this->{width}; #print "WI: $old_width\n"; #$this->{width} += $width; #$this->{height} = $height; if (length($name) < 1) { croak("Length of name must be > 0!"); return 0; } if (exists($this->{Name_To_Column}->{$name})) { croak("Column named: \"" . $name . "\" already exists.\nPlease + delete it first before (re)adding it, or use another name.\n"); return 0; } #$this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Frame'} = $t +his->{'Pane'}->Labelframe(-text => $name, $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Frame'} = $th +is->{'Pane'}->Frame( -relief => "ridge", -bd => 1, -width => $width, )->pack(-side => 'left', -fill => 'both', -expand => "all", ); # DnD SUPPORT! my $frame1 = $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{' +Frame'}->Frame()->pack(); my $frame2 = $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{' +Frame'}->Frame()->pack(); $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'drag_source'} + = $frame1->DragDrop( -event => '<B1-Motion>', -sitetypes => [qw/Local/], ); $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'width'} = $wi +dth; $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'heigth'} = $h +eight; $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Adjuster'} = +$this->{'Pane'}->Adjuster(); $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Adjuster'}-> packAfter($this->{'ColumnsHash'}->{$this->{amount_Colu +mns}}->{'Frame'}, -side => 'left'); #$this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Label'} = $t +his->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Frame'}->Label(-wi +dth => 30, -text => $name, # )->pack(); $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Label'} = $fr +ame1->Label(-width => 30, -text => $name, )->pack(); #$this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Label'} = $t +his->{'ColumnsHash'}->{$this->{amount_Columns}}->{'drag_source'}->Lab +el(-width => 30, -text => $name, # )->pack(); $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Adjuster'}->b +ind( '<Configure>' => sub { onResize($this, @_); }); my $pane = $this->{'Pane'}; my $folderimage = $pane->Getimage("folder"); my $fileimage = $pane->Getimage("file"); my $srcimage = $pane->Getimage("srcfile"); my $textimage = $pane->Getimage("textfile"); print "[ColumnView::addColumn] Added $name\n"; #print "[ColumnView::addColumn] am: " . $this->{amount_Columns} . +"\n"; my $scrolled_hlist; #my $labelFrame = $pw->Labelframe(-text => $name)->pack(-fill => " +both", -expand => "all"); #my $labelFrame = $this->{'ColumnsHash'}->{$this->{amount_Columns} +}->{'Frame'}; my $labelFrame = $frame1; $scrolled_hlist = $labelFrame->Scrolled("OverriddenHList", # -left_right_nav => sub {print "Hej\n"}, # -columns => 1, -scrollbars => 'osoe', -selectmode => 'extended', -browsecmd => sub { #$this->Callback(-browsecmd, $this->br +owsecmd(@_)); $this->browsecmd($this, @_); }, -left_right_nav => sub { $this->_LeftRightNavigation($scr +olled_hlist, @_) }, -up_down_nav => sub { $this->_UpDownNavigation($scroll +ed_hlist, @_) }, -button_press => sub { $this->_Button1($scrolled_hlist, + @_) }, -at_column => $this->{amount_Columns}, -name => $name, -width => $width, -height => $height, ); #->pack(-expand => 1, -fill => 'both'); $scrolled_hlist->bind( '<Motion>' => sub { $this->MouseMotion($ +scrolled_hlist); } ); my $rows_added = 0; if (ref(\$to_add) eq 'SCALAR') { my $i = 0; if (length($to_add) > 0) { foreach (glob($to_add)) { my $image; if (-d $_) { $image = $folderimage; } elsif (-f $_) { if (/\.(c|cpp|cc|pl)$/) { $image = $srcimage; } elsif (/\.te?xt$/) { $image = $textimage; } else { $image = $fileimage; } } $scrolled_hlist->add($i++, -itemtype => "imagetext", -text => basename($_), (defined $image ? (-image => $image) : ()), ); ++$rows_added; } } } elsif (ref($to_add) eq 'ARRAY') { my $i = 0; foreach (@{$to_add}) { $scrolled_hlist->add($i++, -itemtype => "imagetext", -text => $_, -image => $textimage, ); ++$rows_added; } } elsif (ref($to_add) eq 'HASH') { } if ($name) { #print "Setting: $name " . Dumper($to_add); $this->{Name_To_Column}->{$name} = $this->{amount_Columns}; } push(@{$this->{Columns}}, { 's_hlist' => $scrolled_hlist, 'width' => 100, 'height' => 200, 'rows_added' => $rows_added, 'row_selected' => 0, 'name' => $name, } ); #print Dumper($this->{Name_To_Column}); $scrolled_hlist->pack(-fill => "both", -expand => "all"); #$pw->add($scrolled_hlist); #$labelFrame->pack(-fill => "both", -expand => "all"); # $pw->bind($labelFrame, '<ButtonPress-1>' => [$this->{'press'}, $la +belFrame, $this->{'drag_source'}]); # $pw->add($labelFrame); ## $this->{Columns_LabelFrame}->{$name} = $labelFrame; #$scrolled_hlist->idletasks; #$pw->packForget(); #$pw->pack(qw/-side top -expand yes -fill both -pady 2 -padx 1m/); #$width += $this->{width}; #$width -= $this->{one_width}; $this->{width} = $old_width + $width; # $pw->toplevel->geometry($this->{width}."x".($height)); #$pw->toplevel->geometry(($this->{width}+$this->{one_width})."x".( +$this->{height}+$this->{one_height})); #$this->{'reqheight'} = $pw->reqheight(); #$this->{'reqwidth'} = $pw->reqwidth(); # if ($this->{amount_Columns} > 1) { #$pw->sashPlace($this->{amount_Columns} - 2, $this->{one_width +} * ($this->{amount_Columns} - 1), 10); # $pw->sashPlace($this->{amount_Columns} - 2, $width * ($this-> +{amount_Columns} - 1) + 4, 100); # +4 for the sash (splitter) # my $i = 0; # foreach (@{$this->{Columns}}) { #$pw->sashPlace($this->{amount_Columns} - 2, $old_width + 4, 1 +00); # +4 for the sash (splitter) #$pw->sashPlace($i, $_->{'s_hlist'}->getWidth() * $_->{'s_ +hlist'}->getAtColumn(), 100); # +4 for the sash (splitter) #++$i; #last if ($i == ($this->{amount_Columns} - 1)); # } #print ($width * ($this->{amount_Columns} - 1) . "\n"); # } #$pw->update; #print "asdasd: " . $this->{width} . " $old_width $width +\n"; #$scrolled_hlist->focus; #$scrolled_hlist->selectionSet(0); #$pw->idletasks; #$this->{width} += 24; #$this->{width} += 4; #$this->{height} = $height; #print "OLD: $old_width\n"; # USEFULL #my $i = 0; #foreach (@{$this->{Columns}}) { #print $scrolled_hlist->getWidth(); #print Dumper($_->{'s_hlist'}); #print "ASDFADSFDSFASDDSF\n"; #print Dumper($_); #print $i++ . " " . $_->{'s_hlist'}->getWidth() . "\n"; #} #$this->_printColumnNames(); #$this->{'Pane'}->update; $pane->update; $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Frame'}->conf +igure(-width => $width); $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Frame'}->upda +te; #$this->_printColumnNames(); ++$this->{'column_selected'}; ++$this->{amount_Columns}; return 1; } sub onResize { my $this = shift; shift; #print Dumper(@_); foreach (keys %{$this->{'ColumnsHash'}}) { #print $_ . "\n"; #my $width = $this->{'ColumnsHash'}->{$_}->{'Frame'}->cget(-wi +dth); my $width = $this->{'ColumnsHash'}->{$_}->{'Frame'}->width; my $height = $this->{'ColumnsHash'}->{$_}->{'Frame'}->height; $this->{'ColumnsHash'}->{$_}->{'width'} = $width; $this->{'ColumnsHash'}->{$_}->{'heigth'} = $height; #$this->{'ColumnsHash'}->{$_}->{'Frame'}->configure(-width => +$width); #print $width . " " . $height . "\n"; } } sub browsecmd { my $this = shift; my $at = shift; my $with_mouse = shift; my $c_selected = $this->{'column_selected'}; my $name = &_getColumnNameAtNr($this, $c_selected); my ($path, $last) = &_getPath($this); #print $path . "\n"; #print Dumper($name); #print Dumper($this->{Name_To_Column}); #print Dumper(scalar @{$this->{Columns}}); $this->Callback(-browsecmd, $name, $path, $with_mouse); } sub _getPath { my $this = shift; my $c_selected = shift; unless ($c_selected) { $c_selected = $this->{'column_selected'}; } #print $c_selected . "\n"; my $path = ""; my $last = ""; my $i = 0; foreach (@{$this->{Columns}}) { my $s_hlist = $_->{'s_hlist'}; my @s_hlist_rows_selected = $s_hlist->selectionGet(); if (@s_hlist_rows_selected > 0) { $path .= $s_hlist->entrycget($s_hlist_rows_selected[0], -t +ext) . ","; if ($i == $c_selected) { $last = $s_hlist->entrycget($s_hlist_rows_selected[0], + -text); last; } } ++$i; } $path =~ s/,$//; return ($path, $last); } sub delLastColumn { my $this = shift; my $path = shift; #$this->_printColumnNames(); return if ($this->{amount_Columns} == 1); my $pane = $this->{'Pane'}; my $hlist_hash = pop(@{$this->{Columns}}); my $s_hlist = $hlist_hash->{'s_hlist'}; my $s_hlist_width = $hlist_hash->{'width'}; my $s_hlist_height = $hlist_hash->{'height'}; my $s_hlist_name = $hlist_hash->{'name'}; #my $labelFrame = $this->{Columns_LabelFrame}->{$s_hlist_name}; #my $width = $s_hlist->getWidth(); #my $height = $hlist_hash->getHeigth(); #$this->{width} -= $width; #$s_hlist->packForget(); #$pw->forget($s_hlist); ##$pw->forget($labelFrame); #$pw->packForget(); #$pw->pack(qw/-side top -expand yes -fill both -pady 2 -padx 1m/); print "[ColumnView::delLastColumn] NAME: $s_hlist_name\n"; --$this->{amount_Columns}; #$this->{'Pane'}->packForget(); $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Adjuster'}->p +ackForget(); $this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Frame'}->pack +Forget(); delete $this->{'ColumnsHash'}->{$this->{amount_Columns}}; delete $this->{Name_To_Column}->{$s_hlist_name}; #$pw->toplevel->geometry(($this->{width}+$this->{one_width})."x".( +$this->{height}+$this->{one_height})); #$this->{width} -= 26; ##$this->{width} -= 4; ##$pw->toplevel->geometry(($this->{width})."x".($this->{height})); #print "[ColumnView::delLastColumn] $s_hlist_name\n"; delete $this->{Name_To_Column}->{$s_hlist_name}; ##delete $this->{Columns_LabelFrame}->{$s_hlist_name}; #print Dumper(${$this->{Columns}}[$this->{amount_Columns} - 1]->{' +s_hlist'}); $pane->update; $this->{'column_selected'} = $this->{amount_Columns} - 1; #${$this->{Columns}}[$this->{amount_Columns} - 1]->{'s_hlist'}->fo +cus; #print "SDFADRAEWRFWEEDEEEEEEELLLASLTDLTLAESRLASDFLFAWELRAELAELALE +LAWER\n"; #print Dumper($this->{Name_To_Column}); #$this->_printColumnNames(); } sub modifyColumn { my $this = shift; my $name = shift; my $data = shift; #my $pw = $this->{'PanedWindow'}; my $column_at = $this->{Name_To_Column}->{$name}; if ($column_at >= 0) { my $hlist_hash = (@{$this->{Columns}}[$column_at]); my $scrolled_hlist = $hlist_hash->{'s_hlist'}; my $s_hlist_width = $hlist_hash->{'width'}; my $s_hlist_height = $hlist_hash->{'height'}; $scrolled_hlist->delete('all'); my $pane = $this->{'Pane'}; my $folderimage = $pane->Getimage("folder"); my $fileimage = $pane->Getimage("file"); my $srcimage = $pane->Getimage("srcfile"); my $textimage = $pane->Getimage("textfile"); my $rows_added = 0; if (ref(\$data) eq 'SCALAR') { my $i = 0; foreach (glob($data)) { my $image; if (-d $_) { $image = $folderimage; } elsif (-f $_) { if (/\.(c|cpp|cc|pl)$/) { $image = $srcimage; } elsif (/\.te?xt$/) { $image = $textimage; } else { $image = $fileimage; } } $scrolled_hlist->add($i++, -itemtype => "imagetext", -text => basename($_), (defined $image ? (-image => $image) : ()), ); ++$rows_added; } } elsif (ref($data) eq 'ARRAY') { my $i = 0; foreach (@{$data}) { $scrolled_hlist->add($i++, -itemtype => "imagetext", -text => $_, #-image => $textimage, ); ++$rows_added; } } elsif (ref($data) eq 'HASH') { } @{$this->{Columns}}[$column_at]->{'rows_added'} = $rows_added; #$hlist_hash->{'s_hlist'}->update; #$this->{'PanedWindow'}->update; #$pw->toplevel->geometry(($this->{width}-$this->{one_width})." +x".($this->{height})); } else { warn "[ColumnView::modifyColumn] Column named: \"" . $name . " +\" not found.\n"; } } sub getAmountOfColumns { my $this = shift; return $this->{amount_Columns}; } sub renameColumnNamed { my $this = shift; my $old_name = shift; my $new_name = shift; #$this->_printColumnNames($this); if (exists($this->{Name_To_Column}->{$new_name})) { warn ("[ColumnView::renameColumnNamed] Column named: \"" . $ne +w_name . "\" already exists.\nPlease delete it first before (re)addin +g it, or use another name.\n"); return 0; } else { if (!(exists($this->{Name_To_Column}->{$old_name}))) { warn ("[ColumnView::renameColumnNamed] Column named: \"" . + $old_name . "\" doesn't exist.\n"); return 0; } #print "[ColumnView::renameColumnNamed] from $old_name to $new +_name\n"; # Change the name inbedded with the column too! #my $hlist_hash = $this->{Columns}->[$this->{Name_To_Column}-> +{$old_name}]; #$hlist_hash->{'name'} = $new_name; #$this->{'ColumnsHash'}->{$this->{amount_Columns}}->{'Label'} += $this->{Name_To_Column}->{$new_name} = delete $this->{Name_To_ +Column}->{$old_name}; my $hlist_hash = $this->{Columns}->[$this->{Name_To_Column}->{ +$new_name}]; my $old_name = $hlist_hash->{'name'}; print "[ColumnView::renameColumnNamed] OLD_NAME: $old_name N +EW_NAME: $new_name\n"; $this->{Columns}->[$this->{Name_To_Column}->{$new_name}]->{'na +me'} = $new_name; ## $this->{Columns_LabelFrame}->{$old_name}->configure(-text => + $new_name); ## $this->{Columns_LabelFrame}->{$new_name} = delete $this->{Co +lumns_LabelFrame}->{$old_name}; #$this->{Name_To_Column}->{$new_name} = $this->{Name_To_Column +}->{$old_name}; #delete $this->{Name_To_Column}->{$old_name}; $this->{'ColumnsHash'}->{$this->{amount_Columns} - 1}->{'Label +'}->configure(-text => $new_name); } #$this->_printColumnNames($this); #foreach (@{$this->{Columns}}) { # print $_->{'name'} . "\n"; #} return 1; } sub renameLastColumnTo { my $this = shift; my $new_name = shift; if (exists($this->{Name_To_Column}->{$new_name})) { warn ("[ColumnView::renameColumnNamed] Column named: \"" . $ne +w_name . "\" already exists.\nPlease delete it first before (re)addin +g it, or use another name.\n"); return 0; } my $hlist_hash = $this->{Columns}->[(@{$this->{Columns}}) - 1]; my $old_name = $hlist_hash->{'name'}; foreach (@{$this->{Columns}}) { print $_->{'name'} . "\n"; } print "[ColumnView::renameLastColumnTo] OLD_NAME: $old_name NEW_ +NAME: $new_name\n"; $this->{Columns}->[$this->{Name_To_Column}->{$old_name}]->{'name'} + = $new_name; #print Dumper($this->{Name_To_Column}); my $fuck = $this->{Name_To_Column}->{$old_name}; $this->{Name_To_Column}->{$new_name} = delete $this->{Name_To_C +olumn}->{$old_name}; $this->{'ColumnsHash'}->{$this->{amount_Columns} - 1}->{'Label'}-> +configure(-text => $new_name); ##$this->{Columns_LabelFrame}->{$old_name}->configure(-text => +$new_name); ##$this->{Columns_LabelFrame}->{$new_name} = delete $this->{Col +umns_LabelFrame}->{$old_name}; #print Dumper($this->{Name_To_Column}); #$this->_printColumnNames(); #print Dumper($this->{Name_To_Column}); return 1; } sub columnExistsNamed { my $this = shift; my $name = shift; return exists($this->{Name_To_Column}->{$name}); } sub _printColumnNames { my $this = shift; my $i = 0; foreach (@{$this->{Columns}}) { print($i++ . ": " . $_->{'name'} . "\n"); } } sub _LeftRightNavigation { my $this = shift; my $s_hlist = shift; my $direction = shift; my $c_selected = $this->{'column_selected'}; #print "ASSSSSSF: ". $c_selected . "\n"; my $this_hlist = ""; my @s_hlist_row_selected = $s_hlist->selectionGet(); my $path = ""; if (@s_hlist_row_selected > 0) { $this_hlist = $s_hlist->entrycget($s_hlist_row_selected[0], -t +ext); foreach (@{$this->{Columns}}) { my $s_hlist = $_->{'s_hlist'}; my @s_hlist_row_selected = $s_hlist->selectionGet(); if (@s_hlist_row_selected > 0) { $path .= $s_hlist->entrycget($s_hlist_row_selected[0], + -text) . ","; } } $path =~ s/,$//; # Notice! This means nothing is set althouth something is in c +olumnlist! Its there but "empty" # Like adding undef. if (!defined($this_hlist)) { $this_hlist = ""; } } #print "sfasdfsdfsdfasfasdf\n"; $this->Callback(-left_right_nav_pre => $direction, $path, $this_hl +ist); my $row_selected = -1; #print Dumper($s_hlist); if ($direction eq "left") { --$c_selected; if ($c_selected < 0) { $c_selected = 0; } my $rows_added = ${$this->{Columns}}[$c_selected]{'rows_added' +}; ${$this->{Columns}}[$c_selected]{'s_hlist'}->focus(); if ($rows_added > 0) { my $row_selected = ${$this->{Columns}}[$c_selected]{'row_s +elected'}; if ($row_selected < 0) { $row_selected = 0; } ${$this->{Columns}}[$c_selected]{'s_hlist'}->selectionSet( +$row_selected); ${$this->{Columns}}[$c_selected]{'s_hlist'}->anchorSet($ro +w_selected); ${$this->{Columns}}[$c_selected]{'s_hlist'}->see($row_sele +cted); } } elsif ($direction eq "right") { ++$c_selected; if ($c_selected >= @{$this->{Columns}}) { --$c_selected; } my $rows_added = ${$this->{Columns}}[$c_selected]{'rows_added' +}; ${$this->{Columns}}[$c_selected]{'s_hlist'}->focus(); if ($rows_added > 0) { $row_selected = ${$this->{Columns}}[$c_selected]{'row_sele +cted'}; if ($row_selected > $rows_added) { $row_selected = $rows_added - 1; } ${$this->{Columns}}[$c_selected]{'s_hlist'}->selectionSet( +$row_selected); ${$this->{Columns}}[$c_selected]{'s_hlist'}->anchorSet($ro +w_selected); ${$this->{Columns}}[$c_selected]{'s_hlist'}->see($row_sele +cted); $this->{'Pane'}->see($this->{'ColumnsHash'}->{$c_selected} +->{'Frame'}); $this->{'Pane'}->update; } } my ($new_path, $last) = &_getPath($this, $c_selected); $this->Callback(-left_right_nav_post => $direction, $path, $new_pa +th, $this_hlist, $last); $this->{'column_selected'} = $c_selected; $this->browsecmd($this, $row_selected, "no_mouse"); } sub setOverRideLeftRightNavigation { my $this = shift; $this->{left_right_nav_overridden} = shift; } sub _UpDownNavigation { my $this = shift; my $s_hlist = shift; my $direction = shift; my $c_selected = $this->{'column_selected'}; if ($direction eq "prev") { if (${$this->{Columns}}[$c_selected]{'row_selected'} > 1) { --${$this->{Columns}}[$c_selected]{'row_selected'}; } } elsif ($direction eq "next") { if (${$this->{Columns}}[$c_selected]{'row_selected'} < ${$this +->{Columns}}[$c_selected]{'rows_added'}) { ++${$this->{Columns}}[$c_selected]{'row_selected'}; } } #print "SEL: $c_selected R: " . ${$this->{Columns}}[$c_selected] +{'row_selected'} . "\n"; my $this_hlist = ""; my @s_hlist_row_selected = $s_hlist->selectionGet(); if (@s_hlist_row_selected > 0) { $this_hlist = $s_hlist->entrycget($s_hlist_row_selected[0], -t +ext); } else { if (!$this->{up_down_nav_overridden}) { return; } } my $path = ""; foreach (@{$this->{Columns}}) { my $s_hlist = $_->{'s_hlist'}; my @s_hlist_row_selected = $s_hlist->selectionGet(); if (@s_hlist_row_selected > 0) { $path .= $s_hlist->entrycget($s_hlist_row_selected[0], -te +xt) . ","; } } $path =~ s/,$//; $this->Callback(-up_down_nav => $direction, $path, $this_hlist); } sub setOverRideUpDownNavigation { my $this = shift; $this->{up_down_nav_overridden} = shift; } sub setFocusOnColunmAt { my $this = shift; my $column_at = shift; return if (!defined($column_at)); return if ($column_at < 0); return if ($column_at > @{$this->{Columns}}); $this->{'column_selected'} = $column_at; ${$this->{Columns}}[$column_at]{'s_hlist'}->focus(); if (${$this->{Columns}}[$column_at]{'rows_added'} > 0) { my $row_selected = ${$this->{Columns}}[$column_at]{'row_select +ed'}; ${$this->{Columns}}[$column_at]{'s_hlist'}->selectionSet($row_ +selected); ${$this->{Columns}}[$column_at]{'s_hlist'}->anchorSet($row_sel +ected); ${$this->{Columns}}[$column_at]{'s_hlist'}->see($row_selected) +; } ${$this->{Columns}}[$column_at]{'s_hlist'}->update(); my $path = ""; foreach (@{$this->{Columns}}) { my $s_hlist = $_->{'s_hlist'}; my @s_hlist_row_selected = $s_hlist->selectionGet(); if (@s_hlist_row_selected > 0) { $path .= $s_hlist->entrycget($s_hlist_row_selected[0], -te +xt) . ","; } } $path =~ s/,$//; $this->Callback(-browsecmd => $column_at); } sub setFocusOnColunmNamed { my $this = shift; my $column_named = shift; return if (!defined($column_named)); return if (length($column_named) < 1); #print "SDFSDAF_ : $column_named\n"; #print Dumper($this->{Name_To_Column}); if (!exists($this->{Name_To_Column}->{$column_named})) { warn "Column named: \"" . $column_named . "\" doesn't exist!\n +"; return; } my $c_selected = $this->{Name_To_Column}->{$column_named}; $this->{'column_selected'} = $c_selected; #print "C: $c_selected\n"; ${$this->{Columns}}[$c_selected]{'s_hlist'}->focus(); if (${$this->{Columns}}[$c_selected]{'rows_added'} > 0) { my $row_selected = ${$this->{Columns}}[$c_selected]{'row_selec +ted'}; ${$this->{Columns}}[$c_selected]{'s_hlist'}->selectionSet($row +_selected); ${$this->{Columns}}[$c_selected]{'s_hlist'}->anchorSet($row_se +lected); ${$this->{Columns}}[$c_selected]{'s_hlist'}->see($row_selected +); ${$this->{Columns}}[$c_selected]{'s_hlist'}->update; } #$this->{'PanedWindow'}->update; } ###################################################################### +## 1; __END__
My email is included in the module if needed.

Thanks alot!
Ace

Replies are listed 'Best First'.
Re: Tk::ColumnView (part 2)
by zentara (Cardinal) on May 05, 2006 at 16:08 UTC
    Well I'm sure you learned alot from writing this, but I still don't think it's working right. Maybe it is... but I don't know what it's supposed to do. I tested it by running it in a directory with some nested subdirs containing more subdirs and files. When I run the script, if I click on a subdir, a new pane opens listing the contained files and subdirs, but as soon as I release the mouse button everything dissappears! I assume it's supposed to let you keep clicking and recursing into the subdirs and files?

    I'm not really a human, but I play one on earth. flash japh
      Yea, precisly! That is the idea! However, if you navigate with the arrow keys instead it should work much better - this is how it is supposed to work using the mouse aswell. You are supposed to have the content of the dir in the column to the right. Up/Down navigates in the dir. Left/Right is supposed to be "up"/"down" in the dir hierarchy. This is a little tricky since with the mouse you can click in _any_ column, while with the keys you kinda know where you are (internally in the code that is). That is, with the keys you step, while with the mouse you can jump... :)