Ace128 has asked for the wisdom of the Perl Monks concerning the following question:
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 . "/*"); } }
######################################## 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__
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Tk::ColumnView (part 2)
by zentara (Cardinal) on May 05, 2006 at 16:08 UTC | |
by Ace128 (Hermit) on May 05, 2006 at 16:51 UTC |